packages feed

wireform-proto 0.1.0.0 → 0.2.0.0

raw patch · 142 files changed

+22477/−32357 lines, 142 filesdep +sydtestdep +sydtest-hedgehogdep −tastydep −tasty-hedgehogdep −tasty-hunitdep ~aesondep ~basedep ~bytestring

Dependencies added: sydtest, sydtest-hedgehog

Dependencies removed: tasty, tasty-hedgehog, tasty-hunit

Dependency ranges changed: aeson, base, bytestring, containers, deepseq, directory, filepath, hashable, process, reflection, template-haskell, text, time, vector, wireform-core, wireform-derive

Files

CHANGELOG.md view
@@ -1,7 +1,24 @@ # Changelog for wireform-proto -## 0.1.0.0 -- 2026-05-16 +## 0.2.0.0 -- 2026-07-16++Breaking release from 0.1.0.0.++* Rename generated well-known-type modules to match their canonical+  `google.protobuf` package paths (for example,+  `Proto.Google.Protobuf.Timestamp`).+* Replace the legacy public wire codec surface with `Proto.Encode` and+  `Proto.Decode`, and add collecting decode diagnostics in+  `Proto.Decode.Collect`.+* Add `Proto.JSONSchema`, a draft-2020-12 / OpenAPI 3.1 schema generator+  aligned with the proto3 JSON mapping.+* Update `loadProto`, code generation, well-known types, dynamic messages,+  extensions, text format, compatibility, and tests to the current+  wireform-derive and wireform-core APIs.++## 0.1.0.0 -- 2026+ Initial release.  ### Highlights@@ -11,15 +28,14 @@   enums, oneofs, maps, services, well-known type imports, and   extension bindings -- plus a serialized `FileDescriptorProto` blob   for each module.-* Annotation-driven Template Haskell deriver (`Proto.TH.Derive`) that-  emits wire codecs (`MessageEncode` / `MessageDecode`),-  `IsMessage`, and `ProtoMessage` schema metadata for hand-written-  Haskell records. JSON instances (`ToJSON` / `FromJSON`) and `Hashable`-  are derived separately via `deriving anyclass` on the generated types.+* Annotation-driven Template Haskell deriver (`Proto.Derive`) that+  emits wire codecs (`MessageEncode` / `MessageDecode` / `MessageSize`),+  JSON instances, `Hashable`, `IsMessage`, and `ProtoMessage` schema+  metadata for hand-written Haskell records. * `Proto.TH.loadProto` Template Haskell splice that runs the parser   and the deriver together for an in-place `data` + instances bundle. * Inline `[proto| ... |]` quasi-quoter for one-off types-  (`Proto.TH.QQ`).+  (`Proto.QQ`). * `Proto.Setup` Cabal `Setup.hs` integration hook for pre-build   protobuf code generation. * `protoc-gen-wireform` `protoc` plugin (`--wireform_out=DIR`).@@ -28,18 +44,21 @@   (`Proto.SizedBuilder`, `Proto.Encode.Archetype`), pre-computed   field tags, packed repeated field encode/decode, branchless varint   sizing, lazy submessage decoding.-* Proto3 canonical JSON mapping with `json_name` override, base64-  bytes, string-encoded 64-bit integers, and NaN/Infinity sentinels.-  Generated types get `ToJSON` / `FromJSON` instances automatically;-  the implementation lives in `Proto.Internal.JSON` and-  `Proto.Internal.JSON.WellKnown`.+* Proto3 canonical JSON mapping (`Proto.JSON`) with `json_name`+  override, base64 bytes, string-encoded 64-bit integers, and+  NaN/Infinity sentinels.+* Proto → JSON Schema (draft 2020-12 / OpenAPI 3.1) walk+  (`Proto.JSONSchema`): the transport-agnostic half of schema-derived+  API doc generation. Emits `#/components/schemas` objects whose field+  names, 64-bit-int-as-string, base64 bytes, inlined well-known types,+  enum-as-string, map, and oneof shapes match the proto3-canonical-JSON+  codec byte-for-byte. Consumed by `wireform-connect`'s OpenAPI emitter. * Well-known types (`Timestamp`, `Duration`, `Any`, `FieldMask`,   `Struct`, `Value`, `ListValue`, `NullValue`, `Empty`, `Wrappers`,   `SourceContext`) generated from the bundled `.proto` files by the-  `regen-wkt` executable (`cabal run regen-wkt`).  Supplementary logic-  (  `Proto.Google.Protobuf.*.Util`) ships `packAny`, RFC 3339-  formatting, `TypeRegistry`, `FieldMask` ops. Well-known types are-  regenerated from the bundled `.proto` files by `cabal run regen-wkt`.+  `gen-wkt` executable.  Supplementary logic+  (`Proto.Google.Protobuf.*.Util`) ships `packAny`, RFC 3339+  formatting, `TypeRegistry`, `FieldMask` ops. * Proto2 typed extensions (`Proto.Extension.HasExtensions`),   unknown-field round-trip preservation, dynamic / untyped messages   (`Proto.Dynamic`), `.pbtxt` text format I/O@@ -47,9 +66,8 @@   (`Proto.Registry`). * Streaming and incremental decoders   (`Proto.Decode.Stream`, `Proto.Decode.Streaming`).-* gRPC service-method codegen. `loadProto` and the other codegen entry-  points generate typed service/method descriptor values. Wire framing-  and transport live in the `wireform-grpc` package.+* gRPC service-method codegen (`Proto.GRPC`).  The wire framing+  lives in the `wireform-grpc` package. * Conformance test driver (`Proto.Conformance`) that exposes the   protocol expected by the upstream   [`conformance_test_runner`](https://github.com/protocolbuffers/protobuf/tree/main/conformance).
README.md view
@@ -55,8 +55,8 @@   Left err -> print err ``` -For the other entry points, you can use inline `Proto.TH.QQ`, Haskell-first-`Proto.TH.Derive`, on-disk output via `Proto.Setup`, the `protoc`+For the other entry points, you can use inline `Proto.QQ`, Haskell-first+`Proto.Derive`, on-disk output via `Proto.Setup`, the `protoc` plugin, or direct `Proto.CodeGen`.  ---@@ -85,14 +85,14 @@ representations (see [Custom field representations](#custom-field-representations)). -### `Proto.TH.QQ`: inline quasi-quoter+### `Proto.QQ`: inline quasi-quoter  For one-off messages or quick prototyping:  ```haskell {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-}-import Proto.TH.QQ (proto)+import Proto.QQ (proto)  [proto|   syntax = "proto3";@@ -107,14 +107,14 @@ `SearchRequest` is now a regular Haskell type with encode/decode/JSON instances. -### `Proto.TH.Derive`: annotation-driven, no `.proto` file+### `Proto.Derive`: annotation-driven, no `.proto` file  Define your Haskell types first, derive the wire format from annotations:  ```haskell {-# LANGUAGE TemplateHaskell #-}-import Proto.TH.Derive (deriveProto, tag)+import Proto.Derive (deriveProto, tag)  data Measurement = Measurement   { sensorId    :: !Text@@ -131,7 +131,8 @@ ```  Useful when the Haskell types are the source of truth and protobuf-is just the serialisation format. You get `MessageEncode` / `MessageDecode` instances like every other path.+is just the serialisation format. You get `MessageEncode` /+`MessageDecode` / `MessageSize` instances like every other path.  ### `Proto.Setup`: Cabal pre-build hook @@ -215,8 +216,8 @@ | Method | When to use it | |:---|:---| | `loadProto` | Most projects. Simple, no build setup. |-| `Proto.TH.QQ` | Quick prototyping, one-off messages, tests. |-| `Proto.TH.Derive` | Haskell types are the source of truth. |+| `Proto.QQ` | Quick prototyping, one-off messages, tests. |+| `Proto.Derive` | Haskell types are the source of truth. | | `Proto.Setup` | You want generated `.hs` files on disk. | | `protoc-gen-wireform` | Your build system already runs `protoc`. | | `Proto.CodeGen` | Custom tooling, full pipeline control. |@@ -370,12 +371,12 @@  | Operation | wireform-proto | proto-lens | ratio | | :-------- | -------------: | ---------: | ----: |-| Small     |        30.9 ns |     153 ns | 4.94x |-| Medium    |        67.5 ns |     297 ns | 4.40x |-| Nested    |        54.6 ns |     335 ns | 6.13x |-| Repeated  |         786 ns |    2728 ns | 3.47x |+| Small     |        26.6 ns |     151 ns | 5.67x |+| Medium    |        72.4 ns |     286 ns | 3.95x |+| Nested    |        55.5 ns |     333 ns | 6.00x |+| Repeated  |        1038 ns |    2758 ns | 2.66x | -<sub>Last run 2026-05-15 00:00:00 UTC. ghc-9.8.4 on darwin-aarch64, criterion 1.6.5.</sub>+<sub>Last run 2026-06-27 11:56:42 UTC. ghc-9.8.4 on darwin-aarch64, criterion 1.6.5.</sub> <!-- END_AUTOGEN bench:proto-vs-proto-lens-encode -->  <!-- BEGIN_AUTOGEN bench:proto-vs-proto-lens-decode -->@@ -386,12 +387,12 @@  | Operation | wireform-proto | proto-lens | ratio | | :-------- | -------------: | ---------: | ----: |-| Small     |        45.9 ns |    81.9 ns | 1.78x |-| Medium    |         111 ns |     204 ns | 1.85x |-| Nested    |        76.7 ns |     148 ns | 1.93x |-| Repeated  |        1070 ns |    2166 ns | 2.02x |+| Small     |        41.6 ns |    81.6 ns | 1.96x |+| Medium    |         111 ns |     212 ns | 1.90x |+| Nested    |       80.10 ns |     151 ns | 1.87x |+| Repeated  |        1422 ns |    2293 ns | 1.61x | -<sub>Last run 2026-05-15 00:00:00 UTC. ghc-9.8.4 on darwin-aarch64, criterion 1.6.5.</sub>+<sub>Last run 2026-06-27 11:56:42 UTC. ghc-9.8.4 on darwin-aarch64, criterion 1.6.5.</sub> <!-- END_AUTOGEN bench:proto-vs-proto-lens-decode -->  Encode and decode cost about the same. A 3-field message encodes@@ -400,24 +401,6 @@ 1 us. Builder output can be streamed directly to a `Handle` without materialising a `ByteString`. -### Enabling LLVM--Add `-fllvm` to both this package and `wireform-core` in your-`cabal.project.local` (or the consuming package's `ghc-options`):--```cabal-package wireform-proto-  ghc-options: -fllvm--package wireform-core-  ghc-options: -fllvm-```--LLVM must be installed and on `$PATH` (`llc`, `opt`). The improvement is largest on repeated-fields (~27%) and nested message encode (~12%) where LLVM's loop-optimiser and instruction scheduler outperform the native code-generator.- ---  ## Also included@@ -504,16 +487,15 @@  ### gRPC codegen -`loadProto` (and the other code-generation entry points) generates typed-service and method descriptor values alongside the message types. The-`ServiceDef` / `MethodDef` types and all wire framing live in-[`wireform-grpc`](../wireform-grpc/); `wireform-proto` generates the-metadata that plugs into those types.+`Proto.GRPC` generates service/method type metadata. Wire framing+and transport live in [`wireform-grpc`](../wireform-grpc/).  ```haskell--- Generated by loadProto from a service definition:--- grpcGreeterService :: Network.GRPC.Common.ServiceDef--- grpcSayHelloMethod :: Network.GRPC.Common.MethodDef SayHelloRequest SayHelloResponse+import Proto.GRPC (ServiceDef(..), MethodDef(..))++-- Generated:+-- grpcGreeterService :: ServiceDef+-- grpcSayHelloMethod :: MethodDef ```  ---@@ -522,7 +504,7 @@  **2675 / 2675** tests pass against the official [upstream protobuf conformance suite][upstream-conformance] (`protocolbuffers/protobuf@v28.2`),-covering proto3 and proto2 binary and JSON.+covering proto3 and proto2 binary and JSON. Zero unexpected failures.  [upstream-conformance]: https://github.com/protocolbuffers/protobuf/tree/main/conformance @@ -549,7 +531,7 @@ **Optics integration:** wireform-proto generates plain records, so `OverloadedRecordDot` and pattern matching work out of the box. For lens-style access, `Proto.Lens` provides van Laarhoven lenses-via a `field @"name"` combinator, which are compatible with both `lens` and+via a `field @"name"` combinator — compatible with both `lens` and `microlens` with no dependency on either:  ```haskell
− bench/AccumBench.hs 
@@ -1,328 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ScopedTypeVariables #-}--{- | Criterion micro-benchmarks comparing repeated-field accumulator strategies.--The decode loop for @repeated@ non-packed fields threads an accumulator-as a parameter (since the Decoder monad is pure).  The accumulator must-support:--  * O(1) snoc during the field loop-  * One-shot materialisation to @V.Vector@ or @VU.Vector@ at the end--Strategies compared:--  1. __GrowList__ (current) — difference list (@[a] -> [a]@) with a-     count.  O(1) snoc, but allocates two heap objects per element:-     a lambda closure for @(.)@ and a partial application for @(x:)@.--  2. __RevList__ — plain reversed @[a]@ with a count.  O(1) snoc-     (one cons cell per element), @V.fromListN n (reverse xs)@ at-     the end.  No closure overhead.--  3. __Seq__ (@Data.Sequence.Seq@) — finger tree with O(1) amortised-     snoc.  Complex allocation pattern; measured to see if the-     implicit chunking pays off.--  4. __STLoop__ — tail-recursive loop inside @runST@, carrying the-     mutable vector + size + capacity as explicit parameters.  No-     @STRef@ wrapper; the recursive call is the "snoc".  This is the-     ST-based analogue of the existing pure decode loop — same-     structure, different accumulator.--  5. __STLoopU__ — same as STLoop but with an unboxed @MVU.MVector@,-     for scalar (Int-like) element types.--Benchmarks vary:--  * Element type: @Int@ (unboxable scalar) and @BS.ByteString@-    (heap-allocated, stands in for submessage values).--  * Count N: 4, 16, 64, 256 — trivial messages up to-    @FileDescriptorProto@-scale.--Run with:--> cabal bench accum-bench -- --output accum-bench.html--}-module Main where--import Control.DeepSeq (force, rnf)-import Control.Exception (evaluate)-import Control.Monad.ST (runST)-import Criterion.Main-import Data.ByteString qualified as BS-import Data.List (foldl')-import Data.Sequence (Seq)-import Data.Sequence qualified as Seq-import Data.Vector qualified as V-import Data.Vector.Mutable qualified as MV-import Data.Vector.Unboxed qualified as VU-import Data.Vector.Unboxed.Mutable qualified as MVU----------------------------------------------------------------------------- Strategy 1: GrowList (current implementation, inlined for self-containment)---------------------------------------------------------------------------data GrowList a = GrowList-  { glBuild :: !([a] -> [a])-  , glCount :: {-# UNPACK #-} !Int-  }--emptyGrowList :: GrowList a-emptyGrowList = GrowList id 0-{-# INLINE emptyGrowList #-}--snocGrowList :: GrowList a -> a -> GrowList a-snocGrowList (GrowList f n) x = GrowList (f . (x :)) (n + 1)-{-# INLINE snocGrowList #-}--growListToVector :: GrowList a -> V.Vector a-growListToVector (GrowList f n)-  | n == 0 = V.empty-  | otherwise = V.create $ do-      let !xs = f []-      mv <- MV.new n-      let fill !_ [] = pure ()-          fill !i (e : es) = MV.unsafeWrite mv i e >> fill (i + 1) es-      fill 0 xs-      pure mv-{-# INLINE growListToVector #-}--growListToVectorU :: VU.Unbox a => GrowList a -> VU.Vector a-growListToVectorU gl = VU.convert (growListToVector gl)-{-# INLINE growListToVectorU #-}------------------------------------------------------------------------------ Strategy 2: reversed cons list with count---------------------------------------------------------------------------data RevList a = RevList {-# UNPACK #-} !Int ![a]--emptyRevList :: RevList a-emptyRevList = RevList 0 []-{-# INLINE emptyRevList #-}--snocRevList :: RevList a -> a -> RevList a-snocRevList (RevList n xs) x = RevList (n + 1) (x : xs)-{-# INLINE snocRevList #-}--revListToVector :: RevList a -> V.Vector a-revListToVector (RevList n xs) = V.fromListN n (reverse xs)-{-# INLINE revListToVector #-}--revListToVectorU :: VU.Unbox a => RevList a -> VU.Vector a-revListToVectorU (RevList n xs) = VU.fromListN n (reverse xs)-{-# INLINE revListToVectorU #-}------------------------------------------------------------------------------ Strategy 3: Seq---------------------------------------------------------------------------seqToVector :: Seq a -> V.Vector a-seqToVector s = V.fromList (foldr (:) [] s)-{-# INLINE seqToVector #-}------------------------------------------------------------------------------ Strategy 4: ST tail-recursive loop, boxed------ Carries (size, capacity, MV.MVector) as explicit loop params —--- no STRef overhead.  Models what the generated decode loop would--- look like if the Decoder monad were restructured to run in ST.---------------------------------------------------------------------------stLoopAccum :: [a] -> V.Vector a-stLoopAccum xs = runST $ do-    mv0 <- MV.unsafeNew 4-    go 0 4 mv0 xs-  where-    go !sz !_ mv [] =-        V.unsafeFreeze (MV.unsafeSlice 0 sz mv)-    go !sz !cap mv (x : rest) = do-        mv' <- if sz < cap-                then pure mv-                else MV.unsafeGrow mv cap-        MV.unsafeWrite mv' sz x-        go (sz + 1) (if sz < cap then cap else cap * 2) mv' rest-{-# NOINLINE stLoopAccum #-}------------------------------------------------------------------------------ Strategy 5: ST tail-recursive loop, unboxed---------------------------------------------------------------------------stLoopAccumU :: VU.Unbox a => [a] -> VU.Vector a-stLoopAccumU xs = runST $ do-    mv0 <- MVU.unsafeNew 4-    go 0 4 mv0 xs-  where-    go !sz !_ mv [] =-        VU.unsafeFreeze (MVU.unsafeSlice 0 sz mv)-    go !sz !cap mv (x : rest) = do-        mv' <- if sz < cap-                then pure mv-                else MVU.unsafeGrow mv cap-        MVU.unsafeWrite mv' sz x-        go (sz + 1) (if sz < cap then cap else cap * 2) mv' rest-{-# NOINLINE stLoopAccumU #-}------------------------------------------------------------------------------ Strategy 6: SmallList------ Inline 0–4 elements as ADT constructors — zero allocation for the--- dominant single-element case.  Falls back to a reversed cons list--- (with count) for N > 4.  Purely threadable; no IO/ST needed.---------------------------------------------------------------------------data SmallList a-    = SL0-    | SL1 a-    | SL2 a a-    | SL3 a a a-    | SL4 a a a a-    | SLN {-# UNPACK #-} !Int ![a]  -- reversed, N > 4--emptySL :: SmallList a-emptySL = SL0-{-# INLINE emptySL #-}--snocSL :: SmallList a -> a -> SmallList a-snocSL SL0           x = SL1 x-snocSL (SL1 a)       x = SL2 a x-snocSL (SL2 a b)     x = SL3 a b x-snocSL (SL3 a b c)   x = SL4 a b c x-snocSL (SL4 a b c d) x = SLN 5 [x, d, c, b, a]-snocSL (SLN n xs)    x = SLN (n + 1) (x : xs)-{-# INLINE snocSL #-}--slToVector :: SmallList a -> V.Vector a-slToVector SL0           = V.empty-slToVector (SL1 a)       = V.singleton a-slToVector (SL2 a b)     = V.fromListN 2 [a, b]-slToVector (SL3 a b c)   = V.fromListN 3 [a, b, c]-slToVector (SL4 a b c d) = V.fromListN 4 [a, b, c, d]-slToVector (SLN n xs)    = V.fromListN n (reverse xs)-{-# INLINE slToVector #-}--slToVectorU :: VU.Unbox a => SmallList a -> VU.Vector a-slToVectorU SL0           = VU.empty-slToVectorU (SL1 a)       = VU.singleton a-slToVectorU (SL2 a b)     = VU.fromListN 2 [a, b]-slToVectorU (SL3 a b c)   = VU.fromListN 3 [a, b, c]-slToVectorU (SL4 a b c d) = VU.fromListN 4 [a, b, c, d]-slToVectorU (SLN n xs)    = VU.fromListN n (reverse xs)-{-# INLINE slToVectorU #-}------------------------------------------------------------------------------ Strategy 7: ChunkVec------ Buffer elements into small fixed-size chunks (chunkSz = 8).  When a--- chunk fills, freeze it into an immutable V.Vector via runST and push--- it onto a reversed list of frozen chunks.  At the end, reverse the--- chunk list and V.concat.------ Per-element cost: ~1 cons cell.  A vector alloc happens only every--- chunkSz elements.  Materialization is a single V.concat (one copy).---------------------------------------------------------------------------chunkSz :: Int-chunkSz = 8--data ChunkVec a = ChunkVec-    { cvTotal   :: {-# UNPACK #-} !Int-    , cvChunks  :: ![V.Vector a]    -- frozen completed chunks, reversed-    , cvPending :: ![a]             -- reversed current partial chunk-    , cvPendSz  :: {-# UNPACK #-} !Int-    }--emptyCV :: ChunkVec a-emptyCV = ChunkVec 0 [] [] 0-{-# INLINE emptyCV #-}--snocCV :: ChunkVec a -> a -> ChunkVec a-snocCV cv x-    | cvPendSz cv + 1 >= chunkSz =-        let !chunk = V.fromListN chunkSz (reverse (x : cvPending cv))-        in ChunkVec (cvTotal cv + 1) (chunk : cvChunks cv) [] 0-    | otherwise =-        ChunkVec (cvTotal cv + 1) (cvChunks cv) (x : cvPending cv) (cvPendSz cv + 1)-{-# INLINE snocCV #-}--cvToVector :: ChunkVec a -> V.Vector a-cvToVector cv =-    let !lastChunk = V.fromListN (cvPendSz cv) (reverse (cvPending cv))-        !allChunks = reverse (lastChunk : cvChunks cv)-    in V.concat allChunks-{-# INLINE cvToVector #-}--cvToVectorU :: VU.Unbox a => ChunkVec a -> VU.Vector a-cvToVectorU cv = VU.convert (cvToVector cv)-{-# INLINE cvToVectorU #-}------------------------------------------------------------------------------ Strategy 8: RevList with fill-backwards (no intermediate 'reverse')------ Collects into a reversed [a] with a count, then V.create fills the--- vector by writing index n-1-i for each element, traversing the--- reversed list front-to-back.  Avoids the extra O(n) 'reverse' pass--- that RevList pays.---------------------------------------------------------------------------revFillToVector :: RevList a -> V.Vector a-revFillToVector (RevList n xs) = V.create $ do-    mv <- MV.unsafeNew n-    let go !i []       = pure ()-        go !i (e : es) = MV.unsafeWrite mv (n - 1 - i) e >> go (i + 1) es-    go 0 xs-    pure mv-{-# INLINE revFillToVector #-}--revFillToVectorU :: VU.Unbox a => RevList a -> VU.Vector a-revFillToVectorU (RevList n xs) = VU.create $ do-    mv <- MVU.unsafeNew n-    let go !i []       = pure ()-        go !i (e : es) = MVU.unsafeWrite mv (n - 1 - i) e >> go (i + 1) es-    go 0 xs-    pure mv-{-# INLINE revFillToVectorU #-}------------------------------------------------------------------------------ Benchmark groups---------------------------------------------------------------------------benchN :: Int -> [Benchmark]-benchN n =-    let !ints = [1 .. n] :: [Int]-        !bss  = map (\i -> BS.replicate (i `rem` 16 + 1) 0x42) ints-    in-    [ bgroup ("Int/" <> show n)-        [ bench "GrowList"   $ nf (\es -> growListToVectorU (foldl' snocGrowList emptyGrowList es)) ints-        , bench "RevList"    $ nf (\es -> revListToVectorU  (foldl' snocRevList  emptyRevList  es)) ints-        , bench "RevFill"    $ nf (\es -> revFillToVectorU  (foldl' snocRevList  emptyRevList  es)) ints-        , bench "SmallList"  $ nf (\es -> slToVectorU       (foldl' snocSL       emptySL       es)) ints-        , bench "ChunkVec"   $ nf (\es -> cvToVectorU       (foldl' snocCV       emptyCV       es)) ints-        , bench "STLoop"     $ nf stLoopAccumU ints-        ]-    , bgroup ("BS/" <> show n)-        [ bench "GrowList"   $ nf (\es -> growListToVector  (foldl' snocGrowList emptyGrowList es)) bss-        , bench "RevList"    $ nf (\es -> revListToVector   (foldl' snocRevList  emptyRevList  es)) bss-        , bench "RevFill"    $ nf (\es -> revFillToVector   (foldl' snocRevList  emptyRevList  es)) bss-        , bench "SmallList"  $ nf (\es -> slToVector        (foldl' snocSL       emptySL       es)) bss-        , bench "ChunkVec"   $ nf (\es -> cvToVector        (foldl' snocCV       emptyCV       es)) bss-        , bench "STLoop"     $ nf stLoopAccum bss-        ]-    ]---main :: IO ()-main = do-    _ <- evaluate $ force ([1..256] :: [Int])-    evaluate $ rnf (map (\i -> BS.replicate (i `rem` 16 + 1) 0x42) ([1..256] :: [Int]))-    defaultMain $ concatMap benchN [4, 16, 64, 256]
bench/LoadProtoBench.hs view
@@ -1,36 +1,38 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-unused-imports -Wno-orphans -Wno-missing-signatures                  -Wno-incomplete-patterns -Wno-incomplete-uni-patterns #-} --- | Micro-benchmarks for the @loadProto@-generated codec hot--- paths: wire encode \/ decode and JSON encode \/ decode for a--- representative singular-scalar message, a repeated-scalar--- message, a oneof message, and a message holding a known--- enum field (exercises the open-enum representation and its--- catch-all wrapper). The bench is hand-rolled (no criterion--- dep) so it ships without dragging extra deps into--- wireform-proto.+{- | Micro-benchmarks for the @loadProto@-generated codec hot+paths: wire encode \/ decode and JSON encode \/ decode for a+representative singular-scalar message, a repeated-scalar+message, a oneof message, and a message holding a known+enum field (exercises the open-enum representation and its+catch-all wrapper). The bench is hand-rolled (no criterion+dep) so it ships without dragging extra deps into+wireform-proto.+-} module Main where  import Control.DeepSeq (NFData, deepseq, force) import Control.Exception (evaluate)-import qualified Data.Aeson as Aeson-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as BL-import qualified Data.Text as T-import qualified Data.Vector as V+import Data.Aeson qualified as Aeson+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Data.Reflection (Given (..))+import Data.Text qualified as T+import Data.Vector qualified as V import GHC.Generics (Generic)+import Proto.Decode qualified as PD+import Proto.Encode qualified as PE+import Proto.Extension qualified as Ext+import Proto.Google.Protobuf.Timestamp (Timestamp (..), defaultTimestamp)+import Proto.Internal.JSON.Extension (ExtensionRegistry, emptyExtensionRegistry)+import Proto.TH (loadProto) import System.CPUTime (getCPUTime) import System.IO (hFlush, stdout) import Text.Printf (printf) -import Data.Reflection (Given (..))-import Proto.Internal.JSON.Extension (ExtensionRegistry, emptyExtensionRegistry)-import Proto.TH (loadProto)-import qualified Proto.Decode as PD-import qualified Proto.Encode as PE-import qualified Proto.Extension as Ext-import Proto.Google.Protobuf.WellKnownTypes.Timestamp (Timestamp(..), defaultTimestamp)  -- TH-generated JSON instances carry a 'Given ExtensionRegistry' constraint -- for proto2 extensions; this bench schema has none, so satisfy it with@@ -39,45 +41,51 @@ instance Given ExtensionRegistry where   given = emptyExtensionRegistry + -- A small inline schema covering the common shapes.+-- The generated record and enum types already derive 'NFData'+-- (via the deriver's anyclass clause), so the bench's deepseq+-- forcing works without hand-written instances. $(loadProto "bench/Bench.proto") --- All loadProto-generated record types already derive Generic;--- bolt on NFData via Generic for the bench's deepseq forcing.-deriving anyclass instance NFData Person-deriving anyclass instance NFData Numbers-deriving anyclass instance NFData Status-deriving anyclass instance NFData Choice-deriving anyclass instance NFData Choice'Choice  ------------------------------------------------------------------------ -- Test inputs ------------------------------------------------------------------------  samplePerson :: Person-samplePerson = defaultPerson-  { personName  = T.pack "John Doe"-  , personAge   = 30-  , personEmail = T.pack "john@example.com"-  , personScore = 95.5-  , personActive = True-  }+samplePerson =+  defaultPerson+    { personName = T.pack "John Doe"+    , personAge = 30+    , personEmail = T.pack "john@example.com"+    , personScore = 95.5+    , personActive = True+    } + sampleNumbers :: Numbers-sampleNumbers = defaultNumbers-  { numbersInts   = V.fromList [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]-  , numbersDoubles = V.fromList [1.1, 2.2, 3.3, 4.4, 5.5]-  }+sampleNumbers =+  defaultNumbers+    { numbersInts = V.fromList [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]+    , numbersDoubles = V.fromList [1.1, 2.2, 3.3, 4.4, 5.5]+    } + sampleChoice :: Choice-sampleChoice = defaultChoice-  { choiceChoice = Just (Choice'Choice'StringValue (T.pack "hello"))-  }+sampleChoice =+  defaultChoice+    { choiceChoice = Just (Choice'Choice'StringValue (T.pack "hello"))+    } + sampleStatus :: Person-sampleStatus = samplePerson-  { personStatus = Status'StatusActive }+sampleStatus =+  samplePerson+    { personStatus = Status'StatusActive+    } + ------------------------------------------------------------------------ -- Timing ------------------------------------------------------------------------@@ -85,16 +93,18 @@ iters :: Int iters = 200000 --- | Run @action@ @n@ times, accumulating an Int summary so the--- compiler can't dead-code-eliminate the work. The summary is--- 'evaluate'd to WHNF every iteration, defeating laziness.++{- | Run @action@ @n@ times, accumulating an Int summary so the+compiler can't dead-code-eliminate the work. The summary is+'evaluate'd to WHNF every iteration, defeating laziness.+-} timeNF :: NFData b => Int -> (Int -> b) -> (b -> Int) -> IO Integer timeNF n make summarize = do   -- Warmup   _ <- evaluate (force (make n))   start <- getCPUTime   let loop !k !acc-        | k <= 0    = pure acc+        | k <= 0 = pure acc         | otherwise = do             !y <- evaluate (make k)             let !a = acc + summarize y@@ -106,15 +116,18 @@   printf "    [acc=%d] " final   pure ((end - start) `div` fromIntegral n) + nsPerIter :: Integer -> Integer nsPerIter = id + bench :: NFData b => String -> (Int -> b) -> (b -> Int) -> IO () bench label make summarize = do   ns <- timeNF iters make summarize   printf "%-36s %7d ns/iter\n" label ns   hFlush stdout + ------------------------------------------------------------------------ -- Bench drivers ------------------------------------------------------------------------@@ -125,104 +138,126 @@   putStrLn (replicate 60 '=')   putStrLn "" -  let !p      = samplePerson+  let !p = samplePerson       !pBytes = PE.encodeMessage p-      !pJson  = Aeson.encode p+      !pJson = Aeson.encode p   printf "Person (4 scalars + 1 bool, encoded size = %d bytes):\n" (BS.length pBytes)   bench "wire encode" (\_ -> PE.encodeMessage p) BS.length-  bench "wire decode"-    (\_ -> case PD.decodeMessage pBytes :: Either PD.DecodeError Person of-             Right v -> v-             Left _  -> defaultPerson)+  bench+    "wire decode"+    ( \_ -> case PD.decodeMessage pBytes :: Either PD.DecodeError Person of+        Right v -> v+        Left _ -> defaultPerson+    )     (\v -> fromIntegral (personAge v))   bench "JSON encode" (\_ -> Aeson.encode p) (fromIntegral . BL.length)-  bench "JSON decode"-    (\_ -> case Aeson.eitherDecode pJson :: Either String Person of-             Right v -> v-             Left _  -> defaultPerson)+  bench+    "JSON decode"+    ( \_ -> case Aeson.eitherDecode pJson :: Either String Person of+        Right v -> v+        Left _ -> defaultPerson+    )     (\v -> fromIntegral (personAge v))   putStrLn "" -  let !n      = sampleNumbers+  let !n = sampleNumbers       !nBytes = PE.encodeMessage n-      !nJson  = Aeson.encode n+      !nJson = Aeson.encode n   printf "Numbers (10 int32 + 5 doubles, encoded size = %d bytes):\n" (BS.length nBytes)   bench "wire encode" (\_ -> PE.encodeMessage n) BS.length-  bench "wire decode"-    (\_ -> case PD.decodeMessage nBytes :: Either PD.DecodeError Numbers of-             Right v -> v-             Left _  -> defaultNumbers)+  bench+    "wire decode"+    ( \_ -> case PD.decodeMessage nBytes :: Either PD.DecodeError Numbers of+        Right v -> v+        Left _ -> defaultNumbers+    )     (\v -> V.length (numbersInts v))   bench "JSON encode" (\_ -> Aeson.encode n) (fromIntegral . BL.length)-  bench "JSON decode"-    (\_ -> case Aeson.eitherDecode nJson :: Either String Numbers of-             Right v -> v-             Left _  -> defaultNumbers)+  bench+    "JSON decode"+    ( \_ -> case Aeson.eitherDecode nJson :: Either String Numbers of+        Right v -> v+        Left _ -> defaultNumbers+    )     (\v -> V.length (numbersInts v))   putStrLn "" -  let !c      = sampleChoice+  let !c = sampleChoice       !cBytes = PE.encodeMessage c-      !cJson  = Aeson.encode c+      !cJson = Aeson.encode c   printf "Choice (oneof string variant, encoded size = %d bytes):\n" (BS.length cBytes)   bench "wire encode" (\_ -> PE.encodeMessage c) BS.length-  bench "wire decode"-    (\_ -> case PD.decodeMessage cBytes :: Either PD.DecodeError Choice of-             Right v -> v-             Left _  -> defaultChoice)-    (\v -> case choiceChoice v of-             Just (Choice'Choice'StringValue s) -> T.length s-             _ -> 0)+  bench+    "wire decode"+    ( \_ -> case PD.decodeMessage cBytes :: Either PD.DecodeError Choice of+        Right v -> v+        Left _ -> defaultChoice+    )+    ( \v -> case choiceChoice v of+        Just (Choice'Choice'StringValue s) -> T.length s+        _ -> 0+    )   bench "JSON encode" (\_ -> Aeson.encode c) (fromIntegral . BL.length)-  bench "JSON decode"-    (\_ -> case Aeson.eitherDecode cJson :: Either String Choice of-             Right v -> v-             Left _  -> defaultChoice)-    (\v -> case choiceChoice v of-             Just (Choice'Choice'StringValue s) -> T.length s-             _ -> 0)+  bench+    "JSON decode"+    ( \_ -> case Aeson.eitherDecode cJson :: Either String Choice of+        Right v -> v+        Left _ -> defaultChoice+    )+    ( \v -> case choiceChoice v of+        Just (Choice'Choice'StringValue s) -> T.length s+        _ -> 0+    )   putStrLn ""    putStrLn "Sanity baselines (small Aeson Object):"   let aesonBytes = "{\"name\":\"John Doe\"}" :: BL.ByteString-  bench "Aeson decode tiny obj"-    (\_ -> case Aeson.eitherDecode aesonBytes :: Either String Aeson.Value of-             Right v -> v-             Left _  -> Aeson.Null)+  bench+    "Aeson decode tiny obj"+    ( \_ -> case Aeson.eitherDecode aesonBytes :: Either String Aeson.Value of+        Right v -> v+        Left _ -> Aeson.Null+    )     (\_ -> 0)   putStrLn ""    putStrLn "Status enum (open-enum representation):"-  let !sKnown   = sampleStatus-      !sBytesK  = PE.encodeMessage sKnown-      !sUnknown = sampleStatus { personStatus = Status'Unknown 12345 }-      !sBytesU  = PE.encodeMessage sUnknown-  bench "encode known enum"   (\_ -> PE.encodeMessage sKnown) BS.length-  bench "decode known enum"-    (\_ -> case PD.decodeMessage sBytesK :: Either PD.DecodeError Person of-             Right v -> v-             Left _  -> defaultPerson)+  let !sKnown = sampleStatus+      !sBytesK = PE.encodeMessage sKnown+      !sUnknown = sampleStatus {personStatus = Status''Unrecognized 12345}+      !sBytesU = PE.encodeMessage sUnknown+  bench "encode known enum" (\_ -> PE.encodeMessage sKnown) BS.length+  bench+    "decode known enum"+    ( \_ -> case PD.decodeMessage sBytesK :: Either PD.DecodeError Person of+        Right v -> v+        Left _ -> defaultPerson+    )     (\v -> fromEnum (personStatus v))   bench "encode unknown enum" (\_ -> PE.encodeMessage sUnknown) BS.length-  bench "decode unknown enum"-    (\_ -> case PD.decodeMessage sBytesU :: Either PD.DecodeError Person of-             Right v -> v-             Left _  -> defaultPerson)+  bench+    "decode unknown enum"+    ( \_ -> case PD.decodeMessage sBytesU :: Either PD.DecodeError Person of+        Right v -> v+        Left _ -> defaultPerson+    )     (\v -> fromEnum (personStatus v))   putStrLn ""    -- Direct Timestamp bench. The checked-in-  -- Proto.Google.Protobuf.WellKnownTypes.Timestamp uses a hand-edited+  -- Proto.Google.Protobuf.Timestamp uses a hand-edited   -- 'loop_dispatch + loop_after_N + withTagM' state-machine shape   -- that this benchmark measures against the codegen-emitted   -- shape after regen.-  let !ts      = defaultTimestamp { timestampSeconds = 1234567890, timestampNanos = 999999 }+  let !ts = defaultTimestamp {timestampSeconds = 1234567890, timestampNanos = 999999}       !tsBytes = PE.encodeMessage ts   printf "Timestamp (2 varint scalars, encoded size = %d bytes):\n" (BS.length tsBytes)   bench "wire encode" (\_ -> PE.encodeMessage ts) BS.length-  bench "wire decode"-    (\_ -> case PD.decodeMessage tsBytes :: Either PD.DecodeError Timestamp of-             Right v -> v-             Left _  -> defaultTimestamp)+  bench+    "wire decode"+    ( \_ -> case PD.decodeMessage tsBytes :: Either PD.DecodeError Timestamp of+        Right v -> v+        Left _ -> defaultTimestamp+    )     (\v -> fromIntegral (timestampSeconds v))   putStrLn ""
bench/compare/Main.hs view
@@ -3,16 +3,11 @@  {- | Criterion benchmark: wireform vs proto-lens (real generated code). -Wireform side uses @Proto.CodeGen@ output (@Proto.Bench.Wireform.Messages@)-including the sorted-tag @inOrderStage@ decode fast path. Regenerate that-module after editing @bench/compare/gen-wireform/Messages.proto@:--> cabal run regen-compare-bench-wireform- Run: cabal bench compare-bench -} module Main where +import Control.DeepSeq (NFData (..)) import Criterion.Main import Data.ByteString qualified as BS import Data.Int (Int32, Int64)@@ -24,29 +19,29 @@ import Data.Vector.Unboxed qualified as VU import Lens.Family2 ((&), (.~)) import Proto.Bench qualified as PL-import Proto.Bench.Wireform.Messages qualified as W import Proto.Bench_Fields qualified as F-import Proto qualified as H-import Proto qualified as H+import Proto.Decode qualified as H+import Proto.Encode qualified as H+import WireformTypes  -encSmallH :: W.Small -> BS.ByteString-encSmallH = H.encodeMessage+encSmallH :: HSmall -> BS.ByteString+encSmallH = H.encodeMessageSized {-# NOINLINE encSmallH #-}  -encMediumH :: W.Medium -> BS.ByteString-encMediumH = H.encodeMessage+encMediumH :: HMedium -> BS.ByteString+encMediumH = H.encodeMessageSized {-# NOINLINE encMediumH #-}  -encNestedH :: W.WithNested -> BS.ByteString-encNestedH = H.encodeMessage+encNestedH :: HWithNested -> BS.ByteString+encNestedH = H.encodeMessageSized {-# NOINLINE encNestedH #-}  -encRepH :: W.WithRepeated -> BS.ByteString-encRepH = H.encodeMessage+encRepH :: HWithRepeated -> BS.ByteString+encRepH = H.encodeMessageSized {-# NOINLINE encRepH #-}  @@ -123,7 +118,7 @@     ]  -decSmallH :: BS.ByteString -> Either H.DecodeError W.Small+decSmallH :: BS.ByteString -> Either H.DecodeError HSmall decSmallH = H.decodeMessage {-# NOINLINE decSmallH #-} @@ -133,8 +128,8 @@ {-# NOINLINE decSmallP #-}  -rtSmallH :: W.Small -> Either H.DecodeError W.Small-rtSmallH m = H.decodeMessage (H.encodeMessage m)+rtSmallH :: HSmall -> Either H.DecodeError HSmall+rtSmallH m = H.decodeMessage (H.encodeMessageSized m) {-# NOINLINE rtSmallH #-}  @@ -143,7 +138,7 @@ {-# NOINLINE rtSmallP #-}  -decMediumH :: BS.ByteString -> Either H.DecodeError W.Medium+decMediumH :: BS.ByteString -> Either H.DecodeError HMedium decMediumH = H.decodeMessage {-# NOINLINE decMediumH #-} @@ -153,8 +148,8 @@ {-# NOINLINE decMediumP #-}  -rtMediumH :: W.Medium -> Either H.DecodeError W.Medium-rtMediumH m = H.decodeMessage (H.encodeMessage m)+rtMediumH :: HMedium -> Either H.DecodeError HMedium+rtMediumH m = H.decodeMessage (H.encodeMessageSized m) {-# NOINLINE rtMediumH #-}  @@ -163,7 +158,7 @@ {-# NOINLINE rtMediumP #-}  -decNestedH :: BS.ByteString -> Either H.DecodeError W.WithNested+decNestedH :: BS.ByteString -> Either H.DecodeError HWithNested decNestedH = H.decodeMessage {-# NOINLINE decNestedH #-} @@ -173,8 +168,8 @@ {-# NOINLINE decNestedP #-}  -rtNestedH :: W.WithNested -> Either H.DecodeError W.WithNested-rtNestedH m = H.decodeMessage (H.encodeMessage m)+rtNestedH :: HWithNested -> Either H.DecodeError HWithNested+rtNestedH m = H.decodeMessage (H.encodeMessageSized m) {-# NOINLINE rtNestedH #-}  @@ -183,7 +178,7 @@ {-# NOINLINE rtNestedP #-}  -decRepH :: BS.ByteString -> Either H.DecodeError W.WithRepeated+decRepH :: BS.ByteString -> Either H.DecodeError HWithRepeated decRepH = H.decodeMessage {-# NOINLINE decRepH #-} @@ -193,68 +188,26 @@ {-# NOINLINE decRepP #-}  --- wireform test values (PrefixedFields codegen; keep in sync with proto-lens fixtures)+-- wireform test values -smallHS :: W.Small-smallHS =-  W.Small-    { W.smallId = 42-    , W.smallName = "hello world"-    , W.smallActive = True-    , W.smallUnknownFields = []-    }+smallHS :: HSmall+smallHS = HSmall 42 "hello world" True  -mediumHS :: W.Medium-mediumHS =-  W.Medium-    { W.mediumTitle = "benchmark title"-    , W.mediumCount = 100-    , W.mediumScore = 3.14159-    , W.mediumPayload = "payload\x00\x01\x02"-    , W.mediumEnabled = True-    , W.mediumTimestamp = 1708000000-    , W.mediumDescription = "a medium description"-    , W.mediumRatio = 0.75-    , W.mediumUnknownFields = []-    }+mediumHS :: HMedium+mediumHS = HMedium "benchmark title" 100 3.14159 "payload\x00\x01\x02" True 1708000000 "a medium description" 0.75  -nestedHS :: W.WithNested-nestedHS =-  W.WithNested-    { W.withNestedId = 99-    , W.withNestedInner =-        Just-          ( W.Small-              { W.smallId = 1-              , W.smallName = "inner"-              , W.smallActive = True-              , W.smallUnknownFields = []-              }-          )-    , W.withNestedLabel = "outer label"-    , W.withNestedUnknownFields = []-    }+nestedHS :: HWithNested+nestedHS = HWithNested 99 (Just (HSmall 1 "inner" True)) "outer label"  -repeatedHS :: W.WithRepeated+repeatedHS :: HWithRepeated repeatedHS =-  W.WithRepeated-    { W.withRepeatedValues = VU.fromList [1 .. 50]-    , W.withRepeatedTags = V.fromList (fmap (\i -> "tag_" <> T.pack (show i)) [1 .. 20 :: Int])-    , W.withRepeatedItems =-        V.fromList-          [ W.Small-              { W.smallId = fromIntegral i-              , W.smallName = "item" <> T.pack (show i)-              , W.smallActive = even i-              , W.smallUnknownFields = []-              }-          | i <- [1 .. 10 :: Int]-          ]-    , W.withRepeatedUnknownFields = []-    }+  HWithRepeated+    (VU.fromList [1 .. 50])+    (V.fromList (fmap (\i -> "tag_" <> T.pack (show i)) [1 .. 20 :: Int]))+    (V.fromList [HSmall (fromIntegral i) ("item" <> T.pack (show i)) (even i) | i <- [1 .. 10 :: Int]])   -- proto-lens test values (using the real generated field lenses)@@ -288,9 +241,9 @@           & F.name .~ ("inner" :: Text)           & F.active .~ True   in (defMessage :: PL.WithNested)-      & F.id .~ (99 :: Int64)-      & F.inner .~ inner-      & F.label .~ ("outer label" :: Text)+       & F.id .~ (99 :: Int64)+       & F.inner .~ inner+       & F.label .~ ("outer label" :: Text)   repeatedPL :: PL.WithRepeated@@ -302,12 +255,12 @@           & F.name .~ (("item" <> T.pack (show i)) :: Text)           & F.active .~ (even i :: Bool)   in (defMessage :: PL.WithRepeated)-      & F.vec'values .~ VU.fromList ([1 .. 50] :: [Int32])-      & F.vec'tags .~ V.fromList (fmap (\i -> ("tag_" <> T.pack (show i)) :: Text) [1 .. 20 :: Int])-      & F.vec'items .~ V.fromList (fmap mkItem [1 .. 10])+       & F.vec'values .~ VU.fromList ([1 .. 50] :: [Int32])+       & F.vec'tags .~ V.fromList (fmap (\i -> ("tag_" <> T.pack (show i)) :: Text) [1 .. 20 :: Int])+       & F.vec'items .~ V.fromList (fmap mkItem [1 .. 10])  --- Pre-encoded bytes (wireform canonical encoding for the fixtures above)+-- Pre-encoded bytes smallBytes, mediumBytes, nestedBytes, repeatedBytes :: BS.ByteString smallBytes = encSmallH smallHS mediumBytes = encMediumH mediumHS
+ bench/compare/WireformTypes.hs view
@@ -0,0 +1,375 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE UnboxedTuples #-}++-- | wireform types matching bench.proto for benchmark comparison.+module WireformTypes where++import Control.DeepSeq (NFData)+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Int (Int32, Int64)+import Data.Text (Text)+import Data.Vector qualified as V+import Data.Vector.Unboxed qualified as VU+import Data.Word (Word64, Word8)+import GHC.Exts (Int (I#), Int#)+import GHC.Generics (Generic)+import Proto.Decode+import Proto.Encode+import Proto.Internal.Encode.Archetype+import Proto.Internal.GrowList+import Proto.Internal.SizedBuilder qualified as SB+import Proto.Internal.Wire.Decode (Decoder (..), runDecoder')+import Proto.Internal.Wire.Encode (putText, putVarint, varintSize)+import Wireform.Builder qualified as FB+++-- Small++data HSmall = HSmall+  { hsId :: {-# UNPACK #-} !Int64+  , hsName :: !Text+  , hsActive :: !Bool+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++buildSizedSmall :: HSmall -> SB.SizedBuilder+buildSizedSmall (HSmall i n a) =+  (if i == 0 then mempty else sbArchVarint 0x08 (fromIntegral i))+    <> (if n == "" then mempty else sbArchString 0x12 n)+    <> (if not a then mempty else sbArchBool 0x18 True)+{-# INLINE buildSizedSmall #-}+++instance MessageEncode HSmall where+  buildMessage = buildSmallDirect+  {-# INLINE buildMessage #-}+++instance MessageSize HSmall where+  messageSize = sizeSmall+  {-# INLINE messageSize #-}+++-- Direct builder path (skip SizedBuilder overhead)+buildSmallDirect :: HSmall -> FB.Builder+buildSmallDirect (HSmall i n a) =+  (if i == 0 then mempty else FB.word8 0x08 <> putVarint (fromIntegral i))+    <> (if n == "" then mempty else FB.word8 0x12 <> putText n)+    <> (if not a then mempty else FB.word8 0x18 <> FB.word8 1)+{-# INLINE buildSmallDirect #-}+++encodeSmallDirect :: HSmall -> ByteString+encodeSmallDirect m =+  let !sz = sizeSmall m+  in FB.toStrictByteStringExact sz (buildSmallDirect m)+{-# NOINLINE encodeSmallDirect #-}+++buildMediumDirect :: HMedium -> FB.Builder+buildMediumDirect m =+  (if hmTitle m == "" then mempty else FB.word8 0x0a <> putText (hmTitle m))+    <> (if hmCount m == 0 then mempty else FB.word8 0x10 <> putVarint (fromIntegral (hmCount m)))+    <> (if hmScore m == 0 then mempty else FB.word8 0x19 <> FB.doubleLE (hmScore m))+    <> (if BS.null (hmPayload m) then mempty else FB.word8 0x22 <> putVarint (fromIntegral (BS.length (hmPayload m))) <> FB.byteStringCopy (hmPayload m))+    <> (if not (hmEnabled m) then mempty else FB.word8 0x28 <> FB.word8 1)+    <> (if hmTimestamp m == 0 then mempty else FB.word8 0x30 <> putVarint (fromIntegral (hmTimestamp m)))+    <> (if hmDescription m == "" then mempty else FB.word8 0x3a <> putText (hmDescription m))+    <> (if hmRatio m == 0 then mempty else FB.word8 0x45 <> FB.floatLE (hmRatio m))+{-# INLINE buildMediumDirect #-}+++encodeMediumDirect :: HMedium -> ByteString+encodeMediumDirect m =+  let !sz = sizeMedium m+  in FB.toStrictByteStringExact sz (buildMediumDirect m)+{-# NOINLINE encodeMediumDirect #-}+++instance MessageDecode HSmall where+  messageDecoder = Decoder (loop 0 "" False)+    where+      loop :: Int64 -> Text -> Bool -> ByteString -> Int# -> (# (# HSmall, Int# #) | DecodeError #)+      loop !i !n !a !bs !off =+        withTag+          bs+          off+          (\off' -> (# (# HSmall i n a, off' #) | #))+          ( \fn _wt off' -> case I# fn of+              1 -> case runDecoder# getVarint bs off' of+                (# (# v, off'' #) | #) -> loop (fromIntegral v) n a bs off''+                (# | e #) -> (# | e #)+              2 -> case runDecoder# getText bs off' of+                (# (# v, off'' #) | #) -> loop i v a bs off''+                (# | e #) -> (# | e #)+              3 -> case runDecoder# getVarint bs off' of+                (# (# v, off'' #) | #) -> loop i n (v /= 0) bs off''+                (# | e #) -> (# | e #)+              _ -> case runDecoder# (skipField (toEnum (I# _wt))) bs off' of+                (# (# _, off'' #) | #) -> loop i n a bs off''+                (# | e #) -> (# | e #)+          )+          (\e -> (# | e #))+  {-# INLINE messageDecoder #-}+++-- Medium++data HMedium = HMedium+  { hmTitle :: !Text+  , hmCount :: {-# UNPACK #-} !Int32+  , hmScore :: {-# UNPACK #-} !Double+  , hmPayload :: !ByteString+  , hmEnabled :: !Bool+  , hmTimestamp :: {-# UNPACK #-} !Int64+  , hmDescription :: !Text+  , hmRatio :: {-# UNPACK #-} !Float+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++buildSizedMedium :: HMedium -> SB.SizedBuilder+buildSizedMedium m =+  (if hmTitle m == "" then mempty else sbArchString 0x0a (hmTitle m))+    <> (if hmCount m == 0 then mempty else sbArchVarint 0x10 (fromIntegral (hmCount m)))+    <> (if hmScore m == 0 then mempty else sbArchDouble 0x19 (hmScore m))+    <> (if BS.null (hmPayload m) then mempty else sbArchBytes 0x22 (hmPayload m))+    <> (if not (hmEnabled m) then mempty else sbArchBool 0x28 True)+    <> (if hmTimestamp m == 0 then mempty else sbArchVarint 0x30 (fromIntegral (hmTimestamp m)))+    <> (if hmDescription m == "" then mempty else sbArchString 0x3a (hmDescription m))+    <> (if hmRatio m == 0 then mempty else sbArchFloat 0x45 (hmRatio m))+{-# INLINE buildSizedMedium #-}+++instance MessageEncode HMedium where+  buildMessage m = SB.toBuilder (buildSizedMedium m)+  {-# INLINE buildMessage #-}+++instance MessageSize HMedium where+  messageSize m = SB.size (buildSizedMedium m)+  {-# INLINE messageSize #-}+++instance MessageDecode HMedium where+  messageDecoder = Decoder (loop "" 0 0 "" False 0 "" 0)+    where+      loop :: Text -> Int32 -> Double -> ByteString -> Bool -> Int64 -> Text -> Float -> ByteString -> Int# -> (# (# HMedium, Int# #) | DecodeError #)+      loop !t !c !sc !p !e !ts !d !r !bs !off =+        withTag+          bs+          off+          (\off' -> (# (# HMedium t c sc p e ts d r, off' #) | #))+          ( \fn _wt off' -> case I# fn of+              1 -> case runDecoder# decodeFieldString bs off' of+                (# (# v, off'' #) | #) -> loop v c sc p e ts d r bs off''+                (# | err #) -> (# | err #)+              2 -> case runDecoder# getVarint bs off' of+                (# (# v, off'' #) | #) -> loop t (fromIntegral v) sc p e ts d r bs off''+                (# | err #) -> (# | err #)+              3 -> case runDecoder# getDouble bs off' of+                (# (# v, off'' #) | #) -> loop t c v p e ts d r bs off''+                (# | err #) -> (# | err #)+              4 -> case runDecoder# decodeFieldBytes bs off' of+                (# (# v, off'' #) | #) -> loop t c sc v e ts d r bs off''+                (# | err #) -> (# | err #)+              5 -> case runDecoder# getVarint bs off' of+                (# (# v, off'' #) | #) -> loop t c sc p (v /= 0) ts d r bs off''+                (# | err #) -> (# | err #)+              6 -> case runDecoder# getVarint bs off' of+                (# (# v, off'' #) | #) -> loop t c sc p e (fromIntegral v) d r bs off''+                (# | err #) -> (# | err #)+              7 -> case runDecoder# decodeFieldString bs off' of+                (# (# v, off'' #) | #) -> loop t c sc p e ts v r bs off''+                (# | err #) -> (# | err #)+              8 -> case runDecoder# getFloat bs off' of+                (# (# v, off'' #) | #) -> loop t c sc p e ts d v bs off''+                (# | err #) -> (# | err #)+              _ -> case runDecoder# (skipField (toEnum (I# _wt))) bs off' of+                (# (# _, off'' #) | #) -> loop t c sc p e ts d r bs off''+                (# | err #) -> (# | err #)+          )+          (\err -> (# | err #))+  {-# INLINE messageDecoder #-}+++-- WithNested++data HWithNested = HWithNested+  { hwnId :: {-# UNPACK #-} !Int64+  , hwnInner :: !(Maybe HSmall)+  , hwnLabel :: !Text+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++buildSizedNested :: HWithNested -> SB.SizedBuilder+buildSizedNested m =+  (if hwnId m == 0 then mempty else sbArchVarint 0x08 (fromIntegral (hwnId m)))+    <> maybe mempty (sbArchSubmessage 0x12 . buildSizedSmall) (hwnInner m)+    <> (if hwnLabel m == "" then mempty else sbArchString 0x1a (hwnLabel m))+{-# INLINE buildSizedNested #-}+++instance MessageEncode HWithNested where+  buildMessage m = SB.toBuilder (buildSizedNested m)+  {-# INLINE buildMessage #-}+++instance MessageSize HWithNested where+  messageSize m = SB.size (buildSizedNested m)+  {-# INLINE messageSize #-}+++instance MessageDecode HWithNested where+  messageDecoder = Decoder (loop 0 Nothing "")+    where+      loop :: Int64 -> Maybe HSmall -> Text -> ByteString -> Int# -> (# (# HWithNested, Int# #) | DecodeError #)+      loop !i !inner !lbl !bs !off =+        withTag+          bs+          off+          (\off' -> (# (# HWithNested i inner lbl, off' #) | #))+          ( \fn _wt off' -> case I# fn of+              1 -> case runDecoder# getVarint bs off' of+                (# (# v, off'' #) | #) -> loop (fromIntegral v) inner lbl bs off''+                (# | e #) -> (# | e #)+              2 -> case runDecoder# decodeFieldMessage bs off' of+                (# (# v, off'' #) | #) -> loop i (Just v) lbl bs off''+                (# | e #) -> (# | e #)+              3 -> case runDecoder# decodeFieldString bs off' of+                (# (# v, off'' #) | #) -> loop i inner v bs off''+                (# | e #) -> (# | e #)+              _ -> case runDecoder# (skipField (toEnum (I# _wt))) bs off' of+                (# (# _, off'' #) | #) -> loop i inner lbl bs off''+                (# | e #) -> (# | e #)+          )+          (\e -> (# | e #))+  {-# INLINE messageDecoder #-}+++-- WithRepeated++data HWithRepeated = HWithRepeated+  { hwrValues :: !(VU.Vector Int32)+  , hwrTags :: !(V.Vector Text)+  , hwrItems :: !(V.Vector HSmall)+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++buildSizedRepeated :: HWithRepeated -> SB.SizedBuilder+buildSizedRepeated m =+  sbArchPackedVarints 0x0a (hwrValues m)+    <> V.foldl' (\acc s -> acc <> sbArchString 0x12 s) mempty (hwrTags m)+    <> V.foldl' (\acc item -> acc <> sbArchSubmessage 0x1a (buildSizedSmall item)) mempty (hwrItems m)+{-# INLINE buildSizedRepeated #-}+++instance MessageEncode HWithRepeated where+  buildMessage m = SB.toBuilder (buildSizedRepeated m)+  {-# INLINE buildMessage #-}+++instance MessageSize HWithRepeated where+  messageSize m = SB.size (buildSizedRepeated m)+  {-# INLINE messageSize #-}+++instance MessageDecode HWithRepeated where+  messageDecoder = Decoder (loop emptyGrowList emptyGrowList emptyGrowList)+    where+      loop :: GrowList Int32 -> GrowList Text -> GrowList HSmall -> ByteString -> Int# -> (# (# HWithRepeated, Int# #) | DecodeError #)+      loop !vals !tags !items !bs !off =+        withTag+          bs+          off+          (\off' -> (# (# HWithRepeated (growListToVectorU vals) (growListToVector tags) (growListToVector items), off' #) | #))+          ( \fn wt off' -> case I# fn of+              1 -> case I# wt of+                2 -> case runDecoder# getLengthDelimited bs off' of+                  (# (# chunk, off'' #) | #) ->+                    let !vals' = decodePackedInto vals chunk+                    in loop vals' tags items bs off''+                  (# | e #) -> (# | e #)+                _ -> case runDecoder# getVarint bs off' of+                  (# (# v, off'' #) | #) -> loop (snocGrowList vals (fromIntegral v)) tags items bs off''+                  (# | e #) -> (# | e #)+              2 -> case runDecoder# decodeFieldString bs off' of+                (# (# v, off'' #) | #) -> loop vals (snocGrowList tags v) items bs off''+                (# | e #) -> (# | e #)+              3 -> case runDecoder# decodeFieldMessage bs off' of+                (# (# v, off'' #) | #) -> loop vals tags (snocGrowList items v) bs off''+                (# | e #) -> (# | e #)+              _ -> case runDecoder# (skipField (toEnum (I# wt))) bs off' of+                (# (# _, off'' #) | #) -> loop vals tags items bs off''+                (# | e #) -> (# | e #)+          )+          (\e -> (# | e #))+  {-# INLINE messageDecoder #-}+++decodePackedInto :: GrowList Int32 -> ByteString -> GrowList Int32+decodePackedInto !gl bs = go gl 0+  where+    bsLen = BS.length bs+    go !acc !off+      | off >= bsLen = acc+      | otherwise = case runDecoder' getVarint bs off of+          DecodeOK v off' -> go (snocGrowList acc (fromIntegral v)) off'+          DecodeFail _ -> acc+++sizeSmall :: HSmall -> Int+sizeSmall (HSmall i n a) =+  (if i == 0 then 0 else archVarintSize (fromIntegral i))+    + (if n == "" then 0 else archStringSize n)+    + (if not a then 0 else archBoolSize)+{-# INLINE sizeSmall #-}+++sizeMedium :: HMedium -> Int+sizeMedium m =+  (if hmTitle m == "" then 0 else archStringSize (hmTitle m))+    + (if hmCount m == 0 then 0 else archVarintSize (fromIntegral (hmCount m)))+    + (if hmScore m == 0 then 0 else archFixed64Size)+    + (if BS.null (hmPayload m) then 0 else archBytesSize (hmPayload m))+    + (if not (hmEnabled m) then 0 else archBoolSize)+    + (if hmTimestamp m == 0 then 0 else archVarintSize (fromIntegral (hmTimestamp m)))+    + (if hmDescription m == "" then 0 else archStringSize (hmDescription m))+    + (if hmRatio m == 0 then 0 else archFixed32Size)+{-# INLINE sizeMedium #-}+++sizeNested :: HWithNested -> Int+sizeNested m =+  (if hwnId m == 0 then 0 else archVarintSize (fromIntegral (hwnId m)))+    + maybe 0 (archSubmessageSize . sizeSmall) (hwnInner m)+    + (if hwnLabel m == "" then 0 else archStringSize (hwnLabel m))+{-# INLINE sizeNested #-}+++sizeRepeated :: HWithRepeated -> Int+sizeRepeated m =+  ( let vs = hwrValues m+    in if VU.null vs+         then 0+         else+           let !packedSz = VU.foldl' (\acc v -> acc + varintSize (fromIntegral v :: Word64)) 0 vs+           in 1 + varintSize (fromIntegral packedSz) + packedSz+  )+    + V.foldl' (\acc s -> acc + archStringSize s) 0 (hwrTags m)+    + V.foldl' (\acc item -> acc + archSubmessageSize (sizeSmall item)) 0 (hwrItems m)+{-# INLINE sizeRepeated #-}
− bench/compare/gen-wireform/Proto/Bench/Wireform/Messages.hs 
@@ -1,754 +0,0 @@-{-# LANGUAGE StrictData #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedRecordDot #-}--- | Auto-generated protobuf types from package @bench@.------ __THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__------ Any manual changes will be overwritten the next time code--- generation is run.  To modify the types or instances, edit the--- @.proto@ source file and re-run the code generator.-module Proto.Bench.Wireform.Messages where--import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Wireform.Builder as B-import Data.Int (Int32, Int64)-import Data.Text (Text)-import qualified Data.Text as T-import Data.Word (Word8, Word32, Word64)-import qualified Data.IntMap.Strict as IntMap-import qualified Data.Map.Strict as Map-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU-import GHC.Generics (Generic)-import Control.DeepSeq (NFData(..))-import Data.Hashable (Hashable(..))-import Proto-import Proto-import Proto.Internal.GrowList (GrowList, emptyGrowList, snocGrowList, growListToVector)-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson-import qualified Data.Aeson.Key as AesonKey-import qualified Data.Aeson.KeyMap as AesonKM-import Proto.Internal.JSON (jsonObject, (.=:), parseFieldMaybe, bytesFieldToJSON, parseBytesFieldMaybe, bytesMapFieldToJSON, parseBytesMapFieldMaybe, protoBytesToJSON, OneofVariantNullSemantics (..), parseOneofVariants)-import Data.Proxy (Proxy(..))-import Proto.Schema (ProtoMessage(..), SomeFieldDescriptor(..), FieldDescriptor(..), FieldTypeDescriptor(..), ScalarFieldType(..), FieldLabel'(..))-import Proto.Registry (IsMessage)-import Proto.Registry qualified-import qualified Proto.Extension-import Proto.Internal.Wire (Tag(..), WireType(..))-import Proto.Internal.Wire.Encode (putTag, putVarint, putFixed32, putFixed64,-  putFloat, putDouble, putText, putByteString, putLengthDelimited,-  putSVarint32, putSVarint64, putVarintSigned,-  varintSize, tagSize,-  varintSize32, zigZag32, zigZag64)-import Proto.Internal.Encode.Archetype (archVarint, archSVarint32, archSVarint64,-  archFixed32, archFixed64, archFloat, archDouble, archBool,-  archString, archBytes, archSubmessage)---- | Serialized FileDescriptorProto for this .proto file.--- Decode with @Proto.Decode.decodeMessage@.-fileDescriptorProtoBytes :: ByteString-fileDescriptorProtoBytes = "\x0a\x0e\x4d\x65\x73\x73\x61\x67\x65\x73\x2e\x70\x72\x6f\x74\x6f\x12\x05\x62\x65\x6e\x63\x68\x22\x31\x0a\x05\x53\x6d\x61\x6c\x6c\x12\x0a\x0a\x02\x69\x64\x18\x01\x20\x00\x28\x02\x12\x0c\x0a\x04\x6e\x61\x6d\x65\x18\x02\x20\x00\x28\x08\x12\x0e\x0a\x06\x61\x63\x74\x69\x76\x65\x18\x03\x20\x00\x28\x07\x22\x8e\x01\x0a\x06\x4d\x65\x64\x69\x75\x6d\x12\x0d\x0a\x05\x74\x69\x74\x6c\x65\x18\x01\x20\x00\x28\x08\x12\x0d\x0a\x05\x63\x6f\x75\x6e\x74\x18\x02\x20\x00\x28\x04\x12\x0d\x0a\x05\x73\x63\x6f\x72\x65\x18\x03\x20\x00\x28\x00\x12\x0f\x0a\x07\x70\x61\x79\x6c\x6f\x61\x64\x18\x04\x20\x00\x28\x0b\x12\x0f\x0a\x07\x65\x6e\x61\x62\x6c\x65\x64\x18\x05\x20\x00\x28\x07\x12\x11\x0a\x09\x74\x69\x6d\x65\x73\x74\x61\x6d\x70\x18\x06\x20\x00\x28\x02\x12\x13\x0a\x0b\x64\x65\x73\x63\x72\x69\x70\x74\x69\x6f\x6e\x18\x07\x20\x00\x28\x08\x12\x0d\x0a\x05\x72\x61\x74\x69\x6f\x18\x08\x20\x00\x28\x01\x22\x3d\x0a\x0a\x57\x69\x74\x68\x4e\x65\x73\x74\x65\x64\x12\x0a\x0a\x02\x69\x64\x18\x01\x20\x00\x28\x02\x12\x14\x0a\x05\x69\x6e\x6e\x65\x72\x18\x02\x20\x00\x28\x0a\x32\x05\x53\x6d\x61\x6c\x6c\x12\x0d\x0a\x05\x6c\x61\x62\x65\x6c\x18\x03\x20\x00\x28\x08\x22\x42\x0a\x0c\x57\x69\x74\x68\x52\x65\x70\x65\x61\x74\x65\x64\x12\x0e\x0a\x06\x76\x61\x6c\x75\x65\x73\x18\x01\x20\x01\x28\x04\x12\x0c\x0a\x04\x74\x61\x67\x73\x18\x02\x20\x01\x28\x08\x12\x14\x0a\x05\x69\x74\x65\x6d\x73\x18\x03\x20\x01\x28\x0a\x32\x05\x53\x6d\x61\x6c\x6c\x62\x06\x70\x72\x6f\x74\x6f\x33"---data Small = Small-  { smallId :: {-# UNPACK #-} !Int64-  , smallName :: !Text-  , smallActive :: {-# UNPACK #-} !Bool-  , smallUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultSmall :: Small-defaultSmall = Small-  { smallId = 0-  , smallName = ""-  , smallActive = False-  , smallUnknownFields = []-  }--instance MessageEncode Small where-  buildSized msg =-    (if msg.smallId == 0 then mempty else archVarint 8 (fromIntegral msg.smallId))-    <> (if msg.smallName == T.empty then mempty else archString 18 msg.smallName)-    <> (if msg.smallActive == False then mempty else archBool 24 msg.smallActive)-    <> encodeUnknownFieldsSized msg.smallUnknownFields--instance MessageDecode Small where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultSmall-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_1 (msg { smallId = v}))-          (pure (case msg.smallUnknownFields of { [] -> msg; _ -> msg { smallUnknownFields = reverse (msg.smallUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_2 (msg { smallName = v}))-          (pure (case msg.smallUnknownFields of { [] -> msg; _ -> msg { smallUnknownFields = reverse (msg.smallUnknownFields) } }))-          (loop msg)-      stage_2 msg =-        inOrderStage1-          (0x18 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> loop (msg { smallActive = v}))-          (pure (case msg.smallUnknownFields of { [] -> msg; _ -> msg { smallUnknownFields = reverse (msg.smallUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.smallUnknownFields of { [] -> msg; _ -> msg { smallUnknownFields = reverse (msg.smallUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { smallId = v})-          2 -> do-            v <- decodeFieldString-            loop (msg { smallName = v})-          3 -> do-            v <- decodeFieldBool-            loop (msg { smallActive = v})-          _ -> do-            uf <- captureUnknownField fn (toEnum wt)-            loop (msg { smallUnknownFields = (uf : msg.smallUnknownFields)}))---- | Field descriptors for 'Small', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-smallFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor Small)-smallFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "id"-        , fdNumber = 1-        , fdTypeDesc = ScalarType Int64Field-        , fdLabel = LabelOptional-        , fdGet = smallId-        , fdSet = \v m -> m { smallId = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "name"-        , fdNumber = 2-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = smallName-        , fdSet = \v m -> m { smallName = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "active"-        , fdNumber = 3-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = smallActive-        , fdSet = \v m -> m { smallActive = v }-        })-    ]--instance ProtoMessage Small where-  protoMessageName _ = "bench.Small"-  protoPackageName _ = "bench"-  protoDefaultValue = defaultSmall-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = smallFieldDescriptors--instance IsMessage Small--instance Aeson.ToJSON Small where-  toJSON msg = jsonObject-      [ "id" .=: msg.smallId-      , "name" .=: msg.smallName-      , "active" .=: msg.smallActive-      ]--instance Aeson.FromJSON Small where-  parseJSON = Aeson.withObject "Small" $ \obj -> do-    fld_smallId <- parseFieldMaybe obj "id"-    fld_smallName <- parseFieldMaybe obj "name"-    fld_smallActive <- parseFieldMaybe obj "active"-    pure defaultSmall-      { smallId = maybe (smallId defaultSmall) id fld_smallId-      , smallName = maybe (smallName defaultSmall) id fld_smallName-      , smallActive = maybe (smallActive defaultSmall) id fld_smallActive-      }--instance Hashable Small where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.smallId) msg.smallName) msg.smallActive--instance Proto.Extension.HasExtensions Small where-  messageUnknownFields = smallUnknownFields-  setMessageUnknownFields !ufs msg = msg { smallUnknownFields = ufs }--instance Semigroup Small where-  a <> b = Small-    { smallId = if b.smallId == 0 then a.smallId else b.smallId-    , smallName = if b.smallName == "" then a.smallName else b.smallName-    , smallActive = if b.smallActive == False then a.smallActive else b.smallActive-    , smallUnknownFields = a.smallUnknownFields <> b.smallUnknownFields-    }--instance Monoid Small where-  mempty = defaultSmall--data Medium = Medium-  { mediumTitle :: !Text-  , mediumCount :: {-# UNPACK #-} !Int32-  , mediumScore :: {-# UNPACK #-} !Double-  , mediumPayload :: !ByteString-  , mediumEnabled :: {-# UNPACK #-} !Bool-  , mediumTimestamp :: {-# UNPACK #-} !Int64-  , mediumDescription :: !Text-  , mediumRatio :: {-# UNPACK #-} !Float-  , mediumUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultMedium :: Medium-defaultMedium = Medium-  { mediumTitle = ""-  , mediumCount = 0-  , mediumScore = 0-  , mediumPayload = ""-  , mediumEnabled = False-  , mediumTimestamp = 0-  , mediumDescription = ""-  , mediumRatio = 0-  , mediumUnknownFields = []-  }--instance MessageEncode Medium where-  buildSized msg =-    (if msg.mediumTitle == T.empty then mempty else archString 10 msg.mediumTitle)-    <> (if msg.mediumCount == 0 then mempty else archVarint 16 (fromIntegral msg.mediumCount))-    <> (if msg.mediumScore == 0 then mempty else archDouble 25 msg.mediumScore)-    <> (if BS.null msg.mediumPayload then mempty else archBytes 34 msg.mediumPayload)-    <> (if msg.mediumEnabled == False then mempty else archBool 40 msg.mediumEnabled)-    <> (if msg.mediumTimestamp == 0 then mempty else archVarint 48 (fromIntegral msg.mediumTimestamp))-    <> (if msg.mediumDescription == T.empty then mempty else archString 58 msg.mediumDescription)-    <> (if msg.mediumRatio == 0 then mempty else archFloat 69 msg.mediumRatio)-    <> encodeUnknownFieldsSized msg.mediumUnknownFields--instance MessageDecode Medium where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultMedium-    where-      stage_0 msg =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_1 (msg { mediumTitle = v}))-          (pure (case msg.mediumUnknownFields of { [] -> msg; _ -> msg { mediumUnknownFields = reverse (msg.mediumUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x10 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_2 (msg { mediumCount = v}))-          (pure (case msg.mediumUnknownFields of { [] -> msg; _ -> msg { mediumUnknownFields = reverse (msg.mediumUnknownFields) } }))-          (loop msg)-      stage_2 msg =-        inOrderStage1-          (0x19 :: Data.Word.Word8)-          decodeFieldDouble-          (\v -> stage_3 (msg { mediumScore = v}))-          (pure (case msg.mediumUnknownFields of { [] -> msg; _ -> msg { mediumUnknownFields = reverse (msg.mediumUnknownFields) } }))-          (loop msg)-      stage_3 msg =-        inOrderStage1-          (0x22 :: Data.Word.Word8)-          decodeFieldBytes-          (\v -> stage_4 (msg { mediumPayload = v}))-          (pure (case msg.mediumUnknownFields of { [] -> msg; _ -> msg { mediumUnknownFields = reverse (msg.mediumUnknownFields) } }))-          (loop msg)-      stage_4 msg =-        inOrderStage1-          (0x28 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_5 (msg { mediumEnabled = v}))-          (pure (case msg.mediumUnknownFields of { [] -> msg; _ -> msg { mediumUnknownFields = reverse (msg.mediumUnknownFields) } }))-          (loop msg)-      stage_5 msg =-        inOrderStage1-          (0x30 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_6 (msg { mediumTimestamp = v}))-          (pure (case msg.mediumUnknownFields of { [] -> msg; _ -> msg { mediumUnknownFields = reverse (msg.mediumUnknownFields) } }))-          (loop msg)-      stage_6 msg =-        inOrderStage1-          (0x3a :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_7 (msg { mediumDescription = v}))-          (pure (case msg.mediumUnknownFields of { [] -> msg; _ -> msg { mediumUnknownFields = reverse (msg.mediumUnknownFields) } }))-          (loop msg)-      stage_7 msg =-        inOrderStage1-          (0x45 :: Data.Word.Word8)-          decodeFieldFloat-          (\v -> loop (msg { mediumRatio = v}))-          (pure (case msg.mediumUnknownFields of { [] -> msg; _ -> msg { mediumUnknownFields = reverse (msg.mediumUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.mediumUnknownFields of { [] -> msg; _ -> msg { mediumUnknownFields = reverse (msg.mediumUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { mediumTitle = v})-          2 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { mediumCount = v})-          3 -> do-            v <- decodeFieldDouble-            loop (msg { mediumScore = v})-          4 -> do-            v <- decodeFieldBytes-            loop (msg { mediumPayload = v})-          5 -> do-            v <- decodeFieldBool-            loop (msg { mediumEnabled = v})-          6 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { mediumTimestamp = v})-          7 -> do-            v <- decodeFieldString-            loop (msg { mediumDescription = v})-          8 -> do-            v <- decodeFieldFloat-            loop (msg { mediumRatio = v})-          _ -> do-            uf <- captureUnknownField fn (toEnum wt)-            loop (msg { mediumUnknownFields = (uf : msg.mediumUnknownFields)}))---- | Field descriptors for 'Medium', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-mediumFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor Medium)-mediumFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "title"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = mediumTitle-        , fdSet = \v m -> m { mediumTitle = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "count"-        , fdNumber = 2-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = mediumCount-        , fdSet = \v m -> m { mediumCount = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "score"-        , fdNumber = 3-        , fdTypeDesc = ScalarType DoubleField-        , fdLabel = LabelOptional-        , fdGet = mediumScore-        , fdSet = \v m -> m { mediumScore = v }-        })-    , (4, SomeField FieldDescriptor-        { fdName = "payload"-        , fdNumber = 4-        , fdTypeDesc = ScalarType BytesField-        , fdLabel = LabelOptional-        , fdGet = mediumPayload-        , fdSet = \v m -> m { mediumPayload = v }-        })-    , (5, SomeField FieldDescriptor-        { fdName = "enabled"-        , fdNumber = 5-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = mediumEnabled-        , fdSet = \v m -> m { mediumEnabled = v }-        })-    , (6, SomeField FieldDescriptor-        { fdName = "timestamp"-        , fdNumber = 6-        , fdTypeDesc = ScalarType Int64Field-        , fdLabel = LabelOptional-        , fdGet = mediumTimestamp-        , fdSet = \v m -> m { mediumTimestamp = v }-        })-    , (7, SomeField FieldDescriptor-        { fdName = "description"-        , fdNumber = 7-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = mediumDescription-        , fdSet = \v m -> m { mediumDescription = v }-        })-    , (8, SomeField FieldDescriptor-        { fdName = "ratio"-        , fdNumber = 8-        , fdTypeDesc = ScalarType FloatField-        , fdLabel = LabelOptional-        , fdGet = mediumRatio-        , fdSet = \v m -> m { mediumRatio = v }-        })-    ]--instance ProtoMessage Medium where-  protoMessageName _ = "bench.Medium"-  protoPackageName _ = "bench"-  protoDefaultValue = defaultMedium-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = mediumFieldDescriptors--instance IsMessage Medium--instance Aeson.ToJSON Medium where-  toJSON msg = jsonObject-      [ "title" .=: msg.mediumTitle-      , "count" .=: msg.mediumCount-      , "score" .=: msg.mediumScore-      , bytesFieldToJSON "payload" msg.mediumPayload-      , "enabled" .=: msg.mediumEnabled-      , "timestamp" .=: msg.mediumTimestamp-      , "description" .=: msg.mediumDescription-      , "ratio" .=: msg.mediumRatio-      ]--instance Aeson.FromJSON Medium where-  parseJSON = Aeson.withObject "Medium" $ \obj -> do-    fld_mediumTitle <- parseFieldMaybe obj "title"-    fld_mediumCount <- parseFieldMaybe obj "count"-    fld_mediumScore <- parseFieldMaybe obj "score"-    fld_mediumPayload <- parseBytesFieldMaybe obj "payload"-    fld_mediumEnabled <- parseFieldMaybe obj "enabled"-    fld_mediumTimestamp <- parseFieldMaybe obj "timestamp"-    fld_mediumDescription <- parseFieldMaybe obj "description"-    fld_mediumRatio <- parseFieldMaybe obj "ratio"-    pure defaultMedium-      { mediumTitle = maybe (mediumTitle defaultMedium) id fld_mediumTitle-      , mediumCount = maybe (mediumCount defaultMedium) id fld_mediumCount-      , mediumScore = maybe (mediumScore defaultMedium) id fld_mediumScore-      , mediumPayload = maybe (mediumPayload defaultMedium) id fld_mediumPayload-      , mediumEnabled = maybe (mediumEnabled defaultMedium) id fld_mediumEnabled-      , mediumTimestamp = maybe (mediumTimestamp defaultMedium) id fld_mediumTimestamp-      , mediumDescription = maybe (mediumDescription defaultMedium) id fld_mediumDescription-      , mediumRatio = maybe (mediumRatio defaultMedium) id fld_mediumRatio-      }--instance Hashable Medium where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.mediumTitle) msg.mediumCount) msg.mediumScore) msg.mediumPayload) msg.mediumEnabled) msg.mediumTimestamp) msg.mediumDescription) msg.mediumRatio--instance Proto.Extension.HasExtensions Medium where-  messageUnknownFields = mediumUnknownFields-  setMessageUnknownFields !ufs msg = msg { mediumUnknownFields = ufs }--instance Semigroup Medium where-  a <> b = Medium-    { mediumTitle = if b.mediumTitle == "" then a.mediumTitle else b.mediumTitle-    , mediumCount = if b.mediumCount == 0 then a.mediumCount else b.mediumCount-    , mediumScore = if b.mediumScore == 0 then a.mediumScore else b.mediumScore-    , mediumPayload = if b.mediumPayload == "" then a.mediumPayload else b.mediumPayload-    , mediumEnabled = if b.mediumEnabled == False then a.mediumEnabled else b.mediumEnabled-    , mediumTimestamp = if b.mediumTimestamp == 0 then a.mediumTimestamp else b.mediumTimestamp-    , mediumDescription = if b.mediumDescription == "" then a.mediumDescription else b.mediumDescription-    , mediumRatio = if b.mediumRatio == 0 then a.mediumRatio else b.mediumRatio-    , mediumUnknownFields = a.mediumUnknownFields <> b.mediumUnknownFields-    }--instance Monoid Medium where-  mempty = defaultMedium--data WithNested = WithNested-  { withNestedId :: {-# UNPACK #-} !Int64-  , withNestedInner :: !(Maybe Small)-  , withNestedLabel :: !Text-  , withNestedUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultWithNested :: WithNested-defaultWithNested = WithNested-  { withNestedId = 0-  , withNestedInner = Nothing-  , withNestedLabel = ""-  , withNestedUnknownFields = []-  }--instance MessageEncode WithNested where-  buildSized msg =-    (if msg.withNestedId == 0 then mempty else archVarint 8 (fromIntegral msg.withNestedId))-    <> (maybe mempty (\v -> archSubmessage 18 (buildSized v)) msg.withNestedInner)-    <> (if msg.withNestedLabel == T.empty then mempty else archString 26 msg.withNestedLabel)-    <> encodeUnknownFieldsSized msg.withNestedUnknownFields--instance MessageDecode WithNested where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultWithNested-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_1 (msg { withNestedId = v}))-          (pure (case msg.withNestedUnknownFields of { [] -> msg; _ -> msg { withNestedUnknownFields = reverse (msg.withNestedUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_2 (msg { withNestedInner = (Just v)}))-          (pure (case msg.withNestedUnknownFields of { [] -> msg; _ -> msg { withNestedUnknownFields = reverse (msg.withNestedUnknownFields) } }))-          (loop msg)-      stage_2 msg =-        inOrderStage1-          (0x1a :: Data.Word.Word8)-          decodeFieldString-          (\v -> loop (msg { withNestedLabel = v}))-          (pure (case msg.withNestedUnknownFields of { [] -> msg; _ -> msg { withNestedUnknownFields = reverse (msg.withNestedUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.withNestedUnknownFields of { [] -> msg; _ -> msg { withNestedUnknownFields = reverse (msg.withNestedUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { withNestedId = v})-          2 -> do-            v <- decodeFieldMessage-            loop (msg { withNestedInner = (Just v)})-          3 -> do-            v <- decodeFieldString-            loop (msg { withNestedLabel = v})-          _ -> do-            uf <- captureUnknownField fn (toEnum wt)-            loop (msg { withNestedUnknownFields = (uf : msg.withNestedUnknownFields)}))---- | Field descriptors for 'WithNested', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-withNestedFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor WithNested)-withNestedFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "id"-        , fdNumber = 1-        , fdTypeDesc = ScalarType Int64Field-        , fdLabel = LabelOptional-        , fdGet = withNestedId-        , fdSet = \v m -> m { withNestedId = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "inner"-        , fdNumber = 2-        , fdTypeDesc = MessageType "Small"-        , fdLabel = LabelOptional-        , fdGet = withNestedInner-        , fdSet = \v m -> m { withNestedInner = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "label"-        , fdNumber = 3-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = withNestedLabel-        , fdSet = \v m -> m { withNestedLabel = v }-        })-    ]--instance ProtoMessage WithNested where-  protoMessageName _ = "bench.WithNested"-  protoPackageName _ = "bench"-  protoDefaultValue = defaultWithNested-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = withNestedFieldDescriptors--instance IsMessage WithNested--instance Aeson.ToJSON WithNested where-  toJSON msg = jsonObject-      [ "id" .=: msg.withNestedId-      , "inner" .=: msg.withNestedInner-      , "label" .=: msg.withNestedLabel-      ]--instance Aeson.FromJSON WithNested where-  parseJSON = Aeson.withObject "WithNested" $ \obj -> do-    fld_withNestedId <- parseFieldMaybe obj "id"-    fld_withNestedInner <- parseFieldMaybe obj "inner"-    fld_withNestedLabel <- parseFieldMaybe obj "label"-    pure defaultWithNested-      { withNestedId = maybe (withNestedId defaultWithNested) id fld_withNestedId-      , withNestedInner = maybe (withNestedInner defaultWithNested) id fld_withNestedInner-      , withNestedLabel = maybe (withNestedLabel defaultWithNested) id fld_withNestedLabel-      }--instance Hashable WithNested where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.withNestedId) msg.withNestedInner) msg.withNestedLabel--instance Proto.Extension.HasExtensions WithNested where-  messageUnknownFields = withNestedUnknownFields-  setMessageUnknownFields !ufs msg = msg { withNestedUnknownFields = ufs }--instance Semigroup WithNested where-  a <> b = WithNested-    { withNestedId = if b.withNestedId == 0 then a.withNestedId else b.withNestedId-    , withNestedInner = case b.withNestedInner of { Nothing -> a.withNestedInner; x -> x }-    , withNestedLabel = if b.withNestedLabel == "" then a.withNestedLabel else b.withNestedLabel-    , withNestedUnknownFields = a.withNestedUnknownFields <> b.withNestedUnknownFields-    }--instance Monoid WithNested where-  mempty = defaultWithNested--data WithRepeated = WithRepeated-  { withRepeatedValues :: !(VU.Vector Int32)-  , withRepeatedTags :: !(V.Vector Text)-  , withRepeatedItems :: !(V.Vector Small)-  , withRepeatedUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultWithRepeated :: WithRepeated-defaultWithRepeated = WithRepeated-  { withRepeatedValues = VU.empty-  , withRepeatedTags = V.empty-  , withRepeatedItems = V.empty-  , withRepeatedUnknownFields = []-  }--instance MessageEncode WithRepeated where-  buildSized msg =-    encodePackedInt32 1 msg.withRepeatedValues-    <> V.foldl' (\acc v -> acc <> archString 18 v) mempty msg.withRepeatedTags-    <> V.foldl' (\acc v -> acc <> archSubmessage 26 (buildSized v)) mempty msg.withRepeatedItems-    <> encodeUnknownFieldsSized msg.withRepeatedUnknownFields--instance MessageDecode WithRepeated where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultWithRepeated emptyGrowList emptyGrowList-    where-      stage_0 msg gl_0 gl_1 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          (VU.map fromIntegral <$> decodePackedVarint)-          (\v -> stage_1 (msg { withRepeatedValues = v}) gl_0 gl_1)-          (pure (case msg.withRepeatedUnknownFields of { [] -> msg { withRepeatedTags = growListToVector gl_0, withRepeatedItems = growListToVector gl_1 }; _ -> msg { withRepeatedTags = growListToVector gl_0, withRepeatedItems = growListToVector gl_1, withRepeatedUnknownFields = reverse (msg.withRepeatedUnknownFields) } }))-          (loop msg gl_0 gl_1)-      stage_1 msg gl_0 gl_1 =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_1 msg (snocGrowList gl_0 v) gl_1)-          (pure (case msg.withRepeatedUnknownFields of { [] -> msg { withRepeatedTags = growListToVector gl_0, withRepeatedItems = growListToVector gl_1 }; _ -> msg { withRepeatedTags = growListToVector gl_0, withRepeatedItems = growListToVector gl_1, withRepeatedUnknownFields = reverse (msg.withRepeatedUnknownFields) } }))-          (loop msg gl_0 gl_1)-      stage_2 msg gl_0 gl_1 =-        inOrderStage1-          (0x1a :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_2 msg gl_0 (snocGrowList gl_1 v))-          (pure (case msg.withRepeatedUnknownFields of { [] -> msg { withRepeatedTags = growListToVector gl_0, withRepeatedItems = growListToVector gl_1 }; _ -> msg { withRepeatedTags = growListToVector gl_0, withRepeatedItems = growListToVector gl_1, withRepeatedUnknownFields = reverse (msg.withRepeatedUnknownFields) } }))-          (loop msg gl_0 gl_1)-      loop msg gl_0 gl_1 = withTagM-        (pure (case msg.withRepeatedUnknownFields of { [] -> msg { withRepeatedTags = growListToVector gl_0, withRepeatedItems = growListToVector gl_1 }; _ -> msg { withRepeatedTags = growListToVector gl_0, withRepeatedItems = growListToVector gl_1, withRepeatedUnknownFields = reverse (msg.withRepeatedUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> case wt of-            2 -> do-              vs <- (VU.map fromIntegral <$> decodePackedVarint)-              loop (msg { withRepeatedValues = (msg.withRepeatedValues <> vs)}) gl_0 gl_1-            _ -> do-              v <- (fromIntegral <$> decodeFieldVarint)-              loop (msg { withRepeatedValues = (VU.snoc msg.withRepeatedValues v)}) gl_0 gl_1-          2 -> do-            v <- decodeFieldString-            loop msg (snocGrowList gl_0 v) gl_1-          3 -> do-            v <- decodeFieldMessage-            loop msg gl_0 (snocGrowList gl_1 v)-          _ -> do-            uf <- captureUnknownField fn (toEnum wt)-            loop (msg { withRepeatedUnknownFields = (uf : msg.withRepeatedUnknownFields)}) gl_0 gl_1)---- | Field descriptors for 'WithRepeated', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-withRepeatedFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor WithRepeated)-withRepeatedFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "values"-        , fdNumber = 1-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelRepeated-        , fdGet = withRepeatedValues-        , fdSet = \v m -> m { withRepeatedValues = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "tags"-        , fdNumber = 2-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelRepeated-        , fdGet = withRepeatedTags-        , fdSet = \v m -> m { withRepeatedTags = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "items"-        , fdNumber = 3-        , fdTypeDesc = MessageType "Small"-        , fdLabel = LabelRepeated-        , fdGet = withRepeatedItems-        , fdSet = \v m -> m { withRepeatedItems = v }-        })-    ]--instance ProtoMessage WithRepeated where-  protoMessageName _ = "bench.WithRepeated"-  protoPackageName _ = "bench"-  protoDefaultValue = defaultWithRepeated-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = withRepeatedFieldDescriptors--instance IsMessage WithRepeated--instance Aeson.ToJSON WithRepeated where-  toJSON msg = jsonObject-      [ "values" .=: msg.withRepeatedValues-      , "tags" .=: msg.withRepeatedTags-      , "items" .=: msg.withRepeatedItems-      ]--instance Aeson.FromJSON WithRepeated where-  parseJSON = Aeson.withObject "WithRepeated" $ \obj -> do-    fld_withRepeatedValues <- parseFieldMaybe obj "values"-    fld_withRepeatedTags <- parseFieldMaybe obj "tags"-    fld_withRepeatedItems <- parseFieldMaybe obj "items"-    pure defaultWithRepeated-      { withRepeatedValues = maybe (withRepeatedValues defaultWithRepeated) id fld_withRepeatedValues-      , withRepeatedTags = maybe (withRepeatedTags defaultWithRepeated) id fld_withRepeatedTags-      , withRepeatedItems = maybe (withRepeatedItems defaultWithRepeated) id fld_withRepeatedItems-      }--instance Hashable WithRepeated where-  hashWithSalt salt msg = V.foldl' hashWithSalt (V.foldl' hashWithSalt (VU.foldl' hashWithSalt (salt) msg.withRepeatedValues) msg.withRepeatedTags) msg.withRepeatedItems--instance Proto.Extension.HasExtensions WithRepeated where-  messageUnknownFields = withRepeatedUnknownFields-  setMessageUnknownFields !ufs msg = msg { withRepeatedUnknownFields = ufs }--instance Semigroup WithRepeated where-  a <> b = WithRepeated-    { withRepeatedValues = a.withRepeatedValues <> b.withRepeatedValues-    , withRepeatedTags = a.withRepeatedTags <> b.withRepeatedTags-    , withRepeatedItems = a.withRepeatedItems <> b.withRepeatedItems-    , withRepeatedUnknownFields = a.withRepeatedUnknownFields <> b.withRepeatedUnknownFields-    }--instance Monoid WithRepeated where-  mempty = defaultWithRepeated
bench/compare/gen/Proto/Bench.hs view
@@ -1,1302 +1,1794 @@ {- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}-{-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies, UndecidableInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternSynonyms, MagicHash, NoImplicitPrelude, DataKinds, BangPatterns, TypeApplications, OverloadedStrings, DerivingStrategies#-}-{-# OPTIONS_GHC -Wno-unused-imports#-}-{-# OPTIONS_GHC -Wno-duplicate-exports#-}-{-# OPTIONS_GHC -Wno-dodgy-exports#-}-module Proto.Bench (-        Medium(), Small(), WithNested(), WithRepeated()-    ) where-import qualified Data.ProtoLens.Runtime.Control.DeepSeq as Control.DeepSeq-import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Prism as Data.ProtoLens.Prism-import qualified Data.ProtoLens.Runtime.Prelude as Prelude-import qualified Data.ProtoLens.Runtime.Data.Int as Data.Int-import qualified Data.ProtoLens.Runtime.Data.Monoid as Data.Monoid-import qualified Data.ProtoLens.Runtime.Data.Word as Data.Word-import qualified Data.ProtoLens.Runtime.Data.ProtoLens as Data.ProtoLens-import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Bytes as Data.ProtoLens.Encoding.Bytes-import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Growing as Data.ProtoLens.Encoding.Growing-import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Parser.Unsafe as Data.ProtoLens.Encoding.Parser.Unsafe-import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Wire as Data.ProtoLens.Encoding.Wire-import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Field as Data.ProtoLens.Field-import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Message.Enum as Data.ProtoLens.Message.Enum-import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Service.Types as Data.ProtoLens.Service.Types-import qualified Data.ProtoLens.Runtime.Lens.Family2 as Lens.Family2-import qualified Data.ProtoLens.Runtime.Lens.Family2.Unchecked as Lens.Family2.Unchecked-import qualified Data.ProtoLens.Runtime.Data.Text as Data.Text-import qualified Data.ProtoLens.Runtime.Data.Map as Data.Map-import qualified Data.ProtoLens.Runtime.Data.ByteString as Data.ByteString-import qualified Data.ProtoLens.Runtime.Data.ByteString.Char8 as Data.ByteString.Char8-import qualified Data.ProtoLens.Runtime.Data.Text.Encoding as Data.Text.Encoding-import qualified Data.ProtoLens.Runtime.Data.Vector as Data.Vector-import qualified Data.ProtoLens.Runtime.Data.Vector.Generic as Data.Vector.Generic-import qualified Data.ProtoLens.Runtime.Data.Vector.Unboxed as Data.Vector.Unboxed-import qualified Data.ProtoLens.Runtime.Text.Read as Text.Read-{- | Fields :-     -         * 'Proto.Bench_Fields.title' @:: Lens' Medium Data.Text.Text@-         * 'Proto.Bench_Fields.count' @:: Lens' Medium Data.Int.Int32@-         * 'Proto.Bench_Fields.score' @:: Lens' Medium Prelude.Double@-         * 'Proto.Bench_Fields.payload' @:: Lens' Medium Data.ByteString.ByteString@-         * 'Proto.Bench_Fields.enabled' @:: Lens' Medium Prelude.Bool@-         * 'Proto.Bench_Fields.timestamp' @:: Lens' Medium Data.Int.Int64@-         * 'Proto.Bench_Fields.description' @:: Lens' Medium Data.Text.Text@-         * 'Proto.Bench_Fields.ratio' @:: Lens' Medium Prelude.Float@ -}-data Medium-  = Medium'_constructor {_Medium'title :: !Data.Text.Text,-                         _Medium'count :: !Data.Int.Int32,-                         _Medium'score :: !Prelude.Double,-                         _Medium'payload :: !Data.ByteString.ByteString,-                         _Medium'enabled :: !Prelude.Bool,-                         _Medium'timestamp :: !Data.Int.Int64,-                         _Medium'description :: !Data.Text.Text,-                         _Medium'ratio :: !Prelude.Float,-                         _Medium'_unknownFields :: !Data.ProtoLens.FieldSet}-  deriving stock (Prelude.Eq, Prelude.Ord)-instance Prelude.Show Medium where-  showsPrec _ __x __s-    = Prelude.showChar-        '{'-        (Prelude.showString-           (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s))-instance Data.ProtoLens.Field.HasField Medium "title" Data.Text.Text where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _Medium'title (\ x__ y__ -> x__ {_Medium'title = y__}))-        Prelude.id-instance Data.ProtoLens.Field.HasField Medium "count" Data.Int.Int32 where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _Medium'count (\ x__ y__ -> x__ {_Medium'count = y__}))-        Prelude.id-instance Data.ProtoLens.Field.HasField Medium "score" Prelude.Double where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _Medium'score (\ x__ y__ -> x__ {_Medium'score = y__}))-        Prelude.id-instance Data.ProtoLens.Field.HasField Medium "payload" Data.ByteString.ByteString where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _Medium'payload (\ x__ y__ -> x__ {_Medium'payload = y__}))-        Prelude.id-instance Data.ProtoLens.Field.HasField Medium "enabled" Prelude.Bool where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _Medium'enabled (\ x__ y__ -> x__ {_Medium'enabled = y__}))-        Prelude.id-instance Data.ProtoLens.Field.HasField Medium "timestamp" Data.Int.Int64 where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _Medium'timestamp (\ x__ y__ -> x__ {_Medium'timestamp = y__}))-        Prelude.id-instance Data.ProtoLens.Field.HasField Medium "description" Data.Text.Text where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _Medium'description (\ x__ y__ -> x__ {_Medium'description = y__}))-        Prelude.id-instance Data.ProtoLens.Field.HasField Medium "ratio" Prelude.Float where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _Medium'ratio (\ x__ y__ -> x__ {_Medium'ratio = y__}))-        Prelude.id-instance Data.ProtoLens.Message Medium where-  messageName _ = Data.Text.pack "bench.Medium"-  packedMessageDescriptor _-    = "\n\-      \\ACKMedium\DC2\DC4\n\-      \\ENQtitle\CAN\SOH \SOH(\tR\ENQtitle\DC2\DC4\n\-      \\ENQcount\CAN\STX \SOH(\ENQR\ENQcount\DC2\DC4\n\-      \\ENQscore\CAN\ETX \SOH(\SOHR\ENQscore\DC2\CAN\n\-      \\apayload\CAN\EOT \SOH(\fR\apayload\DC2\CAN\n\-      \\aenabled\CAN\ENQ \SOH(\bR\aenabled\DC2\FS\n\-      \\ttimestamp\CAN\ACK \SOH(\ETXR\ttimestamp\DC2 \n\-      \\vdescription\CAN\a \SOH(\tR\vdescription\DC2\DC4\n\-      \\ENQratio\CAN\b \SOH(\STXR\ENQratio"-  packedFileDescriptor _ = packedFileDescriptor-  fieldsByTag-    = let-        title__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "title"-              (Data.ProtoLens.ScalarField Data.ProtoLens.StringField ::-                 Data.ProtoLens.FieldTypeDescriptor Data.Text.Text)-              (Data.ProtoLens.PlainField-                 Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"title")) ::-              Data.ProtoLens.FieldDescriptor Medium-        count__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "count"-              (Data.ProtoLens.ScalarField Data.ProtoLens.Int32Field ::-                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32)-              (Data.ProtoLens.PlainField-                 Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"count")) ::-              Data.ProtoLens.FieldDescriptor Medium-        score__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "score"-              (Data.ProtoLens.ScalarField Data.ProtoLens.DoubleField ::-                 Data.ProtoLens.FieldTypeDescriptor Prelude.Double)-              (Data.ProtoLens.PlainField-                 Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"score")) ::-              Data.ProtoLens.FieldDescriptor Medium-        payload__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "payload"-              (Data.ProtoLens.ScalarField Data.ProtoLens.BytesField ::-                 Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString)-              (Data.ProtoLens.PlainField-                 Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"payload")) ::-              Data.ProtoLens.FieldDescriptor Medium-        enabled__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "enabled"-              (Data.ProtoLens.ScalarField Data.ProtoLens.BoolField ::-                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)-              (Data.ProtoLens.PlainField-                 Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"enabled")) ::-              Data.ProtoLens.FieldDescriptor Medium-        timestamp__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "timestamp"-              (Data.ProtoLens.ScalarField Data.ProtoLens.Int64Field ::-                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)-              (Data.ProtoLens.PlainField-                 Data.ProtoLens.Optional-                 (Data.ProtoLens.Field.field @"timestamp")) ::-              Data.ProtoLens.FieldDescriptor Medium-        description__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "description"-              (Data.ProtoLens.ScalarField Data.ProtoLens.StringField ::-                 Data.ProtoLens.FieldTypeDescriptor Data.Text.Text)-              (Data.ProtoLens.PlainField-                 Data.ProtoLens.Optional-                 (Data.ProtoLens.Field.field @"description")) ::-              Data.ProtoLens.FieldDescriptor Medium-        ratio__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "ratio"-              (Data.ProtoLens.ScalarField Data.ProtoLens.FloatField ::-                 Data.ProtoLens.FieldTypeDescriptor Prelude.Float)-              (Data.ProtoLens.PlainField-                 Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"ratio")) ::-              Data.ProtoLens.FieldDescriptor Medium-      in-        Data.Map.fromList-          [(Data.ProtoLens.Tag 1, title__field_descriptor),-           (Data.ProtoLens.Tag 2, count__field_descriptor),-           (Data.ProtoLens.Tag 3, score__field_descriptor),-           (Data.ProtoLens.Tag 4, payload__field_descriptor),-           (Data.ProtoLens.Tag 5, enabled__field_descriptor),-           (Data.ProtoLens.Tag 6, timestamp__field_descriptor),-           (Data.ProtoLens.Tag 7, description__field_descriptor),-           (Data.ProtoLens.Tag 8, ratio__field_descriptor)]-  unknownFields-    = Lens.Family2.Unchecked.lens-        _Medium'_unknownFields-        (\ x__ y__ -> x__ {_Medium'_unknownFields = y__})-  defMessage-    = Medium'_constructor-        {_Medium'title = Data.ProtoLens.fieldDefault,-         _Medium'count = Data.ProtoLens.fieldDefault,-         _Medium'score = Data.ProtoLens.fieldDefault,-         _Medium'payload = Data.ProtoLens.fieldDefault,-         _Medium'enabled = Data.ProtoLens.fieldDefault,-         _Medium'timestamp = Data.ProtoLens.fieldDefault,-         _Medium'description = Data.ProtoLens.fieldDefault,-         _Medium'ratio = Data.ProtoLens.fieldDefault,-         _Medium'_unknownFields = []}-  parseMessage-    = let-        loop :: Medium -> Data.ProtoLens.Encoding.Bytes.Parser Medium-        loop x-          = do end <- Data.ProtoLens.Encoding.Bytes.atEnd-               if end then-                   do (let missing = []-                       in-                         if Prelude.null missing then-                             Prelude.return ()-                         else-                             Prelude.fail-                               ((Prelude.++)-                                  "Missing required fields: "-                                  (Prelude.show (missing :: [Prelude.String]))))-                      Prelude.return-                        (Lens.Family2.over-                           Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x)-               else-                   do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt-                      case tag of-                        10-                          -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                       (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt-                                           Data.ProtoLens.Encoding.Bytes.getText-                                             (Prelude.fromIntegral len))-                                       "title"-                                loop (Lens.Family2.set (Data.ProtoLens.Field.field @"title") y x)-                        16-                          -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                       (Prelude.fmap-                                          Prelude.fromIntegral-                                          Data.ProtoLens.Encoding.Bytes.getVarInt)-                                       "count"-                                loop (Lens.Family2.set (Data.ProtoLens.Field.field @"count") y x)-                        25-                          -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                       (Prelude.fmap-                                          Data.ProtoLens.Encoding.Bytes.wordToDouble-                                          Data.ProtoLens.Encoding.Bytes.getFixed64)-                                       "score"-                                loop (Lens.Family2.set (Data.ProtoLens.Field.field @"score") y x)-                        34-                          -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                       (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt-                                           Data.ProtoLens.Encoding.Bytes.getBytes-                                             (Prelude.fromIntegral len))-                                       "payload"-                                loop (Lens.Family2.set (Data.ProtoLens.Field.field @"payload") y x)-                        40-                          -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                       (Prelude.fmap-                                          ((Prelude./=) 0) Data.ProtoLens.Encoding.Bytes.getVarInt)-                                       "enabled"-                                loop (Lens.Family2.set (Data.ProtoLens.Field.field @"enabled") y x)-                        48-                          -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                       (Prelude.fmap-                                          Prelude.fromIntegral-                                          Data.ProtoLens.Encoding.Bytes.getVarInt)-                                       "timestamp"-                                loop-                                  (Lens.Family2.set (Data.ProtoLens.Field.field @"timestamp") y x)-                        58-                          -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                       (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt-                                           Data.ProtoLens.Encoding.Bytes.getText-                                             (Prelude.fromIntegral len))-                                       "description"-                                loop-                                  (Lens.Family2.set (Data.ProtoLens.Field.field @"description") y x)-                        69-                          -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                       (Prelude.fmap-                                          Data.ProtoLens.Encoding.Bytes.wordToFloat-                                          Data.ProtoLens.Encoding.Bytes.getFixed32)-                                       "ratio"-                                loop (Lens.Family2.set (Data.ProtoLens.Field.field @"ratio") y x)-                        wire-                          -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire-                                        wire-                                loop-                                  (Lens.Family2.over-                                     Data.ProtoLens.unknownFields (\ !t -> (:) y t) x)-      in-        (Data.ProtoLens.Encoding.Bytes.<?>)-          (do loop Data.ProtoLens.defMessage) "Medium"-  buildMessage-    = \ _x-        -> (Data.Monoid.<>)-             (let-                _v = Lens.Family2.view (Data.ProtoLens.Field.field @"title") _x-              in-                if (Prelude.==) _v Data.ProtoLens.fieldDefault then-                    Data.Monoid.mempty-                else-                    (Data.Monoid.<>)-                      (Data.ProtoLens.Encoding.Bytes.putVarInt 10)-                      ((Prelude..)-                         (\ bs-                            -> (Data.Monoid.<>)-                                 (Data.ProtoLens.Encoding.Bytes.putVarInt-                                    (Prelude.fromIntegral (Data.ByteString.length bs)))-                                 (Data.ProtoLens.Encoding.Bytes.putBytes bs))-                         Data.Text.Encoding.encodeUtf8 _v))-             ((Data.Monoid.<>)-                (let-                   _v = Lens.Family2.view (Data.ProtoLens.Field.field @"count") _x-                 in-                   if (Prelude.==) _v Data.ProtoLens.fieldDefault then-                       Data.Monoid.mempty-                   else-                       (Data.Monoid.<>)-                         (Data.ProtoLens.Encoding.Bytes.putVarInt 16)-                         ((Prelude..)-                            Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral _v))-                ((Data.Monoid.<>)-                   (let-                      _v = Lens.Family2.view (Data.ProtoLens.Field.field @"score") _x-                    in-                      if (Prelude.==) _v Data.ProtoLens.fieldDefault then-                          Data.Monoid.mempty-                      else-                          (Data.Monoid.<>)-                            (Data.ProtoLens.Encoding.Bytes.putVarInt 25)-                            ((Prelude..)-                               Data.ProtoLens.Encoding.Bytes.putFixed64-                               Data.ProtoLens.Encoding.Bytes.doubleToWord _v))-                   ((Data.Monoid.<>)-                      (let-                         _v = Lens.Family2.view (Data.ProtoLens.Field.field @"payload") _x-                       in-                         if (Prelude.==) _v Data.ProtoLens.fieldDefault then-                             Data.Monoid.mempty-                         else-                             (Data.Monoid.<>)-                               (Data.ProtoLens.Encoding.Bytes.putVarInt 34)-                               ((\ bs-                                   -> (Data.Monoid.<>)-                                        (Data.ProtoLens.Encoding.Bytes.putVarInt-                                           (Prelude.fromIntegral (Data.ByteString.length bs)))-                                        (Data.ProtoLens.Encoding.Bytes.putBytes bs))-                                  _v))-                      ((Data.Monoid.<>)-                         (let-                            _v = Lens.Family2.view (Data.ProtoLens.Field.field @"enabled") _x-                          in-                            if (Prelude.==) _v Data.ProtoLens.fieldDefault then-                                Data.Monoid.mempty-                            else-                                (Data.Monoid.<>)-                                  (Data.ProtoLens.Encoding.Bytes.putVarInt 40)-                                  ((Prelude..)-                                     Data.ProtoLens.Encoding.Bytes.putVarInt-                                     (\ b -> if b then 1 else 0) _v))-                         ((Data.Monoid.<>)-                            (let-                               _v = Lens.Family2.view (Data.ProtoLens.Field.field @"timestamp") _x-                             in-                               if (Prelude.==) _v Data.ProtoLens.fieldDefault then-                                   Data.Monoid.mempty-                               else-                                   (Data.Monoid.<>)-                                     (Data.ProtoLens.Encoding.Bytes.putVarInt 48)-                                     ((Prelude..)-                                        Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral-                                        _v))-                            ((Data.Monoid.<>)-                               (let-                                  _v-                                    = Lens.Family2.view-                                        (Data.ProtoLens.Field.field @"description") _x-                                in-                                  if (Prelude.==) _v Data.ProtoLens.fieldDefault then-                                      Data.Monoid.mempty-                                  else-                                      (Data.Monoid.<>)-                                        (Data.ProtoLens.Encoding.Bytes.putVarInt 58)-                                        ((Prelude..)-                                           (\ bs-                                              -> (Data.Monoid.<>)-                                                   (Data.ProtoLens.Encoding.Bytes.putVarInt-                                                      (Prelude.fromIntegral-                                                         (Data.ByteString.length bs)))-                                                   (Data.ProtoLens.Encoding.Bytes.putBytes bs))-                                           Data.Text.Encoding.encodeUtf8 _v))-                               ((Data.Monoid.<>)-                                  (let-                                     _v = Lens.Family2.view (Data.ProtoLens.Field.field @"ratio") _x-                                   in-                                     if (Prelude.==) _v Data.ProtoLens.fieldDefault then-                                         Data.Monoid.mempty-                                     else-                                         (Data.Monoid.<>)-                                           (Data.ProtoLens.Encoding.Bytes.putVarInt 69)-                                           ((Prelude..)-                                              Data.ProtoLens.Encoding.Bytes.putFixed32-                                              Data.ProtoLens.Encoding.Bytes.floatToWord _v))-                                  (Data.ProtoLens.Encoding.Wire.buildFieldSet-                                     (Lens.Family2.view Data.ProtoLens.unknownFields _x)))))))))-instance Control.DeepSeq.NFData Medium where-  rnf-    = \ x__-        -> Control.DeepSeq.deepseq-             (_Medium'_unknownFields x__)-             (Control.DeepSeq.deepseq-                (_Medium'title x__)-                (Control.DeepSeq.deepseq-                   (_Medium'count x__)-                   (Control.DeepSeq.deepseq-                      (_Medium'score x__)-                      (Control.DeepSeq.deepseq-                         (_Medium'payload x__)-                         (Control.DeepSeq.deepseq-                            (_Medium'enabled x__)-                            (Control.DeepSeq.deepseq-                               (_Medium'timestamp x__)-                               (Control.DeepSeq.deepseq-                                  (_Medium'description x__)-                                  (Control.DeepSeq.deepseq (_Medium'ratio x__) ()))))))))-{- | Fields :-     -         * 'Proto.Bench_Fields.id' @:: Lens' Small Data.Int.Int64@-         * 'Proto.Bench_Fields.name' @:: Lens' Small Data.Text.Text@-         * 'Proto.Bench_Fields.active' @:: Lens' Small Prelude.Bool@ -}-data Small-  = Small'_constructor {_Small'id :: !Data.Int.Int64,-                        _Small'name :: !Data.Text.Text,-                        _Small'active :: !Prelude.Bool,-                        _Small'_unknownFields :: !Data.ProtoLens.FieldSet}-  deriving stock (Prelude.Eq, Prelude.Ord)-instance Prelude.Show Small where-  showsPrec _ __x __s-    = Prelude.showChar-        '{'-        (Prelude.showString-           (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s))-instance Data.ProtoLens.Field.HasField Small "id" Data.Int.Int64 where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _Small'id (\ x__ y__ -> x__ {_Small'id = y__}))-        Prelude.id-instance Data.ProtoLens.Field.HasField Small "name" Data.Text.Text where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _Small'name (\ x__ y__ -> x__ {_Small'name = y__}))-        Prelude.id-instance Data.ProtoLens.Field.HasField Small "active" Prelude.Bool where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _Small'active (\ x__ y__ -> x__ {_Small'active = y__}))-        Prelude.id-instance Data.ProtoLens.Message Small where-  messageName _ = Data.Text.pack "bench.Small"-  packedMessageDescriptor _-    = "\n\-      \\ENQSmall\DC2\SO\n\-      \\STXid\CAN\SOH \SOH(\ETXR\STXid\DC2\DC2\n\-      \\EOTname\CAN\STX \SOH(\tR\EOTname\DC2\SYN\n\-      \\ACKactive\CAN\ETX \SOH(\bR\ACKactive"-  packedFileDescriptor _ = packedFileDescriptor-  fieldsByTag-    = let-        id__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "id"-              (Data.ProtoLens.ScalarField Data.ProtoLens.Int64Field ::-                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)-              (Data.ProtoLens.PlainField-                 Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"id")) ::-              Data.ProtoLens.FieldDescriptor Small-        name__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "name"-              (Data.ProtoLens.ScalarField Data.ProtoLens.StringField ::-                 Data.ProtoLens.FieldTypeDescriptor Data.Text.Text)-              (Data.ProtoLens.PlainField-                 Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"name")) ::-              Data.ProtoLens.FieldDescriptor Small-        active__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "active"-              (Data.ProtoLens.ScalarField Data.ProtoLens.BoolField ::-                 Data.ProtoLens.FieldTypeDescriptor Prelude.Bool)-              (Data.ProtoLens.PlainField-                 Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"active")) ::-              Data.ProtoLens.FieldDescriptor Small-      in-        Data.Map.fromList-          [(Data.ProtoLens.Tag 1, id__field_descriptor),-           (Data.ProtoLens.Tag 2, name__field_descriptor),-           (Data.ProtoLens.Tag 3, active__field_descriptor)]-  unknownFields-    = Lens.Family2.Unchecked.lens-        _Small'_unknownFields-        (\ x__ y__ -> x__ {_Small'_unknownFields = y__})-  defMessage-    = Small'_constructor-        {_Small'id = Data.ProtoLens.fieldDefault,-         _Small'name = Data.ProtoLens.fieldDefault,-         _Small'active = Data.ProtoLens.fieldDefault,-         _Small'_unknownFields = []}-  parseMessage-    = let-        loop :: Small -> Data.ProtoLens.Encoding.Bytes.Parser Small-        loop x-          = do end <- Data.ProtoLens.Encoding.Bytes.atEnd-               if end then-                   do (let missing = []-                       in-                         if Prelude.null missing then-                             Prelude.return ()-                         else-                             Prelude.fail-                               ((Prelude.++)-                                  "Missing required fields: "-                                  (Prelude.show (missing :: [Prelude.String]))))-                      Prelude.return-                        (Lens.Family2.over-                           Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x)-               else-                   do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt-                      case tag of-                        8 -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                       (Prelude.fmap-                                          Prelude.fromIntegral-                                          Data.ProtoLens.Encoding.Bytes.getVarInt)-                                       "id"-                                loop (Lens.Family2.set (Data.ProtoLens.Field.field @"id") y x)-                        18-                          -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                       (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt-                                           Data.ProtoLens.Encoding.Bytes.getText-                                             (Prelude.fromIntegral len))-                                       "name"-                                loop (Lens.Family2.set (Data.ProtoLens.Field.field @"name") y x)-                        24-                          -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                       (Prelude.fmap-                                          ((Prelude./=) 0) Data.ProtoLens.Encoding.Bytes.getVarInt)-                                       "active"-                                loop (Lens.Family2.set (Data.ProtoLens.Field.field @"active") y x)-                        wire-                          -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire-                                        wire-                                loop-                                  (Lens.Family2.over-                                     Data.ProtoLens.unknownFields (\ !t -> (:) y t) x)-      in-        (Data.ProtoLens.Encoding.Bytes.<?>)-          (do loop Data.ProtoLens.defMessage) "Small"-  buildMessage-    = \ _x-        -> (Data.Monoid.<>)-             (let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"id") _x-              in-                if (Prelude.==) _v Data.ProtoLens.fieldDefault then-                    Data.Monoid.mempty-                else-                    (Data.Monoid.<>)-                      (Data.ProtoLens.Encoding.Bytes.putVarInt 8)-                      ((Prelude..)-                         Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral _v))-             ((Data.Monoid.<>)-                (let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"name") _x-                 in-                   if (Prelude.==) _v Data.ProtoLens.fieldDefault then-                       Data.Monoid.mempty-                   else-                       (Data.Monoid.<>)-                         (Data.ProtoLens.Encoding.Bytes.putVarInt 18)-                         ((Prelude..)-                            (\ bs-                               -> (Data.Monoid.<>)-                                    (Data.ProtoLens.Encoding.Bytes.putVarInt-                                       (Prelude.fromIntegral (Data.ByteString.length bs)))-                                    (Data.ProtoLens.Encoding.Bytes.putBytes bs))-                            Data.Text.Encoding.encodeUtf8 _v))-                ((Data.Monoid.<>)-                   (let-                      _v = Lens.Family2.view (Data.ProtoLens.Field.field @"active") _x-                    in-                      if (Prelude.==) _v Data.ProtoLens.fieldDefault then-                          Data.Monoid.mempty-                      else-                          (Data.Monoid.<>)-                            (Data.ProtoLens.Encoding.Bytes.putVarInt 24)-                            ((Prelude..)-                               Data.ProtoLens.Encoding.Bytes.putVarInt (\ b -> if b then 1 else 0)-                               _v))-                   (Data.ProtoLens.Encoding.Wire.buildFieldSet-                      (Lens.Family2.view Data.ProtoLens.unknownFields _x))))-instance Control.DeepSeq.NFData Small where-  rnf-    = \ x__-        -> Control.DeepSeq.deepseq-             (_Small'_unknownFields x__)-             (Control.DeepSeq.deepseq-                (_Small'id x__)-                (Control.DeepSeq.deepseq-                   (_Small'name x__)-                   (Control.DeepSeq.deepseq (_Small'active x__) ())))-{- | Fields :-     -         * 'Proto.Bench_Fields.id' @:: Lens' WithNested Data.Int.Int64@-         * 'Proto.Bench_Fields.inner' @:: Lens' WithNested Small@-         * 'Proto.Bench_Fields.maybe'inner' @:: Lens' WithNested (Prelude.Maybe Small)@-         * 'Proto.Bench_Fields.label' @:: Lens' WithNested Data.Text.Text@ -}-data WithNested-  = WithNested'_constructor {_WithNested'id :: !Data.Int.Int64,-                             _WithNested'inner :: !(Prelude.Maybe Small),-                             _WithNested'label :: !Data.Text.Text,-                             _WithNested'_unknownFields :: !Data.ProtoLens.FieldSet}-  deriving stock (Prelude.Eq, Prelude.Ord)-instance Prelude.Show WithNested where-  showsPrec _ __x __s-    = Prelude.showChar-        '{'-        (Prelude.showString-           (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s))-instance Data.ProtoLens.Field.HasField WithNested "id" Data.Int.Int64 where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _WithNested'id (\ x__ y__ -> x__ {_WithNested'id = y__}))-        Prelude.id-instance Data.ProtoLens.Field.HasField WithNested "inner" Small where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _WithNested'inner (\ x__ y__ -> x__ {_WithNested'inner = y__}))-        (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage)-instance Data.ProtoLens.Field.HasField WithNested "maybe'inner" (Prelude.Maybe Small) where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _WithNested'inner (\ x__ y__ -> x__ {_WithNested'inner = y__}))-        Prelude.id-instance Data.ProtoLens.Field.HasField WithNested "label" Data.Text.Text where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _WithNested'label (\ x__ y__ -> x__ {_WithNested'label = y__}))-        Prelude.id-instance Data.ProtoLens.Message WithNested where-  messageName _ = Data.Text.pack "bench.WithNested"-  packedMessageDescriptor _-    = "\n\-      \\n\-      \WithNested\DC2\SO\n\-      \\STXid\CAN\SOH \SOH(\ETXR\STXid\DC2\"\n\-      \\ENQinner\CAN\STX \SOH(\v2\f.bench.SmallR\ENQinner\DC2\DC4\n\-      \\ENQlabel\CAN\ETX \SOH(\tR\ENQlabel"-  packedFileDescriptor _ = packedFileDescriptor-  fieldsByTag-    = let-        id__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "id"-              (Data.ProtoLens.ScalarField Data.ProtoLens.Int64Field ::-                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64)-              (Data.ProtoLens.PlainField-                 Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"id")) ::-              Data.ProtoLens.FieldDescriptor WithNested-        inner__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "inner"-              (Data.ProtoLens.MessageField Data.ProtoLens.MessageType ::-                 Data.ProtoLens.FieldTypeDescriptor Small)-              (Data.ProtoLens.OptionalField-                 (Data.ProtoLens.Field.field @"maybe'inner")) ::-              Data.ProtoLens.FieldDescriptor WithNested-        label__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "label"-              (Data.ProtoLens.ScalarField Data.ProtoLens.StringField ::-                 Data.ProtoLens.FieldTypeDescriptor Data.Text.Text)-              (Data.ProtoLens.PlainField-                 Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"label")) ::-              Data.ProtoLens.FieldDescriptor WithNested-      in-        Data.Map.fromList-          [(Data.ProtoLens.Tag 1, id__field_descriptor),-           (Data.ProtoLens.Tag 2, inner__field_descriptor),-           (Data.ProtoLens.Tag 3, label__field_descriptor)]-  unknownFields-    = Lens.Family2.Unchecked.lens-        _WithNested'_unknownFields-        (\ x__ y__ -> x__ {_WithNested'_unknownFields = y__})-  defMessage-    = WithNested'_constructor-        {_WithNested'id = Data.ProtoLens.fieldDefault,-         _WithNested'inner = Prelude.Nothing,-         _WithNested'label = Data.ProtoLens.fieldDefault,-         _WithNested'_unknownFields = []}-  parseMessage-    = let-        loop ::-          WithNested -> Data.ProtoLens.Encoding.Bytes.Parser WithNested-        loop x-          = do end <- Data.ProtoLens.Encoding.Bytes.atEnd-               if end then-                   do (let missing = []-                       in-                         if Prelude.null missing then-                             Prelude.return ()-                         else-                             Prelude.fail-                               ((Prelude.++)-                                  "Missing required fields: "-                                  (Prelude.show (missing :: [Prelude.String]))))-                      Prelude.return-                        (Lens.Family2.over-                           Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x)-               else-                   do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt-                      case tag of-                        8 -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                       (Prelude.fmap-                                          Prelude.fromIntegral-                                          Data.ProtoLens.Encoding.Bytes.getVarInt)-                                       "id"-                                loop (Lens.Family2.set (Data.ProtoLens.Field.field @"id") y x)-                        18-                          -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                       (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt-                                           Data.ProtoLens.Encoding.Bytes.isolate-                                             (Prelude.fromIntegral len) Data.ProtoLens.parseMessage)-                                       "inner"-                                loop (Lens.Family2.set (Data.ProtoLens.Field.field @"inner") y x)-                        26-                          -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                       (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt-                                           Data.ProtoLens.Encoding.Bytes.getText-                                             (Prelude.fromIntegral len))-                                       "label"-                                loop (Lens.Family2.set (Data.ProtoLens.Field.field @"label") y x)-                        wire-                          -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire-                                        wire-                                loop-                                  (Lens.Family2.over-                                     Data.ProtoLens.unknownFields (\ !t -> (:) y t) x)-      in-        (Data.ProtoLens.Encoding.Bytes.<?>)-          (do loop Data.ProtoLens.defMessage) "WithNested"-  buildMessage-    = \ _x-        -> (Data.Monoid.<>)-             (let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"id") _x-              in-                if (Prelude.==) _v Data.ProtoLens.fieldDefault then-                    Data.Monoid.mempty-                else-                    (Data.Monoid.<>)-                      (Data.ProtoLens.Encoding.Bytes.putVarInt 8)-                      ((Prelude..)-                         Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral _v))-             ((Data.Monoid.<>)-                (case-                     Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'inner") _x-                 of-                   Prelude.Nothing -> Data.Monoid.mempty-                   (Prelude.Just _v)-                     -> (Data.Monoid.<>)-                          (Data.ProtoLens.Encoding.Bytes.putVarInt 18)-                          ((Prelude..)-                             (\ bs-                                -> (Data.Monoid.<>)-                                     (Data.ProtoLens.Encoding.Bytes.putVarInt-                                        (Prelude.fromIntegral (Data.ByteString.length bs)))-                                     (Data.ProtoLens.Encoding.Bytes.putBytes bs))-                             Data.ProtoLens.encodeMessage _v))-                ((Data.Monoid.<>)-                   (let-                      _v = Lens.Family2.view (Data.ProtoLens.Field.field @"label") _x-                    in-                      if (Prelude.==) _v Data.ProtoLens.fieldDefault then-                          Data.Monoid.mempty-                      else-                          (Data.Monoid.<>)-                            (Data.ProtoLens.Encoding.Bytes.putVarInt 26)-                            ((Prelude..)-                               (\ bs-                                  -> (Data.Monoid.<>)-                                       (Data.ProtoLens.Encoding.Bytes.putVarInt-                                          (Prelude.fromIntegral (Data.ByteString.length bs)))-                                       (Data.ProtoLens.Encoding.Bytes.putBytes bs))-                               Data.Text.Encoding.encodeUtf8 _v))-                   (Data.ProtoLens.Encoding.Wire.buildFieldSet-                      (Lens.Family2.view Data.ProtoLens.unknownFields _x))))-instance Control.DeepSeq.NFData WithNested where-  rnf-    = \ x__-        -> Control.DeepSeq.deepseq-             (_WithNested'_unknownFields x__)-             (Control.DeepSeq.deepseq-                (_WithNested'id x__)-                (Control.DeepSeq.deepseq-                   (_WithNested'inner x__)-                   (Control.DeepSeq.deepseq (_WithNested'label x__) ())))-{- | Fields :-     -         * 'Proto.Bench_Fields.values' @:: Lens' WithRepeated [Data.Int.Int32]@-         * 'Proto.Bench_Fields.vec'values' @:: Lens' WithRepeated (Data.Vector.Unboxed.Vector Data.Int.Int32)@-         * 'Proto.Bench_Fields.tags' @:: Lens' WithRepeated [Data.Text.Text]@-         * 'Proto.Bench_Fields.vec'tags' @:: Lens' WithRepeated (Data.Vector.Vector Data.Text.Text)@-         * 'Proto.Bench_Fields.items' @:: Lens' WithRepeated [Small]@-         * 'Proto.Bench_Fields.vec'items' @:: Lens' WithRepeated (Data.Vector.Vector Small)@ -}-data WithRepeated-  = WithRepeated'_constructor {_WithRepeated'values :: !(Data.Vector.Unboxed.Vector Data.Int.Int32),-                               _WithRepeated'tags :: !(Data.Vector.Vector Data.Text.Text),-                               _WithRepeated'items :: !(Data.Vector.Vector Small),-                               _WithRepeated'_unknownFields :: !Data.ProtoLens.FieldSet}-  deriving stock (Prelude.Eq, Prelude.Ord)-instance Prelude.Show WithRepeated where-  showsPrec _ __x __s-    = Prelude.showChar-        '{'-        (Prelude.showString-           (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s))-instance Data.ProtoLens.Field.HasField WithRepeated "values" [Data.Int.Int32] where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _WithRepeated'values-           (\ x__ y__ -> x__ {_WithRepeated'values = y__}))-        (Lens.Family2.Unchecked.lens-           Data.Vector.Generic.toList-           (\ _ y__ -> Data.Vector.Generic.fromList y__))-instance Data.ProtoLens.Field.HasField WithRepeated "vec'values" (Data.Vector.Unboxed.Vector Data.Int.Int32) where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _WithRepeated'values-           (\ x__ y__ -> x__ {_WithRepeated'values = y__}))-        Prelude.id-instance Data.ProtoLens.Field.HasField WithRepeated "tags" [Data.Text.Text] where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _WithRepeated'tags (\ x__ y__ -> x__ {_WithRepeated'tags = y__}))-        (Lens.Family2.Unchecked.lens-           Data.Vector.Generic.toList-           (\ _ y__ -> Data.Vector.Generic.fromList y__))-instance Data.ProtoLens.Field.HasField WithRepeated "vec'tags" (Data.Vector.Vector Data.Text.Text) where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _WithRepeated'tags (\ x__ y__ -> x__ {_WithRepeated'tags = y__}))-        Prelude.id-instance Data.ProtoLens.Field.HasField WithRepeated "items" [Small] where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _WithRepeated'items (\ x__ y__ -> x__ {_WithRepeated'items = y__}))-        (Lens.Family2.Unchecked.lens-           Data.Vector.Generic.toList-           (\ _ y__ -> Data.Vector.Generic.fromList y__))-instance Data.ProtoLens.Field.HasField WithRepeated "vec'items" (Data.Vector.Vector Small) where-  fieldOf _-    = (Prelude..)-        (Lens.Family2.Unchecked.lens-           _WithRepeated'items (\ x__ y__ -> x__ {_WithRepeated'items = y__}))-        Prelude.id-instance Data.ProtoLens.Message WithRepeated where-  messageName _ = Data.Text.pack "bench.WithRepeated"-  packedMessageDescriptor _-    = "\n\-      \\fWithRepeated\DC2\SYN\n\-      \\ACKvalues\CAN\SOH \ETX(\ENQR\ACKvalues\DC2\DC2\n\-      \\EOTtags\CAN\STX \ETX(\tR\EOTtags\DC2\"\n\-      \\ENQitems\CAN\ETX \ETX(\v2\f.bench.SmallR\ENQitems"-  packedFileDescriptor _ = packedFileDescriptor-  fieldsByTag-    = let-        values__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "values"-              (Data.ProtoLens.ScalarField Data.ProtoLens.Int32Field ::-                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32)-              (Data.ProtoLens.RepeatedField-                 Data.ProtoLens.Packed (Data.ProtoLens.Field.field @"values")) ::-              Data.ProtoLens.FieldDescriptor WithRepeated-        tags__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "tags"-              (Data.ProtoLens.ScalarField Data.ProtoLens.StringField ::-                 Data.ProtoLens.FieldTypeDescriptor Data.Text.Text)-              (Data.ProtoLens.RepeatedField-                 Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"tags")) ::-              Data.ProtoLens.FieldDescriptor WithRepeated-        items__field_descriptor-          = Data.ProtoLens.FieldDescriptor-              "items"-              (Data.ProtoLens.MessageField Data.ProtoLens.MessageType ::-                 Data.ProtoLens.FieldTypeDescriptor Small)-              (Data.ProtoLens.RepeatedField-                 Data.ProtoLens.Unpacked (Data.ProtoLens.Field.field @"items")) ::-              Data.ProtoLens.FieldDescriptor WithRepeated-      in-        Data.Map.fromList-          [(Data.ProtoLens.Tag 1, values__field_descriptor),-           (Data.ProtoLens.Tag 2, tags__field_descriptor),-           (Data.ProtoLens.Tag 3, items__field_descriptor)]-  unknownFields-    = Lens.Family2.Unchecked.lens-        _WithRepeated'_unknownFields-        (\ x__ y__ -> x__ {_WithRepeated'_unknownFields = y__})-  defMessage-    = WithRepeated'_constructor-        {_WithRepeated'values = Data.Vector.Generic.empty,-         _WithRepeated'tags = Data.Vector.Generic.empty,-         _WithRepeated'items = Data.Vector.Generic.empty,-         _WithRepeated'_unknownFields = []}-  parseMessage-    = let-        loop ::-          WithRepeated-          -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Small-             -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.Text.Text-                -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Unboxed.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.Int.Int32-                   -> Data.ProtoLens.Encoding.Bytes.Parser WithRepeated-        loop x mutable'items mutable'tags mutable'values-          = do end <- Data.ProtoLens.Encoding.Bytes.atEnd-               if end then-                   do frozen'items <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO-                                        (Data.ProtoLens.Encoding.Growing.unsafeFreeze mutable'items)-                      frozen'tags <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO-                                       (Data.ProtoLens.Encoding.Growing.unsafeFreeze mutable'tags)-                      frozen'values <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO-                                         (Data.ProtoLens.Encoding.Growing.unsafeFreeze-                                            mutable'values)-                      (let missing = []-                       in-                         if Prelude.null missing then-                             Prelude.return ()-                         else-                             Prelude.fail-                               ((Prelude.++)-                                  "Missing required fields: "-                                  (Prelude.show (missing :: [Prelude.String]))))-                      Prelude.return-                        (Lens.Family2.over-                           Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t)-                           (Lens.Family2.set-                              (Data.ProtoLens.Field.field @"vec'items") frozen'items-                              (Lens.Family2.set-                                 (Data.ProtoLens.Field.field @"vec'tags") frozen'tags-                                 (Lens.Family2.set-                                    (Data.ProtoLens.Field.field @"vec'values") frozen'values x))))-               else-                   do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt-                      case tag of-                        8 -> do !y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                        (Prelude.fmap-                                           Prelude.fromIntegral-                                           Data.ProtoLens.Encoding.Bytes.getVarInt)-                                        "values"-                                v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO-                                       (Data.ProtoLens.Encoding.Growing.append mutable'values y)-                                loop x mutable'items mutable'tags v-                        10-                          -> do y <- do len <- Data.ProtoLens.Encoding.Bytes.getVarInt-                                        Data.ProtoLens.Encoding.Bytes.isolate-                                          (Prelude.fromIntegral len)-                                          ((let-                                              ploop qs-                                                = do packedEnd <- Data.ProtoLens.Encoding.Bytes.atEnd-                                                     if packedEnd then-                                                         Prelude.return qs-                                                     else-                                                         do !q <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                                                    (Prelude.fmap-                                                                       Prelude.fromIntegral-                                                                       Data.ProtoLens.Encoding.Bytes.getVarInt)-                                                                    "values"-                                                            qs' <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO-                                                                     (Data.ProtoLens.Encoding.Growing.append-                                                                        qs q)-                                                            ploop qs'-                                            in ploop)-                                             mutable'values)-                                loop x mutable'items mutable'tags y-                        18-                          -> do !y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                        (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt-                                            Data.ProtoLens.Encoding.Bytes.getText-                                              (Prelude.fromIntegral len))-                                        "tags"-                                v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO-                                       (Data.ProtoLens.Encoding.Growing.append mutable'tags y)-                                loop x mutable'items v mutable'values-                        26-                          -> do !y <- (Data.ProtoLens.Encoding.Bytes.<?>)-                                        (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt-                                            Data.ProtoLens.Encoding.Bytes.isolate-                                              (Prelude.fromIntegral len)-                                              Data.ProtoLens.parseMessage)-                                        "items"-                                v <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO-                                       (Data.ProtoLens.Encoding.Growing.append mutable'items y)-                                loop x v mutable'tags mutable'values-                        wire-                          -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire-                                        wire-                                loop-                                  (Lens.Family2.over-                                     Data.ProtoLens.unknownFields (\ !t -> (:) y t) x)-                                  mutable'items mutable'tags mutable'values-      in-        (Data.ProtoLens.Encoding.Bytes.<?>)-          (do mutable'items <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO-                                 Data.ProtoLens.Encoding.Growing.new-              mutable'tags <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO-                                Data.ProtoLens.Encoding.Growing.new-              mutable'values <- Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO-                                  Data.ProtoLens.Encoding.Growing.new-              loop-                Data.ProtoLens.defMessage mutable'items mutable'tags-                mutable'values)-          "WithRepeated"-  buildMessage-    = \ _x-        -> (Data.Monoid.<>)-             (let-                p = Lens.Family2.view (Data.ProtoLens.Field.field @"vec'values") _x-              in-                if Data.Vector.Generic.null p then-                    Data.Monoid.mempty-                else-                    (Data.Monoid.<>)-                      (Data.ProtoLens.Encoding.Bytes.putVarInt 10)-                      ((\ bs-                          -> (Data.Monoid.<>)-                               (Data.ProtoLens.Encoding.Bytes.putVarInt-                                  (Prelude.fromIntegral (Data.ByteString.length bs)))-                               (Data.ProtoLens.Encoding.Bytes.putBytes bs))-                         (Data.ProtoLens.Encoding.Bytes.runBuilder-                            (Data.ProtoLens.Encoding.Bytes.foldMapBuilder-                               ((Prelude..)-                                  Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral)-                               p))))-             ((Data.Monoid.<>)-                (Data.ProtoLens.Encoding.Bytes.foldMapBuilder-                   (\ _v-                      -> (Data.Monoid.<>)-                           (Data.ProtoLens.Encoding.Bytes.putVarInt 18)-                           ((Prelude..)-                              (\ bs-                                 -> (Data.Monoid.<>)-                                      (Data.ProtoLens.Encoding.Bytes.putVarInt-                                         (Prelude.fromIntegral (Data.ByteString.length bs)))-                                      (Data.ProtoLens.Encoding.Bytes.putBytes bs))-                              Data.Text.Encoding.encodeUtf8 _v))-                   (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'tags") _x))-                ((Data.Monoid.<>)-                   (Data.ProtoLens.Encoding.Bytes.foldMapBuilder-                      (\ _v-                         -> (Data.Monoid.<>)-                              (Data.ProtoLens.Encoding.Bytes.putVarInt 26)-                              ((Prelude..)-                                 (\ bs-                                    -> (Data.Monoid.<>)-                                         (Data.ProtoLens.Encoding.Bytes.putVarInt-                                            (Prelude.fromIntegral (Data.ByteString.length bs)))-                                         (Data.ProtoLens.Encoding.Bytes.putBytes bs))-                                 Data.ProtoLens.encodeMessage _v))-                      (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'items") _x))-                   (Data.ProtoLens.Encoding.Wire.buildFieldSet-                      (Lens.Family2.view Data.ProtoLens.unknownFields _x))))-instance Control.DeepSeq.NFData WithRepeated where-  rnf-    = \ x__-        -> Control.DeepSeq.deepseq-             (_WithRepeated'_unknownFields x__)-             (Control.DeepSeq.deepseq-                (_WithRepeated'values x__)-                (Control.DeepSeq.deepseq-                   (_WithRepeated'tags x__)-                   (Control.DeepSeq.deepseq (_WithRepeated'items x__) ())))-packedFileDescriptor :: Data.ByteString.ByteString-packedFileDescriptor-  = "\n\-    \\vbench.proto\DC2\ENQbench\"C\n\-    \\ENQSmall\DC2\SO\n\-    \\STXid\CAN\SOH \SOH(\ETXR\STXid\DC2\DC2\n\-    \\EOTname\CAN\STX \SOH(\tR\EOTname\DC2\SYN\n\-    \\ACKactive\CAN\ETX \SOH(\bR\ACKactive\"\212\SOH\n\-    \\ACKMedium\DC2\DC4\n\-    \\ENQtitle\CAN\SOH \SOH(\tR\ENQtitle\DC2\DC4\n\-    \\ENQcount\CAN\STX \SOH(\ENQR\ENQcount\DC2\DC4\n\-    \\ENQscore\CAN\ETX \SOH(\SOHR\ENQscore\DC2\CAN\n\-    \\apayload\CAN\EOT \SOH(\fR\apayload\DC2\CAN\n\-    \\aenabled\CAN\ENQ \SOH(\bR\aenabled\DC2\FS\n\-    \\ttimestamp\CAN\ACK \SOH(\ETXR\ttimestamp\DC2 \n\-    \\vdescription\CAN\a \SOH(\tR\vdescription\DC2\DC4\n\-    \\ENQratio\CAN\b \SOH(\STXR\ENQratio\"V\n\-    \\n\-    \WithNested\DC2\SO\n\-    \\STXid\CAN\SOH \SOH(\ETXR\STXid\DC2\"\n\-    \\ENQinner\CAN\STX \SOH(\v2\f.bench.SmallR\ENQinner\DC2\DC4\n\-    \\ENQlabel\CAN\ETX \SOH(\tR\ENQlabel\"^\n\-    \\fWithRepeated\DC2\SYN\n\-    \\ACKvalues\CAN\SOH \ETX(\ENQR\ACKvalues\DC2\DC2\n\-    \\EOTtags\CAN\STX \ETX(\tR\EOTtags\DC2\"\n\-    \\ENQitems\CAN\ETX \ETX(\v2\f.bench.SmallR\ENQitemsJ\139\n\-    \\n\-    \\ACK\DC2\EOT\NUL\NUL#\SOH\n\-    \\b\n\-    \\SOH\f\DC2\ETX\NUL\NUL\DC2\n\-    \\b\n\-    \\SOH\STX\DC2\ETX\STX\NUL\SO\n\-    \8\n\-    \\STX\EOT\NUL\DC2\EOT\ENQ\NUL\t\SOH\SUB, Small message for tight-loop benchmarking.\n\-    \\n\-    \\n\-    \\n\-    \\ETX\EOT\NUL\SOH\DC2\ETX\ENQ\b\r\n\-    \\v\n\-    \\EOT\EOT\NUL\STX\NUL\DC2\ETX\ACK\STX\SI\n\-    \\f\n\-    \\ENQ\EOT\NUL\STX\NUL\ENQ\DC2\ETX\ACK\STX\a\n\-    \\f\n\-    \\ENQ\EOT\NUL\STX\NUL\SOH\DC2\ETX\ACK\b\n\-    \\n\-    \\f\n\-    \\ENQ\EOT\NUL\STX\NUL\ETX\DC2\ETX\ACK\r\SO\n\-    \\v\n\-    \\EOT\EOT\NUL\STX\SOH\DC2\ETX\a\STX\DC2\n\-    \\f\n\-    \\ENQ\EOT\NUL\STX\SOH\ENQ\DC2\ETX\a\STX\b\n\-    \\f\n\-    \\ENQ\EOT\NUL\STX\SOH\SOH\DC2\ETX\a\t\r\n\-    \\f\n\-    \\ENQ\EOT\NUL\STX\SOH\ETX\DC2\ETX\a\DLE\DC1\n\-    \\v\n\-    \\EOT\EOT\NUL\STX\STX\DC2\ETX\b\STX\DC2\n\-    \\f\n\-    \\ENQ\EOT\NUL\STX\STX\ENQ\DC2\ETX\b\STX\ACK\n\-    \\f\n\-    \\ENQ\EOT\NUL\STX\STX\SOH\DC2\ETX\b\a\r\n\-    \\f\n\-    \\ENQ\EOT\NUL\STX\STX\ETX\DC2\ETX\b\DLE\DC1\n\-    \5\n\-    \\STX\EOT\SOH\DC2\EOT\f\NUL\NAK\SOH\SUB) Medium message with more field variety.\n\-    \\n\-    \\n\-    \\n\-    \\ETX\EOT\SOH\SOH\DC2\ETX\f\b\SO\n\-    \\v\n\-    \\EOT\EOT\SOH\STX\NUL\DC2\ETX\r\STX\DC3\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\NUL\ENQ\DC2\ETX\r\STX\b\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\NUL\SOH\DC2\ETX\r\t\SO\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\NUL\ETX\DC2\ETX\r\DC1\DC2\n\-    \\v\n\-    \\EOT\EOT\SOH\STX\SOH\DC2\ETX\SO\STX\DC2\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\SOH\ENQ\DC2\ETX\SO\STX\a\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\SOH\SOH\DC2\ETX\SO\b\r\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\SOH\ETX\DC2\ETX\SO\DLE\DC1\n\-    \\v\n\-    \\EOT\EOT\SOH\STX\STX\DC2\ETX\SI\STX\DC3\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\STX\ENQ\DC2\ETX\SI\STX\b\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\STX\SOH\DC2\ETX\SI\t\SO\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\STX\ETX\DC2\ETX\SI\DC1\DC2\n\-    \\v\n\-    \\EOT\EOT\SOH\STX\ETX\DC2\ETX\DLE\STX\DC4\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\ETX\ENQ\DC2\ETX\DLE\STX\a\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\ETX\SOH\DC2\ETX\DLE\b\SI\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\ETX\ETX\DC2\ETX\DLE\DC2\DC3\n\-    \\v\n\-    \\EOT\EOT\SOH\STX\EOT\DC2\ETX\DC1\STX\DC3\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\EOT\ENQ\DC2\ETX\DC1\STX\ACK\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\EOT\SOH\DC2\ETX\DC1\a\SO\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\EOT\ETX\DC2\ETX\DC1\DC1\DC2\n\-    \\v\n\-    \\EOT\EOT\SOH\STX\ENQ\DC2\ETX\DC2\STX\SYN\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\ENQ\ENQ\DC2\ETX\DC2\STX\a\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\ENQ\SOH\DC2\ETX\DC2\b\DC1\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\ENQ\ETX\DC2\ETX\DC2\DC4\NAK\n\-    \\v\n\-    \\EOT\EOT\SOH\STX\ACK\DC2\ETX\DC3\STX\EM\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\ACK\ENQ\DC2\ETX\DC3\STX\b\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\ACK\SOH\DC2\ETX\DC3\t\DC4\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\ACK\ETX\DC2\ETX\DC3\ETB\CAN\n\-    \\v\n\-    \\EOT\EOT\SOH\STX\a\DC2\ETX\DC4\STX\DC2\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\a\ENQ\DC2\ETX\DC4\STX\a\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\a\SOH\DC2\ETX\DC4\b\r\n\-    \\f\n\-    \\ENQ\EOT\SOH\STX\a\ETX\DC2\ETX\DC4\DLE\DC1\n\-    \N\n\-    \\STX\EOT\STX\DC2\EOT\CAN\NUL\FS\SOH\SUBB Message with a submessage for nested encode/decode benchmarking.\n\-    \\n\-    \\n\-    \\n\-    \\ETX\EOT\STX\SOH\DC2\ETX\CAN\b\DC2\n\-    \\v\n\-    \\EOT\EOT\STX\STX\NUL\DC2\ETX\EM\STX\SI\n\-    \\f\n\-    \\ENQ\EOT\STX\STX\NUL\ENQ\DC2\ETX\EM\STX\a\n\-    \\f\n\-    \\ENQ\EOT\STX\STX\NUL\SOH\DC2\ETX\EM\b\n\-    \\n\-    \\f\n\-    \\ENQ\EOT\STX\STX\NUL\ETX\DC2\ETX\EM\r\SO\n\-    \\v\n\-    \\EOT\EOT\STX\STX\SOH\DC2\ETX\SUB\STX\DC2\n\-    \\f\n\-    \\ENQ\EOT\STX\STX\SOH\ACK\DC2\ETX\SUB\STX\a\n\-    \\f\n\-    \\ENQ\EOT\STX\STX\SOH\SOH\DC2\ETX\SUB\b\r\n\-    \\f\n\-    \\ENQ\EOT\STX\STX\SOH\ETX\DC2\ETX\SUB\DLE\DC1\n\-    \\v\n\-    \\EOT\EOT\STX\STX\STX\DC2\ETX\ESC\STX\DC3\n\-    \\f\n\-    \\ENQ\EOT\STX\STX\STX\ENQ\DC2\ETX\ESC\STX\b\n\-    \\f\n\-    \\ENQ\EOT\STX\STX\STX\SOH\DC2\ETX\ESC\t\SO\n\-    \\f\n\-    \\ENQ\EOT\STX\STX\STX\ETX\DC2\ETX\ESC\DC1\DC2\n\-    \+\n\-    \\STX\EOT\ETX\DC2\EOT\US\NUL#\SOH\SUB\US Message with repeated fields.\n\-    \\n\-    \\n\-    \\n\-    \\ETX\EOT\ETX\SOH\DC2\ETX\US\b\DC4\n\-    \\v\n\-    \\EOT\EOT\ETX\STX\NUL\DC2\ETX \STX\FS\n\-    \\f\n\-    \\ENQ\EOT\ETX\STX\NUL\EOT\DC2\ETX \STX\n\-    \\n\-    \\f\n\-    \\ENQ\EOT\ETX\STX\NUL\ENQ\DC2\ETX \v\DLE\n\-    \\f\n\-    \\ENQ\EOT\ETX\STX\NUL\SOH\DC2\ETX \DC1\ETB\n\-    \\f\n\-    \\ENQ\EOT\ETX\STX\NUL\ETX\DC2\ETX \SUB\ESC\n\-    \\v\n\-    \\EOT\EOT\ETX\STX\SOH\DC2\ETX!\STX\ESC\n\-    \\f\n\-    \\ENQ\EOT\ETX\STX\SOH\EOT\DC2\ETX!\STX\n\-    \\n\-    \\f\n\-    \\ENQ\EOT\ETX\STX\SOH\ENQ\DC2\ETX!\v\DC1\n\-    \\f\n\-    \\ENQ\EOT\ETX\STX\SOH\SOH\DC2\ETX!\DC2\SYN\n\-    \\f\n\-    \\ENQ\EOT\ETX\STX\SOH\ETX\DC2\ETX!\EM\SUB\n\-    \\v\n\-    \\EOT\EOT\ETX\STX\STX\DC2\ETX\"\STX\ESC\n\-    \\f\n\-    \\ENQ\EOT\ETX\STX\STX\EOT\DC2\ETX\"\STX\n\-    \\n\-    \\f\n\-    \\ENQ\EOT\ETX\STX\STX\ACK\DC2\ETX\"\v\DLE\n\-    \\f\n\-    \\ENQ\EOT\ETX\STX\STX\SOH\DC2\ETX\"\DC1\SYN\n\-    \\f\n\-    \\ENQ\EOT\ETX\STX\STX\ETX\DC2\ETX\"\EM\SUBb\ACKproto3"+{-# LANGUAGE BangPatterns #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE DataKinds #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE DerivingStrategies #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE FlexibleContexts #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE FlexibleInstances #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE MagicHash #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE MultiParamTypeClasses #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE OverloadedStrings #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE PatternSynonyms #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE ScopedTypeVariables #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE TypeApplications #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE TypeFamilies #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE UndecidableInstances #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wno-dodgy-exports #-}+{-# OPTIONS_GHC -Wno-duplicate-exports #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}++module Proto.Bench (+  Medium (),+  Small (),+  WithNested (),+  WithRepeated (),+) where++import Data.ProtoLens.Runtime.Control.DeepSeq qualified as Control.DeepSeq+import Data.ProtoLens.Runtime.Data.ByteString qualified as Data.ByteString+import Data.ProtoLens.Runtime.Data.ByteString.Char8 qualified as Data.ByteString.Char8+import Data.ProtoLens.Runtime.Data.Int qualified as Data.Int+import Data.ProtoLens.Runtime.Data.Map qualified as Data.Map+import Data.ProtoLens.Runtime.Data.Monoid qualified as Data.Monoid+import Data.ProtoLens.Runtime.Data.ProtoLens qualified as Data.ProtoLens+import Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Bytes qualified as Data.ProtoLens.Encoding.Bytes+import Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Growing qualified as Data.ProtoLens.Encoding.Growing+import Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Parser.Unsafe qualified as Data.ProtoLens.Encoding.Parser.Unsafe+import Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Wire qualified as Data.ProtoLens.Encoding.Wire+import Data.ProtoLens.Runtime.Data.ProtoLens.Field qualified as Data.ProtoLens.Field+import Data.ProtoLens.Runtime.Data.ProtoLens.Message.Enum qualified as Data.ProtoLens.Message.Enum+import Data.ProtoLens.Runtime.Data.ProtoLens.Prism qualified as Data.ProtoLens.Prism+import Data.ProtoLens.Runtime.Data.ProtoLens.Service.Types qualified as Data.ProtoLens.Service.Types+import Data.ProtoLens.Runtime.Data.Text qualified as Data.Text+import Data.ProtoLens.Runtime.Data.Text.Encoding qualified as Data.Text.Encoding+import Data.ProtoLens.Runtime.Data.Vector qualified as Data.Vector+import Data.ProtoLens.Runtime.Data.Vector.Generic qualified as Data.Vector.Generic+import Data.ProtoLens.Runtime.Data.Vector.Unboxed qualified as Data.Vector.Unboxed+import Data.ProtoLens.Runtime.Data.Word qualified as Data.Word+import Data.ProtoLens.Runtime.Lens.Family2 qualified as Lens.Family2+import Data.ProtoLens.Runtime.Lens.Family2.Unchecked qualified as Lens.Family2.Unchecked+import Data.ProtoLens.Runtime.Prelude qualified as Prelude+import Data.ProtoLens.Runtime.Text.Read qualified as Text.Read+++{- | Fields :++         * 'Proto.Bench_Fields.title' @:: Lens' Medium Data.Text.Text@+         * 'Proto.Bench_Fields.count' @:: Lens' Medium Data.Int.Int32@+         * 'Proto.Bench_Fields.score' @:: Lens' Medium Prelude.Double@+         * 'Proto.Bench_Fields.payload' @:: Lens' Medium Data.ByteString.ByteString@+         * 'Proto.Bench_Fields.enabled' @:: Lens' Medium Prelude.Bool@+         * 'Proto.Bench_Fields.timestamp' @:: Lens' Medium Data.Int.Int64@+         * 'Proto.Bench_Fields.description' @:: Lens' Medium Data.Text.Text@+         * 'Proto.Bench_Fields.ratio' @:: Lens' Medium Prelude.Float@+-}+data Medium+  = Medium'_constructor+  { _Medium'title :: !Data.Text.Text+  , _Medium'count :: !Data.Int.Int32+  , _Medium'score :: !Prelude.Double+  , _Medium'payload :: !Data.ByteString.ByteString+  , _Medium'enabled :: !Prelude.Bool+  , _Medium'timestamp :: !Data.Int.Int64+  , _Medium'description :: !Data.Text.Text+  , _Medium'ratio :: !Prelude.Float+  , _Medium'_unknownFields :: !Data.ProtoLens.FieldSet+  }+  deriving stock (Prelude.Eq, Prelude.Ord)+++instance Prelude.Show Medium where+  showsPrec _ __x __s =+    Prelude.showChar+      '{'+      ( Prelude.showString+          (Data.ProtoLens.showMessageShort __x)+          (Prelude.showChar '}' __s)+      )+++instance Data.ProtoLens.Field.HasField Medium "title" Data.Text.Text where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _Medium'title+          (\x__ y__ -> x__ {_Medium'title = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Field.HasField Medium "count" Data.Int.Int32 where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _Medium'count+          (\x__ y__ -> x__ {_Medium'count = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Field.HasField Medium "score" Prelude.Double where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _Medium'score+          (\x__ y__ -> x__ {_Medium'score = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Field.HasField Medium "payload" Data.ByteString.ByteString where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _Medium'payload+          (\x__ y__ -> x__ {_Medium'payload = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Field.HasField Medium "enabled" Prelude.Bool where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _Medium'enabled+          (\x__ y__ -> x__ {_Medium'enabled = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Field.HasField Medium "timestamp" Data.Int.Int64 where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _Medium'timestamp+          (\x__ y__ -> x__ {_Medium'timestamp = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Field.HasField Medium "description" Data.Text.Text where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _Medium'description+          (\x__ y__ -> x__ {_Medium'description = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Field.HasField Medium "ratio" Prelude.Float where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _Medium'ratio+          (\x__ y__ -> x__ {_Medium'ratio = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Message Medium where+  messageName _ = Data.Text.pack "bench.Medium"+  packedMessageDescriptor _ =+    "\n\+    \\ACKMedium\DC2\DC4\n\+    \\ENQtitle\CAN\SOH \SOH(\tR\ENQtitle\DC2\DC4\n\+    \\ENQcount\CAN\STX \SOH(\ENQR\ENQcount\DC2\DC4\n\+    \\ENQscore\CAN\ETX \SOH(\SOHR\ENQscore\DC2\CAN\n\+    \\apayload\CAN\EOT \SOH(\fR\apayload\DC2\CAN\n\+    \\aenabled\CAN\ENQ \SOH(\bR\aenabled\DC2\FS\n\+    \\ttimestamp\CAN\ACK \SOH(\ETXR\ttimestamp\DC2 \n\+    \\vdescription\CAN\a \SOH(\tR\vdescription\DC2\DC4\n\+    \\ENQratio\CAN\b \SOH(\STXR\ENQratio"+  packedFileDescriptor _ = packedFileDescriptor+  fieldsByTag =+    let+      title__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "title"+          ( Data.ProtoLens.ScalarField Data.ProtoLens.StringField+              :: Data.ProtoLens.FieldTypeDescriptor Data.Text.Text+          )+          ( Data.ProtoLens.PlainField+              Data.ProtoLens.Optional+              (Data.ProtoLens.Field.field @"title")+          )+          :: Data.ProtoLens.FieldDescriptor Medium+      count__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "count"+          ( Data.ProtoLens.ScalarField Data.ProtoLens.Int32Field+              :: Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32+          )+          ( Data.ProtoLens.PlainField+              Data.ProtoLens.Optional+              (Data.ProtoLens.Field.field @"count")+          )+          :: Data.ProtoLens.FieldDescriptor Medium+      score__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "score"+          ( Data.ProtoLens.ScalarField Data.ProtoLens.DoubleField+              :: Data.ProtoLens.FieldTypeDescriptor Prelude.Double+          )+          ( Data.ProtoLens.PlainField+              Data.ProtoLens.Optional+              (Data.ProtoLens.Field.field @"score")+          )+          :: Data.ProtoLens.FieldDescriptor Medium+      payload__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "payload"+          ( Data.ProtoLens.ScalarField Data.ProtoLens.BytesField+              :: Data.ProtoLens.FieldTypeDescriptor Data.ByteString.ByteString+          )+          ( Data.ProtoLens.PlainField+              Data.ProtoLens.Optional+              (Data.ProtoLens.Field.field @"payload")+          )+          :: Data.ProtoLens.FieldDescriptor Medium+      enabled__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "enabled"+          ( Data.ProtoLens.ScalarField Data.ProtoLens.BoolField+              :: Data.ProtoLens.FieldTypeDescriptor Prelude.Bool+          )+          ( Data.ProtoLens.PlainField+              Data.ProtoLens.Optional+              (Data.ProtoLens.Field.field @"enabled")+          )+          :: Data.ProtoLens.FieldDescriptor Medium+      timestamp__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "timestamp"+          ( Data.ProtoLens.ScalarField Data.ProtoLens.Int64Field+              :: Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64+          )+          ( Data.ProtoLens.PlainField+              Data.ProtoLens.Optional+              (Data.ProtoLens.Field.field @"timestamp")+          )+          :: Data.ProtoLens.FieldDescriptor Medium+      description__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "description"+          ( Data.ProtoLens.ScalarField Data.ProtoLens.StringField+              :: Data.ProtoLens.FieldTypeDescriptor Data.Text.Text+          )+          ( Data.ProtoLens.PlainField+              Data.ProtoLens.Optional+              (Data.ProtoLens.Field.field @"description")+          )+          :: Data.ProtoLens.FieldDescriptor Medium+      ratio__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "ratio"+          ( Data.ProtoLens.ScalarField Data.ProtoLens.FloatField+              :: Data.ProtoLens.FieldTypeDescriptor Prelude.Float+          )+          ( Data.ProtoLens.PlainField+              Data.ProtoLens.Optional+              (Data.ProtoLens.Field.field @"ratio")+          )+          :: Data.ProtoLens.FieldDescriptor Medium+    in+      Data.Map.fromList+        [ (Data.ProtoLens.Tag 1, title__field_descriptor)+        , (Data.ProtoLens.Tag 2, count__field_descriptor)+        , (Data.ProtoLens.Tag 3, score__field_descriptor)+        , (Data.ProtoLens.Tag 4, payload__field_descriptor)+        , (Data.ProtoLens.Tag 5, enabled__field_descriptor)+        , (Data.ProtoLens.Tag 6, timestamp__field_descriptor)+        , (Data.ProtoLens.Tag 7, description__field_descriptor)+        , (Data.ProtoLens.Tag 8, ratio__field_descriptor)+        ]+  unknownFields =+    Lens.Family2.Unchecked.lens+      _Medium'_unknownFields+      (\x__ y__ -> x__ {_Medium'_unknownFields = y__})+  defMessage =+    Medium'_constructor+      { _Medium'title = Data.ProtoLens.fieldDefault+      , _Medium'count = Data.ProtoLens.fieldDefault+      , _Medium'score = Data.ProtoLens.fieldDefault+      , _Medium'payload = Data.ProtoLens.fieldDefault+      , _Medium'enabled = Data.ProtoLens.fieldDefault+      , _Medium'timestamp = Data.ProtoLens.fieldDefault+      , _Medium'description = Data.ProtoLens.fieldDefault+      , _Medium'ratio = Data.ProtoLens.fieldDefault+      , _Medium'_unknownFields = []+      }+  parseMessage =+    let+      loop :: Medium -> Data.ProtoLens.Encoding.Bytes.Parser Medium+      loop x =+        do+          end <- Data.ProtoLens.Encoding.Bytes.atEnd+          if end+            then do+              ( let missing = []+                in if Prelude.null missing+                     then+                       Prelude.return ()+                     else+                       Prelude.fail+                         ( (Prelude.++)+                             "Missing required fields: "+                             (Prelude.show (missing :: [Prelude.String]))+                         )+                )+              Prelude.return+                ( Lens.Family2.over+                    Data.ProtoLens.unknownFields+                    (\ !t -> Prelude.reverse t)+                    x+                )+            else do+              tag <- Data.ProtoLens.Encoding.Bytes.getVarInt+              case tag of+                10 ->+                  do+                    y <-+                      (Data.ProtoLens.Encoding.Bytes.<?>)+                        ( do+                            len <- Data.ProtoLens.Encoding.Bytes.getVarInt+                            Data.ProtoLens.Encoding.Bytes.getText+                              (Prelude.fromIntegral len)+                        )+                        "title"+                    loop (Lens.Family2.set (Data.ProtoLens.Field.field @"title") y x)+                16 ->+                  do+                    y <-+                      (Data.ProtoLens.Encoding.Bytes.<?>)+                        ( Prelude.fmap+                            Prelude.fromIntegral+                            Data.ProtoLens.Encoding.Bytes.getVarInt+                        )+                        "count"+                    loop (Lens.Family2.set (Data.ProtoLens.Field.field @"count") y x)+                25 ->+                  do+                    y <-+                      (Data.ProtoLens.Encoding.Bytes.<?>)+                        ( Prelude.fmap+                            Data.ProtoLens.Encoding.Bytes.wordToDouble+                            Data.ProtoLens.Encoding.Bytes.getFixed64+                        )+                        "score"+                    loop (Lens.Family2.set (Data.ProtoLens.Field.field @"score") y x)+                34 ->+                  do+                    y <-+                      (Data.ProtoLens.Encoding.Bytes.<?>)+                        ( do+                            len <- Data.ProtoLens.Encoding.Bytes.getVarInt+                            Data.ProtoLens.Encoding.Bytes.getBytes+                              (Prelude.fromIntegral len)+                        )+                        "payload"+                    loop (Lens.Family2.set (Data.ProtoLens.Field.field @"payload") y x)+                40 ->+                  do+                    y <-+                      (Data.ProtoLens.Encoding.Bytes.<?>)+                        ( Prelude.fmap+                            ((Prelude./=) 0)+                            Data.ProtoLens.Encoding.Bytes.getVarInt+                        )+                        "enabled"+                    loop (Lens.Family2.set (Data.ProtoLens.Field.field @"enabled") y x)+                48 ->+                  do+                    y <-+                      (Data.ProtoLens.Encoding.Bytes.<?>)+                        ( Prelude.fmap+                            Prelude.fromIntegral+                            Data.ProtoLens.Encoding.Bytes.getVarInt+                        )+                        "timestamp"+                    loop+                      (Lens.Family2.set (Data.ProtoLens.Field.field @"timestamp") y x)+                58 ->+                  do+                    y <-+                      (Data.ProtoLens.Encoding.Bytes.<?>)+                        ( do+                            len <- Data.ProtoLens.Encoding.Bytes.getVarInt+                            Data.ProtoLens.Encoding.Bytes.getText+                              (Prelude.fromIntegral len)+                        )+                        "description"+                    loop+                      (Lens.Family2.set (Data.ProtoLens.Field.field @"description") y x)+                69 ->+                  do+                    y <-+                      (Data.ProtoLens.Encoding.Bytes.<?>)+                        ( Prelude.fmap+                            Data.ProtoLens.Encoding.Bytes.wordToFloat+                            Data.ProtoLens.Encoding.Bytes.getFixed32+                        )+                        "ratio"+                    loop (Lens.Family2.set (Data.ProtoLens.Field.field @"ratio") y x)+                wire ->+                  do+                    !y <-+                      Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire+                        wire+                    loop+                      ( Lens.Family2.over+                          Data.ProtoLens.unknownFields+                          (\ !t -> (:) y t)+                          x+                      )+    in+      (Data.ProtoLens.Encoding.Bytes.<?>)+        (do loop Data.ProtoLens.defMessage)+        "Medium"+  buildMessage =+    \_x ->+      (Data.Monoid.<>)+        ( let+            _v = Lens.Family2.view (Data.ProtoLens.Field.field @"title") _x+          in+            if (Prelude.==) _v Data.ProtoLens.fieldDefault+              then+                Data.Monoid.mempty+              else+                (Data.Monoid.<>)+                  (Data.ProtoLens.Encoding.Bytes.putVarInt 10)+                  ( (Prelude..)+                      ( \bs ->+                          (Data.Monoid.<>)+                            ( Data.ProtoLens.Encoding.Bytes.putVarInt+                                (Prelude.fromIntegral (Data.ByteString.length bs))+                            )+                            (Data.ProtoLens.Encoding.Bytes.putBytes bs)+                      )+                      Data.Text.Encoding.encodeUtf8+                      _v+                  )+        )+        ( (Data.Monoid.<>)+            ( let+                _v = Lens.Family2.view (Data.ProtoLens.Field.field @"count") _x+              in+                if (Prelude.==) _v Data.ProtoLens.fieldDefault+                  then+                    Data.Monoid.mempty+                  else+                    (Data.Monoid.<>)+                      (Data.ProtoLens.Encoding.Bytes.putVarInt 16)+                      ( (Prelude..)+                          Data.ProtoLens.Encoding.Bytes.putVarInt+                          Prelude.fromIntegral+                          _v+                      )+            )+            ( (Data.Monoid.<>)+                ( let+                    _v = Lens.Family2.view (Data.ProtoLens.Field.field @"score") _x+                  in+                    if (Prelude.==) _v Data.ProtoLens.fieldDefault+                      then+                        Data.Monoid.mempty+                      else+                        (Data.Monoid.<>)+                          (Data.ProtoLens.Encoding.Bytes.putVarInt 25)+                          ( (Prelude..)+                              Data.ProtoLens.Encoding.Bytes.putFixed64+                              Data.ProtoLens.Encoding.Bytes.doubleToWord+                              _v+                          )+                )+                ( (Data.Monoid.<>)+                    ( let+                        _v = Lens.Family2.view (Data.ProtoLens.Field.field @"payload") _x+                      in+                        if (Prelude.==) _v Data.ProtoLens.fieldDefault+                          then+                            Data.Monoid.mempty+                          else+                            (Data.Monoid.<>)+                              (Data.ProtoLens.Encoding.Bytes.putVarInt 34)+                              ( ( \bs ->+                                    (Data.Monoid.<>)+                                      ( Data.ProtoLens.Encoding.Bytes.putVarInt+                                          (Prelude.fromIntegral (Data.ByteString.length bs))+                                      )+                                      (Data.ProtoLens.Encoding.Bytes.putBytes bs)+                                )+                                  _v+                              )+                    )+                    ( (Data.Monoid.<>)+                        ( let+                            _v = Lens.Family2.view (Data.ProtoLens.Field.field @"enabled") _x+                          in+                            if (Prelude.==) _v Data.ProtoLens.fieldDefault+                              then+                                Data.Monoid.mempty+                              else+                                (Data.Monoid.<>)+                                  (Data.ProtoLens.Encoding.Bytes.putVarInt 40)+                                  ( (Prelude..)+                                      Data.ProtoLens.Encoding.Bytes.putVarInt+                                      (\b -> if b then 1 else 0)+                                      _v+                                  )+                        )+                        ( (Data.Monoid.<>)+                            ( let+                                _v = Lens.Family2.view (Data.ProtoLens.Field.field @"timestamp") _x+                              in+                                if (Prelude.==) _v Data.ProtoLens.fieldDefault+                                  then+                                    Data.Monoid.mempty+                                  else+                                    (Data.Monoid.<>)+                                      (Data.ProtoLens.Encoding.Bytes.putVarInt 48)+                                      ( (Prelude..)+                                          Data.ProtoLens.Encoding.Bytes.putVarInt+                                          Prelude.fromIntegral+                                          _v+                                      )+                            )+                            ( (Data.Monoid.<>)+                                ( let+                                    _v =+                                      Lens.Family2.view+                                        (Data.ProtoLens.Field.field @"description")+                                        _x+                                  in+                                    if (Prelude.==) _v Data.ProtoLens.fieldDefault+                                      then+                                        Data.Monoid.mempty+                                      else+                                        (Data.Monoid.<>)+                                          (Data.ProtoLens.Encoding.Bytes.putVarInt 58)+                                          ( (Prelude..)+                                              ( \bs ->+                                                  (Data.Monoid.<>)+                                                    ( Data.ProtoLens.Encoding.Bytes.putVarInt+                                                        ( Prelude.fromIntegral+                                                            (Data.ByteString.length bs)+                                                        )+                                                    )+                                                    (Data.ProtoLens.Encoding.Bytes.putBytes bs)+                                              )+                                              Data.Text.Encoding.encodeUtf8+                                              _v+                                          )+                                )+                                ( (Data.Monoid.<>)+                                    ( let+                                        _v = Lens.Family2.view (Data.ProtoLens.Field.field @"ratio") _x+                                      in+                                        if (Prelude.==) _v Data.ProtoLens.fieldDefault+                                          then+                                            Data.Monoid.mempty+                                          else+                                            (Data.Monoid.<>)+                                              (Data.ProtoLens.Encoding.Bytes.putVarInt 69)+                                              ( (Prelude..)+                                                  Data.ProtoLens.Encoding.Bytes.putFixed32+                                                  Data.ProtoLens.Encoding.Bytes.floatToWord+                                                  _v+                                              )+                                    )+                                    ( Data.ProtoLens.Encoding.Wire.buildFieldSet+                                        (Lens.Family2.view Data.ProtoLens.unknownFields _x)+                                    )+                                )+                            )+                        )+                    )+                )+            )+        )+++instance Control.DeepSeq.NFData Medium where+  rnf =+    \x__ ->+      Control.DeepSeq.deepseq+        (_Medium'_unknownFields x__)+        ( Control.DeepSeq.deepseq+            (_Medium'title x__)+            ( Control.DeepSeq.deepseq+                (_Medium'count x__)+                ( Control.DeepSeq.deepseq+                    (_Medium'score x__)+                    ( Control.DeepSeq.deepseq+                        (_Medium'payload x__)+                        ( Control.DeepSeq.deepseq+                            (_Medium'enabled x__)+                            ( Control.DeepSeq.deepseq+                                (_Medium'timestamp x__)+                                ( Control.DeepSeq.deepseq+                                    (_Medium'description x__)+                                    (Control.DeepSeq.deepseq (_Medium'ratio x__) ())+                                )+                            )+                        )+                    )+                )+            )+        )+++{- | Fields :++         * 'Proto.Bench_Fields.id' @:: Lens' Small Data.Int.Int64@+         * 'Proto.Bench_Fields.name' @:: Lens' Small Data.Text.Text@+         * 'Proto.Bench_Fields.active' @:: Lens' Small Prelude.Bool@+-}+data Small+  = Small'_constructor+  { _Small'id :: !Data.Int.Int64+  , _Small'name :: !Data.Text.Text+  , _Small'active :: !Prelude.Bool+  , _Small'_unknownFields :: !Data.ProtoLens.FieldSet+  }+  deriving stock (Prelude.Eq, Prelude.Ord)+++instance Prelude.Show Small where+  showsPrec _ __x __s =+    Prelude.showChar+      '{'+      ( Prelude.showString+          (Data.ProtoLens.showMessageShort __x)+          (Prelude.showChar '}' __s)+      )+++instance Data.ProtoLens.Field.HasField Small "id" Data.Int.Int64 where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _Small'id+          (\x__ y__ -> x__ {_Small'id = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Field.HasField Small "name" Data.Text.Text where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _Small'name+          (\x__ y__ -> x__ {_Small'name = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Field.HasField Small "active" Prelude.Bool where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _Small'active+          (\x__ y__ -> x__ {_Small'active = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Message Small where+  messageName _ = Data.Text.pack "bench.Small"+  packedMessageDescriptor _ =+    "\n\+    \\ENQSmall\DC2\SO\n\+    \\STXid\CAN\SOH \SOH(\ETXR\STXid\DC2\DC2\n\+    \\EOTname\CAN\STX \SOH(\tR\EOTname\DC2\SYN\n\+    \\ACKactive\CAN\ETX \SOH(\bR\ACKactive"+  packedFileDescriptor _ = packedFileDescriptor+  fieldsByTag =+    let+      id__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "id"+          ( Data.ProtoLens.ScalarField Data.ProtoLens.Int64Field+              :: Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64+          )+          ( Data.ProtoLens.PlainField+              Data.ProtoLens.Optional+              (Data.ProtoLens.Field.field @"id")+          )+          :: Data.ProtoLens.FieldDescriptor Small+      name__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "name"+          ( Data.ProtoLens.ScalarField Data.ProtoLens.StringField+              :: Data.ProtoLens.FieldTypeDescriptor Data.Text.Text+          )+          ( Data.ProtoLens.PlainField+              Data.ProtoLens.Optional+              (Data.ProtoLens.Field.field @"name")+          )+          :: Data.ProtoLens.FieldDescriptor Small+      active__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "active"+          ( Data.ProtoLens.ScalarField Data.ProtoLens.BoolField+              :: Data.ProtoLens.FieldTypeDescriptor Prelude.Bool+          )+          ( Data.ProtoLens.PlainField+              Data.ProtoLens.Optional+              (Data.ProtoLens.Field.field @"active")+          )+          :: Data.ProtoLens.FieldDescriptor Small+    in+      Data.Map.fromList+        [ (Data.ProtoLens.Tag 1, id__field_descriptor)+        , (Data.ProtoLens.Tag 2, name__field_descriptor)+        , (Data.ProtoLens.Tag 3, active__field_descriptor)+        ]+  unknownFields =+    Lens.Family2.Unchecked.lens+      _Small'_unknownFields+      (\x__ y__ -> x__ {_Small'_unknownFields = y__})+  defMessage =+    Small'_constructor+      { _Small'id = Data.ProtoLens.fieldDefault+      , _Small'name = Data.ProtoLens.fieldDefault+      , _Small'active = Data.ProtoLens.fieldDefault+      , _Small'_unknownFields = []+      }+  parseMessage =+    let+      loop :: Small -> Data.ProtoLens.Encoding.Bytes.Parser Small+      loop x =+        do+          end <- Data.ProtoLens.Encoding.Bytes.atEnd+          if end+            then do+              ( let missing = []+                in if Prelude.null missing+                     then+                       Prelude.return ()+                     else+                       Prelude.fail+                         ( (Prelude.++)+                             "Missing required fields: "+                             (Prelude.show (missing :: [Prelude.String]))+                         )+                )+              Prelude.return+                ( Lens.Family2.over+                    Data.ProtoLens.unknownFields+                    (\ !t -> Prelude.reverse t)+                    x+                )+            else do+              tag <- Data.ProtoLens.Encoding.Bytes.getVarInt+              case tag of+                8 -> do+                  y <-+                    (Data.ProtoLens.Encoding.Bytes.<?>)+                      ( Prelude.fmap+                          Prelude.fromIntegral+                          Data.ProtoLens.Encoding.Bytes.getVarInt+                      )+                      "id"+                  loop (Lens.Family2.set (Data.ProtoLens.Field.field @"id") y x)+                18 ->+                  do+                    y <-+                      (Data.ProtoLens.Encoding.Bytes.<?>)+                        ( do+                            len <- Data.ProtoLens.Encoding.Bytes.getVarInt+                            Data.ProtoLens.Encoding.Bytes.getText+                              (Prelude.fromIntegral len)+                        )+                        "name"+                    loop (Lens.Family2.set (Data.ProtoLens.Field.field @"name") y x)+                24 ->+                  do+                    y <-+                      (Data.ProtoLens.Encoding.Bytes.<?>)+                        ( Prelude.fmap+                            ((Prelude./=) 0)+                            Data.ProtoLens.Encoding.Bytes.getVarInt+                        )+                        "active"+                    loop (Lens.Family2.set (Data.ProtoLens.Field.field @"active") y x)+                wire ->+                  do+                    !y <-+                      Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire+                        wire+                    loop+                      ( Lens.Family2.over+                          Data.ProtoLens.unknownFields+                          (\ !t -> (:) y t)+                          x+                      )+    in+      (Data.ProtoLens.Encoding.Bytes.<?>)+        (do loop Data.ProtoLens.defMessage)+        "Small"+  buildMessage =+    \_x ->+      (Data.Monoid.<>)+        ( let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"id") _x+          in if (Prelude.==) _v Data.ProtoLens.fieldDefault+               then+                 Data.Monoid.mempty+               else+                 (Data.Monoid.<>)+                   (Data.ProtoLens.Encoding.Bytes.putVarInt 8)+                   ( (Prelude..)+                       Data.ProtoLens.Encoding.Bytes.putVarInt+                       Prelude.fromIntegral+                       _v+                   )+        )+        ( (Data.Monoid.<>)+            ( let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"name") _x+              in if (Prelude.==) _v Data.ProtoLens.fieldDefault+                   then+                     Data.Monoid.mempty+                   else+                     (Data.Monoid.<>)+                       (Data.ProtoLens.Encoding.Bytes.putVarInt 18)+                       ( (Prelude..)+                           ( \bs ->+                               (Data.Monoid.<>)+                                 ( Data.ProtoLens.Encoding.Bytes.putVarInt+                                     (Prelude.fromIntegral (Data.ByteString.length bs))+                                 )+                                 (Data.ProtoLens.Encoding.Bytes.putBytes bs)+                           )+                           Data.Text.Encoding.encodeUtf8+                           _v+                       )+            )+            ( (Data.Monoid.<>)+                ( let+                    _v = Lens.Family2.view (Data.ProtoLens.Field.field @"active") _x+                  in+                    if (Prelude.==) _v Data.ProtoLens.fieldDefault+                      then+                        Data.Monoid.mempty+                      else+                        (Data.Monoid.<>)+                          (Data.ProtoLens.Encoding.Bytes.putVarInt 24)+                          ( (Prelude..)+                              Data.ProtoLens.Encoding.Bytes.putVarInt+                              (\b -> if b then 1 else 0)+                              _v+                          )+                )+                ( Data.ProtoLens.Encoding.Wire.buildFieldSet+                    (Lens.Family2.view Data.ProtoLens.unknownFields _x)+                )+            )+        )+++instance Control.DeepSeq.NFData Small where+  rnf =+    \x__ ->+      Control.DeepSeq.deepseq+        (_Small'_unknownFields x__)+        ( Control.DeepSeq.deepseq+            (_Small'id x__)+            ( Control.DeepSeq.deepseq+                (_Small'name x__)+                (Control.DeepSeq.deepseq (_Small'active x__) ())+            )+        )+++{- | Fields :++         * 'Proto.Bench_Fields.id' @:: Lens' WithNested Data.Int.Int64@+         * 'Proto.Bench_Fields.inner' @:: Lens' WithNested Small@+         * 'Proto.Bench_Fields.maybe'inner' @:: Lens' WithNested (Prelude.Maybe Small)@+         * 'Proto.Bench_Fields.label' @:: Lens' WithNested Data.Text.Text@+-}+data WithNested+  = WithNested'_constructor+  { _WithNested'id :: !Data.Int.Int64+  , _WithNested'inner :: !(Prelude.Maybe Small)+  , _WithNested'label :: !Data.Text.Text+  , _WithNested'_unknownFields :: !Data.ProtoLens.FieldSet+  }+  deriving stock (Prelude.Eq, Prelude.Ord)+++instance Prelude.Show WithNested where+  showsPrec _ __x __s =+    Prelude.showChar+      '{'+      ( Prelude.showString+          (Data.ProtoLens.showMessageShort __x)+          (Prelude.showChar '}' __s)+      )+++instance Data.ProtoLens.Field.HasField WithNested "id" Data.Int.Int64 where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _WithNested'id+          (\x__ y__ -> x__ {_WithNested'id = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Field.HasField WithNested "inner" Small where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _WithNested'inner+          (\x__ y__ -> x__ {_WithNested'inner = y__})+      )+      (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage)+++instance Data.ProtoLens.Field.HasField WithNested "maybe'inner" (Prelude.Maybe Small) where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _WithNested'inner+          (\x__ y__ -> x__ {_WithNested'inner = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Field.HasField WithNested "label" Data.Text.Text where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _WithNested'label+          (\x__ y__ -> x__ {_WithNested'label = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Message WithNested where+  messageName _ = Data.Text.pack "bench.WithNested"+  packedMessageDescriptor _ =+    "\n\+    \\n\+    \WithNested\DC2\SO\n\+    \\STXid\CAN\SOH \SOH(\ETXR\STXid\DC2\"\n\+    \\ENQinner\CAN\STX \SOH(\v2\f.bench.SmallR\ENQinner\DC2\DC4\n\+    \\ENQlabel\CAN\ETX \SOH(\tR\ENQlabel"+  packedFileDescriptor _ = packedFileDescriptor+  fieldsByTag =+    let+      id__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "id"+          ( Data.ProtoLens.ScalarField Data.ProtoLens.Int64Field+              :: Data.ProtoLens.FieldTypeDescriptor Data.Int.Int64+          )+          ( Data.ProtoLens.PlainField+              Data.ProtoLens.Optional+              (Data.ProtoLens.Field.field @"id")+          )+          :: Data.ProtoLens.FieldDescriptor WithNested+      inner__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "inner"+          ( Data.ProtoLens.MessageField Data.ProtoLens.MessageType+              :: Data.ProtoLens.FieldTypeDescriptor Small+          )+          ( Data.ProtoLens.OptionalField+              (Data.ProtoLens.Field.field @"maybe'inner")+          )+          :: Data.ProtoLens.FieldDescriptor WithNested+      label__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "label"+          ( Data.ProtoLens.ScalarField Data.ProtoLens.StringField+              :: Data.ProtoLens.FieldTypeDescriptor Data.Text.Text+          )+          ( Data.ProtoLens.PlainField+              Data.ProtoLens.Optional+              (Data.ProtoLens.Field.field @"label")+          )+          :: Data.ProtoLens.FieldDescriptor WithNested+    in+      Data.Map.fromList+        [ (Data.ProtoLens.Tag 1, id__field_descriptor)+        , (Data.ProtoLens.Tag 2, inner__field_descriptor)+        , (Data.ProtoLens.Tag 3, label__field_descriptor)+        ]+  unknownFields =+    Lens.Family2.Unchecked.lens+      _WithNested'_unknownFields+      (\x__ y__ -> x__ {_WithNested'_unknownFields = y__})+  defMessage =+    WithNested'_constructor+      { _WithNested'id = Data.ProtoLens.fieldDefault+      , _WithNested'inner = Prelude.Nothing+      , _WithNested'label = Data.ProtoLens.fieldDefault+      , _WithNested'_unknownFields = []+      }+  parseMessage =+    let+      loop+        :: WithNested -> Data.ProtoLens.Encoding.Bytes.Parser WithNested+      loop x =+        do+          end <- Data.ProtoLens.Encoding.Bytes.atEnd+          if end+            then do+              ( let missing = []+                in if Prelude.null missing+                     then+                       Prelude.return ()+                     else+                       Prelude.fail+                         ( (Prelude.++)+                             "Missing required fields: "+                             (Prelude.show (missing :: [Prelude.String]))+                         )+                )+              Prelude.return+                ( Lens.Family2.over+                    Data.ProtoLens.unknownFields+                    (\ !t -> Prelude.reverse t)+                    x+                )+            else do+              tag <- Data.ProtoLens.Encoding.Bytes.getVarInt+              case tag of+                8 -> do+                  y <-+                    (Data.ProtoLens.Encoding.Bytes.<?>)+                      ( Prelude.fmap+                          Prelude.fromIntegral+                          Data.ProtoLens.Encoding.Bytes.getVarInt+                      )+                      "id"+                  loop (Lens.Family2.set (Data.ProtoLens.Field.field @"id") y x)+                18 ->+                  do+                    y <-+                      (Data.ProtoLens.Encoding.Bytes.<?>)+                        ( do+                            len <- Data.ProtoLens.Encoding.Bytes.getVarInt+                            Data.ProtoLens.Encoding.Bytes.isolate+                              (Prelude.fromIntegral len)+                              Data.ProtoLens.parseMessage+                        )+                        "inner"+                    loop (Lens.Family2.set (Data.ProtoLens.Field.field @"inner") y x)+                26 ->+                  do+                    y <-+                      (Data.ProtoLens.Encoding.Bytes.<?>)+                        ( do+                            len <- Data.ProtoLens.Encoding.Bytes.getVarInt+                            Data.ProtoLens.Encoding.Bytes.getText+                              (Prelude.fromIntegral len)+                        )+                        "label"+                    loop (Lens.Family2.set (Data.ProtoLens.Field.field @"label") y x)+                wire ->+                  do+                    !y <-+                      Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire+                        wire+                    loop+                      ( Lens.Family2.over+                          Data.ProtoLens.unknownFields+                          (\ !t -> (:) y t)+                          x+                      )+    in+      (Data.ProtoLens.Encoding.Bytes.<?>)+        (do loop Data.ProtoLens.defMessage)+        "WithNested"+  buildMessage =+    \_x ->+      (Data.Monoid.<>)+        ( let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"id") _x+          in if (Prelude.==) _v Data.ProtoLens.fieldDefault+               then+                 Data.Monoid.mempty+               else+                 (Data.Monoid.<>)+                   (Data.ProtoLens.Encoding.Bytes.putVarInt 8)+                   ( (Prelude..)+                       Data.ProtoLens.Encoding.Bytes.putVarInt+                       Prelude.fromIntegral+                       _v+                   )+        )+        ( (Data.Monoid.<>)+            ( case Lens.Family2.view (Data.ProtoLens.Field.field @"maybe'inner") _x of+                Prelude.Nothing -> Data.Monoid.mempty+                (Prelude.Just _v) ->+                  (Data.Monoid.<>)+                    (Data.ProtoLens.Encoding.Bytes.putVarInt 18)+                    ( (Prelude..)+                        ( \bs ->+                            (Data.Monoid.<>)+                              ( Data.ProtoLens.Encoding.Bytes.putVarInt+                                  (Prelude.fromIntegral (Data.ByteString.length bs))+                              )+                              (Data.ProtoLens.Encoding.Bytes.putBytes bs)+                        )+                        Data.ProtoLens.encodeMessage+                        _v+                    )+            )+            ( (Data.Monoid.<>)+                ( let+                    _v = Lens.Family2.view (Data.ProtoLens.Field.field @"label") _x+                  in+                    if (Prelude.==) _v Data.ProtoLens.fieldDefault+                      then+                        Data.Monoid.mempty+                      else+                        (Data.Monoid.<>)+                          (Data.ProtoLens.Encoding.Bytes.putVarInt 26)+                          ( (Prelude..)+                              ( \bs ->+                                  (Data.Monoid.<>)+                                    ( Data.ProtoLens.Encoding.Bytes.putVarInt+                                        (Prelude.fromIntegral (Data.ByteString.length bs))+                                    )+                                    (Data.ProtoLens.Encoding.Bytes.putBytes bs)+                              )+                              Data.Text.Encoding.encodeUtf8+                              _v+                          )+                )+                ( Data.ProtoLens.Encoding.Wire.buildFieldSet+                    (Lens.Family2.view Data.ProtoLens.unknownFields _x)+                )+            )+        )+++instance Control.DeepSeq.NFData WithNested where+  rnf =+    \x__ ->+      Control.DeepSeq.deepseq+        (_WithNested'_unknownFields x__)+        ( Control.DeepSeq.deepseq+            (_WithNested'id x__)+            ( Control.DeepSeq.deepseq+                (_WithNested'inner x__)+                (Control.DeepSeq.deepseq (_WithNested'label x__) ())+            )+        )+++{- | Fields :++         * 'Proto.Bench_Fields.values' @:: Lens' WithRepeated [Data.Int.Int32]@+         * 'Proto.Bench_Fields.vec'values' @:: Lens' WithRepeated (Data.Vector.Unboxed.Vector Data.Int.Int32)@+         * 'Proto.Bench_Fields.tags' @:: Lens' WithRepeated [Data.Text.Text]@+         * 'Proto.Bench_Fields.vec'tags' @:: Lens' WithRepeated (Data.Vector.Vector Data.Text.Text)@+         * 'Proto.Bench_Fields.items' @:: Lens' WithRepeated [Small]@+         * 'Proto.Bench_Fields.vec'items' @:: Lens' WithRepeated (Data.Vector.Vector Small)@+-}+data WithRepeated+  = WithRepeated'_constructor+  { _WithRepeated'values :: !(Data.Vector.Unboxed.Vector Data.Int.Int32)+  , _WithRepeated'tags :: !(Data.Vector.Vector Data.Text.Text)+  , _WithRepeated'items :: !(Data.Vector.Vector Small)+  , _WithRepeated'_unknownFields :: !Data.ProtoLens.FieldSet+  }+  deriving stock (Prelude.Eq, Prelude.Ord)+++instance Prelude.Show WithRepeated where+  showsPrec _ __x __s =+    Prelude.showChar+      '{'+      ( Prelude.showString+          (Data.ProtoLens.showMessageShort __x)+          (Prelude.showChar '}' __s)+      )+++instance Data.ProtoLens.Field.HasField WithRepeated "values" [Data.Int.Int32] where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _WithRepeated'values+          (\x__ y__ -> x__ {_WithRepeated'values = y__})+      )+      ( Lens.Family2.Unchecked.lens+          Data.Vector.Generic.toList+          (\_ y__ -> Data.Vector.Generic.fromList y__)+      )+++instance Data.ProtoLens.Field.HasField WithRepeated "vec'values" (Data.Vector.Unboxed.Vector Data.Int.Int32) where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _WithRepeated'values+          (\x__ y__ -> x__ {_WithRepeated'values = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Field.HasField WithRepeated "tags" [Data.Text.Text] where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _WithRepeated'tags+          (\x__ y__ -> x__ {_WithRepeated'tags = y__})+      )+      ( Lens.Family2.Unchecked.lens+          Data.Vector.Generic.toList+          (\_ y__ -> Data.Vector.Generic.fromList y__)+      )+++instance Data.ProtoLens.Field.HasField WithRepeated "vec'tags" (Data.Vector.Vector Data.Text.Text) where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _WithRepeated'tags+          (\x__ y__ -> x__ {_WithRepeated'tags = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Field.HasField WithRepeated "items" [Small] where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _WithRepeated'items+          (\x__ y__ -> x__ {_WithRepeated'items = y__})+      )+      ( Lens.Family2.Unchecked.lens+          Data.Vector.Generic.toList+          (\_ y__ -> Data.Vector.Generic.fromList y__)+      )+++instance Data.ProtoLens.Field.HasField WithRepeated "vec'items" (Data.Vector.Vector Small) where+  fieldOf _ =+    (Prelude..)+      ( Lens.Family2.Unchecked.lens+          _WithRepeated'items+          (\x__ y__ -> x__ {_WithRepeated'items = y__})+      )+      Prelude.id+++instance Data.ProtoLens.Message WithRepeated where+  messageName _ = Data.Text.pack "bench.WithRepeated"+  packedMessageDescriptor _ =+    "\n\+    \\fWithRepeated\DC2\SYN\n\+    \\ACKvalues\CAN\SOH \ETX(\ENQR\ACKvalues\DC2\DC2\n\+    \\EOTtags\CAN\STX \ETX(\tR\EOTtags\DC2\"\n\+    \\ENQitems\CAN\ETX \ETX(\v2\f.bench.SmallR\ENQitems"+  packedFileDescriptor _ = packedFileDescriptor+  fieldsByTag =+    let+      values__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "values"+          ( Data.ProtoLens.ScalarField Data.ProtoLens.Int32Field+              :: Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32+          )+          ( Data.ProtoLens.RepeatedField+              Data.ProtoLens.Packed+              (Data.ProtoLens.Field.field @"values")+          )+          :: Data.ProtoLens.FieldDescriptor WithRepeated+      tags__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "tags"+          ( Data.ProtoLens.ScalarField Data.ProtoLens.StringField+              :: Data.ProtoLens.FieldTypeDescriptor Data.Text.Text+          )+          ( Data.ProtoLens.RepeatedField+              Data.ProtoLens.Unpacked+              (Data.ProtoLens.Field.field @"tags")+          )+          :: Data.ProtoLens.FieldDescriptor WithRepeated+      items__field_descriptor =+        Data.ProtoLens.FieldDescriptor+          "items"+          ( Data.ProtoLens.MessageField Data.ProtoLens.MessageType+              :: Data.ProtoLens.FieldTypeDescriptor Small+          )+          ( Data.ProtoLens.RepeatedField+              Data.ProtoLens.Unpacked+              (Data.ProtoLens.Field.field @"items")+          )+          :: Data.ProtoLens.FieldDescriptor WithRepeated+    in+      Data.Map.fromList+        [ (Data.ProtoLens.Tag 1, values__field_descriptor)+        , (Data.ProtoLens.Tag 2, tags__field_descriptor)+        , (Data.ProtoLens.Tag 3, items__field_descriptor)+        ]+  unknownFields =+    Lens.Family2.Unchecked.lens+      _WithRepeated'_unknownFields+      (\x__ y__ -> x__ {_WithRepeated'_unknownFields = y__})+  defMessage =+    WithRepeated'_constructor+      { _WithRepeated'values = Data.Vector.Generic.empty+      , _WithRepeated'tags = Data.Vector.Generic.empty+      , _WithRepeated'items = Data.Vector.Generic.empty+      , _WithRepeated'_unknownFields = []+      }+  parseMessage =+    let+      loop+        :: WithRepeated+        -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Small+        -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.Text.Text+        -> Data.ProtoLens.Encoding.Growing.Growing Data.Vector.Unboxed.Vector Data.ProtoLens.Encoding.Growing.RealWorld Data.Int.Int32+        -> Data.ProtoLens.Encoding.Bytes.Parser WithRepeated+      loop x mutable'items mutable'tags mutable'values =+        do+          end <- Data.ProtoLens.Encoding.Bytes.atEnd+          if end+            then do+              frozen'items <-+                Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO+                  (Data.ProtoLens.Encoding.Growing.unsafeFreeze mutable'items)+              frozen'tags <-+                Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO+                  (Data.ProtoLens.Encoding.Growing.unsafeFreeze mutable'tags)+              frozen'values <-+                Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO+                  ( Data.ProtoLens.Encoding.Growing.unsafeFreeze+                      mutable'values+                  )+              ( let missing = []+                in if Prelude.null missing+                     then+                       Prelude.return ()+                     else+                       Prelude.fail+                         ( (Prelude.++)+                             "Missing required fields: "+                             (Prelude.show (missing :: [Prelude.String]))+                         )+                )+              Prelude.return+                ( Lens.Family2.over+                    Data.ProtoLens.unknownFields+                    (\ !t -> Prelude.reverse t)+                    ( Lens.Family2.set+                        (Data.ProtoLens.Field.field @"vec'items")+                        frozen'items+                        ( Lens.Family2.set+                            (Data.ProtoLens.Field.field @"vec'tags")+                            frozen'tags+                            ( Lens.Family2.set+                                (Data.ProtoLens.Field.field @"vec'values")+                                frozen'values+                                x+                            )+                        )+                    )+                )+            else do+              tag <- Data.ProtoLens.Encoding.Bytes.getVarInt+              case tag of+                8 -> do+                  !y <-+                    (Data.ProtoLens.Encoding.Bytes.<?>)+                      ( Prelude.fmap+                          Prelude.fromIntegral+                          Data.ProtoLens.Encoding.Bytes.getVarInt+                      )+                      "values"+                  v <-+                    Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO+                      (Data.ProtoLens.Encoding.Growing.append mutable'values y)+                  loop x mutable'items mutable'tags v+                10 ->+                  do+                    y <- do+                      len <- Data.ProtoLens.Encoding.Bytes.getVarInt+                      Data.ProtoLens.Encoding.Bytes.isolate+                        (Prelude.fromIntegral len)+                        ( ( let+                              ploop qs =+                                do+                                  packedEnd <- Data.ProtoLens.Encoding.Bytes.atEnd+                                  if packedEnd+                                    then+                                      Prelude.return qs+                                    else do+                                      !q <-+                                        (Data.ProtoLens.Encoding.Bytes.<?>)+                                          ( Prelude.fmap+                                              Prelude.fromIntegral+                                              Data.ProtoLens.Encoding.Bytes.getVarInt+                                          )+                                          "values"+                                      qs' <-+                                        Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO+                                          ( Data.ProtoLens.Encoding.Growing.append+                                              qs+                                              q+                                          )+                                      ploop qs'+                            in+                              ploop+                          )+                            mutable'values+                        )+                    loop x mutable'items mutable'tags y+                18 ->+                  do+                    !y <-+                      (Data.ProtoLens.Encoding.Bytes.<?>)+                        ( do+                            len <- Data.ProtoLens.Encoding.Bytes.getVarInt+                            Data.ProtoLens.Encoding.Bytes.getText+                              (Prelude.fromIntegral len)+                        )+                        "tags"+                    v <-+                      Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO+                        (Data.ProtoLens.Encoding.Growing.append mutable'tags y)+                    loop x mutable'items v mutable'values+                26 ->+                  do+                    !y <-+                      (Data.ProtoLens.Encoding.Bytes.<?>)+                        ( do+                            len <- Data.ProtoLens.Encoding.Bytes.getVarInt+                            Data.ProtoLens.Encoding.Bytes.isolate+                              (Prelude.fromIntegral len)+                              Data.ProtoLens.parseMessage+                        )+                        "items"+                    v <-+                      Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO+                        (Data.ProtoLens.Encoding.Growing.append mutable'items y)+                    loop x v mutable'tags mutable'values+                wire ->+                  do+                    !y <-+                      Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire+                        wire+                    loop+                      ( Lens.Family2.over+                          Data.ProtoLens.unknownFields+                          (\ !t -> (:) y t)+                          x+                      )+                      mutable'items+                      mutable'tags+                      mutable'values+    in+      (Data.ProtoLens.Encoding.Bytes.<?>)+        ( do+            mutable'items <-+              Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO+                Data.ProtoLens.Encoding.Growing.new+            mutable'tags <-+              Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO+                Data.ProtoLens.Encoding.Growing.new+            mutable'values <-+              Data.ProtoLens.Encoding.Parser.Unsafe.unsafeLiftIO+                Data.ProtoLens.Encoding.Growing.new+            loop+              Data.ProtoLens.defMessage+              mutable'items+              mutable'tags+              mutable'values+        )+        "WithRepeated"+  buildMessage =+    \_x ->+      (Data.Monoid.<>)+        ( let+            p = Lens.Family2.view (Data.ProtoLens.Field.field @"vec'values") _x+          in+            if Data.Vector.Generic.null p+              then+                Data.Monoid.mempty+              else+                (Data.Monoid.<>)+                  (Data.ProtoLens.Encoding.Bytes.putVarInt 10)+                  ( ( \bs ->+                        (Data.Monoid.<>)+                          ( Data.ProtoLens.Encoding.Bytes.putVarInt+                              (Prelude.fromIntegral (Data.ByteString.length bs))+                          )+                          (Data.ProtoLens.Encoding.Bytes.putBytes bs)+                    )+                      ( Data.ProtoLens.Encoding.Bytes.runBuilder+                          ( Data.ProtoLens.Encoding.Bytes.foldMapBuilder+                              ( (Prelude..)+                                  Data.ProtoLens.Encoding.Bytes.putVarInt+                                  Prelude.fromIntegral+                              )+                              p+                          )+                      )+                  )+        )+        ( (Data.Monoid.<>)+            ( Data.ProtoLens.Encoding.Bytes.foldMapBuilder+                ( \_v ->+                    (Data.Monoid.<>)+                      (Data.ProtoLens.Encoding.Bytes.putVarInt 18)+                      ( (Prelude..)+                          ( \bs ->+                              (Data.Monoid.<>)+                                ( Data.ProtoLens.Encoding.Bytes.putVarInt+                                    (Prelude.fromIntegral (Data.ByteString.length bs))+                                )+                                (Data.ProtoLens.Encoding.Bytes.putBytes bs)+                          )+                          Data.Text.Encoding.encodeUtf8+                          _v+                      )+                )+                (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'tags") _x)+            )+            ( (Data.Monoid.<>)+                ( Data.ProtoLens.Encoding.Bytes.foldMapBuilder+                    ( \_v ->+                        (Data.Monoid.<>)+                          (Data.ProtoLens.Encoding.Bytes.putVarInt 26)+                          ( (Prelude..)+                              ( \bs ->+                                  (Data.Monoid.<>)+                                    ( Data.ProtoLens.Encoding.Bytes.putVarInt+                                        (Prelude.fromIntegral (Data.ByteString.length bs))+                                    )+                                    (Data.ProtoLens.Encoding.Bytes.putBytes bs)+                              )+                              Data.ProtoLens.encodeMessage+                              _v+                          )+                    )+                    (Lens.Family2.view (Data.ProtoLens.Field.field @"vec'items") _x)+                )+                ( Data.ProtoLens.Encoding.Wire.buildFieldSet+                    (Lens.Family2.view Data.ProtoLens.unknownFields _x)+                )+            )+        )+++instance Control.DeepSeq.NFData WithRepeated where+  rnf =+    \x__ ->+      Control.DeepSeq.deepseq+        (_WithRepeated'_unknownFields x__)+        ( Control.DeepSeq.deepseq+            (_WithRepeated'values x__)+            ( Control.DeepSeq.deepseq+                (_WithRepeated'tags x__)+                (Control.DeepSeq.deepseq (_WithRepeated'items x__) ())+            )+        )+++packedFileDescriptor :: Data.ByteString.ByteString+packedFileDescriptor =+  "\n\+  \\vbench.proto\DC2\ENQbench\"C\n\+  \\ENQSmall\DC2\SO\n\+  \\STXid\CAN\SOH \SOH(\ETXR\STXid\DC2\DC2\n\+  \\EOTname\CAN\STX \SOH(\tR\EOTname\DC2\SYN\n\+  \\ACKactive\CAN\ETX \SOH(\bR\ACKactive\"\212\SOH\n\+  \\ACKMedium\DC2\DC4\n\+  \\ENQtitle\CAN\SOH \SOH(\tR\ENQtitle\DC2\DC4\n\+  \\ENQcount\CAN\STX \SOH(\ENQR\ENQcount\DC2\DC4\n\+  \\ENQscore\CAN\ETX \SOH(\SOHR\ENQscore\DC2\CAN\n\+  \\apayload\CAN\EOT \SOH(\fR\apayload\DC2\CAN\n\+  \\aenabled\CAN\ENQ \SOH(\bR\aenabled\DC2\FS\n\+  \\ttimestamp\CAN\ACK \SOH(\ETXR\ttimestamp\DC2 \n\+  \\vdescription\CAN\a \SOH(\tR\vdescription\DC2\DC4\n\+  \\ENQratio\CAN\b \SOH(\STXR\ENQratio\"V\n\+  \\n\+  \WithNested\DC2\SO\n\+  \\STXid\CAN\SOH \SOH(\ETXR\STXid\DC2\"\n\+  \\ENQinner\CAN\STX \SOH(\v2\f.bench.SmallR\ENQinner\DC2\DC4\n\+  \\ENQlabel\CAN\ETX \SOH(\tR\ENQlabel\"^\n\+  \\fWithRepeated\DC2\SYN\n\+  \\ACKvalues\CAN\SOH \ETX(\ENQR\ACKvalues\DC2\DC2\n\+  \\EOTtags\CAN\STX \ETX(\tR\EOTtags\DC2\"\n\+  \\ENQitems\CAN\ETX \ETX(\v2\f.bench.SmallR\ENQitemsJ\139\n\+  \\n\+  \\ACK\DC2\EOT\NUL\NUL#\SOH\n\+  \\b\n\+  \\SOH\f\DC2\ETX\NUL\NUL\DC2\n\+  \\b\n\+  \\SOH\STX\DC2\ETX\STX\NUL\SO\n\+  \8\n\+  \\STX\EOT\NUL\DC2\EOT\ENQ\NUL\t\SOH\SUB, Small message for tight-loop benchmarking.\n\+  \\n\+  \\n\+  \\n\+  \\ETX\EOT\NUL\SOH\DC2\ETX\ENQ\b\r\n\+  \\v\n\+  \\EOT\EOT\NUL\STX\NUL\DC2\ETX\ACK\STX\SI\n\+  \\f\n\+  \\ENQ\EOT\NUL\STX\NUL\ENQ\DC2\ETX\ACK\STX\a\n\+  \\f\n\+  \\ENQ\EOT\NUL\STX\NUL\SOH\DC2\ETX\ACK\b\n\+  \\n\+  \\f\n\+  \\ENQ\EOT\NUL\STX\NUL\ETX\DC2\ETX\ACK\r\SO\n\+  \\v\n\+  \\EOT\EOT\NUL\STX\SOH\DC2\ETX\a\STX\DC2\n\+  \\f\n\+  \\ENQ\EOT\NUL\STX\SOH\ENQ\DC2\ETX\a\STX\b\n\+  \\f\n\+  \\ENQ\EOT\NUL\STX\SOH\SOH\DC2\ETX\a\t\r\n\+  \\f\n\+  \\ENQ\EOT\NUL\STX\SOH\ETX\DC2\ETX\a\DLE\DC1\n\+  \\v\n\+  \\EOT\EOT\NUL\STX\STX\DC2\ETX\b\STX\DC2\n\+  \\f\n\+  \\ENQ\EOT\NUL\STX\STX\ENQ\DC2\ETX\b\STX\ACK\n\+  \\f\n\+  \\ENQ\EOT\NUL\STX\STX\SOH\DC2\ETX\b\a\r\n\+  \\f\n\+  \\ENQ\EOT\NUL\STX\STX\ETX\DC2\ETX\b\DLE\DC1\n\+  \5\n\+  \\STX\EOT\SOH\DC2\EOT\f\NUL\NAK\SOH\SUB) Medium message with more field variety.\n\+  \\n\+  \\n\+  \\n\+  \\ETX\EOT\SOH\SOH\DC2\ETX\f\b\SO\n\+  \\v\n\+  \\EOT\EOT\SOH\STX\NUL\DC2\ETX\r\STX\DC3\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\NUL\ENQ\DC2\ETX\r\STX\b\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\NUL\SOH\DC2\ETX\r\t\SO\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\NUL\ETX\DC2\ETX\r\DC1\DC2\n\+  \\v\n\+  \\EOT\EOT\SOH\STX\SOH\DC2\ETX\SO\STX\DC2\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\SOH\ENQ\DC2\ETX\SO\STX\a\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\SOH\SOH\DC2\ETX\SO\b\r\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\SOH\ETX\DC2\ETX\SO\DLE\DC1\n\+  \\v\n\+  \\EOT\EOT\SOH\STX\STX\DC2\ETX\SI\STX\DC3\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\STX\ENQ\DC2\ETX\SI\STX\b\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\STX\SOH\DC2\ETX\SI\t\SO\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\STX\ETX\DC2\ETX\SI\DC1\DC2\n\+  \\v\n\+  \\EOT\EOT\SOH\STX\ETX\DC2\ETX\DLE\STX\DC4\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\ETX\ENQ\DC2\ETX\DLE\STX\a\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\ETX\SOH\DC2\ETX\DLE\b\SI\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\ETX\ETX\DC2\ETX\DLE\DC2\DC3\n\+  \\v\n\+  \\EOT\EOT\SOH\STX\EOT\DC2\ETX\DC1\STX\DC3\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\EOT\ENQ\DC2\ETX\DC1\STX\ACK\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\EOT\SOH\DC2\ETX\DC1\a\SO\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\EOT\ETX\DC2\ETX\DC1\DC1\DC2\n\+  \\v\n\+  \\EOT\EOT\SOH\STX\ENQ\DC2\ETX\DC2\STX\SYN\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\ENQ\ENQ\DC2\ETX\DC2\STX\a\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\ENQ\SOH\DC2\ETX\DC2\b\DC1\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\ENQ\ETX\DC2\ETX\DC2\DC4\NAK\n\+  \\v\n\+  \\EOT\EOT\SOH\STX\ACK\DC2\ETX\DC3\STX\EM\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\ACK\ENQ\DC2\ETX\DC3\STX\b\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\ACK\SOH\DC2\ETX\DC3\t\DC4\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\ACK\ETX\DC2\ETX\DC3\ETB\CAN\n\+  \\v\n\+  \\EOT\EOT\SOH\STX\a\DC2\ETX\DC4\STX\DC2\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\a\ENQ\DC2\ETX\DC4\STX\a\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\a\SOH\DC2\ETX\DC4\b\r\n\+  \\f\n\+  \\ENQ\EOT\SOH\STX\a\ETX\DC2\ETX\DC4\DLE\DC1\n\+  \N\n\+  \\STX\EOT\STX\DC2\EOT\CAN\NUL\FS\SOH\SUBB Message with a submessage for nested encode/decode benchmarking.\n\+  \\n\+  \\n\+  \\n\+  \\ETX\EOT\STX\SOH\DC2\ETX\CAN\b\DC2\n\+  \\v\n\+  \\EOT\EOT\STX\STX\NUL\DC2\ETX\EM\STX\SI\n\+  \\f\n\+  \\ENQ\EOT\STX\STX\NUL\ENQ\DC2\ETX\EM\STX\a\n\+  \\f\n\+  \\ENQ\EOT\STX\STX\NUL\SOH\DC2\ETX\EM\b\n\+  \\n\+  \\f\n\+  \\ENQ\EOT\STX\STX\NUL\ETX\DC2\ETX\EM\r\SO\n\+  \\v\n\+  \\EOT\EOT\STX\STX\SOH\DC2\ETX\SUB\STX\DC2\n\+  \\f\n\+  \\ENQ\EOT\STX\STX\SOH\ACK\DC2\ETX\SUB\STX\a\n\+  \\f\n\+  \\ENQ\EOT\STX\STX\SOH\SOH\DC2\ETX\SUB\b\r\n\+  \\f\n\+  \\ENQ\EOT\STX\STX\SOH\ETX\DC2\ETX\SUB\DLE\DC1\n\+  \\v\n\+  \\EOT\EOT\STX\STX\STX\DC2\ETX\ESC\STX\DC3\n\+  \\f\n\+  \\ENQ\EOT\STX\STX\STX\ENQ\DC2\ETX\ESC\STX\b\n\+  \\f\n\+  \\ENQ\EOT\STX\STX\STX\SOH\DC2\ETX\ESC\t\SO\n\+  \\f\n\+  \\ENQ\EOT\STX\STX\STX\ETX\DC2\ETX\ESC\DC1\DC2\n\+  \+\n\+  \\STX\EOT\ETX\DC2\EOT\US\NUL#\SOH\SUB\US Message with repeated fields.\n\+  \\n\+  \\n\+  \\n\+  \\ETX\EOT\ETX\SOH\DC2\ETX\US\b\DC4\n\+  \\v\n\+  \\EOT\EOT\ETX\STX\NUL\DC2\ETX \STX\FS\n\+  \\f\n\+  \\ENQ\EOT\ETX\STX\NUL\EOT\DC2\ETX \STX\n\+  \\n\+  \\f\n\+  \\ENQ\EOT\ETX\STX\NUL\ENQ\DC2\ETX \v\DLE\n\+  \\f\n\+  \\ENQ\EOT\ETX\STX\NUL\SOH\DC2\ETX \DC1\ETB\n\+  \\f\n\+  \\ENQ\EOT\ETX\STX\NUL\ETX\DC2\ETX \SUB\ESC\n\+  \\v\n\+  \\EOT\EOT\ETX\STX\SOH\DC2\ETX!\STX\ESC\n\+  \\f\n\+  \\ENQ\EOT\ETX\STX\SOH\EOT\DC2\ETX!\STX\n\+  \\n\+  \\f\n\+  \\ENQ\EOT\ETX\STX\SOH\ENQ\DC2\ETX!\v\DC1\n\+  \\f\n\+  \\ENQ\EOT\ETX\STX\SOH\SOH\DC2\ETX!\DC2\SYN\n\+  \\f\n\+  \\ENQ\EOT\ETX\STX\SOH\ETX\DC2\ETX!\EM\SUB\n\+  \\v\n\+  \\EOT\EOT\ETX\STX\STX\DC2\ETX\"\STX\ESC\n\+  \\f\n\+  \\ENQ\EOT\ETX\STX\STX\EOT\DC2\ETX\"\STX\n\+  \\n\+  \\f\n\+  \\ENQ\EOT\ETX\STX\STX\ACK\DC2\ETX\"\v\DLE\n\+  \\f\n\+  \\ENQ\EOT\ETX\STX\STX\SOH\DC2\ETX\"\DC1\SYN\n\+  \\f\n\+  \\ENQ\EOT\ETX\STX\STX\ETX\DC2\ETX\"\EM\SUBb\ACKproto3"
bench/compare/gen/Proto/Bench_Fields.hs view
@@ -1,135 +1,211 @@ {- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}-{-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies, UndecidableInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternSynonyms, MagicHash, NoImplicitPrelude, DataKinds, BangPatterns, TypeApplications, OverloadedStrings, DerivingStrategies#-}-{-# OPTIONS_GHC -Wno-unused-imports#-}-{-# OPTIONS_GHC -Wno-duplicate-exports#-}-{-# OPTIONS_GHC -Wno-dodgy-exports#-}+{-# LANGUAGE BangPatterns #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE DataKinds #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE DerivingStrategies #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE FlexibleContexts #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE FlexibleInstances #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE MagicHash #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE MultiParamTypeClasses #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE OverloadedStrings #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE PatternSynonyms #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE ScopedTypeVariables #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE TypeApplications #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE TypeFamilies #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE UndecidableInstances #-}+{- This file was auto-generated from bench.proto by the proto-lens-protoc program. -}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wno-dodgy-exports #-}+{-# OPTIONS_GHC -Wno-duplicate-exports #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+ module Proto.Bench_Fields where-import qualified Data.ProtoLens.Runtime.Prelude as Prelude-import qualified Data.ProtoLens.Runtime.Data.Int as Data.Int-import qualified Data.ProtoLens.Runtime.Data.Monoid as Data.Monoid-import qualified Data.ProtoLens.Runtime.Data.Word as Data.Word-import qualified Data.ProtoLens.Runtime.Data.ProtoLens as Data.ProtoLens-import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Bytes as Data.ProtoLens.Encoding.Bytes-import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Growing as Data.ProtoLens.Encoding.Growing-import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Parser.Unsafe as Data.ProtoLens.Encoding.Parser.Unsafe-import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Wire as Data.ProtoLens.Encoding.Wire-import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Field as Data.ProtoLens.Field-import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Message.Enum as Data.ProtoLens.Message.Enum-import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Service.Types as Data.ProtoLens.Service.Types-import qualified Data.ProtoLens.Runtime.Lens.Family2 as Lens.Family2-import qualified Data.ProtoLens.Runtime.Lens.Family2.Unchecked as Lens.Family2.Unchecked-import qualified Data.ProtoLens.Runtime.Data.Text as Data.Text-import qualified Data.ProtoLens.Runtime.Data.Map as Data.Map-import qualified Data.ProtoLens.Runtime.Data.ByteString as Data.ByteString-import qualified Data.ProtoLens.Runtime.Data.ByteString.Char8 as Data.ByteString.Char8-import qualified Data.ProtoLens.Runtime.Data.Text.Encoding as Data.Text.Encoding-import qualified Data.ProtoLens.Runtime.Data.Vector as Data.Vector-import qualified Data.ProtoLens.Runtime.Data.Vector.Generic as Data.Vector.Generic-import qualified Data.ProtoLens.Runtime.Data.Vector.Unboxed as Data.Vector.Unboxed-import qualified Data.ProtoLens.Runtime.Text.Read as Text.Read-active ::-  forall f s a.-  (Prelude.Functor f, Data.ProtoLens.Field.HasField s "active" a) =>-  Lens.Family2.LensLike' f s a++import Data.ProtoLens.Runtime.Data.ByteString qualified as Data.ByteString+import Data.ProtoLens.Runtime.Data.ByteString.Char8 qualified as Data.ByteString.Char8+import Data.ProtoLens.Runtime.Data.Int qualified as Data.Int+import Data.ProtoLens.Runtime.Data.Map qualified as Data.Map+import Data.ProtoLens.Runtime.Data.Monoid qualified as Data.Monoid+import Data.ProtoLens.Runtime.Data.ProtoLens qualified as Data.ProtoLens+import Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Bytes qualified as Data.ProtoLens.Encoding.Bytes+import Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Growing qualified as Data.ProtoLens.Encoding.Growing+import Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Parser.Unsafe qualified as Data.ProtoLens.Encoding.Parser.Unsafe+import Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Wire qualified as Data.ProtoLens.Encoding.Wire+import Data.ProtoLens.Runtime.Data.ProtoLens.Field qualified as Data.ProtoLens.Field+import Data.ProtoLens.Runtime.Data.ProtoLens.Message.Enum qualified as Data.ProtoLens.Message.Enum+import Data.ProtoLens.Runtime.Data.ProtoLens.Service.Types qualified as Data.ProtoLens.Service.Types+import Data.ProtoLens.Runtime.Data.Text qualified as Data.Text+import Data.ProtoLens.Runtime.Data.Text.Encoding qualified as Data.Text.Encoding+import Data.ProtoLens.Runtime.Data.Vector qualified as Data.Vector+import Data.ProtoLens.Runtime.Data.Vector.Generic qualified as Data.Vector.Generic+import Data.ProtoLens.Runtime.Data.Vector.Unboxed qualified as Data.Vector.Unboxed+import Data.ProtoLens.Runtime.Data.Word qualified as Data.Word+import Data.ProtoLens.Runtime.Lens.Family2 qualified as Lens.Family2+import Data.ProtoLens.Runtime.Lens.Family2.Unchecked qualified as Lens.Family2.Unchecked+import Data.ProtoLens.Runtime.Prelude qualified as Prelude+import Data.ProtoLens.Runtime.Text.Read qualified as Text.Read+++active+  :: forall f s a+   . (Prelude.Functor f, Data.ProtoLens.Field.HasField s "active" a)+  => Lens.Family2.LensLike' f s a active = Data.ProtoLens.Field.field @"active"-count ::-  forall f s a.-  (Prelude.Functor f, Data.ProtoLens.Field.HasField s "count" a) =>-  Lens.Family2.LensLike' f s a+++count+  :: forall f s a+   . (Prelude.Functor f, Data.ProtoLens.Field.HasField s "count" a)+  => Lens.Family2.LensLike' f s a count = Data.ProtoLens.Field.field @"count"-description ::-  forall f s a.-  (Prelude.Functor f,-   Data.ProtoLens.Field.HasField s "description" a) =>-  Lens.Family2.LensLike' f s a+++description+  :: forall f s a+   . ( Prelude.Functor f+     , Data.ProtoLens.Field.HasField s "description" a+     )+  => Lens.Family2.LensLike' f s a description = Data.ProtoLens.Field.field @"description"-enabled ::-  forall f s a.-  (Prelude.Functor f, Data.ProtoLens.Field.HasField s "enabled" a) =>-  Lens.Family2.LensLike' f s a+++enabled+  :: forall f s a+   . (Prelude.Functor f, Data.ProtoLens.Field.HasField s "enabled" a)+  => Lens.Family2.LensLike' f s a enabled = Data.ProtoLens.Field.field @"enabled"-id ::-  forall f s a.-  (Prelude.Functor f, Data.ProtoLens.Field.HasField s "id" a) =>-  Lens.Family2.LensLike' f s a+++id+  :: forall f s a+   . (Prelude.Functor f, Data.ProtoLens.Field.HasField s "id" a)+  => Lens.Family2.LensLike' f s a id = Data.ProtoLens.Field.field @"id"-inner ::-  forall f s a.-  (Prelude.Functor f, Data.ProtoLens.Field.HasField s "inner" a) =>-  Lens.Family2.LensLike' f s a+++inner+  :: forall f s a+   . (Prelude.Functor f, Data.ProtoLens.Field.HasField s "inner" a)+  => Lens.Family2.LensLike' f s a inner = Data.ProtoLens.Field.field @"inner"-items ::-  forall f s a.-  (Prelude.Functor f, Data.ProtoLens.Field.HasField s "items" a) =>-  Lens.Family2.LensLike' f s a+++items+  :: forall f s a+   . (Prelude.Functor f, Data.ProtoLens.Field.HasField s "items" a)+  => Lens.Family2.LensLike' f s a items = Data.ProtoLens.Field.field @"items"-label ::-  forall f s a.-  (Prelude.Functor f, Data.ProtoLens.Field.HasField s "label" a) =>-  Lens.Family2.LensLike' f s a+++label+  :: forall f s a+   . (Prelude.Functor f, Data.ProtoLens.Field.HasField s "label" a)+  => Lens.Family2.LensLike' f s a label = Data.ProtoLens.Field.field @"label"-maybe'inner ::-  forall f s a.-  (Prelude.Functor f,-   Data.ProtoLens.Field.HasField s "maybe'inner" a) =>-  Lens.Family2.LensLike' f s a+++maybe'inner+  :: forall f s a+   . ( Prelude.Functor f+     , Data.ProtoLens.Field.HasField s "maybe'inner" a+     )+  => Lens.Family2.LensLike' f s a maybe'inner = Data.ProtoLens.Field.field @"maybe'inner"-name ::-  forall f s a.-  (Prelude.Functor f, Data.ProtoLens.Field.HasField s "name" a) =>-  Lens.Family2.LensLike' f s a+++name+  :: forall f s a+   . (Prelude.Functor f, Data.ProtoLens.Field.HasField s "name" a)+  => Lens.Family2.LensLike' f s a name = Data.ProtoLens.Field.field @"name"-payload ::-  forall f s a.-  (Prelude.Functor f, Data.ProtoLens.Field.HasField s "payload" a) =>-  Lens.Family2.LensLike' f s a+++payload+  :: forall f s a+   . (Prelude.Functor f, Data.ProtoLens.Field.HasField s "payload" a)+  => Lens.Family2.LensLike' f s a payload = Data.ProtoLens.Field.field @"payload"-ratio ::-  forall f s a.-  (Prelude.Functor f, Data.ProtoLens.Field.HasField s "ratio" a) =>-  Lens.Family2.LensLike' f s a+++ratio+  :: forall f s a+   . (Prelude.Functor f, Data.ProtoLens.Field.HasField s "ratio" a)+  => Lens.Family2.LensLike' f s a ratio = Data.ProtoLens.Field.field @"ratio"-score ::-  forall f s a.-  (Prelude.Functor f, Data.ProtoLens.Field.HasField s "score" a) =>-  Lens.Family2.LensLike' f s a+++score+  :: forall f s a+   . (Prelude.Functor f, Data.ProtoLens.Field.HasField s "score" a)+  => Lens.Family2.LensLike' f s a score = Data.ProtoLens.Field.field @"score"-tags ::-  forall f s a.-  (Prelude.Functor f, Data.ProtoLens.Field.HasField s "tags" a) =>-  Lens.Family2.LensLike' f s a+++tags+  :: forall f s a+   . (Prelude.Functor f, Data.ProtoLens.Field.HasField s "tags" a)+  => Lens.Family2.LensLike' f s a tags = Data.ProtoLens.Field.field @"tags"-timestamp ::-  forall f s a.-  (Prelude.Functor f,-   Data.ProtoLens.Field.HasField s "timestamp" a) =>-  Lens.Family2.LensLike' f s a+++timestamp+  :: forall f s a+   . ( Prelude.Functor f+     , Data.ProtoLens.Field.HasField s "timestamp" a+     )+  => Lens.Family2.LensLike' f s a timestamp = Data.ProtoLens.Field.field @"timestamp"-title ::-  forall f s a.-  (Prelude.Functor f, Data.ProtoLens.Field.HasField s "title" a) =>-  Lens.Family2.LensLike' f s a+++title+  :: forall f s a+   . (Prelude.Functor f, Data.ProtoLens.Field.HasField s "title" a)+  => Lens.Family2.LensLike' f s a title = Data.ProtoLens.Field.field @"title"-values ::-  forall f s a.-  (Prelude.Functor f, Data.ProtoLens.Field.HasField s "values" a) =>-  Lens.Family2.LensLike' f s a+++values+  :: forall f s a+   . (Prelude.Functor f, Data.ProtoLens.Field.HasField s "values" a)+  => Lens.Family2.LensLike' f s a values = Data.ProtoLens.Field.field @"values"-vec'items ::-  forall f s a.-  (Prelude.Functor f,-   Data.ProtoLens.Field.HasField s "vec'items" a) =>-  Lens.Family2.LensLike' f s a+++vec'items+  :: forall f s a+   . ( Prelude.Functor f+     , Data.ProtoLens.Field.HasField s "vec'items" a+     )+  => Lens.Family2.LensLike' f s a vec'items = Data.ProtoLens.Field.field @"vec'items"-vec'tags ::-  forall f s a.-  (Prelude.Functor f,-   Data.ProtoLens.Field.HasField s "vec'tags" a) =>-  Lens.Family2.LensLike' f s a+++vec'tags+  :: forall f s a+   . ( Prelude.Functor f+     , Data.ProtoLens.Field.HasField s "vec'tags" a+     )+  => Lens.Family2.LensLike' f s a vec'tags = Data.ProtoLens.Field.field @"vec'tags"-vec'values ::-  forall f s a.-  (Prelude.Functor f,-   Data.ProtoLens.Field.HasField s "vec'values" a) =>-  Lens.Family2.LensLike' f s a+++vec'values+  :: forall f s a+   . ( Prelude.Functor f+     , Data.ProtoLens.Field.HasField s "vec'values" a+     )+  => Lens.Family2.LensLike' f s a vec'values = Data.ProtoLens.Field.field @"vec'values"
data/proto/google/protobuf/any.proto view
@@ -5,8 +5,6 @@ option java_package = "com.google.protobuf"; option java_outer_classname = "AnyProto"; option go_package = "google.golang.org/protobuf/types/known/anypb";-option csharp_namespace = "Google.Protobuf.WellKnownTypes";-option objc_class_prefix = "GPB";  message Any {   string type_url = 1;
data/proto/google/protobuf/api.proto view
@@ -2,7 +2,6 @@  package google.protobuf; -import "google/protobuf/any.proto"; import "google/protobuf/source_context.proto";  option java_package = "com.google.protobuf";
− data/proto/google/protobuf/descriptor.proto 
@@ -1,1296 +0,0 @@-// Protocol Buffers - Google's data interchange format-// Copyright 2008 Google Inc.  All rights reserved.-// https://developers.google.com/protocol-buffers/-//-// Redistribution and use in source and binary forms, with or without-// modification, are permitted provided that the following conditions are-// met:-//-//     * Redistributions of source code must retain the above copyright-// notice, this list of conditions and the following disclaimer.-//     * Redistributions in binary form must reproduce the above-// copyright notice, this list of conditions and the following disclaimer-// in the documentation and/or other materials provided with the-// distribution.-//     * Neither the name of Google Inc. nor the names of its-// contributors may be used to endorse or promote products derived from-// this software without specific prior written permission.-//-// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-// "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-// LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-// A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-// OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-// SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-// LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-// DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-// THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-// (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-// OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.--// Author: kenton@google.com (Kenton Varda)-//  Based on original Protocol Buffers design by-//  Sanjay Ghemawat, Jeff Dean, and others.-//-// The messages in this file describe the definitions found in .proto files.-// A valid .proto file can be translated directly to a FileDescriptorProto-// without any other information (e.g. without reading its imports).--syntax = "proto2";--package google.protobuf;--option go_package = "google.golang.org/protobuf/types/descriptorpb";-option java_package = "com.google.protobuf";-option java_outer_classname = "DescriptorProtos";-option csharp_namespace = "Google.Protobuf.Reflection";-option objc_class_prefix = "GPB";-option cc_enable_arenas = true;--// descriptor.proto must be optimized for speed because reflection-based-// algorithms don't work during bootstrapping.-option optimize_for = SPEED;--// The protocol compiler can output a FileDescriptorSet containing the .proto-// files it parses.-message FileDescriptorSet {-  repeated FileDescriptorProto file = 1;-}--// The full set of known editions.-enum Edition {-  // A placeholder for an unknown edition value.-  EDITION_UNKNOWN = 0;--  // A placeholder edition for specifying default behaviors *before* a feature-  // was first introduced.  This is effectively an "infinite past".-  EDITION_LEGACY = 900;--  // Legacy syntax "editions".  These pre-date editions, but behave much like-  // distinct editions.  These can't be used to specify the edition of proto-  // files, but feature definitions must supply proto2/proto3 defaults for-  // backwards compatibility.-  EDITION_PROTO2 = 998;-  EDITION_PROTO3 = 999;--  // Editions that have been released.  The specific values are arbitrary and-  // should not be depended on, but they will always be time-ordered for easy-  // comparison.-  EDITION_2023 = 1000;-  EDITION_2024 = 1001;--  // Placeholder editions for testing feature resolution.  These should not be-  // used or relyed on outside of tests.-  EDITION_1_TEST_ONLY = 1;-  EDITION_2_TEST_ONLY = 2;-  EDITION_99997_TEST_ONLY = 99997;-  EDITION_99998_TEST_ONLY = 99998;-  EDITION_99999_TEST_ONLY = 99999;--  // Placeholder for specifying unbounded edition support.  This should only-  // ever be used by plugins that can expect to never require any changes to-  // support a new edition.-  EDITION_MAX = 0x7FFFFFFF;-}--// Describes a complete .proto file.-message FileDescriptorProto {-  optional string name = 1;     // file name, relative to root of source tree-  optional string package = 2;  // e.g. "foo", "foo.bar", etc.--  // Names of files imported by this file.-  repeated string dependency = 3;-  // Indexes of the public imported files in the dependency list above.-  repeated int32 public_dependency = 10;-  // Indexes of the weak imported files in the dependency list.-  // For Google-internal migration only. Do not use.-  repeated int32 weak_dependency = 11;--  // All top-level definitions in this file.-  repeated DescriptorProto message_type = 4;-  repeated EnumDescriptorProto enum_type = 5;-  repeated ServiceDescriptorProto service = 6;-  repeated FieldDescriptorProto extension = 7;--  optional FileOptions options = 8;--  // This field contains optional information about the original source code.-  // You may safely remove this entire field without harming runtime-  // functionality of the descriptors -- the information is needed only by-  // development tools.-  optional SourceCodeInfo source_code_info = 9;--  // The syntax of the proto file.-  // The supported values are "proto2", "proto3", and "editions".-  //-  // If `edition` is present, this value must be "editions".-  optional string syntax = 12;--  // The edition of the proto file.-  optional Edition edition = 14;-}--// Describes a message type.-message DescriptorProto {-  optional string name = 1;--  repeated FieldDescriptorProto field = 2;-  repeated FieldDescriptorProto extension = 6;--  repeated DescriptorProto nested_type = 3;-  repeated EnumDescriptorProto enum_type = 4;--  message ExtensionRange {-    optional int32 start = 1;  // Inclusive.-    optional int32 end = 2;    // Exclusive.--    optional ExtensionRangeOptions options = 3;-  }-  repeated ExtensionRange extension_range = 5;--  repeated OneofDescriptorProto oneof_decl = 8;--  optional MessageOptions options = 7;--  // Range of reserved tag numbers. Reserved tag numbers may not be used by-  // fields or extension ranges in the same message. Reserved ranges may-  // not overlap.-  message ReservedRange {-    optional int32 start = 1;  // Inclusive.-    optional int32 end = 2;    // Exclusive.-  }-  repeated ReservedRange reserved_range = 9;-  // Reserved field names, which may not be used by fields in the same message.-  // A given name may only be reserved once.-  repeated string reserved_name = 10;-}--message ExtensionRangeOptions {-  // The parser stores options it doesn't recognize here. See above.-  repeated UninterpretedOption uninterpreted_option = 999;--  message Declaration {-    // The extension number declared within the extension range.-    optional int32 number = 1;--    // The fully-qualified name of the extension field. There must be a leading-    // dot in front of the full name.-    optional string full_name = 2;--    // The fully-qualified type name of the extension field. Unlike-    // Metadata.type, Declaration.type must have a leading dot for messages-    // and enums.-    optional string type = 3;--    // If true, indicates that the number is reserved in the extension range,-    // and any extension field with the number will fail to compile. Set this-    // when a declared extension field is deleted.-    optional bool reserved = 5;--    // If true, indicates that the extension must be defined as repeated.-    // Otherwise the extension must be defined as optional.-    optional bool repeated = 6;--    reserved 4;  // removed is_repeated-  }--  // For external users: DO NOT USE. We are in the process of open sourcing-  // extension declaration and executing internal cleanups before it can be-  // used externally.-  repeated Declaration declaration = 2 [retention = RETENTION_SOURCE];--  // Any features defined in the specific edition.-  optional FeatureSet features = 50;--  // The verification state of the extension range.-  enum VerificationState {-    // All the extensions of the range must be declared.-    DECLARATION = 0;-    UNVERIFIED = 1;-  }--  // The verification state of the range.-  // TODO: flip the default to DECLARATION once all empty ranges-  // are marked as UNVERIFIED.-  optional VerificationState verification = 3-      [default = UNVERIFIED, retention = RETENTION_SOURCE];--  // Clients can define custom options in extensions of this message. See above.-  extensions 1000 to max;-}--// Describes a field within a message.-message FieldDescriptorProto {-  enum Type {-    // 0 is reserved for errors.-    // Order is weird for historical reasons.-    TYPE_DOUBLE = 1;-    TYPE_FLOAT = 2;-    // Not ZigZag encoded.  Negative numbers take 10 bytes.  Use TYPE_SINT64 if-    // negative values are likely.-    TYPE_INT64 = 3;-    TYPE_UINT64 = 4;-    // Not ZigZag encoded.  Negative numbers take 10 bytes.  Use TYPE_SINT32 if-    // negative values are likely.-    TYPE_INT32 = 5;-    TYPE_FIXED64 = 6;-    TYPE_FIXED32 = 7;-    TYPE_BOOL = 8;-    TYPE_STRING = 9;-    // Tag-delimited aggregate.-    // Group type is deprecated and not supported after google.protobuf. However, Proto3-    // implementations should still be able to parse the group wire format and-    // treat group fields as unknown fields.  In Editions, the group wire format-    // can be enabled via the `message_encoding` feature.-    TYPE_GROUP = 10;-    TYPE_MESSAGE = 11;  // Length-delimited aggregate.--    // New in version 2.-    TYPE_BYTES = 12;-    TYPE_UINT32 = 13;-    TYPE_ENUM = 14;-    TYPE_SFIXED32 = 15;-    TYPE_SFIXED64 = 16;-    TYPE_SINT32 = 17;  // Uses ZigZag encoding.-    TYPE_SINT64 = 18;  // Uses ZigZag encoding.-  }--  enum Label {-    // 0 is reserved for errors-    LABEL_OPTIONAL = 1;-    LABEL_REPEATED = 3;-    // The required label is only allowed in google.protobuf.  In proto3 and Editions-    // it's explicitly prohibited.  In Editions, the `field_presence` feature-    // can be used to get this behavior.-    LABEL_REQUIRED = 2;-  }--  optional string name = 1;-  optional int32 number = 3;-  optional Label label = 4;--  // If type_name is set, this need not be set.  If both this and type_name-  // are set, this must be one of TYPE_ENUM, TYPE_MESSAGE or TYPE_GROUP.-  optional Type type = 5;--  // For message and enum types, this is the name of the type.  If the name-  // starts with a '.', it is fully-qualified.  Otherwise, C++-like scoping-  // rules are used to find the type (i.e. first the nested types within this-  // message are searched, then within the parent, on up to the root-  // namespace).-  optional string type_name = 6;--  // For extensions, this is the name of the type being extended.  It is-  // resolved in the same manner as type_name.-  optional string extendee = 2;--  // For numeric types, contains the original text representation of the value.-  // For booleans, "true" or "false".-  // For strings, contains the default text contents (not escaped in any way).-  // For bytes, contains the C escaped value.  All bytes >= 128 are escaped.-  optional string default_value = 7;--  // If set, gives the index of a oneof in the containing type's oneof_decl-  // list.  This field is a member of that oneof.-  optional int32 oneof_index = 9;--  // JSON name of this field. The value is set by protocol compiler. If the-  // user has set a "json_name" option on this field, that option's value-  // will be used. Otherwise, it's deduced from the field's name by converting-  // it to camelCase.-  optional string json_name = 10;--  optional FieldOptions options = 8;--  // If true, this is a proto3 "optional". When a proto3 field is optional, it-  // tracks presence regardless of field type.-  //-  // When proto3_optional is true, this field must belong to a oneof to signal-  // to old proto3 clients that presence is tracked for this field. This oneof-  // is known as a "synthetic" oneof, and this field must be its sole member-  // (each proto3 optional field gets its own synthetic oneof). Synthetic oneofs-  // exist in the descriptor only, and do not generate any API. Synthetic oneofs-  // must be ordered after all "real" oneofs.-  //-  // For message fields, proto3_optional doesn't create any semantic change,-  // since non-repeated message fields always track presence. However it still-  // indicates the semantic detail of whether the user wrote "optional" or not.-  // This can be useful for round-tripping the .proto file. For consistency we-  // give message fields a synthetic oneof also, even though it is not required-  // to track presence. This is especially important because the parser can't-  // tell if a field is a message or an enum, so it must always create a-  // synthetic oneof.-  //-  // Proto2 optional fields do not set this flag, because they already indicate-  // optional with `LABEL_OPTIONAL`.-  optional bool proto3_optional = 17;-}--// Describes a oneof.-message OneofDescriptorProto {-  optional string name = 1;-  optional OneofOptions options = 2;-}--// Describes an enum type.-message EnumDescriptorProto {-  optional string name = 1;--  repeated EnumValueDescriptorProto value = 2;--  optional EnumOptions options = 3;--  // Range of reserved numeric values. Reserved values may not be used by-  // entries in the same enum. Reserved ranges may not overlap.-  //-  // Note that this is distinct from DescriptorProto.ReservedRange in that it-  // is inclusive such that it can appropriately represent the entire int32-  // domain.-  message EnumReservedRange {-    optional int32 start = 1;  // Inclusive.-    optional int32 end = 2;    // Inclusive.-  }--  // Range of reserved numeric values. Reserved numeric values may not be used-  // by enum values in the same enum declaration. Reserved ranges may not-  // overlap.-  repeated EnumReservedRange reserved_range = 4;--  // Reserved enum value names, which may not be reused. A given name may only-  // be reserved once.-  repeated string reserved_name = 5;-}--// Describes a value within an enum.-message EnumValueDescriptorProto {-  optional string name = 1;-  optional int32 number = 2;--  optional EnumValueOptions options = 3;-}--// Describes a service.-message ServiceDescriptorProto {-  optional string name = 1;-  repeated MethodDescriptorProto method = 2;--  optional ServiceOptions options = 3;-}--// Describes a method of a service.-message MethodDescriptorProto {-  optional string name = 1;--  // Input and output type names.  These are resolved in the same way as-  // FieldDescriptorProto.type_name, but must refer to a message type.-  optional string input_type = 2;-  optional string output_type = 3;--  optional MethodOptions options = 4;--  // Identifies if client streams multiple client messages-  optional bool client_streaming = 5 [default = false];-  // Identifies if server streams multiple server messages-  optional bool server_streaming = 6 [default = false];-}--// ===================================================================-// Options--// Each of the definitions above may have "options" attached.  These are-// just annotations which may cause code to be generated slightly differently-// or may contain hints for code that manipulates protocol messages.-//-// Clients may define custom options as extensions of the *Options messages.-// These extensions may not yet be known at parsing time, so the parser cannot-// store the values in them.  Instead it stores them in a field in the *Options-// message called uninterpreted_option. This field must have the same name-// across all *Options messages. We then use this field to populate the-// extensions when we build a descriptor, at which point all protos have been-// parsed and so all extensions are known.-//-// Extension numbers for custom options may be chosen as follows:-// * For options which will only be used within a single application or-//   organization, or for experimental options, use field numbers 50000-//   through 99999.  It is up to you to ensure that you do not use the-//   same number for multiple options.-// * For options which will be published and used publicly by multiple-//   independent entities, e-mail protobuf-global-extension-registry@google.com-//   to reserve extension numbers. Simply provide your project name (e.g.-//   Objective-C plugin) and your project website (if available) -- there's no-//   need to explain how you intend to use them. Usually you only need one-//   extension number. You can declare multiple options with only one extension-//   number by putting them in a sub-message. See the Custom Options section of-//   the docs for examples:-//   https://developers.google.com/protocol-buffers/docs/proto#options-//   If this turns out to be popular, a web service will be set up-//   to automatically assign option numbers.--message FileOptions {--  // Sets the Java package where classes generated from this .proto will be-  // placed.  By default, the proto package is used, but this is often-  // inappropriate because proto packages do not normally start with backwards-  // domain names.-  optional string java_package = 1;--  // Controls the name of the wrapper Java class generated for the .proto file.-  // That class will always contain the .proto file's getDescriptor() method as-  // well as any top-level extensions defined in the .proto file.-  // If java_multiple_files is disabled, then all the other classes from the-  // .proto file will be nested inside the single wrapper outer class.-  optional string java_outer_classname = 8;--  // If enabled, then the Java code generator will generate a separate .java-  // file for each top-level message, enum, and service defined in the .proto-  // file.  Thus, these types will *not* be nested inside the wrapper class-  // named by java_outer_classname.  However, the wrapper class will still be-  // generated to contain the file's getDescriptor() method as well as any-  // top-level extensions defined in the file.-  optional bool java_multiple_files = 10 [default = false];--  // This option does nothing.-  optional bool java_generate_equals_and_hash = 20 [deprecated=true];--  // A proto2 file can set this to true to opt in to UTF-8 checking for Java,-  // which will throw an exception if invalid UTF-8 is parsed from the wire or-  // assigned to a string field.-  //-  // TODO: clarify exactly what kinds of field types this option-  // applies to, and update these docs accordingly.-  //-  // Proto3 files already perform these checks. Setting the option explicitly to-  // false has no effect: it cannot be used to opt proto3 files out of UTF-8-  // checks.-  optional bool java_string_check_utf8 = 27 [default = false];--  // Generated classes can be optimized for speed or code size.-  enum OptimizeMode {-    SPEED = 1;         // Generate complete code for parsing, serialization,-                       // etc.-    CODE_SIZE = 2;     // Use ReflectionOps to implement these methods.-    LITE_RUNTIME = 3;  // Generate code using MessageLite and the lite runtime.-  }-  optional OptimizeMode optimize_for = 9 [default = SPEED];--  // Sets the Go package where structs generated from this .proto will be-  // placed. If omitted, the Go package will be derived from the following:-  //   - The basename of the package import path, if provided.-  //   - Otherwise, the package statement in the .proto file, if present.-  //   - Otherwise, the basename of the .proto file, without extension.-  optional string go_package = 11;--  // Should generic services be generated in each language?  "Generic" services-  // are not specific to any particular RPC system.  They are generated by the-  // main code generators in each language (without additional plugins).-  // Generic services were the only kind of service generation supported by-  // early versions of google.protobuf.-  //-  // Generic services are now considered deprecated in favor of using plugins-  // that generate code specific to your particular RPC system.  Therefore,-  // these default to false.  Old code which depends on generic services should-  // explicitly set them to true.-  optional bool cc_generic_services = 16 [default = false];-  optional bool java_generic_services = 17 [default = false];-  optional bool py_generic_services = 18 [default = false];-  reserved 42;  // removed php_generic_services-  reserved "php_generic_services";--  // Is this file deprecated?-  // Depending on the target platform, this can emit Deprecated annotations-  // for everything in the file, or it will be completely ignored; in the very-  // least, this is a formalization for deprecating files.-  optional bool deprecated = 23 [default = false];--  // Enables the use of arenas for the proto messages in this file. This applies-  // only to generated classes for C++.-  optional bool cc_enable_arenas = 31 [default = true];--  // Sets the objective c class prefix which is prepended to all objective c-  // generated classes from this .proto. There is no default.-  optional string objc_class_prefix = 36;--  // Namespace for generated classes; defaults to the package.-  optional string csharp_namespace = 37;--  // By default Swift generators will take the proto package and CamelCase it-  // replacing '.' with underscore and use that to prefix the types/symbols-  // defined. When this options is provided, they will use this value instead-  // to prefix the types/symbols defined.-  optional string swift_prefix = 39;--  // Sets the php class prefix which is prepended to all php generated classes-  // from this .proto. Default is empty.-  optional string php_class_prefix = 40;--  // Use this option to change the namespace of php generated classes. Default-  // is empty. When this option is empty, the package name will be used for-  // determining the namespace.-  optional string php_namespace = 41;--  // Use this option to change the namespace of php generated metadata classes.-  // Default is empty. When this option is empty, the proto file name will be-  // used for determining the namespace.-  optional string php_metadata_namespace = 44;--  // Use this option to change the package of ruby generated classes. Default-  // is empty. When this option is not set, the package name will be used for-  // determining the ruby package.-  optional string ruby_package = 45;--  // Any features defined in the specific edition.-  optional FeatureSet features = 50;--  // The parser stores options it doesn't recognize here.-  // See the documentation for the "Options" section above.-  repeated UninterpretedOption uninterpreted_option = 999;--  // Clients can define custom options in extensions of this message.-  // See the documentation for the "Options" section above.-  extensions 1000 to max;--  reserved 38;-}--message MessageOptions {-  // Set true to use the old proto1 MessageSet wire format for extensions.-  // This is provided for backwards-compatibility with the MessageSet wire-  // format.  You should not use this for any other reason:  It's less-  // efficient, has fewer features, and is more complicated.-  //-  // The message must be defined exactly as follows:-  //   message Foo {-  //     option message_set_wire_format = true;-  //     extensions 4 to max;-  //   }-  // Note that the message cannot have any defined fields; MessageSets only-  // have extensions.-  //-  // All extensions of your type must be singular messages; e.g. they cannot-  // be int32s, enums, or repeated messages.-  //-  // Because this is an option, the above two restrictions are not enforced by-  // the protocol compiler.-  optional bool message_set_wire_format = 1 [default = false];--  // Disables the generation of the standard "descriptor()" accessor, which can-  // conflict with a field of the same name.  This is meant to make migration-  // from proto1 easier; new code should avoid fields named "descriptor".-  optional bool no_standard_descriptor_accessor = 2 [default = false];--  // Is this message deprecated?-  // Depending on the target platform, this can emit Deprecated annotations-  // for the message, or it will be completely ignored; in the very least,-  // this is a formalization for deprecating messages.-  optional bool deprecated = 3 [default = false];--  reserved 4, 5, 6;--  // Whether the message is an automatically generated map entry type for the-  // maps field.-  //-  // For maps fields:-  //     map<KeyType, ValueType> map_field = 1;-  // The parsed descriptor looks like:-  //     message MapFieldEntry {-  //         option map_entry = true;-  //         optional KeyType key = 1;-  //         optional ValueType value = 2;-  //     }-  //     repeated MapFieldEntry map_field = 1;-  //-  // Implementations may choose not to generate the map_entry=true message, but-  // use a native map in the target language to hold the keys and values.-  // The reflection APIs in such implementations still need to work as-  // if the field is a repeated message field.-  //-  // NOTE: Do not set the option in .proto files. Always use the maps syntax-  // instead. The option should only be implicitly set by the proto compiler-  // parser.-  optional bool map_entry = 7;--  reserved 8;  // javalite_serializable-  reserved 9;  // javanano_as_lite--  // Enable the legacy handling of JSON field name conflicts.  This lowercases-  // and strips underscored from the fields before comparison in proto3 only.-  // The new behavior takes `json_name` into account and applies to proto2 as-  // well.-  //-  // This should only be used as a temporary measure against broken builds due-  // to the change in behavior for JSON field name conflicts.-  //-  // TODO This is legacy behavior we plan to remove once downstream-  // teams have had time to migrate.-  optional bool deprecated_legacy_json_field_conflicts = 11 [deprecated = true];--  // Any features defined in the specific edition.-  optional FeatureSet features = 12;--  // The parser stores options it doesn't recognize here. See above.-  repeated UninterpretedOption uninterpreted_option = 999;--  // Clients can define custom options in extensions of this message. See above.-  extensions 1000 to max;-}--message FieldOptions {-  // NOTE: ctype is deprecated. Use `features.(pb.cpp).string_type` instead.-  // The ctype option instructs the C++ code generator to use a different-  // representation of the field than it normally would.  See the specific-  // options below.  This option is only implemented to support use of-  // [ctype=CORD] and [ctype=STRING] (the default) on non-repeated fields of-  // type "bytes" in the open source release.-  // TODO: make ctype actually deprecated.-  optional CType ctype = 1 [/*deprecated = true,*/ default = STRING];-  enum CType {-    // Default mode.-    STRING = 0;--    // The option [ctype=CORD] may be applied to a non-repeated field of type-    // "bytes". It indicates that in C++, the data should be stored in a Cord-    // instead of a string.  For very large strings, this may reduce memory-    // fragmentation. It may also allow better performance when parsing from a-    // Cord, or when parsing with aliasing enabled, as the parsed Cord may then-    // alias the original buffer.-    CORD = 1;--    STRING_PIECE = 2;-  }-  // The packed option can be enabled for repeated primitive fields to enable-  // a more efficient representation on the wire. Rather than repeatedly-  // writing the tag and type for each element, the entire array is encoded as-  // a single length-delimited blob. In proto3, only explicit setting it to-  // false will avoid using packed encoding.  This option is prohibited in-  // Editions, but the `repeated_field_encoding` feature can be used to control-  // the behavior.-  optional bool packed = 2;--  // The jstype option determines the JavaScript type used for values of the-  // field.  The option is permitted only for 64 bit integral and fixed types-  // (int64, uint64, sint64, fixed64, sfixed64).  A field with jstype JS_STRING-  // is represented as JavaScript string, which avoids loss of precision that-  // can happen when a large value is converted to a floating point JavaScript.-  // Specifying JS_NUMBER for the jstype causes the generated JavaScript code to-  // use the JavaScript "number" type.  The behavior of the default option-  // JS_NORMAL is implementation dependent.-  //-  // This option is an enum to permit additional types to be added, e.g.-  // goog.math.Integer.-  optional JSType jstype = 6 [default = JS_NORMAL];-  enum JSType {-    // Use the default type.-    JS_NORMAL = 0;--    // Use JavaScript strings.-    JS_STRING = 1;--    // Use JavaScript numbers.-    JS_NUMBER = 2;-  }--  // Should this field be parsed lazily?  Lazy applies only to message-type-  // fields.  It means that when the outer message is initially parsed, the-  // inner message's contents will not be parsed but instead stored in encoded-  // form.  The inner message will actually be parsed when it is first accessed.-  //-  // This is only a hint.  Implementations are free to choose whether to use-  // eager or lazy parsing regardless of the value of this option.  However,-  // setting this option true suggests that the protocol author believes that-  // using lazy parsing on this field is worth the additional bookkeeping-  // overhead typically needed to implement it.-  //-  // This option does not affect the public interface of any generated code;-  // all method signatures remain the same.  Furthermore, thread-safety of the-  // interface is not affected by this option; const methods remain safe to-  // call from multiple threads concurrently, while non-const methods continue-  // to require exclusive access.-  //-  // Note that lazy message fields are still eagerly verified to check-  // ill-formed wireformat or missing required fields. Calling IsInitialized()-  // on the outer message would fail if the inner message has missing required-  // fields. Failed verification would result in parsing failure (except when-  // uninitialized messages are acceptable).-  optional bool lazy = 5 [default = false];--  // unverified_lazy does no correctness checks on the byte stream. This should-  // only be used where lazy with verification is prohibitive for performance-  // reasons.-  optional bool unverified_lazy = 15 [default = false];--  // Is this field deprecated?-  // Depending on the target platform, this can emit Deprecated annotations-  // for accessors, or it will be completely ignored; in the very least, this-  // is a formalization for deprecating fields.-  optional bool deprecated = 3 [default = false];--  // For Google-internal migration only. Do not use.-  optional bool weak = 10 [default = false];--  // Indicate that the field value should not be printed out when using debug-  // formats, e.g. when the field contains sensitive credentials.-  optional bool debug_redact = 16 [default = false];--  // If set to RETENTION_SOURCE, the option will be omitted from the binary.-  // Note: as of January 2023, support for this is in progress and does not yet-  // have an effect (b/264593489).-  enum OptionRetention {-    RETENTION_UNKNOWN = 0;-    RETENTION_RUNTIME = 1;-    RETENTION_SOURCE = 2;-  }--  optional OptionRetention retention = 17;--  // This indicates the types of entities that the field may apply to when used-  // as an option. If it is unset, then the field may be freely used as an-  // option on any kind of entity. Note: as of January 2023, support for this is-  // in progress and does not yet have an effect (b/264593489).-  enum OptionTargetType {-    TARGET_TYPE_UNKNOWN = 0;-    TARGET_TYPE_FILE = 1;-    TARGET_TYPE_EXTENSION_RANGE = 2;-    TARGET_TYPE_MESSAGE = 3;-    TARGET_TYPE_FIELD = 4;-    TARGET_TYPE_ONEOF = 5;-    TARGET_TYPE_ENUM = 6;-    TARGET_TYPE_ENUM_ENTRY = 7;-    TARGET_TYPE_SERVICE = 8;-    TARGET_TYPE_METHOD = 9;-  }--  repeated OptionTargetType targets = 19;--  message EditionDefault {-    optional Edition edition = 3;-    optional string value = 2;  // Textproto value.-  }-  repeated EditionDefault edition_defaults = 20;--  // Any features defined in the specific edition.-  optional FeatureSet features = 21;--  // Information about the support window of a feature.-  message FeatureSupport {-    // The edition that this feature was first available in.  In editions-    // earlier than this one, the default assigned to EDITION_LEGACY will be-    // used, and proto files will not be able to override it.-    optional Edition edition_introduced = 1;--    // The edition this feature becomes deprecated in.  Using this after this-    // edition may trigger warnings.-    optional Edition edition_deprecated = 2;--    // The deprecation warning text if this feature is used after the edition it-    // was marked deprecated in.-    optional string deprecation_warning = 3;--    // The edition this feature is no longer available in.  In editions after-    // this one, the last default assigned will be used, and proto files will-    // not be able to override it.-    optional Edition edition_removed = 4;-  }-  optional FeatureSupport feature_support = 22;--  // The parser stores options it doesn't recognize here. See above.-  repeated UninterpretedOption uninterpreted_option = 999;--  // Clients can define custom options in extensions of this message. See above.-  extensions 1000 to max;--  reserved 4;   // removed jtype-  reserved 18;  // reserve target, target_obsolete_do_not_use-}--message OneofOptions {-  // Any features defined in the specific edition.-  optional FeatureSet features = 1;--  // The parser stores options it doesn't recognize here. See above.-  repeated UninterpretedOption uninterpreted_option = 999;--  // Clients can define custom options in extensions of this message. See above.-  extensions 1000 to max;-}--message EnumOptions {--  // Set this option to true to allow mapping different tag names to the same-  // value.-  optional bool allow_alias = 2;--  // Is this enum deprecated?-  // Depending on the target platform, this can emit Deprecated annotations-  // for the enum, or it will be completely ignored; in the very least, this-  // is a formalization for deprecating enums.-  optional bool deprecated = 3 [default = false];--  reserved 5;  // javanano_as_lite--  // Enable the legacy handling of JSON field name conflicts.  This lowercases-  // and strips underscored from the fields before comparison in proto3 only.-  // The new behavior takes `json_name` into account and applies to proto2 as-  // well.-  // TODO Remove this legacy behavior once downstream teams have-  // had time to migrate.-  optional bool deprecated_legacy_json_field_conflicts = 6 [deprecated = true];--  // Any features defined in the specific edition.-  optional FeatureSet features = 7;--  // The parser stores options it doesn't recognize here. See above.-  repeated UninterpretedOption uninterpreted_option = 999;--  // Clients can define custom options in extensions of this message. See above.-  extensions 1000 to max;-}--message EnumValueOptions {-  // Is this enum value deprecated?-  // Depending on the target platform, this can emit Deprecated annotations-  // for the enum value, or it will be completely ignored; in the very least,-  // this is a formalization for deprecating enum values.-  optional bool deprecated = 1 [default = false];--  // Any features defined in the specific edition.-  optional FeatureSet features = 2;--  // Indicate that fields annotated with this enum value should not be printed-  // out when using debug formats, e.g. when the field contains sensitive-  // credentials.-  optional bool debug_redact = 3 [default = false];--  // Information about the support window of a feature value.-  optional FieldOptions.FeatureSupport feature_support = 4;--  // The parser stores options it doesn't recognize here. See above.-  repeated UninterpretedOption uninterpreted_option = 999;--  // Clients can define custom options in extensions of this message. See above.-  extensions 1000 to max;-}--message ServiceOptions {--  // Any features defined in the specific edition.-  optional FeatureSet features = 34;--  // Note:  Field numbers 1 through 32 are reserved for Google's internal RPC-  //   framework.  We apologize for hoarding these numbers to ourselves, but-  //   we were already using them long before we decided to release Protocol-  //   Buffers.--  // Is this service deprecated?-  // Depending on the target platform, this can emit Deprecated annotations-  // for the service, or it will be completely ignored; in the very least,-  // this is a formalization for deprecating services.-  optional bool deprecated = 33 [default = false];--  // The parser stores options it doesn't recognize here. See above.-  repeated UninterpretedOption uninterpreted_option = 999;--  // Clients can define custom options in extensions of this message. See above.-  extensions 1000 to max;-}--message MethodOptions {--  // Note:  Field numbers 1 through 32 are reserved for Google's internal RPC-  //   framework.  We apologize for hoarding these numbers to ourselves, but-  //   we were already using them long before we decided to release Protocol-  //   Buffers.--  // Is this method deprecated?-  // Depending on the target platform, this can emit Deprecated annotations-  // for the method, or it will be completely ignored; in the very least,-  // this is a formalization for deprecating methods.-  optional bool deprecated = 33 [default = false];--  // Is this method side-effect-free (or safe in HTTP parlance), or idempotent,-  // or neither? HTTP based RPC implementation may choose GET verb for safe-  // methods, and PUT verb for idempotent methods instead of the default POST.-  enum IdempotencyLevel {-    IDEMPOTENCY_UNKNOWN = 0;-    NO_SIDE_EFFECTS = 1;  // implies idempotent-    IDEMPOTENT = 2;       // idempotent, but may have side effects-  }-  optional IdempotencyLevel idempotency_level = 34-      [default = IDEMPOTENCY_UNKNOWN];--  // Any features defined in the specific edition.-  optional FeatureSet features = 35;--  // The parser stores options it doesn't recognize here. See above.-  repeated UninterpretedOption uninterpreted_option = 999;--  // Clients can define custom options in extensions of this message. See above.-  extensions 1000 to max;-}--// A message representing a option the parser does not recognize. This only-// appears in options protos created by the compiler::Parser class.-// DescriptorPool resolves these when building Descriptor objects. Therefore,-// options protos in descriptor objects (e.g. returned by Descriptor::options(),-// or produced by Descriptor::CopyTo()) will never have UninterpretedOptions-// in them.-message UninterpretedOption {-  // The name of the uninterpreted option.  Each string represents a segment in-  // a dot-separated name.  is_extension is true iff a segment represents an-  // extension (denoted with parentheses in options specs in .proto files).-  // E.g.,{ ["foo", false], ["bar.baz", true], ["moo", false] } represents-  // "foo.(bar.baz).moo".-  message NamePart {-    required string name_part = 1;-    required bool is_extension = 2;-  }-  repeated NamePart name = 2;--  // The value of the uninterpreted option, in whatever type the tokenizer-  // identified it as during parsing. Exactly one of these should be set.-  optional string identifier_value = 3;-  optional uint64 positive_int_value = 4;-  optional int64 negative_int_value = 5;-  optional double double_value = 6;-  optional bytes string_value = 7;-  optional string aggregate_value = 8;-}--// ===================================================================-// Features--// TODO Enums in C++ gencode (and potentially other languages) are-// not well scoped.  This means that each of the feature enums below can clash-// with each other.  The short names we've chosen maximize call-site-// readability, but leave us very open to this scenario.  A future feature will-// be designed and implemented to handle this, hopefully before we ever hit a-// conflict here.-message FeatureSet {-  enum FieldPresence {-    FIELD_PRESENCE_UNKNOWN = 0;-    EXPLICIT = 1;-    IMPLICIT = 2;-    LEGACY_REQUIRED = 3;-  }-  optional FieldPresence field_presence = 1 [-    retention = RETENTION_RUNTIME,-    targets = TARGET_TYPE_FIELD,-    targets = TARGET_TYPE_FILE,-    feature_support = {-      edition_introduced: EDITION_2023,-    },-    edition_defaults = { edition: EDITION_LEGACY, value: "EXPLICIT" },-    edition_defaults = { edition: EDITION_PROTO3, value: "IMPLICIT" },-    edition_defaults = { edition: EDITION_2023, value: "EXPLICIT" }-  ];--  enum EnumType {-    ENUM_TYPE_UNKNOWN = 0;-    OPEN = 1;-    CLOSED = 2;-  }-  optional EnumType enum_type = 2 [-    retention = RETENTION_RUNTIME,-    targets = TARGET_TYPE_ENUM,-    targets = TARGET_TYPE_FILE,-    feature_support = {-      edition_introduced: EDITION_2023,-    },-    edition_defaults = { edition: EDITION_LEGACY, value: "CLOSED" },-    edition_defaults = { edition: EDITION_PROTO3, value: "OPEN" }-  ];--  enum RepeatedFieldEncoding {-    REPEATED_FIELD_ENCODING_UNKNOWN = 0;-    PACKED = 1;-    EXPANDED = 2;-  }-  optional RepeatedFieldEncoding repeated_field_encoding = 3 [-    retention = RETENTION_RUNTIME,-    targets = TARGET_TYPE_FIELD,-    targets = TARGET_TYPE_FILE,-    feature_support = {-      edition_introduced: EDITION_2023,-    },-    edition_defaults = { edition: EDITION_LEGACY, value: "EXPANDED" },-    edition_defaults = { edition: EDITION_PROTO3, value: "PACKED" }-  ];--  enum Utf8Validation {-    UTF8_VALIDATION_UNKNOWN = 0;-    VERIFY = 2;-    NONE = 3;-    reserved 1;-  }-  optional Utf8Validation utf8_validation = 4 [-    retention = RETENTION_RUNTIME,-    targets = TARGET_TYPE_FIELD,-    targets = TARGET_TYPE_FILE,-    feature_support = {-      edition_introduced: EDITION_2023,-    },-    edition_defaults = { edition: EDITION_LEGACY, value: "NONE" },-    edition_defaults = { edition: EDITION_PROTO3, value: "VERIFY" }-  ];--  enum MessageEncoding {-    MESSAGE_ENCODING_UNKNOWN = 0;-    LENGTH_PREFIXED = 1;-    DELIMITED = 2;-  }-  optional MessageEncoding message_encoding = 5 [-    retention = RETENTION_RUNTIME,-    targets = TARGET_TYPE_FIELD,-    targets = TARGET_TYPE_FILE,-    feature_support = {-      edition_introduced: EDITION_2023,-    },-    edition_defaults = { edition: EDITION_LEGACY, value: "LENGTH_PREFIXED" }-  ];--  enum JsonFormat {-    JSON_FORMAT_UNKNOWN = 0;-    ALLOW = 1;-    LEGACY_BEST_EFFORT = 2;-  }-  optional JsonFormat json_format = 6 [-    retention = RETENTION_RUNTIME,-    targets = TARGET_TYPE_MESSAGE,-    targets = TARGET_TYPE_ENUM,-    targets = TARGET_TYPE_FILE,-    feature_support = {-      edition_introduced: EDITION_2023,-    },-    edition_defaults = { edition: EDITION_LEGACY, value: "LEGACY_BEST_EFFORT" },-    edition_defaults = { edition: EDITION_PROTO3, value: "ALLOW" }-  ];--  reserved 999;--  extensions 1000 to 9994 [-    declaration = {-      number: 1000,-      full_name: ".pb.cpp",-      type: ".pb.CppFeatures"-    },-    declaration = {-      number: 1001,-      full_name: ".pb.java",-      type: ".pb.JavaFeatures"-    },-    declaration = { number: 1002, full_name: ".pb.go", type: ".pb.GoFeatures" },-    declaration = {-      number: 9990,-      full_name: ".pb.proto1",-      type: ".pb.Proto1Features"-    }-  ];--  extensions 9995 to 9999;  // For internal testing-  extensions 10000;         // for https://github.com/bufbuild/protobuf-es-}--// A compiled specification for the defaults of a set of features.  These-// messages are generated from FeatureSet extensions and can be used to seed-// feature resolution. The resolution with this object becomes a simple search-// for the closest matching edition, followed by proto merges.-message FeatureSetDefaults {-  // A map from every known edition with a unique set of defaults to its-  // defaults. Not all editions may be contained here.  For a given edition,-  // the defaults at the closest matching edition ordered at or before it should-  // be used.  This field must be in strict ascending order by edition.-  message FeatureSetEditionDefault {-    optional Edition edition = 3;--    // Defaults of features that can be overridden in this edition.-    optional FeatureSet overridable_features = 4;--    // Defaults of features that can't be overridden in this edition.-    optional FeatureSet fixed_features = 5;--    reserved 1, 2;-    reserved "features";-  }-  repeated FeatureSetEditionDefault defaults = 1;--  // The minimum supported edition (inclusive) when this was constructed.-  // Editions before this will not have defaults.-  optional Edition minimum_edition = 4;--  // The maximum known edition (inclusive) when this was constructed. Editions-  // after this will not have reliable defaults.-  optional Edition maximum_edition = 5;-}--// ===================================================================-// Optional source code info--// Encapsulates information about the original source file from which a-// FileDescriptorProto was generated.-message SourceCodeInfo {-  // A Location identifies a piece of source code in a .proto file which-  // corresponds to a particular definition.  This information is intended-  // to be useful to IDEs, code indexers, documentation generators, and similar-  // tools.-  //-  // For example, say we have a file like:-  //   message Foo {-  //     optional string foo = 1;-  //   }-  // Let's look at just the field definition:-  //   optional string foo = 1;-  //   ^       ^^     ^^  ^  ^^^-  //   a       bc     de  f  ghi-  // We have the following locations:-  //   span   path               represents-  //   [a,i)  [ 4, 0, 2, 0 ]     The whole field definition.-  //   [a,b)  [ 4, 0, 2, 0, 4 ]  The label (optional).-  //   [c,d)  [ 4, 0, 2, 0, 5 ]  The type (string).-  //   [e,f)  [ 4, 0, 2, 0, 1 ]  The name (foo).-  //   [g,h)  [ 4, 0, 2, 0, 3 ]  The number (1).-  //-  // Notes:-  // - A location may refer to a repeated field itself (i.e. not to any-  //   particular index within it).  This is used whenever a set of elements are-  //   logically enclosed in a single code segment.  For example, an entire-  //   extend block (possibly containing multiple extension definitions) will-  //   have an outer location whose path refers to the "extensions" repeated-  //   field without an index.-  // - Multiple locations may have the same path.  This happens when a single-  //   logical declaration is spread out across multiple places.  The most-  //   obvious example is the "extend" block again -- there may be multiple-  //   extend blocks in the same scope, each of which will have the same path.-  // - A location's span is not always a subset of its parent's span.  For-  //   example, the "extendee" of an extension declaration appears at the-  //   beginning of the "extend" block and is shared by all extensions within-  //   the block.-  // - Just because a location's span is a subset of some other location's span-  //   does not mean that it is a descendant.  For example, a "group" defines-  //   both a type and a field in a single declaration.  Thus, the locations-  //   corresponding to the type and field and their components will overlap.-  // - Code which tries to interpret locations should probably be designed to-  //   ignore those that it doesn't understand, as more types of locations could-  //   be recorded in the future.-  repeated Location location = 1;-  message Location {-    // Identifies which part of the FileDescriptorProto was defined at this-    // location.-    //-    // Each element is a field number or an index.  They form a path from-    // the root FileDescriptorProto to the place where the definition appears.-    // For example, this path:-    //   [ 4, 3, 2, 7, 1 ]-    // refers to:-    //   file.message_type(3)  // 4, 3-    //       .field(7)         // 2, 7-    //       .name()           // 1-    // This is because FileDescriptorProto.message_type has field number 4:-    //   repeated DescriptorProto message_type = 4;-    // and DescriptorProto.field has field number 2:-    //   repeated FieldDescriptorProto field = 2;-    // and FieldDescriptorProto.name has field number 1:-    //   optional string name = 1;-    //-    // Thus, the above path gives the location of a field name.  If we removed-    // the last element:-    //   [ 4, 3, 2, 7 ]-    // this path refers to the whole field declaration (from the beginning-    // of the label to the terminating semicolon).-    repeated int32 path = 1 [packed = true];--    // Always has exactly three or four elements: start line, start column,-    // end line (optional, otherwise assumed same as start line), end column.-    // These are packed into a single field for efficiency.  Note that line-    // and column numbers are zero-based -- typically you will want to add-    // 1 to each before displaying to a user.-    repeated int32 span = 2 [packed = true];--    // If this SourceCodeInfo represents a complete declaration, these are any-    // comments appearing before and after the declaration which appear to be-    // attached to the declaration.-    //-    // A series of line comments appearing on consecutive lines, with no other-    // tokens appearing on those lines, will be treated as a single comment.-    //-    // leading_detached_comments will keep paragraphs of comments that appear-    // before (but not connected to) the current element. Each paragraph,-    // separated by empty lines, will be one comment element in the repeated-    // field.-    //-    // Only the comment content is provided; comment markers (e.g. //) are-    // stripped out.  For block comments, leading whitespace and an asterisk-    // will be stripped from the beginning of each line other than the first.-    // Newlines are included in the output.-    //-    // Examples:-    //-    //   optional int32 foo = 1;  // Comment attached to foo.-    //   // Comment attached to bar.-    //   optional int32 bar = 2;-    //-    //   optional string baz = 3;-    //   // Comment attached to baz.-    //   // Another line attached to baz.-    //-    //   // Comment attached to moo.-    //   //-    //   // Another line attached to moo.-    //   optional double moo = 4;-    //-    //   // Detached comment for corge. This is not leading or trailing comments-    //   // to moo or corge because there are blank lines separating it from-    //   // both.-    //-    //   // Detached comment for corge paragraph 2.-    //-    //   optional string corge = 5;-    //   /* Block comment attached-    //    * to corge.  Leading asterisks-    //    * will be removed. */-    //   /* Block comment attached to-    //    * grault. */-    //   optional int32 grault = 6;-    //-    //   // ignored detached comments.-    optional string leading_comments = 3;-    optional string trailing_comments = 4;-    repeated string leading_detached_comments = 6;-  }-}--// Describes the relationship between generated code and its original source-// file. A GeneratedCodeInfo message is associated with only one generated-// source file, but may contain references to different source .proto files.-message GeneratedCodeInfo {-  // An Annotation connects some span of text in generated code to an element-  // of its generating .proto file.-  repeated Annotation annotation = 1;-  message Annotation {-    // Identifies the element in the original source .proto file. This field-    // is formatted the same as SourceCodeInfo.Location.path.-    repeated int32 path = 1 [packed = true];--    // Identifies the filesystem path to the original source .proto.-    optional string source_file = 2;--    // Identifies the starting offset in bytes in the generated code-    // that relates to the identified object.-    optional int32 begin = 3;--    // Identifies the ending offset in bytes in the generated code that-    // relates to the identified object. The end offset should be one past-    // the last relevant byte (so the length of the text = end - begin).-    optional int32 end = 4;--    // Represents the identified object's effect on the element in the original-    // .proto file.-    enum Semantic {-      // There is no effect or the effect is indescribable.-      NONE = 0;-      // The element is set or otherwise mutated.-      SET = 1;-      // An alias to the element is returned.-      ALIAS = 2;-    }-    optional Semantic semantic = 5;-  }-}
data/proto/google/protobuf/duration.proto view
@@ -5,8 +5,6 @@ option java_package = "com.google.protobuf"; option java_outer_classname = "DurationProto"; option go_package = "google.golang.org/protobuf/types/known/durationpb";-option csharp_namespace = "Google.Protobuf.WellKnownTypes";-option objc_class_prefix = "GPB";  message Duration {   int64 seconds = 1;
data/proto/google/protobuf/empty.proto view
@@ -5,8 +5,6 @@ option java_package = "com.google.protobuf"; option java_outer_classname = "EmptyProto"; option go_package = "google.golang.org/protobuf/types/known/emptypb";-option csharp_namespace = "Google.Protobuf.WellKnownTypes";-option objc_class_prefix = "GPB";  message Empty { }
data/proto/google/protobuf/field_mask.proto view
@@ -5,8 +5,6 @@ option java_package = "com.google.protobuf"; option java_outer_classname = "FieldMaskProto"; option go_package = "google.golang.org/protobuf/types/known/fieldmaskpb";-option csharp_namespace = "Google.Protobuf.WellKnownTypes";-option objc_class_prefix = "GPB";  message FieldMask {   repeated string paths = 1;
data/proto/google/protobuf/source_context.proto view
@@ -5,8 +5,6 @@ option java_package = "com.google.protobuf"; option java_outer_classname = "SourceContextProto"; option go_package = "google.golang.org/protobuf/types/known/sourcecontextpb";-option csharp_namespace = "Google.Protobuf.WellKnownTypes";-option objc_class_prefix = "GPB";  message SourceContext {   string file_name = 1;
data/proto/google/protobuf/struct.proto view
@@ -5,8 +5,6 @@ option java_package = "com.google.protobuf"; option java_outer_classname = "StructProto"; option go_package = "google.golang.org/protobuf/types/known/structpb";-option csharp_namespace = "Google.Protobuf.WellKnownTypes";-option objc_class_prefix = "GPB";  message Struct {   map<string, Value> fields = 1;
data/proto/google/protobuf/timestamp.proto view
@@ -4,11 +4,7 @@  option java_package = "com.google.protobuf"; option java_outer_classname = "TimestampProto";-option java_multiple_files = true; option go_package = "google.golang.org/protobuf/types/known/timestamppb";-option csharp_namespace = "Google.Protobuf.WellKnownTypes";-option objc_class_prefix = "GPB";-option cc_enable_arenas = true;  message Timestamp {   int64 seconds = 1;
data/proto/google/protobuf/wrappers.proto view
@@ -5,8 +5,6 @@ option java_package = "com.google.protobuf"; option java_outer_classname = "WrappersProto"; option go_package = "google.golang.org/protobuf/types/known/wrapperspb";-option csharp_namespace = "Google.Protobuf.WellKnownTypes";-option objc_class_prefix = "GPB";  message DoubleValue {   double value = 1;
protoc-plugin/Main.hs view
@@ -5,13 +5,11 @@ module Main where  import Data.Map.Strict qualified as Map-import Data.Maybe (fromMaybe) import Data.Text qualified as T import Data.Vector qualified as V import Proto.CodeGen import Proto.Google.Protobuf.Compiler.Plugin-import Proto.Google.Protobuf.Compiler.Plugin.Util (pluginMain)-import Proto.Google.Protobuf.Reflection.Descriptor (FileDescriptorProto (..))+import Proto.Google.Protobuf.Descriptor import Proto.IDL.Descriptor (fileDescriptorToAST) import Proto.IDL.Parser.Resolver (ResolvedProto (..)) @@ -22,16 +20,16 @@  handleRequest :: CodeGeneratorRequest -> IO CodeGeneratorResponse handleRequest req = do-  let requestedFiles = V.toList (codeGeneratorRequestFileToGenerate req)-      allProtos = V.toList (codeGeneratorRequestProtoFile req)-      opts = parsePluginOpts (fromMaybe "" (codeGeneratorRequestParameter req))-  let resolvedPairs = fmap fdpToResolved allProtos+  let requestedFiles = V.toList (cgrFileToGenerate req)+      allProtos = V.toList (cgrProtoFile req)+      opts = parsePluginOpts (cgrParameter req)+      resolvedPairs = fmap fdpToResolved allProtos       typeReg = buildTypeRegistry opts resolvedPairs-      outputFiles = concatMap (generateForFile opts typeReg requestedFiles) allProtos+      outputFiles = concatMap (generateForFile opts typeReg requestedFiles allProtos) allProtos   pure     defaultCodeGeneratorResponse-      { codeGeneratorResponseFile = V.fromList outputFiles-      , codeGeneratorResponseSupportedFeatures = Just 1+      { cgrsFile = V.fromList outputFiles+      , cgrsSupportedFeatures = 1       }  @@ -41,7 +39,7 @@  fdpToResolved :: FileDescriptorProto -> (FilePath, ResolvedProto) fdpToResolved fdp =-  let path = T.unpack (fromMaybe "" (fileDescriptorProtoName fdp))+  let path = T.unpack (fdpName fdp)       pf = fileDescriptorToAST fdp   in ( path      , ResolvedProto {rpFile = pf, rpPath = path, rpImports = Map.empty}@@ -52,20 +50,16 @@   :: GenerateOpts   -> TypeRegistry   -> [T.Text]+  -> [FileDescriptorProto]   -> FileDescriptorProto-  -> [CodeGeneratorResponse'File]-generateForFile opts reg requestedFiles fdp =-  if fromMaybe "" (fileDescriptorProtoName fdp) `elem` requestedFiles+  -> [CodeGeneratorResponseFile]+generateForFile opts reg requestedFiles _allFdps fdp =+  if fdpName fdp `elem` requestedFiles     then-      let filePath = T.unpack (fromMaybe "" (fileDescriptorProtoName fdp))+      let filePath = T.unpack (fdpName fdp)           pf = fileDescriptorToAST fdp           moduleName = moduleNameForProto opts filePath pf           outputPath = T.replace "." "/" moduleName <> ".hs"           content = generateModuleText opts reg filePath pf-      in-        [ defaultCodeGeneratorResponse'File-            { codeGeneratorResponseFileName = Just outputPath-            , codeGeneratorResponseFileContent = Just content-            }-        ]+      in [CodeGeneratorResponseFile outputPath content]     else []
− python-interop/Main.hs 
@@ -1,529 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TemplateHaskell #-}--{- | wireform-proto ↔ Python google-protobuf interop test.--Run after installing google-protobuf in your Python environment:--  pip install protobuf-  cabal run wireform-proto:wireform-proto-python-interop--Skipped automatically when @python3@ is not in PATH or @google-protobuf@-is not installed.--What is tested:--  1. Haskell encodes a message → Python decodes (google-protobuf) and-     re-encodes → Haskell compares bytes.  Verifies the wire format is-     accepted by the official implementation.--  2. Python encodes a message from a JSON field spec → Haskell decodes →-     Haskell checks field values.  Verifies Haskell can consume bytes-     produced by the official implementation.--Both directions are exercised for: scalar fields, enum, nested-submessage, repeated, map, optional presence, and all numeric kinds.--}-module Main where--import Control.Exception (SomeException, try)-import Data.Aeson ((.=))-import Data.Aeson qualified as A-import Data.Aeson.Types qualified as AT-import Data.ByteString (ByteString)-import Data.ByteString qualified as BS-import Data.ByteString.Base64 qualified as B64-import Data.ByteString.Lazy qualified as BL-import Data.IORef-import Data.Map.Strict qualified as Map-import Data.Text (Text)-import Data.Text qualified as T-import Data.Text.Encoding qualified as TE-import Data.Vector qualified as V-import System.Directory (doesFileExist)-import System.Exit (ExitCode (..), exitFailure, exitSuccess)-import System.IO-import System.Process--import Data.Reflection (Given (..))-import Proto (decodeMessage)-import Proto (encodeMessage)-import Proto.IDL.Descriptor (serializeFileDescriptor)-import Proto.IDL.Parser (parseProtoFile)-import Proto.Internal.JSON.Extension (ExtensionRegistry, emptyExtensionRegistry)-import Proto.TH.QQ (proto)----- Satisfy the Given ExtensionRegistry constraint used by the--- ToJSON / FromJSON instances generated by [proto|...|].--- An empty registry is correct for proto3 messages which have no extensions.-instance Given ExtensionRegistry where-  given = emptyExtensionRegistry----- ------------------------------------------------------------------------------ Generated types (inline quasi-quoter so no file path is needed at runtime)--- -----------------------------------------------------------------------------[proto|-  syntax = "proto3";-  package test.interop;--  enum Priority {-    PRIORITY_UNSPECIFIED = 0;-    PRIORITY_LOW         = 1;-    PRIORITY_HIGH        = 2;-  }--  message Address {-    string street  = 1;-    string city    = 2;-    string country = 3;-  }--  message Person {-    string   name     = 1;-    int32    age      = 2;-    bool     active   = 3;-    double   score    = 4;-    bytes    payload  = 5;-    Priority priority = 6;-    Address  address  = 7;-    repeated string tags    = 8;-    map<string, int32> ratings = 9;-    optional string nickname   = 10;-  }--  message NumberKinds {-    int32    i32  = 1;-    int64    i64  = 2;-    uint32   u32  = 3;-    uint64   u64  = 4;-    sint32   s32  = 5;-    sint64   s64  = 6;-    float    f32  = 7;-    double   f64  = 8;-    fixed32  fx32 = 9;-    fixed64  fx64 = 10;-    sfixed32 sf32 = 11;-    sfixed64 sf64 = 12;-  }-|]----- ------------------------------------------------------------------------------ Protocol helpers--- -----------------------------------------------------------------------------sendJSON :: Handle -> A.Value -> IO ()-sendJSON h v = do-  BS.hPut h (BL.toStrict (A.encode v))-  BS.hPut h "\n"-  hFlush h---recvJSON :: Handle -> IO (Either String A.Value)-recvJSON h = do-  line <- hGetLine h-  pure (A.eitherDecodeStrict (TE.encodeUtf8 (T.pack line)))---b64Encode :: ByteString -> Text-b64Encode = TE.decodeUtf8 . B64.encode---b64Decode :: Text -> Either String ByteString-b64Decode t = case B64.decode (TE.encodeUtf8 t) of-  Left e -> Left (show e)-  Right b -> Right b----- | Parse the 'status', optional 'data', and optional 'message' fields from--- a JSON response object. All other shapes are an error.-parseResp :: A.Value -> Either String (Text, Maybe Text, Maybe Text)-parseResp = AT.parseEither $-  A.withObject "response" $ \o -> do-    status <- o A..:  "status"-    dat    <- o A..:? "data"-    msg    <- o A..:? "message"-    pure (status, dat, msg)----- ------------------------------------------------------------------------------ Driver lifecycle--- -----------------------------------------------------------------------------data PythonDriver = PythonDriver-  { pdIn :: Handle-  , pdOut :: Handle-  }---initDriver :: FilePath -> IO PythonDriver-initDriver driverPath = do-  (Just hin, Just hout, _, _) <--    createProcess-      (proc "python3" [driverPath])-        { std_in = CreatePipe-        , std_out = CreatePipe-        , std_err = Inherit-        }-  hSetBuffering hin LineBuffering-  hSetBuffering hout LineBuffering-  pure (PythonDriver hin hout)----- | Send the FileDescriptorProto so Python can register the message types.-initSchema :: PythonDriver -> IO ()-initSchema pd = do-  let protoSrc =-        T.unlines-          [ "syntax = \"proto3\";"-          , "package test.interop;"-          , "enum Priority { PRIORITY_UNSPECIFIED = 0; PRIORITY_LOW = 1; PRIORITY_HIGH = 2; }"-          , "message Address { string street = 1; string city = 2; string country = 3; }"-          , "message Person {"-          , "  string name = 1; int32 age = 2; bool active = 3; double score = 4;"-          , "  bytes payload = 5; Priority priority = 6; Address address = 7;"-          , "  repeated string tags = 8; map<string,int32> ratings = 9;"-          , "  optional string nickname = 10;"-          , "}"-          , "message NumberKinds {"-          , "  int32 i32 = 1; int64 i64 = 2; uint32 u32 = 3; uint64 u64 = 4;"-          , "  sint32 s32 = 5; sint64 s64 = 6; float f32 = 7; double f64 = 8;"-          , "  fixed32 fx32 = 9; fixed64 fx64 = 10; sfixed32 sf32 = 11; sfixed64 sf64 = 12;"-          , "}"-          ]-  case parseProtoFile "interop_fixture.proto" protoSrc of-    Left e -> fail ("initSchema: parse failed: " <> show e)-    Right pf -> do-      let schemaBytes = serializeFileDescriptor "interop_fixture.proto" pf-      sendJSON (pdIn pd) $-        A.object ["type" .= ("init" :: Text), "schema" .= b64Encode schemaBytes]-      resp <- recvJSON (pdOut pd)-      case resp >>= parseResp of-        Right ("ready", _, _) -> pure ()-        Right ("error", _, Just msg) -> fail ("initSchema: Python error: " <> T.unpack msg)-        Right (other, _, _) -> fail ("initSchema: unexpected status: " <> T.unpack other)-        Left e -> fail ("initSchema: parse error: " <> e)----- ------------------------------------------------------------------------------ Test harness--- -----------------------------------------------------------------------------data Result = Pass | Fail String deriving (Eq)---type Test = PythonDriver -> IO Result---runTest :: String -> Test -> PythonDriver -> IORef Int -> IORef Int -> IO ()-runTest name test pd passRef failRef = do-  result <- try @SomeException (test pd)-  case result of-    Left e -> do-      modifyIORef' failRef (+1)-      putStrLn $ "  FAIL  " <> name-      putStrLn $ "        exception: " <> show e-    Right (Fail msg) -> do-      modifyIORef' failRef (+1)-      putStrLn $ "  FAIL  " <> name-      putStrLn $ "        " <> msg-    Right Pass -> do-      modifyIORef' passRef (+1)-      putStrLn $ "  OK    " <> name----- | Send bytes from Haskell, have Python decode and re-encode, then--- decode the Python output in Haskell and check field values.--- Comparing raw bytes is wrong for map fields since entry ordering--- is not guaranteed by the wire format.-h2p-  :: Text-  -> ByteString-  -> (ByteString -> Either String ())-  -- ^ Check the Python-re-encoded bytes by decoding in Haskell.-  -> PythonDriver-  -> IO Result-h2p msgType hsBytes check pd = do-  sendJSON (pdIn pd) $-    A.object-      [ "type" .= ("h2p" :: Text)-      , "msg" .= msgType-      , "data" .= b64Encode hsBytes-      ]-  resp <- recvJSON (pdOut pd)-  case resp >>= parseResp of-    Right ("ok", Just pyB64, _) ->-      case b64Decode pyB64 of-        Left e -> pure (Fail ("base64 decode: " <> e))-        Right pyBytes -> case check pyBytes of-          Left e -> pure (Fail e)-          Right () -> pure Pass-    Right ("error", _, Just msg) -> pure (Fail ("Python error: " <> T.unpack msg))-    Right (other, _, _) -> pure (Fail ("unexpected status: " <> T.unpack other))-    Left e -> pure (Fail ("response parse error: " <> e))----- | Have Python encode from a field spec, decode in Haskell, check fields.-p2h :: Text -> A.Value -> (ByteString -> Either String ()) -> PythonDriver -> IO Result-p2h msgType fields check pd = do-  sendJSON (pdIn pd) $-    A.object-      [ "type" .= ("p2h" :: Text)-      , "msg" .= msgType-      , "fields" .= fields-      ]-  resp <- recvJSON (pdOut pd)-  case resp >>= parseResp of-    Right ("ok", Just pyB64, _) ->-      case b64Decode pyB64 of-        Left e -> pure (Fail ("base64 decode: " <> e))-        Right pyBytes -> case check pyBytes of-          Left e -> pure (Fail e)-          Right () -> pure Pass-    Right ("error", _, Just msg) -> pure (Fail ("Python error: " <> T.unpack msg))-    Right (other, _, _) -> pure (Fail ("unexpected status: " <> T.unpack other))-    Left e -> pure (Fail ("response parse error: " <> e))----- ------------------------------------------------------------------------------ Test cases--- ------------------------------------------------------------------------------- | Bidirectional test: Haskell encodes, Python re-encodes (bytes must match),--- then Python encodes from the same spec and Haskell decodes + checks.-testPerson :: Test-testPerson pd = do-  let hs =-        defaultPerson-          { personName = "Alice"-          , personAge = 30-          , personActive = True-          , personScore = 3.14-          , personPayload = "\x00\x01\x02\x03"-          , personPriority = Priority'PriorityHigh-          , personAddress =-              Just-                defaultAddress-                  { addressStreet = "123 Main St"-                  , addressCity = "Springfield"-                  , addressCountry = "US"-                  }-          , personTags = V.fromList ["haskell", "protobuf", "interop"]-          , personRatings = Map.fromList [("speed", 9), ("clarity", 8)]-          , personNickname = Just "Al"-          }-      hsBytes = encodeMessage hs-      fields =-        A.object-          [ "name" .= ("Alice" :: Text)-          , "age" .= (30 :: Int)-          , "active" .= True-          , "score" .= (3.14 :: Double)-          , "payload" .= A.object ["__bytes__" .= ("AAECAw==" :: Text)]-          , "priority" .= (2 :: Int) -- PRIORITY_HIGH-          , "address" .= A.object-              [ "street" .= ("123 Main St" :: Text)-              , "city" .= ("Springfield" :: Text)-              , "country" .= ("US" :: Text)-              ]-          , "tags" .= (["haskell", "protobuf", "interop"] :: [Text])-          , "ratings" .= A.object ["speed" .= (9 :: Int), "clarity" .= (8 :: Int)]-          , "nickname" .= ("Al" :: Text)-          ]--  r1 <- h2p "test.interop.Person" hsBytes checkPerson pd-  case r1 of-    Fail msg -> pure (Fail ("h2p failed: " <> msg))-    Pass -> p2h "test.interop.Person" fields checkPerson pd-  where-    checkPerson bytes = case decodeMessage @Person bytes of-      Left e -> Left ("decode failed: " <> show e)-      Right p -> do-        check "name" (personName p == "Alice") "expected \"Alice\""-        check "age" (personAge p == 30) "expected 30"-        check "active" (personActive p == True) "expected True"-        check "score" (abs (personScore p - 3.14) < 1e-10) "expected ~3.14"-        check "payload" (personPayload p == "\x00\x01\x02\x03") "expected [0,1,2,3]"-        check "priority" (personPriority p == Priority'PriorityHigh) "expected PRIORITY_HIGH"-        check "address.city" (fmap addressCity (personAddress p) == Just "Springfield") "expected Springfield"-        check "tags length" (length (personTags p) == 3) "expected 3 tags"-        check "ratings[speed]" (Map.lookup "speed" (personRatings p) == Just 9) "expected 9"-        check "nickname" (personNickname p == Just "Al") "expected Just \"Al\""-    check _ True _ = Right ()-    check field False msg = Left ("field " <> field <> ": " <> msg)---testEmptyMessage :: Test-testEmptyMessage pd = do-  let hs = defaultPerson-      hsBytes = encodeMessage hs-  r1 <- h2p "test.interop.Person" hsBytes checkEmpty pd-  case r1 of-    Fail msg -> pure (Fail ("h2p empty failed: " <> msg))-    Pass -> p2h "test.interop.Person" (A.object []) checkEmpty pd-  where-    checkEmpty bytes = case decodeMessage @Person bytes of-      Left e -> Left ("decode failed: " <> show e)-      Right p -> do-        if personName p == "" && personAge p == 0 && personActive p == False-          then Right ()-          else Left "default values wrong"---testNumberKinds :: Test-testNumberKinds pd = do-  let hs =-        defaultNumberKinds-          { numberKindsI32 = -1-          , numberKindsI64 = -1000000000000-          , numberKindsU32 = maxBound-          , numberKindsU64 = maxBound-          , numberKindsS32 = -500-          , numberKindsS64 = -5000000000-          , numberKindsF32 = 1.5-          , numberKindsF64 = 2.718281828-          , numberKindsFx32 = 42-          , numberKindsFx64 = 123456-          , numberKindsSf32 = -42-          , numberKindsSf64 = -123456-          }-      hsBytes = encodeMessage hs-      fields =-        A.object-          [ "i32" .= (-1 :: Int)-          , "i64" .= (-1000000000000 :: Integer)-          , "u32" .= (4294967295 :: Integer) -- maxBound @Word32-          , "u64" .= (18446744073709551615 :: Integer) -- maxBound @Word64-          , "s32" .= (-500 :: Int)-          , "s64" .= (-5000000000 :: Integer)-          , "f32" .= (1.5 :: Double)-          , "f64" .= (2.718281828 :: Double)-          , "fx32" .= (42 :: Int)-          , "fx64" .= (123456 :: Int)-          , "sf32" .= (-42 :: Int)-          , "sf64" .= (-123456 :: Int)-          ]-  r1 <- h2p "test.interop.NumberKinds" hsBytes checkNumbers pd-  case r1 of-    Fail msg -> pure (Fail ("h2p numbers failed: " <> msg))-    Pass -> p2h "test.interop.NumberKinds" fields checkNumbers pd-  where-    checkNumbers bytes = case decodeMessage @NumberKinds bytes of-      Left e -> Left ("decode failed: " <> show e)-      Right n -> do-        check "i32" (numberKindsI32 n == -1) "expected -1"-        check "i64" (numberKindsI64 n == -1000000000000) "expected -1000000000000"-        check "u32" (numberKindsU32 n == maxBound) "expected maxBound"-        check "u64" (numberKindsU64 n == maxBound) "expected maxBound"-        check "s32" (numberKindsS32 n == -500) "expected -500"-        check "s64" (numberKindsS64 n == -5000000000) "expected -5000000000"-        check "f32" (abs (numberKindsF32 n - 1.5) < 1e-5) "expected ~1.5"-        check "f64" (abs (numberKindsF64 n - 2.718281828) < 1e-10) "expected ~2.718..."-        check "fx32" (numberKindsFx32 n == 42) "expected 42"-        check "fx64" (numberKindsFx64 n == 123456) "expected 123456"-        check "sf32" (numberKindsSf32 n == -42) "expected -42"-        check "sf64" (numberKindsSf64 n == -123456) "expected -123456"-    check _ True _ = Right ()-    check field False msg = Left ("field " <> field <> ": " <> msg)---testOptionalPresence :: Test-testOptionalPresence pd = do-  -- Absent optional: no nickname field → Nothing-  let absentCheck bytes = case decodeMessage @Person bytes of-        Left e -> Left ("decode failed: " <> show e)-        Right p ->-          if personNickname p == Nothing-            then Right ()-            else Left ("expected Nothing, got " <> show (personNickname p))--  r1 <- p2h "test.interop.Person" (A.object []) absentCheck pd-  case r1 of-    Fail msg -> pure (Fail ("absent optional failed: " <> msg))-    Pass -> do-      -- Present optional with non-empty value → Just "Nikki"-      -- (empty string is ambiguous in proto3 JSON: json_format may omit it)-      let presentCheck bytes = case decodeMessage @Person bytes of-            Left e -> Left ("decode failed: " <> show e)-            Right p ->-              if personNickname p == Just "Nikki"-                then Right ()-                else Left ("expected Just \"Nikki\", got " <> show (personNickname p))-          hsPresent = defaultPerson{personNickname = Just "Nikki"}-          hsBytesPresent = encodeMessage hsPresent-      r2 <- h2p "test.interop.Person" hsBytesPresent presentCheck pd-      case r2 of-        Fail msg -> pure (Fail ("h2p present optional failed: " <> msg))-        Pass -> p2h "test.interop.Person" (A.object ["nickname" .= ("Nikki" :: Text)]) presentCheck pd----- ------------------------------------------------------------------------------ Entry point--- -----------------------------------------------------------------------------main :: IO ()-main = do-  -- Verify python3 actually runs. In some environments (e.g. nix devshells)-  -- the binary exists at /usr/bin/python3 but is blocked at exec time.-  pyOk <- try @SomeException (readProcessWithExitCode "python3" ["--version"] "")-  case pyOk of-    Left _ -> do-      putStrLn "SKIP: python3 not runnable in this environment"-      exitSuccess-    Right (ExitFailure _, _, _) -> do-      putStrLn "SKIP: python3 --version returned non-zero"-      exitSuccess-    Right (ExitSuccess, _, _) -> pure ()--  driver <- do-    let candidates =-          [ "python-interop/driver.py"-          , "wireform-proto/python-interop/driver.py"-          ]-        firstExisting [] = fail "Could not find python-interop/driver.py"-        firstExisting (p : ps) = do-          exists <- doesFileExist p-          if exists then pure p else firstExisting ps-    firstExisting candidates--  pd <- initDriver driver--  -- Check google-protobuf is installed (init will fail fast with a clear message).-  result <- try @SomeException (initSchema pd)-  case result of-    Left e -> do-      let msg = show e-      if "google-protobuf not installed" `T.isInfixOf` T.pack msg-        then do-          putStrLn "SKIP: google-protobuf not installed (pip install protobuf)"-          exitSuccess-        else do-          putStrLn $ "FAIL: schema init: " <> msg-          exitFailure-    Right () -> pure ()--  passRef <- newIORef (0 :: Int)-  failRef <- newIORef (0 :: Int)--  putStrLn "wireform-proto ↔ google-protobuf interop"-  putStrLn ""--  let run name test = runTest name test pd passRef failRef--  run "Person round-trip (full)"      testPerson-  run "Person empty message"          testEmptyMessage-  run "NumberKinds all scalar types"  testNumberKinds-  run "Optional field presence"       testOptionalPresence--  sendJSON (pdIn pd) (A.object ["type" .= ("done" :: Text)])--  passes <- readIORef passRef-  fails  <- readIORef failRef-  putStrLn ""-  putStrLn $ show passes <> " passed, " <> show fails <> " failed"--  if fails > 0 then exitFailure else exitSuccess
− regen-compare-bench-wireform/Main.hs 
@@ -1,69 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--{- | Regenerate wireform text-codegen output for @compare-bench@.--Reads @bench/compare/gen-wireform/Messages.proto@ and writes-@bench/compare/gen-wireform/Proto/Bench/Wireform/Messages.hs@ so the-Criterion harness exercises the same @Proto.CodeGen@ decode path as-production (including @inOrderStage@ fast paths for ascending tags).--Run from the @wireform-proto@ package root:--> cabal run regen-compare-bench-wireform--}-module Main (main) where--import Data.Map.Strict qualified as Map-import Data.Text qualified as T-import Data.Text.IO qualified as TIO-import Proto.CodeGen (GenerateOpts (..), defaultGenerateOpts, generateModuleText, moduleNameForProto)-import Proto.IDL.Parser (parseProtoFile)-import Proto.IDL.Parser.Error (renderParseError)-import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory)-import System.FilePath (takeDirectory, (</>))-import System.IO (hPutStrLn, stderr)--opts :: GenerateOpts-opts =-  defaultGenerateOpts-    { genModulePrefix = "Proto"-    }---- | Locate the @wireform-proto@ package directory (monorepo-friendly).-findWireformProtoRoot :: IO FilePath-findWireformProtoRoot = do-  here <- getCurrentDirectory-  let candidates =-        here-          : (here </> "wireform-proto")-          : [takeDirectory here </> "wireform-proto" | takeDirectory here /= here]-  go candidates- where-  go [] =-    fail "regen-compare-bench-wireform: wireform-proto.cabal not found (run from repo root or wireform-proto/)"-  go (dir : rest) = do-    ok <- doesFileExist (dir </> "wireform-proto.cabal")-    if ok then pure dir else go rest--main :: IO ()-main = do-  root <- findWireformProtoRoot-  let input = root </> "bench/compare/gen-wireform/Messages.proto"-      filePath = "Messages.proto"-  src <- TIO.readFile input-  case parseProtoFile filePath src of-    Left err -> do-      hPutStrLn stderr (renderParseError err)-      error "parseProtoFile failed"-    Right pf -> do-      let code = generateModuleText opts Map.empty filePath pf-          modPath =-            T.unpack-              ( T.map-                  (\c -> if c == '.' then '/' else c)-                  (moduleNameForProto opts filePath pf)-              )-          out = root </> "bench/compare/gen-wireform" </> modPath <> ".hs"-      createDirectoryIfMissing True (takeDirectory out)-      TIO.writeFile out code-      putStrLn ("Wrote " <> out)
regen-wkt/Main.hs view
@@ -1,94 +1,31 @@ {- | Regenerate the well-known type modules from their .proto files. -The list of input @.proto@ files is given as @(modulePath, diskPath)@-pairs below; the *output* Haskell module name and filesystem path are-derived by 'Proto.CodeGen.moduleNameForProto', which respects the-@csharp_namespace@ option in each @.proto@. E.g.--    option csharp_namespace = "Google.Protobuf.WellKnownTypes";--in @timestamp.proto@ produces module-@Proto.Google.Protobuf.WellKnownTypes.Timestamp@ at-@src/Proto/Google/Protobuf/WellKnownTypes/Timestamp.hs@.--Before regenerating, this driver also sweeps any pre-existing stale-output files at *both* the legacy unprefixed paths (e.g.-@src/Proto/Google/Protobuf/Timestamp.hs@) and the new-@WellKnownTypes/@-prefixed paths, so a regen run is a clean slate.--Run from the @wireform-proto@ directory:+Run from the wireform-proto directory: -    cabal run regen-wkt+  cabal run regen-wkt -} module Main where -import Data.Text (Text) import Data.Text qualified as T import Data.Text.IO qualified as TIO-import Proto.CodeGen (-  GenerateOpts (..),-  buildTypeRegistry,-  builtinWellKnownTypes,-  defaultGenerateOpts,-  generateModuleText,-  moduleNameForProto,- )+import Proto.CodeGen (GenerateOpts (..), defaultGenerateOpts, generateModuleText)+import Proto.IDL.Parser (parseProtoFile) import Proto.IDL.Parser.Resolver (ResolvedProto (..), resolveProtoImports)-import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile)-import System.FilePath (takeDirectory, (</>))+import System.Directory (createDirectoryIfMissing)+import System.FilePath (takeDirectory)  --- | @(modulePath, diskPath)@ for every proto in the well-known-types--- regen pass. @modulePath@ is the *import-relative* name used by other--- protos (i.e. the path that would appear in an @import "..."@--- directive); @diskPath@ is the filesystem location to read the proto--- from.-protos :: [(FilePath, FilePath)]+-- (proto path relative to data/proto/, disk path for proto, output hs path)+protos :: [(FilePath, FilePath, FilePath)] protos =-  [ ("google/protobuf/timestamp.proto",       "data/proto/google/protobuf/timestamp.proto")-  , ("google/protobuf/duration.proto",        "data/proto/google/protobuf/duration.proto")-  , ("google/protobuf/empty.proto",           "data/proto/google/protobuf/empty.proto")-  , ("google/protobuf/field_mask.proto",      "data/proto/google/protobuf/field_mask.proto")-  , ("google/protobuf/source_context.proto",  "data/proto/google/protobuf/source_context.proto")-  , ("google/protobuf/any.proto",             "data/proto/google/protobuf/any.proto")-  , ("google/protobuf/wrappers.proto",        "data/proto/google/protobuf/wrappers.proto")-  , ("google/protobuf/struct.proto",          "data/proto/google/protobuf/struct.proto")-  -- type.proto and api.proto are intentionally excluded from this list.-  -- Both define messages with names that collide with Haskell built-ins:-  -- type.proto has a top-level message "Enum" which conflicts with-  -- Prelude.Enum (the typeclass), breaking 'deriving Enum' in the generated-  -- file. Including type.proto in the registry also causes descriptor.proto's-  -- nested FieldDescriptorProto.Type enum to be incorrectly resolved as-  -- google.protobuf.Type (from type.proto) instead of the local nested enum.-  -- The .proto files ship in data/proto/ for runtime use; they are not-  -- compiled as library modules.-  -- Reflection-time / plugin-protocol types. These ship the upstream-  -- @descriptor.proto@ and @compiler/plugin.proto@ unmodified; their-  -- @csharp_namespace@ options (@Google.Protobuf.Reflection@ and-  -- @Google.Protobuf.Compiler@ respectively) put them at-  -- @Proto.Google.Protobuf.Reflection.Descriptor@ and-  -- @Proto.Google.Protobuf.Compiler.Plugin@.-  , ("google/protobuf/descriptor.proto",      "data/proto/google/protobuf/descriptor.proto")-  , ("google/protobuf/compiler/plugin.proto", "data/proto/google/protobuf/compiler/plugin.proto")-  ]----- | Legacy output paths (no @WellKnownTypes/@ segment). These are--- the files the *old* hard-coded regen-wkt wrote to. We sweep them--- on every regen so stale output never lingers.-legacyOutputs :: [FilePath]-legacyOutputs =-  [ "src/Proto/Google/Protobuf/Timestamp.hs"-  , "src/Proto/Google/Protobuf/Duration.hs"-  , "src/Proto/Google/Protobuf/Empty.hs"-  , "src/Proto/Google/Protobuf/FieldMask.hs"-  , "src/Proto/Google/Protobuf/SourceContext.hs"-  , "src/Proto/Google/Protobuf/Any.hs"-  , "src/Proto/Google/Protobuf/Wrappers.hs"-  , "src/Proto/Google/Protobuf/Struct.hs"-  -- Removed hand-written @Descriptor.hs@ — use @Reflection.Descriptor@.-  , "src/Proto/Google/Protobuf/Descriptor.hs"-  , "src/Proto/Google/Protobuf/Type.hs"+  [ ("google/protobuf/timestamp.proto", "data/proto/google/protobuf/timestamp.proto", "src/Proto/Google/Protobuf/Timestamp.hs")+  , ("google/protobuf/duration.proto", "data/proto/google/protobuf/duration.proto", "src/Proto/Google/Protobuf/Duration.hs")+  , ("google/protobuf/empty.proto", "data/proto/google/protobuf/empty.proto", "src/Proto/Google/Protobuf/Empty.hs")+  , ("google/protobuf/field_mask.proto", "data/proto/google/protobuf/field_mask.proto", "src/Proto/Google/Protobuf/FieldMask.hs")+  , ("google/protobuf/source_context.proto", "data/proto/google/protobuf/source_context.proto", "src/Proto/Google/Protobuf/SourceContext.hs")+  , ("google/protobuf/any.proto", "data/proto/google/protobuf/any.proto", "src/Proto/Google/Protobuf/Any.hs")+  , ("google/protobuf/wrappers.proto", "data/proto/google/protobuf/wrappers.proto", "src/Proto/Google/Protobuf/Wrappers.hs")+  , ("google/protobuf/struct.proto", "data/proto/google/protobuf/struct.proto", "src/Proto/Google/Protobuf/Struct.hs")   ]  @@ -99,66 +36,21 @@     }  --- | Convert a Haskell module name (e.g. @\"Proto.Google.Protobuf.WellKnownTypes.Timestamp\"@)--- into a source-tree path (e.g. @\"src/Proto/Google/Protobuf/WellKnownTypes/Timestamp.hs\"@).-moduleNameToPath :: Text -> FilePath-moduleNameToPath mn =-  let parts = T.splitOn (T.pack ".") mn-      joined = T.unpack (T.intercalate (T.pack "/") parts)-   in "src" </> (joined ++ ".hs")----- | Sweep a previously-generated file if it exists. Silent no-op--- otherwise. We only delete files we know we wrote ourselves —--- never anything outside the configured sweep list.-sweep :: FilePath -> IO ()-sweep p = do-  exists <- doesFileExist p-  if exists-    then do-      removeFile p-      putStrLn $ "  Removed stale " <> p-    else pure ()-- main :: IO () main = do-  putStrLn "Sweeping legacy output paths..."-  mapM_ sweep legacyOutputs--  putStrLn ""-  putStrLn "Resolving proto imports..."-  resolved <- traverse resolveOne protos--  -- A *global* registry covering every proto in this regen pass.-  -- @builtinWellKnownTypes@ provides the eight WKT fallback entries-  -- (with the @csharp_namespace@-derived Haskell module names), but-  -- we *also* fold in entries for the in-pass files so a cross-file-  -- type reference such as @plugin.proto@ → @FileDescriptorProto@-  -- resolves to @Proto.Google.Protobuf.Reflection.Descriptor@.-  -- Without this the generator emits a bare unqualified type name and-  -- the build fails with "Not in scope".-  let globalReg =-        builtinWellKnownTypes-          <> buildTypeRegistry opts (fmap (\(modulePath, _, rp) -> (modulePath, rp)) resolved)--  putStrLn ""-  putStrLn "Regenerating well-known types..."   mapM_-    ( \(modulePath, _diskPath, rp) -> do-        let modName = moduleNameForProto opts modulePath (rpFile rp)-            hsPath = moduleNameToPath modName-            code = generateModuleText opts globalReg modulePath (rpFile rp)-        createDirectoryIfMissing True (takeDirectory hsPath)-        TIO.writeFile hsPath code-        putStrLn $ "  Generated " <> hsPath <> " (module " <> T.unpack modName <> ")"+    ( \(modulePath, diskPath, hsPath) -> do+        result <- resolveProtoImports ["data/proto/", "data/", "."] diskPath+        case result of+          Left err -> error $ "Resolve error for " <> diskPath <> ": " <> show err+          Right rp -> do+            -- Use modulePath (without data/proto/ prefix) so the generated+            -- module name is Proto.Google.Protobuf.Foo, not Proto.Data.Proto.Google.Protobuf.Foo+            let code = generateModuleText opts mempty modulePath (rpFile rp)+            createDirectoryIfMissing True (takeDirectory hsPath)+            TIO.writeFile hsPath code+            putStrLn $ "Generated " <> hsPath     )-    resolved+    protos    putStrLn "Done."-  where-    resolveOne (modulePath, diskPath) = do-      result <- resolveProtoImports ["data/proto/", "data/", "."] diskPath-      case result of-        Left err -> error $ "Resolve error for " <> diskPath <> ": " <> show err-        Right rp -> pure (modulePath, diskPath, rp)
src/Proto.hs view
@@ -1,174 +1,23 @@-{- | Primary interface for wireform-proto.--A single @import Proto@ gives you everything needed for everyday-protobuf use: encoding, decoding, schema introspection, the type-registry, and proto2 extension support.+{- | Convenience re-export module for the common wireform-proto surface. -== Quick start+Import this module to get encoding, decoding, schema metadata,+the type registry, and extension support in one go.  @ import Proto --- Serialise to a strict ByteString (exact-size, single allocation).-let bs = 'encodeMessage' myMsg---- Deserialise; returns Either so errors are explicit.-case 'decodeMessage' bs of-  Left  err -> handleError err   -- 'DecodeError'+let bs = encodeMessage myMsg+case decodeMessage bs of+  Left err  -> handleError err   Right msg -> use msg @--== Encoding--'encodeMessage' is the common entry point.  It calls 'buildSized' on-the message (which generated types implement via 'MessageEncode') and-allocates a single 'Data.ByteString.ByteString' of exactly the right-length in one pass.--Variants:--* 'encodeLazy'                   — lazy @ByteString@ (chunked output)-* 'hPutMessage'                  — write to a @Handle@ without materialising-* 'hPutMessageLen'               — same, but also returns the byte count-* 'encodeMessageStream'          — length-delimited stream (list of messages → lazy @ByteString@)-* 'encodeMessageStreamSized'     — like above but avoids a materialisation step-* 'hPutMessageStream'            — stream directly to a @Handle@--For low-level access, 'buildMessage' returns a-@Wireform.Builder.Builder@ and 'messageSize' returns the wire byte-count without encoding.--== Decoding--'decodeMessage' parses a strict @ByteString@. For lazy input or-length-delimited streams see "Proto.Decode.Stream".--'decodeSubmessage' is identical to 'decodeMessage'; the name is a hint-that the bytes come from a submessage payload rather than a top-level-framing.--Error values: 'DecodeError' covers truncated input, invalid varints,-UTF-8 validation failures, negative length prefixes, and domain errors-from generated closed-enum decoders.--== Unknown field preservation--Generated types carry an @unknownFields@ slot. Any field numbers-absent from the @.proto@ schema are accumulated there as 'UnknownField'-values and re-emitted verbatim on encode, so messages survive a-round-trip through code compiled against an older schema version.-'encodeUnknownFields' produces the raw 'Data.ByteString.ByteString'-fragment for manual encoding pipelines.--== Schema metadata--Re-exports from "Proto.Schema": 'ProtoMessage', 'FieldDescriptor',-'protoFieldDescriptors', etc.  These are used by the dynamic decoder in-"Proto.Dynamic" and by generic tooling that needs to introspect message-shape at runtime.--== Generating message instances--There are two ways to obtain 'MessageEncode' \/ 'MessageDecode' instances-and schema metadata for your types.  Choose whichever fits your workflow:--=== 1. From a @.proto@ file — "Proto.TH"--@-{\-\# LANGUAGE TemplateHaskell \#-\}-import Proto.TH--\$(loadProto "proto\/person.proto")-@--'Proto.TH.loadProto' parses the @.proto@ file at compile time and-splices in Haskell record types, wire codecs, JSON instances, and-'Proto.Schema.ProtoMessage' metadata for every message and enum.-Use 'Proto.TH.loadProtoWith' with a 'Proto.TH.LoadOpts' value to-customise field naming, include paths, or lazy submessage decoding.--=== 2. From hand-written records — "Proto.TH.Derive"--If you already have a Haskell record and want to assign protobuf-field numbers and wire semantics to it:--@-{\-\# LANGUAGE TemplateHaskell \#-\}-import Proto.TH.Derive-import Wireform.Derive.Modifier--data Person = Person-  { personName :: !Text-  , personAge  :: !Word32-  } deriving stock (Show, Eq, Generic)--{\-\# ANN personName (tag 1) \#-\}-{\-\# ANN personAge  (tag 2) \#-\}--\$(deriveProto ''Person)-@--'Proto.TH.Derive.deriveProto' reads the @ANN@ pragmas and generates-the same instances as the @.proto@-file route.  Use-'Proto.TH.Derive.deriveProtoEncode' or-'Proto.TH.Derive.deriveProtoDecode' separately if you only need one-direction.--=== 3. Pure text code generator — "Proto.CodeGen"--For offline or build-system–driven generation, "Proto.CodeGen"-provides a pure @.proto@ → Haskell source pipeline.  The-@wireform-gen@ executable wraps this for use with @protoc@ or-custom build scripts.--== Lazy submessage decoding--'LazyMessage' lets you defer parsing a submessage until you actually-need it, which is useful in middleware that forwards messages without inspecting-every field. Opt in via @genLazySubmessages = True@ in-'Proto.CodeGen.GenerateOpts'; fields then have type @'LazyMessage' Foo@-instead of @Foo@. Call 'forceLazyMessage' to run the deferred parse.-See the 'LazyMessage' haddock for a full example and memory-retention-caveats.- -} module Proto (   -- * Encoding-  MessageEncode (..),-  encodeMessage,-  encodeLazy,-  hPutMessage,-  hPutMessageLen,-  buildMessage,-  messageSize,--  -- ** Length-delimited streams-  encodeMessageLazy,-  encodeMessageStream,-  encodeMessageStreamSized,-  hPutMessageStream,-  buildMessageFramed,+  module Proto.Encode,    -- * Decoding-  MessageDecode (..),-  decodeMessage,-  decodeSubmessage,--  -- * Errors-  DecodeError (..),--  -- * Lazy submessage decoding-  ---  -- | See 'LazyMessage' for when to use this and how to opt in.-  LazyMessage (..),-  forceLazyMessage,--  -- * Unknown field preservation-  ---  -- | Unrecognised fields round-trip automatically; 'encodeUnknownFields'-  -- is only needed in hand-written encode pipelines.-  UnknownField (..),-  encodeUnknownFields,+  module Proto.Decode,    -- * Schema metadata   module Proto.Schema,@@ -176,34 +25,13 @@   -- * Type registry   module Proto.Registry, -  -- * Proto2 extensions+  -- * Extensions (proto2)   module Proto.Extension, ) where -import Proto.Internal.Decode-  ( DecodeError (..)-  , LazyMessage (..)-  , MessageDecode (..)-  , UnknownField (..)-  , decodeMessage-  , decodeSubmessage-  , encodeUnknownFields-  , forceLazyMessage-  )-import Proto.Internal.Encode-  ( MessageEncode (..)-  , buildMessage-  , buildMessageFramed-  , encodeMessage-  , encodeLazy-  , encodeMessageLazy-  , encodeMessageStream-  , encodeMessageStreamSized-  , hPutMessage-  , hPutMessageLen-  , hPutMessageStream-  , messageSize-  )+import Proto.Decode+import Proto.Encode import Proto.Extension import Proto.Registry import Proto.Schema+
src/Proto/CodeGen.hs view
@@ -1,3640 +1,2940 @@ {- | Pure-text code generation for Haskell modules from parsed proto files. -This module powers the @protoc-gen-wireform@ plugin, the 'Proto.Setup'-pre-build hook, and the Template Haskell path in "Proto.TH". It produces-complete, compilable Haskell source text with:--* Proper cross-module imports via a 'TypeRegistry'-* Record types for messages, sum types for enums and oneofs-* @MessageEncode@ \/ @MessageDecode@ instances (size is computed inline)-* @Aeson.ToJSON@ \/ @Aeson.FromJSON@ instances (respecting @json_name@)-* Map field, oneof, and nested message support--== 'GenerateOpts' configuration--Use 'GenerateOpts' to control the output:--  ['genModulePrefix'] The Haskell module prefix prepended to generated-    module names. Default: @\"Proto.Gen\"@.--  ['genFieldNaming'] How to name record fields -- 'PrefixedFields'-    (default, e.g. @personName@) or 'UnprefixedFields' (e.g. @name@,-    requires @DuplicateRecordFields@).--  ['genStrictFields'] Whether to add strict-field annotations (@!@).-    Default: 'True'.--  ['genUnpackPrims'] Whether to add @UNPACK@ pragmas on primitive-    fields. Default: 'True'.--  ['genDeriveGeneric'] Derive @GHC.Generics.Generic@. Default: 'True'.--  ['genDeriveNFData'] Derive @Control.DeepSeq.NFData@. Default: 'True'.--  ['genPackedRepeated'] Use packed encoding for repeated scalar fields.-    Default: 'True'.--  ['genLazySubmessages'] Decode submessage fields lazily-    (via 'LazyMessage'). Default: 'False'.--  ['genJsonOverrides'] Per-message overrides for JSON instances. See-    'JsonOverride'.--  ['genHooks'] 'CodeGenHooks' callbacks for emitting extra declarations.--}-module Proto.CodeGen (-  generateModule,-  generateModuleText,-  GenerateOpts (..),-  defaultGenerateOpts,-  FieldNaming (..),-  JsonOverride (..),-  defaultJsonOverrides,-  TypeRegistry,-  TypeInfo (..),-  TypeKind (..),-  buildTypeRegistry,-  builtinWellKnownTypes,-  moduleNameForProto,-  hsTypeName,-  hsModuleName,-  scopedTypeName,-  scopedFieldName,-  scopedFieldNameWith,-  scopedEnumCon,-  snakeToCamel,-  snakeToPascal,-  protoJsonName,-  lowerFirst,-  escapeReserved,--  -- * Codegen combinators (re-exported from Combinators)-  txt,-  tshow,-  braceBlock,-  instanceHead,--  -- * Codegen hooks (re-exported from Hooks)-  module Proto.CodeGen.Hooks,-) where--import Data.Bits (shiftL, shiftR, (.&.), (.|.))-import Data.ByteString qualified as BS-import Data.Char (isAsciiUpper, toLower, toUpper)-import Data.List (foldl')-import Data.Map.Strict (Map)-import Data.Map.Strict qualified as Map-import Data.Maybe (fromMaybe)-import Data.Set (Set)-import Data.Set qualified as Set-import Data.Text (Text)-import Data.Text qualified as T-import Data.Word (Word8, Word64)-import Numeric (showHex)-import Prettyprinter-import Prettyprinter.Render.Text (renderStrict)-import Proto.CodeGen.Hooks-import Proto.CodeGen.Service qualified as Service-import Proto.IDL.AST-import Proto.IDL.Annotations (lookupSimpleOption, optionAsString)-import Proto.IDL.Descriptor (serializeFileDescriptor)-import Proto.IDL.Options-import Proto.IDL.Options.Custom (emptyCustomOptionRegistry, extractExtensionOptions, registerCustomOption)-import Proto.IDL.Parser.Resolver (ResolvedProto (..))-import Proto.Internal.CodeGen.Combinators (braceBlock, instanceHead, tshow, txt)-import Proto.Internal.Wire (WireType (..))----- | Emit a Haddock doc comment block from a proto doc comment.-haddockDoc :: Maybe Text -> [Doc ann]-haddockDoc Nothing = []-haddockDoc (Just doc) =-  let ls = T.lines doc-  in case ls of-      [] -> []-      (first_ : rest) ->-        [txt "-- | " <> pretty first_]-          <> fmap (\l -> txt "-- " <> pretty l) rest----- | Emit a Haddock post-item doc comment (@-- ^@) from a proto doc comment.-haddockFieldDoc :: Maybe Text -> [Doc ann]-haddockFieldDoc Nothing = []-haddockFieldDoc (Just doc) =-  let ls = T.lines doc-  in case ls of-      [] -> []-      (first_ : rest) ->-        [indent 2 (txt "-- ^ " <> pretty first_)]-          <> fmap (\l -> indent 2 (txt "-- " <> pretty l)) rest---wireVarint, wire64Bit, wireLengthDelimited, wire32Bit :: Int-wireVarint = 0-wire64Bit = 1-wireLengthDelimited = 2-wire32Bit = 5---computeTagByte :: Int -> Int -> Int-computeTagByte fieldNum wireType = fieldNum * 8 + wireType---tagLit :: Text -> Int -> Doc ann-tagLit fnText wt =-  let fieldNum = read (T.unpack fnText) :: Int-  in pretty (computeTagByte fieldNum wt)----- ------------------------------------------------------------------------------ Options--- -----------------------------------------------------------------------------{- | Controls how generated record field names relate to the proto-field name and the enclosing message name.--}-data FieldNaming-  = -- | Prefix each field with the lowercased message name.-    -- @message Person { string name = 1; }@ becomes-    -- @personName :: !Text@. This is the default; it avoids-    -- name clashes without @DuplicateRecordFields@.-    PrefixedFields-  | -- | Use the proto field name directly (snake_case to camelCase).-    -- @message Person { string name = 1; }@ becomes-    -- @name :: !Text@.  Requires @DuplicateRecordFields@ if two-    -- messages share a field name. Works well with-    -- @OverloadedRecordDot@ and GHC's @HasField@ class.-    UnprefixedFields-  deriving stock (Show, Eq)---{- | Options controlling the pure-text code generator.-See the module-level documentation for a description of each field.--}-data GenerateOpts = GenerateOpts-  { genModulePrefix :: Text-  -- ^ Haskell module prefix (e.g. @\"Proto.Gen\"@).-  , genFieldNaming :: FieldNaming-  -- ^ Record field naming strategy.-  , genStrictFields :: Bool-  -- ^ Add strict annotations (@!@) to record fields.-  , genUnpackPrims :: Bool-  -- ^ Add @UNPACK@ pragmas on primitive fields.-  , genDeriveGeneric :: Bool-  -- ^ Derive @GHC.Generics.Generic@.-  , genDeriveNFData :: Bool-  -- ^ Derive @Control.DeepSeq.NFData@.-  , genPackedRepeated :: Bool-  -- ^ Use packed wire encoding for repeated scalar fields.-  , genClosedEnums :: Bool-  -- ^ Use closed-enum decoding: reject unknown wire values with 'decodeFail'-  -- instead of mapping them to the @'Unknown N@ constructor. Corresponds to-  -- @features.enum_type = CLOSED@ in proto editions.-  , genLazySubmessages :: Bool-  -- ^ Decode submessage fields lazily via 'LazyMessage'.-  , genJsonOverrides :: Map Text JsonOverride-  -- ^ Per-message 'JsonOverride' keyed by fully-qualified proto name.-  , genHooks :: CodeGenHooks-  -- ^ Callbacks for emitting extra declarations during codegen.-  , genExternalTypes :: TypeRegistry-  {- ^ Externally-managed types: proto FQNs whose Haskell definitions-       live in some other package the consumer already depends on.--       Two effects, both driven off the same registry:--       1. __Skip emission.__ When the code generator walks the-          top-levels of the @.proto@ file being processed and finds a-          FQN that appears in @genExternalTypes@, it /omits/ the type-          declaration, default value, encode/decode/schema/JSON-          instances, and lenses for that entry. The user is expected-          to import the externally-managed module that already-          provides them.--       2. __Resolve references.__ When some other field's type refers-          to that FQN, the generator looks the entry up here and-          emits a qualified reference to its 'tiModule' /-          'tiHsName'. This is the same mechanism 'builtinWellKnownTypes'-          uses for the bundled @google.protobuf.*@ types.--       Typical population: at the Setup.hs / build-tool level, the-       consumer iterates over packages they depend on, asks each for-       its @TypeRegistry@ (typically by calling 'buildTypeRegistry'-       on the @.proto@ files that package owns), and unions the-       results into @genExternalTypes@ before invoking the generator.--       The two cases @genExternalTypes@ supports overlap with-       @reg@'s second argument to 'generateModule' / 'generateModuleText'-       — that registry covers /every/ proto in the current regen-       batch, including the file currently being generated.-       @genExternalTypes@ is specifically for types defined /outside/-       this regen pass, in another package's source tree.--       Defaults to 'mempty'. -}-  }---{- | Custom JSON instance override for a specific FQ proto message name.-When present, the code generator emits the provided Haskell source text-instead of the generic JSON instances.--}-data JsonOverride = JsonOverride-  { joToJSON :: Text-  , joFromJSON :: Text-  }-  deriving stock (Show, Eq)---{- | Sensible defaults: @\"Proto.Gen\"@ module prefix, prefixed field-names, strict fields, unpack primitives, derive Generic and NFData,-packed repeated scalars, eager submessages, built-in JSON overrides-for well-known types, no hooks.--}-defaultGenerateOpts :: GenerateOpts-defaultGenerateOpts =-  GenerateOpts-    { genModulePrefix = "Proto.Gen"-    , genFieldNaming = PrefixedFields-    , genStrictFields = True-    , genUnpackPrims = True-    , genDeriveGeneric = True-    , genDeriveNFData = True-    , genPackedRepeated = True-    , genClosedEnums = False-    , genLazySubmessages = False-    , genJsonOverrides = defaultJsonOverrides-    , genHooks = defaultCodeGenHooks-    , genExternalTypes = mempty-    }---{- | Built-in JSON overrides for well-known types that require canonical-proto3 JSON representations.--}-defaultJsonOverrides :: Map Text JsonOverride-defaultJsonOverrides =-  Map.fromList-    [-      ( "google.protobuf.Timestamp"-      , JsonOverride-          { joToJSON =-              T.unlines-                [ "  toJSON msg ="-                , "    let s = msg.timestampSeconds"-                , "        n = msg.timestampNanos"-                , "        (rawDays, remSec) = s `divMod` 86400"-                , "        (hours, remH) = remSec `divMod` 3600"-                , "        (mins, secs) = remH `divMod` 60"-                , "        z = rawDays + 719468"-                , "        era = (if z >= 0 then z else z - 146096) `div` 146097"-                , "        doe = z - era * 146097"-                , "        yoe = (doe - doe `div` 1460 + doe `div` 36524 - doe `div` 146096) `div` 365"-                , "        y = yoe + era * 400"-                , "        doy = doe - (365 * yoe + yoe `div` 4 - yoe `div` 100)"-                , "        mp = (5 * doy + 2) `div` 153"-                , "        d = doy - (153 * mp + 2) `div` 5 + 1"-                , "        m = mp + (if mp < 10 then 3 else -9)"-                , "        y' = y + (if m <= 2 then 1 else 0)"-                , "        pad2 x = let sx = T.pack (show (abs x)) in if T.length sx < 2 then T.pack \"0\" <> sx else sx"-                , "        pad4 x = let sx = T.pack (show (abs x)) in T.replicate (4 - T.length sx) (T.pack \"0\") <> sx"-                , "        pad9 x = let sx = T.pack (show (abs x)) in T.replicate (9 - T.length sx) (T.pack \"0\") <> sx"-                , "        nanoStr = if n == 0 then T.pack \"\" else T.pack \".\" <> dropTrailingZeros (pad9 (fromIntegral n))"-                , "        dropTrailingZeros t = case T.stripSuffix (T.pack \"0\") t of { Just t' -> dropTrailingZeros t'; Nothing -> t }"-                , "    in Aeson.String (pad4 y' <> T.pack \"-\" <> pad2 (fromIntegral m) <> T.pack \"-\" <> pad2 (fromIntegral d)"-                , "         <> T.pack \"T\" <> pad2 hours <> T.pack \":\" <> pad2 mins <> T.pack \":\" <> pad2 secs"-                , "         <> nanoStr <> T.pack \"Z\")"-                ]-          , joFromJSON =-              T.unlines-                [ "  parseJSON (Aeson.String _) = pure defaultTimestamp"-                , "  parseJSON _ = fail \"Expected RFC 3339 timestamp string\""-                ]-          }-      )-    ,-      ( "google.protobuf.Duration"-      , JsonOverride-          { joToJSON =-              T.unlines-                [ "  toJSON msg ="-                , "    let s = msg.durationSeconds"-                , "        n = msg.durationNanos"-                , "        nanoStr = if n == 0 then T.pack \"\" else T.pack \".\" <> dropTrailingZeros (pad9 (abs (fromIntegral n)))"-                , "        dropTrailingZeros t = case T.stripSuffix (T.pack \"0\") t of { Just t' -> dropTrailingZeros t'; Nothing -> t }"-                , "        pad9 x = let sx = T.pack (show x) in T.replicate (9 - T.length sx) (T.pack \"0\") <> sx"-                , "        sign = if s < 0 || n < 0 then T.pack \"-\" else T.pack \"\""-                , "    in Aeson.String (sign <> T.pack (show (abs s)) <> nanoStr <> T.pack \"s\")"-                ]-          , joFromJSON =-              T.unlines-                [ "  parseJSON (Aeson.String _) = pure defaultDuration"-                , "  parseJSON _ = fail \"Expected duration string like \\\"3.5s\\\"\""-                ]-          }-      )-    ]----- ------------------------------------------------------------------------------ Type registry: maps fully-qualified proto names to Haskell type info--- ------------------------------------------------------------------------------- | Whether a registered type is a message or an enum.-data TypeKind-  = -- | A message type.-    TKMessage-  | -- | An enum type.-    TKEnum-  deriving stock (Show, Eq, Ord)----- | Information about a registered proto type's Haskell mapping.-data TypeInfo = TypeInfo-  { tiModule :: Text-  -- ^ The Haskell module containing this type.-  , tiHsName :: Text-  -- ^ The Haskell type name.-  , tiKind :: TypeKind-  -- ^ Whether this is a message or enum.-  }-  deriving stock (Show, Eq)----- | Maps fully-qualified proto type names to their Haskell type info.-type TypeRegistry = Map Text TypeInfo---{- | Build a TypeRegistry from a list of (proto file path, resolved proto).-Walks all top-levels and nested definitions, recording their FQ names.-| Build a TypeRegistry from resolved proto files. Also includes entries-for the standard well-known Google protobuf types, pointing to their-generated modules under @Proto.Google.Protobuf.*@.--}-buildTypeRegistry :: GenerateOpts -> [(FilePath, ResolvedProto)] -> TypeRegistry-buildTypeRegistry opts rpList =-  Map.union-    builtinWellKnownTypes-    (Map.unions (fmap (\(fp, rp) -> registryForFile opts (normalizeProtoPath fp) (rpFile rp)) rpList))---{- | Registry entries for standard Google well-known types.-These reference the generated modules at @Proto.Google.Protobuf.*@,-which are produced by running the code generator on the bundled-@proto/google/protobuf/*.proto@ files with prefix @Proto@.--}-builtinWellKnownTypes :: TypeRegistry-builtinWellKnownTypes =-  Map.fromList-    [ wkt "google.protobuf.Duration" "Proto.Google.Protobuf.WellKnownTypes.Duration" "Duration"-    , wkt "google.protobuf.Timestamp" "Proto.Google.Protobuf.WellKnownTypes.Timestamp" "Timestamp"-    , wkt "google.protobuf.Empty" "Proto.Google.Protobuf.WellKnownTypes.Empty" "Empty"-    , wkt "google.protobuf.Any" "Proto.Google.Protobuf.WellKnownTypes.Any" "Any"-    , wkt "google.protobuf.Struct" "Proto.Google.Protobuf.WellKnownTypes.Struct" "Struct"-    , wkt "google.protobuf.Value" "Proto.Google.Protobuf.WellKnownTypes.Struct" "Value"-    , wkt "google.protobuf.ListValue" "Proto.Google.Protobuf.WellKnownTypes.Struct" "ListValue"-    , wkt "google.protobuf.NullValue" "Proto.Google.Protobuf.WellKnownTypes.Struct" "NullValue"-    , wkt "google.protobuf.FieldMask" "Proto.Google.Protobuf.WellKnownTypes.FieldMask" "FieldMask"-    , wkt "google.protobuf.SourceContext" "Proto.Google.Protobuf.WellKnownTypes.SourceContext" "SourceContext"-    , wkt "google.protobuf.DoubleValue" "Proto.Google.Protobuf.WellKnownTypes.Wrappers" "DoubleValue"-    , wkt "google.protobuf.FloatValue" "Proto.Google.Protobuf.WellKnownTypes.Wrappers" "FloatValue"-    , wkt "google.protobuf.Int64Value" "Proto.Google.Protobuf.WellKnownTypes.Wrappers" "Int64Value"-    , wkt "google.protobuf.UInt64Value" "Proto.Google.Protobuf.WellKnownTypes.Wrappers" "UInt64Value"-    , wkt "google.protobuf.Int32Value" "Proto.Google.Protobuf.WellKnownTypes.Wrappers" "Int32Value"-    , wkt "google.protobuf.UInt32Value" "Proto.Google.Protobuf.WellKnownTypes.Wrappers" "UInt32Value"-    , wkt "google.protobuf.BoolValue" "Proto.Google.Protobuf.WellKnownTypes.Wrappers" "BoolValue"-    , wkt "google.protobuf.StringValue" "Proto.Google.Protobuf.WellKnownTypes.Wrappers" "StringValue"-    , wkt "google.protobuf.BytesValue" "Proto.Google.Protobuf.WellKnownTypes.Wrappers" "BytesValue"-    ]-  where-    wkt fqn modName hsName = (fqn, TypeInfo modName hsName TKMessage)---{- | Normalize a proto file path to a relative path suitable for module naming.-Handles absolute paths by extracting the proto-relative portion.--}-normalizeProtoPath :: FilePath -> FilePath-normalizeProtoPath = id---registryForFile :: GenerateOpts -> FilePath -> ProtoFile -> TypeRegistry-registryForFile opts fp pf =-  let modName = moduleNameForProto opts fp pf-      pkg = fromMaybe "" (protoPackage pf)-  in Map.unions (fmap (registryForTopLevel modName pkg []) (protoTopLevels pf))---registryForTopLevel :: Text -> Text -> [Text] -> TopLevel -> TypeRegistry-registryForTopLevel modName pkg scope = \case-  TLMessage msg -> registryForMessage modName pkg scope msg-  TLEnum ed -> registryForEnum modName pkg scope ed-  _ -> Map.empty---registryForMessage :: Text -> Text -> [Text] -> MessageDef -> TypeRegistry-registryForMessage modName pkg scope msg =-  let scope' = scope <> [msgName msg]-      fqName = if T.null pkg then T.intercalate "." scope' else pkg <> "." <> T.intercalate "." scope'-      hsName = T.intercalate "'" (fmap hsTypeName scope')-      self =-        Map.singleton-          fqName-          TypeInfo-            { tiModule = modName-            , tiHsName = hsName-            , tiKind = TKMessage-            }-      nested = Map.unions (fmap (registryForElement modName pkg scope') (msgElements msg))-  in Map.union self nested---registryForElement :: Text -> Text -> [Text] -> MessageElement -> TypeRegistry-registryForElement modName pkg scope = \case-  MEMessage inner -> registryForMessage modName pkg scope inner-  MEEnum ed -> registryForEnum modName pkg scope ed-  _ -> Map.empty---registryForEnum :: Text -> Text -> [Text] -> EnumDef -> TypeRegistry-registryForEnum modName pkg scope ed =-  let scope' = scope <> [enumName ed]-      fqName = if T.null pkg then T.intercalate "." scope' else pkg <> "." <> T.intercalate "." scope'-      hsName = T.intercalate "'" (fmap hsTypeName scope')-  in Map.singleton-      fqName-      TypeInfo-        { tiModule = modName-        , tiHsName = hsName-        , tiKind = TKEnum-        }---{- | Compute the Haskell module name for a proto file.--Prefers @csharp_namespace@ if set (already PascalCase with dots), appending-the proto file's base name for disambiguation when multiple files share a-namespace (e.g. enum files). Falls back to the file path.--@csharp_namespace = "Temporalio.Api.Common.V1"@ with file @message.proto@-produces @Proto.Temporalio.Api.Common.V1.Message@.--}-moduleNameForProto :: GenerateOpts -> FilePath -> ProtoFile -> Text-moduleNameForProto opts filePath pf =-  let fo = extractFileOptions (protoOptions pf)-      baseName = fileBaseName filePath-  in case foCsharpNamespace fo of-      Just ns -> genModulePrefix opts <> "." <> ns <> "." <> baseName-      Nothing -> genModulePrefix opts <> "." <> moduleFromPath filePath-  where-    fileBaseName fp =-      let t = T.pack fp-          stripped = fromMaybe t (T.stripSuffix ".proto" t)-          parts = T.splitOn "/" stripped-      in pathPartToModule (last parts)--    moduleFromPath fp =-      let t = T.pack fp-          s = fromMaybe t (T.stripSuffix ".proto" t)-          parts = T.splitOn "/" s-      in T.intercalate "." (fmap pathPartToModule parts)--    pathPartToModule t = snakeToPascal (capitalize t)--    capitalize t = case T.uncons t of-      Just (c, rest) -> T.cons (toUpper c) rest-      Nothing -> t----- ------------------------------------------------------------------------------ Code generation--- -----------------------------------------------------------------------------data GenCtx = GenCtx-  { gcOpts :: GenerateOpts-  , gcRegistry :: TypeRegistry-  , gcThisMod :: Text-  , gcPkg :: Maybe Text-  , gcLocalTypes :: Set Text-  }----- | Produce a record field name using the context's naming mode.-ctxFieldName :: GenCtx -> [Text] -> Text -> Text-ctxFieldName ctx = scopedFieldNameWith (genFieldNaming (gcOpts ctx))----- | Generate a complete Haskell module as a 'Doc' from a proto file.-generateModule :: GenerateOpts -> TypeRegistry -> FilePath -> ProtoFile -> Doc ann-generateModule opts reg filePath pf =-  let thisMod = moduleNameForProto opts filePath pf-      -- Fold the user-supplied @genExternalTypes@ map into the-      -- resolution registry so cross-references in this file pick up-      -- the externally-managed module qualifications.-      reg' = reg <> genExternalTypes opts-      localTypes = collectLocalTypes (fromMaybe "" (protoPackage pf)) [] (protoTopLevels pf)-      -- For editions schemas, derive effective packed-encoding and closed-enum-      -- flags from the file-level features.* option overrides.-      editionFs = case protoSyntax pf of-        Editions ed -> Just (resolveFileFeatures (Editions ed) (protoOptions pf))-        _           -> Nothing-      effectivePacked = case editionFs of-        Just fs -> featureRepeatedFieldEncoding fs == PackedEncoding-        Nothing -> genPackedRepeated opts-      effectiveClosedEnums = case editionFs of-        Just fs -> featureEnumType fs == ClosedEnum-        Nothing -> genClosedEnums opts-      ctx =-        GenCtx-          { gcOpts = opts-              { genPackedRepeated = effectivePacked-              , genClosedEnums    = effectiveClosedEnums-              }-          , gcRegistry = reg'-          , gcThisMod = thisMod-          , gcPkg = protoPackage pf-          , gcLocalTypes = localTypes-          }-      -- Drop top-levels whose FQN is already owned by another-      -- package (per @genExternalTypes@). The user is expected to-      -- import that other package's module for the missing types;-      -- the generator just won't redefine them here.-      visibleTopLevels =-        filter (not . topLevelManagedExternally opts (protoPackage pf)) (protoTopLevels pf)-      body = concatMap (genTopLevel ctx []) visibleTopLevels-      referencedTypes = collectReferencedTypes (protoTopLevels pf)-      importedModules = computeImports ctx referencedTypes-      customOpts =-        foldl-          (flip registerCustomOption)-          emptyCustomOptionRegistry-          (extractExtensionOptions pf)-      fileHookCtx =-        FileHookCtx-          { fhcProtoFile = pf-          , fhcModuleName = thisMod-          , fhcFileOptions = protoOptions pf-          , fhcCustomOptions = customOpts-          }-      fileHookOutput = onFileCodeGen (genHooks opts) fileHookCtx-      fileHookDocs = fmap pretty fileHookOutput-  in vsep $-      [ genModuleHeader opts filePath pf-      , mempty-      , genImports importedModules-      , mempty-      , genFileDescriptorBinding filePath pf-      , mempty-      , vsep body-      ]-        <> case fileHookDocs of-          [] -> []-          ds -> [mempty, vsep ds]----- | Generate a complete Haskell module as rendered 'Text' from a proto file.-generateModuleText :: GenerateOpts -> TypeRegistry -> FilePath -> ProtoFile -> Text-generateModuleText opts reg filePath pf =-  renderStrict (layoutPretty defaultLayoutOptions (generateModule opts reg filePath pf))----- Collect all FQ type names defined locally in this file-collectLocalTypes :: Text -> [Text] -> [TopLevel] -> Set Text-collectLocalTypes pkg scope = foldMap go-  where-    go = \case-      TLMessage msg ->-        let scope' = scope <> [msgName msg]-            fqName = if T.null pkg then T.intercalate "." scope' else pkg <> "." <> T.intercalate "." scope'-        in Set.singleton fqName <> foldMap (goElem scope') (msgElements msg)-      TLEnum ed ->-        let scope' = scope <> [enumName ed]-            fqName = if T.null pkg then T.intercalate "." scope' else pkg <> "." <> T.intercalate "." scope'-        in Set.singleton fqName-      _ -> Set.empty-    goElem s = \case-      MEMessage inner ->-        let scope' = s <> [msgName inner]-            fqName = if T.null pkg then T.intercalate "." scope' else pkg <> "." <> T.intercalate "." scope'-        in Set.singleton fqName <> foldMap (goElem scope') (msgElements inner)-      MEEnum ed ->-        let scope' = s <> [enumName ed]-            fqName = if T.null pkg then T.intercalate "." scope' else pkg <> "." <> T.intercalate "." scope'-        in Set.singleton fqName-      _ -> Set.empty----- Collect all FTNamed type references from top-levels. Covers message--- fields (including map values, oneof branches, nested messages) and--- service RPC request/response types — without the service coverage,--- a @.proto@ that defines a service whose inputs and outputs live in--- a separate module would emit the module-header imports block--- without those dependencies, which broke compilation for the--- generated Service modules (they would @import@ their--- RequestResponse module after top-level declarations, which is a--- Haskell parse error).-collectReferencedTypes :: [TopLevel] -> Set Text-collectReferencedTypes = foldMap goTL-  where-    goTL = \case-      TLMessage msg -> goMsg msg-      TLService svc -> foldMap goRpc (svcRpcs svc)-      _ -> Set.empty-    goMsg msg = foldMap goElem (msgElements msg)-    goElem = \case-      MEField fd -> goFT (fieldType fd)-      MEMapField mf -> goFT (mapValueType mf)-      MEOneof od -> foldMap (goFT . oneofFieldType) (oneofFields od)-      MEMessage inner -> goMsg inner-      _ -> Set.empty-    goRpc r = Set.fromList [rpcInput r, rpcOutput r]-    goFT = \case-      FTNamed n -> Set.singleton n-      _ -> Set.empty----- Compute the set of external modules referenced by this file.-computeImports :: GenCtx -> Set Text -> Set Text-computeImports ctx refs =-  let thisMod = gcThisMod ctx-  in Set.fromList-      [ tiModule ti-      | ref <- Set.toList refs-      , Just ti <- [resolveType ctx ref]-      , tiModule ti /= thisMod-      ]----- Resolve a proto type name to TypeInfo. Tries FQ lookup first, then--- with current package prefix, then with parent message scopes, then simple.-resolveType :: GenCtx -> Text -> Maybe TypeInfo-resolveType ctx = resolveTypeWithScope ctx []---resolveTypeWithScope :: GenCtx -> [Text] -> Text -> Maybe TypeInfo-resolveTypeWithScope ctx scope name =-  let reg = gcRegistry ctx-      pkg = fromMaybe "" (gcPkg ctx)-      -- Check inner scopes first (proto type-resolution rule: innermost wins),-      -- then package-qualified, then bare. This ensures a locally-defined nested-      -- type (e.g. FieldDescriptorProto.Type) is preferred over a same-named-      -- top-level type in the same package (e.g. google.protobuf.Type).-      candidates =-        fmap (\s -> pkg <> "." <> T.intercalate "." s <> "." <> name) (filter (not . null) (tails' scope))-          <> [ pkg <> "." <> name-             , name-             ]-  in case firstJust (`Map.lookup` reg) candidates of-      Just ti -> Just ti-      Nothing ->-        let suffix = "." <> name-            matches = fmap snd (filter (\(k, _) -> T.isSuffixOf suffix k || k == name) (Map.toList reg))-        in case matches of-            (ti : _) -> Just ti-            [] -> Nothing-  where-    tails' [] = []-    tails' xs = xs : tails' (init xs)-    firstJust _ [] = Nothing-    firstJust f (x : xs) = case f x of-      Just v -> Just v-      Nothing -> firstJust f xs----- ------------------------------------------------------------------------------ Module header & imports--- -----------------------------------------------------------------------------genModuleHeader :: GenerateOpts -> FilePath -> ProtoFile -> Doc ann-genModuleHeader opts filePath pf =-  let modName = moduleNameForProto opts filePath pf-      pkgDoc = maybe "" (\p -> " from package @" <> p <> "@") (protoPackage pf)-      fo = extractFileOptions (protoOptions pf)-      deprLine =-        if foDeprecated fo-          then [txt "--", txt "-- __This file is deprecated.__"]-          else []-      dupRecordExts = case genFieldNaming opts of-        UnprefixedFields ->-          [ txt "{-# LANGUAGE DuplicateRecordFields #-}"-          , txt "{-# LANGUAGE NoFieldSelectors #-}"-          ]-        PrefixedFields -> []-  in vsep $-      [ txt "{-# LANGUAGE StrictData #-}"-      , txt "{-# LANGUAGE DeriveGeneric #-}"-      , txt "{-# LANGUAGE DeriveAnyClass #-}"-      , txt "{-# LANGUAGE DerivingStrategies #-}"-      , txt "{-# LANGUAGE OverloadedStrings #-}"-      , txt "{-# LANGUAGE OverloadedRecordDot #-}"-      ]-        <> dupRecordExts-        <> [ txt "-- | Auto-generated protobuf types" <> pretty pkgDoc <> txt "."-           , txt "--"-           , txt "-- __THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__"-           , txt "--"-           , txt "-- Any manual changes will be overwritten the next time code"-           , txt "-- generation is run.  To modify the types or instances, edit the"-           , txt "-- @.proto@ source file and re-run the code generator."-           ]-        <> deprLine-        <> [txt "module " <> pretty modName <> txt " where"]---genImports :: Set Text -> Doc ann-genImports externalModules =-  vsep $-    [ txt "import Data.ByteString (ByteString)"-    , txt "import qualified Data.ByteString as BS"-    , txt "import qualified Wireform.Builder as B"-    , txt "import Data.Int (Int32, Int64)"-    , txt "import Data.Text (Text)"-    , txt "import qualified Data.Text as T"-    , txt "import Data.Word (Word8, Word32, Word64)"-    , txt "import qualified Data.IntMap.Strict as IntMap"-    , txt "import qualified Data.Map.Strict as Map"-    , txt "import qualified Data.Vector as V"-    , txt "import qualified Data.Vector.Unboxed as VU"-    , txt "import GHC.Generics (Generic)"-    , txt "import Control.DeepSeq (NFData(..))"-    , txt "import Data.Hashable (Hashable(..))"-    , txt "import Proto.Internal.Encode"-    , txt "import Proto.Internal.Decode"-    , txt "import Proto.Internal.GrowList (GrowList, emptyGrowList, snocGrowList, growListToVector)"-    , txt "import qualified Data.Aeson as Aeson"-    , txt "import qualified Data.Aeson.Types as Aeson"-    , txt "import qualified Data.Aeson.Key as AesonKey"-    , txt "import qualified Data.Aeson.KeyMap as AesonKM"-    , txt "import Proto.Internal.JSON (jsonObject, (.=:), parseFieldMaybe, bytesFieldToJSON, parseBytesFieldMaybe, bytesMapFieldToJSON, parseBytesMapFieldMaybe, protoBytesToJSON, OneofVariantNullSemantics (..), parseOneofVariants)"-    , txt "import Data.Proxy (Proxy(..))"-    , txt "import Proto.Schema (ProtoMessage(..), SomeFieldDescriptor(..), FieldDescriptor(..), FieldTypeDescriptor(..), ScalarFieldType(..), FieldLabel'(..))"-    , txt "import Proto.Registry (IsMessage)"-    , txt "import Proto.Registry qualified"-    , txt "import qualified Proto.Extension"-    , txt "import Proto.Internal.Wire (Tag(..), WireType(..))"-    , txt "import Proto.Internal.Wire.Encode (putTag, putVarint, putFixed32, putFixed64,"-    , txt "  putFloat, putDouble, putText, putByteString, putLengthDelimited,"-    , txt "  putSVarint32, putSVarint64, putVarintSigned,"-    , txt "  varintSize, tagSize,"-    , txt "  varintSize32, zigZag32, zigZag64)"-    , txt "import Proto.Internal.Encode.Archetype (archVarint, archSVarint32, archSVarint64,"-    , txt "  archFixed32, archFixed64, archFloat, archDouble, archBool,"-    , txt "  archString, archBytes, archSubmessage)"-    ]-      <> fmap genQualifiedImport (Set.toAscList externalModules)---genQualifiedImport :: Text -> Doc ann-genQualifiedImport modName =-  txt "import qualified " <> pretty modName <> txt " as " <> pretty (moduleAlias modName)---{- | Derive a short, deterministic alias from a module name.-Strips common prefixes and uses initials for boilerplate segments.--@Proto.Google.Protobuf.WellKnownTypes.Timestamp@             -> @PB_Timestamp@-@Proto.Google.Protobuf.WellKnownTypes.Empty@  -> @PB_WellKnownTypes_Empty@-@Proto.Temporalio.Api.Common.V1.Message@       -> @TA_Common_V1_Message@-@Proto.Temporalio.Api.Enums.V1.Common@         -> @TA_Enums_V1_Common@--}-moduleAlias :: Text -> Text-moduleAlias modName =-  let parts = T.splitOn "." modName-      meaningful = dropBoilerplate parts-  in T.intercalate "_" meaningful-  where-    dropBoilerplate = \case-      ("Proto" : "Google" : "Protobuf" : rest) -> "PB" : rest-      ("Proto" : ns : "Api" : rest) -> initials ns : rest-      ("Proto" : ns : rest) -> initials ns : rest-      ps -> ps-    initials t =-      let uppers = T.filter isAsciiUpper t-      in if T.length uppers >= 2 then uppers else T.toUpper (T.take 2 t)----- | Generate a top-level binding containing the serialized FileDescriptorProto.-genFileDescriptorBinding :: FilePath -> ProtoFile -> Doc ann-genFileDescriptorBinding filePath pf =-  let fdpBytes = serializeFileDescriptor filePath pf-      escapedLit = byteStringToHsLiteral fdpBytes-  in vsep-      [ txt "-- | Serialized FileDescriptorProto for this .proto file."-      , txt "-- Decode with @Proto.Decode.decodeMessage@."-      , txt "fileDescriptorProtoBytes :: ByteString"-      , txt "fileDescriptorProtoBytes = " <> pretty ("\"" :: Text) <> pretty escapedLit <> pretty ("\"" :: Text)-      ]----- | Render a 'ByteString' as a Haskell string literal body using @\\xHH@ escapes.-byteStringToHsLiteral :: BS.ByteString -> Text-byteStringToHsLiteral = T.concat . fmap escapeWord8 . BS.unpack-  where-    escapeWord8 :: Word8 -> Text-    escapeWord8 w =-      let hi = hexNibble (w `div` 16)-          lo = hexNibble (w `mod` 16)-      in T.pack ['\\', 'x', hi, lo]-    hexNibble :: Word8 -> Char-    hexNibble n-      | n < 10 = toEnum (fromEnum '0' + fromIntegral n)-      | otherwise = toEnum (fromEnum 'a' + fromIntegral n - 10)----- ------------------------------------------------------------------------------ Top-level generation--- -----------------------------------------------------------------------------genTopLevel :: GenCtx -> [Text] -> TopLevel -> [Doc ann]-genTopLevel ctx scope = \case-  TLMessage msg -> genMessage ctx scope msg-  TLEnum ed -> genEnum ctx scope ed-  TLService svc -> genServiceTopLevel ctx scope svc-  TLExtend extName fields -> genExtensionBlock ctx scope extName fields-  TLOption _ -> []-  TLComment _ -> []---genMessage :: GenCtx -> [Text] -> MessageDef -> [Doc ann]-genMessage ctx scope msg =-  let scope' = scope <> [msgName msg]-      tyN = scopedTypeName scope'-      nestedDefs = concatMap (genNestedElement ctx scope') (msgElements msg)-      hookCtx =-        MessageHookCtx-          { mhcMessageDef = msg-          , mhcScope = scope'-          , mhcHsTypeName = tyN-          , mhcFqProtoName = fqProtoName (gcPkg ctx) scope'-          , mhcOptions = messageOptions msg-          }-      hookOutput = onMessageCodeGen (genHooks (gcOpts ctx)) hookCtx-      hookDocs = fmap pretty hookOutput-  in [ mempty-     , genMessageDataDecl ctx scope' msg-     ]-      <> nestedDefs-      <> [ mempty-         , genDefaultInstance ctx scope' msg-         , mempty-         -- 'genEncodeInstance' emits a single fused 'buildSized'-         -- method (returning 'SizedBuilder'); 'messageSize' falls-         -- out as a free function over 'buildSized', so the-         -- separate 'MessageSize' instance the codegen used to-         -- emit has been retired. See 'genEncodeInstance' for the-         -- O(N²) → O(N) rationale.-         , genEncodeInstance ctx scope' msg-         , mempty-         , genDecodeInstance ctx scope' msg-         , mempty-         , genProtoMessageInstance ctx scope' msg-         , mempty-         , genIsMessageInstance scope'-         , mempty-         , genToJSONInstance ctx scope' msg-         , mempty-         , genFromJSONInstance ctx scope' msg-         , mempty-         , genHashableInstance ctx scope' msg-         , mempty-         , genHasExtensionsInstance scope' msg-         , mempty-         , genSemigroupInstance ctx scope' msg-         , mempty-         , genMonoidInstance scope'-         ]-      <> case hookDocs of-        [] -> []-        ds -> [mempty, vsep ds]---genNestedElement :: GenCtx -> [Text] -> MessageElement -> [Doc ann]-genNestedElement ctx scope = \case-  MEMessage inner -> genMessage ctx scope inner-  MEEnum ed -> genEnum ctx scope ed-  MEOneof od -> [genOneofDecl ctx scope od, genOneofToJSONInstance ctx scope od, genOneofFromJSONInstance ctx scope od, genOneofHashableInstance ctx scope od]-  _ -> []----- ------------------------------------------------------------------------------ Data declarations--- -----------------------------------------------------------------------------genMessageDataDecl :: GenCtx -> [Text] -> MessageDef -> Doc ann-genMessageDataDecl ctx scope msg =-  let tyN = scopedTypeName scope-      userFields = concatMap (extractFieldDecl ctx scope) (msgElements msg)-      unknownFieldDecl = pretty (unknownFieldAccessor scope) <+> txt "::" <+> txt "![UnknownField]"-      allFields = userFields <> [unknownFieldDecl]-  in vsep $-      haddockDoc (msgDoc msg)-        <> [ txt "data " <> pretty tyN <> txt " = " <> pretty tyN-           , indent 2 (braceBlock allFields)-           , indent 2 (txt "deriving stock (Show, Eq, Generic)")-           , indent 2 (txt "deriving anyclass NFData")-           ]---unknownFieldAccessor :: [Text] -> Text-unknownFieldAccessor scope =-  let prefix = case scope of-        [] -> ""-        [s] -> lowerFirst (hsTypeName s)-        _ -> lowerFirst (T.intercalate "" (fmap hsTypeName scope))-  in prefix <> "UnknownFields"---extractFieldDecl :: GenCtx -> [Text] -> MessageElement -> [Doc ann]-extractFieldDecl ctx scope = \case-  MEField fd -> [genFieldDecl ctx scope fd]-  MEMapField mf -> [genMapFieldDecl ctx scope mf]-  MEOneof od -> [genOneofFieldRef ctx scope od]-  _ -> []---genFieldDecl :: GenCtx -> [Text] -> FieldDef -> Doc ann-genFieldDecl ctx scope fd =-  let fieldLine =-        pretty (ctxFieldName ctx scope (fieldName fd))-          <+> txt "::"-          <+> hsFieldType ctx scope (fieldType fd) (fieldLabel fd)-  in case fieldDoc fd of-      Nothing -> fieldLine-      Just doc ->-        let ls = T.lines doc-        in case ls of-            [] -> fieldLine-            (first_ : rest) ->-              vsep $-                [fieldLine]-                  <> [indent 2 (txt "-- ^ " <> pretty first_)]-                  <> fmap (\l -> indent 2 (txt "-- " <> pretty l)) rest---genMapFieldDecl :: GenCtx -> [Text] -> MapField -> Doc ann-genMapFieldDecl ctx scope mf =-  let fieldLine =-        pretty (ctxFieldName ctx scope (mapFieldName mf))-          <+> txt "::"-          <+> txt "!(Map.Map "-          <> hsScalarType (mapKeyType mf)-          <+> hsFieldTypeInner ctx scope (mapValueType mf)-          <> txt ")"-  in case mapDoc mf of-      Nothing -> fieldLine-      Just doc ->-        let ls = T.lines doc-        in case ls of-            [] -> fieldLine-            (first_ : rest) ->-              vsep $-                [fieldLine]-                  <> [indent 2 (txt "-- ^ " <> pretty first_)]-                  <> fmap (\l -> indent 2 (txt "-- " <> pretty l)) rest---genOneofFieldRef :: GenCtx -> [Text] -> OneofDef -> Doc ann-genOneofFieldRef ctx scope od =-  pretty (ctxFieldName ctx scope (oneofName od))-    <+> txt "::"-    <+> txt "!(Maybe "-    <> pretty (scopedTypeName scope <> "'" <> snakeToPascal (oneofName od))-    <> txt ")"---genOneofDecl :: GenCtx -> [Text] -> OneofDef -> Doc ann-genOneofDecl ctx scope od =-  let tyN = scopedTypeName scope <> "'" <> snakeToPascal (oneofName od)-  in vsep $-      haddockDoc (oneofDoc od)-        <> [ txt "data " <> pretty tyN-           , indent 2 (vsep (concatMap (\(pfx, f) -> (pfx <+> genOneofCon ctx scope f) : haddockFieldDoc (oneofFieldDoc f)) (zip seps (oneofFields od))))-           , indent 2 (txt "deriving stock (Show, Eq, Generic)")-           , indent 2 (txt "deriving anyclass NFData")-           ]-  where-    seps = txt "=" : repeat (txt "|")-    genOneofCon cx s f =-      pretty (oneofConName s (oneofName od) (oneofFieldName f))-        <+> hsOneofFieldType cx s (oneofFieldType f)---{- | Emit a /standalone/ 'Aeson.ToJSON' instance for a oneof carrier.--Proto3 JSON encodes a oneof by inlining the selected branch's key-and value at the /parent/ message level (see-'genToJSONFieldFragment'). When something serialises a oneof sum-value on its own (e.g. for debug printing, or because a user-treats the carrier as a top-level type), we render the same-single-key object: @{ "\<branchJsonKey\>": \<value\> }@. That keeps-the standalone instance compatible with what would have been-emitted inline, and it round-trips through 'parseJSON' below.--If the oneof has no fields (a malformed @oneof X {}@), we emit a-fallback that produces @Aeson.Null@.--}-genOneofToJSONInstance :: GenCtx -> [Text] -> OneofDef -> Doc ann-genOneofToJSONInstance ctx scope od =-  let tyN = scopedTypeName scope <> "'" <> snakeToPascal (oneofName od)-      branches = fmap (oneofBranchToJSON ctx scope (oneofName od)) (oneofFields od)-  in case branches of-      [] ->-        vsep-          [ instanceHead "Aeson.ToJSON" tyN-          , indent 2 (txt "toJSON _ = Aeson.Null")-          ]-      _ ->-        vsep $-          [ instanceHead "Aeson.ToJSON" tyN-          , indent 2 (txt "toJSON v0 = jsonObject (case v0 of")-          ]-            <> fmap (\b -> indent 4 (genOneofStandaloneToJSONArm b)) branches-            <> [indent 4 (txt ")")]----- | One arm of the standalone oneof @toJSON@'s @case v0 of@.-genOneofStandaloneToJSONArm :: JSONOneofBranch -> Doc ann-genOneofStandaloneToJSONArm branch =-  let keyLit = pretty ("\"" :: Text) <> pretty (jobJsonKey branch) <> pretty ("\"" :: Text)-  in case jobShape branch of-      OBSNullValue ->-        pretty (jobConstructor branch) <> txt " _ -> [(" <> keyLit <> txt ", Aeson.Null)]"-      _ ->-        pretty (jobConstructor branch) <> txt " v -> [" <> keyLit <> txt " .=: v]"---{- | Emit a /standalone/ 'Aeson.FromJSON' instance for a oneof-carrier. Symmetric to 'genOneofToJSONInstance': scan the object-for exactly one of the branch keys (via 'parseOneofVariants'), fail-otherwise. Useful for tests and for tooling that needs to parse-a oneof value out of context.--}-genOneofFromJSONInstance :: GenCtx -> [Text] -> OneofDef -> Doc ann-genOneofFromJSONInstance ctx scope od =-  let tyN = scopedTypeName scope <> "'" <> snakeToPascal (oneofName od)-      branches = fmap (oneofBranchToJSON ctx scope (oneofName od)) (oneofFields od)-  in case branches of-      [] ->-        vsep-          [ instanceHead "Aeson.FromJSON" tyN-          , indent 2 (pretty ("parseJSON _ = fail \"Empty oneof has no JSON form\"" :: Text))-          ]-      _ ->-        vsep-          [ instanceHead "Aeson.FromJSON" tyN-          , indent 2 $-              vsep-                [ txt "parseJSON = Aeson.withObject "-                    <> pretty ("\"" :: Text)-                    <> pretty tyN-                    <> pretty ("\"" :: Text)-                    <> txt " $ \\obj -> do"-                , indent 2 $-                    vsep-                      [ txt "mr <- parseOneofVariants obj"-                      , indent 2 $-                          vsep-                            [ txt "[ " <> genOneofBranchParser (head branches)-                            , vsep (fmap (\b -> txt ", " <> genOneofBranchParser b) (tail branches))-                            , txt "]"-                            ]-                      , txt "case mr of"-                      , indent 2 $-                          vsep-                            [ txt "Just v -> pure v"-                            , txt "Nothing -> fail \"Expected one of: "-                                <> pretty (T.intercalate ", " (fmap jobJsonKey branches))-                                <> txt "\""-                            ]-                      ]-                ]-          ]----- ------------------------------------------------------------------------------ Default instances--- -----------------------------------------------------------------------------genDefaultInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann-genDefaultInstance ctx scope msg =-  let tyN = scopedTypeName scope-  in vsep-      [ txt "default" <> pretty tyN <+> txt "::" <+> pretty tyN-      , txt "default" <> pretty tyN <+> txt "=" <+> pretty tyN-      , indent 2 (genDefaultFields ctx scope (msgElements msg))-      ]---genDefaultFields :: GenCtx -> [Text] -> [MessageElement] -> Doc ann-genDefaultFields ctx scope elems =-  let userFields = concatMap extractDefault elems-      unknownDefault = pretty (unknownFieldAccessor scope) <+> txt "=" <+> txt "[]"-      fields = userFields <> [unknownDefault]-  in braceBlock fields-  where-    extractDefault = \case-      MEField fd ->-        [pretty (ctxFieldName ctx scope (fieldName fd)) <+> txt "=" <+> defaultValue ctx (fieldLabel fd) (fieldType fd)]-      MEMapField mf ->-        [pretty (ctxFieldName ctx scope (mapFieldName mf)) <+> txt "=" <+> txt "Map.empty"]-      MEOneof od ->-        [pretty (ctxFieldName ctx scope (oneofName od)) <+> txt "=" <+> txt "Nothing"]-      _ -> []---defaultValue :: GenCtx -> Maybe FieldLabel -> FieldType -> Doc ann-defaultValue ctx lbl ft = case lbl of-  Just Repeated -> case ft of-    FTScalar s | isUnboxableScalar s -> txt "VU.empty"-    _ -> txt "V.empty"-  Just Optional -> txt "Nothing"-  _ -> case ft of-    FTScalar SBool -> txt "False"-    FTScalar SString -> pretty ("\"\"" :: Text)-    FTScalar SBytes -> pretty ("\"\"" :: Text)-    FTScalar _ -> txt "0"-    FTNamed n ->-      case resolveType ctx n of-        Just ti | tiKind ti == TKEnum -> txt "(Prelude.toEnum 0)"-        _ -> txt "Nothing"----- ------------------------------------------------------------------------------ Encode instances--- -----------------------------------------------------------------------------{- | Emit the 'MessageEncode' instance for a message.--The instance defines 'buildSized' — the fused-@(SizedBuilder)@-returning method that carries the message's wire-byte count alongside the byte fragments in a single pass. The-default 'buildMessage' / 'messageSize' implementations off-'MessageEncode' compose from 'buildSized' for free, so the-codegen never needs to emit a separate @MessageSize@ instance or-duplicate the field-walk into two parallel functions. The old-'O(N²)' shape (parent calls @messageSize child@ which traverses-the entire subtree, then 'buildMessage' traverses the subtree-again) is replaced by a single 'O(N)' fused traversal.--}-genEncodeInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann-genEncodeInstance ctx scope msg =-  let tyN = scopedTypeName scope-      fields = extractAllFields ctx scope (msgElements msg)-      unknownAcc = "msg." <> unknownFieldAccessor scope-  in vsep-      [ instanceHead "MessageEncode" tyN-      , indent 2 $-          vsep-            [ txt "buildSized msg ="-            , indent 2 $ case fields of-                [] -> txt "encodeUnknownFieldsSized " <> pretty unknownAcc-                _ ->-                  vsep-                    ( zipWith (genFieldBuild ctx) [0 ..] fields-                        <> [txt "<> encodeUnknownFieldsSized " <> pretty unknownAcc]-                    )-            ]-      ]---genFieldBuild :: GenCtx -> Int -> FieldInfoFull -> Doc ann-genFieldBuild ctx idx fi =-  let op = if idx == 0 then mempty else txt "<> "-      accessor = "msg." <> fifAccessor fi-      fn = T.pack (show (fifFieldNum fi))-  in op <> case fifKind fi of-      FKScalar lbl ft -> genBuildExprScalar ctx fn accessor lbl ft-      FKNamed lbl name tk -> genBuildExprNamed ctx fn accessor lbl name tk-      FKMap keyT valT -> genBuildExprMap ctx fn accessor keyT valT-      FKOneof scope ood -> genBuildExprOneof ctx scope fn accessor ood---genBuildExprScalar :: GenCtx -> Text -> Text -> Maybe FieldLabel -> ScalarType -> Doc ann-genBuildExprScalar ctx fn accessor lbl st = case lbl of-  Just Repeated -> genRepeatedScalarBuild (genPackedRepeated (gcOpts ctx)) fn accessor st-  Just Optional -> txt "(maybe mempty (\\v -> " <> genSingleScalarBuild fn "v" st <> txt ") " <> pretty accessor <> txt ")"-  _ -> txt "(if " <> scalarDefaultCheck accessor st <> txt " then mempty else " <> genSingleScalarBuild fn accessor st <> txt ")"---genBuildExprNamed :: GenCtx -> Text -> Text -> Maybe FieldLabel -> Text -> TypeKind -> Doc ann-genBuildExprNamed ctx fn accessor lbl name tk = case tk of-  TKEnum ->-    -- Use toProtoEnum<TypeName> to get the wire value. The derived Haskell-    -- 'fromEnum' gives a 0-based constructor index, which is wrong when the-    -- proto enum's first value isn't 0 (e.g. FieldDescriptorProto.Type-    -- starts at 1). toProtoEnum<T> always returns the correct wire value.-    let toProto = case resolveType ctx name of-          Just ti -> txt "toProtoEnum" <> pretty (tiHsName ti)-          Nothing -> txt "Prelude.fromEnum" -- fallback (shouldn't happen)-    in case lbl of-    Just Repeated ->-      txt "V.foldl' (\\acc v -> acc <> archVarint "-        <> tagLit fn wireVarint-        <+> txt "(fromIntegral (" <> toProto <+> txt "v))) mempty "-        <> pretty accessor-    Just Optional ->-      txt "(maybe mempty (\\v -> archVarint "-        <> tagLit fn wireVarint-        <+> txt "(fromIntegral (" <> toProto <+> txt "v))) "-        <> pretty accessor-        <> txt ")"-    _ ->-      txt "(if "-        <> toProto-        <+> pretty accessor-        <> txt " == 0 then mempty else archVarint "-        <> tagLit fn wireVarint-        <+> txt "(fromIntegral ("-        <> toProto-        <+> pretty accessor-        <> txt ")))"-  TKMessage -> case lbl of-    -- New shape: 'archSubmessage' takes the child's SizedBuilder-    -- directly. The size flows up from the child's own 'buildSized'-    -- traversal — no separate @messageSize@ pre-pass.-    Just Repeated -> txt "V.foldl' (\\acc v -> acc <> archSubmessage " <> tagLit fn wireLengthDelimited <+> txt "(buildSized v)) mempty " <> pretty accessor-    Just Optional -> txt "(maybe mempty (\\v -> archSubmessage " <> tagLit fn wireLengthDelimited <+> txt "(buildSized v)) " <> pretty accessor <> txt ")"-    _ -> txt "(maybe mempty (\\v -> archSubmessage " <> tagLit fn wireLengthDelimited <+> txt "(buildSized v)) " <> pretty accessor <> txt ")"---genBuildExprMap :: GenCtx -> Text -> Text -> ScalarType -> FieldType -> Doc ann-genBuildExprMap ctx fn accessor keyT valT =-  -- Map field: fold over the entries, fusing each (key, value)-  -- pair into a 'SizedBuilder' submessage via 'mapField'.-  -- Keys go in slot 1 and values in slot 2 of the entry; both are-  -- encoded via @sizedFieldX@ helpers so each entry's wire size is-  -- known without a separate pass.-  txt "Map.foldlWithKey' (\\acc k v -> acc <> mapField "-    <> pretty fn-    <> txt " ("-    <> genMapKeyEncode keyT-    <> txt " k) ("-    <> genMapValEncode ctx valT-    <> txt " v)) mempty "-    <> pretty accessor----- | Sized-encoder for a map key (always at field number 1 inside the--- entry submessage). Returns a partially-applied @sizedFieldX 1@ so--- the caller can supply the key value.-genMapKeyEncode :: ScalarType -> Doc ann-genMapKeyEncode st = case st of-  SString -> txt "fieldString 1"-  SBool -> txt "fieldBool 1"-  SInt32 -> txt "(\\x -> fieldVarint 1 (fromIntegral x))"-  SInt64 -> txt "(\\x -> fieldVarint 1 (fromIntegral x))"-  SUInt32 -> txt "(\\x -> fieldVarint 1 (fromIntegral x))"-  SUInt64 -> txt "fieldVarint 1"-  SSInt32 -> txt "fieldSVarint32 1"-  SSInt64 -> txt "fieldSVarint64 1"-  SFixed32 -> txt "fieldFixed32 1"-  SFixed64 -> txt "fieldFixed64 1"-  SSFixed32 -> txt "(\\x -> fieldFixed32 1 (fromIntegral x))"-  SSFixed64 -> txt "(\\x -> fieldFixed64 1 (fromIntegral x))"-  _ -> txt "fieldBytes 1"----- | Sized-encoder for a map value (always at field number 2 inside--- the entry submessage).-genMapValEncode :: GenCtx -> FieldType -> Doc ann-genMapValEncode ctx = \case-  FTScalar st -> genMapValEncodeScalar 2 st-  FTNamed n -> case resolveType ctx n of-    Just ti | tiKind ti == TKEnum ->-      txt "(\\x -> fieldVarint 2 (fromIntegral (toProtoEnum" <> pretty (tiHsName ti) <+> txt "x)))"-    -- Submessage value: build the child as a SizedBuilder and wrap-    -- with the slot-2 length prefix via 'fieldMessage'.-    _ -> txt "(fieldMessage 2 . buildSized)"-  where-    genMapValEncodeScalar :: Int -> ScalarType -> Doc ann-    genMapValEncodeScalar fn st = case st of-      SString -> txt "fieldString " <> pretty (T.pack (show fn))-      SBytes -> txt "fieldBytes " <> pretty (T.pack (show fn))-      SBool -> txt "fieldBool " <> pretty (T.pack (show fn))-      SDouble -> txt "fieldDouble " <> pretty (T.pack (show fn))-      SFloat -> txt "fieldFloat " <> pretty (T.pack (show fn))-      SFixed32 -> txt "fieldFixed32 " <> pretty (T.pack (show fn))-      SFixed64 -> txt "fieldFixed64 " <> pretty (T.pack (show fn))-      SSFixed32 -> txt "fieldFixed32 " <> pretty (T.pack (show fn)) <> txt " . fromIntegral"-      SSFixed64 -> txt "fieldFixed64 " <> pretty (T.pack (show fn)) <> txt " . fromIntegral"-      _ -> txt "fieldVarint " <> pretty (T.pack (show fn)) <> txt " . fromIntegral"---genBuildExprOneof :: GenCtx -> [Text] -> Text -> Text -> OneofDef -> Doc ann-genBuildExprOneof ctx scope _fn accessor ood =-  txt "(case "-    <> pretty accessor-    <> txt " of"-    <> line-    <> indent-      2-      ( vsep-          ( txt "Nothing -> mempty"-              : fmap (genOneofArmEncode ctx scope (oneofName ood)) (oneofFields ood)-          )-      )-    <> txt ")"---genOneofArmEncode :: GenCtx -> [Text] -> Text -> OneofField -> Doc ann-genOneofArmEncode ctx scope ooName f =-  let conName = oneofConName scope ooName (oneofFieldName f)-      fn = T.pack (show (unFieldNumber (oneofFieldNumber f)))-  in txt "Just ("-      <> pretty conName-      <+> txt "v) -> "-      <> case oneofFieldType f of-        FTScalar st -> genSingleScalarBuild fn "v" st-        FTNamed n -> case resolveType ctx n of-          Just ti-            | tiKind ti == TKEnum ->-                txt "archVarint " <> tagLit fn wireVarint <+> txt "(fromIntegral (toProtoEnum" <> pretty (tiHsName ti) <+> txt "v))"-          -- Submessage variant: hand the child's SizedBuilder-          -- straight to 'archSubmessage'. No separate size pass.-          _ -> txt "archSubmessage " <> tagLit fn wireLengthDelimited <+> txt "(buildSized v)"---genSingleScalarBuild :: Text -> Text -> ScalarType -> Doc ann-genSingleScalarBuild fn accessor = \case-  SDouble -> txt "archDouble " <> tagLit fn wire64Bit <+> pretty accessor-  SFloat -> txt "archFloat " <> tagLit fn wire32Bit <+> pretty accessor-  SInt32 -> txt "archVarint " <> tagLit fn wireVarint <+> txt "(fromIntegral " <> pretty accessor <> txt ")"-  SInt64 -> txt "archVarint " <> tagLit fn wireVarint <+> txt "(fromIntegral " <> pretty accessor <> txt ")"-  SUInt32 -> txt "archVarint " <> tagLit fn wireVarint <+> txt "(fromIntegral " <> pretty accessor <> txt ")"-  SUInt64 -> txt "archVarint " <> tagLit fn wireVarint <+> pretty accessor-  SSInt32 -> txt "archSVarint32 " <> tagLit fn wireVarint <+> pretty accessor-  SSInt64 -> txt "archSVarint64 " <> tagLit fn wireVarint <+> pretty accessor-  SFixed32 -> txt "archFixed32 " <> tagLit fn wire32Bit <+> pretty accessor-  SFixed64 -> txt "archFixed64 " <> tagLit fn wire64Bit <+> pretty accessor-  SSFixed32 -> txt "archFixed32 " <> tagLit fn wire32Bit <+> txt "(fromIntegral " <> pretty accessor <> txt ")"-  SSFixed64 -> txt "archFixed64 " <> tagLit fn wire64Bit <+> txt "(fromIntegral " <> pretty accessor <> txt ")"-  SBool -> txt "archBool " <> tagLit fn wireVarint <+> pretty accessor-  SString -> txt "archString " <> tagLit fn wireLengthDelimited <+> pretty accessor-  SBytes -> txt "archBytes " <> tagLit fn wireLengthDelimited <+> pretty accessor---genRepeatedScalarBuild :: Bool -> Text -> Text -> ScalarType -> Doc ann-genRepeatedScalarBuild packed fn accessor = \case-  SString ->-    txt "V.foldl' (\\acc v -> acc <> archString " <> tagLit fn wireLengthDelimited <+> txt "v) mempty " <> pretty accessor-  SBytes ->-    txt "V.foldl' (\\acc v -> acc <> archBytes " <> tagLit fn wireLengthDelimited <+> txt "v) mempty " <> pretty accessor-  s ->-    if packed-      then txt "encode" <> pretty (packedFnName s) <+> pretty fn <+> pretty accessor-      else-        -- Expanded encoding: one tag-value pair per element (proto2 style).-        txt "(VU.foldl' (\\acc v -> acc <> " <> genSingleScalarBuild fn "v" s <> txt ") mempty " <> pretty accessor <> txt ")"---scalarDefaultCheck :: Text -> ScalarType -> Doc ann-scalarDefaultCheck accessor = \case-  SBool -> pretty accessor <+> txt "== False"-  SString -> pretty accessor <+> txt "== T.empty"-  SBytes -> txt "BS.null " <> pretty accessor-  _ -> pretty accessor <+> txt "== 0"---packedFnName :: ScalarType -> Text-packedFnName = \case-  SDouble -> "PackedDouble"-  SFloat -> "PackedFloat"-  SInt32 -> "PackedInt32"-  SInt64 -> "PackedInt64"-  SUInt32 -> "PackedWord32"-  SUInt64 -> "PackedWord64"-  SSInt32 -> "PackedSVarint32"-  SSInt64 -> "PackedSVarint64"-  SFixed32 -> "PackedFixed32"-  SFixed64 -> "PackedFixed64"-  SSFixed32 -> "PackedFixed32"-  SSFixed64 -> "PackedFixed64"-  SBool -> "PackedBool"-  s -> error ("Cannot pack: " <> show s)----- ------------------------------------------------------------------------------ Decode instances--- ------------------------------------------------------------------------------- | Binding threaded through textual @messageDecoder@ (fast path and--- generic @loop@): starts at @default\<Ty\>@ and is refined with record--- updates after each decoded field. Using the message type itself keeps--- arity fixed at one and avoids each fast-path stage closing over every--- accumulator parameter (which used to make GHC's simplifier blow up on--- large descriptors).-decodeThreadMsg :: Text-decodeThreadMsg = "msg"---- | Marker in fast-path @fpsWrap@ strings from 'eligibleStage' —--- substituted with 'decodeThreadMsg' when emitting @inOrderStage@--- continuations (repeated slots need the previous field value).-decodeAccPlaceholder :: Text-decodeAccPlaceholder = "__DEC_MSG__"----- ------------------------------------------------------------------------------ GrowList accumulator parameters--- -----------------------------------------------------------------------------{- | One @GrowList@-backed accumulator parameter threaded through the-decoder for a repeated unpacked boxed field (repeated message, repeated-string, repeated bytes).--For these field kinds, the previous @V.snoc@ approach was O(n²) — every-append copied the full vector. @GrowAccum@ replaces the vector with a-difference-list (@GrowList@) that is O(1) per snoc and converted to the-final @V.Vector@ only at end-of-input.--Repeated packed scalars and repeated enums do /not/ get a @GrowAccum@-— their fast path already returns the full vector in one shot via the-packed decoder, so the per-element append path is rare (non-conforming-writers only) and not worth complicating.--}-data GrowAccum = GrowAccum-  { gaName :: !Text-  -- ^ Parameter name in generated code, e.g. @\"gl_0\"@.-  , gaFieldNum :: !Int-  -- ^ Proto field number, used to match the field in the generic loop.-  , gaAccessor :: !Text-  -- ^ Record field accessor, e.g. @\"withRepeatedTags\"@.-  }----- | Collect 'GrowAccum' descriptors for the fields of a message that--- benefit from @GrowList@ accumulation.  Each repeated unpacked boxed--- field gets one entry.-collectGrowAccums :: [FieldInfoFull] -> [GrowAccum]-collectGrowAccums flds =-  let eligible fi = case fifKind fi of-        FKNamed (Just Repeated) _ TKMessage -> True-        FKScalar (Just Repeated) SString -> True-        FKScalar (Just Repeated) SBytes -> True-        _ -> False-      makeAcc i fi = GrowAccum-        { gaName = "gl_" <> T.pack (show (i :: Int))-        , gaFieldNum = fifFieldNum fi-        , gaAccessor = fifAccessor fi-        }-  in zipWith makeAcc [0 ..] (filter eligible flds)----- | Render the GrowList argument list as a space-separated suffix for--- a stage or loop call, e.g. @\" gl_0 gl_1\"@.  Empty string when there--- are no accumulators.-growAccumArgs :: [GrowAccum] -> Text-growAccumArgs [] = ""-growAccumArgs gas = " " <> T.unwords (fmap gaName gas)----- | Build the @pure (msg { … })@ EOI expression that:---   (1) restores every GrowList field to a proper @V.Vector@, and---   (2) reverses the unknown-fields accumulator.------ When there are no GrowList fields, we optimise the common case where--- @unknownFields@ is empty: emit @case msg.unknownFld of { [] -> msg; _ -> … }@--- so GHC can statically eliminate the record reconstruction when no unknown--- fields were seen (the fast path for well-formed messages).-buildResultExpr :: Text -> Text -> [GrowAccum] -> Text-buildResultExpr msgVar unknownFld gas =-  let glParts = fmap (\ga ->-        gaAccessor ga <> " = growListToVector " <> gaName ga) gas-      fullUpdate = msgVar <> " { " <> T.intercalate ", " (glParts <> [ufPart]) <> " }"-        where ufPart = unknownFld <> " = reverse (" <> msgVar <> "." <> unknownFld <> ")"-  in if null gas-      -- No GrowList fields: can skip record reconstruction when unknowns empty.-      then "(pure (case " <> msgVar <> "." <> unknownFld <> " of { [] -> " <> msgVar-           <> "; _ -> " <> msgVar <> " { " <> unknownFld <> " = reverse (" <> msgVar-           <> "." <> unknownFld <> ") } }))"-      -- GrowList fields must be converted regardless; include the null-check too.-      else "(pure (case " <> msgVar <> "." <> unknownFld <> " of { [] -> "-           <> msgVar <> " { " <> T.intercalate ", " (fmap (\ga -> gaAccessor ga <> " = growListToVector " <> gaName ga) gas) <> " }"-           <> "; _ -> " <> fullUpdate <> " }))"--msgFieldProj :: Text -> Text -> Text-msgFieldProj msgVar fieldAcc = msgVar <> "." <> fieldAcc--msgFieldUpdate :: Text -> Text -> Text -> Text-msgFieldUpdate msgVar fieldAcc rhs =-  "(" <> msgVar <> " { " <> fieldAcc <> " = " <> rhs <> "})"--substDecodeMsg :: Text -> Text -> Text-substDecodeMsg msgVar = T.replace decodeAccPlaceholder msgVar--{- | Emit the 'MessageDecode' instance for a message.--The decoder has a two-tier shape:--1. A chain of /per-field stage functions/ (@stage_0@, @stage_1@, …)-   that implement the hyperpb-style in-order tag predictor — each-   stage tries the precomputed varint-encoded tag for the next-   field /before/ falling back to the generic loop.--2. The generic @loop@, exactly as before — reads a tag, dispatches-   to the right field handler, handles repeated\/map\/oneof fields,-   collects unknown fields. This is the correctness backbone; the-   stages only ever short-circuit /well-formed/ in-order input.--A stage function is only emitted for a contiguous prefix of fields-that are eligible for the fast path (singular scalars, singular-messages, singular enums, repeated scalars/messages/enums with the-appropriate @inOrderStage@ shape, and oneofs via a chained predictor-per variant). Ineligible fields (currently: @map@ entries) end the-prefix; decoding continues in the generic @loop@, which handles every-wire shape.--}-genDecodeInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann-genDecodeInstance ctx scope msg =-  let tyN = scopedTypeName scope-      fields = extractAllFields ctx scope (msgElements msg)-      unknownFieldName = unknownFieldAccessor scope-      msgVar = decodeThreadMsg-      gas = collectGrowAccums fields-      fpStages = fastPathStages ctx fields-      -- Entry call: "stage_0 defaultTy emptyGrowList emptyGrowList …"-      -- or "loop defaultTy emptyGrowList …" when there are no fast-path stages.-      entryFn = case fpStages of [] -> "loop"; _ -> "stage_0"-      initAccumArgs = if null gas then "" else " " <> T.unwords (replicate (length gas) "emptyGrowList")-      entryCall = txt entryFn <+> txt "default" <> pretty tyN <> txt initAccumArgs-      -- end-of-input expression shared by all stages and the loop-      buildResultDoc = txt (buildResultExpr msgVar unknownFieldName gas)-      -- loop signature: "loop msg gl_0 gl_1 …"-      loopSig = txt "loop " <> pretty msgVar <> txt (growAccumArgs gas)-      genericLoop =-        vsep-          [ loopSig <+> txt "= withTagM"-          , indent 2 $-              vsep-                [ buildResultDoc-                , txt "(\\fn wt -> case fn of"-                , indent 2 $-                    vsep (concatMap (genFieldDecodeCase ctx gas msgVar) fields <> [genDefaultDecodeCase scope gas msgVar])-                    <> txt ")"-                ]-          ]-      stageDocs = fmap (genFastPathStage ctx tyN fields msgVar gas buildResultDoc fpStages) fpStages-      -- INLINE on small messages: GHC inlines the full decoder at the-      -- call site so it can specialize, eliminate intermediate branches,-      -- and keep values in registers. Benchmarks confirm this is-      -- measurably faster than INLINABLE or no pragma for the common-      -- sub-8-field message. Large messages cap here to avoid compile-      -- time explosion (Descriptor.hs has 30+ fields).-      decoderPragma =-        if length fields <= fastPathMaxStages-          then [txt "{-# INLINE messageDecoder #-}"]-          else []-  in vsep-      [ instanceHead "MessageDecode" tyN-      , indent 2 $-          vsep $-            decoderPragma-              <> [ txt "messageDecoder = " <> entryCall-                 , indent 2 $ txt "where"-                 ]-              <> fmap (indent 4) stageDocs-              <> [indent 4 genericLoop]-      ]----- ------------------------------------------------------------------------------ In-order tag predictor (hyperpb-style fast path)--- -----------------------------------------------------------------------------data FastPathStageKind-  = SingularField-  | RepeatedUnpacked-  | RepeatedPacked-  | OneofStage-  deriving stock (Show, Eq)---data OneofBranch = OneofBranch-  { obExpected :: !Word64-  , obMask :: !Word64-  , obTagLen :: !Int-  , obDecoder :: !Text-  , obWrap :: !Text-  }---data FastPathStage = FastPathStage-  { fpsField :: !FieldInfoFull-  , fpsKind :: !FastPathStageKind-  , fpsBranches :: ![OneofBranch]-  , fpsExpected :: !Word64-  , fpsMask :: !Word64-  , fpsTagLen :: !Int-  , fpsValueDecoder :: !Text-  , fpsWrap :: !Text-  }---fastPathMaxStages :: Int-fastPathMaxStages = 8---fastPathStages :: GenCtx -> [FieldInfoFull] -> [FastPathStage]-fastPathStages ctx = take fastPathMaxStages . go-  where-    go [] = []-    go (fi : rest) = case eligibleStage ctx fi of-      Nothing -> []-      Just s -> s : go rest---eligibleStage :: GenCtx -> FieldInfoFull -> Maybe FastPathStage-eligibleStage ctx fi = case fifKind fi of-  FKScalar (Just Repeated) ft ->-    let snocFp = if isUnboxableScalar ft then "VU.snoc" else "V.snoc"-        isPackable = case ft of-          SString -> False-          SBytes -> False-          _ -> True-    in if isPackable-        then-          Just $-            mkStage-              RepeatedPacked-              (fifFieldNum fi)-              WireLengthDelimited-              (scalarPackedDecoderExpr ft)-              "v"-        else-          Just $-            mkStage-              RepeatedUnpacked-              (fifFieldNum fi)-              (scalarWireTypeFor ft)-              (scalarDecoderExpr ft)-              ("(" <> snocFp <> " " <> decodeAccPlaceholder <> "." <> fifAccessor fi <> " v)")-  FKScalar lbl ft ->-    let wt = scalarWireTypeFor ft-        wrap = case lbl of-          Just Optional -> "(Just v)"-          _ -> "v"-    in Just (mkStage SingularField (fifFieldNum fi) wt (scalarDecoderExpr ft) wrap)-  FKNamed (Just Repeated) _ TKMessage ->-    Just $-      mkStage-        RepeatedUnpacked-        (fifFieldNum fi)-        WireLengthDelimited-        "decodeFieldMessage"-        ("(V.snoc " <> decodeAccPlaceholder <> "." <> fifAccessor fi <> " v)")-  FKNamed (Just Repeated) _ TKEnum ->-    Just $-      mkStage-        RepeatedUnpacked-        (fifFieldNum fi)-        WireVarint-        "decodeFieldEnum"-        ("(V.snoc " <> decodeAccPlaceholder <> "." <> fifAccessor fi <> " v)")-  FKNamed lbl _ tk ->-    let wt = case tk of TKMessage -> WireLengthDelimited; TKEnum -> WireVarint-        decoder = case tk of TKMessage -> "decodeFieldMessage"; TKEnum -> "decodeFieldEnum"-        wrap = case (lbl, tk) of-          (Just Optional, _) -> "(Just v)"-          (_, TKMessage) -> "(Just v)"-          _ -> "v"-    in Just (mkStage SingularField (fifFieldNum fi) wt decoder wrap)-  FKMap _ _ -> Nothing-  FKOneof scope ood ->-    let branches = fmap (oneofBranch scope (oneofName ood)) (oneofFields ood)-    in if null branches-        then Nothing-        else-          Just $-            FastPathStage-              { fpsField = fi-              , fpsKind = OneofStage-              , fpsBranches = branches-              , fpsExpected = 0-              , fpsMask = 0-              , fpsTagLen = 0-              , fpsValueDecoder = ""-              , fpsWrap = ""-              }-  where-    oneofBranch oscope ooName oof =-      let conName = oneofConName oscope ooName (oneofFieldName oof)-          (wt, decoder) = case oneofFieldType oof of-            FTScalar st -> (scalarWireTypeFor st, scalarDecoderExpr st)-            FTNamed n -> case resolveType ctx n of-              Just ti | tiKind ti == TKEnum -> (WireVarint, "decodeFieldEnum")-              _ -> (WireLengthDelimited, "decodeFieldMessage")-          (expected, mask, tagLen) = tagVarintToWord64 (unFieldNumber (oneofFieldNumber oof)) wt-      in OneofBranch-          { obExpected = expected-          , obMask = mask-          , obTagLen = tagLen-          , obDecoder = decoder-          , obWrap = "(Just (" <> conName <> " v))"-          }--    mkStage kind fieldNum wt decoder wrap =-      let (expected, mask, tagLen) = tagVarintToWord64 fieldNum wt-      in FastPathStage-          { fpsField = fi-          , fpsKind = kind-          , fpsBranches = []-          , fpsExpected = expected-          , fpsMask = mask-          , fpsTagLen = tagLen-          , fpsValueDecoder = decoder-          , fpsWrap = wrap-          }---scalarWireTypeFor :: ScalarType -> WireType-scalarWireTypeFor = \case-  SDouble -> Wire64Bit-  SFixed64 -> Wire64Bit-  SSFixed64 -> Wire64Bit-  SFloat -> Wire32Bit-  SFixed32 -> Wire32Bit-  SSFixed32 -> Wire32Bit-  SString -> WireLengthDelimited-  SBytes -> WireLengthDelimited-  _ -> WireVarint---wireTypeNum :: WireType -> Int-wireTypeNum = \case-  WireVarint -> 0-  Wire64Bit -> 1-  WireLengthDelimited -> 2-  WireStartGroup -> 3-  WireEndGroup -> 4-  Wire32Bit -> 5---tagVarintToWord64 :: Int -> WireType -> (Word64, Word64, Int)-tagVarintToWord64 fieldNum wt =-  let tagVal = fromIntegral fieldNum * 8 + fromIntegral (wireTypeNum wt) :: Word64-      bytes = varintEncode tagVal-      tagLen = length bytes-      expected = foldl' (\acc (i, b) -> acc .|. (fromIntegral b `shiftL` (8 * i))) 0 (zip [0 ..] bytes)-      mask = if tagLen >= 8 then maxBound else (1 `shiftL` (8 * tagLen)) - 1-  in (expected, mask, tagLen)---varintEncode :: Word64 -> [Word8]-varintEncode n-  | n < 0x80 = [fromIntegral n]-  | otherwise = fromIntegral (n .&. 0x7F .|. 0x80) : varintEncode (n `shiftR` 7)---genFastPathStage-  :: GenCtx-  -> Text-  -> [FieldInfoFull]-  -> Text-  -> [GrowAccum]-  -> Doc ann-  -> [FastPathStage]-  -> FastPathStage-  -> Doc ann-genFastPathStage _ctx _tyN _fields msgVar gas buildResultDoc allStages stage =-  let fi = fpsField stage-      idx = fifIndex fi-      fldAcc = fifAccessor fi-      stageName = "stage_" <> T.pack (show idx)-      lastIdx = fifIndex (fpsField (last allStages))-      isLastStage = idx == lastIdx-      -- Loop / stage calls carry all GrowAccum args after the message var.-      accArgs = growAccumArgs gas-      loopFallback = txt "(loop " <> pretty msgVar <> txt (accArgs <> ")")-      -- Stage header: "stage_N msg gl_0 gl_1 … ="-      stageHeader = pretty stageName <+> pretty msgVar <> txt (accArgs <> " =")-      -- Look up the GrowAccum for a given field number (if any).-      gaFor :: Int -> Maybe GrowAccum-      gaFor fn = foldr (\ga _ -> Just ga) Nothing (filter (\ga -> gaFieldNum ga == fn) gas)-      bumpMsg :: Text -> Text-      bumpMsg wrapText =-        msgFieldUpdate msgVar fldAcc (substDecodeMsg msgVar wrapText)-      stageBody = case fpsKind stage of-        OneofStage -> emitOneofChain idx (fpsBranches stage) isLastStage-        _ -> emitSingleStage stage isLastStage idx-      emitSingleStage st isLast i =-        -- For a RepeatedUnpacked field that has a GrowAccum, the kHit-        -- updates the accumulator parameter (snocGrowList) instead of-        -- doing a V.snoc record update.-        let mGa = gaFor (fifFieldNum (fpsField st))-            -- Build the advance/same-stage call with all GrowAccum args.-            callWithAccs pfx = txt pfx <> pretty msgVar <> txt accArgs-            advanceCallFor msgArg =-              if isLast-                then txt "loop " <> txt msgArg <> txt accArgs-                else txt "stage_" <> pretty (T.pack (show (i + 1))) <+> txt msgArg <> txt accArgs-            -- For singular/packed: bump msg record, advance to next stage.-            msgBumped = msgFieldUpdate msgVar fldAcc (substDecodeMsg msgVar (fpsWrap st))-            -- For GrowList repeated: snoc into the accumulator, recurse same stage.-            kHit = case (fpsKind st, mGa) of-              (RepeatedUnpacked, Just ga) ->-                -- Replace the accumulator param for this field; leave msg unchanged.-                let newAcc = "(snocGrowList " <> gaName ga <> " v)"-                    accArgs' = " " <> T.unwords (fmap (\g -> if gaName g == gaName ga then newAcc else gaName g) gas)-                in txt "(\\v -> " <> pretty stageName <+> pretty msgVar <> txt accArgs' <> txt ")"-              (RepeatedUnpacked, Nothing) ->-                -- No GrowAccum (packed scalar fallback) — V.snoc as before.-                let msgBumped' = bumpMsg (fpsWrap st)-                in txt "(\\v -> " <> pretty stageName <+> txt msgBumped' <> txt accArgs <> txt ")"-              (SingularField, _) ->-                txt "(\\v -> " <> advanceCallFor msgBumped <> txt ")"-              (RepeatedPacked, _) ->-                txt "(\\v -> " <> advanceCallFor msgBumped <> txt ")"-              (OneofStage, _) -> txt "(error \"OneofStage uses emitOneofChain\")"-        in if fpsTagLen st == 1-            -- 1-byte tag (field numbers 1–15): skip the Word64 load+mask,-            -- use a direct byte comparison via the specialised variant.-            then vsep-              [ txt "inOrderStage1"-              , indent 2 $-                  vsep-                    [ pretty ("(0x" <> T.pack (showHex (fpsExpected st) "") <> " :: Data.Word.Word8)")-                    , pretty (fpsValueDecoder st)-                    , kHit-                    , buildResultDoc-                    , loopFallback-                    ]-              ]-            else vsep-              [ txt "inOrderStage"-              , indent 2 $-                  vsep-                    [ pretty (word64Lit (fpsExpected st))-                    , pretty (word64Lit (fpsMask st))-                    , pretty (T.pack (show (fpsTagLen st)))-                    , pretty (fpsValueDecoder st)-                    , kHit-                    , buildResultDoc-                    , loopFallback-                    ]-              ]-      emitOneofChain i branches isLast =-        let advanceWith wrap =-              let msgBumped = msgFieldUpdate msgVar fldAcc (substDecodeMsg msgVar wrap)-              in if isLast-                  then txt "loop " <> pretty msgBumped <> txt accArgs-                  else txt "stage_" <> pretty (T.pack (show (i + 1))) <+> pretty msgBumped <> txt accArgs-            go [] = loopFallback-            go (b : bs) =-              if obTagLen b == 1-                then vsep-                  [ txt "inOrderStage1"-                  , indent 2 $-                      vsep-                        [ pretty ("(0x" <> T.pack (showHex (obExpected b) "") <> " :: Data.Word.Word8)")-                        , pretty (obDecoder b)-                        , txt "(\\v -> " <> advanceWith (obWrap b) <> txt ")"-                        , buildResultDoc-                        , parens (go bs)-                        ]-                  ]-                else vsep-                  [ txt "inOrderStage"-                  , indent 2 $-                      vsep-                        [ pretty (word64Lit (obExpected b))-                        , pretty (word64Lit (obMask b))-                        , pretty (T.pack (show (obTagLen b)))-                        , pretty (obDecoder b)-                        , txt "(\\v -> " <> advanceWith (obWrap b) <> txt ")"-                        , buildResultDoc-                        , parens (go bs)-                        ]-                  ]-        in go branches-  in vsep [stageHeader, indent 2 stageBody]---word64Lit :: Word64 -> Text-word64Lit n = "0x" <> T.pack (showHex n "")-----genFieldDecodeCase :: GenCtx -> [GrowAccum] -> Text -> FieldInfoFull -> [Doc ann]-genFieldDecodeCase ctx gas msgVar fi =-  let gaFor fn = foldr (\ga _ -> Just ga) Nothing (filter (\ga -> gaFieldNum ga == fn) gas)-      loopCall msgExpr = "loop " <> msgExpr <> growAccumArgs gas-  in case fifKind fi of-    FKScalar lbl ft -> [genScalarDecodeCase gas msgVar fi lbl ft loopCall]-    FKNamed lbl name tk -> [genNamedDecodeCase gas ctx msgVar fi lbl name tk loopCall gaFor]-    FKMap keyT valT -> [genMapDecodeCase gas ctx msgVar fi keyT valT loopCall]-    FKOneof scope ood -> concatMap (genOneofDecodeCase gas ctx scope (oneofName ood) msgVar fi loopCall) (oneofFields ood)---genScalarDecodeCase :: [GrowAccum] -> Text -> FieldInfoFull -> Maybe FieldLabel -> ScalarType -> (Text -> Text) -> Doc ann-genScalarDecodeCase gas msgVar fi lbl st loopCall =-  let fn = T.pack (show (fifFieldNum fi))-      fld = fifAccessor fi-      mGa = foldr (\ga _ -> Just ga) Nothing (filter (\ga -> gaFieldNum ga == fifFieldNum fi) gas)-  in case lbl of-      Just Repeated ->-        -- proto3 says a 'repeated <packable scalar>' field can appear-        -- on the wire either as a sequence of unpacked entries (one-        -- tag per value, wire-type 0/1/5 depending on the scalar)-        -- or as a single packed length-delimited blob (wire-type-        -- 2). Readers must accept both. Branching on 'wt' covers-        -- both shapes -- but only for packable scalars. Strings-        -- and bytes are NEVER packable (each element is-        -- self-delimiting on the wire), so their tag already-        -- carries wire-type 2 for every element; treating wire-type-        -- 2 as "packed mode" there would mis-decode every repeated-        -- string field (and previously did, until 'isPackable'-        -- below started gating the dispatch).-        let snocFn = if isUnboxableScalar st then "VU.snoc" else "V.snoc"-            appendMany = loopCall (msgFieldUpdate msgVar fld ("(" <> msgFieldProj msgVar fld <> " <> vs)"))-            packedDecoderE = scalarPackedDecoderExpr st-            unpackedDecoderE = scalarDecoderExpr st-            isPackable = case st of-              SString -> False-              SBytes -> False-              _ -> True-            -- For a GrowAccum field: snoc into the accumulator parameter.-            -- For plain repeated scalars: V.snoc/VU.snoc into the record.-            loopWithSnoc = case mGa of-              Just ga ->-                let newAcc = "(snocGrowList " <> gaName ga <> " v)"-                    accArgs' = T.unwords (fmap (\g -> if gaName g == gaName ga then newAcc else gaName g) gas)-                in "loop " <> msgVar <> " " <> accArgs'-              Nothing -> loopCall (msgFieldUpdate msgVar fld ("(" <> snocFn <> " " <> msgFieldProj msgVar fld <> " v)"))-        in if isPackable-            then-              pretty fn-                <+> txt "-> case wt of"-                <> line-                <> indent-                  2-                  ( vsep-                      -- 'wt' is an 'Int' under 'withTagM'; literal 2 is-                      -- 'WireLengthDelimited' per the proto wire-format-                      -- spec (the wire-type encoding @len = 2@).-                      [ txt "2 -> do"-                      , indent-                          2-                          ( vsep-                              [ txt "vs <- " <> pretty packedDecoderE-                              , txt (appendMany)-                              ]-                          )-                      , txt "_ -> do"-                      , indent-                          2-                          ( vsep-                              [ txt "v <- " <> pretty unpackedDecoderE-                              , txt loopWithSnoc-                              ]-                          )-                      ]-                  )-            else-              pretty fn-                <+> txt "-> do"-                <> line-                <> indent-                  2-                  ( vsep-                      [ txt "v <- " <> pretty unpackedDecoderE-                      , txt loopWithSnoc-                      ]-                  )-      Just Optional ->-        -- proto3 'optional <scalar>' fields synthesise a oneof-style-        -- presence bit; the field's record slot is 'Maybe T', so the-        -- decoded value has to be wrapped with 'Just' here.-        let bump = msgFieldUpdate msgVar fld "(Just v)"-        in pretty fn-            <+> txt "-> do"-            <> line-            <> indent-              2-              ( vsep-                  [ txt "v <- " <> pretty (scalarDecoderExpr st)-                  , txt (loopCall bump)-                  ]-              )-      _ ->-        let bump = msgFieldUpdate msgVar fld "v"-        in pretty fn-            <+> txt "-> do"-            <> line-            <> indent-              2-              ( vsep-                  [ txt "v <- " <> pretty (scalarDecoderExpr st)-                  , txt (loopCall bump)-                  ]-              )---{- | Decoder expression for a 'repeated <scalar>' encoded as a-single packed length-delimited blob.--}-scalarPackedDecoderExpr :: ScalarType -> Text-scalarPackedDecoderExpr = \case-  SDouble -> "decodePackedDouble"-  SFloat -> "decodePackedFloat"-  SInt32 -> "(VU.map fromIntegral <$> decodePackedVarint)"-  SInt64 -> "(VU.map fromIntegral <$> decodePackedVarint)"-  SUInt32 -> "(VU.map fromIntegral <$> decodePackedVarint)"-  SUInt64 -> "decodePackedVarint"-  SSInt32 -> "decodePackedSVarint32"-  SSInt64 -> "decodePackedSVarint64"-  SFixed32 -> "decodePackedFixed32"-  SFixed64 -> "decodePackedFixed64"-  SSFixed32 -> "(VU.map fromIntegral <$> decodePackedFixed32)"-  SSFixed64 -> "(VU.map fromIntegral <$> decodePackedFixed64)"-  SBool -> "(VU.map (/= 0) <$> decodePackedVarint)"-  -- 'repeated string' / 'repeated bytes' aren't packable per the-  -- proto spec; they always come as one-tag-per-entry. Calling this-  -- helper for them is a codegen bug; emit a runtime fail to surface-  -- it loudly rather than silently mis-decoding.-  SString -> "(decodeFail (CustomError \"repeated string is never packed\"))"-  SBytes -> "(decodeFail (CustomError \"repeated bytes is never packed\"))"---genNamedDecodeCase :: [GrowAccum] -> GenCtx -> Text -> FieldInfoFull -> Maybe FieldLabel -> Text -> TypeKind -> (Text -> Text) -> (Int -> Maybe GrowAccum) -> Doc ann-genNamedDecodeCase gas ctx msgVar fi lbl name tk loopCall gaFor =-  let fn = T.pack (show (fifFieldNum fi))-      fld = fifAccessor fi-      mGa = gaFor (fifFieldNum fi)-      -- For closed enums, resolve the type name to its Haskell name and-      -- generate a fromProtoEnum-based decode that fails on unknown values.-      closedEnum = tk == TKEnum && genClosedEnums (gcOpts ctx)-      hsEnumName = case resolveType ctx name of-        Just ti -> tiHsName ti-        Nothing -> ""-      loopExpr = case (lbl, mGa) of-        (Just Repeated, Just ga) ->-          let newAcc = "(snocGrowList " <> gaName ga <> " v)"-              accArgs' = T.unwords (fmap (\g -> if gaName g == gaName ga then newAcc else gaName g) gas)-          in "loop " <> msgVar <> " " <> accArgs'-        (Just Repeated, Nothing) ->-          loopCall (msgFieldUpdate msgVar fld ("(V.snoc " <> msgFieldProj msgVar fld <> " v)"))-        (Just Optional, _) ->-          loopCall (msgFieldUpdate msgVar fld "(Just v)")-        -- proto2 required fields: non-Maybe record slot — assign v directly.-        -- Enum fields are also non-Maybe (same treatment as the Nothing case).-        (Just Required, _) ->-          loopCall (msgFieldUpdate msgVar fld "v")-        -- proto3 singular (lbl == Nothing): message slots are Maybe, scalars are plain.-        _ -> case tk of-          TKEnum    -> loopCall (msgFieldUpdate msgVar fld "v")-          TKMessage -> loopCall (msgFieldUpdate msgVar fld "(Just v)")-      decoderExpr :: Text-      decoderExpr = case tk of-        TKEnum -> "decodeFieldEnum"-        TKMessage -> "decodeFieldMessage"-  in if closedEnum && not (T.null hsEnumName)-      -- Closed enum: read varint → fromProtoEnum → fail on unknown.-      then-        pretty fn-          <+> txt "-> do"-          <> line-          <> indent-            2-            ( vsep-                [ txt "n <- fromIntegral <$> getVarint"-                , txt ("case fromProtoEnum" <> hsEnumName <> " n of")-                , indent 2 $-                    vsep-                      [ txt ("Nothing -> decodeFail (CustomError (\"Unknown closed enum value: \" <> show n))")-                      , txt "Just v ->"-                      , indent 2 (txt loopExpr)-                      ]-                ]-            )-      else-        pretty fn-          <+> txt "-> do"-          <> line-          <> indent-            2-            ( vsep-                [ txt "v <- " <> pretty decoderExpr-                , txt loopExpr-                ]-            )---genMapDecodeCase :: [GrowAccum] -> GenCtx -> Text -> FieldInfoFull -> ScalarType -> FieldType -> (Text -> Text) -> Doc ann-genMapDecodeCase _gas ctx msgVar fi keyT valT loopCall =-  let fn = T.pack (show (fifFieldNum fi))-      fld = fifAccessor fi-      bump =-        msgFieldUpdate-          msgVar-          fld-          ("(Map.union " <> msgFieldProj msgVar fld <> " (Map.singleton mk' mv'))")-      keyDecoder = scalarDecoderExpr keyT-      valDecoder = mapValDecoderExpr ctx valT-      keyDefault = scalarDefaultLit keyT-      valDefault = mapValDefaultLit ctx valT-  in pretty fn-      <+> txt "-> do"-      <> line-      <> indent-        2-        ( vsep-            [ txt "bs' <- getLengthDelimited"-            , txt "let decodeEntry = runDecoder (decodeMapEntry"-                <+> pretty keyDecoder-                <+> pretty valDecoder-                <+> pretty keyDefault-                <+> pretty valDefault-                <> txt ") bs'"-            , txt "case decodeEntry of"-            , indent 2 $-                vsep-                  [ txt ("Left _ -> " <> loopCall msgVar)-                  , txt ("Right (mk', mv') -> " <> loopCall bump)-                  ]-            ]-        )---genOneofDecodeCase :: [GrowAccum] -> GenCtx -> [Text] -> Text -> Text -> FieldInfoFull -> (Text -> Text) -> OneofField -> [Doc ann]-genOneofDecodeCase _gas ctx scope ooName msgVar fi loopCall oof =-  let fn = T.pack (show (unFieldNumber (oneofFieldNumber oof)))-      fld = fifAccessor fi-      conName = oneofConName scope ooName (oneofFieldName oof)-      bump = msgFieldUpdate msgVar fld ("(Just (" <> conName <> " v))")-      decoderExpr = case oneofFieldType oof of-        FTScalar st -> scalarDecoderExpr st-        FTNamed n -> case resolveType ctx n of-          Just ti | tiKind ti == TKEnum -> "decodeFieldEnum"-          _ -> "decodeFieldMessage"-  in [ pretty fn-        <+> txt "-> do"-        <> line-        <> indent-          2-          ( vsep-              [ txt "v <- " <> pretty decoderExpr-              , txt (loopCall bump)-              ]-          )-     ]---genDefaultDecodeCase :: [Text] -> [GrowAccum] -> Text -> Doc ann-genDefaultDecodeCase scope gas msgVar =-  let ufa = unknownFieldAccessor scope-      bump = msgFieldUpdate msgVar ufa ("(uf : " <> msgFieldProj msgVar ufa <> ")")-      loopExpr = "loop " <> bump <> growAccumArgs gas-  in txt "_ -> do"-      <> line-      <> indent-        2-        ( vsep-            -- 'wt' comes through as an 'Int' (withTagM's continuation-            -- takes raw Ints), so 'toEnum' it back into a 'WireType'-            -- before handing it to 'captureUnknownField'.-            [ txt "uf <- captureUnknownField fn (Prelude.toEnum wt)"-            , txt loopExpr-            ]-        )---scalarDefaultText :: ScalarType -> Text-scalarDefaultText = \case-  SBool -> "False"-  SString -> "\"\""-  SBytes -> "\"\""-  _ -> "0"---scalarDecoderExpr :: ScalarType -> Text-scalarDecoderExpr = \case-  SDouble -> "decodeFieldDouble"-  SFloat -> "decodeFieldFloat"-  SInt32 -> "(fromIntegral <$> decodeFieldVarint)"-  SInt64 -> "(fromIntegral <$> decodeFieldVarint)"-  SUInt32 -> "(fromIntegral <$> decodeFieldVarint)"-  SUInt64 -> "decodeFieldVarint"-  SSInt32 -> "decodeFieldSVarint32"-  SSInt64 -> "decodeFieldSVarint64"-  SFixed32 -> "decodeFieldFixed32"-  SFixed64 -> "decodeFieldFixed64"-  SSFixed32 -> "(fromIntegral <$> decodeFieldFixed32)"-  SSFixed64 -> "(fromIntegral <$> decodeFieldFixed64)"-  SBool -> "decodeFieldBool"-  SString -> "decodeFieldString"-  SBytes -> "decodeFieldBytes"---mapValDecoderExpr :: GenCtx -> FieldType -> Text-mapValDecoderExpr ctx = \case-  FTScalar st -> scalarDecoderExpr st-  FTNamed n -> case resolveType ctx n of-    Just ti | tiKind ti == TKEnum -> "decodeFieldEnum"-    _ -> "decodeFieldMessage"---scalarDefaultLit :: ScalarType -> Text-scalarDefaultLit = \case-  SBool -> "False"-  SString -> "\"\""-  SBytes -> "\"\""-  _ -> "0"---mapValDefaultLit :: GenCtx -> FieldType -> Text-mapValDefaultLit ctx = \case-  FTScalar st -> scalarDefaultLit st-  FTNamed n -> case resolveType ctx n of-    Just ti | tiKind ti == TKEnum -> "(Prelude.toEnum 0)"-    Just ti -> "default" <> tiHsName ti-    Nothing -> "error \"mapValDefaultLit: unresolved type " <> n <> "\""----- ------------------------------------------------------------------------------ JSON instances--- -----------------------------------------------------------------------------{- | Generate an empty @instance IsMessage Foo@. 'IsMessage' is a marker-class with no methods of its own; its superclasses ('MessageEncode',-'MessageDecode', 'ProtoMessage', 'Aeson.ToJSON', 'Aeson.FromJSON',-'Typeable') do the work. Emitting an instance signals to the registry-TH discovery splice that this type is eligible for inclusion.--}-genIsMessageInstance :: [Text] -> Doc ann-genIsMessageInstance scope =-  let tyN = scopedTypeName scope-  in txt "instance IsMessage " <> pretty tyN---{- | Emit the @ProtoMessage@ instance for a message.--The field-descriptor map is bound as a top-level CAF-(@\<tyN\>FieldDescriptors@) and the instance method just returns it.--Why not inline @Map.fromList [...]@ in the instance body? GHC's-full-laziness pass at @-O1@ does already float the @Map.fromList@-out of the @\\_ -> ...@ lambda (verified in Core: the lambda becomes-@\\_ -> $fProtoMessage<X>1@ where @$fProtoMessage<X>1@ is a-top-level CAF), so the map is built once and shared. But that's a-contract of the optimiser, not the source. Making the CAF explicit:--* guarantees the optimisation independently of GHC version,-  optimisation level, or future heuristic changes;-* makes the intent obvious at the source level — no reader has to-  reason about full-laziness to know the map isn't rebuilt per-  call;-* gives downstream code a name to reference if it wants the map-  without going through the typeclass dictionary.--}-genProtoMessageInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann-genProtoMessageInstance ctx scope msg =-  let tyN = scopedTypeName scope-      fqn = fqProtoName (gcPkg ctx) scope-      pkg = fromMaybe "" (gcPkg ctx)-      fields = extractMessageFieldsForSchema scope (msgElements msg)-      defN = "default" <> tyN-      descN = fieldDescriptorsBindingName scope-      descTy = txt "IntMap.IntMap (SomeFieldDescriptor " <> pretty tyN <> txt ")"-      -- 'IntMap.fromList []' would also be fine, but emitting 'IntMap.empty'-      -- for the empty case keeps the generated source tidier and avoids-      -- the (admittedly tiny) cost of the runtime list traversal.-      descBody = case fields of-        [] -> txt "IntMap.empty"-        _ ->-          vsep-            [ txt "IntMap.fromList"-            , indent 2 $ genFieldDescriptorList ctx scope fields-            ]-  in vsep-      [ txt "-- | Field descriptors for '"-          <> pretty tyN-          <> txt "', keyed by proto field number."-      , txt "--"-      , txt "-- Top-level CAF: allocated lazily on first force, shared on every"-      , txt "-- subsequent 'protoFieldDescriptors' call (no per-call rebuild)."-      , pretty descN <+> txt "::" <+> descTy-      , pretty descN <+> txt "="-      , indent 2 descBody-      , mempty-      , instanceHead "ProtoMessage" tyN-      , indent 2 $ pretty ("protoMessageName _ = \"" :: Text) <> pretty fqn <> pretty ("\"" :: Text)-      , indent 2 $ pretty ("protoPackageName _ = \"" :: Text) <> pretty pkg <> pretty ("\"" :: Text)-      , indent 2 $ txt "protoDefaultValue = " <> pretty defN-      , indent 2 $ txt "protoFileDescriptorBytes _ = fileDescriptorProtoBytes"-      , indent 2 $ txt "protoFieldDescriptors _ = " <> pretty descN-      ]---{- | Name of the top-level CAF holding a message's field descriptors.--Format: @\<lowerFirst tyN\>FieldDescriptors@. The 'FieldDescriptors'-suffix is verbose on purpose — it makes accidental collision with a-user-declared field accessor near-impossible (record field 'fooBar'-would never share a name with binding 'fooBarFieldDescriptors').--}-fieldDescriptorsBindingName :: [Text] -> Text-fieldDescriptorsBindingName scope =-  lowerFirst (scopedTypeName scope) <> "FieldDescriptors"---data SchemaField = SchemaField-  { sfName :: Text-  , sfNum :: Int-  , sfType :: FieldType-  , sfLabel :: Maybe FieldLabel-  }---extractMessageFieldsForSchema :: [Text] -> [MessageElement] -> [SchemaField]-extractMessageFieldsForSchema _scope = concatMap go-  where-    go (MEField fd) = [SchemaField (fieldName fd) (unFieldNumber (fieldNumber fd)) (fieldType fd) (fieldLabel fd)]-    go (MEMapField mf) = [SchemaField (mapFieldName mf) (unFieldNumber (mapFieldNum mf)) (FTScalar SBytes) (Just Repeated)]-    go (MEOneof od) = case oneofFields od of-      (f : _) -> [SchemaField (oneofName od) (unFieldNumber (oneofFieldNumber f)) (FTNamed (oneofName od)) (Just Optional)]-      [] -> []-    go _ = []---genFieldDescriptorList :: GenCtx -> [Text] -> [SchemaField] -> Doc ann-genFieldDescriptorList ctx scope fields =-  let entries = fmap (genFieldDescriptorEntry ctx scope) fields-  in case entries of-      [] -> txt "[]"-      _ ->-        vsep [txt "[ " <> head entries]-          <> vsep (fmap (\e -> txt ", " <> e) (tail entries))-          <> line-          <> txt "]"---genFieldDescriptorEntry :: GenCtx -> [Text] -> SchemaField -> Doc ann-genFieldDescriptorEntry ctx scope sf =-  let accN = ctxFieldName ctx scope (sfName sf)-  in txt "("-      <> pretty (T.pack (show (sfNum sf)))-      <> txt ", SomeField FieldDescriptor"-      <> line-      <> indent-        4-        ( vsep-            [ pretty ("{ fdName = \"" :: Text) <> pretty (sfName sf) <> pretty ("\"" :: Text)-            , txt ", fdNumber = " <> pretty (T.pack (show (sfNum sf)))-            , txt ", fdTypeDesc = " <> genFieldTypeDesc (sfType sf)-            , txt ", fdLabel = " <> genLabelLit (sfLabel sf)-            , txt ", fdGet = " <> pretty accN-            , txt ", fdSet = \\v m -> m { " <> pretty accN <> txt " = v }"-            , txt "})"-            ]-        )---genFieldTypeDesc :: FieldType -> Doc ann-genFieldTypeDesc = \case-  FTScalar SDouble -> txt "ScalarType DoubleField"-  FTScalar SFloat -> txt "ScalarType FloatField"-  FTScalar SInt32 -> txt "ScalarType Int32Field"-  FTScalar SInt64 -> txt "ScalarType Int64Field"-  FTScalar SUInt32 -> txt "ScalarType UInt32Field"-  FTScalar SUInt64 -> txt "ScalarType UInt64Field"-  FTScalar SSInt32 -> txt "ScalarType SInt32Field"-  FTScalar SSInt64 -> txt "ScalarType SInt64Field"-  FTScalar SFixed32 -> txt "ScalarType Fixed32Field"-  FTScalar SFixed64 -> txt "ScalarType Fixed64Field"-  FTScalar SSFixed32 -> txt "ScalarType SFixed32Field"-  FTScalar SSFixed64 -> txt "ScalarType SFixed64Field"-  FTScalar SBool -> txt "ScalarType BoolField"-  FTScalar SString -> txt "ScalarType StringField"-  FTScalar SBytes -> txt "ScalarType BytesField"-  FTNamed n -> pretty ("MessageType \"" :: Text) <> pretty n <> pretty ("\"" :: Text)---genLabelLit :: Maybe FieldLabel -> Doc ann-genLabelLit Nothing = txt "LabelOptional"-genLabelLit (Just Optional) = txt "LabelOptional"-genLabelLit (Just Required) = txt "LabelRequired"-genLabelLit (Just Repeated) = txt "LabelRepeated"----- ------------------------------------------------------------------------------ JSON instances--- -----------------------------------------------------------------------------genToJSONInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann-genToJSONInstance ctx scope msg =-  let tyN = scopedTypeName scope-      fqn = fqProtoName (gcPkg ctx) scope-      overrides = genJsonOverrides (gcOpts ctx)-  in case Map.lookup fqn overrides of-      Just jo ->-        vsep-          [ instanceHead "Aeson.ToJSON" tyN-          , pretty (joToJSON jo)-          ]-      Nothing ->-        let fields = extractAllFieldsJSON ctx scope (msgElements msg)-            anyOneof = any (\jfi -> case jfiKind jfi of JFKOneof _ -> True; _ -> False) fields-        in vsep-            [ instanceHead "Aeson.ToJSON" tyN-            , indent 2 $-                if anyOneof-                  then-                    -- A oneof contributes /0 or 1/ pairs to the-                    -- output depending on which variant is selected,-                    -- which means we can't fit every field into a-                    -- flat pair-list any more. Use @mconcat@ over-                    -- per-field fragment lists instead.-                    vsep-                      [ txt "toJSON msg = jsonObject $ mconcat"-                      , indent 4 $ case fields of-                          [] -> txt "[]"-                          _ ->-                            vsep-                              [ txt "[ " <> genToJSONFieldFragment ctx (head fields)-                              , vsep (fmap (\f -> txt ", " <> genToJSONFieldFragment ctx f) (tail fields))-                              , txt "]"-                              ]-                      ]-                  else-                    vsep-                      [ txt "toJSON msg = jsonObject"-                      , indent 4 $ case fields of-                          [] -> txt "[]"-                          _ ->-                            vsep-                              [ txt "[ " <> head (fmap (genToJSONField ctx) fields)-                              , vsep (fmap (\f -> txt ", " <> genToJSONField ctx f) (tail fields))-                              , txt "]"-                              ]-                      ]-            ]----- | Emit the @(Text, Aeson.Value)@ pair expression for one--- non-oneof JSON field.-genToJSONField :: GenCtx -> JSONFieldInfo -> Doc ann-genToJSONField _ctx jfi = case jfiKind jfi of-  JFKBytes ->-    txt "bytesFieldToJSON " <> pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\"" :: Text) <+> txt "msg." <> pretty (jfiAccessor jfi)-  JFKOptionalBytes ->-    -- proto3 'optional bytes' fields are 'Maybe ByteString' on-    -- the record. Lift through 'Maybe' before calling the-    -- base64-encoding helper so each slot stays well-typed.-    pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\" .=: (fmap protoBytesToJSON msg." :: Text) <> pretty (jfiAccessor jfi) <> txt ")"-  JFKBytesMap ->-    txt "bytesMapFieldToJSON " <> pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\"" :: Text) <+> txt "msg." <> pretty (jfiAccessor jfi)-  JFKNormal ->-    pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\" .=: msg." :: Text) <> pretty (jfiAccessor jfi)-  JFKOneof _ ->-    -- 'genToJSONField' is only reached on the "no oneofs in this-    -- message" path; the @mconcat@ form uses 'genToJSONFieldFragment'-    -- instead. If we ever land here for a oneof field, it's a bug-    -- in the caller. Emit a runtime fail so the mistake surfaces.-    txt "(error \"codegen bug: oneof reached genToJSONField\")"----- | Emit a @[(Text, Aeson.Value)]@ fragment expression for one JSON--- field. Singular fields produce a singleton list; oneofs produce a--- @case@ that yields 0 or 1 entries.-genToJSONFieldFragment :: GenCtx -> JSONFieldInfo -> Doc ann-genToJSONFieldFragment ctx jfi = case jfiKind jfi of-  JFKOneof branches ->-    -- Inline each branch under its own JSON key. The carrier is-    -- @Maybe \<OneofSum\>@:-    --   Nothing                  -> []  (no variant selected)-    --   Just (\<ctor\> v)        -> [(\<jsonKey\>, encode v)]-    let nothingArm = txt "Nothing -> []"-        branchArms = fmap (genOneofBranchToJSONArm jfi) branches-    in vsep-        [ txt "(case msg." <> pretty (jfiAccessor jfi) <> txt " of"-        , indent 4 $-            vsep $-              [nothingArm] <> branchArms-        , txt ")"-        ]-  _ ->-    -- Non-oneof: wrap the existing single-pair expression in a-    -- singleton list so it composes under 'mconcat'.-    txt "[" <> genToJSONField ctx jfi <> txt "]"----- | One arm of the parent's @case msg.foo of { Just (Con v) -> ... }@.-genOneofBranchToJSONArm :: JSONFieldInfo -> JSONOneofBranch -> Doc ann-genOneofBranchToJSONArm _jfi branch =-  let keyLit = pretty ("\"" :: Text) <> pretty (jobJsonKey branch) <> pretty ("\"" :: Text)-  in case jobShape branch of-      OBSNullValue ->-        -- The variant's value /is/ JSON null — emit the bare-        -- @Aeson.Null@ rather than routing through @.=:@ (whose-        -- @Aeson.toJSON@ on the singleton 'NullValue' enum would-        -- render the proto-name string @"NULL_VALUE"@, which the-        -- proto3 JSON spec explicitly rejects for this WKT).-        txt "Just ("-          <> pretty (jobConstructor branch)-          <> txt " _) -> [("-          <> keyLit-          <> txt ", Aeson.Null)]"-      _ ->-        -- Scalars, submessages, and ordinary enums all route-        -- through '.=:' (which is @Aeson.toJSON@ under the hood),-        -- matching 'genToJSONField' for a non-oneof field of the-        -- same Haskell type.-        txt "Just ("-          <> pretty (jobConstructor branch)-          <> txt " v) -> ["-          <> keyLit-          <> txt " .=: v]"---genFromJSONInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann-genFromJSONInstance ctx scope msg =-  let tyN = scopedTypeName scope-      fqn = fqProtoName (gcPkg ctx) scope-      overrides = genJsonOverrides (gcOpts ctx)-  in case Map.lookup fqn overrides of-      Just jo ->-        vsep-          [ instanceHead "Aeson.FromJSON" tyN-          , pretty (joFromJSON jo)-          ]-      Nothing ->-        let fields = extractAllFieldsJSON ctx scope (msgElements msg)-        in case fields of-            [] ->-              vsep-                [ instanceHead "Aeson.FromJSON" tyN-                , indent 2 $ txt "parseJSON _ = pure default" <> pretty tyN-                ]-            _ ->-              vsep-                [ instanceHead "Aeson.FromJSON" tyN-                , indent 2 $-                    vsep-                      [ txt "parseJSON = Aeson.withObject " <> pretty ("\"" :: Text) <> pretty tyN <> pretty ("\"" :: Text) <> txt " $ \\obj -> do"-                      , indent 2 $-                          vsep-                            ( fmap genFromJSONFieldBind fields-                                <> [ txt "pure default" <> pretty tyN-                                   , indent 2 $-                                      vsep-                                        ( txt "{ " <> genFromJSONFieldAssign tyN (head fields)-                                            : fmap (\jfi -> txt ", " <> genFromJSONFieldAssign tyN jfi) (tail fields)-                                              <> [txt "}"]-                                        )-                                   ]-                            )-                      ]-                ]---genFromJSONFieldBind :: JSONFieldInfo -> Doc ann-genFromJSONFieldBind jfi = case jfiKind jfi of-  JFKBytes ->-    txt "fld_" <> pretty (jfiAccessor jfi) <+> txt "<- parseBytesFieldMaybe obj " <> pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\"" :: Text)-  JFKOptionalBytes ->-    -- 'parseBytesFieldMaybe' already returns @Maybe ByteString@,-    -- which is the slot type; no second 'Just' wrap needed.-    txt "fld_" <> pretty (jfiAccessor jfi) <+> txt "<- parseBytesFieldMaybe obj " <> pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\"" :: Text)-  JFKBytesMap ->-    txt "fld_" <> pretty (jfiAccessor jfi) <+> txt "<- parseBytesMapFieldMaybe obj " <> pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\"" :: Text)-  JFKNormal ->-    txt "fld_" <> pretty (jfiAccessor jfi) <+> txt "<- parseFieldMaybe obj " <> pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\"" :: Text)-  JFKOneof branches ->-    -- Hand off to the shared 'parseOneofVariants' helper. The-    -- variants list carries (jsonKey, null-semantics, parser)-    -- triples — one per branch — and the helper enforces-    -- "exactly one matching key" with a parser failure on-    -- duplicates (proto3 'OneofFieldDuplicate' conformance test).-    vsep-      [ txt "fld_" <> pretty (jfiAccessor jfi) <+> txt "<- parseOneofVariants obj"-      , indent 2 $ case branches of-          [] -> txt "[]"-          _ ->-            vsep-              [ txt "[ " <> genOneofBranchParser (head branches)-              , vsep (fmap (\b -> txt ", " <> genOneofBranchParser b) (tail branches))-              , txt "]"-              ]-      ]----- | One @(jsonKey, OneofVariantNullSemantics, \\v -> Con \<$\> parser v)@--- tuple for 'parseOneofVariants'.-genOneofBranchParser :: JSONOneofBranch -> Doc ann-genOneofBranchParser branch =-  let keyLit = pretty ("\"" :: Text) <> pretty (jobJsonKey branch) <> pretty ("\"" :: Text)-      nullSem = case jobShape branch of-        OBSNullValue -> txt "OneofVariantNullIsValue"-        _ -> txt "OneofVariantNullIsUnset"-      parserE = case jobShape branch of-        OBSNullValue ->-          -- @null@ is the value: accept it directly (yielding the-          -- singleton enum); fall through to the standard parser-          -- for the @"NULL_VALUE"@ string sentinel (which proto3-          -- also accepts).-          txt "(\\v -> "-            <> pretty (jobConstructor branch)-            <> txt " <$> (case v of Aeson.Null -> pure (Prelude.toEnum 0); _ -> Aeson.parseJSON v))"-        _ ->-          txt "(\\v -> "-            <> pretty (jobConstructor branch)-            <> txt " <$> Aeson.parseJSON v)"-  in txt "(" <> keyLit <> txt ", " <> nullSem <> txt ", " <> parserE <> txt ")"---genFromJSONFieldAssign :: Text -> JSONFieldInfo -> Doc ann-genFromJSONFieldAssign tyN jfi = case jfiKind jfi of-  JFKOptionalBytes ->-    -- The slot is already 'Maybe ByteString'; the parse helper-    -- returned 'Maybe ByteString' too, so just plug it in-    -- directly instead of stripping the wrapper.-    pretty (jfiAccessor jfi) <+> txt "= fld_" <> pretty (jfiAccessor jfi)-  JFKOneof _ ->-    -- The slot is @Maybe \<Oneof\>@ and 'parseOneofVariants' already-    -- returns @Maybe \<Oneof\>@, so plug it in directly — wrapping-    -- with another 'maybe' would type-error on the double-Maybe.-    pretty (jfiAccessor jfi) <+> txt "= fld_" <> pretty (jfiAccessor jfi)-  _ ->-    pretty (jfiAccessor jfi) <+> txt "= maybe (" <> pretty (jfiAccessor jfi) <+> txt "default" <> pretty tyN <> txt ") id fld_" <> pretty (jfiAccessor jfi)----- ------------------------------------------------------------------------------ Hashable instances--- -----------------------------------------------------------------------------genHashableInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann-genHashableInstance ctx scope msg =-  let tyN = scopedTypeName scope-      fields = extractAllFields ctx scope (msgElements msg)-  in vsep-      [ instanceHead "Hashable" tyN-      , indent 2 $ case fields of-          [] -> txt "hashWithSalt salt _ = salt"-          _ -> txt "hashWithSalt salt msg = " <> genHashExpr fields-      ]---{- | Emit the per-message 'Proto.Extension.HasExtensions' instance so-that generated messages with @extensions@ declarations (or any-@extend@ block targeting them) support the typed extension-accessors from "Proto.Extension". The instance is always safe to-emit because every generated message type already carries an-unknown-fields list; messages without extension ranges will just-never have callers that use the instance.--}-genHasExtensionsInstance :: [Text] -> MessageDef -> Doc ann-genHasExtensionsInstance scope _msg =-  let tyN = scopedTypeName scope-      acc = unknownFieldAccessor scope-  in vsep-      [ txt "instance Proto.Extension.HasExtensions " <> pretty tyN <> txt " where"-      , indent 2 $ txt "messageUnknownFields = " <> pretty acc-      , indent 2 $-          txt "setMessageUnknownFields !ufs msg = msg { "-            <> pretty acc-            <> txt " = ufs }"-      ]---{- | Generate a 'Semigroup' instance encoding protobuf merge semantics:-singular scalar fields take the right value only if non-default-(matching MergeFrom in protoc-gen-go/cpp), repeated and map fields-append/union, submessages and oneofs pick the right value when set.--}-genSemigroupInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann-genSemigroupInstance ctx scope msg =-  let tyN = scopedTypeName scope-      fields = extractAllFields ctx scope (msgElements msg)-      conN = scopedTypeName scope-      unknownAcc = unknownFieldAccessor scope-      mergeField fi =-        let acc = fifAccessor fi-            ba = txt "b." <> pretty acc-            aa = txt "a." <> pretty acc-            lastNonDefault def =-              txt "if "-                <> ba-                <> txt " == "-                <> txt def-                <> txt " then "-                <> aa-                <> txt " else "-                <> ba-        in pretty acc <> txt " = " <> case fifKind fi of-            FKMap _ _ -> aa <> txt " <> " <> ba-            FKOneof _ _ -> txt "case " <> ba <> txt " of { Nothing -> " <> aa <> txt "; x -> x }"-            FKScalar (Just Repeated) _ -> aa <> txt " <> " <> ba-            FKNamed (Just Repeated) _ _ -> aa <> txt " <> " <> ba-            FKNamed (Just Optional) _ _ -> txt "case " <> ba <> txt " of { Nothing -> " <> aa <> txt "; x -> x }"-            FKNamed Nothing _ TKMessage -> txt "case " <> ba <> txt " of { Nothing -> " <> aa <> txt "; x -> x }"-            FKNamed Nothing _ TKEnum -> lastNonDefault "(Prelude.toEnum 0)"-            FKScalar (Just Optional) _ -> txt "case " <> ba <> txt " of { Nothing -> " <> aa <> txt "; x -> x }"-            FKScalar Nothing ft -> lastNonDefault (scalarDefaultText ft)-            -- proto2 @required@ fields: the merge rule is "last wins"-            -- (same as a singular scalar), but the field carries no-            -- default-skipping check — required by definition.-            FKScalar (Just Required) _ -> ba-            FKNamed (Just Required) _ _ -> ba-  in vsep-      [ txt "instance Semigroup " <> pretty tyN <> txt " where"-      , indent 2 $-          vsep-            [ txt "a <> b = " <> pretty conN-            , indent 2 $-                braceBlock-                  ( fmap mergeField fields-                      <> [pretty unknownAcc <> txt " = a." <> pretty unknownAcc <> txt " <> b." <> pretty unknownAcc]-                  )-            ]-      ]---{- | Generate a 'Monoid' instance whose identity is the proto3 default-message (all scalars zero, all repeated / map / optional fields empty-/ 'Nothing'). The 'Semigroup' instance skips default-valued scalars-from the right operand, so @a <> mempty = a@ holds.--}-genMonoidInstance :: [Text] -> Doc ann-genMonoidInstance scope =-  let tyN = scopedTypeName scope-      defN = "default" <> tyN-  in vsep-      [ txt "instance Monoid " <> pretty tyN <> txt " where"-      , indent 2 $ txt "mempty = " <> pretty defN-      ]---genHashExpr :: [FieldInfoFull] -> Doc ann-genHashExpr = go (txt "salt")-  where-    go acc [] = acc-    go acc (fi : rest) = go (genFieldHashApp acc fi) rest---genFieldHashApp :: Doc ann -> FieldInfoFull -> Doc ann-genFieldHashApp acc fi =-  let fld = txt "msg." <> pretty (fifAccessor fi)-  in case fifKind fi of-      FKScalar (Just Repeated) st-        | isUnboxableScalar st ->-            txt "VU.foldl' hashWithSalt (" <> acc <> txt ") " <> fld-      FKScalar (Just Repeated) _ ->-        txt "V.foldl' hashWithSalt (" <> acc <> txt ") " <> fld-      FKNamed (Just Repeated) _ _ ->-        txt "V.foldl' hashWithSalt (" <> acc <> txt ") " <> fld-      FKMap _ _ ->-        txt "Map.foldlWithKey' (\\s k v -> s `hashWithSalt` k `hashWithSalt` v) (" <> acc <> txt ") " <> fld-      _ ->-        txt "hashWithSalt (" <> acc <> txt ") " <> fld---genOneofHashableInstance :: GenCtx -> [Text] -> OneofDef -> Doc ann-genOneofHashableInstance _ctx scope od =-  let tyN = scopedTypeName scope <> "'" <> snakeToPascal (oneofName od)-      arms = zipWith (genOneofHashArm scope (oneofName od)) [0 :: Int ..] (oneofFields od)-  in vsep-      [ instanceHead "Hashable" tyN-      , indent 2 $ vsep arms-      ]---genOneofHashArm :: [Text] -> Text -> Int -> OneofField -> Doc ann-genOneofHashArm scope ooName tag f =-  let conName = oneofConName scope ooName (oneofFieldName f)-      tagStr = T.pack (show tag)-  in txt "hashWithSalt salt (" <> pretty conName <+> txt "v) = salt `hashWithSalt` (" <> pretty tagStr <> txt " :: Int) `hashWithSalt` v"---genEnumHashableInstance :: [Text] -> EnumDef -> Doc ann-genEnumHashableInstance scope _ed =-  let tyN = scopedTypeName scope-  in vsep-      [ instanceHead "Hashable" tyN-      , indent 2 (txt "hashWithSalt salt x = hashWithSalt salt (toProtoEnum" <> pretty tyN <+> txt "x)")-      ]---fqProtoName :: Maybe Text -> [Text] -> Text-fqProtoName pkg scope =-  let msgName = T.intercalate "." scope-  in case pkg of-      Just p -> p <> "." <> msgName-      Nothing -> msgName---{- | Is a top-level message / enum / service whose fully-qualified-proto name appears in 'genExternalTypes' — meaning some other-package already provides Haskell definitions for it and the code-generator should /not/ emit a parallel set in this output file?--Service definitions are never skipped here, because the codegen-emits @Network.GRPC@-flavoured service stubs that aren't covered by-the @TypeRegistry@ surface (@TypeRegistry@ maps type FQNs, not-service FQNs). If a downstream consumer needs to suppress a service-definition they can do it via 'genHooks' instead.--}-topLevelManagedExternally :: GenerateOpts -> Maybe Text -> TopLevel -> Bool-topLevelManagedExternally opts pkg tl =-  let externals = genExternalTypes opts-   in case tl of-        TLMessage msg -> Map.member (fqProtoName pkg [msgName msg]) externals-        TLEnum ed -> Map.member (fqProtoName pkg [enumName ed]) externals-        TLService _ -> False-        _ -> False----- ------------------------------------------------------------------------------ Field extraction (unified)--- -----------------------------------------------------------------------------data FieldKindFull-  = FKScalar (Maybe FieldLabel) ScalarType-  | FKNamed (Maybe FieldLabel) Text TypeKind-  | FKMap ScalarType FieldType-  | FKOneof [Text] OneofDef-  deriving stock (Show, Eq)---data FieldInfoFull = FieldInfoFull-  { fifAccessor :: Text-  , fifFieldNum :: Int-  , fifIndex :: Int-  , fifKind :: FieldKindFull-  }-  deriving stock (Show, Eq)---extractAllFields :: GenCtx -> [Text] -> [MessageElement] -> [FieldInfoFull]-extractAllFields ctx scope elems =-  zipWith (\i fi -> fi {fifIndex = i}) [0 ..] (concatMap go elems)-  where-    go = \case-      MEField fd ->-        let accessor = ctxFieldName ctx scope (fieldName fd)-            fn = unFieldNumber (fieldNumber fd)-            kind = case fieldType fd of-              FTScalar st -> FKScalar (fieldLabel fd) st-              FTNamed n -> FKNamed (fieldLabel fd) n (resolveTypeKindScoped ctx scope n)-        in [FieldInfoFull accessor fn 0 kind]-      MEMapField mf ->-        let accessor = ctxFieldName ctx scope (mapFieldName mf)-            fn = unFieldNumber (mapFieldNum mf)-        in [FieldInfoFull accessor fn 0 (FKMap (mapKeyType mf) (mapValueType mf))]-      MEOneof od ->-        let accessor = ctxFieldName ctx scope (oneofName od)-            fn = 0-        in [FieldInfoFull accessor fn 0 (FKOneof scope od)]-      _ -> []---resolveTypeKindScoped :: GenCtx -> [Text] -> Text -> TypeKind-resolveTypeKindScoped ctx scope name = maybe TKMessage tiKind (resolveTypeWithScope ctx scope name)----- JSON field info------ 'JFKBytes' is split into bare-bytes and optional-bytes shapes--- so the bytes ToJSON / FromJSON helpers (which require a--- 'ByteString' / 'Maybe ByteString' argument respectively) line--- up with the actual record-slot type. Without the split,--- proto3 'optional bytes' fields generate code that takes a--- 'Maybe ByteString' where 'bytesFieldToJSON' wants 'ByteString',--- which doesn't type-check.------ 'JFKOneof' carries the per-branch JSON info so the writer/reader--- can inline each branch under its /own/ proto-3-canonical JSON--- key (the proto3 spec inlines oneofs at the parent message level--- — there is no enclosing key for the group itself). Each--- branch's key honours its individual @json_name@ option when--- present, falling back to the camelCase form of the branch field--- name.-data JSONFieldKind-  = JFKNormal-  | JFKBytes-  | JFKOptionalBytes-  | JFKBytesMap-  | JFKOneof ![JSONOneofBranch]-  deriving stock (Show, Eq)---{- | One branch of a oneof's JSON projection. The codegen turns each-of these into:--* one arm of the parent's @toJSON@ @case@ expression-  (@\\Just (\<conName\> v) -> [(\<jsonKey\>, \<encode v\>)]@), and-* one tuple of the parent's @parseOneofVariants@ call list-  (@(\<jsonKey\>, \<nullSem\>, \\v -> \<conName\> \<$\> parseJSON v)@).--}-data JSONOneofBranch = JSONOneofBranch-  { jobConstructor :: !Text-  -- ^ Fully-qualified Haskell-side constructor for this branch,-  --   e.g. @ResetOptions'Target'BuildId@.-  , jobJsonKey :: !Text-  -- ^ Proto-3-canonical JSON key. From @json_name@ if the-  --   branch field carries one; otherwise the camelCase form of-  --   the branch field's proto name.-  , jobShape :: !OneofBranchShape-  -- ^ How to encode\/decode the branch payload.-  }-  deriving stock (Show, Eq)---{- | Branch payload shape, kept narrow on purpose. Proto-3-canonical-JSON has type-specific rules (e.g. @int64@ as string, @bytes@ as-base64) that the writer\/reader will eventually want to dispatch-on, but for the first cut we route everything through-'Aeson.toJSON' \/ 'Aeson.parseJSON' the same way the existing-pure-text codegen does for regular submessage and scalar fields.-The constructors are kept distinct so a future refactor can-discriminate without touching every call site.--}-data OneofBranchShape-  = OBSScalar-  | OBSMessage-  | OBSEnum-  | -- | @google.protobuf.NullValue@: bare JSON @null@ is the-    --   variant's value, not the "variant unset" marker.-    OBSNullValue-  deriving stock (Show, Eq)---data JSONFieldInfo = JSONFieldInfo-  { jfiAccessor :: Text-  , jfiJsonName :: Text-  -- ^ Empty for 'JFKOneof' fields — the per-branch key lives in-  --   'jobJsonKey' inside the kind payload, since proto3 inlines-  --   the branch keys at the parent level rather than wrapping-  --   them under the oneof group's name.-  , jfiOptional :: Bool-  , jfiKind :: JSONFieldKind-  }-  deriving stock (Show, Eq)---extractAllFieldsJSON :: GenCtx -> [Text] -> [MessageElement] -> [JSONFieldInfo]-extractAllFieldsJSON ctx scope = concatMap go-  where-    go = \case-      MEField fd ->-        let accessor = ctxFieldName ctx scope (fieldName fd)-            jsonName = fromMaybe (protoJsonName (fieldName fd)) (getJsonName (fieldOptions fd))-            kind = case fieldType fd of-              FTScalar SBytes -> case fieldLabel fd of-                Just Optional -> JFKOptionalBytes-                _ -> JFKBytes-              _ -> JFKNormal-        in [JSONFieldInfo accessor jsonName True kind]-      MEMapField mf ->-        let accessor = ctxFieldName ctx scope (mapFieldName mf)-            jsonName = fromMaybe (protoJsonName (mapFieldName mf)) (getJsonName (mapOptions mf))-            kind = case mapValueType mf of FTScalar SBytes -> JFKBytesMap; _ -> JFKNormal-        in [JSONFieldInfo accessor jsonName True kind]-      MEOneof od ->-        let accessor = ctxFieldName ctx scope (oneofName od)-            branches = fmap (oneofBranchToJSON ctx scope (oneofName od)) (oneofFields od)-        in [JSONFieldInfo accessor "" True (JFKOneof branches)]-      _ -> []----- | Build the JSON projection of one oneof branch.-oneofBranchToJSON :: GenCtx -> [Text] -> Text -> OneofField -> JSONOneofBranch-oneofBranchToJSON ctx scope ooName f =-  let conName = oneofConName scope ooName (oneofFieldName f)-      -- proto3 JSON semantics: the BRANCH's own field name (or its-      -- 'json_name' option if it has one) is the JSON key — NOT the-      -- oneof group's name.-      jsonKey =-        fromMaybe-          (protoJsonName (oneofFieldName f))-          (getJsonName (oneofFieldOptions f))-      shape = case oneofFieldType f of-        FTScalar _ -> OBSScalar-        FTNamed n-          -- 'google.protobuf.NullValue' is the only enum-shaped WKT-          -- where bare JSON @null@ is a valid /value/ (rather than-          -- "this variant is absent"); flag it so the reader/writer-          -- can special-case the null-handling.-          | n == "google.protobuf.NullValue" -> OBSNullValue-          | otherwise -> case resolveType ctx n of-              Just ti | tiKind ti == TKEnum -> OBSEnum-              _ -> OBSMessage-  in JSONOneofBranch-      { jobConstructor = conName-      , jobJsonKey = jsonKey-      , jobShape = shape-      }---getJsonName :: [OptionDef] -> Maybe Text-getJsonName = \case-  [] -> Nothing-  opts -> lookupSimpleOption "json_name" opts >>= optionAsString----- ------------------------------------------------------------------------------ Service generation--- -----------------------------------------------------------------------------genServiceTopLevel :: GenCtx -> [Text] -> ServiceDef -> [Doc ann]-genServiceTopLevel ctx scope svc =-  let pkg = fromMaybe "" (gcPkg ctx)-      resolveRpcType name =-        let candidates = [name, pkg <> "." <> name]-            go [] = Nothing-            go (c : cs) = case Map.lookup c (gcRegistry ctx) of-              Just ti -> Just ti-              Nothing -> go cs-        in go candidates-      -- RPC types are now registered in 'collectReferencedTypes', so-      -- the module-level imports block covers them. We only need to-      -- /qualify/ each RPC type when emitting the service's-      -- declarations.-      qualifyRpcType name = case resolveRpcType name of-        Just ti-          | tiModule ti /= gcThisMod ctx -> moduleAlias (tiModule ti) <> "." <> tiHsName ti-          | otherwise -> tiHsName ti-        Nothing -> hsTypeName (lastPart name)-      lastPart t = case T.splitOn "." t of [] -> t; parts -> last parts-      svcScope = scope <> [svcName svc]-      hookCtx =-        ServiceHookCtx-          { shcServiceDef = svc-          , shcScope = svcScope-          , shcHsTypeName = T.intercalate "'" (fmap hsTypeName svcScope)-          , shcOptions = svcOptions svc-          }-      hookOutput = onServiceCodeGen (genHooks (gcOpts ctx)) hookCtx-      hookDocs = fmap pretty hookOutput-  in Service.genServiceDeclsQualified (gcPkg ctx) scope qualifyRpcType svc-      <> case hookDocs of-        [] -> []-        ds -> [mempty, vsep ds]----- ------------------------------------------------------------------------------ Proto2 extension blocks (@extend Foo { optional int32 bar = 123; }@)--- -----------------------------------------------------------------------------{- | Emit one top-level 'Proto.Extension.Extension' binding per field-in an @extend@ block. Callers of the generated module use-'Proto.Extension.getExtension' / 'setExtension' / 'clearExtension'-to interact with the extension through the message's-unknown-fields list; the owning message type automatically-satisfies 'Proto.Extension.HasExtensions' via the-per-message instance emitted by 'genHasExtensionsInstance'.--Singular + repeated (packed and unpacked) extensions are-emitted here. Proto2 message-groups never made it into this-codebase's 'FieldType' ADT, so the old-style group extension-is not representable at all — the parser rejects group-fields before they can reach this function.--}-genExtensionBlock-  :: GenCtx -> [Text] -> Text -> [FieldDef] -> [Doc ann]-genExtensionBlock ctx scope extOwnerName fields =-  let pkg = fromMaybe "" (gcPkg ctx)-      ownerHsType = qualifyExtendedType ctx pkg extOwnerName-      ownerProtoShort = lastDot extOwnerName-      ownerPrefix = lowerFirst (hsTypeName ownerProtoShort)-  in concatMap (genOneExtension ctx scope ownerHsType ownerPrefix) fields----- Generate one @Extension <owner> <payload>@ (or--- @RepeatedExtension <owner> <payload>@) binding.-genOneExtension-  :: GenCtx -> [Text] -> Text -> Text -> FieldDef -> [Doc ann]-genOneExtension _ctx _scope ownerHsType ownerPrefix fd =-  let fieldNameHs =-        escapeReserved-          (ownerPrefix <> upperFirst (snakeToCamel (fieldName fd)))-      num = unFieldNumber (fieldNumber fd)-      repeated = fieldLabel fd == Just Repeated-      packed =-        repeated && case fieldType fd of-          FTScalar s -> packableScalar s-          _ -> False-      payload = extensionPayloadCore (fieldType fd)-  in case payload of-      Nothing ->-        [ mempty-        , txt "-- WARNING: extension '"-            <> pretty (fieldName fd)-            <> txt "' uses an unsupported shape and was skipped."-        ]-      Just (haskellType, extTag) ->-        if repeated-          then-            [ mempty-            , txt fieldNameHs-                <> txt " :: Proto.Extension.RepeatedExtension "-                <> pretty ownerHsType-                <> txt " "-                <> haskellType-            , txt fieldNameHs <> txt " = Proto.Extension.RepeatedExtension"-            , indent 2 $ txt "{ Proto.Extension.reNumber   = " <> pretty (tshow num)-            , indent 2 $-                txt ", Proto.Extension.reType     = Proto.Extension."-                  <> pretty extTag-            , indent 2 $-                txt ", Proto.Extension.reIsPacked = "-                  <> (if packed then txt "True" else txt "False")-            , indent 2 $ txt "}"-            ]-          else-            [ mempty-            , txt fieldNameHs-                <> txt " :: Proto.Extension.Extension "-                <> pretty ownerHsType-                <> txt " "-                <> haskellType-            , txt fieldNameHs <> txt " = Proto.Extension.Extension"-            , indent 2 $ txt "{ Proto.Extension.extNumber = " <> pretty (tshow num)-            , indent 2 $-                txt ", Proto.Extension.extType   = Proto.Extension."-                  <> pretty extTag-            , indent 2 $ txt "}"-            ]---{- | Project a proto 'FieldType' onto @(Haskell type,-'ExtensionType' constructor name)@. The label-aware split is now-the caller's job: 'genOneExtension' picks Extension vs.-RepeatedExtension based on @fieldLabel@.--}-extensionPayloadCore :: FieldType -> Maybe (Doc ann, Text)-extensionPayloadCore (FTScalar s) = case s of-  SDouble -> Just (txt "Double", "ExtDouble")-  SFloat -> Just (txt "Float", "ExtFloat")-  SInt32 -> Just (txt "Int32", "ExtInt32")-  SInt64 -> Just (txt "Int64", "ExtInt64")-  SUInt32 -> Just (txt "Word32", "ExtUInt32")-  SUInt64 -> Just (txt "Word64", "ExtUInt64")-  SSInt32 -> Just (txt "Int32", "ExtSInt32")-  SSInt64 -> Just (txt "Int64", "ExtSInt64")-  SFixed32 -> Just (txt "Word32", "ExtFixed32")-  SFixed64 -> Just (txt "Word64", "ExtFixed64")-  SSFixed32 -> Just (txt "Int32", "ExtSFixed32")-  SSFixed64 -> Just (txt "Int64", "ExtSFixed64")-  SBool -> Just (txt "Bool", "ExtBool")-  SString -> Just (txt "Text", "ExtString")-  SBytes -> Just (txt "ByteString", "ExtBytes")-extensionPayloadCore (FTNamed _) =-  -- Named-type (message / enum) extensions carry raw encoded-  -- bytes; callers decode them lazily via the normal message-  -- decoder for the referenced type.-  Just (txt "ByteString", "ExtMessage")---{- | Whether a scalar can use the packed encoding (proto2 default-false; proto3 default true). Strings and bytes can't.--}-packableScalar :: ScalarType -> Bool-packableScalar = \case-  SString -> False-  SBytes -> False-  _ -> True----- Resolve an extended type name to its Haskell module-qualified--- form. Same logic as 'qualifyRpcType' in 'genServiceTopLevel'.-qualifyExtendedType :: GenCtx -> Text -> Text -> Text-qualifyExtendedType ctx pkg name =-  let candidates = [name, pkg <> "." <> name]-      go [] = Nothing-      go (c : cs) = case Map.lookup c (gcRegistry ctx) of-        Just ti -> Just ti-        Nothing -> go cs-  in case go candidates of-      Just ti-        | tiModule ti /= gcThisMod ctx ->-            moduleAlias (tiModule ti) <> "." <> tiHsName ti-        | otherwise -> tiHsName ti-      Nothing -> hsTypeName (lastDot name)---lastDot :: Text -> Text-lastDot t = case T.splitOn "." t of-  [] -> t-  parts -> last parts----- ------------------------------------------------------------------------------ Enum generation--- -----------------------------------------------------------------------------genEnum :: GenCtx -> [Text] -> EnumDef -> [Doc ann]-genEnum ctx scope ed =-  let scope' = scope <> [enumName ed]-      tyN = scopedTypeName scope'-      hookCtx =-        EnumHookCtx-          { ehcEnumDef = ed-          , ehcScope = scope'-          , ehcHsTypeName = tyN-          , ehcOptions = enumOptions ed-          }-      hookOutput = onEnumCodeGen (genHooks (gcOpts ctx)) hookCtx-      hookDocs = fmap pretty hookOutput-  in [ mempty-     , genEnumDataDecl scope' ed-     , mempty-     , genEnumToProto scope' ed-     , mempty-     , genEnumFromProto scope' ed-     , mempty-     , genEnumEncodeInstance scope' ed-     , mempty-     , genEnumToJSONInstance scope' ed-     , mempty-     , genEnumFromJSONInstance scope' ed-     , mempty-     , genEnumHashableInstance scope' ed-     ]-      <> case hookDocs of-        [] -> []-        ds -> [mempty, vsep ds]---genEnumDataDecl :: [Text] -> EnumDef -> Doc ann-genEnumDataDecl scope ed =-  let tyN = scopedTypeName scope-      hasAlias = enumHasAliases ed-      primaryVals = enumPrimaryValues ed-      aliasVals = enumAliasValues ed-      deriveLine =-        if hasAlias-          then txt "deriving stock (Show, Eq, Ord, Generic)"-          else txt "deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)"-      aliasSyns =-        fmap-          ( \ev ->-              txt "pattern "-                <> pretty (scopedEnumCon scope (evName ev))-                <+> txt "::"-                <+> pretty tyN-                <> line-                <> txt "pattern "-                <> pretty (scopedEnumCon scope (evName ev))-                <+> txt "= "-                <> pretty (scopedEnumCon scope (canonicalNameForNumber ed (evNumber ev)))-          )-          aliasVals-  in vsep $-      haddockDoc (enumDoc ed)-        <> [ txt "data " <> pretty tyN-           , indent 2 (vsep (concatMap (\(pfx, v) -> (pfx <+> pretty (scopedEnumCon scope (evName v))) : haddockFieldDoc (evDoc v)) (zip seps primaryVals)))-           , indent 2 deriveLine-           , indent 2 (txt "deriving anyclass NFData")-           ]-        <> aliasSyns-  where-    seps = txt "=" : repeat (txt "|")---genEnumToProto :: [Text] -> EnumDef -> Doc ann-genEnumToProto scope ed =-  let tyN = scopedTypeName scope-      primaryVals = enumPrimaryValues ed-      genCase ev =-        txt "toProtoEnum"-          <> pretty tyN-          <+> pretty (scopedEnumCon scope (evName ev))-          <+> txt "= "-          <> pretty (T.pack (show (evNumber ev)))-  in vsep-      [ txt "toProtoEnum" <> pretty tyN <+> txt "::" <+> pretty tyN <+> txt "-> Int"-      , vsep (fmap genCase primaryVals)-      ]---genEnumFromProto :: [Text] -> EnumDef -> Doc ann-genEnumFromProto scope ed =-  let tyN = scopedTypeName scope-      primaryVals = enumPrimaryValues ed-      genCase ev =-        txt "fromProtoEnum"-          <> pretty tyN-          <+> pretty (T.pack (show (evNumber ev)))-          <+> txt "= Just "-          <> pretty (scopedEnumCon scope (evName ev))-  in vsep-      [ txt "fromProtoEnum" <> pretty tyN <+> txt "::" <+> txt "Int -> Maybe " <> pretty tyN-      , vsep (fmap genCase primaryVals)-      , txt "fromProtoEnum" <> pretty tyN <+> txt "_ = Nothing"-      ]---enumHasAliases :: EnumDef -> Bool-enumHasAliases ed =-  let nums = fmap evNumber (enumValues ed)-  in length nums /= length (Set.fromList nums)---enumPrimaryValues :: EnumDef -> [EnumValue]-enumPrimaryValues ed = go Set.empty (enumValues ed)-  where-    go _ [] = []-    go seen (ev : evs)-      | Set.member (evNumber ev) seen = go seen evs-      | otherwise = ev : go (Set.insert (evNumber ev) seen) evs---enumAliasValues :: EnumDef -> [EnumValue]-enumAliasValues ed = go Set.empty (enumValues ed)-  where-    go _ [] = []-    go seen (ev : evs)-      | Set.member (evNumber ev) seen = ev : go seen evs-      | otherwise = go (Set.insert (evNumber ev) seen) evs---canonicalNameForNumber :: EnumDef -> Int -> Text-canonicalNameForNumber ed num =-  case filter (\ev -> evNumber ev == num) (enumValues ed) of-    (ev : _) -> evName ev-    [] -> "UNKNOWN"---genEnumEncodeInstance :: [Text] -> EnumDef -> Doc ann-genEnumEncodeInstance scope _ed =-  let tyN = scopedTypeName scope-  in vsep-      [ instanceHead "MessageEncode" tyN-      , indent 2 (txt "buildSized _ = mempty")-      , instanceHead "MessageDecode" tyN-      , indent 2 (txt "messageDecoder = pure (Prelude.toEnum 0)")-      ]---genEnumToJSONInstance :: [Text] -> EnumDef -> Doc ann-genEnumToJSONInstance scope ed =-  let tyN = scopedTypeName scope-      primaryVals = enumPrimaryValues ed-      genCase ev =-        txt "toJSON "-          <> pretty (scopedEnumCon scope (evName ev))-          <+> pretty ("= Aeson.String \"" :: Text)-          <> pretty (evName ev)-          <> pretty ("\"" :: Text)-  in vsep-      [ instanceHead "Aeson.ToJSON" tyN-      , indent 2 (vsep (fmap genCase primaryVals))-      ]---genEnumFromJSONInstance :: [Text] -> EnumDef -> Doc ann-genEnumFromJSONInstance scope ed =-  let tyN = scopedTypeName scope-      hasAlias = enumHasAliases ed-      genCase ev =-        pretty ("  Aeson.String \"" :: Text) <> pretty (evName ev) <> pretty ("\" -> pure " :: Text) <> pretty (scopedEnumCon scope (evName ev))-      fallbackNumCase =-        if hasAlias-          then-            txt "  Aeson.Number n -> case fromProtoEnum"-              <> pretty tyN-              <> pretty (" (round n) of { Just v -> pure v; Nothing -> fail \"Invalid enum\" }" :: Text)-          else txt "  Aeson.Number n -> pure (Prelude.toEnum (round n))"-  in vsep-      [ instanceHead "Aeson.FromJSON" tyN-      , indent 2 $-          vsep-            [ txt "parseJSON = \\case"-            , vsep (fmap genCase (enumValues ed))-            , fallbackNumCase-            , txt "  _ -> fail " <> pretty ("\"Invalid enum value for " :: Text) <> pretty tyN <> pretty ("\"" :: Text)-            ]-      ]----- ------------------------------------------------------------------------------ Haskell type helpers--- -----------------------------------------------------------------------------hsFieldType :: GenCtx -> [Text] -> FieldType -> Maybe FieldLabel -> Doc ann-hsFieldType ctx scope ft = \case-  Just Repeated -> hsRepeatedType ctx scope ft-  Just Optional -> txt "!(Maybe " <> hsFieldTypeInner ctx scope ft <> txt ")"-  Just Required -> txt "!" <> hsFieldTypeInner ctx scope ft-  Nothing -> case ft of-    FTScalar s | isUnboxableScalar s -> txt "{-# UNPACK #-} !" <> hsScalarType s-    FTScalar _ -> txt "!" <> hsFieldTypeInner ctx scope ft-    FTNamed n -> case resolveTypeWithScope ctx scope n of-      Just ti | tiKind ti == TKEnum -> txt "!" <> pretty (qualifyTypeRef ctx (Just ti) n)-      _ -> txt "!(Maybe " <> hsFieldTypeInner ctx scope ft <> txt ")"---hsFieldTypeInner :: GenCtx -> [Text] -> FieldType -> Doc ann-hsFieldTypeInner ctx scope = \case-  FTScalar s -> hsScalarType s-  FTNamed n -> pretty (resolveHsTypeNameScoped ctx scope n)---hsOneofFieldType :: GenCtx -> [Text] -> FieldType -> Doc ann-hsOneofFieldType ctx scope = \case-  FTScalar s -> unpackPragma s <> hsScalarType s-  FTNamed n -> txt "!" <> pretty (resolveHsTypeNameScoped ctx scope n)---hsRepeatedType :: GenCtx -> [Text] -> FieldType -> Doc ann-hsRepeatedType ctx scope = \case-  FTScalar s | isUnboxableScalar s -> txt "!(VU.Vector " <> hsScalarType s <> txt ")"-  ft -> txt "!(V.Vector " <> hsFieldTypeInner ctx scope ft <> txt ")"---{- | Resolve a proto type name to its Haskell reference.-Returns a qualified name like @PB_Timestamp.Timestamp@ for external types,-or an unqualified name like @Payload@ for local types.--}-resolveHsTypeNameScoped :: GenCtx -> [Text] -> Text -> Text-resolveHsTypeNameScoped ctx scope name = qualifyTypeRef ctx (resolveTypeWithScope ctx scope name) name---qualifyTypeRef :: GenCtx -> Maybe TypeInfo -> Text -> Text-qualifyTypeRef ctx mti name = case mti of-  Just ti-    | tiModule ti == gcThisMod ctx -> tiHsName ti-    | otherwise -> moduleAlias (tiModule ti) <> "." <> tiHsName ti-  Nothing -> hsTypeName (lastPart name)-  where-    lastPart t = case T.splitOn "." t of-      [] -> t-      parts -> last parts---hsScalarType :: ScalarType -> Doc ann-hsScalarType = \case-  SDouble -> txt "Double"-  SFloat -> txt "Float"-  SInt32 -> txt "Int32"-  SInt64 -> txt "Int64"-  SUInt32 -> txt "Word32"-  SUInt64 -> txt "Word64"-  SSInt32 -> txt "Int32"-  SSInt64 -> txt "Int64"-  SFixed32 -> txt "Word32"-  SFixed64 -> txt "Word64"-  SSFixed32 -> txt "Int32"-  SSFixed64 -> txt "Int64"-  SBool -> txt "Bool"-  SString -> txt "Text"-  SBytes -> txt "ByteString"---isUnboxableScalar :: ScalarType -> Bool-isUnboxableScalar = \case-  SString -> False-  SBytes -> False-  _ -> True---unpackPragma :: ScalarType -> Doc ann-unpackPragma s-  | isUnboxableScalar s = txt "{-# UNPACK #-} !"-  | otherwise = txt "!"----- ------------------------------------------------------------------------------ Name conversion helpers--- ------------------------------------------------------------------------------- | Build a Haskell type name from a scope path, joining with @'@.-scopedTypeName :: [Text] -> Text-scopedTypeName = T.intercalate "'" . fmap hsTypeName----- | Build a Haskell record field name using 'PrefixedFields' naming.-scopedFieldName :: [Text] -> Text -> Text-scopedFieldName = scopedFieldNameWith PrefixedFields----- | Build a Haskell record field name using the given naming strategy.-scopedFieldNameWith :: FieldNaming -> [Text] -> Text -> Text-scopedFieldNameWith PrefixedFields scope fName =-  let prefix = case scope of-        [] -> ""-        [s] -> lowerFirst (hsTypeName s)-        _ -> lowerFirst (T.intercalate "" (fmap hsTypeName scope))-  in escapeReserved (prefix <> upperFirst (snakeToCamel fName))-scopedFieldNameWith UnprefixedFields _scope fName =-  escapeReserved (snakeToCamel fName)---upperFirst :: Text -> Text-upperFirst s = case T.uncons s of-  Just (c, rest) -> T.cons (toUpper c) rest-  Nothing -> s----- | Build a Haskell enum constructor name from scope and value name.-scopedEnumCon :: [Text] -> Text -> Text-scopedEnumCon scope valName =-  case scope of-    [] -> snakeToPascal valName-    _ -> scopedTypeName scope <> "'" <> snakeToPascal valName----- | Capitalize the first character of a name for use as a Haskell type name.-hsTypeName :: Text -> Text-hsTypeName t = case T.uncons t of-  Just (c, rest) -> T.cons (toUpper c) rest-  Nothing -> t---hsModuleName :: Text -> Text-hsModuleName = T.intercalate "." . fmap capitalize . T.splitOn "."-  where-    capitalize t = case T.uncons t of-      Just (c, rest) -> T.cons (toUpper c) rest-      Nothing -> t---lowerFirst :: Text -> Text-lowerFirst s = case T.uncons s of-  Just (c, rest) -> T.cons (toLower c) rest-  Nothing -> s---titleCase :: Text -> Text-titleCase s = case T.uncons s of-  Just (c, rest) -> T.cons (toUpper c) (T.toLower rest)-  Nothing -> s---snakeToCamel :: Text -> Text-snakeToCamel t =-  let parts = T.splitOn "_" t-  in case parts of-      [] -> t-      (p : ps) -> T.concat (lowerFirst p : fmap titleCase ps)---{- | Proto3 JSON name conversion per the canonical spec-(mirror of @ToJsonName@ in the upstream protoc C++ source).--Differences vs. 'snakeToCamel' that the conformance suite-(@FieldNameWithMixedCases@, @FieldNameWithDoubleUnderscores@,-etc.) depends on:--* The case of every non-underscore character is preserved-  /as-is/, only the character /after/ an @_@ is upcased.-  So @FieldName8@ stays @FieldName8@ (we don't lowercase-  the leading @F@).-* Repeated underscores collapse: @field__name15@ becomes-  @fieldName15@ (only the next non-underscore is upcased).-* Trailing underscores are dropped: @Field_name18__@-  becomes @FieldName18@.--}-protoJsonName :: Text -> Text-protoJsonName = T.pack . go False . T.unpack-  where-    go _ [] = []-    go capNext (c : cs)-      | c == '_' = go True cs-      | capNext = toUpper c : go False cs-      | otherwise = c : go False cs---snakeToPascal :: Text -> Text-snakeToPascal t =-  let parts = T.splitOn "_" t-  in T.concat (fmap titleCase parts)---escapeReserved :: Text -> Text-escapeReserved t-  | t `elem` haskellReserved = t <> "'"-  | otherwise = t---haskellReserved :: [Text]-haskellReserved =-  [ "type"-  , "class"-  , "data"-  , "default"-  , "deriving"-  , "do"-  , "else"-  , "if"-  , "import"-  , "in"-  , "infix"-  , "infixl"-  , "infixr"-  , "instance"-  , "let"-  , "module"-  , "newtype"-  , "of"-  , "then"-  , "where"-  , "case"-  , "foreign"-  , "forall"-  , "mdo"-  , "qualified"-  , "hiding"-  ]---oneofConName :: [Text] -> Text -> Text -> Text-oneofConName scope oneofN fieldName =-  scopedTypeName scope <> "'" <> snakeToPascal oneofN <> "'" <> snakeToPascal fieldName+This module powers the standalone @wireform-protoc@ code generator+(as opposed to the Template Haskell path in "Proto.TH"). It produces+complete, compilable Haskell source text with:++* Proper cross-module imports via a 'TypeRegistry'+* Record types for messages, sum types for enums and oneofs+* @MessageEncode@ \/ @MessageDecode@ \/ @MessageSize@ instances+* @Aeson.ToJSON@ \/ @Aeson.FromJSON@ instances (respecting @json_name@)+* Map field, oneof, and nested message support++== 'GenerateOpts' configuration++Use 'GenerateOpts' to control the output:++  ['genModulePrefix'] The Haskell module prefix prepended to generated+    module names. Default: @\"Proto.Gen\"@.++  ['genFieldNaming'] How to name record fields -- 'PrefixedFields'+    (default, e.g. @personName@) or 'UnprefixedFields' (e.g. @name@,+    requires @DuplicateRecordFields@).++  ['genStrictFields'] Whether to add strict-field annotations (@!@).+    Default: 'True'.++  ['genUnpackPrims'] Whether to add @UNPACK@ pragmas on primitive+    fields. Default: 'True'.++  ['genDeriveGeneric'] Derive @GHC.Generics.Generic@. Default: 'True'.++  ['genDeriveNFData'] Derive @Control.DeepSeq.NFData@. Default: 'True'.++  ['genPackedRepeated'] Use packed encoding for repeated scalar fields.+    Default: 'True'.++  ['genLazySubmessages'] Decode submessage fields lazily+    (via 'Proto.Decode.LazyMessage'). Default: 'False'.++  ['genJsonOverrides'] Per-message overrides for JSON instances. See+    'JsonOverride'.++  ['genHooks'] 'CodeGenHooks' callbacks for emitting extra declarations.+-}+module Proto.CodeGen (+  generateModule,+  generateModuleText,+  GenerateOpts (..),+  defaultGenerateOpts,+  FieldNaming (..),+  JsonOverride (..),+  defaultJsonOverrides,+  TypeRegistry,+  TypeInfo (..),+  TypeKind (..),+  buildTypeRegistry,+  moduleNameForProto,+  hsTypeName,+  hsModuleName,+  scopedTypeName,+  scopedFieldName,+  scopedFieldNameWith,+  scopedEnumCon,+  snakeToCamel,+  snakeToPascal,+  protoJsonName,+  lowerFirst,+  escapeReserved,++  -- * Codegen combinators (re-exported from Combinators)+  txt,+  tshow,+  braceBlock,+  instanceHead,++  -- * Codegen hooks (re-exported from Hooks)+  module Proto.CodeGen.Hooks,+) where++import Data.ByteString qualified as BS+import Data.Char (isAsciiUpper, toLower, toUpper)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe)+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Word (Word8)+import Prettyprinter+import Prettyprinter.Render.Text (renderStrict)+import Proto.CodeGen.Hooks+import Proto.CodeGen.Service qualified as Service+import Proto.IDL.AST+import Proto.IDL.Annotations (lookupSimpleOption, optionAsString)+import Proto.IDL.Descriptor (serializeFileDescriptor)+import Proto.IDL.Options+import Proto.IDL.Options.Custom (emptyCustomOptionRegistry, extractExtensionOptions, registerCustomOption)+import Proto.IDL.Parser.Resolver (ResolvedProto (..))+import Proto.Internal.CodeGen.Combinators (braceBlock, instanceHead, tshow, txt)+++-- | Emit a Haddock doc comment block from a proto doc comment.+haddockDoc :: Maybe Text -> [Doc ann]+haddockDoc Nothing = []+haddockDoc (Just doc) =+  let ls = T.lines doc+  in case ls of+       [] -> []+       (first_ : rest) ->+         [txt "-- | " <> pretty first_]+           <> fmap (\l -> txt "-- " <> pretty l) rest+++-- | Emit a Haddock post-item doc comment (@-- ^@) from a proto doc comment.+haddockFieldDoc :: Maybe Text -> [Doc ann]+haddockFieldDoc Nothing = []+haddockFieldDoc (Just doc) =+  let ls = T.lines doc+  in case ls of+       [] -> []+       (first_ : rest) ->+         [indent 2 (txt "-- ^ " <> pretty first_)]+           <> fmap (\l -> indent 2 (txt "-- " <> pretty l)) rest+++wireVarint, wire64Bit, wireLengthDelimited, wire32Bit :: Int+wireVarint = 0+wire64Bit = 1+wireLengthDelimited = 2+wire32Bit = 5+++computeTagByte :: Int -> Int -> Int+computeTagByte fieldNum wireType = fieldNum * 8 + wireType+++tagLit :: Text -> Int -> Doc ann+tagLit fnText wt =+  let fieldNum = read (T.unpack fnText) :: Int+  in pretty (computeTagByte fieldNum wt)+++-- ---------------------------------------------------------------------------+-- Options+-- ---------------------------------------------------------------------------++{- | Controls how generated record field names relate to the proto+field name and the enclosing message name.+-}+data FieldNaming+  = {- | Prefix each field with the lowercased message name.+    @message Person { string name = 1; }@ becomes+    @personName :: !Text@. This is the default; it avoids+    name clashes without @DuplicateRecordFields@.+    -}+    PrefixedFields+  | {- | Use the proto field name directly (snake_case to camelCase).+    @message Person { string name = 1; }@ becomes+    @name :: !Text@.  Requires @DuplicateRecordFields@ if two+    messages share a field name. Works well with+    @OverloadedRecordDot@ and GHC's @HasField@ class.+    -}+    UnprefixedFields+  deriving stock (Show, Eq)+++{- | Options controlling the pure-text code generator.+See the module-level documentation for a description of each field.+-}+data GenerateOpts = GenerateOpts+  { genModulePrefix :: Text+  -- ^ Haskell module prefix (e.g. @\"Proto.Gen\"@).+  , genFieldNaming :: FieldNaming+  -- ^ Record field naming strategy.+  , genStrictFields :: Bool+  -- ^ Add strict annotations (@!@) to record fields.+  , genUnpackPrims :: Bool+  -- ^ Add @UNPACK@ pragmas on primitive fields.+  , genDeriveGeneric :: Bool+  -- ^ Derive @GHC.Generics.Generic@.+  , genDeriveNFData :: Bool+  -- ^ Derive @Control.DeepSeq.NFData@.+  , genPackedRepeated :: Bool+  -- ^ Use packed wire encoding for repeated scalar fields.+  , genLazySubmessages :: Bool+  -- ^ Decode submessage fields lazily via 'Proto.Decode.LazyMessage'.+  , genJsonOverrides :: Map Text JsonOverride+  -- ^ Per-message 'JsonOverride' keyed by fully-qualified proto name.+  , genHooks :: CodeGenHooks+  -- ^ Callbacks for emitting extra declarations during codegen.+  }+++{- | Custom JSON instance override for a specific FQ proto message name.+When present, the code generator emits the provided Haskell source text+instead of the generic JSON instances.+-}+data JsonOverride = JsonOverride+  { joToJSON :: Text+  , joFromJSON :: Text+  }+  deriving stock (Show, Eq)+++{- | Sensible defaults: @\"Proto.Gen\"@ module prefix, prefixed field+names, strict fields, unpack primitives, derive Generic and NFData,+packed repeated scalars, eager submessages, built-in JSON overrides+for well-known types, no hooks.+-}+defaultGenerateOpts :: GenerateOpts+defaultGenerateOpts =+  GenerateOpts+    { genModulePrefix = "Proto.Gen"+    , genFieldNaming = PrefixedFields+    , genStrictFields = True+    , genUnpackPrims = True+    , genDeriveGeneric = True+    , genDeriveNFData = True+    , genPackedRepeated = True+    , genLazySubmessages = False+    , genJsonOverrides = defaultJsonOverrides+    , genHooks = defaultCodeGenHooks+    }+++{- | Built-in JSON overrides for well-known types that require canonical+proto3 JSON representations.+-}+defaultJsonOverrides :: Map Text JsonOverride+defaultJsonOverrides =+  Map.fromList+    [+      ( "google.protobuf.Timestamp"+      , JsonOverride+          { joToJSON =+              T.unlines+                [ "  toJSON msg ="+                , "    let s = msg.timestampSeconds"+                , "        n = msg.timestampNanos"+                , "        (rawDays, remSec) = s `divMod` 86400"+                , "        (hours, remH) = remSec `divMod` 3600"+                , "        (mins, secs) = remH `divMod` 60"+                , "        z = rawDays + 719468"+                , "        era = (if z >= 0 then z else z - 146096) `div` 146097"+                , "        doe = z - era * 146097"+                , "        yoe = (doe - doe `div` 1460 + doe `div` 36524 - doe `div` 146096) `div` 365"+                , "        y = yoe + era * 400"+                , "        doy = doe - (365 * yoe + yoe `div` 4 - yoe `div` 100)"+                , "        mp = (5 * doy + 2) `div` 153"+                , "        d = doy - (153 * mp + 2) `div` 5 + 1"+                , "        m = mp + (if mp < 10 then 3 else -9)"+                , "        y' = y + (if m <= 2 then 1 else 0)"+                , "        pad2 x = let sx = T.pack (show (abs x)) in if T.length sx < 2 then T.pack \"0\" <> sx else sx"+                , "        pad4 x = let sx = T.pack (show (abs x)) in T.replicate (4 - T.length sx) (T.pack \"0\") <> sx"+                , "        pad9 x = let sx = T.pack (show (abs x)) in T.replicate (9 - T.length sx) (T.pack \"0\") <> sx"+                , "        nanoStr = if n == 0 then T.pack \"\" else T.pack \".\" <> dropTrailingZeros (pad9 (fromIntegral n))"+                , "        dropTrailingZeros t = case T.stripSuffix (T.pack \"0\") t of { Just t' -> dropTrailingZeros t'; Nothing -> t }"+                , "    in Aeson.String (pad4 y' <> T.pack \"-\" <> pad2 (fromIntegral m) <> T.pack \"-\" <> pad2 (fromIntegral d)"+                , "         <> T.pack \"T\" <> pad2 hours <> T.pack \":\" <> pad2 mins <> T.pack \":\" <> pad2 secs"+                , "         <> nanoStr <> T.pack \"Z\")"+                ]+          , joFromJSON =+              T.unlines+                [ "  parseJSON (Aeson.String _) = pure defaultTimestamp"+                , "  parseJSON _ = fail \"Expected RFC 3339 timestamp string\""+                ]+          }+      )+    ,+      ( "google.protobuf.Duration"+      , JsonOverride+          { joToJSON =+              T.unlines+                [ "  toJSON msg ="+                , "    let s = msg.durationSeconds"+                , "        n = msg.durationNanos"+                , "        nanoStr = if n == 0 then T.pack \"\" else T.pack \".\" <> dropTrailingZeros (pad9 (abs (fromIntegral n)))"+                , "        dropTrailingZeros t = case T.stripSuffix (T.pack \"0\") t of { Just t' -> dropTrailingZeros t'; Nothing -> t }"+                , "        pad9 x = let sx = T.pack (show x) in T.replicate (9 - T.length sx) (T.pack \"0\") <> sx"+                , "        sign = if s < 0 || n < 0 then T.pack \"-\" else T.pack \"\""+                , "    in Aeson.String (sign <> T.pack (show (abs s)) <> nanoStr <> T.pack \"s\")"+                ]+          , joFromJSON =+              T.unlines+                [ "  parseJSON (Aeson.String _) = pure defaultDuration"+                , "  parseJSON _ = fail \"Expected duration string like \\\"3.5s\\\"\""+                ]+          }+      )+    ]+++-- ---------------------------------------------------------------------------+-- Type registry: maps fully-qualified proto names to Haskell type info+-- ---------------------------------------------------------------------------++-- | Whether a registered type is a message or an enum.+data TypeKind+  = -- | A message type.+    TKMessage+  | -- | An enum type.+    TKEnum+  deriving stock (Show, Eq, Ord)+++-- | Information about a registered proto type's Haskell mapping.+data TypeInfo = TypeInfo+  { tiModule :: Text+  -- ^ The Haskell module containing this type.+  , tiHsName :: Text+  -- ^ The Haskell type name.+  , tiKind :: TypeKind+  -- ^ Whether this is a message or enum.+  }+  deriving stock (Show, Eq)+++-- | Maps fully-qualified proto type names to their Haskell type info.+type TypeRegistry = Map Text TypeInfo+++{- | Build a TypeRegistry from a list of (proto file path, resolved proto).+Walks all top-levels and nested definitions, recording their FQ names.+| Build a TypeRegistry from resolved proto files. Also includes entries+for the standard well-known Google protobuf types, pointing to their+generated modules under @Proto.Google.Protobuf.*@.+-}+buildTypeRegistry :: GenerateOpts -> [(FilePath, ResolvedProto)] -> TypeRegistry+buildTypeRegistry opts rpList =+  Map.union+    builtinWellKnownTypes+    (Map.unions (fmap (\(fp, rp) -> registryForFile opts (normalizeProtoPath fp) (rpFile rp)) rpList))+++{- | Registry entries for standard Google well-known types.+These reference the generated modules at @Proto.Google.Protobuf.*@,+which are produced by running the code generator on the bundled+@proto/google/protobuf/*.proto@ files with prefix @Proto@.+-}+builtinWellKnownTypes :: TypeRegistry+builtinWellKnownTypes =+  Map.fromList+    [ wkt "google.protobuf.Duration" "Proto.Google.Protobuf.Duration" "Duration"+    , wkt "google.protobuf.Timestamp" "Proto.Google.Protobuf.Timestamp" "Timestamp"+    , wkt "google.protobuf.Empty" "Proto.Google.Protobuf.Empty" "Empty"+    , wkt "google.protobuf.Any" "Proto.Google.Protobuf.Any" "Any"+    , wkt "google.protobuf.Struct" "Proto.Google.Protobuf.Struct" "Struct"+    , wkt "google.protobuf.Value" "Proto.Google.Protobuf.Struct" "Value"+    , wkt "google.protobuf.ListValue" "Proto.Google.Protobuf.Struct" "ListValue"+    , wkt "google.protobuf.NullValue" "Proto.Google.Protobuf.Struct" "NullValue"+    , wkt "google.protobuf.FieldMask" "Proto.Google.Protobuf.FieldMask" "FieldMask"+    , wkt "google.protobuf.SourceContext" "Proto.Google.Protobuf.SourceContext" "SourceContext"+    , wkt "google.protobuf.DoubleValue" "Proto.Google.Protobuf.Wrappers" "DoubleValue"+    , wkt "google.protobuf.FloatValue" "Proto.Google.Protobuf.Wrappers" "FloatValue"+    , wkt "google.protobuf.Int64Value" "Proto.Google.Protobuf.Wrappers" "Int64Value"+    , wkt "google.protobuf.UInt64Value" "Proto.Google.Protobuf.Wrappers" "UInt64Value"+    , wkt "google.protobuf.Int32Value" "Proto.Google.Protobuf.Wrappers" "Int32Value"+    , wkt "google.protobuf.UInt32Value" "Proto.Google.Protobuf.Wrappers" "UInt32Value"+    , wkt "google.protobuf.BoolValue" "Proto.Google.Protobuf.Wrappers" "BoolValue"+    , wkt "google.protobuf.StringValue" "Proto.Google.Protobuf.Wrappers" "StringValue"+    , wkt "google.protobuf.BytesValue" "Proto.Google.Protobuf.Wrappers" "BytesValue"+    ]+  where+    wkt fqn modName hsName = (fqn, TypeInfo modName hsName TKMessage)+++{- | Normalize a proto file path to a relative path suitable for module naming.+Handles absolute paths by extracting the proto-relative portion.+-}+normalizeProtoPath :: FilePath -> FilePath+normalizeProtoPath = id+++registryForFile :: GenerateOpts -> FilePath -> ProtoFile -> TypeRegistry+registryForFile opts fp pf =+  let modName = moduleNameForProto opts fp pf+      pkg = fromMaybe "" (protoPackage pf)+  in Map.unions (fmap (registryForTopLevel modName pkg []) (protoTopLevels pf))+++registryForTopLevel :: Text -> Text -> [Text] -> TopLevel -> TypeRegistry+registryForTopLevel modName pkg scope = \case+  TLMessage msg -> registryForMessage modName pkg scope msg+  TLEnum ed -> registryForEnum modName pkg scope ed+  _ -> Map.empty+++registryForMessage :: Text -> Text -> [Text] -> MessageDef -> TypeRegistry+registryForMessage modName pkg scope msg =+  let scope' = scope <> [msgName msg]+      fqName = if T.null pkg then T.intercalate "." scope' else pkg <> "." <> T.intercalate "." scope'+      hsName = T.intercalate "'" (fmap hsTypeName scope')+      self =+        Map.singleton+          fqName+          TypeInfo+            { tiModule = modName+            , tiHsName = hsName+            , tiKind = TKMessage+            }+      nested = Map.unions (fmap (registryForElement modName pkg scope') (msgElements msg))+  in Map.union self nested+++registryForElement :: Text -> Text -> [Text] -> MessageElement -> TypeRegistry+registryForElement modName pkg scope = \case+  MEMessage inner -> registryForMessage modName pkg scope inner+  MEEnum ed -> registryForEnum modName pkg scope ed+  _ -> Map.empty+++registryForEnum :: Text -> Text -> [Text] -> EnumDef -> TypeRegistry+registryForEnum modName pkg scope ed =+  let scope' = scope <> [enumName ed]+      fqName = if T.null pkg then T.intercalate "." scope' else pkg <> "." <> T.intercalate "." scope'+      hsName = T.intercalate "'" (fmap hsTypeName scope')+  in Map.singleton+       fqName+       TypeInfo+         { tiModule = modName+         , tiHsName = hsName+         , tiKind = TKEnum+         }+++{- | Compute the Haskell module name for a proto file.++Prefers @csharp_namespace@ if set (already PascalCase with dots), appending+the proto file's base name for disambiguation when multiple files share a+namespace (e.g. enum files). Falls back to the file path.++@csharp_namespace = "Temporalio.Api.Common.V1"@ with file @message.proto@+produces @Proto.Temporalio.Api.Common.V1.Message@.+-}+moduleNameForProto :: GenerateOpts -> FilePath -> ProtoFile -> Text+moduleNameForProto opts filePath pf =+  let fo = extractFileOptions (protoOptions pf)+      baseName = fileBaseName filePath+  in case foCsharpNamespace fo of+       Just ns -> genModulePrefix opts <> "." <> ns <> "." <> baseName+       Nothing -> genModulePrefix opts <> "." <> moduleFromPath filePath+  where+    fileBaseName fp =+      let t = T.pack fp+          stripped = fromMaybe t (T.stripSuffix ".proto" t)+          parts = T.splitOn "/" stripped+      in pathPartToModule (last parts)++    moduleFromPath fp =+      let t = T.pack fp+          s = fromMaybe t (T.stripSuffix ".proto" t)+          parts = T.splitOn "/" s+      in T.intercalate "." (fmap pathPartToModule parts)++    pathPartToModule t = snakeToPascal (capitalize t)++    capitalize t = case T.uncons t of+      Just (c, rest) -> T.cons (toUpper c) rest+      Nothing -> t+++-- ---------------------------------------------------------------------------+-- Code generation+-- ---------------------------------------------------------------------------++data GenCtx = GenCtx+  { gcOpts :: GenerateOpts+  , gcRegistry :: TypeRegistry+  , gcThisMod :: Text+  , gcPkg :: Maybe Text+  , gcLocalTypes :: Set Text+  }+++-- | Produce a record field name using the context's naming mode.+ctxFieldName :: GenCtx -> [Text] -> Text -> Text+ctxFieldName ctx = scopedFieldNameWith (genFieldNaming (gcOpts ctx))+++-- | Generate a complete Haskell module as a 'Doc' from a proto file.+generateModule :: GenerateOpts -> TypeRegistry -> FilePath -> ProtoFile -> Doc ann+generateModule opts reg filePath pf =+  let thisMod = moduleNameForProto opts filePath pf+      localTypes = collectLocalTypes (fromMaybe "" (protoPackage pf)) [] (protoTopLevels pf)+      ctx =+        GenCtx+          { gcOpts = opts+          , gcRegistry = reg+          , gcThisMod = thisMod+          , gcPkg = protoPackage pf+          , gcLocalTypes = localTypes+          }+      body = concatMap (genTopLevel ctx []) (protoTopLevels pf)+      referencedTypes = collectReferencedTypes (protoTopLevels pf)+      importedModules = computeImports ctx referencedTypes+      customOpts =+        foldl+          (flip registerCustomOption)+          emptyCustomOptionRegistry+          (extractExtensionOptions pf)+      fileHookCtx =+        FileHookCtx+          { fhcProtoFile = pf+          , fhcModuleName = thisMod+          , fhcFileOptions = protoOptions pf+          , fhcCustomOptions = customOpts+          }+      fileHookOutput = onFileCodeGen (genHooks opts) fileHookCtx+      fileHookDocs = fmap pretty fileHookOutput+  in vsep $+       [ genModuleHeader opts filePath pf+       , mempty+       , genImports importedModules+       , mempty+       , genFileDescriptorBinding filePath pf+       , mempty+       , vsep body+       ]+         <> case fileHookDocs of+           [] -> []+           ds -> [mempty, vsep ds]+++-- | Generate a complete Haskell module as rendered 'Text' from a proto file.+generateModuleText :: GenerateOpts -> TypeRegistry -> FilePath -> ProtoFile -> Text+generateModuleText opts reg filePath pf =+  renderStrict (layoutPretty defaultLayoutOptions (generateModule opts reg filePath pf))+++-- Collect all FQ type names defined locally in this file+collectLocalTypes :: Text -> [Text] -> [TopLevel] -> Set Text+collectLocalTypes pkg scope = foldMap go+  where+    go = \case+      TLMessage msg ->+        let scope' = scope <> [msgName msg]+            fqName = if T.null pkg then T.intercalate "." scope' else pkg <> "." <> T.intercalate "." scope'+        in Set.singleton fqName <> foldMap (goElem scope') (msgElements msg)+      TLEnum ed ->+        let scope' = scope <> [enumName ed]+            fqName = if T.null pkg then T.intercalate "." scope' else pkg <> "." <> T.intercalate "." scope'+        in Set.singleton fqName+      _ -> Set.empty+    goElem s = \case+      MEMessage inner ->+        let scope' = s <> [msgName inner]+            fqName = if T.null pkg then T.intercalate "." scope' else pkg <> "." <> T.intercalate "." scope'+        in Set.singleton fqName <> foldMap (goElem scope') (msgElements inner)+      MEEnum ed ->+        let scope' = s <> [enumName ed]+            fqName = if T.null pkg then T.intercalate "." scope' else pkg <> "." <> T.intercalate "." scope'+        in Set.singleton fqName+      _ -> Set.empty+++-- Collect all FTNamed type references from top-levels. Covers message+-- fields (including map values, oneof branches, nested messages) and+-- service RPC request/response types — without the service coverage,+-- a @.proto@ that defines a service whose inputs and outputs live in+-- a separate module would emit the module-header imports block+-- without those dependencies, which broke compilation for the+-- generated Service modules (they would @import@ their+-- RequestResponse module after top-level declarations, which is a+-- Haskell parse error).+collectReferencedTypes :: [TopLevel] -> Set Text+collectReferencedTypes = foldMap goTL+  where+    goTL = \case+      TLMessage msg -> goMsg msg+      TLService svc -> foldMap goRpc (svcRpcs svc)+      _ -> Set.empty+    goMsg msg = foldMap goElem (msgElements msg)+    goElem = \case+      MEField fd -> goFT (fieldType fd)+      MEMapField mf -> goFT (mapValueType mf)+      MEOneof od -> foldMap (goFT . oneofFieldType) (oneofFields od)+      MEMessage inner -> goMsg inner+      _ -> Set.empty+    goRpc r = Set.fromList [rpcInput r, rpcOutput r]+    goFT = \case+      FTNamed n -> Set.singleton n+      _ -> Set.empty+++-- Compute the set of external modules referenced by this file.+computeImports :: GenCtx -> Set Text -> Set Text+computeImports ctx refs =+  let thisMod = gcThisMod ctx+  in Set.fromList+       [ tiModule ti+       | ref <- Set.toList refs+       , Just ti <- [resolveType ctx ref]+       , tiModule ti /= thisMod+       ]+++-- Resolve a proto type name to TypeInfo. Tries FQ lookup first, then+-- with current package prefix, then with parent message scopes, then simple.+resolveType :: GenCtx -> Text -> Maybe TypeInfo+resolveType ctx = resolveTypeWithScope ctx []+++resolveTypeWithScope :: GenCtx -> [Text] -> Text -> Maybe TypeInfo+resolveTypeWithScope ctx scope name =+  let reg = gcRegistry ctx+      pkg = fromMaybe "" (gcPkg ctx)+      candidates =+        [ name+        , pkg <> "." <> name+        ]+          <> fmap (\s -> pkg <> "." <> T.intercalate "." s <> "." <> name) (filter (not . null) (tails' scope))+  in case firstJust (`Map.lookup` reg) candidates of+       Just ti -> Just ti+       Nothing ->+         let suffix = "." <> name+             matches = fmap snd (filter (\(k, _) -> T.isSuffixOf suffix k || k == name) (Map.toList reg))+         in case matches of+              (ti : _) -> Just ti+              [] -> Nothing+  where+    tails' [] = []+    tails' xs = xs : tails' (init xs)+    firstJust _ [] = Nothing+    firstJust f (x : xs) = case f x of+      Just v -> Just v+      Nothing -> firstJust f xs+++-- ---------------------------------------------------------------------------+-- Module header & imports+-- ---------------------------------------------------------------------------++genModuleHeader :: GenerateOpts -> FilePath -> ProtoFile -> Doc ann+genModuleHeader opts filePath pf =+  let modName = moduleNameForProto opts filePath pf+      pkgDoc = maybe "" (\p -> " from package @" <> p <> "@") (protoPackage pf)+      fo = extractFileOptions (protoOptions pf)+      deprLine =+        if foDeprecated fo+          then [txt "--", txt "-- __This file is deprecated.__"]+          else []+      dupRecordExts = case genFieldNaming opts of+        UnprefixedFields ->+          [ txt "{-# LANGUAGE DuplicateRecordFields #-}"+          , txt "{-# LANGUAGE NoFieldSelectors #-}"+          , -- The type-annotated getters/setters/updates that make bare+            -- field names unambiguous still trip -Wambiguous-fields (a+            -- deprecation notice for the type-directed resolution they rely+            -- on); silence it so the generated module builds under -Werror.+            txt "{-# OPTIONS_GHC -Wno-ambiguous-fields #-}"+          ]+        PrefixedFields -> []+  in vsep $+       [ txt "{-# LANGUAGE StrictData #-}"+       , txt "{-# LANGUAGE DeriveGeneric #-}"+       , txt "{-# LANGUAGE DeriveAnyClass #-}"+       , txt "{-# LANGUAGE DerivingStrategies #-}"+       , txt "{-# LANGUAGE OverloadedStrings #-}"+       , txt "{-# LANGUAGE OverloadedRecordDot #-}"+       , txt "{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-matches -Wno-unused-top-binds #-}"+       ]+         <> dupRecordExts+         <> [ txt "-- | Auto-generated protobuf types" <> pretty pkgDoc <> txt "."+            , txt "--"+            , txt "-- __THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__"+            , txt "--"+            , txt "-- Any manual changes will be overwritten the next time code"+            , txt "-- generation is run.  To modify the types or instances, edit the"+            , txt "-- @.proto@ source file and re-run the code generator."+            ]+         <> deprLine+         <> [txt "module " <> pretty modName <> txt " where"]+++genImports :: Set Text -> Doc ann+genImports externalModules =+  vsep $+    [ txt "import Data.ByteString (ByteString)"+    , txt "import qualified Data.ByteString as BS"+    , txt "import qualified Wireform.Builder as B"+    , txt "import Data.Int (Int32, Int64)"+    , txt "import Data.Text (Text)"+    , txt "import qualified Data.Text as T"+    , txt "import Data.Word (Word32, Word64)"+    , txt "import qualified Data.Map.Strict as Map"+    , txt "import qualified Data.Vector as V"+    , txt "import qualified Data.Vector.Unboxed as VU"+    , txt "import GHC.Generics (Generic)"+    , txt "import Control.DeepSeq (NFData(..))"+    , txt "import Data.Hashable (Hashable(..))"+    , txt "import Proto.Encode"+    , txt "import Proto.Decode"+    , txt "import qualified Data.Aeson as Aeson"+    , txt "import qualified Data.Aeson.Types as Aeson"+    , txt "import qualified Data.Aeson.Key as AesonKey"+    , txt "import qualified Data.Aeson.KeyMap as AesonKM"+    , txt "import Proto.Internal.JSON (jsonObject, (.=:), parseFieldMaybe, bytesFieldToJSON, parseBytesFieldMaybe, bytesMapFieldToJSON, parseBytesMapFieldMaybe, protoBytesToJSON)"+    , txt "import Data.Proxy (Proxy(..))"+    , txt "import Data.Reflection (Given(..), given)"+    , txt "import Proto.Internal.JSON.Extension qualified as PJExt"+    , txt "import Proto.Schema (ProtoMessage(..), SomeFieldDescriptor(..), FieldDescriptor(..), FieldTypeDescriptor(..), ScalarFieldType(..), FieldLabel'(..))"+    , txt "import Proto.Registry (IsMessage)"+    , txt "import Proto.Registry qualified"+    , txt "import qualified Proto.Extension"+    , txt "import Proto.Internal.Wire (Tag(..), WireType(..))"+    , txt "import Proto.Internal.Wire.Encode (putTag, putVarint, putFixed32, putFixed64,"+    , txt "  putFloat, putDouble, putText, putByteString, putLengthDelimited,"+    , txt "  putSVarint32, putSVarint64, putVarintSigned,"+    , txt "  varintSize, tagSize, fieldMessageSize,"+    , txt "  fieldVarintSize, fieldFixed32Size, fieldFixed64Size,"+    , txt "  fieldBoolSize, fieldFloatSize, fieldDoubleSize,"+    , txt "  fieldTextSize, fieldBytesSize,"+    , txt "  fieldSVarint32Size, fieldSVarint64Size,"+    , txt "  varintSize32, zigZag32, zigZag64)"+    , txt "import Proto.Internal.Encode.Archetype (archVarint, archSVarint32, archSVarint64,"+    , txt "  archFixed32, archFixed64, archFloat, archDouble, archBool,"+    , txt "  archString, archBytes, archSubmessage,"+    , txt "  archVarintSize, archStringSize, archBytesSize, archBoolSize,"+    , txt "  archFixed32Size, archFixed64Size, archSubmessageSize)"+    ]+      <> fmap genQualifiedImport (Set.toAscList externalModules)+++genQualifiedImport :: Text -> Doc ann+genQualifiedImport modName =+  txt "import qualified " <> pretty modName <> txt " as " <> pretty (moduleAlias modName)+++{- | Derive a short, deterministic alias from a module name.+Strips common prefixes and uses initials for boilerplate segments.++@Proto.Google.Protobuf.Timestamp@             -> @PB_Timestamp@+@Proto.Google.Protobuf.WellKnownTypes.Empty@  -> @PB_WellKnownTypes_Empty@+@Proto.Temporalio.Api.Common.V1.Message@       -> @TA_Common_V1_Message@+@Proto.Temporalio.Api.Enums.V1.Common@         -> @TA_Enums_V1_Common@+-}+moduleAlias :: Text -> Text+moduleAlias modName =+  let parts = T.splitOn "." modName+      meaningful = dropBoilerplate parts+  in T.intercalate "_" meaningful+  where+    dropBoilerplate = \case+      ("Proto" : "Google" : "Protobuf" : rest) -> "PB" : rest+      ("Proto" : ns : "Api" : rest) -> initials ns : rest+      ("Proto" : ns : rest) -> initials ns : rest+      ps -> ps+    initials t =+      let uppers = T.filter isAsciiUpper t+      in if T.length uppers >= 2 then uppers else T.toUpper (T.take 2 t)+++-- | Generate a top-level binding containing the serialized FileDescriptorProto.+genFileDescriptorBinding :: FilePath -> ProtoFile -> Doc ann+genFileDescriptorBinding filePath pf =+  let fdpBytes = serializeFileDescriptor filePath pf+      escapedLit = byteStringToHsLiteral fdpBytes+  in vsep+       [ txt "-- | Serialized FileDescriptorProto for this .proto file."+       , txt "-- Decode with @Proto.Google.Protobuf.Descriptor.decodeMessage@."+       , txt "fileDescriptorProtoBytes :: ByteString"+       , txt "fileDescriptorProtoBytes = " <> pretty ("\"" :: Text) <> pretty escapedLit <> pretty ("\"" :: Text)+       ]+++-- | Render a 'ByteString' as a Haskell string literal body using @\\xHH@ escapes.+byteStringToHsLiteral :: BS.ByteString -> Text+byteStringToHsLiteral = T.concat . fmap escapeWord8 . BS.unpack+  where+    escapeWord8 :: Word8 -> Text+    escapeWord8 w =+      let hi = hexNibble (w `div` 16)+          lo = hexNibble (w `mod` 16)+      in T.pack ['\\', 'x', hi, lo]+    hexNibble :: Word8 -> Char+    hexNibble n+      | n < 10 = toEnum (fromEnum '0' + fromIntegral n)+      | otherwise = toEnum (fromEnum 'a' + fromIntegral n - 10)+++-- ---------------------------------------------------------------------------+-- Top-level generation+-- ---------------------------------------------------------------------------++genTopLevel :: GenCtx -> [Text] -> TopLevel -> [Doc ann]+genTopLevel ctx scope = \case+  TLMessage msg -> genMessage ctx scope msg+  TLEnum ed -> genEnum ctx scope ed+  TLService svc -> genServiceTopLevel ctx scope svc+  TLExtend extName fields -> genExtensionBlock ctx scope extName fields+  TLOption _ -> []+  TLComment _ -> []+++genMessage :: GenCtx -> [Text] -> MessageDef -> [Doc ann]+genMessage ctx scope msg =+  let scope' = scope <> [msgName msg]+      tyN = scopedTypeName scope'+      nestedDefs = concatMap (genNestedElement ctx scope') (msgElements msg)+      hookCtx =+        MessageHookCtx+          { mhcMessageDef = msg+          , mhcScope = scope'+          , mhcHsTypeName = tyN+          , mhcFqProtoName = fqProtoName (gcPkg ctx) scope'+          , mhcOptions = messageOptions msg+          }+      hookOutput = onMessageCodeGen (genHooks (gcOpts ctx)) hookCtx+      hookDocs = fmap pretty hookOutput+  in [ mempty+     , genMessageDataDecl ctx scope' msg+     ]+       <> nestedDefs+       <> [ mempty+          , genDefaultInstance ctx scope' msg+          , mempty+          , genEncodeInstance ctx scope' msg+          , mempty+          , genSizeInstance ctx scope' msg+          , mempty+          , genDecodeInstance ctx scope' msg+          , mempty+          , genProtoMessageInstance ctx scope' msg+          , mempty+          , genIsMessageInstance scope'+          , mempty+          , genToJSONInstance ctx scope' msg+          , mempty+          , genFromJSONInstance ctx scope' msg+          , mempty+          , genHashableInstance ctx scope' msg+          , mempty+          , genHasExtensionsInstance scope' msg+          , mempty+          , genSemigroupInstance ctx scope' msg+          , mempty+          , genMonoidInstance scope'+          ]+       <> case hookDocs of+         [] -> []+         ds -> [mempty, vsep ds]+++genNestedElement :: GenCtx -> [Text] -> MessageElement -> [Doc ann]+genNestedElement ctx scope = \case+  MEMessage inner -> genMessage ctx scope inner+  MEEnum ed -> genEnum ctx scope ed+  MEOneof od -> [genOneofDecl ctx scope od, genOneofToJSONInstance ctx scope od, genOneofFromJSONInstance ctx scope od, genOneofHashableInstance ctx scope od]+  MEExtend extName fields -> genExtensionBlock ctx scope extName fields+  _ -> []+++-- ---------------------------------------------------------------------------+-- Data declarations+-- ---------------------------------------------------------------------------++genMessageDataDecl :: GenCtx -> [Text] -> MessageDef -> Doc ann+genMessageDataDecl ctx scope msg =+  let tyN = scopedTypeName scope+      userFields = concatMap (extractFieldDecl ctx scope) (msgElements msg)+      unknownFieldDecl = pretty (unknownFieldAccessor scope) <+> txt "::" <+> txt "![UnknownField]"+      allFields = userFields <> [unknownFieldDecl]+  in vsep $+       haddockDoc (msgDoc msg)+         <> [ txt "data " <> pretty tyN <> txt " = " <> pretty tyN+            , indent 2 (braceBlock allFields)+            , indent 2 (txt "deriving stock (Show, Eq, Generic)")+            , indent 2 (txt "deriving anyclass NFData")+            ]+++unknownFieldAccessor :: [Text] -> Text+unknownFieldAccessor scope =+  let prefix = case scope of+        [] -> ""+        [s] -> lowerFirst (hsTypeName s)+        _ -> lowerFirst (T.intercalate "" (fmap hsTypeName scope))+  in prefix <> "UnknownFields"+++extractFieldDecl :: GenCtx -> [Text] -> MessageElement -> [Doc ann]+extractFieldDecl ctx scope = \case+  MEField fd -> [genFieldDecl ctx scope fd]+  MEMapField mf -> [genMapFieldDecl ctx scope mf]+  MEOneof od -> [genOneofFieldRef ctx scope od]+  _ -> []+++genFieldDecl :: GenCtx -> [Text] -> FieldDef -> Doc ann+genFieldDecl ctx scope fd =+  let fieldLine =+        pretty (ctxFieldName ctx scope (fieldName fd))+          <+> txt "::"+          <+> hsFieldType ctx scope (fieldType fd) (fieldLabel fd)+  in case fieldDoc fd of+       Nothing -> fieldLine+       Just doc ->+         let ls = T.lines doc+         in case ls of+              [] -> fieldLine+              (first_ : rest) ->+                vsep $+                  [fieldLine]+                    <> [indent 2 (txt "-- ^ " <> pretty first_)]+                    <> fmap (\l -> indent 2 (txt "-- " <> pretty l)) rest+++genMapFieldDecl :: GenCtx -> [Text] -> MapField -> Doc ann+genMapFieldDecl ctx scope mf =+  let fieldLine =+        pretty (ctxFieldName ctx scope (mapFieldName mf))+          <+> txt "::"+          <+> txt "!(Map.Map "+          <> hsScalarType (mapKeyType mf)+          <+> hsFieldTypeInner ctx scope (mapValueType mf)+          <> txt ")"+  in case mapDoc mf of+       Nothing -> fieldLine+       Just doc ->+         let ls = T.lines doc+         in case ls of+              [] -> fieldLine+              (first_ : rest) ->+                vsep $+                  [fieldLine]+                    <> [indent 2 (txt "-- ^ " <> pretty first_)]+                    <> fmap (\l -> indent 2 (txt "-- " <> pretty l)) rest+++genOneofFieldRef :: GenCtx -> [Text] -> OneofDef -> Doc ann+genOneofFieldRef ctx scope od =+  pretty (ctxFieldName ctx scope (oneofName od))+    <+> txt "::"+    <+> txt "!(Maybe "+    <> pretty (scopedTypeName scope <> "'" <> snakeToPascal (oneofName od))+    <> txt ")"+++genOneofDecl :: GenCtx -> [Text] -> OneofDef -> Doc ann+genOneofDecl ctx scope od =+  let tyN = scopedTypeName scope <> "'" <> snakeToPascal (oneofName od)+  in vsep $+       haddockDoc (oneofDoc od)+         <> [ txt "data " <> pretty tyN+            , indent 2 (vsep (concatMap (\(pfx, f) -> (pfx <+> genOneofCon ctx scope f) : haddockFieldDoc (oneofFieldDoc f)) (zip seps (oneofFields od))))+            , indent 2 (txt "deriving stock (Show, Eq, Generic)")+            , indent 2 (txt "deriving anyclass NFData")+            ]+  where+    seps = txt "=" : repeat (txt "|")+    genOneofCon cx s f =+      pretty (oneofConName s (oneofName od) (oneofFieldName f))+        <+> hsOneofFieldType cx s (oneofFieldType f)+++genOneofToJSONInstance :: GenCtx -> [Text] -> OneofDef -> Doc ann+genOneofToJSONInstance _ctx scope od =+  let tyN = scopedTypeName scope <> "'" <> snakeToPascal (oneofName od)+  in vsep+       [ instanceHead "Aeson.ToJSON" tyN+       , indent 2 (txt "toJSON _ = Aeson.Null")+       ]+++genOneofFromJSONInstance :: GenCtx -> [Text] -> OneofDef -> Doc ann+genOneofFromJSONInstance _ctx scope od =+  let tyN = scopedTypeName scope <> "'" <> snakeToPascal (oneofName od)+  in vsep+       [ instanceHead "Aeson.FromJSON" tyN+       , indent 2 (pretty ("parseJSON _ = fail \"Cannot parse oneof from JSON\"" :: Text))+       ]+++-- ---------------------------------------------------------------------------+-- Default instances+-- ---------------------------------------------------------------------------++genDefaultInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann+genDefaultInstance ctx scope msg =+  let tyN = scopedTypeName scope+  in vsep+       [ txt "default" <> pretty tyN <+> txt "::" <+> pretty tyN+       , txt "default" <> pretty tyN <+> txt "=" <+> pretty tyN+       , indent 2 (genDefaultFields ctx scope (msgElements msg))+       ]+++genDefaultFields :: GenCtx -> [Text] -> [MessageElement] -> Doc ann+genDefaultFields ctx scope elems =+  let userFields = concatMap extractDefault elems+      unknownDefault = pretty (unknownFieldAccessor scope) <+> txt "=" <+> txt "[]"+      fields = userFields <> [unknownDefault]+  in braceBlock fields+  where+    extractDefault = \case+      MEField fd ->+        [pretty (ctxFieldName ctx scope (fieldName fd)) <+> txt "=" <+> defaultValue ctx (fieldLabel fd) (fieldType fd)]+      MEMapField mf ->+        [pretty (ctxFieldName ctx scope (mapFieldName mf)) <+> txt "=" <+> txt "Map.empty"]+      MEOneof od ->+        [pretty (ctxFieldName ctx scope (oneofName od)) <+> txt "=" <+> txt "Nothing"]+      _ -> []+++defaultValue :: GenCtx -> Maybe FieldLabel -> FieldType -> Doc ann+defaultValue ctx lbl ft = case lbl of+  Just Repeated -> case ft of+    FTScalar s | isUnboxableScalar s -> txt "VU.empty"+    _ -> txt "V.empty"+  Just Optional -> txt "Nothing"+  _ -> case ft of+    FTScalar SBool -> txt "False"+    FTScalar SString -> pretty ("\"\"" :: Text)+    FTScalar SBytes -> pretty ("\"\"" :: Text)+    FTScalar _ -> txt "0"+    FTNamed n ->+      case resolveType ctx n of+        Just ti | tiKind ti == TKEnum -> txt "(toEnum 0)"+        _ -> txt "Nothing"+++-- ---------------------------------------------------------------------------+-- Encode instances+-- ---------------------------------------------------------------------------++genEncodeInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann+genEncodeInstance ctx scope msg =+  let tyN = scopedTypeName scope+      fields = extractAllFields ctx scope (msgElements msg)+      unknownAcc = "msg." <> unknownFieldAccessor scope+  in vsep+       [ instanceHead "MessageEncode" tyN+       , indent 2 $+           vsep+             [ txt "buildMessage msg ="+             , indent 2 $ case fields of+                 [] -> txt "encodeUnknownFields " <> pretty unknownAcc+                 _ ->+                   vsep+                     ( zipWith (genFieldBuild ctx) [0 ..] fields+                         <> [txt "<> encodeUnknownFields " <> pretty unknownAcc]+                     )+             ]+       ]+++genFieldBuild :: GenCtx -> Int -> FieldInfoFull -> Doc ann+genFieldBuild ctx idx fi =+  let op = if idx == 0 then mempty else txt "<> "+      accessor = "msg." <> fifAccessor fi+      fn = T.pack (show (fifFieldNum fi))+  in op <> case fifKind fi of+       FKScalar lbl ft -> genBuildExprScalar fn accessor lbl ft+       FKNamed lbl name tk -> genBuildExprNamed ctx fn accessor lbl name tk+       FKMap keyT valT -> genBuildExprMap ctx fn accessor keyT valT+       FKOneof scope ood -> genBuildExprOneof ctx scope fn accessor ood+++genBuildExprScalar :: Text -> Text -> Maybe FieldLabel -> ScalarType -> Doc ann+genBuildExprScalar fn accessor lbl st = case lbl of+  Just Repeated -> genRepeatedScalarBuild fn accessor st+  Just Optional -> txt "(maybe mempty (\\v -> " <> genSingleScalarBuild fn "v" st <> txt ") " <> pretty accessor <> txt ")"+  _ -> txt "(if " <> scalarDefaultCheck accessor st <> txt " then mempty else " <> genSingleScalarBuild fn accessor st <> txt ")"+++genBuildExprNamed :: GenCtx -> Text -> Text -> Maybe FieldLabel -> Text -> TypeKind -> Doc ann+genBuildExprNamed _ctx fn accessor lbl _name tk = case tk of+  TKEnum -> case lbl of+    Just Repeated -> txt "V.foldl' (\\acc v -> acc <> archVarint " <> tagLit fn wireVarint <+> txt "(fromIntegral (fromEnum v))) mempty " <> pretty accessor+    Just Optional -> txt "(maybe mempty (\\v -> archVarint " <> tagLit fn wireVarint <+> txt "(fromIntegral (fromEnum v))) " <> pretty accessor <> txt ")"+    _ -> txt "(if fromEnum " <> pretty accessor <> txt " == 0 then mempty else archVarint " <> tagLit fn wireVarint <+> txt "(fromIntegral (fromEnum " <> pretty accessor <> txt ")))"+  TKMessage -> case lbl of+    Just Repeated -> txt "V.foldl' (\\acc v -> let sz = messageSize v in acc <> archSubmessage " <> tagLit fn wireLengthDelimited <+> txt "sz (buildMessage v)) mempty " <> pretty accessor+    Just Optional -> txt "(maybe mempty (\\v -> let sz = messageSize v in archSubmessage " <> tagLit fn wireLengthDelimited <+> txt "sz (buildMessage v)) " <> pretty accessor <> txt ")"+    _ -> txt "(maybe mempty (\\v -> let sz = messageSize v in archSubmessage " <> tagLit fn wireLengthDelimited <+> txt "sz (buildMessage v)) " <> pretty accessor <> txt ")"+++genBuildExprMap :: GenCtx -> Text -> Text -> ScalarType -> FieldType -> Doc ann+genBuildExprMap ctx fn accessor keyT valT =+  txt "Map.foldlWithKey' (\\acc k v -> acc <> encodeMapField "+    <> pretty fn+    <> txt " ("+    <> genMapKeyEncode keyT+    <> txt " k) ("+    <> genMapValEncode ctx valT+    <> txt " v)) mempty "+    <> pretty accessor+++genMapKeyEncode :: ScalarType -> Doc ann+genMapKeyEncode st = case st of+  SString -> txt "encodeFieldString 1"+  SBool -> txt "encodeFieldBool 1"+  SInt32 -> txt "(\\x -> encodeFieldVarint 1 (fromIntegral x))"+  SInt64 -> txt "(\\x -> encodeFieldVarint 1 (fromIntegral x))"+  SUInt32 -> txt "(\\x -> encodeFieldVarint 1 (fromIntegral x))"+  SUInt64 -> txt "encodeFieldVarint 1"+  SSInt32 -> txt "encodeFieldSVarint32 1"+  SSInt64 -> txt "encodeFieldSVarint64 1"+  SFixed32 -> txt "encodeFieldFixed32 1"+  SFixed64 -> txt "encodeFieldFixed64 1"+  SSFixed32 -> txt "(\\x -> encodeFieldFixed32 1 (fromIntegral x))"+  SSFixed64 -> txt "(\\x -> encodeFieldFixed64 1 (fromIntegral x))"+  _ -> txt "encodeFieldBytes 1"+++genMapValEncode :: GenCtx -> FieldType -> Doc ann+genMapValEncode ctx = \case+  FTScalar st -> genMapKeyEncode' 2 st+  FTNamed n -> case resolveType ctx n of+    Just ti | tiKind ti == TKEnum -> txt "(\\x -> encodeFieldVarint 2 (fromIntegral (fromEnum x)))"+    _ -> txt "encodeFieldMessage 2"+  where+    genMapKeyEncode' :: Int -> ScalarType -> Doc ann+    genMapKeyEncode' fn st = case st of+      SString -> txt "encodeFieldString " <> pretty (T.pack (show fn))+      SBytes -> txt "encodeFieldBytes " <> pretty (T.pack (show fn))+      SBool -> txt "encodeFieldBool " <> pretty (T.pack (show fn))+      SDouble -> txt "encodeFieldDouble " <> pretty (T.pack (show fn))+      SFloat -> txt "encodeFieldFloat " <> pretty (T.pack (show fn))+      SFixed32 -> txt "encodeFieldFixed32 " <> pretty (T.pack (show fn))+      SFixed64 -> txt "encodeFieldFixed64 " <> pretty (T.pack (show fn))+      SSFixed32 -> txt "encodeFieldFixed32 " <> pretty (T.pack (show fn)) <> txt " . fromIntegral"+      SSFixed64 -> txt "encodeFieldFixed64 " <> pretty (T.pack (show fn)) <> txt " . fromIntegral"+      _ -> txt "encodeFieldVarint " <> pretty (T.pack (show fn)) <> txt " . fromIntegral"+++genBuildExprOneof :: GenCtx -> [Text] -> Text -> Text -> OneofDef -> Doc ann+genBuildExprOneof ctx scope _fn accessor ood =+  txt "(case "+    <> pretty accessor+    <> txt " of"+    <> line+    <> indent+      2+      ( vsep+          ( txt "Nothing -> mempty"+              : fmap (genOneofArmEncode ctx scope (oneofName ood)) (oneofFields ood)+          )+      )+    <> txt ")"+++genOneofArmEncode :: GenCtx -> [Text] -> Text -> OneofField -> Doc ann+genOneofArmEncode ctx scope ooName f =+  let conName = oneofConName scope ooName (oneofFieldName f)+      fn = T.pack (show (unFieldNumber (oneofFieldNumber f)))+  in txt "Just ("+       <> pretty conName+       <+> txt "v) -> "+       <> case oneofFieldType f of+         FTScalar st -> genSingleScalarBuild fn "v" st+         FTNamed n -> case resolveType ctx n of+           Just ti+             | tiKind ti == TKEnum ->+                 txt "archVarint " <> tagLit fn wireVarint <+> txt "(fromIntegral (fromEnum v))"+           _ -> txt "(let sz = messageSize v in archSubmessage " <> tagLit fn wireLengthDelimited <+> txt "sz (buildMessage v))"+++genSingleScalarBuild :: Text -> Text -> ScalarType -> Doc ann+genSingleScalarBuild fn accessor = \case+  SDouble -> txt "archDouble " <> tagLit fn wire64Bit <+> pretty accessor+  SFloat -> txt "archFloat " <> tagLit fn wire32Bit <+> pretty accessor+  SInt32 -> txt "archVarint " <> tagLit fn wireVarint <+> txt "(fromIntegral " <> pretty accessor <> txt ")"+  SInt64 -> txt "archVarint " <> tagLit fn wireVarint <+> txt "(fromIntegral " <> pretty accessor <> txt ")"+  SUInt32 -> txt "archVarint " <> tagLit fn wireVarint <+> txt "(fromIntegral " <> pretty accessor <> txt ")"+  SUInt64 -> txt "archVarint " <> tagLit fn wireVarint <+> pretty accessor+  SSInt32 -> txt "archSVarint32 " <> tagLit fn wireVarint <+> pretty accessor+  SSInt64 -> txt "archSVarint64 " <> tagLit fn wireVarint <+> pretty accessor+  SFixed32 -> txt "archFixed32 " <> tagLit fn wire32Bit <+> pretty accessor+  SFixed64 -> txt "archFixed64 " <> tagLit fn wire64Bit <+> pretty accessor+  SSFixed32 -> txt "archFixed32 " <> tagLit fn wire32Bit <+> txt "(fromIntegral " <> pretty accessor <> txt ")"+  SSFixed64 -> txt "archFixed64 " <> tagLit fn wire64Bit <+> txt "(fromIntegral " <> pretty accessor <> txt ")"+  SBool -> txt "archBool " <> tagLit fn wireVarint <+> pretty accessor+  SString -> txt "archString " <> tagLit fn wireLengthDelimited <+> pretty accessor+  SBytes -> txt "archBytes " <> tagLit fn wireLengthDelimited <+> pretty accessor+++genRepeatedScalarBuild :: Text -> Text -> ScalarType -> Doc ann+genRepeatedScalarBuild fn accessor = \case+  SString ->+    txt "V.foldl' (\\acc v -> acc <> archString " <> tagLit fn wireLengthDelimited <+> txt "v) mempty " <> pretty accessor+  SBytes ->+    txt "V.foldl' (\\acc v -> acc <> archBytes " <> tagLit fn wireLengthDelimited <+> txt "v) mempty " <> pretty accessor+  s -> txt "encode" <> pretty (packedFnName s) <+> pretty fn <+> pretty accessor+++scalarDefaultCheck :: Text -> ScalarType -> Doc ann+scalarDefaultCheck accessor = \case+  SBool -> pretty accessor <+> txt "== False"+  SString -> pretty accessor <+> txt "== T.empty"+  SBytes -> txt "BS.null " <> pretty accessor+  _ -> pretty accessor <+> txt "== 0"+++packedFnName :: ScalarType -> Text+packedFnName = \case+  SDouble -> "PackedDouble"+  SFloat -> "PackedFloat"+  SInt32 -> "PackedInt32"+  SInt64 -> "PackedInt64"+  SUInt32 -> "PackedWord32"+  SUInt64 -> "PackedWord64"+  SSInt32 -> "PackedSVarint32"+  SSInt64 -> "PackedSVarint64"+  SFixed32 -> "PackedFixed32"+  SFixed64 -> "PackedFixed64"+  SSFixed32 -> "PackedFixed32"+  SSFixed64 -> "PackedFixed64"+  SBool -> "PackedBool"+  s -> error ("Cannot pack: " <> show s)+++-- ---------------------------------------------------------------------------+-- Size instances+-- ---------------------------------------------------------------------------++genSizeInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann+genSizeInstance ctx scope msg =+  let tyN = scopedTypeName scope+      fields = extractAllFields ctx scope (msgElements msg)+      unknownAcc = "msg." <> unknownFieldAccessor scope+  in vsep+       [ instanceHead "MessageSize" tyN+       , indent 2 $+           vsep+             [ txt "messageSize msg ="+             , indent 2 $ case fields of+                 [] -> txt "unknownFieldsSize " <> pretty unknownAcc+                 _ ->+                   vsep+                     ( zipWith (genFieldSizeExpr ctx) [0 ..] fields+                         <> [txt "+ unknownFieldsSize " <> pretty unknownAcc]+                     )+             ]+       ]+++genFieldSizeExpr :: GenCtx -> Int -> FieldInfoFull -> Doc ann+genFieldSizeExpr ctx idx fi =+  let op = if idx == 0 then mempty else txt "+ "+      accessor = "msg." <> fifAccessor fi+      fn = T.pack (show (fifFieldNum fi))+  in op <> case fifKind fi of+       FKScalar lbl ft -> genSizeScalar fn accessor lbl ft+       FKNamed lbl name tk -> genSizeNamed ctx fn accessor lbl name tk+       FKMap keyT valT -> genSizeMap ctx fn accessor keyT valT+       FKOneof scope ood -> genSizeOneof ctx scope fn accessor ood+++genSizeScalar :: Text -> Text -> Maybe FieldLabel -> ScalarType -> Doc ann+genSizeScalar fn accessor lbl st = case lbl of+  Just Repeated -> genRepeatedSizeScalar fn accessor st+  Just Optional -> txt "(maybe 0 (\\v -> " <> genSingleSizeScalar fn "v" st <> txt ") " <> pretty accessor <> txt ")"+  _ -> txt "(if " <> scalarDefaultCheck accessor st <> txt " then 0 else " <> genSingleSizeScalar fn accessor st <> txt ")"+++genRepeatedSizeScalar :: Text -> Text -> ScalarType -> Doc ann+genRepeatedSizeScalar fn accessor = \case+  SString ->+    txt "(V.foldl' (\\acc v -> acc + fieldTextSize " <> pretty fn <+> txt "v) 0 " <> pretty accessor <> txt ")"+  SBytes ->+    txt "(V.foldl' (\\acc v -> acc + fieldBytesSize " <> pretty fn <+> txt "v) 0 " <> pretty accessor <> txt ")"+  SDouble ->+    txt "(let n = VU.length " <> pretty accessor <> txt " in if n == 0 then 0 else tagSize " <> pretty fn <> txt " + varintSize (fromIntegral (n * 8)) + n * 8)"+  SFloat ->+    txt "(let n = VU.length " <> pretty accessor <> txt " in if n == 0 then 0 else tagSize " <> pretty fn <> txt " + varintSize (fromIntegral (n * 4)) + n * 4)"+  SFixed32 ->+    txt "(let n = VU.length " <> pretty accessor <> txt " in if n == 0 then 0 else tagSize " <> pretty fn <> txt " + varintSize (fromIntegral (n * 4)) + n * 4)"+  SFixed64 ->+    txt "(let n = VU.length " <> pretty accessor <> txt " in if n == 0 then 0 else tagSize " <> pretty fn <> txt " + varintSize (fromIntegral (n * 8)) + n * 8)"+  SSFixed32 ->+    txt "(let n = VU.length " <> pretty accessor <> txt " in if n == 0 then 0 else tagSize " <> pretty fn <> txt " + varintSize (fromIntegral (n * 4)) + n * 4)"+  SSFixed64 ->+    txt "(let n = VU.length " <> pretty accessor <> txt " in if n == 0 then 0 else tagSize " <> pretty fn <> txt " + varintSize (fromIntegral (n * 8)) + n * 8)"+  SBool ->+    txt "(let n = VU.length " <> pretty accessor <> txt " in if n == 0 then 0 else tagSize " <> pretty fn <> txt " + varintSize (fromIntegral n) + n)"+  SUInt64 ->+    txt "(let pl = VU.foldl' (\\a v -> a + varintSize v) 0 " <> pretty accessor <> txt " in if pl == 0 then 0 else tagSize " <> pretty fn <> txt " + varintSize (fromIntegral pl) + pl)"+  SUInt32 ->+    txt "(let pl = VU.foldl' (\\a v -> a + varintSize32 v) 0 " <> pretty accessor <> txt " in if pl == 0 then 0 else tagSize " <> pretty fn <> txt " + varintSize (fromIntegral pl) + pl)"+  SInt32 ->+    txt "(let pl = VU.foldl' (\\a v -> a + varintSize (fromIntegral v)) 0 " <> pretty accessor <> txt " in if pl == 0 then 0 else tagSize " <> pretty fn <> txt " + varintSize (fromIntegral pl) + pl)"+  SInt64 ->+    txt "(let pl = VU.foldl' (\\a v -> a + varintSize (fromIntegral v)) 0 " <> pretty accessor <> txt " in if pl == 0 then 0 else tagSize " <> pretty fn <> txt " + varintSize (fromIntegral pl) + pl)"+  SSInt32 ->+    txt "(let pl = VU.foldl' (\\a v -> a + varintSize (fromIntegral (zigZag32 v))) 0 " <> pretty accessor <> txt " in if pl == 0 then 0 else tagSize " <> pretty fn <> txt " + varintSize (fromIntegral pl) + pl)"+  SSInt64 ->+    txt "(let pl = VU.foldl' (\\a v -> a + varintSize (zigZag64 v)) 0 " <> pretty accessor <> txt " in if pl == 0 then 0 else tagSize " <> pretty fn <> txt " + varintSize (fromIntegral pl) + pl)"+++genSingleSizeScalar :: Text -> Text -> ScalarType -> Doc ann+genSingleSizeScalar _fn accessor = \case+  SDouble -> txt "archFixed64Size"+  SFloat -> txt "archFixed32Size"+  SFixed32 -> txt "archFixed32Size"+  SFixed64 -> txt "archFixed64Size"+  SSFixed32 -> txt "archFixed32Size"+  SSFixed64 -> txt "archFixed64Size"+  SBool -> txt "archBoolSize"+  SInt32 -> txt "archVarintSize (fromIntegral " <> pretty accessor <> txt ")"+  SInt64 -> txt "archVarintSize (fromIntegral " <> pretty accessor <> txt ")"+  SUInt32 -> txt "archVarintSize (fromIntegral " <> pretty accessor <> txt ")"+  SUInt64 -> txt "archVarintSize " <> pretty accessor+  SSInt32 -> txt "(1 + varintSize (fromIntegral (zigZag32 " <> pretty accessor <> txt ")))"+  SSInt64 -> txt "(1 + varintSize (zigZag64 " <> pretty accessor <> txt "))"+  SString -> txt "archStringSize " <> pretty accessor+  SBytes -> txt "archBytesSize " <> pretty accessor+++genSizeNamed :: GenCtx -> Text -> Text -> Maybe FieldLabel -> Text -> TypeKind -> Doc ann+genSizeNamed _ctx _fn accessor lbl _name tk = case tk of+  TKEnum -> case lbl of+    Just Repeated -> txt "(V.foldl' (\\acc v -> acc + archVarintSize (fromIntegral (fromEnum v))) 0 " <> pretty accessor <> txt ")"+    Just Optional -> txt "(maybe 0 (\\v -> archVarintSize (fromIntegral (fromEnum v))) " <> pretty accessor <> txt ")"+    _ -> txt "(if fromEnum " <> pretty accessor <> txt " == 0 then 0 else archVarintSize (fromIntegral (fromEnum " <> pretty accessor <> txt ")))"+  TKMessage -> case lbl of+    Just Repeated -> txt "(V.foldl' (\\acc v -> acc + archSubmessageSize (messageSize v)) 0 " <> pretty accessor <> txt ")"+    Just Optional -> txt "(maybe 0 (\\v -> archSubmessageSize (messageSize v)) " <> pretty accessor <> txt ")"+    _ -> txt "(maybe 0 (\\v -> archSubmessageSize (messageSize v)) " <> pretty accessor <> txt ")"+++genSizeMap :: GenCtx -> Text -> Text -> ScalarType -> FieldType -> Doc ann+genSizeMap ctx fn accessor keyT valT =+  let keySizeExpr = mapKeySizeExpr keyT+      valSizeExpr = mapValSizeExpr ctx valT+  in txt "(Map.foldlWithKey' (\\acc k v -> let entrySz = "+       <> keySizeExpr+       <> txt " + "+       <> valSizeExpr+       <> txt " in acc + tagSize "+       <> pretty fn+       <> txt " + varintSize (fromIntegral entrySz) + entrySz) 0 "+       <> pretty accessor+       <> txt ")"+++mapKeySizeExpr :: ScalarType -> Doc ann+mapKeySizeExpr = \case+  SString -> txt "fieldTextSize 1 k"+  SBool -> txt "fieldBoolSize 1"+  SInt32 -> txt "fieldVarintSize 1 (fromIntegral k)"+  SInt64 -> txt "fieldVarintSize 1 (fromIntegral k)"+  SUInt32 -> txt "fieldVarintSize 1 (fromIntegral k)"+  SUInt64 -> txt "fieldVarintSize 1 k"+  SSInt32 -> txt "fieldSVarint32Size 1 k"+  SSInt64 -> txt "fieldSVarint64Size 1 k"+  SFixed32 -> txt "fieldFixed32Size 1"+  SFixed64 -> txt "fieldFixed64Size 1"+  SSFixed32 -> txt "fieldFixed32Size 1"+  SSFixed64 -> txt "fieldFixed64Size 1"+  _ -> txt "fieldBytesSize 1 k"+++mapValSizeExpr :: GenCtx -> FieldType -> Doc ann+mapValSizeExpr ctx = \case+  FTScalar SString -> txt "fieldTextSize 2 v"+  FTScalar SBytes -> txt "fieldBytesSize 2 v"+  FTScalar SBool -> txt "fieldBoolSize 2"+  FTScalar SDouble -> txt "fieldDoubleSize 2"+  FTScalar SFloat -> txt "fieldFloatSize 2"+  FTScalar SFixed32 -> txt "fieldFixed32Size 2"+  FTScalar SFixed64 -> txt "fieldFixed64Size 2"+  FTScalar SSFixed32 -> txt "fieldFixed32Size 2"+  FTScalar SSFixed64 -> txt "fieldFixed64Size 2"+  FTScalar _s -> txt "fieldVarintSize 2 (fromIntegral v)"+  FTNamed n -> case resolveType ctx n of+    Just ti | tiKind ti == TKEnum -> txt "fieldVarintSize 2 (fromIntegral (fromEnum v))"+    _ -> txt "fieldMessageSize 2 (messageSize v)"+++genSizeOneof :: GenCtx -> [Text] -> Text -> Text -> OneofDef -> Doc ann+genSizeOneof ctx scope _fn accessor ood =+  txt "(case "+    <> pretty accessor+    <> txt " of { Nothing -> 0"+    <> vsep+      ( fmap+          ( \f ->+              let conName = oneofConName scope (oneofName ood) (oneofFieldName f)+                  ffn = T.pack (show (unFieldNumber (oneofFieldNumber f)))+              in txt "; Just ("+                   <> pretty conName+                   <+> txt "v) -> "+                   <> case oneofFieldType f of+                     FTScalar st -> genSingleSizeScalar ffn "v" st+                     FTNamed n -> case resolveType ctx n of+                       Just ti | tiKind ti == TKEnum -> txt "archVarintSize (fromIntegral (fromEnum v))"+                       _ -> txt "archSubmessageSize (messageSize v)"+          )+          (oneofFields ood)+      )+    <> txt " })"+++-- ---------------------------------------------------------------------------+-- Decode instances+-- ---------------------------------------------------------------------------++genDecodeInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann+genDecodeInstance ctx scope msg =+  let tyN = scopedTypeName scope+      fields = extractAllFields ctx scope (msgElements msg)+      allAccs = fmap (\(i, _) -> "acc_" <> T.pack (show i)) (zip ([0 ..] :: [Int]) fields)+      unknownAcc = "acc_unknown_"+      allAccsWithUnknown = allAccs <> [unknownAcc]+      unknownFieldName = unknownFieldAccessor scope+  in vsep+       [ instanceHead "MessageDecode" tyN+       , indent 2 $+           vsep+             [ txt "{-# INLINE messageDecoder #-}"+             , txt "messageDecoder = "+                 <> txt "loop"+                 <+> hsep (fmap (pretty . fieldDefaultText ctx) fields)+                 <+> txt "[]"+             , indent 2 $ txt "where"+             , indent 4 $+                 vsep+                   [ txt "loop " <> hsep (fmap pretty allAccsWithUnknown) <+> txt "= withTagM"+                   , -- withTagM (Proto.Internal.Wire.Decode) is the CPS form of+                     -- 'getTagOrU': the EOI continuation produces the+                     -- final message, the tag continuation takes the+                     -- field number and wire type as raw 'Int' values+                     -- (no 'Tag' record allocation, no 'UMaybe' wrapper).+                     -- This avoids one boxing step per field on every+                     -- generated decoder. The previous shape+                     -- (@mTag <- getTagOrU; case mTag of ...@) is still+                     -- correct but pays for an unboxed-sum case-split+                     -- per field that this form fuses through the+                     -- continuation.+                     indent 2 $+                       vsep+                         [ txt "(pure ("+                             <> pretty tyN+                             <+> braces+                               ( hsep+                                   ( punctuate+                                       comma+                                       ( fmap+                                           ( \fi ->+                                               pretty (fifAccessor fi) <+> txt "=" <+> txt "acc_" <> pretty (T.pack (show (fifIndex fi)))+                                           )+                                           fields+                                           <> [pretty unknownFieldName <+> txt "= reverse " <> pretty unknownAcc]+                                       )+                                   )+                               )+                             <> txt "))"+                         , txt "(\\fn wt -> case fn of"+                         , indent 2 $ vsep (concatMap (genFieldDecodeCase ctx allAccsWithUnknown) fields <> [genDefaultDecodeCase scope allAccsWithUnknown]) <> txt ")"+                         ]+                   ]+             ]+       ]+++genFieldDecodeCase :: GenCtx -> [Text] -> FieldInfoFull -> [Doc ann]+genFieldDecodeCase ctx allAccs fi =+  case fifKind fi of+    FKScalar lbl ft -> [genScalarDecodeCase allAccs fi lbl ft]+    FKNamed lbl name tk -> [genNamedDecodeCase ctx allAccs fi lbl name tk]+    FKMap keyT valT -> [genMapDecodeCase ctx allAccs fi keyT valT]+    FKOneof scope ood -> concatMap (genOneofDecodeCase ctx scope (oneofName ood) allAccs fi) (oneofFields ood)+++genScalarDecodeCase :: [Text] -> FieldInfoFull -> Maybe FieldLabel -> ScalarType -> Doc ann+genScalarDecodeCase allAccs fi lbl st =+  let fn = T.pack (show (fifFieldNum fi))+      idx = fifIndex fi+      accName = "acc_" <> T.pack (show idx)+      singletonFn = if isUnboxableScalar st then "VU.singleton" else "V.singleton"+  in case lbl of+       Just Repeated ->+         -- proto3 says a 'repeated <packable scalar>' field can appear+         -- on the wire either as a sequence of unpacked entries (one+         -- tag per value, wire-type 0/1/5 depending on the scalar)+         -- or as a single packed length-delimited blob (wire-type+         -- 2). Readers must accept both. Branching on 'wt' covers+         -- both shapes -- but only for packable scalars. Strings+         -- and bytes are NEVER packable (each element is+         -- self-delimiting on the wire), so their tag already+         -- carries wire-type 2 for every element; treating wire-type+         -- 2 as "packed mode" there would mis-decode every repeated+         -- string field (and previously did, until 'isPackable'+         -- below started gating the dispatch).+         let appendOne =+               replaceAt idx ("(" <> accName <> " <> " <> singletonFn <> " v)") allAccs+             appendMany =+               replaceAt idx ("(" <> accName <> " <> vs)") allAccs+             packedDecoderE = scalarPackedDecoderExpr st+             unpackedDecoderE = scalarDecoderExpr st+             isPackable = case st of+               SString -> False+               SBytes -> False+               _ -> True+         in if isPackable+              then+                pretty fn+                  <+> txt "-> case wt of"+                  <> line+                  <> indent+                    2+                    ( vsep+                        -- 'wt' is an 'Int' under 'withTagM'; literal 2 is+                        -- 'WireLengthDelimited' per the proto wire-format+                        -- spec (the wire-type encoding @len = 2@).+                        [ txt "2 -> do"+                        , indent+                            2+                            ( vsep+                                [ txt "vs <- " <> pretty packedDecoderE+                                , txt "loop " <> hsep (fmap pretty appendMany)+                                ]+                            )+                        , txt "_ -> do"+                        , indent+                            2+                            ( vsep+                                [ txt "v <- " <> pretty unpackedDecoderE+                                , txt "loop " <> hsep (fmap pretty appendOne)+                                ]+                            )+                        ]+                    )+              else+                pretty fn+                  <+> txt "-> do"+                  <> line+                  <> indent+                    2+                    ( vsep+                        [ txt "v <- " <> pretty unpackedDecoderE+                        , txt "loop " <> hsep (fmap pretty appendOne)+                        ]+                    )+       Just Optional ->+         -- proto3 'optional <scalar>' fields synthesise a oneof-style+         -- presence bit; the field's record slot is 'Maybe T' (see+         -- 'fieldDefaultText'), so the decoded value has to be+         -- wrapped with 'Just' here.+         let newAccs = replaceAt idx "(Just v)" allAccs+         in pretty fn+              <+> txt "-> do"+              <> line+              <> indent+                2+                ( vsep+                    [ txt "v <- " <> pretty (scalarDecoderExpr st)+                    , txt "loop " <> hsep (fmap pretty newAccs)+                    ]+                )+       _ ->+         let newAccs = replaceAt idx "v" allAccs+         in pretty fn+              <+> txt "-> do"+              <> line+              <> indent+                2+                ( vsep+                    [ txt "v <- " <> pretty (scalarDecoderExpr st)+                    , txt "loop " <> hsep (fmap pretty newAccs)+                    ]+                )+++{- | Decoder expression for a 'repeated <scalar>' encoded as a+single packed length-delimited blob.+-}+scalarPackedDecoderExpr :: ScalarType -> Text+scalarPackedDecoderExpr = \case+  SDouble -> "decodePackedDouble"+  SFloat -> "decodePackedFloat"+  SInt32 -> "(VU.map fromIntegral <$> decodePackedVarint)"+  SInt64 -> "(VU.map fromIntegral <$> decodePackedVarint)"+  SUInt32 -> "(VU.map fromIntegral <$> decodePackedVarint)"+  SUInt64 -> "decodePackedVarint"+  SSInt32 -> "decodePackedSVarint32"+  SSInt64 -> "decodePackedSVarint64"+  SFixed32 -> "decodePackedFixed32"+  SFixed64 -> "decodePackedFixed64"+  SSFixed32 -> "(VU.map fromIntegral <$> decodePackedFixed32)"+  SSFixed64 -> "(VU.map fromIntegral <$> decodePackedFixed64)"+  SBool -> "(VU.map (/= 0) <$> decodePackedVarint)"+  -- 'repeated string' / 'repeated bytes' aren't packable per the+  -- proto spec; they always come as one-tag-per-entry. Calling this+  -- helper for them is a codegen bug; emit a runtime fail to surface+  -- it loudly rather than silently mis-decoding.+  SString -> "(decodeFail (CustomError \"repeated string is never packed\"))"+  SBytes -> "(decodeFail (CustomError \"repeated bytes is never packed\"))"+++genNamedDecodeCase :: GenCtx -> [Text] -> FieldInfoFull -> Maybe FieldLabel -> Text -> TypeKind -> Doc ann+genNamedDecodeCase _ctx allAccs fi lbl _name tk =+  let fn = T.pack (show (fifFieldNum fi))+      idx = fifIndex fi+      accName = "acc_" <> T.pack (show idx)+      newAccs = case lbl of+        Just Repeated -> replaceAt idx ("(" <> accName <> " <> V.singleton v)") allAccs+        Just Optional -> replaceAt idx "(Just v)" allAccs+        _ -> case tk of+          TKEnum -> replaceAt idx "v" allAccs+          TKMessage -> replaceAt idx "(Just v)" allAccs+      decoderExpr :: Text+      decoderExpr = case tk of+        TKEnum -> "decodeFieldEnum"+        TKMessage -> "decodeFieldMessage"+  in pretty fn+       <+> txt "-> do"+       <> line+       <> indent+         2+         ( vsep+             [ txt "v <- " <> pretty decoderExpr+             , txt "loop " <> hsep (fmap pretty newAccs)+             ]+         )+++genMapDecodeCase :: GenCtx -> [Text] -> FieldInfoFull -> ScalarType -> FieldType -> Doc ann+genMapDecodeCase ctx allAccs fi keyT valT =+  let fn = T.pack (show (fifFieldNum fi))+      idx = fifIndex fi+      accName = "acc_" <> T.pack (show idx)+      newAccs = replaceAt idx ("(Map.union " <> accName <> " (Map.singleton mk' mv'))") allAccs+      keyDecoder = scalarDecoderExpr keyT+      valDecoder = mapValDecoderExpr ctx valT+      keyDefault = scalarDefaultLit keyT+      valDefault = mapValDefaultLit ctx valT+  in pretty fn+       <+> txt "-> do"+       <> line+       <> indent+         2+         ( vsep+             [ txt "bs' <- getLengthDelimited"+             , txt "let decodeEntry = runDecoder (decodeMapEntry"+                 <+> pretty keyDecoder+                 <+> pretty valDecoder+                 <+> pretty keyDefault+                 <+> pretty valDefault+                 <> txt ") bs'"+             , txt "case decodeEntry of"+             , indent 2 $+                 vsep+                   [ txt "Left _ -> loop " <> hsep (fmap pretty allAccs)+                   , txt "Right (mk', mv') -> loop " <> hsep (fmap pretty newAccs)+                   ]+             ]+         )+++genOneofDecodeCase :: GenCtx -> [Text] -> Text -> [Text] -> FieldInfoFull -> OneofField -> [Doc ann]+genOneofDecodeCase ctx scope ooName allAccs fi oof =+  let fn = T.pack (show (unFieldNumber (oneofFieldNumber oof)))+      idx = fifIndex fi+      conName = oneofConName scope ooName (oneofFieldName oof)+      newAccs = replaceAt idx ("(Just (" <> conName <> " v))") allAccs+      decoderExpr = case oneofFieldType oof of+        FTScalar st -> scalarDecoderExpr st+        FTNamed n -> case resolveType ctx n of+          Just ti | tiKind ti == TKEnum -> "decodeFieldEnum"+          _ -> "decodeFieldMessage"+  in [ pretty fn+         <+> txt "-> do"+         <> line+         <> indent+           2+           ( vsep+               [ txt "v <- " <> pretty decoderExpr+               , txt "loop " <> hsep (fmap pretty newAccs)+               ]+           )+     ]+++genDefaultDecodeCase :: [Text] -> [Text] -> Doc ann+genDefaultDecodeCase _scope allAccsWithUnknown =+  let unknownAcc = last allAccsWithUnknown+      fieldAccs = init allAccsWithUnknown+      newAccs = fieldAccs <> ["(uf : " <> unknownAcc <> ")"]+  in txt "_ -> do"+       <> line+       <> indent+         2+         ( vsep+             -- 'wt' comes through as an 'Int' (withTagM's continuation+             -- takes raw Ints), so 'toEnum' it back into a 'WireType'+             -- before handing it to 'captureUnknownField'.+             [ txt "uf <- captureUnknownField fn (toEnum wt)"+             , txt "loop " <> hsep (fmap pretty newAccs)+             ]+         )+++fieldDefaultText :: GenCtx -> FieldInfoFull -> Text+fieldDefaultText _ctx fi = case fifKind fi of+  FKScalar lbl ft -> case lbl of+    Just Repeated | isUnboxableScalar ft -> "VU.empty"+    Just Repeated -> "V.empty"+    Just Optional -> "Nothing"+    _ -> scalarDefaultText ft+  FKNamed lbl _ tk -> case lbl of+    Just Repeated -> "V.empty"+    Just Optional -> "Nothing"+    _ -> case tk of+      TKEnum -> "(toEnum 0)"+      TKMessage -> "Nothing"+  FKMap _ _ -> "Map.empty"+  FKOneof _ _ -> "Nothing"+++scalarDefaultText :: ScalarType -> Text+scalarDefaultText = \case+  SBool -> "False"+  SString -> "\"\""+  SBytes -> "\"\""+  _ -> "0"+++scalarDecoderExpr :: ScalarType -> Text+scalarDecoderExpr = \case+  SDouble -> "decodeFieldDouble"+  SFloat -> "decodeFieldFloat"+  SInt32 -> "(fromIntegral <$> decodeFieldVarint)"+  SInt64 -> "(fromIntegral <$> decodeFieldVarint)"+  SUInt32 -> "(fromIntegral <$> decodeFieldVarint)"+  SUInt64 -> "decodeFieldVarint"+  SSInt32 -> "decodeFieldSVarint32"+  SSInt64 -> "decodeFieldSVarint64"+  SFixed32 -> "decodeFieldFixed32"+  SFixed64 -> "decodeFieldFixed64"+  SSFixed32 -> "(fromIntegral <$> decodeFieldFixed32)"+  SSFixed64 -> "(fromIntegral <$> decodeFieldFixed64)"+  SBool -> "decodeFieldBool"+  SString -> "decodeFieldString"+  SBytes -> "decodeFieldBytes"+++mapValDecoderExpr :: GenCtx -> FieldType -> Text+mapValDecoderExpr ctx = \case+  FTScalar st -> scalarDecoderExpr st+  FTNamed n -> case resolveType ctx n of+    Just ti | tiKind ti == TKEnum -> "decodeFieldEnum"+    _ -> "decodeFieldMessage"+++scalarDefaultLit :: ScalarType -> Text+scalarDefaultLit = \case+  SBool -> "False"+  SString -> "\"\""+  SBytes -> "\"\""+  _ -> "0"+++mapValDefaultLit :: GenCtx -> FieldType -> Text+mapValDefaultLit ctx = \case+  FTScalar st -> scalarDefaultLit st+  FTNamed n -> case resolveType ctx n of+    Just ti | tiKind ti == TKEnum -> "(toEnum 0)"+    _ -> "undefined"+++-- ---------------------------------------------------------------------------+-- JSON instances+-- ---------------------------------------------------------------------------++{- | Generate an empty @instance IsMessage Foo@. 'IsMessage' is a marker+class with no methods of its own; its superclasses ('MessageEncode',+'MessageDecode', 'ProtoMessage', 'Aeson.ToJSON', 'Aeson.FromJSON',+'Typeable') do the work. Emitting an instance signals to the registry+TH discovery splice that this type is eligible for inclusion.+-}+genIsMessageInstance :: [Text] -> Doc ann+genIsMessageInstance scope =+  let tyN = scopedTypeName scope+  in txt "instance IsMessage " <> pretty tyN+++genProtoMessageInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann+genProtoMessageInstance ctx scope msg =+  let tyN = scopedTypeName scope+      fqn = fqProtoName (gcPkg ctx) scope+      pkg = fromMaybe "" (gcPkg ctx)+      fields = extractMessageFieldsForSchema scope (msgElements msg)+      defN = "default" <> tyN+  in vsep+       [ instanceHead "ProtoMessage" tyN+       , indent 2 $ pretty ("protoMessageName _ = \"" :: Text) <> pretty fqn <> pretty ("\"" :: Text)+       , indent 2 $ pretty ("protoPackageName _ = \"" :: Text) <> pretty pkg <> pretty ("\"" :: Text)+       , indent 2 $ txt "protoDefaultValue = " <> pretty defN+       , indent 2 $ txt "protoFileDescriptorBytes _ = fileDescriptorProtoBytes"+       , indent 2 $+           vsep+             [ txt "protoFieldDescriptors _ = Map.fromList"+             , indent 2 $ genFieldDescriptorList ctx scope fields+             ]+       ]+++data SchemaField = SchemaField+  { sfName :: Text+  , sfNum :: Int+  , sfType :: FieldType+  , sfLabel :: Maybe FieldLabel+  }+++extractMessageFieldsForSchema :: [Text] -> [MessageElement] -> [SchemaField]+extractMessageFieldsForSchema _scope = concatMap go+  where+    go (MEField fd) = [SchemaField (fieldName fd) (unFieldNumber (fieldNumber fd)) (fieldType fd) (fieldLabel fd)]+    go (MEMapField mf) = [SchemaField (mapFieldName mf) (unFieldNumber (mapFieldNum mf)) (FTScalar SBytes) (Just Repeated)]+    go (MEOneof od) = case oneofFields od of+      (f : _) -> [SchemaField (oneofName od) (unFieldNumber (oneofFieldNumber f)) (FTNamed (oneofName od)) (Just Optional)]+      [] -> []+    go _ = []+++genFieldDescriptorList :: GenCtx -> [Text] -> [SchemaField] -> Doc ann+genFieldDescriptorList ctx scope fields =+  let entries = fmap (genFieldDescriptorEntry ctx scope) fields+  in case entries of+       [] -> txt "[]"+       (e : es) ->+         vsep [txt "[ " <> e]+           <> vsep (fmap (\x -> txt ", " <> x) es)+           <> line+           <> txt "]"+++genFieldDescriptorEntry :: GenCtx -> [Text] -> SchemaField -> Doc ann+genFieldDescriptorEntry ctx scope sf =+  let accN = ctxFieldName ctx scope (sfName sf)+      -- Under 'UnprefixedFields' the record fields are bare (and+      -- 'NoFieldSelectors' is on), so a bare selector for 'fdGet' does not+      -- exist and an un-annotated update for 'fdSet' is ambiguous when the+      -- same field name recurs across messages in the file. Both are made+      -- concrete by fixing the message type: a record-dot read and an+      -- update on a type-annotated binder. Under 'PrefixedFields' the+      -- selectors are unique, so the plain forms are kept byte-identical.+      tyN = scopedTypeName scope+      (getExpr, setExpr) = case genFieldNaming (gcOpts ctx) of+        UnprefixedFields ->+          ( "\\(m :: " <> tyN <> ") -> m." <> accN+          , "\\v (m :: " <> tyN <> ") -> m { " <> accN <> " = v }"+          )+        PrefixedFields ->+          ( accN+          , "\\v m -> m { " <> accN <> " = v }"+          )+  in txt "("+       <> pretty (T.pack (show (sfNum sf)))+       <> txt ", SomeField FieldDescriptor"+       <> line+       <> indent+         4+         ( vsep+             [ pretty ("{ fdName = \"" :: Text) <> pretty (sfName sf) <> pretty ("\"" :: Text)+             , txt ", fdNumber = " <> pretty (T.pack (show (sfNum sf)))+             , txt ", fdTypeDesc = " <> genFieldTypeDesc (sfType sf)+             , txt ", fdLabel = " <> genLabelLit (sfLabel sf)+             , txt ", fdGet = " <> pretty getExpr+             , txt ", fdSet = " <> pretty setExpr+             , txt "})"+             ]+         )+++genFieldTypeDesc :: FieldType -> Doc ann+genFieldTypeDesc = \case+  FTScalar SDouble -> txt "ScalarType DoubleField"+  FTScalar SFloat -> txt "ScalarType FloatField"+  FTScalar SInt32 -> txt "ScalarType Int32Field"+  FTScalar SInt64 -> txt "ScalarType Int64Field"+  FTScalar SUInt32 -> txt "ScalarType UInt32Field"+  FTScalar SUInt64 -> txt "ScalarType UInt64Field"+  FTScalar SSInt32 -> txt "ScalarType SInt32Field"+  FTScalar SSInt64 -> txt "ScalarType SInt64Field"+  FTScalar SFixed32 -> txt "ScalarType Fixed32Field"+  FTScalar SFixed64 -> txt "ScalarType Fixed64Field"+  FTScalar SSFixed32 -> txt "ScalarType SFixed32Field"+  FTScalar SSFixed64 -> txt "ScalarType SFixed64Field"+  FTScalar SBool -> txt "ScalarType BoolField"+  FTScalar SString -> txt "ScalarType StringField"+  FTScalar SBytes -> txt "ScalarType BytesField"+  FTNamed n -> pretty ("MessageType \"" :: Text) <> pretty n <> pretty ("\"" :: Text)+++genLabelLit :: Maybe FieldLabel -> Doc ann+genLabelLit Nothing = txt "LabelOptional"+genLabelLit (Just Optional) = txt "LabelOptional"+genLabelLit (Just Required) = txt "LabelRequired"+genLabelLit (Just Repeated) = txt "LabelRepeated"+++-- ---------------------------------------------------------------------------+-- JSON instances+-- ---------------------------------------------------------------------------++hasExtensions :: MessageDef -> Bool+hasExtensions msg = any isExt (msgElements msg)+  where+    isExt (MEExtensions _ _) = True+    isExt _ = False+++genToJSONInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann+genToJSONInstance ctx scope msg =+  let tyN = scopedTypeName scope+      fqn = fqProtoName (gcPkg ctx) scope+      overrides = genJsonOverrides (gcOpts ctx)+      hasExts = hasExtensions msg+      headDoc =+        if hasExts+          then txt "instance Given PJExt.ExtensionRegistry => Aeson.ToJSON " <> pretty tyN <> txt " where"+          else instanceHead "Aeson.ToJSON" tyN+  in case Map.lookup fqn overrides of+       Just jo ->+         vsep+           [ headDoc+           , pretty (joToJSON jo)+           ]+       Nothing ->+         let fields = extractAllFieldsJSON ctx scope (msgElements msg)+         in vsep+              [ headDoc+              , indent 2 $+                  vsep+                    [ txt "toJSON msg = jsonObject"+                    , indent 4 $ case fields of+                        [] ->+                          if hasExts+                            then txt "(PJExt.extensionEntriesForJson (given :: PJExt.ExtensionRegistry) " <> pretty ("\"" :: Text) <> pretty fqn <> pretty ("\" msg." :: Text) <> txt (unknownFieldAccessor scope) <> txt ")"+                            else txt "[]"+                        (f0 : fs) ->+                          vsep $+                            ( if hasExts+                                then [txt "(PJExt.extensionEntriesForJson (given :: PJExt.ExtensionRegistry) " <> pretty ("\"" :: Text) <> pretty fqn <> pretty ("\" msg." :: Text) <> txt (unknownFieldAccessor scope) <+> txt "++"]+                                else []+                            )+                              <> [ txt "[ " <> genToJSONField ctx f0+                                 , vsep (fmap (\f -> txt ", " <> genToJSONField ctx f) fs)+                                 , txt "]" <> if hasExts then txt ")" else emptyDoc+                                 ]+                    ]+              ]+++genToJSONField :: GenCtx -> JSONFieldInfo -> Doc ann+genToJSONField _ctx jfi = case jfiKind jfi of+  JFKBytes ->+    txt "bytesFieldToJSON " <> pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\"" :: Text) <+> txt "msg." <> pretty (jfiAccessor jfi)+  JFKOptionalBytes ->+    -- proto3 'optional bytes' fields are 'Maybe ByteString' on+    -- the record. Lift through 'Maybe' before calling the+    -- base64-encoding helper so each slot stays well-typed.+    pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\" .=: (fmap protoBytesToJSON msg." :: Text) <> pretty (jfiAccessor jfi) <> txt ")"+  JFKBytesMap ->+    txt "bytesMapFieldToJSON " <> pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\"" :: Text) <+> txt "msg." <> pretty (jfiAccessor jfi)+  JFKNormal ->+    pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\" .=: msg." :: Text) <> pretty (jfiAccessor jfi)+++genFromJSONInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann+genFromJSONInstance ctx scope msg =+  let tyN = scopedTypeName scope+      fqn = fqProtoName (gcPkg ctx) scope+      overrides = genJsonOverrides (gcOpts ctx)+      hasExts = hasExtensions msg+      headDoc =+        if hasExts+          then txt "instance Given PJExt.ExtensionRegistry => Aeson.FromJSON " <> pretty tyN <> txt " where"+          else instanceHead "Aeson.FromJSON" tyN+  in case Map.lookup fqn overrides of+       Just jo ->+         vsep+           [ headDoc+           , pretty (joFromJSON jo)+           ]+       Nothing ->+         let fields = extractAllFieldsJSON ctx scope (msgElements msg)+             extsAssign = if hasExts then txt "exts" else txt "[]"+             extsBind =+               if hasExts+                 then [txt "exts <- either fail pure (PJExt.parseExtensionsFromJson (given :: PJExt.ExtensionRegistry) " <> pretty ("\"" :: Text) <> pretty fqn <> pretty ("\" obj)" :: Text)]+                 else []+         in case fields of+              [] ->+                vsep+                  [ headDoc+                  , indent 2 $+                      if hasExts+                        then+                          txt "parseJSON = Aeson.withObject "+                            <> pretty ("\"" :: Text)+                            <> pretty tyN+                            <> pretty ("\" $ \\obj -> do" :: Text)+                            <> line+                            <> indent 4 (vsep (extsBind <> [txt "pure default" <> pretty tyN, indent 2 (braceBlock [txt (unknownFieldAccessor scope) <+> txt "=" <+> extsAssign])]))+                        else txt "parseJSON _ = pure default" <> pretty tyN+                  ]+              (f0 : frest) ->+                -- Under 'UnprefixedFields' a record update whose fields recur+                -- across messages is ambiguous; pin it with a trailing type+                -- annotation. 'PrefixedFields' updates are unique, so they are+                -- left byte-identical.+                let (pureOpen, closeBrace) = case genFieldNaming (gcOpts ctx) of+                      UnprefixedFields -> (txt "pure (default" <> pretty tyN, txt "} :: " <> pretty tyN <> txt ")")+                      PrefixedFields -> (txt "pure default" <> pretty tyN, txt "}")+                in vsep+                  [ headDoc+                  , indent 2 $+                      vsep+                        [ txt "parseJSON = Aeson.withObject " <> pretty ("\"" :: Text) <> pretty tyN <> pretty ("\" $ \\obj -> do" :: Text)+                        , indent 2 $+                            vsep+                              ( fmap genFromJSONFieldBind (f0 : frest)+                                  <> extsBind+                                  <> [ pureOpen+                                     , indent 2 $+                                         vsep+                                           ( txt "{ " <> genFromJSONFieldAssign tyN f0+                                               : fmap (\jfi -> txt ", " <> genFromJSONFieldAssign tyN jfi) frest+                                                 <> [txt ", " <> txt (unknownFieldAccessor scope) <+> txt "=" <+> extsAssign]+                                                 <> [closeBrace]+                                           )+                                     ]+                              )+                        ]+                  ]+++genFromJSONFieldBind :: JSONFieldInfo -> Doc ann+genFromJSONFieldBind jfi = case jfiKind jfi of+  JFKBytes ->+    txt "fld_" <> pretty (jfiAccessor jfi) <+> txt "<- parseBytesFieldMaybe obj " <> pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\"" :: Text)+  JFKOptionalBytes ->+    -- 'parseBytesFieldMaybe' already returns @Maybe ByteString@,+    -- which is the slot type; no second 'Just' wrap needed.+    txt "fld_" <> pretty (jfiAccessor jfi) <+> txt "<- parseBytesFieldMaybe obj " <> pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\"" :: Text)+  JFKBytesMap ->+    txt "fld_" <> pretty (jfiAccessor jfi) <+> txt "<- parseBytesMapFieldMaybe obj " <> pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\"" :: Text)+  JFKNormal ->+    txt "fld_" <> pretty (jfiAccessor jfi) <+> txt "<- parseFieldMaybe obj " <> pretty ("\"" :: Text) <> pretty (jfiJsonName jfi) <> pretty ("\"" :: Text)+++genFromJSONFieldAssign :: Text -> JSONFieldInfo -> Doc ann+genFromJSONFieldAssign tyN jfi = case jfiKind jfi of+  JFKOptionalBytes ->+    -- The slot is already 'Maybe ByteString'; the parse helper+    -- returned 'Maybe ByteString' too, so just plug it in+    -- directly instead of stripping the wrapper.+    pretty (jfiAccessor jfi) <+> txt "= fld_" <> pretty (jfiAccessor jfi)+  _ ->+    pretty (jfiAccessor jfi) <+> txt "= maybe (" <> pretty (jfiAccessor jfi) <+> txt "default" <> pretty tyN <> txt ") id fld_" <> pretty (jfiAccessor jfi)+++-- ---------------------------------------------------------------------------+-- Hashable instances+-- ---------------------------------------------------------------------------++genHashableInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann+genHashableInstance ctx scope msg =+  let tyN = scopedTypeName scope+      fields = extractAllFields ctx scope (msgElements msg)+  in vsep+       [ instanceHead "Hashable" tyN+       , indent 2 $ case fields of+           [] -> txt "hashWithSalt salt _ = salt"+           _ -> txt "hashWithSalt salt msg = " <> genHashExpr fields+       ]+++{- | Emit the per-message 'Proto.Extension.HasExtensions' instance so+that generated messages with @extensions@ declarations (or any+@extend@ block targeting them) support the typed extension+accessors from "Proto.Extension". The instance is always safe to+emit because every generated message type already carries an+unknown-fields list; messages without extension ranges will just+never have callers that use the instance.+-}+genHasExtensionsInstance :: [Text] -> MessageDef -> Doc ann+genHasExtensionsInstance scope _msg =+  let tyN = scopedTypeName scope+      acc = unknownFieldAccessor scope+  in vsep+       [ txt "instance Proto.Extension.HasExtensions " <> pretty tyN <> txt " where"+       , indent 2 $ txt "messageUnknownFields = " <> pretty acc+       , indent 2 $+           txt "setMessageUnknownFields !ufs msg = msg { "+             <> pretty acc+             <> txt " = ufs }"+       ]+++{- | Generate a 'Semigroup' instance encoding protobuf merge semantics:+singular scalar fields take the right value only if non-default+(matching MergeFrom in protoc-gen-go/cpp), repeated and map fields+append/union, submessages and oneofs pick the right value when set.+-}+genSemigroupInstance :: GenCtx -> [Text] -> MessageDef -> Doc ann+genSemigroupInstance ctx scope msg =+  let tyN = scopedTypeName scope+      fields = extractAllFields ctx scope (msgElements msg)+      conN = scopedTypeName scope+      unknownAcc = unknownFieldAccessor scope+      mergeField fi =+        let acc = fifAccessor fi+            ba = txt "b." <> pretty acc+            aa = txt "a." <> pretty acc+            lastNonDefault def =+              txt "if "+                <> ba+                <> txt " == "+                <> txt def+                <> txt " then "+                <> aa+                <> txt " else "+                <> ba+        in pretty acc <> txt " = " <> case fifKind fi of+             FKMap _ _ -> aa <> txt " <> " <> ba+             FKOneof _ _ -> txt "case " <> ba <> txt " of { Nothing -> " <> aa <> txt "; x -> x }"+             FKScalar (Just Repeated) _ -> aa <> txt " <> " <> ba+             FKNamed (Just Repeated) _ _ -> aa <> txt " <> " <> ba+             FKNamed (Just Optional) _ _ -> txt "case " <> ba <> txt " of { Nothing -> " <> aa <> txt "; x -> x }"+             FKNamed (Just Required) _ TKMessage -> txt "case " <> ba <> txt " of { Nothing -> " <> aa <> txt "; x -> x }"+             FKNamed (Just Required) _ TKEnum -> lastNonDefault "(toEnum 0)"+             FKNamed Nothing _ TKMessage -> txt "case " <> ba <> txt " of { Nothing -> " <> aa <> txt "; x -> x }"+             FKNamed Nothing _ TKEnum -> lastNonDefault "(toEnum 0)"+             FKScalar (Just Optional) _ -> txt "case " <> ba <> txt " of { Nothing -> " <> aa <> txt "; x -> x }"+             FKScalar (Just Required) ft -> lastNonDefault (scalarDefaultText ft)+             FKScalar Nothing ft -> lastNonDefault (scalarDefaultText ft)+  in vsep+       [ txt "instance Semigroup " <> pretty tyN <> txt " where"+       , indent 2 $+           vsep+             [ txt "a <> b = " <> pretty conN+             , indent 2 $+                 braceBlock+                   ( fmap mergeField fields+                       <> [pretty unknownAcc <> txt " = a." <> pretty unknownAcc <> txt " <> b." <> pretty unknownAcc]+                   )+             ]+       ]+++{- | Generate a 'Monoid' instance whose identity is the proto3 default+message (all scalars zero, all repeated / map / optional fields empty+/ 'Nothing'). The 'Semigroup' instance skips default-valued scalars+from the right operand, so @a <> mempty = a@ holds.+-}+genMonoidInstance :: [Text] -> Doc ann+genMonoidInstance scope =+  let tyN = scopedTypeName scope+      defN = "default" <> tyN+  in vsep+       [ txt "instance Monoid " <> pretty tyN <> txt " where"+       , indent 2 $ txt "mempty = " <> pretty defN+       ]+++genHashExpr :: [FieldInfoFull] -> Doc ann+genHashExpr = go (txt "salt")+  where+    go acc [] = acc+    go acc (fi : rest) = go (genFieldHashApp acc fi) rest+++genFieldHashApp :: Doc ann -> FieldInfoFull -> Doc ann+genFieldHashApp acc fi =+  let fld = txt "msg." <> pretty (fifAccessor fi)+  in case fifKind fi of+       FKScalar (Just Repeated) st+         | isUnboxableScalar st ->+             txt "VU.foldl' hashWithSalt (" <> acc <> txt ") " <> fld+       FKScalar (Just Repeated) _ ->+         txt "V.foldl' hashWithSalt (" <> acc <> txt ") " <> fld+       FKNamed (Just Repeated) _ _ ->+         txt "V.foldl' hashWithSalt (" <> acc <> txt ") " <> fld+       FKMap _ _ ->+         txt "Map.foldlWithKey' (\\s k v -> s `hashWithSalt` k `hashWithSalt` v) (" <> acc <> txt ") " <> fld+       _ ->+         txt "hashWithSalt (" <> acc <> txt ") " <> fld+++genOneofHashableInstance :: GenCtx -> [Text] -> OneofDef -> Doc ann+genOneofHashableInstance _ctx scope od =+  let tyN = scopedTypeName scope <> "'" <> snakeToPascal (oneofName od)+      arms = zipWith (genOneofHashArm scope (oneofName od)) [0 :: Int ..] (oneofFields od)+  in vsep+       [ instanceHead "Hashable" tyN+       , indent 2 $ vsep arms+       ]+++genOneofHashArm :: [Text] -> Text -> Int -> OneofField -> Doc ann+genOneofHashArm scope ooName tag f =+  let conName = oneofConName scope ooName (oneofFieldName f)+      tagStr = T.pack (show tag)+  in txt "hashWithSalt salt (" <> pretty conName <+> txt "v) = salt `hashWithSalt` (" <> pretty tagStr <> txt " :: Int) `hashWithSalt` v"+++genEnumHashableInstance :: [Text] -> EnumDef -> Doc ann+genEnumHashableInstance scope _ed =+  let tyN = scopedTypeName scope+  in vsep+       [ instanceHead "Hashable" tyN+       , indent 2 (txt "hashWithSalt salt x = hashWithSalt salt (toProtoEnum" <> pretty tyN <+> txt "x)")+       ]+++fqProtoName :: Maybe Text -> [Text] -> Text+fqProtoName pkg scope =+  let msgName = T.intercalate "." scope+  in case pkg of+       Just p -> p <> "." <> msgName+       Nothing -> msgName+++-- ---------------------------------------------------------------------------+-- Field extraction (unified)+-- ---------------------------------------------------------------------------++data FieldKindFull+  = FKScalar (Maybe FieldLabel) ScalarType+  | FKNamed (Maybe FieldLabel) Text TypeKind+  | FKMap ScalarType FieldType+  | FKOneof [Text] OneofDef+  deriving stock (Show, Eq)+++data FieldInfoFull = FieldInfoFull+  { fifAccessor :: Text+  , fifFieldNum :: Int+  , fifIndex :: Int+  , fifKind :: FieldKindFull+  }+  deriving stock (Show, Eq)+++extractAllFields :: GenCtx -> [Text] -> [MessageElement] -> [FieldInfoFull]+extractAllFields ctx scope elems =+  zipWith (\i fi -> fi {fifIndex = i}) [0 ..] (concatMap go elems)+  where+    go = \case+      MEField fd ->+        let accessor = ctxFieldName ctx scope (fieldName fd)+            fn = unFieldNumber (fieldNumber fd)+            kind = case fieldType fd of+              FTScalar st -> FKScalar (fieldLabel fd) st+              FTNamed n -> FKNamed (fieldLabel fd) n (resolveTypeKindScoped ctx scope n)+        in [FieldInfoFull accessor fn 0 kind]+      MEMapField mf ->+        let accessor = ctxFieldName ctx scope (mapFieldName mf)+            fn = unFieldNumber (mapFieldNum mf)+        in [FieldInfoFull accessor fn 0 (FKMap (mapKeyType mf) (mapValueType mf))]+      MEOneof od ->+        let accessor = ctxFieldName ctx scope (oneofName od)+            fn = 0+        in [FieldInfoFull accessor fn 0 (FKOneof scope od)]+      _ -> []+++resolveTypeKindScoped :: GenCtx -> [Text] -> Text -> TypeKind+resolveTypeKindScoped ctx scope name = maybe TKMessage tiKind (resolveTypeWithScope ctx scope name)+++-- JSON field info+--+-- 'JFKBytes' is split into bare-bytes and optional-bytes shapes+-- so the bytes ToJSON / FromJSON helpers (which require a+-- 'ByteString' / 'Maybe ByteString' argument respectively) line+-- up with the actual record-slot type. Without the split,+-- proto3 'optional bytes' fields generate code that takes a+-- 'Maybe ByteString' where 'bytesFieldToJSON' wants 'ByteString',+-- which doesn't type-check.+data JSONFieldKind = JFKNormal | JFKBytes | JFKOptionalBytes | JFKBytesMap+  deriving stock (Show, Eq)+++data JSONFieldInfo = JSONFieldInfo+  { jfiAccessor :: Text+  , jfiJsonName :: Text+  , jfiOptional :: Bool+  , jfiKind :: JSONFieldKind+  }+  deriving stock (Show, Eq)+++extractAllFieldsJSON :: GenCtx -> [Text] -> [MessageElement] -> [JSONFieldInfo]+extractAllFieldsJSON ctx scope = concatMap go+  where+    go = \case+      MEField fd ->+        let accessor = ctxFieldName ctx scope (fieldName fd)+            jsonName = fromMaybe (protoJsonName (fieldName fd)) (getJsonName (fieldOptions fd))+            kind = case fieldType fd of+              FTScalar SBytes -> case fieldLabel fd of+                Just Optional -> JFKOptionalBytes+                _ -> JFKBytes+              _ -> JFKNormal+        in [JSONFieldInfo accessor jsonName True kind]+      MEMapField mf ->+        let accessor = ctxFieldName ctx scope (mapFieldName mf)+            jsonName = fromMaybe (protoJsonName (mapFieldName mf)) (getJsonName (mapOptions mf))+            kind = case mapValueType mf of FTScalar SBytes -> JFKBytesMap; _ -> JFKNormal+        in [JSONFieldInfo accessor jsonName True kind]+      MEOneof od ->+        let accessor = ctxFieldName ctx scope (oneofName od)+            jsonName = protoJsonName (oneofName od)+        in [JSONFieldInfo accessor jsonName True JFKNormal]+      _ -> []+++getJsonName :: [OptionDef] -> Maybe Text+getJsonName = \case+  [] -> Nothing+  opts -> lookupSimpleOption "json_name" opts >>= optionAsString+++-- ---------------------------------------------------------------------------+-- Service generation+-- ---------------------------------------------------------------------------++genServiceTopLevel :: GenCtx -> [Text] -> ServiceDef -> [Doc ann]+genServiceTopLevel ctx scope svc =+  let pkg = fromMaybe "" (gcPkg ctx)+      resolveRpcType name =+        let candidates = [name, pkg <> "." <> name]+            go [] = Nothing+            go (c : cs) = case Map.lookup c (gcRegistry ctx) of+              Just ti -> Just ti+              Nothing -> go cs+        in go candidates+      -- RPC types are now registered in 'collectReferencedTypes', so+      -- the module-level imports block covers them. We only need to+      -- /qualify/ each RPC type when emitting the service's+      -- declarations.+      qualifyRpcType name = case resolveRpcType name of+        Just ti+          | tiModule ti /= gcThisMod ctx -> moduleAlias (tiModule ti) <> "." <> tiHsName ti+          | otherwise -> tiHsName ti+        Nothing -> hsTypeName (lastPart name)+      lastPart t = case T.splitOn "." t of [] -> t; parts -> last parts+      svcScope = scope <> [svcName svc]+      hookCtx =+        ServiceHookCtx+          { shcServiceDef = svc+          , shcScope = svcScope+          , shcHsTypeName = T.intercalate "'" (fmap hsTypeName svcScope)+          , shcOptions = svcOptions svc+          }+      hookOutput = onServiceCodeGen (genHooks (gcOpts ctx)) hookCtx+      hookDocs = fmap pretty hookOutput+  in Service.genServiceDeclsQualified (gcPkg ctx) scope qualifyRpcType svc+       <> case hookDocs of+         [] -> []+         ds -> [mempty, vsep ds]+++-- ---------------------------------------------------------------------------+-- Proto2 extension blocks (@extend Foo { optional int32 bar = 123; }@)+-- ---------------------------------------------------------------------------++{- | Emit one top-level 'Proto.Extension.Extension' binding per field+in an @extend@ block. Callers of the generated module use+'Proto.Extension.getExtension' / 'setExtension' / 'clearExtension'+to interact with the extension through the message's+unknown-fields list; the owning message type automatically+satisfies 'Proto.Extension.HasExtensions' via the+per-message instance emitted by 'genHasExtensionsInstance'.++Singular + repeated (packed and unpacked) extensions are+emitted here. Proto2 message-groups never made it into this+codebase's 'FieldType' ADT, so the old-style group extension+is not representable at all — the parser rejects group+fields before they can reach this function.+-}+genExtensionBlock+  :: GenCtx -> [Text] -> Text -> [FieldDef] -> [Doc ann]+genExtensionBlock ctx scope extOwnerName fields =+  let pkg = fromMaybe "" (gcPkg ctx)+      ownerHsType = qualifyExtendedType ctx pkg extOwnerName+      ownerProtoShort = lastDot extOwnerName+      ownerPrefix = lowerFirst (hsTypeName ownerProtoShort)+  in concatMap (genOneExtension ctx scope ownerHsType ownerPrefix) fields+++-- Generate one @Extension <owner> <payload>@ (or+-- @RepeatedExtension <owner> <payload>@) binding.+genOneExtension+  :: GenCtx -> [Text] -> Text -> Text -> FieldDef -> [Doc ann]+genOneExtension _ctx _scope ownerHsType ownerPrefix fd =+  let fieldNameHs =+        escapeReserved+          (ownerPrefix <> upperFirst (snakeToCamel (fieldName fd)))+      num = unFieldNumber (fieldNumber fd)+      repeated = fieldLabel fd == Just Repeated+      packed =+        repeated && case fieldType fd of+          FTScalar s -> packableScalar s+          _ -> False+      payload = extensionPayloadCore (fieldType fd)+  in case payload of+       Nothing ->+         [ mempty+         , txt "-- WARNING: extension '"+             <> pretty (fieldName fd)+             <> txt "' uses an unsupported shape and was skipped."+         ]+       Just (haskellType, extTag) ->+         if repeated+           then+             [ mempty+             , txt fieldNameHs+                 <> txt " :: Proto.Extension.RepeatedExtension "+                 <> pretty ownerHsType+                 <> txt " "+                 <> haskellType+             , txt fieldNameHs <> txt " = Proto.Extension.RepeatedExtension"+             , indent 2 $ txt "{ Proto.Extension.reNumber   = " <> pretty (tshow num)+             , indent 2 $+                 txt ", Proto.Extension.reType     = Proto.Extension."+                   <> pretty extTag+             , indent 2 $+                 txt ", Proto.Extension.reIsPacked = "+                   <> (if packed then txt "True" else txt "False")+             , indent 2 $ txt "}"+             ]+           else+             [ mempty+             , txt fieldNameHs+                 <> txt " :: Proto.Extension.Extension "+                 <> pretty ownerHsType+                 <> txt " "+                 <> haskellType+             , txt fieldNameHs <> txt " = Proto.Extension.Extension"+             , indent 2 $ txt "{ Proto.Extension.extNumber = " <> pretty (tshow num)+             , indent 2 $+                 txt ", Proto.Extension.extType   = Proto.Extension."+                   <> pretty extTag+             , indent 2 $ txt "}"+             ]+++{- | Project a proto 'FieldType' onto @(Haskell type,+'ExtensionType' constructor name)@. The label-aware split is now+the caller's job: 'genOneExtension' picks Extension vs.+RepeatedExtension based on @fieldLabel@.+-}+extensionPayloadCore :: FieldType -> Maybe (Doc ann, Text)+extensionPayloadCore (FTScalar s) = case s of+  SDouble -> Just (txt "Double", "ExtDouble")+  SFloat -> Just (txt "Float", "ExtFloat")+  SInt32 -> Just (txt "Int32", "ExtInt32")+  SInt64 -> Just (txt "Int64", "ExtInt64")+  SUInt32 -> Just (txt "Word32", "ExtUInt32")+  SUInt64 -> Just (txt "Word64", "ExtUInt64")+  SSInt32 -> Just (txt "Int32", "ExtSInt32")+  SSInt64 -> Just (txt "Int64", "ExtSInt64")+  SFixed32 -> Just (txt "Word32", "ExtFixed32")+  SFixed64 -> Just (txt "Word64", "ExtFixed64")+  SSFixed32 -> Just (txt "Int32", "ExtSFixed32")+  SSFixed64 -> Just (txt "Int64", "ExtSFixed64")+  SBool -> Just (txt "Bool", "ExtBool")+  SString -> Just (txt "Text", "ExtString")+  SBytes -> Just (txt "ByteString", "ExtBytes")+extensionPayloadCore (FTNamed _) =+  -- Named-type (message / enum) extensions carry raw encoded+  -- bytes; callers decode them lazily via the normal message+  -- decoder for the referenced type.+  Just (txt "ByteString", "ExtMessage")+++{- | Whether a scalar can use the packed encoding (proto2 default+false; proto3 default true). Strings and bytes can't.+-}+packableScalar :: ScalarType -> Bool+packableScalar = \case+  SString -> False+  SBytes -> False+  _ -> True+++-- Resolve an extended type name to its Haskell module-qualified+-- form. Same logic as 'qualifyRpcType' in 'genServiceTopLevel'.+qualifyExtendedType :: GenCtx -> Text -> Text -> Text+qualifyExtendedType ctx pkg name =+  let candidates = [name, pkg <> "." <> name]+      go [] = Nothing+      go (c : cs) = case Map.lookup c (gcRegistry ctx) of+        Just ti -> Just ti+        Nothing -> go cs+  in case go candidates of+       Just ti+         | tiModule ti /= gcThisMod ctx ->+             moduleAlias (tiModule ti) <> "." <> tiHsName ti+         | otherwise -> tiHsName ti+       Nothing -> hsTypeName (lastDot name)+++lastDot :: Text -> Text+lastDot t = case T.splitOn "." t of+  [] -> t+  parts -> last parts+++-- ---------------------------------------------------------------------------+-- Enum generation+-- ---------------------------------------------------------------------------++genEnum :: GenCtx -> [Text] -> EnumDef -> [Doc ann]+genEnum ctx scope ed =+  let scope' = scope <> [enumName ed]+      tyN = scopedTypeName scope'+      hookCtx =+        EnumHookCtx+          { ehcEnumDef = ed+          , ehcScope = scope'+          , ehcHsTypeName = tyN+          , ehcOptions = enumOptions ed+          }+      hookOutput = onEnumCodeGen (genHooks (gcOpts ctx)) hookCtx+      hookDocs = fmap pretty hookOutput+  in [ mempty+     , genEnumDataDecl scope' ed+     , mempty+     , genEnumToProto scope' ed+     , mempty+     , genEnumFromProto scope' ed+     , mempty+     , genEnumEncodeInstance scope' ed+     , mempty+     , genEnumToJSONInstance scope' ed+     , mempty+     , genEnumFromJSONInstance scope' ed+     , mempty+     , genEnumHashableInstance scope' ed+     ]+       <> case hookDocs of+         [] -> []+         ds -> [mempty, vsep ds]+++genEnumDataDecl :: [Text] -> EnumDef -> Doc ann+genEnumDataDecl scope ed =+  let tyN = scopedTypeName scope+      hasAlias = enumHasAliases ed+      primaryVals = enumPrimaryValues ed+      aliasVals = enumAliasValues ed+      deriveLine =+        if hasAlias+          then txt "deriving stock (Show, Eq, Ord, Generic)"+          else txt "deriving stock (Show, Eq, Ord, Enum, Bounded, Generic)"+      aliasSyns =+        fmap+          ( \ev ->+              txt "pattern "+                <> pretty (scopedEnumCon scope (evName ev))+                <+> txt "::"+                <+> pretty tyN+                <> line+                <> txt "pattern "+                <> pretty (scopedEnumCon scope (evName ev))+                <+> txt "= "+                <> pretty (scopedEnumCon scope (canonicalNameForNumber ed (evNumber ev)))+          )+          aliasVals+  in vsep $+       haddockDoc (enumDoc ed)+         <> [ txt "data " <> pretty tyN+            , indent 2 (vsep (concatMap (\(pfx, v) -> (pfx <+> pretty (scopedEnumCon scope (evName v))) : haddockFieldDoc (evDoc v)) (zip seps primaryVals)))+            , indent 2 deriveLine+            , indent 2 (txt "deriving anyclass NFData")+            ]+         <> aliasSyns+  where+    seps = txt "=" : repeat (txt "|")+++genEnumToProto :: [Text] -> EnumDef -> Doc ann+genEnumToProto scope ed =+  let tyN = scopedTypeName scope+      primaryVals = enumPrimaryValues ed+      genCase ev =+        txt "toProtoEnum"+          <> pretty tyN+          <+> pretty (scopedEnumCon scope (evName ev))+          <+> txt "= "+          <> pretty (T.pack (show (evNumber ev)))+  in vsep+       [ txt "toProtoEnum" <> pretty tyN <+> txt "::" <+> pretty tyN <+> txt "-> Int"+       , vsep (fmap genCase primaryVals)+       ]+++genEnumFromProto :: [Text] -> EnumDef -> Doc ann+genEnumFromProto scope ed =+  let tyN = scopedTypeName scope+      primaryVals = enumPrimaryValues ed+      genCase ev =+        txt "fromProtoEnum"+          <> pretty tyN+          <+> pretty (T.pack (show (evNumber ev)))+          <+> txt "= Just "+          <> pretty (scopedEnumCon scope (evName ev))+  in vsep+       [ txt "fromProtoEnum" <> pretty tyN <+> txt "::" <+> txt "Int -> Maybe " <> pretty tyN+       , vsep (fmap genCase primaryVals)+       , txt "fromProtoEnum" <> pretty tyN <+> txt "_ = Nothing"+       ]+++enumHasAliases :: EnumDef -> Bool+enumHasAliases ed =+  let nums = fmap evNumber (enumValues ed)+  in length nums /= length (Set.fromList nums)+++enumPrimaryValues :: EnumDef -> [EnumValue]+enumPrimaryValues ed = go Set.empty (enumValues ed)+  where+    go _ [] = []+    go seen (ev : evs)+      | Set.member (evNumber ev) seen = go seen evs+      | otherwise = ev : go (Set.insert (evNumber ev) seen) evs+++enumAliasValues :: EnumDef -> [EnumValue]+enumAliasValues ed = go Set.empty (enumValues ed)+  where+    go _ [] = []+    go seen (ev : evs)+      | Set.member (evNumber ev) seen = ev : go seen evs+      | otherwise = go (Set.insert (evNumber ev) seen) evs+++canonicalNameForNumber :: EnumDef -> Int -> Text+canonicalNameForNumber ed num =+  case filter (\ev -> evNumber ev == num) (enumValues ed) of+    (ev : _) -> evName ev+    [] -> "UNKNOWN"+++genEnumEncodeInstance :: [Text] -> EnumDef -> Doc ann+genEnumEncodeInstance scope _ed =+  let tyN = scopedTypeName scope+  in vsep+       [ instanceHead "MessageEncode" tyN+       , indent 2 (txt "buildMessage _ = mempty")+       , instanceHead "MessageSize" tyN+       , indent 2 (txt "messageSize _ = 0")+       , instanceHead "MessageDecode" tyN+       , indent 2 (txt "messageDecoder = pure (toEnum 0)")+       ]+++genEnumToJSONInstance :: [Text] -> EnumDef -> Doc ann+genEnumToJSONInstance scope ed =+  let tyN = scopedTypeName scope+      primaryVals = enumPrimaryValues ed+      genCase ev =+        txt "toJSON "+          <> pretty (scopedEnumCon scope (evName ev))+          <+> pretty ("= Aeson.String \"" :: Text)+          <> pretty (evName ev)+          <> pretty ("\"" :: Text)+  in vsep+       [ instanceHead "Aeson.ToJSON" tyN+       , indent 2 (vsep (fmap genCase primaryVals))+       ]+++genEnumFromJSONInstance :: [Text] -> EnumDef -> Doc ann+genEnumFromJSONInstance scope ed =+  let tyN = scopedTypeName scope+      hasAlias = enumHasAliases ed+      genCase ev =+        pretty ("  Aeson.String \"" :: Text) <> pretty (evName ev) <> pretty ("\" -> pure " :: Text) <> pretty (scopedEnumCon scope (evName ev))+      fallbackNumCase =+        if hasAlias+          then+            txt "  Aeson.Number n -> case fromProtoEnum"+              <> pretty tyN+              <> pretty (" (round n) of { Just v -> pure v; Nothing -> fail \"Invalid enum\" }" :: Text)+          else txt "  Aeson.Number n -> pure (toEnum (round n))"+  in vsep+       [ instanceHead "Aeson.FromJSON" tyN+       , indent 2 $+           vsep+             [ txt "parseJSON = \\case"+             , vsep (fmap genCase (enumValues ed))+             , fallbackNumCase+             , txt "  _ -> fail " <> pretty ("\"Invalid enum value for " :: Text) <> pretty tyN <> pretty ("\"" :: Text)+             ]+       ]+++-- ---------------------------------------------------------------------------+-- Haskell type helpers+-- ---------------------------------------------------------------------------++hsFieldType :: GenCtx -> [Text] -> FieldType -> Maybe FieldLabel -> Doc ann+hsFieldType ctx scope ft = \case+  Just Repeated -> hsRepeatedType ctx scope ft+  Just Optional -> txt "!(Maybe " <> hsFieldTypeInner ctx scope ft <> txt ")"+  Just Required -> txt "!" <> hsFieldTypeInner ctx scope ft+  Nothing -> case ft of+    FTScalar s | isUnboxableScalar s -> txt "{-# UNPACK #-} !" <> hsScalarType s+    FTScalar _ -> txt "!" <> hsFieldTypeInner ctx scope ft+    FTNamed n -> case resolveTypeWithScope ctx scope n of+      Just ti | tiKind ti == TKEnum -> txt "!" <> pretty (qualifyTypeRef ctx (Just ti) n)+      _ -> txt "!(Maybe " <> hsFieldTypeInner ctx scope ft <> txt ")"+++hsFieldTypeInner :: GenCtx -> [Text] -> FieldType -> Doc ann+hsFieldTypeInner ctx scope = \case+  FTScalar s -> hsScalarType s+  FTNamed n -> pretty (resolveHsTypeNameScoped ctx scope n)+++hsOneofFieldType :: GenCtx -> [Text] -> FieldType -> Doc ann+hsOneofFieldType ctx scope = \case+  FTScalar s -> unpackPragma s <> hsScalarType s+  FTNamed n -> txt "!" <> pretty (resolveHsTypeNameScoped ctx scope n)+++hsRepeatedType :: GenCtx -> [Text] -> FieldType -> Doc ann+hsRepeatedType ctx scope = \case+  FTScalar s | isUnboxableScalar s -> txt "!(VU.Vector " <> hsScalarType s <> txt ")"+  ft -> txt "!(V.Vector " <> hsFieldTypeInner ctx scope ft <> txt ")"+++{- | Resolve a proto type name to its Haskell reference.+Returns a qualified name like @PB_Timestamp.Timestamp@ for external types,+or an unqualified name like @Payload@ for local types.+-}+resolveHsTypeNameScoped :: GenCtx -> [Text] -> Text -> Text+resolveHsTypeNameScoped ctx scope name = qualifyTypeRef ctx (resolveTypeWithScope ctx scope name) name+++qualifyTypeRef :: GenCtx -> Maybe TypeInfo -> Text -> Text+qualifyTypeRef ctx mti name = case mti of+  Just ti+    | tiModule ti == gcThisMod ctx -> tiHsName ti+    | otherwise -> moduleAlias (tiModule ti) <> "." <> tiHsName ti+  Nothing -> hsTypeName (lastPart name)+  where+    lastPart t = case T.splitOn "." t of+      [] -> t+      parts -> last parts+++hsScalarType :: ScalarType -> Doc ann+hsScalarType = \case+  SDouble -> txt "Double"+  SFloat -> txt "Float"+  SInt32 -> txt "Int32"+  SInt64 -> txt "Int64"+  SUInt32 -> txt "Word32"+  SUInt64 -> txt "Word64"+  SSInt32 -> txt "Int32"+  SSInt64 -> txt "Int64"+  SFixed32 -> txt "Word32"+  SFixed64 -> txt "Word64"+  SSFixed32 -> txt "Int32"+  SSFixed64 -> txt "Int64"+  SBool -> txt "Bool"+  SString -> txt "Text"+  SBytes -> txt "ByteString"+++isUnboxableScalar :: ScalarType -> Bool+isUnboxableScalar = \case+  SString -> False+  SBytes -> False+  _ -> True+++unpackPragma :: ScalarType -> Doc ann+unpackPragma s+  | isUnboxableScalar s = txt "{-# UNPACK #-} !"+  | otherwise = txt "!"+++-- ---------------------------------------------------------------------------+-- Name conversion helpers+-- ---------------------------------------------------------------------------++-- | Build a Haskell type name from a scope path, joining with @'@.+scopedTypeName :: [Text] -> Text+scopedTypeName = T.intercalate "'" . fmap hsTypeName+++-- | Build a Haskell record field name using 'PrefixedFields' naming.+scopedFieldName :: [Text] -> Text -> Text+scopedFieldName = scopedFieldNameWith PrefixedFields+++-- | Build a Haskell record field name using the given naming strategy.+scopedFieldNameWith :: FieldNaming -> [Text] -> Text -> Text+scopedFieldNameWith PrefixedFields scope fName =+  let prefix = case scope of+        [] -> ""+        [s] -> lowerFirst (hsTypeName s)+        _ -> lowerFirst (T.intercalate "" (fmap hsTypeName scope))+  in escapeReserved (prefix <> upperFirst (snakeToCamel fName))+scopedFieldNameWith UnprefixedFields _scope fName =+  escapeReserved (snakeToCamel fName)+++upperFirst :: Text -> Text+upperFirst s = case T.uncons s of+  Just (c, rest) -> T.cons (toUpper c) rest+  Nothing -> s+++-- | Build a Haskell enum constructor name from scope and value name.+scopedEnumCon :: [Text] -> Text -> Text+scopedEnumCon scope valName =+  case scope of+    [] -> snakeToPascal valName+    _ -> scopedTypeName scope <> "'" <> snakeToPascal valName+++-- | Capitalize the first character of a name for use as a Haskell type name.+hsTypeName :: Text -> Text+hsTypeName t = case T.uncons t of+  Just (c, rest) -> T.cons (toUpper c) rest+  Nothing -> t+++hsModuleName :: Text -> Text+hsModuleName = T.intercalate "." . fmap capitalize . T.splitOn "."+  where+    capitalize t = case T.uncons t of+      Just (c, rest) -> T.cons (toUpper c) rest+      Nothing -> t+++lowerFirst :: Text -> Text+lowerFirst s = case T.uncons s of+  Just (c, rest) -> T.cons (toLower c) rest+  Nothing -> s+++titleCase :: Text -> Text+titleCase s = case T.uncons s of+  Just (c, rest) -> T.cons (toUpper c) (T.toLower rest)+  Nothing -> s+++snakeToCamel :: Text -> Text+snakeToCamel t =+  let parts = T.splitOn "_" t+  in case parts of+       [] -> t+       (p : ps) -> T.concat (lowerFirst p : fmap titleCase ps)+++{- | Proto3 JSON name conversion per the canonical spec+(mirror of @ToJsonName@ in the upstream protoc C++ source).++Differences vs. 'snakeToCamel' that the conformance suite+(@FieldNameWithMixedCases@, @FieldNameWithDoubleUnderscores@,+etc.) depends on:++* The case of every non-underscore character is preserved+  /as-is/, only the character /after/ an @_@ is upcased.+  So @FieldName8@ stays @FieldName8@ (we don't lowercase+  the leading @F@).+* Repeated underscores collapse: @field__name15@ becomes+  @fieldName15@ (only the next non-underscore is upcased).+* Trailing underscores are dropped: @Field_name18__@+  becomes @FieldName18@.+-}+protoJsonName :: Text -> Text+protoJsonName = T.pack . go False . T.unpack+  where+    go _ [] = []+    go capNext (c : cs)+      | c == '_' = go True cs+      | capNext = toUpper c : go False cs+      | otherwise = c : go False cs+++snakeToPascal :: Text -> Text+snakeToPascal t =+  let parts = T.splitOn "_" t+  in T.concat (fmap titleCase parts)+++escapeReserved :: Text -> Text+escapeReserved t+  | t `elem` haskellReserved = t <> "'"+  | otherwise = t+++haskellReserved :: [Text]+haskellReserved =+  [ "type"+  , "class"+  , "data"+  , "default"+  , "deriving"+  , "do"+  , "else"+  , "if"+  , "import"+  , "in"+  , "infix"+  , "infixl"+  , "infixr"+  , "instance"+  , "let"+  , "module"+  , "newtype"+  , "of"+  , "then"+  , "where"+  , "case"+  , "foreign"+  , "forall"+  , "mdo"+  , "qualified"+  , "hiding"+  ]+++oneofConName :: [Text] -> Text -> Text -> Text+oneofConName scope oneofN fieldName =+  scopedTypeName scope <> "'" <> snakeToPascal oneofN <> "'" <> snakeToPascal fieldName+++replaceAt :: Int -> a -> [a] -> [a]+replaceAt _ _ [] = []+replaceAt 0 x (_ : ys) = x : ys+replaceAt n x (y : ys) = y : replaceAt (n - 1) x ys
+ src/Proto/CodeGen/Decode.hs view
@@ -0,0 +1,306 @@+{- | Code generation for message decoding functions.++Generates specialized 'messageDecoder' implementations that:+* Use a tight decode loop with accumulators for each field+* Dispatch on field number with a case expression+* Handle unknown fields by skipping efficiently+* Support both packed and unpacked repeated fields+* Support proto3 merge semantics for submessages++Field-order scheduling (inspired by hyperpb):+After decoding field N, the generated code predicts that the next+field on the wire will be field N+1 (declaration order). This is+almost always correct since every protobuf encoder emits fields in+order. On a correct prediction, we skip the full case dispatch and+go straight to the right decoder — a single comparison instead of+a multi-way branch.+-}+module Proto.CodeGen.Decode (+  genDecodeInstance,+) where++import Data.Text (Text)+import Data.Text qualified as T+import Prettyprinter+import Proto.CodeGen.Types (hsFieldName, hsTypeName)+import Proto.IDL.AST+import Proto.Internal.CodeGen.Combinators (txt)+++{- | Generate a MessageDecode instance for a message.++For messages with 2+ fields, generates per-field entry points that+predict the next field in declaration order (field-order scheduling).+For 0-1 field messages, uses the simpler flat dispatch.+-}+genDecodeInstance :: MessageDef -> Doc ann+genDecodeInstance msg =+  let fields = extractFields (msgElements msg)+      allAccs = fmap fieldAccum fields+  in case fields of+       [] -> genDecodeInstanceSimple msg fields allAccs+       [_] -> genDecodeInstanceSimple msg fields allAccs+       _ -> genDecodeInstanceScheduled msg fields allAccs+++-- | Simple flat dispatch (for 0-1 fields).+genDecodeInstanceSimple :: MessageDef -> [FieldInfo] -> [Text] -> Doc ann+genDecodeInstanceSimple msg fields allAccs =+  vsep+    [ txt "instance MessageDecode" <+> pretty (hsTypeName (msgName msg)) <+> txt "where"+    , indent 2 $+        vsep+          [ txt "messageDecoder ="+              <+> txt "loop"+              <+> hsep (fmap (pretty . fieldDefault) fields)+          , indent 2 $ txt "where"+          , indent 4 $+              vsep+                [ txt "loop" <+> hsep (fmap (pretty . fieldAccum) fields) <+> txt "= do"+                , indent 2 $+                    vsep+                      [ txt "mTag <- getTagOrU"+                      , txt "case mTag of"+                      , indent 2 $+                          vsep+                            [ txt "UNothing -> pure" <+> genRecordCon msg fields+                            , txt "UJust (Tag fn wt) -> case fn of"+                            , indent 2 $ vsep (fmap (genFieldCaseSimple allAccs "loop") fields <> [genDefaultCase allAccs "loop"])+                            ]+                      ]+                ]+          ]+    ]+++{- | Field-order scheduled dispatch (for 2+ fields).++Generates:+  loop_dispatch (the full case dispatch, used as fallback)+  loop_after_0, loop_after_1, ... (per-field entry points)++Each loop_after_i first checks if fn == field[i+1].fieldNum;+on match, decodes and calls loop_after_{i+1}; on mismatch,+falls through to loop_dispatch.+-}+genDecodeInstanceScheduled :: MessageDef -> [FieldInfo] -> [Text] -> Doc ann+genDecodeInstanceScheduled msg fields allAccs =+  let nFields = length fields+  in vsep+       [ txt "instance MessageDecode" <+> pretty (hsTypeName (msgName msg)) <+> txt "where"+       , indent 2 $+           vsep+             [ txt "messageDecoder ="+                 <+> txt "loop_dispatch"+                 <+> hsep (fmap (pretty . fieldDefault) fields)+             , indent 2 $ txt "where"+             , indent 4 $+                 vsep $+                   -- The full dispatch loop (fallback)+                   [genDispatchLoop msg fields allAccs nFields]+                     <>+                     -- Per-field entry points with next-field prediction+                     fmap (genAfterLoop msg fields allAccs nFields) [0 .. nFields - 1]+             ]+       ]+++-- | Generate the full dispatch loop (fallback for mispredictions).+genDispatchLoop :: MessageDef -> [FieldInfo] -> [Text] -> Int -> Doc ann+genDispatchLoop msg fields allAccs nFields =+  vsep+    [ txt "loop_dispatch" <+> hsep (fmap (pretty . fieldAccum) fields) <+> txt "= do"+    , indent 2 $+        vsep+          [ txt "mTag <- getTagOrU"+          , txt "case mTag of"+          , indent 2 $+              vsep+                [ txt "UNothing -> pure" <+> genRecordCon msg fields+                , txt "UJust (Tag fn wt) -> case fn of"+                , indent 2 $+                    vsep+                      ( fmap (genFieldCaseScheduled allAccs nFields) fields+                          <> [genDefaultCase allAccs "loop_dispatch"]+                      )+                ]+          ]+    ]+++-- | Generate a per-field "after" loop that predicts the next field.+genAfterLoop :: MessageDef -> [FieldInfo] -> [Text] -> Int -> Int -> Doc ann+genAfterLoop msg fields allAccs nFields currentIdx =+  let nextIdx = (currentIdx + 1) `mod` nFields+      nextField = fields !! nextIdx+      nextFn = T.pack (show (fiFieldNum nextField))+      afterName = afterLoopName nextIdx nFields+  in vsep+       [ txt (afterLoopNameForCurrent currentIdx) <+> hsep (fmap (pretty . fieldAccum) fields) <+> txt "= do"+       , indent 2 $+           vsep+             [ txt "mTag <- getTagOrU"+             , txt "case mTag of"+             , indent 2 $+                 vsep+                   [ txt "UNothing -> pure" <+> genRecordCon msg fields+                   , txt "UJust (Tag fn wt)"+                   , indent 2 $+                       vsep+                         [ txt "| fn ==" <+> pretty nextFn <+> txt "-> do"+                         , indent 4 $ genFieldDecodeScheduled allAccs nextField afterName nFields+                         , txt "| otherwise -> case fn of"+                         , indent 4 $+                             vsep+                               ( fmap (genFieldCaseScheduled allAccs nFields) fields+                                   <> [genDefaultCase allAccs "loop_dispatch"]+                               )+                         ]+                   ]+             ]+       ]+++afterLoopNameForCurrent :: Int -> Text+afterLoopNameForCurrent idx = "loop_after_" <> T.pack (show idx)+++afterLoopName :: Int -> Int -> Text+afterLoopName idx _nFields = "loop_after_" <> T.pack (show idx)+++genFieldCaseSimple :: [Text] -> Text -> FieldInfo -> Doc ann+genFieldCaseSimple allAccs loopName fi =+  let fn = T.pack (show (fiFieldNum fi))+  in pretty fn+       <+> txt "-> do"+       <> line+       <> indent 2 (genFieldDecodeSimple allAccs fi loopName)+++genFieldDecodeSimple :: [Text] -> FieldInfo -> Text -> Doc ann+genFieldDecodeSimple allAccs fi loopName =+  let idx = fiIndex fi+      newAccs = case fiLabel fi of+        Just Repeated -> replaceAt idx ("(" <> fieldAccum fi <> " <> V.singleton v)") allAccs+        _ -> replaceAt idx "v" allAccs+  in vsep+       [ txt "v <- " <> pretty (decoderExpr (fiType fi))+       , pretty loopName <+> hsep (fmap pretty newAccs)+       ]+++genFieldCaseScheduled :: [Text] -> Int -> FieldInfo -> Doc ann+genFieldCaseScheduled allAccs nFields fi =+  let fn = T.pack (show (fiFieldNum fi))+      after = afterLoopName (fiIndex fi) nFields+  in pretty fn+       <+> txt "-> do"+       <> line+       <> indent 2 (genFieldDecodeScheduled allAccs fi after nFields)+++genFieldDecodeScheduled :: [Text] -> FieldInfo -> Text -> Int -> Doc ann+genFieldDecodeScheduled allAccs fi loopName _nFields =+  let idx = fiIndex fi+      newAccs = case fiLabel fi of+        Just Repeated -> replaceAt idx ("(" <> fieldAccum fi <> " <> V.singleton v)") allAccs+        _ -> replaceAt idx "v" allAccs+  in vsep+       [ txt "v <- " <> pretty (decoderExpr (fiType fi))+       , pretty loopName <+> hsep (fmap pretty newAccs)+       ]+++genDefaultCase :: [Text] -> Text -> Doc ann+genDefaultCase allAccs loopName =+  txt "_ -> skipField wt >> " <> pretty loopName <+> hsep (fmap pretty allAccs)+++genRecordCon :: MessageDef -> [FieldInfo] -> Doc ann+genRecordCon msg fields = case fields of+  [] -> pretty (hsTypeName (msgName msg)) <+> txt "{ }"+  _ ->+    parens $+      pretty (hsTypeName (msgName msg))+        <+> braces (hsep (punctuate comma (fmap genAssign fields)))+  where+    genAssign fi =+      pretty (hsFieldName (fiName fi)) <+> txt "=" <+> pretty (fieldAccum fi)+++fieldAccum :: FieldInfo -> Text+fieldAccum fi = "acc_" <> T.pack (show (fiIndex fi))+++fieldDefault :: FieldInfo -> Text+fieldDefault fi = case fiLabel fi of+  Just Repeated -> case fiType fi of+    FTScalar s | isUnboxable s -> "VU.empty"+    _ -> "V.empty"+  Just Optional -> "Nothing"+  _ -> case fiType fi of+    FTScalar SBool -> "False"+    FTScalar SString -> "\"\""+    FTScalar SBytes -> "\"\""+    FTScalar _ -> "0"+    FTNamed _ -> "Nothing"+++isUnboxable :: ScalarType -> Bool+isUnboxable = \case+  SString -> False+  SBytes -> False+  _ -> True+++decoderExpr :: FieldType -> Text+decoderExpr = \case+  FTScalar SDouble -> "decodeFieldDouble"+  FTScalar SFloat -> "decodeFieldFloat"+  FTScalar SInt32 -> "fromIntegral <$> decodeFieldVarint"+  FTScalar SInt64 -> "fromIntegral <$> decodeFieldVarint"+  FTScalar SUInt32 -> "fromIntegral <$> decodeFieldVarint"+  FTScalar SUInt64 -> "decodeFieldVarint"+  FTScalar SSInt32 -> "decodeFieldSVarint32"+  FTScalar SSInt64 -> "decodeFieldSVarint64"+  FTScalar SFixed32 -> "decodeFieldFixed32"+  FTScalar SFixed64 -> "decodeFieldFixed64"+  FTScalar SSFixed32 -> "fromIntegral <$> decodeFieldFixed32"+  FTScalar SSFixed64 -> "fromIntegral <$> decodeFieldFixed64"+  FTScalar SBool -> "decodeFieldBool"+  FTScalar SString -> "decodeFieldString"+  FTScalar SBytes -> "decodeFieldBytes"+  FTNamed _ -> "decodeFieldMessage"+++data FieldInfo = FieldInfo+  { fiName :: Text+  , fiFieldNum :: Int+  , fiLabel :: Maybe FieldLabel+  , fiType :: FieldType+  , fiIndex :: Int+  }+++extractFields :: [MessageElement] -> [FieldInfo]+extractFields elems =+  zipWith (\i fi -> fi {fiIndex = i}) [0 ..] (concatMap go elems)+  where+    go = \case+      MEField fd ->+        [ FieldInfo+            { fiName = fieldName fd+            , fiFieldNum = unFieldNumber (fieldNumber fd)+            , fiLabel = fieldLabel fd+            , fiType = fieldType fd+            , fiIndex = 0+            }+        ]+      _ -> []+++replaceAt :: Int -> a -> [a] -> [a]+replaceAt _ _ [] = []+replaceAt 0 x (_ : ys) = x : ys+replaceAt n x (y : ys) = y : replaceAt (n - 1) x ys
+ src/Proto/CodeGen/Encode.hs view
@@ -0,0 +1,202 @@+{- | Code generation for message encoding functions.++Generates specialized 'buildMessage' implementations using the archetype+encode functions from 'Proto.Internal.Encode.Archetype', with tag bytes pre-computed+at code generation time as compile-time constants.++* First pass: compute exact wire size via 'messageSize'+* Second pass: serialize via 'buildMessage' using pre-known sizes+* Skip default-valued fields (proto3 semantics)+* Packed encoding for repeated scalar fields+* Minimize allocations: no intermediate ByteString for submessages+-}+module Proto.CodeGen.Encode (+  genEncodeInstance,+  genSizeInstance,+) where++import Data.Text (Text)+import Data.Text qualified as T+import Prettyprinter+import Proto.CodeGen.Types (hsFieldName, hsTypeName)+import Proto.IDL.AST+import Proto.Internal.CodeGen.Combinators (txt)+++wireVarint, wire64Bit, wireLengthDelimited, wire32Bit :: Int+wireVarint = 0+wire64Bit = 1+wireLengthDelimited = 2+wire32Bit = 5+++computeTagByte :: Int -> Int -> Int+computeTagByte fieldNum wireType = fieldNum * 8 + wireType+++-- | Generate a MessageEncode instance for a message.+genEncodeInstance :: MessageDef -> Doc ann+genEncodeInstance msg =+  let fields = extractFields (msgElements msg)+  in vsep+       [ txt "instance MessageEncode" <+> pretty (hsTypeName (msgName msg)) <+> txt "where"+       , indent 2 $+           vsep+             [ txt "buildMessage msg ="+             , indent 2 $ case fields of+                 [] -> txt "mempty"+                 _ -> vsep (fmap (uncurry genFieldBuild) (zip [0 ..] fields))+             ]+       ]+  where+    genFieldBuild :: Int -> FieldInfo -> Doc ann+    genFieldBuild idx fi =+      let op = if idx == 0 then mempty else txt "<> "+          accessor = "msg." <> hsFieldName (fiName fi)+          fieldNum = fiFieldNum fi+      in op <> genBuildExpr fieldNum accessor (fiLabel fi) (fiType fi)+++genBuildExpr :: Int -> Text -> Maybe FieldLabel -> FieldType -> Doc ann+genBuildExpr fieldNum accessor lbl ft = case lbl of+  Just Repeated -> genRepeatedBuild fieldNum accessor ft+  Just Optional -> txt "(maybe mempty (\\v -> " <> genSingleBuild fieldNum "v" ft <> txt ") " <> pretty accessor <> txt ")"+  _ -> genProto3Build fieldNum accessor ft+++genProto3Build :: Int -> Text -> FieldType -> Doc ann+genProto3Build fieldNum accessor ft =+  let cond = defaultCheck accessor ft+  in txt "(if " <> cond <> txt " then mempty else " <> genSingleBuild fieldNum accessor ft <> txt ")"+++genSingleBuild :: Int -> Text -> FieldType -> Doc ann+genSingleBuild fieldNum accessor = \case+  FTScalar SDouble -> txt "archDouble " <> pretty (computeTagByte fieldNum wire64Bit) <+> pretty accessor+  FTScalar SFloat -> txt "archFloat " <> pretty (computeTagByte fieldNum wire32Bit) <+> pretty accessor+  FTScalar SInt32 -> txt "archVarint " <> pretty (computeTagByte fieldNum wireVarint) <+> txt "(fromIntegral " <> pretty accessor <> txt ")"+  FTScalar SInt64 -> txt "archVarint " <> pretty (computeTagByte fieldNum wireVarint) <+> txt "(fromIntegral " <> pretty accessor <> txt ")"+  FTScalar SUInt32 -> txt "archVarint " <> pretty (computeTagByte fieldNum wireVarint) <+> txt "(fromIntegral " <> pretty accessor <> txt ")"+  FTScalar SUInt64 -> txt "archVarint " <> pretty (computeTagByte fieldNum wireVarint) <+> pretty accessor+  FTScalar SSInt32 -> txt "archSVarint32 " <> pretty (computeTagByte fieldNum wireVarint) <+> pretty accessor+  FTScalar SSInt64 -> txt "archSVarint64 " <> pretty (computeTagByte fieldNum wireVarint) <+> pretty accessor+  FTScalar SFixed32 -> txt "archFixed32 " <> pretty (computeTagByte fieldNum wire32Bit) <+> pretty accessor+  FTScalar SFixed64 -> txt "archFixed64 " <> pretty (computeTagByte fieldNum wire64Bit) <+> pretty accessor+  FTScalar SSFixed32 -> txt "archFixed32 " <> pretty (computeTagByte fieldNum wire32Bit) <+> txt "(fromIntegral " <> pretty accessor <> txt ")"+  FTScalar SSFixed64 -> txt "archFixed64 " <> pretty (computeTagByte fieldNum wire64Bit) <+> txt "(fromIntegral " <> pretty accessor <> txt ")"+  FTScalar SBool -> txt "archBool " <> pretty (computeTagByte fieldNum wireVarint) <+> pretty accessor+  FTScalar SString -> txt "archString " <> pretty (computeTagByte fieldNum wireLengthDelimited) <+> pretty accessor+  FTScalar SBytes -> txt "archBytes " <> pretty (computeTagByte fieldNum wireLengthDelimited) <+> pretty accessor+  FTNamed _ -> txt "(let sz = messageSize " <> pretty accessor <> txt " in archSubmessage " <> pretty (computeTagByte fieldNum wireLengthDelimited) <+> txt "sz (buildMessage " <> pretty accessor <> txt "))"+++genRepeatedBuild :: Int -> Text -> FieldType -> Doc ann+genRepeatedBuild fieldNum accessor = \case+  FTScalar SString ->+    txt "V.foldl' (\\acc v -> acc <> archString " <> pretty (computeTagByte fieldNum wireLengthDelimited) <+> txt "v) mempty " <> pretty accessor+  FTScalar SBytes ->+    txt "V.foldl' (\\acc v -> acc <> archBytes " <> pretty (computeTagByte fieldNum wireLengthDelimited) <+> txt "v) mempty " <> pretty accessor+  FTScalar s ->+    txt "encode" <> pretty (packedFnName s) <+> pretty (T.pack (show fieldNum)) <+> pretty accessor+  FTNamed _ ->+    txt "V.foldl' (\\acc v -> let sz = messageSize v in acc <> archSubmessage " <> pretty (computeTagByte fieldNum wireLengthDelimited) <+> txt "sz (buildMessage v)) mempty " <> pretty accessor+++defaultCheck :: Text -> FieldType -> Doc ann+defaultCheck accessor = \case+  FTScalar SBool -> pretty accessor <+> txt "== False"+  FTScalar SString -> pretty accessor <+> pretty ("== \"\"" :: Text)+  FTScalar SBytes -> txt "BS.null " <> pretty accessor+  FTScalar _ -> pretty accessor <+> txt "== 0"+  FTNamed _ -> pretty accessor <+> txt "== Nothing"+++-- | Generate a MessageSize instance.+genSizeInstance :: MessageDef -> Doc ann+genSizeInstance msg =+  let fields = extractFields (msgElements msg)+  in vsep+       [ txt "instance MessageSize" <+> pretty (hsTypeName (msgName msg)) <+> txt "where"+       , indent 2 $+           vsep+             [ txt "messageSize msg ="+             , indent 2 $ case fields of+                 [] -> txt "0"+                 _ -> vsep (fmap (uncurry genFieldSize) (zip [0 ..] fields))+             ]+       ]+  where+    genFieldSize :: Int -> FieldInfo -> Doc ann+    genFieldSize idx fi =+      let op = if idx == 0 then mempty else txt "+ "+          accessor = "msg." <> hsFieldName (fiName fi)+          fieldNum = fiFieldNum fi+      in op <> genSizeExpr fieldNum accessor (fiLabel fi) (fiType fi)+++genSizeExpr :: Int -> Text -> Maybe FieldLabel -> FieldType -> Doc ann+genSizeExpr fieldNum accessor lbl ft = case lbl of+  Just Repeated -> txt "(sizeRepeated " <> pretty (T.pack (show fieldNum)) <+> pretty accessor <> txt ")"+  Just Optional -> txt "(maybe 0 (\\v -> " <> genSingleSize "v" ft <> txt ") " <> pretty accessor <> txt ")"+  _ -> txt "(if " <> defaultCheck accessor ft <> txt " then 0 else " <> genSingleSize accessor ft <> txt ")"+++genSingleSize :: Text -> FieldType -> Doc ann+genSingleSize accessor = \case+  FTScalar SDouble -> txt "archFixed64Size"+  FTScalar SFloat -> txt "archFixed32Size"+  FTScalar SFixed32 -> txt "archFixed32Size"+  FTScalar SFixed64 -> txt "archFixed64Size"+  FTScalar SSFixed32 -> txt "archFixed32Size"+  FTScalar SSFixed64 -> txt "archFixed64Size"+  FTScalar SBool -> txt "archBoolSize"+  FTScalar SInt32 -> txt "archVarintSize (fromIntegral " <> pretty accessor <> txt ")"+  FTScalar SInt64 -> txt "archVarintSize (fromIntegral " <> pretty accessor <> txt ")"+  FTScalar SUInt32 -> txt "archVarintSize (fromIntegral " <> pretty accessor <> txt ")"+  FTScalar SUInt64 -> txt "archVarintSize " <> pretty accessor+  FTScalar SSInt32 -> txt "(1 + varintSize (fromIntegral (zigZag32 " <> pretty accessor <> txt ")))"+  FTScalar SSInt64 -> txt "(1 + varintSize (zigZag64 " <> pretty accessor <> txt "))"+  FTScalar SString -> txt "archStringSize " <> pretty accessor+  FTScalar SBytes -> txt "archBytesSize " <> pretty accessor+  FTNamed _ -> txt "archSubmessageSize (messageSize " <> pretty accessor <> txt ")"+++packedFnName :: ScalarType -> Text+packedFnName = \case+  SDouble -> "PackedDouble"+  SFloat -> "PackedFloat"+  SInt32 -> "PackedVarint"+  SInt64 -> "PackedVarint"+  SUInt32 -> "PackedVarint"+  SUInt64 -> "PackedVarint"+  SSInt32 -> "PackedSVarint32"+  SSInt64 -> "PackedSVarint64"+  SFixed32 -> "PackedFixed32"+  SFixed64 -> "PackedFixed64"+  SSFixed32 -> "PackedFixed32"+  SSFixed64 -> "PackedFixed64"+  SBool -> "PackedVarint"+  s -> error ("Cannot pack: " <> show s)+++data FieldInfo = FieldInfo+  { fiName :: Text+  , fiFieldNum :: Int+  , fiLabel :: Maybe FieldLabel+  , fiType :: FieldType+  }+++extractFields :: [MessageElement] -> [FieldInfo]+extractFields = concatMap go+  where+    go = \case+      MEField fd ->+        [ FieldInfo+            { fiName = fieldName fd+            , fiFieldNum = unFieldNumber (fieldNumber fd)+            , fiLabel = fieldLabel fd+            , fiType = fieldType fd+            }+        ]+      _ -> []
src/Proto/CodeGen/Hooks.hs view
@@ -183,8 +183,9 @@   , fhcModuleName :: !Text   , fhcFileOptions :: ![OptionDef]   , fhcCustomOptions :: !CustomOptionRegistry-  -- ^ Registry of custom option extensions extracted from-  -- @extend google.protobuf.FieldOptions@ blocks in this file.+  {- ^ Registry of custom option extensions extracted from+  @extend google.protobuf.FieldOptions@ blocks in this file.+  -}   }   deriving stock (Show)
src/Proto/CodeGen/Service.hs view
@@ -61,16 +61,17 @@ genServiceModule pkg prefix svc =   let modName = prefix <> "." <> hsModuleName' (fromMaybe "" pkg) <> "." <> hsTypeName' (svcName svc)   in vsep-      [ txt "{-# LANGUAGE OverloadedStrings #-}"-      , txt "-- | Generated gRPC service interface for " <> pretty (svcName svc)-      , txt "module " <> pretty modName <> txt " where"-      , mempty-      , txt "import Data.ByteString (ByteString)"-      , txt "import Data.Text (Text)"-      , txt "import Proto (MessageEncode, MessageDecode, encodeMessage, decodeMessage)"-      , mempty-      , vsep (genServiceDecls pkg [] svc)-      ]+       [ txt "{-# LANGUAGE OverloadedStrings #-}"+       , txt "-- | Generated gRPC service interface for " <> pretty (svcName svc)+       , txt "module " <> pretty modName <> txt " where"+       , mempty+       , txt "import Data.ByteString (ByteString)"+       , txt "import Data.Text (Text)"+       , txt "import Proto.Encode (MessageEncode, encodeMessage)"+       , txt "import Proto.Decode (MessageDecode, decodeMessage)"+       , mempty+       , vsep (genServiceDecls pkg [] svc)+       ]   genServiceDoc :: Maybe Text -> ServiceDef -> Doc ann@@ -81,34 +82,34 @@         Just doc ->           let ls = T.lines doc           in case ls of-              [] -> []-              (first_ : rest) ->-                [txt "-- | " <> pretty first_]-                  <> fmap (\l -> txt "-- " <> pretty l) rest-                  <> [txt "--"]+               [] -> []+               (first_ : rest) ->+                 [txt "-- | " <> pretty first_]+                   <> fmap (\l -> txt "-- " <> pretty l) rest+                   <> [txt "--"]       header = case protoDoc of         [] -> [txt "-- | gRPC service @" <> pretty qualified <> txt "@."]         _ -> protoDoc <> [txt "-- gRPC service @" <> pretty qualified <> txt "@."]   in vsep $-      header-        <> [ txt "--"-           , txt "-- Methods:"-           , vsep-              ( fmap-                  ( \r ->-                      txt "-- * "-                        <> pretty (rpcName r)-                        <> txt " ("-                        <> streamLabel (rpcInputStr r)-                        <> pretty (rpcInput r)-                        <> txt " -> "-                        <> streamLabel (rpcOutputStr r)-                        <> pretty (rpcOutput r)-                        <> txt ")"-                  )-                  (svcRpcs svc)-              )-           ]+       header+         <> [ txt "--"+            , txt "-- Methods:"+            , vsep+                ( fmap+                    ( \r ->+                        txt "-- * "+                          <> pretty (rpcName r)+                          <> txt " ("+                          <> streamLabel (rpcInputStr r)+                          <> pretty (rpcInput r)+                          <> txt " -> "+                          <> streamLabel (rpcOutputStr r)+                          <> pretty (rpcOutput r)+                          <> txt ")"+                    )+                    (svcRpcs svc)+                )+            ]   streamLabel :: StreamQualifier -> Doc ann@@ -121,12 +122,12 @@ genServerType scope svc =   let tyN = svcTypeName scope svc <> "Server"   in vsep-      [ txt "-- | Server handler record for @" <> pretty (svcName svc) <> txt "@."-      , txt "-- Each field is a handler function for one RPC method."-      , txt "-- Implement all fields to create a server."-      , txt "data " <> pretty tyN <> txt " m = " <> pretty tyN-      , indent 2 (braceFields (fmap (genServerField scope) (svcRpcs svc)))-      ]+       [ txt "-- | Server handler record for @" <> pretty (svcName svc) <> txt "@."+       , txt "-- Each field is a handler function for one RPC method."+       , txt "-- Implement all fields to create a server."+       , txt "data " <> pretty tyN <> txt " m = " <> pretty tyN+       , indent 2 (braceFields (fmap (genServerField scope) (svcRpcs svc)))+       ]   genServerField :: [Text] -> RpcDef -> Doc ann@@ -134,16 +135,16 @@   let fname = lowerFirst' (snakeToCamel' (rpcName rpc)) <> "Handler"       fieldLine = pretty (escapeReserved' fname) <+> txt "::" <+> genRpcServerType scope rpc   in case rpcDoc rpc of-      Nothing -> fieldLine-      Just doc ->-        let ls = T.lines doc-        in case ls of-            [] -> fieldLine-            (first_ : rest) ->-              vsep $-                [fieldLine]-                  <> [indent 2 (txt "-- ^ " <> pretty first_)]-                  <> fmap (\l -> indent 2 (txt "-- " <> pretty l)) rest+       Nothing -> fieldLine+       Just doc ->+         let ls = T.lines doc+         in case ls of+              [] -> fieldLine+              (first_ : rest) ->+                vsep $+                  [fieldLine]+                    <> [indent 2 (txt "-- ^ " <> pretty first_)]+                    <> fmap (\l -> indent 2 (txt "-- " <> pretty l)) rest   genRpcServerType :: [Text] -> RpcDef -> Doc ann@@ -173,11 +174,11 @@ genClientType scope svc =   let tyN = svcTypeName scope svc <> "Client"   in vsep-      [ txt "-- | Client stub record for @" <> pretty (svcName svc) <> txt "@."-      , txt "-- Each field is a function for calling one RPC method."-      , txt "data " <> pretty tyN <> txt " m = " <> pretty tyN-      , indent 2 (braceFields (fmap (genClientField scope) (svcRpcs svc)))-      ]+       [ txt "-- | Client stub record for @" <> pretty (svcName svc) <> txt "@."+       , txt "-- Each field is a function for calling one RPC method."+       , txt "data " <> pretty tyN <> txt " m = " <> pretty tyN+       , indent 2 (braceFields (fmap (genClientField scope) (svcRpcs svc)))+       ]   genClientField :: [Text] -> RpcDef -> Doc ann@@ -185,16 +186,16 @@   let fname = lowerFirst' (snakeToCamel' (rpcName rpc))       fieldLine = pretty (escapeReserved' fname) <+> txt "::" <+> genRpcClientType scope rpc   in case rpcDoc rpc of-      Nothing -> fieldLine-      Just doc ->-        let ls = T.lines doc-        in case ls of-            [] -> fieldLine-            (first_ : rest) ->-              vsep $-                [fieldLine]-                  <> [indent 2 (txt "-- ^ " <> pretty first_)]-                  <> fmap (\l -> indent 2 (txt "-- " <> pretty l)) rest+       Nothing -> fieldLine+       Just doc ->+         let ls = T.lines doc+         in case ls of+              [] -> fieldLine+              (first_ : rest) ->+                vsep $+                  [fieldLine]+                    <> [indent 2 (txt "-- ^ " <> pretty first_)]+                    <> fmap (\l -> indent 2 (txt "-- " <> pretty l)) rest   genRpcClientType :: [Text] -> RpcDef -> Doc ann@@ -206,35 +207,35 @@ genMethodInfos scope svc =   let tyN = svcTypeName scope svc   in vsep-      [ txt "-- | Method metadata for @" <> pretty (svcName svc) <> txt "@."-      , txt "data " <> pretty tyN <> txt "Method"-      , indent-          2-          ( vsep-              ( zipWith-                  ( \pfx r ->-                      pfx-                        <+> pretty (hsTypeName' (rpcName r) <> "Method")-                  )-                  seps-                  (svcRpcs svc)-              )-          )-      , indent 2 (txt "deriving stock (Show, Eq, Ord, Enum, Bounded)")-      , mempty-      , pretty (T.toLower tyN <> "MethodName :: " :: Text) <> pretty tyN <> txt "Method -> Text"-      , vsep-          ( fmap-              ( \r ->-                  pretty (T.toLower tyN <> "MethodName " :: Text)-                    <> pretty (hsTypeName' (rpcName r) <> "Method" :: Text)-                    <+> pretty ("= \"" :: Text)-                    <> pretty (rpcName r)-                    <> pretty ("\"" :: Text)-              )-              (svcRpcs svc)-          )-      ]+       [ txt "-- | Method metadata for @" <> pretty (svcName svc) <> txt "@."+       , txt "data " <> pretty tyN <> txt "Method"+       , indent+           2+           ( vsep+               ( zipWith+                   ( \pfx r ->+                       pfx+                         <+> pretty (hsTypeName' (rpcName r) <> "Method")+                   )+                   seps+                   (svcRpcs svc)+               )+           )+       , indent 2 (txt "deriving stock (Show, Eq, Ord, Enum, Bounded)")+       , mempty+       , pretty (T.toLower tyN <> "MethodName :: " :: Text) <> pretty tyN <> txt "Method -> Text"+       , vsep+           ( fmap+               ( \r ->+                   pretty (T.toLower tyN <> "MethodName " :: Text)+                     <> pretty (hsTypeName' (rpcName r) <> "Method" :: Text)+                     <+> pretty ("= \"" :: Text)+                     <> pretty (rpcName r)+                     <> pretty ("\"" :: Text)+               )+               (svcRpcs svc)+           )+       ]   where     seps = txt "=" : repeat (txt "|") @@ -245,27 +246,27 @@   let tyN = svcTypeName scope svc       fullName = T.intercalate "." (scope <> [svcName svc])   in vsep-      [ txt "-- | Fully-qualified service name: @" <> pretty fullName <> txt "@"-      , pretty (T.toLower tyN <> "ServiceName :: Text" :: Text)-      , pretty (T.toLower tyN <> "ServiceName = \"" :: Text) <> pretty fullName <> pretty ("\"" :: Text)-      , mempty-      , txt "-- | All method paths for @" <> pretty (svcName svc) <> txt "@."-      , pretty (T.toLower tyN <> "MethodPaths :: [Text]" :: Text)-      , pretty (T.toLower tyN <> "MethodPaths = " :: Text)-          <> pretty (T.pack (show (fmap (\r -> "/" <> fullName <> "/" <> rpcName r) (svcRpcs svc))))-      ]+       [ txt "-- | Fully-qualified service name: @" <> pretty fullName <> txt "@"+       , pretty (T.toLower tyN <> "ServiceName :: Text" :: Text)+       , pretty (T.toLower tyN <> "ServiceName = \"" :: Text) <> pretty fullName <> pretty ("\"" :: Text)+       , mempty+       , txt "-- | All method paths for @" <> pretty (svcName svc) <> txt "@."+       , pretty (T.toLower tyN <> "MethodPaths :: [Text]" :: Text)+       , pretty (T.toLower tyN <> "MethodPaths = " :: Text)+           <> pretty (T.pack (show (fmap (\r -> "/" <> fullName <> "/" <> rpcName r) (svcRpcs svc))))+       ]   genServerTypeQ :: [Text] -> (Text -> Text) -> ServiceDef -> Doc ann genServerTypeQ scope qualify svc =   let tyN = svcTypeName scope svc <> "Server"   in vsep-      [ txt "-- | Server handler record for @" <> pretty (svcName svc) <> txt "@."-      , txt "-- Each field is a handler function for one RPC method."-      , txt "-- Implement all fields to create a server."-      , txt "data " <> pretty tyN <> txt " m = " <> pretty tyN-      , indent 2 (braceFields (fmap (genServerFieldQ scope qualify) (svcRpcs svc)))-      ]+       [ txt "-- | Server handler record for @" <> pretty (svcName svc) <> txt "@."+       , txt "-- Each field is a handler function for one RPC method."+       , txt "-- Implement all fields to create a server."+       , txt "data " <> pretty tyN <> txt " m = " <> pretty tyN+       , indent 2 (braceFields (fmap (genServerFieldQ scope qualify) (svcRpcs svc)))+       ]   genServerFieldQ :: [Text] -> (Text -> Text) -> RpcDef -> Doc ann@@ -273,16 +274,16 @@   let fname = lowerFirst' (snakeToCamel' (rpcName rpc)) <> "Handler"       fieldLine = pretty (escapeReserved' fname) <+> txt "::" <+> genRpcTypeQ qualify rpc   in case rpcDoc rpc of-      Nothing -> fieldLine-      Just doc ->-        let ls = T.lines doc-        in case ls of-            [] -> fieldLine-            (first_ : rest) ->-              vsep $-                [fieldLine]-                  <> [indent 2 (txt "-- ^ " <> pretty first_)]-                  <> fmap (\l -> indent 2 (txt "-- " <> pretty l)) rest+       Nothing -> fieldLine+       Just doc ->+         let ls = T.lines doc+         in case ls of+              [] -> fieldLine+              (first_ : rest) ->+                vsep $+                  [fieldLine]+                    <> [indent 2 (txt "-- ^ " <> pretty first_)]+                    <> fmap (\l -> indent 2 (txt "-- " <> pretty l)) rest   genRpcTypeQ :: (Text -> Text) -> RpcDef -> Doc ann@@ -311,11 +312,11 @@ genClientTypeQ scope qualify svc =   let tyN = svcTypeName scope svc <> "Client"   in vsep-      [ txt "-- | Client stub record for @" <> pretty (svcName svc) <> txt "@."-      , txt "-- Each field is a function for calling one RPC method."-      , txt "data " <> pretty tyN <> txt " m = " <> pretty tyN-      , indent 2 (braceFields (fmap (genClientFieldQ scope qualify) (svcRpcs svc)))-      ]+       [ txt "-- | Client stub record for @" <> pretty (svcName svc) <> txt "@."+       , txt "-- Each field is a function for calling one RPC method."+       , txt "data " <> pretty tyN <> txt " m = " <> pretty tyN+       , indent 2 (braceFields (fmap (genClientFieldQ scope qualify) (svcRpcs svc)))+       ]   genClientFieldQ :: [Text] -> (Text -> Text) -> RpcDef -> Doc ann@@ -323,16 +324,16 @@   let fname = lowerFirst' (snakeToCamel' (rpcName rpc))       fieldLine = pretty (escapeReserved' fname) <+> txt "::" <+> genRpcTypeQ qualify rpc   in case rpcDoc rpc of-      Nothing -> fieldLine-      Just doc ->-        let ls = T.lines doc-        in case ls of-            [] -> fieldLine-            (first_ : rest) ->-              vsep $-                [fieldLine]-                  <> [indent 2 (txt "-- ^ " <> pretty first_)]-                  <> fmap (\l -> indent 2 (txt "-- " <> pretty l)) rest+       Nothing -> fieldLine+       Just doc ->+         let ls = T.lines doc+         in case ls of+              [] -> fieldLine+              (first_ : rest) ->+                vsep $+                  [fieldLine]+                    <> [indent 2 (txt "-- ^ " <> pretty first_)]+                    <> fmap (\l -> indent 2 (txt "-- " <> pretty l)) rest   svcTypeName :: [Text] -> ServiceDef -> Text@@ -365,8 +366,8 @@ snakeToCamel' t =   let parts = T.splitOn (T.singleton '_') t   in case parts of-      [] -> t-      (p : ps) -> T.concat (lowerFirst' p : fmap titleCase ps)+       [] -> t+       (p : ps) -> T.concat (lowerFirst' p : fmap titleCase ps)   lowerFirst' :: Text -> Text
src/Proto/Compat.hs view
@@ -188,26 +188,26 @@       oldMsgs = Map.fromList (fmap (\m -> (msgName m, m)) (allMessages old))   in -- Messages present in old but absent in new      foldMap-      ( \name -> case dir of-          BackwardDir -> mempty-          ForwardDir ->-            makeError-              (dirLabel dir <> ": message '" <> name <> "' was removed")-              name-              Error-              "MESSAGE_REMOVED"-      )-      (Map.keys (Map.difference oldMsgs newMsgs))-      <>-      -- Messages present in both: check field-level compatibility-      Map.foldlWithKey'-        ( \acc name newMsg ->-            case Map.lookup name oldMsgs of-              Nothing -> acc-              Just oldMsg -> acc <> checkMessageCompat dir name newMsg oldMsg-        )-        mempty-        newMsgs+       ( \name -> case dir of+           BackwardDir -> mempty+           ForwardDir ->+             makeError+               (dirLabel dir <> ": message '" <> name <> "' was removed")+               name+               Error+               "MESSAGE_REMOVED"+       )+       (Map.keys (Map.difference oldMsgs newMsgs))+       <>+       -- Messages present in both: check field-level compatibility+       Map.foldlWithKey'+         ( \acc name newMsg ->+             case Map.lookup name oldMsgs of+               Nothing -> acc+               Just oldMsg -> acc <> checkMessageCompat dir name newMsg oldMsg+         )+         mempty+         newMsgs   -- | Check field-level compatibility between two versions of a message definition.@@ -220,89 +220,89 @@       reserved = reservedNumbers newMsg   in -- Fields removed from old      foldMap-      ( \num ->-          let oldFd = oldFields Map.! num-              path = msgPath <> "." <> fieldName oldFd-          in case dir of-              BackwardDir ->-                if num `Set.member` reserved-                  then mempty-                  else-                    makeError+       ( \num ->+           let oldFd = oldFields Map.! num+               path = msgPath <> "." <> fieldName oldFd+           in case dir of+                BackwardDir ->+                  if num `Set.member` reserved+                    then mempty+                    else+                      makeError+                        ( dirLabel dir+                            <> ": field '"+                            <> fieldName oldFd+                            <> "' (number "+                            <> T.pack (show num)+                            <> ") removed without reserving the number"+                        )+                        path+                        Error+                        "FIELD_REMOVED_NOT_RESERVED"+                        <> case fieldLabel oldFd of+                          Just Required ->+                            makeError+                              (dirLabel dir <> ": required field '" <> fieldName oldFd <> "' removed")+                              path+                              Error+                              "REQUIRED_FIELD_REMOVED"+                          _ -> mempty+                ForwardDir -> mempty+       )+       (Set.difference oldNums newNums)+       <>+       -- Fields added in new+       foldMap+         ( \num ->+             let newFd = newFields Map.! num+                 path = msgPath <> "." <> fieldName newFd+             in case dir of+                  BackwardDir -> case fieldLabel newFd of+                    Just Required ->+                      makeError+                        (dirLabel dir <> ": required field '" <> fieldName newFd <> "' added")+                        path+                        Error+                        "REQUIRED_FIELD_ADDED"+                    _ -> mempty+                  ForwardDir -> mempty+         )+         (Set.difference newNums oldNums)+       <>+       -- Fields present in both: check type compatibility+       Map.foldlWithKey'+         ( \acc num newFd ->+             case Map.lookup num oldFields of+               Nothing -> acc+               Just oldFd -> acc <> checkFieldCompat dir msgPath newFd oldFd+         )+         mempty+         newFields+       <>+       -- Number reuse check: field numbers in new that were in old but deleted+       -- and then re-added with a different name+       foldMap+         ( \num ->+             let newFd = newFields Map.! num+                 oldFd = oldFields Map.! num+                 path = msgPath <> "." <> fieldName newFd+             in if fieldName newFd /= fieldName oldFd && not (num `Set.member` reserved)+                  then+                    makeWarning                       ( dirLabel dir-                          <> ": field '"-                          <> fieldName oldFd-                          <> "' (number "+                          <> ": field number "                           <> T.pack (show num)-                          <> ") removed without reserving the number"+                          <> " changed name from '"+                          <> fieldName oldFd+                          <> "' to '"+                          <> fieldName newFd+                          <> "'"                       )                       path-                      Error-                      "FIELD_REMOVED_NOT_RESERVED"-                      <> case fieldLabel oldFd of-                        Just Required ->-                          makeError-                            (dirLabel dir <> ": required field '" <> fieldName oldFd <> "' removed")-                            path-                            Error-                            "REQUIRED_FIELD_REMOVED"-                        _ -> mempty-              ForwardDir -> mempty-      )-      (Set.difference oldNums newNums)-      <>-      -- Fields added in new-      foldMap-        ( \num ->-            let newFd = newFields Map.! num-                path = msgPath <> "." <> fieldName newFd-            in case dir of-                BackwardDir -> case fieldLabel newFd of-                  Just Required ->-                    makeError-                      (dirLabel dir <> ": required field '" <> fieldName newFd <> "' added")-                      path-                      Error-                      "REQUIRED_FIELD_ADDED"-                  _ -> mempty-                ForwardDir -> mempty-        )-        (Set.difference newNums oldNums)-      <>-      -- Fields present in both: check type compatibility-      Map.foldlWithKey'-        ( \acc num newFd ->-            case Map.lookup num oldFields of-              Nothing -> acc-              Just oldFd -> acc <> checkFieldCompat dir msgPath newFd oldFd-        )-        mempty-        newFields-      <>-      -- Number reuse check: field numbers in new that were in old but deleted-      -- and then re-added with a different name-      foldMap-        ( \num ->-            let newFd = newFields Map.! num-                oldFd = oldFields Map.! num-                path = msgPath <> "." <> fieldName newFd-            in if fieldName newFd /= fieldName oldFd && not (num `Set.member` reserved)-                then-                  makeWarning-                    ( dirLabel dir-                        <> ": field number "-                        <> T.pack (show num)-                        <> " changed name from '"-                        <> fieldName oldFd-                        <> "' to '"-                        <> fieldName newFd-                        <> "'"-                    )-                    path-                    "FIELD_NAME_CHANGED"-                else mempty-        )-        (Set.intersection newNums oldNums)+                      "FIELD_NAME_CHANGED"+                  else mempty+         )+         (Set.intersection newNums oldNums)   -- | Check compatibility of a single field.@@ -311,74 +311,74 @@   let path = msgPath <> "." <> fieldName newFd   in -- Type change      ( if fieldType newFd /= fieldType oldFd-        then-          if wireCompatible (fieldType newFd) (fieldType oldFd)-            then-              makeWarning-                ( dirLabel dir-                    <> ": field '"-                    <> fieldName newFd-                    <> "' type changed from "-                    <> showFieldType (fieldType oldFd)-                    <> " to "-                    <> showFieldType (fieldType newFd)-                    <> " (wire-compatible)"-                )-                path-                "FIELD_TYPE_CHANGED_COMPATIBLE"-            else-              makeError-                ( dirLabel dir-                    <> ": field '"-                    <> fieldName newFd-                    <> "' type changed from "-                    <> showFieldType (fieldType oldFd)-                    <> " to "-                    <> showFieldType (fieldType newFd)-                    <> " (wire-INCOMPATIBLE)"-                )-                path-                Error-                "FIELD_TYPE_CHANGED_INCOMPATIBLE"-        else mempty+         then+           if wireCompatible (fieldType newFd) (fieldType oldFd)+             then+               makeWarning+                 ( dirLabel dir+                     <> ": field '"+                     <> fieldName newFd+                     <> "' type changed from "+                     <> showFieldType (fieldType oldFd)+                     <> " to "+                     <> showFieldType (fieldType newFd)+                     <> " (wire-compatible)"+                 )+                 path+                 "FIELD_TYPE_CHANGED_COMPATIBLE"+             else+               makeError+                 ( dirLabel dir+                     <> ": field '"+                     <> fieldName newFd+                     <> "' type changed from "+                     <> showFieldType (fieldType oldFd)+                     <> " to "+                     <> showFieldType (fieldType newFd)+                     <> " (wire-INCOMPATIBLE)"+                 )+                 path+                 Error+                 "FIELD_TYPE_CHANGED_INCOMPATIBLE"+         else mempty      )-      <>-      -- Label change (required -> optional is OK for backward, not for forward)-      ( case (fieldLabel oldFd, fieldLabel newFd) of-          (Just Required, Just Optional) -> case dir of-            BackwardDir -> mempty-            ForwardDir ->-              makeError-                ( dirLabel dir-                    <> ": field '"-                    <> fieldName newFd-                    <> "' changed from required to optional"-                )-                path-                Error-                "REQUIRED_TO_OPTIONAL"-          (Just Optional, Just Required) ->-            makeError-              ( dirLabel dir-                  <> ": field '"-                  <> fieldName newFd-                  <> "' changed from optional to required"-              )-              path-              Error-              "OPTIONAL_TO_REQUIRED"-          (Nothing, Just Required) ->-            makeError-              ( dirLabel dir-                  <> ": field '"-                  <> fieldName newFd-                  <> "' changed to required"-              )-              path-              Error-              "BECAME_REQUIRED"-          _ -> mempty-      )+       <>+       -- Label change (required -> optional is OK for backward, not for forward)+       ( case (fieldLabel oldFd, fieldLabel newFd) of+           (Just Required, Just Optional) -> case dir of+             BackwardDir -> mempty+             ForwardDir ->+               makeError+                 ( dirLabel dir+                     <> ": field '"+                     <> fieldName newFd+                     <> "' changed from required to optional"+                 )+                 path+                 Error+                 "REQUIRED_TO_OPTIONAL"+           (Just Optional, Just Required) ->+             makeError+               ( dirLabel dir+                   <> ": field '"+                   <> fieldName newFd+                   <> "' changed from optional to required"+               )+               path+               Error+               "OPTIONAL_TO_REQUIRED"+           (Nothing, Just Required) ->+             makeError+               ( dirLabel dir+                   <> ": field '"+                   <> fieldName newFd+                   <> "' changed to required"+               )+               path+               Error+               "BECAME_REQUIRED"+           _ -> mempty+       )   -- Enum-level checks@@ -388,13 +388,13 @@   let newEnums = Map.fromList (fmap (\e -> (enumName e, e)) (allEnums new))       oldEnums = Map.fromList (fmap (\e -> (enumName e, e)) (allEnums old))   in Map.foldlWithKey'-      ( \acc name newEnum ->-          case Map.lookup name oldEnums of-            Nothing -> acc-            Just oldEnum -> acc <> checkEnumCompat dir name newEnum oldEnum-      )-      mempty-      newEnums+       ( \acc name newEnum ->+           case Map.lookup name oldEnums of+             Nothing -> acc+             Just oldEnum -> acc <> checkEnumCompat dir name newEnum oldEnum+       )+       mempty+       newEnums   -- | Check compatibility of an enum definition.@@ -406,71 +406,71 @@       oldNums = Map.keysSet oldVals   in -- Values removed      foldMap-      ( \num ->-          let name = oldVals Map.! num-              path = enumPath <> "." <> name-          in case dir of-              BackwardDir ->-                makeError-                  ( dirLabel dir-                      <> ": enum value '"-                      <> name-                      <> "' (number "-                      <> T.pack (show num)-                      <> ") removed"-                  )-                  path-                  Error-                  "ENUM_VALUE_REMOVED"-              ForwardDir -> mempty-      )-      (Set.difference oldNums newNums)-      <>-      -- Values added-      foldMap-        ( \num ->-            let name = newVals Map.! num-                path = enumPath <> "." <> name-            in case dir of-                ForwardDir ->-                  makeWarning+       ( \num ->+           let name = oldVals Map.! num+               path = enumPath <> "." <> name+           in case dir of+                BackwardDir ->+                  makeError                     ( dirLabel dir                         <> ": enum value '"                         <> name                         <> "' (number "                         <> T.pack (show num)-                        <> ") added; "-                        <> "old readers will see the numeric value"-                    )-                    path-                    "ENUM_VALUE_ADDED"-                BackwardDir -> mempty-        )-        (Set.difference newNums oldNums)-      <>-      -- Values renamed (same number, different name) — problematic for JSON encoding-      foldMap-        ( \num ->-            let newName = newVals Map.! num-                oldName = oldVals Map.! num-                path = enumPath <> "." <> newName-            in if newName /= oldName-                then-                  makeWarning-                    ( dirLabel dir-                        <> ": enum value at number "-                        <> T.pack (show num)-                        <> " renamed from '"-                        <> oldName-                        <> "' to '"-                        <> newName-                        <> "' (breaks JSON compatibility)"+                        <> ") removed"                     )                     path-                    "ENUM_VALUE_RENAMED"-                else mempty-        )-        (Set.intersection newNums oldNums)+                    Error+                    "ENUM_VALUE_REMOVED"+                ForwardDir -> mempty+       )+       (Set.difference oldNums newNums)+       <>+       -- Values added+       foldMap+         ( \num ->+             let name = newVals Map.! num+                 path = enumPath <> "." <> name+             in case dir of+                  ForwardDir ->+                    makeWarning+                      ( dirLabel dir+                          <> ": enum value '"+                          <> name+                          <> "' (number "+                          <> T.pack (show num)+                          <> ") added; "+                          <> "old readers will see the numeric value"+                      )+                      path+                      "ENUM_VALUE_ADDED"+                  BackwardDir -> mempty+         )+         (Set.difference newNums oldNums)+       <>+       -- Values renamed (same number, different name) — problematic for JSON encoding+       foldMap+         ( \num ->+             let newName = newVals Map.! num+                 oldName = oldVals Map.! num+                 path = enumPath <> "." <> newName+             in if newName /= oldName+                  then+                    makeWarning+                      ( dirLabel dir+                          <> ": enum value at number "+                          <> T.pack (show num)+                          <> " renamed from '"+                          <> oldName+                          <> "' to '"+                          <> newName+                          <> "' (breaks JSON compatibility)"+                      )+                      path+                      "ENUM_VALUE_RENAMED"+                  else mempty+         )+         (Set.intersection newNums oldNums)   -- Wire compatibility: two types are wire-compatible if they use the same
src/Proto/Conformance.hs view
@@ -21,6 +21,7 @@    -- * Conformance runner   conformanceMain,+  handleConformanceRequest, ) where  import Control.DeepSeq (NFData)@@ -31,8 +32,8 @@ import Data.Text (Text) import Data.Word (Word32) import GHC.Generics (Generic)-import Proto.Internal.Decode-import Proto.Internal.Encode+import Proto.Decode+import Proto.Encode import Proto.Internal.Wire (Tag (..)) import System.IO (BufferMode (..), hFlush, hSetBinaryMode, hSetBuffering, isEOF, stdin, stdout) @@ -56,13 +57,13 @@   instance MessageEncode ConformanceRequest where-  buildSized cr =-    (if BS.null (crPayload cr) then mempty else fieldBytes 1 (crPayload cr))+  buildMessage cr =+    (if BS.null (crPayload cr) then mempty else encodeFieldBytes 1 (crPayload cr))       <> ( if crRequestedOutputFormat cr == 0-            then mempty-            else fieldVarint 3 (fromIntegral (crRequestedOutputFormat cr))+             then mempty+             else encodeFieldVarint 3 (fromIntegral (crRequestedOutputFormat cr))          )-      <> (if crMessageType cr == "" then mempty else fieldString 4 (crMessageType cr))+      <> (if crMessageType cr == "" then mempty else encodeFieldString 4 (crMessageType cr))   instance MessageDecode ConformanceRequest where@@ -102,13 +103,13 @@   instance MessageEncode ConformanceResponse where-  buildSized (ConformanceResponse r) = case r of-    ParseError t -> fieldString 1 t-    RuntimeError t -> fieldString 2 t-    ProtobufPayload b -> fieldBytes 3 b-    JsonPayload t -> fieldString 4 t-    Skipped t -> fieldString 5 t-    SerializeError t -> fieldString 6 t+  buildMessage (ConformanceResponse r) = case r of+    ParseError t -> encodeFieldString 1 t+    RuntimeError t -> encodeFieldString 2 t+    ProtobufPayload b -> encodeFieldBytes 3 b+    JsonPayload t -> encodeFieldString 4 t+    Skipped t -> encodeFieldString 5 t+    SerializeError t -> encodeFieldString 6 t   instance MessageDecode ConformanceResponse where@@ -186,3 +187,7 @@     ]  +-- | Default handler that does protobuf round-trip.+handleConformanceRequest :: ConformanceRequest -> IO ConformanceResponse+handleConformanceRequest _req =+  pure (ConformanceResponse (Skipped "Not yet implemented"))
+ src/Proto/Decode.hs view
@@ -0,0 +1,643 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}++{- | High-level decoding interface for protobuf messages.++This is the primary module for deserialising protobuf messages from+bytes. Most users only need 'decodeMessage'.++== Quick start++@+import Proto.Decode++case 'decodeMessage' rawBytes of+  Left err -> handleError err   -- 'DecodeError' with details+  Right msg -> use msg+@++== Typeclass approach++Generated message types automatically get a 'MessageDecode' instance+via Template Haskell ('Proto.TH.loadProto'). The instance provides+'messageDecoder', a 'Decoder' action that is run by 'decodeMessage'.++== Error handling++'decodeMessage' returns @'Either' 'DecodeError' a@. 'DecodeError'+covers truncated input, invalid varints, UTF-8 validation failures,+negative length prefixes, and custom errors from generated code.++== Performance characteristics++* __Zero-copy__: @bytes@ and @string@ fields reference slices of the+  input 'Data.ByteString.ByteString' (no allocation for those fields).+* __Lazy submessage decoding__: with 'LazyMessage', submessage bytes+  are captured but not parsed until 'forceLazyMessage' is called.+* __Packed repeated fields__: adaptive multi-strategy decode with+  SWAR pre-counting for exact vector pre-allocation.+* __Unknown field preservation__: unrecognised fields are captured as+  'UnknownField' values for round-trip fidelity.+-}+module Proto.Decode (+  -- * Decoding typeclass+  MessageDecode (..),++  -- * Running decoders+  decodeMessage,++  -- * Field decoding helpers+  decodeFieldVarint,+  decodeFieldSVarint32,+  decodeFieldSVarint64,+  decodeFieldFixed32,+  decodeFieldFixed64,+  decodeFieldFloat,+  decodeFieldDouble,+  decodeFieldBool,+  decodeFieldString,+  decodeFieldBytes,+  decodeFieldMessage,+  decodeFieldEnum,++  -- * Packed repeated field decoding+  decodePackedVarint,+  decodePackedFixed32,+  decodePackedFixed64,+  decodePackedFloat,+  decodePackedDouble,+  decodePackedSVarint32,+  decodePackedSVarint64,++  -- * Submessage decoding+  decodeSubmessage,++  -- * Lazy submessage decoding+  LazyMessage (..),+  forceLazyMessage,+  decodeFieldLazyMessage,++  -- * Unknown field preservation+  UnknownField (..),+  captureUnknownField,+  encodeUnknownFields,++  -- * Re-exports for generated code+  Decoder,+  DecodeResult (..),+  DecodeError (..),+  runDecoder,+  getVarint,+  getVarintSigned,+  getTagOr,+  getTag,+  skipField,+  getLengthDelimited,+  getFixed32,+  getFixed64,+  getFloat,+  getDouble,+  getText,+  getSVarint32,+  getSVarint64,++  -- * Map entry decoding+  decodeMapEntry,++  -- * CPS failure+  decodeFail,++  -- * Unknown field sizes+  unknownFieldsSize,++  -- * Unboxed internal types (re-exported for generated code)+  UMaybe (UJust, UNothing),+  umaybe,+  getTagOrU,++  -- * Three-way tag CPS (flattened, zero-allocation decode loop)+  TagResult#,+  withTag,++  -- * Monadic CPS tag dispatch (zero Tag allocation, for generated code)+  withTagM,+  skipWireType,+) where++import Control.DeepSeq (NFData (..))+import Control.Monad qualified+import Control.Monad.ST (runST)+import Data.Bits (shiftL, (.&.), (.|.))+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.ByteString.Internal qualified as BSI+import Data.ByteString.Unsafe qualified as BSU+import Data.Int (Int32, Int64)+import Data.List (foldl')+import Data.Text (Text)+import Data.Vector.Storable qualified as VS+import Data.Vector.Storable.Mutable qualified as VSM+import Data.Vector.Unboxed qualified as VU+import Data.Vector.Unboxed.Mutable qualified as MVU+import Data.Word (Word32, Word64)+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Marshal.Utils (copyBytes)+import Foreign.Ptr (castPtr)+import Foreign.Storable (Storable)+import GHC.Exts (Int (I#))+import GHC.Float (castWord32ToFloat, castWord64ToDouble)+import Proto.Internal.Wire (Tag (..), WireType (..))+import Proto.Internal.Wire.Decode+import Proto.Internal.Wire.Encode (putFixed32, putFixed64, putLengthDelimited, putTag, putVarint, tagSize, varintSize)+import System.IO.Unsafe (unsafeDupablePerformIO)+import Wireform.Builder qualified as B+import Wireform.FFI (countPackedVarints)+++-- | Typeclass for types that can be decoded from protobuf wire format.+class MessageDecode a where+  {- | Decode a message from a ByteString, starting from default field values.+  The decoder should consume all bytes of the submessage.+  -}+  messageDecoder :: Decoder a+++-- | Decode a message from a strict 'ByteString'.+decodeMessage :: MessageDecode a => ByteString -> Either DecodeError a+decodeMessage = runDecoder messageDecoder+{-# INLINE decodeMessage #-}+++-- | Decode a varint value.+decodeFieldVarint :: Decoder Word64+decodeFieldVarint = getVarint+{-# INLINE decodeFieldVarint #-}+++-- | Decode a sint32 value.+decodeFieldSVarint32 :: Decoder Int32+decodeFieldSVarint32 = getSVarint32+{-# INLINE decodeFieldSVarint32 #-}+++-- | Decode a sint64 value.+decodeFieldSVarint64 :: Decoder Int64+decodeFieldSVarint64 = getSVarint64+{-# INLINE decodeFieldSVarint64 #-}+++-- | Decode a fixed32 value.+decodeFieldFixed32 :: Decoder Word32+decodeFieldFixed32 = getFixed32+{-# INLINE decodeFieldFixed32 #-}+++-- | Decode a fixed64 value.+decodeFieldFixed64 :: Decoder Word64+decodeFieldFixed64 = getFixed64+{-# INLINE decodeFieldFixed64 #-}+++-- | Decode a float value.+decodeFieldFloat :: Decoder Float+decodeFieldFloat = getFloat+{-# INLINE decodeFieldFloat #-}+++-- | Decode a double value.+decodeFieldDouble :: Decoder Double+decodeFieldDouble = getDouble+{-# INLINE decodeFieldDouble #-}+++-- | Decode a bool value.+decodeFieldBool :: Decoder Bool+decodeFieldBool = do+  v <- getVarint+  pure (v /= 0)+{-# INLINE decodeFieldBool #-}+++-- | Decode a string value (validated UTF-8, zero-copy).+decodeFieldString :: Decoder Text+decodeFieldString = getText+{-# INLINE decodeFieldString #-}+++-- | Decode a bytes value (zero-copy).+decodeFieldBytes :: Decoder ByteString+decodeFieldBytes = getByteString+{-# INLINE decodeFieldBytes #-}+++{- | Decode a submessage field using a bounded sub-buffer.++Reads the length prefix from the parent buffer, slices the exact+submessage bytes (zero-copy — just ForeignPtr offset adjustment),+then runs the sub-decoder on that slice. The sub-decoder's end-of-input+check naturally enforces the submessage boundary.+-}+decodeFieldMessage :: MessageDecode a => Decoder a+decodeFieldMessage = Decoder $ \bs off ->+  case runDecoder# getVarint bs off of+    (# (# lenW, off' #) | #) ->+      let !len = fromIntegral lenW :: Int+      in if len < 0+           then (# | NegativeLength #)+           else+             if I# off' + len > BS.length bs+               then (# | UnexpectedEnd #)+               else+                 let !subBs = BSU.unsafeTake len (BSU.unsafeDrop (I# off') bs)+                 in case runDecoder# messageDecoder subBs 0# of+                      (# (# a, subOff #) | #)+                        | I# subOff == len ->+                            (# (# a, case I# off' + len of I# r -> r #) | #)+                        | otherwise -> (# | SubMessageError ExtraBytes #)+                      (# | e #) -> (# | SubMessageError e #)+    (# | e #) -> (# | e #)+{-# INLINE decodeFieldMessage #-}+++-- | CPS-compatible failure: calls the error continuation.+decodeFail :: DecodeError -> Decoder a+decodeFail e = Decoder $ \_ _ -> (# | e #)+{-# INLINE decodeFail #-}+++{- | Decode an enum field (as varint, then fromEnum).++Per the proto3 wire spec, enum values are 32-bit on the wire+even though varints can carry larger values: a sender that+writes @kInt64Max@ for an enum field is expected to be parsed+as the int32 truncation of that value (low 32 bits, sign-+extended). We honour that by casting the decoded 'Word64'+through 'Int32' before handing it to 'toEnum', so a generated+enum with @NEG = -1@ correctly reconstitutes from a 10-byte+varint of @0xFF...FF7F@.+-}+decodeFieldEnum :: Enum a => Decoder a+decodeFieldEnum =+  toEnum . fromIntegral . (fromIntegral :: Word64 -> Int32)+    <$> getVarint+{-# INLINE decodeFieldEnum #-}+++-- | Decode a submessage from raw bytes.+decodeSubmessage :: MessageDecode a => ByteString -> Either DecodeError a+decodeSubmessage = runDecoder messageDecoder+{-# INLINE decodeSubmessage #-}+++-- Packed decoders: decode a length-delimited chunk containing multiple values.++-- | Decode packed varint values.+decodePackedVarint :: Decoder (VU.Vector Word64)+decodePackedVarint = do+  bs <- getLengthDelimited+  case decodeAllVarints bs of+    Left e -> decodeFail e+    Right vs -> pure vs+{-# INLINE decodePackedVarint #-}+++{- | Decode all varints from a packed buffer.++Optimizations borrowed from hyperpb (mcyoung.xyz/2025/07/16/hyperpb):++ 1. SWAR pre-count: use the C SWAR routine to count terminator bytes+    in one pass, then allocate the output vector to exact size upfront.+    This avoids grow-and-copy or list-reversal overhead.++ 2. Single-byte zero-copy: when every varint is one byte (values 0-127),+    each byte IS the value. We skip varint parsing entirely and just+    widen bytes to Word64. This is the common case for enum fields,+    small indices, and boolean-like repeated fields.+| Decode all varints from a packed buffer.++Adaptive 3-strategy decode from hyperpb's parsePackedVarint:++ 1. count == byteLength: every varint is 1 byte (values 0-127).+    Zero-copy widening — each byte IS the value.++ 2. count >= byteLength/2: mostly 1-2 byte varints.+    Inline 1-2 byte fast path with fallback for larger varints.+    The 1-2 byte branches are well-predicted because they're common.++ 3. count < byteLength/2: many large varints.+    Call full varint decoder (1-2 byte branches would mispredict often).+-}+decodeAllVarints :: ByteString -> Either DecodeError (VU.Vector Word64)+decodeAllVarints bs+  | BS.null bs = Right VU.empty+  | otherwise =+      let !len = BS.length bs+          !n = countPackedVarints bs+      in if n == len+           -- Strategy 1: all single-byte+           then Right $! VU.generate n (fromIntegral . BSU.unsafeIndex bs)+           else Right $! runST $ do+             mv <- MVU.unsafeNew n+             if n >= len `quot` 2+               -- Strategy 2: mostly small varints, inline 1-2 byte fast path+               then do+                 let go !idx !off+                       | off >= len = pure ()+                       | otherwise =+                           let !b0 = fromIntegral (BSU.unsafeIndex bs off) :: Word64+                           in if b0 < 0x80+                                then do+                                  MVU.unsafeWrite mv idx b0+                                  go (idx + 1) (off + 1)+                                else+                                  Control.Monad.when (off + 1 < len) $+                                    let !b1 = fromIntegral (BSU.unsafeIndex bs (off + 1)) :: Word64+                                    in if b1 < 0x80+                                         then do+                                           MVU.unsafeWrite mv idx ((b0 .&. 0x7F) .|. (b1 `shiftL` 7))+                                           go (idx + 1) (off + 2)+                                         else case runDecoder' getVarint bs off of+                                           DecodeOK v off' -> do+                                             MVU.unsafeWrite mv idx v+                                             go (idx + 1) off'+                                           DecodeFail _ -> pure ()+                 go 0 0+               -- Strategy 3: many large varints, full decoder+               else do+                 let go !idx !off+                       | off >= len = pure ()+                       | otherwise = case runDecoder' getVarint bs off of+                           DecodeOK v off' -> do+                             MVU.unsafeWrite mv idx v+                             go (idx + 1) off'+                           DecodeFail _ -> pure ()+                 go 0 0+             VU.unsafeFreeze mv+++-- | Decode packed fixed32 values.+decodePackedFixed32 :: Decoder (VU.Vector Word32)+decodePackedFixed32 = do+  bs <- getLengthDelimited+  case decodeAllFixed32 bs of+    Left e -> decodeFail e+    Right vs -> pure vs+{-# INLINE decodePackedFixed32 #-}+++{- | Decode packed fixed32 values. Count is known: byteLength / 4.+On little-endian (x86_64, aarch64-LE): single memcpy of the entire packed+buffer into the vector's backing store. The wire bytes are already the+native representation, so no per-element work is needed.+-}+decodeAllFixed32 :: ByteString -> Either DecodeError (VU.Vector Word32)+decodeAllFixed32 bs+  | r /= 0 = Left (CustomError "packed fixed32: byte length not multiple of 4")+  | otherwise = Right $! unsafeBulkCopyToVectorU n 4 bs+  where+    (!n, !r) = BS.length bs `quotRem` 4+++-- | Decode packed fixed64 values. Count is known: byteLength / 8.+decodePackedFixed64 :: Decoder (VU.Vector Word64)+decodePackedFixed64 = do+  bs <- getLengthDelimited+  case decodeAllFixed64 bs of+    Left e -> decodeFail e+    Right vs -> pure vs+{-# INLINE decodePackedFixed64 #-}+++decodeAllFixed64 :: ByteString -> Either DecodeError (VU.Vector Word64)+decodeAllFixed64 bs+  | r /= 0 = Left (CustomError "packed fixed64: byte length not multiple of 8")+  | otherwise = Right $! unsafeBulkCopyToVectorU n 8 bs+  where+    (!n, !r) = BS.length bs `quotRem` 8+++-- | Decode packed float values. Count is known: byteLength / 4.+decodePackedFloat :: Decoder (VU.Vector Float)+decodePackedFloat = do+  bs <- getLengthDelimited+  case decodeAllFloat bs of+    Left e -> decodeFail e+    Right vs -> pure vs+{-# INLINE decodePackedFloat #-}+++decodeAllFloat :: ByteString -> Either DecodeError (VU.Vector Float)+decodeAllFloat bs+  | r /= 0 = Left (CustomError "packed float: byte length not multiple of 4")+  | otherwise = Right $! VU.map castWord32ToFloat (unsafeBulkCopyToVectorU n 4 bs :: VU.Vector Word32)+  where+    (!n, !r) = BS.length bs `quotRem` 4+++-- | Decode packed double values. Count is known: byteLength / 8.+decodePackedDouble :: Decoder (VU.Vector Double)+decodePackedDouble = do+  bs <- getLengthDelimited+  case decodeAllDouble bs of+    Left e -> decodeFail e+    Right vs -> pure vs+{-# INLINE decodePackedDouble #-}+++decodeAllDouble :: ByteString -> Either DecodeError (VU.Vector Double)+decodeAllDouble bs+  | r /= 0 = Left (CustomError "packed double: byte length not multiple of 8")+  | otherwise = Right $! VU.map castWord64ToDouble (unsafeBulkCopyToVectorU n 8 bs :: VU.Vector Word64)+  where+    (!n, !r) = BS.length bs `quotRem` 8+++-- | Bulk-copy a ByteString into a new unboxed vector+unsafeBulkCopyToVectorU+  :: (VU.Unbox a, Storable a)+  => Int+  -> Int+  -> ByteString+  -> VU.Vector a+unsafeBulkCopyToVectorU elemCount elemSize (BSI.BS fp _) =+  let sv = unsafeDupablePerformIO $ do+        mvs <- VSM.unsafeNew elemCount+        VSM.unsafeWith mvs $ \dst ->+          withForeignPtr fp $ \src ->+            copyBytes dst (castPtr src) (elemCount * elemSize)+        VS.unsafeFreeze mvs+  in VU.convert sv+{-# INLINE unsafeBulkCopyToVectorU #-}+++-- | Decode packed sint32 values.+decodePackedSVarint32 :: Decoder (VU.Vector Int32)+decodePackedSVarint32 = do+  bs <- getLengthDelimited+  case decodeAllSVarint32 bs of+    Left e -> decodeFail e+    Right vs -> pure vs+{-# INLINE decodePackedSVarint32 #-}+++decodeAllSVarint32 :: ByteString -> Either DecodeError (VU.Vector Int32)+decodeAllSVarint32 bs+  | BS.null bs = Right VU.empty+  | otherwise =+      let !n = countPackedVarints bs+      in Right $! runST $ do+           mv <- MVU.unsafeNew n+           let len = BS.length bs+               go !idx !off+                 | off >= len = pure ()+                 | otherwise = case runDecoder' getSVarint32 bs off of+                     DecodeOK v off' -> do+                       MVU.unsafeWrite mv idx v+                       go (idx + 1) off'+                     DecodeFail _ -> pure ()+           go 0 0+           VU.unsafeFreeze mv+++-- | Decode packed sint64 values.+decodePackedSVarint64 :: Decoder (VU.Vector Int64)+decodePackedSVarint64 = do+  bs <- getLengthDelimited+  case decodeAllSVarint64 bs of+    Left e -> decodeFail e+    Right vs -> pure vs+{-# INLINE decodePackedSVarint64 #-}+++decodeAllSVarint64 :: ByteString -> Either DecodeError (VU.Vector Int64)+decodeAllSVarint64 bs+  | BS.null bs = Right VU.empty+  | otherwise =+      let !n = countPackedVarints bs+      in Right $! runST $ do+           mv <- MVU.unsafeNew n+           let len = BS.length bs+               go !idx !off+                 | off >= len = pure ()+                 | otherwise = case runDecoder' getSVarint64 bs off of+                     DecodeOK v off' -> do+                       MVU.unsafeWrite mv idx v+                       go (idx + 1) off'+                     DecodeFail _ -> pure ()+           go 0 0+           VU.unsafeFreeze mv+++{- | A lazily-decoded submessage. The raw bytes are captured during the+parent message decode, but the actual submessage parsing is deferred+until 'forceLazyMessage' is called. This is a key performance+optimization from the Buf protobuf performance guide: if the consumer+never accesses a submessage field, the decode cost is zero.+-}+data LazyMessage a = LazyMessage+  { lazyRawBytes :: !ByteString+  -- ^ The raw submessage bytes captured from the parent buffer.+  , lazyCached :: ~(Either DecodeError a)+  -- ^ The lazily-evaluated decode result; not forced until 'forceLazyMessage' is called.+  }+++instance Show a => Show (LazyMessage a) where+  show (LazyMessage bs _) = "LazyMessage (" <> show (BS.length bs) <> " bytes)"+++instance Eq a => Eq (LazyMessage a) where+  a == b = lazyRawBytes a == lazyRawBytes b+++-- | Force a lazy message, decoding the raw bytes.+forceLazyMessage :: LazyMessage a -> Either DecodeError a+forceLazyMessage = lazyCached+{-# INLINE forceLazyMessage #-}+++-- | Decode a submessage field lazily: capture the bytes but defer parsing.+decodeFieldLazyMessage :: MessageDecode a => Decoder (LazyMessage a)+decodeFieldLazyMessage = do+  bs <- getLengthDelimited+  pure+    LazyMessage+      { lazyRawBytes = bs+      , lazyCached = runDecoder messageDecoder bs+      }+{-# INLINE decodeFieldLazyMessage #-}+++{- | An unknown field captured during decoding for round-trip preservation.+Storing unknown fields allows messages to pass through intermediaries+without losing data added by newer protocol versions.+-}+data UnknownField+  = -- | A varint-encoded unknown field (wire type 0).+    UnknownVarint {-# UNPACK #-} !Int {-# UNPACK #-} !Word64+  | -- | A 64-bit fixed-width unknown field (wire type 1).+    UnknownFixed64 {-# UNPACK #-} !Int {-# UNPACK #-} !Word64+  | -- | A 32-bit fixed-width unknown field (wire type 5).+    UnknownFixed32 {-# UNPACK #-} !Int {-# UNPACK #-} !Word32+  | -- | A length-delimited unknown field (wire type 2).+    UnknownLenDelim {-# UNPACK #-} !Int !ByteString+  deriving stock (Show, Eq)+++instance NFData UnknownField where+  rnf (UnknownVarint a b) = rnf a `seq` rnf b+  rnf (UnknownFixed64 a b) = rnf a `seq` rnf b+  rnf (UnknownFixed32 a b) = rnf a `seq` rnf b+  rnf (UnknownLenDelim a b) = rnf a `seq` rnf b+++-- | Capture an unknown field value during decoding.+captureUnknownField :: Int -> WireType -> Decoder UnknownField+captureUnknownField fn = \case+  WireVarint -> UnknownVarint fn <$> getVarint+  Wire64Bit -> UnknownFixed64 fn <$> getFixed64+  Wire32Bit -> UnknownFixed32 fn <$> getFixed32+  WireLengthDelimited -> UnknownLenDelim fn <$> getLengthDelimited+  wt -> skipField wt >> decodeFail (CustomError ("Unsupported unknown wire type: " <> show wt))+++-- | Compute the wire-format size of unknown fields.+unknownFieldsSize :: [UnknownField] -> Int+unknownFieldsSize = foldl' (\acc uf -> acc + unknownFieldSize uf) 0+  where+    unknownFieldSize (UnknownVarint fn val) =+      tagSize fn + varintSize val+    unknownFieldSize (UnknownFixed64 fn _) =+      tagSize fn + 8+    unknownFieldSize (UnknownFixed32 fn _) =+      tagSize fn + 4+    unknownFieldSize (UnknownLenDelim fn val) =+      tagSize fn + varintSize (fromIntegral (BS.length val)) + BS.length val+++-- | Re-encode unknown fields for round-trip preservation.+encodeUnknownFields :: [UnknownField] -> B.Builder+encodeUnknownFields = foldMap encodeOne+  where+    encodeOne (UnknownVarint fn val) =+      putTag fn WireVarint <> putVarint val+    encodeOne (UnknownFixed64 fn val) =+      putTag fn Wire64Bit <> putFixed64 val+    encodeOne (UnknownFixed32 fn val) =+      putTag fn Wire32Bit <> putFixed32 val+    encodeOne (UnknownLenDelim fn val) =+      putTag fn WireLengthDelimited <> putLengthDelimited val+++-- | Decode a map entry (key=field1, value=field2) from a length-delimited chunk.+decodeMapEntry :: Decoder k -> Decoder v -> k -> v -> Decoder (k, v)+decodeMapEntry decK decV = loop+  where+    loop !mk !mv =+      withTagM+        (pure (mk, mv))+        ( \fn wt -> case fn of+            1 -> do kv <- decK; loop kv mv+            2 -> do vv <- decV; loop mk vv+            _ -> skipWireType wt >> loop mk mv+        )
+ src/Proto/Decode/Collect.hs view
@@ -0,0 +1,189 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++{- | Error-/accumulating/ message decoding.++The primary 'Proto.Decode.decodeMessage' is fail-fast: it stops at the first+'DecodeError'. This module adds a diagnostic, schema-driven pass that, like+the validation library, collects /all/ recoverable problems in a message at+once — each with a field path — instead of surfacing only the first.++'decodeCollecting' returns the list of 'DecodeIssue's plus the strictly+decoded value when (and only when) the message is clean. It is built on the+message's 'Proto.Schema.ProtoMessage' field descriptors and a self-contained+wire scanner, so it never touches the hot-path decoder.++What it reports:++  * invalid UTF-8 in @string@ fields (each occurrence, with path/index);+  * structurally malformed (e.g. truncated) sub-messages and map entries;+  * malformed top-level wire data (bad varint, truncation, bad wire type).++Deep semantic checks inside sub-messages require the nested type's schema;+this pass validates each sub-message's framing one level down. Wire-type+mismatches on scalar fields are intentionally not flagged because packed+repeated fields make them ambiguous.+-}+module Proto.Decode.Collect (+  DecodeIssue (..),+  decodeCollecting,+  collectIssues,+) where++import Control.DeepSeq (NFData)+import Data.Bits (shiftL, shiftR, (.&.), (.|.))+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Map.Strict qualified as Map+import Data.Proxy (Proxy (..))+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Data.Word (Word32, Word64)+import GHC.Generics (Generic)+import Proto.Decode (DecodeError (..), MessageDecode, decodeMessage)+import Proto.Schema (+  FieldDescriptor (..),+  FieldLabel' (..),+  FieldTypeDescriptor (..),+  ProtoMessage (..),+  ScalarFieldType (..),+  SomeFieldDescriptor (..),+ )+++{- | A single problem found while decoding, with a dotted/indexed field path+(empty for message-level / framing problems).+-}+data DecodeIssue = DecodeIssue+  { issuePath :: ![Text]+  , issueError :: !DecodeError+  }+  deriving stock (Eq, Show, Generic)+++instance NFData DecodeIssue+++{- | Decode a message, collecting every recoverable problem. The typed value is+@'Just' a@ exactly when the strict decoder also succeeds (i.e. the message is+clean); otherwise it is 'Nothing' and 'fst' enumerates the problems.+-}+decodeCollecting :: forall a. (ProtoMessage a, MessageDecode a) => ByteString -> ([DecodeIssue], Maybe a)+decodeCollecting bytes =+  let issues = collectIssues (Proxy :: Proxy a) bytes+  in case decodeMessage bytes :: Either DecodeError a of+       Right a -> (issues, Just a)+       Left e -> (if null issues then [DecodeIssue [] e] else issues, Nothing)+++-- | Collect issues for a message type's wire bytes using its field schema.+collectIssues :: ProtoMessage a => Proxy a -> ByteString -> [DecodeIssue]+collectIssues proxy bytes =+  let fds = protoFieldDescriptors proxy+      (entries, mErr) = scan bytes+      fieldIssues = checkEntries fds entries+      tailIssue = maybe [] (\e -> [DecodeIssue [] e]) mErr+  in fieldIssues ++ tailIssue+++-- Assign per-field occurrence indices, then check each entry against its+-- descriptor.+checkEntries :: Map.Map Int (SomeFieldDescriptor a) -> [(Int, WV)] -> [DecodeIssue]+checkEntries fds = go Map.empty+  where+    go _ [] = []+    go counts ((fn, wv) : rest) =+      let idx = Map.findWithDefault 0 fn counts+          counts' = Map.insert fn (idx + 1) counts+      in checkOne fds fn idx wv ++ go counts' rest+++checkOne :: Map.Map Int (SomeFieldDescriptor a) -> Int -> Int -> WV -> [DecodeIssue]+checkOne fds fn idx wv = case Map.lookup fn fds of+  Nothing -> [] -- unknown field: allowed, preserved elsewhere+  Just (SomeField fd) ->+    let seg =+          if fdLabel fd == LabelRepeated+            then fdName fd <> "[" <> T.pack (show idx) <> "]"+            else fdName fd+        issue e = [DecodeIssue [seg] e]+    in case fdTypeDesc fd of+         ScalarType StringField -> case wv of+           WLen bs -> case TE.decodeUtf8' bs of+             Left _ -> issue InvalidUtf8+             Right _ -> []+           _ -> []+         MessageType _ -> subMessageIssues issue wv+         MapType _ _ -> subMessageIssues issue wv+         _ -> []+++subMessageIssues :: (DecodeError -> [DecodeIssue]) -> WV -> [DecodeIssue]+subMessageIssues issue wv = case wv of+  WLen bs -> case snd (scan bs) of+    Just e -> issue (SubMessageError e)+    Nothing -> []+  _ -> []+++----------------------------------------------------------------------+-- Self-contained wire scanner+----------------------------------------------------------------------++data WV = WVarint !Word64 | WI64 !Word64 | WI32 !Word32 | WLen !ByteString+++{- | Scan a message into @(fieldNumber, value)@ pairs, preserving repeats.+Returns any trailing structural error encountered.+-}+scan :: ByteString -> ([(Int, WV)], Maybe DecodeError)+scan = go id+  where+    go acc bs+      | BS.null bs = (acc [], Nothing)+      | otherwise = case readVarint bs of+          Nothing -> (acc [], Just InvalidVarint)+          Just (tag, r) ->+            let fn = fromIntegral (tag `shiftR` 3)+                wt = tag .&. 7+            in case wt of+                 0 -> case readVarint r of+                   Just (v, r2) -> go (acc . ((fn, WVarint v) :)) r2+                   Nothing -> (acc [], Just InvalidVarint)+                 1 ->+                   if BS.length r >= 8+                     then go (acc . ((fn, WI64 (le64 (BS.take 8 r))) :)) (BS.drop 8 r)+                     else (acc [], Just UnexpectedEnd)+                 5 ->+                   if BS.length r >= 4+                     then go (acc . ((fn, WI32 (le32 (BS.take 4 r))) :)) (BS.drop 4 r)+                     else (acc [], Just UnexpectedEnd)+                 2 -> case readVarint r of+                   Just (len, r2) ->+                     let n = fromIntegral len+                     in if n >= 0 && BS.length r2 >= n+                          then go (acc . ((fn, WLen (BS.take n r2)) :)) (BS.drop n r2)+                          else (acc [], Just UnexpectedEnd)+                   Nothing -> (acc [], Just InvalidVarint)+                 _ -> (acc [], Just (InvalidWireType (fromIntegral wt)))+++readVarint :: ByteString -> Maybe (Word64, ByteString)+readVarint = goV 0 0+  where+    goV !shift !acc bs = case BS.uncons bs of+      Nothing -> Nothing+      Just (b, rest) ->+        let acc' = acc .|. (fromIntegral (b .&. 0x7F) `shiftL` shift)+        in if b .&. 0x80 /= 0+             then if shift >= 63 then Nothing else goV (shift + 7) acc' rest+             else Just (acc', rest)+++le64 :: ByteString -> Word64+le64 = BS.foldr (\b a -> a `shiftL` 8 .|. fromIntegral b) 0+++le32 :: ByteString -> Word32+le32 = BS.foldr (\b a -> a `shiftL` 8 .|. fromIntegral b) 0
src/Proto/Decode/Stream.hs view
@@ -36,7 +36,7 @@ import Data.ByteString.Lazy qualified as BL import Data.Int (Int64) import Data.Word (Word64)-import Proto (MessageDecode, decodeMessage)+import Proto.Decode (MessageDecode, decodeMessage) import Proto.Internal.Wire.Decode (DecodeError (..))  @@ -72,8 +72,8 @@         let msgLen = fromIntegral len :: Int64             (msgBytes, remaining) = BL.splitAt msgLen rest         in if BL.length msgBytes < msgLen-            then [Left UnexpectedEnd]-            else decodeMessage (BL.toStrict msgBytes) : decodeMessageStream remaining+             then [Left UnexpectedEnd]+             else decodeMessage (BL.toStrict msgBytes) : decodeMessageStream remaining   -- ---------------------------------------------------------------------------@@ -96,13 +96,15 @@ (which produces 'IFail' if the message is incomplete). -} data IDecode a-  = -- | Successfully decoded a message. The 'ByteString' contains-    -- any unconsumed input that follows the message.+  = {- | Successfully decoded a message. The 'ByteString' contains+    any unconsumed input that follows the message.+    -}     IDone !a !ByteString   | -- | Decode failed. The 'ByteString' contains unconsumed input.     IFail !DecodeError !ByteString-  | -- | More input needed. Supply @Just chunk@ for more bytes, or-    -- @Nothing@ to signal that no more input will arrive.+  | {- | More input needed. Supply @Just chunk@ for more bytes, or+    @Nothing@ to signal that no more input will arrive.+    -}     IPartial (Maybe ByteString -> IDecode a)  @@ -161,12 +163,12 @@           !rest = BS.drop 1 buf           !val = acc .|. ((fromIntegral b .&. 0x7F) `shiftL` shift)       in if b < 0x80-          then-            let !msgLen = fromIntegral val :: Int-            in if msgLen < 0-                then IFail NegativeLength rest-                else goBody msgLen 0 [] rest-          else goVarint val (shift + 7) rest+           then+             let !msgLen = fromIntegral val :: Int+             in if msgLen < 0+                  then IFail NegativeLength rest+                  else goBody msgLen 0 [] rest+           else goVarint val (shift + 7) rest   -- ---------------------------------------------------------------------------@@ -187,10 +189,10 @@       let !available = BS.length buf           !remaining = needed - have       in if available >= remaining-          then-            let (!msgPart, !leftover) = BS.splitAt remaining buf-            in finishDecode needed (msgPart : acc) leftover-          else goBody needed (have + available) (buf : acc) BS.empty+           then+             let (!msgPart, !leftover) = BS.splitAt remaining buf+             in finishDecode needed (msgPart : acc) leftover+           else goBody needed (have + available) (buf : acc) BS.empty   finishDecode :: MessageDecode a => Int -> [ByteString] -> ByteString -> IDecode a@@ -199,8 +201,8 @@         [single] | BS.length single == needed -> single         _ -> BS.concat (reverse acc)   in case decodeMessage msgBytes of-      Left e -> IFail e leftover-      Right a -> IDone a leftover+       Left e -> IFail e leftover+       Right a -> IDone a leftover   reassemble :: [ByteString] -> ByteString@@ -222,8 +224,8 @@           Just (b, rest) ->             let val = acc .|. ((fromIntegral b .&. 0x7F) `shiftL` shift)             in if b < 0x80-                then Right (val, rest)-                else go val (shift + 7) rest+                 then Right (val, rest)+                 else go val (shift + 7) rest   -- ---------------------------------------------------------------------------@@ -278,12 +280,12 @@           !rest = BS.drop 1 buf           !val = acc .|. ((fromIntegral b .&. 0x7F) `shiftL` shift)       in if b < 0x80-          then-            let !msgLen = fromIntegral val :: Int-            in if msgLen < 0-                then Fail "negative message length"-                else dsBody msgLen 0 [] rest-          else dsVarint val (shift + 7) rest+           then+             let !msgLen = fromIntegral val :: Int+             in if msgLen < 0+                  then Fail "negative message length"+                  else dsBody msgLen 0 [] rest+           else dsVarint val (shift + 7) rest   dsBody :: MessageDecode a => Int -> Int -> [ByteString] -> ByteString -> DecodeStep a@@ -299,10 +301,10 @@       let !available = BS.length buf           !remaining = needed - have       in if available >= remaining-          then-            let (!msgPart, !leftover) = BS.splitAt remaining buf-            in dsFinish needed (msgPart : acc) leftover-          else dsBody needed (have + available) (buf : acc) BS.empty+           then+             let (!msgPart, !leftover) = BS.splitAt remaining buf+             in dsFinish needed (msgPart : acc) leftover+           else dsBody needed (have + available) (buf : acc) BS.empty   dsFinish :: MessageDecode a => Int -> [ByteString] -> ByteString -> DecodeStep a@@ -311,5 +313,5 @@         [single] | BS.length single == needed -> single         _ -> BS.concat (reverse acc)   in case decodeMessage msgBytes of-      Left e -> Fail (show e)-      Right a -> Done a leftover+       Left e -> Fail (show e)+       Right a -> Done a leftover
src/Proto/Dynamic.hs view
@@ -1,34 +1,26 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE UnboxedTuples #-}+ {- | Dynamic messages for runtime protobuf manipulation.  A 'DynamicMessage' can represent any protobuf message without compile-time generated code, using field descriptors to interpret the wire format at runtime. -== Quick start--@-import Proto.Dynamic---- Schemaless decode (wire-type inference)-case 'decodeDynamic' rawBytes of-  Left err -> handleError err-  Right msg -> use ('dynamicField' 1 msg)---- Schema-driven decode (faster, type-aware)-let table = 'compileParseTable' (Proxy @MyMsg)-case 'decodeDynamicWithSchema' table rawBytes of-  Left err -> handleError err-  Right msg -> use msg-@+Use cases: -== Note on module structure+* Proxies and middleware that forward messages without knowing types+* Schema registries and tooling+* Testing and debugging+* Dynamic configuration systems -The full schema-table internals ('FieldParser', 'ParseTable' record-fields, 'FieldThunk', thunk builders) live in-"Proto.Internal.Dynamic". That module is exposed for testing and-tooling that needs to construct custom parse tables; normal-application code should only call 'compileParseTable' and the-decode functions in this module.+This module also provides a schema-driven fast decode path via+'compileParseTable' and 'decodeDynamicWithSchema', inspired by+hyperpb's table-driven parser. The schema-driven path+compiles a 'ProtoMessage' schema into a flat array of 'FieldParser'+entries that a small interpreter loop evaluates against incoming+wire data, sharing the same 'DynamicValue'/'DynamicMessage' types+as the schemaless decoder. -} module Proto.Dynamic (   -- * Dynamic value type@@ -45,37 +37,585 @@   encodeDynamic,   decodeDynamic, -  -- * Streaming decode (length-delimited frames)-  decodeDynamicStream,-  decodeDynamicStreamLazy,-   -- * Schema-driven decoding (fast path)-  ---  -- | Build a parse table once from a 'Proto.Schema.ProtoMessage'-  -- schema and reuse it across many 'decodeDynamicWithSchema' calls.-  ParseTable,+  ParseTable (..),+  FieldParser (..),+  FieldThunk,   compileParseTable,   decodeDynamicWithSchema,-  decodeDynamicStreamWithSchema,    -- * Conversion   dynamicToJson, ) where -import Proto.Internal.Dynamic (-  DynamicMessage (..),-  DynamicValue (..),-  ParseTable,-  compileParseTable,-  decodeDynamic,-  decodeDynamicStream,-  decodeDynamicStreamLazy,-  decodeDynamicStreamWithSchema,-  decodeDynamicWithSchema,-  dynamicToJson,-  emptyDynamic,-  encodeDynamic,-  dynamicField,-  removeDynamicField,-  setDynamicField,+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as AesonKey+import Data.Aeson.KeyMap qualified as AesonKM+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.ByteString.Base64 qualified as Base64+import Data.ByteString.Lazy qualified as BL+import Data.ByteString.Unsafe qualified as BSU+import Data.IORef+import Data.Int (Int32, Int64)+import Data.IntMap.Strict (IntMap)+import Data.IntMap.Strict qualified as IntMap+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Proxy (Proxy (..))+import Data.Scientific (fromFloatDigits)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Data.Vector qualified as V+import Data.Word (Word32, Word64, Word8)+import GHC.Float (castWord32ToFloat, castWord64ToDouble)+import Proto.Internal.Wire (Tag (..), WireType (..), fieldTag)+import Proto.Internal.Wire.Decode (+  DecodeError (..),+  DecodeResult (..),+  Decoder,+  UMaybe (UJust, UNothing),+  getDouble,+  getFixed32,+  getFixed64,+  getFloat,+  getLengthDelimited,+  getTagOrU,+  getText,+  getVarint,+  runDecoder,+  runDecoder',+  skipField,+  validateUtf8,  )+import Proto.Internal.Wire.Encode (+  putByteString,+  putDouble,+  putFixed32,+  putFixed64,+  putFloat,+  putLengthDelimited,+  putTag,+  putText,+  putVarint,+ )+import Proto.Schema (+  FieldDescriptor (..),+  FieldLabel' (..),+  FieldTypeDescriptor (..),+  ProtoMessage (..),+  ScalarFieldType (..),+  SomeFieldDescriptor (..),+ )+import System.IO.Unsafe (unsafePerformIO)+import Wireform.Builder qualified as B+import Wireform.FFI (decodeVarintSWAR, relocatePageBoundary)+++-- | A dynamically-typed protobuf value.+data DynamicValue+  = DynVarint !Word64+  | DynSVarint !Int64+  | DynFixed32 !Word32+  | DynFixed64 !Word64+  | DynFloat !Float+  | DynDouble !Double+  | DynBool !Bool+  | DynString !Text+  | DynBytes !ByteString+  | DynMessage !DynamicMessage+  | DynEnum !Int+  | DynRepeated ![DynamicValue]+  | DynMap !(Map DynamicValue DynamicValue)+  deriving stock (Show, Eq, Ord)+++-- | A dynamically-typed protobuf message, storing fields by number.+data DynamicMessage = DynamicMessage+  { dynFields :: !(Map Int DynamicValue)+  , dynUnknownFields :: ![(Int, WireType, ByteString)]+  }+  deriving stock (Show, Eq, Ord)+++-- | An empty dynamic message with no fields and no unknown fields.+emptyDynamic :: DynamicMessage+emptyDynamic = DynamicMessage Map.empty []+++-- | Look up a field by its proto field number in a dynamic message.+dynamicField :: Int -> DynamicMessage -> Maybe DynamicValue+dynamicField n (DynamicMessage fs _) = Map.lookup n fs+++-- | Insert or replace a field value at the given field number.+setDynamicField :: Int -> DynamicValue -> DynamicMessage -> DynamicMessage+setDynamicField n v (DynamicMessage fs unk) =+  DynamicMessage (Map.insert n v fs) unk+++-- | Remove a field by its proto field number, if present.+removeDynamicField :: Int -> DynamicMessage -> DynamicMessage+removeDynamicField n (DynamicMessage fs unk) =+  DynamicMessage (Map.delete n fs) unk+++{- | Encode a dynamic message to bytes.+Uses varint wire type for integer values, length-delimited for strings/bytes/messages.+-}+encodeDynamic :: DynamicMessage -> ByteString+encodeDynamic (DynamicMessage fs _) =+  BL.toStrict $ B.toLazyByteString $ Map.foldlWithKey' encodeField mempty fs+  where+    encodeField acc fn val = acc <> encodeDynValue fn val+++encodeDynValue :: Int -> DynamicValue -> B.Builder+encodeDynValue fn = \case+  DynVarint v -> putTag fn WireVarint <> putVarint v+  DynSVarint v -> putTag fn WireVarint <> putVarint (fromIntegral v)+  DynFixed32 v -> putTag fn Wire32Bit <> putFixed32 v+  DynFixed64 v -> putTag fn Wire64Bit <> putFixed64 v+  DynFloat v -> putTag fn Wire32Bit <> putFloat v+  DynDouble v -> putTag fn Wire64Bit <> putDouble v+  DynBool v -> putTag fn WireVarint <> putVarint (if v then 1 else 0)+  DynString v -> putTag fn WireLengthDelimited <> putText v+  DynBytes v -> putTag fn WireLengthDelimited <> putByteString v+  DynEnum v -> putTag fn WireVarint <> putVarint (fromIntegral v)+  DynMessage m ->+    let payload = encodeDynamic m+    in putTag fn WireLengthDelimited <> putLengthDelimited payload+  DynRepeated vs -> foldMap (encodeDynValue fn) vs+  DynMap _kvs -> mempty+++-- | Decode a dynamic message from bytes using wire type inference.+decodeDynamic :: ByteString -> Either DecodeError DynamicMessage+decodeDynamic = runDecoder decodeDynLoop+++decodeDynLoop :: Decoder DynamicMessage+decodeDynLoop = go Map.empty+  where+    go !acc = do+      mt <- getTagOrU+      case mt of+        UNothing -> pure (DynamicMessage acc [])+        UJust (Tag fn wt) -> do+          val <- decodeWireValue wt+          let acc' = case Map.lookup fn acc of+                Nothing -> Map.insert fn val acc+                Just (DynRepeated vs) -> Map.insert fn (DynRepeated (vs <> [val])) acc+                Just existing -> Map.insert fn (DynRepeated [existing, val]) acc+          go acc'+++decodeWireValue :: WireType -> Decoder DynamicValue+decodeWireValue = \case+  WireVarint -> DynVarint <$> getVarint+  Wire64Bit -> DynFixed64 <$> getFixed64+  Wire32Bit -> DynFixed32 <$> getFixed32+  WireLengthDelimited -> DynBytes <$> getLengthDelimited+  wt -> skipField wt >> pure (DynBytes BS.empty)+++-- | Convert a dynamic message to JSON (field numbers as keys).+dynamicToJson :: DynamicMessage -> Aeson.Value+dynamicToJson (DynamicMessage fs _) =+  Aeson.Object+    ( AesonKM.fromList+        (fmap (\(k, v) -> (AesonKey.fromText (intToText k), dynValueToJson v)) (Map.toList fs))+    )+++dynValueToJson :: DynamicValue -> Aeson.Value+dynValueToJson = \case+  DynVarint v -> Aeson.Number (fromIntegral v)+  DynSVarint v -> Aeson.Number (fromIntegral v)+  DynFixed32 v -> Aeson.Number (fromIntegral v)+  DynFixed64 v -> Aeson.String (word64ToText v)+  DynFloat v -> Aeson.Number (fromFloatDigits v)+  DynDouble v -> Aeson.Number (fromFloatDigits v)+  DynBool v -> Aeson.Bool v+  DynString v -> Aeson.String v+  DynBytes bs -> Aeson.String (TE.decodeUtf8 (Base64.encode bs))+  DynEnum v -> Aeson.Number (fromIntegral v)+  DynMessage m -> dynamicToJson m+  DynRepeated vs -> Aeson.toJSON (fmap dynValueToJson vs)+  DynMap _ -> Aeson.object []+++-- ============================================================+-- Schema-driven fast decode path (Table-Driven Parser)+-- ============================================================++{- | A thunk for parsing a single field. Takes a ByteString and offset,+returns the parsed value and new offset.+-}+type FieldThunk = ByteString -> Int -> IO (DynamicValue, Int)+++-- | A single field's parse configuration in the table.+data FieldParser = FieldParser+  { fpTag :: {-# UNPACK #-} !Word64+  -- ^ The wire tag (field number << 3 | wire type) this entry matches.+  , fpFieldNum :: {-# UNPACK #-} !Int+  -- ^ Proto field number.+  , fpNextOk :: {-# UNPACK #-} !Int+  -- ^ Index of next FieldParser to try on successful match (field scheduling).+  , fpNextErr :: {-# UNPACK #-} !Int+  -- ^ Index of next FieldParser to try on mismatch.+  , fpParse :: !FieldThunk+  -- ^ The thunk that actually decodes this field's value.+  , fpLabel :: !FieldLabel'+  -- ^ Whether this field is repeated (affects accumulation).+  , fpSubmsg :: !(Maybe ParseTable)+  -- ^ Nested parse table for submessage fields.+  }+++-- | Compiled parse table for a message type.+data ParseTable = ParseTable+  { ptFields :: !(V.Vector FieldParser)+  -- ^ Field parsers in scheduled order.+  , ptTagLUT :: !ByteString+  {- ^ 128-byte LUT: tag byte -> index in ptFields (0xFF = miss).+  For tags < 128 (field numbers 1-15), this is a direct O(1) lookup.+  -}+  , ptTagMap :: !(IntMap Int)+  -- ^ Fallback map: wire tag -> index in ptFields, for tags >= 128.+  , ptMaxMiss :: {-# UNPACK #-} !Int+  -- ^ Max consecutive misses before hitting the hash table.+  }+++-- | Compile a 'ProtoMessage' schema into a 'ParseTable'.+compileParseTable :: forall a. ProtoMessage a => Proxy a -> ParseTable+compileParseTable proxy =+  let descriptors = protoFieldDescriptors proxy+      fieldList' = Map.toAscList descriptors+      nFields = length fieldList'++      parsers =+        V.fromList+          [ mkFieldParser i nFields fd+          | (i, (_, SomeField fd)) <- zip [0 ..] fieldList'+          ]++      tagLUTBytes = BS.pack (fmap tagLUTEntry [0 .. 127])+      tagMap =+        IntMap.fromList+          [ (fromIntegral (fpTag fp), i)+          | (i, fp) <- zip [0 ..] (V.toList parsers)+          ]+  in ParseTable+       { ptFields = parsers+       , ptTagLUT = tagLUTBytes+       , ptTagMap = tagMap+       , ptMaxMiss = min 4 nFields+       }+  where+    fieldList = Map.toAscList (protoFieldDescriptors proxy)+    nFields = length fieldList++    fpList :: [(Int, FieldParser)]+    fpList =+      [ (i, mkFieldParser i nFields fd)+      | (i, (_, SomeField fd)) <- zip [0 ..] fieldList+      ]++    tagLUTEntry :: Word8 -> Word8+    tagLUTEntry tag =+      case IntMap.lookup (fromIntegral tag) tagIdxMap of+        Just idx | idx < 256 -> fromIntegral idx+        _ -> 0xFF++    tagIdxMap :: IntMap Int+    tagIdxMap =+      IntMap.fromList+        [ (fromIntegral (fpTag (snd fp)), fst fp)+        | fp <- fpList+        ]+++-- | Build a FieldParser from a schema FieldDescriptor.+mkFieldParser :: Int -> Int -> FieldDescriptor msg a -> FieldParser+mkFieldParser idx nFields fd =+  let fn = fdNumber fd+      wt = fieldWireType (fdTypeDesc fd)+      tag = fieldTag fn wt+      nextOk = (idx + 1) `mod` nFields+      nextErr = (idx + 1) `mod` nFields+  in FieldParser+       { fpTag = tag+       , fpFieldNum = fn+       , fpNextOk = nextOk+       , fpNextErr = nextErr+       , fpParse = mkThunk (fdTypeDesc fd)+       , fpLabel = fdLabel fd+       , fpSubmsg = Nothing+       }+++fieldWireType :: FieldTypeDescriptor -> WireType+fieldWireType = \case+  ScalarType DoubleField -> Wire64Bit+  ScalarType FloatField -> Wire32Bit+  ScalarType Int32Field -> WireVarint+  ScalarType Int64Field -> WireVarint+  ScalarType UInt32Field -> WireVarint+  ScalarType UInt64Field -> WireVarint+  ScalarType SInt32Field -> WireVarint+  ScalarType SInt64Field -> WireVarint+  ScalarType Fixed32Field -> Wire32Bit+  ScalarType Fixed64Field -> Wire64Bit+  ScalarType SFixed32Field -> Wire32Bit+  ScalarType SFixed64Field -> Wire64Bit+  ScalarType BoolField -> WireVarint+  ScalarType StringField -> WireLengthDelimited+  ScalarType BytesField -> WireLengthDelimited+  MessageType _ -> WireLengthDelimited+  EnumType _ -> WireVarint+  MapType _ _ -> WireLengthDelimited+++-- | Make a decode thunk for a field type.+mkThunk :: FieldTypeDescriptor -> FieldThunk+mkThunk = \case+  ScalarType DoubleField -> thunkFixed64 (DynDouble . castWord64ToDouble)+  ScalarType FloatField -> thunkFixed32 (DynFloat . castWord32ToFloat)+  ScalarType Int32Field -> thunkVarint DynVarint+  ScalarType Int64Field -> thunkVarint DynVarint+  ScalarType UInt32Field -> thunkVarint DynVarint+  ScalarType UInt64Field -> thunkVarint DynVarint+  ScalarType SInt32Field -> thunkVarint DynVarint+  ScalarType SInt64Field -> thunkVarint DynVarint+  ScalarType Fixed32Field -> thunkFixed32 DynFixed32+  ScalarType Fixed64Field -> thunkFixed64 DynFixed64+  ScalarType SFixed32Field -> thunkFixed32 DynFixed32+  ScalarType SFixed64Field -> thunkFixed64 DynFixed64+  ScalarType BoolField -> thunkVarint (\v -> DynBool (v /= 0))+  ScalarType StringField -> thunkLenDelim (fmap DynString . decodeTextValue)+  ScalarType BytesField -> thunkLenDelim (Right . DynBytes)+  MessageType _ -> thunkLenDelim (fmap DynMessage . decodeSubmsg)+  EnumType _ -> thunkVarint (DynEnum . fromIntegral)+  MapType _ _ -> thunkLenDelim (Right . DynBytes)+++decodeTextValue :: ByteString -> Either DecodeError Text+decodeTextValue bs+  | validateUtf8 bs = Right (TE.decodeUtf8Lenient bs)+  | otherwise = Left InvalidUtf8+++-- Thunk builders: decode a wire value at a given offset in a ByteString.++thunkVarint :: (Word64 -> DynamicValue) -> FieldThunk+thunkVarint f bs off =+  case runDecoder' getVarint bs off of+    DecodeOK v off' -> pure (f v, off')+    DecodeFail e -> error ("dynamic varint decode: " <> show e)+++thunkFixed32 :: (Word32 -> DynamicValue) -> FieldThunk+thunkFixed32 f bs off =+  case runDecoder' getFixed32 bs off of+    DecodeOK v off' -> pure (f v, off')+    DecodeFail e -> error ("dynamic fixed32 decode: " <> show e)+++thunkFixed64 :: (Word64 -> DynamicValue) -> FieldThunk+thunkFixed64 f bs off =+  case runDecoder' getFixed64 bs off of+    DecodeOK v off' -> pure (f v, off')+    DecodeFail e -> error ("dynamic fixed64 decode: " <> show e)+++thunkLenDelim :: (ByteString -> Either DecodeError DynamicValue) -> FieldThunk+thunkLenDelim f bs off =+  case runDecoder' getLengthDelimited bs off of+    DecodeOK bytes off' -> case f bytes of+      Right v -> pure (v, off')+      Left e -> error ("dynamic len-delim decode: " <> show e)+    DecodeFail e -> error ("dynamic len-delim decode: " <> show e)+++-- | Decode a submessage using schemaless wire-type inference.+decodeSubmsg :: ByteString -> Either DecodeError DynamicMessage+decodeSubmsg = decodeDynamic+++{- | Run a parse table on raw bytes (without a compiled table — wire-type inference).+Used as a fallback when no schema fields are compiled.+-}+decodeRaw :: ByteString -> DynamicMessage+decodeRaw bs = unsafePerformIO $ do+  fieldsRef <- newIORef IntMap.empty+  let len = BS.length bs+      go !off+        | off >= len = pure ()+        | otherwise = do+            case runDecoder' getVarint bs off of+              DecodeOK tagW off1 -> do+                let !fn = fromIntegral (tagW `div` 8) :: Int+                    !wt = fromIntegral (tagW `mod` 8) :: Int+                case wt of+                  0 -> case runDecoder' getVarint bs off1 of+                    DecodeOK v off2 -> do+                      modifyIORef' fieldsRef (IntMap.insert fn (DynVarint v))+                      go off2+                    DecodeFail _ -> pure ()+                  1 -> case runDecoder' getFixed64 bs off1 of+                    DecodeOK v off2 -> do+                      modifyIORef' fieldsRef (IntMap.insert fn (DynFixed64 v))+                      go off2+                    DecodeFail _ -> pure ()+                  2 -> case runDecoder' getLengthDelimited bs off1 of+                    DecodeOK v off2 -> do+                      modifyIORef' fieldsRef (IntMap.insert fn (DynBytes v))+                      go off2+                    DecodeFail _ -> pure ()+                  5 -> case runDecoder' getFixed32 bs off1 of+                    DecodeOK v off2 -> do+                      modifyIORef' fieldsRef (IntMap.insert fn (DynFixed32 v))+                      go off2+                    DecodeFail _ -> pure ()+                  _ -> pure ()+              DecodeFail _ -> pure ()+  go 0+  fields <- readIORef fieldsRef+  pure (DynamicMessage (IntMap.foldlWithKey' (\m k v -> Map.insert k v m) Map.empty fields) [])+++{- | Decode a message using a compiled 'ParseTable'.++This is the schema-driven fast decode path. The core table-driven interpreter loop:++1. Decode a tag varint.+2. If tag < 128, use the TagLUT for O(1) field lookup.+3. Otherwise, try the predicted next field ('fpNextOk').+4. On mismatch, walk 'fpNextErr' up to 'ptMaxMiss' times.+5. Fall back to the tag hash map.+6. Call the matched field's thunk ('fpParse') to decode the value.+7. Store the value in the accumulator.+8. Repeat until end of input.+-}+decodeDynamicWithSchema :: ParseTable -> ByteString -> Either DecodeError DynamicMessage+decodeDynamicWithSchema pt bs0+  | BS.null bs0 = Right (DynamicMessage Map.empty [])+  | V.null (ptFields pt) = Right (decodeRaw bs0)+  | otherwise = unsafePerformIO $ do+      let !bs = relocatePageBoundary bs0+      fieldsRef <- newIORef IntMap.empty+      let len = BS.length bs0++          decodeTag !off+            | off + 8 <= BS.length bs =+                case decodeVarintSWAR bs off of+                  Just (v, consumed) -> Just (v, off + consumed)+                  Nothing -> decodeTagSlow off+            | otherwise = decodeTagSlow off++          decodeTagSlow !off =+            case runDecoder' getVarint bs0 off of+              DecodeOK v o -> Just (v, o)+              DecodeFail _ -> Nothing++          go !off !curIdx+            | off >= len = pure ()+            | otherwise =+                case decodeTag off of+                  Nothing -> pure ()+                  Just (tagW, off1)+                    | off1 > len -> pure ()+                    | otherwise -> do+                        let !tagInt = fromIntegral tagW :: Int+                        mIdx <- findField pt tagW tagInt curIdx+                        case mIdx of+                          Just idx -> do+                            let !fp = ptFields pt V.! idx+                            (val, off2) <- fpParse fp bs0 off1+                            case fpLabel fp of+                              LabelRepeated -> do+                                fields <- readIORef fieldsRef+                                let fn = fpFieldNum fp+                                    val' = case IntMap.lookup fn fields of+                                      Just (DynRepeated vs) -> DynRepeated (vs ++ [val])+                                      Just existing -> DynRepeated [existing, val]+                                      Nothing -> val+                                writeIORef fieldsRef (IntMap.insert fn val' fields)+                              _ ->+                                modifyIORef' fieldsRef (IntMap.insert (fpFieldNum fp) val)+                            go off2 (fpNextOk fp)+                          Nothing -> do+                            -- Unknown field: skip it+                            let !wt = fromIntegral (tagW `mod` 8) :: Int+                            case skipWireValue wt bs0 off1 of+                              Just off2 -> go off2 curIdx+                              Nothing -> pure ()+      go 0 0+      fields <- readIORef fieldsRef+      pure (Right (DynamicMessage (IntMap.foldlWithKey' (\m k v -> Map.insert k v m) Map.empty fields) []))+++-- | Find the matching field parser for a given tag.+findField :: ParseTable -> Word64 -> Int -> Int -> IO (Maybe Int)+findField pt tagW tagInt curIdx+  -- TagLUT fast path: single-byte tags (field numbers 1-15)+  | tagInt >= 0+  , tagInt < 128 =+      let !lutVal = BSU.unsafeIndex (ptTagLUT pt) tagInt+      in if lutVal /= 0xFF+           then pure (Just (fromIntegral lutVal))+           else pure Nothing+  -- Predicted next field+  | curIdx < V.length (ptFields pt)+  , let fp = ptFields pt V.! curIdx+  , fpTag fp == tagW =+      pure (Just curIdx)+  -- Walk NextErr chain+  | otherwise = walkErr pt tagW curIdx (ptMaxMiss pt)+++walkErr :: ParseTable -> Word64 -> Int -> Int -> IO (Maybe Int)+walkErr pt tagW curIdx !tries+  | tries <= 0 = pure (IntMap.lookup (fromIntegral tagW) (ptTagMap pt))+  | curIdx >= V.length (ptFields pt) = pure (IntMap.lookup (fromIntegral tagW) (ptTagMap pt))+  | otherwise =+      let !fp = ptFields pt V.! curIdx+      in if fpTag fp == tagW+           then pure (Just curIdx)+           else walkErr pt tagW (fpNextErr fp) (tries - 1)+++-- | Skip a wire value based on wire type. Returns new offset or Nothing.+skipWireValue :: Int -> ByteString -> Int -> Maybe Int+skipWireValue wt bs off = case wt of+  0 -> case runDecoder' getVarint bs off of+    DecodeOK _ off' -> Just off'+    DecodeFail _ -> Nothing+  1 -> let off' = off + 8 in if off' <= BS.length bs then Just off' else Nothing+  2 -> case runDecoder' getVarint bs off of+    DecodeOK lenW off' ->+      let off'' = off' + fromIntegral lenW+      in if off'' <= BS.length bs then Just off'' else Nothing+    DecodeFail _ -> Nothing+  5 -> let off' = off + 4 in if off' <= BS.length bs then Just off' else Nothing+  _ -> Nothing+++intToText :: Int -> Text+intToText n+  | n < 0 = "-" <> word64ToText (fromIntegral (negate n))+  | otherwise = word64ToText (fromIntegral n)+++word64ToText :: Word64 -> Text+word64ToText 0 = "0"+word64ToText n = go T.empty n+  where+    go !acc 0 = acc+    go !acc v =+      let (!q, !r) = v `quotRem` 10+      in go (T.cons (toEnum (fromIntegral r + 48)) acc) q
+ src/Proto/Encode.hs view
@@ -0,0 +1,627 @@+{- | High-level encoding interface for protobuf messages.++This is the primary module for serialising protobuf messages to bytes.+Most users only need 'encodeMessage' (or 'encodeMessageSized' for+maximum performance) and 'hPutMessage' for streaming to a file handle.++== Quick start++@+import Proto.Encode++-- Encode to a strict ByteString+let bs = 'encodeMessage' myMsg++-- Encode with exact-size pre-allocation (fastest)+let bs = 'encodeMessageSized' myMsg++-- Stream directly to a Handle (no intermediate ByteString)+'hPutMessage' handle myMsg+@++== Typeclass approach++Generated message types automatically get 'MessageEncode' and+'MessageSize' instances via Template Haskell ('Proto.TH.loadProto').+'MessageEncode' provides the 'buildMessage' method that produces a+'Builder'; 'MessageSize' provides 'messageSize' for exact byte-count+pre-computation.++The two-pass optimisation (compute size, then encode) avoids+materialising submessages to intermediate 'Data.ByteString.ByteString'+values just to measure their length prefix. The size pass is pure+arithmetic; the encode pass writes directly into the output buffer.++== Field-level helpers++The @encodeField*@ and @sizedField*@ families are used by generated+code and are not normally called directly. The @encodeField*@ variants+produce a 'Builder'; the @sizedField*@ variants produce a+'Proto.Internal.SizedBuilder.SizedBuilder' that fuses the size computation with+the builder for zero-allocation submessage encoding.+-}+module Proto.Encode (+  -- * Builder type (re-exported from wireform-core)+  WB.Builder,++  -- * Encoding typeclasses+  MessageEncode (..),+  MessageSize (..),++  -- * Running encoders (strict ByteString output)+  encodeMessage,+  encodeMessageSized,+  encodeLazy,++  -- * Stream encoding (length-delimited framing)+  encodeMessageLazy,+  encodeMessageStream,+  encodeMessageStreamSized,+  hPutMessageStream,+  buildMessageFramed,++  -- * Running encoders (Builder output)+  hPutMessage,+  hPutMessageLen,++  -- * Field encoding helpers+  encodeFieldVarint,+  encodeFieldSVarint32,+  encodeFieldSVarint64,+  encodeFieldFixed32,+  encodeFieldFixed64,+  encodeFieldFloat,+  encodeFieldDouble,+  encodeFieldBool,+  encodeFieldString,+  encodeFieldBytes,+  encodeFieldMessage,+  encodeFieldEnum,++  -- * Packed repeated field encoding+  encodePackedWord64,+  encodePackedWord32,+  encodePackedInt64,+  encodePackedInt32,+  encodePackedBool,+  encodePackedFixed32,+  encodePackedFixed64,+  encodePackedFloat,+  encodePackedDouble,+  encodePackedSVarint32,+  encodePackedSVarint64,++  -- * Legacy alias+  encodePackedVarint,++  -- * Map field encoding+  encodeMapField,++  -- * Optimized submessage encoding (size-aware)+  encodeFieldMessageSized,+  encodeMapFieldSized,++  -- * Raw builders+  messageToByteString,++  -- * SizedBuilder-based encoding (fused size+builder)+  sizedFieldVarint,+  sizedFieldSVarint32,+  sizedFieldSVarint64,+  sizedFieldFixed32,+  sizedFieldFixed64,+  sizedFieldFloat,+  sizedFieldDouble,+  sizedFieldBool,+  sizedFieldString,+  sizedFieldBytes,+  sizedFieldMessage,+) where++import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Data.Int (Int32, Int64)+import Data.Text (Text)+import Data.Vector qualified as V+import Data.Vector.Storable qualified as VS+import Data.Vector.Unboxed qualified as VU+import Data.Word (Word32, Word64)+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (castPtr)+import Foreign.Storable (Storable, sizeOf)+import Proto.Internal.SizedBuilder (SizedBuilder, sized, toByteStringFromBuilder, withSubMessage)+import Proto.Internal.Wire (WireType (..))+import Proto.Internal.Wire.Encode+import System.IO (Handle)+import System.IO.Unsafe (unsafeDupablePerformIO)+import Wireform.Builder qualified as B+import Wireform.Builder qualified as WB+++-- | Typeclass for types that can be encoded as protobuf messages.+class MessageEncode a where+  -- | Build the wire-format representation (fields only, no outer length prefix).+  buildMessage :: a -> B.Builder+++{- | Typeclass for types whose wire-format size can be pre-computed.+Implementing this enables the two-pass optimization for submessage encoding:+compute sizes top-down, then encode in a single pass.+-}+class MessageSize a where+  -- | Compute the wire-format size in bytes (fields only, no outer length prefix).+  messageSize :: a -> Int+++{- | Encode a message to a strict 'ByteString'.+When the message implements 'MessageSize', this allocates a single+buffer of exactly the right size for zero-copy output.+-}+encodeMessage :: MessageEncode a => a -> ByteString+encodeMessage = B.toStrictByteString . buildMessage+{-# INLINE encodeMessage #-}+++{- | Encode a message to a strict 'ByteString' with exact-size allocation.+Requires 'MessageSize' to pre-compute the buffer size.+Allocates a single ByteString of exactly the right length — no+intermediate lazy chunks or recopying.+-}+encodeMessageSized :: (MessageEncode a, MessageSize a) => a -> ByteString+encodeMessageSized msg =+  toByteStringFromBuilder (messageSize msg) (buildMessage msg)+{-# INLINE encodeMessageSized #-}+++-- | Encode a message to a lazy 'ByteString' (useful for streaming).+encodeLazy :: MessageEncode a => a -> BL.ByteString+encodeLazy = B.toLazyByteString . buildMessage+{-# INLINE encodeLazy #-}+++{- | Write a message directly to a 'Handle' without materializing an+intermediate 'ByteString'. Uses fast-builder's streaming output.+-}+hPutMessage :: MessageEncode a => Handle -> a -> IO ()+hPutMessage h = WB.hPutBuilder h . buildMessage+{-# INLINE hPutMessage #-}+++-- | Like 'hPutMessage' but also returns the number of bytes written.+hPutMessageLen :: MessageEncode a => Handle -> a -> IO Int+hPutMessageLen h = WB.hPutBuilderLen h . buildMessage+{-# INLINE hPutMessageLen #-}+++-- | Convert a builder to strict ByteString.+messageToByteString :: B.Builder -> ByteString+messageToByteString = B.toStrictByteString+++-- | Encode a varint field (int32, int64, uint32, uint64).+encodeFieldVarint :: Int -> Word64 -> B.Builder+encodeFieldVarint fn val =+  putTag fn WireVarint <> putVarint val+{-# INLINE encodeFieldVarint #-}+++-- | Encode a sint32 field.+encodeFieldSVarint32 :: Int -> Int32 -> B.Builder+encodeFieldSVarint32 fn val =+  putTag fn WireVarint <> putSVarint32 val+{-# INLINE encodeFieldSVarint32 #-}+++-- | Encode a sint64 field.+encodeFieldSVarint64 :: Int -> Int64 -> B.Builder+encodeFieldSVarint64 fn val =+  putTag fn WireVarint <> putSVarint64 val+{-# INLINE encodeFieldSVarint64 #-}+++-- | Encode a fixed32 field.+encodeFieldFixed32 :: Int -> Word32 -> B.Builder+encodeFieldFixed32 fn val =+  putTag fn Wire32Bit <> putFixed32 val+{-# INLINE encodeFieldFixed32 #-}+++-- | Encode a fixed64 field.+encodeFieldFixed64 :: Int -> Word64 -> B.Builder+encodeFieldFixed64 fn val =+  putTag fn Wire64Bit <> putFixed64 val+{-# INLINE encodeFieldFixed64 #-}+++-- | Encode a float field.+encodeFieldFloat :: Int -> Float -> B.Builder+encodeFieldFloat fn val =+  putTag fn Wire32Bit <> putFloat val+{-# INLINE encodeFieldFloat #-}+++-- | Encode a double field.+encodeFieldDouble :: Int -> Double -> B.Builder+encodeFieldDouble fn val =+  putTag fn Wire64Bit <> putDouble val+{-# INLINE encodeFieldDouble #-}+++-- | Encode a bool field.+encodeFieldBool :: Int -> Bool -> B.Builder+encodeFieldBool fn val =+  putTag fn WireVarint <> putVarint (if val then 1 else 0)+{-# INLINE encodeFieldBool #-}+++-- | Encode a string field.+encodeFieldString :: Int -> Text -> B.Builder+encodeFieldString fn val =+  putTag fn WireLengthDelimited <> putText val+{-# INLINE encodeFieldString #-}+++-- | Encode a bytes field.+encodeFieldBytes :: Int -> ByteString -> B.Builder+encodeFieldBytes fn val =+  putTag fn WireLengthDelimited <> putByteString val+{-# INLINE encodeFieldBytes #-}+++{- | Encode a submessage field. Materializes the submessage to calculate its length.+Use 'encodeFieldMessageSized' when the message implements 'MessageSize'+for better performance.+-}+encodeFieldMessage :: MessageEncode a => Int -> a -> B.Builder+encodeFieldMessage fn msg =+  let payload = messageToByteString (buildMessage msg)+  in putTag fn WireLengthDelimited <> putLengthDelimited payload+{-# INLINE encodeFieldMessage #-}+++{- | Encode a submessage field using pre-computed size (no materialization).+Two-pass: first compute size, then write tag + length + payload.+This avoids allocating a temporary ByteString for the submessage.+-}+encodeFieldMessageSized :: (MessageEncode a, MessageSize a) => Int -> a -> B.Builder+encodeFieldMessageSized fn msg =+  let sz = messageSize msg+  in putTag fn WireLengthDelimited <> putVarint (fromIntegral sz) <> buildMessage msg+{-# INLINE encodeFieldMessageSized #-}+++-- | Encode an enum field (as varint).+encodeFieldEnum :: Enum a => Int -> a -> B.Builder+encodeFieldEnum fn val =+  putTag fn WireVarint <> putVarint (fromIntegral (fromEnum val))+{-# INLINE encodeFieldEnum #-}+++-- | Encode a packed repeated uint64 field. No conversion needed.+encodePackedWord64 :: Int -> VU.Vector Word64 -> B.Builder+encodePackedWord64 fn vals+  | VU.null vals = mempty+  | otherwise =+      let sz = VU.foldl' (\acc v -> acc + varintSize v) 0 vals+      in putTag fn WireLengthDelimited+           <> putVarint (fromIntegral sz)+           <> VU.foldl' (\acc v -> acc <> putVarint v) mempty vals+{-# INLINE encodePackedWord64 #-}+++-- | Encode a packed repeated uint32 field. Uses native 32-bit varint encoding.+encodePackedWord32 :: Int -> VU.Vector Word32 -> B.Builder+encodePackedWord32 fn vals+  | VU.null vals = mempty+  | otherwise =+      let sz = VU.foldl' (\acc v -> acc + varintSize32 v) 0 vals+      in putTag fn WireLengthDelimited+           <> putVarint (fromIntegral sz)+           <> VU.foldl' (\acc v -> acc <> putVarint32 v) mempty vals+{-# INLINE encodePackedWord32 #-}+++{- | Encode a packed repeated int64 field.+Negative values use 10-byte two's complement.+-}+encodePackedInt64 :: Int -> VU.Vector Int64 -> B.Builder+encodePackedInt64 fn vals+  | VU.null vals = mempty+  | otherwise =+      let sz = VU.foldl' (\acc v -> acc + varintSize (fromIntegral v)) 0 vals+      in putTag fn WireLengthDelimited+           <> putVarint (fromIntegral sz)+           <> VU.foldl' (\acc v -> acc <> putVarint (fromIntegral v)) mempty vals+{-# INLINE encodePackedInt64 #-}+++{- | Encode a packed repeated int32 field.+Negative values are sign-extended to 64-bit and use 10-byte encoding per the+protobuf spec.+-}+encodePackedInt32 :: Int -> VU.Vector Int32 -> B.Builder+encodePackedInt32 fn vals+  | VU.null vals = mempty+  | otherwise =+      let sz = VU.foldl' (\acc v -> acc + varintSize (fromIntegral v :: Word64)) 0 vals+      in putTag fn WireLengthDelimited+           <> putVarint (fromIntegral sz)+           <> VU.foldl' (\acc v -> acc <> putVarint (fromIntegral v)) mempty vals+{-# INLINE encodePackedInt32 #-}+++-- | Encode a packed repeated bool field. Each bool is a single varint byte.+encodePackedBool :: Int -> VU.Vector Bool -> B.Builder+encodePackedBool fn vals+  | VU.null vals = mempty+  | otherwise =+      let sz = VU.length vals+      in putTag fn WireLengthDelimited+           <> putVarint (fromIntegral sz)+           <> VU.foldl' (\acc v -> acc <> B.word8 (if v then 1 else 0)) mempty vals+{-# INLINE encodePackedBool #-}+++-- | Legacy alias. Prefer the type-specific variants.+encodePackedVarint :: Int -> VU.Vector Word64 -> B.Builder+encodePackedVarint = encodePackedWord64+{-# INLINE encodePackedVarint #-}+++{- | Encode a packed repeated fixed32 field.+On LE platforms: the vector's backing store is already the wire bytes.+We bulk-copy via a single B.byteString instead of N individual putFixed32.+-}+encodePackedFixed32 :: Int -> VU.Vector Word32 -> B.Builder+encodePackedFixed32 fn vals+  | VU.null vals = mempty+  | otherwise =+      let sz = VU.length vals * 4+      in putTag fn WireLengthDelimited+           <> putVarint (fromIntegral sz)+           <> vectorToBuilder vals 4+{-# INLINE encodePackedFixed32 #-}+++-- | Encode a packed repeated fixed64 field.+encodePackedFixed64 :: Int -> VU.Vector Word64 -> B.Builder+encodePackedFixed64 fn vals+  | VU.null vals = mempty+  | otherwise =+      let sz = VU.length vals * 8+      in putTag fn WireLengthDelimited+           <> putVarint (fromIntegral sz)+           <> vectorToBuilder vals 8+{-# INLINE encodePackedFixed64 #-}+++-- | Encode a packed repeated float field.+encodePackedFloat :: Int -> VU.Vector Float -> B.Builder+encodePackedFloat fn vals+  | VU.null vals = mempty+  | otherwise =+      let sz = VU.length vals * 4+      in putTag fn WireLengthDelimited+           <> putVarint (fromIntegral sz)+           <> vectorToBuilder vals 4+{-# INLINE encodePackedFloat #-}+++-- | Encode a packed repeated double field.+encodePackedDouble :: Int -> VU.Vector Double -> B.Builder+encodePackedDouble fn vals+  | VU.null vals = mempty+  | otherwise =+      let sz = VU.length vals * 8+      in putTag fn WireLengthDelimited+           <> putVarint (fromIntegral sz)+           <> vectorToBuilder vals 8+{-# INLINE encodePackedDouble #-}+++{- | Bulk-copy an unboxed vector's backing bytes into a Builder.+On LE platforms (x86_64, aarch64-LE), the vector's internal+representation is already in wire byte order for fixed-width+protobuf types. This emits a single B.byteString instead of+N individual word writes.+-}+vectorToBuilder :: (VU.Unbox a, Storable a) => VU.Vector a -> Int -> B.Builder+vectorToBuilder vec elemSize =+  let sv = unboxedToStorable vec+      bs = unsafeDupablePerformIO $ VS.unsafeWith sv $ \ptr ->+        BS.packCStringLen (castPtr ptr, VS.length sv * elemSize)+  in B.byteStringCopy bs+{-# INLINE vectorToBuilder #-}+++unboxedToStorable :: (VU.Unbox a, Storable a) => VU.Vector a -> VS.Vector a+unboxedToStorable uv = VS.generate (VU.length uv) (VU.unsafeIndex uv)+{-# INLINE unboxedToStorable #-}+++-- | Encode a packed repeated sint32 field.+encodePackedSVarint32 :: Int -> VU.Vector Int32 -> B.Builder+encodePackedSVarint32 fn vals+  | VU.null vals = mempty+  | otherwise =+      let sz = VU.foldl' (\acc v -> acc + varintSize (fromIntegral (zigZag32 v))) 0 vals+      in putTag fn WireLengthDelimited+           <> putVarint (fromIntegral sz)+           <> VU.foldl' (\acc v -> acc <> putSVarint32 v) mempty vals+{-# INLINE encodePackedSVarint32 #-}+++-- | Encode a packed repeated sint64 field.+encodePackedSVarint64 :: Int -> VU.Vector Int64 -> B.Builder+encodePackedSVarint64 fn vals+  | VU.null vals = mempty+  | otherwise =+      let sz = VU.foldl' (\acc v -> acc + varintSize (zigZag64 v)) 0 vals+      in putTag fn WireLengthDelimited+           <> putVarint (fromIntegral sz)+           <> VU.foldl' (\acc v -> acc <> putSVarint64 v) mempty vals+{-# INLINE encodePackedSVarint64 #-}+++-- | Encode a map field entry (materializing to get the length).+encodeMapField+  :: Int+  -- ^ Field number of the map field+  -> B.Builder+  -- ^ Key encoding (field 1)+  -> B.Builder+  -- ^ Value encoding (field 2)+  -> B.Builder+encodeMapField fn keyEnc valEnc =+  let entry = messageToByteString (keyEnc <> valEnc)+  in putTag fn WireLengthDelimited <> putLengthDelimited entry+{-# INLINE encodeMapField #-}+++-- | Encode a map field entry using pre-computed entry size.+encodeMapFieldSized+  :: Int+  -- ^ Field number+  -> Int+  -- ^ Pre-computed entry size (key encoding + value encoding bytes)+  -> B.Builder+  -- ^ Key encoding (field 1)+  -> B.Builder+  -- ^ Value encoding (field 2)+  -> B.Builder+encodeMapFieldSized fn entrySz keyEnc valEnc =+  putTag fn WireLengthDelimited+    <> putVarint (fromIntegral entrySz)+    <> keyEnc+    <> valEnc+{-# INLINE encodeMapFieldSized #-}+++-- SizedBuilder-based field encoders: compute size and builder in one pass.+-- These are the Church-encoded (fused) versions of the two-pass approach.++-- | Encode a varint field, producing a SizedBuilder.+sizedFieldVarint :: Int -> Word64 -> SizedBuilder+sizedFieldVarint fn val =+  sized (fieldVarintSize fn val) (putTag fn WireVarint <> putVarint val)+{-# INLINE sizedFieldVarint #-}+++-- | Encode a sint32 field, producing a SizedBuilder.+sizedFieldSVarint32 :: Int -> Int32 -> SizedBuilder+sizedFieldSVarint32 fn val =+  sized (fieldSVarint32Size fn val) (putTag fn WireVarint <> putSVarint32 val)+{-# INLINE sizedFieldSVarint32 #-}+++-- | Encode a sint64 field, producing a SizedBuilder.+sizedFieldSVarint64 :: Int -> Int64 -> SizedBuilder+sizedFieldSVarint64 fn val =+  sized (fieldSVarint64Size fn val) (putTag fn WireVarint <> putSVarint64 val)+{-# INLINE sizedFieldSVarint64 #-}+++-- | Encode a fixed32 field, producing a SizedBuilder.+sizedFieldFixed32 :: Int -> Word32 -> SizedBuilder+sizedFieldFixed32 fn val =+  sized (fieldFixed32Size fn) (putTag fn Wire32Bit <> putFixed32 val)+{-# INLINE sizedFieldFixed32 #-}+++-- | Encode a fixed64 field, producing a SizedBuilder.+sizedFieldFixed64 :: Int -> Word64 -> SizedBuilder+sizedFieldFixed64 fn val =+  sized (fieldFixed64Size fn) (putTag fn Wire64Bit <> putFixed64 val)+{-# INLINE sizedFieldFixed64 #-}+++-- | Encode a float field, producing a SizedBuilder.+sizedFieldFloat :: Int -> Float -> SizedBuilder+sizedFieldFloat fn val =+  sized (fieldFloatSize fn) (putTag fn Wire32Bit <> putFloat val)+{-# INLINE sizedFieldFloat #-}+++-- | Encode a double field, producing a SizedBuilder.+sizedFieldDouble :: Int -> Double -> SizedBuilder+sizedFieldDouble fn val =+  sized (fieldDoubleSize fn) (putTag fn Wire64Bit <> putDouble val)+{-# INLINE sizedFieldDouble #-}+++-- | Encode a bool field, producing a SizedBuilder.+sizedFieldBool :: Int -> Bool -> SizedBuilder+sizedFieldBool fn val =+  sized (fieldBoolSize fn) (putTag fn WireVarint <> putVarint (if val then 1 else 0))+{-# INLINE sizedFieldBool #-}+++-- | Encode a string field, producing a SizedBuilder.+sizedFieldString :: Int -> Text -> SizedBuilder+sizedFieldString fn val =+  sized (fieldTextSize fn val) (putTag fn WireLengthDelimited <> putText val)+{-# INLINE sizedFieldString #-}+++-- | Encode a bytes field, producing a SizedBuilder.+sizedFieldBytes :: Int -> ByteString -> SizedBuilder+sizedFieldBytes fn val =+  sized (fieldBytesSize fn val) (putTag fn WireLengthDelimited <> putByteString val)+{-# INLINE sizedFieldBytes #-}+++{- | Encode a submessage field using SizedBuilder (fully fused, no materialization).+The submessage is provided as a SizedBuilder, which already knows its size.+This means we never allocate a ByteString for the submessage — just prepend+the tag and length prefix.+-}+sizedFieldMessage :: Int -> SizedBuilder -> SizedBuilder+sizedFieldMessage fn submsg =+  let tagSB = sized (tagSize fn) (putTag fn WireLengthDelimited)+  in tagSB <> withSubMessage submsg+{-# INLINE sizedFieldMessage #-}+++-- | Encode a message to a lazy 'ByteString'.+encodeMessageLazy :: MessageEncode a => a -> BL.ByteString+encodeMessageLazy = B.toLazyByteString . buildMessage+{-# INLINE encodeMessageLazy #-}+++{- | Encode a list of messages with length-delimited framing.+Each message is preceded by a varint length prefix.+-}+encodeMessageStream :: MessageEncode a => [a] -> BL.ByteString+encodeMessageStream = B.toLazyByteString . foldMap buildMessageFramedMaterialized+++{- | Like 'encodeMessageStream' but uses 'MessageSize' to avoid+materialising each message for its length prefix.+-}+encodeMessageStreamSized :: (MessageEncode a, MessageSize a) => [a] -> BL.ByteString+encodeMessageStreamSized = B.toLazyByteString . foldMap buildMessageFramed+++{- | Write a stream of messages directly to a 'Handle' with+length-delimited framing.+-}+hPutMessageStream :: (MessageEncode a, MessageSize a) => Handle -> [a] -> IO ()+hPutMessageStream h = WB.hPutBuilder h . foldMap buildMessageFramed+++{- | Build a single length-delimited frame: varint size prefix+followed by the message payload.+-}+buildMessageFramed :: (MessageEncode a, MessageSize a) => a -> B.Builder+buildMessageFramed msg =+  let !sz = messageSize msg+  in putVarint (fromIntegral sz) <> buildMessage msg+{-# INLINE buildMessageFramed #-}+++buildMessageFramedMaterialized :: MessageEncode a => a -> B.Builder+buildMessageFramedMaterialized msg =+  let payload = B.toStrictByteString (buildMessage msg)+  in putVarint (fromIntegral (BS.length payload))+       <> B.byteStringCopy payload
src/Proto/Extension.hs view
@@ -50,10 +50,11 @@    -- * Internal helpers -  -- | Reused by "Proto.Internal.JSON.Extension" to bridge the-  -- bracket-quoted JSON @[FQN]@ extension key syntax through-  -- the same encoder \/ decoder used for typed extension-  -- accessors.+  {- | Reused by "Proto.Internal.JSON.Extension" to bridge the+  bracket-quoted JSON @[FQN]@ extension key syntax through+  the same encoder \/ decoder used for typed extension+  accessors.+  -}   encodeExtensionValue,   decodeExtensionValue,   unknownFieldNumber,@@ -73,7 +74,7 @@   castWord32ToFloat,   castWord64ToDouble,  )-import Proto.Internal.Decode (UnknownField (..))+import Proto.Decode (UnknownField (..))   -- ============================================================@@ -118,8 +119,9 @@   ExtString :: ExtensionType Text   ExtBytes :: ExtensionType ByteString   ExtMessage :: ExtensionType ByteString-    -- ^ Sub-message stored as its raw length-delimited payload;-    -- callers use 'Proto.Decode.decodeMessage' to re-project.+    {- ^ Sub-message stored as its raw length-delimited payload;+    callers use 'Proto.Decode.decodeMessage' to re-project.+    -}   deriving stock instance Show (ExtensionType a)@@ -336,8 +338,8 @@ appendRepeatedExtension ext value msg =   let !uf = encodeExtensionValue (reNumber ext) (reType ext) value   in setMessageUnknownFields-      (messageUnknownFields msg ++ [uf])-      msg+       (messageUnknownFields msg ++ [uf])+       msg   -- | Drop every entry for this repeated extension.@@ -445,8 +447,8 @@           let b = BS.head bs               acc' = acc + (fromIntegral (b .&. 0x7F) `shiftL` shift)           in if b < 0x80-              then Just (acc', BS.tail bs)-              else step acc' (shift + 7) (BS.tail bs)+               then Just (acc', BS.tail bs)+               else step acc' (shift + 7) (BS.tail bs)   encodeVarint :: Word64 -> ByteString@@ -501,13 +503,13 @@       b6 = fromIntegral (BS.index bs 6) :: Word64       b7 = fromIntegral (BS.index bs 7) :: Word64   in b0-      .|. (b1 `shiftL` 8)-      .|. (b2 `shiftL` 16)-      .|. (b3 `shiftL` 24)-      .|. (b4 `shiftL` 32)-      .|. (b5 `shiftL` 40)-      .|. (b6 `shiftL` 48)-      .|. (b7 `shiftL` 56)+       .|. (b1 `shiftL` 8)+       .|. (b2 `shiftL` 16)+       .|. (b3 `shiftL` 24)+       .|. (b4 `shiftL` 32)+       .|. (b5 `shiftL` 40)+       .|. (b6 `shiftL` 48)+       .|. (b7 `shiftL` 56)   chunked :: Int -> (ByteString -> a) -> ByteString -> [a]
+ src/Proto/Google/Protobuf/Any.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}+{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-matches -Wno-unused-top-binds #-}++{- | Auto-generated protobuf types from package @google.protobuf@.++__THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__++Any manual changes will be overwritten the next time code+generation is run.  To modify the types or instances, edit the+@.proto@ source file and re-run the code generator.+-}+module Proto.Google.Protobuf.Any where++import Control.DeepSeq (NFData (..))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as AesonKey+import Data.Aeson.KeyMap qualified as AesonKM+import Data.Aeson.Types qualified as Aeson+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Hashable (Hashable (..))+import Data.Int (Int32, Int64)+import Data.Map.Strict qualified as Map+import Data.Proxy (Proxy (..))+import Data.Reflection (Given (..), given)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V+import Data.Vector.Unboxed qualified as VU+import Data.Word (Word32, Word64)+import GHC.Generics (Generic)+import Proto.Decode+import Proto.Encode+import Proto.Extension qualified+import Proto.Internal.Encode.Archetype (+  archBool,+  archBoolSize,+  archBytes,+  archBytesSize,+  archDouble,+  archFixed32,+  archFixed32Size,+  archFixed64,+  archFixed64Size,+  archFloat,+  archSVarint32,+  archSVarint64,+  archString,+  archStringSize,+  archSubmessage,+  archSubmessageSize,+  archVarint,+  archVarintSize,+ )+import Proto.Internal.JSON (bytesFieldToJSON, bytesMapFieldToJSON, jsonObject, parseBytesFieldMaybe, parseBytesMapFieldMaybe, parseFieldMaybe, protoBytesToJSON, (.=:))+import Proto.Internal.JSON.Extension qualified as PJExt+import Proto.Internal.Wire (Tag (..), WireType (..))+import Proto.Internal.Wire.Encode (+  fieldBoolSize,+  fieldBytesSize,+  fieldDoubleSize,+  fieldFixed32Size,+  fieldFixed64Size,+  fieldFloatSize,+  fieldMessageSize,+  fieldSVarint32Size,+  fieldSVarint64Size,+  fieldTextSize,+  fieldVarintSize,+  putByteString,+  putDouble,+  putFixed32,+  putFixed64,+  putFloat,+  putLengthDelimited,+  putSVarint32,+  putSVarint64,+  putTag,+  putText,+  putVarint,+  putVarintSigned,+  tagSize,+  varintSize,+  varintSize32,+  zigZag32,+  zigZag64,+ )+import Proto.Registry (IsMessage)+import Proto.Registry qualified+import Proto.Schema (FieldDescriptor (..), FieldLabel' (..), FieldTypeDescriptor (..), ProtoMessage (..), ScalarFieldType (..), SomeFieldDescriptor (..))+import Wireform.Builder qualified as B+++{- | Serialized FileDescriptorProto for this .proto file.+Decode with @Proto.Google.Protobuf.Descriptor.decodeMessage@.+-}+fileDescriptorProtoBytes :: ByteString+fileDescriptorProtoBytes = "\x0a\x19\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x61\x6e\x79\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x26\x0a\x03\x41\x6e\x79\x12\x10\x0a\x08\x74\x79\x70\x65\x5f\x75\x72\x6c\x18\x01\x20\x01\x28\x09\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x02\x20\x01\x28\x0c\x62\x06\x70\x72\x6f\x74\x6f\x33"+++data Any = Any+  { anyTypeUrl :: !Text+  , anyValue :: !ByteString+  , anyUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultAny :: Any+defaultAny =+  Any+    { anyTypeUrl = ""+    , anyValue = ""+    , anyUnknownFields = []+    }+++instance MessageEncode Any where+  buildMessage msg =+    (if msg.anyTypeUrl == T.empty then mempty else archString 10 msg.anyTypeUrl)+      <> (if BS.null msg.anyValue then mempty else archBytes 18 msg.anyValue)+      <> encodeUnknownFields msg.anyUnknownFields+++instance MessageSize Any where+  messageSize msg =+    (if msg.anyTypeUrl == T.empty then 0 else archStringSize msg.anyTypeUrl)+      + (if BS.null msg.anyValue then 0 else archBytesSize msg.anyValue)+      + unknownFieldsSize msg.anyUnknownFields+++instance MessageDecode Any where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop "" "" []+    where+      loop acc_0 acc_1 acc_unknown_ =+        withTagM+          (pure (Any {anyTypeUrl = acc_0, anyValue = acc_1, anyUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- decodeFieldString+                loop v acc_1 acc_unknown_+              2 -> do+                v <- decodeFieldBytes+                loop acc_0 v acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 acc_1 (uf : acc_unknown_)+          )+++instance ProtoMessage Any where+  protoMessageName _ = "google.protobuf.Any"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultAny+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "type_url"+              , fdNumber = 1+              , fdTypeDesc = ScalarType StringField+              , fdLabel = LabelOptional+              , fdGet = anyTypeUrl+              , fdSet = \v m -> m {anyTypeUrl = v}+              }+        )+      ,+        ( 2+        , SomeField+            FieldDescriptor+              { fdName = "value"+              , fdNumber = 2+              , fdTypeDesc = ScalarType BytesField+              , fdLabel = LabelOptional+              , fdGet = anyValue+              , fdSet = \v m -> m {anyValue = v}+              }+        )+      ]+++instance IsMessage Any+++instance Aeson.ToJSON Any where+  toJSON msg =+    jsonObject+      [ "typeUrl" .=: msg.anyTypeUrl+      , bytesFieldToJSON "value" msg.anyValue+      ]+++instance Aeson.FromJSON Any where+  parseJSON = Aeson.withObject "Any" $ \obj -> do+    fld_anyTypeUrl <- parseFieldMaybe obj "typeUrl"+    fld_anyValue <- parseBytesFieldMaybe obj "value"+    pure+      defaultAny+        { anyTypeUrl = maybe (anyTypeUrl defaultAny) id fld_anyTypeUrl+        , anyValue = maybe (anyValue defaultAny) id fld_anyValue+        , anyUnknownFields = []+        }+++instance Hashable Any where+  hashWithSalt salt msg = hashWithSalt (hashWithSalt (salt) msg.anyTypeUrl) msg.anyValue+++instance Proto.Extension.HasExtensions Any where+  messageUnknownFields = anyUnknownFields+  setMessageUnknownFields !ufs msg = msg {anyUnknownFields = ufs}+++instance Semigroup Any where+  a <> b =+    Any+      { anyTypeUrl = if b.anyTypeUrl == "" then a.anyTypeUrl else b.anyTypeUrl+      , anyValue = if b.anyValue == "" then a.anyValue else b.anyValue+      , anyUnknownFields = a.anyUnknownFields <> b.anyUnknownFields+      }+++instance Monoid Any where+  mempty = defaultAny
+ src/Proto/Google/Protobuf/Any/Util.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE ScopedTypeVariables #-}++{- | Utility functions for @google.protobuf.Any@ — type-safe packing,+unpacking, and runtime dispatch via 'TypeRegistry'.+-}+module Proto.Google.Protobuf.Any.Util (+  -- * Type-safe packing / unpacking+  packAny,+  packAnyWithPrefix,+  unpackAny,+  isMessageType,++  -- * Utilities+  typeUrlPrefix,+  typeUrlOf,+  typeNameFromUrl,+) where++import Data.Proxy (Proxy (..))+import Data.Text (Text)+import Data.Text qualified as T+import Proto.Decode (DecodeError, decodeMessage)+import Proto.Encode (encodeMessage)+import Proto.Google.Protobuf.Any (Any (..))+import Proto.Registry (IsMessage)+import Proto.Schema (ProtoMessage (..))+++typeUrlPrefix :: Text+typeUrlPrefix = "type.googleapis.com/"+++typeUrlOf :: forall a. IsMessage a => Proxy a -> Text+typeUrlOf p = typeUrlPrefix <> protoMessageName p+++packAny :: forall a. IsMessage a => a -> Any+packAny msg =+  Any+    { anyTypeUrl = typeUrlOf (Proxy :: Proxy a)+    , anyValue = encodeMessage msg+    , anyUnknownFields = []+    }+++packAnyWithPrefix :: forall a. IsMessage a => Text -> a -> Any+packAnyWithPrefix prefix msg =+  Any+    { anyTypeUrl = prefix <> protoMessageName (Proxy :: Proxy a)+    , anyValue = encodeMessage msg+    , anyUnknownFields = []+    }+++unpackAny :: forall a. IsMessage a => Any -> Maybe (Either DecodeError a)+unpackAny any'+  | isTypeMatch (anyTypeUrl any') (Proxy :: Proxy a) = Just (decodeMessage (anyValue any'))+  | otherwise = Nothing+++isMessageType :: forall a. IsMessage a => Proxy a -> Any -> Bool+isMessageType p any' = isTypeMatch (anyTypeUrl any') p+++isTypeMatch :: forall a. IsMessage a => Text -> Proxy a -> Bool+isTypeMatch tu p =+  let expected = protoMessageName p+  in typeNameFromUrl tu == expected+++typeNameFromUrl :: Text -> Text+typeNameFromUrl tu = case T.breakOnEnd "/" tu of+  ("", name) -> name+  (_, name) -> name
src/Proto/Google/Protobuf/Compiler/Plugin.hs view
@@ -1,923 +1,132 @@-{-# LANGUAGE StrictData #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedRecordDot #-}--- | Auto-generated protobuf types from package @google.protobuf.compiler@.------ __THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__+{-# LANGUAGE BangPatterns #-}+-- | Haskell types for @google/protobuf/compiler/plugin.proto@. ----- Any manual changes will be overwritten the next time code--- generation is run.  To modify the types or instances, edit the--- @.proto@ source file and re-run the code generator.-module Proto.Google.Protobuf.Compiler.Plugin where+-- These types define the interface between protoc and code generator plugins.+-- A plugin reads a 'CodeGeneratorRequest' from stdin and writes a+-- 'CodeGeneratorResponse' to stdout.+module Proto.Google.Protobuf.Compiler.Plugin+  ( -- * Request+    CodeGeneratorRequest (..)+  , defaultCodeGeneratorRequest +    -- * Response+  , CodeGeneratorResponse (..)+  , defaultCodeGeneratorResponse+  , CodeGeneratorResponseFile (..)+  , defaultCodeGeneratorResponseFile++    -- * Plugin entry point+  , pluginMain+  ) where+ import Data.ByteString (ByteString) import qualified Data.ByteString as BS-import qualified Wireform.Builder as B-import Data.Int (Int32, Int64) import Data.Text (Text) import qualified Data.Text as T-import Data.Word (Word8, Word32, Word64)-import qualified Data.IntMap.Strict as IntMap-import qualified Data.Map.Strict as Map import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU import GHC.Generics (Generic)-import Control.DeepSeq (NFData(..))-import Data.Hashable (Hashable(..))-import Proto.Internal.Encode-import Proto.Internal.Decode-import Proto.Internal.GrowList (GrowList, emptyGrowList, snocGrowList, growListToVector)-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson-import qualified Data.Aeson.Key as AesonKey-import qualified Data.Aeson.KeyMap as AesonKM-import Proto.Internal.JSON (jsonObject, (.=:), parseFieldMaybe, bytesFieldToJSON, parseBytesFieldMaybe, bytesMapFieldToJSON, parseBytesMapFieldMaybe, protoBytesToJSON, OneofVariantNullSemantics (..), parseOneofVariants)-import Data.Proxy (Proxy(..))-import Proto.Schema (ProtoMessage(..), SomeFieldDescriptor(..), FieldDescriptor(..), FieldTypeDescriptor(..), ScalarFieldType(..), FieldLabel'(..))-import Proto.Registry (IsMessage)-import Proto.Registry qualified-import qualified Proto.Extension-import Proto.Internal.Wire (Tag(..), WireType(..))-import Proto.Internal.Wire.Encode (putTag, putVarint, putFixed32, putFixed64,-  putFloat, putDouble, putText, putByteString, putLengthDelimited,-  putSVarint32, putSVarint64, putVarintSigned,-  varintSize, tagSize,-  varintSize32, zigZag32, zigZag64)-import Proto.Internal.Encode.Archetype (archVarint, archSVarint32, archSVarint64,-  archFixed32, archFixed64, archFloat, archDouble, archBool,-  archString, archBytes, archSubmessage)-import qualified Proto.Google.Protobuf.Reflection.Descriptor as PB_Reflection_Descriptor---- | Serialized FileDescriptorProto for this .proto file.--- Decode with @Proto.Decode.decodeMessage@.-fileDescriptorProtoBytes :: ByteString-fileDescriptorProtoBytes = "\x0a\x25\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x63\x6f\x6d\x70\x69\x6c\x65\x72\x2f\x70\x6c\x75\x67\x69\x6e\x2e\x70\x72\x6f\x74\x6f\x12\x18\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x2e\x63\x6f\x6d\x70\x69\x6c\x65\x72\x1a\x20\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x64\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x2e\x70\x72\x6f\x74\x6f\x22\x46\x0a\x07\x56\x65\x72\x73\x69\x6f\x6e\x12\x0d\x0a\x05\x6d\x61\x6a\x6f\x72\x18\x01\x20\x01\x28\x05\x12\x0d\x0a\x05\x6d\x69\x6e\x6f\x72\x18\x02\x20\x01\x28\x05\x12\x0d\x0a\x05\x70\x61\x74\x63\x68\x18\x03\x20\x01\x28\x05\x12\x0e\x0a\x06\x73\x75\x66\x66\x69\x78\x18\x04\x20\x01\x28\x09\x22\xc5\x01\x0a\x14\x43\x6f\x64\x65\x47\x65\x6e\x65\x72\x61\x74\x6f\x72\x52\x65\x71\x75\x65\x73\x74\x12\x18\x0a\x10\x66\x69\x6c\x65\x5f\x74\x6f\x5f\x67\x65\x6e\x65\x72\x61\x74\x65\x18\x01\x20\x03\x28\x09\x12\x11\x0a\x09\x70\x61\x72\x61\x6d\x65\x74\x65\x72\x18\x02\x20\x01\x28\x09\x12\x27\x0a\x0a\x70\x72\x6f\x74\x6f\x5f\x66\x69\x6c\x65\x18\x0f\x20\x03\x28\x0b\x32\x13\x46\x69\x6c\x65\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x34\x0a\x17\x73\x6f\x75\x72\x63\x65\x5f\x66\x69\x6c\x65\x5f\x64\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x73\x18\x11\x20\x03\x28\x0b\x32\x13\x46\x69\x6c\x65\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x21\x0a\x10\x63\x6f\x6d\x70\x69\x6c\x65\x72\x5f\x76\x65\x72\x73\x69\x6f\x6e\x18\x03\x20\x01\x28\x0b\x32\x07\x56\x65\x72\x73\x69\x6f\x6e\x22\xd1\x02\x0a\x15\x43\x6f\x64\x65\x47\x65\x6e\x65\x72\x61\x74\x6f\x72\x52\x65\x73\x70\x6f\x6e\x73\x65\x12\x0d\x0a\x05\x65\x72\x72\x6f\x72\x18\x01\x20\x01\x28\x09\x12\x1a\x0a\x12\x73\x75\x70\x70\x6f\x72\x74\x65\x64\x5f\x66\x65\x61\x74\x75\x72\x65\x73\x18\x02\x20\x01\x28\x04\x12\x17\x0a\x0f\x6d\x69\x6e\x69\x6d\x75\x6d\x5f\x65\x64\x69\x74\x69\x6f\x6e\x18\x03\x20\x01\x28\x05\x12\x17\x0a\x0f\x6d\x61\x78\x69\x6d\x75\x6d\x5f\x65\x64\x69\x74\x69\x6f\x6e\x18\x04\x20\x01\x28\x05\x12\x12\x0a\x04\x66\x69\x6c\x65\x18\x0f\x20\x03\x28\x0b\x32\x04\x46\x69\x6c\x65\x1a\x6e\x0a\x04\x46\x69\x6c\x65\x12\x0c\x0a\x04\x6e\x61\x6d\x65\x18\x01\x20\x01\x28\x09\x12\x17\x0a\x0f\x69\x6e\x73\x65\x72\x74\x69\x6f\x6e\x5f\x70\x6f\x69\x6e\x74\x18\x02\x20\x01\x28\x09\x12\x0f\x0a\x07\x63\x6f\x6e\x74\x65\x6e\x74\x18\x0f\x20\x01\x28\x09\x12\x2e\x0a\x13\x67\x65\x6e\x65\x72\x61\x74\x65\x64\x5f\x63\x6f\x64\x65\x5f\x69\x6e\x66\x6f\x18\x10\x20\x01\x28\x0b\x32\x11\x47\x65\x6e\x65\x72\x61\x74\x65\x64\x43\x6f\x64\x65\x49\x6e\x66\x6f\x22\x57\x0a\x07\x46\x65\x61\x74\x75\x72\x65\x12\x10\x0a\x0c\x46\x45\x41\x54\x55\x52\x45\x5f\x4e\x4f\x4e\x45\x10\x00\x12\x1b\x0a\x17\x46\x45\x41\x54\x55\x52\x45\x5f\x50\x52\x4f\x54\x4f\x33\x5f\x4f\x50\x54\x49\x4f\x4e\x41\x4c\x10\x01\x12\x1d\x0a\x19\x46\x45\x41\x54\x55\x52\x45\x5f\x53\x55\x50\x50\x4f\x52\x54\x53\x5f\x45\x44\x49\x54\x49\x4f\x4e\x53\x10\x02\x62\x06\x70\x72\x6f\x74\x6f\x32"----- | The version number of protocol compiler.-data Version = Version-  { versionMajor :: !(Maybe Int32)-  , versionMinor :: !(Maybe Int32)-  , versionPatch :: !(Maybe Int32)-  , versionSuffix :: !(Maybe Text)-    -- ^ A suffix for alpha, beta or rc release, e.g., "alpha-1", "rc2". It should-    -- be empty for mainline stable releases.-  , versionUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultVersion :: Version-defaultVersion = Version-  { versionMajor = Nothing-  , versionMinor = Nothing-  , versionPatch = Nothing-  , versionSuffix = Nothing-  , versionUnknownFields = []-  }--instance MessageEncode Version where-  buildSized msg =-    (maybe mempty (\v -> archVarint 8 (fromIntegral v)) msg.versionMajor)-    <> (maybe mempty (\v -> archVarint 16 (fromIntegral v)) msg.versionMinor)-    <> (maybe mempty (\v -> archVarint 24 (fromIntegral v)) msg.versionPatch)-    <> (maybe mempty (\v -> archString 34 v) msg.versionSuffix)-    <> encodeUnknownFieldsSized msg.versionUnknownFields--instance MessageDecode Version where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultVersion-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_1 (msg { versionMajor = (Just v)}))-          (pure (case msg.versionUnknownFields of { [] -> msg; _ -> msg { versionUnknownFields = reverse (msg.versionUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x10 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_2 (msg { versionMinor = (Just v)}))-          (pure (case msg.versionUnknownFields of { [] -> msg; _ -> msg { versionUnknownFields = reverse (msg.versionUnknownFields) } }))-          (loop msg)-      stage_2 msg =-        inOrderStage1-          (0x18 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_3 (msg { versionPatch = (Just v)}))-          (pure (case msg.versionUnknownFields of { [] -> msg; _ -> msg { versionUnknownFields = reverse (msg.versionUnknownFields) } }))-          (loop msg)-      stage_3 msg =-        inOrderStage1-          (0x22 :: Data.Word.Word8)-          decodeFieldString-          (\v -> loop (msg { versionSuffix = (Just v)}))-          (pure (case msg.versionUnknownFields of { [] -> msg; _ -> msg { versionUnknownFields = reverse (msg.versionUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.versionUnknownFields of { [] -> msg; _ -> msg { versionUnknownFields = reverse (msg.versionUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { versionMajor = (Just v)})-          2 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { versionMinor = (Just v)})-          3 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { versionPatch = (Just v)})-          4 -> do-            v <- decodeFieldString-            loop (msg { versionSuffix = (Just v)})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { versionUnknownFields = (uf : msg.versionUnknownFields)}))---- | Field descriptors for 'Version', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-versionFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor Version)-versionFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "major"-        , fdNumber = 1-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = versionMajor-        , fdSet = \v m -> m { versionMajor = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "minor"-        , fdNumber = 2-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = versionMinor-        , fdSet = \v m -> m { versionMinor = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "patch"-        , fdNumber = 3-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = versionPatch-        , fdSet = \v m -> m { versionPatch = v }-        })-    , (4, SomeField FieldDescriptor-        { fdName = "suffix"-        , fdNumber = 4-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = versionSuffix-        , fdSet = \v m -> m { versionSuffix = v }-        })-    ]--instance ProtoMessage Version where-  protoMessageName _ = "google.protobuf.compiler.Version"-  protoPackageName _ = "google.protobuf.compiler"-  protoDefaultValue = defaultVersion-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = versionFieldDescriptors--instance IsMessage Version--instance Aeson.ToJSON Version where-  toJSON msg = jsonObject-      [ "major" .=: msg.versionMajor-      , "minor" .=: msg.versionMinor-      , "patch" .=: msg.versionPatch-      , "suffix" .=: msg.versionSuffix-      ]--instance Aeson.FromJSON Version where-  parseJSON = Aeson.withObject "Version" $ \obj -> do-    fld_versionMajor <- parseFieldMaybe obj "major"-    fld_versionMinor <- parseFieldMaybe obj "minor"-    fld_versionPatch <- parseFieldMaybe obj "patch"-    fld_versionSuffix <- parseFieldMaybe obj "suffix"-    pure defaultVersion-      { versionMajor = maybe (versionMajor defaultVersion) id fld_versionMajor-      , versionMinor = maybe (versionMinor defaultVersion) id fld_versionMinor-      , versionPatch = maybe (versionPatch defaultVersion) id fld_versionPatch-      , versionSuffix = maybe (versionSuffix defaultVersion) id fld_versionSuffix-      }--instance Hashable Version where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.versionMajor) msg.versionMinor) msg.versionPatch) msg.versionSuffix--instance Proto.Extension.HasExtensions Version where-  messageUnknownFields = versionUnknownFields-  setMessageUnknownFields !ufs msg = msg { versionUnknownFields = ufs }--instance Semigroup Version where-  a <> b = Version-    { versionMajor = case b.versionMajor of { Nothing -> a.versionMajor; x -> x }-    , versionMinor = case b.versionMinor of { Nothing -> a.versionMinor; x -> x }-    , versionPatch = case b.versionPatch of { Nothing -> a.versionPatch; x -> x }-    , versionSuffix = case b.versionSuffix of { Nothing -> a.versionSuffix; x -> x }-    , versionUnknownFields = a.versionUnknownFields <> b.versionUnknownFields-    }+import Control.DeepSeq (NFData)+import System.IO (stdin, stdout, hSetBinaryMode) -instance Monoid Version where-  mempty = defaultVersion+import Proto.Encode+import Proto.Decode+import Proto.Internal.Wire (Tag(..))+import Proto.Google.Protobuf.Descriptor (FileDescriptorProto) --- | An encoded CodeGeneratorRequest is written to the plugin's stdin. data CodeGeneratorRequest = CodeGeneratorRequest-  { codeGeneratorRequestFileToGenerate :: !(V.Vector Text)-    -- ^ The .proto files that were explicitly listed on the command-line.  The-    -- code generator should generate code only for these files.  Each file's-    -- descriptor will be included in proto_file, below.-  , codeGeneratorRequestParameter :: !(Maybe Text)-    -- ^ The generator parameter passed on the command-line.-  , codeGeneratorRequestProtoFile :: !(V.Vector PB_Reflection_Descriptor.FileDescriptorProto)-    -- ^ FileDescriptorProtos for all files in files_to_generate and everything-    -- they import.  The files will appear in topological order, so each file-    -- appears before any file that imports it.-    -- -    -- Note: the files listed in files_to_generate will include runtime-retention-    -- options only, but all other files will include source-retention options.-    -- The source_file_descriptors field below is available in case you need-    -- source-retention options for files_to_generate.-    -- -    -- protoc guarantees that all proto_files will be written after-    -- the fields above, even though this is not technically guaranteed by the-    -- protobuf wire format.  This theoretically could allow a plugin to stream-    -- in the FileDescriptorProtos and handle them one by one rather than read-    -- the entire set into memory at once.  However, as of this writing, this-    -- is not similarly optimized on protoc's end -- it will store all fields in-    -- memory at once before sending them to the plugin.-    -- -    -- Type names of fields and extensions in the FileDescriptorProto are always-    -- fully qualified.-  , codeGeneratorRequestSourceFileDescriptors :: !(V.Vector PB_Reflection_Descriptor.FileDescriptorProto)-    -- ^ File descriptors with all options, including source-retention options.-    -- These descriptors are only provided for the files listed in-    -- files_to_generate.-  , codeGeneratorRequestCompilerVersion :: !(Maybe Version)-    -- ^ The version number of protocol compiler.-  , codeGeneratorRequestUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData+  { cgrFileToGenerate    :: !(V.Vector Text)+  , cgrParameter         :: !Text+  , cgrProtoFile         :: !(V.Vector FileDescriptorProto)+  } deriving stock (Show, Eq, Generic)+    deriving anyclass NFData  defaultCodeGeneratorRequest :: CodeGeneratorRequest-defaultCodeGeneratorRequest = CodeGeneratorRequest-  { codeGeneratorRequestFileToGenerate = V.empty-  , codeGeneratorRequestParameter = Nothing-  , codeGeneratorRequestProtoFile = V.empty-  , codeGeneratorRequestSourceFileDescriptors = V.empty-  , codeGeneratorRequestCompilerVersion = Nothing-  , codeGeneratorRequestUnknownFields = []-  }+defaultCodeGeneratorRequest = CodeGeneratorRequest V.empty "" V.empty  instance MessageEncode CodeGeneratorRequest where-  buildSized msg =-    V.foldl' (\acc v -> acc <> archString 10 v) mempty msg.codeGeneratorRequestFileToGenerate-    <> (maybe mempty (\v -> archString 18 v) msg.codeGeneratorRequestParameter)-    <> V.foldl' (\acc v -> acc <> archSubmessage 122 (buildSized v)) mempty msg.codeGeneratorRequestProtoFile-    <> V.foldl' (\acc v -> acc <> archSubmessage 138 (buildSized v)) mempty msg.codeGeneratorRequestSourceFileDescriptors-    <> (maybe mempty (\v -> archSubmessage 26 (buildSized v)) msg.codeGeneratorRequestCompilerVersion)-    <> encodeUnknownFieldsSized msg.codeGeneratorRequestUnknownFields+  buildMessage cgr =+    V.foldl' (\a f -> a <> encodeFieldString 1 f) mempty (cgrFileToGenerate cgr) <>+    (if cgrParameter cgr == "" then mempty else encodeFieldString 2 (cgrParameter cgr)) <>+    V.foldl' (\a p -> a <> encodeFieldMessage 15 p) mempty (cgrProtoFile cgr)  instance MessageDecode CodeGeneratorRequest where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultCodeGeneratorRequest emptyGrowList emptyGrowList emptyGrowList+  messageDecoder = loop defaultCodeGeneratorRequest     where-      stage_0 msg gl_0 gl_1 gl_2 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_0 msg (snocGrowList gl_0 v) gl_1 gl_2)-          (pure (case msg.codeGeneratorRequestUnknownFields of { [] -> msg { codeGeneratorRequestFileToGenerate = growListToVector gl_0, codeGeneratorRequestProtoFile = growListToVector gl_1, codeGeneratorRequestSourceFileDescriptors = growListToVector gl_2 }; _ -> msg { codeGeneratorRequestFileToGenerate = growListToVector gl_0, codeGeneratorRequestProtoFile = growListToVector gl_1, codeGeneratorRequestSourceFileDescriptors = growListToVector gl_2, codeGeneratorRequestUnknownFields = reverse (msg.codeGeneratorRequestUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2)-      stage_1 msg gl_0 gl_1 gl_2 =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_2 (msg { codeGeneratorRequestParameter = (Just v)}) gl_0 gl_1 gl_2)-          (pure (case msg.codeGeneratorRequestUnknownFields of { [] -> msg { codeGeneratorRequestFileToGenerate = growListToVector gl_0, codeGeneratorRequestProtoFile = growListToVector gl_1, codeGeneratorRequestSourceFileDescriptors = growListToVector gl_2 }; _ -> msg { codeGeneratorRequestFileToGenerate = growListToVector gl_0, codeGeneratorRequestProtoFile = growListToVector gl_1, codeGeneratorRequestSourceFileDescriptors = growListToVector gl_2, codeGeneratorRequestUnknownFields = reverse (msg.codeGeneratorRequestUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2)-      stage_2 msg gl_0 gl_1 gl_2 =-        inOrderStage1-          (0x7a :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_2 msg gl_0 (snocGrowList gl_1 v) gl_2)-          (pure (case msg.codeGeneratorRequestUnknownFields of { [] -> msg { codeGeneratorRequestFileToGenerate = growListToVector gl_0, codeGeneratorRequestProtoFile = growListToVector gl_1, codeGeneratorRequestSourceFileDescriptors = growListToVector gl_2 }; _ -> msg { codeGeneratorRequestFileToGenerate = growListToVector gl_0, codeGeneratorRequestProtoFile = growListToVector gl_1, codeGeneratorRequestSourceFileDescriptors = growListToVector gl_2, codeGeneratorRequestUnknownFields = reverse (msg.codeGeneratorRequestUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2)-      stage_3 msg gl_0 gl_1 gl_2 =-        inOrderStage-          0x18a-          0xffff-          2-          decodeFieldMessage-          (\v -> stage_3 msg gl_0 gl_1 (snocGrowList gl_2 v))-          (pure (case msg.codeGeneratorRequestUnknownFields of { [] -> msg { codeGeneratorRequestFileToGenerate = growListToVector gl_0, codeGeneratorRequestProtoFile = growListToVector gl_1, codeGeneratorRequestSourceFileDescriptors = growListToVector gl_2 }; _ -> msg { codeGeneratorRequestFileToGenerate = growListToVector gl_0, codeGeneratorRequestProtoFile = growListToVector gl_1, codeGeneratorRequestSourceFileDescriptors = growListToVector gl_2, codeGeneratorRequestUnknownFields = reverse (msg.codeGeneratorRequestUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2)-      stage_4 msg gl_0 gl_1 gl_2 =-        inOrderStage1-          (0x1a :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> loop (msg { codeGeneratorRequestCompilerVersion = (Just v)}) gl_0 gl_1 gl_2)-          (pure (case msg.codeGeneratorRequestUnknownFields of { [] -> msg { codeGeneratorRequestFileToGenerate = growListToVector gl_0, codeGeneratorRequestProtoFile = growListToVector gl_1, codeGeneratorRequestSourceFileDescriptors = growListToVector gl_2 }; _ -> msg { codeGeneratorRequestFileToGenerate = growListToVector gl_0, codeGeneratorRequestProtoFile = growListToVector gl_1, codeGeneratorRequestSourceFileDescriptors = growListToVector gl_2, codeGeneratorRequestUnknownFields = reverse (msg.codeGeneratorRequestUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2)-      loop msg gl_0 gl_1 gl_2 = withTagM-        (pure (case msg.codeGeneratorRequestUnknownFields of { [] -> msg { codeGeneratorRequestFileToGenerate = growListToVector gl_0, codeGeneratorRequestProtoFile = growListToVector gl_1, codeGeneratorRequestSourceFileDescriptors = growListToVector gl_2 }; _ -> msg { codeGeneratorRequestFileToGenerate = growListToVector gl_0, codeGeneratorRequestProtoFile = growListToVector gl_1, codeGeneratorRequestSourceFileDescriptors = growListToVector gl_2, codeGeneratorRequestUnknownFields = reverse (msg.codeGeneratorRequestUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop msg (snocGrowList gl_0 v) gl_1 gl_2-          2 -> do-            v <- decodeFieldString-            loop (msg { codeGeneratorRequestParameter = (Just v)}) gl_0 gl_1 gl_2-          15 -> do-            v <- decodeFieldMessage-            loop msg gl_0 (snocGrowList gl_1 v) gl_2-          17 -> do-            v <- decodeFieldMessage-            loop msg gl_0 gl_1 (snocGrowList gl_2 v)-          3 -> do-            v <- decodeFieldMessage-            loop (msg { codeGeneratorRequestCompilerVersion = (Just v)}) gl_0 gl_1 gl_2-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { codeGeneratorRequestUnknownFields = (uf : msg.codeGeneratorRequestUnknownFields)}) gl_0 gl_1 gl_2)---- | Field descriptors for 'CodeGeneratorRequest', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-codeGeneratorRequestFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor CodeGeneratorRequest)-codeGeneratorRequestFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "file_to_generate"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelRepeated-        , fdGet = codeGeneratorRequestFileToGenerate-        , fdSet = \v m -> m { codeGeneratorRequestFileToGenerate = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "parameter"-        , fdNumber = 2-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = codeGeneratorRequestParameter-        , fdSet = \v m -> m { codeGeneratorRequestParameter = v }-        })-    , (15, SomeField FieldDescriptor-        { fdName = "proto_file"-        , fdNumber = 15-        , fdTypeDesc = MessageType "FileDescriptorProto"-        , fdLabel = LabelRepeated-        , fdGet = codeGeneratorRequestProtoFile-        , fdSet = \v m -> m { codeGeneratorRequestProtoFile = v }-        })-    , (17, SomeField FieldDescriptor-        { fdName = "source_file_descriptors"-        , fdNumber = 17-        , fdTypeDesc = MessageType "FileDescriptorProto"-        , fdLabel = LabelRepeated-        , fdGet = codeGeneratorRequestSourceFileDescriptors-        , fdSet = \v m -> m { codeGeneratorRequestSourceFileDescriptors = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "compiler_version"-        , fdNumber = 3-        , fdTypeDesc = MessageType "Version"-        , fdLabel = LabelOptional-        , fdGet = codeGeneratorRequestCompilerVersion-        , fdSet = \v m -> m { codeGeneratorRequestCompilerVersion = v }-        })-    ]--instance ProtoMessage CodeGeneratorRequest where-  protoMessageName _ = "google.protobuf.compiler.CodeGeneratorRequest"-  protoPackageName _ = "google.protobuf.compiler"-  protoDefaultValue = defaultCodeGeneratorRequest-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = codeGeneratorRequestFieldDescriptors--instance IsMessage CodeGeneratorRequest--instance Aeson.ToJSON CodeGeneratorRequest where-  toJSON msg = jsonObject-      [ "fileToGenerate" .=: msg.codeGeneratorRequestFileToGenerate-      , "parameter" .=: msg.codeGeneratorRequestParameter-      , "protoFile" .=: msg.codeGeneratorRequestProtoFile-      , "sourceFileDescriptors" .=: msg.codeGeneratorRequestSourceFileDescriptors-      , "compilerVersion" .=: msg.codeGeneratorRequestCompilerVersion-      ]--instance Aeson.FromJSON CodeGeneratorRequest where-  parseJSON = Aeson.withObject "CodeGeneratorRequest" $ \obj -> do-    fld_codeGeneratorRequestFileToGenerate <- parseFieldMaybe obj "fileToGenerate"-    fld_codeGeneratorRequestParameter <- parseFieldMaybe obj "parameter"-    fld_codeGeneratorRequestProtoFile <- parseFieldMaybe obj "protoFile"-    fld_codeGeneratorRequestSourceFileDescriptors <- parseFieldMaybe obj "sourceFileDescriptors"-    fld_codeGeneratorRequestCompilerVersion <- parseFieldMaybe obj "compilerVersion"-    pure defaultCodeGeneratorRequest-      { codeGeneratorRequestFileToGenerate = maybe (codeGeneratorRequestFileToGenerate defaultCodeGeneratorRequest) id fld_codeGeneratorRequestFileToGenerate-      , codeGeneratorRequestParameter = maybe (codeGeneratorRequestParameter defaultCodeGeneratorRequest) id fld_codeGeneratorRequestParameter-      , codeGeneratorRequestProtoFile = maybe (codeGeneratorRequestProtoFile defaultCodeGeneratorRequest) id fld_codeGeneratorRequestProtoFile-      , codeGeneratorRequestSourceFileDescriptors = maybe (codeGeneratorRequestSourceFileDescriptors defaultCodeGeneratorRequest) id fld_codeGeneratorRequestSourceFileDescriptors-      , codeGeneratorRequestCompilerVersion = maybe (codeGeneratorRequestCompilerVersion defaultCodeGeneratorRequest) id fld_codeGeneratorRequestCompilerVersion-      }--instance Hashable CodeGeneratorRequest where-  hashWithSalt salt msg = hashWithSalt (V.foldl' hashWithSalt (V.foldl' hashWithSalt (hashWithSalt (V.foldl' hashWithSalt (salt) msg.codeGeneratorRequestFileToGenerate) msg.codeGeneratorRequestParameter) msg.codeGeneratorRequestProtoFile) msg.codeGeneratorRequestSourceFileDescriptors) msg.codeGeneratorRequestCompilerVersion--instance Proto.Extension.HasExtensions CodeGeneratorRequest where-  messageUnknownFields = codeGeneratorRequestUnknownFields-  setMessageUnknownFields !ufs msg = msg { codeGeneratorRequestUnknownFields = ufs }--instance Semigroup CodeGeneratorRequest where-  a <> b = CodeGeneratorRequest-    { codeGeneratorRequestFileToGenerate = a.codeGeneratorRequestFileToGenerate <> b.codeGeneratorRequestFileToGenerate-    , codeGeneratorRequestParameter = case b.codeGeneratorRequestParameter of { Nothing -> a.codeGeneratorRequestParameter; x -> x }-    , codeGeneratorRequestProtoFile = a.codeGeneratorRequestProtoFile <> b.codeGeneratorRequestProtoFile-    , codeGeneratorRequestSourceFileDescriptors = a.codeGeneratorRequestSourceFileDescriptors <> b.codeGeneratorRequestSourceFileDescriptors-    , codeGeneratorRequestCompilerVersion = case b.codeGeneratorRequestCompilerVersion of { Nothing -> a.codeGeneratorRequestCompilerVersion; x -> x }-    , codeGeneratorRequestUnknownFields = a.codeGeneratorRequestUnknownFields <> b.codeGeneratorRequestUnknownFields-    }--instance Monoid CodeGeneratorRequest where-  mempty = defaultCodeGeneratorRequest+      loop !r = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure r+          UJust (Tag 1 _)  -> do v <- decodeFieldString; loop r { cgrFileToGenerate = V.snoc (cgrFileToGenerate r) v }+          UJust (Tag 2 _)  -> do v <- decodeFieldString; loop r { cgrParameter = v }+          UJust (Tag 15 _) -> do v <- decodeFieldMessage; loop r { cgrProtoFile = V.snoc (cgrProtoFile r) v }+          UJust (Tag _ wt) -> skipField wt >> loop r --- | The plugin writes an encoded CodeGeneratorResponse to stdout. data CodeGeneratorResponse = CodeGeneratorResponse-  { codeGeneratorResponseError :: !(Maybe Text)-    -- ^ Error message.  If non-empty, code generation failed.  The plugin process-    -- should exit with status code zero even if it reports an error in this way.-    -- -    -- This should be used to indicate errors in .proto files which prevent the-    -- code generator from generating correct code.  Errors which indicate a-    -- problem in protoc itself -- such as the input CodeGeneratorRequest being-    -- unparseable -- should be reported by writing a message to stderr and-    -- exiting with a non-zero status code.-  , codeGeneratorResponseSupportedFeatures :: !(Maybe Word64)-    -- ^ A bitmask of supported features that the code generator supports.-    -- This is a bitwise "or" of values from the Feature enum.-  , codeGeneratorResponseMinimumEdition :: !(Maybe Int32)-    -- ^ The minimum edition this plugin supports.  This will be treated as an-    -- Edition enum, but we want to allow unknown values.  It should be specified-    -- according the edition enum value, *not* the edition number.  Only takes-    -- effect for plugins that have FEATURE_SUPPORTS_EDITIONS set.-  , codeGeneratorResponseMaximumEdition :: !(Maybe Int32)-    -- ^ The maximum edition this plugin supports.  This will be treated as an-    -- Edition enum, but we want to allow unknown values.  It should be specified-    -- according the edition enum value, *not* the edition number.  Only takes-    -- effect for plugins that have FEATURE_SUPPORTS_EDITIONS set.-  , codeGeneratorResponseFile :: !(V.Vector CodeGeneratorResponse'File)-  , codeGeneratorResponseUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData---- | Sync with code_generator.h.-data CodeGeneratorResponse'Feature-  = CodeGeneratorResponse'Feature'FeatureNone-  | CodeGeneratorResponse'Feature'FeatureProto3Optional-  | CodeGeneratorResponse'Feature'FeatureSupportsEditions-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumCodeGeneratorResponse'Feature :: CodeGeneratorResponse'Feature -> Int-toProtoEnumCodeGeneratorResponse'Feature CodeGeneratorResponse'Feature'FeatureNone = 0-toProtoEnumCodeGeneratorResponse'Feature CodeGeneratorResponse'Feature'FeatureProto3Optional = 1-toProtoEnumCodeGeneratorResponse'Feature CodeGeneratorResponse'Feature'FeatureSupportsEditions = 2--fromProtoEnumCodeGeneratorResponse'Feature :: Int -> Maybe CodeGeneratorResponse'Feature-fromProtoEnumCodeGeneratorResponse'Feature 0 = Just CodeGeneratorResponse'Feature'FeatureNone-fromProtoEnumCodeGeneratorResponse'Feature 1 = Just CodeGeneratorResponse'Feature'FeatureProto3Optional-fromProtoEnumCodeGeneratorResponse'Feature 2 = Just CodeGeneratorResponse'Feature'FeatureSupportsEditions-fromProtoEnumCodeGeneratorResponse'Feature _ = Nothing--instance MessageEncode CodeGeneratorResponse'Feature where-  buildSized _ = mempty-instance MessageDecode CodeGeneratorResponse'Feature where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON CodeGeneratorResponse'Feature where-  toJSON CodeGeneratorResponse'Feature'FeatureNone = Aeson.String "FEATURE_NONE"-  toJSON CodeGeneratorResponse'Feature'FeatureProto3Optional = Aeson.String "FEATURE_PROTO3_OPTIONAL"-  toJSON CodeGeneratorResponse'Feature'FeatureSupportsEditions = Aeson.String "FEATURE_SUPPORTS_EDITIONS"--instance Aeson.FromJSON CodeGeneratorResponse'Feature where-  parseJSON = \case-    Aeson.String "FEATURE_NONE" -> pure CodeGeneratorResponse'Feature'FeatureNone-    Aeson.String "FEATURE_PROTO3_OPTIONAL" -> pure CodeGeneratorResponse'Feature'FeatureProto3Optional-    Aeson.String "FEATURE_SUPPORTS_EDITIONS" -> pure CodeGeneratorResponse'Feature'FeatureSupportsEditions-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for CodeGeneratorResponse'Feature"--instance Hashable CodeGeneratorResponse'Feature where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumCodeGeneratorResponse'Feature x)---- | Represents a single generated file.-data CodeGeneratorResponse'File = CodeGeneratorResponse'File-  { codeGeneratorResponseFileName :: !(Maybe Text)-    -- ^ The file name, relative to the output directory.  The name must not-    -- contain "." or ".." components and must be relative, not be absolute (so,-    -- the file cannot lie outside the output directory).  "/" must be used as-    -- the path separator, not "\".-    -- -    -- If the name is omitted, the content will be appended to the previous-    -- file.  This allows the generator to break large files into small chunks,-    -- and allows the generated text to be streamed back to protoc so that large-    -- files need not reside completely in memory at one time.  Note that as of-    -- this writing protoc does not optimize for this -- it will read the entire-    -- CodeGeneratorResponse before writing files to disk.-  , codeGeneratorResponseFileInsertionPoint :: !(Maybe Text)-    -- ^ If non-empty, indicates that the named file should already exist, and the-    -- content here is to be inserted into that file at a defined insertion-    -- point.  This feature allows a code generator to extend the output-    -- produced by another code generator.  The original generator may provide-    -- insertion points by placing special annotations in the file that look-    -- like:-    --   @@protoc_insertion_point(NAME)-    -- The annotation can have arbitrary text before and after it on the line,-    -- which allows it to be placed in a comment.  NAME should be replaced with-    -- an identifier naming the point -- this is what other generators will use-    -- as the insertion_point.  Code inserted at this point will be placed-    -- immediately above the line containing the insertion point (thus multiple-    -- insertions to the same point will come out in the order they were added).-    -- The double-@ is intended to make it unlikely that the generated code-    -- could contain things that look like insertion points by accident.-    -- -    -- For example, the C++ code generator places the following line in the-    -- .pb.h files that it generates:-    --   // @@protoc_insertion_point(namespace_scope)-    -- This line appears within the scope of the file's package namespace, but-    -- outside of any particular class.  Another plugin can then specify the-    -- insertion_point "namespace_scope" to generate additional classes or-    -- other declarations that should be placed in this scope.-    -- -    -- Note that if the line containing the insertion point begins with-    -- whitespace, the same whitespace will be added to every line of the-    -- inserted text.  This is useful for languages like Python, where-    -- indentation matters.  In these languages, the insertion point comment-    -- should be indented the same amount as any inserted code will need to be-    -- in order to work correctly in that context.-    -- -    -- The code generator that generates the initial file and the one which-    -- inserts into it must both run as part of a single invocation of protoc.-    -- Code generators are executed in the order in which they appear on the-    -- command line.-    -- -    -- If |insertion_point| is present, |name| must also be present.-  , codeGeneratorResponseFileContent :: !(Maybe Text)-    -- ^ The file contents.-  , codeGeneratorResponseFileGeneratedCodeInfo :: !(Maybe PB_Reflection_Descriptor.GeneratedCodeInfo)-    -- ^ Information describing the file content being inserted. If an insertion-    -- point is used, this information will be appropriately offset and inserted-    -- into the code generation metadata for the generated files.-  , codeGeneratorResponseFileUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultCodeGeneratorResponse'File :: CodeGeneratorResponse'File-defaultCodeGeneratorResponse'File = CodeGeneratorResponse'File-  { codeGeneratorResponseFileName = Nothing-  , codeGeneratorResponseFileInsertionPoint = Nothing-  , codeGeneratorResponseFileContent = Nothing-  , codeGeneratorResponseFileGeneratedCodeInfo = Nothing-  , codeGeneratorResponseFileUnknownFields = []-  }--instance MessageEncode CodeGeneratorResponse'File where-  buildSized msg =-    (maybe mempty (\v -> archString 10 v) msg.codeGeneratorResponseFileName)-    <> (maybe mempty (\v -> archString 18 v) msg.codeGeneratorResponseFileInsertionPoint)-    <> (maybe mempty (\v -> archString 122 v) msg.codeGeneratorResponseFileContent)-    <> (maybe mempty (\v -> archSubmessage 130 (buildSized v)) msg.codeGeneratorResponseFileGeneratedCodeInfo)-    <> encodeUnknownFieldsSized msg.codeGeneratorResponseFileUnknownFields--instance MessageDecode CodeGeneratorResponse'File where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultCodeGeneratorResponse'File-    where-      stage_0 msg =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_1 (msg { codeGeneratorResponseFileName = (Just v)}))-          (pure (case msg.codeGeneratorResponseFileUnknownFields of { [] -> msg; _ -> msg { codeGeneratorResponseFileUnknownFields = reverse (msg.codeGeneratorResponseFileUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_2 (msg { codeGeneratorResponseFileInsertionPoint = (Just v)}))-          (pure (case msg.codeGeneratorResponseFileUnknownFields of { [] -> msg; _ -> msg { codeGeneratorResponseFileUnknownFields = reverse (msg.codeGeneratorResponseFileUnknownFields) } }))-          (loop msg)-      stage_2 msg =-        inOrderStage1-          (0x7a :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_3 (msg { codeGeneratorResponseFileContent = (Just v)}))-          (pure (case msg.codeGeneratorResponseFileUnknownFields of { [] -> msg; _ -> msg { codeGeneratorResponseFileUnknownFields = reverse (msg.codeGeneratorResponseFileUnknownFields) } }))-          (loop msg)-      stage_3 msg =-        inOrderStage-          0x182-          0xffff-          2-          decodeFieldMessage-          (\v -> loop (msg { codeGeneratorResponseFileGeneratedCodeInfo = (Just v)}))-          (pure (case msg.codeGeneratorResponseFileUnknownFields of { [] -> msg; _ -> msg { codeGeneratorResponseFileUnknownFields = reverse (msg.codeGeneratorResponseFileUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.codeGeneratorResponseFileUnknownFields of { [] -> msg; _ -> msg { codeGeneratorResponseFileUnknownFields = reverse (msg.codeGeneratorResponseFileUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { codeGeneratorResponseFileName = (Just v)})-          2 -> do-            v <- decodeFieldString-            loop (msg { codeGeneratorResponseFileInsertionPoint = (Just v)})-          15 -> do-            v <- decodeFieldString-            loop (msg { codeGeneratorResponseFileContent = (Just v)})-          16 -> do-            v <- decodeFieldMessage-            loop (msg { codeGeneratorResponseFileGeneratedCodeInfo = (Just v)})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { codeGeneratorResponseFileUnknownFields = (uf : msg.codeGeneratorResponseFileUnknownFields)}))---- | Field descriptors for 'CodeGeneratorResponse'File', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-codeGeneratorResponse'FileFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor CodeGeneratorResponse'File)-codeGeneratorResponse'FileFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "name"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = codeGeneratorResponseFileName-        , fdSet = \v m -> m { codeGeneratorResponseFileName = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "insertion_point"-        , fdNumber = 2-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = codeGeneratorResponseFileInsertionPoint-        , fdSet = \v m -> m { codeGeneratorResponseFileInsertionPoint = v }-        })-    , (15, SomeField FieldDescriptor-        { fdName = "content"-        , fdNumber = 15-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = codeGeneratorResponseFileContent-        , fdSet = \v m -> m { codeGeneratorResponseFileContent = v }-        })-    , (16, SomeField FieldDescriptor-        { fdName = "generated_code_info"-        , fdNumber = 16-        , fdTypeDesc = MessageType "GeneratedCodeInfo"-        , fdLabel = LabelOptional-        , fdGet = codeGeneratorResponseFileGeneratedCodeInfo-        , fdSet = \v m -> m { codeGeneratorResponseFileGeneratedCodeInfo = v }-        })-    ]--instance ProtoMessage CodeGeneratorResponse'File where-  protoMessageName _ = "google.protobuf.compiler.CodeGeneratorResponse.File"-  protoPackageName _ = "google.protobuf.compiler"-  protoDefaultValue = defaultCodeGeneratorResponse'File-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = codeGeneratorResponse'FileFieldDescriptors--instance IsMessage CodeGeneratorResponse'File--instance Aeson.ToJSON CodeGeneratorResponse'File where-  toJSON msg = jsonObject-      [ "name" .=: msg.codeGeneratorResponseFileName-      , "insertionPoint" .=: msg.codeGeneratorResponseFileInsertionPoint-      , "content" .=: msg.codeGeneratorResponseFileContent-      , "generatedCodeInfo" .=: msg.codeGeneratorResponseFileGeneratedCodeInfo-      ]--instance Aeson.FromJSON CodeGeneratorResponse'File where-  parseJSON = Aeson.withObject "CodeGeneratorResponse'File" $ \obj -> do-    fld_codeGeneratorResponseFileName <- parseFieldMaybe obj "name"-    fld_codeGeneratorResponseFileInsertionPoint <- parseFieldMaybe obj "insertionPoint"-    fld_codeGeneratorResponseFileContent <- parseFieldMaybe obj "content"-    fld_codeGeneratorResponseFileGeneratedCodeInfo <- parseFieldMaybe obj "generatedCodeInfo"-    pure defaultCodeGeneratorResponse'File-      { codeGeneratorResponseFileName = maybe (codeGeneratorResponseFileName defaultCodeGeneratorResponse'File) id fld_codeGeneratorResponseFileName-      , codeGeneratorResponseFileInsertionPoint = maybe (codeGeneratorResponseFileInsertionPoint defaultCodeGeneratorResponse'File) id fld_codeGeneratorResponseFileInsertionPoint-      , codeGeneratorResponseFileContent = maybe (codeGeneratorResponseFileContent defaultCodeGeneratorResponse'File) id fld_codeGeneratorResponseFileContent-      , codeGeneratorResponseFileGeneratedCodeInfo = maybe (codeGeneratorResponseFileGeneratedCodeInfo defaultCodeGeneratorResponse'File) id fld_codeGeneratorResponseFileGeneratedCodeInfo-      }--instance Hashable CodeGeneratorResponse'File where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.codeGeneratorResponseFileName) msg.codeGeneratorResponseFileInsertionPoint) msg.codeGeneratorResponseFileContent) msg.codeGeneratorResponseFileGeneratedCodeInfo--instance Proto.Extension.HasExtensions CodeGeneratorResponse'File where-  messageUnknownFields = codeGeneratorResponseFileUnknownFields-  setMessageUnknownFields !ufs msg = msg { codeGeneratorResponseFileUnknownFields = ufs }--instance Semigroup CodeGeneratorResponse'File where-  a <> b = CodeGeneratorResponse'File-    { codeGeneratorResponseFileName = case b.codeGeneratorResponseFileName of { Nothing -> a.codeGeneratorResponseFileName; x -> x }-    , codeGeneratorResponseFileInsertionPoint = case b.codeGeneratorResponseFileInsertionPoint of { Nothing -> a.codeGeneratorResponseFileInsertionPoint; x -> x }-    , codeGeneratorResponseFileContent = case b.codeGeneratorResponseFileContent of { Nothing -> a.codeGeneratorResponseFileContent; x -> x }-    , codeGeneratorResponseFileGeneratedCodeInfo = case b.codeGeneratorResponseFileGeneratedCodeInfo of { Nothing -> a.codeGeneratorResponseFileGeneratedCodeInfo; x -> x }-    , codeGeneratorResponseFileUnknownFields = a.codeGeneratorResponseFileUnknownFields <> b.codeGeneratorResponseFileUnknownFields-    }--instance Monoid CodeGeneratorResponse'File where-  mempty = defaultCodeGeneratorResponse'File+  { cgrsError   :: !Text+  , cgrsFile    :: !(V.Vector CodeGeneratorResponseFile)+  , cgrsSupportedFeatures :: !Int+  } deriving stock (Show, Eq, Generic)+    deriving anyclass NFData  defaultCodeGeneratorResponse :: CodeGeneratorResponse-defaultCodeGeneratorResponse = CodeGeneratorResponse-  { codeGeneratorResponseError = Nothing-  , codeGeneratorResponseSupportedFeatures = Nothing-  , codeGeneratorResponseMinimumEdition = Nothing-  , codeGeneratorResponseMaximumEdition = Nothing-  , codeGeneratorResponseFile = V.empty-  , codeGeneratorResponseUnknownFields = []-  }+defaultCodeGeneratorResponse = CodeGeneratorResponse "" V.empty 0  instance MessageEncode CodeGeneratorResponse where-  buildSized msg =-    (maybe mempty (\v -> archString 10 v) msg.codeGeneratorResponseError)-    <> (maybe mempty (\v -> archVarint 16 v) msg.codeGeneratorResponseSupportedFeatures)-    <> (maybe mempty (\v -> archVarint 24 (fromIntegral v)) msg.codeGeneratorResponseMinimumEdition)-    <> (maybe mempty (\v -> archVarint 32 (fromIntegral v)) msg.codeGeneratorResponseMaximumEdition)-    <> V.foldl' (\acc v -> acc <> archSubmessage 122 (buildSized v)) mempty msg.codeGeneratorResponseFile-    <> encodeUnknownFieldsSized msg.codeGeneratorResponseUnknownFields+  buildMessage cgr =+    (if cgrsError cgr == "" then mempty else encodeFieldString 1 (cgrsError cgr)) <>+    (if cgrsSupportedFeatures cgr == 0 then mempty+     else encodeFieldVarint 2 (fromIntegral (cgrsSupportedFeatures cgr))) <>+    V.foldl' (\a f -> a <> encodeFieldMessage 15 f) mempty (cgrsFile cgr)  instance MessageDecode CodeGeneratorResponse where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultCodeGeneratorResponse emptyGrowList+  messageDecoder = loop defaultCodeGeneratorResponse     where-      stage_0 msg gl_0 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_1 (msg { codeGeneratorResponseError = (Just v)}) gl_0)-          (pure (case msg.codeGeneratorResponseUnknownFields of { [] -> msg { codeGeneratorResponseFile = growListToVector gl_0 }; _ -> msg { codeGeneratorResponseFile = growListToVector gl_0, codeGeneratorResponseUnknownFields = reverse (msg.codeGeneratorResponseUnknownFields) } }))-          (loop msg gl_0)-      stage_1 msg gl_0 =-        inOrderStage1-          (0x10 :: Data.Word.Word8)-          decodeFieldVarint-          (\v -> stage_2 (msg { codeGeneratorResponseSupportedFeatures = (Just v)}) gl_0)-          (pure (case msg.codeGeneratorResponseUnknownFields of { [] -> msg { codeGeneratorResponseFile = growListToVector gl_0 }; _ -> msg { codeGeneratorResponseFile = growListToVector gl_0, codeGeneratorResponseUnknownFields = reverse (msg.codeGeneratorResponseUnknownFields) } }))-          (loop msg gl_0)-      stage_2 msg gl_0 =-        inOrderStage1-          (0x18 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_3 (msg { codeGeneratorResponseMinimumEdition = (Just v)}) gl_0)-          (pure (case msg.codeGeneratorResponseUnknownFields of { [] -> msg { codeGeneratorResponseFile = growListToVector gl_0 }; _ -> msg { codeGeneratorResponseFile = growListToVector gl_0, codeGeneratorResponseUnknownFields = reverse (msg.codeGeneratorResponseUnknownFields) } }))-          (loop msg gl_0)-      stage_3 msg gl_0 =-        inOrderStage1-          (0x20 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_4 (msg { codeGeneratorResponseMaximumEdition = (Just v)}) gl_0)-          (pure (case msg.codeGeneratorResponseUnknownFields of { [] -> msg { codeGeneratorResponseFile = growListToVector gl_0 }; _ -> msg { codeGeneratorResponseFile = growListToVector gl_0, codeGeneratorResponseUnknownFields = reverse (msg.codeGeneratorResponseUnknownFields) } }))-          (loop msg gl_0)-      stage_4 msg gl_0 =-        inOrderStage1-          (0x7a :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_4 msg (snocGrowList gl_0 v))-          (pure (case msg.codeGeneratorResponseUnknownFields of { [] -> msg { codeGeneratorResponseFile = growListToVector gl_0 }; _ -> msg { codeGeneratorResponseFile = growListToVector gl_0, codeGeneratorResponseUnknownFields = reverse (msg.codeGeneratorResponseUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.codeGeneratorResponseUnknownFields of { [] -> msg { codeGeneratorResponseFile = growListToVector gl_0 }; _ -> msg { codeGeneratorResponseFile = growListToVector gl_0, codeGeneratorResponseUnknownFields = reverse (msg.codeGeneratorResponseUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { codeGeneratorResponseError = (Just v)}) gl_0-          2 -> do-            v <- decodeFieldVarint-            loop (msg { codeGeneratorResponseSupportedFeatures = (Just v)}) gl_0-          3 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { codeGeneratorResponseMinimumEdition = (Just v)}) gl_0-          4 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { codeGeneratorResponseMaximumEdition = (Just v)}) gl_0-          15 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { codeGeneratorResponseUnknownFields = (uf : msg.codeGeneratorResponseUnknownFields)}) gl_0)---- | Field descriptors for 'CodeGeneratorResponse', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-codeGeneratorResponseFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor CodeGeneratorResponse)-codeGeneratorResponseFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "error"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = codeGeneratorResponseError-        , fdSet = \v m -> m { codeGeneratorResponseError = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "supported_features"-        , fdNumber = 2-        , fdTypeDesc = ScalarType UInt64Field-        , fdLabel = LabelOptional-        , fdGet = codeGeneratorResponseSupportedFeatures-        , fdSet = \v m -> m { codeGeneratorResponseSupportedFeatures = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "minimum_edition"-        , fdNumber = 3-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = codeGeneratorResponseMinimumEdition-        , fdSet = \v m -> m { codeGeneratorResponseMinimumEdition = v }-        })-    , (4, SomeField FieldDescriptor-        { fdName = "maximum_edition"-        , fdNumber = 4-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = codeGeneratorResponseMaximumEdition-        , fdSet = \v m -> m { codeGeneratorResponseMaximumEdition = v }-        })-    , (15, SomeField FieldDescriptor-        { fdName = "file"-        , fdNumber = 15-        , fdTypeDesc = MessageType "File"-        , fdLabel = LabelRepeated-        , fdGet = codeGeneratorResponseFile-        , fdSet = \v m -> m { codeGeneratorResponseFile = v }-        })-    ]--instance ProtoMessage CodeGeneratorResponse where-  protoMessageName _ = "google.protobuf.compiler.CodeGeneratorResponse"-  protoPackageName _ = "google.protobuf.compiler"-  protoDefaultValue = defaultCodeGeneratorResponse-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = codeGeneratorResponseFieldDescriptors--instance IsMessage CodeGeneratorResponse--instance Aeson.ToJSON CodeGeneratorResponse where-  toJSON msg = jsonObject-      [ "error" .=: msg.codeGeneratorResponseError-      , "supportedFeatures" .=: msg.codeGeneratorResponseSupportedFeatures-      , "minimumEdition" .=: msg.codeGeneratorResponseMinimumEdition-      , "maximumEdition" .=: msg.codeGeneratorResponseMaximumEdition-      , "file" .=: msg.codeGeneratorResponseFile-      ]+      loop !r = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure r+          UJust (Tag 1 _)  -> do v <- decodeFieldString; loop r { cgrsError = v }+          UJust (Tag 2 _)  -> do v <- getVarint; loop r { cgrsSupportedFeatures = fromIntegral v }+          UJust (Tag 15 _) -> do v <- decodeFieldMessage; loop r { cgrsFile = V.snoc (cgrsFile r) v }+          UJust (Tag _ wt) -> skipField wt >> loop r -instance Aeson.FromJSON CodeGeneratorResponse where-  parseJSON = Aeson.withObject "CodeGeneratorResponse" $ \obj -> do-    fld_codeGeneratorResponseError <- parseFieldMaybe obj "error"-    fld_codeGeneratorResponseSupportedFeatures <- parseFieldMaybe obj "supportedFeatures"-    fld_codeGeneratorResponseMinimumEdition <- parseFieldMaybe obj "minimumEdition"-    fld_codeGeneratorResponseMaximumEdition <- parseFieldMaybe obj "maximumEdition"-    fld_codeGeneratorResponseFile <- parseFieldMaybe obj "file"-    pure defaultCodeGeneratorResponse-      { codeGeneratorResponseError = maybe (codeGeneratorResponseError defaultCodeGeneratorResponse) id fld_codeGeneratorResponseError-      , codeGeneratorResponseSupportedFeatures = maybe (codeGeneratorResponseSupportedFeatures defaultCodeGeneratorResponse) id fld_codeGeneratorResponseSupportedFeatures-      , codeGeneratorResponseMinimumEdition = maybe (codeGeneratorResponseMinimumEdition defaultCodeGeneratorResponse) id fld_codeGeneratorResponseMinimumEdition-      , codeGeneratorResponseMaximumEdition = maybe (codeGeneratorResponseMaximumEdition defaultCodeGeneratorResponse) id fld_codeGeneratorResponseMaximumEdition-      , codeGeneratorResponseFile = maybe (codeGeneratorResponseFile defaultCodeGeneratorResponse) id fld_codeGeneratorResponseFile-      }+data CodeGeneratorResponseFile = CodeGeneratorResponseFile+  { cgrfName    :: !Text+  , cgrfContent :: !Text+  } deriving stock (Show, Eq, Generic)+    deriving anyclass NFData -instance Hashable CodeGeneratorResponse where-  hashWithSalt salt msg = V.foldl' hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.codeGeneratorResponseError) msg.codeGeneratorResponseSupportedFeatures) msg.codeGeneratorResponseMinimumEdition) msg.codeGeneratorResponseMaximumEdition) msg.codeGeneratorResponseFile+defaultCodeGeneratorResponseFile :: CodeGeneratorResponseFile+defaultCodeGeneratorResponseFile = CodeGeneratorResponseFile "" "" -instance Proto.Extension.HasExtensions CodeGeneratorResponse where-  messageUnknownFields = codeGeneratorResponseUnknownFields-  setMessageUnknownFields !ufs msg = msg { codeGeneratorResponseUnknownFields = ufs }+instance MessageEncode CodeGeneratorResponseFile where+  buildMessage f =+    (if cgrfName f == "" then mempty else encodeFieldString 1 (cgrfName f)) <>+    (if cgrfContent f == "" then mempty else encodeFieldString 15 (cgrfContent f)) -instance Semigroup CodeGeneratorResponse where-  a <> b = CodeGeneratorResponse-    { codeGeneratorResponseError = case b.codeGeneratorResponseError of { Nothing -> a.codeGeneratorResponseError; x -> x }-    , codeGeneratorResponseSupportedFeatures = case b.codeGeneratorResponseSupportedFeatures of { Nothing -> a.codeGeneratorResponseSupportedFeatures; x -> x }-    , codeGeneratorResponseMinimumEdition = case b.codeGeneratorResponseMinimumEdition of { Nothing -> a.codeGeneratorResponseMinimumEdition; x -> x }-    , codeGeneratorResponseMaximumEdition = case b.codeGeneratorResponseMaximumEdition of { Nothing -> a.codeGeneratorResponseMaximumEdition; x -> x }-    , codeGeneratorResponseFile = a.codeGeneratorResponseFile <> b.codeGeneratorResponseFile-    , codeGeneratorResponseUnknownFields = a.codeGeneratorResponseUnknownFields <> b.codeGeneratorResponseUnknownFields-    }+instance MessageDecode CodeGeneratorResponseFile where+  messageDecoder = loop defaultCodeGeneratorResponseFile+    where+      loop !f = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure f+          UJust (Tag 1 _)  -> do v <- decodeFieldString; loop f { cgrfName = v }+          UJust (Tag 15 _) -> do v <- decodeFieldString; loop f { cgrfContent = v }+          UJust (Tag _ wt) -> skipField wt >> loop f -instance Monoid CodeGeneratorResponse where-  mempty = defaultCodeGeneratorResponse+-- | Entry point for a protoc plugin.+-- Reads a CodeGeneratorRequest from stdin, applies the handler,+-- and writes the CodeGeneratorResponse to stdout.+pluginMain :: (CodeGeneratorRequest -> IO CodeGeneratorResponse) -> IO ()+pluginMain handler = do+  hSetBinaryMode stdin True+  hSetBinaryMode stdout True+  input <- BS.hGetContents stdin+  case decodeMessage input of+    Left err -> do+      let resp = defaultCodeGeneratorResponse { cgrsError = T.pack (show err) }+      BS.hPut stdout (encodeMessage resp)+    Right req -> do+      resp <- handler req+      BS.hPut stdout (encodeMessage resp)
− src/Proto/Google/Protobuf/Compiler/Plugin/Util.hs 
@@ -1,93 +0,0 @@-{- | Hand-written companion to 'Proto.Google.Protobuf.Compiler.Plugin'.--The @Plugin.hs@ module itself is *codegen output* from the upstream-@google\/protobuf\/compiler\/plugin.proto@ — pure data types plus-wire / JSON codecs, no IO. The @protoc@ side of the protocol (read-'CodeGeneratorRequest' off stdin, hand to a handler, write-'CodeGeneratorResponse' to stdout) is a hand-written wrapper because-it depends on @System.IO@ and isn't expressible in proto IDL. It-lives here, in the @Util@ sibling, so a regen pass over the @.proto@-file never clobbers it.--}-module Proto.Google.Protobuf.Compiler.Plugin.Util-  ( -- * Plugin entry point-    pluginMain--    -- * Convenience constructors-  , makeErrorResponse-  , makeFileResponse-  , responseFile-  ) where--import Control.Exception (SomeException, try)-import Data.ByteString qualified as BS-import Data.Text (Text)-import Data.Text qualified as T-import Data.Vector qualified as V-import System.IO (hSetBinaryMode, stderr, stdin, stdout)-import System.IO qualified as IO--import Proto (decodeMessage)-import Proto (encodeMessage)-import Proto.Google.Protobuf.Compiler.Plugin-  ( CodeGeneratorRequest-  , CodeGeneratorResponse-  , CodeGeneratorResponse'File-  , defaultCodeGeneratorResponse-  , defaultCodeGeneratorResponse'File-  )-import Proto.Google.Protobuf.Compiler.Plugin qualified as P---{- | Entry point for a @protoc@ plugin.--Reads a 'CodeGeneratorRequest' from @stdin@, hands it to the-supplied handler, and writes the resulting 'CodeGeneratorResponse'-back out to @stdout@. The handler runs in @IO@ so it can do-filesystem lookups, fetch external resources, etc., but the-top-level wire framing is exactly what @protoc@ expects from any-plugin executable.--If decoding the request fails — or the handler itself throws — the-exception is converted into a @CodeGeneratorResponse{ error = ... }@-on the wire. @protoc@'s convention is that plugin executables exit-with status 0 even when reporting a generation error; the error-message goes through the @error@ field. Genuine plumbing failures-(stdin closed, stdout broken pipe) propagate normally and end the-process.--}-pluginMain :: (CodeGeneratorRequest -> IO CodeGeneratorResponse) -> IO ()-pluginMain handler = do-  hSetBinaryMode stdin True-  hSetBinaryMode stdout True-  input <- BS.hGetContents stdin-  case decodeMessage input of-    Left err -> writeOut (makeErrorResponse (T.pack ("protoc-gen-wireform: decode error: " <> show err)))-    Right req -> do-      result <- try @SomeException (handler req)-      case result of-        Left exn -> writeOut (makeErrorResponse (T.pack ("protoc-gen-wireform: handler raised: " <> show exn)))-        Right resp -> writeOut resp-  where-    writeOut resp = BS.hPut stdout (encodeMessage resp)----- | A 'CodeGeneratorResponse' carrying just an error message.-makeErrorResponse :: Text -> CodeGeneratorResponse-makeErrorResponse msg =-  defaultCodeGeneratorResponse {P.codeGeneratorResponseError = Just msg}----- | A 'CodeGeneratorResponse' carrying the given output files.-makeFileResponse :: [CodeGeneratorResponse'File] -> CodeGeneratorResponse-makeFileResponse fs =-  defaultCodeGeneratorResponse {P.codeGeneratorResponseFile = V.fromList fs}----- | Build a 'CodeGeneratorResponse'File' from a path and contents.-responseFile :: Text -> Text -> CodeGeneratorResponse'File-responseFile path contents =-  defaultCodeGeneratorResponse'File-    { P.codeGeneratorResponseFileName = Just path-    , P.codeGeneratorResponseFileContent = Just contents-    }
+ src/Proto/Google/Protobuf/Descriptor.hs view
@@ -0,0 +1,982 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Haskell types for the full @google/protobuf/descriptor.proto@.+--+-- These are the core descriptor types used by protoc and other protobuf tools:+-- @FileDescriptorProto@ and friends, the per-element @*Options@ messages, the+-- @SourceCodeInfo@ / @GeneratedCodeInfo@ side tables, and @UninterpretedOption@.+--+-- This module is deliberately hand-written rather than produced by the+-- @regen-wkt@ code generator: it is the bootstrap type that the generator+-- itself uses to embed a serialized @FileDescriptorProto@ in every generated+-- module, so it cannot depend on generated output.+--+-- Every message preserves __unknown fields__ on decode and re-emits them on+-- encode (the @*UnknownFields@ accessor + 'Proto.Decode.captureUnknownField' /+-- 'Proto.Decode.encodeUnknownFields'). This is what lets custom options —+-- most importantly protobuf option /extensions/ such as @buf.validate@'s+-- extension #1159 on 'FieldOptions' / 'MessageOptions' — survive a+-- decode/encode round trip even though they are not modeled as typed fields.+-- See "Proto.IDL.Descriptor" for AST conversion and (downstream)+-- @Protovalidate.Descriptor@ for reading @buf.validate@ rules out of a+-- 'FileDescriptorSet'.+--+-- Field numbers and types follow @descriptor.proto@. The classic+-- packed-repeated @int32@ side fields (@public_dependency@, @weak_dependency@,+-- @SourceCodeInfo.Location.path/span@) are not given typed accessors; they are+-- preserved losslessly as unknown fields.+module Proto.Google.Protobuf.Descriptor where++import Control.DeepSeq (NFData)+import Data.ByteString (ByteString)+import Data.Int (Int32, Int64)+import Data.Text (Text)+import qualified Data.Vector as V+import Data.Word (Word64)+import GHC.Generics (Generic)++import Proto.Decode+import Proto.Encode+import Proto.Internal.Wire (Tag (..))++----------------------------------------------------------------------+-- FileDescriptorSet+----------------------------------------------------------------------++data FileDescriptorSet = FileDescriptorSet+  { fdsFile :: !(V.Vector FileDescriptorProto)+  , fdsUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultFileDescriptorSet :: FileDescriptorSet+defaultFileDescriptorSet = FileDescriptorSet V.empty []++instance MessageEncode FileDescriptorSet where+  buildMessage m =+    V.foldl' (\a f -> a <> encodeFieldMessage 1 f) mempty (fdsFile m)+      <> encodeUnknownFields (fdsUnknownFields m)++instance MessageDecode FileDescriptorSet where+  messageDecoder = loop defaultFileDescriptorSet+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {fdsUnknownFields = reverse (fdsUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldMessage; loop m {fdsFile = V.snoc (fdsFile m) v}+            _ -> do uf <- captureUnknownField n wt; loop m {fdsUnknownFields = uf : fdsUnknownFields m}++----------------------------------------------------------------------+-- FileDescriptorProto+----------------------------------------------------------------------++data FileDescriptorProto = FileDescriptorProto+  { fdpName :: !Text+  , fdpPackage :: !Text+  , fdpDependency :: !(V.Vector Text)+  , fdpMessageType :: !(V.Vector DescriptorProto)+  , fdpEnumType :: !(V.Vector EnumDescriptorProto)+  , fdpService :: !(V.Vector ServiceDescriptorProto)+  , fdpExtension :: !(V.Vector FieldDescriptorProto)+  , fdpOptions :: !(Maybe FileOptions)+  , fdpSourceCodeInfo :: !(Maybe SourceCodeInfo)+  , fdpSyntax :: !Text+  , fdpEdition :: !Text+  , fdpUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultFileDescriptorProto :: FileDescriptorProto+defaultFileDescriptorProto =+  FileDescriptorProto "" "" V.empty V.empty V.empty V.empty V.empty Nothing Nothing "" "" []++instance MessageEncode FileDescriptorProto where+  buildMessage m =+    encStr 1 (fdpName m)+      <> encStr 2 (fdpPackage m)+      <> V.foldl' (\a d -> a <> encodeFieldString 3 d) mempty (fdpDependency m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 4 x) mempty (fdpMessageType m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 5 x) mempty (fdpEnumType m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 6 x) mempty (fdpService m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 7 x) mempty (fdpExtension m)+      <> encMsg 8 (fdpOptions m)+      <> encMsg 9 (fdpSourceCodeInfo m)+      <> encStr 12 (fdpSyntax m)+      <> encStr 14 (fdpEdition m)+      <> encodeUnknownFields (fdpUnknownFields m)++instance MessageDecode FileDescriptorProto where+  messageDecoder = loop defaultFileDescriptorProto+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {fdpUnknownFields = reverse (fdpUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldString; loop m {fdpName = v}+            2 -> do v <- decodeFieldString; loop m {fdpPackage = v}+            3 -> do v <- decodeFieldString; loop m {fdpDependency = V.snoc (fdpDependency m) v}+            4 -> do v <- decodeFieldMessage; loop m {fdpMessageType = V.snoc (fdpMessageType m) v}+            5 -> do v <- decodeFieldMessage; loop m {fdpEnumType = V.snoc (fdpEnumType m) v}+            6 -> do v <- decodeFieldMessage; loop m {fdpService = V.snoc (fdpService m) v}+            7 -> do v <- decodeFieldMessage; loop m {fdpExtension = V.snoc (fdpExtension m) v}+            8 -> do v <- decodeFieldMessage; loop m {fdpOptions = Just v}+            9 -> do v <- decodeFieldMessage; loop m {fdpSourceCodeInfo = Just v}+            12 -> do v <- decodeFieldString; loop m {fdpSyntax = v}+            14 -> do v <- decodeFieldString; loop m {fdpEdition = v}+            _ -> do uf <- captureUnknownField n wt; loop m {fdpUnknownFields = uf : fdpUnknownFields m}++----------------------------------------------------------------------+-- DescriptorProto (+ ExtensionRange, ReservedRange)+----------------------------------------------------------------------++data DescriptorProto = DescriptorProto+  { dpName :: !Text+  , dpField :: !(V.Vector FieldDescriptorProto)+  , dpNestedType :: !(V.Vector DescriptorProto)+  , dpEnumType :: !(V.Vector EnumDescriptorProto)+  , dpExtensionRange :: !(V.Vector DescriptorProtoExtensionRange)+  , dpExtension :: !(V.Vector FieldDescriptorProto)+  , dpOptions :: !(Maybe MessageOptions)+  , dpOneofDecl :: !(V.Vector OneofDescriptorProto)+  , dpReservedRange :: !(V.Vector DescriptorProtoReservedRange)+  , dpReservedName :: !(V.Vector Text)+  , dpUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultDescriptorProto :: DescriptorProto+defaultDescriptorProto =+  DescriptorProto "" V.empty V.empty V.empty V.empty V.empty Nothing V.empty V.empty V.empty []++instance MessageEncode DescriptorProto where+  buildMessage m =+    encStr 1 (dpName m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 2 x) mempty (dpField m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 3 x) mempty (dpNestedType m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 4 x) mempty (dpEnumType m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 5 x) mempty (dpExtensionRange m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 6 x) mempty (dpExtension m)+      <> encMsg 7 (dpOptions m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 8 x) mempty (dpOneofDecl m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 9 x) mempty (dpReservedRange m)+      <> V.foldl' (\a x -> a <> encodeFieldString 10 x) mempty (dpReservedName m)+      <> encodeUnknownFields (dpUnknownFields m)++instance MessageDecode DescriptorProto where+  messageDecoder = loop defaultDescriptorProto+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {dpUnknownFields = reverse (dpUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldString; loop m {dpName = v}+            2 -> do v <- decodeFieldMessage; loop m {dpField = V.snoc (dpField m) v}+            3 -> do v <- decodeFieldMessage; loop m {dpNestedType = V.snoc (dpNestedType m) v}+            4 -> do v <- decodeFieldMessage; loop m {dpEnumType = V.snoc (dpEnumType m) v}+            5 -> do v <- decodeFieldMessage; loop m {dpExtensionRange = V.snoc (dpExtensionRange m) v}+            6 -> do v <- decodeFieldMessage; loop m {dpExtension = V.snoc (dpExtension m) v}+            7 -> do v <- decodeFieldMessage; loop m {dpOptions = Just v}+            8 -> do v <- decodeFieldMessage; loop m {dpOneofDecl = V.snoc (dpOneofDecl m) v}+            9 -> do v <- decodeFieldMessage; loop m {dpReservedRange = V.snoc (dpReservedRange m) v}+            10 -> do v <- decodeFieldString; loop m {dpReservedName = V.snoc (dpReservedName m) v}+            _ -> do uf <- captureUnknownField n wt; loop m {dpUnknownFields = uf : dpUnknownFields m}++data DescriptorProtoExtensionRange = DescriptorProtoExtensionRange+  { dperStart :: !Int32+  , dperEnd :: !Int32+  , dperOptions :: !(Maybe ExtensionRangeOptions)+  , dperUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultDescriptorProtoExtensionRange :: DescriptorProtoExtensionRange+defaultDescriptorProtoExtensionRange = DescriptorProtoExtensionRange 0 0 Nothing []++instance MessageEncode DescriptorProtoExtensionRange where+  buildMessage m =+    encI32 1 (dperStart m) <> encI32 2 (dperEnd m) <> encMsg 3 (dperOptions m)+      <> encodeUnknownFields (dperUnknownFields m)++instance MessageDecode DescriptorProtoExtensionRange where+  messageDecoder = loop defaultDescriptorProtoExtensionRange+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {dperUnknownFields = reverse (dperUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldVarint; loop m {dperStart = fromIntegral v}+            2 -> do v <- decodeFieldVarint; loop m {dperEnd = fromIntegral v}+            3 -> do v <- decodeFieldMessage; loop m {dperOptions = Just v}+            _ -> do uf <- captureUnknownField n wt; loop m {dperUnknownFields = uf : dperUnknownFields m}++data DescriptorProtoReservedRange = DescriptorProtoReservedRange+  { dprrStart :: !Int32+  , dprrEnd :: !Int32+  , dprrUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultDescriptorProtoReservedRange :: DescriptorProtoReservedRange+defaultDescriptorProtoReservedRange = DescriptorProtoReservedRange 0 0 []++instance MessageEncode DescriptorProtoReservedRange where+  buildMessage m =+    encI32 1 (dprrStart m) <> encI32 2 (dprrEnd m) <> encodeUnknownFields (dprrUnknownFields m)++instance MessageDecode DescriptorProtoReservedRange where+  messageDecoder = loop defaultDescriptorProtoReservedRange+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {dprrUnknownFields = reverse (dprrUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldVarint; loop m {dprrStart = fromIntegral v}+            2 -> do v <- decodeFieldVarint; loop m {dprrEnd = fromIntegral v}+            _ -> do uf <- captureUnknownField n wt; loop m {dprrUnknownFields = uf : dprrUnknownFields m}++----------------------------------------------------------------------+-- FieldDescriptorProto+----------------------------------------------------------------------++-- | The wire @type@ codes (field 5 of 'FieldDescriptorProto').+data FieldDescriptorType+  = TYPE_DOUBLE | TYPE_FLOAT | TYPE_INT64 | TYPE_UINT64 | TYPE_INT32+  | TYPE_FIXED64 | TYPE_FIXED32 | TYPE_BOOL | TYPE_STRING | TYPE_GROUP+  | TYPE_MESSAGE | TYPE_BYTES | TYPE_UINT32 | TYPE_ENUM | TYPE_SFIXED32+  | TYPE_SFIXED64 | TYPE_SINT32 | TYPE_SINT64+  deriving stock (Show, Eq, Ord, Enum, Bounded, Generic)+  deriving anyclass (NFData)++-- | The @label@ codes (field 4 of 'FieldDescriptorProto').+data FieldDescriptorLabel+  = LABEL_OPTIONAL | LABEL_REQUIRED | LABEL_REPEATED+  deriving stock (Show, Eq, Ord, Enum, Bounded, Generic)+  deriving anyclass (NFData)++data FieldDescriptorProto = FieldDescriptorProto+  { fdpFieldName :: !Text+  , fdpFieldExtendee :: !Text+  , fdpFieldNumber :: !Int32+  , fdpFieldLabel :: !Int32+  , fdpFieldType :: !Int32+  , fdpFieldTypeName :: !Text+  , fdpFieldDefault :: !Text+  , fdpFieldOptions :: !(Maybe FieldOptions)+  , fdpFieldOneofIdx :: !Int32+  , fdpFieldJsonName :: !Text+  , fdpFieldProto3Optional :: !Bool+  , fdpFieldUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultFieldDescriptorProto :: FieldDescriptorProto+defaultFieldDescriptorProto =+  FieldDescriptorProto "" "" 0 0 0 "" "" Nothing (-1) "" False []++instance MessageEncode FieldDescriptorProto where+  buildMessage m =+    encStr 1 (fdpFieldName m)+      <> encStr 2 (fdpFieldExtendee m)+      <> encI32 3 (fdpFieldNumber m)+      <> encI32 4 (fdpFieldLabel m)+      <> encI32 5 (fdpFieldType m)+      <> encStr 6 (fdpFieldTypeName m)+      <> encStr 7 (fdpFieldDefault m)+      <> encMsg 8 (fdpFieldOptions m)+      <> (if fdpFieldOneofIdx m < 0 then mempty else encodeFieldVarint 9 (fromIntegral (fdpFieldOneofIdx m)))+      <> encStr 10 (fdpFieldJsonName m)+      <> (if fdpFieldProto3Optional m then encodeFieldBool 17 True else mempty)+      <> encodeUnknownFields (fdpFieldUnknownFields m)++instance MessageDecode FieldDescriptorProto where+  messageDecoder = loop defaultFieldDescriptorProto+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {fdpFieldUnknownFields = reverse (fdpFieldUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldString; loop m {fdpFieldName = v}+            2 -> do v <- decodeFieldString; loop m {fdpFieldExtendee = v}+            3 -> do v <- decodeFieldVarint; loop m {fdpFieldNumber = fromIntegral v}+            4 -> do v <- decodeFieldVarint; loop m {fdpFieldLabel = fromIntegral v}+            5 -> do v <- decodeFieldVarint; loop m {fdpFieldType = fromIntegral v}+            6 -> do v <- decodeFieldString; loop m {fdpFieldTypeName = v}+            7 -> do v <- decodeFieldString; loop m {fdpFieldDefault = v}+            8 -> do v <- decodeFieldMessage; loop m {fdpFieldOptions = Just v}+            9 -> do v <- decodeFieldVarint; loop m {fdpFieldOneofIdx = fromIntegral v}+            10 -> do v <- decodeFieldString; loop m {fdpFieldJsonName = v}+            17 -> do v <- decodeFieldBool; loop m {fdpFieldProto3Optional = v}+            _ -> do uf <- captureUnknownField n wt; loop m {fdpFieldUnknownFields = uf : fdpFieldUnknownFields m}++----------------------------------------------------------------------+-- OneofDescriptorProto+----------------------------------------------------------------------++data OneofDescriptorProto = OneofDescriptorProto+  { odpName :: !Text+  , odpOptions :: !(Maybe OneofOptions)+  , odpUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultOneofDescriptorProto :: OneofDescriptorProto+defaultOneofDescriptorProto = OneofDescriptorProto "" Nothing []++instance MessageEncode OneofDescriptorProto where+  buildMessage m =+    encStr 1 (odpName m) <> encMsg 2 (odpOptions m) <> encodeUnknownFields (odpUnknownFields m)++instance MessageDecode OneofDescriptorProto where+  messageDecoder = loop defaultOneofDescriptorProto+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {odpUnknownFields = reverse (odpUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldString; loop m {odpName = v}+            2 -> do v <- decodeFieldMessage; loop m {odpOptions = Just v}+            _ -> do uf <- captureUnknownField n wt; loop m {odpUnknownFields = uf : odpUnknownFields m}++----------------------------------------------------------------------+-- EnumDescriptorProto (+ EnumReservedRange) / EnumValueDescriptorProto+----------------------------------------------------------------------++data EnumDescriptorProto = EnumDescriptorProto+  { edpName :: !Text+  , edpValue :: !(V.Vector EnumValueDescriptorProto)+  , edpOptions :: !(Maybe EnumOptions)+  , edpReservedRange :: !(V.Vector EnumDescriptorProtoEnumReservedRange)+  , edpReservedName :: !(V.Vector Text)+  , edpUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultEnumDescriptorProto :: EnumDescriptorProto+defaultEnumDescriptorProto = EnumDescriptorProto "" V.empty Nothing V.empty V.empty []++instance MessageEncode EnumDescriptorProto where+  buildMessage m =+    encStr 1 (edpName m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 2 x) mempty (edpValue m)+      <> encMsg 3 (edpOptions m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 4 x) mempty (edpReservedRange m)+      <> V.foldl' (\a x -> a <> encodeFieldString 5 x) mempty (edpReservedName m)+      <> encodeUnknownFields (edpUnknownFields m)++instance MessageDecode EnumDescriptorProto where+  messageDecoder = loop defaultEnumDescriptorProto+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {edpUnknownFields = reverse (edpUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldString; loop m {edpName = v}+            2 -> do v <- decodeFieldMessage; loop m {edpValue = V.snoc (edpValue m) v}+            3 -> do v <- decodeFieldMessage; loop m {edpOptions = Just v}+            4 -> do v <- decodeFieldMessage; loop m {edpReservedRange = V.snoc (edpReservedRange m) v}+            5 -> do v <- decodeFieldString; loop m {edpReservedName = V.snoc (edpReservedName m) v}+            _ -> do uf <- captureUnknownField n wt; loop m {edpUnknownFields = uf : edpUnknownFields m}++data EnumDescriptorProtoEnumReservedRange = EnumDescriptorProtoEnumReservedRange+  { edprrStart :: !Int32+  , edprrEnd :: !Int32+  , edprrUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultEnumDescriptorProtoEnumReservedRange :: EnumDescriptorProtoEnumReservedRange+defaultEnumDescriptorProtoEnumReservedRange = EnumDescriptorProtoEnumReservedRange 0 0 []++instance MessageEncode EnumDescriptorProtoEnumReservedRange where+  buildMessage m =+    encI32 1 (edprrStart m) <> encI32 2 (edprrEnd m) <> encodeUnknownFields (edprrUnknownFields m)++instance MessageDecode EnumDescriptorProtoEnumReservedRange where+  messageDecoder = loop defaultEnumDescriptorProtoEnumReservedRange+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {edprrUnknownFields = reverse (edprrUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldVarint; loop m {edprrStart = fromIntegral v}+            2 -> do v <- decodeFieldVarint; loop m {edprrEnd = fromIntegral v}+            _ -> do uf <- captureUnknownField n wt; loop m {edprrUnknownFields = uf : edprrUnknownFields m}++data EnumValueDescriptorProto = EnumValueDescriptorProto+  { evdpName :: !Text+  , evdpNumber :: !Int32+  , evdpOptions :: !(Maybe EnumValueOptions)+  , evdpUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultEnumValueDescriptorProto :: EnumValueDescriptorProto+defaultEnumValueDescriptorProto = EnumValueDescriptorProto "" 0 Nothing []++instance MessageEncode EnumValueDescriptorProto where+  buildMessage m =+    encStr 1 (evdpName m)+      <> encI32 2 (evdpNumber m)+      <> encMsg 3 (evdpOptions m)+      <> encodeUnknownFields (evdpUnknownFields m)++instance MessageDecode EnumValueDescriptorProto where+  messageDecoder = loop defaultEnumValueDescriptorProto+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {evdpUnknownFields = reverse (evdpUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldString; loop m {evdpName = v}+            2 -> do v <- decodeFieldVarint; loop m {evdpNumber = fromIntegral v}+            3 -> do v <- decodeFieldMessage; loop m {evdpOptions = Just v}+            _ -> do uf <- captureUnknownField n wt; loop m {evdpUnknownFields = uf : evdpUnknownFields m}++----------------------------------------------------------------------+-- ServiceDescriptorProto / MethodDescriptorProto+----------------------------------------------------------------------++data ServiceDescriptorProto = ServiceDescriptorProto+  { sdpName :: !Text+  , sdpMethod :: !(V.Vector MethodDescriptorProto)+  , sdpOptions :: !(Maybe ServiceOptions)+  , sdpUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultServiceDescriptorProto :: ServiceDescriptorProto+defaultServiceDescriptorProto = ServiceDescriptorProto "" V.empty Nothing []++instance MessageEncode ServiceDescriptorProto where+  buildMessage m =+    encStr 1 (sdpName m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 2 x) mempty (sdpMethod m)+      <> encMsg 3 (sdpOptions m)+      <> encodeUnknownFields (sdpUnknownFields m)++instance MessageDecode ServiceDescriptorProto where+  messageDecoder = loop defaultServiceDescriptorProto+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {sdpUnknownFields = reverse (sdpUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldString; loop m {sdpName = v}+            2 -> do v <- decodeFieldMessage; loop m {sdpMethod = V.snoc (sdpMethod m) v}+            3 -> do v <- decodeFieldMessage; loop m {sdpOptions = Just v}+            _ -> do uf <- captureUnknownField n wt; loop m {sdpUnknownFields = uf : sdpUnknownFields m}++data MethodDescriptorProto = MethodDescriptorProto+  { mdpName :: !Text+  , mdpInputType :: !Text+  , mdpOutputType :: !Text+  , mdpOptions :: !(Maybe MethodOptions)+  , mdpClientStreaming :: !Bool+  , mdpServerStreaming :: !Bool+  , mdpUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultMethodDescriptorProto :: MethodDescriptorProto+defaultMethodDescriptorProto = MethodDescriptorProto "" "" "" Nothing False False []++instance MessageEncode MethodDescriptorProto where+  buildMessage m =+    encStr 1 (mdpName m)+      <> encStr 2 (mdpInputType m)+      <> encStr 3 (mdpOutputType m)+      <> encMsg 4 (mdpOptions m)+      <> (if mdpClientStreaming m then encodeFieldBool 5 True else mempty)+      <> (if mdpServerStreaming m then encodeFieldBool 6 True else mempty)+      <> encodeUnknownFields (mdpUnknownFields m)++instance MessageDecode MethodDescriptorProto where+  messageDecoder = loop defaultMethodDescriptorProto+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {mdpUnknownFields = reverse (mdpUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldString; loop m {mdpName = v}+            2 -> do v <- decodeFieldString; loop m {mdpInputType = v}+            3 -> do v <- decodeFieldString; loop m {mdpOutputType = v}+            4 -> do v <- decodeFieldMessage; loop m {mdpOptions = Just v}+            5 -> do v <- decodeFieldBool; loop m {mdpClientStreaming = v}+            6 -> do v <- decodeFieldBool; loop m {mdpServerStreaming = v}+            _ -> do uf <- captureUnknownField n wt; loop m {mdpUnknownFields = uf : mdpUnknownFields m}++----------------------------------------------------------------------+-- Options messages+--+-- The common standard fields are modeled; every other set field (including+-- option /extensions/ such as buf.validate) is preserved as an unknown field.+----------------------------------------------------------------------++data FileOptions = FileOptions+  { foJavaPackage :: !Text+  , foGoPackage :: !Text+  , foDeprecated :: !Bool+  , foUninterpretedOption :: !(V.Vector UninterpretedOption)+  , foUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultFileOptions :: FileOptions+defaultFileOptions = FileOptions "" "" False V.empty []++instance MessageEncode FileOptions where+  buildMessage m =+    encStr 1 (foJavaPackage m)+      <> encStr 11 (foGoPackage m)+      <> (if foDeprecated m then encodeFieldBool 23 True else mempty)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 999 x) mempty (foUninterpretedOption m)+      <> encodeUnknownFields (foUnknownFields m)++instance MessageDecode FileOptions where+  messageDecoder = loop defaultFileOptions+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {foUnknownFields = reverse (foUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldString; loop m {foJavaPackage = v}+            11 -> do v <- decodeFieldString; loop m {foGoPackage = v}+            23 -> do v <- decodeFieldBool; loop m {foDeprecated = v}+            999 -> do v <- decodeFieldMessage; loop m {foUninterpretedOption = V.snoc (foUninterpretedOption m) v}+            _ -> do uf <- captureUnknownField n wt; loop m {foUnknownFields = uf : foUnknownFields m}++data MessageOptions = MessageOptions+  { moMessageSetWireFormat :: !Bool+  , moNoStandardDescriptorAccessor :: !Bool+  , moDeprecated :: !Bool+  , moMapEntry :: !Bool+  , moUninterpretedOption :: !(V.Vector UninterpretedOption)+  , moUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultMessageOptions :: MessageOptions+defaultMessageOptions = MessageOptions False False False False V.empty []++instance MessageEncode MessageOptions where+  buildMessage m =+    (if moMessageSetWireFormat m then encodeFieldBool 1 True else mempty)+      <> (if moNoStandardDescriptorAccessor m then encodeFieldBool 2 True else mempty)+      <> (if moDeprecated m then encodeFieldBool 3 True else mempty)+      <> (if moMapEntry m then encodeFieldBool 7 True else mempty)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 999 x) mempty (moUninterpretedOption m)+      <> encodeUnknownFields (moUnknownFields m)++instance MessageDecode MessageOptions where+  messageDecoder = loop defaultMessageOptions+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {moUnknownFields = reverse (moUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldBool; loop m {moMessageSetWireFormat = v}+            2 -> do v <- decodeFieldBool; loop m {moNoStandardDescriptorAccessor = v}+            3 -> do v <- decodeFieldBool; loop m {moDeprecated = v}+            7 -> do v <- decodeFieldBool; loop m {moMapEntry = v}+            999 -> do v <- decodeFieldMessage; loop m {moUninterpretedOption = V.snoc (moUninterpretedOption m) v}+            _ -> do uf <- captureUnknownField n wt; loop m {moUnknownFields = uf : moUnknownFields m}++data FieldOptions = FieldOptions+  { fldoCtype :: !Int32+  , fldoPacked :: !Bool+  , fldoDeprecated :: !Bool+  , fldoJstype :: !Int32+  , fldoUninterpretedOption :: !(V.Vector UninterpretedOption)+  , fldoUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultFieldOptions :: FieldOptions+defaultFieldOptions = FieldOptions 0 False False 0 V.empty []++instance MessageEncode FieldOptions where+  buildMessage m =+    encI32 1 (fldoCtype m)+      <> (if fldoPacked m then encodeFieldBool 2 True else mempty)+      <> (if fldoDeprecated m then encodeFieldBool 3 True else mempty)+      <> encI32 6 (fldoJstype m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 999 x) mempty (fldoUninterpretedOption m)+      <> encodeUnknownFields (fldoUnknownFields m)++instance MessageDecode FieldOptions where+  messageDecoder = loop defaultFieldOptions+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {fldoUnknownFields = reverse (fldoUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldVarint; loop m {fldoCtype = fromIntegral v}+            2 -> do v <- decodeFieldBool; loop m {fldoPacked = v}+            3 -> do v <- decodeFieldBool; loop m {fldoDeprecated = v}+            6 -> do v <- decodeFieldVarint; loop m {fldoJstype = fromIntegral v}+            999 -> do v <- decodeFieldMessage; loop m {fldoUninterpretedOption = V.snoc (fldoUninterpretedOption m) v}+            _ -> do uf <- captureUnknownField n wt; loop m {fldoUnknownFields = uf : fldoUnknownFields m}++data OneofOptions = OneofOptions+  { oneofoUninterpretedOption :: !(V.Vector UninterpretedOption)+  , oneofoUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultOneofOptions :: OneofOptions+defaultOneofOptions = OneofOptions V.empty []++instance MessageEncode OneofOptions where+  buildMessage m =+    V.foldl' (\a x -> a <> encodeFieldMessage 999 x) mempty (oneofoUninterpretedOption m)+      <> encodeUnknownFields (oneofoUnknownFields m)++instance MessageDecode OneofOptions where+  messageDecoder = loop defaultOneofOptions+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {oneofoUnknownFields = reverse (oneofoUnknownFields m)}+          UJust (Tag n wt) -> case n of+            999 -> do v <- decodeFieldMessage; loop m {oneofoUninterpretedOption = V.snoc (oneofoUninterpretedOption m) v}+            _ -> do uf <- captureUnknownField n wt; loop m {oneofoUnknownFields = uf : oneofoUnknownFields m}++data EnumOptions = EnumOptions+  { enoAllowAlias :: !Bool+  , enoDeprecated :: !Bool+  , enoUninterpretedOption :: !(V.Vector UninterpretedOption)+  , enoUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultEnumOptions :: EnumOptions+defaultEnumOptions = EnumOptions False False V.empty []++instance MessageEncode EnumOptions where+  buildMessage m =+    (if enoAllowAlias m then encodeFieldBool 2 True else mempty)+      <> (if enoDeprecated m then encodeFieldBool 3 True else mempty)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 999 x) mempty (enoUninterpretedOption m)+      <> encodeUnknownFields (enoUnknownFields m)++instance MessageDecode EnumOptions where+  messageDecoder = loop defaultEnumOptions+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {enoUnknownFields = reverse (enoUnknownFields m)}+          UJust (Tag n wt) -> case n of+            2 -> do v <- decodeFieldBool; loop m {enoAllowAlias = v}+            3 -> do v <- decodeFieldBool; loop m {enoDeprecated = v}+            999 -> do v <- decodeFieldMessage; loop m {enoUninterpretedOption = V.snoc (enoUninterpretedOption m) v}+            _ -> do uf <- captureUnknownField n wt; loop m {enoUnknownFields = uf : enoUnknownFields m}++data EnumValueOptions = EnumValueOptions+  { evoDeprecated :: !Bool+  , evoUninterpretedOption :: !(V.Vector UninterpretedOption)+  , evoUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultEnumValueOptions :: EnumValueOptions+defaultEnumValueOptions = EnumValueOptions False V.empty []++instance MessageEncode EnumValueOptions where+  buildMessage m =+    (if evoDeprecated m then encodeFieldBool 1 True else mempty)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 999 x) mempty (evoUninterpretedOption m)+      <> encodeUnknownFields (evoUnknownFields m)++instance MessageDecode EnumValueOptions where+  messageDecoder = loop defaultEnumValueOptions+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {evoUnknownFields = reverse (evoUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldBool; loop m {evoDeprecated = v}+            999 -> do v <- decodeFieldMessage; loop m {evoUninterpretedOption = V.snoc (evoUninterpretedOption m) v}+            _ -> do uf <- captureUnknownField n wt; loop m {evoUnknownFields = uf : evoUnknownFields m}++data ServiceOptions = ServiceOptions+  { svoDeprecated :: !Bool+  , svoUninterpretedOption :: !(V.Vector UninterpretedOption)+  , svoUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultServiceOptions :: ServiceOptions+defaultServiceOptions = ServiceOptions False V.empty []++instance MessageEncode ServiceOptions where+  buildMessage m =+    (if svoDeprecated m then encodeFieldBool 33 True else mempty)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 999 x) mempty (svoUninterpretedOption m)+      <> encodeUnknownFields (svoUnknownFields m)++instance MessageDecode ServiceOptions where+  messageDecoder = loop defaultServiceOptions+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {svoUnknownFields = reverse (svoUnknownFields m)}+          UJust (Tag n wt) -> case n of+            33 -> do v <- decodeFieldBool; loop m {svoDeprecated = v}+            999 -> do v <- decodeFieldMessage; loop m {svoUninterpretedOption = V.snoc (svoUninterpretedOption m) v}+            _ -> do uf <- captureUnknownField n wt; loop m {svoUnknownFields = uf : svoUnknownFields m}++data MethodOptions = MethodOptions+  { mtoDeprecated :: !Bool+  , mtoIdempotencyLevel :: !Int32+  , mtoUninterpretedOption :: !(V.Vector UninterpretedOption)+  , mtoUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultMethodOptions :: MethodOptions+defaultMethodOptions = MethodOptions False 0 V.empty []++instance MessageEncode MethodOptions where+  buildMessage m =+    (if mtoDeprecated m then encodeFieldBool 33 True else mempty)+      <> encI32 34 (mtoIdempotencyLevel m)+      <> V.foldl' (\a x -> a <> encodeFieldMessage 999 x) mempty (mtoUninterpretedOption m)+      <> encodeUnknownFields (mtoUnknownFields m)++instance MessageDecode MethodOptions where+  messageDecoder = loop defaultMethodOptions+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {mtoUnknownFields = reverse (mtoUnknownFields m)}+          UJust (Tag n wt) -> case n of+            33 -> do v <- decodeFieldBool; loop m {mtoDeprecated = v}+            34 -> do v <- decodeFieldVarint; loop m {mtoIdempotencyLevel = fromIntegral v}+            999 -> do v <- decodeFieldMessage; loop m {mtoUninterpretedOption = V.snoc (mtoUninterpretedOption m) v}+            _ -> do uf <- captureUnknownField n wt; loop m {mtoUnknownFields = uf : mtoUnknownFields m}++data ExtensionRangeOptions = ExtensionRangeOptions+  { eroUninterpretedOption :: !(V.Vector UninterpretedOption)+  , eroUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultExtensionRangeOptions :: ExtensionRangeOptions+defaultExtensionRangeOptions = ExtensionRangeOptions V.empty []++instance MessageEncode ExtensionRangeOptions where+  buildMessage m =+    V.foldl' (\a x -> a <> encodeFieldMessage 999 x) mempty (eroUninterpretedOption m)+      <> encodeUnknownFields (eroUnknownFields m)++instance MessageDecode ExtensionRangeOptions where+  messageDecoder = loop defaultExtensionRangeOptions+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {eroUnknownFields = reverse (eroUnknownFields m)}+          UJust (Tag n wt) -> case n of+            999 -> do v <- decodeFieldMessage; loop m {eroUninterpretedOption = V.snoc (eroUninterpretedOption m) v}+            _ -> do uf <- captureUnknownField n wt; loop m {eroUnknownFields = uf : eroUnknownFields m}++----------------------------------------------------------------------+-- UninterpretedOption (+ NamePart)+----------------------------------------------------------------------++data UninterpretedOption = UninterpretedOption+  { uoName :: !(V.Vector UninterpretedOptionNamePart)+  , uoIdentifierValue :: !Text+  , uoPositiveIntValue :: !Word64+  , uoNegativeIntValue :: !Int64+  , uoDoubleValue :: !Double+  , uoStringValue :: !ByteString+  , uoAggregateValue :: !Text+  , uoUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultUninterpretedOption :: UninterpretedOption+defaultUninterpretedOption = UninterpretedOption V.empty "" 0 0 0 "" "" []++instance MessageEncode UninterpretedOption where+  buildMessage m =+    V.foldl' (\a x -> a <> encodeFieldMessage 2 x) mempty (uoName m)+      <> encStr 3 (uoIdentifierValue m)+      <> (if uoPositiveIntValue m == 0 then mempty else encodeFieldVarint 4 (uoPositiveIntValue m))+      <> (if uoNegativeIntValue m == 0 then mempty else encodeFieldVarint 5 (fromIntegral (uoNegativeIntValue m)))+      <> (if uoDoubleValue m == 0 then mempty else encodeFieldDouble 6 (uoDoubleValue m))+      <> encBytes 7 (uoStringValue m)+      <> encStr 8 (uoAggregateValue m)+      <> encodeUnknownFields (uoUnknownFields m)++instance MessageDecode UninterpretedOption where+  messageDecoder = loop defaultUninterpretedOption+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {uoUnknownFields = reverse (uoUnknownFields m)}+          UJust (Tag n wt) -> case n of+            2 -> do v <- decodeFieldMessage; loop m {uoName = V.snoc (uoName m) v}+            3 -> do v <- decodeFieldString; loop m {uoIdentifierValue = v}+            4 -> do v <- decodeFieldVarint; loop m {uoPositiveIntValue = v}+            5 -> do v <- decodeFieldVarint; loop m {uoNegativeIntValue = fromIntegral v}+            6 -> do v <- decodeFieldDouble; loop m {uoDoubleValue = v}+            7 -> do v <- decodeFieldBytes; loop m {uoStringValue = v}+            8 -> do v <- decodeFieldString; loop m {uoAggregateValue = v}+            _ -> do uf <- captureUnknownField n wt; loop m {uoUnknownFields = uf : uoUnknownFields m}++data UninterpretedOptionNamePart = UninterpretedOptionNamePart+  { uonpNamePart :: !Text+  , uonpIsExtension :: !Bool+  , uonpUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultUninterpretedOptionNamePart :: UninterpretedOptionNamePart+defaultUninterpretedOptionNamePart = UninterpretedOptionNamePart "" False []++instance MessageEncode UninterpretedOptionNamePart where+  buildMessage m =+    encStr 1 (uonpNamePart m)+      <> encodeFieldBool 2 (uonpIsExtension m)+      <> encodeUnknownFields (uonpUnknownFields m)++instance MessageDecode UninterpretedOptionNamePart where+  messageDecoder = loop defaultUninterpretedOptionNamePart+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {uonpUnknownFields = reverse (uonpUnknownFields m)}+          UJust (Tag n wt) -> case n of+            1 -> do v <- decodeFieldString; loop m {uonpNamePart = v}+            2 -> do v <- decodeFieldBool; loop m {uonpIsExtension = v}+            _ -> do uf <- captureUnknownField n wt; loop m {uonpUnknownFields = uf : uonpUnknownFields m}++----------------------------------------------------------------------+-- SourceCodeInfo / GeneratedCodeInfo+--+-- The packed-repeated int32 @path@ / @span@ side fields are preserved as+-- unknown fields rather than given typed accessors.+----------------------------------------------------------------------++newtype SourceCodeInfo = SourceCodeInfo+  { sciLocation :: V.Vector SourceCodeInfoLocation+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultSourceCodeInfo :: SourceCodeInfo+defaultSourceCodeInfo = SourceCodeInfo V.empty++instance MessageEncode SourceCodeInfo where+  buildMessage m = V.foldl' (\a x -> a <> encodeFieldMessage 1 x) mempty (sciLocation m)++instance MessageDecode SourceCodeInfo where+  messageDecoder = loop defaultSourceCodeInfo+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m+          UJust (Tag 1 _) -> do v <- decodeFieldMessage; loop m {sciLocation = V.snoc (sciLocation m) v}+          UJust (Tag _ wt) -> skipField wt >> loop m++data SourceCodeInfoLocation = SourceCodeInfoLocation+  { scilLeadingComments :: !Text+  , scilTrailingComments :: !Text+  , scilLeadingDetachedComments :: !(V.Vector Text)+  , scilUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++defaultSourceCodeInfoLocation :: SourceCodeInfoLocation+defaultSourceCodeInfoLocation = SourceCodeInfoLocation "" "" V.empty []++instance MessageEncode SourceCodeInfoLocation where+  buildMessage m =+    encStr 3 (scilLeadingComments m)+      <> encStr 4 (scilTrailingComments m)+      <> V.foldl' (\a x -> a <> encodeFieldString 6 x) mempty (scilLeadingDetachedComments m)+      <> encodeUnknownFields (scilUnknownFields m)++instance MessageDecode SourceCodeInfoLocation where+  messageDecoder = loop defaultSourceCodeInfoLocation+    where+      loop !m = do+        mt <- getTagOrU+        case mt of+          UNothing -> pure m {scilUnknownFields = reverse (scilUnknownFields m)}+          UJust (Tag n wt) -> case n of+            3 -> do v <- decodeFieldString; loop m {scilLeadingComments = v}+            4 -> do v <- decodeFieldString; loop m {scilTrailingComments = v}+            6 -> do v <- decodeFieldString; loop m {scilLeadingDetachedComments = V.snoc (scilLeadingDetachedComments m) v}+            _ -> do uf <- captureUnknownField n wt; loop m {scilUnknownFields = uf : scilUnknownFields m}++----------------------------------------------------------------------+-- Encode helpers (omit zero/empty scalars, like proto3 implicit presence)+----------------------------------------------------------------------++encStr :: Int -> Text -> Builder+encStr n t = if t == "" then mempty else encodeFieldString n t+{-# INLINE encStr #-}++encBytes :: Int -> ByteString -> Builder+encBytes n b = if b == "" then mempty else encodeFieldBytes n b+{-# INLINE encBytes #-}++encI32 :: Int -> Int32 -> Builder+encI32 n v = if v == 0 then mempty else encodeFieldVarint n (fromIntegral v)+{-# INLINE encI32 #-}++encMsg :: MessageEncode a => Int -> Maybe a -> Builder+encMsg n = maybe mempty (encodeFieldMessage n)+{-# INLINE encMsg #-}
+ src/Proto/Google/Protobuf/Duration.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}+{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-matches -Wno-unused-top-binds #-}++{- | Auto-generated protobuf types from package @google.protobuf@.++__THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__++Any manual changes will be overwritten the next time code+generation is run.  To modify the types or instances, edit the+@.proto@ source file and re-run the code generator.+-}+module Proto.Google.Protobuf.Duration where++import Control.DeepSeq (NFData (..))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as AesonKey+import Data.Aeson.KeyMap qualified as AesonKM+import Data.Aeson.Types qualified as Aeson+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Hashable (Hashable (..))+import Data.Int (Int32, Int64)+import Data.Map.Strict qualified as Map+import Data.Proxy (Proxy (..))+import Data.Reflection (Given (..), given)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V+import Data.Vector.Unboxed qualified as VU+import Data.Word (Word32, Word64)+import GHC.Generics (Generic)+import Proto.Decode+import Proto.Encode+import Proto.Extension qualified+import Proto.Internal.Encode.Archetype (+  archBool,+  archBoolSize,+  archBytes,+  archBytesSize,+  archDouble,+  archFixed32,+  archFixed32Size,+  archFixed64,+  archFixed64Size,+  archFloat,+  archSVarint32,+  archSVarint64,+  archString,+  archStringSize,+  archSubmessage,+  archSubmessageSize,+  archVarint,+  archVarintSize,+ )+import Proto.Internal.JSON (bytesFieldToJSON, bytesMapFieldToJSON, jsonObject, parseBytesFieldMaybe, parseBytesMapFieldMaybe, parseFieldMaybe, protoBytesToJSON, (.=:))+import Proto.Internal.JSON.Extension qualified as PJExt+import Proto.Internal.Wire (Tag (..), WireType (..))+import Proto.Internal.Wire.Encode (+  fieldBoolSize,+  fieldBytesSize,+  fieldDoubleSize,+  fieldFixed32Size,+  fieldFixed64Size,+  fieldFloatSize,+  fieldMessageSize,+  fieldSVarint32Size,+  fieldSVarint64Size,+  fieldTextSize,+  fieldVarintSize,+  putByteString,+  putDouble,+  putFixed32,+  putFixed64,+  putFloat,+  putLengthDelimited,+  putSVarint32,+  putSVarint64,+  putTag,+  putText,+  putVarint,+  putVarintSigned,+  tagSize,+  varintSize,+  varintSize32,+  zigZag32,+  zigZag64,+ )+import Proto.Registry (IsMessage)+import Proto.Registry qualified+import Proto.Schema (FieldDescriptor (..), FieldLabel' (..), FieldTypeDescriptor (..), ProtoMessage (..), ScalarFieldType (..), SomeFieldDescriptor (..))+import Wireform.Builder qualified as B+++{- | Serialized FileDescriptorProto for this .proto file.+Decode with @Proto.Google.Protobuf.Descriptor.decodeMessage@.+-}+fileDescriptorProtoBytes :: ByteString+fileDescriptorProtoBytes = "\x0a\x1e\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x64\x75\x72\x61\x74\x69\x6f\x6e\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x2a\x0a\x08\x44\x75\x72\x61\x74\x69\x6f\x6e\x12\x0f\x0a\x07\x73\x65\x63\x6f\x6e\x64\x73\x18\x01\x20\x01\x28\x03\x12\x0d\x0a\x05\x6e\x61\x6e\x6f\x73\x18\x02\x20\x01\x28\x05\x62\x06\x70\x72\x6f\x74\x6f\x33"+++data Duration = Duration+  { durationSeconds :: {-# UNPACK #-} !Int64+  , durationNanos :: {-# UNPACK #-} !Int32+  , durationUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultDuration :: Duration+defaultDuration =+  Duration+    { durationSeconds = 0+    , durationNanos = 0+    , durationUnknownFields = []+    }+++instance MessageEncode Duration where+  buildMessage msg =+    (if msg.durationSeconds == 0 then mempty else archVarint 8 (fromIntegral msg.durationSeconds))+      <> (if msg.durationNanos == 0 then mempty else archVarint 16 (fromIntegral msg.durationNanos))+      <> encodeUnknownFields msg.durationUnknownFields+++instance MessageSize Duration where+  messageSize msg =+    (if msg.durationSeconds == 0 then 0 else archVarintSize (fromIntegral msg.durationSeconds))+      + (if msg.durationNanos == 0 then 0 else archVarintSize (fromIntegral msg.durationNanos))+      + unknownFieldsSize msg.durationUnknownFields+++instance MessageDecode Duration where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop 0 0 []+    where+      loop acc_0 acc_1 acc_unknown_ =+        withTagM+          (pure (Duration {durationSeconds = acc_0, durationNanos = acc_1, durationUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- (fromIntegral <$> decodeFieldVarint)+                loop v acc_1 acc_unknown_+              2 -> do+                v <- (fromIntegral <$> decodeFieldVarint)+                loop acc_0 v acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 acc_1 (uf : acc_unknown_)+          )+++instance ProtoMessage Duration where+  protoMessageName _ = "google.protobuf.Duration"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultDuration+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "seconds"+              , fdNumber = 1+              , fdTypeDesc = ScalarType Int64Field+              , fdLabel = LabelOptional+              , fdGet = durationSeconds+              , fdSet = \v m -> m {durationSeconds = v}+              }+        )+      ,+        ( 2+        , SomeField+            FieldDescriptor+              { fdName = "nanos"+              , fdNumber = 2+              , fdTypeDesc = ScalarType Int32Field+              , fdLabel = LabelOptional+              , fdGet = durationNanos+              , fdSet = \v m -> m {durationNanos = v}+              }+        )+      ]+++instance IsMessage Duration+++instance Aeson.ToJSON Duration where+  toJSON msg =+    let s = msg.durationSeconds+        n = msg.durationNanos+        nanoStr = if n == 0 then T.pack "" else T.pack "." <> dropTrailingZeros (pad9 (abs (fromIntegral n)))+        dropTrailingZeros t = case T.stripSuffix (T.pack "0") t of Just t' -> dropTrailingZeros t'; Nothing -> t+        pad9 x = let sx = T.pack (show x) in T.replicate (9 - T.length sx) (T.pack "0") <> sx+        sign = if s < 0 || n < 0 then T.pack "-" else T.pack ""+    in Aeson.String (sign <> T.pack (show (abs s)) <> nanoStr <> T.pack "s")+++instance Aeson.FromJSON Duration where+  parseJSON (Aeson.String _) = pure defaultDuration+  parseJSON _ = fail "Expected duration string like \"3.5s\""+++instance Hashable Duration where+  hashWithSalt salt msg = hashWithSalt (hashWithSalt (salt) msg.durationSeconds) msg.durationNanos+++instance Proto.Extension.HasExtensions Duration where+  messageUnknownFields = durationUnknownFields+  setMessageUnknownFields !ufs msg = msg {durationUnknownFields = ufs}+++instance Semigroup Duration where+  a <> b =+    Duration+      { durationSeconds = if b.durationSeconds == 0 then a.durationSeconds else b.durationSeconds+      , durationNanos = if b.durationNanos == 0 then a.durationNanos else b.durationNanos+      , durationUnknownFields = a.durationUnknownFields <> b.durationUnknownFields+      }+++instance Monoid Duration where+  mempty = defaultDuration
+ src/Proto/Google/Protobuf/Duration/Util.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE ScopedTypeVariables #-}++{- | Utility functions for @google.protobuf.Duration@.++Provides conversions to\/from 'NominalDiffTime', construction from+milliseconds\/microseconds\/nanoseconds, arithmetic, an 'Ord' instance,+and validation — mirroring utilities found in Go (@durationpb@),+Java (@com.google.protobuf.util.Durations@), and Rust (@prost-types@).+-}+module Proto.Google.Protobuf.Duration.Util (+  -- * Conversions+  durationFromNominalDiffTime,+  durationToNominalDiffTime,++  -- * Construction+  durationFromSeconds,+  durationFromMillis,+  durationFromMicros,+  durationFromNanos,++  -- * Extraction+  durationToSeconds,+  durationToMillis,+  durationToMicros,+  durationToNanos,++  -- * Arithmetic+  addDurations,+  negateDuration,+  absDuration,++  -- * Validation+  isValidDuration,+  normalizeDuration,++  -- * Comparison+  compareDuration,+) where++import Data.Int (Int32, Int64)+import Data.Time.Clock (NominalDiffTime)+import Proto.Google.Protobuf.Duration (Duration (..), defaultDuration)+++nanosPerSecond :: Int64+nanosPerSecond = 1000000000+++{- | Convert a 'NominalDiffTime' to a 'Duration'.++Fractional seconds are preserved at nanosecond granularity.+-}+durationFromNominalDiffTime :: NominalDiffTime -> Duration+durationFromNominalDiffTime ndt =+  let totalNanos = round (ndt * fromIntegral nanosPerSecond) :: Int64+      (s, n) = totalNanos `quotRem` nanosPerSecond+  in defaultDuration+       { durationSeconds = s+       , durationNanos = fromIntegral n+       }+++-- | Convert a 'Duration' to a 'NominalDiffTime'.+durationToNominalDiffTime :: Duration -> NominalDiffTime+durationToNominalDiffTime dur =+  let s = fromIntegral (durationSeconds dur) :: NominalDiffTime+      n = fromIntegral (durationNanos dur) / fromIntegral nanosPerSecond :: NominalDiffTime+  in s + n+++-- | Construct a 'Duration' from whole seconds.+durationFromSeconds :: Int64 -> Duration+durationFromSeconds s = defaultDuration {durationSeconds = s}+++-- | Construct a 'Duration' from milliseconds.+durationFromMillis :: Int64 -> Duration+durationFromMillis ms =+  let (s, rem') = ms `quotRem` 1000+  in defaultDuration+       { durationSeconds = s+       , durationNanos = fromIntegral (rem' * 1000000)+       }+++-- | Construct a 'Duration' from microseconds.+durationFromMicros :: Int64 -> Duration+durationFromMicros us =+  let (s, rem') = us `quotRem` 1000000+  in defaultDuration+       { durationSeconds = s+       , durationNanos = fromIntegral (rem' * 1000)+       }+++-- | Construct a 'Duration' from nanoseconds.+durationFromNanos :: Int64 -> Duration+durationFromNanos ns =+  let (s, n) = ns `quotRem` nanosPerSecond+  in defaultDuration+       { durationSeconds = s+       , durationNanos = fromIntegral n+       }+++-- | Extract total seconds (truncating nanos).+durationToSeconds :: Duration -> Int64+durationToSeconds = durationSeconds+++-- | Convert to total milliseconds (truncating sub-millisecond part).+durationToMillis :: Duration -> Int64+durationToMillis dur =+  durationSeconds dur * 1000 + fromIntegral (durationNanos dur) `quot` 1000000+++-- | Convert to total microseconds (truncating sub-microsecond part).+durationToMicros :: Duration -> Int64+durationToMicros dur =+  durationSeconds dur * 1000000 + fromIntegral (durationNanos dur) `quot` 1000+++-- | Convert to total nanoseconds.+durationToNanos :: Duration -> Int64+durationToNanos dur =+  durationSeconds dur * nanosPerSecond + fromIntegral (durationNanos dur)+++-- | Add two 'Duration' values.+addDurations :: Duration -> Duration -> Duration+addDurations a b =+  let totalNanos = durationToNanos a + durationToNanos b+      (s, n) = totalNanos `quotRem` nanosPerSecond+  in defaultDuration+       { durationSeconds = s+       , durationNanos = fromIntegral n+       }+++-- | Negate a 'Duration'.+negateDuration :: Duration -> Duration+negateDuration dur =+  defaultDuration+    { durationSeconds = negate (durationSeconds dur)+    , durationNanos = negate (durationNanos dur)+    }+++-- | Absolute value of a 'Duration'.+absDuration :: Duration -> Duration+absDuration dur+  | durationSeconds dur < 0 || (durationSeconds dur == 0 && durationNanos dur < 0) =+      negateDuration dur+  | otherwise = dur+++{- | Normalize a Duration so that seconds and nanos have the same sign+and nanos is in @(-999999999, 999999999)@.++The proto spec requires that for valid Durations, nanos have the same+sign as seconds (or be zero) and @|nanos| < 10^9@.+-}+normalizeDuration :: Duration -> Duration+normalizeDuration dur =+  let totalNanos = durationToNanos dur+      (s, n) = totalNanos `quotRem` nanosPerSecond+  in defaultDuration+       { durationSeconds = s+       , durationNanos = fromIntegral n+       }+++{- | A 'Duration' is valid when:++* seconds is in @[-315576000000, 315576000000]@ (roughly +/- 10000 years)+* nanos is in @[-999999999, 999999999]@+* seconds and nanos have the same sign (or either is zero)+-}+isValidDuration :: Duration -> Bool+isValidDuration dur =+  abs (durationSeconds dur) <= 315576000000+    && abs (fromIntegral (durationNanos dur) :: Int64) <= 999999999+    && signsAgree (durationSeconds dur) (fromIntegral (durationNanos dur))+  where+    signsAgree s n+      | s == 0 || n == 0 = True+      | otherwise = (s > 0) == (n > 0)+++-- | Compare two 'Duration' values by total nanoseconds.+compareDuration :: Duration -> Duration -> Ordering+compareDuration a b = compare (durationToNanos a) (durationToNanos b)+++instance Ord Duration where+  compare = compareDuration
+ src/Proto/Google/Protobuf/Empty.hs view
@@ -0,0 +1,184 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}+{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-matches -Wno-unused-top-binds #-}++{- | Auto-generated protobuf types from package @google.protobuf@.++__THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__++Any manual changes will be overwritten the next time code+generation is run.  To modify the types or instances, edit the+@.proto@ source file and re-run the code generator.+-}+module Proto.Google.Protobuf.Empty where++import Control.DeepSeq (NFData (..))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as AesonKey+import Data.Aeson.KeyMap qualified as AesonKM+import Data.Aeson.Types qualified as Aeson+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Hashable (Hashable (..))+import Data.Int (Int32, Int64)+import Data.Map.Strict qualified as Map+import Data.Proxy (Proxy (..))+import Data.Reflection (Given (..), given)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V+import Data.Vector.Unboxed qualified as VU+import Data.Word (Word32, Word64)+import GHC.Generics (Generic)+import Proto.Decode+import Proto.Encode+import Proto.Extension qualified+import Proto.Internal.Encode.Archetype (+  archBool,+  archBoolSize,+  archBytes,+  archBytesSize,+  archDouble,+  archFixed32,+  archFixed32Size,+  archFixed64,+  archFixed64Size,+  archFloat,+  archSVarint32,+  archSVarint64,+  archString,+  archStringSize,+  archSubmessage,+  archSubmessageSize,+  archVarint,+  archVarintSize,+ )+import Proto.Internal.JSON (bytesFieldToJSON, bytesMapFieldToJSON, jsonObject, parseBytesFieldMaybe, parseBytesMapFieldMaybe, parseFieldMaybe, protoBytesToJSON, (.=:))+import Proto.Internal.JSON.Extension qualified as PJExt+import Proto.Internal.Wire (Tag (..), WireType (..))+import Proto.Internal.Wire.Encode (+  fieldBoolSize,+  fieldBytesSize,+  fieldDoubleSize,+  fieldFixed32Size,+  fieldFixed64Size,+  fieldFloatSize,+  fieldMessageSize,+  fieldSVarint32Size,+  fieldSVarint64Size,+  fieldTextSize,+  fieldVarintSize,+  putByteString,+  putDouble,+  putFixed32,+  putFixed64,+  putFloat,+  putLengthDelimited,+  putSVarint32,+  putSVarint64,+  putTag,+  putText,+  putVarint,+  putVarintSigned,+  tagSize,+  varintSize,+  varintSize32,+  zigZag32,+  zigZag64,+ )+import Proto.Registry (IsMessage)+import Proto.Registry qualified+import Proto.Schema (FieldDescriptor (..), FieldLabel' (..), FieldTypeDescriptor (..), ProtoMessage (..), ScalarFieldType (..), SomeFieldDescriptor (..))+import Wireform.Builder qualified as B+++{- | Serialized FileDescriptorProto for this .proto file.+Decode with @Proto.Google.Protobuf.Descriptor.decodeMessage@.+-}+fileDescriptorProtoBytes :: ByteString+fileDescriptorProtoBytes = "\x0a\x1b\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x65\x6d\x70\x74\x79\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x07\x0a\x05\x45\x6d\x70\x74\x79\x62\x06\x70\x72\x6f\x74\x6f\x33"+++data Empty = Empty+  { emptyUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultEmpty :: Empty+defaultEmpty =+  Empty+    { emptyUnknownFields = []+    }+++instance MessageEncode Empty where+  buildMessage msg =+    encodeUnknownFields msg.emptyUnknownFields+++instance MessageSize Empty where+  messageSize msg =+    unknownFieldsSize msg.emptyUnknownFields+++instance MessageDecode Empty where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop []+    where+      loop acc_unknown_ =+        withTagM+          (pure (Empty {emptyUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop (uf : acc_unknown_)+          )+++instance ProtoMessage Empty where+  protoMessageName _ = "google.protobuf.Empty"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultEmpty+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      []+++instance IsMessage Empty+++instance Aeson.ToJSON Empty where+  toJSON msg =+    jsonObject+      []+++instance Aeson.FromJSON Empty where+  parseJSON _ = pure defaultEmpty+++instance Hashable Empty where+  hashWithSalt salt _ = salt+++instance Proto.Extension.HasExtensions Empty where+  messageUnknownFields = emptyUnknownFields+  setMessageUnknownFields !ufs msg = msg {emptyUnknownFields = ufs}+++instance Semigroup Empty where+  a <> b =+    Empty+      { emptyUnknownFields = a.emptyUnknownFields <> b.emptyUnknownFields+      }+++instance Monoid Empty where+  mempty = defaultEmpty
+ src/Proto/Google/Protobuf/FieldMask.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}+{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-matches -Wno-unused-top-binds #-}++{- | Auto-generated protobuf types from package @google.protobuf@.++__THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__++Any manual changes will be overwritten the next time code+generation is run.  To modify the types or instances, edit the+@.proto@ source file and re-run the code generator.+-}+module Proto.Google.Protobuf.FieldMask where++import Control.DeepSeq (NFData (..))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as AesonKey+import Data.Aeson.KeyMap qualified as AesonKM+import Data.Aeson.Types qualified as Aeson+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Hashable (Hashable (..))+import Data.Int (Int32, Int64)+import Data.Map.Strict qualified as Map+import Data.Proxy (Proxy (..))+import Data.Reflection (Given (..), given)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V+import Data.Vector.Unboxed qualified as VU+import Data.Word (Word32, Word64)+import GHC.Generics (Generic)+import Proto.Decode+import Proto.Encode+import Proto.Extension qualified+import Proto.Internal.Encode.Archetype (+  archBool,+  archBoolSize,+  archBytes,+  archBytesSize,+  archDouble,+  archFixed32,+  archFixed32Size,+  archFixed64,+  archFixed64Size,+  archFloat,+  archSVarint32,+  archSVarint64,+  archString,+  archStringSize,+  archSubmessage,+  archSubmessageSize,+  archVarint,+  archVarintSize,+ )+import Proto.Internal.JSON (bytesFieldToJSON, bytesMapFieldToJSON, jsonObject, parseBytesFieldMaybe, parseBytesMapFieldMaybe, parseFieldMaybe, protoBytesToJSON, (.=:))+import Proto.Internal.JSON.Extension qualified as PJExt+import Proto.Internal.Wire (Tag (..), WireType (..))+import Proto.Internal.Wire.Encode (+  fieldBoolSize,+  fieldBytesSize,+  fieldDoubleSize,+  fieldFixed32Size,+  fieldFixed64Size,+  fieldFloatSize,+  fieldMessageSize,+  fieldSVarint32Size,+  fieldSVarint64Size,+  fieldTextSize,+  fieldVarintSize,+  putByteString,+  putDouble,+  putFixed32,+  putFixed64,+  putFloat,+  putLengthDelimited,+  putSVarint32,+  putSVarint64,+  putTag,+  putText,+  putVarint,+  putVarintSigned,+  tagSize,+  varintSize,+  varintSize32,+  zigZag32,+  zigZag64,+ )+import Proto.Registry (IsMessage)+import Proto.Registry qualified+import Proto.Schema (FieldDescriptor (..), FieldLabel' (..), FieldTypeDescriptor (..), ProtoMessage (..), ScalarFieldType (..), SomeFieldDescriptor (..))+import Wireform.Builder qualified as B+++{- | Serialized FileDescriptorProto for this .proto file.+Decode with @Proto.Google.Protobuf.Descriptor.decodeMessage@.+-}+fileDescriptorProtoBytes :: ByteString+fileDescriptorProtoBytes = "\x0a\x20\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x66\x69\x65\x6c\x64\x5f\x6d\x61\x73\x6b\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x1a\x0a\x09\x46\x69\x65\x6c\x64\x4d\x61\x73\x6b\x12\x0d\x0a\x05\x70\x61\x74\x68\x73\x18\x01\x20\x03\x28\x09\x62\x06\x70\x72\x6f\x74\x6f\x33"+++data FieldMask = FieldMask+  { fieldMaskPaths :: !(V.Vector Text)+  , fieldMaskUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultFieldMask :: FieldMask+defaultFieldMask =+  FieldMask+    { fieldMaskPaths = V.empty+    , fieldMaskUnknownFields = []+    }+++instance MessageEncode FieldMask where+  buildMessage msg =+    V.foldl' (\acc v -> acc <> archString 10 v) mempty msg.fieldMaskPaths+      <> encodeUnknownFields msg.fieldMaskUnknownFields+++instance MessageSize FieldMask where+  messageSize msg =+    (V.foldl' (\acc v -> acc + fieldTextSize 1 v) 0 msg.fieldMaskPaths)+      + unknownFieldsSize msg.fieldMaskUnknownFields+++instance MessageDecode FieldMask where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop V.empty []+    where+      loop acc_0 acc_unknown_ =+        withTagM+          (pure (FieldMask {fieldMaskPaths = acc_0, fieldMaskUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- decodeFieldString+                loop (acc_0 <> V.singleton v) acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 (uf : acc_unknown_)+          )+++instance ProtoMessage FieldMask where+  protoMessageName _ = "google.protobuf.FieldMask"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultFieldMask+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "paths"+              , fdNumber = 1+              , fdTypeDesc = ScalarType StringField+              , fdLabel = LabelRepeated+              , fdGet = fieldMaskPaths+              , fdSet = \v m -> m {fieldMaskPaths = v}+              }+        )+      ]+++instance IsMessage FieldMask+++instance Aeson.ToJSON FieldMask where+  toJSON msg =+    jsonObject+      [ "paths" .=: msg.fieldMaskPaths+      ]+++instance Aeson.FromJSON FieldMask where+  parseJSON = Aeson.withObject "FieldMask" $ \obj -> do+    fld_fieldMaskPaths <- parseFieldMaybe obj "paths"+    pure+      defaultFieldMask+        { fieldMaskPaths = maybe (fieldMaskPaths defaultFieldMask) id fld_fieldMaskPaths+        , fieldMaskUnknownFields = []+        }+++instance Hashable FieldMask where+  hashWithSalt salt msg = V.foldl' hashWithSalt (salt) msg.fieldMaskPaths+++instance Proto.Extension.HasExtensions FieldMask where+  messageUnknownFields = fieldMaskUnknownFields+  setMessageUnknownFields !ufs msg = msg {fieldMaskUnknownFields = ufs}+++instance Semigroup FieldMask where+  a <> b =+    FieldMask+      { fieldMaskPaths = a.fieldMaskPaths <> b.fieldMaskPaths+      , fieldMaskUnknownFields = a.fieldMaskUnknownFields <> b.fieldMaskUnknownFields+      }+++instance Monoid FieldMask where+  mempty = defaultFieldMask
+ src/Proto/Google/Protobuf/FieldMask/Util.hs view
@@ -0,0 +1,206 @@+{-# LANGUAGE ScopedTypeVariables #-}++{- | Utility functions for @google.protobuf.FieldMask@.++Provides set operations (union, intersection), path normalization,+containment checks, construction helpers, validation against a message+schema, and an @allFieldMask@ constructor — mirroring utilities found in+Go (@fieldmaskpb@), Java (@com.google.protobuf.util.FieldMaskUtil@),+and C++ (@google::protobuf::util::FieldMaskUtil@).+-}+module Proto.Google.Protobuf.FieldMask.Util (+  -- * Construction+  fromPaths,+  toPaths,+  allFieldMask,++  -- * Set operations+  union,+  intersection,+  subtractMask,++  -- * Normalization+  normalize,++  -- * Querying+  contains,+  isEmpty,++  -- * Validation+  isValid,++  -- * Path utilities+  canonicalForm,+  toCamelCase,+  toSnakeCase,+) where++import Data.Char (isUpper, toLower, toUpper)+import Data.Map.Strict qualified as Map+import Data.Proxy (Proxy)+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V+import Proto.Google.Protobuf.FieldMask (FieldMask (..), defaultFieldMask)+import Proto.Schema (FieldDescriptor (..), ProtoMessage (..), SomeFieldDescriptor (..))+++-- | Construct a 'FieldMask' from a list of paths.+fromPaths :: [Text] -> FieldMask+fromPaths ps = defaultFieldMask {fieldMaskPaths = V.fromList ps}+++-- | Extract the list of paths from a 'FieldMask'.+toPaths :: FieldMask -> [Text]+toPaths = V.toList . fieldMaskPaths+++-- | Construct a 'FieldMask' covering all top-level fields of a message.+allFieldMask :: forall a. ProtoMessage a => Proxy a -> FieldMask+allFieldMask p =+  let descs = protoFieldDescriptors p+      names = fmap (\(SomeField fd) -> fdName fd) (Map.elems descs)+  in defaultFieldMask {fieldMaskPaths = V.fromList names}+++{- | Union of two 'FieldMask' values (all paths from both).++The result is normalized: sorted, deduplicated, and sub-paths are+removed when a parent path is present.+-}+union :: FieldMask -> FieldMask -> FieldMask+union a b =+  normalize $+    defaultFieldMask+      { fieldMaskPaths = fieldMaskPaths a V.++ fieldMaskPaths b+      }+++{- | Intersection of two 'FieldMask' values.++A path is included if it appears in both masks, or if one mask contains+a parent path that covers the other's more specific path.+-}+intersection :: FieldMask -> FieldMask -> FieldMask+intersection a b =+  let setPaths fm = Set.fromList (V.toList (fieldMaskPaths fm))+      sa = setPaths a+      sb = setPaths b+      result =+        Set.filter (\p -> containedIn p sb) sa+          `Set.union` Set.filter (\p -> containedIn p sa) sb+  in defaultFieldMask {fieldMaskPaths = V.fromList (Set.toAscList result)}+  where+    containedIn path pathSet =+      Set.member path pathSet || hasAncestor path pathSet++    hasAncestor path pathSet =+      any (\candidate -> isProperPrefix candidate path) (Set.toList pathSet)+++{- | Subtract one 'FieldMask' from another. The result contains paths from+the first mask that are not covered by the second.+-}+subtractMask :: FieldMask -> FieldMask -> FieldMask+subtractMask a b =+  let sb = Set.fromList (V.toList (fieldMaskPaths b))+      filtered = V.filter (\p -> not (coveredBy p sb)) (fieldMaskPaths a)+  in defaultFieldMask {fieldMaskPaths = filtered}+  where+    coveredBy path pathSet =+      Set.member path pathSet+        || any (\candidate -> isProperPrefix candidate path) (Set.toList pathSet)+++{- | Normalize a 'FieldMask': sort paths, remove duplicates, and remove+paths that are sub-paths of another entry.++For example, @[\"a.b\", \"a\", \"c\"]@ normalizes to @[\"a\", \"c\"]@.+-}+normalize :: FieldMask -> FieldMask+normalize fm =+  let sorted = Set.toAscList (Set.fromList (V.toList (fieldMaskPaths fm)))+      pruned = removeRedundant sorted+  in defaultFieldMask {fieldMaskPaths = V.fromList pruned}+++removeRedundant :: [Text] -> [Text]+removeRedundant = go Set.empty+  where+    go _ [] = []+    go ancestors (p : ps)+      | any (\a -> isProperPrefix a p) (Set.toList ancestors) = go ancestors ps+      | otherwise = p : go (Set.insert p ancestors) ps+++isProperPrefix :: Text -> Text -> Bool+isProperPrefix prefix path =+  T.isPrefixOf prefix path+    && T.length prefix < T.length path+    && T.index path (T.length prefix) == '.'+++{- | Check whether a 'FieldMask' contains a specific path, accounting for+parent-path coverage.++@contains (fromPaths [\"a\"]) \"a.b\"@ is 'True' because @\"a\"@ covers+all sub-paths.+-}+contains :: FieldMask -> Text -> Bool+contains fm path =+  V.any (\p -> p == path || isProperPrefix p path) (fieldMaskPaths fm)+++-- | Is the 'FieldMask' empty (no paths)?+isEmpty :: FieldMask -> Bool+isEmpty = V.null . fieldMaskPaths+++{- | Validate a 'FieldMask' against a message's schema. Each top-level+path segment must correspond to a known field name.+-}+isValid :: forall a. ProtoMessage a => Proxy a -> FieldMask -> Bool+isValid p fm =+  let descs = protoFieldDescriptors p+      validNames = Set.fromList (fmap (\(SomeField fd) -> fdName fd) (Map.elems descs))+  in V.all (\path -> topLevel path `Set.member` validNames) (fieldMaskPaths fm)+  where+    topLevel path = case T.breakOn "." path of+      (first, _) -> first+++-- | Produce a canonical text form: sorted, deduplicated, sub-paths removed.+canonicalForm :: FieldMask -> Text+canonicalForm = T.intercalate "," . toPaths . normalize+++{- | Convert a snake_case field path to lowerCamelCase (for JSON mapping).++@\"foo_bar.baz_qux\"@ becomes @\"fooBar.bazQux\"@.+-}+toCamelCase :: Text -> Text+toCamelCase = T.intercalate "." . fmap segmentToCamel . T.splitOn "."+  where+    segmentToCamel seg =+      let parts = T.splitOn "_" seg+      in case parts of+           [] -> ""+           (first : rest) -> first <> T.concat (fmap capitalize rest)+    capitalize t+      | T.null t = t+      | otherwise = T.cons (toUpper (T.head t)) (T.tail t)+++{- | Convert a lowerCamelCase field path to snake_case (from JSON mapping).++@\"fooBar.bazQux\"@ becomes @\"foo_bar.baz_qux\"@.+-}+toSnakeCase :: Text -> Text+toSnakeCase = T.intercalate "." . fmap segmentToSnake . T.splitOn "."+  where+    segmentToSnake = T.concatMap $ \c ->+      if isUpper c+        then T.pack ['_', toLower c]+        else T.singleton c
− src/Proto/Google/Protobuf/Reflection/Descriptor.hs 
@@ -1,7794 +0,0 @@-{-# LANGUAGE StrictData #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedRecordDot #-}--- | Auto-generated protobuf types from package @google.protobuf@.------ __THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__------ Any manual changes will be overwritten the next time code--- generation is run.  To modify the types or instances, edit the--- @.proto@ source file and re-run the code generator.-module Proto.Google.Protobuf.Reflection.Descriptor where--import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Wireform.Builder as B-import Data.Int (Int32, Int64)-import Data.Text (Text)-import qualified Data.Text as T-import Data.Word (Word8, Word32, Word64)-import qualified Data.IntMap.Strict as IntMap-import qualified Data.Map.Strict as Map-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU-import GHC.Generics (Generic)-import Control.DeepSeq (NFData(..))-import Data.Hashable (Hashable(..))-import Proto.Internal.Encode-import Proto.Internal.Decode-import Proto.Internal.GrowList (GrowList, emptyGrowList, snocGrowList, growListToVector)-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson-import qualified Data.Aeson.Key as AesonKey-import qualified Data.Aeson.KeyMap as AesonKM-import Proto.Internal.JSON (jsonObject, (.=:), parseFieldMaybe, bytesFieldToJSON, parseBytesFieldMaybe, bytesMapFieldToJSON, parseBytesMapFieldMaybe, protoBytesToJSON, OneofVariantNullSemantics (..), parseOneofVariants)-import Data.Proxy (Proxy(..))-import Proto.Schema (ProtoMessage(..), SomeFieldDescriptor(..), FieldDescriptor(..), FieldTypeDescriptor(..), ScalarFieldType(..), FieldLabel'(..))-import Proto.Registry (IsMessage)-import Proto.Registry qualified-import qualified Proto.Extension-import Proto.Internal.Wire (Tag(..), WireType(..))-import Proto.Internal.Wire.Encode (putTag, putVarint, putFixed32, putFixed64,-  putFloat, putDouble, putText, putByteString, putLengthDelimited,-  putSVarint32, putSVarint64, putVarintSigned,-  varintSize, tagSize,-  varintSize32, zigZag32, zigZag64)-import Proto.Internal.Encode.Archetype (archVarint, archSVarint32, archSVarint64,-  archFixed32, archFixed64, archFloat, archDouble, archBool,-  archString, archBytes, archSubmessage)---- | Serialized FileDescriptorProto for this .proto file.--- Decode with @Proto.Decode.decodeMessage@.-fileDescriptorProtoBytes :: ByteString-fileDescriptorProtoBytes = "\x0a\x20\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x64\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x36\x0a\x11\x46\x69\x6c\x65\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x53\x65\x74\x12\x21\x0a\x04\x66\x69\x6c\x65\x18\x01\x20\x03\x28\x0b\x32\x13\x46\x69\x6c\x65\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x22\x8f\x03\x0a\x13\x46\x69\x6c\x65\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x0c\x0a\x04\x6e\x61\x6d\x65\x18\x01\x20\x01\x28\x09\x12\x0f\x0a\x07\x70\x61\x63\x6b\x61\x67\x65\x18\x02\x20\x01\x28\x09\x12\x12\x0a\x0a\x64\x65\x70\x65\x6e\x64\x65\x6e\x63\x79\x18\x03\x20\x03\x28\x09\x12\x19\x0a\x11\x70\x75\x62\x6c\x69\x63\x5f\x64\x65\x70\x65\x6e\x64\x65\x6e\x63\x79\x18\x0a\x20\x03\x28\x05\x12\x17\x0a\x0f\x77\x65\x61\x6b\x5f\x64\x65\x70\x65\x6e\x64\x65\x6e\x63\x79\x18\x0b\x20\x03\x28\x05\x12\x25\x0a\x0c\x6d\x65\x73\x73\x61\x67\x65\x5f\x74\x79\x70\x65\x18\x04\x20\x03\x28\x0b\x32\x0f\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x26\x0a\x09\x65\x6e\x75\x6d\x5f\x74\x79\x70\x65\x18\x05\x20\x03\x28\x0b\x32\x13\x45\x6e\x75\x6d\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x27\x0a\x07\x73\x65\x72\x76\x69\x63\x65\x18\x06\x20\x03\x28\x0b\x32\x16\x53\x65\x72\x76\x69\x63\x65\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x27\x0a\x09\x65\x78\x74\x65\x6e\x73\x69\x6f\x6e\x18\x07\x20\x03\x28\x0b\x32\x14\x46\x69\x65\x6c\x64\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x1c\x0a\x07\x6f\x70\x74\x69\x6f\x6e\x73\x18\x08\x20\x01\x28\x0b\x32\x0b\x46\x69\x6c\x65\x4f\x70\x74\x69\x6f\x6e\x73\x12\x28\x0a\x10\x73\x6f\x75\x72\x63\x65\x5f\x63\x6f\x64\x65\x5f\x69\x6e\x66\x6f\x18\x09\x20\x01\x28\x0b\x32\x0e\x53\x6f\x75\x72\x63\x65\x43\x6f\x64\x65\x49\x6e\x66\x6f\x12\x0e\x0a\x06\x73\x79\x6e\x74\x61\x78\x18\x0c\x20\x01\x28\x09\x12\x18\x0a\x07\x65\x64\x69\x74\x69\x6f\x6e\x18\x0e\x20\x01\x28\x0b\x32\x07\x45\x64\x69\x74\x69\x6f\x6e\x22\xf0\x03\x0a\x0f\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x0c\x0a\x04\x6e\x61\x6d\x65\x18\x01\x20\x01\x28\x09\x12\x23\x0a\x05\x66\x69\x65\x6c\x64\x18\x02\x20\x03\x28\x0b\x32\x14\x46\x69\x65\x6c\x64\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x27\x0a\x09\x65\x78\x74\x65\x6e\x73\x69\x6f\x6e\x18\x06\x20\x03\x28\x0b\x32\x14\x46\x69\x65\x6c\x64\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x24\x0a\x0b\x6e\x65\x73\x74\x65\x64\x5f\x74\x79\x70\x65\x18\x03\x20\x03\x28\x0b\x32\x0f\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x26\x0a\x09\x65\x6e\x75\x6d\x5f\x74\x79\x70\x65\x18\x04\x20\x03\x28\x0b\x32\x13\x45\x6e\x75\x6d\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x27\x0a\x0f\x65\x78\x74\x65\x6e\x73\x69\x6f\x6e\x5f\x72\x61\x6e\x67\x65\x18\x05\x20\x03\x28\x0b\x32\x0e\x45\x78\x74\x65\x6e\x73\x69\x6f\x6e\x52\x61\x6e\x67\x65\x12\x28\x0a\x0a\x6f\x6e\x65\x6f\x66\x5f\x64\x65\x63\x6c\x18\x08\x20\x03\x28\x0b\x32\x14\x4f\x6e\x65\x6f\x66\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x1f\x0a\x07\x6f\x70\x74\x69\x6f\x6e\x73\x18\x07\x20\x01\x28\x0b\x32\x0e\x4d\x65\x73\x73\x61\x67\x65\x4f\x70\x74\x69\x6f\x6e\x73\x12\x25\x0a\x0e\x72\x65\x73\x65\x72\x76\x65\x64\x5f\x72\x61\x6e\x67\x65\x18\x09\x20\x03\x28\x0b\x32\x0d\x52\x65\x73\x65\x72\x76\x65\x64\x52\x61\x6e\x67\x65\x12\x15\x0a\x0d\x72\x65\x73\x65\x72\x76\x65\x64\x5f\x6e\x61\x6d\x65\x18\x0a\x20\x03\x28\x09\x1a\x54\x0a\x0e\x45\x78\x74\x65\x6e\x73\x69\x6f\x6e\x52\x61\x6e\x67\x65\x12\x0d\x0a\x05\x73\x74\x61\x72\x74\x18\x01\x20\x01\x28\x05\x12\x0b\x0a\x03\x65\x6e\x64\x18\x02\x20\x01\x28\x05\x12\x26\x0a\x07\x6f\x70\x74\x69\x6f\x6e\x73\x18\x03\x20\x01\x28\x0b\x32\x15\x45\x78\x74\x65\x6e\x73\x69\x6f\x6e\x52\x61\x6e\x67\x65\x4f\x70\x74\x69\x6f\x6e\x73\x1a\x2b\x0a\x0d\x52\x65\x73\x65\x72\x76\x65\x64\x52\x61\x6e\x67\x65\x12\x0d\x0a\x05\x73\x74\x61\x72\x74\x18\x01\x20\x01\x28\x05\x12\x0b\x0a\x03\x65\x6e\x64\x18\x02\x20\x01\x28\x05\x22\xce\x02\x0a\x15\x45\x78\x74\x65\x6e\x73\x69\x6f\x6e\x52\x61\x6e\x67\x65\x4f\x70\x74\x69\x6f\x6e\x73\x12\x32\x0a\x14\x75\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x5f\x6f\x70\x74\x69\x6f\x6e\x18\xe7\x07\x20\x03\x28\x0b\x32\x13\x55\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x4f\x70\x74\x69\x6f\x6e\x12\x20\x0a\x0b\x64\x65\x63\x6c\x61\x72\x61\x74\x69\x6f\x6e\x18\x02\x20\x03\x28\x0b\x32\x0b\x44\x65\x63\x6c\x61\x72\x61\x74\x69\x6f\x6e\x12\x1c\x0a\x08\x66\x65\x61\x74\x75\x72\x65\x73\x18\x32\x20\x01\x28\x0b\x32\x0a\x46\x65\x61\x74\x75\x72\x65\x53\x65\x74\x12\x27\x0a\x0c\x76\x65\x72\x69\x66\x69\x63\x61\x74\x69\x6f\x6e\x18\x03\x20\x01\x28\x0b\x32\x11\x56\x65\x72\x69\x66\x69\x63\x61\x74\x69\x6f\x6e\x53\x74\x61\x74\x65\x1a\x62\x0a\x0b\x44\x65\x63\x6c\x61\x72\x61\x74\x69\x6f\x6e\x12\x0e\x0a\x06\x6e\x75\x6d\x62\x65\x72\x18\x01\x20\x01\x28\x05\x12\x11\x0a\x09\x66\x75\x6c\x6c\x5f\x6e\x61\x6d\x65\x18\x02\x20\x01\x28\x09\x12\x0c\x0a\x04\x74\x79\x70\x65\x18\x03\x20\x01\x28\x09\x12\x10\x0a\x08\x72\x65\x73\x65\x72\x76\x65\x64\x18\x05\x20\x01\x28\x08\x12\x10\x0a\x08\x72\x65\x70\x65\x61\x74\x65\x64\x18\x06\x20\x01\x28\x08\x22\x34\x0a\x11\x56\x65\x72\x69\x66\x69\x63\x61\x74\x69\x6f\x6e\x53\x74\x61\x74\x65\x12\x0f\x0a\x0b\x44\x45\x43\x4c\x41\x52\x41\x54\x49\x4f\x4e\x10\x00\x12\x0e\x0a\x0a\x55\x4e\x56\x45\x52\x49\x46\x49\x45\x44\x10\x01\x22\xf8\x04\x0a\x14\x46\x69\x65\x6c\x64\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x0c\x0a\x04\x6e\x61\x6d\x65\x18\x01\x20\x01\x28\x09\x12\x0e\x0a\x06\x6e\x75\x6d\x62\x65\x72\x18\x03\x20\x01\x28\x05\x12\x14\x0a\x05\x6c\x61\x62\x65\x6c\x18\x04\x20\x01\x28\x0b\x32\x05\x4c\x61\x62\x65\x6c\x12\x12\x0a\x04\x74\x79\x70\x65\x18\x05\x20\x01\x28\x0b\x32\x04\x54\x79\x70\x65\x12\x11\x0a\x09\x74\x79\x70\x65\x5f\x6e\x61\x6d\x65\x18\x06\x20\x01\x28\x09\x12\x10\x0a\x08\x65\x78\x74\x65\x6e\x64\x65\x65\x18\x02\x20\x01\x28\x09\x12\x15\x0a\x0d\x64\x65\x66\x61\x75\x6c\x74\x5f\x76\x61\x6c\x75\x65\x18\x07\x20\x01\x28\x09\x12\x13\x0a\x0b\x6f\x6e\x65\x6f\x66\x5f\x69\x6e\x64\x65\x78\x18\x09\x20\x01\x28\x05\x12\x11\x0a\x09\x6a\x73\x6f\x6e\x5f\x6e\x61\x6d\x65\x18\x0a\x20\x01\x28\x09\x12\x1d\x0a\x07\x6f\x70\x74\x69\x6f\x6e\x73\x18\x08\x20\x01\x28\x0b\x32\x0c\x46\x69\x65\x6c\x64\x4f\x70\x74\x69\x6f\x6e\x73\x12\x17\x0a\x0f\x70\x72\x6f\x74\x6f\x33\x5f\x6f\x70\x74\x69\x6f\x6e\x61\x6c\x18\x11\x20\x01\x28\x08\x22\xb6\x02\x0a\x04\x54\x79\x70\x65\x12\x0f\x0a\x0b\x54\x59\x50\x45\x5f\x44\x4f\x55\x42\x4c\x45\x10\x01\x12\x0e\x0a\x0a\x54\x59\x50\x45\x5f\x46\x4c\x4f\x41\x54\x10\x02\x12\x0e\x0a\x0a\x54\x59\x50\x45\x5f\x49\x4e\x54\x36\x34\x10\x03\x12\x0f\x0a\x0b\x54\x59\x50\x45\x5f\x55\x49\x4e\x54\x36\x34\x10\x04\x12\x0e\x0a\x0a\x54\x59\x50\x45\x5f\x49\x4e\x54\x33\x32\x10\x05\x12\x10\x0a\x0c\x54\x59\x50\x45\x5f\x46\x49\x58\x45\x44\x36\x34\x10\x06\x12\x10\x0a\x0c\x54\x59\x50\x45\x5f\x46\x49\x58\x45\x44\x33\x32\x10\x07\x12\x0d\x0a\x09\x54\x59\x50\x45\x5f\x42\x4f\x4f\x4c\x10\x08\x12\x0f\x0a\x0b\x54\x59\x50\x45\x5f\x53\x54\x52\x49\x4e\x47\x10\x09\x12\x0e\x0a\x0a\x54\x59\x50\x45\x5f\x47\x52\x4f\x55\x50\x10\x0a\x12\x10\x0a\x0c\x54\x59\x50\x45\x5f\x4d\x45\x53\x53\x41\x47\x45\x10\x0b\x12\x0e\x0a\x0a\x54\x59\x50\x45\x5f\x42\x59\x54\x45\x53\x10\x0c\x12\x0f\x0a\x0b\x54\x59\x50\x45\x5f\x55\x49\x4e\x54\x33\x32\x10\x0d\x12\x0d\x0a\x09\x54\x59\x50\x45\x5f\x45\x4e\x55\x4d\x10\x0e\x12\x11\x0a\x0d\x54\x59\x50\x45\x5f\x53\x46\x49\x58\x45\x44\x33\x32\x10\x0f\x12\x11\x0a\x0d\x54\x59\x50\x45\x5f\x53\x46\x49\x58\x45\x44\x36\x34\x10\x10\x12\x0f\x0a\x0b\x54\x59\x50\x45\x5f\x53\x49\x4e\x54\x33\x32\x10\x11\x12\x0f\x0a\x0b\x54\x59\x50\x45\x5f\x53\x49\x4e\x54\x36\x34\x10\x12\x22\x43\x0a\x05\x4c\x61\x62\x65\x6c\x12\x12\x0a\x0e\x4c\x41\x42\x45\x4c\x5f\x4f\x50\x54\x49\x4f\x4e\x41\x4c\x10\x01\x12\x12\x0a\x0e\x4c\x41\x42\x45\x4c\x5f\x52\x45\x50\x45\x41\x54\x45\x44\x10\x03\x12\x12\x0a\x0e\x4c\x41\x42\x45\x4c\x5f\x52\x45\x51\x55\x49\x52\x45\x44\x10\x02\x22\x43\x0a\x14\x4f\x6e\x65\x6f\x66\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x0c\x0a\x04\x6e\x61\x6d\x65\x18\x01\x20\x01\x28\x09\x12\x1d\x0a\x07\x6f\x70\x74\x69\x6f\x6e\x73\x18\x02\x20\x01\x28\x0b\x32\x0c\x4f\x6e\x65\x6f\x66\x4f\x70\x74\x69\x6f\x6e\x73\x22\xdd\x01\x0a\x13\x45\x6e\x75\x6d\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x0c\x0a\x04\x6e\x61\x6d\x65\x18\x01\x20\x01\x28\x09\x12\x27\x0a\x05\x76\x61\x6c\x75\x65\x18\x02\x20\x03\x28\x0b\x32\x18\x45\x6e\x75\x6d\x56\x61\x6c\x75\x65\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x1c\x0a\x07\x6f\x70\x74\x69\x6f\x6e\x73\x18\x03\x20\x01\x28\x0b\x32\x0b\x45\x6e\x75\x6d\x4f\x70\x74\x69\x6f\x6e\x73\x12\x29\x0a\x0e\x72\x65\x73\x65\x72\x76\x65\x64\x5f\x72\x61\x6e\x67\x65\x18\x04\x20\x03\x28\x0b\x32\x11\x45\x6e\x75\x6d\x52\x65\x73\x65\x72\x76\x65\x64\x52\x61\x6e\x67\x65\x12\x15\x0a\x0d\x72\x65\x73\x65\x72\x76\x65\x64\x5f\x6e\x61\x6d\x65\x18\x05\x20\x03\x28\x09\x1a\x2f\x0a\x11\x45\x6e\x75\x6d\x52\x65\x73\x65\x72\x76\x65\x64\x52\x61\x6e\x67\x65\x12\x0d\x0a\x05\x73\x74\x61\x72\x74\x18\x01\x20\x01\x28\x05\x12\x0b\x0a\x03\x65\x6e\x64\x18\x02\x20\x01\x28\x05\x22\x5b\x0a\x18\x45\x6e\x75\x6d\x56\x61\x6c\x75\x65\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x0c\x0a\x04\x6e\x61\x6d\x65\x18\x01\x20\x01\x28\x09\x12\x0e\x0a\x06\x6e\x75\x6d\x62\x65\x72\x18\x02\x20\x01\x28\x05\x12\x21\x0a\x07\x6f\x70\x74\x69\x6f\x6e\x73\x18\x03\x20\x01\x28\x0b\x32\x10\x45\x6e\x75\x6d\x56\x61\x6c\x75\x65\x4f\x70\x74\x69\x6f\x6e\x73\x22\x6e\x0a\x16\x53\x65\x72\x76\x69\x63\x65\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x0c\x0a\x04\x6e\x61\x6d\x65\x18\x01\x20\x01\x28\x09\x12\x25\x0a\x06\x6d\x65\x74\x68\x6f\x64\x18\x02\x20\x03\x28\x0b\x32\x15\x4d\x65\x74\x68\x6f\x64\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x1f\x0a\x07\x6f\x70\x74\x69\x6f\x6e\x73\x18\x03\x20\x01\x28\x0b\x32\x0e\x53\x65\x72\x76\x69\x63\x65\x4f\x70\x74\x69\x6f\x6e\x73\x22\xa2\x01\x0a\x15\x4d\x65\x74\x68\x6f\x64\x44\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x50\x72\x6f\x74\x6f\x12\x0c\x0a\x04\x6e\x61\x6d\x65\x18\x01\x20\x01\x28\x09\x12\x12\x0a\x0a\x69\x6e\x70\x75\x74\x5f\x74\x79\x70\x65\x18\x02\x20\x01\x28\x09\x12\x13\x0a\x0b\x6f\x75\x74\x70\x75\x74\x5f\x74\x79\x70\x65\x18\x03\x20\x01\x28\x09\x12\x1e\x0a\x07\x6f\x70\x74\x69\x6f\x6e\x73\x18\x04\x20\x01\x28\x0b\x32\x0d\x4d\x65\x74\x68\x6f\x64\x4f\x70\x74\x69\x6f\x6e\x73\x12\x18\x0a\x10\x63\x6c\x69\x65\x6e\x74\x5f\x73\x74\x72\x65\x61\x6d\x69\x6e\x67\x18\x05\x20\x01\x28\x08\x12\x18\x0a\x10\x73\x65\x72\x76\x65\x72\x5f\x73\x74\x72\x65\x61\x6d\x69\x6e\x67\x18\x06\x20\x01\x28\x08\x22\xa4\x05\x0a\x0b\x46\x69\x6c\x65\x4f\x70\x74\x69\x6f\x6e\x73\x12\x14\x0a\x0c\x6a\x61\x76\x61\x5f\x70\x61\x63\x6b\x61\x67\x65\x18\x01\x20\x01\x28\x09\x12\x1c\x0a\x14\x6a\x61\x76\x61\x5f\x6f\x75\x74\x65\x72\x5f\x63\x6c\x61\x73\x73\x6e\x61\x6d\x65\x18\x08\x20\x01\x28\x09\x12\x1b\x0a\x13\x6a\x61\x76\x61\x5f\x6d\x75\x6c\x74\x69\x70\x6c\x65\x5f\x66\x69\x6c\x65\x73\x18\x0a\x20\x01\x28\x08\x12\x25\x0a\x1d\x6a\x61\x76\x61\x5f\x67\x65\x6e\x65\x72\x61\x74\x65\x5f\x65\x71\x75\x61\x6c\x73\x5f\x61\x6e\x64\x5f\x68\x61\x73\x68\x18\x14\x20\x01\x28\x08\x12\x1e\x0a\x16\x6a\x61\x76\x61\x5f\x73\x74\x72\x69\x6e\x67\x5f\x63\x68\x65\x63\x6b\x5f\x75\x74\x66\x38\x18\x1b\x20\x01\x28\x08\x12\x22\x0a\x0c\x6f\x70\x74\x69\x6d\x69\x7a\x65\x5f\x66\x6f\x72\x18\x09\x20\x01\x28\x0b\x32\x0c\x4f\x70\x74\x69\x6d\x69\x7a\x65\x4d\x6f\x64\x65\x12\x12\x0a\x0a\x67\x6f\x5f\x70\x61\x63\x6b\x61\x67\x65\x18\x0b\x20\x01\x28\x09\x12\x1b\x0a\x13\x63\x63\x5f\x67\x65\x6e\x65\x72\x69\x63\x5f\x73\x65\x72\x76\x69\x63\x65\x73\x18\x10\x20\x01\x28\x08\x12\x1d\x0a\x15\x6a\x61\x76\x61\x5f\x67\x65\x6e\x65\x72\x69\x63\x5f\x73\x65\x72\x76\x69\x63\x65\x73\x18\x11\x20\x01\x28\x08\x12\x1b\x0a\x13\x70\x79\x5f\x67\x65\x6e\x65\x72\x69\x63\x5f\x73\x65\x72\x76\x69\x63\x65\x73\x18\x12\x20\x01\x28\x08\x12\x12\x0a\x0a\x64\x65\x70\x72\x65\x63\x61\x74\x65\x64\x18\x17\x20\x01\x28\x08\x12\x18\x0a\x10\x63\x63\x5f\x65\x6e\x61\x62\x6c\x65\x5f\x61\x72\x65\x6e\x61\x73\x18\x1f\x20\x01\x28\x08\x12\x19\x0a\x11\x6f\x62\x6a\x63\x5f\x63\x6c\x61\x73\x73\x5f\x70\x72\x65\x66\x69\x78\x18\x24\x20\x01\x28\x09\x12\x18\x0a\x10\x63\x73\x68\x61\x72\x70\x5f\x6e\x61\x6d\x65\x73\x70\x61\x63\x65\x18\x25\x20\x01\x28\x09\x12\x14\x0a\x0c\x73\x77\x69\x66\x74\x5f\x70\x72\x65\x66\x69\x78\x18\x27\x20\x01\x28\x09\x12\x18\x0a\x10\x70\x68\x70\x5f\x63\x6c\x61\x73\x73\x5f\x70\x72\x65\x66\x69\x78\x18\x28\x20\x01\x28\x09\x12\x15\x0a\x0d\x70\x68\x70\x5f\x6e\x61\x6d\x65\x73\x70\x61\x63\x65\x18\x29\x20\x01\x28\x09\x12\x1e\x0a\x16\x70\x68\x70\x5f\x6d\x65\x74\x61\x64\x61\x74\x61\x5f\x6e\x61\x6d\x65\x73\x70\x61\x63\x65\x18\x2c\x20\x01\x28\x09\x12\x14\x0a\x0c\x72\x75\x62\x79\x5f\x70\x61\x63\x6b\x61\x67\x65\x18\x2d\x20\x01\x28\x09\x12\x1c\x0a\x08\x66\x65\x61\x74\x75\x72\x65\x73\x18\x32\x20\x01\x28\x0b\x32\x0a\x46\x65\x61\x74\x75\x72\x65\x53\x65\x74\x12\x32\x0a\x14\x75\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x5f\x6f\x70\x74\x69\x6f\x6e\x18\xe7\x07\x20\x03\x28\x0b\x32\x13\x55\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x4f\x70\x74\x69\x6f\x6e\x22\x3a\x0a\x0c\x4f\x70\x74\x69\x6d\x69\x7a\x65\x4d\x6f\x64\x65\x12\x09\x0a\x05\x53\x50\x45\x45\x44\x10\x01\x12\x0d\x0a\x09\x43\x4f\x44\x45\x5f\x53\x49\x5a\x45\x10\x02\x12\x10\x0a\x0c\x4c\x49\x54\x45\x5f\x52\x55\x4e\x54\x49\x4d\x45\x10\x03\x22\x83\x02\x0a\x0e\x4d\x65\x73\x73\x61\x67\x65\x4f\x70\x74\x69\x6f\x6e\x73\x12\x1f\x0a\x17\x6d\x65\x73\x73\x61\x67\x65\x5f\x73\x65\x74\x5f\x77\x69\x72\x65\x5f\x66\x6f\x72\x6d\x61\x74\x18\x01\x20\x01\x28\x08\x12\x27\x0a\x1f\x6e\x6f\x5f\x73\x74\x61\x6e\x64\x61\x72\x64\x5f\x64\x65\x73\x63\x72\x69\x70\x74\x6f\x72\x5f\x61\x63\x63\x65\x73\x73\x6f\x72\x18\x02\x20\x01\x28\x08\x12\x12\x0a\x0a\x64\x65\x70\x72\x65\x63\x61\x74\x65\x64\x18\x03\x20\x01\x28\x08\x12\x11\x0a\x09\x6d\x61\x70\x5f\x65\x6e\x74\x72\x79\x18\x07\x20\x01\x28\x08\x12\x2e\x0a\x26\x64\x65\x70\x72\x65\x63\x61\x74\x65\x64\x5f\x6c\x65\x67\x61\x63\x79\x5f\x6a\x73\x6f\x6e\x5f\x66\x69\x65\x6c\x64\x5f\x63\x6f\x6e\x66\x6c\x69\x63\x74\x73\x18\x0b\x20\x01\x28\x08\x12\x1c\x0a\x08\x66\x65\x61\x74\x75\x72\x65\x73\x18\x0c\x20\x01\x28\x0b\x32\x0a\x46\x65\x61\x74\x75\x72\x65\x53\x65\x74\x12\x32\x0a\x14\x75\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x5f\x6f\x70\x74\x69\x6f\x6e\x18\xe7\x07\x20\x03\x28\x0b\x32\x13\x55\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x4f\x70\x74\x69\x6f\x6e\x22\xbc\x08\x0a\x0c\x46\x69\x65\x6c\x64\x4f\x70\x74\x69\x6f\x6e\x73\x12\x14\x0a\x05\x63\x74\x79\x70\x65\x18\x01\x20\x01\x28\x0b\x32\x05\x43\x54\x79\x70\x65\x12\x0e\x0a\x06\x70\x61\x63\x6b\x65\x64\x18\x02\x20\x01\x28\x08\x12\x16\x0a\x06\x6a\x73\x74\x79\x70\x65\x18\x06\x20\x01\x28\x0b\x32\x06\x4a\x53\x54\x79\x70\x65\x12\x0c\x0a\x04\x6c\x61\x7a\x79\x18\x05\x20\x01\x28\x08\x12\x17\x0a\x0f\x75\x6e\x76\x65\x72\x69\x66\x69\x65\x64\x5f\x6c\x61\x7a\x79\x18\x0f\x20\x01\x28\x08\x12\x12\x0a\x0a\x64\x65\x70\x72\x65\x63\x61\x74\x65\x64\x18\x03\x20\x01\x28\x08\x12\x0c\x0a\x04\x77\x65\x61\x6b\x18\x0a\x20\x01\x28\x08\x12\x14\x0a\x0c\x64\x65\x62\x75\x67\x5f\x72\x65\x64\x61\x63\x74\x18\x10\x20\x01\x28\x08\x12\x22\x0a\x09\x72\x65\x74\x65\x6e\x74\x69\x6f\x6e\x18\x11\x20\x01\x28\x0b\x32\x0f\x4f\x70\x74\x69\x6f\x6e\x52\x65\x74\x65\x6e\x74\x69\x6f\x6e\x12\x21\x0a\x07\x74\x61\x72\x67\x65\x74\x73\x18\x13\x20\x03\x28\x0b\x32\x10\x4f\x70\x74\x69\x6f\x6e\x54\x61\x72\x67\x65\x74\x54\x79\x70\x65\x12\x28\x0a\x10\x65\x64\x69\x74\x69\x6f\x6e\x5f\x64\x65\x66\x61\x75\x6c\x74\x73\x18\x14\x20\x03\x28\x0b\x32\x0e\x45\x64\x69\x74\x69\x6f\x6e\x44\x65\x66\x61\x75\x6c\x74\x12\x1c\x0a\x08\x66\x65\x61\x74\x75\x72\x65\x73\x18\x15\x20\x01\x28\x0b\x32\x0a\x46\x65\x61\x74\x75\x72\x65\x53\x65\x74\x12\x27\x0a\x0f\x66\x65\x61\x74\x75\x72\x65\x5f\x73\x75\x70\x70\x6f\x72\x74\x18\x16\x20\x01\x28\x0b\x32\x0e\x46\x65\x61\x74\x75\x72\x65\x53\x75\x70\x70\x6f\x72\x74\x12\x32\x0a\x14\x75\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x5f\x6f\x70\x74\x69\x6f\x6e\x18\xe7\x07\x20\x03\x28\x0b\x32\x13\x55\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x4f\x70\x74\x69\x6f\x6e\x1a\x39\x0a\x0e\x45\x64\x69\x74\x69\x6f\x6e\x44\x65\x66\x61\x75\x6c\x74\x12\x18\x0a\x07\x65\x64\x69\x74\x69\x6f\x6e\x18\x03\x20\x01\x28\x0b\x32\x07\x45\x64\x69\x74\x69\x6f\x6e\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x02\x20\x01\x28\x09\x1a\x99\x01\x0a\x0e\x46\x65\x61\x74\x75\x72\x65\x53\x75\x70\x70\x6f\x72\x74\x12\x23\x0a\x12\x65\x64\x69\x74\x69\x6f\x6e\x5f\x69\x6e\x74\x72\x6f\x64\x75\x63\x65\x64\x18\x01\x20\x01\x28\x0b\x32\x07\x45\x64\x69\x74\x69\x6f\x6e\x12\x23\x0a\x12\x65\x64\x69\x74\x69\x6f\x6e\x5f\x64\x65\x70\x72\x65\x63\x61\x74\x65\x64\x18\x02\x20\x01\x28\x0b\x32\x07\x45\x64\x69\x74\x69\x6f\x6e\x12\x1b\x0a\x13\x64\x65\x70\x72\x65\x63\x61\x74\x69\x6f\x6e\x5f\x77\x61\x72\x6e\x69\x6e\x67\x18\x03\x20\x01\x28\x09\x12\x20\x0a\x0f\x65\x64\x69\x74\x69\x6f\x6e\x5f\x72\x65\x6d\x6f\x76\x65\x64\x18\x04\x20\x01\x28\x0b\x32\x07\x45\x64\x69\x74\x69\x6f\x6e\x22\x2f\x0a\x05\x43\x54\x79\x70\x65\x12\x0a\x0a\x06\x53\x54\x52\x49\x4e\x47\x10\x00\x12\x08\x0a\x04\x43\x4f\x52\x44\x10\x01\x12\x10\x0a\x0c\x53\x54\x52\x49\x4e\x47\x5f\x50\x49\x45\x43\x45\x10\x02\x22\x35\x0a\x06\x4a\x53\x54\x79\x70\x65\x12\x0d\x0a\x09\x4a\x53\x5f\x4e\x4f\x52\x4d\x41\x4c\x10\x00\x12\x0d\x0a\x09\x4a\x53\x5f\x53\x54\x52\x49\x4e\x47\x10\x01\x12\x0d\x0a\x09\x4a\x53\x5f\x4e\x55\x4d\x42\x45\x52\x10\x02\x22\x55\x0a\x0f\x4f\x70\x74\x69\x6f\x6e\x52\x65\x74\x65\x6e\x74\x69\x6f\x6e\x12\x15\x0a\x11\x52\x45\x54\x45\x4e\x54\x49\x4f\x4e\x5f\x55\x4e\x4b\x4e\x4f\x57\x4e\x10\x00\x12\x15\x0a\x11\x52\x45\x54\x45\x4e\x54\x49\x4f\x4e\x5f\x52\x55\x4e\x54\x49\x4d\x45\x10\x01\x12\x14\x0a\x10\x52\x45\x54\x45\x4e\x54\x49\x4f\x4e\x5f\x53\x4f\x55\x52\x43\x45\x10\x02\x22\x8c\x02\x0a\x10\x4f\x70\x74\x69\x6f\x6e\x54\x61\x72\x67\x65\x74\x54\x79\x70\x65\x12\x17\x0a\x13\x54\x41\x52\x47\x45\x54\x5f\x54\x59\x50\x45\x5f\x55\x4e\x4b\x4e\x4f\x57\x4e\x10\x00\x12\x14\x0a\x10\x54\x41\x52\x47\x45\x54\x5f\x54\x59\x50\x45\x5f\x46\x49\x4c\x45\x10\x01\x12\x1f\x0a\x1b\x54\x41\x52\x47\x45\x54\x5f\x54\x59\x50\x45\x5f\x45\x58\x54\x45\x4e\x53\x49\x4f\x4e\x5f\x52\x41\x4e\x47\x45\x10\x02\x12\x17\x0a\x13\x54\x41\x52\x47\x45\x54\x5f\x54\x59\x50\x45\x5f\x4d\x45\x53\x53\x41\x47\x45\x10\x03\x12\x15\x0a\x11\x54\x41\x52\x47\x45\x54\x5f\x54\x59\x50\x45\x5f\x46\x49\x45\x4c\x44\x10\x04\x12\x15\x0a\x11\x54\x41\x52\x47\x45\x54\x5f\x54\x59\x50\x45\x5f\x4f\x4e\x45\x4f\x46\x10\x05\x12\x14\x0a\x10\x54\x41\x52\x47\x45\x54\x5f\x54\x59\x50\x45\x5f\x45\x4e\x55\x4d\x10\x06\x12\x1a\x0a\x16\x54\x41\x52\x47\x45\x54\x5f\x54\x59\x50\x45\x5f\x45\x4e\x55\x4d\x5f\x45\x4e\x54\x52\x59\x10\x07\x12\x17\x0a\x13\x54\x41\x52\x47\x45\x54\x5f\x54\x59\x50\x45\x5f\x53\x45\x52\x56\x49\x43\x45\x10\x08\x12\x16\x0a\x12\x54\x41\x52\x47\x45\x54\x5f\x54\x59\x50\x45\x5f\x4d\x45\x54\x48\x4f\x44\x10\x09\x22\x60\x0a\x0c\x4f\x6e\x65\x6f\x66\x4f\x70\x74\x69\x6f\x6e\x73\x12\x1c\x0a\x08\x66\x65\x61\x74\x75\x72\x65\x73\x18\x01\x20\x01\x28\x0b\x32\x0a\x46\x65\x61\x74\x75\x72\x65\x53\x65\x74\x12\x32\x0a\x14\x75\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x5f\x6f\x70\x74\x69\x6f\x6e\x18\xe7\x07\x20\x03\x28\x0b\x32\x13\x55\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x4f\x70\x74\x69\x6f\x6e\x22\xb8\x01\x0a\x0b\x45\x6e\x75\x6d\x4f\x70\x74\x69\x6f\x6e\x73\x12\x13\x0a\x0b\x61\x6c\x6c\x6f\x77\x5f\x61\x6c\x69\x61\x73\x18\x02\x20\x01\x28\x08\x12\x12\x0a\x0a\x64\x65\x70\x72\x65\x63\x61\x74\x65\x64\x18\x03\x20\x01\x28\x08\x12\x2e\x0a\x26\x64\x65\x70\x72\x65\x63\x61\x74\x65\x64\x5f\x6c\x65\x67\x61\x63\x79\x5f\x6a\x73\x6f\x6e\x5f\x66\x69\x65\x6c\x64\x5f\x63\x6f\x6e\x66\x6c\x69\x63\x74\x73\x18\x06\x20\x01\x28\x08\x12\x1c\x0a\x08\x66\x65\x61\x74\x75\x72\x65\x73\x18\x07\x20\x01\x28\x0b\x32\x0a\x46\x65\x61\x74\x75\x72\x65\x53\x65\x74\x12\x32\x0a\x14\x75\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x5f\x6f\x70\x74\x69\x6f\x6e\x18\xe7\x07\x20\x03\x28\x0b\x32\x13\x55\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x4f\x70\x74\x69\x6f\x6e\x22\xc4\x01\x0a\x10\x45\x6e\x75\x6d\x56\x61\x6c\x75\x65\x4f\x70\x74\x69\x6f\x6e\x73\x12\x12\x0a\x0a\x64\x65\x70\x72\x65\x63\x61\x74\x65\x64\x18\x01\x20\x01\x28\x08\x12\x1c\x0a\x08\x66\x65\x61\x74\x75\x72\x65\x73\x18\x02\x20\x01\x28\x0b\x32\x0a\x46\x65\x61\x74\x75\x72\x65\x53\x65\x74\x12\x14\x0a\x0c\x64\x65\x62\x75\x67\x5f\x72\x65\x64\x61\x63\x74\x18\x03\x20\x01\x28\x08\x12\x34\x0a\x0f\x66\x65\x61\x74\x75\x72\x65\x5f\x73\x75\x70\x70\x6f\x72\x74\x18\x04\x20\x01\x28\x0b\x32\x1b\x46\x69\x65\x6c\x64\x4f\x70\x74\x69\x6f\x6e\x73\x2e\x46\x65\x61\x74\x75\x72\x65\x53\x75\x70\x70\x6f\x72\x74\x12\x32\x0a\x14\x75\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x5f\x6f\x70\x74\x69\x6f\x6e\x18\xe7\x07\x20\x03\x28\x0b\x32\x13\x55\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x4f\x70\x74\x69\x6f\x6e\x22\x76\x0a\x0e\x53\x65\x72\x76\x69\x63\x65\x4f\x70\x74\x69\x6f\x6e\x73\x12\x1c\x0a\x08\x66\x65\x61\x74\x75\x72\x65\x73\x18\x22\x20\x01\x28\x0b\x32\x0a\x46\x65\x61\x74\x75\x72\x65\x53\x65\x74\x12\x12\x0a\x0a\x64\x65\x70\x72\x65\x63\x61\x74\x65\x64\x18\x21\x20\x01\x28\x08\x12\x32\x0a\x14\x75\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x5f\x6f\x70\x74\x69\x6f\x6e\x18\xe7\x07\x20\x03\x28\x0b\x32\x13\x55\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x4f\x70\x74\x69\x6f\x6e\x22\xf4\x01\x0a\x0d\x4d\x65\x74\x68\x6f\x64\x4f\x70\x74\x69\x6f\x6e\x73\x12\x12\x0a\x0a\x64\x65\x70\x72\x65\x63\x61\x74\x65\x64\x18\x21\x20\x01\x28\x08\x12\x2b\x0a\x11\x69\x64\x65\x6d\x70\x6f\x74\x65\x6e\x63\x79\x5f\x6c\x65\x76\x65\x6c\x18\x22\x20\x01\x28\x0b\x32\x10\x49\x64\x65\x6d\x70\x6f\x74\x65\x6e\x63\x79\x4c\x65\x76\x65\x6c\x12\x1c\x0a\x08\x66\x65\x61\x74\x75\x72\x65\x73\x18\x23\x20\x01\x28\x0b\x32\x0a\x46\x65\x61\x74\x75\x72\x65\x53\x65\x74\x12\x32\x0a\x14\x75\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x5f\x6f\x70\x74\x69\x6f\x6e\x18\xe7\x07\x20\x03\x28\x0b\x32\x13\x55\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x4f\x70\x74\x69\x6f\x6e\x22\x50\x0a\x10\x49\x64\x65\x6d\x70\x6f\x74\x65\x6e\x63\x79\x4c\x65\x76\x65\x6c\x12\x17\x0a\x13\x49\x44\x45\x4d\x50\x4f\x54\x45\x4e\x43\x59\x5f\x55\x4e\x4b\x4e\x4f\x57\x4e\x10\x00\x12\x13\x0a\x0f\x4e\x4f\x5f\x53\x49\x44\x45\x5f\x45\x46\x46\x45\x43\x54\x53\x10\x01\x12\x0e\x0a\x0a\x49\x44\x45\x4d\x50\x4f\x54\x45\x4e\x54\x10\x02\x22\xf9\x01\x0a\x13\x55\x6e\x69\x6e\x74\x65\x72\x70\x72\x65\x74\x65\x64\x4f\x70\x74\x69\x6f\x6e\x12\x16\x0a\x04\x6e\x61\x6d\x65\x18\x02\x20\x03\x28\x0b\x32\x08\x4e\x61\x6d\x65\x50\x61\x72\x74\x12\x18\x0a\x10\x69\x64\x65\x6e\x74\x69\x66\x69\x65\x72\x5f\x76\x61\x6c\x75\x65\x18\x03\x20\x01\x28\x09\x12\x1a\x0a\x12\x70\x6f\x73\x69\x74\x69\x76\x65\x5f\x69\x6e\x74\x5f\x76\x61\x6c\x75\x65\x18\x04\x20\x01\x28\x04\x12\x1a\x0a\x12\x6e\x65\x67\x61\x74\x69\x76\x65\x5f\x69\x6e\x74\x5f\x76\x61\x6c\x75\x65\x18\x05\x20\x01\x28\x03\x12\x14\x0a\x0c\x64\x6f\x75\x62\x6c\x65\x5f\x76\x61\x6c\x75\x65\x18\x06\x20\x01\x28\x01\x12\x14\x0a\x0c\x73\x74\x72\x69\x6e\x67\x5f\x76\x61\x6c\x75\x65\x18\x07\x20\x01\x28\x0c\x12\x17\x0a\x0f\x61\x67\x67\x72\x65\x67\x61\x74\x65\x5f\x76\x61\x6c\x75\x65\x18\x08\x20\x01\x28\x09\x1a\x33\x0a\x08\x4e\x61\x6d\x65\x50\x61\x72\x74\x12\x11\x0a\x09\x6e\x61\x6d\x65\x5f\x70\x61\x72\x74\x18\x01\x20\x02\x28\x09\x12\x14\x0a\x0c\x69\x73\x5f\x65\x78\x74\x65\x6e\x73\x69\x6f\x6e\x18\x02\x20\x02\x28\x08\x22\xd0\x05\x0a\x0a\x46\x65\x61\x74\x75\x72\x65\x53\x65\x74\x12\x25\x0a\x0e\x66\x69\x65\x6c\x64\x5f\x70\x72\x65\x73\x65\x6e\x63\x65\x18\x01\x20\x01\x28\x0b\x32\x0d\x46\x69\x65\x6c\x64\x50\x72\x65\x73\x65\x6e\x63\x65\x12\x1b\x0a\x09\x65\x6e\x75\x6d\x5f\x74\x79\x70\x65\x18\x02\x20\x01\x28\x0b\x32\x08\x45\x6e\x75\x6d\x54\x79\x70\x65\x12\x36\x0a\x17\x72\x65\x70\x65\x61\x74\x65\x64\x5f\x66\x69\x65\x6c\x64\x5f\x65\x6e\x63\x6f\x64\x69\x6e\x67\x18\x03\x20\x01\x28\x0b\x32\x15\x52\x65\x70\x65\x61\x74\x65\x64\x46\x69\x65\x6c\x64\x45\x6e\x63\x6f\x64\x69\x6e\x67\x12\x27\x0a\x0f\x75\x74\x66\x38\x5f\x76\x61\x6c\x69\x64\x61\x74\x69\x6f\x6e\x18\x04\x20\x01\x28\x0b\x32\x0e\x55\x74\x66\x38\x56\x61\x6c\x69\x64\x61\x74\x69\x6f\x6e\x12\x29\x0a\x10\x6d\x65\x73\x73\x61\x67\x65\x5f\x65\x6e\x63\x6f\x64\x69\x6e\x67\x18\x05\x20\x01\x28\x0b\x32\x0f\x4d\x65\x73\x73\x61\x67\x65\x45\x6e\x63\x6f\x64\x69\x6e\x67\x12\x1f\x0a\x0b\x6a\x73\x6f\x6e\x5f\x66\x6f\x72\x6d\x61\x74\x18\x06\x20\x01\x28\x0b\x32\x0a\x4a\x73\x6f\x6e\x46\x6f\x72\x6d\x61\x74\x22\x5c\x0a\x0d\x46\x69\x65\x6c\x64\x50\x72\x65\x73\x65\x6e\x63\x65\x12\x1a\x0a\x16\x46\x49\x45\x4c\x44\x5f\x50\x52\x45\x53\x45\x4e\x43\x45\x5f\x55\x4e\x4b\x4e\x4f\x57\x4e\x10\x00\x12\x0c\x0a\x08\x45\x58\x50\x4c\x49\x43\x49\x54\x10\x01\x12\x0c\x0a\x08\x49\x4d\x50\x4c\x49\x43\x49\x54\x10\x02\x12\x13\x0a\x0f\x4c\x45\x47\x41\x43\x59\x5f\x52\x45\x51\x55\x49\x52\x45\x44\x10\x03\x22\x37\x0a\x08\x45\x6e\x75\x6d\x54\x79\x70\x65\x12\x15\x0a\x11\x45\x4e\x55\x4d\x5f\x54\x59\x50\x45\x5f\x55\x4e\x4b\x4e\x4f\x57\x4e\x10\x00\x12\x08\x0a\x04\x4f\x50\x45\x4e\x10\x01\x12\x0a\x0a\x06\x43\x4c\x4f\x53\x45\x44\x10\x02\x22\x56\x0a\x15\x52\x65\x70\x65\x61\x74\x65\x64\x46\x69\x65\x6c\x64\x45\x6e\x63\x6f\x64\x69\x6e\x67\x12\x23\x0a\x1f\x52\x45\x50\x45\x41\x54\x45\x44\x5f\x46\x49\x45\x4c\x44\x5f\x45\x4e\x43\x4f\x44\x49\x4e\x47\x5f\x55\x4e\x4b\x4e\x4f\x57\x4e\x10\x00\x12\x0a\x0a\x06\x50\x41\x43\x4b\x45\x44\x10\x01\x12\x0c\x0a\x08\x45\x58\x50\x41\x4e\x44\x45\x44\x10\x02\x22\x43\x0a\x0e\x55\x74\x66\x38\x56\x61\x6c\x69\x64\x61\x74\x69\x6f\x6e\x12\x1b\x0a\x17\x55\x54\x46\x38\x5f\x56\x41\x4c\x49\x44\x41\x54\x49\x4f\x4e\x5f\x55\x4e\x4b\x4e\x4f\x57\x4e\x10\x00\x12\x0a\x0a\x06\x56\x45\x52\x49\x46\x59\x10\x02\x12\x08\x0a\x04\x4e\x4f\x4e\x45\x10\x03\x22\x53\x0a\x0f\x4d\x65\x73\x73\x61\x67\x65\x45\x6e\x63\x6f\x64\x69\x6e\x67\x12\x1c\x0a\x18\x4d\x45\x53\x53\x41\x47\x45\x5f\x45\x4e\x43\x4f\x44\x49\x4e\x47\x5f\x55\x4e\x4b\x4e\x4f\x57\x4e\x10\x00\x12\x13\x0a\x0f\x4c\x45\x4e\x47\x54\x48\x5f\x50\x52\x45\x46\x49\x58\x45\x44\x10\x01\x12\x0d\x0a\x09\x44\x45\x4c\x49\x4d\x49\x54\x45\x44\x10\x02\x22\x48\x0a\x0a\x4a\x73\x6f\x6e\x46\x6f\x72\x6d\x61\x74\x12\x17\x0a\x13\x4a\x53\x4f\x4e\x5f\x46\x4f\x52\x4d\x41\x54\x5f\x55\x4e\x4b\x4e\x4f\x57\x4e\x10\x00\x12\x09\x0a\x05\x41\x4c\x4c\x4f\x57\x10\x01\x12\x16\x0a\x12\x4c\x45\x47\x41\x43\x59\x5f\x42\x45\x53\x54\x5f\x45\x46\x46\x4f\x52\x54\x10\x02\x22\x89\x02\x0a\x12\x46\x65\x61\x74\x75\x72\x65\x53\x65\x74\x44\x65\x66\x61\x75\x6c\x74\x73\x12\x2a\x0a\x08\x64\x65\x66\x61\x75\x6c\x74\x73\x18\x01\x20\x03\x28\x0b\x32\x18\x46\x65\x61\x74\x75\x72\x65\x53\x65\x74\x45\x64\x69\x74\x69\x6f\x6e\x44\x65\x66\x61\x75\x6c\x74\x12\x20\x0a\x0f\x6d\x69\x6e\x69\x6d\x75\x6d\x5f\x65\x64\x69\x74\x69\x6f\x6e\x18\x04\x20\x01\x28\x0b\x32\x07\x45\x64\x69\x74\x69\x6f\x6e\x12\x20\x0a\x0f\x6d\x61\x78\x69\x6d\x75\x6d\x5f\x65\x64\x69\x74\x69\x6f\x6e\x18\x05\x20\x01\x28\x0b\x32\x07\x45\x64\x69\x74\x69\x6f\x6e\x1a\x82\x01\x0a\x18\x46\x65\x61\x74\x75\x72\x65\x53\x65\x74\x45\x64\x69\x74\x69\x6f\x6e\x44\x65\x66\x61\x75\x6c\x74\x12\x18\x0a\x07\x65\x64\x69\x74\x69\x6f\x6e\x18\x03\x20\x01\x28\x0b\x32\x07\x45\x64\x69\x74\x69\x6f\x6e\x12\x28\x0a\x14\x6f\x76\x65\x72\x72\x69\x64\x61\x62\x6c\x65\x5f\x66\x65\x61\x74\x75\x72\x65\x73\x18\x04\x20\x01\x28\x0b\x32\x0a\x46\x65\x61\x74\x75\x72\x65\x53\x65\x74\x12\x22\x0a\x0e\x66\x69\x78\x65\x64\x5f\x66\x65\x61\x74\x75\x72\x65\x73\x18\x05\x20\x01\x28\x0b\x32\x0a\x46\x65\x61\x74\x75\x72\x65\x53\x65\x74\x22\xac\x01\x0a\x0e\x53\x6f\x75\x72\x63\x65\x43\x6f\x64\x65\x49\x6e\x66\x6f\x12\x1a\x0a\x08\x6c\x6f\x63\x61\x74\x69\x6f\x6e\x18\x01\x20\x03\x28\x0b\x32\x08\x4c\x6f\x63\x61\x74\x69\x6f\x6e\x1a\x7e\x0a\x08\x4c\x6f\x63\x61\x74\x69\x6f\x6e\x12\x0c\x0a\x04\x70\x61\x74\x68\x18\x01\x20\x03\x28\x05\x12\x0c\x0a\x04\x73\x70\x61\x6e\x18\x02\x20\x03\x28\x05\x12\x18\x0a\x10\x6c\x65\x61\x64\x69\x6e\x67\x5f\x63\x6f\x6d\x6d\x65\x6e\x74\x73\x18\x03\x20\x01\x28\x09\x12\x19\x0a\x11\x74\x72\x61\x69\x6c\x69\x6e\x67\x5f\x63\x6f\x6d\x6d\x65\x6e\x74\x73\x18\x04\x20\x01\x28\x09\x12\x21\x0a\x19\x6c\x65\x61\x64\x69\x6e\x67\x5f\x64\x65\x74\x61\x63\x68\x65\x64\x5f\x63\x6f\x6d\x6d\x65\x6e\x74\x73\x18\x06\x20\x03\x28\x09\x22\xc7\x01\x0a\x11\x47\x65\x6e\x65\x72\x61\x74\x65\x64\x43\x6f\x64\x65\x49\x6e\x66\x6f\x12\x1e\x0a\x0a\x61\x6e\x6e\x6f\x74\x61\x74\x69\x6f\x6e\x18\x01\x20\x03\x28\x0b\x32\x0a\x41\x6e\x6e\x6f\x74\x61\x74\x69\x6f\x6e\x1a\x91\x01\x0a\x0a\x41\x6e\x6e\x6f\x74\x61\x74\x69\x6f\x6e\x12\x0c\x0a\x04\x70\x61\x74\x68\x18\x01\x20\x03\x28\x05\x12\x13\x0a\x0b\x73\x6f\x75\x72\x63\x65\x5f\x66\x69\x6c\x65\x18\x02\x20\x01\x28\x09\x12\x0d\x0a\x05\x62\x65\x67\x69\x6e\x18\x03\x20\x01\x28\x05\x12\x0b\x0a\x03\x65\x6e\x64\x18\x04\x20\x01\x28\x05\x12\x1a\x0a\x08\x73\x65\x6d\x61\x6e\x74\x69\x63\x18\x05\x20\x01\x28\x0b\x32\x08\x53\x65\x6d\x61\x6e\x74\x69\x63\x22\x28\x0a\x08\x53\x65\x6d\x61\x6e\x74\x69\x63\x12\x08\x0a\x04\x4e\x4f\x4e\x45\x10\x00\x12\x07\x0a\x03\x53\x45\x54\x10\x01\x12\x09\x0a\x05\x41\x4c\x49\x41\x53\x10\x02\x2a\xa7\x02\x0a\x07\x45\x64\x69\x74\x69\x6f\x6e\x12\x13\x0a\x0f\x45\x44\x49\x54\x49\x4f\x4e\x5f\x55\x4e\x4b\x4e\x4f\x57\x4e\x10\x00\x12\x13\x0a\x0e\x45\x44\x49\x54\x49\x4f\x4e\x5f\x4c\x45\x47\x41\x43\x59\x10\x84\x07\x12\x13\x0a\x0e\x45\x44\x49\x54\x49\x4f\x4e\x5f\x50\x52\x4f\x54\x4f\x32\x10\xe6\x07\x12\x13\x0a\x0e\x45\x44\x49\x54\x49\x4f\x4e\x5f\x50\x52\x4f\x54\x4f\x33\x10\xe7\x07\x12\x11\x0a\x0c\x45\x44\x49\x54\x49\x4f\x4e\x5f\x32\x30\x32\x33\x10\xe8\x07\x12\x11\x0a\x0c\x45\x44\x49\x54\x49\x4f\x4e\x5f\x32\x30\x32\x34\x10\xe9\x07\x12\x17\x0a\x13\x45\x44\x49\x54\x49\x4f\x4e\x5f\x31\x5f\x54\x45\x53\x54\x5f\x4f\x4e\x4c\x59\x10\x01\x12\x17\x0a\x13\x45\x44\x49\x54\x49\x4f\x4e\x5f\x32\x5f\x54\x45\x53\x54\x5f\x4f\x4e\x4c\x59\x10\x02\x12\x1d\x0a\x17\x45\x44\x49\x54\x49\x4f\x4e\x5f\x39\x39\x39\x39\x37\x5f\x54\x45\x53\x54\x5f\x4f\x4e\x4c\x59\x10\x9d\x8d\x06\x12\x1d\x0a\x17\x45\x44\x49\x54\x49\x4f\x4e\x5f\x39\x39\x39\x39\x38\x5f\x54\x45\x53\x54\x5f\x4f\x4e\x4c\x59\x10\x9e\x8d\x06\x12\x1d\x0a\x17\x45\x44\x49\x54\x49\x4f\x4e\x5f\x39\x39\x39\x39\x39\x5f\x54\x45\x53\x54\x5f\x4f\x4e\x4c\x59\x10\x9f\x8d\x06\x12\x13\x0a\x0b\x45\x44\x49\x54\x49\x4f\x4e\x5f\x4d\x41\x58\x10\xff\xff\xff\xff\x07\x62\x06\x70\x72\x6f\x74\x6f\x32"----- | The protocol compiler can output a FileDescriptorSet containing the .proto--- files it parses.-data FileDescriptorSet = FileDescriptorSet-  { fileDescriptorSetFile :: !(V.Vector FileDescriptorProto)-  , fileDescriptorSetUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultFileDescriptorSet :: FileDescriptorSet-defaultFileDescriptorSet = FileDescriptorSet-  { fileDescriptorSetFile = V.empty-  , fileDescriptorSetUnknownFields = []-  }--instance MessageEncode FileDescriptorSet where-  buildSized msg =-    V.foldl' (\acc v -> acc <> archSubmessage 10 (buildSized v)) mempty msg.fileDescriptorSetFile-    <> encodeUnknownFieldsSized msg.fileDescriptorSetUnknownFields--instance MessageDecode FileDescriptorSet where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultFileDescriptorSet emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_0 msg (snocGrowList gl_0 v))-          (pure (case msg.fileDescriptorSetUnknownFields of { [] -> msg { fileDescriptorSetFile = growListToVector gl_0 }; _ -> msg { fileDescriptorSetFile = growListToVector gl_0, fileDescriptorSetUnknownFields = reverse (msg.fileDescriptorSetUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.fileDescriptorSetUnknownFields of { [] -> msg { fileDescriptorSetFile = growListToVector gl_0 }; _ -> msg { fileDescriptorSetFile = growListToVector gl_0, fileDescriptorSetUnknownFields = reverse (msg.fileDescriptorSetUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { fileDescriptorSetUnknownFields = (uf : msg.fileDescriptorSetUnknownFields)}) gl_0)---- | Field descriptors for 'FileDescriptorSet', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-fileDescriptorSetFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor FileDescriptorSet)-fileDescriptorSetFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "file"-        , fdNumber = 1-        , fdTypeDesc = MessageType "FileDescriptorProto"-        , fdLabel = LabelRepeated-        , fdGet = fileDescriptorSetFile-        , fdSet = \v m -> m { fileDescriptorSetFile = v }-        })-    ]--instance ProtoMessage FileDescriptorSet where-  protoMessageName _ = "google.protobuf.FileDescriptorSet"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultFileDescriptorSet-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = fileDescriptorSetFieldDescriptors--instance IsMessage FileDescriptorSet--instance Aeson.ToJSON FileDescriptorSet where-  toJSON msg = jsonObject-      [ "file" .=: msg.fileDescriptorSetFile--      ]--instance Aeson.FromJSON FileDescriptorSet where-  parseJSON = Aeson.withObject "FileDescriptorSet" $ \obj -> do-    fld_fileDescriptorSetFile <- parseFieldMaybe obj "file"-    pure defaultFileDescriptorSet-      { fileDescriptorSetFile = maybe (fileDescriptorSetFile defaultFileDescriptorSet) id fld_fileDescriptorSetFile-      }--instance Hashable FileDescriptorSet where-  hashWithSalt salt msg = V.foldl' hashWithSalt (salt) msg.fileDescriptorSetFile--instance Proto.Extension.HasExtensions FileDescriptorSet where-  messageUnknownFields = fileDescriptorSetUnknownFields-  setMessageUnknownFields !ufs msg = msg { fileDescriptorSetUnknownFields = ufs }--instance Semigroup FileDescriptorSet where-  a <> b = FileDescriptorSet-    { fileDescriptorSetFile = a.fileDescriptorSetFile <> b.fileDescriptorSetFile-    , fileDescriptorSetUnknownFields = a.fileDescriptorSetUnknownFields <> b.fileDescriptorSetUnknownFields-    }--instance Monoid FileDescriptorSet where-  mempty = defaultFileDescriptorSet---- | The full set of known editions.-data Edition-  = Edition'EditionUnknown-    -- ^ A placeholder for an unknown edition value.-  | Edition'EditionLegacy-    -- ^ A placeholder edition for specifying default behaviors *before* a feature-    -- was first introduced.  This is effectively an "infinite past".-  | Edition'EditionProto2-    -- ^ Legacy syntax "editions".  These pre-date editions, but behave much like-    -- distinct editions.  These can't be used to specify the edition of proto-    -- files, but feature definitions must supply proto2/proto3 defaults for-    -- backwards compatibility.-  | Edition'EditionProto3-  | Edition'Edition2023-    -- ^ Editions that have been released.  The specific values are arbitrary and-    -- should not be depended on, but they will always be time-ordered for easy-    -- comparison.-  | Edition'Edition2024-  | Edition'Edition1TestOnly-    -- ^ Placeholder editions for testing feature resolution.  These should not be-    -- used or relyed on outside of tests.-  | Edition'Edition2TestOnly-  | Edition'Edition99997TestOnly-  | Edition'Edition99998TestOnly-  | Edition'Edition99999TestOnly-  | Edition'EditionMax-    -- ^ Placeholder for specifying unbounded edition support.  This should only-    -- ever be used by plugins that can expect to never require any changes to-    -- support a new edition.-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumEdition :: Edition -> Int-toProtoEnumEdition Edition'EditionUnknown = 0-toProtoEnumEdition Edition'EditionLegacy = 900-toProtoEnumEdition Edition'EditionProto2 = 998-toProtoEnumEdition Edition'EditionProto3 = 999-toProtoEnumEdition Edition'Edition2023 = 1000-toProtoEnumEdition Edition'Edition2024 = 1001-toProtoEnumEdition Edition'Edition1TestOnly = 1-toProtoEnumEdition Edition'Edition2TestOnly = 2-toProtoEnumEdition Edition'Edition99997TestOnly = 99997-toProtoEnumEdition Edition'Edition99998TestOnly = 99998-toProtoEnumEdition Edition'Edition99999TestOnly = 99999-toProtoEnumEdition Edition'EditionMax = 2147483647--fromProtoEnumEdition :: Int -> Maybe Edition-fromProtoEnumEdition 0 = Just Edition'EditionUnknown-fromProtoEnumEdition 900 = Just Edition'EditionLegacy-fromProtoEnumEdition 998 = Just Edition'EditionProto2-fromProtoEnumEdition 999 = Just Edition'EditionProto3-fromProtoEnumEdition 1000 = Just Edition'Edition2023-fromProtoEnumEdition 1001 = Just Edition'Edition2024-fromProtoEnumEdition 1 = Just Edition'Edition1TestOnly-fromProtoEnumEdition 2 = Just Edition'Edition2TestOnly-fromProtoEnumEdition 99997 = Just Edition'Edition99997TestOnly-fromProtoEnumEdition 99998 = Just Edition'Edition99998TestOnly-fromProtoEnumEdition 99999 = Just Edition'Edition99999TestOnly-fromProtoEnumEdition 2147483647 = Just Edition'EditionMax-fromProtoEnumEdition _ = Nothing--instance MessageEncode Edition where-  buildSized _ = mempty-instance MessageDecode Edition where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON Edition where-  toJSON Edition'EditionUnknown = Aeson.String "EDITION_UNKNOWN"-  toJSON Edition'EditionLegacy = Aeson.String "EDITION_LEGACY"-  toJSON Edition'EditionProto2 = Aeson.String "EDITION_PROTO2"-  toJSON Edition'EditionProto3 = Aeson.String "EDITION_PROTO3"-  toJSON Edition'Edition2023 = Aeson.String "EDITION_2023"-  toJSON Edition'Edition2024 = Aeson.String "EDITION_2024"-  toJSON Edition'Edition1TestOnly = Aeson.String "EDITION_1_TEST_ONLY"-  toJSON Edition'Edition2TestOnly = Aeson.String "EDITION_2_TEST_ONLY"-  toJSON Edition'Edition99997TestOnly = Aeson.String "EDITION_99997_TEST_ONLY"-  toJSON Edition'Edition99998TestOnly = Aeson.String "EDITION_99998_TEST_ONLY"-  toJSON Edition'Edition99999TestOnly = Aeson.String "EDITION_99999_TEST_ONLY"-  toJSON Edition'EditionMax = Aeson.String "EDITION_MAX"--instance Aeson.FromJSON Edition where-  parseJSON = \case-    Aeson.String "EDITION_UNKNOWN" -> pure Edition'EditionUnknown-    Aeson.String "EDITION_LEGACY" -> pure Edition'EditionLegacy-    Aeson.String "EDITION_PROTO2" -> pure Edition'EditionProto2-    Aeson.String "EDITION_PROTO3" -> pure Edition'EditionProto3-    Aeson.String "EDITION_2023" -> pure Edition'Edition2023-    Aeson.String "EDITION_2024" -> pure Edition'Edition2024-    Aeson.String "EDITION_1_TEST_ONLY" -> pure Edition'Edition1TestOnly-    Aeson.String "EDITION_2_TEST_ONLY" -> pure Edition'Edition2TestOnly-    Aeson.String "EDITION_99997_TEST_ONLY" -> pure Edition'Edition99997TestOnly-    Aeson.String "EDITION_99998_TEST_ONLY" -> pure Edition'Edition99998TestOnly-    Aeson.String "EDITION_99999_TEST_ONLY" -> pure Edition'Edition99999TestOnly-    Aeson.String "EDITION_MAX" -> pure Edition'EditionMax-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for Edition"--instance Hashable Edition where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumEdition x)---- | Describes a complete .proto file.-data FileDescriptorProto = FileDescriptorProto-  { fileDescriptorProtoName :: !(Maybe Text)-  , fileDescriptorProtoPackage :: !(Maybe Text)-  , fileDescriptorProtoDependency :: !(V.Vector Text)-    -- ^ Names of files imported by this file.-  , fileDescriptorProtoPublicDependency :: !(VU.Vector Int32)-    -- ^ Indexes of the public imported files in the dependency list above.-  , fileDescriptorProtoWeakDependency :: !(VU.Vector Int32)-    -- ^ Indexes of the weak imported files in the dependency list.-    -- For Google-internal migration only. Do not use.-  , fileDescriptorProtoMessageType :: !(V.Vector DescriptorProto)-    -- ^ All top-level definitions in this file.-  , fileDescriptorProtoEnumType :: !(V.Vector EnumDescriptorProto)-  , fileDescriptorProtoService :: !(V.Vector ServiceDescriptorProto)-  , fileDescriptorProtoExtension :: !(V.Vector FieldDescriptorProto)-  , fileDescriptorProtoOptions :: !(Maybe FileOptions)-  , fileDescriptorProtoSourceCodeInfo :: !(Maybe SourceCodeInfo)-    -- ^ This field contains optional information about the original source code.-    -- You may safely remove this entire field without harming runtime-    -- functionality of the descriptors -- the information is needed only by-    -- development tools.-  , fileDescriptorProtoSyntax :: !(Maybe Text)-    -- ^ The syntax of the proto file.-    -- The supported values are "proto2", "proto3", and "editions".-    -- -    -- If `edition` is present, this value must be "editions".-  , fileDescriptorProtoEdition :: !(Maybe Edition)-    -- ^ The edition of the proto file.-  , fileDescriptorProtoUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultFileDescriptorProto :: FileDescriptorProto-defaultFileDescriptorProto = FileDescriptorProto-  { fileDescriptorProtoName = Nothing-  , fileDescriptorProtoPackage = Nothing-  , fileDescriptorProtoDependency = V.empty-  , fileDescriptorProtoPublicDependency = VU.empty-  , fileDescriptorProtoWeakDependency = VU.empty-  , fileDescriptorProtoMessageType = V.empty-  , fileDescriptorProtoEnumType = V.empty-  , fileDescriptorProtoService = V.empty-  , fileDescriptorProtoExtension = V.empty-  , fileDescriptorProtoOptions = Nothing-  , fileDescriptorProtoSourceCodeInfo = Nothing-  , fileDescriptorProtoSyntax = Nothing-  , fileDescriptorProtoEdition = Nothing-  , fileDescriptorProtoUnknownFields = []-  }--instance MessageEncode FileDescriptorProto where-  buildSized msg =-    (maybe mempty (\v -> archString 10 v) msg.fileDescriptorProtoName)-    <> (maybe mempty (\v -> archString 18 v) msg.fileDescriptorProtoPackage)-    <> V.foldl' (\acc v -> acc <> archString 26 v) mempty msg.fileDescriptorProtoDependency-    <> encodePackedInt32 10 msg.fileDescriptorProtoPublicDependency-    <> encodePackedInt32 11 msg.fileDescriptorProtoWeakDependency-    <> V.foldl' (\acc v -> acc <> archSubmessage 34 (buildSized v)) mempty msg.fileDescriptorProtoMessageType-    <> V.foldl' (\acc v -> acc <> archSubmessage 42 (buildSized v)) mempty msg.fileDescriptorProtoEnumType-    <> V.foldl' (\acc v -> acc <> archSubmessage 50 (buildSized v)) mempty msg.fileDescriptorProtoService-    <> V.foldl' (\acc v -> acc <> archSubmessage 58 (buildSized v)) mempty msg.fileDescriptorProtoExtension-    <> (maybe mempty (\v -> archSubmessage 66 (buildSized v)) msg.fileDescriptorProtoOptions)-    <> (maybe mempty (\v -> archSubmessage 74 (buildSized v)) msg.fileDescriptorProtoSourceCodeInfo)-    <> (maybe mempty (\v -> archString 98 v) msg.fileDescriptorProtoSyntax)-    <> (maybe mempty (\v -> archVarint 112 (fromIntegral (toProtoEnumEdition v))) msg.fileDescriptorProtoEdition)-    <> encodeUnknownFieldsSized msg.fileDescriptorProtoUnknownFields--instance MessageDecode FileDescriptorProto where-  messageDecoder = stage_0 defaultFileDescriptorProto emptyGrowList emptyGrowList emptyGrowList emptyGrowList emptyGrowList-    where-      stage_0 msg gl_0 gl_1 gl_2 gl_3 gl_4 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_1 (msg { fileDescriptorProtoName = (Just v)}) gl_0 gl_1 gl_2 gl_3 gl_4)-          (pure (case msg.fileDescriptorProtoUnknownFields of { [] -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4 }; _ -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4, fileDescriptorProtoUnknownFields = reverse (msg.fileDescriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4)-      stage_1 msg gl_0 gl_1 gl_2 gl_3 gl_4 =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_2 (msg { fileDescriptorProtoPackage = (Just v)}) gl_0 gl_1 gl_2 gl_3 gl_4)-          (pure (case msg.fileDescriptorProtoUnknownFields of { [] -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4 }; _ -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4, fileDescriptorProtoUnknownFields = reverse (msg.fileDescriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4)-      stage_2 msg gl_0 gl_1 gl_2 gl_3 gl_4 =-        inOrderStage1-          (0x1a :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_2 msg (snocGrowList gl_0 v) gl_1 gl_2 gl_3 gl_4)-          (pure (case msg.fileDescriptorProtoUnknownFields of { [] -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4 }; _ -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4, fileDescriptorProtoUnknownFields = reverse (msg.fileDescriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4)-      stage_3 msg gl_0 gl_1 gl_2 gl_3 gl_4 =-        inOrderStage1-          (0x52 :: Data.Word.Word8)-          (VU.map fromIntegral <$> decodePackedVarint)-          (\v -> stage_4 (msg { fileDescriptorProtoPublicDependency = v}) gl_0 gl_1 gl_2 gl_3 gl_4)-          (pure (case msg.fileDescriptorProtoUnknownFields of { [] -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4 }; _ -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4, fileDescriptorProtoUnknownFields = reverse (msg.fileDescriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4)-      stage_4 msg gl_0 gl_1 gl_2 gl_3 gl_4 =-        inOrderStage1-          (0x5a :: Data.Word.Word8)-          (VU.map fromIntegral <$> decodePackedVarint)-          (\v -> stage_5 (msg { fileDescriptorProtoWeakDependency = v}) gl_0 gl_1 gl_2 gl_3 gl_4)-          (pure (case msg.fileDescriptorProtoUnknownFields of { [] -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4 }; _ -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4, fileDescriptorProtoUnknownFields = reverse (msg.fileDescriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4)-      stage_5 msg gl_0 gl_1 gl_2 gl_3 gl_4 =-        inOrderStage1-          (0x22 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_5 msg gl_0 (snocGrowList gl_1 v) gl_2 gl_3 gl_4)-          (pure (case msg.fileDescriptorProtoUnknownFields of { [] -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4 }; _ -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4, fileDescriptorProtoUnknownFields = reverse (msg.fileDescriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4)-      stage_6 msg gl_0 gl_1 gl_2 gl_3 gl_4 =-        inOrderStage1-          (0x2a :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_6 msg gl_0 gl_1 (snocGrowList gl_2 v) gl_3 gl_4)-          (pure (case msg.fileDescriptorProtoUnknownFields of { [] -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4 }; _ -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4, fileDescriptorProtoUnknownFields = reverse (msg.fileDescriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4)-      stage_7 msg gl_0 gl_1 gl_2 gl_3 gl_4 =-        inOrderStage1-          (0x32 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_7 msg gl_0 gl_1 gl_2 (snocGrowList gl_3 v) gl_4)-          (pure (case msg.fileDescriptorProtoUnknownFields of { [] -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4 }; _ -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4, fileDescriptorProtoUnknownFields = reverse (msg.fileDescriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4)-      loop msg gl_0 gl_1 gl_2 gl_3 gl_4 = withTagM-        (pure (case msg.fileDescriptorProtoUnknownFields of { [] -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4 }; _ -> msg { fileDescriptorProtoDependency = growListToVector gl_0, fileDescriptorProtoMessageType = growListToVector gl_1, fileDescriptorProtoEnumType = growListToVector gl_2, fileDescriptorProtoService = growListToVector gl_3, fileDescriptorProtoExtension = growListToVector gl_4, fileDescriptorProtoUnknownFields = reverse (msg.fileDescriptorProtoUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { fileDescriptorProtoName = (Just v)}) gl_0 gl_1 gl_2 gl_3 gl_4-          2 -> do-            v <- decodeFieldString-            loop (msg { fileDescriptorProtoPackage = (Just v)}) gl_0 gl_1 gl_2 gl_3 gl_4-          3 -> do-            v <- decodeFieldString-            loop msg (snocGrowList gl_0 v) gl_1 gl_2 gl_3 gl_4-          10 -> case wt of-            2 -> do-              vs <- (VU.map fromIntegral <$> decodePackedVarint)-              loop (msg { fileDescriptorProtoPublicDependency = (msg.fileDescriptorProtoPublicDependency <> vs)}) gl_0 gl_1 gl_2 gl_3 gl_4-            _ -> do-              v <- (fromIntegral <$> decodeFieldVarint)-              loop (msg { fileDescriptorProtoPublicDependency = (VU.snoc msg.fileDescriptorProtoPublicDependency v)}) gl_0 gl_1 gl_2 gl_3 gl_4-          11 -> case wt of-            2 -> do-              vs <- (VU.map fromIntegral <$> decodePackedVarint)-              loop (msg { fileDescriptorProtoWeakDependency = (msg.fileDescriptorProtoWeakDependency <> vs)}) gl_0 gl_1 gl_2 gl_3 gl_4-            _ -> do-              v <- (fromIntegral <$> decodeFieldVarint)-              loop (msg { fileDescriptorProtoWeakDependency = (VU.snoc msg.fileDescriptorProtoWeakDependency v)}) gl_0 gl_1 gl_2 gl_3 gl_4-          4 -> do-            v <- decodeFieldMessage-            loop msg gl_0 (snocGrowList gl_1 v) gl_2 gl_3 gl_4-          5 -> do-            v <- decodeFieldMessage-            loop msg gl_0 gl_1 (snocGrowList gl_2 v) gl_3 gl_4-          6 -> do-            v <- decodeFieldMessage-            loop msg gl_0 gl_1 gl_2 (snocGrowList gl_3 v) gl_4-          7 -> do-            v <- decodeFieldMessage-            loop msg gl_0 gl_1 gl_2 gl_3 (snocGrowList gl_4 v)-          8 -> do-            v <- decodeFieldMessage-            loop (msg { fileDescriptorProtoOptions = (Just v)}) gl_0 gl_1 gl_2 gl_3 gl_4-          9 -> do-            v <- decodeFieldMessage-            loop (msg { fileDescriptorProtoSourceCodeInfo = (Just v)}) gl_0 gl_1 gl_2 gl_3 gl_4-          12 -> do-            v <- decodeFieldString-            loop (msg { fileDescriptorProtoSyntax = (Just v)}) gl_0 gl_1 gl_2 gl_3 gl_4-          14 -> do-            v <- decodeFieldEnum-            loop (msg { fileDescriptorProtoEdition = (Just v)}) gl_0 gl_1 gl_2 gl_3 gl_4-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { fileDescriptorProtoUnknownFields = (uf : msg.fileDescriptorProtoUnknownFields)}) gl_0 gl_1 gl_2 gl_3 gl_4)---- | Field descriptors for 'FileDescriptorProto', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-fileDescriptorProtoFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor FileDescriptorProto)-fileDescriptorProtoFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "name"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fileDescriptorProtoName-        , fdSet = \v m -> m { fileDescriptorProtoName = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "package"-        , fdNumber = 2-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fileDescriptorProtoPackage-        , fdSet = \v m -> m { fileDescriptorProtoPackage = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "dependency"-        , fdNumber = 3-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelRepeated-        , fdGet = fileDescriptorProtoDependency-        , fdSet = \v m -> m { fileDescriptorProtoDependency = v }-        })-    , (10, SomeField FieldDescriptor-        { fdName = "public_dependency"-        , fdNumber = 10-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelRepeated-        , fdGet = fileDescriptorProtoPublicDependency-        , fdSet = \v m -> m { fileDescriptorProtoPublicDependency = v }-        })-    , (11, SomeField FieldDescriptor-        { fdName = "weak_dependency"-        , fdNumber = 11-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelRepeated-        , fdGet = fileDescriptorProtoWeakDependency-        , fdSet = \v m -> m { fileDescriptorProtoWeakDependency = v }-        })-    , (4, SomeField FieldDescriptor-        { fdName = "message_type"-        , fdNumber = 4-        , fdTypeDesc = MessageType "DescriptorProto"-        , fdLabel = LabelRepeated-        , fdGet = fileDescriptorProtoMessageType-        , fdSet = \v m -> m { fileDescriptorProtoMessageType = v }-        })-    , (5, SomeField FieldDescriptor-        { fdName = "enum_type"-        , fdNumber = 5-        , fdTypeDesc = MessageType "EnumDescriptorProto"-        , fdLabel = LabelRepeated-        , fdGet = fileDescriptorProtoEnumType-        , fdSet = \v m -> m { fileDescriptorProtoEnumType = v }-        })-    , (6, SomeField FieldDescriptor-        { fdName = "service"-        , fdNumber = 6-        , fdTypeDesc = MessageType "ServiceDescriptorProto"-        , fdLabel = LabelRepeated-        , fdGet = fileDescriptorProtoService-        , fdSet = \v m -> m { fileDescriptorProtoService = v }-        })-    , (7, SomeField FieldDescriptor-        { fdName = "extension"-        , fdNumber = 7-        , fdTypeDesc = MessageType "FieldDescriptorProto"-        , fdLabel = LabelRepeated-        , fdGet = fileDescriptorProtoExtension-        , fdSet = \v m -> m { fileDescriptorProtoExtension = v }-        })-    , (8, SomeField FieldDescriptor-        { fdName = "options"-        , fdNumber = 8-        , fdTypeDesc = MessageType "FileOptions"-        , fdLabel = LabelOptional-        , fdGet = fileDescriptorProtoOptions-        , fdSet = \v m -> m { fileDescriptorProtoOptions = v }-        })-    , (9, SomeField FieldDescriptor-        { fdName = "source_code_info"-        , fdNumber = 9-        , fdTypeDesc = MessageType "SourceCodeInfo"-        , fdLabel = LabelOptional-        , fdGet = fileDescriptorProtoSourceCodeInfo-        , fdSet = \v m -> m { fileDescriptorProtoSourceCodeInfo = v }-        })-    , (12, SomeField FieldDescriptor-        { fdName = "syntax"-        , fdNumber = 12-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fileDescriptorProtoSyntax-        , fdSet = \v m -> m { fileDescriptorProtoSyntax = v }-        })-    , (14, SomeField FieldDescriptor-        { fdName = "edition"-        , fdNumber = 14-        , fdTypeDesc = MessageType "Edition"-        , fdLabel = LabelOptional-        , fdGet = fileDescriptorProtoEdition-        , fdSet = \v m -> m { fileDescriptorProtoEdition = v }-        })-    ]--instance ProtoMessage FileDescriptorProto where-  protoMessageName _ = "google.protobuf.FileDescriptorProto"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultFileDescriptorProto-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = fileDescriptorProtoFieldDescriptors--instance IsMessage FileDescriptorProto--instance Aeson.ToJSON FileDescriptorProto where-  toJSON msg = jsonObject-      [ "name" .=: msg.fileDescriptorProtoName-      , "package" .=: msg.fileDescriptorProtoPackage-      , "dependency" .=: msg.fileDescriptorProtoDependency-      , "publicDependency" .=: msg.fileDescriptorProtoPublicDependency-      , "weakDependency" .=: msg.fileDescriptorProtoWeakDependency-      , "messageType" .=: msg.fileDescriptorProtoMessageType-      , "enumType" .=: msg.fileDescriptorProtoEnumType-      , "service" .=: msg.fileDescriptorProtoService-      , "extension" .=: msg.fileDescriptorProtoExtension-      , "options" .=: msg.fileDescriptorProtoOptions-      , "sourceCodeInfo" .=: msg.fileDescriptorProtoSourceCodeInfo-      , "syntax" .=: msg.fileDescriptorProtoSyntax-      , "edition" .=: msg.fileDescriptorProtoEdition-      ]--instance Aeson.FromJSON FileDescriptorProto where-  parseJSON = Aeson.withObject "FileDescriptorProto" $ \obj -> do-    fld_fileDescriptorProtoName <- parseFieldMaybe obj "name"-    fld_fileDescriptorProtoPackage <- parseFieldMaybe obj "package"-    fld_fileDescriptorProtoDependency <- parseFieldMaybe obj "dependency"-    fld_fileDescriptorProtoPublicDependency <- parseFieldMaybe obj "publicDependency"-    fld_fileDescriptorProtoWeakDependency <- parseFieldMaybe obj "weakDependency"-    fld_fileDescriptorProtoMessageType <- parseFieldMaybe obj "messageType"-    fld_fileDescriptorProtoEnumType <- parseFieldMaybe obj "enumType"-    fld_fileDescriptorProtoService <- parseFieldMaybe obj "service"-    fld_fileDescriptorProtoExtension <- parseFieldMaybe obj "extension"-    fld_fileDescriptorProtoOptions <- parseFieldMaybe obj "options"-    fld_fileDescriptorProtoSourceCodeInfo <- parseFieldMaybe obj "sourceCodeInfo"-    fld_fileDescriptorProtoSyntax <- parseFieldMaybe obj "syntax"-    fld_fileDescriptorProtoEdition <- parseFieldMaybe obj "edition"-    pure defaultFileDescriptorProto-      { fileDescriptorProtoName = maybe (fileDescriptorProtoName defaultFileDescriptorProto) id fld_fileDescriptorProtoName-      , fileDescriptorProtoPackage = maybe (fileDescriptorProtoPackage defaultFileDescriptorProto) id fld_fileDescriptorProtoPackage-      , fileDescriptorProtoDependency = maybe (fileDescriptorProtoDependency defaultFileDescriptorProto) id fld_fileDescriptorProtoDependency-      , fileDescriptorProtoPublicDependency = maybe (fileDescriptorProtoPublicDependency defaultFileDescriptorProto) id fld_fileDescriptorProtoPublicDependency-      , fileDescriptorProtoWeakDependency = maybe (fileDescriptorProtoWeakDependency defaultFileDescriptorProto) id fld_fileDescriptorProtoWeakDependency-      , fileDescriptorProtoMessageType = maybe (fileDescriptorProtoMessageType defaultFileDescriptorProto) id fld_fileDescriptorProtoMessageType-      , fileDescriptorProtoEnumType = maybe (fileDescriptorProtoEnumType defaultFileDescriptorProto) id fld_fileDescriptorProtoEnumType-      , fileDescriptorProtoService = maybe (fileDescriptorProtoService defaultFileDescriptorProto) id fld_fileDescriptorProtoService-      , fileDescriptorProtoExtension = maybe (fileDescriptorProtoExtension defaultFileDescriptorProto) id fld_fileDescriptorProtoExtension-      , fileDescriptorProtoOptions = maybe (fileDescriptorProtoOptions defaultFileDescriptorProto) id fld_fileDescriptorProtoOptions-      , fileDescriptorProtoSourceCodeInfo = maybe (fileDescriptorProtoSourceCodeInfo defaultFileDescriptorProto) id fld_fileDescriptorProtoSourceCodeInfo-      , fileDescriptorProtoSyntax = maybe (fileDescriptorProtoSyntax defaultFileDescriptorProto) id fld_fileDescriptorProtoSyntax-      , fileDescriptorProtoEdition = maybe (fileDescriptorProtoEdition defaultFileDescriptorProto) id fld_fileDescriptorProtoEdition-      }--instance Hashable FileDescriptorProto where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (V.foldl' hashWithSalt (V.foldl' hashWithSalt (V.foldl' hashWithSalt (V.foldl' hashWithSalt (VU.foldl' hashWithSalt (VU.foldl' hashWithSalt (V.foldl' hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.fileDescriptorProtoName) msg.fileDescriptorProtoPackage) msg.fileDescriptorProtoDependency) msg.fileDescriptorProtoPublicDependency) msg.fileDescriptorProtoWeakDependency) msg.fileDescriptorProtoMessageType) msg.fileDescriptorProtoEnumType) msg.fileDescriptorProtoService) msg.fileDescriptorProtoExtension) msg.fileDescriptorProtoOptions) msg.fileDescriptorProtoSourceCodeInfo) msg.fileDescriptorProtoSyntax) msg.fileDescriptorProtoEdition--instance Proto.Extension.HasExtensions FileDescriptorProto where-  messageUnknownFields = fileDescriptorProtoUnknownFields-  setMessageUnknownFields !ufs msg = msg { fileDescriptorProtoUnknownFields = ufs }--instance Semigroup FileDescriptorProto where-  a <> b = FileDescriptorProto-    { fileDescriptorProtoName = case b.fileDescriptorProtoName of { Nothing -> a.fileDescriptorProtoName; x -> x }-    , fileDescriptorProtoPackage = case b.fileDescriptorProtoPackage of { Nothing -> a.fileDescriptorProtoPackage; x -> x }-    , fileDescriptorProtoDependency = a.fileDescriptorProtoDependency <> b.fileDescriptorProtoDependency-    , fileDescriptorProtoPublicDependency = a.fileDescriptorProtoPublicDependency <> b.fileDescriptorProtoPublicDependency-    , fileDescriptorProtoWeakDependency = a.fileDescriptorProtoWeakDependency <> b.fileDescriptorProtoWeakDependency-    , fileDescriptorProtoMessageType = a.fileDescriptorProtoMessageType <> b.fileDescriptorProtoMessageType-    , fileDescriptorProtoEnumType = a.fileDescriptorProtoEnumType <> b.fileDescriptorProtoEnumType-    , fileDescriptorProtoService = a.fileDescriptorProtoService <> b.fileDescriptorProtoService-    , fileDescriptorProtoExtension = a.fileDescriptorProtoExtension <> b.fileDescriptorProtoExtension-    , fileDescriptorProtoOptions = case b.fileDescriptorProtoOptions of { Nothing -> a.fileDescriptorProtoOptions; x -> x }-    , fileDescriptorProtoSourceCodeInfo = case b.fileDescriptorProtoSourceCodeInfo of { Nothing -> a.fileDescriptorProtoSourceCodeInfo; x -> x }-    , fileDescriptorProtoSyntax = case b.fileDescriptorProtoSyntax of { Nothing -> a.fileDescriptorProtoSyntax; x -> x }-    , fileDescriptorProtoEdition = case b.fileDescriptorProtoEdition of { Nothing -> a.fileDescriptorProtoEdition; x -> x }-    , fileDescriptorProtoUnknownFields = a.fileDescriptorProtoUnknownFields <> b.fileDescriptorProtoUnknownFields-    }--instance Monoid FileDescriptorProto where-  mempty = defaultFileDescriptorProto---- | Describes a message type.-data DescriptorProto = DescriptorProto-  { descriptorProtoName :: !(Maybe Text)-  , descriptorProtoField :: !(V.Vector FieldDescriptorProto)-  , descriptorProtoExtension :: !(V.Vector FieldDescriptorProto)-  , descriptorProtoNestedType :: !(V.Vector DescriptorProto)-  , descriptorProtoEnumType :: !(V.Vector EnumDescriptorProto)-  , descriptorProtoExtensionRange :: !(V.Vector DescriptorProto'ExtensionRange)-  , descriptorProtoOneofDecl :: !(V.Vector OneofDescriptorProto)-  , descriptorProtoOptions :: !(Maybe MessageOptions)-  , descriptorProtoReservedRange :: !(V.Vector DescriptorProto'ReservedRange)-  , descriptorProtoReservedName :: !(V.Vector Text)-    -- ^ Reserved field names, which may not be used by fields in the same message.-    -- A given name may only be reserved once.-  , descriptorProtoUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--data DescriptorProto'ExtensionRange = DescriptorProto'ExtensionRange-  { descriptorProtoExtensionRangeStart :: !(Maybe Int32)-  , descriptorProtoExtensionRangeEnd :: !(Maybe Int32)-  , descriptorProtoExtensionRangeOptions :: !(Maybe ExtensionRangeOptions)-  , descriptorProtoExtensionRangeUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultDescriptorProto'ExtensionRange :: DescriptorProto'ExtensionRange-defaultDescriptorProto'ExtensionRange = DescriptorProto'ExtensionRange-  { descriptorProtoExtensionRangeStart = Nothing-  , descriptorProtoExtensionRangeEnd = Nothing-  , descriptorProtoExtensionRangeOptions = Nothing-  , descriptorProtoExtensionRangeUnknownFields = []-  }--instance MessageEncode DescriptorProto'ExtensionRange where-  buildSized msg =-    (maybe mempty (\v -> archVarint 8 (fromIntegral v)) msg.descriptorProtoExtensionRangeStart)-    <> (maybe mempty (\v -> archVarint 16 (fromIntegral v)) msg.descriptorProtoExtensionRangeEnd)-    <> (maybe mempty (\v -> archSubmessage 26 (buildSized v)) msg.descriptorProtoExtensionRangeOptions)-    <> encodeUnknownFieldsSized msg.descriptorProtoExtensionRangeUnknownFields--instance MessageDecode DescriptorProto'ExtensionRange where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultDescriptorProto'ExtensionRange-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_1 (msg { descriptorProtoExtensionRangeStart = (Just v)}))-          (pure (case msg.descriptorProtoExtensionRangeUnknownFields of { [] -> msg; _ -> msg { descriptorProtoExtensionRangeUnknownFields = reverse (msg.descriptorProtoExtensionRangeUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x10 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_2 (msg { descriptorProtoExtensionRangeEnd = (Just v)}))-          (pure (case msg.descriptorProtoExtensionRangeUnknownFields of { [] -> msg; _ -> msg { descriptorProtoExtensionRangeUnknownFields = reverse (msg.descriptorProtoExtensionRangeUnknownFields) } }))-          (loop msg)-      stage_2 msg =-        inOrderStage1-          (0x1a :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> loop (msg { descriptorProtoExtensionRangeOptions = (Just v)}))-          (pure (case msg.descriptorProtoExtensionRangeUnknownFields of { [] -> msg; _ -> msg { descriptorProtoExtensionRangeUnknownFields = reverse (msg.descriptorProtoExtensionRangeUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.descriptorProtoExtensionRangeUnknownFields of { [] -> msg; _ -> msg { descriptorProtoExtensionRangeUnknownFields = reverse (msg.descriptorProtoExtensionRangeUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { descriptorProtoExtensionRangeStart = (Just v)})-          2 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { descriptorProtoExtensionRangeEnd = (Just v)})-          3 -> do-            v <- decodeFieldMessage-            loop (msg { descriptorProtoExtensionRangeOptions = (Just v)})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { descriptorProtoExtensionRangeUnknownFields = (uf : msg.descriptorProtoExtensionRangeUnknownFields)}))---- | Field descriptors for 'DescriptorProto'ExtensionRange', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-descriptorProto'ExtensionRangeFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor DescriptorProto'ExtensionRange)-descriptorProto'ExtensionRangeFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "start"-        , fdNumber = 1-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = descriptorProtoExtensionRangeStart-        , fdSet = \v m -> m { descriptorProtoExtensionRangeStart = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "end"-        , fdNumber = 2-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = descriptorProtoExtensionRangeEnd-        , fdSet = \v m -> m { descriptorProtoExtensionRangeEnd = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "options"-        , fdNumber = 3-        , fdTypeDesc = MessageType "ExtensionRangeOptions"-        , fdLabel = LabelOptional-        , fdGet = descriptorProtoExtensionRangeOptions-        , fdSet = \v m -> m { descriptorProtoExtensionRangeOptions = v }-        })-    ]--instance ProtoMessage DescriptorProto'ExtensionRange where-  protoMessageName _ = "google.protobuf.DescriptorProto.ExtensionRange"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultDescriptorProto'ExtensionRange-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = descriptorProto'ExtensionRangeFieldDescriptors--instance IsMessage DescriptorProto'ExtensionRange--instance Aeson.ToJSON DescriptorProto'ExtensionRange where-  toJSON msg = jsonObject-      [ "start" .=: msg.descriptorProtoExtensionRangeStart-      , "end" .=: msg.descriptorProtoExtensionRangeEnd-      , "options" .=: msg.descriptorProtoExtensionRangeOptions-      ]--instance Aeson.FromJSON DescriptorProto'ExtensionRange where-  parseJSON = Aeson.withObject "DescriptorProto'ExtensionRange" $ \obj -> do-    fld_descriptorProtoExtensionRangeStart <- parseFieldMaybe obj "start"-    fld_descriptorProtoExtensionRangeEnd <- parseFieldMaybe obj "end"-    fld_descriptorProtoExtensionRangeOptions <- parseFieldMaybe obj "options"-    pure defaultDescriptorProto'ExtensionRange-      { descriptorProtoExtensionRangeStart = maybe (descriptorProtoExtensionRangeStart defaultDescriptorProto'ExtensionRange) id fld_descriptorProtoExtensionRangeStart-      , descriptorProtoExtensionRangeEnd = maybe (descriptorProtoExtensionRangeEnd defaultDescriptorProto'ExtensionRange) id fld_descriptorProtoExtensionRangeEnd-      , descriptorProtoExtensionRangeOptions = maybe (descriptorProtoExtensionRangeOptions defaultDescriptorProto'ExtensionRange) id fld_descriptorProtoExtensionRangeOptions-      }--instance Hashable DescriptorProto'ExtensionRange where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.descriptorProtoExtensionRangeStart) msg.descriptorProtoExtensionRangeEnd) msg.descriptorProtoExtensionRangeOptions--instance Proto.Extension.HasExtensions DescriptorProto'ExtensionRange where-  messageUnknownFields = descriptorProtoExtensionRangeUnknownFields-  setMessageUnknownFields !ufs msg = msg { descriptorProtoExtensionRangeUnknownFields = ufs }--instance Semigroup DescriptorProto'ExtensionRange where-  a <> b = DescriptorProto'ExtensionRange-    { descriptorProtoExtensionRangeStart = case b.descriptorProtoExtensionRangeStart of { Nothing -> a.descriptorProtoExtensionRangeStart; x -> x }-    , descriptorProtoExtensionRangeEnd = case b.descriptorProtoExtensionRangeEnd of { Nothing -> a.descriptorProtoExtensionRangeEnd; x -> x }-    , descriptorProtoExtensionRangeOptions = case b.descriptorProtoExtensionRangeOptions of { Nothing -> a.descriptorProtoExtensionRangeOptions; x -> x }-    , descriptorProtoExtensionRangeUnknownFields = a.descriptorProtoExtensionRangeUnknownFields <> b.descriptorProtoExtensionRangeUnknownFields-    }--instance Monoid DescriptorProto'ExtensionRange where-  mempty = defaultDescriptorProto'ExtensionRange---- | Range of reserved tag numbers. Reserved tag numbers may not be used by--- fields or extension ranges in the same message. Reserved ranges may--- not overlap.-data DescriptorProto'ReservedRange = DescriptorProto'ReservedRange-  { descriptorProtoReservedRangeStart :: !(Maybe Int32)-  , descriptorProtoReservedRangeEnd :: !(Maybe Int32)-  , descriptorProtoReservedRangeUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultDescriptorProto'ReservedRange :: DescriptorProto'ReservedRange-defaultDescriptorProto'ReservedRange = DescriptorProto'ReservedRange-  { descriptorProtoReservedRangeStart = Nothing-  , descriptorProtoReservedRangeEnd = Nothing-  , descriptorProtoReservedRangeUnknownFields = []-  }--instance MessageEncode DescriptorProto'ReservedRange where-  buildSized msg =-    (maybe mempty (\v -> archVarint 8 (fromIntegral v)) msg.descriptorProtoReservedRangeStart)-    <> (maybe mempty (\v -> archVarint 16 (fromIntegral v)) msg.descriptorProtoReservedRangeEnd)-    <> encodeUnknownFieldsSized msg.descriptorProtoReservedRangeUnknownFields--instance MessageDecode DescriptorProto'ReservedRange where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultDescriptorProto'ReservedRange-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_1 (msg { descriptorProtoReservedRangeStart = (Just v)}))-          (pure (case msg.descriptorProtoReservedRangeUnknownFields of { [] -> msg; _ -> msg { descriptorProtoReservedRangeUnknownFields = reverse (msg.descriptorProtoReservedRangeUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x10 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> loop (msg { descriptorProtoReservedRangeEnd = (Just v)}))-          (pure (case msg.descriptorProtoReservedRangeUnknownFields of { [] -> msg; _ -> msg { descriptorProtoReservedRangeUnknownFields = reverse (msg.descriptorProtoReservedRangeUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.descriptorProtoReservedRangeUnknownFields of { [] -> msg; _ -> msg { descriptorProtoReservedRangeUnknownFields = reverse (msg.descriptorProtoReservedRangeUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { descriptorProtoReservedRangeStart = (Just v)})-          2 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { descriptorProtoReservedRangeEnd = (Just v)})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { descriptorProtoReservedRangeUnknownFields = (uf : msg.descriptorProtoReservedRangeUnknownFields)}))---- | Field descriptors for 'DescriptorProto'ReservedRange', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-descriptorProto'ReservedRangeFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor DescriptorProto'ReservedRange)-descriptorProto'ReservedRangeFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "start"-        , fdNumber = 1-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = descriptorProtoReservedRangeStart-        , fdSet = \v m -> m { descriptorProtoReservedRangeStart = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "end"-        , fdNumber = 2-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = descriptorProtoReservedRangeEnd-        , fdSet = \v m -> m { descriptorProtoReservedRangeEnd = v }-        })-    ]--instance ProtoMessage DescriptorProto'ReservedRange where-  protoMessageName _ = "google.protobuf.DescriptorProto.ReservedRange"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultDescriptorProto'ReservedRange-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = descriptorProto'ReservedRangeFieldDescriptors--instance IsMessage DescriptorProto'ReservedRange--instance Aeson.ToJSON DescriptorProto'ReservedRange where-  toJSON msg = jsonObject-      [ "start" .=: msg.descriptorProtoReservedRangeStart-      , "end" .=: msg.descriptorProtoReservedRangeEnd-      ]--instance Aeson.FromJSON DescriptorProto'ReservedRange where-  parseJSON = Aeson.withObject "DescriptorProto'ReservedRange" $ \obj -> do-    fld_descriptorProtoReservedRangeStart <- parseFieldMaybe obj "start"-    fld_descriptorProtoReservedRangeEnd <- parseFieldMaybe obj "end"-    pure defaultDescriptorProto'ReservedRange-      { descriptorProtoReservedRangeStart = maybe (descriptorProtoReservedRangeStart defaultDescriptorProto'ReservedRange) id fld_descriptorProtoReservedRangeStart-      , descriptorProtoReservedRangeEnd = maybe (descriptorProtoReservedRangeEnd defaultDescriptorProto'ReservedRange) id fld_descriptorProtoReservedRangeEnd-      }--instance Hashable DescriptorProto'ReservedRange where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (salt) msg.descriptorProtoReservedRangeStart) msg.descriptorProtoReservedRangeEnd--instance Proto.Extension.HasExtensions DescriptorProto'ReservedRange where-  messageUnknownFields = descriptorProtoReservedRangeUnknownFields-  setMessageUnknownFields !ufs msg = msg { descriptorProtoReservedRangeUnknownFields = ufs }--instance Semigroup DescriptorProto'ReservedRange where-  a <> b = DescriptorProto'ReservedRange-    { descriptorProtoReservedRangeStart = case b.descriptorProtoReservedRangeStart of { Nothing -> a.descriptorProtoReservedRangeStart; x -> x }-    , descriptorProtoReservedRangeEnd = case b.descriptorProtoReservedRangeEnd of { Nothing -> a.descriptorProtoReservedRangeEnd; x -> x }-    , descriptorProtoReservedRangeUnknownFields = a.descriptorProtoReservedRangeUnknownFields <> b.descriptorProtoReservedRangeUnknownFields-    }--instance Monoid DescriptorProto'ReservedRange where-  mempty = defaultDescriptorProto'ReservedRange--defaultDescriptorProto :: DescriptorProto-defaultDescriptorProto = DescriptorProto-  { descriptorProtoName = Nothing-  , descriptorProtoField = V.empty-  , descriptorProtoExtension = V.empty-  , descriptorProtoNestedType = V.empty-  , descriptorProtoEnumType = V.empty-  , descriptorProtoExtensionRange = V.empty-  , descriptorProtoOneofDecl = V.empty-  , descriptorProtoOptions = Nothing-  , descriptorProtoReservedRange = V.empty-  , descriptorProtoReservedName = V.empty-  , descriptorProtoUnknownFields = []-  }--instance MessageEncode DescriptorProto where-  buildSized msg =-    (maybe mempty (\v -> archString 10 v) msg.descriptorProtoName)-    <> V.foldl' (\acc v -> acc <> archSubmessage 18 (buildSized v)) mempty msg.descriptorProtoField-    <> V.foldl' (\acc v -> acc <> archSubmessage 50 (buildSized v)) mempty msg.descriptorProtoExtension-    <> V.foldl' (\acc v -> acc <> archSubmessage 26 (buildSized v)) mempty msg.descriptorProtoNestedType-    <> V.foldl' (\acc v -> acc <> archSubmessage 34 (buildSized v)) mempty msg.descriptorProtoEnumType-    <> V.foldl' (\acc v -> acc <> archSubmessage 42 (buildSized v)) mempty msg.descriptorProtoExtensionRange-    <> V.foldl' (\acc v -> acc <> archSubmessage 66 (buildSized v)) mempty msg.descriptorProtoOneofDecl-    <> (maybe mempty (\v -> archSubmessage 58 (buildSized v)) msg.descriptorProtoOptions)-    <> V.foldl' (\acc v -> acc <> archSubmessage 74 (buildSized v)) mempty msg.descriptorProtoReservedRange-    <> V.foldl' (\acc v -> acc <> archString 82 v) mempty msg.descriptorProtoReservedName-    <> encodeUnknownFieldsSized msg.descriptorProtoUnknownFields--instance MessageDecode DescriptorProto where-  messageDecoder = stage_0 defaultDescriptorProto emptyGrowList emptyGrowList emptyGrowList emptyGrowList emptyGrowList emptyGrowList emptyGrowList emptyGrowList-    where-      stage_0 msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_1 (msg { descriptorProtoName = (Just v)}) gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7)-          (pure (case msg.descriptorProtoUnknownFields of { [] -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7 }; _ -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7, descriptorProtoUnknownFields = reverse (msg.descriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7)-      stage_1 msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7 =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_1 msg (snocGrowList gl_0 v) gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7)-          (pure (case msg.descriptorProtoUnknownFields of { [] -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7 }; _ -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7, descriptorProtoUnknownFields = reverse (msg.descriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7)-      stage_2 msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7 =-        inOrderStage1-          (0x32 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_2 msg gl_0 (snocGrowList gl_1 v) gl_2 gl_3 gl_4 gl_5 gl_6 gl_7)-          (pure (case msg.descriptorProtoUnknownFields of { [] -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7 }; _ -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7, descriptorProtoUnknownFields = reverse (msg.descriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7)-      stage_3 msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7 =-        inOrderStage1-          (0x1a :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_3 msg gl_0 gl_1 (snocGrowList gl_2 v) gl_3 gl_4 gl_5 gl_6 gl_7)-          (pure (case msg.descriptorProtoUnknownFields of { [] -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7 }; _ -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7, descriptorProtoUnknownFields = reverse (msg.descriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7)-      stage_4 msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7 =-        inOrderStage1-          (0x22 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_4 msg gl_0 gl_1 gl_2 (snocGrowList gl_3 v) gl_4 gl_5 gl_6 gl_7)-          (pure (case msg.descriptorProtoUnknownFields of { [] -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7 }; _ -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7, descriptorProtoUnknownFields = reverse (msg.descriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7)-      stage_5 msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7 =-        inOrderStage1-          (0x2a :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_5 msg gl_0 gl_1 gl_2 gl_3 (snocGrowList gl_4 v) gl_5 gl_6 gl_7)-          (pure (case msg.descriptorProtoUnknownFields of { [] -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7 }; _ -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7, descriptorProtoUnknownFields = reverse (msg.descriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7)-      stage_6 msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7 =-        inOrderStage1-          (0x42 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_6 msg gl_0 gl_1 gl_2 gl_3 gl_4 (snocGrowList gl_5 v) gl_6 gl_7)-          (pure (case msg.descriptorProtoUnknownFields of { [] -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7 }; _ -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7, descriptorProtoUnknownFields = reverse (msg.descriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7)-      stage_7 msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7 =-        inOrderStage1-          (0x3a :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> loop (msg { descriptorProtoOptions = (Just v)}) gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7)-          (pure (case msg.descriptorProtoUnknownFields of { [] -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7 }; _ -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7, descriptorProtoUnknownFields = reverse (msg.descriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7)-      loop msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7 = withTagM-        (pure (case msg.descriptorProtoUnknownFields of { [] -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7 }; _ -> msg { descriptorProtoField = growListToVector gl_0, descriptorProtoExtension = growListToVector gl_1, descriptorProtoNestedType = growListToVector gl_2, descriptorProtoEnumType = growListToVector gl_3, descriptorProtoExtensionRange = growListToVector gl_4, descriptorProtoOneofDecl = growListToVector gl_5, descriptorProtoReservedRange = growListToVector gl_6, descriptorProtoReservedName = growListToVector gl_7, descriptorProtoUnknownFields = reverse (msg.descriptorProtoUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { descriptorProtoName = (Just v)}) gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7-          2 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v) gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7-          6 -> do-            v <- decodeFieldMessage-            loop msg gl_0 (snocGrowList gl_1 v) gl_2 gl_3 gl_4 gl_5 gl_6 gl_7-          3 -> do-            v <- decodeFieldMessage-            loop msg gl_0 gl_1 (snocGrowList gl_2 v) gl_3 gl_4 gl_5 gl_6 gl_7-          4 -> do-            v <- decodeFieldMessage-            loop msg gl_0 gl_1 gl_2 (snocGrowList gl_3 v) gl_4 gl_5 gl_6 gl_7-          5 -> do-            v <- decodeFieldMessage-            loop msg gl_0 gl_1 gl_2 gl_3 (snocGrowList gl_4 v) gl_5 gl_6 gl_7-          8 -> do-            v <- decodeFieldMessage-            loop msg gl_0 gl_1 gl_2 gl_3 gl_4 (snocGrowList gl_5 v) gl_6 gl_7-          7 -> do-            v <- decodeFieldMessage-            loop (msg { descriptorProtoOptions = (Just v)}) gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7-          9 -> do-            v <- decodeFieldMessage-            loop msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 (snocGrowList gl_6 v) gl_7-          10 -> do-            v <- decodeFieldString-            loop msg gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 (snocGrowList gl_7 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { descriptorProtoUnknownFields = (uf : msg.descriptorProtoUnknownFields)}) gl_0 gl_1 gl_2 gl_3 gl_4 gl_5 gl_6 gl_7)---- | Field descriptors for 'DescriptorProto', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-descriptorProtoFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor DescriptorProto)-descriptorProtoFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "name"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = descriptorProtoName-        , fdSet = \v m -> m { descriptorProtoName = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "field"-        , fdNumber = 2-        , fdTypeDesc = MessageType "FieldDescriptorProto"-        , fdLabel = LabelRepeated-        , fdGet = descriptorProtoField-        , fdSet = \v m -> m { descriptorProtoField = v }-        })-    , (6, SomeField FieldDescriptor-        { fdName = "extension"-        , fdNumber = 6-        , fdTypeDesc = MessageType "FieldDescriptorProto"-        , fdLabel = LabelRepeated-        , fdGet = descriptorProtoExtension-        , fdSet = \v m -> m { descriptorProtoExtension = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "nested_type"-        , fdNumber = 3-        , fdTypeDesc = MessageType "DescriptorProto"-        , fdLabel = LabelRepeated-        , fdGet = descriptorProtoNestedType-        , fdSet = \v m -> m { descriptorProtoNestedType = v }-        })-    , (4, SomeField FieldDescriptor-        { fdName = "enum_type"-        , fdNumber = 4-        , fdTypeDesc = MessageType "EnumDescriptorProto"-        , fdLabel = LabelRepeated-        , fdGet = descriptorProtoEnumType-        , fdSet = \v m -> m { descriptorProtoEnumType = v }-        })-    , (5, SomeField FieldDescriptor-        { fdName = "extension_range"-        , fdNumber = 5-        , fdTypeDesc = MessageType "ExtensionRange"-        , fdLabel = LabelRepeated-        , fdGet = descriptorProtoExtensionRange-        , fdSet = \v m -> m { descriptorProtoExtensionRange = v }-        })-    , (8, SomeField FieldDescriptor-        { fdName = "oneof_decl"-        , fdNumber = 8-        , fdTypeDesc = MessageType "OneofDescriptorProto"-        , fdLabel = LabelRepeated-        , fdGet = descriptorProtoOneofDecl-        , fdSet = \v m -> m { descriptorProtoOneofDecl = v }-        })-    , (7, SomeField FieldDescriptor-        { fdName = "options"-        , fdNumber = 7-        , fdTypeDesc = MessageType "MessageOptions"-        , fdLabel = LabelOptional-        , fdGet = descriptorProtoOptions-        , fdSet = \v m -> m { descriptorProtoOptions = v }-        })-    , (9, SomeField FieldDescriptor-        { fdName = "reserved_range"-        , fdNumber = 9-        , fdTypeDesc = MessageType "ReservedRange"-        , fdLabel = LabelRepeated-        , fdGet = descriptorProtoReservedRange-        , fdSet = \v m -> m { descriptorProtoReservedRange = v }-        })-    , (10, SomeField FieldDescriptor-        { fdName = "reserved_name"-        , fdNumber = 10-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelRepeated-        , fdGet = descriptorProtoReservedName-        , fdSet = \v m -> m { descriptorProtoReservedName = v }-        })-    ]--instance ProtoMessage DescriptorProto where-  protoMessageName _ = "google.protobuf.DescriptorProto"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultDescriptorProto-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = descriptorProtoFieldDescriptors--instance IsMessage DescriptorProto--instance Aeson.ToJSON DescriptorProto where-  toJSON msg = jsonObject-      [ "name" .=: msg.descriptorProtoName-      , "field" .=: msg.descriptorProtoField-      , "extension" .=: msg.descriptorProtoExtension-      , "nestedType" .=: msg.descriptorProtoNestedType-      , "enumType" .=: msg.descriptorProtoEnumType-      , "extensionRange" .=: msg.descriptorProtoExtensionRange-      , "oneofDecl" .=: msg.descriptorProtoOneofDecl-      , "options" .=: msg.descriptorProtoOptions-      , "reservedRange" .=: msg.descriptorProtoReservedRange-      , "reservedName" .=: msg.descriptorProtoReservedName-      ]--instance Aeson.FromJSON DescriptorProto where-  parseJSON = Aeson.withObject "DescriptorProto" $ \obj -> do-    fld_descriptorProtoName <- parseFieldMaybe obj "name"-    fld_descriptorProtoField <- parseFieldMaybe obj "field"-    fld_descriptorProtoExtension <- parseFieldMaybe obj "extension"-    fld_descriptorProtoNestedType <- parseFieldMaybe obj "nestedType"-    fld_descriptorProtoEnumType <- parseFieldMaybe obj "enumType"-    fld_descriptorProtoExtensionRange <- parseFieldMaybe obj "extensionRange"-    fld_descriptorProtoOneofDecl <- parseFieldMaybe obj "oneofDecl"-    fld_descriptorProtoOptions <- parseFieldMaybe obj "options"-    fld_descriptorProtoReservedRange <- parseFieldMaybe obj "reservedRange"-    fld_descriptorProtoReservedName <- parseFieldMaybe obj "reservedName"-    pure defaultDescriptorProto-      { descriptorProtoName = maybe (descriptorProtoName defaultDescriptorProto) id fld_descriptorProtoName-      , descriptorProtoField = maybe (descriptorProtoField defaultDescriptorProto) id fld_descriptorProtoField-      , descriptorProtoExtension = maybe (descriptorProtoExtension defaultDescriptorProto) id fld_descriptorProtoExtension-      , descriptorProtoNestedType = maybe (descriptorProtoNestedType defaultDescriptorProto) id fld_descriptorProtoNestedType-      , descriptorProtoEnumType = maybe (descriptorProtoEnumType defaultDescriptorProto) id fld_descriptorProtoEnumType-      , descriptorProtoExtensionRange = maybe (descriptorProtoExtensionRange defaultDescriptorProto) id fld_descriptorProtoExtensionRange-      , descriptorProtoOneofDecl = maybe (descriptorProtoOneofDecl defaultDescriptorProto) id fld_descriptorProtoOneofDecl-      , descriptorProtoOptions = maybe (descriptorProtoOptions defaultDescriptorProto) id fld_descriptorProtoOptions-      , descriptorProtoReservedRange = maybe (descriptorProtoReservedRange defaultDescriptorProto) id fld_descriptorProtoReservedRange-      , descriptorProtoReservedName = maybe (descriptorProtoReservedName defaultDescriptorProto) id fld_descriptorProtoReservedName-      }--instance Hashable DescriptorProto where-  hashWithSalt salt msg = V.foldl' hashWithSalt (V.foldl' hashWithSalt (hashWithSalt (V.foldl' hashWithSalt (V.foldl' hashWithSalt (V.foldl' hashWithSalt (V.foldl' hashWithSalt (V.foldl' hashWithSalt (V.foldl' hashWithSalt (hashWithSalt (salt) msg.descriptorProtoName) msg.descriptorProtoField) msg.descriptorProtoExtension) msg.descriptorProtoNestedType) msg.descriptorProtoEnumType) msg.descriptorProtoExtensionRange) msg.descriptorProtoOneofDecl) msg.descriptorProtoOptions) msg.descriptorProtoReservedRange) msg.descriptorProtoReservedName--instance Proto.Extension.HasExtensions DescriptorProto where-  messageUnknownFields = descriptorProtoUnknownFields-  setMessageUnknownFields !ufs msg = msg { descriptorProtoUnknownFields = ufs }--instance Semigroup DescriptorProto where-  a <> b = DescriptorProto-    { descriptorProtoName = case b.descriptorProtoName of { Nothing -> a.descriptorProtoName; x -> x }-    , descriptorProtoField = a.descriptorProtoField <> b.descriptorProtoField-    , descriptorProtoExtension = a.descriptorProtoExtension <> b.descriptorProtoExtension-    , descriptorProtoNestedType = a.descriptorProtoNestedType <> b.descriptorProtoNestedType-    , descriptorProtoEnumType = a.descriptorProtoEnumType <> b.descriptorProtoEnumType-    , descriptorProtoExtensionRange = a.descriptorProtoExtensionRange <> b.descriptorProtoExtensionRange-    , descriptorProtoOneofDecl = a.descriptorProtoOneofDecl <> b.descriptorProtoOneofDecl-    , descriptorProtoOptions = case b.descriptorProtoOptions of { Nothing -> a.descriptorProtoOptions; x -> x }-    , descriptorProtoReservedRange = a.descriptorProtoReservedRange <> b.descriptorProtoReservedRange-    , descriptorProtoReservedName = a.descriptorProtoReservedName <> b.descriptorProtoReservedName-    , descriptorProtoUnknownFields = a.descriptorProtoUnknownFields <> b.descriptorProtoUnknownFields-    }--instance Monoid DescriptorProto where-  mempty = defaultDescriptorProto--data ExtensionRangeOptions = ExtensionRangeOptions-  { extensionRangeOptionsUninterpretedOption :: !(V.Vector UninterpretedOption)-    -- ^ The parser stores options it doesn't recognize here. See above.-  , extensionRangeOptionsDeclaration :: !(V.Vector ExtensionRangeOptions'Declaration)-    -- ^ For external users: DO NOT USE. We are in the process of open sourcing-    -- extension declaration and executing internal cleanups before it can be-    -- used externally.-  , extensionRangeOptionsFeatures :: !(Maybe FeatureSet)-    -- ^ Any features defined in the specific edition.-  , extensionRangeOptionsVerification :: !(Maybe ExtensionRangeOptions'VerificationState)-    -- ^ The verification state of the range.-    -- TODO: flip the default to DECLARATION once all empty ranges-    -- are marked as UNVERIFIED.-  , extensionRangeOptionsUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--data ExtensionRangeOptions'Declaration = ExtensionRangeOptions'Declaration-  { extensionRangeOptionsDeclarationNumber :: !(Maybe Int32)-    -- ^ The extension number declared within the extension range.-  , extensionRangeOptionsDeclarationFullName :: !(Maybe Text)-    -- ^ The fully-qualified name of the extension field. There must be a leading-    -- dot in front of the full name.-  , extensionRangeOptionsDeclarationType :: !(Maybe Text)-    -- ^ The fully-qualified type name of the extension field. Unlike-    -- Metadata.type, Declaration.type must have a leading dot for messages-    -- and enums.-  , extensionRangeOptionsDeclarationReserved :: !(Maybe Bool)-    -- ^ If true, indicates that the number is reserved in the extension range,-    -- and any extension field with the number will fail to compile. Set this-    -- when a declared extension field is deleted.-  , extensionRangeOptionsDeclarationRepeated :: !(Maybe Bool)-    -- ^ If true, indicates that the extension must be defined as repeated.-    -- Otherwise the extension must be defined as optional.-  , extensionRangeOptionsDeclarationUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultExtensionRangeOptions'Declaration :: ExtensionRangeOptions'Declaration-defaultExtensionRangeOptions'Declaration = ExtensionRangeOptions'Declaration-  { extensionRangeOptionsDeclarationNumber = Nothing-  , extensionRangeOptionsDeclarationFullName = Nothing-  , extensionRangeOptionsDeclarationType = Nothing-  , extensionRangeOptionsDeclarationReserved = Nothing-  , extensionRangeOptionsDeclarationRepeated = Nothing-  , extensionRangeOptionsDeclarationUnknownFields = []-  }--instance MessageEncode ExtensionRangeOptions'Declaration where-  buildSized msg =-    (maybe mempty (\v -> archVarint 8 (fromIntegral v)) msg.extensionRangeOptionsDeclarationNumber)-    <> (maybe mempty (\v -> archString 18 v) msg.extensionRangeOptionsDeclarationFullName)-    <> (maybe mempty (\v -> archString 26 v) msg.extensionRangeOptionsDeclarationType)-    <> (maybe mempty (\v -> archBool 40 v) msg.extensionRangeOptionsDeclarationReserved)-    <> (maybe mempty (\v -> archBool 48 v) msg.extensionRangeOptionsDeclarationRepeated)-    <> encodeUnknownFieldsSized msg.extensionRangeOptionsDeclarationUnknownFields--instance MessageDecode ExtensionRangeOptions'Declaration where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultExtensionRangeOptions'Declaration-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_1 (msg { extensionRangeOptionsDeclarationNumber = (Just v)}))-          (pure (case msg.extensionRangeOptionsDeclarationUnknownFields of { [] -> msg; _ -> msg { extensionRangeOptionsDeclarationUnknownFields = reverse (msg.extensionRangeOptionsDeclarationUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_2 (msg { extensionRangeOptionsDeclarationFullName = (Just v)}))-          (pure (case msg.extensionRangeOptionsDeclarationUnknownFields of { [] -> msg; _ -> msg { extensionRangeOptionsDeclarationUnknownFields = reverse (msg.extensionRangeOptionsDeclarationUnknownFields) } }))-          (loop msg)-      stage_2 msg =-        inOrderStage1-          (0x1a :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_3 (msg { extensionRangeOptionsDeclarationType = (Just v)}))-          (pure (case msg.extensionRangeOptionsDeclarationUnknownFields of { [] -> msg; _ -> msg { extensionRangeOptionsDeclarationUnknownFields = reverse (msg.extensionRangeOptionsDeclarationUnknownFields) } }))-          (loop msg)-      stage_3 msg =-        inOrderStage1-          (0x28 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_4 (msg { extensionRangeOptionsDeclarationReserved = (Just v)}))-          (pure (case msg.extensionRangeOptionsDeclarationUnknownFields of { [] -> msg; _ -> msg { extensionRangeOptionsDeclarationUnknownFields = reverse (msg.extensionRangeOptionsDeclarationUnknownFields) } }))-          (loop msg)-      stage_4 msg =-        inOrderStage1-          (0x30 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> loop (msg { extensionRangeOptionsDeclarationRepeated = (Just v)}))-          (pure (case msg.extensionRangeOptionsDeclarationUnknownFields of { [] -> msg; _ -> msg { extensionRangeOptionsDeclarationUnknownFields = reverse (msg.extensionRangeOptionsDeclarationUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.extensionRangeOptionsDeclarationUnknownFields of { [] -> msg; _ -> msg { extensionRangeOptionsDeclarationUnknownFields = reverse (msg.extensionRangeOptionsDeclarationUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { extensionRangeOptionsDeclarationNumber = (Just v)})-          2 -> do-            v <- decodeFieldString-            loop (msg { extensionRangeOptionsDeclarationFullName = (Just v)})-          3 -> do-            v <- decodeFieldString-            loop (msg { extensionRangeOptionsDeclarationType = (Just v)})-          5 -> do-            v <- decodeFieldBool-            loop (msg { extensionRangeOptionsDeclarationReserved = (Just v)})-          6 -> do-            v <- decodeFieldBool-            loop (msg { extensionRangeOptionsDeclarationRepeated = (Just v)})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { extensionRangeOptionsDeclarationUnknownFields = (uf : msg.extensionRangeOptionsDeclarationUnknownFields)}))---- | Field descriptors for 'ExtensionRangeOptions'Declaration', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-extensionRangeOptions'DeclarationFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor ExtensionRangeOptions'Declaration)-extensionRangeOptions'DeclarationFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "number"-        , fdNumber = 1-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = extensionRangeOptionsDeclarationNumber-        , fdSet = \v m -> m { extensionRangeOptionsDeclarationNumber = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "full_name"-        , fdNumber = 2-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = extensionRangeOptionsDeclarationFullName-        , fdSet = \v m -> m { extensionRangeOptionsDeclarationFullName = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "type"-        , fdNumber = 3-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = extensionRangeOptionsDeclarationType-        , fdSet = \v m -> m { extensionRangeOptionsDeclarationType = v }-        })-    , (5, SomeField FieldDescriptor-        { fdName = "reserved"-        , fdNumber = 5-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = extensionRangeOptionsDeclarationReserved-        , fdSet = \v m -> m { extensionRangeOptionsDeclarationReserved = v }-        })-    , (6, SomeField FieldDescriptor-        { fdName = "repeated"-        , fdNumber = 6-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = extensionRangeOptionsDeclarationRepeated-        , fdSet = \v m -> m { extensionRangeOptionsDeclarationRepeated = v }-        })-    ]--instance ProtoMessage ExtensionRangeOptions'Declaration where-  protoMessageName _ = "google.protobuf.ExtensionRangeOptions.Declaration"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultExtensionRangeOptions'Declaration-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = extensionRangeOptions'DeclarationFieldDescriptors--instance IsMessage ExtensionRangeOptions'Declaration--instance Aeson.ToJSON ExtensionRangeOptions'Declaration where-  toJSON msg = jsonObject-      [ "number" .=: msg.extensionRangeOptionsDeclarationNumber-      , "fullName" .=: msg.extensionRangeOptionsDeclarationFullName-      , "type" .=: msg.extensionRangeOptionsDeclarationType-      , "reserved" .=: msg.extensionRangeOptionsDeclarationReserved-      , "repeated" .=: msg.extensionRangeOptionsDeclarationRepeated-      ]--instance Aeson.FromJSON ExtensionRangeOptions'Declaration where-  parseJSON = Aeson.withObject "ExtensionRangeOptions'Declaration" $ \obj -> do-    fld_extensionRangeOptionsDeclarationNumber <- parseFieldMaybe obj "number"-    fld_extensionRangeOptionsDeclarationFullName <- parseFieldMaybe obj "fullName"-    fld_extensionRangeOptionsDeclarationType <- parseFieldMaybe obj "type"-    fld_extensionRangeOptionsDeclarationReserved <- parseFieldMaybe obj "reserved"-    fld_extensionRangeOptionsDeclarationRepeated <- parseFieldMaybe obj "repeated"-    pure defaultExtensionRangeOptions'Declaration-      { extensionRangeOptionsDeclarationNumber = maybe (extensionRangeOptionsDeclarationNumber defaultExtensionRangeOptions'Declaration) id fld_extensionRangeOptionsDeclarationNumber-      , extensionRangeOptionsDeclarationFullName = maybe (extensionRangeOptionsDeclarationFullName defaultExtensionRangeOptions'Declaration) id fld_extensionRangeOptionsDeclarationFullName-      , extensionRangeOptionsDeclarationType = maybe (extensionRangeOptionsDeclarationType defaultExtensionRangeOptions'Declaration) id fld_extensionRangeOptionsDeclarationType-      , extensionRangeOptionsDeclarationReserved = maybe (extensionRangeOptionsDeclarationReserved defaultExtensionRangeOptions'Declaration) id fld_extensionRangeOptionsDeclarationReserved-      , extensionRangeOptionsDeclarationRepeated = maybe (extensionRangeOptionsDeclarationRepeated defaultExtensionRangeOptions'Declaration) id fld_extensionRangeOptionsDeclarationRepeated-      }--instance Hashable ExtensionRangeOptions'Declaration where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.extensionRangeOptionsDeclarationNumber) msg.extensionRangeOptionsDeclarationFullName) msg.extensionRangeOptionsDeclarationType) msg.extensionRangeOptionsDeclarationReserved) msg.extensionRangeOptionsDeclarationRepeated--instance Proto.Extension.HasExtensions ExtensionRangeOptions'Declaration where-  messageUnknownFields = extensionRangeOptionsDeclarationUnknownFields-  setMessageUnknownFields !ufs msg = msg { extensionRangeOptionsDeclarationUnknownFields = ufs }--instance Semigroup ExtensionRangeOptions'Declaration where-  a <> b = ExtensionRangeOptions'Declaration-    { extensionRangeOptionsDeclarationNumber = case b.extensionRangeOptionsDeclarationNumber of { Nothing -> a.extensionRangeOptionsDeclarationNumber; x -> x }-    , extensionRangeOptionsDeclarationFullName = case b.extensionRangeOptionsDeclarationFullName of { Nothing -> a.extensionRangeOptionsDeclarationFullName; x -> x }-    , extensionRangeOptionsDeclarationType = case b.extensionRangeOptionsDeclarationType of { Nothing -> a.extensionRangeOptionsDeclarationType; x -> x }-    , extensionRangeOptionsDeclarationReserved = case b.extensionRangeOptionsDeclarationReserved of { Nothing -> a.extensionRangeOptionsDeclarationReserved; x -> x }-    , extensionRangeOptionsDeclarationRepeated = case b.extensionRangeOptionsDeclarationRepeated of { Nothing -> a.extensionRangeOptionsDeclarationRepeated; x -> x }-    , extensionRangeOptionsDeclarationUnknownFields = a.extensionRangeOptionsDeclarationUnknownFields <> b.extensionRangeOptionsDeclarationUnknownFields-    }--instance Monoid ExtensionRangeOptions'Declaration where-  mempty = defaultExtensionRangeOptions'Declaration---- | The verification state of the extension range.-data ExtensionRangeOptions'VerificationState-  = ExtensionRangeOptions'VerificationState'Declaration-    -- ^ All the extensions of the range must be declared.-  | ExtensionRangeOptions'VerificationState'Unverified-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumExtensionRangeOptions'VerificationState :: ExtensionRangeOptions'VerificationState -> Int-toProtoEnumExtensionRangeOptions'VerificationState ExtensionRangeOptions'VerificationState'Declaration = 0-toProtoEnumExtensionRangeOptions'VerificationState ExtensionRangeOptions'VerificationState'Unverified = 1--fromProtoEnumExtensionRangeOptions'VerificationState :: Int -> Maybe ExtensionRangeOptions'VerificationState-fromProtoEnumExtensionRangeOptions'VerificationState 0 = Just ExtensionRangeOptions'VerificationState'Declaration-fromProtoEnumExtensionRangeOptions'VerificationState 1 = Just ExtensionRangeOptions'VerificationState'Unverified-fromProtoEnumExtensionRangeOptions'VerificationState _ = Nothing--instance MessageEncode ExtensionRangeOptions'VerificationState where-  buildSized _ = mempty-instance MessageDecode ExtensionRangeOptions'VerificationState where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON ExtensionRangeOptions'VerificationState where-  toJSON ExtensionRangeOptions'VerificationState'Declaration = Aeson.String "DECLARATION"-  toJSON ExtensionRangeOptions'VerificationState'Unverified = Aeson.String "UNVERIFIED"--instance Aeson.FromJSON ExtensionRangeOptions'VerificationState where-  parseJSON = \case-    Aeson.String "DECLARATION" -> pure ExtensionRangeOptions'VerificationState'Declaration-    Aeson.String "UNVERIFIED" -> pure ExtensionRangeOptions'VerificationState'Unverified-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for ExtensionRangeOptions'VerificationState"--instance Hashable ExtensionRangeOptions'VerificationState where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumExtensionRangeOptions'VerificationState x)--defaultExtensionRangeOptions :: ExtensionRangeOptions-defaultExtensionRangeOptions = ExtensionRangeOptions-  { extensionRangeOptionsUninterpretedOption = V.empty-  , extensionRangeOptionsDeclaration = V.empty-  , extensionRangeOptionsFeatures = Nothing-  , extensionRangeOptionsVerification = Nothing-  , extensionRangeOptionsUnknownFields = []-  }--instance MessageEncode ExtensionRangeOptions where-  buildSized msg =-    V.foldl' (\acc v -> acc <> archSubmessage 7994 (buildSized v)) mempty msg.extensionRangeOptionsUninterpretedOption-    <> V.foldl' (\acc v -> acc <> archSubmessage 18 (buildSized v)) mempty msg.extensionRangeOptionsDeclaration-    <> (maybe mempty (\v -> archSubmessage 402 (buildSized v)) msg.extensionRangeOptionsFeatures)-    <> (maybe mempty (\v -> archVarint 24 (fromIntegral (toProtoEnumExtensionRangeOptions'VerificationState v))) msg.extensionRangeOptionsVerification)-    <> encodeUnknownFieldsSized msg.extensionRangeOptionsUnknownFields--instance MessageDecode ExtensionRangeOptions where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultExtensionRangeOptions emptyGrowList emptyGrowList-    where-      stage_0 msg gl_0 gl_1 =-        inOrderStage-          0x3eba-          0xffff-          2-          decodeFieldMessage-          (\v -> stage_0 msg (snocGrowList gl_0 v) gl_1)-          (pure (case msg.extensionRangeOptionsUnknownFields of { [] -> msg { extensionRangeOptionsUninterpretedOption = growListToVector gl_0, extensionRangeOptionsDeclaration = growListToVector gl_1 }; _ -> msg { extensionRangeOptionsUninterpretedOption = growListToVector gl_0, extensionRangeOptionsDeclaration = growListToVector gl_1, extensionRangeOptionsUnknownFields = reverse (msg.extensionRangeOptionsUnknownFields) } }))-          (loop msg gl_0 gl_1)-      stage_1 msg gl_0 gl_1 =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_1 msg gl_0 (snocGrowList gl_1 v))-          (pure (case msg.extensionRangeOptionsUnknownFields of { [] -> msg { extensionRangeOptionsUninterpretedOption = growListToVector gl_0, extensionRangeOptionsDeclaration = growListToVector gl_1 }; _ -> msg { extensionRangeOptionsUninterpretedOption = growListToVector gl_0, extensionRangeOptionsDeclaration = growListToVector gl_1, extensionRangeOptionsUnknownFields = reverse (msg.extensionRangeOptionsUnknownFields) } }))-          (loop msg gl_0 gl_1)-      stage_2 msg gl_0 gl_1 =-        inOrderStage-          0x392-          0xffff-          2-          decodeFieldMessage-          (\v -> stage_3 (msg { extensionRangeOptionsFeatures = (Just v)}) gl_0 gl_1)-          (pure (case msg.extensionRangeOptionsUnknownFields of { [] -> msg { extensionRangeOptionsUninterpretedOption = growListToVector gl_0, extensionRangeOptionsDeclaration = growListToVector gl_1 }; _ -> msg { extensionRangeOptionsUninterpretedOption = growListToVector gl_0, extensionRangeOptionsDeclaration = growListToVector gl_1, extensionRangeOptionsUnknownFields = reverse (msg.extensionRangeOptionsUnknownFields) } }))-          (loop msg gl_0 gl_1)-      stage_3 msg gl_0 gl_1 =-        inOrderStage1-          (0x18 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> loop (msg { extensionRangeOptionsVerification = (Just v)}) gl_0 gl_1)-          (pure (case msg.extensionRangeOptionsUnknownFields of { [] -> msg { extensionRangeOptionsUninterpretedOption = growListToVector gl_0, extensionRangeOptionsDeclaration = growListToVector gl_1 }; _ -> msg { extensionRangeOptionsUninterpretedOption = growListToVector gl_0, extensionRangeOptionsDeclaration = growListToVector gl_1, extensionRangeOptionsUnknownFields = reverse (msg.extensionRangeOptionsUnknownFields) } }))-          (loop msg gl_0 gl_1)-      loop msg gl_0 gl_1 = withTagM-        (pure (case msg.extensionRangeOptionsUnknownFields of { [] -> msg { extensionRangeOptionsUninterpretedOption = growListToVector gl_0, extensionRangeOptionsDeclaration = growListToVector gl_1 }; _ -> msg { extensionRangeOptionsUninterpretedOption = growListToVector gl_0, extensionRangeOptionsDeclaration = growListToVector gl_1, extensionRangeOptionsUnknownFields = reverse (msg.extensionRangeOptionsUnknownFields) } }))-        (\fn wt -> case fn of-          999 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v) gl_1-          2 -> do-            v <- decodeFieldMessage-            loop msg gl_0 (snocGrowList gl_1 v)-          50 -> do-            v <- decodeFieldMessage-            loop (msg { extensionRangeOptionsFeatures = (Just v)}) gl_0 gl_1-          3 -> do-            v <- decodeFieldEnum-            loop (msg { extensionRangeOptionsVerification = (Just v)}) gl_0 gl_1-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { extensionRangeOptionsUnknownFields = (uf : msg.extensionRangeOptionsUnknownFields)}) gl_0 gl_1)---- | Field descriptors for 'ExtensionRangeOptions', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-extensionRangeOptionsFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor ExtensionRangeOptions)-extensionRangeOptionsFieldDescriptors =-  IntMap.fromList-    [ (999, SomeField FieldDescriptor-        { fdName = "uninterpreted_option"-        , fdNumber = 999-        , fdTypeDesc = MessageType "UninterpretedOption"-        , fdLabel = LabelRepeated-        , fdGet = extensionRangeOptionsUninterpretedOption-        , fdSet = \v m -> m { extensionRangeOptionsUninterpretedOption = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "declaration"-        , fdNumber = 2-        , fdTypeDesc = MessageType "Declaration"-        , fdLabel = LabelRepeated-        , fdGet = extensionRangeOptionsDeclaration-        , fdSet = \v m -> m { extensionRangeOptionsDeclaration = v }-        })-    , (50, SomeField FieldDescriptor-        { fdName = "features"-        , fdNumber = 50-        , fdTypeDesc = MessageType "FeatureSet"-        , fdLabel = LabelOptional-        , fdGet = extensionRangeOptionsFeatures-        , fdSet = \v m -> m { extensionRangeOptionsFeatures = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "verification"-        , fdNumber = 3-        , fdTypeDesc = MessageType "VerificationState"-        , fdLabel = LabelOptional-        , fdGet = extensionRangeOptionsVerification-        , fdSet = \v m -> m { extensionRangeOptionsVerification = v }-        })-    ]--instance ProtoMessage ExtensionRangeOptions where-  protoMessageName _ = "google.protobuf.ExtensionRangeOptions"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultExtensionRangeOptions-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = extensionRangeOptionsFieldDescriptors--instance IsMessage ExtensionRangeOptions--instance Aeson.ToJSON ExtensionRangeOptions where-  toJSON msg = jsonObject-      [ "uninterpretedOption" .=: msg.extensionRangeOptionsUninterpretedOption-      , "declaration" .=: msg.extensionRangeOptionsDeclaration-      , "features" .=: msg.extensionRangeOptionsFeatures-      , "verification" .=: msg.extensionRangeOptionsVerification-      ]--instance Aeson.FromJSON ExtensionRangeOptions where-  parseJSON = Aeson.withObject "ExtensionRangeOptions" $ \obj -> do-    fld_extensionRangeOptionsUninterpretedOption <- parseFieldMaybe obj "uninterpretedOption"-    fld_extensionRangeOptionsDeclaration <- parseFieldMaybe obj "declaration"-    fld_extensionRangeOptionsFeatures <- parseFieldMaybe obj "features"-    fld_extensionRangeOptionsVerification <- parseFieldMaybe obj "verification"-    pure defaultExtensionRangeOptions-      { extensionRangeOptionsUninterpretedOption = maybe (extensionRangeOptionsUninterpretedOption defaultExtensionRangeOptions) id fld_extensionRangeOptionsUninterpretedOption-      , extensionRangeOptionsDeclaration = maybe (extensionRangeOptionsDeclaration defaultExtensionRangeOptions) id fld_extensionRangeOptionsDeclaration-      , extensionRangeOptionsFeatures = maybe (extensionRangeOptionsFeatures defaultExtensionRangeOptions) id fld_extensionRangeOptionsFeatures-      , extensionRangeOptionsVerification = maybe (extensionRangeOptionsVerification defaultExtensionRangeOptions) id fld_extensionRangeOptionsVerification-      }--instance Hashable ExtensionRangeOptions where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (V.foldl' hashWithSalt (V.foldl' hashWithSalt (salt) msg.extensionRangeOptionsUninterpretedOption) msg.extensionRangeOptionsDeclaration) msg.extensionRangeOptionsFeatures) msg.extensionRangeOptionsVerification--instance Proto.Extension.HasExtensions ExtensionRangeOptions where-  messageUnknownFields = extensionRangeOptionsUnknownFields-  setMessageUnknownFields !ufs msg = msg { extensionRangeOptionsUnknownFields = ufs }--instance Semigroup ExtensionRangeOptions where-  a <> b = ExtensionRangeOptions-    { extensionRangeOptionsUninterpretedOption = a.extensionRangeOptionsUninterpretedOption <> b.extensionRangeOptionsUninterpretedOption-    , extensionRangeOptionsDeclaration = a.extensionRangeOptionsDeclaration <> b.extensionRangeOptionsDeclaration-    , extensionRangeOptionsFeatures = case b.extensionRangeOptionsFeatures of { Nothing -> a.extensionRangeOptionsFeatures; x -> x }-    , extensionRangeOptionsVerification = case b.extensionRangeOptionsVerification of { Nothing -> a.extensionRangeOptionsVerification; x -> x }-    , extensionRangeOptionsUnknownFields = a.extensionRangeOptionsUnknownFields <> b.extensionRangeOptionsUnknownFields-    }--instance Monoid ExtensionRangeOptions where-  mempty = defaultExtensionRangeOptions---- | Describes a field within a message.-data FieldDescriptorProto = FieldDescriptorProto-  { fieldDescriptorProtoName :: !(Maybe Text)-  , fieldDescriptorProtoNumber :: !(Maybe Int32)-  , fieldDescriptorProtoLabel :: !(Maybe FieldDescriptorProto'Label)-  , fieldDescriptorProtoType :: !(Maybe FieldDescriptorProto'Type)-    -- ^ If type_name is set, this need not be set.  If both this and type_name-    -- are set, this must be one of TYPE_ENUM, TYPE_MESSAGE or TYPE_GROUP.-  , fieldDescriptorProtoTypeName :: !(Maybe Text)-    -- ^ For message and enum types, this is the name of the type.  If the name-    -- starts with a '.', it is fully-qualified.  Otherwise, C++-like scoping-    -- rules are used to find the type (i.e. first the nested types within this-    -- message are searched, then within the parent, on up to the root-    -- namespace).-  , fieldDescriptorProtoExtendee :: !(Maybe Text)-    -- ^ For extensions, this is the name of the type being extended.  It is-    -- resolved in the same manner as type_name.-  , fieldDescriptorProtoDefaultValue :: !(Maybe Text)-    -- ^ For numeric types, contains the original text representation of the value.-    -- For booleans, "true" or "false".-    -- For strings, contains the default text contents (not escaped in any way).-    -- For bytes, contains the C escaped value.  All bytes >= 128 are escaped.-  , fieldDescriptorProtoOneofIndex :: !(Maybe Int32)-    -- ^ If set, gives the index of a oneof in the containing type's oneof_decl-    -- list.  This field is a member of that oneof.-  , fieldDescriptorProtoJsonName :: !(Maybe Text)-    -- ^ JSON name of this field. The value is set by protocol compiler. If the-    -- user has set a "json_name" option on this field, that option's value-    -- will be used. Otherwise, it's deduced from the field's name by converting-    -- it to camelCase.-  , fieldDescriptorProtoOptions :: !(Maybe FieldOptions)-  , fieldDescriptorProtoProto3Optional :: !(Maybe Bool)-    -- ^ If true, this is a proto3 "optional". When a proto3 field is optional, it-    -- tracks presence regardless of field type.-    -- -    -- When proto3_optional is true, this field must belong to a oneof to signal-    -- to old proto3 clients that presence is tracked for this field. This oneof-    -- is known as a "synthetic" oneof, and this field must be its sole member-    -- (each proto3 optional field gets its own synthetic oneof). Synthetic oneofs-    -- exist in the descriptor only, and do not generate any API. Synthetic oneofs-    -- must be ordered after all "real" oneofs.-    -- -    -- For message fields, proto3_optional doesn't create any semantic change,-    -- since non-repeated message fields always track presence. However it still-    -- indicates the semantic detail of whether the user wrote "optional" or not.-    -- This can be useful for round-tripping the .proto file. For consistency we-    -- give message fields a synthetic oneof also, even though it is not required-    -- to track presence. This is especially important because the parser can't-    -- tell if a field is a message or an enum, so it must always create a-    -- synthetic oneof.-    -- -    -- Proto2 optional fields do not set this flag, because they already indicate-    -- optional with `LABEL_OPTIONAL`.-  , fieldDescriptorProtoUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--data FieldDescriptorProto'Type-  = FieldDescriptorProto'Type'TypeDouble-    -- ^ 0 is reserved for errors.-    -- Order is weird for historical reasons.-  | FieldDescriptorProto'Type'TypeFloat-  | FieldDescriptorProto'Type'TypeInt64-    -- ^ Not ZigZag encoded.  Negative numbers take 10 bytes.  Use TYPE_SINT64 if-    -- negative values are likely.-  | FieldDescriptorProto'Type'TypeUint64-  | FieldDescriptorProto'Type'TypeInt32-    -- ^ Not ZigZag encoded.  Negative numbers take 10 bytes.  Use TYPE_SINT32 if-    -- negative values are likely.-  | FieldDescriptorProto'Type'TypeFixed64-  | FieldDescriptorProto'Type'TypeFixed32-  | FieldDescriptorProto'Type'TypeBool-  | FieldDescriptorProto'Type'TypeString-  | FieldDescriptorProto'Type'TypeGroup-    -- ^ Tag-delimited aggregate.-    -- Group type is deprecated and not supported after google.protobuf. However, Proto3-    -- implementations should still be able to parse the group wire format and-    -- treat group fields as unknown fields.  In Editions, the group wire format-    -- can be enabled via the `message_encoding` feature.-  | FieldDescriptorProto'Type'TypeMessage-  | FieldDescriptorProto'Type'TypeBytes-    -- ^ New in version 2.-  | FieldDescriptorProto'Type'TypeUint32-  | FieldDescriptorProto'Type'TypeEnum-  | FieldDescriptorProto'Type'TypeSfixed32-  | FieldDescriptorProto'Type'TypeSfixed64-  | FieldDescriptorProto'Type'TypeSint32-  | FieldDescriptorProto'Type'TypeSint64-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumFieldDescriptorProto'Type :: FieldDescriptorProto'Type -> Int-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeDouble = 1-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeFloat = 2-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeInt64 = 3-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeUint64 = 4-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeInt32 = 5-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeFixed64 = 6-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeFixed32 = 7-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeBool = 8-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeString = 9-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeGroup = 10-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeMessage = 11-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeBytes = 12-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeUint32 = 13-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeEnum = 14-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeSfixed32 = 15-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeSfixed64 = 16-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeSint32 = 17-toProtoEnumFieldDescriptorProto'Type FieldDescriptorProto'Type'TypeSint64 = 18--fromProtoEnumFieldDescriptorProto'Type :: Int -> Maybe FieldDescriptorProto'Type-fromProtoEnumFieldDescriptorProto'Type 1 = Just FieldDescriptorProto'Type'TypeDouble-fromProtoEnumFieldDescriptorProto'Type 2 = Just FieldDescriptorProto'Type'TypeFloat-fromProtoEnumFieldDescriptorProto'Type 3 = Just FieldDescriptorProto'Type'TypeInt64-fromProtoEnumFieldDescriptorProto'Type 4 = Just FieldDescriptorProto'Type'TypeUint64-fromProtoEnumFieldDescriptorProto'Type 5 = Just FieldDescriptorProto'Type'TypeInt32-fromProtoEnumFieldDescriptorProto'Type 6 = Just FieldDescriptorProto'Type'TypeFixed64-fromProtoEnumFieldDescriptorProto'Type 7 = Just FieldDescriptorProto'Type'TypeFixed32-fromProtoEnumFieldDescriptorProto'Type 8 = Just FieldDescriptorProto'Type'TypeBool-fromProtoEnumFieldDescriptorProto'Type 9 = Just FieldDescriptorProto'Type'TypeString-fromProtoEnumFieldDescriptorProto'Type 10 = Just FieldDescriptorProto'Type'TypeGroup-fromProtoEnumFieldDescriptorProto'Type 11 = Just FieldDescriptorProto'Type'TypeMessage-fromProtoEnumFieldDescriptorProto'Type 12 = Just FieldDescriptorProto'Type'TypeBytes-fromProtoEnumFieldDescriptorProto'Type 13 = Just FieldDescriptorProto'Type'TypeUint32-fromProtoEnumFieldDescriptorProto'Type 14 = Just FieldDescriptorProto'Type'TypeEnum-fromProtoEnumFieldDescriptorProto'Type 15 = Just FieldDescriptorProto'Type'TypeSfixed32-fromProtoEnumFieldDescriptorProto'Type 16 = Just FieldDescriptorProto'Type'TypeSfixed64-fromProtoEnumFieldDescriptorProto'Type 17 = Just FieldDescriptorProto'Type'TypeSint32-fromProtoEnumFieldDescriptorProto'Type 18 = Just FieldDescriptorProto'Type'TypeSint64-fromProtoEnumFieldDescriptorProto'Type _ = Nothing--instance MessageEncode FieldDescriptorProto'Type where-  buildSized _ = mempty-instance MessageDecode FieldDescriptorProto'Type where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON FieldDescriptorProto'Type where-  toJSON FieldDescriptorProto'Type'TypeDouble = Aeson.String "TYPE_DOUBLE"-  toJSON FieldDescriptorProto'Type'TypeFloat = Aeson.String "TYPE_FLOAT"-  toJSON FieldDescriptorProto'Type'TypeInt64 = Aeson.String "TYPE_INT64"-  toJSON FieldDescriptorProto'Type'TypeUint64 = Aeson.String "TYPE_UINT64"-  toJSON FieldDescriptorProto'Type'TypeInt32 = Aeson.String "TYPE_INT32"-  toJSON FieldDescriptorProto'Type'TypeFixed64 = Aeson.String "TYPE_FIXED64"-  toJSON FieldDescriptorProto'Type'TypeFixed32 = Aeson.String "TYPE_FIXED32"-  toJSON FieldDescriptorProto'Type'TypeBool = Aeson.String "TYPE_BOOL"-  toJSON FieldDescriptorProto'Type'TypeString = Aeson.String "TYPE_STRING"-  toJSON FieldDescriptorProto'Type'TypeGroup = Aeson.String "TYPE_GROUP"-  toJSON FieldDescriptorProto'Type'TypeMessage = Aeson.String "TYPE_MESSAGE"-  toJSON FieldDescriptorProto'Type'TypeBytes = Aeson.String "TYPE_BYTES"-  toJSON FieldDescriptorProto'Type'TypeUint32 = Aeson.String "TYPE_UINT32"-  toJSON FieldDescriptorProto'Type'TypeEnum = Aeson.String "TYPE_ENUM"-  toJSON FieldDescriptorProto'Type'TypeSfixed32 = Aeson.String "TYPE_SFIXED32"-  toJSON FieldDescriptorProto'Type'TypeSfixed64 = Aeson.String "TYPE_SFIXED64"-  toJSON FieldDescriptorProto'Type'TypeSint32 = Aeson.String "TYPE_SINT32"-  toJSON FieldDescriptorProto'Type'TypeSint64 = Aeson.String "TYPE_SINT64"--instance Aeson.FromJSON FieldDescriptorProto'Type where-  parseJSON = \case-    Aeson.String "TYPE_DOUBLE" -> pure FieldDescriptorProto'Type'TypeDouble-    Aeson.String "TYPE_FLOAT" -> pure FieldDescriptorProto'Type'TypeFloat-    Aeson.String "TYPE_INT64" -> pure FieldDescriptorProto'Type'TypeInt64-    Aeson.String "TYPE_UINT64" -> pure FieldDescriptorProto'Type'TypeUint64-    Aeson.String "TYPE_INT32" -> pure FieldDescriptorProto'Type'TypeInt32-    Aeson.String "TYPE_FIXED64" -> pure FieldDescriptorProto'Type'TypeFixed64-    Aeson.String "TYPE_FIXED32" -> pure FieldDescriptorProto'Type'TypeFixed32-    Aeson.String "TYPE_BOOL" -> pure FieldDescriptorProto'Type'TypeBool-    Aeson.String "TYPE_STRING" -> pure FieldDescriptorProto'Type'TypeString-    Aeson.String "TYPE_GROUP" -> pure FieldDescriptorProto'Type'TypeGroup-    Aeson.String "TYPE_MESSAGE" -> pure FieldDescriptorProto'Type'TypeMessage-    Aeson.String "TYPE_BYTES" -> pure FieldDescriptorProto'Type'TypeBytes-    Aeson.String "TYPE_UINT32" -> pure FieldDescriptorProto'Type'TypeUint32-    Aeson.String "TYPE_ENUM" -> pure FieldDescriptorProto'Type'TypeEnum-    Aeson.String "TYPE_SFIXED32" -> pure FieldDescriptorProto'Type'TypeSfixed32-    Aeson.String "TYPE_SFIXED64" -> pure FieldDescriptorProto'Type'TypeSfixed64-    Aeson.String "TYPE_SINT32" -> pure FieldDescriptorProto'Type'TypeSint32-    Aeson.String "TYPE_SINT64" -> pure FieldDescriptorProto'Type'TypeSint64-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for FieldDescriptorProto'Type"--instance Hashable FieldDescriptorProto'Type where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumFieldDescriptorProto'Type x)--data FieldDescriptorProto'Label-  = FieldDescriptorProto'Label'LabelOptional-    -- ^ 0 is reserved for errors-  | FieldDescriptorProto'Label'LabelRepeated-  | FieldDescriptorProto'Label'LabelRequired-    -- ^ The required label is only allowed in google.protobuf.  In proto3 and Editions-    -- it's explicitly prohibited.  In Editions, the `field_presence` feature-    -- can be used to get this behavior.-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumFieldDescriptorProto'Label :: FieldDescriptorProto'Label -> Int-toProtoEnumFieldDescriptorProto'Label FieldDescriptorProto'Label'LabelOptional = 1-toProtoEnumFieldDescriptorProto'Label FieldDescriptorProto'Label'LabelRepeated = 3-toProtoEnumFieldDescriptorProto'Label FieldDescriptorProto'Label'LabelRequired = 2--fromProtoEnumFieldDescriptorProto'Label :: Int -> Maybe FieldDescriptorProto'Label-fromProtoEnumFieldDescriptorProto'Label 1 = Just FieldDescriptorProto'Label'LabelOptional-fromProtoEnumFieldDescriptorProto'Label 3 = Just FieldDescriptorProto'Label'LabelRepeated-fromProtoEnumFieldDescriptorProto'Label 2 = Just FieldDescriptorProto'Label'LabelRequired-fromProtoEnumFieldDescriptorProto'Label _ = Nothing--instance MessageEncode FieldDescriptorProto'Label where-  buildSized _ = mempty-instance MessageDecode FieldDescriptorProto'Label where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON FieldDescriptorProto'Label where-  toJSON FieldDescriptorProto'Label'LabelOptional = Aeson.String "LABEL_OPTIONAL"-  toJSON FieldDescriptorProto'Label'LabelRepeated = Aeson.String "LABEL_REPEATED"-  toJSON FieldDescriptorProto'Label'LabelRequired = Aeson.String "LABEL_REQUIRED"--instance Aeson.FromJSON FieldDescriptorProto'Label where-  parseJSON = \case-    Aeson.String "LABEL_OPTIONAL" -> pure FieldDescriptorProto'Label'LabelOptional-    Aeson.String "LABEL_REPEATED" -> pure FieldDescriptorProto'Label'LabelRepeated-    Aeson.String "LABEL_REQUIRED" -> pure FieldDescriptorProto'Label'LabelRequired-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for FieldDescriptorProto'Label"--instance Hashable FieldDescriptorProto'Label where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumFieldDescriptorProto'Label x)--defaultFieldDescriptorProto :: FieldDescriptorProto-defaultFieldDescriptorProto = FieldDescriptorProto-  { fieldDescriptorProtoName = Nothing-  , fieldDescriptorProtoNumber = Nothing-  , fieldDescriptorProtoLabel = Nothing-  , fieldDescriptorProtoType = Nothing-  , fieldDescriptorProtoTypeName = Nothing-  , fieldDescriptorProtoExtendee = Nothing-  , fieldDescriptorProtoDefaultValue = Nothing-  , fieldDescriptorProtoOneofIndex = Nothing-  , fieldDescriptorProtoJsonName = Nothing-  , fieldDescriptorProtoOptions = Nothing-  , fieldDescriptorProtoProto3Optional = Nothing-  , fieldDescriptorProtoUnknownFields = []-  }--instance MessageEncode FieldDescriptorProto where-  buildSized msg =-    (maybe mempty (\v -> archString 10 v) msg.fieldDescriptorProtoName)-    <> (maybe mempty (\v -> archVarint 24 (fromIntegral v)) msg.fieldDescriptorProtoNumber)-    <> (maybe mempty (\v -> archVarint 32 (fromIntegral (toProtoEnumFieldDescriptorProto'Label v))) msg.fieldDescriptorProtoLabel)-    <> (maybe mempty (\v -> archVarint 40 (fromIntegral (toProtoEnumFieldDescriptorProto'Type v))) msg.fieldDescriptorProtoType)-    <> (maybe mempty (\v -> archString 50 v) msg.fieldDescriptorProtoTypeName)-    <> (maybe mempty (\v -> archString 18 v) msg.fieldDescriptorProtoExtendee)-    <> (maybe mempty (\v -> archString 58 v) msg.fieldDescriptorProtoDefaultValue)-    <> (maybe mempty (\v -> archVarint 72 (fromIntegral v)) msg.fieldDescriptorProtoOneofIndex)-    <> (maybe mempty (\v -> archString 82 v) msg.fieldDescriptorProtoJsonName)-    <> (maybe mempty (\v -> archSubmessage 66 (buildSized v)) msg.fieldDescriptorProtoOptions)-    <> (maybe mempty (\v -> archBool 136 v) msg.fieldDescriptorProtoProto3Optional)-    <> encodeUnknownFieldsSized msg.fieldDescriptorProtoUnknownFields--instance MessageDecode FieldDescriptorProto where-  messageDecoder = stage_0 defaultFieldDescriptorProto-    where-      stage_0 msg =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_1 (msg { fieldDescriptorProtoName = (Just v)}))-          (pure (case msg.fieldDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { fieldDescriptorProtoUnknownFields = reverse (msg.fieldDescriptorProtoUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x18 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_2 (msg { fieldDescriptorProtoNumber = (Just v)}))-          (pure (case msg.fieldDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { fieldDescriptorProtoUnknownFields = reverse (msg.fieldDescriptorProtoUnknownFields) } }))-          (loop msg)-      stage_2 msg =-        inOrderStage1-          (0x20 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> stage_3 (msg { fieldDescriptorProtoLabel = (Just v)}))-          (pure (case msg.fieldDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { fieldDescriptorProtoUnknownFields = reverse (msg.fieldDescriptorProtoUnknownFields) } }))-          (loop msg)-      stage_3 msg =-        inOrderStage1-          (0x28 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> stage_4 (msg { fieldDescriptorProtoType = (Just v)}))-          (pure (case msg.fieldDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { fieldDescriptorProtoUnknownFields = reverse (msg.fieldDescriptorProtoUnknownFields) } }))-          (loop msg)-      stage_4 msg =-        inOrderStage1-          (0x32 :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_5 (msg { fieldDescriptorProtoTypeName = (Just v)}))-          (pure (case msg.fieldDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { fieldDescriptorProtoUnknownFields = reverse (msg.fieldDescriptorProtoUnknownFields) } }))-          (loop msg)-      stage_5 msg =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_6 (msg { fieldDescriptorProtoExtendee = (Just v)}))-          (pure (case msg.fieldDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { fieldDescriptorProtoUnknownFields = reverse (msg.fieldDescriptorProtoUnknownFields) } }))-          (loop msg)-      stage_6 msg =-        inOrderStage1-          (0x3a :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_7 (msg { fieldDescriptorProtoDefaultValue = (Just v)}))-          (pure (case msg.fieldDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { fieldDescriptorProtoUnknownFields = reverse (msg.fieldDescriptorProtoUnknownFields) } }))-          (loop msg)-      stage_7 msg =-        inOrderStage1-          (0x48 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> loop (msg { fieldDescriptorProtoOneofIndex = (Just v)}))-          (pure (case msg.fieldDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { fieldDescriptorProtoUnknownFields = reverse (msg.fieldDescriptorProtoUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.fieldDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { fieldDescriptorProtoUnknownFields = reverse (msg.fieldDescriptorProtoUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { fieldDescriptorProtoName = (Just v)})-          3 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { fieldDescriptorProtoNumber = (Just v)})-          4 -> do-            v <- decodeFieldEnum-            loop (msg { fieldDescriptorProtoLabel = (Just v)})-          5 -> do-            v <- decodeFieldEnum-            loop (msg { fieldDescriptorProtoType = (Just v)})-          6 -> do-            v <- decodeFieldString-            loop (msg { fieldDescriptorProtoTypeName = (Just v)})-          2 -> do-            v <- decodeFieldString-            loop (msg { fieldDescriptorProtoExtendee = (Just v)})-          7 -> do-            v <- decodeFieldString-            loop (msg { fieldDescriptorProtoDefaultValue = (Just v)})-          9 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { fieldDescriptorProtoOneofIndex = (Just v)})-          10 -> do-            v <- decodeFieldString-            loop (msg { fieldDescriptorProtoJsonName = (Just v)})-          8 -> do-            v <- decodeFieldMessage-            loop (msg { fieldDescriptorProtoOptions = (Just v)})-          17 -> do-            v <- decodeFieldBool-            loop (msg { fieldDescriptorProtoProto3Optional = (Just v)})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { fieldDescriptorProtoUnknownFields = (uf : msg.fieldDescriptorProtoUnknownFields)}))---- | Field descriptors for 'FieldDescriptorProto', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-fieldDescriptorProtoFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor FieldDescriptorProto)-fieldDescriptorProtoFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "name"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fieldDescriptorProtoName-        , fdSet = \v m -> m { fieldDescriptorProtoName = v }-        }), (3, SomeField FieldDescriptor-        { fdName = "number"-        , fdNumber = 3-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = fieldDescriptorProtoNumber-        , fdSet = \v m -> m { fieldDescriptorProtoNumber = v }-        })-    , (4, SomeField FieldDescriptor-        { fdName = "label"-        , fdNumber = 4-        , fdTypeDesc = MessageType "Label"-        , fdLabel = LabelOptional-        , fdGet = fieldDescriptorProtoLabel-        , fdSet = \v m -> m { fieldDescriptorProtoLabel = v }-        })-    , (5, SomeField FieldDescriptor-        { fdName = "type"-        , fdNumber = 5-        , fdTypeDesc = MessageType "Type"-        , fdLabel = LabelOptional-        , fdGet = fieldDescriptorProtoType-        , fdSet = \v m -> m { fieldDescriptorProtoType = v }-        })-    , (6, SomeField FieldDescriptor-        { fdName = "type_name"-        , fdNumber = 6-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fieldDescriptorProtoTypeName-        , fdSet = \v m -> m { fieldDescriptorProtoTypeName = v }-        })-    , (2, SomeField FieldDescriptor-        { fdName = "extendee"-        , fdNumber = 2-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fieldDescriptorProtoExtendee-        , fdSet = \v m -> m { fieldDescriptorProtoExtendee = v }-        })-    , (7, SomeField FieldDescriptor-        { fdName = "default_value"-        , fdNumber = 7-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fieldDescriptorProtoDefaultValue-        , fdSet = \v m -> m { fieldDescriptorProtoDefaultValue = v }-        })-    , (9, SomeField FieldDescriptor-        { fdName = "oneof_index"-        , fdNumber = 9-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = fieldDescriptorProtoOneofIndex-        , fdSet = \v m -> m { fieldDescriptorProtoOneofIndex = v }-        })-    , (10, SomeField FieldDescriptor-        { fdName = "json_name"-        , fdNumber = 10-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fieldDescriptorProtoJsonName-        , fdSet = \v m -> m { fieldDescriptorProtoJsonName = v }-        })-    , (8, SomeField FieldDescriptor-        { fdName = "options"-        , fdNumber = 8-        , fdTypeDesc = MessageType "FieldOptions"-        , fdLabel = LabelOptional-        , fdGet = fieldDescriptorProtoOptions-        , fdSet = \v m -> m { fieldDescriptorProtoOptions = v }-        })-    , (17, SomeField FieldDescriptor-        { fdName = "proto3_optional"-        , fdNumber = 17-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = fieldDescriptorProtoProto3Optional-        , fdSet = \v m -> m { fieldDescriptorProtoProto3Optional = v }-        })-    ]--instance ProtoMessage FieldDescriptorProto where-  protoMessageName _ = "google.protobuf.FieldDescriptorProto"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultFieldDescriptorProto-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = fieldDescriptorProtoFieldDescriptors--instance IsMessage FieldDescriptorProto--instance Aeson.ToJSON FieldDescriptorProto where-  toJSON msg = jsonObject-      [ "name" .=: msg.fieldDescriptorProtoName-      , "number" .=: msg.fieldDescriptorProtoNumber-      , "label" .=: msg.fieldDescriptorProtoLabel-      , "type" .=: msg.fieldDescriptorProtoType-      , "typeName" .=: msg.fieldDescriptorProtoTypeName-      , "extendee" .=: msg.fieldDescriptorProtoExtendee-      , "defaultValue" .=: msg.fieldDescriptorProtoDefaultValue-      , "oneofIndex" .=: msg.fieldDescriptorProtoOneofIndex-      , "jsonName" .=: msg.fieldDescriptorProtoJsonName-      , "options" .=: msg.fieldDescriptorProtoOptions-      , "proto3Optional" .=: msg.fieldDescriptorProtoProto3Optional-      ]--instance Aeson.FromJSON FieldDescriptorProto where-  parseJSON = Aeson.withObject "FieldDescriptorProto" $ \obj -> do-    fld_fieldDescriptorProtoName <- parseFieldMaybe obj "name"-    fld_fieldDescriptorProtoNumber <- parseFieldMaybe obj "number"-    fld_fieldDescriptorProtoLabel <- parseFieldMaybe obj "label"-    fld_fieldDescriptorProtoType <- parseFieldMaybe obj "type"-    fld_fieldDescriptorProtoTypeName <- parseFieldMaybe obj "typeName"-    fld_fieldDescriptorProtoExtendee <- parseFieldMaybe obj "extendee"-    fld_fieldDescriptorProtoDefaultValue <- parseFieldMaybe obj "defaultValue"-    fld_fieldDescriptorProtoOneofIndex <- parseFieldMaybe obj "oneofIndex"-    fld_fieldDescriptorProtoJsonName <- parseFieldMaybe obj "jsonName"-    fld_fieldDescriptorProtoOptions <- parseFieldMaybe obj "options"-    fld_fieldDescriptorProtoProto3Optional <- parseFieldMaybe obj "proto3Optional"-    pure defaultFieldDescriptorProto-      { fieldDescriptorProtoName = maybe (fieldDescriptorProtoName defaultFieldDescriptorProto) id fld_fieldDescriptorProtoName-      , fieldDescriptorProtoNumber = maybe (fieldDescriptorProtoNumber defaultFieldDescriptorProto) id fld_fieldDescriptorProtoNumber-      , fieldDescriptorProtoLabel = maybe (fieldDescriptorProtoLabel defaultFieldDescriptorProto) id fld_fieldDescriptorProtoLabel-      , fieldDescriptorProtoType = maybe (fieldDescriptorProtoType defaultFieldDescriptorProto) id fld_fieldDescriptorProtoType-      , fieldDescriptorProtoTypeName = maybe (fieldDescriptorProtoTypeName defaultFieldDescriptorProto) id fld_fieldDescriptorProtoTypeName-      , fieldDescriptorProtoExtendee = maybe (fieldDescriptorProtoExtendee defaultFieldDescriptorProto) id fld_fieldDescriptorProtoExtendee-      , fieldDescriptorProtoDefaultValue = maybe (fieldDescriptorProtoDefaultValue defaultFieldDescriptorProto) id fld_fieldDescriptorProtoDefaultValue-      , fieldDescriptorProtoOneofIndex = maybe (fieldDescriptorProtoOneofIndex defaultFieldDescriptorProto) id fld_fieldDescriptorProtoOneofIndex-      , fieldDescriptorProtoJsonName = maybe (fieldDescriptorProtoJsonName defaultFieldDescriptorProto) id fld_fieldDescriptorProtoJsonName-      , fieldDescriptorProtoOptions = maybe (fieldDescriptorProtoOptions defaultFieldDescriptorProto) id fld_fieldDescriptorProtoOptions-      , fieldDescriptorProtoProto3Optional = maybe (fieldDescriptorProtoProto3Optional defaultFieldDescriptorProto) id fld_fieldDescriptorProtoProto3Optional-      }--instance Hashable FieldDescriptorProto where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.fieldDescriptorProtoName) msg.fieldDescriptorProtoNumber) msg.fieldDescriptorProtoLabel) msg.fieldDescriptorProtoType) msg.fieldDescriptorProtoTypeName) msg.fieldDescriptorProtoExtendee) msg.fieldDescriptorProtoDefaultValue) msg.fieldDescriptorProtoOneofIndex) msg.fieldDescriptorProtoJsonName) msg.fieldDescriptorProtoOptions) msg.fieldDescriptorProtoProto3Optional--instance Proto.Extension.HasExtensions FieldDescriptorProto where-  messageUnknownFields = fieldDescriptorProtoUnknownFields-  setMessageUnknownFields !ufs msg = msg { fieldDescriptorProtoUnknownFields = ufs }--instance Semigroup FieldDescriptorProto where-  a <> b = FieldDescriptorProto-    { fieldDescriptorProtoName = case b.fieldDescriptorProtoName of { Nothing -> a.fieldDescriptorProtoName; x -> x }-    , fieldDescriptorProtoNumber = case b.fieldDescriptorProtoNumber of { Nothing -> a.fieldDescriptorProtoNumber; x -> x }-    , fieldDescriptorProtoLabel = case b.fieldDescriptorProtoLabel of { Nothing -> a.fieldDescriptorProtoLabel; x -> x }-    , fieldDescriptorProtoType = case b.fieldDescriptorProtoType of { Nothing -> a.fieldDescriptorProtoType; x -> x }-    , fieldDescriptorProtoTypeName = case b.fieldDescriptorProtoTypeName of { Nothing -> a.fieldDescriptorProtoTypeName; x -> x }-    , fieldDescriptorProtoExtendee = case b.fieldDescriptorProtoExtendee of { Nothing -> a.fieldDescriptorProtoExtendee; x -> x }-    , fieldDescriptorProtoDefaultValue = case b.fieldDescriptorProtoDefaultValue of { Nothing -> a.fieldDescriptorProtoDefaultValue; x -> x }-    , fieldDescriptorProtoOneofIndex = case b.fieldDescriptorProtoOneofIndex of { Nothing -> a.fieldDescriptorProtoOneofIndex; x -> x }-    , fieldDescriptorProtoJsonName = case b.fieldDescriptorProtoJsonName of { Nothing -> a.fieldDescriptorProtoJsonName; x -> x }-    , fieldDescriptorProtoOptions = case b.fieldDescriptorProtoOptions of { Nothing -> a.fieldDescriptorProtoOptions; x -> x }-    , fieldDescriptorProtoProto3Optional = case b.fieldDescriptorProtoProto3Optional of { Nothing -> a.fieldDescriptorProtoProto3Optional; x -> x }-    , fieldDescriptorProtoUnknownFields = a.fieldDescriptorProtoUnknownFields <> b.fieldDescriptorProtoUnknownFields-    }--instance Monoid FieldDescriptorProto where-  mempty = defaultFieldDescriptorProto---- | Describes a oneof.-data OneofDescriptorProto = OneofDescriptorProto-  { oneofDescriptorProtoName :: !(Maybe Text)-  , oneofDescriptorProtoOptions :: !(Maybe OneofOptions)-  , oneofDescriptorProtoUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultOneofDescriptorProto :: OneofDescriptorProto-defaultOneofDescriptorProto = OneofDescriptorProto-  { oneofDescriptorProtoName = Nothing-  , oneofDescriptorProtoOptions = Nothing-  , oneofDescriptorProtoUnknownFields = []-  }--instance MessageEncode OneofDescriptorProto where-  buildSized msg =-    (maybe mempty (\v -> archString 10 v) msg.oneofDescriptorProtoName)-    <> (maybe mempty (\v -> archSubmessage 18 (buildSized v)) msg.oneofDescriptorProtoOptions)-    <> encodeUnknownFieldsSized msg.oneofDescriptorProtoUnknownFields--instance MessageDecode OneofDescriptorProto where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultOneofDescriptorProto-    where-      stage_0 msg =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_1 (msg { oneofDescriptorProtoName = (Just v)}))-          (pure (case msg.oneofDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { oneofDescriptorProtoUnknownFields = reverse (msg.oneofDescriptorProtoUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> loop (msg { oneofDescriptorProtoOptions = (Just v)}))-          (pure (case msg.oneofDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { oneofDescriptorProtoUnknownFields = reverse (msg.oneofDescriptorProtoUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.oneofDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { oneofDescriptorProtoUnknownFields = reverse (msg.oneofDescriptorProtoUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { oneofDescriptorProtoName = (Just v)})-          2 -> do-            v <- decodeFieldMessage-            loop (msg { oneofDescriptorProtoOptions = (Just v)})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { oneofDescriptorProtoUnknownFields = (uf : msg.oneofDescriptorProtoUnknownFields)}))---- | Field descriptors for 'OneofDescriptorProto', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-oneofDescriptorProtoFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor OneofDescriptorProto)-oneofDescriptorProtoFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "name"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = oneofDescriptorProtoName-        , fdSet = \v m -> m { oneofDescriptorProtoName = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "options"-        , fdNumber = 2-        , fdTypeDesc = MessageType "OneofOptions"-        , fdLabel = LabelOptional-        , fdGet = oneofDescriptorProtoOptions-        , fdSet = \v m -> m { oneofDescriptorProtoOptions = v }-        })-    ]--instance ProtoMessage OneofDescriptorProto where-  protoMessageName _ = "google.protobuf.OneofDescriptorProto"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultOneofDescriptorProto-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = oneofDescriptorProtoFieldDescriptors--instance IsMessage OneofDescriptorProto--instance Aeson.ToJSON OneofDescriptorProto where-  toJSON msg = jsonObject-      [ "name" .=: msg.oneofDescriptorProtoName-      , "options" .=: msg.oneofDescriptorProtoOptions-      ]--instance Aeson.FromJSON OneofDescriptorProto where-  parseJSON = Aeson.withObject "OneofDescriptorProto" $ \obj -> do-    fld_oneofDescriptorProtoName <- parseFieldMaybe obj "name"-    fld_oneofDescriptorProtoOptions <- parseFieldMaybe obj "options"-    pure defaultOneofDescriptorProto-      { oneofDescriptorProtoName = maybe (oneofDescriptorProtoName defaultOneofDescriptorProto) id fld_oneofDescriptorProtoName-      , oneofDescriptorProtoOptions = maybe (oneofDescriptorProtoOptions defaultOneofDescriptorProto) id fld_oneofDescriptorProtoOptions-      }--instance Hashable OneofDescriptorProto where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (salt) msg.oneofDescriptorProtoName) msg.oneofDescriptorProtoOptions--instance Proto.Extension.HasExtensions OneofDescriptorProto where-  messageUnknownFields = oneofDescriptorProtoUnknownFields-  setMessageUnknownFields !ufs msg = msg { oneofDescriptorProtoUnknownFields = ufs }--instance Semigroup OneofDescriptorProto where-  a <> b = OneofDescriptorProto-    { oneofDescriptorProtoName = case b.oneofDescriptorProtoName of { Nothing -> a.oneofDescriptorProtoName; x -> x }-    , oneofDescriptorProtoOptions = case b.oneofDescriptorProtoOptions of { Nothing -> a.oneofDescriptorProtoOptions; x -> x }-    , oneofDescriptorProtoUnknownFields = a.oneofDescriptorProtoUnknownFields <> b.oneofDescriptorProtoUnknownFields-    }--instance Monoid OneofDescriptorProto where-  mempty = defaultOneofDescriptorProto---- | Describes an enum type.-data EnumDescriptorProto = EnumDescriptorProto-  { enumDescriptorProtoName :: !(Maybe Text)-  , enumDescriptorProtoValue :: !(V.Vector EnumValueDescriptorProto)-  , enumDescriptorProtoOptions :: !(Maybe EnumOptions)-  , enumDescriptorProtoReservedRange :: !(V.Vector EnumDescriptorProto'EnumReservedRange)-    -- ^ Range of reserved numeric values. Reserved numeric values may not be used-    -- by enum values in the same enum declaration. Reserved ranges may not-    -- overlap.-  , enumDescriptorProtoReservedName :: !(V.Vector Text)-    -- ^ Reserved enum value names, which may not be reused. A given name may only-    -- be reserved once.-  , enumDescriptorProtoUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData---- | Range of reserved numeric values. Reserved values may not be used by--- entries in the same enum. Reserved ranges may not overlap.--- --- Note that this is distinct from DescriptorProto.ReservedRange in that it--- is inclusive such that it can appropriately represent the entire int32--- domain.-data EnumDescriptorProto'EnumReservedRange = EnumDescriptorProto'EnumReservedRange-  { enumDescriptorProtoEnumReservedRangeStart :: !(Maybe Int32)-  , enumDescriptorProtoEnumReservedRangeEnd :: !(Maybe Int32)-  , enumDescriptorProtoEnumReservedRangeUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultEnumDescriptorProto'EnumReservedRange :: EnumDescriptorProto'EnumReservedRange-defaultEnumDescriptorProto'EnumReservedRange = EnumDescriptorProto'EnumReservedRange-  { enumDescriptorProtoEnumReservedRangeStart = Nothing-  , enumDescriptorProtoEnumReservedRangeEnd = Nothing-  , enumDescriptorProtoEnumReservedRangeUnknownFields = []-  }--instance MessageEncode EnumDescriptorProto'EnumReservedRange where-  buildSized msg =-    (maybe mempty (\v -> archVarint 8 (fromIntegral v)) msg.enumDescriptorProtoEnumReservedRangeStart)-    <> (maybe mempty (\v -> archVarint 16 (fromIntegral v)) msg.enumDescriptorProtoEnumReservedRangeEnd)-    <> encodeUnknownFieldsSized msg.enumDescriptorProtoEnumReservedRangeUnknownFields--instance MessageDecode EnumDescriptorProto'EnumReservedRange where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultEnumDescriptorProto'EnumReservedRange-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_1 (msg { enumDescriptorProtoEnumReservedRangeStart = (Just v)}))-          (pure (case msg.enumDescriptorProtoEnumReservedRangeUnknownFields of { [] -> msg; _ -> msg { enumDescriptorProtoEnumReservedRangeUnknownFields = reverse (msg.enumDescriptorProtoEnumReservedRangeUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x10 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> loop (msg { enumDescriptorProtoEnumReservedRangeEnd = (Just v)}))-          (pure (case msg.enumDescriptorProtoEnumReservedRangeUnknownFields of { [] -> msg; _ -> msg { enumDescriptorProtoEnumReservedRangeUnknownFields = reverse (msg.enumDescriptorProtoEnumReservedRangeUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.enumDescriptorProtoEnumReservedRangeUnknownFields of { [] -> msg; _ -> msg { enumDescriptorProtoEnumReservedRangeUnknownFields = reverse (msg.enumDescriptorProtoEnumReservedRangeUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { enumDescriptorProtoEnumReservedRangeStart = (Just v)})-          2 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { enumDescriptorProtoEnumReservedRangeEnd = (Just v)})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { enumDescriptorProtoEnumReservedRangeUnknownFields = (uf : msg.enumDescriptorProtoEnumReservedRangeUnknownFields)}))---- | Field descriptors for 'EnumDescriptorProto'EnumReservedRange', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-enumDescriptorProto'EnumReservedRangeFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor EnumDescriptorProto'EnumReservedRange)-enumDescriptorProto'EnumReservedRangeFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "start"-        , fdNumber = 1-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = enumDescriptorProtoEnumReservedRangeStart-        , fdSet = \v m -> m { enumDescriptorProtoEnumReservedRangeStart = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "end"-        , fdNumber = 2-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = enumDescriptorProtoEnumReservedRangeEnd-        , fdSet = \v m -> m { enumDescriptorProtoEnumReservedRangeEnd = v }-        })-    ]--instance ProtoMessage EnumDescriptorProto'EnumReservedRange where-  protoMessageName _ = "google.protobuf.EnumDescriptorProto.EnumReservedRange"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultEnumDescriptorProto'EnumReservedRange-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = enumDescriptorProto'EnumReservedRangeFieldDescriptors--instance IsMessage EnumDescriptorProto'EnumReservedRange--instance Aeson.ToJSON EnumDescriptorProto'EnumReservedRange where-  toJSON msg = jsonObject-      [ "start" .=: msg.enumDescriptorProtoEnumReservedRangeStart-      , "end" .=: msg.enumDescriptorProtoEnumReservedRangeEnd-      ]--instance Aeson.FromJSON EnumDescriptorProto'EnumReservedRange where-  parseJSON = Aeson.withObject "EnumDescriptorProto'EnumReservedRange" $ \obj -> do-    fld_enumDescriptorProtoEnumReservedRangeStart <- parseFieldMaybe obj "start"-    fld_enumDescriptorProtoEnumReservedRangeEnd <- parseFieldMaybe obj "end"-    pure defaultEnumDescriptorProto'EnumReservedRange-      { enumDescriptorProtoEnumReservedRangeStart = maybe (enumDescriptorProtoEnumReservedRangeStart defaultEnumDescriptorProto'EnumReservedRange) id fld_enumDescriptorProtoEnumReservedRangeStart-      , enumDescriptorProtoEnumReservedRangeEnd = maybe (enumDescriptorProtoEnumReservedRangeEnd defaultEnumDescriptorProto'EnumReservedRange) id fld_enumDescriptorProtoEnumReservedRangeEnd-      }--instance Hashable EnumDescriptorProto'EnumReservedRange where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (salt) msg.enumDescriptorProtoEnumReservedRangeStart) msg.enumDescriptorProtoEnumReservedRangeEnd--instance Proto.Extension.HasExtensions EnumDescriptorProto'EnumReservedRange where-  messageUnknownFields = enumDescriptorProtoEnumReservedRangeUnknownFields-  setMessageUnknownFields !ufs msg = msg { enumDescriptorProtoEnumReservedRangeUnknownFields = ufs }--instance Semigroup EnumDescriptorProto'EnumReservedRange where-  a <> b = EnumDescriptorProto'EnumReservedRange-    { enumDescriptorProtoEnumReservedRangeStart = case b.enumDescriptorProtoEnumReservedRangeStart of { Nothing -> a.enumDescriptorProtoEnumReservedRangeStart; x -> x }-    , enumDescriptorProtoEnumReservedRangeEnd = case b.enumDescriptorProtoEnumReservedRangeEnd of { Nothing -> a.enumDescriptorProtoEnumReservedRangeEnd; x -> x }-    , enumDescriptorProtoEnumReservedRangeUnknownFields = a.enumDescriptorProtoEnumReservedRangeUnknownFields <> b.enumDescriptorProtoEnumReservedRangeUnknownFields-    }--instance Monoid EnumDescriptorProto'EnumReservedRange where-  mempty = defaultEnumDescriptorProto'EnumReservedRange--defaultEnumDescriptorProto :: EnumDescriptorProto-defaultEnumDescriptorProto = EnumDescriptorProto-  { enumDescriptorProtoName = Nothing-  , enumDescriptorProtoValue = V.empty-  , enumDescriptorProtoOptions = Nothing-  , enumDescriptorProtoReservedRange = V.empty-  , enumDescriptorProtoReservedName = V.empty-  , enumDescriptorProtoUnknownFields = []-  }--instance MessageEncode EnumDescriptorProto where-  buildSized msg =-    (maybe mempty (\v -> archString 10 v) msg.enumDescriptorProtoName)-    <> V.foldl' (\acc v -> acc <> archSubmessage 18 (buildSized v)) mempty msg.enumDescriptorProtoValue-    <> (maybe mempty (\v -> archSubmessage 26 (buildSized v)) msg.enumDescriptorProtoOptions)-    <> V.foldl' (\acc v -> acc <> archSubmessage 34 (buildSized v)) mempty msg.enumDescriptorProtoReservedRange-    <> V.foldl' (\acc v -> acc <> archString 42 v) mempty msg.enumDescriptorProtoReservedName-    <> encodeUnknownFieldsSized msg.enumDescriptorProtoUnknownFields--instance MessageDecode EnumDescriptorProto where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultEnumDescriptorProto emptyGrowList emptyGrowList emptyGrowList-    where-      stage_0 msg gl_0 gl_1 gl_2 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_1 (msg { enumDescriptorProtoName = (Just v)}) gl_0 gl_1 gl_2)-          (pure (case msg.enumDescriptorProtoUnknownFields of { [] -> msg { enumDescriptorProtoValue = growListToVector gl_0, enumDescriptorProtoReservedRange = growListToVector gl_1, enumDescriptorProtoReservedName = growListToVector gl_2 }; _ -> msg { enumDescriptorProtoValue = growListToVector gl_0, enumDescriptorProtoReservedRange = growListToVector gl_1, enumDescriptorProtoReservedName = growListToVector gl_2, enumDescriptorProtoUnknownFields = reverse (msg.enumDescriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2)-      stage_1 msg gl_0 gl_1 gl_2 =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_1 msg (snocGrowList gl_0 v) gl_1 gl_2)-          (pure (case msg.enumDescriptorProtoUnknownFields of { [] -> msg { enumDescriptorProtoValue = growListToVector gl_0, enumDescriptorProtoReservedRange = growListToVector gl_1, enumDescriptorProtoReservedName = growListToVector gl_2 }; _ -> msg { enumDescriptorProtoValue = growListToVector gl_0, enumDescriptorProtoReservedRange = growListToVector gl_1, enumDescriptorProtoReservedName = growListToVector gl_2, enumDescriptorProtoUnknownFields = reverse (msg.enumDescriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2)-      stage_2 msg gl_0 gl_1 gl_2 =-        inOrderStage1-          (0x1a :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_3 (msg { enumDescriptorProtoOptions = (Just v)}) gl_0 gl_1 gl_2)-          (pure (case msg.enumDescriptorProtoUnknownFields of { [] -> msg { enumDescriptorProtoValue = growListToVector gl_0, enumDescriptorProtoReservedRange = growListToVector gl_1, enumDescriptorProtoReservedName = growListToVector gl_2 }; _ -> msg { enumDescriptorProtoValue = growListToVector gl_0, enumDescriptorProtoReservedRange = growListToVector gl_1, enumDescriptorProtoReservedName = growListToVector gl_2, enumDescriptorProtoUnknownFields = reverse (msg.enumDescriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2)-      stage_3 msg gl_0 gl_1 gl_2 =-        inOrderStage1-          (0x22 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_3 msg gl_0 (snocGrowList gl_1 v) gl_2)-          (pure (case msg.enumDescriptorProtoUnknownFields of { [] -> msg { enumDescriptorProtoValue = growListToVector gl_0, enumDescriptorProtoReservedRange = growListToVector gl_1, enumDescriptorProtoReservedName = growListToVector gl_2 }; _ -> msg { enumDescriptorProtoValue = growListToVector gl_0, enumDescriptorProtoReservedRange = growListToVector gl_1, enumDescriptorProtoReservedName = growListToVector gl_2, enumDescriptorProtoUnknownFields = reverse (msg.enumDescriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2)-      stage_4 msg gl_0 gl_1 gl_2 =-        inOrderStage1-          (0x2a :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_4 msg gl_0 gl_1 (snocGrowList gl_2 v))-          (pure (case msg.enumDescriptorProtoUnknownFields of { [] -> msg { enumDescriptorProtoValue = growListToVector gl_0, enumDescriptorProtoReservedRange = growListToVector gl_1, enumDescriptorProtoReservedName = growListToVector gl_2 }; _ -> msg { enumDescriptorProtoValue = growListToVector gl_0, enumDescriptorProtoReservedRange = growListToVector gl_1, enumDescriptorProtoReservedName = growListToVector gl_2, enumDescriptorProtoUnknownFields = reverse (msg.enumDescriptorProtoUnknownFields) } }))-          (loop msg gl_0 gl_1 gl_2)-      loop msg gl_0 gl_1 gl_2 = withTagM-        (pure (case msg.enumDescriptorProtoUnknownFields of { [] -> msg { enumDescriptorProtoValue = growListToVector gl_0, enumDescriptorProtoReservedRange = growListToVector gl_1, enumDescriptorProtoReservedName = growListToVector gl_2 }; _ -> msg { enumDescriptorProtoValue = growListToVector gl_0, enumDescriptorProtoReservedRange = growListToVector gl_1, enumDescriptorProtoReservedName = growListToVector gl_2, enumDescriptorProtoUnknownFields = reverse (msg.enumDescriptorProtoUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { enumDescriptorProtoName = (Just v)}) gl_0 gl_1 gl_2-          2 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v) gl_1 gl_2-          3 -> do-            v <- decodeFieldMessage-            loop (msg { enumDescriptorProtoOptions = (Just v)}) gl_0 gl_1 gl_2-          4 -> do-            v <- decodeFieldMessage-            loop msg gl_0 (snocGrowList gl_1 v) gl_2-          5 -> do-            v <- decodeFieldString-            loop msg gl_0 gl_1 (snocGrowList gl_2 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { enumDescriptorProtoUnknownFields = (uf : msg.enumDescriptorProtoUnknownFields)}) gl_0 gl_1 gl_2)---- | Field descriptors for 'EnumDescriptorProto', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-enumDescriptorProtoFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor EnumDescriptorProto)-enumDescriptorProtoFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "name"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = enumDescriptorProtoName-        , fdSet = \v m -> m { enumDescriptorProtoName = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "value"-        , fdNumber = 2-        , fdTypeDesc = MessageType "EnumValueDescriptorProto"-        , fdLabel = LabelRepeated-        , fdGet = enumDescriptorProtoValue-        , fdSet = \v m -> m { enumDescriptorProtoValue = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "options"-        , fdNumber = 3-        , fdTypeDesc = MessageType "EnumOptions"-        , fdLabel = LabelOptional-        , fdGet = enumDescriptorProtoOptions-        , fdSet = \v m -> m { enumDescriptorProtoOptions = v }-        })-    , (4, SomeField FieldDescriptor-        { fdName = "reserved_range"-        , fdNumber = 4-        , fdTypeDesc = MessageType "EnumReservedRange"-        , fdLabel = LabelRepeated-        , fdGet = enumDescriptorProtoReservedRange-        , fdSet = \v m -> m { enumDescriptorProtoReservedRange = v }-        })-    , (5, SomeField FieldDescriptor-        { fdName = "reserved_name"-        , fdNumber = 5-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelRepeated-        , fdGet = enumDescriptorProtoReservedName-        , fdSet = \v m -> m { enumDescriptorProtoReservedName = v }-        })-    ]--instance ProtoMessage EnumDescriptorProto where-  protoMessageName _ = "google.protobuf.EnumDescriptorProto"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultEnumDescriptorProto-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = enumDescriptorProtoFieldDescriptors--instance IsMessage EnumDescriptorProto--instance Aeson.ToJSON EnumDescriptorProto where-  toJSON msg = jsonObject-      [ "name" .=: msg.enumDescriptorProtoName-      , "value" .=: msg.enumDescriptorProtoValue-      , "options" .=: msg.enumDescriptorProtoOptions-      , "reservedRange" .=: msg.enumDescriptorProtoReservedRange-      , "reservedName" .=: msg.enumDescriptorProtoReservedName-      ]--instance Aeson.FromJSON EnumDescriptorProto where-  parseJSON = Aeson.withObject "EnumDescriptorProto" $ \obj -> do-    fld_enumDescriptorProtoName <- parseFieldMaybe obj "name"-    fld_enumDescriptorProtoValue <- parseFieldMaybe obj "value"-    fld_enumDescriptorProtoOptions <- parseFieldMaybe obj "options"-    fld_enumDescriptorProtoReservedRange <- parseFieldMaybe obj "reservedRange"-    fld_enumDescriptorProtoReservedName <- parseFieldMaybe obj "reservedName"-    pure defaultEnumDescriptorProto-      { enumDescriptorProtoName = maybe (enumDescriptorProtoName defaultEnumDescriptorProto) id fld_enumDescriptorProtoName-      , enumDescriptorProtoValue = maybe (enumDescriptorProtoValue defaultEnumDescriptorProto) id fld_enumDescriptorProtoValue-      , enumDescriptorProtoOptions = maybe (enumDescriptorProtoOptions defaultEnumDescriptorProto) id fld_enumDescriptorProtoOptions-      , enumDescriptorProtoReservedRange = maybe (enumDescriptorProtoReservedRange defaultEnumDescriptorProto) id fld_enumDescriptorProtoReservedRange-      , enumDescriptorProtoReservedName = maybe (enumDescriptorProtoReservedName defaultEnumDescriptorProto) id fld_enumDescriptorProtoReservedName-      }--instance Hashable EnumDescriptorProto where-  hashWithSalt salt msg = V.foldl' hashWithSalt (V.foldl' hashWithSalt (hashWithSalt (V.foldl' hashWithSalt (hashWithSalt (salt) msg.enumDescriptorProtoName) msg.enumDescriptorProtoValue) msg.enumDescriptorProtoOptions) msg.enumDescriptorProtoReservedRange) msg.enumDescriptorProtoReservedName--instance Proto.Extension.HasExtensions EnumDescriptorProto where-  messageUnknownFields = enumDescriptorProtoUnknownFields-  setMessageUnknownFields !ufs msg = msg { enumDescriptorProtoUnknownFields = ufs }--instance Semigroup EnumDescriptorProto where-  a <> b = EnumDescriptorProto-    { enumDescriptorProtoName = case b.enumDescriptorProtoName of { Nothing -> a.enumDescriptorProtoName; x -> x }-    , enumDescriptorProtoValue = a.enumDescriptorProtoValue <> b.enumDescriptorProtoValue-    , enumDescriptorProtoOptions = case b.enumDescriptorProtoOptions of { Nothing -> a.enumDescriptorProtoOptions; x -> x }-    , enumDescriptorProtoReservedRange = a.enumDescriptorProtoReservedRange <> b.enumDescriptorProtoReservedRange-    , enumDescriptorProtoReservedName = a.enumDescriptorProtoReservedName <> b.enumDescriptorProtoReservedName-    , enumDescriptorProtoUnknownFields = a.enumDescriptorProtoUnknownFields <> b.enumDescriptorProtoUnknownFields-    }--instance Monoid EnumDescriptorProto where-  mempty = defaultEnumDescriptorProto---- | Describes a value within an enum.-data EnumValueDescriptorProto = EnumValueDescriptorProto-  { enumValueDescriptorProtoName :: !(Maybe Text)-  , enumValueDescriptorProtoNumber :: !(Maybe Int32)-  , enumValueDescriptorProtoOptions :: !(Maybe EnumValueOptions)-  , enumValueDescriptorProtoUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultEnumValueDescriptorProto :: EnumValueDescriptorProto-defaultEnumValueDescriptorProto = EnumValueDescriptorProto-  { enumValueDescriptorProtoName = Nothing-  , enumValueDescriptorProtoNumber = Nothing-  , enumValueDescriptorProtoOptions = Nothing-  , enumValueDescriptorProtoUnknownFields = []-  }--instance MessageEncode EnumValueDescriptorProto where-  buildSized msg =-    (maybe mempty (\v -> archString 10 v) msg.enumValueDescriptorProtoName)-    <> (maybe mempty (\v -> archVarint 16 (fromIntegral v)) msg.enumValueDescriptorProtoNumber)-    <> (maybe mempty (\v -> archSubmessage 26 (buildSized v)) msg.enumValueDescriptorProtoOptions)-    <> encodeUnknownFieldsSized msg.enumValueDescriptorProtoUnknownFields--instance MessageDecode EnumValueDescriptorProto where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultEnumValueDescriptorProto-    where-      stage_0 msg =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_1 (msg { enumValueDescriptorProtoName = (Just v)}))-          (pure (case msg.enumValueDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { enumValueDescriptorProtoUnknownFields = reverse (msg.enumValueDescriptorProtoUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x10 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_2 (msg { enumValueDescriptorProtoNumber = (Just v)}))-          (pure (case msg.enumValueDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { enumValueDescriptorProtoUnknownFields = reverse (msg.enumValueDescriptorProtoUnknownFields) } }))-          (loop msg)-      stage_2 msg =-        inOrderStage1-          (0x1a :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> loop (msg { enumValueDescriptorProtoOptions = (Just v)}))-          (pure (case msg.enumValueDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { enumValueDescriptorProtoUnknownFields = reverse (msg.enumValueDescriptorProtoUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.enumValueDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { enumValueDescriptorProtoUnknownFields = reverse (msg.enumValueDescriptorProtoUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { enumValueDescriptorProtoName = (Just v)})-          2 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { enumValueDescriptorProtoNumber = (Just v)})-          3 -> do-            v <- decodeFieldMessage-            loop (msg { enumValueDescriptorProtoOptions = (Just v)})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { enumValueDescriptorProtoUnknownFields = (uf : msg.enumValueDescriptorProtoUnknownFields)}))---- | Field descriptors for 'EnumValueDescriptorProto', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-enumValueDescriptorProtoFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor EnumValueDescriptorProto)-enumValueDescriptorProtoFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "name"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = enumValueDescriptorProtoName-        , fdSet = \v m -> m { enumValueDescriptorProtoName = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "number"-        , fdNumber = 2-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = enumValueDescriptorProtoNumber-        , fdSet = \v m -> m { enumValueDescriptorProtoNumber = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "options"-        , fdNumber = 3-        , fdTypeDesc = MessageType "EnumValueOptions"-        , fdLabel = LabelOptional-        , fdGet = enumValueDescriptorProtoOptions-        , fdSet = \v m -> m { enumValueDescriptorProtoOptions = v }-        })-    ]--instance ProtoMessage EnumValueDescriptorProto where-  protoMessageName _ = "google.protobuf.EnumValueDescriptorProto"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultEnumValueDescriptorProto-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = enumValueDescriptorProtoFieldDescriptors--instance IsMessage EnumValueDescriptorProto--instance Aeson.ToJSON EnumValueDescriptorProto where-  toJSON msg = jsonObject-      [ "name" .=: msg.enumValueDescriptorProtoName-      , "number" .=: msg.enumValueDescriptorProtoNumber-      , "options" .=: msg.enumValueDescriptorProtoOptions-      ]--instance Aeson.FromJSON EnumValueDescriptorProto where-  parseJSON = Aeson.withObject "EnumValueDescriptorProto" $ \obj -> do-    fld_enumValueDescriptorProtoName <- parseFieldMaybe obj "name"-    fld_enumValueDescriptorProtoNumber <- parseFieldMaybe obj "number"-    fld_enumValueDescriptorProtoOptions <- parseFieldMaybe obj "options"-    pure defaultEnumValueDescriptorProto-      { enumValueDescriptorProtoName = maybe (enumValueDescriptorProtoName defaultEnumValueDescriptorProto) id fld_enumValueDescriptorProtoName-      , enumValueDescriptorProtoNumber = maybe (enumValueDescriptorProtoNumber defaultEnumValueDescriptorProto) id fld_enumValueDescriptorProtoNumber-      , enumValueDescriptorProtoOptions = maybe (enumValueDescriptorProtoOptions defaultEnumValueDescriptorProto) id fld_enumValueDescriptorProtoOptions-      }--instance Hashable EnumValueDescriptorProto where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.enumValueDescriptorProtoName) msg.enumValueDescriptorProtoNumber) msg.enumValueDescriptorProtoOptions--instance Proto.Extension.HasExtensions EnumValueDescriptorProto where-  messageUnknownFields = enumValueDescriptorProtoUnknownFields-  setMessageUnknownFields !ufs msg = msg { enumValueDescriptorProtoUnknownFields = ufs }--instance Semigroup EnumValueDescriptorProto where-  a <> b = EnumValueDescriptorProto-    { enumValueDescriptorProtoName = case b.enumValueDescriptorProtoName of { Nothing -> a.enumValueDescriptorProtoName; x -> x }-    , enumValueDescriptorProtoNumber = case b.enumValueDescriptorProtoNumber of { Nothing -> a.enumValueDescriptorProtoNumber; x -> x }-    , enumValueDescriptorProtoOptions = case b.enumValueDescriptorProtoOptions of { Nothing -> a.enumValueDescriptorProtoOptions; x -> x }-    , enumValueDescriptorProtoUnknownFields = a.enumValueDescriptorProtoUnknownFields <> b.enumValueDescriptorProtoUnknownFields-    }--instance Monoid EnumValueDescriptorProto where-  mempty = defaultEnumValueDescriptorProto---- | Describes a service.-data ServiceDescriptorProto = ServiceDescriptorProto-  { serviceDescriptorProtoName :: !(Maybe Text)-  , serviceDescriptorProtoMethod :: !(V.Vector MethodDescriptorProto)-  , serviceDescriptorProtoOptions :: !(Maybe ServiceOptions)-  , serviceDescriptorProtoUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultServiceDescriptorProto :: ServiceDescriptorProto-defaultServiceDescriptorProto = ServiceDescriptorProto-  { serviceDescriptorProtoName = Nothing-  , serviceDescriptorProtoMethod = V.empty-  , serviceDescriptorProtoOptions = Nothing-  , serviceDescriptorProtoUnknownFields = []-  }--instance MessageEncode ServiceDescriptorProto where-  buildSized msg =-    (maybe mempty (\v -> archString 10 v) msg.serviceDescriptorProtoName)-    <> V.foldl' (\acc v -> acc <> archSubmessage 18 (buildSized v)) mempty msg.serviceDescriptorProtoMethod-    <> (maybe mempty (\v -> archSubmessage 26 (buildSized v)) msg.serviceDescriptorProtoOptions)-    <> encodeUnknownFieldsSized msg.serviceDescriptorProtoUnknownFields--instance MessageDecode ServiceDescriptorProto where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultServiceDescriptorProto emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_1 (msg { serviceDescriptorProtoName = (Just v)}) gl_0)-          (pure (case msg.serviceDescriptorProtoUnknownFields of { [] -> msg { serviceDescriptorProtoMethod = growListToVector gl_0 }; _ -> msg { serviceDescriptorProtoMethod = growListToVector gl_0, serviceDescriptorProtoUnknownFields = reverse (msg.serviceDescriptorProtoUnknownFields) } }))-          (loop msg gl_0)-      stage_1 msg gl_0 =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_1 msg (snocGrowList gl_0 v))-          (pure (case msg.serviceDescriptorProtoUnknownFields of { [] -> msg { serviceDescriptorProtoMethod = growListToVector gl_0 }; _ -> msg { serviceDescriptorProtoMethod = growListToVector gl_0, serviceDescriptorProtoUnknownFields = reverse (msg.serviceDescriptorProtoUnknownFields) } }))-          (loop msg gl_0)-      stage_2 msg gl_0 =-        inOrderStage1-          (0x1a :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> loop (msg { serviceDescriptorProtoOptions = (Just v)}) gl_0)-          (pure (case msg.serviceDescriptorProtoUnknownFields of { [] -> msg { serviceDescriptorProtoMethod = growListToVector gl_0 }; _ -> msg { serviceDescriptorProtoMethod = growListToVector gl_0, serviceDescriptorProtoUnknownFields = reverse (msg.serviceDescriptorProtoUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.serviceDescriptorProtoUnknownFields of { [] -> msg { serviceDescriptorProtoMethod = growListToVector gl_0 }; _ -> msg { serviceDescriptorProtoMethod = growListToVector gl_0, serviceDescriptorProtoUnknownFields = reverse (msg.serviceDescriptorProtoUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { serviceDescriptorProtoName = (Just v)}) gl_0-          2 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v)-          3 -> do-            v <- decodeFieldMessage-            loop (msg { serviceDescriptorProtoOptions = (Just v)}) gl_0-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { serviceDescriptorProtoUnknownFields = (uf : msg.serviceDescriptorProtoUnknownFields)}) gl_0)---- | Field descriptors for 'ServiceDescriptorProto', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-serviceDescriptorProtoFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor ServiceDescriptorProto)-serviceDescriptorProtoFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "name"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = serviceDescriptorProtoName-        , fdSet = \v m -> m { serviceDescriptorProtoName = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "method"-        , fdNumber = 2-        , fdTypeDesc = MessageType "MethodDescriptorProto"-        , fdLabel = LabelRepeated-        , fdGet = serviceDescriptorProtoMethod-        , fdSet = \v m -> m { serviceDescriptorProtoMethod = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "options"-        , fdNumber = 3-        , fdTypeDesc = MessageType "ServiceOptions"-        , fdLabel = LabelOptional-        , fdGet = serviceDescriptorProtoOptions-        , fdSet = \v m -> m { serviceDescriptorProtoOptions = v }-        })-    ]--instance ProtoMessage ServiceDescriptorProto where-  protoMessageName _ = "google.protobuf.ServiceDescriptorProto"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultServiceDescriptorProto-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = serviceDescriptorProtoFieldDescriptors--instance IsMessage ServiceDescriptorProto--instance Aeson.ToJSON ServiceDescriptorProto where-  toJSON msg = jsonObject-      [ "name" .=: msg.serviceDescriptorProtoName-      , "method" .=: msg.serviceDescriptorProtoMethod-      , "options" .=: msg.serviceDescriptorProtoOptions-      ]--instance Aeson.FromJSON ServiceDescriptorProto where-  parseJSON = Aeson.withObject "ServiceDescriptorProto" $ \obj -> do-    fld_serviceDescriptorProtoName <- parseFieldMaybe obj "name"-    fld_serviceDescriptorProtoMethod <- parseFieldMaybe obj "method"-    fld_serviceDescriptorProtoOptions <- parseFieldMaybe obj "options"-    pure defaultServiceDescriptorProto-      { serviceDescriptorProtoName = maybe (serviceDescriptorProtoName defaultServiceDescriptorProto) id fld_serviceDescriptorProtoName-      , serviceDescriptorProtoMethod = maybe (serviceDescriptorProtoMethod defaultServiceDescriptorProto) id fld_serviceDescriptorProtoMethod-      , serviceDescriptorProtoOptions = maybe (serviceDescriptorProtoOptions defaultServiceDescriptorProto) id fld_serviceDescriptorProtoOptions-      }--instance Hashable ServiceDescriptorProto where-  hashWithSalt salt msg = hashWithSalt (V.foldl' hashWithSalt (hashWithSalt (salt) msg.serviceDescriptorProtoName) msg.serviceDescriptorProtoMethod) msg.serviceDescriptorProtoOptions--instance Proto.Extension.HasExtensions ServiceDescriptorProto where-  messageUnknownFields = serviceDescriptorProtoUnknownFields-  setMessageUnknownFields !ufs msg = msg { serviceDescriptorProtoUnknownFields = ufs }--instance Semigroup ServiceDescriptorProto where-  a <> b = ServiceDescriptorProto-    { serviceDescriptorProtoName = case b.serviceDescriptorProtoName of { Nothing -> a.serviceDescriptorProtoName; x -> x }-    , serviceDescriptorProtoMethod = a.serviceDescriptorProtoMethod <> b.serviceDescriptorProtoMethod-    , serviceDescriptorProtoOptions = case b.serviceDescriptorProtoOptions of { Nothing -> a.serviceDescriptorProtoOptions; x -> x }-    , serviceDescriptorProtoUnknownFields = a.serviceDescriptorProtoUnknownFields <> b.serviceDescriptorProtoUnknownFields-    }--instance Monoid ServiceDescriptorProto where-  mempty = defaultServiceDescriptorProto---- | Describes a method of a service.-data MethodDescriptorProto = MethodDescriptorProto-  { methodDescriptorProtoName :: !(Maybe Text)-  , methodDescriptorProtoInputType :: !(Maybe Text)-    -- ^ Input and output type names.  These are resolved in the same way as-    -- FieldDescriptorProto.type_name, but must refer to a message type.-  , methodDescriptorProtoOutputType :: !(Maybe Text)-  , methodDescriptorProtoOptions :: !(Maybe MethodOptions)-  , methodDescriptorProtoClientStreaming :: !(Maybe Bool)-    -- ^ Identifies if client streams multiple client messages-  , methodDescriptorProtoServerStreaming :: !(Maybe Bool)-    -- ^ Identifies if server streams multiple server messages-  , methodDescriptorProtoUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultMethodDescriptorProto :: MethodDescriptorProto-defaultMethodDescriptorProto = MethodDescriptorProto-  { methodDescriptorProtoName = Nothing-  , methodDescriptorProtoInputType = Nothing-  , methodDescriptorProtoOutputType = Nothing-  , methodDescriptorProtoOptions = Nothing-  , methodDescriptorProtoClientStreaming = Nothing-  , methodDescriptorProtoServerStreaming = Nothing-  , methodDescriptorProtoUnknownFields = []-  }--instance MessageEncode MethodDescriptorProto where-  buildSized msg =-    (maybe mempty (\v -> archString 10 v) msg.methodDescriptorProtoName)-    <> (maybe mempty (\v -> archString 18 v) msg.methodDescriptorProtoInputType)-    <> (maybe mempty (\v -> archString 26 v) msg.methodDescriptorProtoOutputType)-    <> (maybe mempty (\v -> archSubmessage 34 (buildSized v)) msg.methodDescriptorProtoOptions)-    <> (maybe mempty (\v -> archBool 40 v) msg.methodDescriptorProtoClientStreaming)-    <> (maybe mempty (\v -> archBool 48 v) msg.methodDescriptorProtoServerStreaming)-    <> encodeUnknownFieldsSized msg.methodDescriptorProtoUnknownFields--instance MessageDecode MethodDescriptorProto where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultMethodDescriptorProto-    where-      stage_0 msg =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_1 (msg { methodDescriptorProtoName = (Just v)}))-          (pure (case msg.methodDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { methodDescriptorProtoUnknownFields = reverse (msg.methodDescriptorProtoUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_2 (msg { methodDescriptorProtoInputType = (Just v)}))-          (pure (case msg.methodDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { methodDescriptorProtoUnknownFields = reverse (msg.methodDescriptorProtoUnknownFields) } }))-          (loop msg)-      stage_2 msg =-        inOrderStage1-          (0x1a :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_3 (msg { methodDescriptorProtoOutputType = (Just v)}))-          (pure (case msg.methodDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { methodDescriptorProtoUnknownFields = reverse (msg.methodDescriptorProtoUnknownFields) } }))-          (loop msg)-      stage_3 msg =-        inOrderStage1-          (0x22 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_4 (msg { methodDescriptorProtoOptions = (Just v)}))-          (pure (case msg.methodDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { methodDescriptorProtoUnknownFields = reverse (msg.methodDescriptorProtoUnknownFields) } }))-          (loop msg)-      stage_4 msg =-        inOrderStage1-          (0x28 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_5 (msg { methodDescriptorProtoClientStreaming = (Just v)}))-          (pure (case msg.methodDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { methodDescriptorProtoUnknownFields = reverse (msg.methodDescriptorProtoUnknownFields) } }))-          (loop msg)-      stage_5 msg =-        inOrderStage1-          (0x30 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> loop (msg { methodDescriptorProtoServerStreaming = (Just v)}))-          (pure (case msg.methodDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { methodDescriptorProtoUnknownFields = reverse (msg.methodDescriptorProtoUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.methodDescriptorProtoUnknownFields of { [] -> msg; _ -> msg { methodDescriptorProtoUnknownFields = reverse (msg.methodDescriptorProtoUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { methodDescriptorProtoName = (Just v)})-          2 -> do-            v <- decodeFieldString-            loop (msg { methodDescriptorProtoInputType = (Just v)})-          3 -> do-            v <- decodeFieldString-            loop (msg { methodDescriptorProtoOutputType = (Just v)})-          4 -> do-            v <- decodeFieldMessage-            loop (msg { methodDescriptorProtoOptions = (Just v)})-          5 -> do-            v <- decodeFieldBool-            loop (msg { methodDescriptorProtoClientStreaming = (Just v)})-          6 -> do-            v <- decodeFieldBool-            loop (msg { methodDescriptorProtoServerStreaming = (Just v)})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { methodDescriptorProtoUnknownFields = (uf : msg.methodDescriptorProtoUnknownFields)}))---- | Field descriptors for 'MethodDescriptorProto', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-methodDescriptorProtoFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor MethodDescriptorProto)-methodDescriptorProtoFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "name"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = methodDescriptorProtoName-        , fdSet = \v m -> m { methodDescriptorProtoName = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "input_type"-        , fdNumber = 2-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = methodDescriptorProtoInputType-        , fdSet = \v m -> m { methodDescriptorProtoInputType = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "output_type"-        , fdNumber = 3-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = methodDescriptorProtoOutputType-        , fdSet = \v m -> m { methodDescriptorProtoOutputType = v }-        })-    , (4, SomeField FieldDescriptor-        { fdName = "options"-        , fdNumber = 4-        , fdTypeDesc = MessageType "MethodOptions"-        , fdLabel = LabelOptional-        , fdGet = methodDescriptorProtoOptions-        , fdSet = \v m -> m { methodDescriptorProtoOptions = v }-        })-    , (5, SomeField FieldDescriptor-        { fdName = "client_streaming"-        , fdNumber = 5-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = methodDescriptorProtoClientStreaming-        , fdSet = \v m -> m { methodDescriptorProtoClientStreaming = v }-        })-    , (6, SomeField FieldDescriptor-        { fdName = "server_streaming"-        , fdNumber = 6-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = methodDescriptorProtoServerStreaming-        , fdSet = \v m -> m { methodDescriptorProtoServerStreaming = v }-        })-    ]--instance ProtoMessage MethodDescriptorProto where-  protoMessageName _ = "google.protobuf.MethodDescriptorProto"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultMethodDescriptorProto-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = methodDescriptorProtoFieldDescriptors--instance IsMessage MethodDescriptorProto--instance Aeson.ToJSON MethodDescriptorProto where-  toJSON msg = jsonObject-      [ "name" .=: msg.methodDescriptorProtoName-      , "inputType" .=: msg.methodDescriptorProtoInputType-      , "outputType" .=: msg.methodDescriptorProtoOutputType-      , "options" .=: msg.methodDescriptorProtoOptions-      , "clientStreaming" .=: msg.methodDescriptorProtoClientStreaming-      , "serverStreaming" .=: msg.methodDescriptorProtoServerStreaming-      ]--instance Aeson.FromJSON MethodDescriptorProto where-  parseJSON = Aeson.withObject "MethodDescriptorProto" $ \obj -> do-    fld_methodDescriptorProtoName <- parseFieldMaybe obj "name"-    fld_methodDescriptorProtoInputType <- parseFieldMaybe obj "inputType"-    fld_methodDescriptorProtoOutputType <- parseFieldMaybe obj "outputType"-    fld_methodDescriptorProtoOptions <- parseFieldMaybe obj "options"-    fld_methodDescriptorProtoClientStreaming <- parseFieldMaybe obj "clientStreaming"-    fld_methodDescriptorProtoServerStreaming <- parseFieldMaybe obj "serverStreaming"-    pure defaultMethodDescriptorProto-      { methodDescriptorProtoName = maybe (methodDescriptorProtoName defaultMethodDescriptorProto) id fld_methodDescriptorProtoName-      , methodDescriptorProtoInputType = maybe (methodDescriptorProtoInputType defaultMethodDescriptorProto) id fld_methodDescriptorProtoInputType-      , methodDescriptorProtoOutputType = maybe (methodDescriptorProtoOutputType defaultMethodDescriptorProto) id fld_methodDescriptorProtoOutputType-      , methodDescriptorProtoOptions = maybe (methodDescriptorProtoOptions defaultMethodDescriptorProto) id fld_methodDescriptorProtoOptions-      , methodDescriptorProtoClientStreaming = maybe (methodDescriptorProtoClientStreaming defaultMethodDescriptorProto) id fld_methodDescriptorProtoClientStreaming-      , methodDescriptorProtoServerStreaming = maybe (methodDescriptorProtoServerStreaming defaultMethodDescriptorProto) id fld_methodDescriptorProtoServerStreaming-      }--instance Hashable MethodDescriptorProto where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.methodDescriptorProtoName) msg.methodDescriptorProtoInputType) msg.methodDescriptorProtoOutputType) msg.methodDescriptorProtoOptions) msg.methodDescriptorProtoClientStreaming) msg.methodDescriptorProtoServerStreaming--instance Proto.Extension.HasExtensions MethodDescriptorProto where-  messageUnknownFields = methodDescriptorProtoUnknownFields-  setMessageUnknownFields !ufs msg = msg { methodDescriptorProtoUnknownFields = ufs }--instance Semigroup MethodDescriptorProto where-  a <> b = MethodDescriptorProto-    { methodDescriptorProtoName = case b.methodDescriptorProtoName of { Nothing -> a.methodDescriptorProtoName; x -> x }-    , methodDescriptorProtoInputType = case b.methodDescriptorProtoInputType of { Nothing -> a.methodDescriptorProtoInputType; x -> x }-    , methodDescriptorProtoOutputType = case b.methodDescriptorProtoOutputType of { Nothing -> a.methodDescriptorProtoOutputType; x -> x }-    , methodDescriptorProtoOptions = case b.methodDescriptorProtoOptions of { Nothing -> a.methodDescriptorProtoOptions; x -> x }-    , methodDescriptorProtoClientStreaming = case b.methodDescriptorProtoClientStreaming of { Nothing -> a.methodDescriptorProtoClientStreaming; x -> x }-    , methodDescriptorProtoServerStreaming = case b.methodDescriptorProtoServerStreaming of { Nothing -> a.methodDescriptorProtoServerStreaming; x -> x }-    , methodDescriptorProtoUnknownFields = a.methodDescriptorProtoUnknownFields <> b.methodDescriptorProtoUnknownFields-    }--instance Monoid MethodDescriptorProto where-  mempty = defaultMethodDescriptorProto---- | ===================================================================--- Options--- Each of the definitions above may have "options" attached.  These are--- just annotations which may cause code to be generated slightly differently--- or may contain hints for code that manipulates protocol messages.--- --- Clients may define custom options as extensions of the *Options messages.--- These extensions may not yet be known at parsing time, so the parser cannot--- store the values in them.  Instead it stores them in a field in the *Options--- message called uninterpreted_option. This field must have the same name--- across all *Options messages. We then use this field to populate the--- extensions when we build a descriptor, at which point all protos have been--- parsed and so all extensions are known.--- --- Extension numbers for custom options may be chosen as follows:--- * For options which will only be used within a single application or---   organization, or for experimental options, use field numbers 50000---   through 99999.  It is up to you to ensure that you do not use the---   same number for multiple options.--- * For options which will be published and used publicly by multiple---   independent entities, e-mail protobuf-global-extension-registry@google.com---   to reserve extension numbers. Simply provide your project name (e.g.---   Objective-C plugin) and your project website (if available) -- there's no---   need to explain how you intend to use them. Usually you only need one---   extension number. You can declare multiple options with only one extension---   number by putting them in a sub-message. See the Custom Options section of---   the docs for examples:---   https://developers.google.com/protocol-buffers/docs/proto#options---   If this turns out to be popular, a web service will be set up---   to automatically assign option numbers.-data FileOptions = FileOptions-  { fileOptionsJavaPackage :: !(Maybe Text)-    -- ^ Sets the Java package where classes generated from this .proto will be-    -- placed.  By default, the proto package is used, but this is often-    -- inappropriate because proto packages do not normally start with backwards-    -- domain names.-  , fileOptionsJavaOuterClassname :: !(Maybe Text)-    -- ^ Controls the name of the wrapper Java class generated for the .proto file.-    -- That class will always contain the .proto file's getDescriptor() method as-    -- well as any top-level extensions defined in the .proto file.-    -- If java_multiple_files is disabled, then all the other classes from the-    -- .proto file will be nested inside the single wrapper outer class.-  , fileOptionsJavaMultipleFiles :: !(Maybe Bool)-    -- ^ If enabled, then the Java code generator will generate a separate .java-    -- file for each top-level message, enum, and service defined in the .proto-    -- file.  Thus, these types will *not* be nested inside the wrapper class-    -- named by java_outer_classname.  However, the wrapper class will still be-    -- generated to contain the file's getDescriptor() method as well as any-    -- top-level extensions defined in the file.-  , fileOptionsJavaGenerateEqualsAndHash :: !(Maybe Bool)-    -- ^ This option does nothing.-  , fileOptionsJavaStringCheckUtf8 :: !(Maybe Bool)-    -- ^ A proto2 file can set this to true to opt in to UTF-8 checking for Java,-    -- which will throw an exception if invalid UTF-8 is parsed from the wire or-    -- assigned to a string field.-    -- -    -- TODO: clarify exactly what kinds of field types this option-    -- applies to, and update these docs accordingly.-    -- -    -- Proto3 files already perform these checks. Setting the option explicitly to-    -- false has no effect: it cannot be used to opt proto3 files out of UTF-8-    -- checks.-  , fileOptionsOptimizeFor :: !(Maybe FileOptions'OptimizeMode)-  , fileOptionsGoPackage :: !(Maybe Text)-    -- ^ Sets the Go package where structs generated from this .proto will be-    -- placed. If omitted, the Go package will be derived from the following:-    --   - The basename of the package import path, if provided.-    --   - Otherwise, the package statement in the .proto file, if present.-    --   - Otherwise, the basename of the .proto file, without extension.-  , fileOptionsCcGenericServices :: !(Maybe Bool)-    -- ^ Should generic services be generated in each language?  "Generic" services-    -- are not specific to any particular RPC system.  They are generated by the-    -- main code generators in each language (without additional plugins).-    -- Generic services were the only kind of service generation supported by-    -- early versions of google.protobuf.-    -- -    -- Generic services are now considered deprecated in favor of using plugins-    -- that generate code specific to your particular RPC system.  Therefore,-    -- these default to false.  Old code which depends on generic services should-    -- explicitly set them to true.-  , fileOptionsJavaGenericServices :: !(Maybe Bool)-  , fileOptionsPyGenericServices :: !(Maybe Bool)-  , fileOptionsDeprecated :: !(Maybe Bool)-    -- ^ Is this file deprecated?-    -- Depending on the target platform, this can emit Deprecated annotations-    -- for everything in the file, or it will be completely ignored; in the very-    -- least, this is a formalization for deprecating files.-  , fileOptionsCcEnableArenas :: !(Maybe Bool)-    -- ^ Enables the use of arenas for the proto messages in this file. This applies-    -- only to generated classes for C++.-  , fileOptionsObjcClassPrefix :: !(Maybe Text)-    -- ^ Sets the objective c class prefix which is prepended to all objective c-    -- generated classes from this .proto. There is no default.-  , fileOptionsCsharpNamespace :: !(Maybe Text)-    -- ^ Namespace for generated classes; defaults to the package.-  , fileOptionsSwiftPrefix :: !(Maybe Text)-    -- ^ By default Swift generators will take the proto package and CamelCase it-    -- replacing '.' with underscore and use that to prefix the types/symbols-    -- defined. When this options is provided, they will use this value instead-    -- to prefix the types/symbols defined.-  , fileOptionsPhpClassPrefix :: !(Maybe Text)-    -- ^ Sets the php class prefix which is prepended to all php generated classes-    -- from this .proto. Default is empty.-  , fileOptionsPhpNamespace :: !(Maybe Text)-    -- ^ Use this option to change the namespace of php generated classes. Default-    -- is empty. When this option is empty, the package name will be used for-    -- determining the namespace.-  , fileOptionsPhpMetadataNamespace :: !(Maybe Text)-    -- ^ Use this option to change the namespace of php generated metadata classes.-    -- Default is empty. When this option is empty, the proto file name will be-    -- used for determining the namespace.-  , fileOptionsRubyPackage :: !(Maybe Text)-    -- ^ Use this option to change the package of ruby generated classes. Default-    -- is empty. When this option is not set, the package name will be used for-    -- determining the ruby package.-  , fileOptionsFeatures :: !(Maybe FeatureSet)-    -- ^ Any features defined in the specific edition.-  , fileOptionsUninterpretedOption :: !(V.Vector UninterpretedOption)-    -- ^ The parser stores options it doesn't recognize here.-    -- See the documentation for the "Options" section above.-  , fileOptionsUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData---- | Generated classes can be optimized for speed or code size.-data FileOptions'OptimizeMode-  = FileOptions'OptimizeMode'Speed-  | FileOptions'OptimizeMode'CodeSize-    -- ^ etc.-  | FileOptions'OptimizeMode'LiteRuntime-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumFileOptions'OptimizeMode :: FileOptions'OptimizeMode -> Int-toProtoEnumFileOptions'OptimizeMode FileOptions'OptimizeMode'Speed = 1-toProtoEnumFileOptions'OptimizeMode FileOptions'OptimizeMode'CodeSize = 2-toProtoEnumFileOptions'OptimizeMode FileOptions'OptimizeMode'LiteRuntime = 3--fromProtoEnumFileOptions'OptimizeMode :: Int -> Maybe FileOptions'OptimizeMode-fromProtoEnumFileOptions'OptimizeMode 1 = Just FileOptions'OptimizeMode'Speed-fromProtoEnumFileOptions'OptimizeMode 2 = Just FileOptions'OptimizeMode'CodeSize-fromProtoEnumFileOptions'OptimizeMode 3 = Just FileOptions'OptimizeMode'LiteRuntime-fromProtoEnumFileOptions'OptimizeMode _ = Nothing--instance MessageEncode FileOptions'OptimizeMode where-  buildSized _ = mempty-instance MessageDecode FileOptions'OptimizeMode where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON FileOptions'OptimizeMode where-  toJSON FileOptions'OptimizeMode'Speed = Aeson.String "SPEED"-  toJSON FileOptions'OptimizeMode'CodeSize = Aeson.String "CODE_SIZE"-  toJSON FileOptions'OptimizeMode'LiteRuntime = Aeson.String "LITE_RUNTIME"--instance Aeson.FromJSON FileOptions'OptimizeMode where-  parseJSON = \case-    Aeson.String "SPEED" -> pure FileOptions'OptimizeMode'Speed-    Aeson.String "CODE_SIZE" -> pure FileOptions'OptimizeMode'CodeSize-    Aeson.String "LITE_RUNTIME" -> pure FileOptions'OptimizeMode'LiteRuntime-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for FileOptions'OptimizeMode"--instance Hashable FileOptions'OptimizeMode where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumFileOptions'OptimizeMode x)--defaultFileOptions :: FileOptions-defaultFileOptions = FileOptions-  { fileOptionsJavaPackage = Nothing-  , fileOptionsJavaOuterClassname = Nothing-  , fileOptionsJavaMultipleFiles = Nothing-  , fileOptionsJavaGenerateEqualsAndHash = Nothing-  , fileOptionsJavaStringCheckUtf8 = Nothing-  , fileOptionsOptimizeFor = Nothing-  , fileOptionsGoPackage = Nothing-  , fileOptionsCcGenericServices = Nothing-  , fileOptionsJavaGenericServices = Nothing-  , fileOptionsPyGenericServices = Nothing-  , fileOptionsDeprecated = Nothing-  , fileOptionsCcEnableArenas = Nothing-  , fileOptionsObjcClassPrefix = Nothing-  , fileOptionsCsharpNamespace = Nothing-  , fileOptionsSwiftPrefix = Nothing-  , fileOptionsPhpClassPrefix = Nothing-  , fileOptionsPhpNamespace = Nothing-  , fileOptionsPhpMetadataNamespace = Nothing-  , fileOptionsRubyPackage = Nothing-  , fileOptionsFeatures = Nothing-  , fileOptionsUninterpretedOption = V.empty-  , fileOptionsUnknownFields = []-  }--instance MessageEncode FileOptions where-  buildSized msg =-    (maybe mempty (\v -> archString 10 v) msg.fileOptionsJavaPackage)-    <> (maybe mempty (\v -> archString 66 v) msg.fileOptionsJavaOuterClassname)-    <> (maybe mempty (\v -> archBool 80 v) msg.fileOptionsJavaMultipleFiles)-    <> (maybe mempty (\v -> archBool 160 v) msg.fileOptionsJavaGenerateEqualsAndHash)-    <> (maybe mempty (\v -> archBool 216 v) msg.fileOptionsJavaStringCheckUtf8)-    <> (maybe mempty (\v -> archVarint 72 (fromIntegral (toProtoEnumFileOptions'OptimizeMode v))) msg.fileOptionsOptimizeFor)-    <> (maybe mempty (\v -> archString 90 v) msg.fileOptionsGoPackage)-    <> (maybe mempty (\v -> archBool 128 v) msg.fileOptionsCcGenericServices)-    <> (maybe mempty (\v -> archBool 136 v) msg.fileOptionsJavaGenericServices)-    <> (maybe mempty (\v -> archBool 144 v) msg.fileOptionsPyGenericServices)-    <> (maybe mempty (\v -> archBool 184 v) msg.fileOptionsDeprecated)-    <> (maybe mempty (\v -> archBool 248 v) msg.fileOptionsCcEnableArenas)-    <> (maybe mempty (\v -> archString 290 v) msg.fileOptionsObjcClassPrefix)-    <> (maybe mempty (\v -> archString 298 v) msg.fileOptionsCsharpNamespace)-    <> (maybe mempty (\v -> archString 314 v) msg.fileOptionsSwiftPrefix)-    <> (maybe mempty (\v -> archString 322 v) msg.fileOptionsPhpClassPrefix)-    <> (maybe mempty (\v -> archString 330 v) msg.fileOptionsPhpNamespace)-    <> (maybe mempty (\v -> archString 354 v) msg.fileOptionsPhpMetadataNamespace)-    <> (maybe mempty (\v -> archString 362 v) msg.fileOptionsRubyPackage)-    <> (maybe mempty (\v -> archSubmessage 402 (buildSized v)) msg.fileOptionsFeatures)-    <> V.foldl' (\acc v -> acc <> archSubmessage 7994 (buildSized v)) mempty msg.fileOptionsUninterpretedOption-    <> encodeUnknownFieldsSized msg.fileOptionsUnknownFields--instance MessageDecode FileOptions where-  messageDecoder = stage_0 defaultFileOptions emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_1 (msg { fileOptionsJavaPackage = (Just v)}) gl_0)-          (pure (case msg.fileOptionsUnknownFields of { [] -> msg { fileOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { fileOptionsUninterpretedOption = growListToVector gl_0, fileOptionsUnknownFields = reverse (msg.fileOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_1 msg gl_0 =-        inOrderStage1-          (0x42 :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_2 (msg { fileOptionsJavaOuterClassname = (Just v)}) gl_0)-          (pure (case msg.fileOptionsUnknownFields of { [] -> msg { fileOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { fileOptionsUninterpretedOption = growListToVector gl_0, fileOptionsUnknownFields = reverse (msg.fileOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_2 msg gl_0 =-        inOrderStage1-          (0x50 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_3 (msg { fileOptionsJavaMultipleFiles = (Just v)}) gl_0)-          (pure (case msg.fileOptionsUnknownFields of { [] -> msg { fileOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { fileOptionsUninterpretedOption = growListToVector gl_0, fileOptionsUnknownFields = reverse (msg.fileOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_3 msg gl_0 =-        inOrderStage-          0x1a0-          0xffff-          2-          decodeFieldBool-          (\v -> stage_4 (msg { fileOptionsJavaGenerateEqualsAndHash = (Just v)}) gl_0)-          (pure (case msg.fileOptionsUnknownFields of { [] -> msg { fileOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { fileOptionsUninterpretedOption = growListToVector gl_0, fileOptionsUnknownFields = reverse (msg.fileOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_4 msg gl_0 =-        inOrderStage-          0x1d8-          0xffff-          2-          decodeFieldBool-          (\v -> stage_5 (msg { fileOptionsJavaStringCheckUtf8 = (Just v)}) gl_0)-          (pure (case msg.fileOptionsUnknownFields of { [] -> msg { fileOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { fileOptionsUninterpretedOption = growListToVector gl_0, fileOptionsUnknownFields = reverse (msg.fileOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_5 msg gl_0 =-        inOrderStage1-          (0x48 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> stage_6 (msg { fileOptionsOptimizeFor = (Just v)}) gl_0)-          (pure (case msg.fileOptionsUnknownFields of { [] -> msg { fileOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { fileOptionsUninterpretedOption = growListToVector gl_0, fileOptionsUnknownFields = reverse (msg.fileOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_6 msg gl_0 =-        inOrderStage1-          (0x5a :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_7 (msg { fileOptionsGoPackage = (Just v)}) gl_0)-          (pure (case msg.fileOptionsUnknownFields of { [] -> msg { fileOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { fileOptionsUninterpretedOption = growListToVector gl_0, fileOptionsUnknownFields = reverse (msg.fileOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_7 msg gl_0 =-        inOrderStage-          0x180-          0xffff-          2-          decodeFieldBool-          (\v -> loop (msg { fileOptionsCcGenericServices = (Just v)}) gl_0)-          (pure (case msg.fileOptionsUnknownFields of { [] -> msg { fileOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { fileOptionsUninterpretedOption = growListToVector gl_0, fileOptionsUnknownFields = reverse (msg.fileOptionsUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.fileOptionsUnknownFields of { [] -> msg { fileOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { fileOptionsUninterpretedOption = growListToVector gl_0, fileOptionsUnknownFields = reverse (msg.fileOptionsUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { fileOptionsJavaPackage = (Just v)}) gl_0-          8 -> do-            v <- decodeFieldString-            loop (msg { fileOptionsJavaOuterClassname = (Just v)}) gl_0-          10 -> do-            v <- decodeFieldBool-            loop (msg { fileOptionsJavaMultipleFiles = (Just v)}) gl_0-          20 -> do-            v <- decodeFieldBool-            loop (msg { fileOptionsJavaGenerateEqualsAndHash = (Just v)}) gl_0-          27 -> do-            v <- decodeFieldBool-            loop (msg { fileOptionsJavaStringCheckUtf8 = (Just v)}) gl_0-          9 -> do-            v <- decodeFieldEnum-            loop (msg { fileOptionsOptimizeFor = (Just v)}) gl_0-          11 -> do-            v <- decodeFieldString-            loop (msg { fileOptionsGoPackage = (Just v)}) gl_0-          16 -> do-            v <- decodeFieldBool-            loop (msg { fileOptionsCcGenericServices = (Just v)}) gl_0-          17 -> do-            v <- decodeFieldBool-            loop (msg { fileOptionsJavaGenericServices = (Just v)}) gl_0-          18 -> do-            v <- decodeFieldBool-            loop (msg { fileOptionsPyGenericServices = (Just v)}) gl_0-          23 -> do-            v <- decodeFieldBool-            loop (msg { fileOptionsDeprecated = (Just v)}) gl_0-          31 -> do-            v <- decodeFieldBool-            loop (msg { fileOptionsCcEnableArenas = (Just v)}) gl_0-          36 -> do-            v <- decodeFieldString-            loop (msg { fileOptionsObjcClassPrefix = (Just v)}) gl_0-          37 -> do-            v <- decodeFieldString-            loop (msg { fileOptionsCsharpNamespace = (Just v)}) gl_0-          39 -> do-            v <- decodeFieldString-            loop (msg { fileOptionsSwiftPrefix = (Just v)}) gl_0-          40 -> do-            v <- decodeFieldString-            loop (msg { fileOptionsPhpClassPrefix = (Just v)}) gl_0-          41 -> do-            v <- decodeFieldString-            loop (msg { fileOptionsPhpNamespace = (Just v)}) gl_0-          44 -> do-            v <- decodeFieldString-            loop (msg { fileOptionsPhpMetadataNamespace = (Just v)}) gl_0-          45 -> do-            v <- decodeFieldString-            loop (msg { fileOptionsRubyPackage = (Just v)}) gl_0-          50 -> do-            v <- decodeFieldMessage-            loop (msg { fileOptionsFeatures = (Just v)}) gl_0-          999 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { fileOptionsUnknownFields = (uf : msg.fileOptionsUnknownFields)}) gl_0)---- | Field descriptors for 'FileOptions', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-fileOptionsFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor FileOptions)-fileOptionsFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "java_package"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsJavaPackage-        , fdSet = \v m -> m { fileOptionsJavaPackage = v }-        }), (8, SomeField FieldDescriptor-        { fdName = "java_outer_classname"-        , fdNumber = 8-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsJavaOuterClassname-        , fdSet = \v m -> m { fileOptionsJavaOuterClassname = v }-        })-    , (10, SomeField FieldDescriptor-        { fdName = "java_multiple_files"-        , fdNumber = 10-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsJavaMultipleFiles-        , fdSet = \v m -> m { fileOptionsJavaMultipleFiles = v }-        })-    , (20, SomeField FieldDescriptor-        { fdName = "java_generate_equals_and_hash"-        , fdNumber = 20-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsJavaGenerateEqualsAndHash-        , fdSet = \v m -> m { fileOptionsJavaGenerateEqualsAndHash = v }-        })-    , (27, SomeField FieldDescriptor-        { fdName = "java_string_check_utf8"-        , fdNumber = 27-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsJavaStringCheckUtf8-        , fdSet = \v m -> m { fileOptionsJavaStringCheckUtf8 = v }-        })-    , (9, SomeField FieldDescriptor-        { fdName = "optimize_for"-        , fdNumber = 9-        , fdTypeDesc = MessageType "OptimizeMode"-        , fdLabel = LabelOptional-        , fdGet = fileOptionsOptimizeFor-        , fdSet = \v m -> m { fileOptionsOptimizeFor = v }-        })-    , (11, SomeField FieldDescriptor-        { fdName = "go_package"-        , fdNumber = 11-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsGoPackage-        , fdSet = \v m -> m { fileOptionsGoPackage = v }-        })-    , (16, SomeField FieldDescriptor-        { fdName = "cc_generic_services"-        , fdNumber = 16-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsCcGenericServices-        , fdSet = \v m -> m { fileOptionsCcGenericServices = v }-        })-    , (17, SomeField FieldDescriptor-        { fdName = "java_generic_services"-        , fdNumber = 17-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsJavaGenericServices-        , fdSet = \v m -> m { fileOptionsJavaGenericServices = v }-        })-    , (18, SomeField FieldDescriptor-        { fdName = "py_generic_services"-        , fdNumber = 18-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsPyGenericServices-        , fdSet = \v m -> m { fileOptionsPyGenericServices = v }-        })-    , (23, SomeField FieldDescriptor-        { fdName = "deprecated"-        , fdNumber = 23-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsDeprecated-        , fdSet = \v m -> m { fileOptionsDeprecated = v }-        })-    , (31, SomeField FieldDescriptor-        { fdName = "cc_enable_arenas"-        , fdNumber = 31-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsCcEnableArenas-        , fdSet = \v m -> m { fileOptionsCcEnableArenas = v }-        })-    , (36, SomeField FieldDescriptor-        { fdName = "objc_class_prefix"-        , fdNumber = 36-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsObjcClassPrefix-        , fdSet = \v m -> m { fileOptionsObjcClassPrefix = v }-        })-    , (37, SomeField FieldDescriptor-        { fdName = "csharp_namespace"-        , fdNumber = 37-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsCsharpNamespace-        , fdSet = \v m -> m { fileOptionsCsharpNamespace = v }-        })-    , (39, SomeField FieldDescriptor-        { fdName = "swift_prefix"-        , fdNumber = 39-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsSwiftPrefix-        , fdSet = \v m -> m { fileOptionsSwiftPrefix = v }-        })-    , (40, SomeField FieldDescriptor-        { fdName = "php_class_prefix"-        , fdNumber = 40-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsPhpClassPrefix-        , fdSet = \v m -> m { fileOptionsPhpClassPrefix = v }-        })-    , (41, SomeField FieldDescriptor-        { fdName = "php_namespace"-        , fdNumber = 41-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsPhpNamespace-        , fdSet = \v m -> m { fileOptionsPhpNamespace = v }-        })-    , (44, SomeField FieldDescriptor-        { fdName = "php_metadata_namespace"-        , fdNumber = 44-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsPhpMetadataNamespace-        , fdSet = \v m -> m { fileOptionsPhpMetadataNamespace = v }-        })-    , (45, SomeField FieldDescriptor-        { fdName = "ruby_package"-        , fdNumber = 45-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fileOptionsRubyPackage-        , fdSet = \v m -> m { fileOptionsRubyPackage = v }-        })-    , (50, SomeField FieldDescriptor-        { fdName = "features"-        , fdNumber = 50-        , fdTypeDesc = MessageType "FeatureSet"-        , fdLabel = LabelOptional-        , fdGet = fileOptionsFeatures-        , fdSet = \v m -> m { fileOptionsFeatures = v }-        })-    , (999, SomeField FieldDescriptor-        { fdName = "uninterpreted_option"-        , fdNumber = 999-        , fdTypeDesc = MessageType "UninterpretedOption"-        , fdLabel = LabelRepeated-        , fdGet = fileOptionsUninterpretedOption-        , fdSet = \v m -> m { fileOptionsUninterpretedOption = v }-        })-    ]--instance ProtoMessage FileOptions where-  protoMessageName _ = "google.protobuf.FileOptions"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultFileOptions-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = fileOptionsFieldDescriptors--instance IsMessage FileOptions--instance Aeson.ToJSON FileOptions where-  toJSON msg = jsonObject-      [ "javaPackage" .=: msg.fileOptionsJavaPackage-      , "javaOuterClassname" .=: msg.fileOptionsJavaOuterClassname-      , "javaMultipleFiles" .=: msg.fileOptionsJavaMultipleFiles-      , "javaGenerateEqualsAndHash" .=: msg.fileOptionsJavaGenerateEqualsAndHash-      , "javaStringCheckUtf8" .=: msg.fileOptionsJavaStringCheckUtf8-      , "optimizeFor" .=: msg.fileOptionsOptimizeFor-      , "goPackage" .=: msg.fileOptionsGoPackage-      , "ccGenericServices" .=: msg.fileOptionsCcGenericServices-      , "javaGenericServices" .=: msg.fileOptionsJavaGenericServices-      , "pyGenericServices" .=: msg.fileOptionsPyGenericServices-      , "deprecated" .=: msg.fileOptionsDeprecated-      , "ccEnableArenas" .=: msg.fileOptionsCcEnableArenas-      , "objcClassPrefix" .=: msg.fileOptionsObjcClassPrefix-      , "csharpNamespace" .=: msg.fileOptionsCsharpNamespace-      , "swiftPrefix" .=: msg.fileOptionsSwiftPrefix-      , "phpClassPrefix" .=: msg.fileOptionsPhpClassPrefix-      , "phpNamespace" .=: msg.fileOptionsPhpNamespace-      , "phpMetadataNamespace" .=: msg.fileOptionsPhpMetadataNamespace-      , "rubyPackage" .=: msg.fileOptionsRubyPackage-      , "features" .=: msg.fileOptionsFeatures-      , "uninterpretedOption" .=: msg.fileOptionsUninterpretedOption-      ]--instance Aeson.FromJSON FileOptions where-  parseJSON = Aeson.withObject "FileOptions" $ \obj -> do-    fld_fileOptionsJavaPackage <- parseFieldMaybe obj "javaPackage"-    fld_fileOptionsJavaOuterClassname <- parseFieldMaybe obj "javaOuterClassname"-    fld_fileOptionsJavaMultipleFiles <- parseFieldMaybe obj "javaMultipleFiles"-    fld_fileOptionsJavaGenerateEqualsAndHash <- parseFieldMaybe obj "javaGenerateEqualsAndHash"-    fld_fileOptionsJavaStringCheckUtf8 <- parseFieldMaybe obj "javaStringCheckUtf8"-    fld_fileOptionsOptimizeFor <- parseFieldMaybe obj "optimizeFor"-    fld_fileOptionsGoPackage <- parseFieldMaybe obj "goPackage"-    fld_fileOptionsCcGenericServices <- parseFieldMaybe obj "ccGenericServices"-    fld_fileOptionsJavaGenericServices <- parseFieldMaybe obj "javaGenericServices"-    fld_fileOptionsPyGenericServices <- parseFieldMaybe obj "pyGenericServices"-    fld_fileOptionsDeprecated <- parseFieldMaybe obj "deprecated"-    fld_fileOptionsCcEnableArenas <- parseFieldMaybe obj "ccEnableArenas"-    fld_fileOptionsObjcClassPrefix <- parseFieldMaybe obj "objcClassPrefix"-    fld_fileOptionsCsharpNamespace <- parseFieldMaybe obj "csharpNamespace"-    fld_fileOptionsSwiftPrefix <- parseFieldMaybe obj "swiftPrefix"-    fld_fileOptionsPhpClassPrefix <- parseFieldMaybe obj "phpClassPrefix"-    fld_fileOptionsPhpNamespace <- parseFieldMaybe obj "phpNamespace"-    fld_fileOptionsPhpMetadataNamespace <- parseFieldMaybe obj "phpMetadataNamespace"-    fld_fileOptionsRubyPackage <- parseFieldMaybe obj "rubyPackage"-    fld_fileOptionsFeatures <- parseFieldMaybe obj "features"-    fld_fileOptionsUninterpretedOption <- parseFieldMaybe obj "uninterpretedOption"-    pure defaultFileOptions-      { fileOptionsJavaPackage = maybe (fileOptionsJavaPackage defaultFileOptions) id fld_fileOptionsJavaPackage-      , fileOptionsJavaOuterClassname = maybe (fileOptionsJavaOuterClassname defaultFileOptions) id fld_fileOptionsJavaOuterClassname-      , fileOptionsJavaMultipleFiles = maybe (fileOptionsJavaMultipleFiles defaultFileOptions) id fld_fileOptionsJavaMultipleFiles-      , fileOptionsJavaGenerateEqualsAndHash = maybe (fileOptionsJavaGenerateEqualsAndHash defaultFileOptions) id fld_fileOptionsJavaGenerateEqualsAndHash-      , fileOptionsJavaStringCheckUtf8 = maybe (fileOptionsJavaStringCheckUtf8 defaultFileOptions) id fld_fileOptionsJavaStringCheckUtf8-      , fileOptionsOptimizeFor = maybe (fileOptionsOptimizeFor defaultFileOptions) id fld_fileOptionsOptimizeFor-      , fileOptionsGoPackage = maybe (fileOptionsGoPackage defaultFileOptions) id fld_fileOptionsGoPackage-      , fileOptionsCcGenericServices = maybe (fileOptionsCcGenericServices defaultFileOptions) id fld_fileOptionsCcGenericServices-      , fileOptionsJavaGenericServices = maybe (fileOptionsJavaGenericServices defaultFileOptions) id fld_fileOptionsJavaGenericServices-      , fileOptionsPyGenericServices = maybe (fileOptionsPyGenericServices defaultFileOptions) id fld_fileOptionsPyGenericServices-      , fileOptionsDeprecated = maybe (fileOptionsDeprecated defaultFileOptions) id fld_fileOptionsDeprecated-      , fileOptionsCcEnableArenas = maybe (fileOptionsCcEnableArenas defaultFileOptions) id fld_fileOptionsCcEnableArenas-      , fileOptionsObjcClassPrefix = maybe (fileOptionsObjcClassPrefix defaultFileOptions) id fld_fileOptionsObjcClassPrefix-      , fileOptionsCsharpNamespace = maybe (fileOptionsCsharpNamespace defaultFileOptions) id fld_fileOptionsCsharpNamespace-      , fileOptionsSwiftPrefix = maybe (fileOptionsSwiftPrefix defaultFileOptions) id fld_fileOptionsSwiftPrefix-      , fileOptionsPhpClassPrefix = maybe (fileOptionsPhpClassPrefix defaultFileOptions) id fld_fileOptionsPhpClassPrefix-      , fileOptionsPhpNamespace = maybe (fileOptionsPhpNamespace defaultFileOptions) id fld_fileOptionsPhpNamespace-      , fileOptionsPhpMetadataNamespace = maybe (fileOptionsPhpMetadataNamespace defaultFileOptions) id fld_fileOptionsPhpMetadataNamespace-      , fileOptionsRubyPackage = maybe (fileOptionsRubyPackage defaultFileOptions) id fld_fileOptionsRubyPackage-      , fileOptionsFeatures = maybe (fileOptionsFeatures defaultFileOptions) id fld_fileOptionsFeatures-      , fileOptionsUninterpretedOption = maybe (fileOptionsUninterpretedOption defaultFileOptions) id fld_fileOptionsUninterpretedOption-      }--instance Hashable FileOptions where-  hashWithSalt salt msg = V.foldl' hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.fileOptionsJavaPackage) msg.fileOptionsJavaOuterClassname) msg.fileOptionsJavaMultipleFiles) msg.fileOptionsJavaGenerateEqualsAndHash) msg.fileOptionsJavaStringCheckUtf8) msg.fileOptionsOptimizeFor) msg.fileOptionsGoPackage) msg.fileOptionsCcGenericServices) msg.fileOptionsJavaGenericServices) msg.fileOptionsPyGenericServices) msg.fileOptionsDeprecated) msg.fileOptionsCcEnableArenas) msg.fileOptionsObjcClassPrefix) msg.fileOptionsCsharpNamespace) msg.fileOptionsSwiftPrefix) msg.fileOptionsPhpClassPrefix) msg.fileOptionsPhpNamespace) msg.fileOptionsPhpMetadataNamespace) msg.fileOptionsRubyPackage) msg.fileOptionsFeatures) msg.fileOptionsUninterpretedOption--instance Proto.Extension.HasExtensions FileOptions where-  messageUnknownFields = fileOptionsUnknownFields-  setMessageUnknownFields !ufs msg = msg { fileOptionsUnknownFields = ufs }--instance Semigroup FileOptions where-  a <> b = FileOptions-    { fileOptionsJavaPackage = case b.fileOptionsJavaPackage of { Nothing -> a.fileOptionsJavaPackage; x -> x }-    , fileOptionsJavaOuterClassname = case b.fileOptionsJavaOuterClassname of { Nothing -> a.fileOptionsJavaOuterClassname; x -> x }-    , fileOptionsJavaMultipleFiles = case b.fileOptionsJavaMultipleFiles of { Nothing -> a.fileOptionsJavaMultipleFiles; x -> x }-    , fileOptionsJavaGenerateEqualsAndHash = case b.fileOptionsJavaGenerateEqualsAndHash of { Nothing -> a.fileOptionsJavaGenerateEqualsAndHash; x -> x }-    , fileOptionsJavaStringCheckUtf8 = case b.fileOptionsJavaStringCheckUtf8 of { Nothing -> a.fileOptionsJavaStringCheckUtf8; x -> x }-    , fileOptionsOptimizeFor = case b.fileOptionsOptimizeFor of { Nothing -> a.fileOptionsOptimizeFor; x -> x }-    , fileOptionsGoPackage = case b.fileOptionsGoPackage of { Nothing -> a.fileOptionsGoPackage; x -> x }-    , fileOptionsCcGenericServices = case b.fileOptionsCcGenericServices of { Nothing -> a.fileOptionsCcGenericServices; x -> x }-    , fileOptionsJavaGenericServices = case b.fileOptionsJavaGenericServices of { Nothing -> a.fileOptionsJavaGenericServices; x -> x }-    , fileOptionsPyGenericServices = case b.fileOptionsPyGenericServices of { Nothing -> a.fileOptionsPyGenericServices; x -> x }-    , fileOptionsDeprecated = case b.fileOptionsDeprecated of { Nothing -> a.fileOptionsDeprecated; x -> x }-    , fileOptionsCcEnableArenas = case b.fileOptionsCcEnableArenas of { Nothing -> a.fileOptionsCcEnableArenas; x -> x }-    , fileOptionsObjcClassPrefix = case b.fileOptionsObjcClassPrefix of { Nothing -> a.fileOptionsObjcClassPrefix; x -> x }-    , fileOptionsCsharpNamespace = case b.fileOptionsCsharpNamespace of { Nothing -> a.fileOptionsCsharpNamespace; x -> x }-    , fileOptionsSwiftPrefix = case b.fileOptionsSwiftPrefix of { Nothing -> a.fileOptionsSwiftPrefix; x -> x }-    , fileOptionsPhpClassPrefix = case b.fileOptionsPhpClassPrefix of { Nothing -> a.fileOptionsPhpClassPrefix; x -> x }-    , fileOptionsPhpNamespace = case b.fileOptionsPhpNamespace of { Nothing -> a.fileOptionsPhpNamespace; x -> x }-    , fileOptionsPhpMetadataNamespace = case b.fileOptionsPhpMetadataNamespace of { Nothing -> a.fileOptionsPhpMetadataNamespace; x -> x }-    , fileOptionsRubyPackage = case b.fileOptionsRubyPackage of { Nothing -> a.fileOptionsRubyPackage; x -> x }-    , fileOptionsFeatures = case b.fileOptionsFeatures of { Nothing -> a.fileOptionsFeatures; x -> x }-    , fileOptionsUninterpretedOption = a.fileOptionsUninterpretedOption <> b.fileOptionsUninterpretedOption-    , fileOptionsUnknownFields = a.fileOptionsUnknownFields <> b.fileOptionsUnknownFields-    }--instance Monoid FileOptions where-  mempty = defaultFileOptions--data MessageOptions = MessageOptions-  { messageOptionsMessageSetWireFormat :: !(Maybe Bool)-    -- ^ Set true to use the old proto1 MessageSet wire format for extensions.-    -- This is provided for backwards-compatibility with the MessageSet wire-    -- format.  You should not use this for any other reason:  It's less-    -- efficient, has fewer features, and is more complicated.-    -- -    -- The message must be defined exactly as follows:-    --   message Foo {-    --     option message_set_wire_format = true;-    --     extensions 4 to max;-    --   }-    -- Note that the message cannot have any defined fields; MessageSets only-    -- have extensions.-    -- -    -- All extensions of your type must be singular messages; e.g. they cannot-    -- be int32s, enums, or repeated messages.-    -- -    -- Because this is an option, the above two restrictions are not enforced by-    -- the protocol compiler.-  , messageOptionsNoStandardDescriptorAccessor :: !(Maybe Bool)-    -- ^ Disables the generation of the standard "descriptor()" accessor, which can-    -- conflict with a field of the same name.  This is meant to make migration-    -- from proto1 easier; new code should avoid fields named "descriptor".-  , messageOptionsDeprecated :: !(Maybe Bool)-    -- ^ Is this message deprecated?-    -- Depending on the target platform, this can emit Deprecated annotations-    -- for the message, or it will be completely ignored; in the very least,-    -- this is a formalization for deprecating messages.-  , messageOptionsMapEntry :: !(Maybe Bool)-    -- ^ Whether the message is an automatically generated map entry type for the-    -- maps field.-    -- -    -- For maps fields:-    --     map<KeyType, ValueType> map_field = 1;-    -- The parsed descriptor looks like:-    --     message MapFieldEntry {-    --         option map_entry = true;-    --         optional KeyType key = 1;-    --         optional ValueType value = 2;-    --     }-    --     repeated MapFieldEntry map_field = 1;-    -- -    -- Implementations may choose not to generate the map_entry=true message, but-    -- use a native map in the target language to hold the keys and values.-    -- The reflection APIs in such implementations still need to work as-    -- if the field is a repeated message field.-    -- -    -- NOTE: Do not set the option in .proto files. Always use the maps syntax-    -- instead. The option should only be implicitly set by the proto compiler-    -- parser.-  , messageOptionsDeprecatedLegacyJsonFieldConflicts :: !(Maybe Bool)-    -- ^ Enable the legacy handling of JSON field name conflicts.  This lowercases-    -- and strips underscored from the fields before comparison in proto3 only.-    -- The new behavior takes `json_name` into account and applies to proto2 as-    -- well.-    -- -    -- This should only be used as a temporary measure against broken builds due-    -- to the change in behavior for JSON field name conflicts.-    -- -    -- TODO This is legacy behavior we plan to remove once downstream-    -- teams have had time to migrate.-  , messageOptionsFeatures :: !(Maybe FeatureSet)-    -- ^ Any features defined in the specific edition.-  , messageOptionsUninterpretedOption :: !(V.Vector UninterpretedOption)-    -- ^ The parser stores options it doesn't recognize here. See above.-  , messageOptionsUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultMessageOptions :: MessageOptions-defaultMessageOptions = MessageOptions-  { messageOptionsMessageSetWireFormat = Nothing-  , messageOptionsNoStandardDescriptorAccessor = Nothing-  , messageOptionsDeprecated = Nothing-  , messageOptionsMapEntry = Nothing-  , messageOptionsDeprecatedLegacyJsonFieldConflicts = Nothing-  , messageOptionsFeatures = Nothing-  , messageOptionsUninterpretedOption = V.empty-  , messageOptionsUnknownFields = []-  }--instance MessageEncode MessageOptions where-  buildSized msg =-    (maybe mempty (\v -> archBool 8 v) msg.messageOptionsMessageSetWireFormat)-    <> (maybe mempty (\v -> archBool 16 v) msg.messageOptionsNoStandardDescriptorAccessor)-    <> (maybe mempty (\v -> archBool 24 v) msg.messageOptionsDeprecated)-    <> (maybe mempty (\v -> archBool 56 v) msg.messageOptionsMapEntry)-    <> (maybe mempty (\v -> archBool 88 v) msg.messageOptionsDeprecatedLegacyJsonFieldConflicts)-    <> (maybe mempty (\v -> archSubmessage 98 (buildSized v)) msg.messageOptionsFeatures)-    <> V.foldl' (\acc v -> acc <> archSubmessage 7994 (buildSized v)) mempty msg.messageOptionsUninterpretedOption-    <> encodeUnknownFieldsSized msg.messageOptionsUnknownFields--instance MessageDecode MessageOptions where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultMessageOptions emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_1 (msg { messageOptionsMessageSetWireFormat = (Just v)}) gl_0)-          (pure (case msg.messageOptionsUnknownFields of { [] -> msg { messageOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { messageOptionsUninterpretedOption = growListToVector gl_0, messageOptionsUnknownFields = reverse (msg.messageOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_1 msg gl_0 =-        inOrderStage1-          (0x10 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_2 (msg { messageOptionsNoStandardDescriptorAccessor = (Just v)}) gl_0)-          (pure (case msg.messageOptionsUnknownFields of { [] -> msg { messageOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { messageOptionsUninterpretedOption = growListToVector gl_0, messageOptionsUnknownFields = reverse (msg.messageOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_2 msg gl_0 =-        inOrderStage1-          (0x18 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_3 (msg { messageOptionsDeprecated = (Just v)}) gl_0)-          (pure (case msg.messageOptionsUnknownFields of { [] -> msg { messageOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { messageOptionsUninterpretedOption = growListToVector gl_0, messageOptionsUnknownFields = reverse (msg.messageOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_3 msg gl_0 =-        inOrderStage1-          (0x38 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_4 (msg { messageOptionsMapEntry = (Just v)}) gl_0)-          (pure (case msg.messageOptionsUnknownFields of { [] -> msg { messageOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { messageOptionsUninterpretedOption = growListToVector gl_0, messageOptionsUnknownFields = reverse (msg.messageOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_4 msg gl_0 =-        inOrderStage1-          (0x58 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_5 (msg { messageOptionsDeprecatedLegacyJsonFieldConflicts = (Just v)}) gl_0)-          (pure (case msg.messageOptionsUnknownFields of { [] -> msg { messageOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { messageOptionsUninterpretedOption = growListToVector gl_0, messageOptionsUnknownFields = reverse (msg.messageOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_5 msg gl_0 =-        inOrderStage1-          (0x62 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_6 (msg { messageOptionsFeatures = (Just v)}) gl_0)-          (pure (case msg.messageOptionsUnknownFields of { [] -> msg { messageOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { messageOptionsUninterpretedOption = growListToVector gl_0, messageOptionsUnknownFields = reverse (msg.messageOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_6 msg gl_0 =-        inOrderStage-          0x3eba-          0xffff-          2-          decodeFieldMessage-          (\v -> stage_6 msg (snocGrowList gl_0 v))-          (pure (case msg.messageOptionsUnknownFields of { [] -> msg { messageOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { messageOptionsUninterpretedOption = growListToVector gl_0, messageOptionsUnknownFields = reverse (msg.messageOptionsUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.messageOptionsUnknownFields of { [] -> msg { messageOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { messageOptionsUninterpretedOption = growListToVector gl_0, messageOptionsUnknownFields = reverse (msg.messageOptionsUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldBool-            loop (msg { messageOptionsMessageSetWireFormat = (Just v)}) gl_0-          2 -> do-            v <- decodeFieldBool-            loop (msg { messageOptionsNoStandardDescriptorAccessor = (Just v)}) gl_0-          3 -> do-            v <- decodeFieldBool-            loop (msg { messageOptionsDeprecated = (Just v)}) gl_0-          7 -> do-            v <- decodeFieldBool-            loop (msg { messageOptionsMapEntry = (Just v)}) gl_0-          11 -> do-            v <- decodeFieldBool-            loop (msg { messageOptionsDeprecatedLegacyJsonFieldConflicts = (Just v)}) gl_0-          12 -> do-            v <- decodeFieldMessage-            loop (msg { messageOptionsFeatures = (Just v)}) gl_0-          999 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { messageOptionsUnknownFields = (uf : msg.messageOptionsUnknownFields)}) gl_0)---- | Field descriptors for 'MessageOptions', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-messageOptionsFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor MessageOptions)-messageOptionsFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "message_set_wire_format"-        , fdNumber = 1-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = messageOptionsMessageSetWireFormat-        , fdSet = \v m -> m { messageOptionsMessageSetWireFormat = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "no_standard_descriptor_accessor"-        , fdNumber = 2-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = messageOptionsNoStandardDescriptorAccessor-        , fdSet = \v m -> m { messageOptionsNoStandardDescriptorAccessor = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "deprecated"-        , fdNumber = 3-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = messageOptionsDeprecated-        , fdSet = \v m -> m { messageOptionsDeprecated = v }-        })-    , (7, SomeField FieldDescriptor-        { fdName = "map_entry"-        , fdNumber = 7-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = messageOptionsMapEntry-        , fdSet = \v m -> m { messageOptionsMapEntry = v }-        })-    , (11, SomeField FieldDescriptor-        { fdName = "deprecated_legacy_json_field_conflicts"-        , fdNumber = 11-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = messageOptionsDeprecatedLegacyJsonFieldConflicts-        , fdSet = \v m -> m { messageOptionsDeprecatedLegacyJsonFieldConflicts = v }-        })-    , (12, SomeField FieldDescriptor-        { fdName = "features"-        , fdNumber = 12-        , fdTypeDesc = MessageType "FeatureSet"-        , fdLabel = LabelOptional-        , fdGet = messageOptionsFeatures-        , fdSet = \v m -> m { messageOptionsFeatures = v }-        })-    , (999, SomeField FieldDescriptor-        { fdName = "uninterpreted_option"-        , fdNumber = 999-        , fdTypeDesc = MessageType "UninterpretedOption"-        , fdLabel = LabelRepeated-        , fdGet = messageOptionsUninterpretedOption-        , fdSet = \v m -> m { messageOptionsUninterpretedOption = v }-        })-    ]--instance ProtoMessage MessageOptions where-  protoMessageName _ = "google.protobuf.MessageOptions"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultMessageOptions-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = messageOptionsFieldDescriptors--instance IsMessage MessageOptions--instance Aeson.ToJSON MessageOptions where-  toJSON msg = jsonObject-      [ "messageSetWireFormat" .=: msg.messageOptionsMessageSetWireFormat-      , "noStandardDescriptorAccessor" .=: msg.messageOptionsNoStandardDescriptorAccessor-      , "deprecated" .=: msg.messageOptionsDeprecated-      , "mapEntry" .=: msg.messageOptionsMapEntry-      , "deprecatedLegacyJsonFieldConflicts" .=: msg.messageOptionsDeprecatedLegacyJsonFieldConflicts-      , "features" .=: msg.messageOptionsFeatures-      , "uninterpretedOption" .=: msg.messageOptionsUninterpretedOption-      ]--instance Aeson.FromJSON MessageOptions where-  parseJSON = Aeson.withObject "MessageOptions" $ \obj -> do-    fld_messageOptionsMessageSetWireFormat <- parseFieldMaybe obj "messageSetWireFormat"-    fld_messageOptionsNoStandardDescriptorAccessor <- parseFieldMaybe obj "noStandardDescriptorAccessor"-    fld_messageOptionsDeprecated <- parseFieldMaybe obj "deprecated"-    fld_messageOptionsMapEntry <- parseFieldMaybe obj "mapEntry"-    fld_messageOptionsDeprecatedLegacyJsonFieldConflicts <- parseFieldMaybe obj "deprecatedLegacyJsonFieldConflicts"-    fld_messageOptionsFeatures <- parseFieldMaybe obj "features"-    fld_messageOptionsUninterpretedOption <- parseFieldMaybe obj "uninterpretedOption"-    pure defaultMessageOptions-      { messageOptionsMessageSetWireFormat = maybe (messageOptionsMessageSetWireFormat defaultMessageOptions) id fld_messageOptionsMessageSetWireFormat-      , messageOptionsNoStandardDescriptorAccessor = maybe (messageOptionsNoStandardDescriptorAccessor defaultMessageOptions) id fld_messageOptionsNoStandardDescriptorAccessor-      , messageOptionsDeprecated = maybe (messageOptionsDeprecated defaultMessageOptions) id fld_messageOptionsDeprecated-      , messageOptionsMapEntry = maybe (messageOptionsMapEntry defaultMessageOptions) id fld_messageOptionsMapEntry-      , messageOptionsDeprecatedLegacyJsonFieldConflicts = maybe (messageOptionsDeprecatedLegacyJsonFieldConflicts defaultMessageOptions) id fld_messageOptionsDeprecatedLegacyJsonFieldConflicts-      , messageOptionsFeatures = maybe (messageOptionsFeatures defaultMessageOptions) id fld_messageOptionsFeatures-      , messageOptionsUninterpretedOption = maybe (messageOptionsUninterpretedOption defaultMessageOptions) id fld_messageOptionsUninterpretedOption-      }--instance Hashable MessageOptions where-  hashWithSalt salt msg = V.foldl' hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.messageOptionsMessageSetWireFormat) msg.messageOptionsNoStandardDescriptorAccessor) msg.messageOptionsDeprecated) msg.messageOptionsMapEntry) msg.messageOptionsDeprecatedLegacyJsonFieldConflicts) msg.messageOptionsFeatures) msg.messageOptionsUninterpretedOption--instance Proto.Extension.HasExtensions MessageOptions where-  messageUnknownFields = messageOptionsUnknownFields-  setMessageUnknownFields !ufs msg = msg { messageOptionsUnknownFields = ufs }--instance Semigroup MessageOptions where-  a <> b = MessageOptions-    { messageOptionsMessageSetWireFormat = case b.messageOptionsMessageSetWireFormat of { Nothing -> a.messageOptionsMessageSetWireFormat; x -> x }-    , messageOptionsNoStandardDescriptorAccessor = case b.messageOptionsNoStandardDescriptorAccessor of { Nothing -> a.messageOptionsNoStandardDescriptorAccessor; x -> x }-    , messageOptionsDeprecated = case b.messageOptionsDeprecated of { Nothing -> a.messageOptionsDeprecated; x -> x }-    , messageOptionsMapEntry = case b.messageOptionsMapEntry of { Nothing -> a.messageOptionsMapEntry; x -> x }-    , messageOptionsDeprecatedLegacyJsonFieldConflicts = case b.messageOptionsDeprecatedLegacyJsonFieldConflicts of { Nothing -> a.messageOptionsDeprecatedLegacyJsonFieldConflicts; x -> x }-    , messageOptionsFeatures = case b.messageOptionsFeatures of { Nothing -> a.messageOptionsFeatures; x -> x }-    , messageOptionsUninterpretedOption = a.messageOptionsUninterpretedOption <> b.messageOptionsUninterpretedOption-    , messageOptionsUnknownFields = a.messageOptionsUnknownFields <> b.messageOptionsUnknownFields-    }--instance Monoid MessageOptions where-  mempty = defaultMessageOptions--data FieldOptions = FieldOptions-  { fieldOptionsCtype :: !(Maybe FieldOptions'CType)-    -- ^ NOTE: ctype is deprecated. Use `features.(pb.cpp).string_type` instead.-    -- The ctype option instructs the C++ code generator to use a different-    -- representation of the field than it normally would.  See the specific-    -- options below.  This option is only implemented to support use of-    -- [ctype=CORD] and [ctype=STRING] (the default) on non-repeated fields of-    -- type "bytes" in the open source release.-    -- TODO: make ctype actually deprecated.-  , fieldOptionsPacked :: !(Maybe Bool)-    -- ^ The packed option can be enabled for repeated primitive fields to enable-    -- a more efficient representation on the wire. Rather than repeatedly-    -- writing the tag and type for each element, the entire array is encoded as-    -- a single length-delimited blob. In proto3, only explicit setting it to-    -- false will avoid using packed encoding.  This option is prohibited in-    -- Editions, but the `repeated_field_encoding` feature can be used to control-    -- the behavior.-  , fieldOptionsJstype :: !(Maybe FieldOptions'JSType)-    -- ^ The jstype option determines the JavaScript type used for values of the-    -- field.  The option is permitted only for 64 bit integral and fixed types-    -- (int64, uint64, sint64, fixed64, sfixed64).  A field with jstype JS_STRING-    -- is represented as JavaScript string, which avoids loss of precision that-    -- can happen when a large value is converted to a floating point JavaScript.-    -- Specifying JS_NUMBER for the jstype causes the generated JavaScript code to-    -- use the JavaScript "number" type.  The behavior of the default option-    -- JS_NORMAL is implementation dependent.-    -- -    -- This option is an enum to permit additional types to be added, e.g.-    -- goog.math.Integer.-  , fieldOptionsLazy :: !(Maybe Bool)-    -- ^ Should this field be parsed lazily?  Lazy applies only to message-type-    -- fields.  It means that when the outer message is initially parsed, the-    -- inner message's contents will not be parsed but instead stored in encoded-    -- form.  The inner message will actually be parsed when it is first accessed.-    -- -    -- This is only a hint.  Implementations are free to choose whether to use-    -- eager or lazy parsing regardless of the value of this option.  However,-    -- setting this option true suggests that the protocol author believes that-    -- using lazy parsing on this field is worth the additional bookkeeping-    -- overhead typically needed to implement it.-    -- -    -- This option does not affect the public interface of any generated code;-    -- all method signatures remain the same.  Furthermore, thread-safety of the-    -- interface is not affected by this option; const methods remain safe to-    -- call from multiple threads concurrently, while non-const methods continue-    -- to require exclusive access.-    -- -    -- Note that lazy message fields are still eagerly verified to check-    -- ill-formed wireformat or missing required fields. Calling IsInitialized()-    -- on the outer message would fail if the inner message has missing required-    -- fields. Failed verification would result in parsing failure (except when-    -- uninitialized messages are acceptable).-  , fieldOptionsUnverifiedLazy :: !(Maybe Bool)-    -- ^ unverified_lazy does no correctness checks on the byte stream. This should-    -- only be used where lazy with verification is prohibitive for performance-    -- reasons.-  , fieldOptionsDeprecated :: !(Maybe Bool)-    -- ^ Is this field deprecated?-    -- Depending on the target platform, this can emit Deprecated annotations-    -- for accessors, or it will be completely ignored; in the very least, this-    -- is a formalization for deprecating fields.-  , fieldOptionsWeak :: !(Maybe Bool)-    -- ^ For Google-internal migration only. Do not use.-  , fieldOptionsDebugRedact :: !(Maybe Bool)-    -- ^ Indicate that the field value should not be printed out when using debug-    -- formats, e.g. when the field contains sensitive credentials.-  , fieldOptionsRetention :: !(Maybe FieldOptions'OptionRetention)-  , fieldOptionsTargets :: !(V.Vector FieldOptions'OptionTargetType)-  , fieldOptionsEditionDefaults :: !(V.Vector FieldOptions'EditionDefault)-  , fieldOptionsFeatures :: !(Maybe FeatureSet)-    -- ^ Any features defined in the specific edition.-  , fieldOptionsFeatureSupport :: !(Maybe FieldOptions'FeatureSupport)-  , fieldOptionsUninterpretedOption :: !(V.Vector UninterpretedOption)-    -- ^ The parser stores options it doesn't recognize here. See above.-  , fieldOptionsUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--data FieldOptions'CType-  = FieldOptions'CType'String-    -- ^ Default mode.-  | FieldOptions'CType'Cord-    -- ^ The option [ctype=CORD] may be applied to a non-repeated field of type-    -- "bytes". It indicates that in C++, the data should be stored in a Cord-    -- instead of a string.  For very large strings, this may reduce memory-    -- fragmentation. It may also allow better performance when parsing from a-    -- Cord, or when parsing with aliasing enabled, as the parsed Cord may then-    -- alias the original buffer.-  | FieldOptions'CType'StringPiece-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumFieldOptions'CType :: FieldOptions'CType -> Int-toProtoEnumFieldOptions'CType FieldOptions'CType'String = 0-toProtoEnumFieldOptions'CType FieldOptions'CType'Cord = 1-toProtoEnumFieldOptions'CType FieldOptions'CType'StringPiece = 2--fromProtoEnumFieldOptions'CType :: Int -> Maybe FieldOptions'CType-fromProtoEnumFieldOptions'CType 0 = Just FieldOptions'CType'String-fromProtoEnumFieldOptions'CType 1 = Just FieldOptions'CType'Cord-fromProtoEnumFieldOptions'CType 2 = Just FieldOptions'CType'StringPiece-fromProtoEnumFieldOptions'CType _ = Nothing--instance MessageEncode FieldOptions'CType where-  buildSized _ = mempty-instance MessageDecode FieldOptions'CType where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON FieldOptions'CType where-  toJSON FieldOptions'CType'String = Aeson.String "STRING"-  toJSON FieldOptions'CType'Cord = Aeson.String "CORD"-  toJSON FieldOptions'CType'StringPiece = Aeson.String "STRING_PIECE"--instance Aeson.FromJSON FieldOptions'CType where-  parseJSON = \case-    Aeson.String "STRING" -> pure FieldOptions'CType'String-    Aeson.String "CORD" -> pure FieldOptions'CType'Cord-    Aeson.String "STRING_PIECE" -> pure FieldOptions'CType'StringPiece-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for FieldOptions'CType"--instance Hashable FieldOptions'CType where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumFieldOptions'CType x)--data FieldOptions'JSType-  = FieldOptions'JSType'JsNormal-    -- ^ Use the default type.-  | FieldOptions'JSType'JsString-    -- ^ Use JavaScript strings.-  | FieldOptions'JSType'JsNumber-    -- ^ Use JavaScript numbers.-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumFieldOptions'JSType :: FieldOptions'JSType -> Int-toProtoEnumFieldOptions'JSType FieldOptions'JSType'JsNormal = 0-toProtoEnumFieldOptions'JSType FieldOptions'JSType'JsString = 1-toProtoEnumFieldOptions'JSType FieldOptions'JSType'JsNumber = 2--fromProtoEnumFieldOptions'JSType :: Int -> Maybe FieldOptions'JSType-fromProtoEnumFieldOptions'JSType 0 = Just FieldOptions'JSType'JsNormal-fromProtoEnumFieldOptions'JSType 1 = Just FieldOptions'JSType'JsString-fromProtoEnumFieldOptions'JSType 2 = Just FieldOptions'JSType'JsNumber-fromProtoEnumFieldOptions'JSType _ = Nothing--instance MessageEncode FieldOptions'JSType where-  buildSized _ = mempty-instance MessageDecode FieldOptions'JSType where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON FieldOptions'JSType where-  toJSON FieldOptions'JSType'JsNormal = Aeson.String "JS_NORMAL"-  toJSON FieldOptions'JSType'JsString = Aeson.String "JS_STRING"-  toJSON FieldOptions'JSType'JsNumber = Aeson.String "JS_NUMBER"--instance Aeson.FromJSON FieldOptions'JSType where-  parseJSON = \case-    Aeson.String "JS_NORMAL" -> pure FieldOptions'JSType'JsNormal-    Aeson.String "JS_STRING" -> pure FieldOptions'JSType'JsString-    Aeson.String "JS_NUMBER" -> pure FieldOptions'JSType'JsNumber-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for FieldOptions'JSType"--instance Hashable FieldOptions'JSType where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumFieldOptions'JSType x)---- | If set to RETENTION_SOURCE, the option will be omitted from the binary.--- Note: as of January 2023, support for this is in progress and does not yet--- have an effect (b/264593489).-data FieldOptions'OptionRetention-  = FieldOptions'OptionRetention'RetentionUnknown-  | FieldOptions'OptionRetention'RetentionRuntime-  | FieldOptions'OptionRetention'RetentionSource-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumFieldOptions'OptionRetention :: FieldOptions'OptionRetention -> Int-toProtoEnumFieldOptions'OptionRetention FieldOptions'OptionRetention'RetentionUnknown = 0-toProtoEnumFieldOptions'OptionRetention FieldOptions'OptionRetention'RetentionRuntime = 1-toProtoEnumFieldOptions'OptionRetention FieldOptions'OptionRetention'RetentionSource = 2--fromProtoEnumFieldOptions'OptionRetention :: Int -> Maybe FieldOptions'OptionRetention-fromProtoEnumFieldOptions'OptionRetention 0 = Just FieldOptions'OptionRetention'RetentionUnknown-fromProtoEnumFieldOptions'OptionRetention 1 = Just FieldOptions'OptionRetention'RetentionRuntime-fromProtoEnumFieldOptions'OptionRetention 2 = Just FieldOptions'OptionRetention'RetentionSource-fromProtoEnumFieldOptions'OptionRetention _ = Nothing--instance MessageEncode FieldOptions'OptionRetention where-  buildSized _ = mempty-instance MessageDecode FieldOptions'OptionRetention where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON FieldOptions'OptionRetention where-  toJSON FieldOptions'OptionRetention'RetentionUnknown = Aeson.String "RETENTION_UNKNOWN"-  toJSON FieldOptions'OptionRetention'RetentionRuntime = Aeson.String "RETENTION_RUNTIME"-  toJSON FieldOptions'OptionRetention'RetentionSource = Aeson.String "RETENTION_SOURCE"--instance Aeson.FromJSON FieldOptions'OptionRetention where-  parseJSON = \case-    Aeson.String "RETENTION_UNKNOWN" -> pure FieldOptions'OptionRetention'RetentionUnknown-    Aeson.String "RETENTION_RUNTIME" -> pure FieldOptions'OptionRetention'RetentionRuntime-    Aeson.String "RETENTION_SOURCE" -> pure FieldOptions'OptionRetention'RetentionSource-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for FieldOptions'OptionRetention"--instance Hashable FieldOptions'OptionRetention where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumFieldOptions'OptionRetention x)---- | This indicates the types of entities that the field may apply to when used--- as an option. If it is unset, then the field may be freely used as an--- option on any kind of entity. Note: as of January 2023, support for this is--- in progress and does not yet have an effect (b/264593489).-data FieldOptions'OptionTargetType-  = FieldOptions'OptionTargetType'TargetTypeUnknown-  | FieldOptions'OptionTargetType'TargetTypeFile-  | FieldOptions'OptionTargetType'TargetTypeExtensionRange-  | FieldOptions'OptionTargetType'TargetTypeMessage-  | FieldOptions'OptionTargetType'TargetTypeField-  | FieldOptions'OptionTargetType'TargetTypeOneof-  | FieldOptions'OptionTargetType'TargetTypeEnum-  | FieldOptions'OptionTargetType'TargetTypeEnumEntry-  | FieldOptions'OptionTargetType'TargetTypeService-  | FieldOptions'OptionTargetType'TargetTypeMethod-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumFieldOptions'OptionTargetType :: FieldOptions'OptionTargetType -> Int-toProtoEnumFieldOptions'OptionTargetType FieldOptions'OptionTargetType'TargetTypeUnknown = 0-toProtoEnumFieldOptions'OptionTargetType FieldOptions'OptionTargetType'TargetTypeFile = 1-toProtoEnumFieldOptions'OptionTargetType FieldOptions'OptionTargetType'TargetTypeExtensionRange = 2-toProtoEnumFieldOptions'OptionTargetType FieldOptions'OptionTargetType'TargetTypeMessage = 3-toProtoEnumFieldOptions'OptionTargetType FieldOptions'OptionTargetType'TargetTypeField = 4-toProtoEnumFieldOptions'OptionTargetType FieldOptions'OptionTargetType'TargetTypeOneof = 5-toProtoEnumFieldOptions'OptionTargetType FieldOptions'OptionTargetType'TargetTypeEnum = 6-toProtoEnumFieldOptions'OptionTargetType FieldOptions'OptionTargetType'TargetTypeEnumEntry = 7-toProtoEnumFieldOptions'OptionTargetType FieldOptions'OptionTargetType'TargetTypeService = 8-toProtoEnumFieldOptions'OptionTargetType FieldOptions'OptionTargetType'TargetTypeMethod = 9--fromProtoEnumFieldOptions'OptionTargetType :: Int -> Maybe FieldOptions'OptionTargetType-fromProtoEnumFieldOptions'OptionTargetType 0 = Just FieldOptions'OptionTargetType'TargetTypeUnknown-fromProtoEnumFieldOptions'OptionTargetType 1 = Just FieldOptions'OptionTargetType'TargetTypeFile-fromProtoEnumFieldOptions'OptionTargetType 2 = Just FieldOptions'OptionTargetType'TargetTypeExtensionRange-fromProtoEnumFieldOptions'OptionTargetType 3 = Just FieldOptions'OptionTargetType'TargetTypeMessage-fromProtoEnumFieldOptions'OptionTargetType 4 = Just FieldOptions'OptionTargetType'TargetTypeField-fromProtoEnumFieldOptions'OptionTargetType 5 = Just FieldOptions'OptionTargetType'TargetTypeOneof-fromProtoEnumFieldOptions'OptionTargetType 6 = Just FieldOptions'OptionTargetType'TargetTypeEnum-fromProtoEnumFieldOptions'OptionTargetType 7 = Just FieldOptions'OptionTargetType'TargetTypeEnumEntry-fromProtoEnumFieldOptions'OptionTargetType 8 = Just FieldOptions'OptionTargetType'TargetTypeService-fromProtoEnumFieldOptions'OptionTargetType 9 = Just FieldOptions'OptionTargetType'TargetTypeMethod-fromProtoEnumFieldOptions'OptionTargetType _ = Nothing--instance MessageEncode FieldOptions'OptionTargetType where-  buildSized _ = mempty-instance MessageDecode FieldOptions'OptionTargetType where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON FieldOptions'OptionTargetType where-  toJSON FieldOptions'OptionTargetType'TargetTypeUnknown = Aeson.String "TARGET_TYPE_UNKNOWN"-  toJSON FieldOptions'OptionTargetType'TargetTypeFile = Aeson.String "TARGET_TYPE_FILE"-  toJSON FieldOptions'OptionTargetType'TargetTypeExtensionRange = Aeson.String "TARGET_TYPE_EXTENSION_RANGE"-  toJSON FieldOptions'OptionTargetType'TargetTypeMessage = Aeson.String "TARGET_TYPE_MESSAGE"-  toJSON FieldOptions'OptionTargetType'TargetTypeField = Aeson.String "TARGET_TYPE_FIELD"-  toJSON FieldOptions'OptionTargetType'TargetTypeOneof = Aeson.String "TARGET_TYPE_ONEOF"-  toJSON FieldOptions'OptionTargetType'TargetTypeEnum = Aeson.String "TARGET_TYPE_ENUM"-  toJSON FieldOptions'OptionTargetType'TargetTypeEnumEntry = Aeson.String "TARGET_TYPE_ENUM_ENTRY"-  toJSON FieldOptions'OptionTargetType'TargetTypeService = Aeson.String "TARGET_TYPE_SERVICE"-  toJSON FieldOptions'OptionTargetType'TargetTypeMethod = Aeson.String "TARGET_TYPE_METHOD"--instance Aeson.FromJSON FieldOptions'OptionTargetType where-  parseJSON = \case-    Aeson.String "TARGET_TYPE_UNKNOWN" -> pure FieldOptions'OptionTargetType'TargetTypeUnknown-    Aeson.String "TARGET_TYPE_FILE" -> pure FieldOptions'OptionTargetType'TargetTypeFile-    Aeson.String "TARGET_TYPE_EXTENSION_RANGE" -> pure FieldOptions'OptionTargetType'TargetTypeExtensionRange-    Aeson.String "TARGET_TYPE_MESSAGE" -> pure FieldOptions'OptionTargetType'TargetTypeMessage-    Aeson.String "TARGET_TYPE_FIELD" -> pure FieldOptions'OptionTargetType'TargetTypeField-    Aeson.String "TARGET_TYPE_ONEOF" -> pure FieldOptions'OptionTargetType'TargetTypeOneof-    Aeson.String "TARGET_TYPE_ENUM" -> pure FieldOptions'OptionTargetType'TargetTypeEnum-    Aeson.String "TARGET_TYPE_ENUM_ENTRY" -> pure FieldOptions'OptionTargetType'TargetTypeEnumEntry-    Aeson.String "TARGET_TYPE_SERVICE" -> pure FieldOptions'OptionTargetType'TargetTypeService-    Aeson.String "TARGET_TYPE_METHOD" -> pure FieldOptions'OptionTargetType'TargetTypeMethod-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for FieldOptions'OptionTargetType"--instance Hashable FieldOptions'OptionTargetType where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumFieldOptions'OptionTargetType x)--data FieldOptions'EditionDefault = FieldOptions'EditionDefault-  { fieldOptionsEditionDefaultEdition :: !(Maybe Edition)-  , fieldOptionsEditionDefaultValue :: !(Maybe Text)-  , fieldOptionsEditionDefaultUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultFieldOptions'EditionDefault :: FieldOptions'EditionDefault-defaultFieldOptions'EditionDefault = FieldOptions'EditionDefault-  { fieldOptionsEditionDefaultEdition = Nothing-  , fieldOptionsEditionDefaultValue = Nothing-  , fieldOptionsEditionDefaultUnknownFields = []-  }--instance MessageEncode FieldOptions'EditionDefault where-  buildSized msg =-    (maybe mempty (\v -> archVarint 24 (fromIntegral (toProtoEnumEdition v))) msg.fieldOptionsEditionDefaultEdition)-    <> (maybe mempty (\v -> archString 18 v) msg.fieldOptionsEditionDefaultValue)-    <> encodeUnknownFieldsSized msg.fieldOptionsEditionDefaultUnknownFields--instance MessageDecode FieldOptions'EditionDefault where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultFieldOptions'EditionDefault-    where-      stage_0 msg =-        inOrderStage1-          (0x18 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> stage_1 (msg { fieldOptionsEditionDefaultEdition = (Just v)}))-          (pure (case msg.fieldOptionsEditionDefaultUnknownFields of { [] -> msg; _ -> msg { fieldOptionsEditionDefaultUnknownFields = reverse (msg.fieldOptionsEditionDefaultUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldString-          (\v -> loop (msg { fieldOptionsEditionDefaultValue = (Just v)}))-          (pure (case msg.fieldOptionsEditionDefaultUnknownFields of { [] -> msg; _ -> msg { fieldOptionsEditionDefaultUnknownFields = reverse (msg.fieldOptionsEditionDefaultUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.fieldOptionsEditionDefaultUnknownFields of { [] -> msg; _ -> msg { fieldOptionsEditionDefaultUnknownFields = reverse (msg.fieldOptionsEditionDefaultUnknownFields) } }))-        (\fn wt -> case fn of-          3 -> do-            v <- decodeFieldEnum-            loop (msg { fieldOptionsEditionDefaultEdition = (Just v)})-          2 -> do-            v <- decodeFieldString-            loop (msg { fieldOptionsEditionDefaultValue = (Just v)})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { fieldOptionsEditionDefaultUnknownFields = (uf : msg.fieldOptionsEditionDefaultUnknownFields)}))---- | Field descriptors for 'FieldOptions'EditionDefault', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-fieldOptions'EditionDefaultFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor FieldOptions'EditionDefault)-fieldOptions'EditionDefaultFieldDescriptors =-  IntMap.fromList-    [ (3, SomeField FieldDescriptor-        { fdName = "edition"-        , fdNumber = 3-        , fdTypeDesc = MessageType "Edition"-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsEditionDefaultEdition-        , fdSet = \v m -> m { fieldOptionsEditionDefaultEdition = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "value"-        , fdNumber = 2-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsEditionDefaultValue-        , fdSet = \v m -> m { fieldOptionsEditionDefaultValue = v }-        })-    ]--instance ProtoMessage FieldOptions'EditionDefault where-  protoMessageName _ = "google.protobuf.FieldOptions.EditionDefault"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultFieldOptions'EditionDefault-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = fieldOptions'EditionDefaultFieldDescriptors--instance IsMessage FieldOptions'EditionDefault--instance Aeson.ToJSON FieldOptions'EditionDefault where-  toJSON msg = jsonObject-      [ "edition" .=: msg.fieldOptionsEditionDefaultEdition-      , "value" .=: msg.fieldOptionsEditionDefaultValue-      ]--instance Aeson.FromJSON FieldOptions'EditionDefault where-  parseJSON = Aeson.withObject "FieldOptions'EditionDefault" $ \obj -> do-    fld_fieldOptionsEditionDefaultEdition <- parseFieldMaybe obj "edition"-    fld_fieldOptionsEditionDefaultValue <- parseFieldMaybe obj "value"-    pure defaultFieldOptions'EditionDefault-      { fieldOptionsEditionDefaultEdition = maybe (fieldOptionsEditionDefaultEdition defaultFieldOptions'EditionDefault) id fld_fieldOptionsEditionDefaultEdition-      , fieldOptionsEditionDefaultValue = maybe (fieldOptionsEditionDefaultValue defaultFieldOptions'EditionDefault) id fld_fieldOptionsEditionDefaultValue-      }--instance Hashable FieldOptions'EditionDefault where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (salt) msg.fieldOptionsEditionDefaultEdition) msg.fieldOptionsEditionDefaultValue--instance Proto.Extension.HasExtensions FieldOptions'EditionDefault where-  messageUnknownFields = fieldOptionsEditionDefaultUnknownFields-  setMessageUnknownFields !ufs msg = msg { fieldOptionsEditionDefaultUnknownFields = ufs }--instance Semigroup FieldOptions'EditionDefault where-  a <> b = FieldOptions'EditionDefault-    { fieldOptionsEditionDefaultEdition = case b.fieldOptionsEditionDefaultEdition of { Nothing -> a.fieldOptionsEditionDefaultEdition; x -> x }-    , fieldOptionsEditionDefaultValue = case b.fieldOptionsEditionDefaultValue of { Nothing -> a.fieldOptionsEditionDefaultValue; x -> x }-    , fieldOptionsEditionDefaultUnknownFields = a.fieldOptionsEditionDefaultUnknownFields <> b.fieldOptionsEditionDefaultUnknownFields-    }--instance Monoid FieldOptions'EditionDefault where-  mempty = defaultFieldOptions'EditionDefault---- | Information about the support window of a feature.-data FieldOptions'FeatureSupport = FieldOptions'FeatureSupport-  { fieldOptionsFeatureSupportEditionIntroduced :: !(Maybe Edition)-    -- ^ The edition that this feature was first available in.  In editions-    -- earlier than this one, the default assigned to EDITION_LEGACY will be-    -- used, and proto files will not be able to override it.-  , fieldOptionsFeatureSupportEditionDeprecated :: !(Maybe Edition)-    -- ^ The edition this feature becomes deprecated in.  Using this after this-    -- edition may trigger warnings.-  , fieldOptionsFeatureSupportDeprecationWarning :: !(Maybe Text)-    -- ^ The deprecation warning text if this feature is used after the edition it-    -- was marked deprecated in.-  , fieldOptionsFeatureSupportEditionRemoved :: !(Maybe Edition)-    -- ^ The edition this feature is no longer available in.  In editions after-    -- this one, the last default assigned will be used, and proto files will-    -- not be able to override it.-  , fieldOptionsFeatureSupportUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultFieldOptions'FeatureSupport :: FieldOptions'FeatureSupport-defaultFieldOptions'FeatureSupport = FieldOptions'FeatureSupport-  { fieldOptionsFeatureSupportEditionIntroduced = Nothing-  , fieldOptionsFeatureSupportEditionDeprecated = Nothing-  , fieldOptionsFeatureSupportDeprecationWarning = Nothing-  , fieldOptionsFeatureSupportEditionRemoved = Nothing-  , fieldOptionsFeatureSupportUnknownFields = []-  }--instance MessageEncode FieldOptions'FeatureSupport where-  buildSized msg =-    (maybe mempty (\v -> archVarint 8 (fromIntegral (toProtoEnumEdition v))) msg.fieldOptionsFeatureSupportEditionIntroduced)-    <> (maybe mempty (\v -> archVarint 16 (fromIntegral (toProtoEnumEdition v))) msg.fieldOptionsFeatureSupportEditionDeprecated)-    <> (maybe mempty (\v -> archString 26 v) msg.fieldOptionsFeatureSupportDeprecationWarning)-    <> (maybe mempty (\v -> archVarint 32 (fromIntegral (toProtoEnumEdition v))) msg.fieldOptionsFeatureSupportEditionRemoved)-    <> encodeUnknownFieldsSized msg.fieldOptionsFeatureSupportUnknownFields--instance MessageDecode FieldOptions'FeatureSupport where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultFieldOptions'FeatureSupport-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> stage_1 (msg { fieldOptionsFeatureSupportEditionIntroduced = (Just v)}))-          (pure (case msg.fieldOptionsFeatureSupportUnknownFields of { [] -> msg; _ -> msg { fieldOptionsFeatureSupportUnknownFields = reverse (msg.fieldOptionsFeatureSupportUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x10 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> stage_2 (msg { fieldOptionsFeatureSupportEditionDeprecated = (Just v)}))-          (pure (case msg.fieldOptionsFeatureSupportUnknownFields of { [] -> msg; _ -> msg { fieldOptionsFeatureSupportUnknownFields = reverse (msg.fieldOptionsFeatureSupportUnknownFields) } }))-          (loop msg)-      stage_2 msg =-        inOrderStage1-          (0x1a :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_3 (msg { fieldOptionsFeatureSupportDeprecationWarning = (Just v)}))-          (pure (case msg.fieldOptionsFeatureSupportUnknownFields of { [] -> msg; _ -> msg { fieldOptionsFeatureSupportUnknownFields = reverse (msg.fieldOptionsFeatureSupportUnknownFields) } }))-          (loop msg)-      stage_3 msg =-        inOrderStage1-          (0x20 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> loop (msg { fieldOptionsFeatureSupportEditionRemoved = (Just v)}))-          (pure (case msg.fieldOptionsFeatureSupportUnknownFields of { [] -> msg; _ -> msg { fieldOptionsFeatureSupportUnknownFields = reverse (msg.fieldOptionsFeatureSupportUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.fieldOptionsFeatureSupportUnknownFields of { [] -> msg; _ -> msg { fieldOptionsFeatureSupportUnknownFields = reverse (msg.fieldOptionsFeatureSupportUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldEnum-            loop (msg { fieldOptionsFeatureSupportEditionIntroduced = (Just v)})-          2 -> do-            v <- decodeFieldEnum-            loop (msg { fieldOptionsFeatureSupportEditionDeprecated = (Just v)})-          3 -> do-            v <- decodeFieldString-            loop (msg { fieldOptionsFeatureSupportDeprecationWarning = (Just v)})-          4 -> do-            v <- decodeFieldEnum-            loop (msg { fieldOptionsFeatureSupportEditionRemoved = (Just v)})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { fieldOptionsFeatureSupportUnknownFields = (uf : msg.fieldOptionsFeatureSupportUnknownFields)}))---- | Field descriptors for 'FieldOptions'FeatureSupport', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-fieldOptions'FeatureSupportFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor FieldOptions'FeatureSupport)-fieldOptions'FeatureSupportFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "edition_introduced"-        , fdNumber = 1-        , fdTypeDesc = MessageType "Edition"-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsFeatureSupportEditionIntroduced-        , fdSet = \v m -> m { fieldOptionsFeatureSupportEditionIntroduced = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "edition_deprecated"-        , fdNumber = 2-        , fdTypeDesc = MessageType "Edition"-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsFeatureSupportEditionDeprecated-        , fdSet = \v m -> m { fieldOptionsFeatureSupportEditionDeprecated = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "deprecation_warning"-        , fdNumber = 3-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsFeatureSupportDeprecationWarning-        , fdSet = \v m -> m { fieldOptionsFeatureSupportDeprecationWarning = v }-        })-    , (4, SomeField FieldDescriptor-        { fdName = "edition_removed"-        , fdNumber = 4-        , fdTypeDesc = MessageType "Edition"-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsFeatureSupportEditionRemoved-        , fdSet = \v m -> m { fieldOptionsFeatureSupportEditionRemoved = v }-        })-    ]--instance ProtoMessage FieldOptions'FeatureSupport where-  protoMessageName _ = "google.protobuf.FieldOptions.FeatureSupport"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultFieldOptions'FeatureSupport-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = fieldOptions'FeatureSupportFieldDescriptors--instance IsMessage FieldOptions'FeatureSupport--instance Aeson.ToJSON FieldOptions'FeatureSupport where-  toJSON msg = jsonObject-      [ "editionIntroduced" .=: msg.fieldOptionsFeatureSupportEditionIntroduced-      , "editionDeprecated" .=: msg.fieldOptionsFeatureSupportEditionDeprecated-      , "deprecationWarning" .=: msg.fieldOptionsFeatureSupportDeprecationWarning-      , "editionRemoved" .=: msg.fieldOptionsFeatureSupportEditionRemoved-      ]--instance Aeson.FromJSON FieldOptions'FeatureSupport where-  parseJSON = Aeson.withObject "FieldOptions'FeatureSupport" $ \obj -> do-    fld_fieldOptionsFeatureSupportEditionIntroduced <- parseFieldMaybe obj "editionIntroduced"-    fld_fieldOptionsFeatureSupportEditionDeprecated <- parseFieldMaybe obj "editionDeprecated"-    fld_fieldOptionsFeatureSupportDeprecationWarning <- parseFieldMaybe obj "deprecationWarning"-    fld_fieldOptionsFeatureSupportEditionRemoved <- parseFieldMaybe obj "editionRemoved"-    pure defaultFieldOptions'FeatureSupport-      { fieldOptionsFeatureSupportEditionIntroduced = maybe (fieldOptionsFeatureSupportEditionIntroduced defaultFieldOptions'FeatureSupport) id fld_fieldOptionsFeatureSupportEditionIntroduced-      , fieldOptionsFeatureSupportEditionDeprecated = maybe (fieldOptionsFeatureSupportEditionDeprecated defaultFieldOptions'FeatureSupport) id fld_fieldOptionsFeatureSupportEditionDeprecated-      , fieldOptionsFeatureSupportDeprecationWarning = maybe (fieldOptionsFeatureSupportDeprecationWarning defaultFieldOptions'FeatureSupport) id fld_fieldOptionsFeatureSupportDeprecationWarning-      , fieldOptionsFeatureSupportEditionRemoved = maybe (fieldOptionsFeatureSupportEditionRemoved defaultFieldOptions'FeatureSupport) id fld_fieldOptionsFeatureSupportEditionRemoved-      }--instance Hashable FieldOptions'FeatureSupport where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.fieldOptionsFeatureSupportEditionIntroduced) msg.fieldOptionsFeatureSupportEditionDeprecated) msg.fieldOptionsFeatureSupportDeprecationWarning) msg.fieldOptionsFeatureSupportEditionRemoved--instance Proto.Extension.HasExtensions FieldOptions'FeatureSupport where-  messageUnknownFields = fieldOptionsFeatureSupportUnknownFields-  setMessageUnknownFields !ufs msg = msg { fieldOptionsFeatureSupportUnknownFields = ufs }--instance Semigroup FieldOptions'FeatureSupport where-  a <> b = FieldOptions'FeatureSupport-    { fieldOptionsFeatureSupportEditionIntroduced = case b.fieldOptionsFeatureSupportEditionIntroduced of { Nothing -> a.fieldOptionsFeatureSupportEditionIntroduced; x -> x }-    , fieldOptionsFeatureSupportEditionDeprecated = case b.fieldOptionsFeatureSupportEditionDeprecated of { Nothing -> a.fieldOptionsFeatureSupportEditionDeprecated; x -> x }-    , fieldOptionsFeatureSupportDeprecationWarning = case b.fieldOptionsFeatureSupportDeprecationWarning of { Nothing -> a.fieldOptionsFeatureSupportDeprecationWarning; x -> x }-    , fieldOptionsFeatureSupportEditionRemoved = case b.fieldOptionsFeatureSupportEditionRemoved of { Nothing -> a.fieldOptionsFeatureSupportEditionRemoved; x -> x }-    , fieldOptionsFeatureSupportUnknownFields = a.fieldOptionsFeatureSupportUnknownFields <> b.fieldOptionsFeatureSupportUnknownFields-    }--instance Monoid FieldOptions'FeatureSupport where-  mempty = defaultFieldOptions'FeatureSupport--defaultFieldOptions :: FieldOptions-defaultFieldOptions = FieldOptions-  { fieldOptionsCtype = Nothing-  , fieldOptionsPacked = Nothing-  , fieldOptionsJstype = Nothing-  , fieldOptionsLazy = Nothing-  , fieldOptionsUnverifiedLazy = Nothing-  , fieldOptionsDeprecated = Nothing-  , fieldOptionsWeak = Nothing-  , fieldOptionsDebugRedact = Nothing-  , fieldOptionsRetention = Nothing-  , fieldOptionsTargets = V.empty-  , fieldOptionsEditionDefaults = V.empty-  , fieldOptionsFeatures = Nothing-  , fieldOptionsFeatureSupport = Nothing-  , fieldOptionsUninterpretedOption = V.empty-  , fieldOptionsUnknownFields = []-  }--instance MessageEncode FieldOptions where-  buildSized msg =-    (maybe mempty (\v -> archVarint 8 (fromIntegral (toProtoEnumFieldOptions'CType v))) msg.fieldOptionsCtype)-    <> (maybe mempty (\v -> archBool 16 v) msg.fieldOptionsPacked)-    <> (maybe mempty (\v -> archVarint 48 (fromIntegral (toProtoEnumFieldOptions'JSType v))) msg.fieldOptionsJstype)-    <> (maybe mempty (\v -> archBool 40 v) msg.fieldOptionsLazy)-    <> (maybe mempty (\v -> archBool 120 v) msg.fieldOptionsUnverifiedLazy)-    <> (maybe mempty (\v -> archBool 24 v) msg.fieldOptionsDeprecated)-    <> (maybe mempty (\v -> archBool 80 v) msg.fieldOptionsWeak)-    <> (maybe mempty (\v -> archBool 128 v) msg.fieldOptionsDebugRedact)-    <> (maybe mempty (\v -> archVarint 136 (fromIntegral (toProtoEnumFieldOptions'OptionRetention v))) msg.fieldOptionsRetention)-    <> V.foldl' (\acc v -> acc <> archVarint 152 (fromIntegral (toProtoEnumFieldOptions'OptionTargetType v))) mempty msg.fieldOptionsTargets-    <> V.foldl' (\acc v -> acc <> archSubmessage 162 (buildSized v)) mempty msg.fieldOptionsEditionDefaults-    <> (maybe mempty (\v -> archSubmessage 170 (buildSized v)) msg.fieldOptionsFeatures)-    <> (maybe mempty (\v -> archSubmessage 178 (buildSized v)) msg.fieldOptionsFeatureSupport)-    <> V.foldl' (\acc v -> acc <> archSubmessage 7994 (buildSized v)) mempty msg.fieldOptionsUninterpretedOption-    <> encodeUnknownFieldsSized msg.fieldOptionsUnknownFields--instance MessageDecode FieldOptions where-  messageDecoder = stage_0 defaultFieldOptions emptyGrowList emptyGrowList-    where-      stage_0 msg gl_0 gl_1 =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> stage_1 (msg { fieldOptionsCtype = (Just v)}) gl_0 gl_1)-          (pure (case msg.fieldOptionsUnknownFields of { [] -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1 }; _ -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1, fieldOptionsUnknownFields = reverse (msg.fieldOptionsUnknownFields) } }))-          (loop msg gl_0 gl_1)-      stage_1 msg gl_0 gl_1 =-        inOrderStage1-          (0x10 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_2 (msg { fieldOptionsPacked = (Just v)}) gl_0 gl_1)-          (pure (case msg.fieldOptionsUnknownFields of { [] -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1 }; _ -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1, fieldOptionsUnknownFields = reverse (msg.fieldOptionsUnknownFields) } }))-          (loop msg gl_0 gl_1)-      stage_2 msg gl_0 gl_1 =-        inOrderStage1-          (0x30 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> stage_3 (msg { fieldOptionsJstype = (Just v)}) gl_0 gl_1)-          (pure (case msg.fieldOptionsUnknownFields of { [] -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1 }; _ -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1, fieldOptionsUnknownFields = reverse (msg.fieldOptionsUnknownFields) } }))-          (loop msg gl_0 gl_1)-      stage_3 msg gl_0 gl_1 =-        inOrderStage1-          (0x28 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_4 (msg { fieldOptionsLazy = (Just v)}) gl_0 gl_1)-          (pure (case msg.fieldOptionsUnknownFields of { [] -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1 }; _ -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1, fieldOptionsUnknownFields = reverse (msg.fieldOptionsUnknownFields) } }))-          (loop msg gl_0 gl_1)-      stage_4 msg gl_0 gl_1 =-        inOrderStage1-          (0x78 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_5 (msg { fieldOptionsUnverifiedLazy = (Just v)}) gl_0 gl_1)-          (pure (case msg.fieldOptionsUnknownFields of { [] -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1 }; _ -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1, fieldOptionsUnknownFields = reverse (msg.fieldOptionsUnknownFields) } }))-          (loop msg gl_0 gl_1)-      stage_5 msg gl_0 gl_1 =-        inOrderStage1-          (0x18 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_6 (msg { fieldOptionsDeprecated = (Just v)}) gl_0 gl_1)-          (pure (case msg.fieldOptionsUnknownFields of { [] -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1 }; _ -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1, fieldOptionsUnknownFields = reverse (msg.fieldOptionsUnknownFields) } }))-          (loop msg gl_0 gl_1)-      stage_6 msg gl_0 gl_1 =-        inOrderStage1-          (0x50 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_7 (msg { fieldOptionsWeak = (Just v)}) gl_0 gl_1)-          (pure (case msg.fieldOptionsUnknownFields of { [] -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1 }; _ -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1, fieldOptionsUnknownFields = reverse (msg.fieldOptionsUnknownFields) } }))-          (loop msg gl_0 gl_1)-      stage_7 msg gl_0 gl_1 =-        inOrderStage-          0x180-          0xffff-          2-          decodeFieldBool-          (\v -> loop (msg { fieldOptionsDebugRedact = (Just v)}) gl_0 gl_1)-          (pure (case msg.fieldOptionsUnknownFields of { [] -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1 }; _ -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1, fieldOptionsUnknownFields = reverse (msg.fieldOptionsUnknownFields) } }))-          (loop msg gl_0 gl_1)-      loop msg gl_0 gl_1 = withTagM-        (pure (case msg.fieldOptionsUnknownFields of { [] -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1 }; _ -> msg { fieldOptionsEditionDefaults = growListToVector gl_0, fieldOptionsUninterpretedOption = growListToVector gl_1, fieldOptionsUnknownFields = reverse (msg.fieldOptionsUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldEnum-            loop (msg { fieldOptionsCtype = (Just v)}) gl_0 gl_1-          2 -> do-            v <- decodeFieldBool-            loop (msg { fieldOptionsPacked = (Just v)}) gl_0 gl_1-          6 -> do-            v <- decodeFieldEnum-            loop (msg { fieldOptionsJstype = (Just v)}) gl_0 gl_1-          5 -> do-            v <- decodeFieldBool-            loop (msg { fieldOptionsLazy = (Just v)}) gl_0 gl_1-          15 -> do-            v <- decodeFieldBool-            loop (msg { fieldOptionsUnverifiedLazy = (Just v)}) gl_0 gl_1-          3 -> do-            v <- decodeFieldBool-            loop (msg { fieldOptionsDeprecated = (Just v)}) gl_0 gl_1-          10 -> do-            v <- decodeFieldBool-            loop (msg { fieldOptionsWeak = (Just v)}) gl_0 gl_1-          16 -> do-            v <- decodeFieldBool-            loop (msg { fieldOptionsDebugRedact = (Just v)}) gl_0 gl_1-          17 -> do-            v <- decodeFieldEnum-            loop (msg { fieldOptionsRetention = (Just v)}) gl_0 gl_1-          19 -> do-            v <- decodeFieldEnum-            loop (msg { fieldOptionsTargets = (V.snoc msg.fieldOptionsTargets v)}) gl_0 gl_1-          20 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v) gl_1-          21 -> do-            v <- decodeFieldMessage-            loop (msg { fieldOptionsFeatures = (Just v)}) gl_0 gl_1-          22 -> do-            v <- decodeFieldMessage-            loop (msg { fieldOptionsFeatureSupport = (Just v)}) gl_0 gl_1-          999 -> do-            v <- decodeFieldMessage-            loop msg gl_0 (snocGrowList gl_1 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { fieldOptionsUnknownFields = (uf : msg.fieldOptionsUnknownFields)}) gl_0 gl_1)---- | Field descriptors for 'FieldOptions', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-fieldOptionsFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor FieldOptions)-fieldOptionsFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "ctype"-        , fdNumber = 1-        , fdTypeDesc = MessageType "CType"-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsCtype-        , fdSet = \v m -> m { fieldOptionsCtype = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "packed"-        , fdNumber = 2-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsPacked-        , fdSet = \v m -> m { fieldOptionsPacked = v }-        })-    , (6, SomeField FieldDescriptor-        { fdName = "jstype"-        , fdNumber = 6-        , fdTypeDesc = MessageType "JSType"-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsJstype-        , fdSet = \v m -> m { fieldOptionsJstype = v }-        })-    , (5, SomeField FieldDescriptor-        { fdName = "lazy"-        , fdNumber = 5-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsLazy-        , fdSet = \v m -> m { fieldOptionsLazy = v }-        })-    , (15, SomeField FieldDescriptor-        { fdName = "unverified_lazy"-        , fdNumber = 15-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsUnverifiedLazy-        , fdSet = \v m -> m { fieldOptionsUnverifiedLazy = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "deprecated"-        , fdNumber = 3-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsDeprecated-        , fdSet = \v m -> m { fieldOptionsDeprecated = v }-        })-    , (10, SomeField FieldDescriptor-        { fdName = "weak"-        , fdNumber = 10-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsWeak-        , fdSet = \v m -> m { fieldOptionsWeak = v }-        })-    , (16, SomeField FieldDescriptor-        { fdName = "debug_redact"-        , fdNumber = 16-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsDebugRedact-        , fdSet = \v m -> m { fieldOptionsDebugRedact = v }-        })-    , (17, SomeField FieldDescriptor-        { fdName = "retention"-        , fdNumber = 17-        , fdTypeDesc = MessageType "OptionRetention"-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsRetention-        , fdSet = \v m -> m { fieldOptionsRetention = v }-        })-    , (19, SomeField FieldDescriptor-        { fdName = "targets"-        , fdNumber = 19-        , fdTypeDesc = MessageType "OptionTargetType"-        , fdLabel = LabelRepeated-        , fdGet = fieldOptionsTargets-        , fdSet = \v m -> m { fieldOptionsTargets = v }-        })-    , (20, SomeField FieldDescriptor-        { fdName = "edition_defaults"-        , fdNumber = 20-        , fdTypeDesc = MessageType "EditionDefault"-        , fdLabel = LabelRepeated-        , fdGet = fieldOptionsEditionDefaults-        , fdSet = \v m -> m { fieldOptionsEditionDefaults = v }-        })-    , (21, SomeField FieldDescriptor-        { fdName = "features"-        , fdNumber = 21-        , fdTypeDesc = MessageType "FeatureSet"-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsFeatures-        , fdSet = \v m -> m { fieldOptionsFeatures = v }-        })-    , (22, SomeField FieldDescriptor-        { fdName = "feature_support"-        , fdNumber = 22-        , fdTypeDesc = MessageType "FeatureSupport"-        , fdLabel = LabelOptional-        , fdGet = fieldOptionsFeatureSupport-        , fdSet = \v m -> m { fieldOptionsFeatureSupport = v }-        })-    , (999, SomeField FieldDescriptor-        { fdName = "uninterpreted_option"-        , fdNumber = 999-        , fdTypeDesc = MessageType "UninterpretedOption"-        , fdLabel = LabelRepeated-        , fdGet = fieldOptionsUninterpretedOption-        , fdSet = \v m -> m { fieldOptionsUninterpretedOption = v }-        })-    ]--instance ProtoMessage FieldOptions where-  protoMessageName _ = "google.protobuf.FieldOptions"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultFieldOptions-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = fieldOptionsFieldDescriptors--instance IsMessage FieldOptions--instance Aeson.ToJSON FieldOptions where-  toJSON msg = jsonObject-      [ "ctype" .=: msg.fieldOptionsCtype-      , "packed" .=: msg.fieldOptionsPacked-      , "jstype" .=: msg.fieldOptionsJstype-      , "lazy" .=: msg.fieldOptionsLazy-      , "unverifiedLazy" .=: msg.fieldOptionsUnverifiedLazy-      , "deprecated" .=: msg.fieldOptionsDeprecated-      , "weak" .=: msg.fieldOptionsWeak-      , "debugRedact" .=: msg.fieldOptionsDebugRedact-      , "retention" .=: msg.fieldOptionsRetention-      , "targets" .=: msg.fieldOptionsTargets-      , "editionDefaults" .=: msg.fieldOptionsEditionDefaults-      , "features" .=: msg.fieldOptionsFeatures-      , "featureSupport" .=: msg.fieldOptionsFeatureSupport-      , "uninterpretedOption" .=: msg.fieldOptionsUninterpretedOption-      ]--instance Aeson.FromJSON FieldOptions where-  parseJSON = Aeson.withObject "FieldOptions" $ \obj -> do-    fld_fieldOptionsCtype <- parseFieldMaybe obj "ctype"-    fld_fieldOptionsPacked <- parseFieldMaybe obj "packed"-    fld_fieldOptionsJstype <- parseFieldMaybe obj "jstype"-    fld_fieldOptionsLazy <- parseFieldMaybe obj "lazy"-    fld_fieldOptionsUnverifiedLazy <- parseFieldMaybe obj "unverifiedLazy"-    fld_fieldOptionsDeprecated <- parseFieldMaybe obj "deprecated"-    fld_fieldOptionsWeak <- parseFieldMaybe obj "weak"-    fld_fieldOptionsDebugRedact <- parseFieldMaybe obj "debugRedact"-    fld_fieldOptionsRetention <- parseFieldMaybe obj "retention"-    fld_fieldOptionsTargets <- parseFieldMaybe obj "targets"-    fld_fieldOptionsEditionDefaults <- parseFieldMaybe obj "editionDefaults"-    fld_fieldOptionsFeatures <- parseFieldMaybe obj "features"-    fld_fieldOptionsFeatureSupport <- parseFieldMaybe obj "featureSupport"-    fld_fieldOptionsUninterpretedOption <- parseFieldMaybe obj "uninterpretedOption"-    pure defaultFieldOptions-      { fieldOptionsCtype = maybe (fieldOptionsCtype defaultFieldOptions) id fld_fieldOptionsCtype-      , fieldOptionsPacked = maybe (fieldOptionsPacked defaultFieldOptions) id fld_fieldOptionsPacked-      , fieldOptionsJstype = maybe (fieldOptionsJstype defaultFieldOptions) id fld_fieldOptionsJstype-      , fieldOptionsLazy = maybe (fieldOptionsLazy defaultFieldOptions) id fld_fieldOptionsLazy-      , fieldOptionsUnverifiedLazy = maybe (fieldOptionsUnverifiedLazy defaultFieldOptions) id fld_fieldOptionsUnverifiedLazy-      , fieldOptionsDeprecated = maybe (fieldOptionsDeprecated defaultFieldOptions) id fld_fieldOptionsDeprecated-      , fieldOptionsWeak = maybe (fieldOptionsWeak defaultFieldOptions) id fld_fieldOptionsWeak-      , fieldOptionsDebugRedact = maybe (fieldOptionsDebugRedact defaultFieldOptions) id fld_fieldOptionsDebugRedact-      , fieldOptionsRetention = maybe (fieldOptionsRetention defaultFieldOptions) id fld_fieldOptionsRetention-      , fieldOptionsTargets = maybe (fieldOptionsTargets defaultFieldOptions) id fld_fieldOptionsTargets-      , fieldOptionsEditionDefaults = maybe (fieldOptionsEditionDefaults defaultFieldOptions) id fld_fieldOptionsEditionDefaults-      , fieldOptionsFeatures = maybe (fieldOptionsFeatures defaultFieldOptions) id fld_fieldOptionsFeatures-      , fieldOptionsFeatureSupport = maybe (fieldOptionsFeatureSupport defaultFieldOptions) id fld_fieldOptionsFeatureSupport-      , fieldOptionsUninterpretedOption = maybe (fieldOptionsUninterpretedOption defaultFieldOptions) id fld_fieldOptionsUninterpretedOption-      }--instance Hashable FieldOptions where-  hashWithSalt salt msg = V.foldl' hashWithSalt (hashWithSalt (hashWithSalt (V.foldl' hashWithSalt (V.foldl' hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.fieldOptionsCtype) msg.fieldOptionsPacked) msg.fieldOptionsJstype) msg.fieldOptionsLazy) msg.fieldOptionsUnverifiedLazy) msg.fieldOptionsDeprecated) msg.fieldOptionsWeak) msg.fieldOptionsDebugRedact) msg.fieldOptionsRetention) msg.fieldOptionsTargets) msg.fieldOptionsEditionDefaults) msg.fieldOptionsFeatures) msg.fieldOptionsFeatureSupport) msg.fieldOptionsUninterpretedOption--instance Proto.Extension.HasExtensions FieldOptions where-  messageUnknownFields = fieldOptionsUnknownFields-  setMessageUnknownFields !ufs msg = msg { fieldOptionsUnknownFields = ufs }--instance Semigroup FieldOptions where-  a <> b = FieldOptions-    { fieldOptionsCtype = case b.fieldOptionsCtype of { Nothing -> a.fieldOptionsCtype; x -> x }-    , fieldOptionsPacked = case b.fieldOptionsPacked of { Nothing -> a.fieldOptionsPacked; x -> x }-    , fieldOptionsJstype = case b.fieldOptionsJstype of { Nothing -> a.fieldOptionsJstype; x -> x }-    , fieldOptionsLazy = case b.fieldOptionsLazy of { Nothing -> a.fieldOptionsLazy; x -> x }-    , fieldOptionsUnverifiedLazy = case b.fieldOptionsUnverifiedLazy of { Nothing -> a.fieldOptionsUnverifiedLazy; x -> x }-    , fieldOptionsDeprecated = case b.fieldOptionsDeprecated of { Nothing -> a.fieldOptionsDeprecated; x -> x }-    , fieldOptionsWeak = case b.fieldOptionsWeak of { Nothing -> a.fieldOptionsWeak; x -> x }-    , fieldOptionsDebugRedact = case b.fieldOptionsDebugRedact of { Nothing -> a.fieldOptionsDebugRedact; x -> x }-    , fieldOptionsRetention = case b.fieldOptionsRetention of { Nothing -> a.fieldOptionsRetention; x -> x }-    , fieldOptionsTargets = a.fieldOptionsTargets <> b.fieldOptionsTargets-    , fieldOptionsEditionDefaults = a.fieldOptionsEditionDefaults <> b.fieldOptionsEditionDefaults-    , fieldOptionsFeatures = case b.fieldOptionsFeatures of { Nothing -> a.fieldOptionsFeatures; x -> x }-    , fieldOptionsFeatureSupport = case b.fieldOptionsFeatureSupport of { Nothing -> a.fieldOptionsFeatureSupport; x -> x }-    , fieldOptionsUninterpretedOption = a.fieldOptionsUninterpretedOption <> b.fieldOptionsUninterpretedOption-    , fieldOptionsUnknownFields = a.fieldOptionsUnknownFields <> b.fieldOptionsUnknownFields-    }--instance Monoid FieldOptions where-  mempty = defaultFieldOptions--data OneofOptions = OneofOptions-  { oneofOptionsFeatures :: !(Maybe FeatureSet)-    -- ^ Any features defined in the specific edition.-  , oneofOptionsUninterpretedOption :: !(V.Vector UninterpretedOption)-    -- ^ The parser stores options it doesn't recognize here. See above.-  , oneofOptionsUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultOneofOptions :: OneofOptions-defaultOneofOptions = OneofOptions-  { oneofOptionsFeatures = Nothing-  , oneofOptionsUninterpretedOption = V.empty-  , oneofOptionsUnknownFields = []-  }--instance MessageEncode OneofOptions where-  buildSized msg =-    (maybe mempty (\v -> archSubmessage 10 (buildSized v)) msg.oneofOptionsFeatures)-    <> V.foldl' (\acc v -> acc <> archSubmessage 7994 (buildSized v)) mempty msg.oneofOptionsUninterpretedOption-    <> encodeUnknownFieldsSized msg.oneofOptionsUnknownFields--instance MessageDecode OneofOptions where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultOneofOptions emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_1 (msg { oneofOptionsFeatures = (Just v)}) gl_0)-          (pure (case msg.oneofOptionsUnknownFields of { [] -> msg { oneofOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { oneofOptionsUninterpretedOption = growListToVector gl_0, oneofOptionsUnknownFields = reverse (msg.oneofOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_1 msg gl_0 =-        inOrderStage-          0x3eba-          0xffff-          2-          decodeFieldMessage-          (\v -> stage_1 msg (snocGrowList gl_0 v))-          (pure (case msg.oneofOptionsUnknownFields of { [] -> msg { oneofOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { oneofOptionsUninterpretedOption = growListToVector gl_0, oneofOptionsUnknownFields = reverse (msg.oneofOptionsUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.oneofOptionsUnknownFields of { [] -> msg { oneofOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { oneofOptionsUninterpretedOption = growListToVector gl_0, oneofOptionsUnknownFields = reverse (msg.oneofOptionsUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldMessage-            loop (msg { oneofOptionsFeatures = (Just v)}) gl_0-          999 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { oneofOptionsUnknownFields = (uf : msg.oneofOptionsUnknownFields)}) gl_0)---- | Field descriptors for 'OneofOptions', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-oneofOptionsFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor OneofOptions)-oneofOptionsFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "features"-        , fdNumber = 1-        , fdTypeDesc = MessageType "FeatureSet"-        , fdLabel = LabelOptional-        , fdGet = oneofOptionsFeatures-        , fdSet = \v m -> m { oneofOptionsFeatures = v }-        }), (999, SomeField FieldDescriptor-        { fdName = "uninterpreted_option"-        , fdNumber = 999-        , fdTypeDesc = MessageType "UninterpretedOption"-        , fdLabel = LabelRepeated-        , fdGet = oneofOptionsUninterpretedOption-        , fdSet = \v m -> m { oneofOptionsUninterpretedOption = v }-        })-    ]--instance ProtoMessage OneofOptions where-  protoMessageName _ = "google.protobuf.OneofOptions"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultOneofOptions-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = oneofOptionsFieldDescriptors--instance IsMessage OneofOptions--instance Aeson.ToJSON OneofOptions where-  toJSON msg = jsonObject-      [ "features" .=: msg.oneofOptionsFeatures-      , "uninterpretedOption" .=: msg.oneofOptionsUninterpretedOption-      ]--instance Aeson.FromJSON OneofOptions where-  parseJSON = Aeson.withObject "OneofOptions" $ \obj -> do-    fld_oneofOptionsFeatures <- parseFieldMaybe obj "features"-    fld_oneofOptionsUninterpretedOption <- parseFieldMaybe obj "uninterpretedOption"-    pure defaultOneofOptions-      { oneofOptionsFeatures = maybe (oneofOptionsFeatures defaultOneofOptions) id fld_oneofOptionsFeatures-      , oneofOptionsUninterpretedOption = maybe (oneofOptionsUninterpretedOption defaultOneofOptions) id fld_oneofOptionsUninterpretedOption-      }--instance Hashable OneofOptions where-  hashWithSalt salt msg = V.foldl' hashWithSalt (hashWithSalt (salt) msg.oneofOptionsFeatures) msg.oneofOptionsUninterpretedOption--instance Proto.Extension.HasExtensions OneofOptions where-  messageUnknownFields = oneofOptionsUnknownFields-  setMessageUnknownFields !ufs msg = msg { oneofOptionsUnknownFields = ufs }--instance Semigroup OneofOptions where-  a <> b = OneofOptions-    { oneofOptionsFeatures = case b.oneofOptionsFeatures of { Nothing -> a.oneofOptionsFeatures; x -> x }-    , oneofOptionsUninterpretedOption = a.oneofOptionsUninterpretedOption <> b.oneofOptionsUninterpretedOption-    , oneofOptionsUnknownFields = a.oneofOptionsUnknownFields <> b.oneofOptionsUnknownFields-    }--instance Monoid OneofOptions where-  mempty = defaultOneofOptions--data EnumOptions = EnumOptions-  { enumOptionsAllowAlias :: !(Maybe Bool)-    -- ^ Set this option to true to allow mapping different tag names to the same-    -- value.-  , enumOptionsDeprecated :: !(Maybe Bool)-    -- ^ Is this enum deprecated?-    -- Depending on the target platform, this can emit Deprecated annotations-    -- for the enum, or it will be completely ignored; in the very least, this-    -- is a formalization for deprecating enums.-  , enumOptionsDeprecatedLegacyJsonFieldConflicts :: !(Maybe Bool)-    -- ^ Enable the legacy handling of JSON field name conflicts.  This lowercases-    -- and strips underscored from the fields before comparison in proto3 only.-    -- The new behavior takes `json_name` into account and applies to proto2 as-    -- well.-    -- TODO Remove this legacy behavior once downstream teams have-    -- had time to migrate.-  , enumOptionsFeatures :: !(Maybe FeatureSet)-    -- ^ Any features defined in the specific edition.-  , enumOptionsUninterpretedOption :: !(V.Vector UninterpretedOption)-    -- ^ The parser stores options it doesn't recognize here. See above.-  , enumOptionsUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultEnumOptions :: EnumOptions-defaultEnumOptions = EnumOptions-  { enumOptionsAllowAlias = Nothing-  , enumOptionsDeprecated = Nothing-  , enumOptionsDeprecatedLegacyJsonFieldConflicts = Nothing-  , enumOptionsFeatures = Nothing-  , enumOptionsUninterpretedOption = V.empty-  , enumOptionsUnknownFields = []-  }--instance MessageEncode EnumOptions where-  buildSized msg =-    (maybe mempty (\v -> archBool 16 v) msg.enumOptionsAllowAlias)-    <> (maybe mempty (\v -> archBool 24 v) msg.enumOptionsDeprecated)-    <> (maybe mempty (\v -> archBool 48 v) msg.enumOptionsDeprecatedLegacyJsonFieldConflicts)-    <> (maybe mempty (\v -> archSubmessage 58 (buildSized v)) msg.enumOptionsFeatures)-    <> V.foldl' (\acc v -> acc <> archSubmessage 7994 (buildSized v)) mempty msg.enumOptionsUninterpretedOption-    <> encodeUnknownFieldsSized msg.enumOptionsUnknownFields--instance MessageDecode EnumOptions where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultEnumOptions emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage1-          (0x10 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_1 (msg { enumOptionsAllowAlias = (Just v)}) gl_0)-          (pure (case msg.enumOptionsUnknownFields of { [] -> msg { enumOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { enumOptionsUninterpretedOption = growListToVector gl_0, enumOptionsUnknownFields = reverse (msg.enumOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_1 msg gl_0 =-        inOrderStage1-          (0x18 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_2 (msg { enumOptionsDeprecated = (Just v)}) gl_0)-          (pure (case msg.enumOptionsUnknownFields of { [] -> msg { enumOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { enumOptionsUninterpretedOption = growListToVector gl_0, enumOptionsUnknownFields = reverse (msg.enumOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_2 msg gl_0 =-        inOrderStage1-          (0x30 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_3 (msg { enumOptionsDeprecatedLegacyJsonFieldConflicts = (Just v)}) gl_0)-          (pure (case msg.enumOptionsUnknownFields of { [] -> msg { enumOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { enumOptionsUninterpretedOption = growListToVector gl_0, enumOptionsUnknownFields = reverse (msg.enumOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_3 msg gl_0 =-        inOrderStage1-          (0x3a :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_4 (msg { enumOptionsFeatures = (Just v)}) gl_0)-          (pure (case msg.enumOptionsUnknownFields of { [] -> msg { enumOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { enumOptionsUninterpretedOption = growListToVector gl_0, enumOptionsUnknownFields = reverse (msg.enumOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_4 msg gl_0 =-        inOrderStage-          0x3eba-          0xffff-          2-          decodeFieldMessage-          (\v -> stage_4 msg (snocGrowList gl_0 v))-          (pure (case msg.enumOptionsUnknownFields of { [] -> msg { enumOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { enumOptionsUninterpretedOption = growListToVector gl_0, enumOptionsUnknownFields = reverse (msg.enumOptionsUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.enumOptionsUnknownFields of { [] -> msg { enumOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { enumOptionsUninterpretedOption = growListToVector gl_0, enumOptionsUnknownFields = reverse (msg.enumOptionsUnknownFields) } }))-        (\fn wt -> case fn of-          2 -> do-            v <- decodeFieldBool-            loop (msg { enumOptionsAllowAlias = (Just v)}) gl_0-          3 -> do-            v <- decodeFieldBool-            loop (msg { enumOptionsDeprecated = (Just v)}) gl_0-          6 -> do-            v <- decodeFieldBool-            loop (msg { enumOptionsDeprecatedLegacyJsonFieldConflicts = (Just v)}) gl_0-          7 -> do-            v <- decodeFieldMessage-            loop (msg { enumOptionsFeatures = (Just v)}) gl_0-          999 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { enumOptionsUnknownFields = (uf : msg.enumOptionsUnknownFields)}) gl_0)---- | Field descriptors for 'EnumOptions', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-enumOptionsFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor EnumOptions)-enumOptionsFieldDescriptors =-  IntMap.fromList-    [ (2, SomeField FieldDescriptor-        { fdName = "allow_alias"-        , fdNumber = 2-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = enumOptionsAllowAlias-        , fdSet = \v m -> m { enumOptionsAllowAlias = v }-        }), (3, SomeField FieldDescriptor-        { fdName = "deprecated"-        , fdNumber = 3-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = enumOptionsDeprecated-        , fdSet = \v m -> m { enumOptionsDeprecated = v }-        })-    , (6, SomeField FieldDescriptor-        { fdName = "deprecated_legacy_json_field_conflicts"-        , fdNumber = 6-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = enumOptionsDeprecatedLegacyJsonFieldConflicts-        , fdSet = \v m -> m { enumOptionsDeprecatedLegacyJsonFieldConflicts = v }-        })-    , (7, SomeField FieldDescriptor-        { fdName = "features"-        , fdNumber = 7-        , fdTypeDesc = MessageType "FeatureSet"-        , fdLabel = LabelOptional-        , fdGet = enumOptionsFeatures-        , fdSet = \v m -> m { enumOptionsFeatures = v }-        })-    , (999, SomeField FieldDescriptor-        { fdName = "uninterpreted_option"-        , fdNumber = 999-        , fdTypeDesc = MessageType "UninterpretedOption"-        , fdLabel = LabelRepeated-        , fdGet = enumOptionsUninterpretedOption-        , fdSet = \v m -> m { enumOptionsUninterpretedOption = v }-        })-    ]--instance ProtoMessage EnumOptions where-  protoMessageName _ = "google.protobuf.EnumOptions"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultEnumOptions-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = enumOptionsFieldDescriptors--instance IsMessage EnumOptions--instance Aeson.ToJSON EnumOptions where-  toJSON msg = jsonObject-      [ "allowAlias" .=: msg.enumOptionsAllowAlias-      , "deprecated" .=: msg.enumOptionsDeprecated-      , "deprecatedLegacyJsonFieldConflicts" .=: msg.enumOptionsDeprecatedLegacyJsonFieldConflicts-      , "features" .=: msg.enumOptionsFeatures-      , "uninterpretedOption" .=: msg.enumOptionsUninterpretedOption-      ]--instance Aeson.FromJSON EnumOptions where-  parseJSON = Aeson.withObject "EnumOptions" $ \obj -> do-    fld_enumOptionsAllowAlias <- parseFieldMaybe obj "allowAlias"-    fld_enumOptionsDeprecated <- parseFieldMaybe obj "deprecated"-    fld_enumOptionsDeprecatedLegacyJsonFieldConflicts <- parseFieldMaybe obj "deprecatedLegacyJsonFieldConflicts"-    fld_enumOptionsFeatures <- parseFieldMaybe obj "features"-    fld_enumOptionsUninterpretedOption <- parseFieldMaybe obj "uninterpretedOption"-    pure defaultEnumOptions-      { enumOptionsAllowAlias = maybe (enumOptionsAllowAlias defaultEnumOptions) id fld_enumOptionsAllowAlias-      , enumOptionsDeprecated = maybe (enumOptionsDeprecated defaultEnumOptions) id fld_enumOptionsDeprecated-      , enumOptionsDeprecatedLegacyJsonFieldConflicts = maybe (enumOptionsDeprecatedLegacyJsonFieldConflicts defaultEnumOptions) id fld_enumOptionsDeprecatedLegacyJsonFieldConflicts-      , enumOptionsFeatures = maybe (enumOptionsFeatures defaultEnumOptions) id fld_enumOptionsFeatures-      , enumOptionsUninterpretedOption = maybe (enumOptionsUninterpretedOption defaultEnumOptions) id fld_enumOptionsUninterpretedOption-      }--instance Hashable EnumOptions where-  hashWithSalt salt msg = V.foldl' hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.enumOptionsAllowAlias) msg.enumOptionsDeprecated) msg.enumOptionsDeprecatedLegacyJsonFieldConflicts) msg.enumOptionsFeatures) msg.enumOptionsUninterpretedOption--instance Proto.Extension.HasExtensions EnumOptions where-  messageUnknownFields = enumOptionsUnknownFields-  setMessageUnknownFields !ufs msg = msg { enumOptionsUnknownFields = ufs }--instance Semigroup EnumOptions where-  a <> b = EnumOptions-    { enumOptionsAllowAlias = case b.enumOptionsAllowAlias of { Nothing -> a.enumOptionsAllowAlias; x -> x }-    , enumOptionsDeprecated = case b.enumOptionsDeprecated of { Nothing -> a.enumOptionsDeprecated; x -> x }-    , enumOptionsDeprecatedLegacyJsonFieldConflicts = case b.enumOptionsDeprecatedLegacyJsonFieldConflicts of { Nothing -> a.enumOptionsDeprecatedLegacyJsonFieldConflicts; x -> x }-    , enumOptionsFeatures = case b.enumOptionsFeatures of { Nothing -> a.enumOptionsFeatures; x -> x }-    , enumOptionsUninterpretedOption = a.enumOptionsUninterpretedOption <> b.enumOptionsUninterpretedOption-    , enumOptionsUnknownFields = a.enumOptionsUnknownFields <> b.enumOptionsUnknownFields-    }--instance Monoid EnumOptions where-  mempty = defaultEnumOptions--data EnumValueOptions = EnumValueOptions-  { enumValueOptionsDeprecated :: !(Maybe Bool)-    -- ^ Is this enum value deprecated?-    -- Depending on the target platform, this can emit Deprecated annotations-    -- for the enum value, or it will be completely ignored; in the very least,-    -- this is a formalization for deprecating enum values.-  , enumValueOptionsFeatures :: !(Maybe FeatureSet)-    -- ^ Any features defined in the specific edition.-  , enumValueOptionsDebugRedact :: !(Maybe Bool)-    -- ^ Indicate that fields annotated with this enum value should not be printed-    -- out when using debug formats, e.g. when the field contains sensitive-    -- credentials.-  , enumValueOptionsFeatureSupport :: !(Maybe FieldOptions'FeatureSupport)-    -- ^ Information about the support window of a feature value.-  , enumValueOptionsUninterpretedOption :: !(V.Vector UninterpretedOption)-    -- ^ The parser stores options it doesn't recognize here. See above.-  , enumValueOptionsUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultEnumValueOptions :: EnumValueOptions-defaultEnumValueOptions = EnumValueOptions-  { enumValueOptionsDeprecated = Nothing-  , enumValueOptionsFeatures = Nothing-  , enumValueOptionsDebugRedact = Nothing-  , enumValueOptionsFeatureSupport = Nothing-  , enumValueOptionsUninterpretedOption = V.empty-  , enumValueOptionsUnknownFields = []-  }--instance MessageEncode EnumValueOptions where-  buildSized msg =-    (maybe mempty (\v -> archBool 8 v) msg.enumValueOptionsDeprecated)-    <> (maybe mempty (\v -> archSubmessage 18 (buildSized v)) msg.enumValueOptionsFeatures)-    <> (maybe mempty (\v -> archBool 24 v) msg.enumValueOptionsDebugRedact)-    <> (maybe mempty (\v -> archSubmessage 34 (buildSized v)) msg.enumValueOptionsFeatureSupport)-    <> V.foldl' (\acc v -> acc <> archSubmessage 7994 (buildSized v)) mempty msg.enumValueOptionsUninterpretedOption-    <> encodeUnknownFieldsSized msg.enumValueOptionsUnknownFields--instance MessageDecode EnumValueOptions where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultEnumValueOptions emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_1 (msg { enumValueOptionsDeprecated = (Just v)}) gl_0)-          (pure (case msg.enumValueOptionsUnknownFields of { [] -> msg { enumValueOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { enumValueOptionsUninterpretedOption = growListToVector gl_0, enumValueOptionsUnknownFields = reverse (msg.enumValueOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_1 msg gl_0 =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_2 (msg { enumValueOptionsFeatures = (Just v)}) gl_0)-          (pure (case msg.enumValueOptionsUnknownFields of { [] -> msg { enumValueOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { enumValueOptionsUninterpretedOption = growListToVector gl_0, enumValueOptionsUnknownFields = reverse (msg.enumValueOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_2 msg gl_0 =-        inOrderStage1-          (0x18 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> stage_3 (msg { enumValueOptionsDebugRedact = (Just v)}) gl_0)-          (pure (case msg.enumValueOptionsUnknownFields of { [] -> msg { enumValueOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { enumValueOptionsUninterpretedOption = growListToVector gl_0, enumValueOptionsUnknownFields = reverse (msg.enumValueOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_3 msg gl_0 =-        inOrderStage1-          (0x22 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_4 (msg { enumValueOptionsFeatureSupport = (Just v)}) gl_0)-          (pure (case msg.enumValueOptionsUnknownFields of { [] -> msg { enumValueOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { enumValueOptionsUninterpretedOption = growListToVector gl_0, enumValueOptionsUnknownFields = reverse (msg.enumValueOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_4 msg gl_0 =-        inOrderStage-          0x3eba-          0xffff-          2-          decodeFieldMessage-          (\v -> stage_4 msg (snocGrowList gl_0 v))-          (pure (case msg.enumValueOptionsUnknownFields of { [] -> msg { enumValueOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { enumValueOptionsUninterpretedOption = growListToVector gl_0, enumValueOptionsUnknownFields = reverse (msg.enumValueOptionsUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.enumValueOptionsUnknownFields of { [] -> msg { enumValueOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { enumValueOptionsUninterpretedOption = growListToVector gl_0, enumValueOptionsUnknownFields = reverse (msg.enumValueOptionsUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldBool-            loop (msg { enumValueOptionsDeprecated = (Just v)}) gl_0-          2 -> do-            v <- decodeFieldMessage-            loop (msg { enumValueOptionsFeatures = (Just v)}) gl_0-          3 -> do-            v <- decodeFieldBool-            loop (msg { enumValueOptionsDebugRedact = (Just v)}) gl_0-          4 -> do-            v <- decodeFieldMessage-            loop (msg { enumValueOptionsFeatureSupport = (Just v)}) gl_0-          999 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { enumValueOptionsUnknownFields = (uf : msg.enumValueOptionsUnknownFields)}) gl_0)---- | Field descriptors for 'EnumValueOptions', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-enumValueOptionsFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor EnumValueOptions)-enumValueOptionsFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "deprecated"-        , fdNumber = 1-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = enumValueOptionsDeprecated-        , fdSet = \v m -> m { enumValueOptionsDeprecated = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "features"-        , fdNumber = 2-        , fdTypeDesc = MessageType "FeatureSet"-        , fdLabel = LabelOptional-        , fdGet = enumValueOptionsFeatures-        , fdSet = \v m -> m { enumValueOptionsFeatures = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "debug_redact"-        , fdNumber = 3-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = enumValueOptionsDebugRedact-        , fdSet = \v m -> m { enumValueOptionsDebugRedact = v }-        })-    , (4, SomeField FieldDescriptor-        { fdName = "feature_support"-        , fdNumber = 4-        , fdTypeDesc = MessageType "FieldOptions.FeatureSupport"-        , fdLabel = LabelOptional-        , fdGet = enumValueOptionsFeatureSupport-        , fdSet = \v m -> m { enumValueOptionsFeatureSupport = v }-        })-    , (999, SomeField FieldDescriptor-        { fdName = "uninterpreted_option"-        , fdNumber = 999-        , fdTypeDesc = MessageType "UninterpretedOption"-        , fdLabel = LabelRepeated-        , fdGet = enumValueOptionsUninterpretedOption-        , fdSet = \v m -> m { enumValueOptionsUninterpretedOption = v }-        })-    ]--instance ProtoMessage EnumValueOptions where-  protoMessageName _ = "google.protobuf.EnumValueOptions"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultEnumValueOptions-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = enumValueOptionsFieldDescriptors--instance IsMessage EnumValueOptions--instance Aeson.ToJSON EnumValueOptions where-  toJSON msg = jsonObject-      [ "deprecated" .=: msg.enumValueOptionsDeprecated-      , "features" .=: msg.enumValueOptionsFeatures-      , "debugRedact" .=: msg.enumValueOptionsDebugRedact-      , "featureSupport" .=: msg.enumValueOptionsFeatureSupport-      , "uninterpretedOption" .=: msg.enumValueOptionsUninterpretedOption-      ]--instance Aeson.FromJSON EnumValueOptions where-  parseJSON = Aeson.withObject "EnumValueOptions" $ \obj -> do-    fld_enumValueOptionsDeprecated <- parseFieldMaybe obj "deprecated"-    fld_enumValueOptionsFeatures <- parseFieldMaybe obj "features"-    fld_enumValueOptionsDebugRedact <- parseFieldMaybe obj "debugRedact"-    fld_enumValueOptionsFeatureSupport <- parseFieldMaybe obj "featureSupport"-    fld_enumValueOptionsUninterpretedOption <- parseFieldMaybe obj "uninterpretedOption"-    pure defaultEnumValueOptions-      { enumValueOptionsDeprecated = maybe (enumValueOptionsDeprecated defaultEnumValueOptions) id fld_enumValueOptionsDeprecated-      , enumValueOptionsFeatures = maybe (enumValueOptionsFeatures defaultEnumValueOptions) id fld_enumValueOptionsFeatures-      , enumValueOptionsDebugRedact = maybe (enumValueOptionsDebugRedact defaultEnumValueOptions) id fld_enumValueOptionsDebugRedact-      , enumValueOptionsFeatureSupport = maybe (enumValueOptionsFeatureSupport defaultEnumValueOptions) id fld_enumValueOptionsFeatureSupport-      , enumValueOptionsUninterpretedOption = maybe (enumValueOptionsUninterpretedOption defaultEnumValueOptions) id fld_enumValueOptionsUninterpretedOption-      }--instance Hashable EnumValueOptions where-  hashWithSalt salt msg = V.foldl' hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.enumValueOptionsDeprecated) msg.enumValueOptionsFeatures) msg.enumValueOptionsDebugRedact) msg.enumValueOptionsFeatureSupport) msg.enumValueOptionsUninterpretedOption--instance Proto.Extension.HasExtensions EnumValueOptions where-  messageUnknownFields = enumValueOptionsUnknownFields-  setMessageUnknownFields !ufs msg = msg { enumValueOptionsUnknownFields = ufs }--instance Semigroup EnumValueOptions where-  a <> b = EnumValueOptions-    { enumValueOptionsDeprecated = case b.enumValueOptionsDeprecated of { Nothing -> a.enumValueOptionsDeprecated; x -> x }-    , enumValueOptionsFeatures = case b.enumValueOptionsFeatures of { Nothing -> a.enumValueOptionsFeatures; x -> x }-    , enumValueOptionsDebugRedact = case b.enumValueOptionsDebugRedact of { Nothing -> a.enumValueOptionsDebugRedact; x -> x }-    , enumValueOptionsFeatureSupport = case b.enumValueOptionsFeatureSupport of { Nothing -> a.enumValueOptionsFeatureSupport; x -> x }-    , enumValueOptionsUninterpretedOption = a.enumValueOptionsUninterpretedOption <> b.enumValueOptionsUninterpretedOption-    , enumValueOptionsUnknownFields = a.enumValueOptionsUnknownFields <> b.enumValueOptionsUnknownFields-    }--instance Monoid EnumValueOptions where-  mempty = defaultEnumValueOptions--data ServiceOptions = ServiceOptions-  { serviceOptionsFeatures :: !(Maybe FeatureSet)-    -- ^ Any features defined in the specific edition.-  , serviceOptionsDeprecated :: !(Maybe Bool)-    -- ^ Note:  Field numbers 1 through 32 are reserved for Google's internal RPC-    --   framework.  We apologize for hoarding these numbers to ourselves, but-    --   we were already using them long before we decided to release Protocol-    --   Buffers.-    -- Is this service deprecated?-    -- Depending on the target platform, this can emit Deprecated annotations-    -- for the service, or it will be completely ignored; in the very least,-    -- this is a formalization for deprecating services.-  , serviceOptionsUninterpretedOption :: !(V.Vector UninterpretedOption)-    -- ^ The parser stores options it doesn't recognize here. See above.-  , serviceOptionsUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultServiceOptions :: ServiceOptions-defaultServiceOptions = ServiceOptions-  { serviceOptionsFeatures = Nothing-  , serviceOptionsDeprecated = Nothing-  , serviceOptionsUninterpretedOption = V.empty-  , serviceOptionsUnknownFields = []-  }--instance MessageEncode ServiceOptions where-  buildSized msg =-    (maybe mempty (\v -> archSubmessage 274 (buildSized v)) msg.serviceOptionsFeatures)-    <> (maybe mempty (\v -> archBool 264 v) msg.serviceOptionsDeprecated)-    <> V.foldl' (\acc v -> acc <> archSubmessage 7994 (buildSized v)) mempty msg.serviceOptionsUninterpretedOption-    <> encodeUnknownFieldsSized msg.serviceOptionsUnknownFields--instance MessageDecode ServiceOptions where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultServiceOptions emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage-          0x292-          0xffff-          2-          decodeFieldMessage-          (\v -> stage_1 (msg { serviceOptionsFeatures = (Just v)}) gl_0)-          (pure (case msg.serviceOptionsUnknownFields of { [] -> msg { serviceOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { serviceOptionsUninterpretedOption = growListToVector gl_0, serviceOptionsUnknownFields = reverse (msg.serviceOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_1 msg gl_0 =-        inOrderStage-          0x288-          0xffff-          2-          decodeFieldBool-          (\v -> stage_2 (msg { serviceOptionsDeprecated = (Just v)}) gl_0)-          (pure (case msg.serviceOptionsUnknownFields of { [] -> msg { serviceOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { serviceOptionsUninterpretedOption = growListToVector gl_0, serviceOptionsUnknownFields = reverse (msg.serviceOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_2 msg gl_0 =-        inOrderStage-          0x3eba-          0xffff-          2-          decodeFieldMessage-          (\v -> stage_2 msg (snocGrowList gl_0 v))-          (pure (case msg.serviceOptionsUnknownFields of { [] -> msg { serviceOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { serviceOptionsUninterpretedOption = growListToVector gl_0, serviceOptionsUnknownFields = reverse (msg.serviceOptionsUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.serviceOptionsUnknownFields of { [] -> msg { serviceOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { serviceOptionsUninterpretedOption = growListToVector gl_0, serviceOptionsUnknownFields = reverse (msg.serviceOptionsUnknownFields) } }))-        (\fn wt -> case fn of-          34 -> do-            v <- decodeFieldMessage-            loop (msg { serviceOptionsFeatures = (Just v)}) gl_0-          33 -> do-            v <- decodeFieldBool-            loop (msg { serviceOptionsDeprecated = (Just v)}) gl_0-          999 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { serviceOptionsUnknownFields = (uf : msg.serviceOptionsUnknownFields)}) gl_0)---- | Field descriptors for 'ServiceOptions', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-serviceOptionsFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor ServiceOptions)-serviceOptionsFieldDescriptors =-  IntMap.fromList-    [ (34, SomeField FieldDescriptor-        { fdName = "features"-        , fdNumber = 34-        , fdTypeDesc = MessageType "FeatureSet"-        , fdLabel = LabelOptional-        , fdGet = serviceOptionsFeatures-        , fdSet = \v m -> m { serviceOptionsFeatures = v }-        }), (33, SomeField FieldDescriptor-        { fdName = "deprecated"-        , fdNumber = 33-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = serviceOptionsDeprecated-        , fdSet = \v m -> m { serviceOptionsDeprecated = v }-        })-    , (999, SomeField FieldDescriptor-        { fdName = "uninterpreted_option"-        , fdNumber = 999-        , fdTypeDesc = MessageType "UninterpretedOption"-        , fdLabel = LabelRepeated-        , fdGet = serviceOptionsUninterpretedOption-        , fdSet = \v m -> m { serviceOptionsUninterpretedOption = v }-        })-    ]--instance ProtoMessage ServiceOptions where-  protoMessageName _ = "google.protobuf.ServiceOptions"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultServiceOptions-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = serviceOptionsFieldDescriptors--instance IsMessage ServiceOptions--instance Aeson.ToJSON ServiceOptions where-  toJSON msg = jsonObject-      [ "features" .=: msg.serviceOptionsFeatures-      , "deprecated" .=: msg.serviceOptionsDeprecated-      , "uninterpretedOption" .=: msg.serviceOptionsUninterpretedOption-      ]--instance Aeson.FromJSON ServiceOptions where-  parseJSON = Aeson.withObject "ServiceOptions" $ \obj -> do-    fld_serviceOptionsFeatures <- parseFieldMaybe obj "features"-    fld_serviceOptionsDeprecated <- parseFieldMaybe obj "deprecated"-    fld_serviceOptionsUninterpretedOption <- parseFieldMaybe obj "uninterpretedOption"-    pure defaultServiceOptions-      { serviceOptionsFeatures = maybe (serviceOptionsFeatures defaultServiceOptions) id fld_serviceOptionsFeatures-      , serviceOptionsDeprecated = maybe (serviceOptionsDeprecated defaultServiceOptions) id fld_serviceOptionsDeprecated-      , serviceOptionsUninterpretedOption = maybe (serviceOptionsUninterpretedOption defaultServiceOptions) id fld_serviceOptionsUninterpretedOption-      }--instance Hashable ServiceOptions where-  hashWithSalt salt msg = V.foldl' hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.serviceOptionsFeatures) msg.serviceOptionsDeprecated) msg.serviceOptionsUninterpretedOption--instance Proto.Extension.HasExtensions ServiceOptions where-  messageUnknownFields = serviceOptionsUnknownFields-  setMessageUnknownFields !ufs msg = msg { serviceOptionsUnknownFields = ufs }--instance Semigroup ServiceOptions where-  a <> b = ServiceOptions-    { serviceOptionsFeatures = case b.serviceOptionsFeatures of { Nothing -> a.serviceOptionsFeatures; x -> x }-    , serviceOptionsDeprecated = case b.serviceOptionsDeprecated of { Nothing -> a.serviceOptionsDeprecated; x -> x }-    , serviceOptionsUninterpretedOption = a.serviceOptionsUninterpretedOption <> b.serviceOptionsUninterpretedOption-    , serviceOptionsUnknownFields = a.serviceOptionsUnknownFields <> b.serviceOptionsUnknownFields-    }--instance Monoid ServiceOptions where-  mempty = defaultServiceOptions--data MethodOptions = MethodOptions-  { methodOptionsDeprecated :: !(Maybe Bool)-    -- ^ Note:  Field numbers 1 through 32 are reserved for Google's internal RPC-    --   framework.  We apologize for hoarding these numbers to ourselves, but-    --   we were already using them long before we decided to release Protocol-    --   Buffers.-    -- Is this method deprecated?-    -- Depending on the target platform, this can emit Deprecated annotations-    -- for the method, or it will be completely ignored; in the very least,-    -- this is a formalization for deprecating methods.-  , methodOptionsIdempotencyLevel :: !(Maybe MethodOptions'IdempotencyLevel)-  , methodOptionsFeatures :: !(Maybe FeatureSet)-    -- ^ Any features defined in the specific edition.-  , methodOptionsUninterpretedOption :: !(V.Vector UninterpretedOption)-    -- ^ The parser stores options it doesn't recognize here. See above.-  , methodOptionsUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData---- | Is this method side-effect-free (or safe in HTTP parlance), or idempotent,--- or neither? HTTP based RPC implementation may choose GET verb for safe--- methods, and PUT verb for idempotent methods instead of the default POST.-data MethodOptions'IdempotencyLevel-  = MethodOptions'IdempotencyLevel'IdempotencyUnknown-  | MethodOptions'IdempotencyLevel'NoSideEffects-  | MethodOptions'IdempotencyLevel'Idempotent-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumMethodOptions'IdempotencyLevel :: MethodOptions'IdempotencyLevel -> Int-toProtoEnumMethodOptions'IdempotencyLevel MethodOptions'IdempotencyLevel'IdempotencyUnknown = 0-toProtoEnumMethodOptions'IdempotencyLevel MethodOptions'IdempotencyLevel'NoSideEffects = 1-toProtoEnumMethodOptions'IdempotencyLevel MethodOptions'IdempotencyLevel'Idempotent = 2--fromProtoEnumMethodOptions'IdempotencyLevel :: Int -> Maybe MethodOptions'IdempotencyLevel-fromProtoEnumMethodOptions'IdempotencyLevel 0 = Just MethodOptions'IdempotencyLevel'IdempotencyUnknown-fromProtoEnumMethodOptions'IdempotencyLevel 1 = Just MethodOptions'IdempotencyLevel'NoSideEffects-fromProtoEnumMethodOptions'IdempotencyLevel 2 = Just MethodOptions'IdempotencyLevel'Idempotent-fromProtoEnumMethodOptions'IdempotencyLevel _ = Nothing--instance MessageEncode MethodOptions'IdempotencyLevel where-  buildSized _ = mempty-instance MessageDecode MethodOptions'IdempotencyLevel where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON MethodOptions'IdempotencyLevel where-  toJSON MethodOptions'IdempotencyLevel'IdempotencyUnknown = Aeson.String "IDEMPOTENCY_UNKNOWN"-  toJSON MethodOptions'IdempotencyLevel'NoSideEffects = Aeson.String "NO_SIDE_EFFECTS"-  toJSON MethodOptions'IdempotencyLevel'Idempotent = Aeson.String "IDEMPOTENT"--instance Aeson.FromJSON MethodOptions'IdempotencyLevel where-  parseJSON = \case-    Aeson.String "IDEMPOTENCY_UNKNOWN" -> pure MethodOptions'IdempotencyLevel'IdempotencyUnknown-    Aeson.String "NO_SIDE_EFFECTS" -> pure MethodOptions'IdempotencyLevel'NoSideEffects-    Aeson.String "IDEMPOTENT" -> pure MethodOptions'IdempotencyLevel'Idempotent-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for MethodOptions'IdempotencyLevel"--instance Hashable MethodOptions'IdempotencyLevel where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumMethodOptions'IdempotencyLevel x)--defaultMethodOptions :: MethodOptions-defaultMethodOptions = MethodOptions-  { methodOptionsDeprecated = Nothing-  , methodOptionsIdempotencyLevel = Nothing-  , methodOptionsFeatures = Nothing-  , methodOptionsUninterpretedOption = V.empty-  , methodOptionsUnknownFields = []-  }--instance MessageEncode MethodOptions where-  buildSized msg =-    (maybe mempty (\v -> archBool 264 v) msg.methodOptionsDeprecated)-    <> (maybe mempty (\v -> archVarint 272 (fromIntegral (toProtoEnumMethodOptions'IdempotencyLevel v))) msg.methodOptionsIdempotencyLevel)-    <> (maybe mempty (\v -> archSubmessage 282 (buildSized v)) msg.methodOptionsFeatures)-    <> V.foldl' (\acc v -> acc <> archSubmessage 7994 (buildSized v)) mempty msg.methodOptionsUninterpretedOption-    <> encodeUnknownFieldsSized msg.methodOptionsUnknownFields--instance MessageDecode MethodOptions where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultMethodOptions emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage-          0x288-          0xffff-          2-          decodeFieldBool-          (\v -> stage_1 (msg { methodOptionsDeprecated = (Just v)}) gl_0)-          (pure (case msg.methodOptionsUnknownFields of { [] -> msg { methodOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { methodOptionsUninterpretedOption = growListToVector gl_0, methodOptionsUnknownFields = reverse (msg.methodOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_1 msg gl_0 =-        inOrderStage-          0x290-          0xffff-          2-          decodeFieldEnum-          (\v -> stage_2 (msg { methodOptionsIdempotencyLevel = (Just v)}) gl_0)-          (pure (case msg.methodOptionsUnknownFields of { [] -> msg { methodOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { methodOptionsUninterpretedOption = growListToVector gl_0, methodOptionsUnknownFields = reverse (msg.methodOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_2 msg gl_0 =-        inOrderStage-          0x29a-          0xffff-          2-          decodeFieldMessage-          (\v -> stage_3 (msg { methodOptionsFeatures = (Just v)}) gl_0)-          (pure (case msg.methodOptionsUnknownFields of { [] -> msg { methodOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { methodOptionsUninterpretedOption = growListToVector gl_0, methodOptionsUnknownFields = reverse (msg.methodOptionsUnknownFields) } }))-          (loop msg gl_0)-      stage_3 msg gl_0 =-        inOrderStage-          0x3eba-          0xffff-          2-          decodeFieldMessage-          (\v -> stage_3 msg (snocGrowList gl_0 v))-          (pure (case msg.methodOptionsUnknownFields of { [] -> msg { methodOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { methodOptionsUninterpretedOption = growListToVector gl_0, methodOptionsUnknownFields = reverse (msg.methodOptionsUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.methodOptionsUnknownFields of { [] -> msg { methodOptionsUninterpretedOption = growListToVector gl_0 }; _ -> msg { methodOptionsUninterpretedOption = growListToVector gl_0, methodOptionsUnknownFields = reverse (msg.methodOptionsUnknownFields) } }))-        (\fn wt -> case fn of-          33 -> do-            v <- decodeFieldBool-            loop (msg { methodOptionsDeprecated = (Just v)}) gl_0-          34 -> do-            v <- decodeFieldEnum-            loop (msg { methodOptionsIdempotencyLevel = (Just v)}) gl_0-          35 -> do-            v <- decodeFieldMessage-            loop (msg { methodOptionsFeatures = (Just v)}) gl_0-          999 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { methodOptionsUnknownFields = (uf : msg.methodOptionsUnknownFields)}) gl_0)---- | Field descriptors for 'MethodOptions', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-methodOptionsFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor MethodOptions)-methodOptionsFieldDescriptors =-  IntMap.fromList-    [ (33, SomeField FieldDescriptor-        { fdName = "deprecated"-        , fdNumber = 33-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = methodOptionsDeprecated-        , fdSet = \v m -> m { methodOptionsDeprecated = v }-        }), (34, SomeField FieldDescriptor-        { fdName = "idempotency_level"-        , fdNumber = 34-        , fdTypeDesc = MessageType "IdempotencyLevel"-        , fdLabel = LabelOptional-        , fdGet = methodOptionsIdempotencyLevel-        , fdSet = \v m -> m { methodOptionsIdempotencyLevel = v }-        })-    , (35, SomeField FieldDescriptor-        { fdName = "features"-        , fdNumber = 35-        , fdTypeDesc = MessageType "FeatureSet"-        , fdLabel = LabelOptional-        , fdGet = methodOptionsFeatures-        , fdSet = \v m -> m { methodOptionsFeatures = v }-        })-    , (999, SomeField FieldDescriptor-        { fdName = "uninterpreted_option"-        , fdNumber = 999-        , fdTypeDesc = MessageType "UninterpretedOption"-        , fdLabel = LabelRepeated-        , fdGet = methodOptionsUninterpretedOption-        , fdSet = \v m -> m { methodOptionsUninterpretedOption = v }-        })-    ]--instance ProtoMessage MethodOptions where-  protoMessageName _ = "google.protobuf.MethodOptions"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultMethodOptions-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = methodOptionsFieldDescriptors--instance IsMessage MethodOptions--instance Aeson.ToJSON MethodOptions where-  toJSON msg = jsonObject-      [ "deprecated" .=: msg.methodOptionsDeprecated-      , "idempotencyLevel" .=: msg.methodOptionsIdempotencyLevel-      , "features" .=: msg.methodOptionsFeatures-      , "uninterpretedOption" .=: msg.methodOptionsUninterpretedOption-      ]--instance Aeson.FromJSON MethodOptions where-  parseJSON = Aeson.withObject "MethodOptions" $ \obj -> do-    fld_methodOptionsDeprecated <- parseFieldMaybe obj "deprecated"-    fld_methodOptionsIdempotencyLevel <- parseFieldMaybe obj "idempotencyLevel"-    fld_methodOptionsFeatures <- parseFieldMaybe obj "features"-    fld_methodOptionsUninterpretedOption <- parseFieldMaybe obj "uninterpretedOption"-    pure defaultMethodOptions-      { methodOptionsDeprecated = maybe (methodOptionsDeprecated defaultMethodOptions) id fld_methodOptionsDeprecated-      , methodOptionsIdempotencyLevel = maybe (methodOptionsIdempotencyLevel defaultMethodOptions) id fld_methodOptionsIdempotencyLevel-      , methodOptionsFeatures = maybe (methodOptionsFeatures defaultMethodOptions) id fld_methodOptionsFeatures-      , methodOptionsUninterpretedOption = maybe (methodOptionsUninterpretedOption defaultMethodOptions) id fld_methodOptionsUninterpretedOption-      }--instance Hashable MethodOptions where-  hashWithSalt salt msg = V.foldl' hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.methodOptionsDeprecated) msg.methodOptionsIdempotencyLevel) msg.methodOptionsFeatures) msg.methodOptionsUninterpretedOption--instance Proto.Extension.HasExtensions MethodOptions where-  messageUnknownFields = methodOptionsUnknownFields-  setMessageUnknownFields !ufs msg = msg { methodOptionsUnknownFields = ufs }--instance Semigroup MethodOptions where-  a <> b = MethodOptions-    { methodOptionsDeprecated = case b.methodOptionsDeprecated of { Nothing -> a.methodOptionsDeprecated; x -> x }-    , methodOptionsIdempotencyLevel = case b.methodOptionsIdempotencyLevel of { Nothing -> a.methodOptionsIdempotencyLevel; x -> x }-    , methodOptionsFeatures = case b.methodOptionsFeatures of { Nothing -> a.methodOptionsFeatures; x -> x }-    , methodOptionsUninterpretedOption = a.methodOptionsUninterpretedOption <> b.methodOptionsUninterpretedOption-    , methodOptionsUnknownFields = a.methodOptionsUnknownFields <> b.methodOptionsUnknownFields-    }--instance Monoid MethodOptions where-  mempty = defaultMethodOptions---- | A message representing a option the parser does not recognize. This only--- appears in options protos created by the compiler::Parser class.--- DescriptorPool resolves these when building Descriptor objects. Therefore,--- options protos in descriptor objects (e.g. returned by Descriptor::options(),--- or produced by Descriptor::CopyTo()) will never have UninterpretedOptions--- in them.-data UninterpretedOption = UninterpretedOption-  { uninterpretedOptionName :: !(V.Vector UninterpretedOption'NamePart)-  , uninterpretedOptionIdentifierValue :: !(Maybe Text)-    -- ^ The value of the uninterpreted option, in whatever type the tokenizer-    -- identified it as during parsing. Exactly one of these should be set.-  , uninterpretedOptionPositiveIntValue :: !(Maybe Word64)-  , uninterpretedOptionNegativeIntValue :: !(Maybe Int64)-  , uninterpretedOptionDoubleValue :: !(Maybe Double)-  , uninterpretedOptionStringValue :: !(Maybe ByteString)-  , uninterpretedOptionAggregateValue :: !(Maybe Text)-  , uninterpretedOptionUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData---- | The name of the uninterpreted option.  Each string represents a segment in--- a dot-separated name.  is_extension is true iff a segment represents an--- extension (denoted with parentheses in options specs in .proto files).--- E.g.,{ ["foo", false], ["bar.baz", true], ["moo", false] } represents--- "foo.(bar.baz).moo".-data UninterpretedOption'NamePart = UninterpretedOption'NamePart-  { uninterpretedOptionNamePartNamePart :: !Text-  , uninterpretedOptionNamePartIsExtension :: !Bool-  , uninterpretedOptionNamePartUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultUninterpretedOption'NamePart :: UninterpretedOption'NamePart-defaultUninterpretedOption'NamePart = UninterpretedOption'NamePart-  { uninterpretedOptionNamePartNamePart = ""-  , uninterpretedOptionNamePartIsExtension = False-  , uninterpretedOptionNamePartUnknownFields = []-  }--instance MessageEncode UninterpretedOption'NamePart where-  buildSized msg =-    (if msg.uninterpretedOptionNamePartNamePart == T.empty then mempty else archString 10 msg.uninterpretedOptionNamePartNamePart)-    <> (if msg.uninterpretedOptionNamePartIsExtension == False then mempty else archBool 16 msg.uninterpretedOptionNamePartIsExtension)-    <> encodeUnknownFieldsSized msg.uninterpretedOptionNamePartUnknownFields--instance MessageDecode UninterpretedOption'NamePart where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultUninterpretedOption'NamePart-    where-      stage_0 msg =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_1 (msg { uninterpretedOptionNamePartNamePart = v}))-          (pure (case msg.uninterpretedOptionNamePartUnknownFields of { [] -> msg; _ -> msg { uninterpretedOptionNamePartUnknownFields = reverse (msg.uninterpretedOptionNamePartUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x10 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> loop (msg { uninterpretedOptionNamePartIsExtension = v}))-          (pure (case msg.uninterpretedOptionNamePartUnknownFields of { [] -> msg; _ -> msg { uninterpretedOptionNamePartUnknownFields = reverse (msg.uninterpretedOptionNamePartUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.uninterpretedOptionNamePartUnknownFields of { [] -> msg; _ -> msg { uninterpretedOptionNamePartUnknownFields = reverse (msg.uninterpretedOptionNamePartUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { uninterpretedOptionNamePartNamePart = v})-          2 -> do-            v <- decodeFieldBool-            loop (msg { uninterpretedOptionNamePartIsExtension = v})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { uninterpretedOptionNamePartUnknownFields = (uf : msg.uninterpretedOptionNamePartUnknownFields)}))---- | Field descriptors for 'UninterpretedOption'NamePart', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-uninterpretedOption'NamePartFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor UninterpretedOption'NamePart)-uninterpretedOption'NamePartFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "name_part"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelRequired-        , fdGet = uninterpretedOptionNamePartNamePart-        , fdSet = \v m -> m { uninterpretedOptionNamePartNamePart = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "is_extension"-        , fdNumber = 2-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelRequired-        , fdGet = uninterpretedOptionNamePartIsExtension-        , fdSet = \v m -> m { uninterpretedOptionNamePartIsExtension = v }-        })-    ]--instance ProtoMessage UninterpretedOption'NamePart where-  protoMessageName _ = "google.protobuf.UninterpretedOption.NamePart"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultUninterpretedOption'NamePart-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = uninterpretedOption'NamePartFieldDescriptors--instance IsMessage UninterpretedOption'NamePart--instance Aeson.ToJSON UninterpretedOption'NamePart where-  toJSON msg = jsonObject-      [ "namePart" .=: msg.uninterpretedOptionNamePartNamePart-      , "isExtension" .=: msg.uninterpretedOptionNamePartIsExtension-      ]--instance Aeson.FromJSON UninterpretedOption'NamePart where-  parseJSON = Aeson.withObject "UninterpretedOption'NamePart" $ \obj -> do-    fld_uninterpretedOptionNamePartNamePart <- parseFieldMaybe obj "namePart"-    fld_uninterpretedOptionNamePartIsExtension <- parseFieldMaybe obj "isExtension"-    pure defaultUninterpretedOption'NamePart-      { uninterpretedOptionNamePartNamePart = maybe (uninterpretedOptionNamePartNamePart defaultUninterpretedOption'NamePart) id fld_uninterpretedOptionNamePartNamePart-      , uninterpretedOptionNamePartIsExtension = maybe (uninterpretedOptionNamePartIsExtension defaultUninterpretedOption'NamePart) id fld_uninterpretedOptionNamePartIsExtension-      }--instance Hashable UninterpretedOption'NamePart where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (salt) msg.uninterpretedOptionNamePartNamePart) msg.uninterpretedOptionNamePartIsExtension--instance Proto.Extension.HasExtensions UninterpretedOption'NamePart where-  messageUnknownFields = uninterpretedOptionNamePartUnknownFields-  setMessageUnknownFields !ufs msg = msg { uninterpretedOptionNamePartUnknownFields = ufs }--instance Semigroup UninterpretedOption'NamePart where-  a <> b = UninterpretedOption'NamePart-    { uninterpretedOptionNamePartNamePart = b.uninterpretedOptionNamePartNamePart-    , uninterpretedOptionNamePartIsExtension = b.uninterpretedOptionNamePartIsExtension-    , uninterpretedOptionNamePartUnknownFields = a.uninterpretedOptionNamePartUnknownFields <> b.uninterpretedOptionNamePartUnknownFields-    }--instance Monoid UninterpretedOption'NamePart where-  mempty = defaultUninterpretedOption'NamePart--defaultUninterpretedOption :: UninterpretedOption-defaultUninterpretedOption = UninterpretedOption-  { uninterpretedOptionName = V.empty-  , uninterpretedOptionIdentifierValue = Nothing-  , uninterpretedOptionPositiveIntValue = Nothing-  , uninterpretedOptionNegativeIntValue = Nothing-  , uninterpretedOptionDoubleValue = Nothing-  , uninterpretedOptionStringValue = Nothing-  , uninterpretedOptionAggregateValue = Nothing-  , uninterpretedOptionUnknownFields = []-  }--instance MessageEncode UninterpretedOption where-  buildSized msg =-    V.foldl' (\acc v -> acc <> archSubmessage 18 (buildSized v)) mempty msg.uninterpretedOptionName-    <> (maybe mempty (\v -> archString 26 v) msg.uninterpretedOptionIdentifierValue)-    <> (maybe mempty (\v -> archVarint 32 v) msg.uninterpretedOptionPositiveIntValue)-    <> (maybe mempty (\v -> archVarint 40 (fromIntegral v)) msg.uninterpretedOptionNegativeIntValue)-    <> (maybe mempty (\v -> archDouble 49 v) msg.uninterpretedOptionDoubleValue)-    <> (maybe mempty (\v -> archBytes 58 v) msg.uninterpretedOptionStringValue)-    <> (maybe mempty (\v -> archString 66 v) msg.uninterpretedOptionAggregateValue)-    <> encodeUnknownFieldsSized msg.uninterpretedOptionUnknownFields--instance MessageDecode UninterpretedOption where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultUninterpretedOption emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_0 msg (snocGrowList gl_0 v))-          (pure (case msg.uninterpretedOptionUnknownFields of { [] -> msg { uninterpretedOptionName = growListToVector gl_0 }; _ -> msg { uninterpretedOptionName = growListToVector gl_0, uninterpretedOptionUnknownFields = reverse (msg.uninterpretedOptionUnknownFields) } }))-          (loop msg gl_0)-      stage_1 msg gl_0 =-        inOrderStage1-          (0x1a :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_2 (msg { uninterpretedOptionIdentifierValue = (Just v)}) gl_0)-          (pure (case msg.uninterpretedOptionUnknownFields of { [] -> msg { uninterpretedOptionName = growListToVector gl_0 }; _ -> msg { uninterpretedOptionName = growListToVector gl_0, uninterpretedOptionUnknownFields = reverse (msg.uninterpretedOptionUnknownFields) } }))-          (loop msg gl_0)-      stage_2 msg gl_0 =-        inOrderStage1-          (0x20 :: Data.Word.Word8)-          decodeFieldVarint-          (\v -> stage_3 (msg { uninterpretedOptionPositiveIntValue = (Just v)}) gl_0)-          (pure (case msg.uninterpretedOptionUnknownFields of { [] -> msg { uninterpretedOptionName = growListToVector gl_0 }; _ -> msg { uninterpretedOptionName = growListToVector gl_0, uninterpretedOptionUnknownFields = reverse (msg.uninterpretedOptionUnknownFields) } }))-          (loop msg gl_0)-      stage_3 msg gl_0 =-        inOrderStage1-          (0x28 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_4 (msg { uninterpretedOptionNegativeIntValue = (Just v)}) gl_0)-          (pure (case msg.uninterpretedOptionUnknownFields of { [] -> msg { uninterpretedOptionName = growListToVector gl_0 }; _ -> msg { uninterpretedOptionName = growListToVector gl_0, uninterpretedOptionUnknownFields = reverse (msg.uninterpretedOptionUnknownFields) } }))-          (loop msg gl_0)-      stage_4 msg gl_0 =-        inOrderStage1-          (0x31 :: Data.Word.Word8)-          decodeFieldDouble-          (\v -> stage_5 (msg { uninterpretedOptionDoubleValue = (Just v)}) gl_0)-          (pure (case msg.uninterpretedOptionUnknownFields of { [] -> msg { uninterpretedOptionName = growListToVector gl_0 }; _ -> msg { uninterpretedOptionName = growListToVector gl_0, uninterpretedOptionUnknownFields = reverse (msg.uninterpretedOptionUnknownFields) } }))-          (loop msg gl_0)-      stage_5 msg gl_0 =-        inOrderStage1-          (0x3a :: Data.Word.Word8)-          decodeFieldBytes-          (\v -> stage_6 (msg { uninterpretedOptionStringValue = (Just v)}) gl_0)-          (pure (case msg.uninterpretedOptionUnknownFields of { [] -> msg { uninterpretedOptionName = growListToVector gl_0 }; _ -> msg { uninterpretedOptionName = growListToVector gl_0, uninterpretedOptionUnknownFields = reverse (msg.uninterpretedOptionUnknownFields) } }))-          (loop msg gl_0)-      stage_6 msg gl_0 =-        inOrderStage1-          (0x42 :: Data.Word.Word8)-          decodeFieldString-          (\v -> loop (msg { uninterpretedOptionAggregateValue = (Just v)}) gl_0)-          (pure (case msg.uninterpretedOptionUnknownFields of { [] -> msg { uninterpretedOptionName = growListToVector gl_0 }; _ -> msg { uninterpretedOptionName = growListToVector gl_0, uninterpretedOptionUnknownFields = reverse (msg.uninterpretedOptionUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.uninterpretedOptionUnknownFields of { [] -> msg { uninterpretedOptionName = growListToVector gl_0 }; _ -> msg { uninterpretedOptionName = growListToVector gl_0, uninterpretedOptionUnknownFields = reverse (msg.uninterpretedOptionUnknownFields) } }))-        (\fn wt -> case fn of-          2 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v)-          3 -> do-            v <- decodeFieldString-            loop (msg { uninterpretedOptionIdentifierValue = (Just v)}) gl_0-          4 -> do-            v <- decodeFieldVarint-            loop (msg { uninterpretedOptionPositiveIntValue = (Just v)}) gl_0-          5 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { uninterpretedOptionNegativeIntValue = (Just v)}) gl_0-          6 -> do-            v <- decodeFieldDouble-            loop (msg { uninterpretedOptionDoubleValue = (Just v)}) gl_0-          7 -> do-            v <- decodeFieldBytes-            loop (msg { uninterpretedOptionStringValue = (Just v)}) gl_0-          8 -> do-            v <- decodeFieldString-            loop (msg { uninterpretedOptionAggregateValue = (Just v)}) gl_0-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { uninterpretedOptionUnknownFields = (uf : msg.uninterpretedOptionUnknownFields)}) gl_0)---- | Field descriptors for 'UninterpretedOption', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-uninterpretedOptionFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor UninterpretedOption)-uninterpretedOptionFieldDescriptors =-  IntMap.fromList-    [ (2, SomeField FieldDescriptor-        { fdName = "name"-        , fdNumber = 2-        , fdTypeDesc = MessageType "NamePart"-        , fdLabel = LabelRepeated-        , fdGet = uninterpretedOptionName-        , fdSet = \v m -> m { uninterpretedOptionName = v }-        }), (3, SomeField FieldDescriptor-        { fdName = "identifier_value"-        , fdNumber = 3-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = uninterpretedOptionIdentifierValue-        , fdSet = \v m -> m { uninterpretedOptionIdentifierValue = v }-        })-    , (4, SomeField FieldDescriptor-        { fdName = "positive_int_value"-        , fdNumber = 4-        , fdTypeDesc = ScalarType UInt64Field-        , fdLabel = LabelOptional-        , fdGet = uninterpretedOptionPositiveIntValue-        , fdSet = \v m -> m { uninterpretedOptionPositiveIntValue = v }-        })-    , (5, SomeField FieldDescriptor-        { fdName = "negative_int_value"-        , fdNumber = 5-        , fdTypeDesc = ScalarType Int64Field-        , fdLabel = LabelOptional-        , fdGet = uninterpretedOptionNegativeIntValue-        , fdSet = \v m -> m { uninterpretedOptionNegativeIntValue = v }-        })-    , (6, SomeField FieldDescriptor-        { fdName = "double_value"-        , fdNumber = 6-        , fdTypeDesc = ScalarType DoubleField-        , fdLabel = LabelOptional-        , fdGet = uninterpretedOptionDoubleValue-        , fdSet = \v m -> m { uninterpretedOptionDoubleValue = v }-        })-    , (7, SomeField FieldDescriptor-        { fdName = "string_value"-        , fdNumber = 7-        , fdTypeDesc = ScalarType BytesField-        , fdLabel = LabelOptional-        , fdGet = uninterpretedOptionStringValue-        , fdSet = \v m -> m { uninterpretedOptionStringValue = v }-        })-    , (8, SomeField FieldDescriptor-        { fdName = "aggregate_value"-        , fdNumber = 8-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = uninterpretedOptionAggregateValue-        , fdSet = \v m -> m { uninterpretedOptionAggregateValue = v }-        })-    ]--instance ProtoMessage UninterpretedOption where-  protoMessageName _ = "google.protobuf.UninterpretedOption"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultUninterpretedOption-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = uninterpretedOptionFieldDescriptors--instance IsMessage UninterpretedOption--instance Aeson.ToJSON UninterpretedOption where-  toJSON msg = jsonObject-      [ "name" .=: msg.uninterpretedOptionName-      , "identifierValue" .=: msg.uninterpretedOptionIdentifierValue-      , "positiveIntValue" .=: msg.uninterpretedOptionPositiveIntValue-      , "negativeIntValue" .=: msg.uninterpretedOptionNegativeIntValue-      , "doubleValue" .=: msg.uninterpretedOptionDoubleValue-      , "stringValue" .=: (fmap protoBytesToJSON msg.uninterpretedOptionStringValue)-      , "aggregateValue" .=: msg.uninterpretedOptionAggregateValue-      ]--instance Aeson.FromJSON UninterpretedOption where-  parseJSON = Aeson.withObject "UninterpretedOption" $ \obj -> do-    fld_uninterpretedOptionName <- parseFieldMaybe obj "name"-    fld_uninterpretedOptionIdentifierValue <- parseFieldMaybe obj "identifierValue"-    fld_uninterpretedOptionPositiveIntValue <- parseFieldMaybe obj "positiveIntValue"-    fld_uninterpretedOptionNegativeIntValue <- parseFieldMaybe obj "negativeIntValue"-    fld_uninterpretedOptionDoubleValue <- parseFieldMaybe obj "doubleValue"-    fld_uninterpretedOptionStringValue <- parseBytesFieldMaybe obj "stringValue"-    fld_uninterpretedOptionAggregateValue <- parseFieldMaybe obj "aggregateValue"-    pure defaultUninterpretedOption-      { uninterpretedOptionName = maybe (uninterpretedOptionName defaultUninterpretedOption) id fld_uninterpretedOptionName-      , uninterpretedOptionIdentifierValue = maybe (uninterpretedOptionIdentifierValue defaultUninterpretedOption) id fld_uninterpretedOptionIdentifierValue-      , uninterpretedOptionPositiveIntValue = maybe (uninterpretedOptionPositiveIntValue defaultUninterpretedOption) id fld_uninterpretedOptionPositiveIntValue-      , uninterpretedOptionNegativeIntValue = maybe (uninterpretedOptionNegativeIntValue defaultUninterpretedOption) id fld_uninterpretedOptionNegativeIntValue-      , uninterpretedOptionDoubleValue = maybe (uninterpretedOptionDoubleValue defaultUninterpretedOption) id fld_uninterpretedOptionDoubleValue-      , uninterpretedOptionStringValue = fld_uninterpretedOptionStringValue-      , uninterpretedOptionAggregateValue = maybe (uninterpretedOptionAggregateValue defaultUninterpretedOption) id fld_uninterpretedOptionAggregateValue-      }--instance Hashable UninterpretedOption where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (V.foldl' hashWithSalt (salt) msg.uninterpretedOptionName) msg.uninterpretedOptionIdentifierValue) msg.uninterpretedOptionPositiveIntValue) msg.uninterpretedOptionNegativeIntValue) msg.uninterpretedOptionDoubleValue) msg.uninterpretedOptionStringValue) msg.uninterpretedOptionAggregateValue--instance Proto.Extension.HasExtensions UninterpretedOption where-  messageUnknownFields = uninterpretedOptionUnknownFields-  setMessageUnknownFields !ufs msg = msg { uninterpretedOptionUnknownFields = ufs }--instance Semigroup UninterpretedOption where-  a <> b = UninterpretedOption-    { uninterpretedOptionName = a.uninterpretedOptionName <> b.uninterpretedOptionName-    , uninterpretedOptionIdentifierValue = case b.uninterpretedOptionIdentifierValue of { Nothing -> a.uninterpretedOptionIdentifierValue; x -> x }-    , uninterpretedOptionPositiveIntValue = case b.uninterpretedOptionPositiveIntValue of { Nothing -> a.uninterpretedOptionPositiveIntValue; x -> x }-    , uninterpretedOptionNegativeIntValue = case b.uninterpretedOptionNegativeIntValue of { Nothing -> a.uninterpretedOptionNegativeIntValue; x -> x }-    , uninterpretedOptionDoubleValue = case b.uninterpretedOptionDoubleValue of { Nothing -> a.uninterpretedOptionDoubleValue; x -> x }-    , uninterpretedOptionStringValue = case b.uninterpretedOptionStringValue of { Nothing -> a.uninterpretedOptionStringValue; x -> x }-    , uninterpretedOptionAggregateValue = case b.uninterpretedOptionAggregateValue of { Nothing -> a.uninterpretedOptionAggregateValue; x -> x }-    , uninterpretedOptionUnknownFields = a.uninterpretedOptionUnknownFields <> b.uninterpretedOptionUnknownFields-    }--instance Monoid UninterpretedOption where-  mempty = defaultUninterpretedOption---- | ===================================================================--- Features--- TODO Enums in C++ gencode (and potentially other languages) are--- not well scoped.  This means that each of the feature enums below can clash--- with each other.  The short names we've chosen maximize call-site--- readability, but leave us very open to this scenario.  A future feature will--- be designed and implemented to handle this, hopefully before we ever hit a--- conflict here.-data FeatureSet = FeatureSet-  { featureSetFieldPresence :: !(Maybe FeatureSet'FieldPresence)-  , featureSetEnumType :: !(Maybe FeatureSet'EnumType)-  , featureSetRepeatedFieldEncoding :: !(Maybe FeatureSet'RepeatedFieldEncoding)-  , featureSetUtf8Validation :: !(Maybe FeatureSet'Utf8Validation)-  , featureSetMessageEncoding :: !(Maybe FeatureSet'MessageEncoding)-  , featureSetJsonFormat :: !(Maybe FeatureSet'JsonFormat)-  , featureSetUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--data FeatureSet'FieldPresence-  = FeatureSet'FieldPresence'FieldPresenceUnknown-  | FeatureSet'FieldPresence'Explicit-  | FeatureSet'FieldPresence'Implicit-  | FeatureSet'FieldPresence'LegacyRequired-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumFeatureSet'FieldPresence :: FeatureSet'FieldPresence -> Int-toProtoEnumFeatureSet'FieldPresence FeatureSet'FieldPresence'FieldPresenceUnknown = 0-toProtoEnumFeatureSet'FieldPresence FeatureSet'FieldPresence'Explicit = 1-toProtoEnumFeatureSet'FieldPresence FeatureSet'FieldPresence'Implicit = 2-toProtoEnumFeatureSet'FieldPresence FeatureSet'FieldPresence'LegacyRequired = 3--fromProtoEnumFeatureSet'FieldPresence :: Int -> Maybe FeatureSet'FieldPresence-fromProtoEnumFeatureSet'FieldPresence 0 = Just FeatureSet'FieldPresence'FieldPresenceUnknown-fromProtoEnumFeatureSet'FieldPresence 1 = Just FeatureSet'FieldPresence'Explicit-fromProtoEnumFeatureSet'FieldPresence 2 = Just FeatureSet'FieldPresence'Implicit-fromProtoEnumFeatureSet'FieldPresence 3 = Just FeatureSet'FieldPresence'LegacyRequired-fromProtoEnumFeatureSet'FieldPresence _ = Nothing--instance MessageEncode FeatureSet'FieldPresence where-  buildSized _ = mempty-instance MessageDecode FeatureSet'FieldPresence where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON FeatureSet'FieldPresence where-  toJSON FeatureSet'FieldPresence'FieldPresenceUnknown = Aeson.String "FIELD_PRESENCE_UNKNOWN"-  toJSON FeatureSet'FieldPresence'Explicit = Aeson.String "EXPLICIT"-  toJSON FeatureSet'FieldPresence'Implicit = Aeson.String "IMPLICIT"-  toJSON FeatureSet'FieldPresence'LegacyRequired = Aeson.String "LEGACY_REQUIRED"--instance Aeson.FromJSON FeatureSet'FieldPresence where-  parseJSON = \case-    Aeson.String "FIELD_PRESENCE_UNKNOWN" -> pure FeatureSet'FieldPresence'FieldPresenceUnknown-    Aeson.String "EXPLICIT" -> pure FeatureSet'FieldPresence'Explicit-    Aeson.String "IMPLICIT" -> pure FeatureSet'FieldPresence'Implicit-    Aeson.String "LEGACY_REQUIRED" -> pure FeatureSet'FieldPresence'LegacyRequired-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for FeatureSet'FieldPresence"--instance Hashable FeatureSet'FieldPresence where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumFeatureSet'FieldPresence x)--data FeatureSet'EnumType-  = FeatureSet'EnumType'EnumTypeUnknown-  | FeatureSet'EnumType'Open-  | FeatureSet'EnumType'Closed-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumFeatureSet'EnumType :: FeatureSet'EnumType -> Int-toProtoEnumFeatureSet'EnumType FeatureSet'EnumType'EnumTypeUnknown = 0-toProtoEnumFeatureSet'EnumType FeatureSet'EnumType'Open = 1-toProtoEnumFeatureSet'EnumType FeatureSet'EnumType'Closed = 2--fromProtoEnumFeatureSet'EnumType :: Int -> Maybe FeatureSet'EnumType-fromProtoEnumFeatureSet'EnumType 0 = Just FeatureSet'EnumType'EnumTypeUnknown-fromProtoEnumFeatureSet'EnumType 1 = Just FeatureSet'EnumType'Open-fromProtoEnumFeatureSet'EnumType 2 = Just FeatureSet'EnumType'Closed-fromProtoEnumFeatureSet'EnumType _ = Nothing--instance MessageEncode FeatureSet'EnumType where-  buildSized _ = mempty-instance MessageDecode FeatureSet'EnumType where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON FeatureSet'EnumType where-  toJSON FeatureSet'EnumType'EnumTypeUnknown = Aeson.String "ENUM_TYPE_UNKNOWN"-  toJSON FeatureSet'EnumType'Open = Aeson.String "OPEN"-  toJSON FeatureSet'EnumType'Closed = Aeson.String "CLOSED"--instance Aeson.FromJSON FeatureSet'EnumType where-  parseJSON = \case-    Aeson.String "ENUM_TYPE_UNKNOWN" -> pure FeatureSet'EnumType'EnumTypeUnknown-    Aeson.String "OPEN" -> pure FeatureSet'EnumType'Open-    Aeson.String "CLOSED" -> pure FeatureSet'EnumType'Closed-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for FeatureSet'EnumType"--instance Hashable FeatureSet'EnumType where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumFeatureSet'EnumType x)--data FeatureSet'RepeatedFieldEncoding-  = FeatureSet'RepeatedFieldEncoding'RepeatedFieldEncodingUnknown-  | FeatureSet'RepeatedFieldEncoding'Packed-  | FeatureSet'RepeatedFieldEncoding'Expanded-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumFeatureSet'RepeatedFieldEncoding :: FeatureSet'RepeatedFieldEncoding -> Int-toProtoEnumFeatureSet'RepeatedFieldEncoding FeatureSet'RepeatedFieldEncoding'RepeatedFieldEncodingUnknown = 0-toProtoEnumFeatureSet'RepeatedFieldEncoding FeatureSet'RepeatedFieldEncoding'Packed = 1-toProtoEnumFeatureSet'RepeatedFieldEncoding FeatureSet'RepeatedFieldEncoding'Expanded = 2--fromProtoEnumFeatureSet'RepeatedFieldEncoding :: Int -> Maybe FeatureSet'RepeatedFieldEncoding-fromProtoEnumFeatureSet'RepeatedFieldEncoding 0 = Just FeatureSet'RepeatedFieldEncoding'RepeatedFieldEncodingUnknown-fromProtoEnumFeatureSet'RepeatedFieldEncoding 1 = Just FeatureSet'RepeatedFieldEncoding'Packed-fromProtoEnumFeatureSet'RepeatedFieldEncoding 2 = Just FeatureSet'RepeatedFieldEncoding'Expanded-fromProtoEnumFeatureSet'RepeatedFieldEncoding _ = Nothing--instance MessageEncode FeatureSet'RepeatedFieldEncoding where-  buildSized _ = mempty-instance MessageDecode FeatureSet'RepeatedFieldEncoding where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON FeatureSet'RepeatedFieldEncoding where-  toJSON FeatureSet'RepeatedFieldEncoding'RepeatedFieldEncodingUnknown = Aeson.String "REPEATED_FIELD_ENCODING_UNKNOWN"-  toJSON FeatureSet'RepeatedFieldEncoding'Packed = Aeson.String "PACKED"-  toJSON FeatureSet'RepeatedFieldEncoding'Expanded = Aeson.String "EXPANDED"--instance Aeson.FromJSON FeatureSet'RepeatedFieldEncoding where-  parseJSON = \case-    Aeson.String "REPEATED_FIELD_ENCODING_UNKNOWN" -> pure FeatureSet'RepeatedFieldEncoding'RepeatedFieldEncodingUnknown-    Aeson.String "PACKED" -> pure FeatureSet'RepeatedFieldEncoding'Packed-    Aeson.String "EXPANDED" -> pure FeatureSet'RepeatedFieldEncoding'Expanded-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for FeatureSet'RepeatedFieldEncoding"--instance Hashable FeatureSet'RepeatedFieldEncoding where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumFeatureSet'RepeatedFieldEncoding x)--data FeatureSet'Utf8Validation-  = FeatureSet'Utf8Validation'Utf8ValidationUnknown-  | FeatureSet'Utf8Validation'Verify-  | FeatureSet'Utf8Validation'None-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumFeatureSet'Utf8Validation :: FeatureSet'Utf8Validation -> Int-toProtoEnumFeatureSet'Utf8Validation FeatureSet'Utf8Validation'Utf8ValidationUnknown = 0-toProtoEnumFeatureSet'Utf8Validation FeatureSet'Utf8Validation'Verify = 2-toProtoEnumFeatureSet'Utf8Validation FeatureSet'Utf8Validation'None = 3--fromProtoEnumFeatureSet'Utf8Validation :: Int -> Maybe FeatureSet'Utf8Validation-fromProtoEnumFeatureSet'Utf8Validation 0 = Just FeatureSet'Utf8Validation'Utf8ValidationUnknown-fromProtoEnumFeatureSet'Utf8Validation 2 = Just FeatureSet'Utf8Validation'Verify-fromProtoEnumFeatureSet'Utf8Validation 3 = Just FeatureSet'Utf8Validation'None-fromProtoEnumFeatureSet'Utf8Validation _ = Nothing--instance MessageEncode FeatureSet'Utf8Validation where-  buildSized _ = mempty-instance MessageDecode FeatureSet'Utf8Validation where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON FeatureSet'Utf8Validation where-  toJSON FeatureSet'Utf8Validation'Utf8ValidationUnknown = Aeson.String "UTF8_VALIDATION_UNKNOWN"-  toJSON FeatureSet'Utf8Validation'Verify = Aeson.String "VERIFY"-  toJSON FeatureSet'Utf8Validation'None = Aeson.String "NONE"--instance Aeson.FromJSON FeatureSet'Utf8Validation where-  parseJSON = \case-    Aeson.String "UTF8_VALIDATION_UNKNOWN" -> pure FeatureSet'Utf8Validation'Utf8ValidationUnknown-    Aeson.String "VERIFY" -> pure FeatureSet'Utf8Validation'Verify-    Aeson.String "NONE" -> pure FeatureSet'Utf8Validation'None-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for FeatureSet'Utf8Validation"--instance Hashable FeatureSet'Utf8Validation where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumFeatureSet'Utf8Validation x)--data FeatureSet'MessageEncoding-  = FeatureSet'MessageEncoding'MessageEncodingUnknown-  | FeatureSet'MessageEncoding'LengthPrefixed-  | FeatureSet'MessageEncoding'Delimited-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumFeatureSet'MessageEncoding :: FeatureSet'MessageEncoding -> Int-toProtoEnumFeatureSet'MessageEncoding FeatureSet'MessageEncoding'MessageEncodingUnknown = 0-toProtoEnumFeatureSet'MessageEncoding FeatureSet'MessageEncoding'LengthPrefixed = 1-toProtoEnumFeatureSet'MessageEncoding FeatureSet'MessageEncoding'Delimited = 2--fromProtoEnumFeatureSet'MessageEncoding :: Int -> Maybe FeatureSet'MessageEncoding-fromProtoEnumFeatureSet'MessageEncoding 0 = Just FeatureSet'MessageEncoding'MessageEncodingUnknown-fromProtoEnumFeatureSet'MessageEncoding 1 = Just FeatureSet'MessageEncoding'LengthPrefixed-fromProtoEnumFeatureSet'MessageEncoding 2 = Just FeatureSet'MessageEncoding'Delimited-fromProtoEnumFeatureSet'MessageEncoding _ = Nothing--instance MessageEncode FeatureSet'MessageEncoding where-  buildSized _ = mempty-instance MessageDecode FeatureSet'MessageEncoding where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON FeatureSet'MessageEncoding where-  toJSON FeatureSet'MessageEncoding'MessageEncodingUnknown = Aeson.String "MESSAGE_ENCODING_UNKNOWN"-  toJSON FeatureSet'MessageEncoding'LengthPrefixed = Aeson.String "LENGTH_PREFIXED"-  toJSON FeatureSet'MessageEncoding'Delimited = Aeson.String "DELIMITED"--instance Aeson.FromJSON FeatureSet'MessageEncoding where-  parseJSON = \case-    Aeson.String "MESSAGE_ENCODING_UNKNOWN" -> pure FeatureSet'MessageEncoding'MessageEncodingUnknown-    Aeson.String "LENGTH_PREFIXED" -> pure FeatureSet'MessageEncoding'LengthPrefixed-    Aeson.String "DELIMITED" -> pure FeatureSet'MessageEncoding'Delimited-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for FeatureSet'MessageEncoding"--instance Hashable FeatureSet'MessageEncoding where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumFeatureSet'MessageEncoding x)--data FeatureSet'JsonFormat-  = FeatureSet'JsonFormat'JsonFormatUnknown-  | FeatureSet'JsonFormat'Allow-  | FeatureSet'JsonFormat'LegacyBestEffort-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumFeatureSet'JsonFormat :: FeatureSet'JsonFormat -> Int-toProtoEnumFeatureSet'JsonFormat FeatureSet'JsonFormat'JsonFormatUnknown = 0-toProtoEnumFeatureSet'JsonFormat FeatureSet'JsonFormat'Allow = 1-toProtoEnumFeatureSet'JsonFormat FeatureSet'JsonFormat'LegacyBestEffort = 2--fromProtoEnumFeatureSet'JsonFormat :: Int -> Maybe FeatureSet'JsonFormat-fromProtoEnumFeatureSet'JsonFormat 0 = Just FeatureSet'JsonFormat'JsonFormatUnknown-fromProtoEnumFeatureSet'JsonFormat 1 = Just FeatureSet'JsonFormat'Allow-fromProtoEnumFeatureSet'JsonFormat 2 = Just FeatureSet'JsonFormat'LegacyBestEffort-fromProtoEnumFeatureSet'JsonFormat _ = Nothing--instance MessageEncode FeatureSet'JsonFormat where-  buildSized _ = mempty-instance MessageDecode FeatureSet'JsonFormat where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON FeatureSet'JsonFormat where-  toJSON FeatureSet'JsonFormat'JsonFormatUnknown = Aeson.String "JSON_FORMAT_UNKNOWN"-  toJSON FeatureSet'JsonFormat'Allow = Aeson.String "ALLOW"-  toJSON FeatureSet'JsonFormat'LegacyBestEffort = Aeson.String "LEGACY_BEST_EFFORT"--instance Aeson.FromJSON FeatureSet'JsonFormat where-  parseJSON = \case-    Aeson.String "JSON_FORMAT_UNKNOWN" -> pure FeatureSet'JsonFormat'JsonFormatUnknown-    Aeson.String "ALLOW" -> pure FeatureSet'JsonFormat'Allow-    Aeson.String "LEGACY_BEST_EFFORT" -> pure FeatureSet'JsonFormat'LegacyBestEffort-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for FeatureSet'JsonFormat"--instance Hashable FeatureSet'JsonFormat where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumFeatureSet'JsonFormat x)--defaultFeatureSet :: FeatureSet-defaultFeatureSet = FeatureSet-  { featureSetFieldPresence = Nothing-  , featureSetEnumType = Nothing-  , featureSetRepeatedFieldEncoding = Nothing-  , featureSetUtf8Validation = Nothing-  , featureSetMessageEncoding = Nothing-  , featureSetJsonFormat = Nothing-  , featureSetUnknownFields = []-  }--instance MessageEncode FeatureSet where-  buildSized msg =-    (maybe mempty (\v -> archVarint 8 (fromIntegral (toProtoEnumFeatureSet'FieldPresence v))) msg.featureSetFieldPresence)-    <> (maybe mempty (\v -> archVarint 16 (fromIntegral (toProtoEnumFeatureSet'EnumType v))) msg.featureSetEnumType)-    <> (maybe mempty (\v -> archVarint 24 (fromIntegral (toProtoEnumFeatureSet'RepeatedFieldEncoding v))) msg.featureSetRepeatedFieldEncoding)-    <> (maybe mempty (\v -> archVarint 32 (fromIntegral (toProtoEnumFeatureSet'Utf8Validation v))) msg.featureSetUtf8Validation)-    <> (maybe mempty (\v -> archVarint 40 (fromIntegral (toProtoEnumFeatureSet'MessageEncoding v))) msg.featureSetMessageEncoding)-    <> (maybe mempty (\v -> archVarint 48 (fromIntegral (toProtoEnumFeatureSet'JsonFormat v))) msg.featureSetJsonFormat)-    <> encodeUnknownFieldsSized msg.featureSetUnknownFields--instance MessageDecode FeatureSet where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultFeatureSet-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> stage_1 (msg { featureSetFieldPresence = (Just v)}))-          (pure (case msg.featureSetUnknownFields of { [] -> msg; _ -> msg { featureSetUnknownFields = reverse (msg.featureSetUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x10 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> stage_2 (msg { featureSetEnumType = (Just v)}))-          (pure (case msg.featureSetUnknownFields of { [] -> msg; _ -> msg { featureSetUnknownFields = reverse (msg.featureSetUnknownFields) } }))-          (loop msg)-      stage_2 msg =-        inOrderStage1-          (0x18 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> stage_3 (msg { featureSetRepeatedFieldEncoding = (Just v)}))-          (pure (case msg.featureSetUnknownFields of { [] -> msg; _ -> msg { featureSetUnknownFields = reverse (msg.featureSetUnknownFields) } }))-          (loop msg)-      stage_3 msg =-        inOrderStage1-          (0x20 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> stage_4 (msg { featureSetUtf8Validation = (Just v)}))-          (pure (case msg.featureSetUnknownFields of { [] -> msg; _ -> msg { featureSetUnknownFields = reverse (msg.featureSetUnknownFields) } }))-          (loop msg)-      stage_4 msg =-        inOrderStage1-          (0x28 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> stage_5 (msg { featureSetMessageEncoding = (Just v)}))-          (pure (case msg.featureSetUnknownFields of { [] -> msg; _ -> msg { featureSetUnknownFields = reverse (msg.featureSetUnknownFields) } }))-          (loop msg)-      stage_5 msg =-        inOrderStage1-          (0x30 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> loop (msg { featureSetJsonFormat = (Just v)}))-          (pure (case msg.featureSetUnknownFields of { [] -> msg; _ -> msg { featureSetUnknownFields = reverse (msg.featureSetUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.featureSetUnknownFields of { [] -> msg; _ -> msg { featureSetUnknownFields = reverse (msg.featureSetUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldEnum-            loop (msg { featureSetFieldPresence = (Just v)})-          2 -> do-            v <- decodeFieldEnum-            loop (msg { featureSetEnumType = (Just v)})-          3 -> do-            v <- decodeFieldEnum-            loop (msg { featureSetRepeatedFieldEncoding = (Just v)})-          4 -> do-            v <- decodeFieldEnum-            loop (msg { featureSetUtf8Validation = (Just v)})-          5 -> do-            v <- decodeFieldEnum-            loop (msg { featureSetMessageEncoding = (Just v)})-          6 -> do-            v <- decodeFieldEnum-            loop (msg { featureSetJsonFormat = (Just v)})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { featureSetUnknownFields = (uf : msg.featureSetUnknownFields)}))---- | Field descriptors for 'FeatureSet', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-featureSetFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor FeatureSet)-featureSetFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "field_presence"-        , fdNumber = 1-        , fdTypeDesc = MessageType "FieldPresence"-        , fdLabel = LabelOptional-        , fdGet = featureSetFieldPresence-        , fdSet = \v m -> m { featureSetFieldPresence = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "enum_type"-        , fdNumber = 2-        , fdTypeDesc = MessageType "EnumType"-        , fdLabel = LabelOptional-        , fdGet = featureSetEnumType-        , fdSet = \v m -> m { featureSetEnumType = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "repeated_field_encoding"-        , fdNumber = 3-        , fdTypeDesc = MessageType "RepeatedFieldEncoding"-        , fdLabel = LabelOptional-        , fdGet = featureSetRepeatedFieldEncoding-        , fdSet = \v m -> m { featureSetRepeatedFieldEncoding = v }-        })-    , (4, SomeField FieldDescriptor-        { fdName = "utf8_validation"-        , fdNumber = 4-        , fdTypeDesc = MessageType "Utf8Validation"-        , fdLabel = LabelOptional-        , fdGet = featureSetUtf8Validation-        , fdSet = \v m -> m { featureSetUtf8Validation = v }-        })-    , (5, SomeField FieldDescriptor-        { fdName = "message_encoding"-        , fdNumber = 5-        , fdTypeDesc = MessageType "MessageEncoding"-        , fdLabel = LabelOptional-        , fdGet = featureSetMessageEncoding-        , fdSet = \v m -> m { featureSetMessageEncoding = v }-        })-    , (6, SomeField FieldDescriptor-        { fdName = "json_format"-        , fdNumber = 6-        , fdTypeDesc = MessageType "JsonFormat"-        , fdLabel = LabelOptional-        , fdGet = featureSetJsonFormat-        , fdSet = \v m -> m { featureSetJsonFormat = v }-        })-    ]--instance ProtoMessage FeatureSet where-  protoMessageName _ = "google.protobuf.FeatureSet"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultFeatureSet-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = featureSetFieldDescriptors--instance IsMessage FeatureSet--instance Aeson.ToJSON FeatureSet where-  toJSON msg = jsonObject-      [ "fieldPresence" .=: msg.featureSetFieldPresence-      , "enumType" .=: msg.featureSetEnumType-      , "repeatedFieldEncoding" .=: msg.featureSetRepeatedFieldEncoding-      , "utf8Validation" .=: msg.featureSetUtf8Validation-      , "messageEncoding" .=: msg.featureSetMessageEncoding-      , "jsonFormat" .=: msg.featureSetJsonFormat-      ]--instance Aeson.FromJSON FeatureSet where-  parseJSON = Aeson.withObject "FeatureSet" $ \obj -> do-    fld_featureSetFieldPresence <- parseFieldMaybe obj "fieldPresence"-    fld_featureSetEnumType <- parseFieldMaybe obj "enumType"-    fld_featureSetRepeatedFieldEncoding <- parseFieldMaybe obj "repeatedFieldEncoding"-    fld_featureSetUtf8Validation <- parseFieldMaybe obj "utf8Validation"-    fld_featureSetMessageEncoding <- parseFieldMaybe obj "messageEncoding"-    fld_featureSetJsonFormat <- parseFieldMaybe obj "jsonFormat"-    pure defaultFeatureSet-      { featureSetFieldPresence = maybe (featureSetFieldPresence defaultFeatureSet) id fld_featureSetFieldPresence-      , featureSetEnumType = maybe (featureSetEnumType defaultFeatureSet) id fld_featureSetEnumType-      , featureSetRepeatedFieldEncoding = maybe (featureSetRepeatedFieldEncoding defaultFeatureSet) id fld_featureSetRepeatedFieldEncoding-      , featureSetUtf8Validation = maybe (featureSetUtf8Validation defaultFeatureSet) id fld_featureSetUtf8Validation-      , featureSetMessageEncoding = maybe (featureSetMessageEncoding defaultFeatureSet) id fld_featureSetMessageEncoding-      , featureSetJsonFormat = maybe (featureSetJsonFormat defaultFeatureSet) id fld_featureSetJsonFormat-      }--instance Hashable FeatureSet where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.featureSetFieldPresence) msg.featureSetEnumType) msg.featureSetRepeatedFieldEncoding) msg.featureSetUtf8Validation) msg.featureSetMessageEncoding) msg.featureSetJsonFormat--instance Proto.Extension.HasExtensions FeatureSet where-  messageUnknownFields = featureSetUnknownFields-  setMessageUnknownFields !ufs msg = msg { featureSetUnknownFields = ufs }--instance Semigroup FeatureSet where-  a <> b = FeatureSet-    { featureSetFieldPresence = case b.featureSetFieldPresence of { Nothing -> a.featureSetFieldPresence; x -> x }-    , featureSetEnumType = case b.featureSetEnumType of { Nothing -> a.featureSetEnumType; x -> x }-    , featureSetRepeatedFieldEncoding = case b.featureSetRepeatedFieldEncoding of { Nothing -> a.featureSetRepeatedFieldEncoding; x -> x }-    , featureSetUtf8Validation = case b.featureSetUtf8Validation of { Nothing -> a.featureSetUtf8Validation; x -> x }-    , featureSetMessageEncoding = case b.featureSetMessageEncoding of { Nothing -> a.featureSetMessageEncoding; x -> x }-    , featureSetJsonFormat = case b.featureSetJsonFormat of { Nothing -> a.featureSetJsonFormat; x -> x }-    , featureSetUnknownFields = a.featureSetUnknownFields <> b.featureSetUnknownFields-    }--instance Monoid FeatureSet where-  mempty = defaultFeatureSet---- | A compiled specification for the defaults of a set of features.  These--- messages are generated from FeatureSet extensions and can be used to seed--- feature resolution. The resolution with this object becomes a simple search--- for the closest matching edition, followed by proto merges.-data FeatureSetDefaults = FeatureSetDefaults-  { featureSetDefaultsDefaults :: !(V.Vector FeatureSetDefaults'FeatureSetEditionDefault)-  , featureSetDefaultsMinimumEdition :: !(Maybe Edition)-    -- ^ The minimum supported edition (inclusive) when this was constructed.-    -- Editions before this will not have defaults.-  , featureSetDefaultsMaximumEdition :: !(Maybe Edition)-    -- ^ The maximum known edition (inclusive) when this was constructed. Editions-    -- after this will not have reliable defaults.-  , featureSetDefaultsUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData---- | A map from every known edition with a unique set of defaults to its--- defaults. Not all editions may be contained here.  For a given edition,--- the defaults at the closest matching edition ordered at or before it should--- be used.  This field must be in strict ascending order by edition.-data FeatureSetDefaults'FeatureSetEditionDefault = FeatureSetDefaults'FeatureSetEditionDefault-  { featureSetDefaultsFeatureSetEditionDefaultEdition :: !(Maybe Edition)-  , featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures :: !(Maybe FeatureSet)-    -- ^ Defaults of features that can be overridden in this edition.-  , featureSetDefaultsFeatureSetEditionDefaultFixedFeatures :: !(Maybe FeatureSet)-    -- ^ Defaults of features that can't be overridden in this edition.-  , featureSetDefaultsFeatureSetEditionDefaultUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultFeatureSetDefaults'FeatureSetEditionDefault :: FeatureSetDefaults'FeatureSetEditionDefault-defaultFeatureSetDefaults'FeatureSetEditionDefault = FeatureSetDefaults'FeatureSetEditionDefault-  { featureSetDefaultsFeatureSetEditionDefaultEdition = Nothing-  , featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures = Nothing-  , featureSetDefaultsFeatureSetEditionDefaultFixedFeatures = Nothing-  , featureSetDefaultsFeatureSetEditionDefaultUnknownFields = []-  }--instance MessageEncode FeatureSetDefaults'FeatureSetEditionDefault where-  buildSized msg =-    (maybe mempty (\v -> archVarint 24 (fromIntegral (toProtoEnumEdition v))) msg.featureSetDefaultsFeatureSetEditionDefaultEdition)-    <> (maybe mempty (\v -> archSubmessage 34 (buildSized v)) msg.featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures)-    <> (maybe mempty (\v -> archSubmessage 42 (buildSized v)) msg.featureSetDefaultsFeatureSetEditionDefaultFixedFeatures)-    <> encodeUnknownFieldsSized msg.featureSetDefaultsFeatureSetEditionDefaultUnknownFields--instance MessageDecode FeatureSetDefaults'FeatureSetEditionDefault where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultFeatureSetDefaults'FeatureSetEditionDefault-    where-      stage_0 msg =-        inOrderStage1-          (0x18 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> stage_1 (msg { featureSetDefaultsFeatureSetEditionDefaultEdition = (Just v)}))-          (pure (case msg.featureSetDefaultsFeatureSetEditionDefaultUnknownFields of { [] -> msg; _ -> msg { featureSetDefaultsFeatureSetEditionDefaultUnknownFields = reverse (msg.featureSetDefaultsFeatureSetEditionDefaultUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x22 :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_2 (msg { featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures = (Just v)}))-          (pure (case msg.featureSetDefaultsFeatureSetEditionDefaultUnknownFields of { [] -> msg; _ -> msg { featureSetDefaultsFeatureSetEditionDefaultUnknownFields = reverse (msg.featureSetDefaultsFeatureSetEditionDefaultUnknownFields) } }))-          (loop msg)-      stage_2 msg =-        inOrderStage1-          (0x2a :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> loop (msg { featureSetDefaultsFeatureSetEditionDefaultFixedFeatures = (Just v)}))-          (pure (case msg.featureSetDefaultsFeatureSetEditionDefaultUnknownFields of { [] -> msg; _ -> msg { featureSetDefaultsFeatureSetEditionDefaultUnknownFields = reverse (msg.featureSetDefaultsFeatureSetEditionDefaultUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.featureSetDefaultsFeatureSetEditionDefaultUnknownFields of { [] -> msg; _ -> msg { featureSetDefaultsFeatureSetEditionDefaultUnknownFields = reverse (msg.featureSetDefaultsFeatureSetEditionDefaultUnknownFields) } }))-        (\fn wt -> case fn of-          3 -> do-            v <- decodeFieldEnum-            loop (msg { featureSetDefaultsFeatureSetEditionDefaultEdition = (Just v)})-          4 -> do-            v <- decodeFieldMessage-            loop (msg { featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures = (Just v)})-          5 -> do-            v <- decodeFieldMessage-            loop (msg { featureSetDefaultsFeatureSetEditionDefaultFixedFeatures = (Just v)})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { featureSetDefaultsFeatureSetEditionDefaultUnknownFields = (uf : msg.featureSetDefaultsFeatureSetEditionDefaultUnknownFields)}))---- | Field descriptors for 'FeatureSetDefaults'FeatureSetEditionDefault', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-featureSetDefaults'FeatureSetEditionDefaultFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor FeatureSetDefaults'FeatureSetEditionDefault)-featureSetDefaults'FeatureSetEditionDefaultFieldDescriptors =-  IntMap.fromList-    [ (3, SomeField FieldDescriptor-        { fdName = "edition"-        , fdNumber = 3-        , fdTypeDesc = MessageType "Edition"-        , fdLabel = LabelOptional-        , fdGet = featureSetDefaultsFeatureSetEditionDefaultEdition-        , fdSet = \v m -> m { featureSetDefaultsFeatureSetEditionDefaultEdition = v }-        }), (4, SomeField FieldDescriptor-        { fdName = "overridable_features"-        , fdNumber = 4-        , fdTypeDesc = MessageType "FeatureSet"-        , fdLabel = LabelOptional-        , fdGet = featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures-        , fdSet = \v m -> m { featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures = v }-        })-    , (5, SomeField FieldDescriptor-        { fdName = "fixed_features"-        , fdNumber = 5-        , fdTypeDesc = MessageType "FeatureSet"-        , fdLabel = LabelOptional-        , fdGet = featureSetDefaultsFeatureSetEditionDefaultFixedFeatures-        , fdSet = \v m -> m { featureSetDefaultsFeatureSetEditionDefaultFixedFeatures = v }-        })-    ]--instance ProtoMessage FeatureSetDefaults'FeatureSetEditionDefault where-  protoMessageName _ = "google.protobuf.FeatureSetDefaults.FeatureSetEditionDefault"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultFeatureSetDefaults'FeatureSetEditionDefault-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = featureSetDefaults'FeatureSetEditionDefaultFieldDescriptors--instance IsMessage FeatureSetDefaults'FeatureSetEditionDefault--instance Aeson.ToJSON FeatureSetDefaults'FeatureSetEditionDefault where-  toJSON msg = jsonObject-      [ "edition" .=: msg.featureSetDefaultsFeatureSetEditionDefaultEdition-      , "overridableFeatures" .=: msg.featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures-      , "fixedFeatures" .=: msg.featureSetDefaultsFeatureSetEditionDefaultFixedFeatures-      ]--instance Aeson.FromJSON FeatureSetDefaults'FeatureSetEditionDefault where-  parseJSON = Aeson.withObject "FeatureSetDefaults'FeatureSetEditionDefault" $ \obj -> do-    fld_featureSetDefaultsFeatureSetEditionDefaultEdition <- parseFieldMaybe obj "edition"-    fld_featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures <- parseFieldMaybe obj "overridableFeatures"-    fld_featureSetDefaultsFeatureSetEditionDefaultFixedFeatures <- parseFieldMaybe obj "fixedFeatures"-    pure defaultFeatureSetDefaults'FeatureSetEditionDefault-      { featureSetDefaultsFeatureSetEditionDefaultEdition = maybe (featureSetDefaultsFeatureSetEditionDefaultEdition defaultFeatureSetDefaults'FeatureSetEditionDefault) id fld_featureSetDefaultsFeatureSetEditionDefaultEdition-      , featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures = maybe (featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures defaultFeatureSetDefaults'FeatureSetEditionDefault) id fld_featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures-      , featureSetDefaultsFeatureSetEditionDefaultFixedFeatures = maybe (featureSetDefaultsFeatureSetEditionDefaultFixedFeatures defaultFeatureSetDefaults'FeatureSetEditionDefault) id fld_featureSetDefaultsFeatureSetEditionDefaultFixedFeatures-      }--instance Hashable FeatureSetDefaults'FeatureSetEditionDefault where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (salt) msg.featureSetDefaultsFeatureSetEditionDefaultEdition) msg.featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures) msg.featureSetDefaultsFeatureSetEditionDefaultFixedFeatures--instance Proto.Extension.HasExtensions FeatureSetDefaults'FeatureSetEditionDefault where-  messageUnknownFields = featureSetDefaultsFeatureSetEditionDefaultUnknownFields-  setMessageUnknownFields !ufs msg = msg { featureSetDefaultsFeatureSetEditionDefaultUnknownFields = ufs }--instance Semigroup FeatureSetDefaults'FeatureSetEditionDefault where-  a <> b = FeatureSetDefaults'FeatureSetEditionDefault-    { featureSetDefaultsFeatureSetEditionDefaultEdition = case b.featureSetDefaultsFeatureSetEditionDefaultEdition of { Nothing -> a.featureSetDefaultsFeatureSetEditionDefaultEdition; x -> x }-    , featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures = case b.featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures of { Nothing -> a.featureSetDefaultsFeatureSetEditionDefaultOverridableFeatures; x -> x }-    , featureSetDefaultsFeatureSetEditionDefaultFixedFeatures = case b.featureSetDefaultsFeatureSetEditionDefaultFixedFeatures of { Nothing -> a.featureSetDefaultsFeatureSetEditionDefaultFixedFeatures; x -> x }-    , featureSetDefaultsFeatureSetEditionDefaultUnknownFields = a.featureSetDefaultsFeatureSetEditionDefaultUnknownFields <> b.featureSetDefaultsFeatureSetEditionDefaultUnknownFields-    }--instance Monoid FeatureSetDefaults'FeatureSetEditionDefault where-  mempty = defaultFeatureSetDefaults'FeatureSetEditionDefault--defaultFeatureSetDefaults :: FeatureSetDefaults-defaultFeatureSetDefaults = FeatureSetDefaults-  { featureSetDefaultsDefaults = V.empty-  , featureSetDefaultsMinimumEdition = Nothing-  , featureSetDefaultsMaximumEdition = Nothing-  , featureSetDefaultsUnknownFields = []-  }--instance MessageEncode FeatureSetDefaults where-  buildSized msg =-    V.foldl' (\acc v -> acc <> archSubmessage 10 (buildSized v)) mempty msg.featureSetDefaultsDefaults-    <> (maybe mempty (\v -> archVarint 32 (fromIntegral (toProtoEnumEdition v))) msg.featureSetDefaultsMinimumEdition)-    <> (maybe mempty (\v -> archVarint 40 (fromIntegral (toProtoEnumEdition v))) msg.featureSetDefaultsMaximumEdition)-    <> encodeUnknownFieldsSized msg.featureSetDefaultsUnknownFields--instance MessageDecode FeatureSetDefaults where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultFeatureSetDefaults emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_0 msg (snocGrowList gl_0 v))-          (pure (case msg.featureSetDefaultsUnknownFields of { [] -> msg { featureSetDefaultsDefaults = growListToVector gl_0 }; _ -> msg { featureSetDefaultsDefaults = growListToVector gl_0, featureSetDefaultsUnknownFields = reverse (msg.featureSetDefaultsUnknownFields) } }))-          (loop msg gl_0)-      stage_1 msg gl_0 =-        inOrderStage1-          (0x20 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> stage_2 (msg { featureSetDefaultsMinimumEdition = (Just v)}) gl_0)-          (pure (case msg.featureSetDefaultsUnknownFields of { [] -> msg { featureSetDefaultsDefaults = growListToVector gl_0 }; _ -> msg { featureSetDefaultsDefaults = growListToVector gl_0, featureSetDefaultsUnknownFields = reverse (msg.featureSetDefaultsUnknownFields) } }))-          (loop msg gl_0)-      stage_2 msg gl_0 =-        inOrderStage1-          (0x28 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> loop (msg { featureSetDefaultsMaximumEdition = (Just v)}) gl_0)-          (pure (case msg.featureSetDefaultsUnknownFields of { [] -> msg { featureSetDefaultsDefaults = growListToVector gl_0 }; _ -> msg { featureSetDefaultsDefaults = growListToVector gl_0, featureSetDefaultsUnknownFields = reverse (msg.featureSetDefaultsUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.featureSetDefaultsUnknownFields of { [] -> msg { featureSetDefaultsDefaults = growListToVector gl_0 }; _ -> msg { featureSetDefaultsDefaults = growListToVector gl_0, featureSetDefaultsUnknownFields = reverse (msg.featureSetDefaultsUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v)-          4 -> do-            v <- decodeFieldEnum-            loop (msg { featureSetDefaultsMinimumEdition = (Just v)}) gl_0-          5 -> do-            v <- decodeFieldEnum-            loop (msg { featureSetDefaultsMaximumEdition = (Just v)}) gl_0-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { featureSetDefaultsUnknownFields = (uf : msg.featureSetDefaultsUnknownFields)}) gl_0)---- | Field descriptors for 'FeatureSetDefaults', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-featureSetDefaultsFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor FeatureSetDefaults)-featureSetDefaultsFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "defaults"-        , fdNumber = 1-        , fdTypeDesc = MessageType "FeatureSetEditionDefault"-        , fdLabel = LabelRepeated-        , fdGet = featureSetDefaultsDefaults-        , fdSet = \v m -> m { featureSetDefaultsDefaults = v }-        }), (4, SomeField FieldDescriptor-        { fdName = "minimum_edition"-        , fdNumber = 4-        , fdTypeDesc = MessageType "Edition"-        , fdLabel = LabelOptional-        , fdGet = featureSetDefaultsMinimumEdition-        , fdSet = \v m -> m { featureSetDefaultsMinimumEdition = v }-        })-    , (5, SomeField FieldDescriptor-        { fdName = "maximum_edition"-        , fdNumber = 5-        , fdTypeDesc = MessageType "Edition"-        , fdLabel = LabelOptional-        , fdGet = featureSetDefaultsMaximumEdition-        , fdSet = \v m -> m { featureSetDefaultsMaximumEdition = v }-        })-    ]--instance ProtoMessage FeatureSetDefaults where-  protoMessageName _ = "google.protobuf.FeatureSetDefaults"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultFeatureSetDefaults-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = featureSetDefaultsFieldDescriptors--instance IsMessage FeatureSetDefaults--instance Aeson.ToJSON FeatureSetDefaults where-  toJSON msg = jsonObject-      [ "defaults" .=: msg.featureSetDefaultsDefaults-      , "minimumEdition" .=: msg.featureSetDefaultsMinimumEdition-      , "maximumEdition" .=: msg.featureSetDefaultsMaximumEdition-      ]--instance Aeson.FromJSON FeatureSetDefaults where-  parseJSON = Aeson.withObject "FeatureSetDefaults" $ \obj -> do-    fld_featureSetDefaultsDefaults <- parseFieldMaybe obj "defaults"-    fld_featureSetDefaultsMinimumEdition <- parseFieldMaybe obj "minimumEdition"-    fld_featureSetDefaultsMaximumEdition <- parseFieldMaybe obj "maximumEdition"-    pure defaultFeatureSetDefaults-      { featureSetDefaultsDefaults = maybe (featureSetDefaultsDefaults defaultFeatureSetDefaults) id fld_featureSetDefaultsDefaults-      , featureSetDefaultsMinimumEdition = maybe (featureSetDefaultsMinimumEdition defaultFeatureSetDefaults) id fld_featureSetDefaultsMinimumEdition-      , featureSetDefaultsMaximumEdition = maybe (featureSetDefaultsMaximumEdition defaultFeatureSetDefaults) id fld_featureSetDefaultsMaximumEdition-      }--instance Hashable FeatureSetDefaults where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (V.foldl' hashWithSalt (salt) msg.featureSetDefaultsDefaults) msg.featureSetDefaultsMinimumEdition) msg.featureSetDefaultsMaximumEdition--instance Proto.Extension.HasExtensions FeatureSetDefaults where-  messageUnknownFields = featureSetDefaultsUnknownFields-  setMessageUnknownFields !ufs msg = msg { featureSetDefaultsUnknownFields = ufs }--instance Semigroup FeatureSetDefaults where-  a <> b = FeatureSetDefaults-    { featureSetDefaultsDefaults = a.featureSetDefaultsDefaults <> b.featureSetDefaultsDefaults-    , featureSetDefaultsMinimumEdition = case b.featureSetDefaultsMinimumEdition of { Nothing -> a.featureSetDefaultsMinimumEdition; x -> x }-    , featureSetDefaultsMaximumEdition = case b.featureSetDefaultsMaximumEdition of { Nothing -> a.featureSetDefaultsMaximumEdition; x -> x }-    , featureSetDefaultsUnknownFields = a.featureSetDefaultsUnknownFields <> b.featureSetDefaultsUnknownFields-    }--instance Monoid FeatureSetDefaults where-  mempty = defaultFeatureSetDefaults---- | ===================================================================--- Optional source code info--- Encapsulates information about the original source file from which a--- FileDescriptorProto was generated.-data SourceCodeInfo = SourceCodeInfo-  { sourceCodeInfoLocation :: !(V.Vector SourceCodeInfo'Location)-    -- ^ A Location identifies a piece of source code in a .proto file which-    -- corresponds to a particular definition.  This information is intended-    -- to be useful to IDEs, code indexers, documentation generators, and similar-    -- tools.-    -- -    -- For example, say we have a file like:-    --   message Foo {-    --     optional string foo = 1;-    --   }-    -- Let's look at just the field definition:-    --   optional string foo = 1;-    --   ^       ^^     ^^  ^  ^^^-    --   a       bc     de  f  ghi-    -- We have the following locations:-    --   span   path               represents-    --   [a,i)  [ 4, 0, 2, 0 ]     The whole field definition.-    --   [a,b)  [ 4, 0, 2, 0, 4 ]  The label (optional).-    --   [c,d)  [ 4, 0, 2, 0, 5 ]  The type (string).-    --   [e,f)  [ 4, 0, 2, 0, 1 ]  The name (foo).-    --   [g,h)  [ 4, 0, 2, 0, 3 ]  The number (1).-    -- -    -- Notes:-    -- - A location may refer to a repeated field itself (i.e. not to any-    --   particular index within it).  This is used whenever a set of elements are-    --   logically enclosed in a single code segment.  For example, an entire-    --   extend block (possibly containing multiple extension definitions) will-    --   have an outer location whose path refers to the "extensions" repeated-    --   field without an index.-    -- - Multiple locations may have the same path.  This happens when a single-    --   logical declaration is spread out across multiple places.  The most-    --   obvious example is the "extend" block again -- there may be multiple-    --   extend blocks in the same scope, each of which will have the same path.-    -- - A location's span is not always a subset of its parent's span.  For-    --   example, the "extendee" of an extension declaration appears at the-    --   beginning of the "extend" block and is shared by all extensions within-    --   the block.-    -- - Just because a location's span is a subset of some other location's span-    --   does not mean that it is a descendant.  For example, a "group" defines-    --   both a type and a field in a single declaration.  Thus, the locations-    --   corresponding to the type and field and their components will overlap.-    -- - Code which tries to interpret locations should probably be designed to-    --   ignore those that it doesn't understand, as more types of locations could-    --   be recorded in the future.-  , sourceCodeInfoUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--data SourceCodeInfo'Location = SourceCodeInfo'Location-  { sourceCodeInfoLocationPath :: !(VU.Vector Int32)-    -- ^ Identifies which part of the FileDescriptorProto was defined at this-    -- location.-    -- -    -- Each element is a field number or an index.  They form a path from-    -- the root FileDescriptorProto to the place where the definition appears.-    -- For example, this path:-    --   [ 4, 3, 2, 7, 1 ]-    -- refers to:-    --   file.message_type(3)  // 4, 3-    --       .field(7)         // 2, 7-    --       .name()           // 1-    -- This is because FileDescriptorProto.message_type has field number 4:-    --   repeated DescriptorProto message_type = 4;-    -- and DescriptorProto.field has field number 2:-    --   repeated FieldDescriptorProto field = 2;-    -- and FieldDescriptorProto.name has field number 1:-    --   optional string name = 1;-    -- -    -- Thus, the above path gives the location of a field name.  If we removed-    -- the last element:-    --   [ 4, 3, 2, 7 ]-    -- this path refers to the whole field declaration (from the beginning-    -- of the label to the terminating semicolon).-  , sourceCodeInfoLocationSpan :: !(VU.Vector Int32)-    -- ^ Always has exactly three or four elements: start line, start column,-    -- end line (optional, otherwise assumed same as start line), end column.-    -- These are packed into a single field for efficiency.  Note that line-    -- and column numbers are zero-based -- typically you will want to add-    -- 1 to each before displaying to a user.-  , sourceCodeInfoLocationLeadingComments :: !(Maybe Text)-    -- ^ If this SourceCodeInfo represents a complete declaration, these are any-    -- comments appearing before and after the declaration which appear to be-    -- attached to the declaration.-    -- -    -- A series of line comments appearing on consecutive lines, with no other-    -- tokens appearing on those lines, will be treated as a single comment.-    -- -    -- leading_detached_comments will keep paragraphs of comments that appear-    -- before (but not connected to) the current element. Each paragraph,-    -- separated by empty lines, will be one comment element in the repeated-    -- field.-    -- -    -- Only the comment content is provided; comment markers (e.g. //) are-    -- stripped out.  For block comments, leading whitespace and an asterisk-    -- will be stripped from the beginning of each line other than the first.-    -- Newlines are included in the output.-    -- -    -- Examples:-    -- -    --   optional int32 foo = 1;  // Comment attached to foo.-    --   // Comment attached to bar.-    --   optional int32 bar = 2;-    -- -    --   optional string baz = 3;-    --   // Comment attached to baz.-    --   // Another line attached to baz.-    -- -    --   // Comment attached to moo.-    --   //-    --   // Another line attached to moo.-    --   optional double moo = 4;-    -- -    --   // Detached comment for corge. This is not leading or trailing comments-    --   // to moo or corge because there are blank lines separating it from-    --   // both.-    -- -    --   // Detached comment for corge paragraph 2.-    -- -    --   optional string corge = 5;-    --   /* Block comment attached-    --    * to corge.  Leading asterisks-    --    * will be removed. */-    --   /* Block comment attached to-    --    * grault. */-    --   optional int32 grault = 6;-    -- -    --   // ignored detached comments.-  , sourceCodeInfoLocationTrailingComments :: !(Maybe Text)-  , sourceCodeInfoLocationLeadingDetachedComments :: !(V.Vector Text)-  , sourceCodeInfoLocationUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultSourceCodeInfo'Location :: SourceCodeInfo'Location-defaultSourceCodeInfo'Location = SourceCodeInfo'Location-  { sourceCodeInfoLocationPath = VU.empty-  , sourceCodeInfoLocationSpan = VU.empty-  , sourceCodeInfoLocationLeadingComments = Nothing-  , sourceCodeInfoLocationTrailingComments = Nothing-  , sourceCodeInfoLocationLeadingDetachedComments = V.empty-  , sourceCodeInfoLocationUnknownFields = []-  }--instance MessageEncode SourceCodeInfo'Location where-  buildSized msg =-    encodePackedInt32 1 msg.sourceCodeInfoLocationPath-    <> encodePackedInt32 2 msg.sourceCodeInfoLocationSpan-    <> (maybe mempty (\v -> archString 26 v) msg.sourceCodeInfoLocationLeadingComments)-    <> (maybe mempty (\v -> archString 34 v) msg.sourceCodeInfoLocationTrailingComments)-    <> V.foldl' (\acc v -> acc <> archString 50 v) mempty msg.sourceCodeInfoLocationLeadingDetachedComments-    <> encodeUnknownFieldsSized msg.sourceCodeInfoLocationUnknownFields--instance MessageDecode SourceCodeInfo'Location where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultSourceCodeInfo'Location emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          (VU.map fromIntegral <$> decodePackedVarint)-          (\v -> stage_1 (msg { sourceCodeInfoLocationPath = v}) gl_0)-          (pure (case msg.sourceCodeInfoLocationUnknownFields of { [] -> msg { sourceCodeInfoLocationLeadingDetachedComments = growListToVector gl_0 }; _ -> msg { sourceCodeInfoLocationLeadingDetachedComments = growListToVector gl_0, sourceCodeInfoLocationUnknownFields = reverse (msg.sourceCodeInfoLocationUnknownFields) } }))-          (loop msg gl_0)-      stage_1 msg gl_0 =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          (VU.map fromIntegral <$> decodePackedVarint)-          (\v -> stage_2 (msg { sourceCodeInfoLocationSpan = v}) gl_0)-          (pure (case msg.sourceCodeInfoLocationUnknownFields of { [] -> msg { sourceCodeInfoLocationLeadingDetachedComments = growListToVector gl_0 }; _ -> msg { sourceCodeInfoLocationLeadingDetachedComments = growListToVector gl_0, sourceCodeInfoLocationUnknownFields = reverse (msg.sourceCodeInfoLocationUnknownFields) } }))-          (loop msg gl_0)-      stage_2 msg gl_0 =-        inOrderStage1-          (0x1a :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_3 (msg { sourceCodeInfoLocationLeadingComments = (Just v)}) gl_0)-          (pure (case msg.sourceCodeInfoLocationUnknownFields of { [] -> msg { sourceCodeInfoLocationLeadingDetachedComments = growListToVector gl_0 }; _ -> msg { sourceCodeInfoLocationLeadingDetachedComments = growListToVector gl_0, sourceCodeInfoLocationUnknownFields = reverse (msg.sourceCodeInfoLocationUnknownFields) } }))-          (loop msg gl_0)-      stage_3 msg gl_0 =-        inOrderStage1-          (0x22 :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_4 (msg { sourceCodeInfoLocationTrailingComments = (Just v)}) gl_0)-          (pure (case msg.sourceCodeInfoLocationUnknownFields of { [] -> msg { sourceCodeInfoLocationLeadingDetachedComments = growListToVector gl_0 }; _ -> msg { sourceCodeInfoLocationLeadingDetachedComments = growListToVector gl_0, sourceCodeInfoLocationUnknownFields = reverse (msg.sourceCodeInfoLocationUnknownFields) } }))-          (loop msg gl_0)-      stage_4 msg gl_0 =-        inOrderStage1-          (0x32 :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_4 msg (snocGrowList gl_0 v))-          (pure (case msg.sourceCodeInfoLocationUnknownFields of { [] -> msg { sourceCodeInfoLocationLeadingDetachedComments = growListToVector gl_0 }; _ -> msg { sourceCodeInfoLocationLeadingDetachedComments = growListToVector gl_0, sourceCodeInfoLocationUnknownFields = reverse (msg.sourceCodeInfoLocationUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.sourceCodeInfoLocationUnknownFields of { [] -> msg { sourceCodeInfoLocationLeadingDetachedComments = growListToVector gl_0 }; _ -> msg { sourceCodeInfoLocationLeadingDetachedComments = growListToVector gl_0, sourceCodeInfoLocationUnknownFields = reverse (msg.sourceCodeInfoLocationUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> case wt of-            2 -> do-              vs <- (VU.map fromIntegral <$> decodePackedVarint)-              loop (msg { sourceCodeInfoLocationPath = (msg.sourceCodeInfoLocationPath <> vs)}) gl_0-            _ -> do-              v <- (fromIntegral <$> decodeFieldVarint)-              loop (msg { sourceCodeInfoLocationPath = (VU.snoc msg.sourceCodeInfoLocationPath v)}) gl_0-          2 -> case wt of-            2 -> do-              vs <- (VU.map fromIntegral <$> decodePackedVarint)-              loop (msg { sourceCodeInfoLocationSpan = (msg.sourceCodeInfoLocationSpan <> vs)}) gl_0-            _ -> do-              v <- (fromIntegral <$> decodeFieldVarint)-              loop (msg { sourceCodeInfoLocationSpan = (VU.snoc msg.sourceCodeInfoLocationSpan v)}) gl_0-          3 -> do-            v <- decodeFieldString-            loop (msg { sourceCodeInfoLocationLeadingComments = (Just v)}) gl_0-          4 -> do-            v <- decodeFieldString-            loop (msg { sourceCodeInfoLocationTrailingComments = (Just v)}) gl_0-          6 -> do-            v <- decodeFieldString-            loop msg (snocGrowList gl_0 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { sourceCodeInfoLocationUnknownFields = (uf : msg.sourceCodeInfoLocationUnknownFields)}) gl_0)---- | Field descriptors for 'SourceCodeInfo'Location', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-sourceCodeInfo'LocationFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor SourceCodeInfo'Location)-sourceCodeInfo'LocationFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "path"-        , fdNumber = 1-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelRepeated-        , fdGet = sourceCodeInfoLocationPath-        , fdSet = \v m -> m { sourceCodeInfoLocationPath = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "span"-        , fdNumber = 2-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelRepeated-        , fdGet = sourceCodeInfoLocationSpan-        , fdSet = \v m -> m { sourceCodeInfoLocationSpan = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "leading_comments"-        , fdNumber = 3-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = sourceCodeInfoLocationLeadingComments-        , fdSet = \v m -> m { sourceCodeInfoLocationLeadingComments = v }-        })-    , (4, SomeField FieldDescriptor-        { fdName = "trailing_comments"-        , fdNumber = 4-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = sourceCodeInfoLocationTrailingComments-        , fdSet = \v m -> m { sourceCodeInfoLocationTrailingComments = v }-        })-    , (6, SomeField FieldDescriptor-        { fdName = "leading_detached_comments"-        , fdNumber = 6-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelRepeated-        , fdGet = sourceCodeInfoLocationLeadingDetachedComments-        , fdSet = \v m -> m { sourceCodeInfoLocationLeadingDetachedComments = v }-        })-    ]--instance ProtoMessage SourceCodeInfo'Location where-  protoMessageName _ = "google.protobuf.SourceCodeInfo.Location"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultSourceCodeInfo'Location-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = sourceCodeInfo'LocationFieldDescriptors--instance IsMessage SourceCodeInfo'Location--instance Aeson.ToJSON SourceCodeInfo'Location where-  toJSON msg = jsonObject-      [ "path" .=: msg.sourceCodeInfoLocationPath-      , "span" .=: msg.sourceCodeInfoLocationSpan-      , "leadingComments" .=: msg.sourceCodeInfoLocationLeadingComments-      , "trailingComments" .=: msg.sourceCodeInfoLocationTrailingComments-      , "leadingDetachedComments" .=: msg.sourceCodeInfoLocationLeadingDetachedComments-      ]--instance Aeson.FromJSON SourceCodeInfo'Location where-  parseJSON = Aeson.withObject "SourceCodeInfo'Location" $ \obj -> do-    fld_sourceCodeInfoLocationPath <- parseFieldMaybe obj "path"-    fld_sourceCodeInfoLocationSpan <- parseFieldMaybe obj "span"-    fld_sourceCodeInfoLocationLeadingComments <- parseFieldMaybe obj "leadingComments"-    fld_sourceCodeInfoLocationTrailingComments <- parseFieldMaybe obj "trailingComments"-    fld_sourceCodeInfoLocationLeadingDetachedComments <- parseFieldMaybe obj "leadingDetachedComments"-    pure defaultSourceCodeInfo'Location-      { sourceCodeInfoLocationPath = maybe (sourceCodeInfoLocationPath defaultSourceCodeInfo'Location) id fld_sourceCodeInfoLocationPath-      , sourceCodeInfoLocationSpan = maybe (sourceCodeInfoLocationSpan defaultSourceCodeInfo'Location) id fld_sourceCodeInfoLocationSpan-      , sourceCodeInfoLocationLeadingComments = maybe (sourceCodeInfoLocationLeadingComments defaultSourceCodeInfo'Location) id fld_sourceCodeInfoLocationLeadingComments-      , sourceCodeInfoLocationTrailingComments = maybe (sourceCodeInfoLocationTrailingComments defaultSourceCodeInfo'Location) id fld_sourceCodeInfoLocationTrailingComments-      , sourceCodeInfoLocationLeadingDetachedComments = maybe (sourceCodeInfoLocationLeadingDetachedComments defaultSourceCodeInfo'Location) id fld_sourceCodeInfoLocationLeadingDetachedComments-      }--instance Hashable SourceCodeInfo'Location where-  hashWithSalt salt msg = V.foldl' hashWithSalt (hashWithSalt (hashWithSalt (VU.foldl' hashWithSalt (VU.foldl' hashWithSalt (salt) msg.sourceCodeInfoLocationPath) msg.sourceCodeInfoLocationSpan) msg.sourceCodeInfoLocationLeadingComments) msg.sourceCodeInfoLocationTrailingComments) msg.sourceCodeInfoLocationLeadingDetachedComments--instance Proto.Extension.HasExtensions SourceCodeInfo'Location where-  messageUnknownFields = sourceCodeInfoLocationUnknownFields-  setMessageUnknownFields !ufs msg = msg { sourceCodeInfoLocationUnknownFields = ufs }--instance Semigroup SourceCodeInfo'Location where-  a <> b = SourceCodeInfo'Location-    { sourceCodeInfoLocationPath = a.sourceCodeInfoLocationPath <> b.sourceCodeInfoLocationPath-    , sourceCodeInfoLocationSpan = a.sourceCodeInfoLocationSpan <> b.sourceCodeInfoLocationSpan-    , sourceCodeInfoLocationLeadingComments = case b.sourceCodeInfoLocationLeadingComments of { Nothing -> a.sourceCodeInfoLocationLeadingComments; x -> x }-    , sourceCodeInfoLocationTrailingComments = case b.sourceCodeInfoLocationTrailingComments of { Nothing -> a.sourceCodeInfoLocationTrailingComments; x -> x }-    , sourceCodeInfoLocationLeadingDetachedComments = a.sourceCodeInfoLocationLeadingDetachedComments <> b.sourceCodeInfoLocationLeadingDetachedComments-    , sourceCodeInfoLocationUnknownFields = a.sourceCodeInfoLocationUnknownFields <> b.sourceCodeInfoLocationUnknownFields-    }--instance Monoid SourceCodeInfo'Location where-  mempty = defaultSourceCodeInfo'Location--defaultSourceCodeInfo :: SourceCodeInfo-defaultSourceCodeInfo = SourceCodeInfo-  { sourceCodeInfoLocation = V.empty-  , sourceCodeInfoUnknownFields = []-  }--instance MessageEncode SourceCodeInfo where-  buildSized msg =-    V.foldl' (\acc v -> acc <> archSubmessage 10 (buildSized v)) mempty msg.sourceCodeInfoLocation-    <> encodeUnknownFieldsSized msg.sourceCodeInfoUnknownFields--instance MessageDecode SourceCodeInfo where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultSourceCodeInfo emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_0 msg (snocGrowList gl_0 v))-          (pure (case msg.sourceCodeInfoUnknownFields of { [] -> msg { sourceCodeInfoLocation = growListToVector gl_0 }; _ -> msg { sourceCodeInfoLocation = growListToVector gl_0, sourceCodeInfoUnknownFields = reverse (msg.sourceCodeInfoUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.sourceCodeInfoUnknownFields of { [] -> msg { sourceCodeInfoLocation = growListToVector gl_0 }; _ -> msg { sourceCodeInfoLocation = growListToVector gl_0, sourceCodeInfoUnknownFields = reverse (msg.sourceCodeInfoUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { sourceCodeInfoUnknownFields = (uf : msg.sourceCodeInfoUnknownFields)}) gl_0)---- | Field descriptors for 'SourceCodeInfo', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-sourceCodeInfoFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor SourceCodeInfo)-sourceCodeInfoFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "location"-        , fdNumber = 1-        , fdTypeDesc = MessageType "Location"-        , fdLabel = LabelRepeated-        , fdGet = sourceCodeInfoLocation-        , fdSet = \v m -> m { sourceCodeInfoLocation = v }-        })-    ]--instance ProtoMessage SourceCodeInfo where-  protoMessageName _ = "google.protobuf.SourceCodeInfo"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultSourceCodeInfo-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = sourceCodeInfoFieldDescriptors--instance IsMessage SourceCodeInfo--instance Aeson.ToJSON SourceCodeInfo where-  toJSON msg = jsonObject-      [ "location" .=: msg.sourceCodeInfoLocation--      ]--instance Aeson.FromJSON SourceCodeInfo where-  parseJSON = Aeson.withObject "SourceCodeInfo" $ \obj -> do-    fld_sourceCodeInfoLocation <- parseFieldMaybe obj "location"-    pure defaultSourceCodeInfo-      { sourceCodeInfoLocation = maybe (sourceCodeInfoLocation defaultSourceCodeInfo) id fld_sourceCodeInfoLocation-      }--instance Hashable SourceCodeInfo where-  hashWithSalt salt msg = V.foldl' hashWithSalt (salt) msg.sourceCodeInfoLocation--instance Proto.Extension.HasExtensions SourceCodeInfo where-  messageUnknownFields = sourceCodeInfoUnknownFields-  setMessageUnknownFields !ufs msg = msg { sourceCodeInfoUnknownFields = ufs }--instance Semigroup SourceCodeInfo where-  a <> b = SourceCodeInfo-    { sourceCodeInfoLocation = a.sourceCodeInfoLocation <> b.sourceCodeInfoLocation-    , sourceCodeInfoUnknownFields = a.sourceCodeInfoUnknownFields <> b.sourceCodeInfoUnknownFields-    }--instance Monoid SourceCodeInfo where-  mempty = defaultSourceCodeInfo---- | Describes the relationship between generated code and its original source--- file. A GeneratedCodeInfo message is associated with only one generated--- source file, but may contain references to different source .proto files.-data GeneratedCodeInfo = GeneratedCodeInfo-  { generatedCodeInfoAnnotation :: !(V.Vector GeneratedCodeInfo'Annotation)-    -- ^ An Annotation connects some span of text in generated code to an element-    -- of its generating .proto file.-  , generatedCodeInfoUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--data GeneratedCodeInfo'Annotation = GeneratedCodeInfo'Annotation-  { generatedCodeInfoAnnotationPath :: !(VU.Vector Int32)-    -- ^ Identifies the element in the original source .proto file. This field-    -- is formatted the same as SourceCodeInfo.Location.path.-  , generatedCodeInfoAnnotationSourceFile :: !(Maybe Text)-    -- ^ Identifies the filesystem path to the original source .proto.-  , generatedCodeInfoAnnotationBegin :: !(Maybe Int32)-    -- ^ Identifies the starting offset in bytes in the generated code-    -- that relates to the identified object.-  , generatedCodeInfoAnnotationEnd :: !(Maybe Int32)-    -- ^ Identifies the ending offset in bytes in the generated code that-    -- relates to the identified object. The end offset should be one past-    -- the last relevant byte (so the length of the text = end - begin).-  , generatedCodeInfoAnnotationSemantic :: !(Maybe GeneratedCodeInfo'Annotation'Semantic)-  , generatedCodeInfoAnnotationUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData---- | Represents the identified object's effect on the element in the original--- .proto file.-data GeneratedCodeInfo'Annotation'Semantic-  = GeneratedCodeInfo'Annotation'Semantic'None-    -- ^ There is no effect or the effect is indescribable.-  | GeneratedCodeInfo'Annotation'Semantic'Set-    -- ^ The element is set or otherwise mutated.-  | GeneratedCodeInfo'Annotation'Semantic'Alias-    -- ^ An alias to the element is returned.-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumGeneratedCodeInfo'Annotation'Semantic :: GeneratedCodeInfo'Annotation'Semantic -> Int-toProtoEnumGeneratedCodeInfo'Annotation'Semantic GeneratedCodeInfo'Annotation'Semantic'None = 0-toProtoEnumGeneratedCodeInfo'Annotation'Semantic GeneratedCodeInfo'Annotation'Semantic'Set = 1-toProtoEnumGeneratedCodeInfo'Annotation'Semantic GeneratedCodeInfo'Annotation'Semantic'Alias = 2--fromProtoEnumGeneratedCodeInfo'Annotation'Semantic :: Int -> Maybe GeneratedCodeInfo'Annotation'Semantic-fromProtoEnumGeneratedCodeInfo'Annotation'Semantic 0 = Just GeneratedCodeInfo'Annotation'Semantic'None-fromProtoEnumGeneratedCodeInfo'Annotation'Semantic 1 = Just GeneratedCodeInfo'Annotation'Semantic'Set-fromProtoEnumGeneratedCodeInfo'Annotation'Semantic 2 = Just GeneratedCodeInfo'Annotation'Semantic'Alias-fromProtoEnumGeneratedCodeInfo'Annotation'Semantic _ = Nothing--instance MessageEncode GeneratedCodeInfo'Annotation'Semantic where-  buildSized _ = mempty-instance MessageDecode GeneratedCodeInfo'Annotation'Semantic where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON GeneratedCodeInfo'Annotation'Semantic where-  toJSON GeneratedCodeInfo'Annotation'Semantic'None = Aeson.String "NONE"-  toJSON GeneratedCodeInfo'Annotation'Semantic'Set = Aeson.String "SET"-  toJSON GeneratedCodeInfo'Annotation'Semantic'Alias = Aeson.String "ALIAS"--instance Aeson.FromJSON GeneratedCodeInfo'Annotation'Semantic where-  parseJSON = \case-    Aeson.String "NONE" -> pure GeneratedCodeInfo'Annotation'Semantic'None-    Aeson.String "SET" -> pure GeneratedCodeInfo'Annotation'Semantic'Set-    Aeson.String "ALIAS" -> pure GeneratedCodeInfo'Annotation'Semantic'Alias-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for GeneratedCodeInfo'Annotation'Semantic"--instance Hashable GeneratedCodeInfo'Annotation'Semantic where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumGeneratedCodeInfo'Annotation'Semantic x)--defaultGeneratedCodeInfo'Annotation :: GeneratedCodeInfo'Annotation-defaultGeneratedCodeInfo'Annotation = GeneratedCodeInfo'Annotation-  { generatedCodeInfoAnnotationPath = VU.empty-  , generatedCodeInfoAnnotationSourceFile = Nothing-  , generatedCodeInfoAnnotationBegin = Nothing-  , generatedCodeInfoAnnotationEnd = Nothing-  , generatedCodeInfoAnnotationSemantic = Nothing-  , generatedCodeInfoAnnotationUnknownFields = []-  }--instance MessageEncode GeneratedCodeInfo'Annotation where-  buildSized msg =-    encodePackedInt32 1 msg.generatedCodeInfoAnnotationPath-    <> (maybe mempty (\v -> archString 18 v) msg.generatedCodeInfoAnnotationSourceFile)-    <> (maybe mempty (\v -> archVarint 24 (fromIntegral v)) msg.generatedCodeInfoAnnotationBegin)-    <> (maybe mempty (\v -> archVarint 32 (fromIntegral v)) msg.generatedCodeInfoAnnotationEnd)-    <> (maybe mempty (\v -> archVarint 40 (fromIntegral (toProtoEnumGeneratedCodeInfo'Annotation'Semantic v))) msg.generatedCodeInfoAnnotationSemantic)-    <> encodeUnknownFieldsSized msg.generatedCodeInfoAnnotationUnknownFields--instance MessageDecode GeneratedCodeInfo'Annotation where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultGeneratedCodeInfo'Annotation-    where-      stage_0 msg =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          (VU.map fromIntegral <$> decodePackedVarint)-          (\v -> stage_1 (msg { generatedCodeInfoAnnotationPath = v}))-          (pure (case msg.generatedCodeInfoAnnotationUnknownFields of { [] -> msg; _ -> msg { generatedCodeInfoAnnotationUnknownFields = reverse (msg.generatedCodeInfoAnnotationUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_2 (msg { generatedCodeInfoAnnotationSourceFile = (Just v)}))-          (pure (case msg.generatedCodeInfoAnnotationUnknownFields of { [] -> msg; _ -> msg { generatedCodeInfoAnnotationUnknownFields = reverse (msg.generatedCodeInfoAnnotationUnknownFields) } }))-          (loop msg)-      stage_2 msg =-        inOrderStage1-          (0x18 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_3 (msg { generatedCodeInfoAnnotationBegin = (Just v)}))-          (pure (case msg.generatedCodeInfoAnnotationUnknownFields of { [] -> msg; _ -> msg { generatedCodeInfoAnnotationUnknownFields = reverse (msg.generatedCodeInfoAnnotationUnknownFields) } }))-          (loop msg)-      stage_3 msg =-        inOrderStage1-          (0x20 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_4 (msg { generatedCodeInfoAnnotationEnd = (Just v)}))-          (pure (case msg.generatedCodeInfoAnnotationUnknownFields of { [] -> msg; _ -> msg { generatedCodeInfoAnnotationUnknownFields = reverse (msg.generatedCodeInfoAnnotationUnknownFields) } }))-          (loop msg)-      stage_4 msg =-        inOrderStage1-          (0x28 :: Data.Word.Word8)-          decodeFieldEnum-          (\v -> loop (msg { generatedCodeInfoAnnotationSemantic = (Just v)}))-          (pure (case msg.generatedCodeInfoAnnotationUnknownFields of { [] -> msg; _ -> msg { generatedCodeInfoAnnotationUnknownFields = reverse (msg.generatedCodeInfoAnnotationUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.generatedCodeInfoAnnotationUnknownFields of { [] -> msg; _ -> msg { generatedCodeInfoAnnotationUnknownFields = reverse (msg.generatedCodeInfoAnnotationUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> case wt of-            2 -> do-              vs <- (VU.map fromIntegral <$> decodePackedVarint)-              loop (msg { generatedCodeInfoAnnotationPath = (msg.generatedCodeInfoAnnotationPath <> vs)})-            _ -> do-              v <- (fromIntegral <$> decodeFieldVarint)-              loop (msg { generatedCodeInfoAnnotationPath = (VU.snoc msg.generatedCodeInfoAnnotationPath v)})-          2 -> do-            v <- decodeFieldString-            loop (msg { generatedCodeInfoAnnotationSourceFile = (Just v)})-          3 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { generatedCodeInfoAnnotationBegin = (Just v)})-          4 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { generatedCodeInfoAnnotationEnd = (Just v)})-          5 -> do-            v <- decodeFieldEnum-            loop (msg { generatedCodeInfoAnnotationSemantic = (Just v)})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { generatedCodeInfoAnnotationUnknownFields = (uf : msg.generatedCodeInfoAnnotationUnknownFields)}))---- | Field descriptors for 'GeneratedCodeInfo'Annotation', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-generatedCodeInfo'AnnotationFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor GeneratedCodeInfo'Annotation)-generatedCodeInfo'AnnotationFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "path"-        , fdNumber = 1-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelRepeated-        , fdGet = generatedCodeInfoAnnotationPath-        , fdSet = \v m -> m { generatedCodeInfoAnnotationPath = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "source_file"-        , fdNumber = 2-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = generatedCodeInfoAnnotationSourceFile-        , fdSet = \v m -> m { generatedCodeInfoAnnotationSourceFile = v }-        })-    , (3, SomeField FieldDescriptor-        { fdName = "begin"-        , fdNumber = 3-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = generatedCodeInfoAnnotationBegin-        , fdSet = \v m -> m { generatedCodeInfoAnnotationBegin = v }-        })-    , (4, SomeField FieldDescriptor-        { fdName = "end"-        , fdNumber = 4-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = generatedCodeInfoAnnotationEnd-        , fdSet = \v m -> m { generatedCodeInfoAnnotationEnd = v }-        })-    , (5, SomeField FieldDescriptor-        { fdName = "semantic"-        , fdNumber = 5-        , fdTypeDesc = MessageType "Semantic"-        , fdLabel = LabelOptional-        , fdGet = generatedCodeInfoAnnotationSemantic-        , fdSet = \v m -> m { generatedCodeInfoAnnotationSemantic = v }-        })-    ]--instance ProtoMessage GeneratedCodeInfo'Annotation where-  protoMessageName _ = "google.protobuf.GeneratedCodeInfo.Annotation"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultGeneratedCodeInfo'Annotation-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = generatedCodeInfo'AnnotationFieldDescriptors--instance IsMessage GeneratedCodeInfo'Annotation--instance Aeson.ToJSON GeneratedCodeInfo'Annotation where-  toJSON msg = jsonObject-      [ "path" .=: msg.generatedCodeInfoAnnotationPath-      , "sourceFile" .=: msg.generatedCodeInfoAnnotationSourceFile-      , "begin" .=: msg.generatedCodeInfoAnnotationBegin-      , "end" .=: msg.generatedCodeInfoAnnotationEnd-      , "semantic" .=: msg.generatedCodeInfoAnnotationSemantic-      ]--instance Aeson.FromJSON GeneratedCodeInfo'Annotation where-  parseJSON = Aeson.withObject "GeneratedCodeInfo'Annotation" $ \obj -> do-    fld_generatedCodeInfoAnnotationPath <- parseFieldMaybe obj "path"-    fld_generatedCodeInfoAnnotationSourceFile <- parseFieldMaybe obj "sourceFile"-    fld_generatedCodeInfoAnnotationBegin <- parseFieldMaybe obj "begin"-    fld_generatedCodeInfoAnnotationEnd <- parseFieldMaybe obj "end"-    fld_generatedCodeInfoAnnotationSemantic <- parseFieldMaybe obj "semantic"-    pure defaultGeneratedCodeInfo'Annotation-      { generatedCodeInfoAnnotationPath = maybe (generatedCodeInfoAnnotationPath defaultGeneratedCodeInfo'Annotation) id fld_generatedCodeInfoAnnotationPath-      , generatedCodeInfoAnnotationSourceFile = maybe (generatedCodeInfoAnnotationSourceFile defaultGeneratedCodeInfo'Annotation) id fld_generatedCodeInfoAnnotationSourceFile-      , generatedCodeInfoAnnotationBegin = maybe (generatedCodeInfoAnnotationBegin defaultGeneratedCodeInfo'Annotation) id fld_generatedCodeInfoAnnotationBegin-      , generatedCodeInfoAnnotationEnd = maybe (generatedCodeInfoAnnotationEnd defaultGeneratedCodeInfo'Annotation) id fld_generatedCodeInfoAnnotationEnd-      , generatedCodeInfoAnnotationSemantic = maybe (generatedCodeInfoAnnotationSemantic defaultGeneratedCodeInfo'Annotation) id fld_generatedCodeInfoAnnotationSemantic-      }--instance Hashable GeneratedCodeInfo'Annotation where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (hashWithSalt (hashWithSalt (VU.foldl' hashWithSalt (salt) msg.generatedCodeInfoAnnotationPath) msg.generatedCodeInfoAnnotationSourceFile) msg.generatedCodeInfoAnnotationBegin) msg.generatedCodeInfoAnnotationEnd) msg.generatedCodeInfoAnnotationSemantic--instance Proto.Extension.HasExtensions GeneratedCodeInfo'Annotation where-  messageUnknownFields = generatedCodeInfoAnnotationUnknownFields-  setMessageUnknownFields !ufs msg = msg { generatedCodeInfoAnnotationUnknownFields = ufs }--instance Semigroup GeneratedCodeInfo'Annotation where-  a <> b = GeneratedCodeInfo'Annotation-    { generatedCodeInfoAnnotationPath = a.generatedCodeInfoAnnotationPath <> b.generatedCodeInfoAnnotationPath-    , generatedCodeInfoAnnotationSourceFile = case b.generatedCodeInfoAnnotationSourceFile of { Nothing -> a.generatedCodeInfoAnnotationSourceFile; x -> x }-    , generatedCodeInfoAnnotationBegin = case b.generatedCodeInfoAnnotationBegin of { Nothing -> a.generatedCodeInfoAnnotationBegin; x -> x }-    , generatedCodeInfoAnnotationEnd = case b.generatedCodeInfoAnnotationEnd of { Nothing -> a.generatedCodeInfoAnnotationEnd; x -> x }-    , generatedCodeInfoAnnotationSemantic = case b.generatedCodeInfoAnnotationSemantic of { Nothing -> a.generatedCodeInfoAnnotationSemantic; x -> x }-    , generatedCodeInfoAnnotationUnknownFields = a.generatedCodeInfoAnnotationUnknownFields <> b.generatedCodeInfoAnnotationUnknownFields-    }--instance Monoid GeneratedCodeInfo'Annotation where-  mempty = defaultGeneratedCodeInfo'Annotation--defaultGeneratedCodeInfo :: GeneratedCodeInfo-defaultGeneratedCodeInfo = GeneratedCodeInfo-  { generatedCodeInfoAnnotation = V.empty-  , generatedCodeInfoUnknownFields = []-  }--instance MessageEncode GeneratedCodeInfo where-  buildSized msg =-    V.foldl' (\acc v -> acc <> archSubmessage 10 (buildSized v)) mempty msg.generatedCodeInfoAnnotation-    <> encodeUnknownFieldsSized msg.generatedCodeInfoUnknownFields--instance MessageDecode GeneratedCodeInfo where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultGeneratedCodeInfo emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_0 msg (snocGrowList gl_0 v))-          (pure (case msg.generatedCodeInfoUnknownFields of { [] -> msg { generatedCodeInfoAnnotation = growListToVector gl_0 }; _ -> msg { generatedCodeInfoAnnotation = growListToVector gl_0, generatedCodeInfoUnknownFields = reverse (msg.generatedCodeInfoUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.generatedCodeInfoUnknownFields of { [] -> msg { generatedCodeInfoAnnotation = growListToVector gl_0 }; _ -> msg { generatedCodeInfoAnnotation = growListToVector gl_0, generatedCodeInfoUnknownFields = reverse (msg.generatedCodeInfoUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { generatedCodeInfoUnknownFields = (uf : msg.generatedCodeInfoUnknownFields)}) gl_0)---- | Field descriptors for 'GeneratedCodeInfo', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-generatedCodeInfoFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor GeneratedCodeInfo)-generatedCodeInfoFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "annotation"-        , fdNumber = 1-        , fdTypeDesc = MessageType "Annotation"-        , fdLabel = LabelRepeated-        , fdGet = generatedCodeInfoAnnotation-        , fdSet = \v m -> m { generatedCodeInfoAnnotation = v }-        })-    ]--instance ProtoMessage GeneratedCodeInfo where-  protoMessageName _ = "google.protobuf.GeneratedCodeInfo"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultGeneratedCodeInfo-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = generatedCodeInfoFieldDescriptors--instance IsMessage GeneratedCodeInfo--instance Aeson.ToJSON GeneratedCodeInfo where-  toJSON msg = jsonObject-      [ "annotation" .=: msg.generatedCodeInfoAnnotation--      ]--instance Aeson.FromJSON GeneratedCodeInfo where-  parseJSON = Aeson.withObject "GeneratedCodeInfo" $ \obj -> do-    fld_generatedCodeInfoAnnotation <- parseFieldMaybe obj "annotation"-    pure defaultGeneratedCodeInfo-      { generatedCodeInfoAnnotation = maybe (generatedCodeInfoAnnotation defaultGeneratedCodeInfo) id fld_generatedCodeInfoAnnotation-      }--instance Hashable GeneratedCodeInfo where-  hashWithSalt salt msg = V.foldl' hashWithSalt (salt) msg.generatedCodeInfoAnnotation--instance Proto.Extension.HasExtensions GeneratedCodeInfo where-  messageUnknownFields = generatedCodeInfoUnknownFields-  setMessageUnknownFields !ufs msg = msg { generatedCodeInfoUnknownFields = ufs }--instance Semigroup GeneratedCodeInfo where-  a <> b = GeneratedCodeInfo-    { generatedCodeInfoAnnotation = a.generatedCodeInfoAnnotation <> b.generatedCodeInfoAnnotation-    , generatedCodeInfoUnknownFields = a.generatedCodeInfoUnknownFields <> b.generatedCodeInfoUnknownFields-    }--instance Monoid GeneratedCodeInfo where-  mempty = defaultGeneratedCodeInfo
+ src/Proto/Google/Protobuf/SourceContext.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}+{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-matches -Wno-unused-top-binds #-}++{- | Auto-generated protobuf types from package @google.protobuf@.++__THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__++Any manual changes will be overwritten the next time code+generation is run.  To modify the types or instances, edit the+@.proto@ source file and re-run the code generator.+-}+module Proto.Google.Protobuf.SourceContext where++import Control.DeepSeq (NFData (..))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as AesonKey+import Data.Aeson.KeyMap qualified as AesonKM+import Data.Aeson.Types qualified as Aeson+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Hashable (Hashable (..))+import Data.Int (Int32, Int64)+import Data.Map.Strict qualified as Map+import Data.Proxy (Proxy (..))+import Data.Reflection (Given (..), given)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V+import Data.Vector.Unboxed qualified as VU+import Data.Word (Word32, Word64)+import GHC.Generics (Generic)+import Proto.Decode+import Proto.Encode+import Proto.Extension qualified+import Proto.Internal.Encode.Archetype (+  archBool,+  archBoolSize,+  archBytes,+  archBytesSize,+  archDouble,+  archFixed32,+  archFixed32Size,+  archFixed64,+  archFixed64Size,+  archFloat,+  archSVarint32,+  archSVarint64,+  archString,+  archStringSize,+  archSubmessage,+  archSubmessageSize,+  archVarint,+  archVarintSize,+ )+import Proto.Internal.JSON (bytesFieldToJSON, bytesMapFieldToJSON, jsonObject, parseBytesFieldMaybe, parseBytesMapFieldMaybe, parseFieldMaybe, protoBytesToJSON, (.=:))+import Proto.Internal.JSON.Extension qualified as PJExt+import Proto.Internal.Wire (Tag (..), WireType (..))+import Proto.Internal.Wire.Encode (+  fieldBoolSize,+  fieldBytesSize,+  fieldDoubleSize,+  fieldFixed32Size,+  fieldFixed64Size,+  fieldFloatSize,+  fieldMessageSize,+  fieldSVarint32Size,+  fieldSVarint64Size,+  fieldTextSize,+  fieldVarintSize,+  putByteString,+  putDouble,+  putFixed32,+  putFixed64,+  putFloat,+  putLengthDelimited,+  putSVarint32,+  putSVarint64,+  putTag,+  putText,+  putVarint,+  putVarintSigned,+  tagSize,+  varintSize,+  varintSize32,+  zigZag32,+  zigZag64,+ )+import Proto.Registry (IsMessage)+import Proto.Registry qualified+import Proto.Schema (FieldDescriptor (..), FieldLabel' (..), FieldTypeDescriptor (..), ProtoMessage (..), ScalarFieldType (..), SomeFieldDescriptor (..))+import Wireform.Builder qualified as B+++{- | Serialized FileDescriptorProto for this .proto file.+Decode with @Proto.Google.Protobuf.Descriptor.decodeMessage@.+-}+fileDescriptorProtoBytes :: ByteString+fileDescriptorProtoBytes = "\x0a\x24\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x73\x6f\x75\x72\x63\x65\x5f\x63\x6f\x6e\x74\x65\x78\x74\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x22\x0a\x0d\x53\x6f\x75\x72\x63\x65\x43\x6f\x6e\x74\x65\x78\x74\x12\x11\x0a\x09\x66\x69\x6c\x65\x5f\x6e\x61\x6d\x65\x18\x01\x20\x01\x28\x09\x62\x06\x70\x72\x6f\x74\x6f\x33"+++data SourceContext = SourceContext+  { sourceContextFileName :: !Text+  , sourceContextUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultSourceContext :: SourceContext+defaultSourceContext =+  SourceContext+    { sourceContextFileName = ""+    , sourceContextUnknownFields = []+    }+++instance MessageEncode SourceContext where+  buildMessage msg =+    (if msg.sourceContextFileName == T.empty then mempty else archString 10 msg.sourceContextFileName)+      <> encodeUnknownFields msg.sourceContextUnknownFields+++instance MessageSize SourceContext where+  messageSize msg =+    (if msg.sourceContextFileName == T.empty then 0 else archStringSize msg.sourceContextFileName)+      + unknownFieldsSize msg.sourceContextUnknownFields+++instance MessageDecode SourceContext where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop "" []+    where+      loop acc_0 acc_unknown_ =+        withTagM+          (pure (SourceContext {sourceContextFileName = acc_0, sourceContextUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- decodeFieldString+                loop v acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 (uf : acc_unknown_)+          )+++instance ProtoMessage SourceContext where+  protoMessageName _ = "google.protobuf.SourceContext"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultSourceContext+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "file_name"+              , fdNumber = 1+              , fdTypeDesc = ScalarType StringField+              , fdLabel = LabelOptional+              , fdGet = sourceContextFileName+              , fdSet = \v m -> m {sourceContextFileName = v}+              }+        )+      ]+++instance IsMessage SourceContext+++instance Aeson.ToJSON SourceContext where+  toJSON msg =+    jsonObject+      [ "fileName" .=: msg.sourceContextFileName+      ]+++instance Aeson.FromJSON SourceContext where+  parseJSON = Aeson.withObject "SourceContext" $ \obj -> do+    fld_sourceContextFileName <- parseFieldMaybe obj "fileName"+    pure+      defaultSourceContext+        { sourceContextFileName = maybe (sourceContextFileName defaultSourceContext) id fld_sourceContextFileName+        , sourceContextUnknownFields = []+        }+++instance Hashable SourceContext where+  hashWithSalt salt msg = hashWithSalt (salt) msg.sourceContextFileName+++instance Proto.Extension.HasExtensions SourceContext where+  messageUnknownFields = sourceContextUnknownFields+  setMessageUnknownFields !ufs msg = msg {sourceContextUnknownFields = ufs}+++instance Semigroup SourceContext where+  a <> b =+    SourceContext+      { sourceContextFileName = if b.sourceContextFileName == "" then a.sourceContextFileName else b.sourceContextFileName+      , sourceContextUnknownFields = a.sourceContextUnknownFields <> b.sourceContextUnknownFields+      }+++instance Monoid SourceContext where+  mempty = defaultSourceContext
+ src/Proto/Google/Protobuf/Struct.hs view
@@ -0,0 +1,531 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}+{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-matches -Wno-unused-top-binds #-}++{- | Auto-generated protobuf types from package @google.protobuf@.++__THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__++Any manual changes will be overwritten the next time code+generation is run.  To modify the types or instances, edit the+@.proto@ source file and re-run the code generator.+-}+module Proto.Google.Protobuf.Struct where++import Control.DeepSeq (NFData (..))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as AesonKey+import Data.Aeson.KeyMap qualified as AesonKM+import Data.Aeson.Types qualified as Aeson+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Hashable (Hashable (..))+import Data.Int (Int32, Int64)+import Data.Map.Strict qualified as Map+import Data.Proxy (Proxy (..))+import Data.Reflection (Given (..), given)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V+import Data.Vector.Unboxed qualified as VU+import Data.Word (Word32, Word64)+import GHC.Generics (Generic)+import Proto.Decode+import Proto.Encode+import Proto.Extension qualified+import Proto.Internal.Encode.Archetype (+  archBool,+  archBoolSize,+  archBytes,+  archBytesSize,+  archDouble,+  archFixed32,+  archFixed32Size,+  archFixed64,+  archFixed64Size,+  archFloat,+  archSVarint32,+  archSVarint64,+  archString,+  archStringSize,+  archSubmessage,+  archSubmessageSize,+  archVarint,+  archVarintSize,+ )+import Proto.Internal.JSON (bytesFieldToJSON, bytesMapFieldToJSON, jsonObject, parseBytesFieldMaybe, parseBytesMapFieldMaybe, parseFieldMaybe, protoBytesToJSON, (.=:))+import Proto.Internal.JSON.Extension qualified as PJExt+import Proto.Internal.Wire (Tag (..), WireType (..))+import Proto.Internal.Wire.Encode (+  fieldBoolSize,+  fieldBytesSize,+  fieldDoubleSize,+  fieldFixed32Size,+  fieldFixed64Size,+  fieldFloatSize,+  fieldMessageSize,+  fieldSVarint32Size,+  fieldSVarint64Size,+  fieldTextSize,+  fieldVarintSize,+  putByteString,+  putDouble,+  putFixed32,+  putFixed64,+  putFloat,+  putLengthDelimited,+  putSVarint32,+  putSVarint64,+  putTag,+  putText,+  putVarint,+  putVarintSigned,+  tagSize,+  varintSize,+  varintSize32,+  zigZag32,+  zigZag64,+ )+import Proto.Registry (IsMessage)+import Proto.Registry qualified+import Proto.Schema (FieldDescriptor (..), FieldLabel' (..), FieldTypeDescriptor (..), ProtoMessage (..), ScalarFieldType (..), SomeFieldDescriptor (..))+import Wireform.Builder qualified as B+++{- | Serialized FileDescriptorProto for this .proto file.+Decode with @Proto.Google.Protobuf.Descriptor.decodeMessage@.+-}+fileDescriptorProtoBytes :: ByteString+fileDescriptorProtoBytes = "\x0a\x1c\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x73\x74\x72\x75\x63\x74\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x25\x0a\x06\x53\x74\x72\x75\x63\x74\x12\x1b\x0a\x06\x66\x69\x65\x6c\x64\x73\x18\x01\x20\x03\x28\x0b\x32\x0b\x66\x69\x65\x6c\x64\x73\x45\x6e\x74\x72\x79\x22\xab\x01\x0a\x05\x56\x61\x6c\x75\x65\x12\x1d\x0a\x0a\x6e\x75\x6c\x6c\x5f\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x0b\x32\x09\x4e\x75\x6c\x6c\x56\x61\x6c\x75\x65\x12\x14\x0a\x0c\x6e\x75\x6d\x62\x65\x72\x5f\x76\x61\x6c\x75\x65\x18\x02\x20\x01\x28\x01\x12\x14\x0a\x0c\x73\x74\x72\x69\x6e\x67\x5f\x76\x61\x6c\x75\x65\x18\x03\x20\x01\x28\x09\x12\x12\x0a\x0a\x62\x6f\x6f\x6c\x5f\x76\x61\x6c\x75\x65\x18\x04\x20\x01\x28\x08\x12\x1c\x0a\x0c\x73\x74\x72\x75\x63\x74\x5f\x76\x61\x6c\x75\x65\x18\x05\x20\x01\x28\x0b\x32\x06\x53\x74\x72\x75\x63\x74\x12\x1d\x0a\x0a\x6c\x69\x73\x74\x5f\x76\x61\x6c\x75\x65\x18\x06\x20\x01\x28\x0b\x32\x09\x4c\x69\x73\x74\x56\x61\x6c\x75\x65\x42\x06\x0a\x04\x6b\x69\x6e\x64\x22\x22\x0a\x09\x4c\x69\x73\x74\x56\x61\x6c\x75\x65\x12\x15\x0a\x06\x76\x61\x6c\x75\x65\x73\x18\x01\x20\x03\x28\x0b\x32\x05\x56\x61\x6c\x75\x65\x2a\x19\x0a\x09\x4e\x75\x6c\x6c\x56\x61\x6c\x75\x65\x12\x0c\x0a\x0a\x4e\x55\x4c\x4c\x5f\x56\x41\x4c\x55\x45\x62\x06\x70\x72\x6f\x74\x6f\x33"+++data Struct = Struct+  { structFields :: !(Map.Map Text Value)+  , structUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultStruct :: Struct+defaultStruct =+  Struct+    { structFields = Map.empty+    , structUnknownFields = []+    }+++instance MessageEncode Struct where+  buildMessage msg =+    Map.foldlWithKey' (\acc k v -> acc <> encodeMapField 1 (encodeFieldString 1 k) (encodeFieldMessage 2 v)) mempty msg.structFields+      <> encodeUnknownFields msg.structUnknownFields+++instance MessageSize Struct where+  messageSize msg =+    (Map.foldlWithKey' (\acc k v -> let entrySz = fieldTextSize 1 k + fieldMessageSize 2 (messageSize v) in acc + tagSize 1 + varintSize (fromIntegral entrySz) + entrySz) 0 msg.structFields)+      + unknownFieldsSize msg.structUnknownFields+++instance MessageDecode Struct where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop Map.empty []+    where+      loop acc_0 acc_unknown_ =+        withTagM+          (pure (Struct {structFields = acc_0, structUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                bs' <- getLengthDelimited+                let decodeEntry = runDecoder (decodeMapEntry decodeFieldString decodeFieldMessage "" undefined) bs'+                case decodeEntry of+                  Left _ -> loop acc_0 acc_unknown_+                  Right (mk', mv') -> loop (Map.union acc_0 (Map.singleton mk' mv')) acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 (uf : acc_unknown_)+          )+++instance ProtoMessage Struct where+  protoMessageName _ = "google.protobuf.Struct"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultStruct+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "fields"+              , fdNumber = 1+              , fdTypeDesc = ScalarType BytesField+              , fdLabel = LabelRepeated+              , fdGet = structFields+              , fdSet = \v m -> m {structFields = v}+              }+        )+      ]+++instance IsMessage Struct+++instance Aeson.ToJSON Struct where+  toJSON msg =+    jsonObject+      [ "fields" .=: msg.structFields+      ]+++instance Aeson.FromJSON Struct where+  parseJSON = Aeson.withObject "Struct" $ \obj -> do+    fld_structFields <- parseFieldMaybe obj "fields"+    pure+      defaultStruct+        { structFields = maybe (structFields defaultStruct) id fld_structFields+        , structUnknownFields = []+        }+++instance Hashable Struct where+  hashWithSalt salt msg = Map.foldlWithKey' (\s k v -> s `hashWithSalt` k `hashWithSalt` v) (salt) msg.structFields+++instance Proto.Extension.HasExtensions Struct where+  messageUnknownFields = structUnknownFields+  setMessageUnknownFields !ufs msg = msg {structUnknownFields = ufs}+++instance Semigroup Struct where+  a <> b =+    Struct+      { structFields = a.structFields <> b.structFields+      , structUnknownFields = a.structUnknownFields <> b.structUnknownFields+      }+++instance Monoid Struct where+  mempty = defaultStruct+++data Value = Value+  { valueKind :: !(Maybe Value'Kind)+  , valueUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++data Value'Kind+  = Value'Kind'NullValue !NullValue+  | Value'Kind'NumberValue {-# UNPACK #-} !Double+  | Value'Kind'StringValue !Text+  | Value'Kind'BoolValue {-# UNPACK #-} !Bool+  | Value'Kind'StructValue !Struct+  | Value'Kind'ListValue !ListValue+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++instance Aeson.ToJSON Value'Kind where+  toJSON _ = Aeson.Null+++instance Aeson.FromJSON Value'Kind where+  parseJSON _ = fail "Cannot parse oneof from JSON"+++instance Hashable Value'Kind where+  hashWithSalt salt (Value'Kind'NullValue v) = salt `hashWithSalt` (0 :: Int) `hashWithSalt` v+  hashWithSalt salt (Value'Kind'NumberValue v) = salt `hashWithSalt` (1 :: Int) `hashWithSalt` v+  hashWithSalt salt (Value'Kind'StringValue v) = salt `hashWithSalt` (2 :: Int) `hashWithSalt` v+  hashWithSalt salt (Value'Kind'BoolValue v) = salt `hashWithSalt` (3 :: Int) `hashWithSalt` v+  hashWithSalt salt (Value'Kind'StructValue v) = salt `hashWithSalt` (4 :: Int) `hashWithSalt` v+  hashWithSalt salt (Value'Kind'ListValue v) = salt `hashWithSalt` (5 :: Int) `hashWithSalt` v+++defaultValue :: Value+defaultValue =+  Value+    { valueKind = Nothing+    , valueUnknownFields = []+    }+++instance MessageEncode Value where+  buildMessage msg =+    ( case msg.valueKind of+        Nothing -> mempty+        Just (Value'Kind'NullValue v) -> (let sz = messageSize v in archSubmessage 10 sz (buildMessage v))+        Just (Value'Kind'NumberValue v) -> archDouble 17 v+        Just (Value'Kind'StringValue v) -> archString 26 v+        Just (Value'Kind'BoolValue v) -> archBool 32 v+        Just (Value'Kind'StructValue v) -> (let sz = messageSize v in archSubmessage 42 sz (buildMessage v))+        Just (Value'Kind'ListValue v) -> (let sz = messageSize v in archSubmessage 50 sz (buildMessage v))+    )+      <> encodeUnknownFields msg.valueUnknownFields+++instance MessageSize Value where+  messageSize msg =+    ( case msg.valueKind of+        Nothing -> 0+        Just (Value'Kind'NullValue v) -> archSubmessageSize (messageSize v)+        Just (Value'Kind'NumberValue v) -> archFixed64Size+        Just (Value'Kind'StringValue v) -> archStringSize v+        Just (Value'Kind'BoolValue v) -> archBoolSize+        Just (Value'Kind'StructValue v) -> archSubmessageSize (messageSize v)+        Just (Value'Kind'ListValue v) -> archSubmessageSize (messageSize v)+    )+      + unknownFieldsSize msg.valueUnknownFields+++instance MessageDecode Value where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop Nothing []+    where+      loop acc_0 acc_unknown_ =+        withTagM+          (pure (Value {valueKind = acc_0, valueUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- decodeFieldMessage+                loop (Just (Value'Kind'NullValue v)) acc_unknown_+              2 -> do+                v <- decodeFieldDouble+                loop (Just (Value'Kind'NumberValue v)) acc_unknown_+              3 -> do+                v <- decodeFieldString+                loop (Just (Value'Kind'StringValue v)) acc_unknown_+              4 -> do+                v <- decodeFieldBool+                loop (Just (Value'Kind'BoolValue v)) acc_unknown_+              5 -> do+                v <- decodeFieldMessage+                loop (Just (Value'Kind'StructValue v)) acc_unknown_+              6 -> do+                v <- decodeFieldMessage+                loop (Just (Value'Kind'ListValue v)) acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 (uf : acc_unknown_)+          )+++instance ProtoMessage Value where+  protoMessageName _ = "google.protobuf.Value"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultValue+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "kind"+              , fdNumber = 1+              , fdTypeDesc = MessageType "kind"+              , fdLabel = LabelOptional+              , fdGet = valueKind+              , fdSet = \v m -> m {valueKind = v}+              }+        )+      ]+++instance IsMessage Value+++instance Aeson.ToJSON Value where+  toJSON msg =+    jsonObject+      [ "kind" .=: msg.valueKind+      ]+++instance Aeson.FromJSON Value where+  parseJSON = Aeson.withObject "Value" $ \obj -> do+    fld_valueKind <- parseFieldMaybe obj "kind"+    pure+      defaultValue+        { valueKind = maybe (valueKind defaultValue) id fld_valueKind+        , valueUnknownFields = []+        }+++instance Hashable Value where+  hashWithSalt salt msg = hashWithSalt (salt) msg.valueKind+++instance Proto.Extension.HasExtensions Value where+  messageUnknownFields = valueUnknownFields+  setMessageUnknownFields !ufs msg = msg {valueUnknownFields = ufs}+++instance Semigroup Value where+  a <> b =+    Value+      { valueKind = case b.valueKind of Nothing -> a.valueKind; x -> x+      , valueUnknownFields = a.valueUnknownFields <> b.valueUnknownFields+      }+++instance Monoid Value where+  mempty = defaultValue+++data NullValue+  = NullValue'NullValue+  deriving stock (Show, Eq, Ord, Enum, Bounded, Generic)+  deriving anyclass (NFData)+++toProtoEnumNullValue :: NullValue -> Int+toProtoEnumNullValue NullValue'NullValue = 0+++fromProtoEnumNullValue :: Int -> Maybe NullValue+fromProtoEnumNullValue 0 = Just NullValue'NullValue+fromProtoEnumNullValue _ = Nothing+++instance MessageEncode NullValue where+  buildMessage _ = mempty+++instance MessageSize NullValue where+  messageSize _ = 0+++instance MessageDecode NullValue where+  messageDecoder = pure (toEnum 0)+++instance Aeson.ToJSON NullValue where+  toJSON NullValue'NullValue = Aeson.String "NULL_VALUE"+++instance Aeson.FromJSON NullValue where+  parseJSON = \case+    Aeson.String "NULL_VALUE" -> pure NullValue'NullValue+    Aeson.Number n -> pure (toEnum (round n))+    _ -> fail "Invalid enum value for NullValue"+++instance Hashable NullValue where+  hashWithSalt salt x = hashWithSalt salt (toProtoEnumNullValue x)+++data ListValue = ListValue+  { listValueValues :: !(V.Vector Value)+  , listValueUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultListValue :: ListValue+defaultListValue =+  ListValue+    { listValueValues = V.empty+    , listValueUnknownFields = []+    }+++instance MessageEncode ListValue where+  buildMessage msg =+    V.foldl' (\acc v -> let sz = messageSize v in acc <> archSubmessage 10 sz (buildMessage v)) mempty msg.listValueValues+      <> encodeUnknownFields msg.listValueUnknownFields+++instance MessageSize ListValue where+  messageSize msg =+    (V.foldl' (\acc v -> acc + archSubmessageSize (messageSize v)) 0 msg.listValueValues)+      + unknownFieldsSize msg.listValueUnknownFields+++instance MessageDecode ListValue where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop V.empty []+    where+      loop acc_0 acc_unknown_ =+        withTagM+          (pure (ListValue {listValueValues = acc_0, listValueUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- decodeFieldMessage+                loop (acc_0 <> V.singleton v) acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 (uf : acc_unknown_)+          )+++instance ProtoMessage ListValue where+  protoMessageName _ = "google.protobuf.ListValue"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultListValue+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "values"+              , fdNumber = 1+              , fdTypeDesc = MessageType "Value"+              , fdLabel = LabelRepeated+              , fdGet = listValueValues+              , fdSet = \v m -> m {listValueValues = v}+              }+        )+      ]+++instance IsMessage ListValue+++instance Aeson.ToJSON ListValue where+  toJSON msg =+    jsonObject+      [ "values" .=: msg.listValueValues+      ]+++instance Aeson.FromJSON ListValue where+  parseJSON = Aeson.withObject "ListValue" $ \obj -> do+    fld_listValueValues <- parseFieldMaybe obj "values"+    pure+      defaultListValue+        { listValueValues = maybe (listValueValues defaultListValue) id fld_listValueValues+        , listValueUnknownFields = []+        }+++instance Hashable ListValue where+  hashWithSalt salt msg = V.foldl' hashWithSalt (salt) msg.listValueValues+++instance Proto.Extension.HasExtensions ListValue where+  messageUnknownFields = listValueUnknownFields+  setMessageUnknownFields !ufs msg = msg {listValueUnknownFields = ufs}+++instance Semigroup ListValue where+  a <> b =+    ListValue+      { listValueValues = a.listValueValues <> b.listValueValues+      , listValueUnknownFields = a.listValueUnknownFields <> b.listValueUnknownFields+      }+++instance Monoid ListValue where+  mempty = defaultListValue
+ src/Proto/Google/Protobuf/Struct/Util.hs view
@@ -0,0 +1,192 @@+{- | Utility functions for @google.protobuf.Struct@ and @Value@.++Provides a builder DSL for constructing 'Struct' and 'Value' from+native Haskell types, plus conversions to\/from 'Aeson.Value' — mirroring+Go's @structpb.NewStruct@, @structpb.NewValue@, etc.+-}+module Proto.Google.Protobuf.Struct.Util (+  -- * Struct construction+  fromMap,+  fromPairs,+  toMap,++  -- * Value construction+  nullValue,+  numberValue,+  stringValue,+  boolValue,+  structValue,+  listValue,++  -- * Value extraction+  asNull,+  asNumber,+  asString,+  asBool,+  asStruct,+  asList,++  -- * Aeson bridge+  valueFromAeson,+  valueToAeson,+  structFromAeson,+  structToAeson,+) where++import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as AesonKey+import Data.Aeson.KeyMap qualified as AesonKM+import Data.Bifunctor (bimap)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Scientific (fromFloatDigits, toRealFloat)+import Data.Text (Text)+import Data.Vector qualified as V+import Proto.Google.Protobuf.Struct+++-- | Construct a 'Struct' from a 'Map'.+fromMap :: Map Text Value -> Struct+fromMap m = defaultStruct {structFields = m}+++-- | Construct a 'Struct' from key-value pairs.+fromPairs :: [(Text, Value)] -> Struct+fromPairs = fromMap . Map.fromList+++-- | Extract the underlying 'Map' from a 'Struct'.+toMap :: Struct -> Map Text Value+toMap = structFields+++-- | A null 'Value'.+nullValue :: Value+nullValue =+  defaultValue+    { valueKind = Just (Value'Kind'NullValue NullValue'NullValue)+    }+++-- | A numeric 'Value'.+numberValue :: Double -> Value+numberValue d =+  defaultValue+    { valueKind = Just (Value'Kind'NumberValue d)+    }+++-- | A string 'Value'.+stringValue :: Text -> Value+stringValue t =+  defaultValue+    { valueKind = Just (Value'Kind'StringValue t)+    }+++-- | A boolean 'Value'.+boolValue :: Bool -> Value+boolValue b =+  defaultValue+    { valueKind = Just (Value'Kind'BoolValue b)+    }+++-- | A 'Value' wrapping a 'Struct'.+structValue :: Struct -> Value+structValue s =+  defaultValue+    { valueKind = Just (Value'Kind'StructValue s)+    }+++-- | A 'Value' wrapping a list of 'Value's.+listValue :: [Value] -> Value+listValue vs =+  defaultValue+    { valueKind = Just (Value'Kind'ListValue (defaultListValue {listValueValues = V.fromList vs}))+    }+++-- | Extract 'Nothing' if the value is null, or 'Just ()' otherwise.+asNull :: Value -> Maybe ()+asNull v = case valueKind v of+  Just (Value'Kind'NullValue _) -> Just ()+  _ -> Nothing+++-- | Extract a 'Double' if the value is numeric.+asNumber :: Value -> Maybe Double+asNumber v = case valueKind v of+  Just (Value'Kind'NumberValue d) -> Just d+  _ -> Nothing+++-- | Extract a 'Text' if the value is a string.+asString :: Value -> Maybe Text+asString v = case valueKind v of+  Just (Value'Kind'StringValue t) -> Just t+  _ -> Nothing+++-- | Extract a 'Bool' if the value is boolean.+asBool :: Value -> Maybe Bool+asBool v = case valueKind v of+  Just (Value'Kind'BoolValue b) -> Just b+  _ -> Nothing+++-- | Extract a 'Struct' if the value wraps one.+asStruct :: Value -> Maybe Struct+asStruct v = case valueKind v of+  Just (Value'Kind'StructValue s) -> Just s+  _ -> Nothing+++-- | Extract a list of 'Value's if the value is a list.+asList :: Value -> Maybe [Value]+asList v = case valueKind v of+  Just (Value'Kind'ListValue lv) -> Just (V.toList (listValueValues lv))+  _ -> Nothing+++-- | Convert an 'Aeson.Value' to a protobuf 'Value'.+valueFromAeson :: Aeson.Value -> Value+valueFromAeson = \case+  Aeson.Null -> nullValue+  Aeson.Bool b -> boolValue b+  Aeson.Number n -> numberValue (toRealFloat n)+  Aeson.String s -> stringValue s+  Aeson.Array vs -> listValue (V.toList (fmap valueFromAeson vs))+  Aeson.Object o -> structValue (structFromAeson (Aeson.Object o))+++-- | Convert a protobuf 'Value' to an 'Aeson.Value'.+valueToAeson :: Value -> Aeson.Value+valueToAeson v = case valueKind v of+  Nothing -> Aeson.Null+  Just vk -> case vk of+    Value'Kind'NullValue _ -> Aeson.Null+    Value'Kind'NumberValue d -> Aeson.Number (fromFloatDigits d)+    Value'Kind'StringValue s -> Aeson.String s+    Value'Kind'BoolValue b -> Aeson.Bool b+    Value'Kind'StructValue s -> structToAeson s+    Value'Kind'ListValue l -> Aeson.Array (fmap valueToAeson (listValueValues l))+++{- | Convert an 'Aeson.Value' (must be an Object) to a 'Struct'.+Non-object inputs produce an empty 'Struct'.+-}+structFromAeson :: Aeson.Value -> Struct+structFromAeson (Aeson.Object o) =+  fromMap (Map.fromList (fmap (bimap AesonKey.toText valueFromAeson) (AesonKM.toList o)))+structFromAeson _ = defaultStruct+++-- | Convert a 'Struct' to an 'Aeson.Value' (Object).+structToAeson :: Struct -> Aeson.Value+structToAeson s =+  Aeson.Object+    ( AesonKM.fromList+        (fmap (bimap AesonKey.fromText valueToAeson) (Map.toList (structFields s)))+    )
+ src/Proto/Google/Protobuf/Timestamp.hs view
@@ -0,0 +1,258 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}+{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-matches -Wno-unused-top-binds #-}++{- | Auto-generated protobuf types from package @google.protobuf@.++__THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__++Any manual changes will be overwritten the next time code+generation is run.  To modify the types or instances, edit the+@.proto@ source file and re-run the code generator.+-}+module Proto.Google.Protobuf.Timestamp where++import Control.DeepSeq (NFData (..))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as AesonKey+import Data.Aeson.KeyMap qualified as AesonKM+import Data.Aeson.Types qualified as Aeson+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Hashable (Hashable (..))+import Data.Int (Int32, Int64)+import Data.Map.Strict qualified as Map+import Data.Proxy (Proxy (..))+import Data.Reflection (Given (..), given)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V+import Data.Vector.Unboxed qualified as VU+import Data.Word (Word32, Word64)+import GHC.Generics (Generic)+import Proto.Decode+import Proto.Encode+import Proto.Extension qualified+import Proto.Internal.Encode.Archetype (+  archBool,+  archBoolSize,+  archBytes,+  archBytesSize,+  archDouble,+  archFixed32,+  archFixed32Size,+  archFixed64,+  archFixed64Size,+  archFloat,+  archSVarint32,+  archSVarint64,+  archString,+  archStringSize,+  archSubmessage,+  archSubmessageSize,+  archVarint,+  archVarintSize,+ )+import Proto.Internal.JSON (bytesFieldToJSON, bytesMapFieldToJSON, jsonObject, parseBytesFieldMaybe, parseBytesMapFieldMaybe, parseFieldMaybe, protoBytesToJSON, (.=:))+import Proto.Internal.JSON.Extension qualified as PJExt+import Proto.Internal.Wire (Tag (..), WireType (..))+import Proto.Internal.Wire.Encode (+  fieldBoolSize,+  fieldBytesSize,+  fieldDoubleSize,+  fieldFixed32Size,+  fieldFixed64Size,+  fieldFloatSize,+  fieldMessageSize,+  fieldSVarint32Size,+  fieldSVarint64Size,+  fieldTextSize,+  fieldVarintSize,+  putByteString,+  putDouble,+  putFixed32,+  putFixed64,+  putFloat,+  putLengthDelimited,+  putSVarint32,+  putSVarint64,+  putTag,+  putText,+  putVarint,+  putVarintSigned,+  tagSize,+  varintSize,+  varintSize32,+  zigZag32,+  zigZag64,+ )+import Proto.Registry (IsMessage)+import Proto.Registry qualified+import Proto.Schema (FieldDescriptor (..), FieldLabel' (..), FieldTypeDescriptor (..), ProtoMessage (..), ScalarFieldType (..), SomeFieldDescriptor (..))+import Wireform.Builder qualified as B+++{- | Serialized FileDescriptorProto for this .proto file.+Decode with @Proto.Google.Protobuf.Descriptor.decodeMessage@.+-}+fileDescriptorProtoBytes :: ByteString+fileDescriptorProtoBytes = "\x0a\x1f\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x74\x69\x6d\x65\x73\x74\x61\x6d\x70\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x2b\x0a\x09\x54\x69\x6d\x65\x73\x74\x61\x6d\x70\x12\x0f\x0a\x07\x73\x65\x63\x6f\x6e\x64\x73\x18\x01\x20\x01\x28\x03\x12\x0d\x0a\x05\x6e\x61\x6e\x6f\x73\x18\x02\x20\x01\x28\x05\x62\x06\x70\x72\x6f\x74\x6f\x33"+++data Timestamp = Timestamp+  { timestampSeconds :: {-# UNPACK #-} !Int64+  , timestampNanos :: {-# UNPACK #-} !Int32+  , timestampUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultTimestamp :: Timestamp+defaultTimestamp =+  Timestamp+    { timestampSeconds = 0+    , timestampNanos = 0+    , timestampUnknownFields = []+    }+++instance MessageEncode Timestamp where+  buildMessage msg =+    (if msg.timestampSeconds == 0 then mempty else archVarint 8 (fromIntegral msg.timestampSeconds))+      <> (if msg.timestampNanos == 0 then mempty else archVarint 16 (fromIntegral msg.timestampNanos))+      <> encodeUnknownFields msg.timestampUnknownFields+++instance MessageSize Timestamp where+  messageSize msg =+    (if msg.timestampSeconds == 0 then 0 else archVarintSize (fromIntegral msg.timestampSeconds))+      + (if msg.timestampNanos == 0 then 0 else archVarintSize (fromIntegral msg.timestampNanos))+      + unknownFieldsSize msg.timestampUnknownFields+++instance MessageDecode Timestamp where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop 0 0 []+    where+      loop acc_0 acc_1 acc_unknown_ =+        withTagM+          (pure (Timestamp {timestampSeconds = acc_0, timestampNanos = acc_1, timestampUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- (fromIntegral <$> decodeFieldVarint)+                loop v acc_1 acc_unknown_+              2 -> do+                v <- (fromIntegral <$> decodeFieldVarint)+                loop acc_0 v acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 acc_1 (uf : acc_unknown_)+          )+++instance ProtoMessage Timestamp where+  protoMessageName _ = "google.protobuf.Timestamp"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultTimestamp+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "seconds"+              , fdNumber = 1+              , fdTypeDesc = ScalarType Int64Field+              , fdLabel = LabelOptional+              , fdGet = timestampSeconds+              , fdSet = \v m -> m {timestampSeconds = v}+              }+        )+      ,+        ( 2+        , SomeField+            FieldDescriptor+              { fdName = "nanos"+              , fdNumber = 2+              , fdTypeDesc = ScalarType Int32Field+              , fdLabel = LabelOptional+              , fdGet = timestampNanos+              , fdSet = \v m -> m {timestampNanos = v}+              }+        )+      ]+++instance IsMessage Timestamp+++instance Aeson.ToJSON Timestamp where+  toJSON msg =+    let s = msg.timestampSeconds+        n = msg.timestampNanos+        (rawDays, remSec) = s `divMod` 86400+        (hours, remH) = remSec `divMod` 3600+        (mins, secs) = remH `divMod` 60+        z = rawDays + 719468+        era = (if z >= 0 then z else z - 146096) `div` 146097+        doe = z - era * 146097+        yoe = (doe - doe `div` 1460 + doe `div` 36524 - doe `div` 146096) `div` 365+        y = yoe + era * 400+        doy = doe - (365 * yoe + yoe `div` 4 - yoe `div` 100)+        mp = (5 * doy + 2) `div` 153+        d = doy - (153 * mp + 2) `div` 5 + 1+        m = mp + (if mp < 10 then 3 else -9)+        y' = y + (if m <= 2 then 1 else 0)+        pad2 x = let sx = T.pack (show (abs x)) in if T.length sx < 2 then T.pack "0" <> sx else sx+        pad4 x = let sx = T.pack (show (abs x)) in T.replicate (4 - T.length sx) (T.pack "0") <> sx+        pad9 x = let sx = T.pack (show (abs x)) in T.replicate (9 - T.length sx) (T.pack "0") <> sx+        nanoStr = if n == 0 then T.pack "" else T.pack "." <> dropTrailingZeros (pad9 (fromIntegral n))+        dropTrailingZeros t = case T.stripSuffix (T.pack "0") t of Just t' -> dropTrailingZeros t'; Nothing -> t+    in Aeson.String+        ( pad4 y'+            <> T.pack "-"+            <> pad2 (fromIntegral m)+            <> T.pack "-"+            <> pad2 (fromIntegral d)+            <> T.pack "T"+            <> pad2 hours+            <> T.pack ":"+            <> pad2 mins+            <> T.pack ":"+            <> pad2 secs+            <> nanoStr+            <> T.pack "Z"+        )+++instance Aeson.FromJSON Timestamp where+  parseJSON (Aeson.String _) = pure defaultTimestamp+  parseJSON _ = fail "Expected RFC 3339 timestamp string"+++instance Hashable Timestamp where+  hashWithSalt salt msg = hashWithSalt (hashWithSalt (salt) msg.timestampSeconds) msg.timestampNanos+++instance Proto.Extension.HasExtensions Timestamp where+  messageUnknownFields = timestampUnknownFields+  setMessageUnknownFields !ufs msg = msg {timestampUnknownFields = ufs}+++instance Semigroup Timestamp where+  a <> b =+    Timestamp+      { timestampSeconds = if b.timestampSeconds == 0 then a.timestampSeconds else b.timestampSeconds+      , timestampNanos = if b.timestampNanos == 0 then a.timestampNanos else b.timestampNanos+      , timestampUnknownFields = a.timestampUnknownFields <> b.timestampUnknownFields+      }+++instance Monoid Timestamp where+  mempty = defaultTimestamp
+ src/Proto/Google/Protobuf/Timestamp/Util.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE ScopedTypeVariables #-}++{- | Utility functions for @google.protobuf.Timestamp@.++Provides conversions to\/from standard Haskell time types ('UTCTime',+'POSIXTime'), arithmetic with 'Duration', a current-time helper,+an 'Ord' instance, and validation — mirroring utilities found in+Go (@timestamppb@), Java (@com.google.protobuf.util.Timestamps@),+and Rust (@prost-types@).+-}+module Proto.Google.Protobuf.Timestamp.Util (+  -- * Conversions+  timestampFromUTCTime,+  timestampToUTCTime,+  timestampFromPOSIXTime,+  timestampToPOSIXTime,++  -- * Current time+  getCurrentTimestamp,++  -- * Arithmetic+  addDuration,+  subtractTimestamps,++  -- * Validation+  isValidTimestamp,++  -- * Comparison+  compareTimestamp,+) where++import Data.Int (Int32, Int64)+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime, posixSecondsToUTCTime, utcTimeToPOSIXSeconds)+import Proto.Google.Protobuf.Duration (Duration (..), defaultDuration)+import Proto.Google.Protobuf.Timestamp (Timestamp (..), defaultTimestamp)+++nanosPerSecond :: Int64+nanosPerSecond = 1000000000+++-- | Convert a 'UTCTime' to a 'Timestamp'.+timestampFromUTCTime :: UTCTime -> Timestamp+timestampFromUTCTime = timestampFromPOSIXTime . utcTimeToPOSIXSeconds+++-- | Convert a 'Timestamp' to a 'UTCTime'.+timestampToUTCTime :: Timestamp -> UTCTime+timestampToUTCTime = posixSecondsToUTCTime . timestampToPOSIXTime+++{- | Convert a 'POSIXTime' to a 'Timestamp'.++Fractional seconds are preserved at nanosecond granularity.+-}+timestampFromPOSIXTime :: POSIXTime -> Timestamp+timestampFromPOSIXTime pt =+  let totalNanos = round (pt * fromIntegral nanosPerSecond) :: Int64+      (s, n) = totalNanos `quotRem` nanosPerSecond+  in defaultTimestamp+       { timestampSeconds = s+       , timestampNanos = fromIntegral n+       }+++-- | Convert a 'Timestamp' to a 'POSIXTime'.+timestampToPOSIXTime :: Timestamp -> POSIXTime+timestampToPOSIXTime ts =+  let s = fromIntegral (timestampSeconds ts) :: POSIXTime+      n = fromIntegral (timestampNanos ts) / fromIntegral nanosPerSecond :: POSIXTime+  in s + n+++-- | Get the current system time as a 'Timestamp'.+getCurrentTimestamp :: IO Timestamp+getCurrentTimestamp = timestampFromPOSIXTime <$> getPOSIXTime+++-- | Add a 'Duration' to a 'Timestamp', producing a new 'Timestamp'.+addDuration :: Timestamp -> Duration -> Timestamp+addDuration ts dur =+  let totalNanos =+        (fromIntegral (timestampSeconds ts) * nanosPerSecond + fromIntegral (timestampNanos ts))+          + (fromIntegral (durationSeconds dur) * nanosPerSecond + fromIntegral (durationNanos dur))+      (s, n) = totalNanos `quotRem` nanosPerSecond+  in defaultTimestamp+       { timestampSeconds = s+       , timestampNanos = fromIntegral n+       }+++-- | Compute the 'Duration' between two 'Timestamp' values (@a - b@).+subtractTimestamps :: Timestamp -> Timestamp -> Duration+subtractTimestamps a b =+  let aNanos = fromIntegral (timestampSeconds a) * nanosPerSecond + fromIntegral (timestampNanos a)+      bNanos = fromIntegral (timestampSeconds b) * nanosPerSecond + fromIntegral (timestampNanos b)+      diff = aNanos - bNanos+      (s, n) = diff `quotRem` nanosPerSecond+  in defaultDuration+       { durationSeconds = s+       , durationNanos = fromIntegral n+       }+++{- | 'Timestamp' is valid when seconds is in @[0001-01-01T00:00:00Z, 9999-12-31T23:59:59Z]@+and nanos is in @[0, 999999999]@.++These are the bounds from the proto spec.+-}+isValidTimestamp :: Timestamp -> Bool+isValidTimestamp ts =+  timestampSeconds ts >= minTimestampSeconds+    && timestampSeconds ts <= maxTimestampSeconds+    && timestampNanos ts >= 0+    && timestampNanos ts <= 999999999+  where+    minTimestampSeconds = -62135596800 -- 0001-01-01T00:00:00Z+    maxTimestampSeconds = 253402300799 -- 9999-12-31T23:59:59Z+++-- | Compare two 'Timestamp' values. Compares seconds first, then nanos.+compareTimestamp :: Timestamp -> Timestamp -> Ordering+compareTimestamp a b =+  compare (timestampSeconds a) (timestampSeconds b)+    <> compare (timestampNanos a) (timestampNanos b)+++instance Ord Timestamp where+  compare = compareTimestamp
− src/Proto/Google/Protobuf/WellKnownTypes/Any.hs 
@@ -1,174 +0,0 @@-{-# LANGUAGE StrictData #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedRecordDot #-}--- | Auto-generated protobuf types from package @google.protobuf@.------ __THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__------ Any manual changes will be overwritten the next time code--- generation is run.  To modify the types or instances, edit the--- @.proto@ source file and re-run the code generator.-module Proto.Google.Protobuf.WellKnownTypes.Any where--import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Wireform.Builder as B-import Data.Int (Int32, Int64)-import Data.Text (Text)-import qualified Data.Text as T-import Data.Word (Word8, Word32, Word64)-import qualified Data.IntMap.Strict as IntMap-import qualified Data.Map.Strict as Map-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU-import GHC.Generics (Generic)-import Control.DeepSeq (NFData(..))-import Data.Hashable (Hashable(..))-import Proto.Internal.Encode-import Proto.Internal.Decode-import Proto.Internal.GrowList (GrowList, emptyGrowList, snocGrowList, growListToVector)-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson-import qualified Data.Aeson.Key as AesonKey-import qualified Data.Aeson.KeyMap as AesonKM-import Proto.Internal.JSON (jsonObject, (.=:), parseFieldMaybe, bytesFieldToJSON, parseBytesFieldMaybe, bytesMapFieldToJSON, parseBytesMapFieldMaybe, protoBytesToJSON, OneofVariantNullSemantics (..), parseOneofVariants)-import Data.Proxy (Proxy(..))-import Proto.Schema (ProtoMessage(..), SomeFieldDescriptor(..), FieldDescriptor(..), FieldTypeDescriptor(..), ScalarFieldType(..), FieldLabel'(..))-import Proto.Registry (IsMessage)-import Proto.Registry qualified-import qualified Proto.Extension-import Proto.Internal.Wire (Tag(..), WireType(..))-import Proto.Internal.Wire.Encode (putTag, putVarint, putFixed32, putFixed64,-  putFloat, putDouble, putText, putByteString, putLengthDelimited,-  putSVarint32, putSVarint64, putVarintSigned,-  varintSize, tagSize,-  varintSize32, zigZag32, zigZag64)-import Proto.Internal.Encode.Archetype (archVarint, archSVarint32, archSVarint64,-  archFixed32, archFixed64, archFloat, archDouble, archBool,-  archString, archBytes, archSubmessage)---- | Serialized FileDescriptorProto for this .proto file.--- Decode with @Proto.Decode.decodeMessage@.-fileDescriptorProtoBytes :: ByteString-fileDescriptorProtoBytes = "\x0a\x19\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x61\x6e\x79\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x26\x0a\x03\x41\x6e\x79\x12\x10\x0a\x08\x74\x79\x70\x65\x5f\x75\x72\x6c\x18\x01\x20\x01\x28\x09\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x02\x20\x01\x28\x0c\x62\x06\x70\x72\x6f\x74\x6f\x33"---data Any = Any-  { anyTypeUrl :: !Text-  , anyValue :: !ByteString-  , anyUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultAny :: Any-defaultAny = Any-  { anyTypeUrl = ""-  , anyValue = ""-  , anyUnknownFields = []-  }--instance MessageEncode Any where-  buildSized msg =-    (if msg.anyTypeUrl == T.empty then mempty else archString 10 msg.anyTypeUrl)-    <> (if BS.null msg.anyValue then mempty else archBytes 18 msg.anyValue)-    <> encodeUnknownFieldsSized msg.anyUnknownFields--instance MessageDecode Any where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultAny-    where-      stage_0 msg =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_1 (msg { anyTypeUrl = v}))-          (pure (case msg.anyUnknownFields of { [] -> msg; _ -> msg { anyUnknownFields = reverse (msg.anyUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x12 :: Data.Word.Word8)-          decodeFieldBytes-          (\v -> loop (msg { anyValue = v}))-          (pure (case msg.anyUnknownFields of { [] -> msg; _ -> msg { anyUnknownFields = reverse (msg.anyUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.anyUnknownFields of { [] -> msg; _ -> msg { anyUnknownFields = reverse (msg.anyUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { anyTypeUrl = v})-          2 -> do-            v <- decodeFieldBytes-            loop (msg { anyValue = v})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { anyUnknownFields = (uf : msg.anyUnknownFields)}))---- | Field descriptors for 'Any', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-anyFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor Any)-anyFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "type_url"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = anyTypeUrl-        , fdSet = \v m -> m { anyTypeUrl = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "value"-        , fdNumber = 2-        , fdTypeDesc = ScalarType BytesField-        , fdLabel = LabelOptional-        , fdGet = anyValue-        , fdSet = \v m -> m { anyValue = v }-        })-    ]--instance ProtoMessage Any where-  protoMessageName _ = "google.protobuf.Any"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultAny-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = anyFieldDescriptors--instance IsMessage Any--instance Aeson.ToJSON Any where-  toJSON msg = jsonObject-      [ "typeUrl" .=: msg.anyTypeUrl-      , bytesFieldToJSON "value" msg.anyValue-      ]--instance Aeson.FromJSON Any where-  parseJSON = Aeson.withObject "Any" $ \obj -> do-    fld_anyTypeUrl <- parseFieldMaybe obj "typeUrl"-    fld_anyValue <- parseBytesFieldMaybe obj "value"-    pure defaultAny-      { anyTypeUrl = maybe (anyTypeUrl defaultAny) id fld_anyTypeUrl-      , anyValue = maybe (anyValue defaultAny) id fld_anyValue-      }--instance Hashable Any where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (salt) msg.anyTypeUrl) msg.anyValue--instance Proto.Extension.HasExtensions Any where-  messageUnknownFields = anyUnknownFields-  setMessageUnknownFields !ufs msg = msg { anyUnknownFields = ufs }--instance Semigroup Any where-  a <> b = Any-    { anyTypeUrl = if b.anyTypeUrl == "" then a.anyTypeUrl else b.anyTypeUrl-    , anyValue = if b.anyValue == "" then a.anyValue else b.anyValue-    , anyUnknownFields = a.anyUnknownFields <> b.anyUnknownFields-    }--instance Monoid Any where-  mempty = defaultAny
− src/Proto/Google/Protobuf/WellKnownTypes/Any/Util.hs 
@@ -1,74 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--{- | Utility functions for @google.protobuf.Any@ — type-safe packing,-unpacking, and runtime dispatch via 'TypeRegistry'.--}-module Proto.Google.Protobuf.WellKnownTypes.Any.Util (-  -- * Type-safe packing / unpacking-  packAny,-  packAnyWithPrefix,-  unpackAny,-  isMessageType,--  -- * Utilities-  typeUrlPrefix,-  typeUrlOf,-  typeNameFromUrl,-) where--import Data.Proxy (Proxy (..))-import Data.Text (Text)-import Data.Text qualified as T-import Proto (DecodeError, decodeMessage)-import Proto (encodeMessage)-import Proto.Google.Protobuf.WellKnownTypes.Any (Any (..))-import Proto.Registry (IsMessage)-import Proto.Schema (ProtoMessage (..))---typeUrlPrefix :: Text-typeUrlPrefix = "type.googleapis.com/"---typeUrlOf :: forall a. IsMessage a => Proxy a -> Text-typeUrlOf p = typeUrlPrefix <> protoMessageName p---packAny :: forall a. IsMessage a => a -> Any-packAny msg =-  Any-    { anyTypeUrl = typeUrlOf (Proxy :: Proxy a)-    , anyValue = encodeMessage msg-    , anyUnknownFields = []-    }---packAnyWithPrefix :: forall a. IsMessage a => Text -> a -> Any-packAnyWithPrefix prefix msg =-  Any-    { anyTypeUrl = prefix <> protoMessageName (Proxy :: Proxy a)-    , anyValue = encodeMessage msg-    , anyUnknownFields = []-    }---unpackAny :: forall a. IsMessage a => Any -> Maybe (Either DecodeError a)-unpackAny any'-  | isTypeMatch (anyTypeUrl any') (Proxy :: Proxy a) = Just (decodeMessage (anyValue any'))-  | otherwise = Nothing---isMessageType :: forall a. IsMessage a => Proxy a -> Any -> Bool-isMessageType p any' = isTypeMatch (anyTypeUrl any') p---isTypeMatch :: forall a. IsMessage a => Text -> Proxy a -> Bool-isTypeMatch tu p =-  let expected = protoMessageName p-  in typeNameFromUrl tu == expected---typeNameFromUrl :: Text -> Text-typeNameFromUrl tu = case T.breakOnEnd "/" tu of-  ("", name) -> name-  (_, name) -> name
− src/Proto/Google/Protobuf/WellKnownTypes/Duration.hs 
@@ -1,175 +0,0 @@-{-# LANGUAGE StrictData #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedRecordDot #-}--- | Auto-generated protobuf types from package @google.protobuf@.------ __THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__------ Any manual changes will be overwritten the next time code--- generation is run.  To modify the types or instances, edit the--- @.proto@ source file and re-run the code generator.-module Proto.Google.Protobuf.WellKnownTypes.Duration where--import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Wireform.Builder as B-import Data.Int (Int32, Int64)-import Data.Text (Text)-import qualified Data.Text as T-import Data.Word (Word8, Word32, Word64)-import qualified Data.IntMap.Strict as IntMap-import qualified Data.Map.Strict as Map-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU-import GHC.Generics (Generic)-import Control.DeepSeq (NFData(..))-import Data.Hashable (Hashable(..))-import Proto.Internal.Encode-import Proto.Internal.Decode-import Proto.Internal.GrowList (GrowList, emptyGrowList, snocGrowList, growListToVector)-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson-import qualified Data.Aeson.Key as AesonKey-import qualified Data.Aeson.KeyMap as AesonKM-import Proto.Internal.JSON (jsonObject, (.=:), parseFieldMaybe, bytesFieldToJSON, parseBytesFieldMaybe, bytesMapFieldToJSON, parseBytesMapFieldMaybe, protoBytesToJSON, OneofVariantNullSemantics (..), parseOneofVariants)-import Data.Proxy (Proxy(..))-import Proto.Schema (ProtoMessage(..), SomeFieldDescriptor(..), FieldDescriptor(..), FieldTypeDescriptor(..), ScalarFieldType(..), FieldLabel'(..))-import Proto.Registry (IsMessage)-import Proto.Registry qualified-import qualified Proto.Extension-import Proto.Internal.Wire (Tag(..), WireType(..))-import Proto.Internal.Wire.Encode (putTag, putVarint, putFixed32, putFixed64,-  putFloat, putDouble, putText, putByteString, putLengthDelimited,-  putSVarint32, putSVarint64, putVarintSigned,-  varintSize, tagSize,-  varintSize32, zigZag32, zigZag64)-import Proto.Internal.Encode.Archetype (archVarint, archSVarint32, archSVarint64,-  archFixed32, archFixed64, archFloat, archDouble, archBool,-  archString, archBytes, archSubmessage)---- | Serialized FileDescriptorProto for this .proto file.--- Decode with @Proto.Decode.decodeMessage@.-fileDescriptorProtoBytes :: ByteString-fileDescriptorProtoBytes = "\x0a\x1e\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x64\x75\x72\x61\x74\x69\x6f\x6e\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x2a\x0a\x08\x44\x75\x72\x61\x74\x69\x6f\x6e\x12\x0f\x0a\x07\x73\x65\x63\x6f\x6e\x64\x73\x18\x01\x20\x01\x28\x03\x12\x0d\x0a\x05\x6e\x61\x6e\x6f\x73\x18\x02\x20\x01\x28\x05\x62\x06\x70\x72\x6f\x74\x6f\x33"---data Duration = Duration-  { durationSeconds :: {-# UNPACK #-} !Int64-  , durationNanos :: {-# UNPACK #-} !Int32-  , durationUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultDuration :: Duration-defaultDuration = Duration-  { durationSeconds = 0-  , durationNanos = 0-  , durationUnknownFields = []-  }--instance MessageEncode Duration where-  buildSized msg =-    (if msg.durationSeconds == 0 then mempty else archVarint 8 (fromIntegral msg.durationSeconds))-    <> (if msg.durationNanos == 0 then mempty else archVarint 16 (fromIntegral msg.durationNanos))-    <> encodeUnknownFieldsSized msg.durationUnknownFields--instance MessageDecode Duration where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultDuration-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_1 (msg { durationSeconds = v}))-          (pure (case msg.durationUnknownFields of { [] -> msg; _ -> msg { durationUnknownFields = reverse (msg.durationUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x10 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> loop (msg { durationNanos = v}))-          (pure (case msg.durationUnknownFields of { [] -> msg; _ -> msg { durationUnknownFields = reverse (msg.durationUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.durationUnknownFields of { [] -> msg; _ -> msg { durationUnknownFields = reverse (msg.durationUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { durationSeconds = v})-          2 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { durationNanos = v})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { durationUnknownFields = (uf : msg.durationUnknownFields)}))---- | Field descriptors for 'Duration', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-durationFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor Duration)-durationFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "seconds"-        , fdNumber = 1-        , fdTypeDesc = ScalarType Int64Field-        , fdLabel = LabelOptional-        , fdGet = durationSeconds-        , fdSet = \v m -> m { durationSeconds = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "nanos"-        , fdNumber = 2-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = durationNanos-        , fdSet = \v m -> m { durationNanos = v }-        })-    ]--instance ProtoMessage Duration where-  protoMessageName _ = "google.protobuf.Duration"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultDuration-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = durationFieldDescriptors--instance IsMessage Duration--instance Aeson.ToJSON Duration where-  toJSON msg =-    let s = msg.durationSeconds-        n = msg.durationNanos-        nanoStr = if n == 0 then T.pack "" else T.pack "." <> dropTrailingZeros (pad9 (abs (fromIntegral n)))-        dropTrailingZeros t = case T.stripSuffix (T.pack "0") t of { Just t' -> dropTrailingZeros t'; Nothing -> t }-        pad9 x = let sx = T.pack (show x) in T.replicate (9 - T.length sx) (T.pack "0") <> sx-        sign = if s < 0 || n < 0 then T.pack "-" else T.pack ""-    in Aeson.String (sign <> T.pack (show (abs s)) <> nanoStr <> T.pack "s")---instance Aeson.FromJSON Duration where-  parseJSON (Aeson.String _) = pure defaultDuration-  parseJSON _ = fail "Expected duration string like \"3.5s\""---instance Hashable Duration where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (salt) msg.durationSeconds) msg.durationNanos--instance Proto.Extension.HasExtensions Duration where-  messageUnknownFields = durationUnknownFields-  setMessageUnknownFields !ufs msg = msg { durationUnknownFields = ufs }--instance Semigroup Duration where-  a <> b = Duration-    { durationSeconds = if b.durationSeconds == 0 then a.durationSeconds else b.durationSeconds-    , durationNanos = if b.durationNanos == 0 then a.durationNanos else b.durationNanos-    , durationUnknownFields = a.durationUnknownFields <> b.durationUnknownFields-    }--instance Monoid Duration where-  mempty = defaultDuration
− src/Proto/Google/Protobuf/WellKnownTypes/Duration/Util.hs 
@@ -1,173 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--- | Utility functions for @google.protobuf.Duration@.------ Provides conversions to\/from 'NominalDiffTime', construction from--- milliseconds\/microseconds\/nanoseconds, arithmetic, an 'Ord' instance,--- and validation — mirroring utilities found in Go (@durationpb@),--- Java (@com.google.protobuf.util.Durations@), and Rust (@prost-types@).-module Proto.Google.Protobuf.WellKnownTypes.Duration.Util-  ( -- * Conversions-    durationFromNominalDiffTime-  , durationToNominalDiffTime--    -- * Construction-  , durationFromSeconds-  , durationFromMillis-  , durationFromMicros-  , durationFromNanos--    -- * Extraction-  , durationToSeconds-  , durationToMillis-  , durationToMicros-  , durationToNanos--    -- * Arithmetic-  , addDurations-  , negateDuration-  , absDuration--    -- * Validation-  , isValidDuration-  , normalizeDuration--    -- * Comparison-  , compareDuration-  ) where--import Data.Int (Int32, Int64)-import Data.Time.Clock (NominalDiffTime)--import Proto.Google.Protobuf.WellKnownTypes.Duration (Duration(..), defaultDuration)--nanosPerSecond :: Int64-nanosPerSecond = 1000000000---- | Convert a 'NominalDiffTime' to a 'Duration'.------ Fractional seconds are preserved at nanosecond granularity.-durationFromNominalDiffTime :: NominalDiffTime -> Duration-durationFromNominalDiffTime ndt =-  let totalNanos = round (ndt * fromIntegral nanosPerSecond) :: Int64-      (s, n) = totalNanos `quotRem` nanosPerSecond-  in defaultDuration-    { durationSeconds = s-    , durationNanos = fromIntegral n-    }---- | Convert a 'Duration' to a 'NominalDiffTime'.-durationToNominalDiffTime :: Duration -> NominalDiffTime-durationToNominalDiffTime dur =-  let s = fromIntegral (durationSeconds dur) :: NominalDiffTime-      n = fromIntegral (durationNanos dur) / fromIntegral nanosPerSecond :: NominalDiffTime-  in s + n---- | Construct a 'Duration' from whole seconds.-durationFromSeconds :: Int64 -> Duration-durationFromSeconds s = defaultDuration { durationSeconds = s }---- | Construct a 'Duration' from milliseconds.-durationFromMillis :: Int64 -> Duration-durationFromMillis ms =-  let (s, rem') = ms `quotRem` 1000-  in defaultDuration-    { durationSeconds = s-    , durationNanos = fromIntegral (rem' * 1000000)-    }---- | Construct a 'Duration' from microseconds.-durationFromMicros :: Int64 -> Duration-durationFromMicros us =-  let (s, rem') = us `quotRem` 1000000-  in defaultDuration-    { durationSeconds = s-    , durationNanos = fromIntegral (rem' * 1000)-    }---- | Construct a 'Duration' from nanoseconds.-durationFromNanos :: Int64 -> Duration-durationFromNanos ns =-  let (s, n) = ns `quotRem` nanosPerSecond-  in defaultDuration-    { durationSeconds = s-    , durationNanos = fromIntegral n-    }---- | Extract total seconds (truncating nanos).-durationToSeconds :: Duration -> Int64-durationToSeconds = durationSeconds---- | Convert to total milliseconds (truncating sub-millisecond part).-durationToMillis :: Duration -> Int64-durationToMillis dur =-  durationSeconds dur * 1000 + fromIntegral (durationNanos dur) `quot` 1000000---- | Convert to total microseconds (truncating sub-microsecond part).-durationToMicros :: Duration -> Int64-durationToMicros dur =-  durationSeconds dur * 1000000 + fromIntegral (durationNanos dur) `quot` 1000---- | Convert to total nanoseconds.-durationToNanos :: Duration -> Int64-durationToNanos dur =-  durationSeconds dur * nanosPerSecond + fromIntegral (durationNanos dur)---- | Add two 'Duration' values.-addDurations :: Duration -> Duration -> Duration-addDurations a b =-  let totalNanos = durationToNanos a + durationToNanos b-      (s, n) = totalNanos `quotRem` nanosPerSecond-  in defaultDuration-    { durationSeconds = s-    , durationNanos = fromIntegral n-    }---- | Negate a 'Duration'.-negateDuration :: Duration -> Duration-negateDuration dur = defaultDuration-  { durationSeconds = negate (durationSeconds dur)-  , durationNanos = negate (durationNanos dur)-  }---- | Absolute value of a 'Duration'.-absDuration :: Duration -> Duration-absDuration dur-  | durationSeconds dur < 0 || (durationSeconds dur == 0 && durationNanos dur < 0) =-      negateDuration dur-  | otherwise = dur---- | Normalize a Duration so that seconds and nanos have the same sign--- and nanos is in @(-999999999, 999999999)@.------ The proto spec requires that for valid Durations, nanos have the same--- sign as seconds (or be zero) and @|nanos| < 10^9@.-normalizeDuration :: Duration -> Duration-normalizeDuration dur =-  let totalNanos = durationToNanos dur-      (s, n) = totalNanos `quotRem` nanosPerSecond-  in defaultDuration-    { durationSeconds = s-    , durationNanos = fromIntegral n-    }---- | A 'Duration' is valid when:------ * seconds is in @[-315576000000, 315576000000]@ (roughly +/- 10000 years)--- * nanos is in @[-999999999, 999999999]@--- * seconds and nanos have the same sign (or either is zero)-isValidDuration :: Duration -> Bool-isValidDuration dur =-  abs (durationSeconds dur) <= 315576000000-  && abs (fromIntegral (durationNanos dur) :: Int64) <= 999999999-  && signsAgree (durationSeconds dur) (fromIntegral (durationNanos dur))-  where-    signsAgree s n-      | s == 0 || n == 0 = True-      | otherwise = (s > 0) == (n > 0)---- | Compare two 'Duration' values by total nanoseconds.-compareDuration :: Duration -> Duration -> Ordering-compareDuration a b = compare (durationToNanos a) (durationToNanos b)--instance Ord Duration where-  compare = compareDuration
− src/Proto/Google/Protobuf/WellKnownTypes/Empty.hs 
@@ -1,122 +0,0 @@-{-# LANGUAGE StrictData #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedRecordDot #-}--- | Auto-generated protobuf types from package @google.protobuf@.------ __THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__------ Any manual changes will be overwritten the next time code--- generation is run.  To modify the types or instances, edit the--- @.proto@ source file and re-run the code generator.-module Proto.Google.Protobuf.WellKnownTypes.Empty where--import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Wireform.Builder as B-import Data.Int (Int32, Int64)-import Data.Text (Text)-import qualified Data.Text as T-import Data.Word (Word8, Word32, Word64)-import qualified Data.IntMap.Strict as IntMap-import qualified Data.Map.Strict as Map-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU-import GHC.Generics (Generic)-import Control.DeepSeq (NFData(..))-import Data.Hashable (Hashable(..))-import Proto.Internal.Encode-import Proto.Internal.Decode-import Proto.Internal.GrowList (GrowList, emptyGrowList, snocGrowList, growListToVector)-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson-import qualified Data.Aeson.Key as AesonKey-import qualified Data.Aeson.KeyMap as AesonKM-import Proto.Internal.JSON (jsonObject, (.=:), parseFieldMaybe, bytesFieldToJSON, parseBytesFieldMaybe, bytesMapFieldToJSON, parseBytesMapFieldMaybe, protoBytesToJSON, OneofVariantNullSemantics (..), parseOneofVariants)-import Data.Proxy (Proxy(..))-import Proto.Schema (ProtoMessage(..), SomeFieldDescriptor(..), FieldDescriptor(..), FieldTypeDescriptor(..), ScalarFieldType(..), FieldLabel'(..))-import Proto.Registry (IsMessage)-import Proto.Registry qualified-import qualified Proto.Extension-import Proto.Internal.Wire (Tag(..), WireType(..))-import Proto.Internal.Wire.Encode (putTag, putVarint, putFixed32, putFixed64,-  putFloat, putDouble, putText, putByteString, putLengthDelimited,-  putSVarint32, putSVarint64, putVarintSigned,-  varintSize, tagSize,-  varintSize32, zigZag32, zigZag64)-import Proto.Internal.Encode.Archetype (archVarint, archSVarint32, archSVarint64,-  archFixed32, archFixed64, archFloat, archDouble, archBool,-  archString, archBytes, archSubmessage)---- | Serialized FileDescriptorProto for this .proto file.--- Decode with @Proto.Decode.decodeMessage@.-fileDescriptorProtoBytes :: ByteString-fileDescriptorProtoBytes = "\x0a\x1b\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x65\x6d\x70\x74\x79\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x07\x0a\x05\x45\x6d\x70\x74\x79\x62\x06\x70\x72\x6f\x74\x6f\x33"---data Empty = Empty-  { emptyUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultEmpty :: Empty-defaultEmpty = Empty-  { emptyUnknownFields = []-  }--instance MessageEncode Empty where-  buildSized msg =-    encodeUnknownFieldsSized msg.emptyUnknownFields--instance MessageDecode Empty where-  {-# INLINE messageDecoder #-}-  messageDecoder = loop defaultEmpty-    where-      loop msg = withTagM-        (pure (case msg.emptyUnknownFields of { [] -> msg; _ -> msg { emptyUnknownFields = reverse (msg.emptyUnknownFields) } }))-        (\fn wt -> case fn of-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { emptyUnknownFields = (uf : msg.emptyUnknownFields)}))---- | Field descriptors for 'Empty', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-emptyFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor Empty)-emptyFieldDescriptors =-  IntMap.empty--instance ProtoMessage Empty where-  protoMessageName _ = "google.protobuf.Empty"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultEmpty-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = emptyFieldDescriptors--instance IsMessage Empty--instance Aeson.ToJSON Empty where-  toJSON msg = jsonObject-      []--instance Aeson.FromJSON Empty where-  parseJSON _ = pure defaultEmpty--instance Hashable Empty where-  hashWithSalt salt _ = salt--instance Proto.Extension.HasExtensions Empty where-  messageUnknownFields = emptyUnknownFields-  setMessageUnknownFields !ufs msg = msg { emptyUnknownFields = ufs }--instance Semigroup Empty where-  a <> b = Empty-    { emptyUnknownFields = a.emptyUnknownFields <> b.emptyUnknownFields-    }--instance Monoid Empty where-  mempty = defaultEmpty
− src/Proto/Google/Protobuf/WellKnownTypes/FieldMask.hs 
@@ -1,151 +0,0 @@-{-# LANGUAGE StrictData #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedRecordDot #-}--- | Auto-generated protobuf types from package @google.protobuf@.------ __THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__------ Any manual changes will be overwritten the next time code--- generation is run.  To modify the types or instances, edit the--- @.proto@ source file and re-run the code generator.-module Proto.Google.Protobuf.WellKnownTypes.FieldMask where--import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Wireform.Builder as B-import Data.Int (Int32, Int64)-import Data.Text (Text)-import qualified Data.Text as T-import Data.Word (Word8, Word32, Word64)-import qualified Data.IntMap.Strict as IntMap-import qualified Data.Map.Strict as Map-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU-import GHC.Generics (Generic)-import Control.DeepSeq (NFData(..))-import Data.Hashable (Hashable(..))-import Proto.Internal.Encode-import Proto.Internal.Decode-import Proto.Internal.GrowList (GrowList, emptyGrowList, snocGrowList, growListToVector)-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson-import qualified Data.Aeson.Key as AesonKey-import qualified Data.Aeson.KeyMap as AesonKM-import Proto.Internal.JSON (jsonObject, (.=:), parseFieldMaybe, bytesFieldToJSON, parseBytesFieldMaybe, bytesMapFieldToJSON, parseBytesMapFieldMaybe, protoBytesToJSON, OneofVariantNullSemantics (..), parseOneofVariants)-import Data.Proxy (Proxy(..))-import Proto.Schema (ProtoMessage(..), SomeFieldDescriptor(..), FieldDescriptor(..), FieldTypeDescriptor(..), ScalarFieldType(..), FieldLabel'(..))-import Proto.Registry (IsMessage)-import Proto.Registry qualified-import qualified Proto.Extension-import Proto.Internal.Wire (Tag(..), WireType(..))-import Proto.Internal.Wire.Encode (putTag, putVarint, putFixed32, putFixed64,-  putFloat, putDouble, putText, putByteString, putLengthDelimited,-  putSVarint32, putSVarint64, putVarintSigned,-  varintSize, tagSize,-  varintSize32, zigZag32, zigZag64)-import Proto.Internal.Encode.Archetype (archVarint, archSVarint32, archSVarint64,-  archFixed32, archFixed64, archFloat, archDouble, archBool,-  archString, archBytes, archSubmessage)---- | Serialized FileDescriptorProto for this .proto file.--- Decode with @Proto.Decode.decodeMessage@.-fileDescriptorProtoBytes :: ByteString-fileDescriptorProtoBytes = "\x0a\x20\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x66\x69\x65\x6c\x64\x5f\x6d\x61\x73\x6b\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x1a\x0a\x09\x46\x69\x65\x6c\x64\x4d\x61\x73\x6b\x12\x0d\x0a\x05\x70\x61\x74\x68\x73\x18\x01\x20\x03\x28\x09\x62\x06\x70\x72\x6f\x74\x6f\x33"---data FieldMask = FieldMask-  { fieldMaskPaths :: !(V.Vector Text)-  , fieldMaskUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultFieldMask :: FieldMask-defaultFieldMask = FieldMask-  { fieldMaskPaths = V.empty-  , fieldMaskUnknownFields = []-  }--instance MessageEncode FieldMask where-  buildSized msg =-    V.foldl' (\acc v -> acc <> archString 10 v) mempty msg.fieldMaskPaths-    <> encodeUnknownFieldsSized msg.fieldMaskUnknownFields--instance MessageDecode FieldMask where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultFieldMask emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> stage_0 msg (snocGrowList gl_0 v))-          (pure (case msg.fieldMaskUnknownFields of { [] -> msg { fieldMaskPaths = growListToVector gl_0 }; _ -> msg { fieldMaskPaths = growListToVector gl_0, fieldMaskUnknownFields = reverse (msg.fieldMaskUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.fieldMaskUnknownFields of { [] -> msg { fieldMaskPaths = growListToVector gl_0 }; _ -> msg { fieldMaskPaths = growListToVector gl_0, fieldMaskUnknownFields = reverse (msg.fieldMaskUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop msg (snocGrowList gl_0 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { fieldMaskUnknownFields = (uf : msg.fieldMaskUnknownFields)}) gl_0)---- | Field descriptors for 'FieldMask', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-fieldMaskFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor FieldMask)-fieldMaskFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "paths"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelRepeated-        , fdGet = fieldMaskPaths-        , fdSet = \v m -> m { fieldMaskPaths = v }-        })-    ]--instance ProtoMessage FieldMask where-  protoMessageName _ = "google.protobuf.FieldMask"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultFieldMask-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = fieldMaskFieldDescriptors--instance IsMessage FieldMask--instance Aeson.ToJSON FieldMask where-  toJSON msg = jsonObject-      [ "paths" .=: msg.fieldMaskPaths--      ]--instance Aeson.FromJSON FieldMask where-  parseJSON = Aeson.withObject "FieldMask" $ \obj -> do-    fld_fieldMaskPaths <- parseFieldMaybe obj "paths"-    pure defaultFieldMask-      { fieldMaskPaths = maybe (fieldMaskPaths defaultFieldMask) id fld_fieldMaskPaths-      }--instance Hashable FieldMask where-  hashWithSalt salt msg = V.foldl' hashWithSalt (salt) msg.fieldMaskPaths--instance Proto.Extension.HasExtensions FieldMask where-  messageUnknownFields = fieldMaskUnknownFields-  setMessageUnknownFields !ufs msg = msg { fieldMaskUnknownFields = ufs }--instance Semigroup FieldMask where-  a <> b = FieldMask-    { fieldMaskPaths = a.fieldMaskPaths <> b.fieldMaskPaths-    , fieldMaskUnknownFields = a.fieldMaskUnknownFields <> b.fieldMaskUnknownFields-    }--instance Monoid FieldMask where-  mempty = defaultFieldMask
− src/Proto/Google/Protobuf/WellKnownTypes/FieldMask/Util.hs 
@@ -1,179 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--- | Utility functions for @google.protobuf.FieldMask@.------ Provides set operations (union, intersection), path normalization,--- containment checks, construction helpers, validation against a message--- schema, and an @allFieldMask@ constructor — mirroring utilities found in--- Go (@fieldmaskpb@), Java (@com.google.protobuf.util.FieldMaskUtil@),--- and C++ (@google::protobuf::util::FieldMaskUtil@).-module Proto.Google.Protobuf.WellKnownTypes.FieldMask.Util-  ( -- * Construction-    fromPaths-  , toPaths-  , allFieldMask--    -- * Set operations-  , union-  , intersection-  , subtractMask--    -- * Normalization-  , normalize--    -- * Querying-  , contains-  , isEmpty--    -- * Validation-  , isValid--    -- * Path utilities-  , canonicalForm-  , toCamelCase-  , toSnakeCase-  ) where--import Data.Char (isUpper, toLower, toUpper)-import Data.Proxy (Proxy)-import Data.Set (Set)-import qualified Data.Set as Set-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Vector as V--import Proto.Google.Protobuf.WellKnownTypes.FieldMask (FieldMask(..), defaultFieldMask)-import Proto.Schema (ProtoMessage(..), SomeFieldDescriptor(..), FieldDescriptor(..))-import qualified Data.IntMap.Strict as IntMap---- | Construct a 'FieldMask' from a list of paths.-fromPaths :: [Text] -> FieldMask-fromPaths ps = defaultFieldMask { fieldMaskPaths = V.fromList ps }---- | Extract the list of paths from a 'FieldMask'.-toPaths :: FieldMask -> [Text]-toPaths = V.toList . fieldMaskPaths---- | Construct a 'FieldMask' covering all top-level fields of a message.-allFieldMask :: forall a. ProtoMessage a => Proxy a -> FieldMask-allFieldMask p =-  let descs = protoFieldDescriptors p-      names = fmap (\(SomeField fd) -> fdName fd) (IntMap.elems descs)-  in defaultFieldMask { fieldMaskPaths = V.fromList names }---- | Union of two 'FieldMask' values (all paths from both).------ The result is normalized: sorted, deduplicated, and sub-paths are--- removed when a parent path is present.-union :: FieldMask -> FieldMask -> FieldMask-union a b = normalize $ defaultFieldMask-  { fieldMaskPaths = fieldMaskPaths a V.++ fieldMaskPaths b }---- | Intersection of two 'FieldMask' values.------ A path is included if it appears in both masks, or if one mask contains--- a parent path that covers the other's more specific path.-intersection :: FieldMask -> FieldMask -> FieldMask-intersection a b =-  let setPaths fm = Set.fromList (V.toList (fieldMaskPaths fm))-      sa = setPaths a-      sb = setPaths b-      result = Set.filter (\p -> containedIn p sb) sa-               `Set.union`-               Set.filter (\p -> containedIn p sa) sb-  in defaultFieldMask { fieldMaskPaths = V.fromList (Set.toAscList result) }-  where-    containedIn path pathSet =-      Set.member path pathSet || hasAncestor path pathSet--    hasAncestor path pathSet =-      any (\candidate -> isProperPrefix candidate path) (Set.toList pathSet)---- | Subtract one 'FieldMask' from another. The result contains paths from--- the first mask that are not covered by the second.-subtractMask :: FieldMask -> FieldMask -> FieldMask-subtractMask a b =-  let sb = Set.fromList (V.toList (fieldMaskPaths b))-      filtered = V.filter (\p -> not (coveredBy p sb)) (fieldMaskPaths a)-  in defaultFieldMask { fieldMaskPaths = filtered }-  where-    coveredBy path pathSet =-      Set.member path pathSet-      || any (\candidate -> isProperPrefix candidate path) (Set.toList pathSet)---- | Normalize a 'FieldMask': sort paths, remove duplicates, and remove--- paths that are sub-paths of another entry.------ For example, @[\"a.b\", \"a\", \"c\"]@ normalizes to @[\"a\", \"c\"]@.-normalize :: FieldMask -> FieldMask-normalize fm =-  let sorted = Set.toAscList (Set.fromList (V.toList (fieldMaskPaths fm)))-      pruned = removeRedundant sorted-  in defaultFieldMask { fieldMaskPaths = V.fromList pruned }--removeRedundant :: [Text] -> [Text]-removeRedundant = go Set.empty-  where-    go _ [] = []-    go ancestors (p : ps)-      | any (\a -> isProperPrefix a p) (Set.toList ancestors) = go ancestors ps-      | otherwise = p : go (Set.insert p ancestors) ps--isProperPrefix :: Text -> Text -> Bool-isProperPrefix prefix path =-  T.isPrefixOf prefix path-  && T.length prefix < T.length path-  && T.index path (T.length prefix) == '.'---- | Check whether a 'FieldMask' contains a specific path, accounting for--- parent-path coverage.------ @contains (fromPaths [\"a\"]) \"a.b\"@ is 'True' because @\"a\"@ covers--- all sub-paths.-contains :: FieldMask -> Text -> Bool-contains fm path =-  V.any (\p -> p == path || isProperPrefix p path) (fieldMaskPaths fm)---- | Is the 'FieldMask' empty (no paths)?-isEmpty :: FieldMask -> Bool-isEmpty = V.null . fieldMaskPaths---- | Validate a 'FieldMask' against a message's schema. Each top-level--- path segment must correspond to a known field name.-isValid :: forall a. ProtoMessage a => Proxy a -> FieldMask -> Bool-isValid p fm =-  let descs = protoFieldDescriptors p-      validNames = Set.fromList (fmap (\(SomeField fd) -> fdName fd) (IntMap.elems descs))-  in V.all (\path -> topLevel path `Set.member` validNames) (fieldMaskPaths fm)-  where-    topLevel path = case T.breakOn "." path of-      (first, _) -> first---- | Produce a canonical text form: sorted, deduplicated, sub-paths removed.-canonicalForm :: FieldMask -> Text-canonicalForm = T.intercalate "," . toPaths . normalize---- | Convert a snake_case field path to lowerCamelCase (for JSON mapping).------ @\"foo_bar.baz_qux\"@ becomes @\"fooBar.bazQux\"@.-toCamelCase :: Text -> Text-toCamelCase = T.intercalate "." . fmap segmentToCamel . T.splitOn "."-  where-    segmentToCamel seg =-      let parts = T.splitOn "_" seg-      in case parts of-        [] -> ""-        (first : rest) -> first <> T.concat (fmap capitalize rest)-    capitalize t-      | T.null t = t-      | otherwise = T.cons (toUpper (T.head t)) (T.tail t)---- | Convert a lowerCamelCase field path to snake_case (from JSON mapping).------ @\"fooBar.bazQux\"@ becomes @\"foo_bar.baz_qux\"@.-toSnakeCase :: Text -> Text-toSnakeCase = T.intercalate "." . fmap segmentToSnake . T.splitOn "."-  where-    segmentToSnake = T.concatMap $ \c ->-      if isUpper c-        then T.pack ['_', toLower c]-        else T.singleton c
− src/Proto/Google/Protobuf/WellKnownTypes/SourceContext.hs 
@@ -1,151 +0,0 @@-{-# LANGUAGE StrictData #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedRecordDot #-}--- | Auto-generated protobuf types from package @google.protobuf@.------ __THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__------ Any manual changes will be overwritten the next time code--- generation is run.  To modify the types or instances, edit the--- @.proto@ source file and re-run the code generator.-module Proto.Google.Protobuf.WellKnownTypes.SourceContext where--import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Wireform.Builder as B-import Data.Int (Int32, Int64)-import Data.Text (Text)-import qualified Data.Text as T-import Data.Word (Word8, Word32, Word64)-import qualified Data.IntMap.Strict as IntMap-import qualified Data.Map.Strict as Map-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU-import GHC.Generics (Generic)-import Control.DeepSeq (NFData(..))-import Data.Hashable (Hashable(..))-import Proto.Internal.Encode-import Proto.Internal.Decode-import Proto.Internal.GrowList (GrowList, emptyGrowList, snocGrowList, growListToVector)-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson-import qualified Data.Aeson.Key as AesonKey-import qualified Data.Aeson.KeyMap as AesonKM-import Proto.Internal.JSON (jsonObject, (.=:), parseFieldMaybe, bytesFieldToJSON, parseBytesFieldMaybe, bytesMapFieldToJSON, parseBytesMapFieldMaybe, protoBytesToJSON, OneofVariantNullSemantics (..), parseOneofVariants)-import Data.Proxy (Proxy(..))-import Proto.Schema (ProtoMessage(..), SomeFieldDescriptor(..), FieldDescriptor(..), FieldTypeDescriptor(..), ScalarFieldType(..), FieldLabel'(..))-import Proto.Registry (IsMessage)-import Proto.Registry qualified-import qualified Proto.Extension-import Proto.Internal.Wire (Tag(..), WireType(..))-import Proto.Internal.Wire.Encode (putTag, putVarint, putFixed32, putFixed64,-  putFloat, putDouble, putText, putByteString, putLengthDelimited,-  putSVarint32, putSVarint64, putVarintSigned,-  varintSize, tagSize,-  varintSize32, zigZag32, zigZag64)-import Proto.Internal.Encode.Archetype (archVarint, archSVarint32, archSVarint64,-  archFixed32, archFixed64, archFloat, archDouble, archBool,-  archString, archBytes, archSubmessage)---- | Serialized FileDescriptorProto for this .proto file.--- Decode with @Proto.Decode.decodeMessage@.-fileDescriptorProtoBytes :: ByteString-fileDescriptorProtoBytes = "\x0a\x24\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x73\x6f\x75\x72\x63\x65\x5f\x63\x6f\x6e\x74\x65\x78\x74\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x22\x0a\x0d\x53\x6f\x75\x72\x63\x65\x43\x6f\x6e\x74\x65\x78\x74\x12\x11\x0a\x09\x66\x69\x6c\x65\x5f\x6e\x61\x6d\x65\x18\x01\x20\x01\x28\x09\x62\x06\x70\x72\x6f\x74\x6f\x33"---data SourceContext = SourceContext-  { sourceContextFileName :: !Text-  , sourceContextUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultSourceContext :: SourceContext-defaultSourceContext = SourceContext-  { sourceContextFileName = ""-  , sourceContextUnknownFields = []-  }--instance MessageEncode SourceContext where-  buildSized msg =-    (if msg.sourceContextFileName == T.empty then mempty else archString 10 msg.sourceContextFileName)-    <> encodeUnknownFieldsSized msg.sourceContextUnknownFields--instance MessageDecode SourceContext where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultSourceContext-    where-      stage_0 msg =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> loop (msg { sourceContextFileName = v}))-          (pure (case msg.sourceContextUnknownFields of { [] -> msg; _ -> msg { sourceContextUnknownFields = reverse (msg.sourceContextUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.sourceContextUnknownFields of { [] -> msg; _ -> msg { sourceContextUnknownFields = reverse (msg.sourceContextUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { sourceContextFileName = v})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { sourceContextUnknownFields = (uf : msg.sourceContextUnknownFields)}))---- | Field descriptors for 'SourceContext', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-sourceContextFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor SourceContext)-sourceContextFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "file_name"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = sourceContextFileName-        , fdSet = \v m -> m { sourceContextFileName = v }-        })-    ]--instance ProtoMessage SourceContext where-  protoMessageName _ = "google.protobuf.SourceContext"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultSourceContext-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = sourceContextFieldDescriptors--instance IsMessage SourceContext--instance Aeson.ToJSON SourceContext where-  toJSON msg = jsonObject-      [ "fileName" .=: msg.sourceContextFileName--      ]--instance Aeson.FromJSON SourceContext where-  parseJSON = Aeson.withObject "SourceContext" $ \obj -> do-    fld_sourceContextFileName <- parseFieldMaybe obj "fileName"-    pure defaultSourceContext-      { sourceContextFileName = maybe (sourceContextFileName defaultSourceContext) id fld_sourceContextFileName-      }--instance Hashable SourceContext where-  hashWithSalt salt msg = hashWithSalt (salt) msg.sourceContextFileName--instance Proto.Extension.HasExtensions SourceContext where-  messageUnknownFields = sourceContextUnknownFields-  setMessageUnknownFields !ufs msg = msg { sourceContextUnknownFields = ufs }--instance Semigroup SourceContext where-  a <> b = SourceContext-    { sourceContextFileName = if b.sourceContextFileName == "" then a.sourceContextFileName else b.sourceContextFileName-    , sourceContextUnknownFields = a.sourceContextUnknownFields <> b.sourceContextUnknownFields-    }--instance Monoid SourceContext where-  mempty = defaultSourceContext
− src/Proto/Google/Protobuf/WellKnownTypes/Struct.hs 
@@ -1,464 +0,0 @@-{-# LANGUAGE StrictData #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedRecordDot #-}--- | Auto-generated protobuf types from package @google.protobuf@.------ __THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__------ Any manual changes will be overwritten the next time code--- generation is run.  To modify the types or instances, edit the--- @.proto@ source file and re-run the code generator.-module Proto.Google.Protobuf.WellKnownTypes.Struct where--import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Wireform.Builder as B-import Data.Int (Int32, Int64)-import Data.Text (Text)-import qualified Data.Text as T-import Data.Word (Word8, Word32, Word64)-import qualified Data.IntMap.Strict as IntMap-import qualified Data.Map.Strict as Map-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU-import GHC.Generics (Generic)-import Control.DeepSeq (NFData(..))-import Data.Hashable (Hashable(..))-import Proto.Internal.Encode-import Proto.Internal.Decode-import Proto.Internal.GrowList (GrowList, emptyGrowList, snocGrowList, growListToVector)-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson-import qualified Data.Aeson.Key as AesonKey-import qualified Data.Aeson.KeyMap as AesonKM-import Proto.Internal.JSON (jsonObject, (.=:), parseFieldMaybe, bytesFieldToJSON, parseBytesFieldMaybe, bytesMapFieldToJSON, parseBytesMapFieldMaybe, protoBytesToJSON, OneofVariantNullSemantics (..), parseOneofVariants)-import Data.Proxy (Proxy(..))-import Proto.Schema (ProtoMessage(..), SomeFieldDescriptor(..), FieldDescriptor(..), FieldTypeDescriptor(..), ScalarFieldType(..), FieldLabel'(..))-import Proto.Registry (IsMessage)-import Proto.Registry qualified-import qualified Proto.Extension-import Proto.Internal.Wire (Tag(..), WireType(..))-import Proto.Internal.Wire.Encode (putTag, putVarint, putFixed32, putFixed64,-  putFloat, putDouble, putText, putByteString, putLengthDelimited,-  putSVarint32, putSVarint64, putVarintSigned,-  varintSize, tagSize,-  varintSize32, zigZag32, zigZag64)-import Proto.Internal.Encode.Archetype (archVarint, archSVarint32, archSVarint64,-  archFixed32, archFixed64, archFloat, archDouble, archBool,-  archString, archBytes, archSubmessage)---- | Serialized FileDescriptorProto for this .proto file.--- Decode with @Proto.Decode.decodeMessage@.-fileDescriptorProtoBytes :: ByteString-fileDescriptorProtoBytes = "\x0a\x1c\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x73\x74\x72\x75\x63\x74\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x5b\x0a\x06\x53\x74\x72\x75\x63\x74\x12\x1b\x0a\x06\x66\x69\x65\x6c\x64\x73\x18\x01\x20\x03\x28\x0b\x32\x0b\x66\x69\x65\x6c\x64\x73\x45\x6e\x74\x72\x79\x1a\x34\x0a\x0b\x66\x69\x65\x6c\x64\x73\x45\x6e\x74\x72\x79\x12\x0b\x0a\x03\x6b\x65\x79\x18\x01\x20\x01\x28\x09\x12\x14\x0a\x05\x76\x61\x6c\x75\x65\x18\x02\x20\x01\x28\x0b\x32\x05\x56\x61\x6c\x75\x65\x3a\x02\x38\x01\x22\xab\x01\x0a\x05\x56\x61\x6c\x75\x65\x12\x1d\x0a\x0a\x6e\x75\x6c\x6c\x5f\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x0b\x32\x09\x4e\x75\x6c\x6c\x56\x61\x6c\x75\x65\x12\x14\x0a\x0c\x6e\x75\x6d\x62\x65\x72\x5f\x76\x61\x6c\x75\x65\x18\x02\x20\x01\x28\x01\x12\x14\x0a\x0c\x73\x74\x72\x69\x6e\x67\x5f\x76\x61\x6c\x75\x65\x18\x03\x20\x01\x28\x09\x12\x12\x0a\x0a\x62\x6f\x6f\x6c\x5f\x76\x61\x6c\x75\x65\x18\x04\x20\x01\x28\x08\x12\x1c\x0a\x0c\x73\x74\x72\x75\x63\x74\x5f\x76\x61\x6c\x75\x65\x18\x05\x20\x01\x28\x0b\x32\x06\x53\x74\x72\x75\x63\x74\x12\x1d\x0a\x0a\x6c\x69\x73\x74\x5f\x76\x61\x6c\x75\x65\x18\x06\x20\x01\x28\x0b\x32\x09\x4c\x69\x73\x74\x56\x61\x6c\x75\x65\x42\x06\x0a\x04\x6b\x69\x6e\x64\x22\x22\x0a\x09\x4c\x69\x73\x74\x56\x61\x6c\x75\x65\x12\x15\x0a\x06\x76\x61\x6c\x75\x65\x73\x18\x01\x20\x03\x28\x0b\x32\x05\x56\x61\x6c\x75\x65\x2a\x1b\x0a\x09\x4e\x75\x6c\x6c\x56\x61\x6c\x75\x65\x12\x0e\x0a\x0a\x4e\x55\x4c\x4c\x5f\x56\x41\x4c\x55\x45\x10\x00\x62\x06\x70\x72\x6f\x74\x6f\x33"---data Struct = Struct-  { structFields :: !(Map.Map Text Value)-  , structUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultStruct :: Struct-defaultStruct = Struct-  { structFields = Map.empty-  , structUnknownFields = []-  }--instance MessageEncode Struct where-  buildSized msg =-    Map.foldlWithKey' (\acc k v -> acc <> mapField 1 (fieldString 1 k) ((fieldMessage 2 . buildSized) v)) mempty msg.structFields-    <> encodeUnknownFieldsSized msg.structUnknownFields--instance MessageDecode Struct where-  {-# INLINE messageDecoder #-}-  messageDecoder = loop defaultStruct-    where-      loop msg = withTagM-        (pure (case msg.structUnknownFields of { [] -> msg; _ -> msg { structUnknownFields = reverse (msg.structUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            bs' <- getLengthDelimited-            let decodeEntry = runDecoder (decodeMapEntry decodeFieldString decodeFieldMessage "" defaultValue) bs'-            case decodeEntry of-              Left _ -> loop msg-              Right (mk', mv') -> loop (msg { structFields = (Map.union msg.structFields (Map.singleton mk' mv'))})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { structUnknownFields = (uf : msg.structUnknownFields)}))---- | Field descriptors for 'Struct', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-structFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor Struct)-structFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "fields"-        , fdNumber = 1-        , fdTypeDesc = ScalarType BytesField-        , fdLabel = LabelRepeated-        , fdGet = structFields-        , fdSet = \v m -> m { structFields = v }-        })-    ]--instance ProtoMessage Struct where-  protoMessageName _ = "google.protobuf.Struct"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultStruct-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = structFieldDescriptors--instance IsMessage Struct--instance Aeson.ToJSON Struct where-  toJSON msg = jsonObject-      [ "fields" .=: msg.structFields--      ]--instance Aeson.FromJSON Struct where-  parseJSON = Aeson.withObject "Struct" $ \obj -> do-    fld_structFields <- parseFieldMaybe obj "fields"-    pure defaultStruct-      { structFields = maybe (structFields defaultStruct) id fld_structFields-      }--instance Hashable Struct where-  hashWithSalt salt msg = Map.foldlWithKey' (\s k v -> s `hashWithSalt` k `hashWithSalt` v) (salt) msg.structFields--instance Proto.Extension.HasExtensions Struct where-  messageUnknownFields = structUnknownFields-  setMessageUnknownFields !ufs msg = msg { structUnknownFields = ufs }--instance Semigroup Struct where-  a <> b = Struct-    { structFields = a.structFields <> b.structFields-    , structUnknownFields = a.structUnknownFields <> b.structUnknownFields-    }--instance Monoid Struct where-  mempty = defaultStruct--data Value = Value-  { valueKind :: !(Maybe Value'Kind)-  , valueUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData-data Value'Kind-  = Value'Kind'NullValue !NullValue-  | Value'Kind'NumberValue {-# UNPACK #-} !Double-  | Value'Kind'StringValue !Text-  | Value'Kind'BoolValue {-# UNPACK #-} !Bool-  | Value'Kind'StructValue !Struct-  | Value'Kind'ListValue !ListValue-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData-instance Aeson.ToJSON Value'Kind where-  toJSON v0 = jsonObject (case v0 of-    Value'Kind'NullValue v -> ["nullValue" .=: v]-    Value'Kind'NumberValue v -> ["numberValue" .=: v]-    Value'Kind'StringValue v -> ["stringValue" .=: v]-    Value'Kind'BoolValue v -> ["boolValue" .=: v]-    Value'Kind'StructValue v -> ["structValue" .=: v]-    Value'Kind'ListValue v -> ["listValue" .=: v]-    )-instance Aeson.FromJSON Value'Kind where-  parseJSON = Aeson.withObject "Value'Kind" $ \obj -> do-    mr <- parseOneofVariants obj-      [ ("nullValue", OneofVariantNullIsUnset, (\v -> Value'Kind'NullValue <$> Aeson.parseJSON v))-      , ("numberValue", OneofVariantNullIsUnset, (\v -> Value'Kind'NumberValue <$> Aeson.parseJSON v))-      , ("stringValue", OneofVariantNullIsUnset, (\v -> Value'Kind'StringValue <$> Aeson.parseJSON v))-      , ("boolValue", OneofVariantNullIsUnset, (\v -> Value'Kind'BoolValue <$> Aeson.parseJSON v))-      , ("structValue", OneofVariantNullIsUnset, (\v -> Value'Kind'StructValue <$> Aeson.parseJSON v))-      , ("listValue", OneofVariantNullIsUnset, (\v -> Value'Kind'ListValue <$> Aeson.parseJSON v))-      ]-    case mr of-      Just v -> pure v-      Nothing -> fail "Expected one of: nullValue, numberValue, stringValue, boolValue, structValue, listValue"-instance Hashable Value'Kind where-  hashWithSalt salt (Value'Kind'NullValue v) = salt `hashWithSalt` (0 :: Int) `hashWithSalt` v-  hashWithSalt salt (Value'Kind'NumberValue v) = salt `hashWithSalt` (1 :: Int) `hashWithSalt` v-  hashWithSalt salt (Value'Kind'StringValue v) = salt `hashWithSalt` (2 :: Int) `hashWithSalt` v-  hashWithSalt salt (Value'Kind'BoolValue v) = salt `hashWithSalt` (3 :: Int) `hashWithSalt` v-  hashWithSalt salt (Value'Kind'StructValue v) = salt `hashWithSalt` (4 :: Int) `hashWithSalt` v-  hashWithSalt salt (Value'Kind'ListValue v) = salt `hashWithSalt` (5 :: Int) `hashWithSalt` v--defaultValue :: Value-defaultValue = Value-  { valueKind = Nothing-  , valueUnknownFields = []-  }--instance MessageEncode Value where-  buildSized msg =-    (case msg.valueKind of-      Nothing -> mempty-      Just (Value'Kind'NullValue v) -> archSubmessage 10 (buildSized v)-      Just (Value'Kind'NumberValue v) -> archDouble 17 v-      Just (Value'Kind'StringValue v) -> archString 26 v-      Just (Value'Kind'BoolValue v) -> archBool 32 v-      Just (Value'Kind'StructValue v) -> archSubmessage 42 (buildSized v)-      Just (Value'Kind'ListValue v) -> archSubmessage 50 (buildSized v))-    <> encodeUnknownFieldsSized msg.valueUnknownFields--instance MessageDecode Value where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultValue-    where-      stage_0 msg =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> loop (msg { valueKind = (Just (Value'Kind'NullValue v))}))-          (pure (case msg.valueUnknownFields of { [] -> msg; _ -> msg { valueUnknownFields = reverse (msg.valueUnknownFields) } }))-          (inOrderStage1-            (0x11 :: Data.Word.Word8)-            decodeFieldDouble-            (\v -> loop (msg { valueKind = (Just (Value'Kind'NumberValue v))}))-            (pure (case msg.valueUnknownFields of { [] -> msg; _ -> msg { valueUnknownFields = reverse (msg.valueUnknownFields) } }))-            (inOrderStage1-              (0x1a :: Data.Word.Word8)-              decodeFieldString-              (\v -> loop (msg { valueKind = (Just (Value'Kind'StringValue v))}))-              (pure (case msg.valueUnknownFields of { [] -> msg; _ -> msg { valueUnknownFields = reverse (msg.valueUnknownFields) } }))-              (inOrderStage1-                (0x20 :: Data.Word.Word8)-                decodeFieldBool-                (\v -> loop (msg { valueKind = (Just (Value'Kind'BoolValue v))}))-                (pure (case msg.valueUnknownFields of { [] -> msg; _ -> msg { valueUnknownFields = reverse (msg.valueUnknownFields) } }))-                (inOrderStage1-                  (0x2a :: Data.Word.Word8)-                  decodeFieldMessage-                  (\v -> loop (msg { valueKind = (Just (Value'Kind'StructValue v))}))-                  (pure (case msg.valueUnknownFields of { [] -> msg; _ -> msg { valueUnknownFields = reverse (msg.valueUnknownFields) } }))-                  (inOrderStage1-                    (0x32 :: Data.Word.Word8)-                    decodeFieldMessage-                    (\v -> loop (msg { valueKind = (Just (Value'Kind'ListValue v))}))-                    (pure (case msg.valueUnknownFields of { [] -> msg; _ -> msg { valueUnknownFields = reverse (msg.valueUnknownFields) } }))-                    ((loop msg)))))))-      loop msg = withTagM-        (pure (case msg.valueUnknownFields of { [] -> msg; _ -> msg { valueUnknownFields = reverse (msg.valueUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldMessage-            loop (msg { valueKind = (Just (Value'Kind'NullValue v))})-          2 -> do-            v <- decodeFieldDouble-            loop (msg { valueKind = (Just (Value'Kind'NumberValue v))})-          3 -> do-            v <- decodeFieldString-            loop (msg { valueKind = (Just (Value'Kind'StringValue v))})-          4 -> do-            v <- decodeFieldBool-            loop (msg { valueKind = (Just (Value'Kind'BoolValue v))})-          5 -> do-            v <- decodeFieldMessage-            loop (msg { valueKind = (Just (Value'Kind'StructValue v))})-          6 -> do-            v <- decodeFieldMessage-            loop (msg { valueKind = (Just (Value'Kind'ListValue v))})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { valueUnknownFields = (uf : msg.valueUnknownFields)}))---- | Field descriptors for 'Value', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-valueFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor Value)-valueFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "kind"-        , fdNumber = 1-        , fdTypeDesc = MessageType "kind"-        , fdLabel = LabelOptional-        , fdGet = valueKind-        , fdSet = \v m -> m { valueKind = v }-        })-    ]--instance ProtoMessage Value where-  protoMessageName _ = "google.protobuf.Value"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultValue-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = valueFieldDescriptors--instance IsMessage Value--instance Aeson.ToJSON Value where-  toJSON msg = jsonObject $ mconcat-      [ (case msg.valueKind of-          Nothing -> []-          Just (Value'Kind'NullValue v) -> ["nullValue" .=: v]-          Just (Value'Kind'NumberValue v) -> ["numberValue" .=: v]-          Just (Value'Kind'StringValue v) -> ["stringValue" .=: v]-          Just (Value'Kind'BoolValue v) -> ["boolValue" .=: v]-          Just (Value'Kind'StructValue v) -> ["structValue" .=: v]-          Just (Value'Kind'ListValue v) -> ["listValue" .=: v]-      )--      ]--instance Aeson.FromJSON Value where-  parseJSON = Aeson.withObject "Value" $ \obj -> do-    fld_valueKind <- parseOneofVariants obj-      [ ("nullValue", OneofVariantNullIsUnset, (\v -> Value'Kind'NullValue <$> Aeson.parseJSON v))-      , ("numberValue", OneofVariantNullIsUnset, (\v -> Value'Kind'NumberValue <$> Aeson.parseJSON v))-      , ("stringValue", OneofVariantNullIsUnset, (\v -> Value'Kind'StringValue <$> Aeson.parseJSON v))-      , ("boolValue", OneofVariantNullIsUnset, (\v -> Value'Kind'BoolValue <$> Aeson.parseJSON v))-      , ("structValue", OneofVariantNullIsUnset, (\v -> Value'Kind'StructValue <$> Aeson.parseJSON v))-      , ("listValue", OneofVariantNullIsUnset, (\v -> Value'Kind'ListValue <$> Aeson.parseJSON v))-      ]-    pure defaultValue-      { valueKind = fld_valueKind-      }--instance Hashable Value where-  hashWithSalt salt msg = hashWithSalt (salt) msg.valueKind--instance Proto.Extension.HasExtensions Value where-  messageUnknownFields = valueUnknownFields-  setMessageUnknownFields !ufs msg = msg { valueUnknownFields = ufs }--instance Semigroup Value where-  a <> b = Value-    { valueKind = case b.valueKind of { Nothing -> a.valueKind; x -> x }-    , valueUnknownFields = a.valueUnknownFields <> b.valueUnknownFields-    }--instance Monoid Value where-  mempty = defaultValue--data NullValue-  = NullValue'NullValue-  deriving stock (Show, Eq, Ord, Prelude.Enum, Prelude.Bounded, Generic)-  deriving anyclass NFData--toProtoEnumNullValue :: NullValue -> Int-toProtoEnumNullValue NullValue'NullValue = 0--fromProtoEnumNullValue :: Int -> Maybe NullValue-fromProtoEnumNullValue 0 = Just NullValue'NullValue-fromProtoEnumNullValue _ = Nothing--instance MessageEncode NullValue where-  buildSized _ = mempty-instance MessageDecode NullValue where-  messageDecoder = pure (Prelude.toEnum 0)--instance Aeson.ToJSON NullValue where-  toJSON NullValue'NullValue = Aeson.String "NULL_VALUE"--instance Aeson.FromJSON NullValue where-  parseJSON = \case-    Aeson.String "NULL_VALUE" -> pure NullValue'NullValue-    Aeson.Number n -> pure (Prelude.toEnum (round n))-    _ -> fail "Invalid enum value for NullValue"--instance Hashable NullValue where-  hashWithSalt salt x = hashWithSalt salt (toProtoEnumNullValue x)--data ListValue = ListValue-  { listValueValues :: !(V.Vector Value)-  , listValueUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultListValue :: ListValue-defaultListValue = ListValue-  { listValueValues = V.empty-  , listValueUnknownFields = []-  }--instance MessageEncode ListValue where-  buildSized msg =-    V.foldl' (\acc v -> acc <> archSubmessage 10 (buildSized v)) mempty msg.listValueValues-    <> encodeUnknownFieldsSized msg.listValueUnknownFields--instance MessageDecode ListValue where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultListValue emptyGrowList-    where-      stage_0 msg gl_0 =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldMessage-          (\v -> stage_0 msg (snocGrowList gl_0 v))-          (pure (case msg.listValueUnknownFields of { [] -> msg { listValueValues = growListToVector gl_0 }; _ -> msg { listValueValues = growListToVector gl_0, listValueUnknownFields = reverse (msg.listValueUnknownFields) } }))-          (loop msg gl_0)-      loop msg gl_0 = withTagM-        (pure (case msg.listValueUnknownFields of { [] -> msg { listValueValues = growListToVector gl_0 }; _ -> msg { listValueValues = growListToVector gl_0, listValueUnknownFields = reverse (msg.listValueUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldMessage-            loop msg (snocGrowList gl_0 v)-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { listValueUnknownFields = (uf : msg.listValueUnknownFields)}) gl_0)---- | Field descriptors for 'ListValue', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-listValueFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor ListValue)-listValueFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "values"-        , fdNumber = 1-        , fdTypeDesc = MessageType "Value"-        , fdLabel = LabelRepeated-        , fdGet = listValueValues-        , fdSet = \v m -> m { listValueValues = v }-        })-    ]--instance ProtoMessage ListValue where-  protoMessageName _ = "google.protobuf.ListValue"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultListValue-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = listValueFieldDescriptors--instance IsMessage ListValue--instance Aeson.ToJSON ListValue where-  toJSON msg = jsonObject-      [ "values" .=: msg.listValueValues--      ]--instance Aeson.FromJSON ListValue where-  parseJSON = Aeson.withObject "ListValue" $ \obj -> do-    fld_listValueValues <- parseFieldMaybe obj "values"-    pure defaultListValue-      { listValueValues = maybe (listValueValues defaultListValue) id fld_listValueValues-      }--instance Hashable ListValue where-  hashWithSalt salt msg = V.foldl' hashWithSalt (salt) msg.listValueValues--instance Proto.Extension.HasExtensions ListValue where-  messageUnknownFields = listValueUnknownFields-  setMessageUnknownFields !ufs msg = msg { listValueUnknownFields = ufs }--instance Semigroup ListValue where-  a <> b = ListValue-    { listValueValues = a.listValueValues <> b.listValueValues-    , listValueUnknownFields = a.listValueUnknownFields <> b.listValueUnknownFields-    }--instance Monoid ListValue where-  mempty = defaultListValue
− src/Proto/Google/Protobuf/WellKnownTypes/Struct/Util.hs 
@@ -1,159 +0,0 @@--- | Utility functions for @google.protobuf.Struct@ and @Value@.------ Provides a builder DSL for constructing 'Struct' and 'Value' from--- native Haskell types, plus conversions to\/from 'Aeson.Value' — mirroring--- Go's @structpb.NewStruct@, @structpb.NewValue@, etc.-module Proto.Google.Protobuf.WellKnownTypes.Struct.Util-  ( -- * Struct construction-    fromMap-  , fromPairs-  , toMap--    -- * Value construction-  , nullValue-  , numberValue-  , stringValue-  , boolValue-  , structValue-  , listValue--    -- * Value extraction-  , asNull-  , asNumber-  , asString-  , asBool-  , asStruct-  , asList--    -- * Aeson bridge-  , valueFromAeson-  , valueToAeson-  , structFromAeson-  , structToAeson-  ) where--import Data.Bifunctor (bimap)-import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map-import Data.Scientific (fromFloatDigits, toRealFloat)-import Data.Text (Text)-import qualified Data.Vector as V--import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Key as AesonKey-import qualified Data.Aeson.KeyMap as AesonKM--import Proto.Google.Protobuf.WellKnownTypes.Struct---- | Construct a 'Struct' from a 'Map'.-fromMap :: Map Text Value -> Struct-fromMap m = defaultStruct { structFields = m }---- | Construct a 'Struct' from key-value pairs.-fromPairs :: [(Text, Value)] -> Struct-fromPairs = fromMap . Map.fromList---- | Extract the underlying 'Map' from a 'Struct'.-toMap :: Struct -> Map Text Value-toMap = structFields---- | A null 'Value'.-nullValue :: Value-nullValue = defaultValue-  { valueKind = Just (Value'Kind'NullValue NullValue'NullValue) }---- | A numeric 'Value'.-numberValue :: Double -> Value-numberValue d = defaultValue-  { valueKind = Just (Value'Kind'NumberValue d) }---- | A string 'Value'.-stringValue :: Text -> Value-stringValue t = defaultValue-  { valueKind = Just (Value'Kind'StringValue t) }---- | A boolean 'Value'.-boolValue :: Bool -> Value-boolValue b = defaultValue-  { valueKind = Just (Value'Kind'BoolValue b) }---- | A 'Value' wrapping a 'Struct'.-structValue :: Struct -> Value-structValue s = defaultValue-  { valueKind = Just (Value'Kind'StructValue s) }---- | A 'Value' wrapping a list of 'Value's.-listValue :: [Value] -> Value-listValue vs = defaultValue-  { valueKind = Just (Value'Kind'ListValue (defaultListValue { listValueValues = V.fromList vs })) }---- | Extract 'Nothing' if the value is null, or 'Just ()' otherwise.-asNull :: Value -> Maybe ()-asNull v = case valueKind v of-  Just (Value'Kind'NullValue _) -> Just ()-  _ -> Nothing---- | Extract a 'Double' if the value is numeric.-asNumber :: Value -> Maybe Double-asNumber v = case valueKind v of-  Just (Value'Kind'NumberValue d) -> Just d-  _ -> Nothing---- | Extract a 'Text' if the value is a string.-asString :: Value -> Maybe Text-asString v = case valueKind v of-  Just (Value'Kind'StringValue t) -> Just t-  _ -> Nothing---- | Extract a 'Bool' if the value is boolean.-asBool :: Value -> Maybe Bool-asBool v = case valueKind v of-  Just (Value'Kind'BoolValue b) -> Just b-  _ -> Nothing---- | Extract a 'Struct' if the value wraps one.-asStruct :: Value -> Maybe Struct-asStruct v = case valueKind v of-  Just (Value'Kind'StructValue s) -> Just s-  _ -> Nothing---- | Extract a list of 'Value's if the value is a list.-asList :: Value -> Maybe [Value]-asList v = case valueKind v of-  Just (Value'Kind'ListValue lv) -> Just (V.toList (listValueValues lv))-  _ -> Nothing---- | Convert an 'Aeson.Value' to a protobuf 'Value'.-valueFromAeson :: Aeson.Value -> Value-valueFromAeson = \case-  Aeson.Null -> nullValue-  Aeson.Bool b -> boolValue b-  Aeson.Number n -> numberValue (toRealFloat n)-  Aeson.String s -> stringValue s-  Aeson.Array vs -> listValue (V.toList (fmap valueFromAeson vs))-  Aeson.Object o -> structValue (structFromAeson (Aeson.Object o))---- | Convert a protobuf 'Value' to an 'Aeson.Value'.-valueToAeson :: Value -> Aeson.Value-valueToAeson v = case valueKind v of-  Nothing -> Aeson.Null-  Just vk -> case vk of-    Value'Kind'NullValue _   -> Aeson.Null-    Value'Kind'NumberValue d -> Aeson.Number (fromFloatDigits d)-    Value'Kind'StringValue s -> Aeson.String s-    Value'Kind'BoolValue b   -> Aeson.Bool b-    Value'Kind'StructValue s -> structToAeson s-    Value'Kind'ListValue l   -> Aeson.Array (fmap valueToAeson (listValueValues l))---- | Convert an 'Aeson.Value' (must be an Object) to a 'Struct'.--- Non-object inputs produce an empty 'Struct'.-structFromAeson :: Aeson.Value -> Struct-structFromAeson (Aeson.Object o) =-  fromMap (Map.fromList (fmap (bimap AesonKey.toText valueFromAeson) (AesonKM.toList o)))-structFromAeson _ = defaultStruct---- | Convert a 'Struct' to an 'Aeson.Value' (Object).-structToAeson :: Struct -> Aeson.Value-structToAeson s =-  Aeson.Object (AesonKM.fromList-    (fmap (bimap AesonKey.fromText valueToAeson) (Map.toList (structFields s))))
− src/Proto/Google/Protobuf/WellKnownTypes/Timestamp.hs 
@@ -1,191 +0,0 @@-{-# LANGUAGE StrictData #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedRecordDot #-}--- | Auto-generated protobuf types from package @google.protobuf@.------ __THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__------ Any manual changes will be overwritten the next time code--- generation is run.  To modify the types or instances, edit the--- @.proto@ source file and re-run the code generator.-module Proto.Google.Protobuf.WellKnownTypes.Timestamp where--import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Wireform.Builder as B-import Data.Int (Int32, Int64)-import Data.Text (Text)-import qualified Data.Text as T-import Data.Word (Word8, Word32, Word64)-import qualified Data.IntMap.Strict as IntMap-import qualified Data.Map.Strict as Map-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU-import GHC.Generics (Generic)-import Control.DeepSeq (NFData(..))-import Data.Hashable (Hashable(..))-import Proto.Internal.Encode-import Proto.Internal.Decode-import Proto.Internal.GrowList (GrowList, emptyGrowList, snocGrowList, growListToVector)-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson-import qualified Data.Aeson.Key as AesonKey-import qualified Data.Aeson.KeyMap as AesonKM-import Proto.Internal.JSON (jsonObject, (.=:), parseFieldMaybe, bytesFieldToJSON, parseBytesFieldMaybe, bytesMapFieldToJSON, parseBytesMapFieldMaybe, protoBytesToJSON, OneofVariantNullSemantics (..), parseOneofVariants)-import Data.Proxy (Proxy(..))-import Proto.Schema (ProtoMessage(..), SomeFieldDescriptor(..), FieldDescriptor(..), FieldTypeDescriptor(..), ScalarFieldType(..), FieldLabel'(..))-import Proto.Registry (IsMessage)-import Proto.Registry qualified-import qualified Proto.Extension-import Proto.Internal.Wire (Tag(..), WireType(..))-import Proto.Internal.Wire.Encode (putTag, putVarint, putFixed32, putFixed64,-  putFloat, putDouble, putText, putByteString, putLengthDelimited,-  putSVarint32, putSVarint64, putVarintSigned,-  varintSize, tagSize,-  varintSize32, zigZag32, zigZag64)-import Proto.Internal.Encode.Archetype (archVarint, archSVarint32, archSVarint64,-  archFixed32, archFixed64, archFloat, archDouble, archBool,-  archString, archBytes, archSubmessage)---- | Serialized FileDescriptorProto for this .proto file.--- Decode with @Proto.Decode.decodeMessage@.-fileDescriptorProtoBytes :: ByteString-fileDescriptorProtoBytes = "\x0a\x1f\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x74\x69\x6d\x65\x73\x74\x61\x6d\x70\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x2b\x0a\x09\x54\x69\x6d\x65\x73\x74\x61\x6d\x70\x12\x0f\x0a\x07\x73\x65\x63\x6f\x6e\x64\x73\x18\x01\x20\x01\x28\x03\x12\x0d\x0a\x05\x6e\x61\x6e\x6f\x73\x18\x02\x20\x01\x28\x05\x62\x06\x70\x72\x6f\x74\x6f\x33"---data Timestamp = Timestamp-  { timestampSeconds :: {-# UNPACK #-} !Int64-  , timestampNanos :: {-# UNPACK #-} !Int32-  , timestampUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultTimestamp :: Timestamp-defaultTimestamp = Timestamp-  { timestampSeconds = 0-  , timestampNanos = 0-  , timestampUnknownFields = []-  }--instance MessageEncode Timestamp where-  buildSized msg =-    (if msg.timestampSeconds == 0 then mempty else archVarint 8 (fromIntegral msg.timestampSeconds))-    <> (if msg.timestampNanos == 0 then mempty else archVarint 16 (fromIntegral msg.timestampNanos))-    <> encodeUnknownFieldsSized msg.timestampUnknownFields--instance MessageDecode Timestamp where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultTimestamp-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> stage_1 (msg { timestampSeconds = v}))-          (pure (case msg.timestampUnknownFields of { [] -> msg; _ -> msg { timestampUnknownFields = reverse (msg.timestampUnknownFields) } }))-          (loop msg)-      stage_1 msg =-        inOrderStage1-          (0x10 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> loop (msg { timestampNanos = v}))-          (pure (case msg.timestampUnknownFields of { [] -> msg; _ -> msg { timestampUnknownFields = reverse (msg.timestampUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.timestampUnknownFields of { [] -> msg; _ -> msg { timestampUnknownFields = reverse (msg.timestampUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { timestampSeconds = v})-          2 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { timestampNanos = v})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { timestampUnknownFields = (uf : msg.timestampUnknownFields)}))---- | Field descriptors for 'Timestamp', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-timestampFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor Timestamp)-timestampFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "seconds"-        , fdNumber = 1-        , fdTypeDesc = ScalarType Int64Field-        , fdLabel = LabelOptional-        , fdGet = timestampSeconds-        , fdSet = \v m -> m { timestampSeconds = v }-        }), (2, SomeField FieldDescriptor-        { fdName = "nanos"-        , fdNumber = 2-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = timestampNanos-        , fdSet = \v m -> m { timestampNanos = v }-        })-    ]--instance ProtoMessage Timestamp where-  protoMessageName _ = "google.protobuf.Timestamp"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultTimestamp-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = timestampFieldDescriptors--instance IsMessage Timestamp--instance Aeson.ToJSON Timestamp where-  toJSON msg =-    let s = msg.timestampSeconds-        n = msg.timestampNanos-        (rawDays, remSec) = s `divMod` 86400-        (hours, remH) = remSec `divMod` 3600-        (mins, secs) = remH `divMod` 60-        z = rawDays + 719468-        era = (if z >= 0 then z else z - 146096) `div` 146097-        doe = z - era * 146097-        yoe = (doe - doe `div` 1460 + doe `div` 36524 - doe `div` 146096) `div` 365-        y = yoe + era * 400-        doy = doe - (365 * yoe + yoe `div` 4 - yoe `div` 100)-        mp = (5 * doy + 2) `div` 153-        d = doy - (153 * mp + 2) `div` 5 + 1-        m = mp + (if mp < 10 then 3 else -9)-        y' = y + (if m <= 2 then 1 else 0)-        pad2 x = let sx = T.pack (show (abs x)) in if T.length sx < 2 then T.pack "0" <> sx else sx-        pad4 x = let sx = T.pack (show (abs x)) in T.replicate (4 - T.length sx) (T.pack "0") <> sx-        pad9 x = let sx = T.pack (show (abs x)) in T.replicate (9 - T.length sx) (T.pack "0") <> sx-        nanoStr = if n == 0 then T.pack "" else T.pack "." <> dropTrailingZeros (pad9 (fromIntegral n))-        dropTrailingZeros t = case T.stripSuffix (T.pack "0") t of { Just t' -> dropTrailingZeros t'; Nothing -> t }-    in Aeson.String (pad4 y' <> T.pack "-" <> pad2 (fromIntegral m) <> T.pack "-" <> pad2 (fromIntegral d)-         <> T.pack "T" <> pad2 hours <> T.pack ":" <> pad2 mins <> T.pack ":" <> pad2 secs-         <> nanoStr <> T.pack "Z")---instance Aeson.FromJSON Timestamp where-  parseJSON (Aeson.String _) = pure defaultTimestamp-  parseJSON _ = fail "Expected RFC 3339 timestamp string"---instance Hashable Timestamp where-  hashWithSalt salt msg = hashWithSalt (hashWithSalt (salt) msg.timestampSeconds) msg.timestampNanos--instance Proto.Extension.HasExtensions Timestamp where-  messageUnknownFields = timestampUnknownFields-  setMessageUnknownFields !ufs msg = msg { timestampUnknownFields = ufs }--instance Semigroup Timestamp where-  a <> b = Timestamp-    { timestampSeconds = if b.timestampSeconds == 0 then a.timestampSeconds else b.timestampSeconds-    , timestampNanos = if b.timestampNanos == 0 then a.timestampNanos else b.timestampNanos-    , timestampUnknownFields = a.timestampUnknownFields <> b.timestampUnknownFields-    }--instance Monoid Timestamp where-  mempty = defaultTimestamp
− src/Proto/Google/Protobuf/WellKnownTypes/Timestamp/Util.hs 
@@ -1,116 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--- | Utility functions for @google.protobuf.Timestamp@.------ Provides conversions to\/from standard Haskell time types ('UTCTime',--- 'POSIXTime'), arithmetic with 'Duration', a current-time helper,--- an 'Ord' instance, and validation — mirroring utilities found in--- Go (@timestamppb@), Java (@com.google.protobuf.util.Timestamps@),--- and Rust (@prost-types@).-module Proto.Google.Protobuf.WellKnownTypes.Timestamp.Util-  ( -- * Conversions-    timestampFromUTCTime-  , timestampToUTCTime-  , timestampFromPOSIXTime-  , timestampToPOSIXTime--    -- * Current time-  , getCurrentTimestamp--    -- * Arithmetic-  , addDuration-  , subtractTimestamps--    -- * Validation-  , isValidTimestamp--    -- * Comparison-  , compareTimestamp-  ) where--import Data.Int (Int32, Int64)-import Data.Time.Clock (UTCTime)-import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime, utcTimeToPOSIXSeconds, getPOSIXTime)--import Proto.Google.Protobuf.WellKnownTypes.Timestamp (Timestamp(..), defaultTimestamp)-import Proto.Google.Protobuf.WellKnownTypes.Duration (Duration(..), defaultDuration)--nanosPerSecond :: Int64-nanosPerSecond = 1000000000---- | Convert a 'UTCTime' to a 'Timestamp'.-timestampFromUTCTime :: UTCTime -> Timestamp-timestampFromUTCTime = timestampFromPOSIXTime . utcTimeToPOSIXSeconds---- | Convert a 'Timestamp' to a 'UTCTime'.-timestampToUTCTime :: Timestamp -> UTCTime-timestampToUTCTime = posixSecondsToUTCTime . timestampToPOSIXTime---- | Convert a 'POSIXTime' to a 'Timestamp'.------ Fractional seconds are preserved at nanosecond granularity.-timestampFromPOSIXTime :: POSIXTime -> Timestamp-timestampFromPOSIXTime pt =-  let totalNanos = round (pt * fromIntegral nanosPerSecond) :: Int64-      (s, n) = totalNanos `quotRem` nanosPerSecond-  in defaultTimestamp-    { timestampSeconds = s-    , timestampNanos = fromIntegral n-    }---- | Convert a 'Timestamp' to a 'POSIXTime'.-timestampToPOSIXTime :: Timestamp -> POSIXTime-timestampToPOSIXTime ts =-  let s = fromIntegral (timestampSeconds ts) :: POSIXTime-      n = fromIntegral (timestampNanos ts) / fromIntegral nanosPerSecond :: POSIXTime-  in s + n---- | Get the current system time as a 'Timestamp'.-getCurrentTimestamp :: IO Timestamp-getCurrentTimestamp = timestampFromPOSIXTime <$> getPOSIXTime---- | Add a 'Duration' to a 'Timestamp', producing a new 'Timestamp'.-addDuration :: Timestamp -> Duration -> Timestamp-addDuration ts dur =-  let totalNanos =-        (fromIntegral (timestampSeconds ts) * nanosPerSecond + fromIntegral (timestampNanos ts))-        + (fromIntegral (durationSeconds dur) * nanosPerSecond + fromIntegral (durationNanos dur))-      (s, n) = totalNanos `quotRem` nanosPerSecond-  in defaultTimestamp-    { timestampSeconds = s-    , timestampNanos = fromIntegral n-    }---- | Compute the 'Duration' between two 'Timestamp' values (@a - b@).-subtractTimestamps :: Timestamp -> Timestamp -> Duration-subtractTimestamps a b =-  let aNanos = fromIntegral (timestampSeconds a) * nanosPerSecond + fromIntegral (timestampNanos a)-      bNanos = fromIntegral (timestampSeconds b) * nanosPerSecond + fromIntegral (timestampNanos b)-      diff = aNanos - bNanos-      (s, n) = diff `quotRem` nanosPerSecond-  in defaultDuration-    { durationSeconds = s-    , durationNanos = fromIntegral n-    }---- | 'Timestamp' is valid when seconds is in @[0001-01-01T00:00:00Z, 9999-12-31T23:59:59Z]@--- and nanos is in @[0, 999999999]@.------ These are the bounds from the proto spec.-isValidTimestamp :: Timestamp -> Bool-isValidTimestamp ts =-  timestampSeconds ts >= minTimestampSeconds-  && timestampSeconds ts <= maxTimestampSeconds-  && timestampNanos ts >= 0-  && timestampNanos ts <= 999999999-  where-    minTimestampSeconds = -62135596800  -- 0001-01-01T00:00:00Z-    maxTimestampSeconds = 253402300799  -- 9999-12-31T23:59:59Z---- | Compare two 'Timestamp' values. Compares seconds first, then nanos.-compareTimestamp :: Timestamp -> Timestamp -> Ordering-compareTimestamp a b =-  compare (timestampSeconds a) (timestampSeconds b)-  <> compare (timestampNanos a) (timestampNanos b)--instance Ord Timestamp where-  compare = compareTimestamp
− src/Proto/Google/Protobuf/WellKnownTypes/Wrappers.hs 
@@ -1,903 +0,0 @@-{-# LANGUAGE StrictData #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedRecordDot #-}--- | Auto-generated protobuf types from package @google.protobuf@.------ __THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__------ Any manual changes will be overwritten the next time code--- generation is run.  To modify the types or instances, edit the--- @.proto@ source file and re-run the code generator.-module Proto.Google.Protobuf.WellKnownTypes.Wrappers where--import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Wireform.Builder as B-import Data.Int (Int32, Int64)-import Data.Text (Text)-import qualified Data.Text as T-import Data.Word (Word8, Word32, Word64)-import qualified Data.IntMap.Strict as IntMap-import qualified Data.Map.Strict as Map-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU-import GHC.Generics (Generic)-import Control.DeepSeq (NFData(..))-import Data.Hashable (Hashable(..))-import Proto.Internal.Encode-import Proto.Internal.Decode-import Proto.Internal.GrowList (GrowList, emptyGrowList, snocGrowList, growListToVector)-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson-import qualified Data.Aeson.Key as AesonKey-import qualified Data.Aeson.KeyMap as AesonKM-import Proto.Internal.JSON (jsonObject, (.=:), parseFieldMaybe, bytesFieldToJSON, parseBytesFieldMaybe, bytesMapFieldToJSON, parseBytesMapFieldMaybe, protoBytesToJSON, OneofVariantNullSemantics (..), parseOneofVariants)-import Data.Proxy (Proxy(..))-import Proto.Schema (ProtoMessage(..), SomeFieldDescriptor(..), FieldDescriptor(..), FieldTypeDescriptor(..), ScalarFieldType(..), FieldLabel'(..))-import Proto.Registry (IsMessage)-import Proto.Registry qualified-import qualified Proto.Extension-import Proto.Internal.Wire (Tag(..), WireType(..))-import Proto.Internal.Wire.Encode (putTag, putVarint, putFixed32, putFixed64,-  putFloat, putDouble, putText, putByteString, putLengthDelimited,-  putSVarint32, putSVarint64, putVarintSigned,-  varintSize, tagSize,-  varintSize32, zigZag32, zigZag64)-import Proto.Internal.Encode.Archetype (archVarint, archSVarint32, archSVarint64,-  archFixed32, archFixed64, archFloat, archDouble, archBool,-  archString, archBytes, archSubmessage)---- | Serialized FileDescriptorProto for this .proto file.--- Decode with @Proto.Decode.decodeMessage@.-fileDescriptorProtoBytes :: ByteString-fileDescriptorProtoBytes = "\x0a\x1e\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x77\x72\x61\x70\x70\x65\x72\x73\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x1c\x0a\x0b\x44\x6f\x75\x62\x6c\x65\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x01\x22\x1b\x0a\x0a\x46\x6c\x6f\x61\x74\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x02\x22\x1b\x0a\x0a\x49\x6e\x74\x36\x34\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x03\x22\x1c\x0a\x0b\x55\x49\x6e\x74\x36\x34\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x04\x22\x1b\x0a\x0a\x49\x6e\x74\x33\x32\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x05\x22\x1c\x0a\x0b\x55\x49\x6e\x74\x33\x32\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x0d\x22\x1a\x0a\x09\x42\x6f\x6f\x6c\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x08\x22\x1c\x0a\x0b\x53\x74\x72\x69\x6e\x67\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x09\x22\x1b\x0a\x0a\x42\x79\x74\x65\x73\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x0c\x62\x06\x70\x72\x6f\x74\x6f\x33"---data DoubleValue = DoubleValue-  { doubleValueValue :: {-# UNPACK #-} !Double-  , doubleValueUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultDoubleValue :: DoubleValue-defaultDoubleValue = DoubleValue-  { doubleValueValue = 0-  , doubleValueUnknownFields = []-  }--instance MessageEncode DoubleValue where-  buildSized msg =-    (if msg.doubleValueValue == 0 then mempty else archDouble 9 msg.doubleValueValue)-    <> encodeUnknownFieldsSized msg.doubleValueUnknownFields--instance MessageDecode DoubleValue where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultDoubleValue-    where-      stage_0 msg =-        inOrderStage1-          (0x9 :: Data.Word.Word8)-          decodeFieldDouble-          (\v -> loop (msg { doubleValueValue = v}))-          (pure (case msg.doubleValueUnknownFields of { [] -> msg; _ -> msg { doubleValueUnknownFields = reverse (msg.doubleValueUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.doubleValueUnknownFields of { [] -> msg; _ -> msg { doubleValueUnknownFields = reverse (msg.doubleValueUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldDouble-            loop (msg { doubleValueValue = v})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { doubleValueUnknownFields = (uf : msg.doubleValueUnknownFields)}))---- | Field descriptors for 'DoubleValue', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-doubleValueFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor DoubleValue)-doubleValueFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "value"-        , fdNumber = 1-        , fdTypeDesc = ScalarType DoubleField-        , fdLabel = LabelOptional-        , fdGet = doubleValueValue-        , fdSet = \v m -> m { doubleValueValue = v }-        })-    ]--instance ProtoMessage DoubleValue where-  protoMessageName _ = "google.protobuf.DoubleValue"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultDoubleValue-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = doubleValueFieldDescriptors--instance IsMessage DoubleValue--instance Aeson.ToJSON DoubleValue where-  toJSON msg = jsonObject-      [ "value" .=: msg.doubleValueValue--      ]--instance Aeson.FromJSON DoubleValue where-  parseJSON = Aeson.withObject "DoubleValue" $ \obj -> do-    fld_doubleValueValue <- parseFieldMaybe obj "value"-    pure defaultDoubleValue-      { doubleValueValue = maybe (doubleValueValue defaultDoubleValue) id fld_doubleValueValue-      }--instance Hashable DoubleValue where-  hashWithSalt salt msg = hashWithSalt (salt) msg.doubleValueValue--instance Proto.Extension.HasExtensions DoubleValue where-  messageUnknownFields = doubleValueUnknownFields-  setMessageUnknownFields !ufs msg = msg { doubleValueUnknownFields = ufs }--instance Semigroup DoubleValue where-  a <> b = DoubleValue-    { doubleValueValue = if b.doubleValueValue == 0 then a.doubleValueValue else b.doubleValueValue-    , doubleValueUnknownFields = a.doubleValueUnknownFields <> b.doubleValueUnknownFields-    }--instance Monoid DoubleValue where-  mempty = defaultDoubleValue--data FloatValue = FloatValue-  { floatValueValue :: {-# UNPACK #-} !Float-  , floatValueUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultFloatValue :: FloatValue-defaultFloatValue = FloatValue-  { floatValueValue = 0-  , floatValueUnknownFields = []-  }--instance MessageEncode FloatValue where-  buildSized msg =-    (if msg.floatValueValue == 0 then mempty else archFloat 13 msg.floatValueValue)-    <> encodeUnknownFieldsSized msg.floatValueUnknownFields--instance MessageDecode FloatValue where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultFloatValue-    where-      stage_0 msg =-        inOrderStage1-          (0xd :: Data.Word.Word8)-          decodeFieldFloat-          (\v -> loop (msg { floatValueValue = v}))-          (pure (case msg.floatValueUnknownFields of { [] -> msg; _ -> msg { floatValueUnknownFields = reverse (msg.floatValueUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.floatValueUnknownFields of { [] -> msg; _ -> msg { floatValueUnknownFields = reverse (msg.floatValueUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldFloat-            loop (msg { floatValueValue = v})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { floatValueUnknownFields = (uf : msg.floatValueUnknownFields)}))---- | Field descriptors for 'FloatValue', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-floatValueFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor FloatValue)-floatValueFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "value"-        , fdNumber = 1-        , fdTypeDesc = ScalarType FloatField-        , fdLabel = LabelOptional-        , fdGet = floatValueValue-        , fdSet = \v m -> m { floatValueValue = v }-        })-    ]--instance ProtoMessage FloatValue where-  protoMessageName _ = "google.protobuf.FloatValue"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultFloatValue-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = floatValueFieldDescriptors--instance IsMessage FloatValue--instance Aeson.ToJSON FloatValue where-  toJSON msg = jsonObject-      [ "value" .=: msg.floatValueValue--      ]--instance Aeson.FromJSON FloatValue where-  parseJSON = Aeson.withObject "FloatValue" $ \obj -> do-    fld_floatValueValue <- parseFieldMaybe obj "value"-    pure defaultFloatValue-      { floatValueValue = maybe (floatValueValue defaultFloatValue) id fld_floatValueValue-      }--instance Hashable FloatValue where-  hashWithSalt salt msg = hashWithSalt (salt) msg.floatValueValue--instance Proto.Extension.HasExtensions FloatValue where-  messageUnknownFields = floatValueUnknownFields-  setMessageUnknownFields !ufs msg = msg { floatValueUnknownFields = ufs }--instance Semigroup FloatValue where-  a <> b = FloatValue-    { floatValueValue = if b.floatValueValue == 0 then a.floatValueValue else b.floatValueValue-    , floatValueUnknownFields = a.floatValueUnknownFields <> b.floatValueUnknownFields-    }--instance Monoid FloatValue where-  mempty = defaultFloatValue--data Int64Value = Int64Value-  { int64ValueValue :: {-# UNPACK #-} !Int64-  , int64ValueUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultInt64Value :: Int64Value-defaultInt64Value = Int64Value-  { int64ValueValue = 0-  , int64ValueUnknownFields = []-  }--instance MessageEncode Int64Value where-  buildSized msg =-    (if msg.int64ValueValue == 0 then mempty else archVarint 8 (fromIntegral msg.int64ValueValue))-    <> encodeUnknownFieldsSized msg.int64ValueUnknownFields--instance MessageDecode Int64Value where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultInt64Value-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> loop (msg { int64ValueValue = v}))-          (pure (case msg.int64ValueUnknownFields of { [] -> msg; _ -> msg { int64ValueUnknownFields = reverse (msg.int64ValueUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.int64ValueUnknownFields of { [] -> msg; _ -> msg { int64ValueUnknownFields = reverse (msg.int64ValueUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { int64ValueValue = v})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { int64ValueUnknownFields = (uf : msg.int64ValueUnknownFields)}))---- | Field descriptors for 'Int64Value', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-int64ValueFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor Int64Value)-int64ValueFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "value"-        , fdNumber = 1-        , fdTypeDesc = ScalarType Int64Field-        , fdLabel = LabelOptional-        , fdGet = int64ValueValue-        , fdSet = \v m -> m { int64ValueValue = v }-        })-    ]--instance ProtoMessage Int64Value where-  protoMessageName _ = "google.protobuf.Int64Value"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultInt64Value-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = int64ValueFieldDescriptors--instance IsMessage Int64Value--instance Aeson.ToJSON Int64Value where-  toJSON msg = jsonObject-      [ "value" .=: msg.int64ValueValue--      ]--instance Aeson.FromJSON Int64Value where-  parseJSON = Aeson.withObject "Int64Value" $ \obj -> do-    fld_int64ValueValue <- parseFieldMaybe obj "value"-    pure defaultInt64Value-      { int64ValueValue = maybe (int64ValueValue defaultInt64Value) id fld_int64ValueValue-      }--instance Hashable Int64Value where-  hashWithSalt salt msg = hashWithSalt (salt) msg.int64ValueValue--instance Proto.Extension.HasExtensions Int64Value where-  messageUnknownFields = int64ValueUnknownFields-  setMessageUnknownFields !ufs msg = msg { int64ValueUnknownFields = ufs }--instance Semigroup Int64Value where-  a <> b = Int64Value-    { int64ValueValue = if b.int64ValueValue == 0 then a.int64ValueValue else b.int64ValueValue-    , int64ValueUnknownFields = a.int64ValueUnknownFields <> b.int64ValueUnknownFields-    }--instance Monoid Int64Value where-  mempty = defaultInt64Value--data UInt64Value = UInt64Value-  { uInt64ValueValue :: {-# UNPACK #-} !Word64-  , uInt64ValueUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultUInt64Value :: UInt64Value-defaultUInt64Value = UInt64Value-  { uInt64ValueValue = 0-  , uInt64ValueUnknownFields = []-  }--instance MessageEncode UInt64Value where-  buildSized msg =-    (if msg.uInt64ValueValue == 0 then mempty else archVarint 8 msg.uInt64ValueValue)-    <> encodeUnknownFieldsSized msg.uInt64ValueUnknownFields--instance MessageDecode UInt64Value where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultUInt64Value-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          decodeFieldVarint-          (\v -> loop (msg { uInt64ValueValue = v}))-          (pure (case msg.uInt64ValueUnknownFields of { [] -> msg; _ -> msg { uInt64ValueUnknownFields = reverse (msg.uInt64ValueUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.uInt64ValueUnknownFields of { [] -> msg; _ -> msg { uInt64ValueUnknownFields = reverse (msg.uInt64ValueUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldVarint-            loop (msg { uInt64ValueValue = v})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { uInt64ValueUnknownFields = (uf : msg.uInt64ValueUnknownFields)}))---- | Field descriptors for 'UInt64Value', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-uInt64ValueFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor UInt64Value)-uInt64ValueFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "value"-        , fdNumber = 1-        , fdTypeDesc = ScalarType UInt64Field-        , fdLabel = LabelOptional-        , fdGet = uInt64ValueValue-        , fdSet = \v m -> m { uInt64ValueValue = v }-        })-    ]--instance ProtoMessage UInt64Value where-  protoMessageName _ = "google.protobuf.UInt64Value"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultUInt64Value-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = uInt64ValueFieldDescriptors--instance IsMessage UInt64Value--instance Aeson.ToJSON UInt64Value where-  toJSON msg = jsonObject-      [ "value" .=: msg.uInt64ValueValue--      ]--instance Aeson.FromJSON UInt64Value where-  parseJSON = Aeson.withObject "UInt64Value" $ \obj -> do-    fld_uInt64ValueValue <- parseFieldMaybe obj "value"-    pure defaultUInt64Value-      { uInt64ValueValue = maybe (uInt64ValueValue defaultUInt64Value) id fld_uInt64ValueValue-      }--instance Hashable UInt64Value where-  hashWithSalt salt msg = hashWithSalt (salt) msg.uInt64ValueValue--instance Proto.Extension.HasExtensions UInt64Value where-  messageUnknownFields = uInt64ValueUnknownFields-  setMessageUnknownFields !ufs msg = msg { uInt64ValueUnknownFields = ufs }--instance Semigroup UInt64Value where-  a <> b = UInt64Value-    { uInt64ValueValue = if b.uInt64ValueValue == 0 then a.uInt64ValueValue else b.uInt64ValueValue-    , uInt64ValueUnknownFields = a.uInt64ValueUnknownFields <> b.uInt64ValueUnknownFields-    }--instance Monoid UInt64Value where-  mempty = defaultUInt64Value--data Int32Value = Int32Value-  { int32ValueValue :: {-# UNPACK #-} !Int32-  , int32ValueUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultInt32Value :: Int32Value-defaultInt32Value = Int32Value-  { int32ValueValue = 0-  , int32ValueUnknownFields = []-  }--instance MessageEncode Int32Value where-  buildSized msg =-    (if msg.int32ValueValue == 0 then mempty else archVarint 8 (fromIntegral msg.int32ValueValue))-    <> encodeUnknownFieldsSized msg.int32ValueUnknownFields--instance MessageDecode Int32Value where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultInt32Value-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> loop (msg { int32ValueValue = v}))-          (pure (case msg.int32ValueUnknownFields of { [] -> msg; _ -> msg { int32ValueUnknownFields = reverse (msg.int32ValueUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.int32ValueUnknownFields of { [] -> msg; _ -> msg { int32ValueUnknownFields = reverse (msg.int32ValueUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { int32ValueValue = v})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { int32ValueUnknownFields = (uf : msg.int32ValueUnknownFields)}))---- | Field descriptors for 'Int32Value', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-int32ValueFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor Int32Value)-int32ValueFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "value"-        , fdNumber = 1-        , fdTypeDesc = ScalarType Int32Field-        , fdLabel = LabelOptional-        , fdGet = int32ValueValue-        , fdSet = \v m -> m { int32ValueValue = v }-        })-    ]--instance ProtoMessage Int32Value where-  protoMessageName _ = "google.protobuf.Int32Value"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultInt32Value-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = int32ValueFieldDescriptors--instance IsMessage Int32Value--instance Aeson.ToJSON Int32Value where-  toJSON msg = jsonObject-      [ "value" .=: msg.int32ValueValue--      ]--instance Aeson.FromJSON Int32Value where-  parseJSON = Aeson.withObject "Int32Value" $ \obj -> do-    fld_int32ValueValue <- parseFieldMaybe obj "value"-    pure defaultInt32Value-      { int32ValueValue = maybe (int32ValueValue defaultInt32Value) id fld_int32ValueValue-      }--instance Hashable Int32Value where-  hashWithSalt salt msg = hashWithSalt (salt) msg.int32ValueValue--instance Proto.Extension.HasExtensions Int32Value where-  messageUnknownFields = int32ValueUnknownFields-  setMessageUnknownFields !ufs msg = msg { int32ValueUnknownFields = ufs }--instance Semigroup Int32Value where-  a <> b = Int32Value-    { int32ValueValue = if b.int32ValueValue == 0 then a.int32ValueValue else b.int32ValueValue-    , int32ValueUnknownFields = a.int32ValueUnknownFields <> b.int32ValueUnknownFields-    }--instance Monoid Int32Value where-  mempty = defaultInt32Value--data UInt32Value = UInt32Value-  { uInt32ValueValue :: {-# UNPACK #-} !Word32-  , uInt32ValueUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultUInt32Value :: UInt32Value-defaultUInt32Value = UInt32Value-  { uInt32ValueValue = 0-  , uInt32ValueUnknownFields = []-  }--instance MessageEncode UInt32Value where-  buildSized msg =-    (if msg.uInt32ValueValue == 0 then mempty else archVarint 8 (fromIntegral msg.uInt32ValueValue))-    <> encodeUnknownFieldsSized msg.uInt32ValueUnknownFields--instance MessageDecode UInt32Value where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultUInt32Value-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          (fromIntegral <$> decodeFieldVarint)-          (\v -> loop (msg { uInt32ValueValue = v}))-          (pure (case msg.uInt32ValueUnknownFields of { [] -> msg; _ -> msg { uInt32ValueUnknownFields = reverse (msg.uInt32ValueUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.uInt32ValueUnknownFields of { [] -> msg; _ -> msg { uInt32ValueUnknownFields = reverse (msg.uInt32ValueUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- (fromIntegral <$> decodeFieldVarint)-            loop (msg { uInt32ValueValue = v})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { uInt32ValueUnknownFields = (uf : msg.uInt32ValueUnknownFields)}))---- | Field descriptors for 'UInt32Value', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-uInt32ValueFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor UInt32Value)-uInt32ValueFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "value"-        , fdNumber = 1-        , fdTypeDesc = ScalarType UInt32Field-        , fdLabel = LabelOptional-        , fdGet = uInt32ValueValue-        , fdSet = \v m -> m { uInt32ValueValue = v }-        })-    ]--instance ProtoMessage UInt32Value where-  protoMessageName _ = "google.protobuf.UInt32Value"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultUInt32Value-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = uInt32ValueFieldDescriptors--instance IsMessage UInt32Value--instance Aeson.ToJSON UInt32Value where-  toJSON msg = jsonObject-      [ "value" .=: msg.uInt32ValueValue--      ]--instance Aeson.FromJSON UInt32Value where-  parseJSON = Aeson.withObject "UInt32Value" $ \obj -> do-    fld_uInt32ValueValue <- parseFieldMaybe obj "value"-    pure defaultUInt32Value-      { uInt32ValueValue = maybe (uInt32ValueValue defaultUInt32Value) id fld_uInt32ValueValue-      }--instance Hashable UInt32Value where-  hashWithSalt salt msg = hashWithSalt (salt) msg.uInt32ValueValue--instance Proto.Extension.HasExtensions UInt32Value where-  messageUnknownFields = uInt32ValueUnknownFields-  setMessageUnknownFields !ufs msg = msg { uInt32ValueUnknownFields = ufs }--instance Semigroup UInt32Value where-  a <> b = UInt32Value-    { uInt32ValueValue = if b.uInt32ValueValue == 0 then a.uInt32ValueValue else b.uInt32ValueValue-    , uInt32ValueUnknownFields = a.uInt32ValueUnknownFields <> b.uInt32ValueUnknownFields-    }--instance Monoid UInt32Value where-  mempty = defaultUInt32Value--data BoolValue = BoolValue-  { boolValueValue :: {-# UNPACK #-} !Bool-  , boolValueUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultBoolValue :: BoolValue-defaultBoolValue = BoolValue-  { boolValueValue = False-  , boolValueUnknownFields = []-  }--instance MessageEncode BoolValue where-  buildSized msg =-    (if msg.boolValueValue == False then mempty else archBool 8 msg.boolValueValue)-    <> encodeUnknownFieldsSized msg.boolValueUnknownFields--instance MessageDecode BoolValue where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultBoolValue-    where-      stage_0 msg =-        inOrderStage1-          (0x8 :: Data.Word.Word8)-          decodeFieldBool-          (\v -> loop (msg { boolValueValue = v}))-          (pure (case msg.boolValueUnknownFields of { [] -> msg; _ -> msg { boolValueUnknownFields = reverse (msg.boolValueUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.boolValueUnknownFields of { [] -> msg; _ -> msg { boolValueUnknownFields = reverse (msg.boolValueUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldBool-            loop (msg { boolValueValue = v})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { boolValueUnknownFields = (uf : msg.boolValueUnknownFields)}))---- | Field descriptors for 'BoolValue', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-boolValueFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor BoolValue)-boolValueFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "value"-        , fdNumber = 1-        , fdTypeDesc = ScalarType BoolField-        , fdLabel = LabelOptional-        , fdGet = boolValueValue-        , fdSet = \v m -> m { boolValueValue = v }-        })-    ]--instance ProtoMessage BoolValue where-  protoMessageName _ = "google.protobuf.BoolValue"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultBoolValue-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = boolValueFieldDescriptors--instance IsMessage BoolValue--instance Aeson.ToJSON BoolValue where-  toJSON msg = jsonObject-      [ "value" .=: msg.boolValueValue--      ]--instance Aeson.FromJSON BoolValue where-  parseJSON = Aeson.withObject "BoolValue" $ \obj -> do-    fld_boolValueValue <- parseFieldMaybe obj "value"-    pure defaultBoolValue-      { boolValueValue = maybe (boolValueValue defaultBoolValue) id fld_boolValueValue-      }--instance Hashable BoolValue where-  hashWithSalt salt msg = hashWithSalt (salt) msg.boolValueValue--instance Proto.Extension.HasExtensions BoolValue where-  messageUnknownFields = boolValueUnknownFields-  setMessageUnknownFields !ufs msg = msg { boolValueUnknownFields = ufs }--instance Semigroup BoolValue where-  a <> b = BoolValue-    { boolValueValue = if b.boolValueValue == False then a.boolValueValue else b.boolValueValue-    , boolValueUnknownFields = a.boolValueUnknownFields <> b.boolValueUnknownFields-    }--instance Monoid BoolValue where-  mempty = defaultBoolValue--data StringValue = StringValue-  { stringValueValue :: !Text-  , stringValueUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultStringValue :: StringValue-defaultStringValue = StringValue-  { stringValueValue = ""-  , stringValueUnknownFields = []-  }--instance MessageEncode StringValue where-  buildSized msg =-    (if msg.stringValueValue == T.empty then mempty else archString 10 msg.stringValueValue)-    <> encodeUnknownFieldsSized msg.stringValueUnknownFields--instance MessageDecode StringValue where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultStringValue-    where-      stage_0 msg =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldString-          (\v -> loop (msg { stringValueValue = v}))-          (pure (case msg.stringValueUnknownFields of { [] -> msg; _ -> msg { stringValueUnknownFields = reverse (msg.stringValueUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.stringValueUnknownFields of { [] -> msg; _ -> msg { stringValueUnknownFields = reverse (msg.stringValueUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldString-            loop (msg { stringValueValue = v})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { stringValueUnknownFields = (uf : msg.stringValueUnknownFields)}))---- | Field descriptors for 'StringValue', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-stringValueFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor StringValue)-stringValueFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "value"-        , fdNumber = 1-        , fdTypeDesc = ScalarType StringField-        , fdLabel = LabelOptional-        , fdGet = stringValueValue-        , fdSet = \v m -> m { stringValueValue = v }-        })-    ]--instance ProtoMessage StringValue where-  protoMessageName _ = "google.protobuf.StringValue"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultStringValue-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = stringValueFieldDescriptors--instance IsMessage StringValue--instance Aeson.ToJSON StringValue where-  toJSON msg = jsonObject-      [ "value" .=: msg.stringValueValue--      ]--instance Aeson.FromJSON StringValue where-  parseJSON = Aeson.withObject "StringValue" $ \obj -> do-    fld_stringValueValue <- parseFieldMaybe obj "value"-    pure defaultStringValue-      { stringValueValue = maybe (stringValueValue defaultStringValue) id fld_stringValueValue-      }--instance Hashable StringValue where-  hashWithSalt salt msg = hashWithSalt (salt) msg.stringValueValue--instance Proto.Extension.HasExtensions StringValue where-  messageUnknownFields = stringValueUnknownFields-  setMessageUnknownFields !ufs msg = msg { stringValueUnknownFields = ufs }--instance Semigroup StringValue where-  a <> b = StringValue-    { stringValueValue = if b.stringValueValue == "" then a.stringValueValue else b.stringValueValue-    , stringValueUnknownFields = a.stringValueUnknownFields <> b.stringValueUnknownFields-    }--instance Monoid StringValue where-  mempty = defaultStringValue--data BytesValue = BytesValue-  { bytesValueValue :: !ByteString-  , bytesValueUnknownFields :: ![UnknownField]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass NFData--defaultBytesValue :: BytesValue-defaultBytesValue = BytesValue-  { bytesValueValue = ""-  , bytesValueUnknownFields = []-  }--instance MessageEncode BytesValue where-  buildSized msg =-    (if BS.null msg.bytesValueValue then mempty else archBytes 10 msg.bytesValueValue)-    <> encodeUnknownFieldsSized msg.bytesValueUnknownFields--instance MessageDecode BytesValue where-  {-# INLINE messageDecoder #-}-  messageDecoder = stage_0 defaultBytesValue-    where-      stage_0 msg =-        inOrderStage1-          (0xa :: Data.Word.Word8)-          decodeFieldBytes-          (\v -> loop (msg { bytesValueValue = v}))-          (pure (case msg.bytesValueUnknownFields of { [] -> msg; _ -> msg { bytesValueUnknownFields = reverse (msg.bytesValueUnknownFields) } }))-          (loop msg)-      loop msg = withTagM-        (pure (case msg.bytesValueUnknownFields of { [] -> msg; _ -> msg { bytesValueUnknownFields = reverse (msg.bytesValueUnknownFields) } }))-        (\fn wt -> case fn of-          1 -> do-            v <- decodeFieldBytes-            loop (msg { bytesValueValue = v})-          _ -> do-            uf <- captureUnknownField fn (Prelude.toEnum wt)-            loop (msg { bytesValueUnknownFields = (uf : msg.bytesValueUnknownFields)}))---- | Field descriptors for 'BytesValue', keyed by proto field number.------ Top-level CAF: allocated lazily on first force, shared on every--- subsequent 'protoFieldDescriptors' call (no per-call rebuild).-bytesValueFieldDescriptors :: IntMap.IntMap (SomeFieldDescriptor BytesValue)-bytesValueFieldDescriptors =-  IntMap.fromList-    [ (1, SomeField FieldDescriptor-        { fdName = "value"-        , fdNumber = 1-        , fdTypeDesc = ScalarType BytesField-        , fdLabel = LabelOptional-        , fdGet = bytesValueValue-        , fdSet = \v m -> m { bytesValueValue = v }-        })-    ]--instance ProtoMessage BytesValue where-  protoMessageName _ = "google.protobuf.BytesValue"-  protoPackageName _ = "google.protobuf"-  protoDefaultValue = defaultBytesValue-  protoFileDescriptorBytes _ = fileDescriptorProtoBytes-  protoFieldDescriptors _ = bytesValueFieldDescriptors--instance IsMessage BytesValue--instance Aeson.ToJSON BytesValue where-  toJSON msg = jsonObject-      [ bytesFieldToJSON "value" msg.bytesValueValue--      ]--instance Aeson.FromJSON BytesValue where-  parseJSON = Aeson.withObject "BytesValue" $ \obj -> do-    fld_bytesValueValue <- parseBytesFieldMaybe obj "value"-    pure defaultBytesValue-      { bytesValueValue = maybe (bytesValueValue defaultBytesValue) id fld_bytesValueValue-      }--instance Hashable BytesValue where-  hashWithSalt salt msg = hashWithSalt (salt) msg.bytesValueValue--instance Proto.Extension.HasExtensions BytesValue where-  messageUnknownFields = bytesValueUnknownFields-  setMessageUnknownFields !ufs msg = msg { bytesValueUnknownFields = ufs }--instance Semigroup BytesValue where-  a <> b = BytesValue-    { bytesValueValue = if b.bytesValueValue == "" then a.bytesValueValue else b.bytesValueValue-    , bytesValueUnknownFields = a.bytesValueUnknownFields <> b.bytesValueUnknownFields-    }--instance Monoid BytesValue where-  mempty = defaultBytesValue
− src/Proto/Google/Protobuf/WellKnownTypes/Wrappers/Util.hs 
@@ -1,196 +0,0 @@--- | Utility functions for @google.protobuf@ wrapper types.------ Wrapper types (@DoubleValue@, @FloatValue@, @Int64Value@, etc.) are used--- in protobuf to distinguish between "field is absent" and "field is present--- with the default value". These utilities provide ergonomic conversions--- between the wrapper message types and plain Haskell scalars, plus--- 'Maybe'-based interop for optional wrapper fields — mirroring the--- implicit boxing\/unboxing in Go, Java, and C++.-module Proto.Google.Protobuf.WellKnownTypes.Wrappers.Util-  ( -- * Double-    toDoubleValue-  , fromDoubleValue-  , maybeToDoubleValue-  , doubleValueToMaybe--    -- * Float-  , toFloatValue-  , fromFloatValue-  , maybeToFloatValue-  , floatValueToMaybe--    -- * Int64-  , toInt64Value-  , fromInt64Value-  , maybeToInt64Value-  , int64ValueToMaybe--    -- * UInt64-  , toUInt64Value-  , fromUInt64Value-  , maybeToUInt64Value-  , uInt64ValueToMaybe--    -- * Int32-  , toInt32Value-  , fromInt32Value-  , maybeToInt32Value-  , int32ValueToMaybe--    -- * UInt32-  , toUInt32Value-  , fromUInt32Value-  , maybeToUInt32Value-  , uInt32ValueToMaybe--    -- * Bool-  , toBoolValue-  , fromBoolValue-  , maybeToBoolValue-  , boolValueToMaybe--    -- * String-  , toStringValue-  , fromStringValue-  , maybeToStringValue-  , stringValueToMaybe--    -- * Bytes-  , toBytesValue-  , fromBytesValue-  , maybeToBytesValue-  , bytesValueToMaybe-  ) where--import Data.ByteString (ByteString)-import Data.Int (Int32, Int64)-import Data.Text (Text)-import Data.Word (Word32, Word64)--import Proto.Google.Protobuf.WellKnownTypes.Wrappers---- Double--toDoubleValue :: Double -> DoubleValue-toDoubleValue v = defaultDoubleValue { doubleValueValue = v }--fromDoubleValue :: DoubleValue -> Double-fromDoubleValue = doubleValueValue--maybeToDoubleValue :: Maybe Double -> Maybe DoubleValue-maybeToDoubleValue = fmap toDoubleValue--doubleValueToMaybe :: Maybe DoubleValue -> Maybe Double-doubleValueToMaybe = fmap fromDoubleValue---- Float--toFloatValue :: Float -> FloatValue-toFloatValue v = defaultFloatValue { floatValueValue = v }--fromFloatValue :: FloatValue -> Float-fromFloatValue = floatValueValue--maybeToFloatValue :: Maybe Float -> Maybe FloatValue-maybeToFloatValue = fmap toFloatValue--floatValueToMaybe :: Maybe FloatValue -> Maybe Float-floatValueToMaybe = fmap fromFloatValue---- Int64--toInt64Value :: Int64 -> Int64Value-toInt64Value v = defaultInt64Value { int64ValueValue = v }--fromInt64Value :: Int64Value -> Int64-fromInt64Value = int64ValueValue--maybeToInt64Value :: Maybe Int64 -> Maybe Int64Value-maybeToInt64Value = fmap toInt64Value--int64ValueToMaybe :: Maybe Int64Value -> Maybe Int64-int64ValueToMaybe = fmap fromInt64Value---- UInt64--toUInt64Value :: Word64 -> UInt64Value-toUInt64Value v = defaultUInt64Value { uInt64ValueValue = v }--fromUInt64Value :: UInt64Value -> Word64-fromUInt64Value = uInt64ValueValue--maybeToUInt64Value :: Maybe Word64 -> Maybe UInt64Value-maybeToUInt64Value = fmap toUInt64Value--uInt64ValueToMaybe :: Maybe UInt64Value -> Maybe Word64-uInt64ValueToMaybe = fmap fromUInt64Value---- Int32--toInt32Value :: Int32 -> Int32Value-toInt32Value v = defaultInt32Value { int32ValueValue = v }--fromInt32Value :: Int32Value -> Int32-fromInt32Value = int32ValueValue--maybeToInt32Value :: Maybe Int32 -> Maybe Int32Value-maybeToInt32Value = fmap toInt32Value--int32ValueToMaybe :: Maybe Int32Value -> Maybe Int32-int32ValueToMaybe = fmap fromInt32Value---- UInt32--toUInt32Value :: Word32 -> UInt32Value-toUInt32Value v = defaultUInt32Value { uInt32ValueValue = v }--fromUInt32Value :: UInt32Value -> Word32-fromUInt32Value = uInt32ValueValue--maybeToUInt32Value :: Maybe Word32 -> Maybe UInt32Value-maybeToUInt32Value = fmap toUInt32Value--uInt32ValueToMaybe :: Maybe UInt32Value -> Maybe Word32-uInt32ValueToMaybe = fmap fromUInt32Value---- Bool--toBoolValue :: Bool -> BoolValue-toBoolValue v = defaultBoolValue { boolValueValue = v }--fromBoolValue :: BoolValue -> Bool-fromBoolValue = boolValueValue--maybeToBoolValue :: Maybe Bool -> Maybe BoolValue-maybeToBoolValue = fmap toBoolValue--boolValueToMaybe :: Maybe BoolValue -> Maybe Bool-boolValueToMaybe = fmap fromBoolValue---- String--toStringValue :: Text -> StringValue-toStringValue v = defaultStringValue { stringValueValue = v }--fromStringValue :: StringValue -> Text-fromStringValue = stringValueValue--maybeToStringValue :: Maybe Text -> Maybe StringValue-maybeToStringValue = fmap toStringValue--stringValueToMaybe :: Maybe StringValue -> Maybe Text-stringValueToMaybe = fmap fromStringValue---- Bytes--toBytesValue :: ByteString -> BytesValue-toBytesValue v = defaultBytesValue { bytesValueValue = v }--fromBytesValue :: BytesValue -> ByteString-fromBytesValue = bytesValueValue--maybeToBytesValue :: Maybe ByteString -> Maybe BytesValue-maybeToBytesValue = fmap toBytesValue--bytesValueToMaybe :: Maybe BytesValue -> Maybe ByteString-bytesValueToMaybe = fmap fromBytesValue
+ src/Proto/Google/Protobuf/Wrappers.hs view
@@ -0,0 +1,1075 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}+{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-matches -Wno-unused-top-binds #-}++{- | Auto-generated protobuf types from package @google.protobuf@.++__THIS FILE IS AUTO-GENERATED BY wireform. DO NOT EDIT.__++Any manual changes will be overwritten the next time code+generation is run.  To modify the types or instances, edit the+@.proto@ source file and re-run the code generator.+-}+module Proto.Google.Protobuf.Wrappers where++import Control.DeepSeq (NFData (..))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as AesonKey+import Data.Aeson.KeyMap qualified as AesonKM+import Data.Aeson.Types qualified as Aeson+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Hashable (Hashable (..))+import Data.Int (Int32, Int64)+import Data.Map.Strict qualified as Map+import Data.Proxy (Proxy (..))+import Data.Reflection (Given (..), given)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V+import Data.Vector.Unboxed qualified as VU+import Data.Word (Word32, Word64)+import GHC.Generics (Generic)+import Proto.Decode+import Proto.Encode+import Proto.Extension qualified+import Proto.Internal.Encode.Archetype (+  archBool,+  archBoolSize,+  archBytes,+  archBytesSize,+  archDouble,+  archFixed32,+  archFixed32Size,+  archFixed64,+  archFixed64Size,+  archFloat,+  archSVarint32,+  archSVarint64,+  archString,+  archStringSize,+  archSubmessage,+  archSubmessageSize,+  archVarint,+  archVarintSize,+ )+import Proto.Internal.JSON (bytesFieldToJSON, bytesMapFieldToJSON, jsonObject, parseBytesFieldMaybe, parseBytesMapFieldMaybe, parseFieldMaybe, protoBytesToJSON, (.=:))+import Proto.Internal.JSON.Extension qualified as PJExt+import Proto.Internal.Wire (Tag (..), WireType (..))+import Proto.Internal.Wire.Encode (+  fieldBoolSize,+  fieldBytesSize,+  fieldDoubleSize,+  fieldFixed32Size,+  fieldFixed64Size,+  fieldFloatSize,+  fieldMessageSize,+  fieldSVarint32Size,+  fieldSVarint64Size,+  fieldTextSize,+  fieldVarintSize,+  putByteString,+  putDouble,+  putFixed32,+  putFixed64,+  putFloat,+  putLengthDelimited,+  putSVarint32,+  putSVarint64,+  putTag,+  putText,+  putVarint,+  putVarintSigned,+  tagSize,+  varintSize,+  varintSize32,+  zigZag32,+  zigZag64,+ )+import Proto.Registry (IsMessage)+import Proto.Registry qualified+import Proto.Schema (FieldDescriptor (..), FieldLabel' (..), FieldTypeDescriptor (..), ProtoMessage (..), ScalarFieldType (..), SomeFieldDescriptor (..))+import Wireform.Builder qualified as B+++{- | Serialized FileDescriptorProto for this .proto file.+Decode with @Proto.Google.Protobuf.Descriptor.decodeMessage@.+-}+fileDescriptorProtoBytes :: ByteString+fileDescriptorProtoBytes = "\x0a\x1e\x67\x6f\x6f\x67\x6c\x65\x2f\x70\x72\x6f\x74\x6f\x62\x75\x66\x2f\x77\x72\x61\x70\x70\x65\x72\x73\x2e\x70\x72\x6f\x74\x6f\x12\x0f\x67\x6f\x6f\x67\x6c\x65\x2e\x70\x72\x6f\x74\x6f\x62\x75\x66\x22\x1c\x0a\x0b\x44\x6f\x75\x62\x6c\x65\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x01\x22\x1b\x0a\x0a\x46\x6c\x6f\x61\x74\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x02\x22\x1b\x0a\x0a\x49\x6e\x74\x36\x34\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x03\x22\x1c\x0a\x0b\x55\x49\x6e\x74\x36\x34\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x04\x22\x1b\x0a\x0a\x49\x6e\x74\x33\x32\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x05\x22\x1c\x0a\x0b\x55\x49\x6e\x74\x33\x32\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x0d\x22\x1a\x0a\x09\x42\x6f\x6f\x6c\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x08\x22\x1c\x0a\x0b\x53\x74\x72\x69\x6e\x67\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x09\x22\x1b\x0a\x0a\x42\x79\x74\x65\x73\x56\x61\x6c\x75\x65\x12\x0d\x0a\x05\x76\x61\x6c\x75\x65\x18\x01\x20\x01\x28\x0c\x62\x06\x70\x72\x6f\x74\x6f\x33"+++data DoubleValue = DoubleValue+  { doubleValueValue :: {-# UNPACK #-} !Double+  , doubleValueUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultDoubleValue :: DoubleValue+defaultDoubleValue =+  DoubleValue+    { doubleValueValue = 0+    , doubleValueUnknownFields = []+    }+++instance MessageEncode DoubleValue where+  buildMessage msg =+    (if msg.doubleValueValue == 0 then mempty else archDouble 9 msg.doubleValueValue)+      <> encodeUnknownFields msg.doubleValueUnknownFields+++instance MessageSize DoubleValue where+  messageSize msg =+    (if msg.doubleValueValue == 0 then 0 else archFixed64Size)+      + unknownFieldsSize msg.doubleValueUnknownFields+++instance MessageDecode DoubleValue where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop 0 []+    where+      loop acc_0 acc_unknown_ =+        withTagM+          (pure (DoubleValue {doubleValueValue = acc_0, doubleValueUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- decodeFieldDouble+                loop v acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 (uf : acc_unknown_)+          )+++instance ProtoMessage DoubleValue where+  protoMessageName _ = "google.protobuf.DoubleValue"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultDoubleValue+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "value"+              , fdNumber = 1+              , fdTypeDesc = ScalarType DoubleField+              , fdLabel = LabelOptional+              , fdGet = doubleValueValue+              , fdSet = \v m -> m {doubleValueValue = v}+              }+        )+      ]+++instance IsMessage DoubleValue+++instance Aeson.ToJSON DoubleValue where+  toJSON msg =+    jsonObject+      [ "value" .=: msg.doubleValueValue+      ]+++instance Aeson.FromJSON DoubleValue where+  parseJSON = Aeson.withObject "DoubleValue" $ \obj -> do+    fld_doubleValueValue <- parseFieldMaybe obj "value"+    pure+      defaultDoubleValue+        { doubleValueValue = maybe (doubleValueValue defaultDoubleValue) id fld_doubleValueValue+        , doubleValueUnknownFields = []+        }+++instance Hashable DoubleValue where+  hashWithSalt salt msg = hashWithSalt (salt) msg.doubleValueValue+++instance Proto.Extension.HasExtensions DoubleValue where+  messageUnknownFields = doubleValueUnknownFields+  setMessageUnknownFields !ufs msg = msg {doubleValueUnknownFields = ufs}+++instance Semigroup DoubleValue where+  a <> b =+    DoubleValue+      { doubleValueValue = if b.doubleValueValue == 0 then a.doubleValueValue else b.doubleValueValue+      , doubleValueUnknownFields = a.doubleValueUnknownFields <> b.doubleValueUnknownFields+      }+++instance Monoid DoubleValue where+  mempty = defaultDoubleValue+++data FloatValue = FloatValue+  { floatValueValue :: {-# UNPACK #-} !Float+  , floatValueUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultFloatValue :: FloatValue+defaultFloatValue =+  FloatValue+    { floatValueValue = 0+    , floatValueUnknownFields = []+    }+++instance MessageEncode FloatValue where+  buildMessage msg =+    (if msg.floatValueValue == 0 then mempty else archFloat 13 msg.floatValueValue)+      <> encodeUnknownFields msg.floatValueUnknownFields+++instance MessageSize FloatValue where+  messageSize msg =+    (if msg.floatValueValue == 0 then 0 else archFixed32Size)+      + unknownFieldsSize msg.floatValueUnknownFields+++instance MessageDecode FloatValue where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop 0 []+    where+      loop acc_0 acc_unknown_ =+        withTagM+          (pure (FloatValue {floatValueValue = acc_0, floatValueUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- decodeFieldFloat+                loop v acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 (uf : acc_unknown_)+          )+++instance ProtoMessage FloatValue where+  protoMessageName _ = "google.protobuf.FloatValue"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultFloatValue+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "value"+              , fdNumber = 1+              , fdTypeDesc = ScalarType FloatField+              , fdLabel = LabelOptional+              , fdGet = floatValueValue+              , fdSet = \v m -> m {floatValueValue = v}+              }+        )+      ]+++instance IsMessage FloatValue+++instance Aeson.ToJSON FloatValue where+  toJSON msg =+    jsonObject+      [ "value" .=: msg.floatValueValue+      ]+++instance Aeson.FromJSON FloatValue where+  parseJSON = Aeson.withObject "FloatValue" $ \obj -> do+    fld_floatValueValue <- parseFieldMaybe obj "value"+    pure+      defaultFloatValue+        { floatValueValue = maybe (floatValueValue defaultFloatValue) id fld_floatValueValue+        , floatValueUnknownFields = []+        }+++instance Hashable FloatValue where+  hashWithSalt salt msg = hashWithSalt (salt) msg.floatValueValue+++instance Proto.Extension.HasExtensions FloatValue where+  messageUnknownFields = floatValueUnknownFields+  setMessageUnknownFields !ufs msg = msg {floatValueUnknownFields = ufs}+++instance Semigroup FloatValue where+  a <> b =+    FloatValue+      { floatValueValue = if b.floatValueValue == 0 then a.floatValueValue else b.floatValueValue+      , floatValueUnknownFields = a.floatValueUnknownFields <> b.floatValueUnknownFields+      }+++instance Monoid FloatValue where+  mempty = defaultFloatValue+++data Int64Value = Int64Value+  { int64ValueValue :: {-# UNPACK #-} !Int64+  , int64ValueUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultInt64Value :: Int64Value+defaultInt64Value =+  Int64Value+    { int64ValueValue = 0+    , int64ValueUnknownFields = []+    }+++instance MessageEncode Int64Value where+  buildMessage msg =+    (if msg.int64ValueValue == 0 then mempty else archVarint 8 (fromIntegral msg.int64ValueValue))+      <> encodeUnknownFields msg.int64ValueUnknownFields+++instance MessageSize Int64Value where+  messageSize msg =+    (if msg.int64ValueValue == 0 then 0 else archVarintSize (fromIntegral msg.int64ValueValue))+      + unknownFieldsSize msg.int64ValueUnknownFields+++instance MessageDecode Int64Value where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop 0 []+    where+      loop acc_0 acc_unknown_ =+        withTagM+          (pure (Int64Value {int64ValueValue = acc_0, int64ValueUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- (fromIntegral <$> decodeFieldVarint)+                loop v acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 (uf : acc_unknown_)+          )+++instance ProtoMessage Int64Value where+  protoMessageName _ = "google.protobuf.Int64Value"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultInt64Value+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "value"+              , fdNumber = 1+              , fdTypeDesc = ScalarType Int64Field+              , fdLabel = LabelOptional+              , fdGet = int64ValueValue+              , fdSet = \v m -> m {int64ValueValue = v}+              }+        )+      ]+++instance IsMessage Int64Value+++instance Aeson.ToJSON Int64Value where+  toJSON msg =+    jsonObject+      [ "value" .=: msg.int64ValueValue+      ]+++instance Aeson.FromJSON Int64Value where+  parseJSON = Aeson.withObject "Int64Value" $ \obj -> do+    fld_int64ValueValue <- parseFieldMaybe obj "value"+    pure+      defaultInt64Value+        { int64ValueValue = maybe (int64ValueValue defaultInt64Value) id fld_int64ValueValue+        , int64ValueUnknownFields = []+        }+++instance Hashable Int64Value where+  hashWithSalt salt msg = hashWithSalt (salt) msg.int64ValueValue+++instance Proto.Extension.HasExtensions Int64Value where+  messageUnknownFields = int64ValueUnknownFields+  setMessageUnknownFields !ufs msg = msg {int64ValueUnknownFields = ufs}+++instance Semigroup Int64Value where+  a <> b =+    Int64Value+      { int64ValueValue = if b.int64ValueValue == 0 then a.int64ValueValue else b.int64ValueValue+      , int64ValueUnknownFields = a.int64ValueUnknownFields <> b.int64ValueUnknownFields+      }+++instance Monoid Int64Value where+  mempty = defaultInt64Value+++data UInt64Value = UInt64Value+  { uInt64ValueValue :: {-# UNPACK #-} !Word64+  , uInt64ValueUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultUInt64Value :: UInt64Value+defaultUInt64Value =+  UInt64Value+    { uInt64ValueValue = 0+    , uInt64ValueUnknownFields = []+    }+++instance MessageEncode UInt64Value where+  buildMessage msg =+    (if msg.uInt64ValueValue == 0 then mempty else archVarint 8 msg.uInt64ValueValue)+      <> encodeUnknownFields msg.uInt64ValueUnknownFields+++instance MessageSize UInt64Value where+  messageSize msg =+    (if msg.uInt64ValueValue == 0 then 0 else archVarintSize msg.uInt64ValueValue)+      + unknownFieldsSize msg.uInt64ValueUnknownFields+++instance MessageDecode UInt64Value where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop 0 []+    where+      loop acc_0 acc_unknown_ =+        withTagM+          (pure (UInt64Value {uInt64ValueValue = acc_0, uInt64ValueUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- decodeFieldVarint+                loop v acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 (uf : acc_unknown_)+          )+++instance ProtoMessage UInt64Value where+  protoMessageName _ = "google.protobuf.UInt64Value"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultUInt64Value+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "value"+              , fdNumber = 1+              , fdTypeDesc = ScalarType UInt64Field+              , fdLabel = LabelOptional+              , fdGet = uInt64ValueValue+              , fdSet = \v m -> m {uInt64ValueValue = v}+              }+        )+      ]+++instance IsMessage UInt64Value+++instance Aeson.ToJSON UInt64Value where+  toJSON msg =+    jsonObject+      [ "value" .=: msg.uInt64ValueValue+      ]+++instance Aeson.FromJSON UInt64Value where+  parseJSON = Aeson.withObject "UInt64Value" $ \obj -> do+    fld_uInt64ValueValue <- parseFieldMaybe obj "value"+    pure+      defaultUInt64Value+        { uInt64ValueValue = maybe (uInt64ValueValue defaultUInt64Value) id fld_uInt64ValueValue+        , uInt64ValueUnknownFields = []+        }+++instance Hashable UInt64Value where+  hashWithSalt salt msg = hashWithSalt (salt) msg.uInt64ValueValue+++instance Proto.Extension.HasExtensions UInt64Value where+  messageUnknownFields = uInt64ValueUnknownFields+  setMessageUnknownFields !ufs msg = msg {uInt64ValueUnknownFields = ufs}+++instance Semigroup UInt64Value where+  a <> b =+    UInt64Value+      { uInt64ValueValue = if b.uInt64ValueValue == 0 then a.uInt64ValueValue else b.uInt64ValueValue+      , uInt64ValueUnknownFields = a.uInt64ValueUnknownFields <> b.uInt64ValueUnknownFields+      }+++instance Monoid UInt64Value where+  mempty = defaultUInt64Value+++data Int32Value = Int32Value+  { int32ValueValue :: {-# UNPACK #-} !Int32+  , int32ValueUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultInt32Value :: Int32Value+defaultInt32Value =+  Int32Value+    { int32ValueValue = 0+    , int32ValueUnknownFields = []+    }+++instance MessageEncode Int32Value where+  buildMessage msg =+    (if msg.int32ValueValue == 0 then mempty else archVarint 8 (fromIntegral msg.int32ValueValue))+      <> encodeUnknownFields msg.int32ValueUnknownFields+++instance MessageSize Int32Value where+  messageSize msg =+    (if msg.int32ValueValue == 0 then 0 else archVarintSize (fromIntegral msg.int32ValueValue))+      + unknownFieldsSize msg.int32ValueUnknownFields+++instance MessageDecode Int32Value where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop 0 []+    where+      loop acc_0 acc_unknown_ =+        withTagM+          (pure (Int32Value {int32ValueValue = acc_0, int32ValueUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- (fromIntegral <$> decodeFieldVarint)+                loop v acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 (uf : acc_unknown_)+          )+++instance ProtoMessage Int32Value where+  protoMessageName _ = "google.protobuf.Int32Value"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultInt32Value+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "value"+              , fdNumber = 1+              , fdTypeDesc = ScalarType Int32Field+              , fdLabel = LabelOptional+              , fdGet = int32ValueValue+              , fdSet = \v m -> m {int32ValueValue = v}+              }+        )+      ]+++instance IsMessage Int32Value+++instance Aeson.ToJSON Int32Value where+  toJSON msg =+    jsonObject+      [ "value" .=: msg.int32ValueValue+      ]+++instance Aeson.FromJSON Int32Value where+  parseJSON = Aeson.withObject "Int32Value" $ \obj -> do+    fld_int32ValueValue <- parseFieldMaybe obj "value"+    pure+      defaultInt32Value+        { int32ValueValue = maybe (int32ValueValue defaultInt32Value) id fld_int32ValueValue+        , int32ValueUnknownFields = []+        }+++instance Hashable Int32Value where+  hashWithSalt salt msg = hashWithSalt (salt) msg.int32ValueValue+++instance Proto.Extension.HasExtensions Int32Value where+  messageUnknownFields = int32ValueUnknownFields+  setMessageUnknownFields !ufs msg = msg {int32ValueUnknownFields = ufs}+++instance Semigroup Int32Value where+  a <> b =+    Int32Value+      { int32ValueValue = if b.int32ValueValue == 0 then a.int32ValueValue else b.int32ValueValue+      , int32ValueUnknownFields = a.int32ValueUnknownFields <> b.int32ValueUnknownFields+      }+++instance Monoid Int32Value where+  mempty = defaultInt32Value+++data UInt32Value = UInt32Value+  { uInt32ValueValue :: {-# UNPACK #-} !Word32+  , uInt32ValueUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultUInt32Value :: UInt32Value+defaultUInt32Value =+  UInt32Value+    { uInt32ValueValue = 0+    , uInt32ValueUnknownFields = []+    }+++instance MessageEncode UInt32Value where+  buildMessage msg =+    (if msg.uInt32ValueValue == 0 then mempty else archVarint 8 (fromIntegral msg.uInt32ValueValue))+      <> encodeUnknownFields msg.uInt32ValueUnknownFields+++instance MessageSize UInt32Value where+  messageSize msg =+    (if msg.uInt32ValueValue == 0 then 0 else archVarintSize (fromIntegral msg.uInt32ValueValue))+      + unknownFieldsSize msg.uInt32ValueUnknownFields+++instance MessageDecode UInt32Value where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop 0 []+    where+      loop acc_0 acc_unknown_ =+        withTagM+          (pure (UInt32Value {uInt32ValueValue = acc_0, uInt32ValueUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- (fromIntegral <$> decodeFieldVarint)+                loop v acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 (uf : acc_unknown_)+          )+++instance ProtoMessage UInt32Value where+  protoMessageName _ = "google.protobuf.UInt32Value"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultUInt32Value+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "value"+              , fdNumber = 1+              , fdTypeDesc = ScalarType UInt32Field+              , fdLabel = LabelOptional+              , fdGet = uInt32ValueValue+              , fdSet = \v m -> m {uInt32ValueValue = v}+              }+        )+      ]+++instance IsMessage UInt32Value+++instance Aeson.ToJSON UInt32Value where+  toJSON msg =+    jsonObject+      [ "value" .=: msg.uInt32ValueValue+      ]+++instance Aeson.FromJSON UInt32Value where+  parseJSON = Aeson.withObject "UInt32Value" $ \obj -> do+    fld_uInt32ValueValue <- parseFieldMaybe obj "value"+    pure+      defaultUInt32Value+        { uInt32ValueValue = maybe (uInt32ValueValue defaultUInt32Value) id fld_uInt32ValueValue+        , uInt32ValueUnknownFields = []+        }+++instance Hashable UInt32Value where+  hashWithSalt salt msg = hashWithSalt (salt) msg.uInt32ValueValue+++instance Proto.Extension.HasExtensions UInt32Value where+  messageUnknownFields = uInt32ValueUnknownFields+  setMessageUnknownFields !ufs msg = msg {uInt32ValueUnknownFields = ufs}+++instance Semigroup UInt32Value where+  a <> b =+    UInt32Value+      { uInt32ValueValue = if b.uInt32ValueValue == 0 then a.uInt32ValueValue else b.uInt32ValueValue+      , uInt32ValueUnknownFields = a.uInt32ValueUnknownFields <> b.uInt32ValueUnknownFields+      }+++instance Monoid UInt32Value where+  mempty = defaultUInt32Value+++data BoolValue = BoolValue+  { boolValueValue :: {-# UNPACK #-} !Bool+  , boolValueUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultBoolValue :: BoolValue+defaultBoolValue =+  BoolValue+    { boolValueValue = False+    , boolValueUnknownFields = []+    }+++instance MessageEncode BoolValue where+  buildMessage msg =+    (if msg.boolValueValue == False then mempty else archBool 8 msg.boolValueValue)+      <> encodeUnknownFields msg.boolValueUnknownFields+++instance MessageSize BoolValue where+  messageSize msg =+    (if msg.boolValueValue == False then 0 else archBoolSize)+      + unknownFieldsSize msg.boolValueUnknownFields+++instance MessageDecode BoolValue where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop False []+    where+      loop acc_0 acc_unknown_ =+        withTagM+          (pure (BoolValue {boolValueValue = acc_0, boolValueUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- decodeFieldBool+                loop v acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 (uf : acc_unknown_)+          )+++instance ProtoMessage BoolValue where+  protoMessageName _ = "google.protobuf.BoolValue"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultBoolValue+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "value"+              , fdNumber = 1+              , fdTypeDesc = ScalarType BoolField+              , fdLabel = LabelOptional+              , fdGet = boolValueValue+              , fdSet = \v m -> m {boolValueValue = v}+              }+        )+      ]+++instance IsMessage BoolValue+++instance Aeson.ToJSON BoolValue where+  toJSON msg =+    jsonObject+      [ "value" .=: msg.boolValueValue+      ]+++instance Aeson.FromJSON BoolValue where+  parseJSON = Aeson.withObject "BoolValue" $ \obj -> do+    fld_boolValueValue <- parseFieldMaybe obj "value"+    pure+      defaultBoolValue+        { boolValueValue = maybe (boolValueValue defaultBoolValue) id fld_boolValueValue+        , boolValueUnknownFields = []+        }+++instance Hashable BoolValue where+  hashWithSalt salt msg = hashWithSalt (salt) msg.boolValueValue+++instance Proto.Extension.HasExtensions BoolValue where+  messageUnknownFields = boolValueUnknownFields+  setMessageUnknownFields !ufs msg = msg {boolValueUnknownFields = ufs}+++instance Semigroup BoolValue where+  a <> b =+    BoolValue+      { boolValueValue = if b.boolValueValue == False then a.boolValueValue else b.boolValueValue+      , boolValueUnknownFields = a.boolValueUnknownFields <> b.boolValueUnknownFields+      }+++instance Monoid BoolValue where+  mempty = defaultBoolValue+++data StringValue = StringValue+  { stringValueValue :: !Text+  , stringValueUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultStringValue :: StringValue+defaultStringValue =+  StringValue+    { stringValueValue = ""+    , stringValueUnknownFields = []+    }+++instance MessageEncode StringValue where+  buildMessage msg =+    (if msg.stringValueValue == T.empty then mempty else archString 10 msg.stringValueValue)+      <> encodeUnknownFields msg.stringValueUnknownFields+++instance MessageSize StringValue where+  messageSize msg =+    (if msg.stringValueValue == T.empty then 0 else archStringSize msg.stringValueValue)+      + unknownFieldsSize msg.stringValueUnknownFields+++instance MessageDecode StringValue where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop "" []+    where+      loop acc_0 acc_unknown_ =+        withTagM+          (pure (StringValue {stringValueValue = acc_0, stringValueUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- decodeFieldString+                loop v acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 (uf : acc_unknown_)+          )+++instance ProtoMessage StringValue where+  protoMessageName _ = "google.protobuf.StringValue"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultStringValue+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "value"+              , fdNumber = 1+              , fdTypeDesc = ScalarType StringField+              , fdLabel = LabelOptional+              , fdGet = stringValueValue+              , fdSet = \v m -> m {stringValueValue = v}+              }+        )+      ]+++instance IsMessage StringValue+++instance Aeson.ToJSON StringValue where+  toJSON msg =+    jsonObject+      [ "value" .=: msg.stringValueValue+      ]+++instance Aeson.FromJSON StringValue where+  parseJSON = Aeson.withObject "StringValue" $ \obj -> do+    fld_stringValueValue <- parseFieldMaybe obj "value"+    pure+      defaultStringValue+        { stringValueValue = maybe (stringValueValue defaultStringValue) id fld_stringValueValue+        , stringValueUnknownFields = []+        }+++instance Hashable StringValue where+  hashWithSalt salt msg = hashWithSalt (salt) msg.stringValueValue+++instance Proto.Extension.HasExtensions StringValue where+  messageUnknownFields = stringValueUnknownFields+  setMessageUnknownFields !ufs msg = msg {stringValueUnknownFields = ufs}+++instance Semigroup StringValue where+  a <> b =+    StringValue+      { stringValueValue = if b.stringValueValue == "" then a.stringValueValue else b.stringValueValue+      , stringValueUnknownFields = a.stringValueUnknownFields <> b.stringValueUnknownFields+      }+++instance Monoid StringValue where+  mempty = defaultStringValue+++data BytesValue = BytesValue+  { bytesValueValue :: !ByteString+  , bytesValueUnknownFields :: ![UnknownField]+  }+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)+++defaultBytesValue :: BytesValue+defaultBytesValue =+  BytesValue+    { bytesValueValue = ""+    , bytesValueUnknownFields = []+    }+++instance MessageEncode BytesValue where+  buildMessage msg =+    (if BS.null msg.bytesValueValue then mempty else archBytes 10 msg.bytesValueValue)+      <> encodeUnknownFields msg.bytesValueUnknownFields+++instance MessageSize BytesValue where+  messageSize msg =+    (if BS.null msg.bytesValueValue then 0 else archBytesSize msg.bytesValueValue)+      + unknownFieldsSize msg.bytesValueUnknownFields+++instance MessageDecode BytesValue where+  {-# INLINE messageDecoder #-}+  messageDecoder = loop "" []+    where+      loop acc_0 acc_unknown_ =+        withTagM+          (pure (BytesValue {bytesValueValue = acc_0, bytesValueUnknownFields = reverse acc_unknown_}))+          ( \fn wt -> case fn of+              1 -> do+                v <- decodeFieldBytes+                loop v acc_unknown_+              _ -> do+                uf <- captureUnknownField fn (toEnum wt)+                loop acc_0 (uf : acc_unknown_)+          )+++instance ProtoMessage BytesValue where+  protoMessageName _ = "google.protobuf.BytesValue"+  protoPackageName _ = "google.protobuf"+  protoDefaultValue = defaultBytesValue+  protoFileDescriptorBytes _ = fileDescriptorProtoBytes+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "value"+              , fdNumber = 1+              , fdTypeDesc = ScalarType BytesField+              , fdLabel = LabelOptional+              , fdGet = bytesValueValue+              , fdSet = \v m -> m {bytesValueValue = v}+              }+        )+      ]+++instance IsMessage BytesValue+++instance Aeson.ToJSON BytesValue where+  toJSON msg =+    jsonObject+      [ bytesFieldToJSON "value" msg.bytesValueValue+      ]+++instance Aeson.FromJSON BytesValue where+  parseJSON = Aeson.withObject "BytesValue" $ \obj -> do+    fld_bytesValueValue <- parseBytesFieldMaybe obj "value"+    pure+      defaultBytesValue+        { bytesValueValue = maybe (bytesValueValue defaultBytesValue) id fld_bytesValueValue+        , bytesValueUnknownFields = []+        }+++instance Hashable BytesValue where+  hashWithSalt salt msg = hashWithSalt (salt) msg.bytesValueValue+++instance Proto.Extension.HasExtensions BytesValue where+  messageUnknownFields = bytesValueUnknownFields+  setMessageUnknownFields !ufs msg = msg {bytesValueUnknownFields = ufs}+++instance Semigroup BytesValue where+  a <> b =+    BytesValue+      { bytesValueValue = if b.bytesValueValue == "" then a.bytesValueValue else b.bytesValueValue+      , bytesValueUnknownFields = a.bytesValueUnknownFields <> b.bytesValueUnknownFields+      }+++instance Monoid BytesValue where+  mempty = defaultBytesValue
+ src/Proto/Google/Protobuf/Wrappers/Util.hs view
@@ -0,0 +1,232 @@+{- | Utility functions for @google.protobuf@ wrapper types.++Wrapper types (@DoubleValue@, @FloatValue@, @Int64Value@, etc.) are used+in protobuf to distinguish between "field is absent" and "field is present+with the default value". These utilities provide ergonomic conversions+between the wrapper message types and plain Haskell scalars, plus+'Maybe'-based interop for optional wrapper fields — mirroring the+implicit boxing\/unboxing in Go, Java, and C++.+-}+module Proto.Google.Protobuf.Wrappers.Util (+  -- * Double+  toDoubleValue,+  fromDoubleValue,+  maybeToDoubleValue,+  doubleValueToMaybe,++  -- * Float+  toFloatValue,+  fromFloatValue,+  maybeToFloatValue,+  floatValueToMaybe,++  -- * Int64+  toInt64Value,+  fromInt64Value,+  maybeToInt64Value,+  int64ValueToMaybe,++  -- * UInt64+  toUInt64Value,+  fromUInt64Value,+  maybeToUInt64Value,+  uInt64ValueToMaybe,++  -- * Int32+  toInt32Value,+  fromInt32Value,+  maybeToInt32Value,+  int32ValueToMaybe,++  -- * UInt32+  toUInt32Value,+  fromUInt32Value,+  maybeToUInt32Value,+  uInt32ValueToMaybe,++  -- * Bool+  toBoolValue,+  fromBoolValue,+  maybeToBoolValue,+  boolValueToMaybe,++  -- * String+  toStringValue,+  fromStringValue,+  maybeToStringValue,+  stringValueToMaybe,++  -- * Bytes+  toBytesValue,+  fromBytesValue,+  maybeToBytesValue,+  bytesValueToMaybe,+) where++import Data.ByteString (ByteString)+import Data.Int (Int32, Int64)+import Data.Text (Text)+import Data.Word (Word32, Word64)+import Proto.Google.Protobuf.Wrappers+++-- Double++toDoubleValue :: Double -> DoubleValue+toDoubleValue v = defaultDoubleValue {doubleValueValue = v}+++fromDoubleValue :: DoubleValue -> Double+fromDoubleValue = doubleValueValue+++maybeToDoubleValue :: Maybe Double -> Maybe DoubleValue+maybeToDoubleValue = fmap toDoubleValue+++doubleValueToMaybe :: Maybe DoubleValue -> Maybe Double+doubleValueToMaybe = fmap fromDoubleValue+++-- Float++toFloatValue :: Float -> FloatValue+toFloatValue v = defaultFloatValue {floatValueValue = v}+++fromFloatValue :: FloatValue -> Float+fromFloatValue = floatValueValue+++maybeToFloatValue :: Maybe Float -> Maybe FloatValue+maybeToFloatValue = fmap toFloatValue+++floatValueToMaybe :: Maybe FloatValue -> Maybe Float+floatValueToMaybe = fmap fromFloatValue+++-- Int64++toInt64Value :: Int64 -> Int64Value+toInt64Value v = defaultInt64Value {int64ValueValue = v}+++fromInt64Value :: Int64Value -> Int64+fromInt64Value = int64ValueValue+++maybeToInt64Value :: Maybe Int64 -> Maybe Int64Value+maybeToInt64Value = fmap toInt64Value+++int64ValueToMaybe :: Maybe Int64Value -> Maybe Int64+int64ValueToMaybe = fmap fromInt64Value+++-- UInt64++toUInt64Value :: Word64 -> UInt64Value+toUInt64Value v = defaultUInt64Value {uInt64ValueValue = v}+++fromUInt64Value :: UInt64Value -> Word64+fromUInt64Value = uInt64ValueValue+++maybeToUInt64Value :: Maybe Word64 -> Maybe UInt64Value+maybeToUInt64Value = fmap toUInt64Value+++uInt64ValueToMaybe :: Maybe UInt64Value -> Maybe Word64+uInt64ValueToMaybe = fmap fromUInt64Value+++-- Int32++toInt32Value :: Int32 -> Int32Value+toInt32Value v = defaultInt32Value {int32ValueValue = v}+++fromInt32Value :: Int32Value -> Int32+fromInt32Value = int32ValueValue+++maybeToInt32Value :: Maybe Int32 -> Maybe Int32Value+maybeToInt32Value = fmap toInt32Value+++int32ValueToMaybe :: Maybe Int32Value -> Maybe Int32+int32ValueToMaybe = fmap fromInt32Value+++-- UInt32++toUInt32Value :: Word32 -> UInt32Value+toUInt32Value v = defaultUInt32Value {uInt32ValueValue = v}+++fromUInt32Value :: UInt32Value -> Word32+fromUInt32Value = uInt32ValueValue+++maybeToUInt32Value :: Maybe Word32 -> Maybe UInt32Value+maybeToUInt32Value = fmap toUInt32Value+++uInt32ValueToMaybe :: Maybe UInt32Value -> Maybe Word32+uInt32ValueToMaybe = fmap fromUInt32Value+++-- Bool++toBoolValue :: Bool -> BoolValue+toBoolValue v = defaultBoolValue {boolValueValue = v}+++fromBoolValue :: BoolValue -> Bool+fromBoolValue = boolValueValue+++maybeToBoolValue :: Maybe Bool -> Maybe BoolValue+maybeToBoolValue = fmap toBoolValue+++boolValueToMaybe :: Maybe BoolValue -> Maybe Bool+boolValueToMaybe = fmap fromBoolValue+++-- String++toStringValue :: Text -> StringValue+toStringValue v = defaultStringValue {stringValueValue = v}+++fromStringValue :: StringValue -> Text+fromStringValue = stringValueValue+++maybeToStringValue :: Maybe Text -> Maybe StringValue+maybeToStringValue = fmap toStringValue+++stringValueToMaybe :: Maybe StringValue -> Maybe Text+stringValueToMaybe = fmap fromStringValue+++-- Bytes++toBytesValue :: ByteString -> BytesValue+toBytesValue v = defaultBytesValue {bytesValueValue = v}+++fromBytesValue :: BytesValue -> ByteString+fromBytesValue = bytesValueValue+++maybeToBytesValue :: Maybe ByteString -> Maybe BytesValue+maybeToBytesValue = fmap toBytesValue+++bytesValueToMaybe :: Maybe BytesValue -> Maybe ByteString+bytesValueToMaybe = fmap fromBytesValue
src/Proto/IDL/AST.hs view
@@ -57,6 +57,7 @@   OneofField' (..),   OneofField,   ReservedDef (..),+  ReservedName (..),   ReservedRange (..),    -- * Enums@@ -99,10 +100,6 @@   JsonFormatFeature (..),   defaultFeatureSet,   featuresForEdition,-  applyFeatureOptions,-  resolveFileFeatures,-  resolveFieldFeatures,-  applyEditionFieldPresence,    -- * Phase conversion   stripSpans,@@ -344,8 +341,15 @@     MEMapField !(MapField' p)   | -- | A reserved declaration.     MEReserved !ReservedDef-  | -- | An extensions range declaration.-    MEExtensions ![ExtensionRange]+  | {- | An extensions range declaration, with any trailing options+    (e.g. @extensions 4 to 8 [verification = UNVERIFIED];@ or an+    editions @[declaration = {…}]@ list).+    -}+    MEExtensions ![ExtensionRange] ![OptionDef' p]+  | {- | A nested @extend@ block (proto2) declaring extension fields on+    another type, with the extended type name and the additional fields.+    -}+    MEExtend !Text ![FieldDef' p]   | -- | A message-level option.     MEOption !(OptionDef' p)   | -- | Standalone comment inside a message body.@@ -529,11 +533,26 @@   = -- | Reserved field number ranges.     ReservedNumbers ![ReservedRange]   | -- | Reserved field names.-    ReservedNames ![Text]+    ReservedNames ![ReservedName]   deriving stock (Show, Eq, Generic)   deriving anyclass (NFData)  +{- | A single name in a @reserved@ declaration.++proto2/proto3 spell reserved names as quoted string literals; editions+(2023+) spell them as bare identifiers. The spelling is retained so that+printing reproduces the correct token for the file's syntax.+-}+data ReservedName+  = -- | A quoted reserved name, e.g. @"foo"@ (proto2/proto3).+    QuotedReservedName !Text+  | -- | A bare-identifier reserved name, e.g. @foo@ (editions 2023+).+    IdentReservedName !Text+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)++ -- | A range within a @reserved@ declaration. data ReservedRange   = -- | A single reserved field number.@@ -864,125 +883,6 @@ featuresForEdition _ = defaultFeatureSet  -{- | Apply @features.*@ option overrides from a list of 'OptionDef's onto-a base 'FeatureSet'.--Handles the options defined in @google/protobuf/descriptor.proto@-(@features.field_presence@, @features.enum_type@,-@features.repeated_field_encoding@, @features.utf8_validation@,-@features.message_encoding@, @features.json_format@).--Unknown feature names and unrecognised values are silently ignored so-that a schema using a future edition feature does not break parsing.--}-applyFeatureOptions :: [OptionDef] -> FeatureSet -> FeatureSet-applyFeatureOptions opts base = foldr applyOne base opts-  where-    applyOne (OptionDef _ (OptionName parts) val) fs-      | matchFeature "field_presence" parts =-          case identOf val of-            "IMPLICIT"      -> fs { featureFieldPresence = ImplicitPresence }-            "EXPLICIT"      -> fs { featureFieldPresence = ExplicitPresence }-            "LEGACY_REQUIRED" -> fs { featureFieldPresence = LegacyRequired }-            _ -> fs-      | matchFeature "enum_type" parts =-          case identOf val of-            "OPEN"   -> fs { featureEnumType = OpenEnum }-            "CLOSED" -> fs { featureEnumType = ClosedEnum }-            _ -> fs-      | matchFeature "repeated_field_encoding" parts =-          case identOf val of-            "PACKED"   -> fs { featureRepeatedFieldEncoding = PackedEncoding }-            "EXPANDED" -> fs { featureRepeatedFieldEncoding = ExpandedEncoding }-            _ -> fs-      | matchFeature "utf8_validation" parts =-          case identOf val of-            "VERIFY" -> fs { featureUtf8Validation = Utf8Verify }-            "NONE"   -> fs { featureUtf8Validation = Utf8None }-            _ -> fs-      | matchFeature "message_encoding" parts =-          case identOf val of-            "LENGTH_PREFIXED" -> fs { featureMessageEncoding = LengthPrefixedEncoding }-            "DELIMITED"       -> fs { featureMessageEncoding = DelimitedEncoding }-            _ -> fs-      | matchFeature "json_format" parts =-          case identOf val of-            "ALLOW"              -> fs { featureJsonFormat = JsonAllow }-            "LEGACY_BEST_EFFORT" -> fs { featureJsonFormat = JsonLegacyBestEffort }-            _ -> fs-      | otherwise = fs--    -- Match when the option name is [SimpleOption "features", SimpleOption key].-    matchFeature :: Text -> [OptionNamePart] -> Bool-    matchFeature key [SimpleOption "features", SimpleOption k] = k == key-    matchFeature _ _ = False--    identOf :: Constant -> Text-    identOf (CIdent t) = t-    identOf _ = ""----- | Resolve the effective 'FeatureSet' for a file given its syntax and--- any file-level @option features.*@ overrides.-resolveFileFeatures :: Syntax -> [OptionDef] -> FeatureSet-resolveFileFeatures (Editions ed) opts = applyFeatureOptions opts (featuresForEdition ed)-resolveFileFeatures _ _ = defaultFeatureSet----- | Resolve the effective 'FeatureSet' for a field, inheriting from the--- parent 'FeatureSet' and applying any field-level @features.*@ overrides.-resolveFieldFeatures :: FeatureSet -> [OptionDef] -> FeatureSet-resolveFieldFeatures parent opts = applyFeatureOptions opts parent---{- | Post-parse normalization pass for editions schemas.--In editions, the @optional@\/@required@\/@repeated@ label keywords are-absent from the syntax; field cardinality is controlled by-@option features.field_presence@. This pass translates that feature back-into 'fieldLabel' so that downstream codegen and TH paths see the same-'FieldLabel' representation as they do for proto2\/proto3:--  * @EXPLICIT@   — sets 'fieldLabel' to @Just Optional@ (has-bit tracking).-  * @IMPLICIT@   — leaves 'fieldLabel' as @Nothing@ (proto3-style, zero = absent).-  * @LEGACY_REQUIRED@ — sets 'fieldLabel' to @Just Required@.--No-op for proto2 and proto3 files.--}-applyEditionFieldPresence :: ProtoFile -> ProtoFile-applyEditionFieldPresence pf = case protoSyntax pf of-  Editions ed ->-    let fileFs = resolveFileFeatures (Editions ed) (protoOptions pf)-    in pf {protoTopLevels = fmap (applyTLPresence fileFs) (protoTopLevels pf)}-  _ -> pf-  where-    applyTLPresence fs (TLMessage msg) = TLMessage (applyMsgPresence fs msg)-    applyTLPresence _ tl = tl--    applyMsgPresence fs msg =-      msg {msgElements = fmap (applyElemPresence fs) (msgElements msg)}--    applyElemPresence parentFs = \case-      MEField fd ->-        let fieldFs = resolveFieldFeatures parentFs (fieldOptions fd)-        in MEField fd {fieldLabel = effectiveLabel (featureFieldPresence fieldFs) (fieldLabel fd)}-      MEMessage inner ->-        MEMessage (applyMsgPresence parentFs inner)-      MEOneof od ->-        -- Oneof fields do not participate in presence features (they are-        -- always explicitly-tracked by the oneof index).-        MEOneof od-      other -> other--    -- Translate a FieldPresenceFeature to the appropriate FieldLabel,-    -- preserving existing Repeated labels and only adjusting singular fields.-    effectiveLabel :: FieldPresenceFeature -> Maybe FieldLabel -> Maybe FieldLabel-    effectiveLabel _               (Just Repeated) = Just Repeated-    effectiveLabel ExplicitPresence _               = Just Optional-    effectiveLabel ImplicitPresence _               = Nothing-    effectiveLabel LegacyRequired   _               = Just Required-- -- ----------------------------------------------------------------------- -- Phase conversion -- -----------------------------------------------------------------------@@ -1034,7 +934,8 @@   MEOneof o -> MEOneof (stripOneof o)   MEMapField mf -> MEMapField (stripMapField mf)   MEReserved r -> MEReserved r-  MEExtensions e -> MEExtensions e+  MEExtensions e opts -> MEExtensions e (fmap stripOption opts)+  MEExtend n fs -> MEExtend n (fmap stripField fs)   MEOption o -> MEOption (stripOption o)   MEComment cs -> MEComment cs
src/Proto/IDL/Descriptor.hs view
@@ -1,18 +1,12 @@ {- | Convert wireform's AST types to descriptor.proto types and back.  This enables bundling schema metadata with generated types:-the parsed 'ProtoFile' is converted to a 'R.FileDescriptorProto',+the parsed 'ProtoFile' is converted to a 'FileDescriptorProto', serialized, and embedded in the generated code.  The reverse direction ('fileDescriptorToAST') is used by the protoc-plugin, which receives 'R.FileDescriptorProto' from protoc in-'CodeGeneratorRequest.proto_file' and needs wireform's 'ProtoFile' to-drive code generation.--All descriptor shapes here are the generated reflection types from-'Proto.Google.Protobuf.Reflection.Descriptor' (full @descriptor.proto@),-so the plugin path matches what @protoc@ emits without a decode/encode-narrowing step.+plugin, which receives 'FileDescriptorProto' from protoc and needs+wireform's 'ProtoFile' to drive code generation. -} module Proto.IDL.Descriptor (   astToFileDescriptor,@@ -29,29 +23,28 @@ ) where  import Data.ByteString (ByteString)-import Data.List (find, partition)-import Data.Maybe (fromMaybe, isNothing)+import Data.Int (Int32)+import Data.Maybe (fromMaybe) import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Read as TR-import qualified Data.Vector as V-import Proto (encodeMessage)-import Proto.Google.Protobuf.Reflection.Descriptor as R+import Data.Text qualified as T+import Data.Vector qualified as V+import Proto.Encode (encodeMessage)+import Proto.Google.Protobuf.Descriptor import Proto.IDL.AST   -- | Convert a parsed ProtoFile to a FileDescriptorProto.-astToFileDescriptor :: FilePath -> ProtoFile -> R.FileDescriptorProto+astToFileDescriptor :: FilePath -> ProtoFile -> FileDescriptorProto astToFileDescriptor path pf =-  R.defaultFileDescriptorProto-    { R.fileDescriptorProtoName = Just (T.pack path)-    , R.fileDescriptorProtoPackage = protoPackage pf-    , R.fileDescriptorProtoDependency = V.fromList (fmap importPath (protoImports pf))-    , R.fileDescriptorProtoMessageType = V.fromList (concatMap topMessages (protoTopLevels pf))-    , R.fileDescriptorProtoEnumType = V.fromList (concatMap topEnums (protoTopLevels pf))-    , R.fileDescriptorProtoService = V.fromList (concatMap topServices (protoTopLevels pf))-    , R.fileDescriptorProtoSyntax = Just (syntaxStr (protoSyntax pf))-    , R.fileDescriptorProtoEdition = astEditionToReflect (protoSyntax pf)+  defaultFileDescriptorProto+    { fdpName = T.pack path+    , fdpPackage = fromMaybe "" (protoPackage pf)+    , fdpDependency = V.fromList (fmap importPath (protoImports pf))+    , fdpMessageType = V.fromList (concatMap topMessages (protoTopLevels pf))+    , fdpEnumType = V.fromList (concatMap topEnums (protoTopLevels pf))+    , fdpService = V.fromList (concatMap topServices (protoTopLevels pf))+    , fdpSyntax = syntaxStr (protoSyntax pf)+    , fdpEdition = editionStr (protoSyntax pf)     }   where     topMessages (TLMessage msg) = [astToDescriptor msg]@@ -63,17 +56,19 @@     syntaxStr Proto2 = "proto2"     syntaxStr Proto3 = "proto3"     syntaxStr (Editions _) = "editions"+    editionStr (Editions ed) = editionName ed+    editionStr _ = ""   -- | Convert a MessageDef to a DescriptorProto.-astToDescriptor :: MessageDef -> R.DescriptorProto+astToDescriptor :: MessageDef -> DescriptorProto astToDescriptor msg =-  R.defaultDescriptorProto-    { R.descriptorProtoName = Just (msgName msg)-    , R.descriptorProtoField = V.fromList (concatMap extractField (msgElements msg))-    , R.descriptorProtoNestedType = V.fromList (concatMap extractNested (msgElements msg))-    , R.descriptorProtoEnumType = V.fromList (concatMap extractEnum (msgElements msg))-    , R.descriptorProtoOneofDecl = V.fromList (concatMap extractOneof (msgElements msg))+  defaultDescriptorProto+    { dpName = msgName msg+    , dpField = V.fromList (concatMap extractField (msgElements msg))+    , dpNestedType = V.fromList (concatMap extractNested (msgElements msg))+    , dpEnumType = V.fromList (concatMap extractEnum (msgElements msg))+    , dpOneofDecl = V.fromList (concatMap extractOneof (msgElements msg))     }   where     extractField (MEField fd) = [astToFieldDescriptor fd]@@ -82,127 +77,79 @@     extractField _ = []      extractNested (MEMessage inner) = [astToDescriptor inner]-    -- Emit the synthetic map-entry DescriptorProto so the round-trip-    -- through FileDescriptorProto preserves the map field type info.-    extractNested (MEMapField mf) = [mapEntryDescriptor mf]     extractNested _ = []      extractEnum (MEEnum ed) = [astToEnumDescriptor ed]     extractEnum _ = [] -    extractOneof (MEOneof od) =-      [ R.defaultOneofDescriptorProto{R.oneofDescriptorProtoName = Just (oneofName od)}-      ]+    extractOneof (MEOneof od) = [defaultOneofDescriptorProto {odpName = oneofName od}]     extractOneof _ = []   -- | Convert a FieldDef to a FieldDescriptorProto.-astToFieldDescriptor :: FieldDef -> R.FieldDescriptorProto+astToFieldDescriptor :: FieldDef -> FieldDescriptorProto astToFieldDescriptor fd =-  let (ty, mTn) = fieldTypeToReflect (fieldType fd)-   in R.defaultFieldDescriptorProto-        { R.fieldDescriptorProtoName = Just (fieldName fd)-        , R.fieldDescriptorProtoNumber = Just (fromIntegral (unFieldNumber (fieldNumber fd)))-        , R.fieldDescriptorProtoLabel = labelToReflect (fieldLabel fd)-        , R.fieldDescriptorProtoType = Just ty-        , R.fieldDescriptorProtoTypeName = mTn-        }+  defaultFieldDescriptorProto+    { fdpFieldName = fieldName fd+    , fdpFieldNumber = fromIntegral (unFieldNumber (fieldNumber fd))+    , fdpFieldLabel = labelToInt (fieldLabel fd)+    , fdpFieldType = fieldTypeToInt (fieldType fd)+    , fdpFieldTypeName = case fieldType fd of+        FTNamed n -> n+        _ -> ""+    }  -mapToFieldDescriptor :: MapField -> R.FieldDescriptorProto+mapToFieldDescriptor :: MapField -> FieldDescriptorProto mapToFieldDescriptor mf =-  R.defaultFieldDescriptorProto-    { R.fieldDescriptorProtoName = Just (mapFieldName mf)-    , R.fieldDescriptorProtoNumber = Just (fromIntegral (unFieldNumber (mapFieldNum mf)))-    , R.fieldDescriptorProtoLabel = Just R.FieldDescriptorProto'Label'LabelRepeated-    , R.fieldDescriptorProtoType = Just R.FieldDescriptorProto'Type'TypeMessage-    , R.fieldDescriptorProtoTypeName = Just (mapEntryName (mapFieldName mf))+  defaultFieldDescriptorProto+    { fdpFieldName = mapFieldName mf+    , fdpFieldNumber = fromIntegral (unFieldNumber (mapFieldNum mf))+    , fdpFieldLabel = 3+    , fdpFieldType = 11+    , fdpFieldTypeName = mapFieldName mf <> "Entry"     }  --- | Build the synthetic map-entry DescriptorProto that encodes a map--- field's key/value types. The entry name matches 'mapToFieldDescriptor'--- so the round-trip through 'FileDescriptorProto' is lossless.-mapEntryDescriptor :: MapField -> R.DescriptorProto-mapEntryDescriptor mf =-  R.defaultDescriptorProto-    { R.descriptorProtoName = Just (mapEntryName (mapFieldName mf))-    , R.descriptorProtoField = V.fromList [keyField, valField]-    , R.descriptorProtoOptions =-        Just R.defaultMessageOptions{R.messageOptionsMapEntry = Just True}-    }-  where-    keyField =-      R.defaultFieldDescriptorProto-        { R.fieldDescriptorProtoName = Just "key"-        , R.fieldDescriptorProtoNumber = Just 1-        , R.fieldDescriptorProtoLabel = Just R.FieldDescriptorProto'Label'LabelOptional-        , R.fieldDescriptorProtoType = Just (scalarToFieldType (mapKeyType mf))-        }-    valField = case mapValueType mf of-      FTScalar st ->-        R.defaultFieldDescriptorProto-          { R.fieldDescriptorProtoName = Just "value"-          , R.fieldDescriptorProtoNumber = Just 2-          , R.fieldDescriptorProtoLabel = Just R.FieldDescriptorProto'Label'LabelOptional-          , R.fieldDescriptorProtoType = Just (scalarToFieldType st)-          }-      FTNamed n ->-        R.defaultFieldDescriptorProto-          { R.fieldDescriptorProtoName = Just "value"-          , R.fieldDescriptorProtoNumber = Just 2-          , R.fieldDescriptorProtoLabel = Just R.FieldDescriptorProto'Label'LabelOptional-          , R.fieldDescriptorProtoType = Just R.FieldDescriptorProto'Type'TypeMessage-          , R.fieldDescriptorProtoTypeName = Just n-          }---mapEntryName :: Text -> Text-mapEntryName fieldName = fieldName <> "Entry"---oneofFieldToFDP :: OneofField -> R.FieldDescriptorProto+oneofFieldToFDP :: OneofField -> FieldDescriptorProto oneofFieldToFDP of' =-  let (ty, mTn) = fieldTypeToReflect (oneofFieldType of')-   in R.defaultFieldDescriptorProto-        { R.fieldDescriptorProtoName = Just (oneofFieldName of')-        , R.fieldDescriptorProtoNumber = Just (fromIntegral (unFieldNumber (oneofFieldNumber of')))-        , R.fieldDescriptorProtoLabel = Just R.FieldDescriptorProto'Label'LabelOptional-        , R.fieldDescriptorProtoType = Just ty-        , R.fieldDescriptorProtoTypeName = mTn-        }+  defaultFieldDescriptorProto+    { fdpFieldName = oneofFieldName of'+    , fdpFieldNumber = fromIntegral (unFieldNumber (oneofFieldNumber of'))+    , fdpFieldLabel = 1+    , fdpFieldType = fieldTypeToInt (oneofFieldType of')+    , fdpFieldTypeName = case oneofFieldType of' of+        FTNamed n -> n+        _ -> ""+    }   -- | Convert an EnumDef to an EnumDescriptorProto.-astToEnumDescriptor :: EnumDef -> R.EnumDescriptorProto+astToEnumDescriptor :: EnumDef -> EnumDescriptorProto astToEnumDescriptor ed =-  R.defaultEnumDescriptorProto-    { R.enumDescriptorProtoName = Just (enumName ed)-    , R.enumDescriptorProtoValue = V.fromList (fmap toEVDP (enumValues ed))+  defaultEnumDescriptorProto+    { edpName = enumName ed+    , edpValue = V.fromList (fmap toEVDP (enumValues ed))     }   where-    toEVDP ev =-      R.defaultEnumValueDescriptorProto-        { R.enumValueDescriptorProtoName = Just (evName ev)-        , R.enumValueDescriptorProtoNumber = Just (fromIntegral (evNumber ev))-        }+    toEVDP ev = defaultEnumValueDescriptorProto {evdpName = evName ev, evdpNumber = fromIntegral (evNumber ev)}   -- | Convert a ServiceDef to a ServiceDescriptorProto.-astToServiceDescriptor :: ServiceDef -> R.ServiceDescriptorProto+astToServiceDescriptor :: ServiceDef -> ServiceDescriptorProto astToServiceDescriptor svc =-  R.defaultServiceDescriptorProto-    { R.serviceDescriptorProtoName = Just (svcName svc)-    , R.serviceDescriptorProtoMethod = V.fromList (fmap toMDP (svcRpcs svc))+  defaultServiceDescriptorProto+    { sdpName = svcName svc+    , sdpMethod = V.fromList (fmap toMDP (svcRpcs svc))     }   where     toMDP rpc =-      R.defaultMethodDescriptorProto-        { R.methodDescriptorProtoName = Just (rpcName rpc)-        , R.methodDescriptorProtoInputType = Just (rpcInput rpc)-        , R.methodDescriptorProtoOutputType = Just (rpcOutput rpc)-        , R.methodDescriptorProtoClientStreaming = Just (rpcInputStr rpc == Streaming)-        , R.methodDescriptorProtoServerStreaming = Just (rpcOutputStr rpc == Streaming)+      defaultMethodDescriptorProto+        { mdpName = rpcName rpc+        , mdpInputType = rpcInput rpc+        , mdpOutputType = rpcOutput rpc+        , mdpClientStreaming = rpcInputStr rpc == Streaming+        , mdpServerStreaming = rpcOutputStr rpc == Streaming         }  @@ -211,50 +158,35 @@ serializeFileDescriptor path pf = encodeMessage (astToFileDescriptor path pf)  -labelToReflect :: Maybe FieldLabel -> Maybe R.FieldDescriptorProto'Label-labelToReflect Nothing = Just R.FieldDescriptorProto'Label'LabelOptional-labelToReflect (Just Optional) = Just R.FieldDescriptorProto'Label'LabelOptional-labelToReflect (Just Required) = Just R.FieldDescriptorProto'Label'LabelRequired-labelToReflect (Just Repeated) = Just R.FieldDescriptorProto'Label'LabelRepeated---fieldTypeToReflect :: FieldType -> (R.FieldDescriptorProto'Type, Maybe Text)-fieldTypeToReflect (FTScalar s) = (scalarToFieldType s, Nothing)-fieldTypeToReflect (FTNamed n) = (R.FieldDescriptorProto'Type'TypeMessage, Just n)+labelToInt :: Maybe FieldLabel -> Int32+labelToInt Nothing = 1+labelToInt (Just Optional) = 1+labelToInt (Just Required) = 2+labelToInt (Just Repeated) = 3  -scalarToFieldType :: ScalarType -> R.FieldDescriptorProto'Type-scalarToFieldType = \case-  SDouble -> R.FieldDescriptorProto'Type'TypeDouble-  SFloat -> R.FieldDescriptorProto'Type'TypeFloat-  SInt64 -> R.FieldDescriptorProto'Type'TypeInt64-  SUInt64 -> R.FieldDescriptorProto'Type'TypeUint64-  SInt32 -> R.FieldDescriptorProto'Type'TypeInt32-  SFixed64 -> R.FieldDescriptorProto'Type'TypeFixed64-  SFixed32 -> R.FieldDescriptorProto'Type'TypeFixed32-  SBool -> R.FieldDescriptorProto'Type'TypeBool-  SString -> R.FieldDescriptorProto'Type'TypeString-  SBytes -> R.FieldDescriptorProto'Type'TypeBytes-  SUInt32 -> R.FieldDescriptorProto'Type'TypeUint32-  SSFixed32 -> R.FieldDescriptorProto'Type'TypeSfixed32-  SSFixed64 -> R.FieldDescriptorProto'Type'TypeSfixed64-  SSInt32 -> R.FieldDescriptorProto'Type'TypeSint32-  SSInt64 -> R.FieldDescriptorProto'Type'TypeSint64+fieldTypeToInt :: FieldType -> Int32+fieldTypeToInt (FTScalar s) = scalarTypeToInt s+fieldTypeToInt (FTNamed _) = 11  -astEditionToReflect :: Syntax -> Maybe R.Edition-astEditionToReflect (Editions (Edition t))-  | Right (n, rest) <- TR.decimal t, T.null rest =-      case fromProtoEnumEdition (fromIntegral (n :: Integer)) of-        Just ed -> Just ed-        Nothing-          | t == "2023" -> Just R.Edition'Edition2023-          | t == "2024" -> Just R.Edition'Edition2024-          | otherwise -> Nothing-  | t == "2023" = Just R.Edition'Edition2023-  | t == "2024" = Just R.Edition'Edition2024-  | otherwise = Nothing-astEditionToReflect _ = Nothing+scalarTypeToInt :: ScalarType -> Int32+scalarTypeToInt = \case+  SDouble -> 1+  SFloat -> 2+  SInt64 -> 3+  SUInt64 -> 4+  SInt32 -> 5+  SFixed64 -> 6+  SFixed32 -> 7+  SBool -> 8+  SString -> 9+  SBytes -> 12+  SUInt32 -> 13+  SSFixed32 -> 15+  SSFixed64 -> 16+  SSInt32 -> 17+  SSInt64 -> 18   -- ---------------------------------------------------------------------------@@ -262,143 +194,59 @@ -- ---------------------------------------------------------------------------  -- | Convert a 'FileDescriptorProto' (as received from protoc) to a 'ProtoFile'.-fileDescriptorToAST :: R.FileDescriptorProto -> ProtoFile+fileDescriptorToAST :: FileDescriptorProto -> ProtoFile fileDescriptorToAST fdp =   ProtoFile-    { protoSyntax = parseSyntax (R.fileDescriptorProtoSyntax fdp) (R.fileDescriptorProtoEdition fdp)-    , protoPackage =-        case R.fileDescriptorProtoPackage fdp of-          Nothing -> Nothing-          Just p | T.null p -> Nothing-          Just p -> Just p-    , protoImports = fmap (ImportDef () Nothing) (V.toList (R.fileDescriptorProtoDependency fdp))+    { protoSyntax = parseSyntax (fdpSyntax fdp) (fdpEdition fdp)+    , protoPackage = if T.null (fdpPackage fdp) then Nothing else Just (fdpPackage fdp)+    , protoImports = fmap (ImportDef () Nothing) (V.toList (fdpDependency fdp))     , protoOptions = []     , protoTopLevels =-        fmap (TLMessage . descriptorToMessage) (V.toList (R.fileDescriptorProtoMessageType fdp))-          <> fmap (TLEnum . enumDescriptorToEnum) (V.toList (R.fileDescriptorProtoEnumType fdp))-          <> fmap (TLService . serviceDescriptorToService) (V.toList (R.fileDescriptorProtoService fdp))+        fmap (TLMessage . descriptorToMessage) (V.toList (fdpMessageType fdp))+          <> fmap (TLEnum . enumDescriptorToEnum) (V.toList (fdpEnumType fdp))+          <> fmap (TLService . serviceDescriptorToService) (V.toList (fdpService fdp))     , protoSource = Nothing     }  -parseSyntax :: Maybe Text -> Maybe R.Edition -> Syntax-parseSyntax mSyn mEd-  | Just "proto2" <- mSyn = Proto2-  | Just "editions" <- mSyn, Just ed <- mEd = Editions (Edition (reflectEditionToAstText ed))-  | Just "editions" <- mSyn = Editions (Edition "")+parseSyntax :: Text -> Text -> Syntax+parseSyntax syn ed+  | syn == "proto2" = Proto2+  | syn == "editions" = Editions (Edition ed)   | otherwise = Proto3  -reflectEditionToAstText :: R.Edition -> Text-reflectEditionToAstText = \case-  R.Edition'Edition2023 -> "2023"-  R.Edition'Edition2024 -> "2024"-  R.Edition'EditionProto2 -> "proto2"-  R.Edition'EditionProto3 -> "proto3"-  e -> T.pack (show (toProtoEnumEdition e))-- -- | Convert a 'DescriptorProto' to a 'MessageDef'.------ Nested descriptors with @options.map_entry = true@ are treated as--- map-entry stubs emitted by 'astToDescriptor'. They are paired back--- with the corresponding repeated-message field to reconstruct the--- original 'MEMapField' element.-descriptorToMessage :: R.DescriptorProto -> MessageDef+descriptorToMessage :: DescriptorProto -> MessageDef descriptorToMessage dp =   MessageDef     { msgExt = ()     , msgDoc = Nothing-    , msgName = fromMaybe "" (R.descriptorProtoName dp)+    , msgName = dpName dp     , msgElements = fieldElems <> nestedElems <> enumElems     }   where-    oneofNames =-      V.toList-        (fmap (fromMaybe "" . R.oneofDescriptorProtoName) (R.descriptorProtoOneofDecl dp))-    allFields = V.toList (R.descriptorProtoField dp)-    nestedTypes = V.toList (R.descriptorProtoNestedType dp)--    -- Separate map-entry stubs from real nested messages.-    (mapEntries, realNested) = partition isMapEntry nestedTypes-    isMapEntry n =-      maybe False (fromMaybe False . R.messageOptionsMapEntry) (R.descriptorProtoOptions n)--    -- Map entry names → MapField (if key/value fields are decodable).-    mapEntryMap :: [(Text, MessageElement)]-    mapEntryMap = concatMap entryToMapElem mapEntries-    entryToMapElem n =-      let entryName = fromMaybe "" (R.descriptorProtoName n)-          fields = V.toList (R.descriptorProtoField n)-          mkeyF = find (\f -> R.fieldDescriptorProtoNumber f == Just 1) fields-          mvalF = find (\f -> R.fieldDescriptorProtoNumber f == Just 2) fields-      in case (mkeyF, mvalF) of-           (Just kf, Just vf) ->-             case R.fieldDescriptorProtoType kf of-               Just kt-                 | Just ks <- fieldTypeToScalar kt ->-                     -- Find the repeated field whose typeName matches this entry.-                     let vft = typeEnumToFieldType-                                 (R.fieldDescriptorProtoType vf)-                                 (fromMaybe "" (R.fieldDescriptorProtoTypeName vf))-                         matchingField = find-                           (\f -> R.fieldDescriptorProtoType f-                                    == Just R.FieldDescriptorProto'Type'TypeMessage-                                  && maybe False (\tn -> tn == entryName || T.isSuffixOf ("." <> entryName) tn)-                                       (R.fieldDescriptorProtoTypeName f))-                           allFields-                     in case matchingField of-                          Just mf ->-                            [ ( fromMaybe "" (R.fieldDescriptorProtoName mf)-                              , MEMapField MapField-                                  { mapExt = ()-                                  , mapDoc = Nothing-                                  , mapKeyType = ks-                                  , mapValueType = vft-                                  , mapFieldName = fromMaybe "" (R.fieldDescriptorProtoName mf)-                                  , mapFieldNum = FieldNumber (fromIntegral (fromMaybe 0 (R.fieldDescriptorProtoNumber mf)))-                                  , mapOptions = []-                                  }-                              )-                            ]-                          Nothing -> []-               _ -> []-           _ -> []--    mapFieldNames :: [Text]-    mapFieldNames = fmap fst mapEntryMap--    -- Fields that are NOT the repeated-message backing a map entry.-    (oneofFields', regularFields) = partitionOneofFields oneofNames-      (filter (\f -> fromMaybe "" (R.fieldDescriptorProtoName f) `notElem` mapFieldNames) allFields)--    fieldElems =-      fmap (MEField . fieldDescriptorToField) regularFields-        <> fmap snd mapEntryMap-    nestedElems = fmap (MEMessage . descriptorToMessage) realNested+    oneofNames = V.toList (fmap odpName (dpOneofDecl dp))+    allFields = V.toList (dpField dp)+    (oneofFields', regularFields) = partitionOneofFields oneofNames allFields+    fieldElems = fmap (MEField . fieldDescriptorToField) regularFields+    nestedElems = fmap (MEMessage . descriptorToMessage) (V.toList (dpNestedType dp))     enumElems =-      fmap (MEEnum . enumDescriptorToEnum) (V.toList (R.descriptorProtoEnumType dp))+      fmap (MEEnum . enumDescriptorToEnum) (V.toList (dpEnumType dp))         <> buildOneofDefs oneofNames oneofFields'  -partitionOneofFields ::-  [Text] ->-  [R.FieldDescriptorProto] ->-  ([[R.FieldDescriptorProto]], [R.FieldDescriptorProto])+partitionOneofFields :: [Text] -> [FieldDescriptorProto] -> ([[FieldDescriptorProto]], [FieldDescriptorProto]) partitionOneofFields oneofNames fields =-  let regular = filter (isNothing . R.fieldDescriptorProtoOneofIndex) fields+  let regular = filter (\f -> fdpFieldOneofIdx f < 0) fields       grouped =         fmap-          ( \(i, _name) ->-              filter-                (\f -> R.fieldDescriptorProtoOneofIndex f == Just (fromIntegral (i :: Int)))-                fields-          )-          (zip [(0 :: Int) ..] oneofNames)+          (\(i, _) -> filter (\f -> fdpFieldOneofIdx f == fromIntegral i) fields)+          (zip [0 :: Int ..] oneofNames)   in (grouped, regular)  -buildOneofDefs :: [Text] -> [[R.FieldDescriptorProto]] -> [MessageElement]+buildOneofDefs :: [Text] -> [[FieldDescriptorProto]] -> [MessageElement] buildOneofDefs = zipWith mkOneof   where     mkOneof name flds =@@ -415,72 +263,56 @@       OneofField         { oneofFieldExt = ()         , oneofFieldDoc = Nothing-        , oneofFieldType =-            typeEnumToFieldType-              (R.fieldDescriptorProtoType f)-              (fromMaybe "" (R.fieldDescriptorProtoTypeName f))-        , oneofFieldName = fromMaybe "" (R.fieldDescriptorProtoName f)-        , oneofFieldNumber =-            FieldNumber (fromIntegral (fromMaybe 0 (R.fieldDescriptorProtoNumber f)))+        , oneofFieldType = intToFieldType (fdpFieldType f) (fdpFieldTypeName f)+        , oneofFieldName = fdpFieldName f+        , oneofFieldNumber = FieldNumber (fromIntegral (fdpFieldNumber f))         , oneofFieldOptions = []         }   -- | Convert a 'FieldDescriptorProto' to a 'FieldDef'.-fieldDescriptorToField :: R.FieldDescriptorProto -> FieldDef+fieldDescriptorToField :: FieldDescriptorProto -> FieldDef fieldDescriptorToField f =   FieldDef     { fieldExt = ()     , fieldDoc = Nothing-    , fieldLabel = labelEnumToMaybeLabel (R.fieldDescriptorProtoLabel f)-    , fieldType =-        typeEnumToFieldType-          (R.fieldDescriptorProtoType f)-          (fromMaybe "" (R.fieldDescriptorProtoTypeName f))-    , fieldName = fromMaybe "" (R.fieldDescriptorProtoName f)-    , fieldNumber =-        FieldNumber (fromIntegral (fromMaybe 0 (R.fieldDescriptorProtoNumber f)))-    , fieldOptions = jsonNameOptMaybe (R.fieldDescriptorProtoJsonName f)+    , fieldLabel = intToLabel (fdpFieldLabel f)+    , fieldType = intToFieldType (fdpFieldType f) (fdpFieldTypeName f)+    , fieldName = fdpFieldName f+    , fieldNumber = FieldNumber (fromIntegral (fdpFieldNumber f))+    , fieldOptions = jsonNameOpt (fdpFieldJsonName f)     }  -jsonNameOptMaybe :: Maybe Text -> [OptionDef]-jsonNameOptMaybe Nothing = []-jsonNameOptMaybe (Just t)+jsonNameOpt :: Text -> [OptionDef]+jsonNameOpt t   | T.null t = []   | otherwise = [OptionDef () (OptionName [SimpleOption "json_name"]) (CString t)]   -- | Convert an 'EnumDescriptorProto' to an 'EnumDef'.-enumDescriptorToEnum :: R.EnumDescriptorProto -> EnumDef+enumDescriptorToEnum :: EnumDescriptorProto -> EnumDef enumDescriptorToEnum e =   EnumDef     { enumExt = ()     , enumDoc = Nothing-    , enumName = fromMaybe "" (R.enumDescriptorProtoName e)+    , enumName = edpName e     , enumValues =         fmap-          ( \v ->-              EnumValue-                ()-                Nothing-                (fromMaybe "" (R.enumValueDescriptorProtoName v))-                (fromIntegral (fromMaybe 0 (R.enumValueDescriptorProtoNumber v)))-                []-          )-          (V.toList (R.enumDescriptorProtoValue e))+          (\v -> EnumValue () Nothing (evdpName v) (fromIntegral (evdpNumber v)) [])+          (V.toList (edpValue e))     , enumOptions = []     }   -- | Convert a 'ServiceDescriptorProto' to a 'ServiceDef'.-serviceDescriptorToService :: R.ServiceDescriptorProto -> ServiceDef+serviceDescriptorToService :: ServiceDescriptorProto -> ServiceDef serviceDescriptorToService s =   ServiceDef     { svcExt = ()     , svcDoc = Nothing-    , svcName = fromMaybe "" (R.serviceDescriptorProtoName s)-    , svcRpcs = fmap methodToRpc (V.toList (R.serviceDescriptorProtoMethod s))+    , svcName = sdpName s+    , svcRpcs = fmap methodToRpc (V.toList (sdpMethod s))     , svcOptions = []     }   where@@ -488,48 +320,25 @@       RpcDef         { rpcExt = ()         , rpcDoc = Nothing-        , rpcName = fromMaybe "" (R.methodDescriptorProtoName m)-        , rpcInput = fromMaybe "" (R.methodDescriptorProtoInputType m)-        , rpcInputStr =-            if fromMaybe False (R.methodDescriptorProtoClientStreaming m)-              then Streaming-              else NoStream-        , rpcOutput = fromMaybe "" (R.methodDescriptorProtoOutputType m)-        , rpcOutputStr =-            if fromMaybe False (R.methodDescriptorProtoServerStreaming m)-              then Streaming-              else NoStream+        , rpcName = mdpName m+        , rpcInput = mdpInputType m+        , rpcInputStr = if mdpClientStreaming m then Streaming else NoStream+        , rpcOutput = mdpOutputType m+        , rpcOutputStr = if mdpServerStreaming m then Streaming else NoStream         , rpcOptions = []         }  -labelEnumToMaybeLabel :: Maybe R.FieldDescriptorProto'Label -> Maybe FieldLabel-labelEnumToMaybeLabel Nothing = Nothing-labelEnumToMaybeLabel (Just R.FieldDescriptorProto'Label'LabelOptional) = Just Optional-labelEnumToMaybeLabel (Just R.FieldDescriptorProto'Label'LabelRequired) = Just Required-labelEnumToMaybeLabel (Just R.FieldDescriptorProto'Label'LabelRepeated) = Just Repeated+intToLabel :: Int32 -> Maybe FieldLabel+intToLabel 1 = Just Optional+intToLabel 2 = Just Required+intToLabel 3 = Just Repeated+intToLabel _ = Nothing  -typeEnumToFieldType :: Maybe R.FieldDescriptorProto'Type -> Text -> FieldType-typeEnumToFieldType mTy typeName = case mTy of-  Just R.FieldDescriptorProto'Type'TypeDouble -> FTScalar SDouble-  Just R.FieldDescriptorProto'Type'TypeFloat -> FTScalar SFloat-  Just R.FieldDescriptorProto'Type'TypeInt64 -> FTScalar SInt64-  Just R.FieldDescriptorProto'Type'TypeUint64 -> FTScalar SUInt64-  Just R.FieldDescriptorProto'Type'TypeInt32 -> FTScalar SInt32-  Just R.FieldDescriptorProto'Type'TypeFixed64 -> FTScalar SFixed64-  Just R.FieldDescriptorProto'Type'TypeFixed32 -> FTScalar SFixed32-  Just R.FieldDescriptorProto'Type'TypeBool -> FTScalar SBool-  Just R.FieldDescriptorProto'Type'TypeString -> FTScalar SString-  Just R.FieldDescriptorProto'Type'TypeGroup -> FTNamed (stripLeadingDot typeName)-  Just R.FieldDescriptorProto'Type'TypeMessage -> FTNamed (stripLeadingDot typeName)-  Just R.FieldDescriptorProto'Type'TypeBytes -> FTScalar SBytes-  Just R.FieldDescriptorProto'Type'TypeUint32 -> FTScalar SUInt32-  Just R.FieldDescriptorProto'Type'TypeEnum -> FTNamed (stripLeadingDot typeName)-  Just R.FieldDescriptorProto'Type'TypeSfixed32 -> FTScalar SSFixed32-  Just R.FieldDescriptorProto'Type'TypeSfixed64 -> FTScalar SSFixed64-  Just R.FieldDescriptorProto'Type'TypeSint32 -> FTScalar SSInt32-  Just R.FieldDescriptorProto'Type'TypeSint64 -> FTScalar SSInt64+intToFieldType :: Int32 -> Text -> FieldType+intToFieldType typeInt typeName = case intToScalar typeInt of+  Just s -> FTScalar s   Nothing -> FTNamed (stripLeadingDot typeName)  @@ -537,24 +346,21 @@ stripLeadingDot t = fromMaybe t (T.stripPrefix "." t)  --- | Invert 'scalarToFieldType': map a 'FieldDescriptorProto'Type' back to a--- 'ScalarType'. Returns 'Nothing' for TYPE_MESSAGE, TYPE_ENUM, and TYPE_GROUP--- (which are not scalar).-fieldTypeToScalar :: R.FieldDescriptorProto'Type -> Maybe ScalarType-fieldTypeToScalar = \case-  R.FieldDescriptorProto'Type'TypeDouble   -> Just SDouble-  R.FieldDescriptorProto'Type'TypeFloat    -> Just SFloat-  R.FieldDescriptorProto'Type'TypeInt64    -> Just SInt64-  R.FieldDescriptorProto'Type'TypeUint64   -> Just SUInt64-  R.FieldDescriptorProto'Type'TypeInt32    -> Just SInt32-  R.FieldDescriptorProto'Type'TypeFixed64  -> Just SFixed64-  R.FieldDescriptorProto'Type'TypeFixed32  -> Just SFixed32-  R.FieldDescriptorProto'Type'TypeBool     -> Just SBool-  R.FieldDescriptorProto'Type'TypeString   -> Just SString-  R.FieldDescriptorProto'Type'TypeBytes    -> Just SBytes-  R.FieldDescriptorProto'Type'TypeUint32   -> Just SUInt32-  R.FieldDescriptorProto'Type'TypeSfixed32 -> Just SSFixed32-  R.FieldDescriptorProto'Type'TypeSfixed64 -> Just SSFixed64-  R.FieldDescriptorProto'Type'TypeSint32   -> Just SSInt32-  R.FieldDescriptorProto'Type'TypeSint64   -> Just SSInt64-  _                                        -> Nothing+intToScalar :: Int32 -> Maybe ScalarType+intToScalar = \case+  1 -> Just SDouble+  2 -> Just SFloat+  3 -> Just SInt64+  4 -> Just SUInt64+  5 -> Just SInt32+  6 -> Just SFixed64+  7 -> Just SFixed32+  8 -> Just SBool+  9 -> Just SString+  12 -> Just SBytes+  13 -> Just SUInt32+  15 -> Just SSFixed32+  16 -> Just SSFixed64+  17 -> Just SSInt32+  18 -> Just SSInt64+  _ -> Nothing
src/Proto/IDL/Options.hs view
@@ -268,16 +268,16 @@ extractLanguagePackages pf =   let fo = extractFileOptions (protoOptions pf)   in LanguagePackages-      { lpProtoPackage = protoPackage pf-      , lpJavaPackage = foJavaPackage fo-      , lpGoPackage = foGoPackage fo-      , lpCsharpNamespace = foCsharpNamespace fo-      , lpPhpNamespace = foPhpNamespace fo-      , lpRubyPackage = foRubyPackage fo-      , lpSwiftPrefix = foSwiftPrefix fo-      , lpObjcPrefix = foObjcClassPrefix fo-      , lpHaskellModule = deriveHaskellModule (protoPackage pf)-      }+       { lpProtoPackage = protoPackage pf+       , lpJavaPackage = foJavaPackage fo+       , lpGoPackage = foGoPackage fo+       , lpCsharpNamespace = foCsharpNamespace fo+       , lpPhpNamespace = foPhpNamespace fo+       , lpRubyPackage = foRubyPackage fo+       , lpSwiftPrefix = foSwiftPrefix fo+       , lpObjcPrefix = foObjcClassPrefix fo+       , lpHaskellModule = deriveHaskellModule (protoPackage pf)+       }   deriveHaskellModule :: Maybe Text -> Text
src/Proto/IDL/Parser.hs view
@@ -17,12 +17,12 @@ import Data.IntMap.Strict qualified as IntMap import Data.IntSet (IntSet) import Data.IntSet qualified as IntSet-import Data.Maybe (fromMaybe, mapMaybe)+import Data.Maybe (catMaybes, fromMaybe, mapMaybe) import Data.Text (Text) import Data.Text qualified as T import Data.Void (Void) import Proto.IDL.AST-import Proto.IDL.AST.Span (Span, SrcSpan (..), mkSpan, noSpan)+import Proto.IDL.AST.Span (Span, SrcSpan (..), mkSpan) import Proto.IDL.Parser.Error (renderParseError, renderParseErrors) import Proto.IDL.Parser.Lexer import Text.Megaparsec hiding (option)@@ -52,10 +52,10 @@   let cm = buildCommentMap src       allComments = buildAllComments src   in case parse (parseProto cm) fp src of-      Left e -> Left e-      Right pf ->-        let pf' = insertComments src allComments cm pf-        in Right pf' {protoSource = Just src}+       Left e -> Left e+       Right pf ->+         let pf' = insertComments src allComments cm pf+         in Right pf' {protoSource = Just src}   -- | Core parser for a proto file given a pre-built comment map.@@ -63,12 +63,12 @@ parseProto cm = do   sc   syn <- option Proto3 syntaxOrEdition-  stmts <- many (topLevelStmt cm)+  stmts <- manyStmts (topLevelStmt cm)   eof   let pkg = firstJust (\case TLStmtPackage p -> Just p; _ -> Nothing) stmts   let imps = concatMap (\case TLStmtImport i -> [i]; _ -> []) stmts   let opts = concatMap (\case TLStmtOption o -> [o]; _ -> []) stmts-  let topDefs = concatMap (\case TLStmtTopLevel t -> [t]; _ -> []) stmts+  let topDefs = concatMap (\case TLStmtTopLevel t -> [t]; TLStmtTopLevels ts -> ts; _ -> []) stmts   pure     ProtoFile       { protoSyntax = syn@@ -87,11 +87,27 @@   Nothing -> firstJust f xs  +{- | Parse zero or more statements, tolerating empty statements (bare @;@).++The proto grammar models a stray semicolon as @emptyStatement = ";"@, which+@protoc@ accepts wherever a statement may appear. The most common case is the+trailing @;@ that follows a message, enum, or service block (e.g.+@message Foo { ... };@), but bare semicolons are also valid between and inside+declarations.+-}+manyStmts :: Parser a -> Parser [a]+manyStmts p = catMaybes <$> many ((Nothing <$ semi) <|> (Just <$> p))++ data TLStmt   = TLStmtPackage Text   | TLStmtImport (ImportDef' Parsed)   | TLStmtOption (OptionDef' Parsed)   | TLStmtTopLevel (TopLevel' Parsed)+  | {- | One statement that expands to several top-level definitions, e.g. an+    @extend@ block containing a group (which hoists the group's message).+    -}+    TLStmtTopLevels [TopLevel' Parsed]   syntaxOrEdition :: Parser Syntax@@ -135,7 +151,7 @@     "message" -> TLStmtTopLevel . TLMessage <$> messageDef cm doc start     "enum" -> TLStmtTopLevel . TLEnum <$> enumDef cm doc start     "service" -> TLStmtTopLevel . TLService <$> serviceDef cm doc start-    "extend" -> TLStmtTopLevel <$> extendDef cm+    "extend" -> TLStmtTopLevels <$> extendDef cm     _ ->       fail         ( "unexpected keyword '"@@ -144,14 +160,39 @@         )  -extendDef :: CommentMap -> Parser (TopLevel' Parsed)+extendDef :: CommentMap -> Parser [TopLevel' Parsed] extendDef cm = do   reserved "extend"   name <- fullIdent-  fields <- braces (many (fieldDef cm))-  pure (TLExtend name fields)+  (fields, groupMsgs) <- extendBody cm+  -- A group inside an extend hoists its message definition to the enclosing+  -- (here, file) scope, matching how protoc models groups.+  pure (TLExtend name fields : fmap TLMessage groupMsgs)  +{- | Parse the body of an @extend@ block: fields and (proto2) groups, plus+empty statements. Returns the extension fields and any group message+definitions that must be hoisted to the enclosing scope.+-}+extendBody :: CommentMap -> Parser ([FieldDef' Parsed], [MessageDef' Parsed])+extendBody cm = braces (mconcat <$> manyStmts (extendElem cm))+++extendElem :: CommentMap -> Parser ([FieldDef' Parsed], [MessageDef' Parsed])+extendElem cm = do+  start <- getOffset+  doc <- getDoc cm+  lbl <- optional fieldLabelP+  isGroup <- option False (True <$ try (reserved "group"))+  if isGroup+    then do+      (nested, fld) <- groupParts cm doc lbl start+      pure ([fld], [nested])+    else do+      f <- fieldRest doc lbl start+      pure ([f], [])++ packageDecl :: Parser Text packageDecl = do   reserved "package"@@ -197,10 +238,10 @@ optionName :: Parser OptionName optionName = do   first <- optionNamePart-  rest <- many (symbol "." *> simpleOptionPart)+  -- Parts after the first may also be extension names in parentheses,+  -- e.g. @option (a).(b).c = …@, which protoc accepts.+  rest <- many (symbol "." *> optionNamePart)   pure OptionName {optNameParts = first : rest}-  where-    simpleOptionPart = SimpleOption <$> identifier   optionNamePart :: Parser OptionNamePart@@ -225,59 +266,97 @@   aggregateLiteral :: Parser [(Text, Constant)]-aggregateLiteral = braces (many aggregateField)+aggregateLiteral = aggBody braces <|> aggBody angles   where+    -- A message value may be delimited by braces or, in text format, angles.+    aggBody delim = delim (concat <$> many aggregateField)++    aggregateField :: Parser [(Text, Constant)]     aggregateField = do-      key <- identifier-      -- Both "key: value" and "key { ... }" are valid-      val <- (symbol ":" *> constant) <|> (CAggregate <$> aggregateLiteral)+      key <- aggKey+      vals <- aggValue       _ <- optional (comma <|> semi)-      pure (key, val)+      pure (fmap ((,) key) vals) +    -- A field key is a bare identifier or a bracketed extension / Any-URL name+    -- (e.g. @[foo.bar]@ or @[type.googleapis.com/foo.Bar]@). The brackets are+    -- kept in the stored key so it round-trips.+    aggKey = aggExtKey <|> identifier+    aggExtKey = do+      void (symbol "[")+      d <- fullIdent+      suffix <- option "" ((\t -> "/" <> t) <$> (symbol "/" *> fullIdent))+      void (symbol "]")+      pure ("[" <> d <> suffix <> "]") +    -- "key: <scalar|list|message>" or the colon-less "key { … }" / "key < … >".+    aggValue =+      (symbol ":" *> (aggListValue <|> ((: []) <$> constant)))+        <|> ((: []) . CAggregate <$> aggregateLiteral)++    -- List values "[a, b, c]" desugar into repeated (key, value) pairs — the+    -- text-format equivalent of writing the key several times.+    aggListValue = brackets (constant `sepBy` comma)++ messageDef :: CommentMap -> Maybe Text -> Int -> Parser (MessageDef' Parsed) messageDef cm doc start = do   reserved "message"   name <- identifier <?> "message name"-  elems <- braces (many (messageElement cm))+  elems <- braces (concat <$> manyStmts (messageElement cm))   end <- getOffset   pure MessageDef {msgExt = mkSpan start end, msgDoc = doc, msgName = name, msgElements = elems}  -messageElement :: CommentMap -> Parser (MessageElement' Parsed)+{- | Parse one message-body element. Returns a list because a proto2 @group@+desugars into two elements (the nested message plus its field); every other+element yields a singleton.+-}+messageElement :: CommentMap -> Parser [MessageElement' Parsed] messageElement cm = do   start <- getOffset   doc <- getDoc cm-  kw <- lookAhead (identifier <?> "message element (field, enum, message, oneof, map, option, reserved, or extensions)")+  kw <- lookAhead (identifier <?> "message element (field, group, enum, message, oneof, map, option, reserved, or extensions)")   case kw of-    "reserved" -> MEReserved <$> reservedDecl-    "extensions" -> MEExtensions <$> extensionsDecl-    "option" -> MEOption <$> optionDecl start-    "enum" -> MEEnum <$> enumDef cm doc start-    "message" -> MEMessage <$> messageDef cm doc start-    "oneof" -> MEOneof <$> oneofDef cm doc start-    "map" -> MEMapField <$> mapFieldDef cm doc start-    _ -> MEField <$> fieldDef' doc start+    "reserved" -> one (MEReserved <$> reservedDecl)+    "extensions" -> one (uncurry MEExtensions <$> extensionsDecl)+    "option" -> one (MEOption <$> optionDecl start)+    "enum" -> one (MEEnum <$> enumDef cm doc start)+    "message" -> one (MEMessage <$> messageDef cm doc start)+    "oneof" -> one (MEOneof <$> oneofDef cm doc start)+    "map" -> one (MEMapField <$> mapFieldDef cm doc start)+    "extend" -> nestedExtend cm+    _ -> fieldOrGroupDef cm doc start+  where+    one = fmap (: [])  -fieldDef :: CommentMap -> Parser (FieldDef' Parsed)-fieldDef cm = do-  start <- getOffset-  doc <- getDoc cm-  fieldDef' doc start+{- | Parse a nested @extend@ block inside a message body. Yields the+'MEExtend' element plus any hoisted group messages (as sibling+'MEMessage' elements in the enclosing message).+-}+nestedExtend :: CommentMap -> Parser [MessageElement' Parsed]+nestedExtend cm = do+  reserved "extend"+  name <- fullIdent+  (fields, groupMsgs) <- extendBody cm+  pure (MEExtend name fields : fmap MEMessage groupMsgs)  -fieldDef' :: Maybe Text -> Int -> Parser (FieldDef' Parsed)-fieldDef' doc start = do-  lbl <--    optional-      ( choice-          [ try (Optional <$ reserved "optional")-          , try (Required <$ reserved "required")-          , try (Repeated <$ reserved "repeated")-          ]-          <?> "field label (optional, required, or repeated)"-      )+-- | A field label (proto2 @optional@/@required@ or @repeated@).+fieldLabelP :: Parser FieldLabel+fieldLabelP =+  choice+    [ try (Optional <$ reserved "optional")+    , try (Required <$ reserved "required")+    , try (Repeated <$ reserved "repeated")+    ]+    <?> "field label (optional, required, or repeated)"+++-- | Parse a field given its (already-consumed) label.+fieldRest :: Maybe Text -> Maybe FieldLabel -> Int -> Parser (FieldDef' Parsed)+fieldRest doc lbl start = do   ft <- parseFieldType   name <- identifier <?> "field name"   equals@@ -297,6 +376,56 @@       }  +{- | Parse either a regular field or a proto2 @group@.++A group (@[label] group Name = N [opts] { body }@) is deprecated syntax that+is semantically a nested message plus a field of that message type. We desugar+it the way @protoc@ does: emit the nested message named @Name@ and a field+named after the lower-cased group name. (The group wire-type — tags 3/4 — is+not emitted by the code generator; the field encodes as a normal submessage.)+-}+fieldOrGroupDef :: CommentMap -> Maybe Text -> Int -> Parser [MessageElement' Parsed]+fieldOrGroupDef cm doc start = do+  lbl <- optional fieldLabelP+  isGroup <- option False (True <$ try (reserved "group"))+  if isGroup+    then (\(nested, fld) -> [MEMessage nested, MEField fld]) <$> groupParts cm doc lbl start+    else fmap ((: []) . MEField) (fieldRest doc lbl start)+++{- | Parse a group body (the @group@ keyword has already been consumed) into+its constituent nested message and field, the way protoc models a group.+The @group@ field name is the lower-cased group name.+-}+groupParts :: CommentMap -> Maybe Text -> Maybe FieldLabel -> Int -> Parser (MessageDef' Parsed, FieldDef' Parsed)+groupParts cm doc lbl start = do+  name <- identifier <?> "group name"+  equals+  num <- FieldNumber . fromIntegral <$> (intLiteral <?> "field number")+  opts <- fieldOptionList+  elems <- braces (concat <$> manyStmts (messageElement cm))+  end <- getOffset+  let sp = mkSpan start end+      nested =+        MessageDef+          { msgExt = sp+          , msgDoc = doc+          , msgName = name+          , msgElements = elems+          }+      fld =+        FieldDef+          { fieldExt = sp+          , fieldDoc = doc+          , fieldLabel = lbl+          , fieldType = FTNamed name+          , fieldName = T.toLower name+          , fieldNumber = num+          , fieldOptions = opts+          }+  pure (nested, fld)++ parseFieldType :: Parser FieldType parseFieldType =   choice@@ -373,7 +502,7 @@   reserved "oneof"   name <- identifier   (fields, opts) <- braces $ do-    items <- many (Left <$> try oneofOption <|> Right <$> oneofField cm)+    items <- manyStmts (Left <$> try oneofOption <|> Right <$> oneofField cm)     let os = concatMap (either (: []) (const [])) items     let fs = concatMap (either (const []) (: [])) items     pure (fs, os)@@ -423,7 +552,10 @@   semi   pure res   where-    reservedNames = ReservedNames <$> (stringLiteral `sepBy1` comma)+    -- proto2/proto3 use quoted names; editions (2023+) use bare identifiers.+    -- The spelling is retained so printing reproduces the right token.+    reservedNames = ReservedNames <$> (reservedName `sepBy1` comma)+    reservedName = (QuotedReservedName <$> stringLiteral) <|> (IdentReservedName <$> identifier)     reservedNumbers = ReservedNumbers <$> (reservedRange `sepBy1` comma)     reservedRange = do       start <- fromIntegral <$> intLiteral@@ -434,25 +566,15 @@         Just (Just e) -> pure (ReservedRange start e)  -extensionsDecl :: Parser [ExtensionRange]+extensionsDecl :: Parser ([ExtensionRange], [OptionDef' Parsed]) extensionsDecl = do   reserved "extensions"   ranges <- extensionRange `sepBy1` comma-  -- proto2 syntax allows a trailing options block, e.g.-  ---  --   extensions 1000 to max [-  --     declaration = { number: 1000, full_name: ".foo", type: ".Foo" },-  --     declaration = { ... }-  --   ];-  ---  -- These options carry registration metadata (which is interesting-  -- only to protoc / descriptor-pool consumers, not the wire codecs we-  -- emit), so for now we parse-and-discard them rather than extending-  -- 'ExtensionRange' with a new field. The names+numbers we *do* keep-  -- are the only things downstream codegen looks at.-  _opts <- fieldOptionList+  -- Optional trailing options, e.g. @[verification = UNVERIFIED]@ or an+  -- editions @[declaration = {…}]@ list; same bracket syntax as field options.+  opts <- fieldOptionList   semi-  pure ranges+  pure (ranges, opts)   where     extensionRange = do       start <- fromIntegral <$> intLiteral@@ -471,7 +593,7 @@ enumDef cm doc start = do   reserved "enum"   name <- identifier-  items <- braces (many (enumItem cm))+  items <- braces (manyStmts (enumItem cm))   let vals = mapMaybe (\case EIValue v -> Just v; _ -> Nothing) items       opts = mapMaybe (\case EIOption o -> Just o; _ -> Nothing) items   end <- getOffset@@ -498,8 +620,17 @@ enumReservedDecl :: Parser () enumReservedDecl = do   reserved "reserved"-  _ <- (stringLiteral `sepBy1` comma) <|> (fmap (T.pack . show) <$> (intLiteral `sepBy1` comma))+  -- Either reserved names (quoted in proto2/proto3, bare identifiers in+  -- editions) or reserved numbers/ranges. Enum reserved ranges+  -- (@reserved 1 to 10;@, @reserved 5 to max;@) are accepted just like+  -- message reserved ranges; the values aren't retained in the AST.+  void (try ((stringLiteral <|> identifier) `sepBy1` comma)) <|> void (enumReservedRange `sepBy1` comma)   semi+  where+    enumReservedRange = do+      _ <- intLiteral+      _ <- optional (reserved "to" *> (reserved "max" <|> void intLiteral))+      pure ()   enumValueDef :: CommentMap -> Parser (EnumValue' Parsed)@@ -527,7 +658,7 @@   reserved "service"   name <- identifier   (rpcs, opts) <- braces $ do-    items <- many (Left <$> try (getOffset >>= optionDecl) <|> Right <$> rpcDef cm)+    items <- manyStmts (Left <$> try (getOffset >>= optionDecl) <|> Right <$> rpcDef cm)     pure       ( concatMap (either (const []) (: [])) items       , concatMap (either (: []) (const [])) items@@ -573,7 +704,7 @@       , rpcOptions = opts       }   where-    rpcBody = braces (many (getOffset >>= optionDecl >>= \o -> optional semi >> pure o))+    rpcBody = braces (manyStmts (getOffset >>= optionDecl))   -- -----------------------------------------------------------------------@@ -721,7 +852,8 @@   MEMapField mf -> spanLine src (mapExt mf)   MEOption o -> spanLine src (optExt o)   MEReserved _ -> Nothing-  MEExtensions _ -> Nothing+  MEExtensions _ _ -> Nothing+  MEExtend _ _ -> Nothing   MEComment _ -> Nothing  @@ -734,7 +866,8 @@   MEMapField mf -> spanEndLine src (mapExt mf)   MEOption o -> spanEndLine src (optExt o)   MEReserved _ -> Nothing-  MEExtensions _ -> Nothing+  MEExtensions _ _ -> Nothing+  MEExtend _ _ -> Nothing   MEComment _ -> Nothing
src/Proto/IDL/Parser/Error.hs view
@@ -76,15 +76,15 @@           else Nothing       pointer = makePointer lineNumWidth effectiveCol (pointerWidth err)   in unlines $-      catMaybes-        [ Just $ "error: " <> summary-        , Just $ pad <> " --> " <> filePath <> ":" <> show line <> ":" <> show col-        , Just $ pad <> " |"-        , contextBefore-        , effectiveLine-        , Just $ pointer <> " " <> details-        , Just $ pad <> " |"-        ]+       catMaybes+         [ Just $ "error: " <> summary+         , Just $ pad <> " --> " <> filePath <> ":" <> show line <> ":" <> show col+         , Just $ pad <> " |"+         , contextBefore+         , effectiveLine+         , Just $ pointer <> " " <> details+         , Just $ pad <> " |"+         ]   getSourceLine :: [Text] -> Int -> Maybe Text@@ -136,12 +136,12 @@ describeItem (Tokens ts) =   let s = NE.toList ts   in case s of-      [c]-        | c == '\n' -> "newline"-        | c == '\t' -> "tab"-        | c == ' ' -> "space"-        | otherwise -> "'" <> [c] <> "'"-      _ -> "\"" <> escapeString s <> "\""+       [c]+         | c == '\n' -> "newline"+         | c == '\t' -> "tab"+         | c == ' ' -> "space"+         | otherwise -> "'" <> [c] <> "'"+       _ -> "\"" <> escapeString s <> "\"" describeItem (Label cs) = NE.toList cs describeItem EndOfInput = "end of input" @@ -203,9 +203,9 @@ formatExpectedGroups (ExpectedGroup labels toks eoi) =   let allParts = labels <> toks <> (if eoi then ["end of input"] else [])   in case allParts of-      [] -> "something"-      [x] -> x-      _ -> commaOr allParts+       [] -> "something"+       [x] -> x+       _ -> commaOr allParts   commaOr :: [String] -> String
src/Proto/IDL/Parser/Lexer.hs view
@@ -197,13 +197,21 @@                 void (char '.')                 frac <- takeWhileP Nothing isDigit                 ex <- option "" exponentPart-                pure (read (T.unpack whole <> "." <> T.unpack frac <> T.unpack ex))+                -- @read@ rejects a bare trailing dot (e.g. "1."), so+                -- normalise an empty fractional part to a single zero.+                let fracStr = if T.null frac then "0" else T.unpack frac+                pure (read (T.unpack whole <> "." <> fracStr <> T.unpack ex))             , try $ do+                void (char '.')+                frac <- takeWhile1P Nothing isDigit+                ex <- option "" exponentPart+                pure (read ("0." <> T.unpack frac <> T.unpack ex))+            , try $ do                 whole <- takeWhile1P Nothing isDigit                 ex <- exponentPart                 pure (read (T.unpack whole <> T.unpack ex))-            , 1 / 0 <$ (string "inf" <|> string "infinity")-            , (0 / 0) <$ string "nan"+            , 1 / 0 <$ try (keywordTok "infinity" <|> keywordTok "inf")+            , (0 / 0) <$ try (keywordTok "nan")             ]         pure (sign n)     )@@ -248,16 +256,38 @@           , '\\' <$ char '\\'           , '\'' <$ char '\''           , '"' <$ char '"'+          , '?' <$ char '?'           , hexEscape+          , unicode4Escape+          , unicode8Escape           , octEscape           ] +    hexValue :: [Char] -> Int+    hexValue = foldl (\acc c -> acc * 16 + digitToInt c) 0++    -- @\xH@ or @\xHH@: one or two hex digits (protoc allows a single digit).     hexEscape = do       void (char 'x' <|> char 'X')       d1 <- hexDigitChar-      d2 <- hexDigitChar-      pure (chr (digitToInt d1 * 16 + digitToInt d2))+      md2 <- optional hexDigitChar+      pure (chr (hexValue (d1 : maybe [] (: []) md2))) +    -- @\uHHHH@: a Basic-Multilingual-Plane code point (always valid).+    unicode4Escape = do+      void (char 'u')+      ds <- count 4 hexDigitChar+      pure (chr (hexValue ds))++    -- @\UHHHHHHHH@: a full code point; reject values above U+10FFFF.+    unicode8Escape = do+      void (char 'U')+      ds <- count 8 hexDigitChar+      let cp = hexValue ds+      if cp <= 0x10FFFF+        then pure (chr cp)+        else fail "invalid Unicode code point in \\U escape (above U+10FFFF)"+     octEscape = do       d1 <- octDigitChar       d2 <- optional octDigitChar@@ -274,20 +304,34 @@ boolLiteral =   lexeme     ( choice-        [ True <$ string "true"-        , False <$ string "false"+        [ True <$ try (keywordTok "true")+        , False <$ try (keywordTok "false")         ]     )     <?> "boolean (true or false)"  +-- | Characters that may continue an identifier.+isIdentChar :: Char -> Bool+isIdentChar c = isAlphaNum c || c == '_'++ -- | Parse a reserved keyword, ensuring it is not a prefix of an identifier. reserved :: Text -> Parser () reserved w = lexeme $ do   void (string w)-  notFollowedBy (satisfy (\c -> isAlphaNum c || c == '_'))+  notFollowedBy (satisfy isIdentChar)  +{- | Match a bare keyword token (no trailing-whitespace handling) that must+not be immediately followed by an identifier character. Used for value+keywords like @true@ / @inf@ so identifiers that merely start with them+(e.g. @trueish@, @information@) are not mis-tokenised as the keyword.+-}+keywordTok :: Text -> Parser Text+keywordTok w = string w <* notFollowedBy (satisfy isIdentChar)++ -- --------------------------------------------------------------------------- -- Span support -- ---------------------------------------------------------------------------@@ -342,8 +386,8 @@           -- This is a definition (or other non-comment) line.           let rest' = go (lineNum + 1) [] rest           in case acc of-              [] -> rest'-              _ -> IntMap.insert lineNum (T.intercalate "\n" (fmap snd acc)) rest'+               [] -> rest'+               _ -> IntMap.insert lineNum (T.intercalate "\n" (fmap snd acc)) rest'      isCommentLine t =       let stripped = T.stripStart t@@ -354,8 +398,8 @@     stripComment t =       let afterSlashes = T.drop 2 (T.stripStart t)       in case T.uncons afterSlashes of-          Just (' ', rest) -> rest-          _ -> afterSlashes+           Just (' ', rest) -> rest+           _ -> afterSlashes   -- | Look up the doc comment for a definition at the given 1-based line number.@@ -389,8 +433,8 @@       let (content, after) = span (/= '\n') rest           lc = LocComment ln (LineComment (T.pack content))       in lc : case after of-          ('\n' : after') -> go (ln + 1) after'-          _ -> []+           ('\n' : after') -> go (ln + 1) after'+           _ -> []     go !ln ('/' : '*' : rest) =       let (content, after, endLn) = scanBlock ln rest           lc = LocComment ln (BlockComment (T.pack content))
src/Proto/IDL/Parser/Resolver.hs view
@@ -36,11 +36,13 @@ -- | Configuration for proto file resolution. data ResolveConfig = ResolveConfig   { rcIncludeDirs :: ![FilePath]-  -- ^ Directories to search for imported .proto files, in order.-  -- The directory containing the importing file is always searched first.+  {- ^ Directories to search for imported .proto files, in order.+  The directory containing the importing file is always searched first.+  -}   , rcBundledDir :: !(Maybe FilePath)-  -- ^ Path to bundled well-known proto files (google/protobuf/*.proto).-  -- If Nothing, uses the built-in bundled protos from the package.+  {- ^ Path to bundled well-known proto files (google/protobuf/*.proto).+  If Nothing, uses the built-in bundled protos from the package.+  -}   }   deriving stock (Show, Eq) @@ -137,13 +139,9 @@             case result of               Left e -> pure (Left e)               Right importMap -> do-                -- For editions schemas, apply field_presence feature overrides so-                -- that EXPLICIT/IMPLICIT/LEGACY_REQUIRED are reflected in fieldLabel.-                -- This normalises the AST before it reaches any codegen path.-                let pf' = applyEditionFieldPresence pf-                    resolved =+                let resolved =                       ResolvedProto-                        { rpFile = pf'+                        { rpFile = pf                         , rpPath = path                         , rpImports = importMap                         }
src/Proto/IDL/Print.hs view
@@ -107,7 +107,15 @@   MEOneof od -> printOneof depth od <> "\n"   MEMapField mf -> printDoc depth (mapDoc mf) <> indent depth <> printMapField mf <> "\n"   MEReserved rd -> indent depth <> printReserved rd <> "\n"-  MEExtensions exs -> indent depth <> "extensions " <> printExtensionRanges exs <> ";\n"+  MEExtensions exs opts -> indent depth <> "extensions " <> printExtensionRanges exs <> printFieldOptions opts <> ";\n"+  MEExtend name fields ->+    indent depth+      <> "extend "+      <> name+      <> " {\n"+      <> T.concat (fmap (\f -> indent (depth + 1) <> printField f <> "\n") fields)+      <> indent depth+      <> "}\n"   MEOption opt -> indent depth <> "option " <> printOptionAssignment opt <> ";\n"   MEComment cs -> printCommentBlock depth cs <> "\n" @@ -311,7 +319,13 @@   ReservedNumbers ranges ->     "reserved " <> T.intercalate ", " (fmap printReservedRange ranges) <> ";"   ReservedNames names ->-    "reserved " <> T.intercalate ", " (fmap (\n -> "\"" <> n <> "\"") names) <> ";"+    "reserved " <> T.intercalate ", " (fmap printReservedName names) <> ";"+++printReservedName :: ReservedName -> Text+printReservedName = \case+  QuotedReservedName n -> "\"" <> escapeProtoString n <> "\""+  IdentReservedName n -> n   printReservedRange :: ReservedRange -> Text
− src/Proto/Internal/Decode.hs 
@@ -1,716 +0,0 @@-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}--{- | High-level decoding interface for protobuf messages.--This is the primary module for deserialising protobuf messages from-bytes. Most users only need 'decodeMessage'.--== Quick start--@-import Proto.Internal.Decode--case 'decodeMessage' rawBytes of-  Left err -> handleError err   -- 'DecodeError' with details-  Right msg -> use msg-@--== Typeclass approach--Generated message types automatically get a 'MessageDecode' instance-via Template Haskell ('Proto.TH.loadProto'). The instance provides-'messageDecoder', a 'Decoder' action that is run by 'decodeMessage'.--== Error handling--'decodeMessage' returns @'Either' 'DecodeError' a@. 'DecodeError'-covers truncated input, invalid varints, UTF-8 validation failures,-negative length prefixes, and custom errors from generated code.--== Performance characteristics--* __Zero-copy__: @bytes@ and @string@ fields reference slices of the-  input 'Data.ByteString.ByteString' (no allocation for those fields).-* __Lazy submessage decoding__: with 'LazyMessage', submessage bytes-  are captured but not parsed until 'forceLazyMessage' is called.-* __Packed repeated fields__: adaptive multi-strategy decode with-  SWAR pre-counting for exact vector pre-allocation.-* __Unknown field preservation__: unrecognised fields are captured as-  'UnknownField' values for round-trip fidelity.--}-module Proto.Internal.Decode (-  -- * Decoding typeclass-  MessageDecode (..),--  -- * Running decoders-  decodeMessage,--  -- * Field decoding helpers-  decodeFieldVarint,-  decodeFieldSVarint32,-  decodeFieldSVarint64,-  decodeFieldFixed32,-  decodeFieldFixed64,-  decodeFieldFloat,-  decodeFieldDouble,-  decodeFieldBool,-  decodeFieldString,-  decodeFieldBytes,-  decodeFieldMessage,-  decodeFieldEnum,--  -- * Packed repeated field decoding-  decodePackedVarint,-  decodePackedFixed32,-  decodePackedFixed64,-  decodePackedFloat,-  decodePackedDouble,-  decodePackedSVarint32,-  decodePackedSVarint64,--  -- * Submessage decoding-  decodeSubmessage,--  -- * Lazy submessage decoding-  LazyMessage (..),-  forceLazyMessage,-  decodeFieldLazyMessage,--  -- * Unknown field preservation-  UnknownField (..),-  captureUnknownField,-  encodeUnknownFields,-  encodeUnknownFieldsSized,--  -- * Re-exports for generated code-  Decoder,-  DecodeResult (..),-  DecodeError (..),-  runDecoder,-  getVarint,-  getVarintSigned,-  getTagOr,-  getTag,-  skipField,-  getLengthDelimited,-  getFixed32,-  getFixed64,-  getFloat,-  getDouble,-  getText,-  getSVarint32,-  getSVarint64,--  -- * Map entry decoding-  decodeMapEntry,--  -- * CPS failure-  decodeFail,--  -- * Unknown field sizes-  unknownFieldsSize,--  -- * Unboxed internal types (re-exported for generated code)-  UMaybe (UJust, UNothing),-  umaybe,-  getTagOrU,--  -- * Three-way tag CPS (flattened, zero-allocation decode loop)-  TagResult#,-  withTag,--  -- * Monadic CPS tag dispatch (zero Tag allocation, for generated code)-  withTagM,-  skipWireType,-  inOrderStage,-  inOrderStage1,-) where--import Control.DeepSeq (NFData (..))-import Control.Monad qualified-import Control.Monad.ST (runST)-import Data.Bits (shiftL, (.&.), (.|.))-import Data.ByteString (ByteString)-import Data.ByteString qualified as BS-import Data.ByteString.Internal qualified as BSI-import Data.ByteString.Unsafe qualified as BSU-import Data.Int (Int32, Int64)-import Data.List (foldl')-import Data.Text (Text)-import Data.Vector.Storable qualified as VS-import Data.Vector.Storable.Mutable qualified as VSM-import Data.Vector.Unboxed qualified as VU-import Data.Vector.Unboxed.Mutable qualified as MVU-import Data.Word (Word32, Word64)-import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Marshal.Utils (copyBytes)-import Foreign.Ptr (castPtr)-import Foreign.Storable (Storable)-import GHC.Exts (Int (I#))-import GHC.Float (castWord32ToFloat, castWord64ToDouble)-import Proto.Internal.SizedBuilder qualified as SB-import Proto.Internal.Wire (Tag (..), WireType (..))-import Proto.Internal.Wire.Decode-import Proto.Internal.Wire.Encode (putFixed32, putFixed64, putLengthDelimited, putTag, putVarint, tagSize, varintSize)-import System.IO.Unsafe (unsafeDupablePerformIO)-import Wireform.Builder qualified as B-import Wireform.FFI (countPackedVarints)----- | Typeclass for types that can be decoded from protobuf wire format.-class MessageDecode a where-  -- | Decode a message from a ByteString, starting from default field values.-  -- The decoder should consume all bytes of the submessage.-  messageDecoder :: Decoder a----- | Decode a message from a strict 'ByteString'.-decodeMessage :: MessageDecode a => ByteString -> Either DecodeError a-decodeMessage = runDecoder messageDecoder-{-# INLINE decodeMessage #-}----- | Decode a varint value.-decodeFieldVarint :: Decoder Word64-decodeFieldVarint = getVarint-{-# INLINE decodeFieldVarint #-}----- | Decode a sint32 value.-decodeFieldSVarint32 :: Decoder Int32-decodeFieldSVarint32 = getSVarint32-{-# INLINE decodeFieldSVarint32 #-}----- | Decode a sint64 value.-decodeFieldSVarint64 :: Decoder Int64-decodeFieldSVarint64 = getSVarint64-{-# INLINE decodeFieldSVarint64 #-}----- | Decode a fixed32 value.-decodeFieldFixed32 :: Decoder Word32-decodeFieldFixed32 = getFixed32-{-# INLINE decodeFieldFixed32 #-}----- | Decode a fixed64 value.-decodeFieldFixed64 :: Decoder Word64-decodeFieldFixed64 = getFixed64-{-# INLINE decodeFieldFixed64 #-}----- | Decode a float value.-decodeFieldFloat :: Decoder Float-decodeFieldFloat = getFloat-{-# INLINE decodeFieldFloat #-}----- | Decode a double value.-decodeFieldDouble :: Decoder Double-decodeFieldDouble = getDouble-{-# INLINE decodeFieldDouble #-}----- | Decode a bool value.-decodeFieldBool :: Decoder Bool-decodeFieldBool = do-  v <- getVarint-  pure (v /= 0)-{-# INLINE decodeFieldBool #-}----- | Decode a string value (validated UTF-8, zero-copy).-decodeFieldString :: Decoder Text-decodeFieldString = getText-{-# INLINE decodeFieldString #-}----- | Decode a bytes value (zero-copy).-decodeFieldBytes :: Decoder ByteString-decodeFieldBytes = getByteString-{-# INLINE decodeFieldBytes #-}---{- | Decode a submessage field using a bounded sub-buffer.--Reads the length prefix from the parent buffer, slices the exact-submessage bytes (zero-copy — just ForeignPtr offset adjustment),-then runs the sub-decoder on that slice. The sub-decoder's end-of-input-check naturally enforces the submessage boundary.--}-decodeFieldMessage :: MessageDecode a => Decoder a-decodeFieldMessage = Decoder $ \bs off ->-  case runDecoder# getVarint bs off of-    (# (# lenW, off' #) | #) ->-      let !len = fromIntegral lenW :: Int-      in if len < 0-          then (# | NegativeLength #)-          else-            if I# off' + len > BS.length bs-              then (# | UnexpectedEnd #)-              else-                let !subBs = case bs of-                      BSI.BS fp _ -> BSI.BS (BSI.plusForeignPtr fp (I# off')) len-                in case runDecoder# messageDecoder subBs 0# of-                    (# (# a, subOff #) | #)-                      | I# subOff == len ->-                          (# (# a, case I# off' + len of I# r -> r #) | #)-                      | otherwise -> (# | SubMessageError ExtraBytes #)-                    (# | e #) -> (# | SubMessageError e #)-    (# | e #) -> (# | e #)-{-# INLINE decodeFieldMessage #-}----- | CPS-compatible failure: calls the error continuation.-decodeFail :: DecodeError -> Decoder a-decodeFail e = Decoder $ \_ _ -> (# | e #)-{-# INLINE decodeFail #-}---{- | Decode an enum field (as varint, then fromEnum).--Per the proto3 wire spec, enum values are 32-bit on the wire-even though varints can carry larger values: a sender that-writes @kInt64Max@ for an enum field is expected to be parsed-as the int32 truncation of that value (low 32 bits, sign--extended). We honour that by casting the decoded 'Word64'-through 'Int32' before handing it to 'toEnum', so a generated-enum with @NEG = -1@ correctly reconstitutes from a 10-byte-varint of @0xFF...FF7F@.--}-decodeFieldEnum :: Enum a => Decoder a-decodeFieldEnum =-  toEnum . fromIntegral . (fromIntegral :: Word64 -> Int32)-    <$> getVarint-{-# INLINE decodeFieldEnum #-}----- | Decode a submessage from raw bytes.-decodeSubmessage :: MessageDecode a => ByteString -> Either DecodeError a-decodeSubmessage = runDecoder messageDecoder-{-# INLINE decodeSubmessage #-}----- Packed decoders: decode a length-delimited chunk containing multiple values.---- | Decode packed varint values.-decodePackedVarint :: Decoder (VU.Vector Word64)-decodePackedVarint = do-  bs <- getLengthDelimited-  case decodeAllVarints bs of-    Left e -> decodeFail e-    Right vs -> pure vs-{-# INLINE decodePackedVarint #-}---{- | Decode all varints from a packed buffer.--Optimizations borrowed from hyperpb (mcyoung.xyz/2025/07/16/hyperpb):-- 1. SWAR pre-count: use the C SWAR routine to count terminator bytes-    in one pass, then allocate the output vector to exact size upfront.-    This avoids grow-and-copy or list-reversal overhead.-- 2. Single-byte zero-copy: when every varint is one byte (values 0-127),-    each byte IS the value. We skip varint parsing entirely and just-    widen bytes to Word64. This is the common case for enum fields,-    small indices, and boolean-like repeated fields.-| Decode all varints from a packed buffer.--Adaptive 3-strategy decode from hyperpb's parsePackedVarint:-- 1. count == byteLength: every varint is 1 byte (values 0-127).-    Zero-copy widening — each byte IS the value.-- 2. count >= byteLength/2: mostly 1-2 byte varints.-    Inline 1-2 byte fast path with fallback for larger varints.-    The 1-2 byte branches are well-predicted because they're common.-- 3. count < byteLength/2: many large varints.-    Call full varint decoder (1-2 byte branches would mispredict often).--}-decodeAllVarints :: ByteString -> Either DecodeError (VU.Vector Word64)-decodeAllVarints bs-  | BS.null bs = Right VU.empty-  | otherwise =-      let !len = BS.length bs-          !n = countPackedVarints bs-      in if n == len-          -- Strategy 1: all single-byte-          then Right $! VU.generate n (fromIntegral . BSU.unsafeIndex bs)-          else Right $! runST $ do-            mv <- MVU.unsafeNew n-            if n >= len `quot` 2-              -- Strategy 2: mostly small varints, inline 1-2 byte fast path-              then do-                let go !idx !off-                      | off >= len = pure ()-                      | otherwise =-                          let !b0 = fromIntegral (BSU.unsafeIndex bs off) :: Word64-                          in if b0 < 0x80-                              then do-                                MVU.unsafeWrite mv idx b0-                                go (idx + 1) (off + 1)-                              else-                                Control.Monad.when (off + 1 < len) $-                                  let !b1 = fromIntegral (BSU.unsafeIndex bs (off + 1)) :: Word64-                                  in if b1 < 0x80-                                      then do-                                        MVU.unsafeWrite mv idx ((b0 .&. 0x7F) .|. (b1 `shiftL` 7))-                                        go (idx + 1) (off + 2)-                                      else case runDecoder' getVarint bs off of-                                        DecodeOK v off' -> do-                                          MVU.unsafeWrite mv idx v-                                          go (idx + 1) off'-                                        DecodeFail _ -> pure ()-                go 0 0-              -- Strategy 3: many large varints, full decoder-              else do-                let go !idx !off-                      | off >= len = pure ()-                      | otherwise = case runDecoder' getVarint bs off of-                          DecodeOK v off' -> do-                            MVU.unsafeWrite mv idx v-                            go (idx + 1) off'-                          DecodeFail _ -> pure ()-                go 0 0-            VU.unsafeFreeze mv----- | Decode packed fixed32 values.-decodePackedFixed32 :: Decoder (VU.Vector Word32)-decodePackedFixed32 = do-  bs <- getLengthDelimited-  case decodeAllFixed32 bs of-    Left e -> decodeFail e-    Right vs -> pure vs-{-# INLINE decodePackedFixed32 #-}---{- | Decode packed fixed32 values. Count is known: byteLength / 4.-On little-endian (x86_64, aarch64-LE): single memcpy of the entire packed-buffer into the vector's backing store. The wire bytes are already the-native representation, so no per-element work is needed.--}-decodeAllFixed32 :: ByteString -> Either DecodeError (VU.Vector Word32)-decodeAllFixed32 bs-  | r /= 0 = Left (CustomError "packed fixed32: byte length not multiple of 4")-  | otherwise = Right $! unsafeBulkCopyToVectorU n 4 bs-  where-    (!n, !r) = BS.length bs `quotRem` 4----- | Decode packed fixed64 values. Count is known: byteLength / 8.-decodePackedFixed64 :: Decoder (VU.Vector Word64)-decodePackedFixed64 = do-  bs <- getLengthDelimited-  case decodeAllFixed64 bs of-    Left e -> decodeFail e-    Right vs -> pure vs-{-# INLINE decodePackedFixed64 #-}---decodeAllFixed64 :: ByteString -> Either DecodeError (VU.Vector Word64)-decodeAllFixed64 bs-  | r /= 0 = Left (CustomError "packed fixed64: byte length not multiple of 8")-  | otherwise = Right $! unsafeBulkCopyToVectorU n 8 bs-  where-    (!n, !r) = BS.length bs `quotRem` 8----- | Decode packed float values. Count is known: byteLength / 4.-decodePackedFloat :: Decoder (VU.Vector Float)-decodePackedFloat = do-  bs <- getLengthDelimited-  case decodeAllFloat bs of-    Left e -> decodeFail e-    Right vs -> pure vs-{-# INLINE decodePackedFloat #-}---decodeAllFloat :: ByteString -> Either DecodeError (VU.Vector Float)-decodeAllFloat bs-  | r /= 0 = Left (CustomError "packed float: byte length not multiple of 4")-  | otherwise = Right $! VU.map castWord32ToFloat (unsafeBulkCopyToVectorU n 4 bs :: VU.Vector Word32)-  where-    (!n, !r) = BS.length bs `quotRem` 4----- | Decode packed double values. Count is known: byteLength / 8.-decodePackedDouble :: Decoder (VU.Vector Double)-decodePackedDouble = do-  bs <- getLengthDelimited-  case decodeAllDouble bs of-    Left e -> decodeFail e-    Right vs -> pure vs-{-# INLINE decodePackedDouble #-}---decodeAllDouble :: ByteString -> Either DecodeError (VU.Vector Double)-decodeAllDouble bs-  | r /= 0 = Left (CustomError "packed double: byte length not multiple of 8")-  | otherwise = Right $! VU.map castWord64ToDouble (unsafeBulkCopyToVectorU n 8 bs :: VU.Vector Word64)-  where-    (!n, !r) = BS.length bs `quotRem` 8----- | Bulk-copy a ByteString into a new unboxed vector-unsafeBulkCopyToVectorU-  :: (VU.Unbox a, Storable a)-  => Int-  -> Int-  -> ByteString-  -> VU.Vector a-unsafeBulkCopyToVectorU elemCount elemSize (BSI.BS fp _) =-  let sv = unsafeDupablePerformIO $ do-        mvs <- VSM.unsafeNew elemCount-        VSM.unsafeWith mvs $ \dst ->-          withForeignPtr fp $ \src ->-            copyBytes dst (castPtr src) (elemCount * elemSize)-        VS.unsafeFreeze mvs-  in VU.convert sv-{-# INLINE unsafeBulkCopyToVectorU #-}----- | Decode packed sint32 values.-decodePackedSVarint32 :: Decoder (VU.Vector Int32)-decodePackedSVarint32 = do-  bs <- getLengthDelimited-  case decodeAllSVarint32 bs of-    Left e -> decodeFail e-    Right vs -> pure vs-{-# INLINE decodePackedSVarint32 #-}---decodeAllSVarint32 :: ByteString -> Either DecodeError (VU.Vector Int32)-decodeAllSVarint32 bs-  | BS.null bs = Right VU.empty-  | otherwise =-      let !n = countPackedVarints bs-      in Right $! runST $ do-          mv <- MVU.unsafeNew n-          let len = BS.length bs-              go !idx !off-                | off >= len = pure ()-                | otherwise = case runDecoder' getSVarint32 bs off of-                    DecodeOK v off' -> do-                      MVU.unsafeWrite mv idx v-                      go (idx + 1) off'-                    DecodeFail _ -> pure ()-          go 0 0-          VU.unsafeFreeze mv----- | Decode packed sint64 values.-decodePackedSVarint64 :: Decoder (VU.Vector Int64)-decodePackedSVarint64 = do-  bs <- getLengthDelimited-  case decodeAllSVarint64 bs of-    Left e -> decodeFail e-    Right vs -> pure vs-{-# INLINE decodePackedSVarint64 #-}---decodeAllSVarint64 :: ByteString -> Either DecodeError (VU.Vector Int64)-decodeAllSVarint64 bs-  | BS.null bs = Right VU.empty-  | otherwise =-      let !n = countPackedVarints bs-      in Right $! runST $ do-          mv <- MVU.unsafeNew n-          let len = BS.length bs-              go !idx !off-                | off >= len = pure ()-                | otherwise = case runDecoder' getSVarint64 bs off of-                    DecodeOK v off' -> do-                      MVU.unsafeWrite mv idx v-                      go (idx + 1) off'-                    DecodeFail _ -> pure ()-          go 0 0-          VU.unsafeFreeze mv---{- | A lazily-decoded submessage.--The parent message decode captures the submessage's raw bytes but does-not parse them immediately. Parsing is deferred until 'forceLazyMessage'-is called — so if you never access a particular submessage field, its-decode cost is zero.--== When to opt in--Lazy decoding pays off when:--* Your code path only inspects a subset of submessages (e.g. routing-  middleware that reads a header field but forwards the body opaque).-* The submessage is large and infrequently accessed.-* You are decoding many messages in bulk and want to amortise heavy-  submessage parsing.--== How to opt in (text codegen)--Pass @genLazySubmessages = True@ in 'Proto.CodeGen.GenerateOpts' when-generating code.  Every submessage field in the generated types then-has type @'LazyMessage' Foo@ instead of @Foo@.--== Usage--@--- Given a generated type with a lazy submessage field:---   data Envelope = Envelope { envelopeBody :: 'LazyMessage' Body, … }---- Decode the envelope — O(envelope fields), Body not parsed yet.-case 'decodeMessage' raw of-  Left err  -> handleError err-  Right env ->-    -- Force the body only if you actually need it:-    case 'forceLazyMessage' (envelopeBody env) of-      Left err  -> handleBodyError err-      Right body -> use body-@--== Caveats--* A 'LazyMessage' retains a reference to the slice of the original-  input 'ByteString'.  If the input is large and you store-  'LazyMessage' values long-term, consider forcing them promptly to-  avoid holding onto the parent buffer.--* 'Eq' compares the raw bytes, not the decoded value; two structurally-  equal messages encoded differently will compare unequal.--}-data LazyMessage a = LazyMessage-  { lazyRawBytes :: !ByteString-  -- ^ The raw submessage bytes captured from the parent buffer.-  , lazyCached :: ~(Either DecodeError a)-  -- ^ The lazily-evaluated decode result; not forced until 'forceLazyMessage' is called.-  }---instance Show a => Show (LazyMessage a) where-  show (LazyMessage bs _) = "LazyMessage (" <> show (BS.length bs) <> " bytes)"---instance Eq a => Eq (LazyMessage a) where-  a == b = lazyRawBytes a == lazyRawBytes b---{- | Force a 'LazyMessage', decoding the raw bytes.--Returns @'Left' 'DecodeError'@ if the bytes are malformed.-The result is memoised: calling 'forceLazyMessage' more than once on-the same 'LazyMessage' does not repeat the decode work.--}-forceLazyMessage :: LazyMessage a -> Either DecodeError a-forceLazyMessage = lazyCached-{-# INLINE forceLazyMessage #-}----- | Decode a submessage field lazily: capture the bytes but defer parsing.-decodeFieldLazyMessage :: MessageDecode a => Decoder (LazyMessage a)-decodeFieldLazyMessage = do-  bs <- getLengthDelimited-  pure-    LazyMessage-      { lazyRawBytes = bs-      , lazyCached = runDecoder messageDecoder bs-      }-{-# INLINE decodeFieldLazyMessage #-}---{- | An unknown field captured during decoding for round-trip preservation.-Storing unknown fields allows messages to pass through intermediaries-without losing data added by newer protocol versions.--}-data UnknownField-  = -- | A varint-encoded unknown field (wire type 0).-    UnknownVarint {-# UNPACK #-} !Int {-# UNPACK #-} !Word64-  | -- | A 64-bit fixed-width unknown field (wire type 1).-    UnknownFixed64 {-# UNPACK #-} !Int {-# UNPACK #-} !Word64-  | -- | A 32-bit fixed-width unknown field (wire type 5).-    UnknownFixed32 {-# UNPACK #-} !Int {-# UNPACK #-} !Word32-  | -- | A length-delimited unknown field (wire type 2).-    UnknownLenDelim {-# UNPACK #-} !Int !ByteString-  deriving stock (Show, Eq)---instance NFData UnknownField where-  rnf (UnknownVarint a b) = rnf a `seq` rnf b-  rnf (UnknownFixed64 a b) = rnf a `seq` rnf b-  rnf (UnknownFixed32 a b) = rnf a `seq` rnf b-  rnf (UnknownLenDelim a b) = rnf a `seq` rnf b----- | Capture an unknown field value during decoding.-captureUnknownField :: Int -> WireType -> Decoder UnknownField-captureUnknownField fn = \case-  WireVarint -> UnknownVarint fn <$> getVarint-  Wire64Bit -> UnknownFixed64 fn <$> getFixed64-  Wire32Bit -> UnknownFixed32 fn <$> getFixed32-  WireLengthDelimited -> UnknownLenDelim fn <$> getLengthDelimited-  wt -> skipField wt >> decodeFail (CustomError ("Unsupported unknown wire type: " <> show wt))----- | Compute the wire-format size of unknown fields.-unknownFieldsSize :: [UnknownField] -> Int-unknownFieldsSize = foldl' (\acc uf -> acc + unknownFieldSize uf) 0-  where-    unknownFieldSize (UnknownVarint fn val) =-      tagSize fn + varintSize val-    unknownFieldSize (UnknownFixed64 fn _) =-      tagSize fn + 8-    unknownFieldSize (UnknownFixed32 fn _) =-      tagSize fn + 4-    unknownFieldSize (UnknownLenDelim fn val) =-      tagSize fn + varintSize (fromIntegral (BS.length val)) + BS.length val----- | Re-encode unknown fields for round-trip preservation.-encodeUnknownFields :: [UnknownField] -> B.Builder-encodeUnknownFields = foldMap encodeOne-  where-    encodeOne (UnknownVarint fn val) =-      putTag fn WireVarint <> putVarint val-    encodeOne (UnknownFixed64 fn val) =-      putTag fn Wire64Bit <> putFixed64 val-    encodeOne (UnknownFixed32 fn val) =-      putTag fn Wire32Bit <> putFixed32 val-    encodeOne (UnknownLenDelim fn val) =-      putTag fn WireLengthDelimited <> putLengthDelimited val----- | 'encodeUnknownFields' fused with 'unknownFieldsSize'. The--- generated 'buildSized' methods append this fragment at the end of--- their @SizedBuilder@ chain so unknown fields contribute their--- exact byte count to the parent's wire size without a second pass.-encodeUnknownFieldsSized :: [UnknownField] -> SB.SizedBuilder-encodeUnknownFieldsSized = foldMap encodeOne-  where-    encodeOne :: UnknownField -> SB.SizedBuilder-    encodeOne (UnknownVarint fn val) =-      SB.sized (tagSize fn + varintSize val) (putTag fn WireVarint <> putVarint val)-    encodeOne (UnknownFixed64 fn val) =-      SB.sized (tagSize fn + 8) (putTag fn Wire64Bit <> putFixed64 val)-    encodeOne (UnknownFixed32 fn val) =-      SB.sized (tagSize fn + 4) (putTag fn Wire32Bit <> putFixed32 val)-    encodeOne (UnknownLenDelim fn val) =-      let !len = BS.length val-          !sz = tagSize fn + varintSize (fromIntegral len) + len-      in SB.sized sz (putTag fn WireLengthDelimited <> putLengthDelimited val)-{-# INLINE encodeUnknownFieldsSized #-}----- | Decode a map entry (key=field1, value=field2) from a length-delimited chunk.-decodeMapEntry :: Decoder k -> Decoder v -> k -> v -> Decoder (k, v)-decodeMapEntry decK decV = loop-  where-    loop !mk !mv =-      withTagM-        (pure (mk, mv))-        ( \fn wt -> case fn of-            1 -> do kv <- decK; loop kv mv-            2 -> do vv <- decV; loop mk vv-            _ -> skipWireType wt >> loop mk mv-        )
src/Proto/Internal/Derive.hs view
@@ -46,6 +46,8 @@   -- * Instance synthesis (no reification required)   mkEncodeInstance,   mkEncodeInstanceWith,+  mkSizeInstance,+  mkSizeInstanceWith,   mkDecodeInstance,   mkDecodeInstanceWith,   mkSemigroupInstance,@@ -71,26 +73,20 @@ import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BL-import Data.ByteString.Short qualified as SBS import Data.Int (Int32, Int64)-import Data.List qualified as List import Data.Map.Strict qualified as Map import Data.Maybe (maybeToList)-import Data.Sequence qualified as Seq import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding qualified as TE-import Data.Text.Lazy qualified as TL-import Data.Vector qualified as V import Data.Word (Word32, Word64) import Language.Haskell.TH-import Proto.Internal.Decode qualified as PD-import Proto.Internal.Encode qualified as PE+import Proto.Decode qualified as PD+import Proto.Encode qualified as PE import Proto.Internal.Encode.Archetype qualified as PA-import Proto.Internal.Wire (Tag (..))+import Proto.Internal.Wire (Tag) import Proto.Internal.Wire qualified as PWire import Proto.Internal.Wire.Decode qualified as PWD-import Proto.Internal.SizedBuilder qualified as PSB import Proto.Internal.Wire.Encode qualified as PWE import Proto.Registry qualified as PReg import Proto.Repr (BytesAdapter (..), BytesRep (..), MapAdapter (..), RepeatedAdapter (..), StringAdapter (..), StringRep (..))@@ -106,31 +102,35 @@  -- | How the field is wrapped on the Haskell side. data ProtoFieldKind-  = -- | Singular scalar / submessage / enum field. Encode with the-    -- proto3 default-skip rule (scalars only; submessages and enums-    -- always encode at least the tag, but a missing tag decodes to-    -- the zero value).+  = {- | Singular scalar / submessage / enum field. Encode with the+    proto3 default-skip rule (scalars only; submessages and enums+    always encode at least the tag, but a missing tag decodes to+    the zero value).+    -}     FKBare   | -- | @Maybe a@-wrapped singular field. Encode only when 'Just'.     FKMaybe-  | -- | A repeated field carried by a container chosen by the-    -- 'RepeatedAdapter'. The element type lives in @pfInnerTy@ and-    -- the wire encoding in @pfType@. 'RepeatedMode' selects packed-    -- vs. unpacked on the encoder side; the decoder always accepts-    -- both when the element is a packable scalar (per the proto3-    -- spec, a parser must accept both encodings regardless of how-    -- the writer chose).+  | {- | A repeated field carried by a container chosen by the+    'RepeatedAdapter'. The element type lives in @pfInnerTy@ and+    the wire encoding in @pfType@. 'RepeatedMode' selects packed+    vs. unpacked on the encoder side; the decoder always accepts+    both when the element is a packable scalar (per the proto3+    spec, a parser must accept both encodings regardless of how+    the writer chose).+    -}     FKRepeated !RepeatedAdapter !RepeatedMode-  | -- | A proto3 @map<K, V>@ field carried by a strict-    -- 'Data.Map.Strict.Map'. The key's wire encoding is the-    -- supplied 'MapKeyScalar'; the value's wire encoding is in-    -- @pfType@ and the value's Haskell type is @pfInnerTy@.+  | {- | A proto3 @map<K, V>@ field carried by a strict+    'Data.Map.Strict.Map'. The key's wire encoding is the+    supplied 'MapKeyScalar'; the value's wire encoding is in+    @pfType@ and the value's Haskell type is @pfInnerTy@.+    -}     FKMap !MapKeyScalar-  | -- | A proto @oneof@ carried as a Haskell @Maybe SumType@. Each-    -- variant's tag, constructor, and payload type lives inline.-    -- @pfTag@ is unused for oneofs; @pfType@ / @pfInnerTy@ describe-    -- the carrier @Maybe SumType@ but are ignored by the body-    -- builders.+  | {- | A proto @oneof@ carried as a Haskell @Maybe SumType@. Each+    variant's tag, constructor, and payload type lives inline.+    @pfTag@ is unused for oneofs; @pfType@ / @pfInnerTy@ describe+    the carrier @Maybe SumType@ but are ignored by the body+    builders.+    -}     FKOneof ![OneofVariant]  @@ -174,11 +174,13 @@   , ovType :: !ProtoFieldType   -- ^ Wire encoding for the arm's payload.   , ovStringAdapter :: StringAdapter-  -- ^ String adapter for this variant when-  -- @ovType = PFScalar SString@.+  {- ^ String adapter for this variant when+  @ovType = PFScalar SString@.+  -}   , ovBytesAdapter :: BytesAdapter-  -- ^ Bytes adapter for this variant when-  -- @ovType = PFScalar SBytes@.+  {- ^ Bytes adapter for this variant when+  @ovType = PFScalar SBytes@.+  -}   }  @@ -203,11 +205,13 @@ data ProtoFieldType   = -- | Recognised scalar.     PFScalar !Scalar-  | -- | Submessage with existing 'PE.MessageEncode' \/-    -- 'PD.MessageDecode' \/ 'PE.MessageSize' instances.+  | {- | Submessage with existing 'PE.MessageEncode' \/+    'PD.MessageDecode' \/ 'PE.MessageSize' instances.+    -}     PFSubmessage-  | -- | A Haskell @Enum@ (any datatype with derived @Enum@).-    -- Encoded as a varint via 'fromEnum' / 'toEnum'.+  | {- | A Haskell @Enum@ (any datatype with derived @Enum@).+    Encoded as a varint via 'fromEnum' / 'toEnum'.+    -}     PFEnum   deriving stock (Eq, Show) @@ -262,19 +266,23 @@   , pfTag :: !Int   , pfKind :: !ProtoFieldKind   , pfType :: !ProtoFieldType-  -- ^ Wire encoding for the field's element/value (singular,-  -- repeated, map-value). Ignored for 'FKOneof' (each variant-  -- carries its own).+  {- ^ Wire encoding for the field's element/value (singular,+  repeated, map-value). Ignored for 'FKOneof' (each variant+  carries its own).+  -}   , pfInnerTy :: !Type-  -- ^ Type of the unwrapped value (no 'Maybe', no container).-  -- For maps, this is the value type. For oneofs this is the-  -- carrier @Maybe SumType@ — body builders ignore it.+  {- ^ Type of the unwrapped value (no 'Maybe', no container).+  For maps, this is the value type. For oneofs this is the+  carrier @Maybe SumType@ — body builders ignore it.+  -}   , pfStringAdapter :: StringAdapter-  -- ^ Adapter for proto @string@ fields. Only consulted when-  -- @pfType = PFScalar SString@.+  {- ^ Adapter for proto @string@ fields. Only consulted when+  @pfType = PFScalar SString@.+  -}   , pfBytesAdapter :: BytesAdapter-  -- ^ Adapter for proto @bytes@ fields. Only consulted when-  -- @pfType = PFScalar SBytes@.+  {- ^ Adapter for proto @bytes@ fields. Only consulted when+  @pfType = PFScalar SBytes@.+  -}   }  @@ -309,20 +317,41 @@ 'Proto.TH.Derive.deriveProto' output and silently drop unknown tags. -}-newtype MessageMeta = MessageMeta+data MessageMeta = MessageMeta   { mmUnknownFieldsSel :: Maybe Name-  -- ^ Selector for an @[Decode.UnknownField]@ field on the-  -- record. When set, the codecs round-trip unknown tags through-  -- this slot.+  {- ^ Selector for an @[Decode.UnknownField]@ field on the+  record. When set, the codecs round-trip unknown tags through+  this slot.+  -}+  , mmRecordDotReads :: !Bool+  {- ^ When 'True', read record fields with record-dot syntax+  (@msg.field@) instead of a bare selector application+  (@field msg@). Required when the record was generated with+  'Proto.CodeGen.UnprefixedFields' (bare field names shared+  across messages are ambiguous, and 'NoFieldSelectors' removes+  the selectors entirely); the enclosing module then needs+  @OverloadedRecordDot@. Left 'False' for the default prefixed+  layout so existing output is byte-identical.+  -}   }   deriving stock (Show)  --- | Default 'MessageMeta' with no unknown-fields slot.+-- | Default 'MessageMeta': no unknown-fields slot, bare-selector reads. defaultMessageMeta :: MessageMeta-defaultMessageMeta = MessageMeta {mmUnknownFieldsSel = Nothing}+defaultMessageMeta = MessageMeta {mmUnknownFieldsSel = Nothing, mmRecordDotReads = False}  +-- | Read a record field: @msg.field@ (record-dot) under+-- 'mmRecordDotReads', else the bare selector application @field msg@.+-- The field label for the record-dot form is the selector's base name,+-- which is exactly the field name in both naming modes.+readSel :: MessageMeta -> Name -> Name -> Exp+readSel meta sel msgVar+  | mmRecordDotReads meta = GetFieldE (VarE msgVar) (nameBase sel)+  | otherwise = AppE (VarE sel) (VarE msgVar)++ -- --------------------------------------------------------------------------- -- Wire-tag helpers -- ---------------------------------------------------------------------------@@ -378,14 +407,14 @@ buildMessageBodyWith :: MessageMeta -> [ProtoField] -> Q Exp buildMessageBodyWith meta fs = do   msg <- newName "msg"-  parts <- mapM (encodeOne msg) fs+  parts <- mapM (encodeOne meta msg) fs   let ufPart = case mmUnknownFieldsSel meta of         Nothing -> Nothing         Just sel ->           Just             ( AppE-                (VarE 'PD.encodeUnknownFieldsSized)-                (AppE (VarE sel) (VarE msg))+                (VarE 'PD.encodeUnknownFields)+                (readSel meta sel msg)             )       allParts = parts <> maybeToList ufPart   case allParts of@@ -408,14 +437,14 @@ messageSizeBodyWith :: MessageMeta -> [ProtoField] -> Q Exp messageSizeBodyWith meta fs = do   msg <- newName "msg"-  parts <- mapM (sizeOne msg) fs+  parts <- mapM (sizeOne meta msg) fs   let ufPart = case mmUnknownFieldsSel meta of         Nothing -> Nothing         Just sel ->           Just             ( AppE                 (VarE 'PD.unknownFieldsSize)-                (AppE (VarE sel) (VarE msg))+                (readSel meta sel msg)             )       allParts = parts <> maybeToList ufPart   case allParts of@@ -480,29 +509,30 @@ mkEncodeInstanceWith :: MessageMeta -> Type -> [ProtoField] -> Q Dec mkEncodeInstanceWith meta ty fs = do   body <- buildMessageBodyWith meta fs-  -- 'buildMessageBodyWith' now produces a 'SizedBuilder'-valued-  -- lambda (every field encoder underneath has been migrated to-  -- the sized archetypes), so this instance defines 'buildSized'-  -- directly. 'buildMessage' falls out of the class default in-  -- "Proto.Encode" via @SB.toBuilder . buildSized@ and-  -- 'messageSize' via @SB.size . buildSized@; neither needs a-  -- separate TH-emitted method.   pure $     InstanceD       Nothing       []       (AppT (ConT ''PE.MessageEncode) ty)-      [FunD 'PE.buildSized [Clause [] (NormalB body) []]]+      [FunD 'PE.buildMessage [Clause [] (NormalB body) []]]  --- The old @mkSizeInstance@ / @mkSizeInstanceWith@ helpers (which--- emitted standalone @MessageSize@ instances) are gone — the--- 'MessageSize' class was removed, and the size pass is now fused--- into 'PE.buildSized' via 'mkEncodeInstance'. If you want the--- message's wire size you go through 'PE.messageSize' (which is--- @'SB.size' . 'PE.buildSized'@).+-- | Generate an 'PE.MessageSize' instance.+mkSizeInstance :: Type -> [ProtoField] -> Q Dec+mkSizeInstance = mkSizeInstanceWith defaultMessageMeta  +mkSizeInstanceWith :: MessageMeta -> Type -> [ProtoField] -> Q Dec+mkSizeInstanceWith meta ty fs = do+  body <- messageSizeBodyWith meta fs+  pure $+    InstanceD+      Nothing+      []+      (AppT (ConT ''PE.MessageSize) ty)+      [FunD 'PE.messageSize [Clause [] (NormalB body) []]]++ {- | Generate a 'PD.MessageDecode' instance using @conName@ as the record constructor. -}@@ -513,7 +543,7 @@ mkDecodeInstanceWith :: MessageMeta -> Type -> Name -> [ProtoField] -> Q Dec mkDecodeInstanceWith meta ty conName fs = do   body <- messageDecoderBodyWith meta conName fs-  -- agents.md ("Performance" → "Decoder monad style") requires+  -- AGENTS.md ("Performance" → "Decoder monad style") requires   -- @{-# INLINE messageDecoder #-}@ on every instance: the   -- continuation-passing dispatch in 'getTagOrU' is only worth its   -- weight when GHC can see the lambda for each field. Mirrors what@@ -565,20 +595,20 @@   bName <- newName "b"   let mergeField pf =         let sel = pfSelector pf-            getA = AppE (VarE sel) (VarE aName)-            getB = AppE (VarE sel) (VarE bName)+            getA = readSel meta sel aName+            getB = readSel meta sel bName         in case pfKind pf of-            FKRepeated _ _ -> [|$(pure getA) <> $(pure getB)|]-            FKMap _ -> [|$(pure getA) <> $(pure getB)|]-            FKOneof _ -> [|case $(pure getB) of Nothing -> $(pure getA); b' -> b'|]-            FKMaybe -> [|case $(pure getB) of Nothing -> $(pure getA); b' -> b'|]-            _ -> case pfType pf of-              PFSubmessage -> [|case $(pure getB) of Nothing -> $(pure getA); b' -> b'|]-              PFEnum -> [|if $(pure getB) == toEnum 0 then $(pure getA) else $(pure getB)|]-              PFScalar SBool -> [|if not $(pure getB) then $(pure getA) else $(pure getB)|]-              PFScalar SString -> [|if $(pure getB) == mempty then $(pure getA) else $(pure getB)|]-              PFScalar SBytes -> [|if $(pure getB) == mempty then $(pure getA) else $(pure getB)|]-              PFScalar _ -> [|if $(pure getB) == 0 then $(pure getA) else $(pure getB)|]+             FKRepeated _ _ -> [|$(pure getA) <> $(pure getB)|]+             FKMap _ -> [|$(pure getA) <> $(pure getB)|]+             FKOneof _ -> [|case $(pure getB) of Nothing -> $(pure getA); b' -> b'|]+             FKMaybe -> [|case $(pure getB) of Nothing -> $(pure getA); b' -> b'|]+             _ -> case pfType pf of+               PFSubmessage -> [|case $(pure getB) of Nothing -> $(pure getA); b' -> b'|]+               PFEnum -> [|if $(pure getB) == toEnum 0 then $(pure getA) else $(pure getB)|]+               PFScalar SBool -> [|if not $(pure getB) then $(pure getA) else $(pure getB)|]+               PFScalar SString -> [|if $(pure getB) == mempty then $(pure getA) else $(pure getB)|]+               PFScalar SBytes -> [|if $(pure getB) == mempty then $(pure getA) else $(pure getB)|]+               PFScalar _ -> [|if $(pure getB) == 0 then $(pure getA) else $(pure getB)|]   fieldExps <-     mapM       ( \pf -> do@@ -593,9 +623,9 @@             , AppE                 ( AppE                     (VarE '(<>))-                    (AppE (VarE ufSel) (VarE aName))+                    (readSel meta ufSel aName)                 )-                (AppE (VarE ufSel) (VarE bName))+                (readSel meta ufSel bName)             )           ]         Nothing -> []@@ -686,19 +716,20 @@   -> Q [Dec] synthesiseProtoInstancesWith meta ty conName _protoName fs = do   enc <- mkEncodeInstanceWith meta ty fs+  siz <- mkSizeInstanceWith meta ty fs   dec <- mkDecodeInstanceWith meta ty conName fs   semi <- mkSemigroupInstanceWith meta ty conName fs   mon <- mkMonoidInstanceWith meta ty conName fs-  pure [enc, dec, semi, mon]+  pure [enc, siz, dec, semi, mon]   -- --------------------------------------------------------------------------- -- Encoder / size internals -- --------------------------------------------------------------------------- -encodeOne :: Name -> ProtoField -> Q Exp-encodeOne msg pf = do-  let getter = AppE (VarE (pfSelector pf)) (VarE msg)+encodeOne :: MessageMeta -> Name -> ProtoField -> Q Exp+encodeOne meta msg pf = do+  let getter = readSel meta (pfSelector pf) msg       tagInt = pfTagByte pf   case pfKind pf of     FKBare -> do@@ -743,14 +774,11 @@       acc <- newName "acc"       keyEnc <- encodeMapKeyE mks kV       valEnc <- encodeMapValueE pf vV-      -- 'mapField' takes the already-sized key and value-      -- builders and produces a sized map entry (one length-prefixed-      -- submessage per entry). Same shape as the pure-text codegen.       let entry =             AppE               ( AppE                   ( AppE-                      (VarE 'PE.mapField)+                      (VarE 'PE.encodeMapField)                       (LitE (IntegerL (fromIntegral (pfTag pf))))                   )                   keyEnc@@ -778,9 +806,9 @@       caseE (pure getter) allArms  -sizeOne :: Name -> ProtoField -> Q Exp-sizeOne msg pf = do-  let getter = AppE (VarE (pfSelector pf)) (VarE msg)+sizeOne :: MessageMeta -> Name -> ProtoField -> Q Exp+sizeOne meta msg pf = do+  let getter = readSel meta (pfSelector pf) msg   case pfKind pf of     FKBare -> do       v <- newName "v"@@ -923,10 +951,7 @@           { pfStringAdapter = ovStringAdapter ov           , pfBytesAdapter = ovBytesAdapter ov           }-  in [|-      PWE.tagSize $(litE (integerL (fromIntegral (ovTag ov))))-        + $(sizeSingleE pseudo v)-      |]+  in sizeSingleE pseudo v   pfTagByte :: ProtoField -> Int@@ -961,9 +986,9 @@   in encodeSingleE pseudo tagInt kVar  -{- | Bytes contributed by one map-key on the wire (1 entry-tag byte-+ the key payload). Used by the exact entry-size emitter for-'FKMap'.+{- | Bytes contributed by one map-key on the wire (tag + payload).+Used by the exact entry-size emitter for 'FKMap'.+'sizeSingleE' already accounts for the tag byte. -} mapKeyEntrySizeE :: MapKeyScalar -> Name -> Q Exp mapKeyEntrySizeE mks kVar =@@ -974,16 +999,16 @@           FKBare           (PFScalar (scalarOfMapKey mks))           (ConT ''Int)-  in [|1 + $(sizeSingleE pseudo kVar)|]+  in sizeSingleE pseudo kVar  -{- | Bytes contributed by one map-value on the wire (1 entry-tag-byte + the value payload).+{- | Bytes contributed by one map-value on the wire (tag + payload).+'sizeSingleE' already accounts for the tag byte. -} mapValueEntrySizeE :: ProtoField -> Name -> Q Exp mapValueEntrySizeE pf vVar =   let valueField = pf {pfTag = 2} -- inside the entry-  in [|1 + $(sizeSingleE valueField vVar)|]+  in sizeSingleE valueField vVar   {- | Build the encoder for one map value at field number 2 inside@@ -1065,120 +1090,80 @@   let tagWord = litE (integerL (fromIntegral tagInt))       var = varE v   in case pfType pf of-      PFScalar SInt32 -> [|PA.archVarint $tagWord (fromIntegral ($var :: Int32))|]-      PFScalar SInt64 -> [|PA.archVarint $tagWord (fromIntegral ($var :: Int64))|]-      PFScalar SUInt32 -> [|PA.archVarint $tagWord (fromIntegral ($var :: Word32))|]-      PFScalar SUInt64 -> [|PA.archVarint $tagWord ($var :: Word64)|]-      PFScalar SSInt32 -> [|PA.archSVarint32 $tagWord ($var :: Int32)|]-      PFScalar SSInt64 -> [|PA.archSVarint64 $tagWord ($var :: Int64)|]-      PFScalar SFixed32 -> [|PA.archFixed32 $tagWord ($var :: Word32)|]-      PFScalar SFixed64 -> [|PA.archFixed64 $tagWord ($var :: Word64)|]-      PFScalar SSFixed32 -> [|PA.archFixed32 $tagWord (fromIntegral ($var :: Int32))|]-      PFScalar SSFixed64 -> [|PA.archFixed64 $tagWord (fromIntegral ($var :: Int64))|]-      PFScalar SBool -> [|PA.archBool $tagWord ($var :: Bool)|]-      PFScalar SFloat -> [|PA.archFloat $tagWord ($var :: Float)|]-      PFScalar SDouble -> [|PA.archDouble $tagWord ($var :: Double)|]-      PFScalar SString -> stringEncodeE (pfStringAdapter pf) tagInt v-      PFScalar SBytes -> bytesEncodeE (pfBytesAdapter pf) tagInt v-      PFSubmessage ->-        -- New shape: 'archSubmessage' takes the child's-        -- 'SizedBuilder' directly. The size flows up from the-        -- child's own 'buildSized' traversal, so there's no-        -- separate @messageSize@ pre-pass.-        [|PA.archSubmessage $tagWord (PE.buildSized $var)|]-      PFEnum ->-        -- 1-byte-tag enum field: bake the tag into 'archVarint'-        -- (which returns 'SizedBuilder', carrying the enum's-        -- varint byte count for the parent's size accumulator).-        [|PA.archVarint $tagWord (fromIntegral (fromEnum $var))|]+       PFScalar SInt32 -> [|PA.archVarint $tagWord (fromIntegral ($var :: Int32))|]+       PFScalar SInt64 -> [|PA.archVarint $tagWord (fromIntegral ($var :: Int64))|]+       PFScalar SUInt32 -> [|PA.archVarint $tagWord (fromIntegral ($var :: Word32))|]+       PFScalar SUInt64 -> [|PA.archVarint $tagWord ($var :: Word64)|]+       PFScalar SSInt32 -> [|PA.archSVarint32 $tagWord ($var :: Int32)|]+       PFScalar SSInt64 -> [|PA.archSVarint64 $tagWord ($var :: Int64)|]+       PFScalar SFixed32 -> [|PA.archFixed32 $tagWord ($var :: Word32)|]+       PFScalar SFixed64 -> [|PA.archFixed64 $tagWord ($var :: Word64)|]+       PFScalar SSFixed32 -> [|PA.archFixed32 $tagWord (fromIntegral ($var :: Int32))|]+       PFScalar SSFixed64 -> [|PA.archFixed64 $tagWord (fromIntegral ($var :: Int64))|]+       PFScalar SBool -> [|PA.archBool $tagWord ($var :: Bool)|]+       PFScalar SFloat -> [|PA.archFloat $tagWord ($var :: Float)|]+       PFScalar SDouble -> [|PA.archDouble $tagWord ($var :: Double)|]+       PFScalar SString -> stringEncodeE (pfStringAdapter pf) tagInt v+       PFScalar SBytes -> bytesEncodeE (pfBytesAdapter pf) tagInt v+       PFSubmessage ->+         [|+           let !sz = PE.messageSize $var+           in PA.archSubmessage $tagWord sz (PE.buildMessage $var)+           |]+       PFEnum ->+         -- 'encodeFieldEnum' takes the proto field number (it computes+         -- its own varint tag); we recover @fieldNumber = tagByte / 8@.+         [|+           PE.encodeFieldEnum+             $(litE (integerL (fromIntegral (tagInt `quot` 8))))+             $var+           |]   {- | Slow path: field number > 15, so the wire tag is two or more-bytes. We dispatch through @Proto.Encode.sizedField*@, which-takes a field number (Int) and varint-encodes the tag while-producing a 'SizedBuilder' that carries the fragment's byte-count up to the enclosing message.+bytes. We dispatch through @Proto.Encode.encodeField*@, which+takes a field number (Int) and varint-encodes the tag. -} encodeSingleSlowE :: ProtoField -> Name -> Q Exp encodeSingleSlowE pf v =   let var = varE v       fieldN = litE (integerL (fromIntegral (pfTag pf)))   in case pfType pf of-      PFScalar SInt32 -> [|PE.fieldVarint $fieldN (fromIntegral ($var :: Int32))|]-      PFScalar SInt64 -> [|PE.fieldVarint $fieldN (fromIntegral ($var :: Int64))|]-      PFScalar SUInt32 -> [|PE.fieldVarint $fieldN (fromIntegral ($var :: Word32))|]-      PFScalar SUInt64 -> [|PE.fieldVarint $fieldN ($var :: Word64)|]-      PFScalar SSInt32 -> [|PE.fieldSVarint32 $fieldN ($var :: Int32)|]-      PFScalar SSInt64 -> [|PE.fieldSVarint64 $fieldN ($var :: Int64)|]-      PFScalar SFixed32 -> [|PE.fieldFixed32 $fieldN ($var :: Word32)|]-      PFScalar SFixed64 -> [|PE.fieldFixed64 $fieldN ($var :: Word64)|]-      PFScalar SSFixed32 -> [|PE.fieldFixed32 $fieldN (fromIntegral ($var :: Int32))|]-      PFScalar SSFixed64 -> [|PE.fieldFixed64 $fieldN (fromIntegral ($var :: Int64))|]-      PFScalar SBool -> [|PE.fieldBool $fieldN ($var :: Bool)|]-      PFScalar SFloat -> [|PE.fieldFloat $fieldN ($var :: Float)|]-      PFScalar SDouble -> [|PE.fieldDouble $fieldN ($var :: Double)|]-      -- Slow-path (multi-byte tag) string / bytes: same trick as-      -- 'stringEncodeE' / 'bytesEncodeE' — compose the adapter's-      -- pre-existing @size@ and @encode@ pieces into a 'SizedBuilder'-      -- with the tag-width correction.-      PFScalar SString ->-        [|-          PSB.sized-            ($(stringSize (pfStringAdapter pf)) $var + PWE.tagSize $fieldN - 1)-            ($(stringEncode (pfStringAdapter pf)) $fieldN $var)-          |]-      PFScalar SBytes ->-        [|-          PSB.sized-            ($(bytesSize (pfBytesAdapter pf)) $var + PWE.tagSize $fieldN - 1)-            ($(bytesEncode (pfBytesAdapter pf)) $fieldN $var)-          |]-      PFSubmessage -> [|PE.fieldMessage $fieldN (PE.buildSized $var)|]-      PFEnum ->-        [|-          PE.fieldVarint-            $fieldN-            (fromIntegral (fromEnum $var))-          |]+       PFScalar SInt32 -> [|PE.encodeFieldVarint $fieldN (fromIntegral ($var :: Int32))|]+       PFScalar SInt64 -> [|PE.encodeFieldVarint $fieldN (fromIntegral ($var :: Int64))|]+       PFScalar SUInt32 -> [|PE.encodeFieldVarint $fieldN (fromIntegral ($var :: Word32))|]+       PFScalar SUInt64 -> [|PE.encodeFieldVarint $fieldN ($var :: Word64)|]+       PFScalar SSInt32 -> [|PE.encodeFieldSVarint32 $fieldN ($var :: Int32)|]+       PFScalar SSInt64 -> [|PE.encodeFieldSVarint64 $fieldN ($var :: Int64)|]+       PFScalar SFixed32 -> [|PE.encodeFieldFixed32 $fieldN ($var :: Word32)|]+       PFScalar SFixed64 -> [|PE.encodeFieldFixed64 $fieldN ($var :: Word64)|]+       PFScalar SSFixed32 -> [|PE.encodeFieldFixed32 $fieldN (fromIntegral ($var :: Int32))|]+       PFScalar SSFixed64 -> [|PE.encodeFieldFixed64 $fieldN (fromIntegral ($var :: Int64))|]+       PFScalar SBool -> [|PE.encodeFieldBool $fieldN ($var :: Bool)|]+       PFScalar SFloat -> [|PE.encodeFieldFloat $fieldN ($var :: Float)|]+       PFScalar SDouble -> [|PE.encodeFieldDouble $fieldN ($var :: Double)|]+       PFScalar SString -> [|$(stringEncode (pfStringAdapter pf)) $fieldN $var|]+       PFScalar SBytes -> [|$(bytesEncode (pfBytesAdapter pf)) $fieldN $var|]+       PFSubmessage -> [|PE.encodeFieldMessageSized $fieldN $var|]+       PFEnum -> [|PE.encodeFieldEnum $fieldN $var|]  -{- | Adapter-based string encoder. Returns a 'SizedBuilder' built-from two adapter pieces:--* the adapter's @'stringEncode'@ Q-spliced function — @Int -> a ->-  Builder@ — emits the tag varint + length varint + UTF-8 bytes;-* the adapter's @'stringSize'@ Q-spliced function — @a -> Int@ —-  returns the wire byte count assuming a /one-byte/ tag.--To produce a correct 'SizedBuilder' for /any/ field number we-correct the size for the actual tag width: @stringSize val + tagSize-fieldN - 1@. No materialisation, no extra allocation — just two-existing adapter functions composed.+{- | Adapter-based string encoder. Splices the adapter's encode+function with the field number. -} stringEncodeE :: StringAdapter -> Int -> Name -> Q Exp stringEncodeE adapter tagInt v =   let fieldN = litE (integerL (fromIntegral (tagInt `quot` 8)))       var = varE v-  in-    [|-      PSB.sized-        ($(stringSize adapter) $var + PWE.tagSize $fieldN - 1)-        ($(stringEncode adapter) $fieldN $var)-      |]+  in [|$(stringEncode adapter) $fieldN $var|]  --- | Adapter-based bytes encoder. Same shape as 'stringEncodeE',--- using 'bytesSize' \/ 'bytesEncode' instead.+-- | Adapter-based bytes encoder. bytesEncodeE :: BytesAdapter -> Int -> Name -> Q Exp bytesEncodeE adapter tagInt v =   let fieldN = litE (integerL (fromIntegral (tagInt `quot` 8)))       var = varE v-  in-    [|-      PSB.sized-        ($(bytesSize adapter) $var + PWE.tagSize $fieldN - 1)-        ($(bytesEncode adapter) $fieldN $var)-      |]+  in [|$(bytesEncode adapter) $fieldN $var|]   {- | Encode a packed repeated scalar field. Walks the (possibly@@ -1195,7 +1180,6 @@ encodePackedScalarE pf sc getter = do   foldFnE <- repeatedFoldlE rep   let tagN = fromIntegral (pfTag pf) :: Integer-      fieldN = litE (integerL (fromIntegral (pfTag pf `quot` 8)))   v <- newName "v"   acc <- newName "acc"   perSizeE <- packedElemSizeE sc v@@ -1227,15 +1211,9 @@       then mempty       else         let !payloadSize = ($(pure sizeE)) :: Int-        in PSB.sized-            ( PWE.tagSize $fieldN-                + PWE.varintSize (fromIntegral payloadSize)-                + payloadSize-            )-            ( PWE.putTag $(litE (IntegerL tagN)) PWire.WireLengthDelimited-                <> PWE.putVarint (fromIntegral payloadSize)-                <> $(pure bytesE)-            )+        in PWE.putTag $(litE (IntegerL tagN)) PWire.WireLengthDelimited+             <> PWE.putVarint (fromIntegral payloadSize)+             <> $(pure bytesE)     |]   where     rep = case pfKind pf of@@ -1270,8 +1248,8 @@       else         let !payloadSize = ($(pure foldedE)) :: Int         in PWE.tagSize $(litE (IntegerL tagN))-            + PWE.varintSize (fromIntegral payloadSize)-            + payloadSize+             + PWE.varintSize (fromIntegral payloadSize)+             + payloadSize     |]   where     rep = case pfKind pf of@@ -1286,21 +1264,21 @@ packedElemSizeE sc v =   let var = varE v   in case sc of-      SInt32 -> [|PWE.varintSize (fromIntegral ($var :: Int32))|]-      SInt64 -> [|PWE.varintSize (fromIntegral ($var :: Int64))|]-      SUInt32 -> [|PWE.varintSize (fromIntegral ($var :: Word32))|]-      SUInt64 -> [|PWE.varintSize ($var :: Word64)|]-      SSInt32 -> [|PWE.varintSize (fromIntegral (PWE.zigZag32 ($var :: Int32)))|]-      SSInt64 -> [|PWE.varintSize (PWE.zigZag64 ($var :: Int64))|]-      SFixed32 -> [|4 :: Int|]-      SFixed64 -> [|8 :: Int|]-      SSFixed32 -> [|4 :: Int|]-      SSFixed64 -> [|8 :: Int|]-      SBool -> [|1 :: Int|]-      SFloat -> [|4 :: Int|]-      SDouble -> [|8 :: Int|]-      SString -> error "Proto.Internal.Derive: SString is not packable"-      SBytes -> error "Proto.Internal.Derive: SBytes is not packable"+       SInt32 -> [|PWE.varintSize (fromIntegral ($var :: Int32))|]+       SInt64 -> [|PWE.varintSize (fromIntegral ($var :: Int64))|]+       SUInt32 -> [|PWE.varintSize (fromIntegral ($var :: Word32))|]+       SUInt64 -> [|PWE.varintSize ($var :: Word64)|]+       SSInt32 -> [|PWE.varintSize (fromIntegral (PWE.zigZag32 ($var :: Int32)))|]+       SSInt64 -> [|PWE.varintSize (PWE.zigZag64 ($var :: Int64))|]+       SFixed32 -> [|4 :: Int|]+       SFixed64 -> [|8 :: Int|]+       SSFixed32 -> [|4 :: Int|]+       SSFixed64 -> [|8 :: Int|]+       SBool -> [|1 :: Int|]+       SFloat -> [|4 :: Int|]+       SDouble -> [|8 :: Int|]+       SString -> error "Proto.Internal.Derive: SString is not packable"+       SBytes -> error "Proto.Internal.Derive: SBytes is not packable"   {- | Per-element on-wire bytes for a packed scalar (just the@@ -1310,21 +1288,21 @@ packedElemBytesE sc v =   let var = varE v   in case sc of-      SInt32 -> [|PWE.putVarint (fromIntegral ($var :: Int32))|]-      SInt64 -> [|PWE.putVarint (fromIntegral ($var :: Int64))|]-      SUInt32 -> [|PWE.putVarint (fromIntegral ($var :: Word32))|]-      SUInt64 -> [|PWE.putVarint ($var :: Word64)|]-      SSInt32 -> [|PWE.putSVarint32 ($var :: Int32)|]-      SSInt64 -> [|PWE.putSVarint64 ($var :: Int64)|]-      SFixed32 -> [|PWE.putFixed32 ($var :: Word32)|]-      SFixed64 -> [|PWE.putFixed64 ($var :: Word64)|]-      SSFixed32 -> [|PWE.putFixed32 (fromIntegral ($var :: Int32))|]-      SSFixed64 -> [|PWE.putFixed64 (fromIntegral ($var :: Int64))|]-      SBool -> [|PWE.putVarint (if ($var :: Bool) then 1 else 0)|]-      SFloat -> [|PWE.putFloat ($var :: Float)|]-      SDouble -> [|PWE.putDouble ($var :: Double)|]-      SString -> error "Proto.Internal.Derive: SString is not packable"-      SBytes -> error "Proto.Internal.Derive: SBytes is not packable"+       SInt32 -> [|PWE.putVarint (fromIntegral ($var :: Int32))|]+       SInt64 -> [|PWE.putVarint (fromIntegral ($var :: Int64))|]+       SUInt32 -> [|PWE.putVarint (fromIntegral ($var :: Word32))|]+       SUInt64 -> [|PWE.putVarint ($var :: Word64)|]+       SSInt32 -> [|PWE.putSVarint32 ($var :: Int32)|]+       SSInt64 -> [|PWE.putSVarint64 ($var :: Int64)|]+       SFixed32 -> [|PWE.putFixed32 ($var :: Word32)|]+       SFixed64 -> [|PWE.putFixed64 ($var :: Word64)|]+       SSFixed32 -> [|PWE.putFixed32 (fromIntegral ($var :: Int32))|]+       SSFixed64 -> [|PWE.putFixed64 (fromIntegral ($var :: Int64))|]+       SBool -> [|PWE.putVarint (if ($var :: Bool) then 1 else 0)|]+       SFloat -> [|PWE.putFloat ($var :: Float)|]+       SDouble -> [|PWE.putDouble ($var :: Double)|]+       SString -> error "Proto.Internal.Derive: SString is not packable"+       SBytes -> error "Proto.Internal.Derive: SBytes is not packable"   -- | Emptiness predicate for a repeated container.@@ -1341,7 +1319,6 @@ encodePackedEnumE pf getter = do   foldFnE <- repeatedFoldlE rep   let tagN = fromIntegral (pfTag pf) :: Integer-      fieldN = litE (integerL (fromIntegral (pfTag pf `quot` 8)))   v <- newName "v"   acc <- newName "acc"   let perSizeE =@@ -1391,15 +1368,9 @@       then mempty       else         let !payloadSize = ($(pure sizeE)) :: Int-        in PSB.sized-            ( PWE.tagSize $fieldN-                + PWE.varintSize (fromIntegral payloadSize)-                + payloadSize-            )-            ( PWE.putTag $(litE (IntegerL tagN)) PWire.WireLengthDelimited-                <> PWE.putVarint (fromIntegral payloadSize)-                <> $(pure bytesE)-            )+        in PWE.putTag $(litE (IntegerL tagN)) PWire.WireLengthDelimited+             <> PWE.putVarint (fromIntegral payloadSize)+             <> $(pure bytesE)     |]   where     rep = case pfKind pf of@@ -1441,8 +1412,8 @@       else         let !payloadSize = ($(pure foldedE)) :: Int         in PWE.tagSize $(litE (IntegerL tagN))-            + PWE.varintSize (fromIntegral payloadSize)-            + payloadSize+             + PWE.varintSize (fromIntegral payloadSize)+             + payloadSize     |]   where     rep = case pfKind pf of@@ -1685,8 +1656,9 @@   -- ^ Loop function name.   -> [(ProtoField, Name)]   -> Maybe Name-  -- ^ Unknown-fields accumulator name (when-  --   'mmUnknownFieldsSel' is set).+  {- ^ Unknown-fields accumulator name (when+  'mmUnknownFieldsSel' is set).+  -}   -> Q Exp decodeLoopBody meta conName loopName pairs ufAccM = do   fnVar <- newName "fn"
− src/Proto/Internal/Dynamic.hs 
@@ -1,634 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE UnboxedTuples #-}--{- | Dynamic messages for runtime protobuf manipulation.--A 'DynamicMessage' can represent any protobuf message without-compile-time generated code, using field descriptors to interpret-the wire format at runtime.--Use cases:--* Proxies and middleware that forward messages without knowing types-* Schema registries and tooling-* Testing and debugging-* Dynamic configuration systems--This module also provides a schema-driven fast decode path via-'compileParseTable' and 'decodeDynamicWithSchema', inspired by-hyperpb's table-driven parser. The schema-driven path-compiles a 'ProtoMessage' schema into a flat array of 'FieldParser'-entries that a small interpreter loop evaluates against incoming-wire data, sharing the same 'DynamicValue'/'DynamicMessage' types-as the schemaless decoder.--}-module Proto.Internal.Dynamic (-  -- * Dynamic value type-  DynamicValue (..),--  -- * Dynamic message-  DynamicMessage (..),-  emptyDynamic,-  dynamicField,-  setDynamicField,-  removeDynamicField,--  -- * Encoding / decoding-  encodeDynamic,-  decodeDynamic,--  -- * Streaming decode (length-delimited frames)-  decodeDynamicStream,-  decodeDynamicStreamLazy,--  -- * Schema-driven decoding (fast path)-  ParseTable (..),-  FieldParser (..),-  FieldThunk,-  compileParseTable,-  decodeDynamicWithSchema,-  decodeDynamicStreamWithSchema,--  -- * Conversion-  dynamicToJson,-) where--import Data.Aeson qualified as Aeson-import Data.Aeson.Key qualified as AesonKey-import Data.Aeson.KeyMap qualified as AesonKM-import Data.ByteString (ByteString)-import Data.ByteString qualified as BS-import Data.ByteString.Base64 qualified as Base64-import Data.ByteString.Lazy qualified as BL-import Data.ByteString.Unsafe qualified as BSU-import Data.Int (Int64)-import Data.IntMap.Strict (IntMap)-import Data.IntMap.Strict qualified as IntMap-import Data.Map.Strict (Map)-import Data.Proxy (Proxy (..))-import Data.Scientific (fromFloatDigits)-import Data.Text (Text)-import Data.Text.Encoding qualified as TE-import Data.Text.Lazy qualified as TL-import Data.Text.Lazy.Builder qualified as TLB-import Data.Text.Lazy.Builder.Int qualified as TLBI-import Data.Vector qualified as V-import Data.Word (Word32, Word64, Word8)-import GHC.Float (castWord32ToFloat, castWord64ToDouble)-import Proto.Internal.Wire (Tag (..), WireType (..), fieldTag)-import Proto.Internal.Wire.Decode (-  DecodeError (..),-  DecodeResult (..),-  Decoder,-  UMaybe (UJust, UNothing),-  getFixed32,-  getFixed64,-  getLengthDelimited,-  getTagOrU,-  getVarint,-  runDecoder,-  runDecoder',-  skipField,-  validateUtf8,- )-import Proto.Internal.Wire.Encode (-  putByteString,-  putDouble,-  putFixed32,-  putFixed64,-  putFloat,-  putLengthDelimited,-  putTag,-  putText,-  putVarint,- )-import Proto.Schema (-  FieldDescriptor (..),-  FieldLabel' (..),-  FieldTypeDescriptor (..),-  ProtoMessage (..),-  ScalarFieldType (..),-  SomeFieldDescriptor (..),- )-import Wireform.Builder qualified as B-import Wireform.FFI (decodeVarintSWAR, relocatePageBoundary)----- | A dynamically-typed protobuf value.-data DynamicValue-  = DynVarint !Word64-  | DynSVarint !Int64-  | DynFixed32 !Word32-  | DynFixed64 !Word64-  | DynFloat !Float-  | DynDouble !Double-  | DynBool !Bool-  | DynString !Text-  | DynBytes !ByteString-  | DynMessage !DynamicMessage-  | DynEnum !Int-  | DynRepeated ![DynamicValue]-  | DynMap !(Map DynamicValue DynamicValue)-  deriving stock (Show, Eq, Ord)----- | A dynamically-typed protobuf message, storing fields by number.-data DynamicMessage = DynamicMessage-  { dynFields :: !(IntMap DynamicValue)-  , dynUnknownFields :: ![(Int, WireType, ByteString)]-  }-  deriving stock (Show, Eq, Ord)----- | An empty dynamic message with no fields and no unknown fields.-emptyDynamic :: DynamicMessage-emptyDynamic = DynamicMessage IntMap.empty []----- | Look up a field by its proto field number in a dynamic message.-dynamicField :: Int -> DynamicMessage -> Maybe DynamicValue-dynamicField n (DynamicMessage fs _) = IntMap.lookup n fs----- | Insert or replace a field value at the given field number.-setDynamicField :: Int -> DynamicValue -> DynamicMessage -> DynamicMessage-setDynamicField n v (DynamicMessage fs unk) =-  DynamicMessage (IntMap.insert n v fs) unk----- | Remove a field by its proto field number, if present.-removeDynamicField :: Int -> DynamicMessage -> DynamicMessage-removeDynamicField n (DynamicMessage fs unk) =-  DynamicMessage (IntMap.delete n fs) unk---{- | Encode a dynamic message to bytes.-Uses varint wire type for integer values, length-delimited for strings/bytes/messages.--}-encodeDynamic :: DynamicMessage -> ByteString-encodeDynamic (DynamicMessage fs _) =-  BL.toStrict $ B.toLazyByteString $ IntMap.foldlWithKey' encodeField mempty fs-  where-    encodeField acc fn val = acc <> encodeDynValue fn val---encodeDynValue :: Int -> DynamicValue -> B.Builder-encodeDynValue fn = \case-  DynVarint v -> putTag fn WireVarint <> putVarint v-  DynSVarint v -> putTag fn WireVarint <> putVarint (fromIntegral v)-  DynFixed32 v -> putTag fn Wire32Bit <> putFixed32 v-  DynFixed64 v -> putTag fn Wire64Bit <> putFixed64 v-  DynFloat v -> putTag fn Wire32Bit <> putFloat v-  DynDouble v -> putTag fn Wire64Bit <> putDouble v-  DynBool v -> putTag fn WireVarint <> putVarint (if v then 1 else 0)-  DynString v -> putTag fn WireLengthDelimited <> putText v-  DynBytes v -> putTag fn WireLengthDelimited <> putByteString v-  DynEnum v -> putTag fn WireVarint <> putVarint (fromIntegral v)-  DynMessage m ->-    let payload = encodeDynamic m-    in putTag fn WireLengthDelimited <> putLengthDelimited payload-  DynRepeated vs -> foldMap (encodeDynValue fn) vs-  DynMap _kvs -> mempty----- | Decode a dynamic message from bytes using wire type inference.-decodeDynamic :: ByteString -> Either DecodeError DynamicMessage-decodeDynamic = runDecoder decodeDynLoop---decodeDynLoop :: Decoder DynamicMessage-decodeDynLoop = go IntMap.empty-  where-    go !acc = do-      mt <- getTagOrU-      case mt of-        UNothing -> pure (DynamicMessage acc [])-        UJust (Tag fn wt) -> do-          val <- decodeWireValue wt-          let acc' = case IntMap.lookup fn acc of-                Nothing -> IntMap.insert fn val acc-                Just (DynRepeated vs) -> IntMap.insert fn (DynRepeated (vs <> [val])) acc-                Just existing -> IntMap.insert fn (DynRepeated [existing, val]) acc-          go acc'---decodeWireValue :: WireType -> Decoder DynamicValue-decodeWireValue = \case-  WireVarint -> DynVarint <$> getVarint-  Wire64Bit -> DynFixed64 <$> getFixed64-  Wire32Bit -> DynFixed32 <$> getFixed32-  WireLengthDelimited -> DynBytes <$> getLengthDelimited-  wt -> skipField wt >> pure (DynBytes BS.empty)---{- | Decode a sequence of length-delimited dynamic messages from a strict-'ByteString'. Each message must be preceded by a varint byte count.--}-decodeDynamicStream :: ByteString -> [Either DecodeError DynamicMessage]-decodeDynamicStream bs = go 0-  where-    !len = BS.length bs-    go !off-      | off >= len = []-      | otherwise = case runDecoder' getVarint bs off of-          DecodeFail _ -> [Left UnexpectedEnd]-          DecodeOK lenW off1 ->-            let !msgLen = fromIntegral lenW-                !off2 = off1 + msgLen-            in if off2 > len-                then [Left UnexpectedEnd]-                else-                  let !msgBs = BSU.unsafeTake msgLen (BSU.unsafeDrop off1 bs)-                  in decodeDynamic msgBs : go off2---{- | Decode a sequence of length-delimited dynamic messages from a lazy-'BL.ByteString'. Useful when reading from a network or file stream.--}-decodeDynamicStreamLazy :: BL.ByteString -> [Either DecodeError DynamicMessage]-decodeDynamicStreamLazy = decodeDynamicStream . BL.toStrict----- | Convert a dynamic message to JSON (field numbers as keys).-dynamicToJson :: DynamicMessage -> Aeson.Value-dynamicToJson (DynamicMessage fs _) =-  Aeson.Object-    ( AesonKM.fromList-        (fmap (\(k, v) -> (AesonKey.fromText (intToText k), dynValueToJson v)) (IntMap.toList fs))-    )---dynValueToJson :: DynamicValue -> Aeson.Value-dynValueToJson = \case-  DynVarint v -> Aeson.Number (fromIntegral v)-  DynSVarint v -> Aeson.Number (fromIntegral v)-  DynFixed32 v -> Aeson.Number (fromIntegral v)-  DynFixed64 v -> Aeson.String (word64ToText v)-  DynFloat v -> Aeson.Number (fromFloatDigits v)-  DynDouble v -> Aeson.Number (fromFloatDigits v)-  DynBool v -> Aeson.Bool v-  DynString v -> Aeson.String v-  DynBytes bs -> Aeson.String (TE.decodeUtf8 (Base64.encode bs))-  DynEnum v -> Aeson.Number (fromIntegral v)-  DynMessage m -> dynamicToJson m-  DynRepeated vs -> Aeson.toJSON (fmap dynValueToJson vs)-  DynMap _ -> Aeson.object []----- ============================================================--- Schema-driven fast decode path (Table-Driven Parser)--- ============================================================--{- | A thunk for parsing a single field. Takes a 'ByteString' and offset,-returns either a decode error or the parsed value and new offset.--}-type FieldThunk = ByteString -> Int -> Either DecodeError (DynamicValue, Int)----- | A single field's parse configuration in the table.-data FieldParser = FieldParser-  { fpTag :: {-# UNPACK #-} !Word64-  -- ^ The wire tag (field number << 3 | wire type) this entry matches.-  , fpFieldNum :: {-# UNPACK #-} !Int-  -- ^ Proto field number.-  , fpNextOk :: {-# UNPACK #-} !Int-  -- ^ Index of next FieldParser to try on successful match (field scheduling).-  , fpNextErr :: {-# UNPACK #-} !Int-  -- ^ Index of next FieldParser to try on mismatch.-  , fpParse :: !FieldThunk-  -- ^ The thunk that actually decodes this field's value.-  , fpLabel :: !FieldLabel'-  -- ^ Whether this field is repeated (affects accumulation).-  , fpSubmsg :: !(Maybe ParseTable)-  -- ^ Nested parse table for submessage fields.-  }----- | Compiled parse table for a message type.-data ParseTable = ParseTable-  { ptFields :: !(V.Vector FieldParser)-  -- ^ Field parsers in scheduled order.-  , ptTagLUT :: !ByteString-  -- ^ 128-byte LUT: tag byte -> index in ptFields (0xFF = miss).-  -- For tags < 128 (field numbers 1-15), this is a direct O(1) lookup.-  , ptTagMap :: !(IntMap Int)-  -- ^ Fallback map: wire tag -> index in ptFields, for tags >= 128.-  , ptMaxMiss :: {-# UNPACK #-} !Int-  -- ^ Max consecutive misses before hitting the hash table.-  }----- | Compile a 'ProtoMessage' schema into a 'ParseTable'.-compileParseTable :: forall a. ProtoMessage a => Proxy a -> ParseTable-compileParseTable proxy =-  let fieldList = IntMap.toAscList (protoFieldDescriptors proxy)-      nFields = length fieldList--      fpList :: [(Int, FieldParser)]-      fpList =-        [ (i, mkFieldParser i nFields fd)-        | (i, (_, SomeField fd)) <- zip [0 ..] fieldList-        ]--      parsers = V.fromList (fmap snd fpList)--      tagLUTBytes = BS.pack (fmap tagLUTEntry [0 .. 127])--      tagIdxMap :: IntMap Int-      tagIdxMap =-        IntMap.fromList-          [ (fromIntegral (fpTag (snd fp)), fst fp)-          | fp <- fpList-          ]--      tagLUTEntry :: Word8 -> Word8-      tagLUTEntry tag =-        case IntMap.lookup (fromIntegral tag) tagIdxMap of-          Just idx | idx < 256 -> fromIntegral idx-          _ -> 0xFF--      tagMap =-        IntMap.fromList-          [ (fromIntegral (fpTag fp), i)-          | (i, fp) <- zip [0 ..] (V.toList parsers)-          ]-  in ParseTable-      { ptFields = parsers-      , ptTagLUT = tagLUTBytes-      , ptTagMap = tagMap-      , ptMaxMiss = min 4 nFields-      }----- | Build a FieldParser from a schema FieldDescriptor.-mkFieldParser :: Int -> Int -> FieldDescriptor msg a -> FieldParser-mkFieldParser idx nFields fd =-  let fn = fdNumber fd-      wt = fieldWireType (fdTypeDesc fd)-      tag = fieldTag fn wt-      nextOk = (idx + 1) `mod` nFields-      nextErr = (idx + 1) `mod` nFields-  in FieldParser-      { fpTag = tag-      , fpFieldNum = fn-      , fpNextOk = nextOk-      , fpNextErr = nextErr-      , fpParse = mkThunk (fdTypeDesc fd)-      , fpLabel = fdLabel fd-      , fpSubmsg = Nothing-      }---fieldWireType :: FieldTypeDescriptor -> WireType-fieldWireType = \case-  ScalarType DoubleField -> Wire64Bit-  ScalarType FloatField -> Wire32Bit-  ScalarType Int32Field -> WireVarint-  ScalarType Int64Field -> WireVarint-  ScalarType UInt32Field -> WireVarint-  ScalarType UInt64Field -> WireVarint-  ScalarType SInt32Field -> WireVarint-  ScalarType SInt64Field -> WireVarint-  ScalarType Fixed32Field -> Wire32Bit-  ScalarType Fixed64Field -> Wire64Bit-  ScalarType SFixed32Field -> Wire32Bit-  ScalarType SFixed64Field -> Wire64Bit-  ScalarType BoolField -> WireVarint-  ScalarType StringField -> WireLengthDelimited-  ScalarType BytesField -> WireLengthDelimited-  MessageType _ -> WireLengthDelimited-  EnumType _ -> WireVarint-  MapType _ _ -> WireLengthDelimited----- | Make a decode thunk for a field type.-mkThunk :: FieldTypeDescriptor -> FieldThunk-mkThunk = \case-  ScalarType DoubleField -> thunkFixed64 (DynDouble . castWord64ToDouble)-  ScalarType FloatField -> thunkFixed32 (DynFloat . castWord32ToFloat)-  ScalarType Int32Field -> thunkVarint DynVarint-  ScalarType Int64Field -> thunkVarint DynVarint-  ScalarType UInt32Field -> thunkVarint DynVarint-  ScalarType UInt64Field -> thunkVarint DynVarint-  ScalarType SInt32Field -> thunkVarint DynVarint-  ScalarType SInt64Field -> thunkVarint DynVarint-  ScalarType Fixed32Field -> thunkFixed32 DynFixed32-  ScalarType Fixed64Field -> thunkFixed64 DynFixed64-  ScalarType SFixed32Field -> thunkFixed32 DynFixed32-  ScalarType SFixed64Field -> thunkFixed64 DynFixed64-  ScalarType BoolField -> thunkVarint (\v -> DynBool (v /= 0))-  ScalarType StringField -> thunkLenDelim (fmap DynString . decodeTextValue)-  ScalarType BytesField -> thunkLenDelim (Right . DynBytes)-  MessageType _ -> thunkLenDelim (fmap DynMessage . decodeSubmsg)-  EnumType _ -> thunkVarint (DynEnum . fromIntegral)-  MapType _ _ -> thunkLenDelim (Right . DynBytes)---decodeTextValue :: ByteString -> Either DecodeError Text-decodeTextValue bs-  | validateUtf8 bs = Right (TE.decodeUtf8Lenient bs)-  | otherwise = Left InvalidUtf8----- Thunk builders: decode a wire value at a given offset in a ByteString.--thunkVarint :: (Word64 -> DynamicValue) -> FieldThunk-thunkVarint f bs off =-  case runDecoder' getVarint bs off of-    DecodeOK v off' -> Right (f v, off')-    DecodeFail e -> Left e---thunkFixed32 :: (Word32 -> DynamicValue) -> FieldThunk-thunkFixed32 f bs off =-  case runDecoder' getFixed32 bs off of-    DecodeOK v off' -> Right (f v, off')-    DecodeFail e -> Left e---thunkFixed64 :: (Word64 -> DynamicValue) -> FieldThunk-thunkFixed64 f bs off =-  case runDecoder' getFixed64 bs off of-    DecodeOK v off' -> Right (f v, off')-    DecodeFail e -> Left e---thunkLenDelim :: (ByteString -> Either DecodeError DynamicValue) -> FieldThunk-thunkLenDelim f bs off =-  case runDecoder' getLengthDelimited bs off of-    DecodeOK bytes off' -> case f bytes of-      Right v -> Right (v, off')-      Left e -> Left e-    DecodeFail e -> Left e----- | Decode a submessage using schemaless wire-type inference.-decodeSubmsg :: ByteString -> Either DecodeError DynamicMessage-decodeSubmsg = decodeDynamic---{- | Schemaless best-effort raw decode. Silently skips malformed fields-since there is no schema to validate against.--}-decodeRaw :: ByteString -> DynamicMessage-decodeRaw bs = DynamicMessage (go IntMap.empty 0) []-  where-    !len = BS.length bs-    go !acc !off-      | off >= len = acc-      | otherwise = case runDecoder' getVarint bs off of-          DecodeFail _ -> acc-          DecodeOK tagW off1 ->-            let !fn = fromIntegral (tagW `div` 8) :: Int-                !wt = fromIntegral (tagW `mod` 8) :: Int-            in case wt of-                 0 -> case runDecoder' getVarint bs off1 of-                   DecodeOK v off2 -> go (IntMap.insert fn (DynVarint v) acc) off2-                   DecodeFail _ -> acc-                 1 -> case runDecoder' getFixed64 bs off1 of-                   DecodeOK v off2 -> go (IntMap.insert fn (DynFixed64 v) acc) off2-                   DecodeFail _ -> acc-                 2 -> case runDecoder' getLengthDelimited bs off1 of-                   DecodeOK v off2 -> go (IntMap.insert fn (DynBytes v) acc) off2-                   DecodeFail _ -> acc-                 5 -> case runDecoder' getFixed32 bs off1 of-                   DecodeOK v off2 -> go (IntMap.insert fn (DynFixed32 v) acc) off2-                   DecodeFail _ -> acc-                 _ -> acc---{- | Decode a message using a compiled 'ParseTable'.--This is the schema-driven fast decode path. The core table-driven interpreter loop:--1. Decode a tag varint (SWAR-accelerated for common cases).-2. If tag < 128, use the TagLUT for O(1) field lookup.-3. Otherwise, try the predicted next field ('fpNextOk').-4. On mismatch, walk 'fpNextErr' up to 'ptMaxMiss' times.-5. Fall back to the tag hash map.-6. Call the matched field's thunk ('fpParse') to decode the value.-7. Accumulate into a strict 'IntMap' (the native 'DynamicMessage' storage).-8. Repeat until end of input.--}-decodeDynamicWithSchema :: ParseTable -> ByteString -> Either DecodeError DynamicMessage-decodeDynamicWithSchema pt bs0-  | BS.null bs0 = Right (DynamicMessage IntMap.empty [])-  | V.null (ptFields pt) = Right (decodeRaw bs0)-  | otherwise =-      let !bs = relocatePageBoundary bs0-          !len = BS.length bs0--          decodeTag !off-            | off + 8 <= BS.length bs =-                case decodeVarintSWAR bs off of-                  Just (v, consumed) -> Just (v, off + consumed)-                  Nothing -> decodeTagSlow off-            | otherwise = decodeTagSlow off--          decodeTagSlow !off =-            case runDecoder' getVarint bs0 off of-              DecodeOK v o -> Just (v, o)-              DecodeFail _ -> Nothing--          go !fields !off !curIdx-            | off >= len = Right fields-            | otherwise =-                case decodeTag off of-                  Nothing -> Right fields-                  Just (tagW, off1)-                    | off1 > len -> Right fields-                    | otherwise ->-                        let !tagInt = fromIntegral tagW :: Int-                        in case findField pt tagW tagInt curIdx of-                             Just idx ->-                               let !fp = ptFields pt V.! idx-                               in case fpParse fp bs0 off1 of-                                    Left e -> Left e-                                    Right (val, off2) ->-                                      let fn = fpFieldNum fp-                                          val' = case fpLabel fp of-                                            LabelRepeated -> case IntMap.lookup fn fields of-                                              Just (DynRepeated vs) -> DynRepeated (vs ++ [val])-                                              Just existing -> DynRepeated [existing, val]-                                              Nothing -> val-                                            _ -> val-                                      in go (IntMap.insert fn val' fields) off2 (fpNextOk fp)-                             Nothing ->-                               case skipWireValue (fromIntegral (tagW `mod` 8)) bs0 off1 of-                                 Just off2 -> go fields off2 curIdx-                                 Nothing -> Right fields-      in fmap (flip DynamicMessage []) (go IntMap.empty 0 0)---{- | Decode a sequence of length-delimited dynamic messages from a strict-'ByteString' using a compiled 'ParseTable'. Each message must be preceded-by a varint byte count.--}-decodeDynamicStreamWithSchema :: ParseTable -> ByteString -> [Either DecodeError DynamicMessage]-decodeDynamicStreamWithSchema pt bs = go 0-  where-    !len = BS.length bs-    go !off-      | off >= len = []-      | otherwise = case runDecoder' getVarint bs off of-          DecodeFail _ -> [Left UnexpectedEnd]-          DecodeOK lenW off1 ->-            let !msgLen = fromIntegral lenW-                !off2 = off1 + msgLen-            in if off2 > len-                then [Left UnexpectedEnd]-                else-                  let !msgBs = BSU.unsafeTake msgLen (BSU.unsafeDrop off1 bs)-                  in decodeDynamicWithSchema pt msgBs : go off2----- | Find the matching field parser index for a given tag.-findField :: ParseTable -> Word64 -> Int -> Int -> Maybe Int-findField pt tagW tagInt curIdx-  -- TagLUT fast path: single-byte tags (field numbers 1-15)-  | tagInt >= 0-  , tagInt < 128 =-      let !lutVal = BSU.unsafeIndex (ptTagLUT pt) tagInt-      in if lutVal /= 0xFF then Just (fromIntegral lutVal) else Nothing-  -- Predicted next field-  | curIdx < V.length (ptFields pt)-  , let fp = ptFields pt V.! curIdx-  , fpTag fp == tagW =-      Just curIdx-  -- Walk NextErr chain-  | otherwise = walkErr pt tagW curIdx (ptMaxMiss pt)---walkErr :: ParseTable -> Word64 -> Int -> Int -> Maybe Int-walkErr pt tagW curIdx !tries-  | tries <= 0 = IntMap.lookup (fromIntegral tagW) (ptTagMap pt)-  | curIdx >= V.length (ptFields pt) = IntMap.lookup (fromIntegral tagW) (ptTagMap pt)-  | otherwise =-      let !fp = ptFields pt V.! curIdx-      in if fpTag fp == tagW-          then Just curIdx-          else walkErr pt tagW (fpNextErr fp) (tries - 1)----- | Skip a wire value based on wire type. Returns new offset or Nothing.-skipWireValue :: Int -> ByteString -> Int -> Maybe Int-skipWireValue wt bs off = case wt of-  0 -> case runDecoder' getVarint bs off of-    DecodeOK _ off' -> Just off'-    DecodeFail _ -> Nothing-  1 -> let off' = off + 8 in if off' <= BS.length bs then Just off' else Nothing-  2 -> case runDecoder' getVarint bs off of-    DecodeOK lenW off' ->-      let off'' = off' + fromIntegral lenW-      in if off'' <= BS.length bs then Just off'' else Nothing-    DecodeFail _ -> Nothing-  5 -> let off' = off + 4 in if off' <= BS.length bs then Just off' else Nothing-  _ -> Nothing---intToText :: Int -> Text-intToText = TL.toStrict . TLB.toLazyText . TLBI.decimal---word64ToText :: Word64 -> Text-word64ToText = TL.toStrict . TLB.toLazyText . TLBI.decimal
+ src/Proto/Internal/Either.hs view
@@ -0,0 +1,52 @@+-- Copyright © 2018 chessai+-- BSD-3-Clause license (see LICENSE for full text)+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE UnboxedSums #-}++{- | Unpacked Either using unboxed sums for zero-allocation branching.++Internal module — public API boundaries convert to standard Either.+Uses GHC's @UnboxedSums@ extension so the Left\/Right tag lives on+the stack, not the heap.+-}+module Proto.Internal.Either (+  Either (Either, Left, Right),+  either,+  fromBaseEither,+  toBaseEither,+) where++import Data.Either qualified as BaseEither+import Prelude ()+++data Either a b = Either (# a | b #)+++pattern Left :: a -> Either a b+pattern Left a = Either (# a | #)+++pattern Right :: b -> Either a b+pattern Right b = Either (# | b #)+++{-# COMPLETE Left, Right #-}+++either :: (a -> c) -> (b -> c) -> Either a b -> c+either fa fb (Either x) = case x of+  (# a | #) -> fa a+  (# | b #) -> fb b+{-# INLINE either #-}+++fromBaseEither :: BaseEither.Either a b -> Either a b+fromBaseEither (BaseEither.Left a) = Left a+fromBaseEither (BaseEither.Right b) = Right b+{-# INLINE fromBaseEither #-}+++toBaseEither :: Either a b -> BaseEither.Either a b+toBaseEither = either BaseEither.Left BaseEither.Right+{-# INLINE toBaseEither #-}
− src/Proto/Internal/Encode.hs 
@@ -1,669 +0,0 @@-{- | High-level encoding interface for protobuf messages.--This is the primary module for serialising protobuf messages to bytes.-Most users only need 'encodeMessage' for a strict 'ByteString',-'encodeLazy' for a lazy one, or 'hPutMessage' to stream straight to a-file handle.--== Quick start--@-import Proto---- Encode to a strict ByteString (exact-size, single allocation).-let bs = 'encodeMessage' myMsg---- Encode to a lazy ByteString (chunks).-let bsL = 'encodeLazy' myMsg---- Stream directly to a Handle, no intermediate ByteString.-'hPutMessage' handle myMsg-@--== One-pass size+build--Generated message types implement 'MessageEncode', whose-'buildMessage' method returns a-'Proto.Internal.SizedBuilder.SizedBuilder' — a pair of @(size,-Builder)@ that propagates the wire byte count up the message tree-alongside the byte fragments. The exact size is known at every-submessage boundary so the varint length prefix can be written-inline without a separate @messageSize@ traversal.--The old two-pass shape ("compute @messageSize@ first, then-@buildMessage@ a second time") is gone; it was 'O(N²)' on deeply-nested messages because each level re-traversed its subtree to-compute the inner size. The fused 'SizedBuilder' shape is 'O(N)'-in the total number of fields.--'messageSize' is still exported as a convenience function for-external callers — it's @'Proto.Internal.SizedBuilder.size' .-'buildMessage'@.--== Field-level helpers--The @encodeField*@ family in this module is used by generated code-and returns 'Builder' fragments. Generated message encoders go-through the archetypes in "Proto.Internal.Encode.Archetype"-instead, which return 'SizedBuilder' fragments (so each call site-carries its own byte count up the tree).--}-module Proto.Internal.Encode (-  -- * Builder type (re-exported from wireform-core)-  WB.Builder,--  -- * Encoding typeclass-  MessageEncode (..),-  buildMessage,-  messageSize,--  -- * Running encoders (strict ByteString output)-  encodeMessage,-  encodeLazy,--  -- * Stream encoding (length-delimited framing)-  encodeMessageLazy,-  encodeMessageStream,-  encodeMessageStreamSized,-  hPutMessageStream,-  buildMessageFramed,--  -- * Running encoders (Builder output)-  hPutMessage,-  hPutMessageLen,--  -- * Field encoding helpers-  encodeFieldVarint,-  encodeFieldSVarint32,-  encodeFieldSVarint64,-  encodeFieldFixed32,-  encodeFieldFixed64,-  encodeFieldFloat,-  encodeFieldDouble,-  encodeFieldBool,-  encodeFieldString,-  encodeFieldBytes,-  encodeFieldMessage,-  encodeFieldEnum,--  -- * Packed repeated field encoding-  encodePackedWord64,-  encodePackedWord32,-  encodePackedInt64,-  encodePackedInt32,-  encodePackedBool,-  encodePackedFixed32,-  encodePackedFixed64,-  encodePackedFloat,-  encodePackedDouble,-  encodePackedSVarint32,-  encodePackedSVarint64,--  -- * Legacy alias-  encodePackedVarint,--  -- * Map field encoding-  encodeMapField,--  -- * Submessage encoding helpers (used by generated code)-  encodeFieldMessageSized,-  encodeMapFieldSized,-  mapField,--  -- * Raw builders-  messageToByteString,--  -- * SizedBuilder-based field helpers (used by generated code)-  fieldVarint,-  fieldSVarint32,-  fieldSVarint64,-  fieldFixed32,-  fieldFixed64,-  fieldFloat,-  fieldDouble,-  fieldBool,-  fieldString,-  fieldBytes,-  fieldMessage,-) where--import Data.ByteString (ByteString)-import Data.ByteString qualified as BS-import Data.ByteString.Lazy qualified as BL-import Data.Int (Int32, Int64)-import Data.Text (Text)-import Data.Vector qualified as V-import Data.Vector.Storable qualified as VS-import Data.Vector.Unboxed qualified as VU-import Data.Word (Word32, Word64)-import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Ptr (castPtr)-import Foreign.Storable (Storable, sizeOf)-import Proto.Internal.SizedBuilder (SizedBuilder, sized, toByteStringFromBuilder, withSubMessage)-import Proto.Internal.SizedBuilder qualified as SB-import Proto.Internal.Wire (WireType (..))-import Proto.Internal.Wire.Encode-import System.IO (Handle)-import System.IO.Unsafe (unsafeDupablePerformIO)-import Wireform.Builder qualified as B-import Wireform.Builder qualified as WB---{- | Typeclass for types that can be encoded as protobuf messages.--The only method is 'buildSized', which returns a 'SizedBuilder' —-byte fragments and their cumulative wire byte count, fused in a-single pass. 'buildMessage' (a 'Builder' view) and 'messageSize'-(an 'Int' view) are free standalone projections over the same-fused traversal.--The @MessageSize@ class that used to live next to 'MessageEncode'-is /gone/. The wire byte count is read off 'buildSized' via-'messageSize'. There is no longer a 'Builder'-returning method on-the class: that path always involved materialising a 'Builder' to-a 'ByteString' just to read the length, which lost the @O(N)@-property on nested submessages. New encoders (generated and-hand-written) all produce 'SizedBuilder' fragments; the byte-count flows up the message tree for free alongside the bytes-themselves.--}-class MessageEncode a where-  -- | Fused encoding: byte fragments + cumulative size in a single-  -- pass.-  buildSized :: a -> SizedBuilder----- | Plain 'Builder' view of an encoded message. Free projection--- of 'buildSized'.-buildMessage :: MessageEncode a => a -> B.Builder-buildMessage = SB.toBuilder . buildSized-{-# INLINE buildMessage #-}----- | Wire-format size in bytes (fields only, no outer length prefix).--- Reads the size off the message's 'SizedBuilder' without a--- separate traversal.-messageSize :: MessageEncode a => a -> Int-messageSize = SB.size . buildSized-{-# INLINE messageSize #-}-----{- | Encode a message to a strict 'ByteString'.--Uses 'buildSized' so the output buffer is allocated at exactly the-right size in one shot — no growing-buffer reallocations.--}-encodeMessage :: MessageEncode a => a -> ByteString-encodeMessage = SB.toByteString . buildSized-{-# INLINE encodeMessage #-}----- | Encode a message to a lazy 'ByteString' (useful for streaming).-encodeLazy :: MessageEncode a => a -> BL.ByteString-encodeLazy = SB.toLazyByteString . buildSized-{-# INLINE encodeLazy #-}---{- | Write a message directly to a 'Handle' without materialising an-intermediate 'ByteString'. Uses fast-builder's streaming output.--}-hPutMessage :: MessageEncode a => Handle -> a -> IO ()-hPutMessage h = WB.hPutBuilder h . buildMessage-{-# INLINE hPutMessage #-}----- | Like 'hPutMessage' but also returns the number of bytes written.-hPutMessageLen :: MessageEncode a => Handle -> a -> IO Int-hPutMessageLen h = WB.hPutBuilderLen h . buildMessage-{-# INLINE hPutMessageLen #-}----- | Convert a builder to strict ByteString.-messageToByteString :: B.Builder -> ByteString-messageToByteString = B.toStrictByteString----- | Encode a varint field (int32, int64, uint32, uint64).-encodeFieldVarint :: Int -> Word64 -> B.Builder-encodeFieldVarint fn val =-  putTag fn WireVarint <> putVarint val-{-# INLINE encodeFieldVarint #-}----- | Encode a sint32 field.-encodeFieldSVarint32 :: Int -> Int32 -> B.Builder-encodeFieldSVarint32 fn val =-  putTag fn WireVarint <> putSVarint32 val-{-# INLINE encodeFieldSVarint32 #-}----- | Encode a sint64 field.-encodeFieldSVarint64 :: Int -> Int64 -> B.Builder-encodeFieldSVarint64 fn val =-  putTag fn WireVarint <> putSVarint64 val-{-# INLINE encodeFieldSVarint64 #-}----- | Encode a fixed32 field.-encodeFieldFixed32 :: Int -> Word32 -> B.Builder-encodeFieldFixed32 fn val =-  putTag fn Wire32Bit <> putFixed32 val-{-# INLINE encodeFieldFixed32 #-}----- | Encode a fixed64 field.-encodeFieldFixed64 :: Int -> Word64 -> B.Builder-encodeFieldFixed64 fn val =-  putTag fn Wire64Bit <> putFixed64 val-{-# INLINE encodeFieldFixed64 #-}----- | Encode a float field.-encodeFieldFloat :: Int -> Float -> B.Builder-encodeFieldFloat fn val =-  putTag fn Wire32Bit <> putFloat val-{-# INLINE encodeFieldFloat #-}----- | Encode a double field.-encodeFieldDouble :: Int -> Double -> B.Builder-encodeFieldDouble fn val =-  putTag fn Wire64Bit <> putDouble val-{-# INLINE encodeFieldDouble #-}----- | Encode a bool field.-encodeFieldBool :: Int -> Bool -> B.Builder-encodeFieldBool fn val =-  putTag fn WireVarint <> putVarint (if val then 1 else 0)-{-# INLINE encodeFieldBool #-}----- | Encode a string field.-encodeFieldString :: Int -> Text -> B.Builder-encodeFieldString fn val =-  putTag fn WireLengthDelimited <> putText val-{-# INLINE encodeFieldString #-}----- | Encode a bytes field.-encodeFieldBytes :: Int -> ByteString -> B.Builder-encodeFieldBytes fn val =-  putTag fn WireLengthDelimited <> putByteString val-{-# INLINE encodeFieldBytes #-}---{- | Encode a submessage field. Materializes the submessage to calculate its length.--}-encodeFieldMessage :: MessageEncode a => Int -> a -> B.Builder-encodeFieldMessage fn msg =-  let !sb = buildSized msg-      !sz = SB.size sb-  in putTag fn WireLengthDelimited-      <> putVarint (fromIntegral sz)-      <> SB.toBuilder sb-{-# INLINE encodeFieldMessage #-}----- | Pre-fused-builder synonym for 'encodeFieldMessage'. Kept under--- the old name because some downstream callers still reach for it.--- Both paths are now O(1) extra over @'buildMessage' msg@ (the--- size is just read from the 'SizedBuilder' rather than recomputed).-encodeFieldMessageSized :: MessageEncode a => Int -> a -> B.Builder-encodeFieldMessageSized = encodeFieldMessage-{-# INLINE encodeFieldMessageSized #-}----- | Encode an enum field (as varint).-encodeFieldEnum :: Enum a => Int -> a -> B.Builder-encodeFieldEnum fn val =-  putTag fn WireVarint <> putVarint (fromIntegral (fromEnum val))-{-# INLINE encodeFieldEnum #-}---{- | Shared @tag(LengthDelimited) || varint(payloadLen) || payload@-framing for packed repeated scalars. Threads the precomputed payload-byte count into the size component of the resulting 'SizedBuilder'-so the caller doesn't traverse the payload twice.--}-packedFrame :: Int -> Int -> B.Builder -> SizedBuilder-packedFrame fn payloadSz inner =-  SB.sized-    (tagSize fn + varintSize (fromIntegral payloadSz) + payloadSz)-    ( putTag fn WireLengthDelimited-        <> putVarint (fromIntegral payloadSz)-        <> inner-    )-{-# INLINE packedFrame #-}----- | Encode a packed repeated uint64 field. No conversion needed.-encodePackedWord64 :: Int -> VU.Vector Word64 -> SizedBuilder-encodePackedWord64 fn vals-  | VU.null vals = mempty-  | otherwise =-      let sz = VU.foldl' (\acc v -> acc + varintSize v) 0 vals-      in packedFrame fn sz-          (VU.foldl' (\acc v -> acc <> putVarint v) mempty vals)-{-# INLINE encodePackedWord64 #-}----- | Encode a packed repeated uint32 field. Uses native 32-bit varint encoding.-encodePackedWord32 :: Int -> VU.Vector Word32 -> SizedBuilder-encodePackedWord32 fn vals-  | VU.null vals = mempty-  | otherwise =-      let sz = VU.foldl' (\acc v -> acc + varintSize32 v) 0 vals-      in packedFrame fn sz-          (VU.foldl' (\acc v -> acc <> putVarint32 v) mempty vals)-{-# INLINE encodePackedWord32 #-}---{- | Encode a packed repeated int64 field.-Negative values use 10-byte two's complement.--}-encodePackedInt64 :: Int -> VU.Vector Int64 -> SizedBuilder-encodePackedInt64 fn vals-  | VU.null vals = mempty-  | otherwise =-      let sz = VU.foldl' (\acc v -> acc + varintSize (fromIntegral v)) 0 vals-      in packedFrame fn sz-          (VU.foldl' (\acc v -> acc <> putVarint (fromIntegral v)) mempty vals)-{-# INLINE encodePackedInt64 #-}---{- | Encode a packed repeated int32 field.-Negative values are sign-extended to 64-bit and use 10-byte encoding per the-protobuf spec.--}-encodePackedInt32 :: Int -> VU.Vector Int32 -> SizedBuilder-encodePackedInt32 fn vals-  | VU.null vals = mempty-  | otherwise =-      let sz = VU.foldl' (\acc v -> acc + varintSize (fromIntegral v :: Word64)) 0 vals-      in packedFrame fn sz-          (VU.foldl' (\acc v -> acc <> putVarint (fromIntegral v)) mempty vals)-{-# INLINE encodePackedInt32 #-}----- | Encode a packed repeated bool field. Each bool is a single varint byte.-encodePackedBool :: Int -> VU.Vector Bool -> SizedBuilder-encodePackedBool fn vals-  | VU.null vals = mempty-  | otherwise =-      let sz = VU.length vals-      in packedFrame fn sz-          (VU.foldl' (\acc v -> acc <> B.word8 (if v then 1 else 0)) mempty vals)-{-# INLINE encodePackedBool #-}----- | Legacy alias. Prefer the type-specific variants.-encodePackedVarint :: Int -> VU.Vector Word64 -> SizedBuilder-encodePackedVarint = encodePackedWord64-{-# INLINE encodePackedVarint #-}---{- | Encode a packed repeated fixed32 field.-On LE platforms: the vector's backing store is already the wire bytes.-We bulk-copy via a single B.byteString instead of N individual putFixed32.--}-encodePackedFixed32 :: Int -> VU.Vector Word32 -> SizedBuilder-encodePackedFixed32 fn vals-  | VU.null vals = mempty-  | otherwise =-      let sz = VU.length vals * 4-      in packedFrame fn sz (vectorToBuilder vals 4)-{-# INLINE encodePackedFixed32 #-}----- | Encode a packed repeated fixed64 field.-encodePackedFixed64 :: Int -> VU.Vector Word64 -> SizedBuilder-encodePackedFixed64 fn vals-  | VU.null vals = mempty-  | otherwise =-      let sz = VU.length vals * 8-      in packedFrame fn sz (vectorToBuilder vals 8)-{-# INLINE encodePackedFixed64 #-}----- | Encode a packed repeated float field.-encodePackedFloat :: Int -> VU.Vector Float -> SizedBuilder-encodePackedFloat fn vals-  | VU.null vals = mempty-  | otherwise =-      let sz = VU.length vals * 4-      in packedFrame fn sz (vectorToBuilder vals 4)-{-# INLINE encodePackedFloat #-}----- | Encode a packed repeated double field.-encodePackedDouble :: Int -> VU.Vector Double -> SizedBuilder-encodePackedDouble fn vals-  | VU.null vals = mempty-  | otherwise =-      let sz = VU.length vals * 8-      in packedFrame fn sz (vectorToBuilder vals 8)-{-# INLINE encodePackedDouble #-}---{- | Bulk-copy an unboxed vector's backing bytes into a Builder.-On LE platforms (x86_64, aarch64-LE), the vector's internal-representation is already in wire byte order for fixed-width-protobuf types. This emits a single B.byteString instead of-N individual word writes.--}-vectorToBuilder :: (VU.Unbox a, Storable a) => VU.Vector a -> Int -> B.Builder-vectorToBuilder vec elemSize =-  let sv = unboxedToStorable vec-      bs = unsafeDupablePerformIO $ VS.unsafeWith sv $ \ptr ->-        BS.packCStringLen (castPtr ptr, VS.length sv * elemSize)-  in B.byteStringCopy bs-{-# INLINE vectorToBuilder #-}---unboxedToStorable :: (VU.Unbox a, Storable a) => VU.Vector a -> VS.Vector a-unboxedToStorable uv = VS.generate (VU.length uv) (VU.unsafeIndex uv)-{-# INLINE unboxedToStorable #-}----- | Encode a packed repeated sint32 field.-encodePackedSVarint32 :: Int -> VU.Vector Int32 -> SizedBuilder-encodePackedSVarint32 fn vals-  | VU.null vals = mempty-  | otherwise =-      let sz = VU.foldl' (\acc v -> acc + varintSize (fromIntegral (zigZag32 v))) 0 vals-      in packedFrame fn sz-          (VU.foldl' (\acc v -> acc <> putSVarint32 v) mempty vals)-{-# INLINE encodePackedSVarint32 #-}----- | Encode a packed repeated sint64 field.-encodePackedSVarint64 :: Int -> VU.Vector Int64 -> SizedBuilder-encodePackedSVarint64 fn vals-  | VU.null vals = mempty-  | otherwise =-      let sz = VU.foldl' (\acc v -> acc + varintSize (zigZag64 v)) 0 vals-      in packedFrame fn sz-          (VU.foldl' (\acc v -> acc <> putSVarint64 v) mempty vals)-{-# INLINE encodePackedSVarint64 #-}----- | Encode a map field entry (materializing to get the length).-encodeMapField-  :: Int-  -- ^ Field number of the map field-  -> B.Builder-  -- ^ Key encoding (field 1)-  -> B.Builder-  -- ^ Value encoding (field 2)-  -> B.Builder-encodeMapField fn keyEnc valEnc =-  let entry = messageToByteString (keyEnc <> valEnc)-  in putTag fn WireLengthDelimited <> putLengthDelimited entry-{-# INLINE encodeMapField #-}----- | Encode a map field entry using pre-computed entry size.-encodeMapFieldSized-  :: Int-  -- ^ Field number-  -> Int-  -- ^ Pre-computed entry size (key encoding + value encoding bytes)-  -> B.Builder-  -- ^ Key encoding (field 1)-  -> B.Builder-  -- ^ Value encoding (field 2)-  -> B.Builder-encodeMapFieldSized fn entrySz keyEnc valEnc =-  putTag fn WireLengthDelimited-    <> putVarint (fromIntegral entrySz)-    <> keyEnc-    <> valEnc-{-# INLINE encodeMapFieldSized #-}---{- | 'encodeMapField' fused with size tracking: combine the key-'SizedBuilder' and value 'SizedBuilder' into one length-prefixed-entry. The entry's wire size comes directly from the-'SizedBuilder' inputs — no @messageToByteString@ materialisation.-Used by the generated 'buildSized' for @map\<K, V\>@ fields.--}-mapField :: Int -> SizedBuilder -> SizedBuilder -> SizedBuilder-mapField fn keyEnc valEnc =-  let !innerSz = SB.size keyEnc + SB.size valEnc-      !sz = tagSize fn + varintSize (fromIntegral innerSz) + innerSz-      !bld =-        putTag fn WireLengthDelimited-          <> putVarint (fromIntegral innerSz)-          <> SB.toBuilder keyEnc-          <> SB.toBuilder valEnc-  in sized sz bld-{-# INLINE mapField #-}----- SizedBuilder-based field encoders: compute size and builder in one pass.--- These are the Church-encoded (fused) versions of the two-pass approach.---- | Encode a varint field, producing a SizedBuilder.-fieldVarint :: Int -> Word64 -> SizedBuilder-fieldVarint fn val =-  sized (fieldVarintSize fn val) (putTag fn WireVarint <> putVarint val)-{-# INLINE fieldVarint #-}----- | Encode a sint32 field, producing a SizedBuilder.-fieldSVarint32 :: Int -> Int32 -> SizedBuilder-fieldSVarint32 fn val =-  sized (fieldSVarint32Size fn val) (putTag fn WireVarint <> putSVarint32 val)-{-# INLINE fieldSVarint32 #-}----- | Encode a sint64 field, producing a SizedBuilder.-fieldSVarint64 :: Int -> Int64 -> SizedBuilder-fieldSVarint64 fn val =-  sized (fieldSVarint64Size fn val) (putTag fn WireVarint <> putSVarint64 val)-{-# INLINE fieldSVarint64 #-}----- | Encode a fixed32 field, producing a SizedBuilder.-fieldFixed32 :: Int -> Word32 -> SizedBuilder-fieldFixed32 fn val =-  sized (fieldFixed32Size fn) (putTag fn Wire32Bit <> putFixed32 val)-{-# INLINE fieldFixed32 #-}----- | Encode a fixed64 field, producing a SizedBuilder.-fieldFixed64 :: Int -> Word64 -> SizedBuilder-fieldFixed64 fn val =-  sized (fieldFixed64Size fn) (putTag fn Wire64Bit <> putFixed64 val)-{-# INLINE fieldFixed64 #-}----- | Encode a float field, producing a SizedBuilder.-fieldFloat :: Int -> Float -> SizedBuilder-fieldFloat fn val =-  sized (fieldFloatSize fn) (putTag fn Wire32Bit <> putFloat val)-{-# INLINE fieldFloat #-}----- | Encode a double field, producing a SizedBuilder.-fieldDouble :: Int -> Double -> SizedBuilder-fieldDouble fn val =-  sized (fieldDoubleSize fn) (putTag fn Wire64Bit <> putDouble val)-{-# INLINE fieldDouble #-}----- | Encode a bool field, producing a SizedBuilder.-fieldBool :: Int -> Bool -> SizedBuilder-fieldBool fn val =-  sized (fieldBoolSize fn) (putTag fn WireVarint <> putVarint (if val then 1 else 0))-{-# INLINE fieldBool #-}----- | Encode a string field, producing a SizedBuilder.-fieldString :: Int -> Text -> SizedBuilder-fieldString fn val =-  sized (fieldTextSize fn val) (putTag fn WireLengthDelimited <> putText val)-{-# INLINE fieldString #-}----- | Encode a bytes field, producing a SizedBuilder.-fieldBytes :: Int -> ByteString -> SizedBuilder-fieldBytes fn val =-  sized (fieldBytesSize fn val) (putTag fn WireLengthDelimited <> putByteString val)-{-# INLINE fieldBytes #-}---{- | Encode a submessage field using SizedBuilder (fully fused, no materialization).-The submessage is provided as a SizedBuilder, which already knows its size.-This means we never allocate a ByteString for the submessage — just prepend-the tag and length prefix.--}-fieldMessage :: Int -> SizedBuilder -> SizedBuilder-fieldMessage fn submsg =-  let tagSB = sized (tagSize fn) (putTag fn WireLengthDelimited)-  in tagSB <> withSubMessage submsg-{-# INLINE fieldMessage #-}----- | Encode a message to a lazy 'ByteString'.-encodeMessageLazy :: MessageEncode a => a -> BL.ByteString-encodeMessageLazy = SB.toLazyByteString . buildSized-{-# INLINE encodeMessageLazy #-}---{- | Encode a list of messages with length-delimited framing.-Each message is preceded by a varint length prefix. The size for-each frame comes from the message's 'SizedBuilder' directly, no-intermediate materialisation.--}-encodeMessageStream :: MessageEncode a => [a] -> BL.ByteString-encodeMessageStream = B.toLazyByteString . foldMap buildMessageFramed----- | Synonym for 'encodeMessageStream' — both paths use the fused--- 'SizedBuilder' size now, so the old "Sized" variant is redundant.-encodeMessageStreamSized :: MessageEncode a => [a] -> BL.ByteString-encodeMessageStreamSized = encodeMessageStream-{-# INLINE encodeMessageStreamSized #-}---{- | Write a stream of messages directly to a 'Handle' with-length-delimited framing.--}-hPutMessageStream :: MessageEncode a => Handle -> [a] -> IO ()-hPutMessageStream h = WB.hPutBuilder h . foldMap buildMessageFramed---{- | Build a single length-delimited frame: varint size prefix-followed by the message payload. Reads the prefix size from the-fused 'SizedBuilder' so there's no separate size traversal.--}-buildMessageFramed :: MessageEncode a => a -> B.Builder-buildMessageFramed msg =-  let !sb = buildSized msg-      !sz = SB.size sb-  in putVarint (fromIntegral sz) <> SB.toBuilder sb-{-# INLINE buildMessageFramed #-}
src/Proto/Internal/Encode/Archetype.hs view
@@ -1,34 +1,17 @@ {-# LANGUAGE BangPatterns #-} -{- | Archetype-specialised encode functions for maximum performance.--__Stability:__ exposed for use by wireform-proto-generated code; not-part of the stable public API.--Each function is specialised for a specific-@(field_number, wire_type, field_type)@ combination, with the wire-tag byte baked in as a compile-time constant. Generated code calls-into these directly rather than going through the-@encodeField*@ / @putTag@ wrapper chain.--== Sized builder return shape+{- | Archetype-specialized encode functions for maximum performance. -Every archetype here returns a 'SizedBuilder', not a raw 'Builder'.-That means each fragment carries the exact wire byte count of what-it will emit, so the parent message can:+Inspired by hyperpb's ~200 archetype thunks: each function is+specialized for a specific (field_number, wire_type, field_type)+combination, with the tag byte baked in as a compile-time constant. -1. allocate its output buffer in one shot at exactly the right size,-   and-2. write a submessage's varint length prefix without a /separate/-   @messageSize@ traversal of the inner message.+These avoid the overhead of:+* Runtime tag computation (fieldTag fn wt)+* putVarint branch chain for 1-byte tags+* Wrapper function call chains (encodeFieldVarint -> putTag -> putVarint) -The old "build a 'Builder', then do a separate size traversal to-prefix the length, then emit" two-pass shape is gone — it was-'O(N²)' on nested-message trees because each level re-traversed-its subtree to compute the inner size, and the cost grew-quadratically with nesting depth. With 'SizedBuilder' the size-flows up the tree alongside the builder fragments in 'O(N)' total.-See "Proto.Internal.SizedBuilder" for the underlying machinery.+Generated code should use these directly for field numbers 1-15. -} module Proto.Internal.Encode.Archetype (   -- * Singular field archetypes (tag byte baked in)@@ -48,13 +31,7 @@   archRepeatedString,   archRepeatedSubmessage, -  -- * Packed repeated archetypes-  archPackedVarints,--  -- * Legacy size-pass helpers (kept so already-generated modules-  -- whose import lists still mention them keep compiling; new-  -- generated code does not use these — the size is carried by-  -- 'SizedBuilder' instead).+  -- * Size archetypes   archVarintSize,   archStringSize,   archBytesSize,@@ -62,13 +39,25 @@   archFixed32Size,   archFixed64Size,   archSubmessageSize,++  -- * Fused SizedBuilder archetypes (single-pass size+build)+  sbArchVarint,+  sbArchBool,+  sbArchFixed32,+  sbArchFixed64,+  sbArchFloat,+  sbArchDouble,+  sbArchString,+  sbArchBytes,+  sbArchSubmessage,+  sbArchPackedVarints, ) where -import Data.Bits (shiftL, shiftR, xor) import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.Int (Int32, Int64) import Data.Text (Text)+import Data.Text.Encoding qualified as TE import Data.Text.Foreign qualified as TF import Data.Vector.Unboxed qualified as VU import Data.Word (Word32, Word64, Word8)@@ -79,201 +68,244 @@   putText,   putVarint,   varintSize,+  zigZag32,+  zigZag64,  ) import Wireform.Builder qualified as B  --- | Varint field. Tag byte + varint-encoded value.-archVarint :: Word64 -> Word64 -> SizedBuilder-archVarint !tag !val =-  let !sz = varintSize tag + varintSize val-  in sized sz (putVarint tag <> putVarint val)+{- | Archetype: varint field with baked tag byte.+@archVarint tagByte value@ emits the tag + varint in ~2 instructions+for the tag (single B.word8) + the varint.+-}+archVarint :: Word8 -> Word64 -> B.Builder+archVarint !tag !val = B.word8 tag <> putVarint val {-# INLINE archVarint #-}  --- | ZigZag-encoded sint32 field. Tag byte + zigzag-varint.-archSVarint32 :: Word64 -> Int32 -> SizedBuilder-archSVarint32 !tag !val =-  -- ZigZag preserves varint width for the worst case; @putSVarint32@-  -- writes the same number of bytes that @varintSize@ would-  -- report for the post-zigzag value.-  let !zz = zigZagW32 val-      !sz = varintSize tag + varintSize (fromIntegral zz)-  in sized sz (putVarint tag <> putSVarint32 val)+-- | Archetype: ZigZag-encoded sint32 field with baked tag byte.+archSVarint32 :: Word8 -> Int32 -> B.Builder+archSVarint32 !tag !val = B.word8 tag <> putSVarint32 val {-# INLINE archSVarint32 #-}  --- | ZigZag-encoded sint64 field. Tag byte + zigzag-varint.-archSVarint64 :: Word64 -> Int64 -> SizedBuilder-archSVarint64 !tag !val =-  let !zz = zigZagW64 val-      !sz = varintSize tag + varintSize zz-  in sized sz (putVarint tag <> putSVarint64 val)+-- | Archetype: ZigZag-encoded sint64 field with baked tag byte.+archSVarint64 :: Word8 -> Int64 -> B.Builder+archSVarint64 !tag !val = B.word8 tag <> putSVarint64 val {-# INLINE archSVarint64 #-}  --- | fixed32 field (little-endian).-archFixed32 :: Word64 -> Word32 -> SizedBuilder-archFixed32 !tag !val =-  sized (varintSize tag + 4) (putVarint tag <> B.word32LE val)+-- | Archetype: fixed32 field with baked tag byte (little-endian).+archFixed32 :: Word8 -> Word32 -> B.Builder+archFixed32 !tag !val = B.word8 tag <> B.word32LE val {-# INLINE archFixed32 #-}  --- | fixed64 field (little-endian).-archFixed64 :: Word64 -> Word64 -> SizedBuilder-archFixed64 !tag !val =-  sized (varintSize tag + 8) (putVarint tag <> B.word64LE val)+-- | Archetype: fixed64 field with baked tag byte (little-endian).+archFixed64 :: Word8 -> Word64 -> B.Builder+archFixed64 !tag !val = B.word8 tag <> B.word64LE val {-# INLINE archFixed64 #-}  --- | IEEE 754 float field.-archFloat :: Word64 -> Float -> SizedBuilder-archFloat !tag !val =-  sized (varintSize tag + 4) (putVarint tag <> B.floatLE val)+-- | Archetype: float field with baked tag byte (IEEE 754).+archFloat :: Word8 -> Float -> B.Builder+archFloat !tag !val = B.word8 tag <> B.floatLE val {-# INLINE archFloat #-}  --- | IEEE 754 double field.-archDouble :: Word64 -> Double -> SizedBuilder-archDouble !tag !val =-  sized (varintSize tag + 8) (putVarint tag <> B.doubleLE val)+-- | Archetype: double field with baked tag byte (IEEE 754).+archDouble :: Word8 -> Double -> B.Builder+archDouble !tag !val = B.word8 tag <> B.doubleLE val {-# INLINE archDouble #-}  --- | bool field. Tag + single varint byte (0 or 1).-archBool :: Word64 -> Bool -> SizedBuilder-archBool !tag True = sized (varintSize tag + 1) (putVarint tag <> B.word8 1)-archBool !tag False = sized (varintSize tag + 1) (putVarint tag <> B.word8 0)+-- | Archetype: bool field with baked tag byte.+archBool :: Word8 -> Bool -> B.Builder+archBool !tag True = B.word8 tag <> B.word8 1+archBool !tag False = B.word8 tag <> B.word8 0 {-# INLINE archBool #-}  -{- | UTF-8 string field. Tag + length varint + UTF-8 bytes.+{- | String archetype: tag + length varint + UTF-8 bytes. -The size pass reads the 'Text' record's byte length in O(1) via-'TF.lengthWord8' (no allocation). The build pass streams the-'Text' 's bytes straight from its unpinned 'ByteArray#' into the-builder buffer via 'putText' — no intermediate pinned-'BS.ByteString' copy.+Delegates to 'putText', which streams the 'Text' 's bytes directly+from its unpinned 'ByteArray#' into the builder buffer. This+avoids the per-call pinned 'BS.ByteString' allocation and second+copy that the naive @'B.byteString' . 'TE.encodeUtf8'@ form+forces. See 'Proto.Internal.Wire.Encode.byteArraySliceBuilder' for the+underlying primitive and rationale. -}-archString :: Word64 -> Text -> SizedBuilder-archString !tag !val =-  let !len = TF.lengthWord8 val-      !sz = varintSize tag + varintSize (fromIntegral len) + len-  in sized sz (putVarint tag <> putText val)+archString :: Word8 -> Text -> B.Builder+archString !tag !val = B.word8 tag <> putText val {-# INLINE archString #-}  --- | bytes field (length-delimited). Tag + length varint + bytes.-archBytes :: Word64 -> ByteString -> SizedBuilder+-- | Archetype: bytes field with baked tag byte (length-delimited).+archBytes :: Word8 -> ByteString -> B.Builder archBytes !tag !val =-  let !len = BS.length val-      !sz = varintSize tag + varintSize (fromIntegral len) + len-  in sized sz (putVarint tag <> putVarint (fromIntegral len) <> B.byteString val)+  B.word8 tag <> putVarint (fromIntegral (BS.length val)) <> B.byteString val {-# INLINE archBytes #-}  -{- | Submessage field. Tag + (varint length + payload) wrapped from-the already-sized inner builder.--The inner 'SizedBuilder' has carried its byte count up from each-of its fields' archetype calls, so this just wraps with one tag-byte and lets 'withSubMessage' prepend the canonical length-varint — no separate size traversal of the submessage tree.+{- | Submessage archetype: tag + length varint + payload builder.+Takes a pre-computed size and the builder for the submessage body. -}-archSubmessage :: Word64 -> SizedBuilder -> SizedBuilder-archSubmessage !tag inner =-  sized (varintSize tag) (putVarint tag) <> withSubMessage inner+archSubmessage :: Word8 -> Int -> B.Builder -> B.Builder+archSubmessage !tag !sz !body =+  B.word8 tag <> putVarint (fromIntegral sz) <> body {-# INLINE archSubmessage #-}  --- | Repeated string archetype — alias for 'archString' (one element).-archRepeatedString :: Word64 -> Text -> SizedBuilder+-- | Repeated string archetype: emits tag + string for each element.+archRepeatedString :: Word8 -> Text -> B.Builder archRepeatedString = archString {-# INLINE archRepeatedString #-}  --- | Repeated submessage archetype — alias for 'archSubmessage'.-archRepeatedSubmessage :: Word64 -> SizedBuilder -> SizedBuilder+-- | Repeated submessage archetype.+archRepeatedSubmessage :: Word8 -> Int -> B.Builder -> B.Builder archRepeatedSubmessage = archSubmessage {-# INLINE archRepeatedSubmessage #-}  -{- | Packed repeated varint field. Tag + total payload length-varint + the concatenated value varints. Empty input emits-nothing (proto3 packed encoding omits empty fields).--}-archPackedVarints :: Word64 -> VU.Vector Int32 -> SizedBuilder-archPackedVarints !tag vs-  | VU.null vs = mempty-  | otherwise =-      let (!packedSz, !packedBld) =-            VU.foldl'-              ( \(!sz, !bld) v ->-                  let !w = fromIntegral v :: Word64-                  in (sz + varintSize w, bld <> putVarint w)-              )-              (0, mempty)-              vs-          !totalSz = varintSize tag + varintSize (fromIntegral packedSz) + packedSz-      in sized totalSz (putVarint tag <> putVarint (fromIntegral packedSz) <> packedBld)-{-# INLINE archPackedVarints #-}----- | ZigZag encoding for Int32 → Word32. Used only to compute the--- post-ZigZag varint byte count for the size pass; 'putSVarint32'--- emits the same encoding when the bytes go to the buffer.-zigZagW32 :: Int32 -> Word32-zigZagW32 n =-  fromIntegral ((n `shiftL` 1) `xor` (n `shiftR` 31))-{-# INLINE zigZagW32 #-}----- | ZigZag encoding for Int64 → Word64. Used only to compute the--- post-ZigZag varint byte count for the size pass; 'putSVarint64'--- emits the same encoding when the bytes go to the buffer.-zigZagW64 :: Int64 -> Word64-zigZagW64 n =-  fromIntegral ((n `shiftL` 1) `xor` (n `shiftR` 63))-{-# INLINE zigZagW64 #-}----- ============================================================--- Legacy size-pass helpers--- ============================================================------ These were used by the pre-SizedBuilder codegen output. They're--- kept here so already-generated modules whose import lists still--- mention them continue to compile; freshly regenerated code--- doesn't import them.+-- Size archetypes: compute encoded size with tag included. +-- | Encoded size of a varint field including the 1-byte tag. archVarintSize :: Word64 -> Int-archVarintSize !val = varintSize val+archVarintSize !val = 1 + varintSize val {-# INLINE archVarintSize #-} ++{- | Encoded size of a text field with baked tag.++Uses 'TF.lengthWord8' to read the 'Text' record's byte length in O(1)+with no heap allocation.+-} archStringSize :: Text -> Int archStringSize !val =   let !len = TF.lengthWord8 val-  in varintSize (fromIntegral len) + len+  in 1 + varintSize (fromIntegral len) + len {-# INLINE archStringSize #-} ++-- | Encoded size of a bytes field including tag and length varint. archBytesSize :: ByteString -> Int archBytesSize !val =   let !len = BS.length val-  in varintSize (fromIntegral len) + len+  in 1 + varintSize (fromIntegral len) + len {-# INLINE archBytesSize #-} + archBoolSize :: Int-archBoolSize = 1+archBoolSize = 2 {-# INLINE archBoolSize #-} + archFixed32Size :: Int-archFixed32Size = 4+archFixed32Size = 5 {-# INLINE archFixed32Size #-} + archFixed64Size :: Int-archFixed64Size = 8+archFixed64Size = 9 {-# INLINE archFixed64Size #-} ++-- | Submessage size: 1 (tag) + varint(payloadSize) + payloadSize archSubmessageSize :: Int -> Int-archSubmessageSize !payloadSz = varintSize (fromIntegral payloadSz) + payloadSz+archSubmessageSize !payloadSz = 1 + varintSize (fromIntegral payloadSz) + payloadSz {-# INLINE archSubmessageSize #-}+++-- ============================================================+-- Fused SizedBuilder archetypes: compute size + build in ONE pass.+-- These eliminate the separate messageSize traversal.+-- ============================================================++-- | Fused varint field: computes size and builds in one shot.+sbArchVarint :: Word8 -> Word64 -> SizedBuilder+sbArchVarint !tag !val =+  let !sz = 1 + varintSize val+  in sized sz (B.word8 tag <> putVarint val)+{-# INLINE sbArchVarint #-}+++sbArchBool :: Word8 -> Bool -> SizedBuilder+sbArchBool !tag !val =+  sized 2 (B.word8 tag <> B.word8 (if val then 1 else 0))+{-# INLINE sbArchBool #-}+++sbArchFixed32 :: Word8 -> Word32 -> SizedBuilder+sbArchFixed32 !tag !val =+  sized 5 (B.word8 tag <> B.word32LE val)+{-# INLINE sbArchFixed32 #-}+++sbArchFixed64 :: Word8 -> Word64 -> SizedBuilder+sbArchFixed64 !tag !val =+  sized 9 (B.word8 tag <> B.word64LE val)+{-# INLINE sbArchFixed64 #-}+++sbArchFloat :: Word8 -> Float -> SizedBuilder+sbArchFloat !tag !val =+  sized 5 (B.word8 tag <> B.floatLE val)+{-# INLINE sbArchFloat #-}+++sbArchDouble :: Word8 -> Double -> SizedBuilder+sbArchDouble !tag !val =+  sized 9 (B.word8 tag <> B.doubleLE val)+{-# INLINE sbArchDouble #-}+++{- | Fused string field: size pass reads the 'Text' length slot+directly via 'TF.lengthWord8' (no allocation), build pass streams+the bytes through 'putText' which writes straight to the builder+buffer (no intermediate pinned 'BS.ByteString'). The previous+implementation forced 'TE.encodeUtf8' to materialise a pinned+'BS.ByteString' just to read its length on every encode call --+with this version both passes touch zero heap.+-}+sbArchString :: Word8 -> Text -> SizedBuilder+sbArchString !tag !val =+  let !len = TF.lengthWord8 val+      !sz = 1 + varintSize (fromIntegral len) + len+  in sized sz (B.word8 tag <> putText val)+{-# INLINE sbArchString #-}+++sbArchBytes :: Word8 -> ByteString -> SizedBuilder+sbArchBytes !tag !val =+  let !len = BS.length val+      !sz = 1 + varintSize (fromIntegral len) + len+  in sized sz (B.word8 tag <> putVarint (fromIntegral len) <> B.byteString val)+{-# INLINE sbArchBytes #-}+++-- | Fused submessage field: tag + withSubMessage on the payload SizedBuilder.+sbArchSubmessage :: Word8 -> SizedBuilder -> SizedBuilder+sbArchSubmessage !tag payload =+  sized 1 (B.word8 tag) <> withSubMessage payload+{-# INLINE sbArchSubmessage #-}+++{- | Fused packed varint field for Int32.+Single pass: computes size and builds simultaneously.+-}+sbArchPackedVarints :: Word8 -> VU.Vector Int32 -> SizedBuilder+sbArchPackedVarints !tag vs+  | VU.null vs = mempty+  | otherwise =+      let (!packedSz, !packedBld) =+            VU.foldl'+              ( \(!sz, !bld) v ->+                  let !w = fromIntegral v :: Word64+                  in (sz + varintSize w, bld <> putVarint w)+              )+              (0, mempty)+              vs+          !totalSz = 1 + varintSize (fromIntegral packedSz) + packedSz+      in sized totalSz (B.word8 tag <> putVarint (fromIntegral packedSz) <> packedBld)+{-# INLINE sbArchPackedVarints #-}
src/Proto/Internal/GrowList.hs view
@@ -2,17 +2,8 @@  {- | Pure growing accumulator for repeated fields. -__Stability:__ exposed for use by wireform-proto-generated code; not-part of the stable public API.--Stores elements in a reversed cons list with a count.  Each 'snocGrowList'-allocates exactly one cons cell.  Materialisation via 'growListToVector'-uses 'V.create' and writes elements backwards into the mutable vector,-so no intermediate reversed list is allocated.--Benchmark results (aarch64, GHC 9.8.4 -O2) vs the previous difference-list-implementation: ~30% faster across all sizes for both boxed and unboxed-element types.+Uses a difference-list (Endo-style function composition with cons)+for O(1) amortised snoc, then materialises to Vector via fromListN. -} module Proto.Internal.GrowList (   GrowList (..),@@ -26,22 +17,21 @@ import Data.Vector qualified as V import Data.Vector.Mutable qualified as MV import Data.Vector.Unboxed qualified as VU-import Data.Vector.Unboxed.Mutable qualified as MVU   data GrowList a = GrowList-  { glBuild :: ![a]             -- reversed: most-recently-snoced element is at the head+  { glBuild :: !([a] -> [a])   , glCount :: {-# UNPACK #-} !Int   }   emptyGrowList :: GrowList a-emptyGrowList = GrowList [] 0+emptyGrowList = GrowList id 0 {-# INLINE emptyGrowList #-}   snocGrowList :: GrowList a -> a -> GrowList a-snocGrowList (GrowList xs n) x = GrowList (x : xs) (n + 1)+snocGrowList (GrowList f n) x = GrowList (f . (x :)) (n + 1) {-# INLINE snocGrowList #-}  @@ -51,17 +41,14 @@   -- | Materialise to a boxed Vector.------ Fills the vector by writing index @n-1-i@ for each element of the--- reversed list, traversing front-to-back.  This is equivalent to--- @reverse@ + forward fill but avoids allocating the reversed list. growListToVector :: GrowList a -> V.Vector a-growListToVector (GrowList xs n)-  | n == 0    = V.empty+growListToVector (GrowList f n)+  | n == 0 = V.empty   | otherwise = V.create $ do-      mv <- MV.unsafeNew n-      let fill !_ []       = pure ()-          fill !i (e : es) = MV.unsafeWrite mv (n - 1 - i) e >> fill (i + 1) es+      let !xs = f []+      mv <- MV.new n+      let fill !_ [] = pure ()+          fill !i (e : es) = MV.unsafeWrite mv i e >> fill (i + 1) es       fill 0 xs       pure mv {-# INLINE growListToVector #-}@@ -69,12 +56,5 @@  -- | Materialise to an unboxed Vector. growListToVectorU :: VU.Unbox a => GrowList a -> VU.Vector a-growListToVectorU (GrowList xs n)-  | n == 0    = VU.empty-  | otherwise = VU.create $ do-      mv <- MVU.unsafeNew n-      let fill !_ []       = pure ()-          fill !i (e : es) = MVU.unsafeWrite mv (n - 1 - i) e >> fill (i + 1) es-      fill 0 xs-      pure mv+growListToVectorU gl = VU.convert (growListToVector gl) {-# INLINE growListToVectorU #-}
src/Proto/Internal/JSON.hs view
@@ -4,9 +4,6 @@  {- | Proto3 canonical JSON encoding and decoding helpers. -__Stability:__ exposed for use by wireform-proto-generated code; not-part of the stable public API.- Provides helpers for proto-canonical JSON representations:  * 64-bit integers encoded as JSON strings (JavaScript precision limits)@@ -51,8 +48,9 @@    -- * Representation-aware string field helpers -  -- | These handle all 'StringRep' variants (strict text, lazy text,-  -- short bytestring, String).+  {- | These handle all 'StringRep' variants (strict text, lazy text,+  short bytestring, String).+  -}   lazyTextFieldToJSON,   parseLazyTextFieldMaybe,   shortTextFieldToJSON,@@ -73,10 +71,6 @@   parseLazyBytesMapFieldMaybe,   shortBytesMapFieldToJSON,   parseShortBytesMapFieldMaybe,--  -- * Oneof variant JSON-  OneofVariantNullSemantics (..),-  parseOneofVariants, ) where  import Data.Aeson qualified as Aeson@@ -95,7 +89,6 @@ import Data.Int (Int64) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map-import Data.Maybe (mapMaybe) import Data.Scientific (Scientific, fromFloatDigits, toBoundedInteger, toRealFloat) import Data.Text (Text) import Data.Text qualified as T@@ -164,13 +157,14 @@ protoWord64ToJSON n = Aeson.String (word64ToText n)  --- | Parse an 'Int64' from a JSON string or number (proto3 canonical).------ Proto3 spec, "JSON Mapping": int64 / uint64 are encoded as--- decimal strings on output, but accepted as either string or--- number on input. The conformance suite verifies range +--- integrality, so we route both shapes through 'boundedFromSci'--- which rejects fractional and out-of-range values.+{- | Parse an 'Int64' from a JSON string or number (proto3 canonical).++Proto3 spec, "JSON Mapping": int64 / uint64 are encoded as+decimal strings on output, but accepted as either string or+number on input. The conformance suite verifies range ++integrality, so we route both shapes through 'boundedFromSci'+which rejects fractional and out-of-range values.+-} protoInt64FromJSON :: Aeson.Value -> Aeson.Parser Int64 protoInt64FromJSON (Aeson.String s) = sciFromText s >>= boundedFromSci "int64" protoInt64FromJSON (Aeson.Number n) = boundedFromSci "int64" n@@ -263,21 +257,22 @@ -- when input length is already a multiple of 4 internally; -- for \"-_\"-style 2-char inputs we manually pad first so the -- @decode@ entrypoint accepts them.+ -- | Parse a strict 'ByteString' from a base64 or base64url JSON string. protoBytesFromJSON :: Aeson.Value -> Aeson.Parser ByteString protoBytesFromJSON (Aeson.String s) =   let bs = TE.encodeUtf8 s   in case Base64.decode bs of-      Right out -> pure out-      -- Standard base64 failed; if the input is plausibly-      -- base64url (no '+' or '/'), retry via the lenient-      -- URL decoder which tolerates unpadded inputs and-      -- the non-canonical trailing pad bits the conformance-      -- BytesFieldBase64Url test sends ("-_").-      Left err-        | looksLikeBase64Url bs ->-            pure (Base64URL.decodeLenient bs)-        | otherwise -> fail ("Invalid base64 bytes: " <> err)+       Right out -> pure out+       -- Standard base64 failed; if the input is plausibly+       -- base64url (no '+' or '/'), retry via the lenient+       -- URL decoder which tolerates unpadded inputs and+       -- the non-canonical trailing pad bits the conformance+       -- BytesFieldBase64Url test sends ("-_").+       Left err+         | looksLikeBase64Url bs ->+             pure (Base64URL.decodeLenient bs)+         | otherwise -> fail ("Invalid base64 bytes: " <> err) protoBytesFromJSON _ = fail "Expected base64 string for bytes"  @@ -541,65 +536,6 @@     pairs <- traverse (\(k, v) -> (,) (AesonKey.toText k) <$> protoShortBytesFromJSON v) (AesonKM.toList o)     pure (Just (Map.fromList pairs))   Just _ -> fail ("Expected object for short-bytes map field: " <> T.unpack key)----- ------------------------------------------------------------------------------ Oneof variant JSON helpers--- -----------------------------------------------------------------------------{- | Per-variant interpretation of JSON @null@ in a oneof. For most-variants @null@ means "this variant is unset" (matching the proto3-spec's "absent submessage" convention), so 'parseOneofVariants'-skips that variant and continues looking. For the-@google.protobuf.NullValue@ WKT, @null@ /is/ the variant's only-inhabitant — the variant must be selected with the singleton enum-value as its payload.--}-data OneofVariantNullSemantics-  = OneofVariantNullIsUnset-  | OneofVariantNullIsValue---{- | Parse the JSON encoding of a proto3 oneof.--Proto3 JSON encodes a oneof inline at the /parent/ message level: only-the selected variant's JSON name appears, mapped to that variant's-payload. There is no enclosing object for the oneof itself.--This helper drives the parser side. The caller supplies the parent-@Aeson.Object@ and a list of @(jsonKey, nullSemantics, parser)@-triples — one per variant. We scan the object for keys that match,-apply the per-variant null filter, and produce:--* @Nothing@ — no matching variant key present.-* @Just v@ — exactly one matching variant key; @v@ is the parsed-  Haskell-side oneof sum value.-* a parser failure — more than one variant key present-  (proto3-conformant: @OneofFieldDuplicate@ is an error).--Used by both the pure-text codegen and the Template-Haskell-codegen so the two paths share one source of truth.--}-parseOneofVariants-  :: Aeson.Object-  -> [(Text, OneofVariantNullSemantics, Aeson.Value -> Aeson.Parser a)]-  -> Aeson.Parser (Maybe a)-parseOneofVariants obj variants =-  let present = mapMaybe collect variants-      collect (k, sem, p) = do-        v <- AesonKM.lookup (AesonKey.fromText k) obj-        if keep sem v then Just (k, v, p) else Nothing-      keep OneofVariantNullIsUnset Aeson.Null = False-      keep _ _ = True-  in case present of-      [] -> pure Nothing-      [(_, v, p)] -> Just <$> p v-      _ ->-        fail-          ( "Multiple oneof variants set: "-              <> show (fmap (\(k, _, _) -> k) present)-          )-{-# INLINE parseOneofVariants #-}   -- ---------------------------------------------------------------------------
src/Proto/Internal/JSON/Extension.hs view
@@ -4,9 +4,6 @@  {- | Registry for proto2 extension JSON helpers. -__Stability:__ exposed for use by wireform-proto-generated code; not-part of the stable public API.- Proto2 lets messages declare extension ranges:  @@@ -59,7 +56,7 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Word (Word32, Word64)-import Proto.Internal.Decode (UnknownField (..))+import Proto.Decode (UnknownField (..)) import Proto.Extension (   ExtensionType (..),   decodeExtensionValue,@@ -75,8 +72,9 @@ -} data ExtJsonCodec = ExtJsonCodec   { ejcExtensionFqn :: !Text-  -- ^ Fully-qualified proto name of the extension (the-  --   bracket-quoted JSON key without the brackets).+  {- ^ Fully-qualified proto name of the extension (the+  bracket-quoted JSON key without the brackets).+  -}   , ejcFieldNumber :: !Int   , ejcParseValue :: Aeson.Value -> Either String UnknownField   , ejcEncodeValue :: UnknownField -> Either String Aeson.Value@@ -216,12 +214,12 @@ parseExtensionEntry reg parentFqn key val =   let t = AesonKey.toText key   in case T.uncons t of-      Just ('[', rest) -> case T.unsnoc rest of-        Just (fqn, ']') -> case lookupExtensionByFqn reg parentFqn fqn of-          Just codec -> Just (ejcParseValue codec val)-          Nothing -> Nothing -- unrecognised extension; ignore-        _ -> Nothing-      _ -> Nothing+       Just ('[', rest) -> case T.unsnoc rest of+         Just (fqn, ']') -> case lookupExtensionByFqn reg parentFqn fqn of+           Just codec -> Just (ejcParseValue codec val)+           Nothing -> Nothing -- unrecognised extension; ignore+         _ -> Nothing+       _ -> Nothing {-# INLINE parseExtensionEntry #-}
src/Proto/Internal/JSON/WellKnown.hs view
@@ -3,9 +3,6 @@  {- | Proto3 canonical JSON mapping for well-known types. -__Stability:__ exposed for use by wireform-proto-generated code; not-part of the stable public API.- These functions provide the canonical conversions specified by the proto3 JSON specification. -}@@ -25,13 +22,14 @@    -- * Wrapper types -  -- | Per the proto3 JSON spec, every @google.protobuf.XValue@-  -- wrapper serialises as just its inner value (rather than the-  -- generic @{"value": ...}@ shape the pre-generated @ToJSON@-  -- instances produce). The 'wrap*' helpers go in the encode-  -- direction; the 'unwrap*' helpers parse a bare JSON value-  -- and construct the wrapper. 64-bit integer wrappers-  -- additionally string-encode their inner value.+  {- | Per the proto3 JSON spec, every @google.protobuf.XValue@+  wrapper serialises as just its inner value (rather than the+  generic @{"value": ...}@ shape the pre-generated @ToJSON@+  instances produce). The 'wrap*' helpers go in the encode+  direction; the 'unwrap*' helpers parse a bare JSON value+  and construct the wrapper. 64-bit integer wrappers+  additionally string-encode their inner value.+  -}   wrapBoolValue,   wrapInt32Value,   wrapInt64Value,@@ -61,6 +59,7 @@   anyToJSON,   anyFromJSON,   standardWktRegistry,+  anyJsonRegistry,    -- * Re-exports from "Proto.Registry"   AnyCodec (..),@@ -83,16 +82,18 @@ import Data.Text.Encoding qualified as TE import Data.Text.Read qualified as TR import Data.Vector qualified as V-import Proto qualified as PD-import Proto qualified as PE-import Proto.Google.Protobuf.WellKnownTypes.Any qualified as Any-import Proto.Google.Protobuf.WellKnownTypes.Duration-import Proto.Google.Protobuf.WellKnownTypes.Empty qualified as Empty-import Proto.Google.Protobuf.WellKnownTypes.FieldMask-import Proto.Google.Protobuf.WellKnownTypes.Struct-import Proto.Google.Protobuf.WellKnownTypes.Timestamp-import Proto.Google.Protobuf.WellKnownTypes.Wrappers qualified as W-import Proto.Registry (AnyCodec (..), TypeRegistry, emptyRegistry, lookupCodec, registerCodec)+import Proto.Decode qualified as PD+import Proto.Encode qualified as PE+import Proto.Google.Protobuf.Any qualified as Any+import Proto.Google.Protobuf.Duration+import Proto.Google.Protobuf.Empty qualified as Empty+import Proto.Google.Protobuf.FieldMask+import Proto.Google.Protobuf.Struct+import Proto.Google.Protobuf.Timestamp+import Proto.Google.Protobuf.Wrappers qualified as W+import Data.IORef (readIORef)+import System.IO.Unsafe (unsafePerformIO)+import Proto.Registry (AnyCodec (..), TypeRegistry, emptyRegistry, globalAnyRegistry, lookupCodec, registerCodec)   {- | Encode a 'Timestamp' as canonical RFC 3339. Throws on out-@@ -353,13 +354,13 @@ parseTime t =   let (wholePart, fracPart) = T.breakOn "." t   in case T.splitOn ":" wholePart of-      [hs, ms, ss] -> do-        h <- readInt hs-        m <- readInt ms-        s <- readInt ss-        let !nanos = parseFracNanos fracPart-        Right (ParsedTime h m s nanos)-      _ -> Left "Invalid time format"+       [hs, ms, ss] -> do+         h <- readInt hs+         m <- readInt ms+         s <- readInt ss+         let !nanos = parseFracNanos fracPart+         Right (ParsedTime h m s nanos)+       _ -> Left "Invalid time format"   parseFracNanos :: Text -> Int32@@ -369,8 +370,8 @@       let digits = T.takeWhile isDigit (T.tail t)           padded = T.take 9 (digits <> T.replicate (9 - T.length digits) "0")       in case readInt padded of-          Right n -> fromIntegral n-          Left _ -> 0+           Right n -> fromIntegral n+           Left _ -> 0   | otherwise = 0  @@ -427,23 +428,23 @@             Just ('-', _) -> True             _ -> False       in case T.breakOn "." numPart of-          (wholePart, fracPart) -> do-            secs <- readInt wholePart-            let !rawNanos = parseFracNanos fracPart-                -- Proto3 spec: nanos carry the same sign as seconds.-                -- For "-0.5s" the wholePart parses to 0 but the-                -- sign comes from the leading '-' in the input.-                !nanos = if negative then negate rawNanos else rawNanos-                !secs64 = fromIntegral secs :: Int64-            if secs64 < durationMinSecs || secs64 > durationMaxSecs-              then Left "Duration out of range [-315576000000, 315576000000]"-              else-                Right-                  Duration-                    { durationSeconds = secs64-                    , durationNanos = nanos-                    , durationUnknownFields = []-                    }+           (wholePart, fracPart) -> do+             secs <- readInt wholePart+             let !rawNanos = parseFracNanos fracPart+                 -- Proto3 spec: nanos carry the same sign as seconds.+                 -- For "-0.5s" the wholePart parses to 0 but the+                 -- sign comes from the leading '-' in the input.+                 !nanos = if negative then negate rawNanos else rawNanos+                 !secs64 = fromIntegral secs :: Int64+             if secs64 < durationMinSecs || secs64 > durationMaxSecs+               then Left "Duration out of range [-315576000000, 315576000000]"+               else+                 Right+                   Duration+                     { durationSeconds = secs64+                     , durationNanos = nanos+                     , durationUnknownFields = []+                     }   -- FieldMask: comma-separated paths@@ -768,7 +769,7 @@   {- | 'NullValue' is the proto3 enum @NULL_VALUE = 0@; it serialises-as JSON @null@. We import it from "Proto.Google.Protobuf.WellKnownTypes.Struct"+as JSON @null@. We import it from "Proto.Google.Protobuf.Struct" (since that's where the codegen put it). -} nullValueToJSON :: NullValue -> Aeson.Value@@ -787,10 +788,10 @@ typeFromUrl t =   let prefix = T.pack "type.googleapis.com/"   in case T.stripPrefix prefix t of-      Just rest -> rest-      Nothing -> case T.breakOnEnd (T.pack "/") t of-        (_, suffix) | not (T.null suffix) -> suffix-        _ -> t+       Just rest -> rest+       Nothing -> case T.breakOnEnd (T.pack "/") t of+         (_, suffix) | not (T.null suffix) -> suffix+         _ -> t   {- | @google.protobuf.Any@ JSON shape:@@ -818,29 +819,29 @@               ]           )   in case lookupCodec ty registry of-      Just codec ->-        case acToJSON codec (Any.anyValue a) of-          Left _ -> fallback-          Right v-            | acIsWkt codec ->-                Aeson.Object-                  ( AesonKM.fromList-                      [ typeVal-                      , (AesonKey.fromText (T.pack "value"), v)-                      ]-                  )-            | Aeson.Object obj <- v ->-                Aeson.Object (AesonKM.insert typeKey (Aeson.String url) obj)-            | otherwise ->-                -- Codec for a non-WKT returned a non-object;-                -- shouldn't happen for our registered types, but-                -- we degrade gracefully by switching back to the-                -- "value": <encoded> form rather than crash.-                Aeson.Object-                  ( AesonKM.fromList-                      [typeVal, (AesonKey.fromText (T.pack "value"), v)]-                  )-      Nothing -> fallback+       Just codec ->+         case acToJSON codec (Any.anyValue a) of+           Left _ -> fallback+           Right v+             | acIsWkt codec ->+                 Aeson.Object+                   ( AesonKM.fromList+                       [ typeVal+                       , (AesonKey.fromText (T.pack "value"), v)+                       ]+                   )+             | Aeson.Object obj <- v ->+                 Aeson.Object (AesonKM.insert typeKey (Aeson.String url) obj)+             | otherwise ->+                 -- Codec for a non-WKT returned a non-object;+                 -- shouldn't happen for our registered types, but+                 -- we degrade gracefully by switching back to the+                 -- "value": <encoded> form rather than crash.+                 Aeson.Object+                   ( AesonKM.fromList+                       [typeVal, (AesonKey.fromText (T.pack "value"), v)]+                   )+       Nothing -> fallback   anyFromJSON :: TypeRegistry -> Aeson.Value -> Either String Any.Any@@ -866,8 +867,8 @@       | otherwise ->           let inner = Aeson.Object (AesonKM.delete typeKey o)           in do-              bs <- acFromJSON codec inner-              Right Any.defaultAny {Any.anyTypeUrl = url, Any.anyValue = bs}+               bs <- acFromJSON codec inner+               Right Any.defaultAny {Any.anyTypeUrl = url, Any.anyValue = bs}     Nothing -> do       -- Unregistered type: fall back to the degenerate       -- "value": base64 form. Tests like AnyWithFieldMask@@ -880,6 +881,26 @@         _ -> Left "Any: non-string value"       Right Any.defaultAny {Any.anyTypeUrl = url, Any.anyValue = bs} anyFromJSON _ _ = Left "Expected JSON Object for Any"+++{- | The 'TypeRegistry' generated code uses to (de)serialise @Any@-typed+fields: 'standardWktRegistry' unioned with the process-global registry+('Proto.Registry.globalAnyRegistry'), so applications can register their+own message types at runtime (via+'Proto.Registry.registerGlobalAnyCodecs') and have @Any@ values wrapping+them produce the canonical inlined @{"\@type": …, …}@ JSON instead of the+degenerate @{"value": <base64>}@ fallback.++This is a CAF: it is evaluated once, on first @Any@ (de)serialisation,+capturing the global registry as it stands at that moment. Register all+application types /before/ any @Any@ value crosses the wire (i.e. during+process startup). When nothing is registered it is exactly+'standardWktRegistry', so WKT-only users see no change.+-}+{-# NOINLINE anyJsonRegistry #-}+anyJsonRegistry :: TypeRegistry+anyJsonRegistry =+  standardWktRegistry <> unsafePerformIO (readIORef globalAnyRegistry)   {- | A pure 'TypeRegistry' containing all 17 standard well-known
+ src/Proto/Internal/Maybe.hs view
@@ -0,0 +1,67 @@+-- Copyright © 2016 Kyle McKean+-- Copyright © 2018 Daniel Cartwright+-- BSD-3-Clause license (see LICENSE for full text)+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE UnboxedTuples #-}++{- | Unpacked Maybe using unboxed sums for zero-allocation optionals.++Internal module — public API boundaries convert to standard Maybe.+Uses GHC's @UnboxedTuples@ extension so the Just\/Nothing distinction+lives on the stack, not the heap.+-}+module Proto.Internal.Maybe (+  Maybe (Maybe, Just, Nothing),+  maybe,+  isJust,+  isNothing,+  fromBaseMaybe,+  toBaseMaybe,+) where++import Data.Function (const)+import Data.Maybe qualified as BaseMaybe+import GHC.Base (Bool (False, True))+import Prelude ()+++data Maybe a = Maybe (# (# #) | a #)+++pattern Just :: a -> Maybe a+pattern Just a = Maybe (# | a #)+++pattern Nothing :: Maybe a+pattern Nothing = Maybe (# (# #) | #)+++{-# COMPLETE Just, Nothing #-}+++maybe :: b -> (a -> b) -> Maybe a -> b+maybe def f (Maybe x) = case x of+  (# (# #) | #) -> def+  (# | a #) -> f a+{-# INLINE maybe #-}+++isJust :: Maybe a -> Bool+isJust = maybe False (const True)+{-# INLINE isJust #-}+++isNothing :: Maybe a -> Bool+isNothing = maybe True (const False)+{-# INLINE isNothing #-}+++fromBaseMaybe :: BaseMaybe.Maybe a -> Maybe a+fromBaseMaybe (BaseMaybe.Just x) = Just x+fromBaseMaybe BaseMaybe.Nothing = Nothing+{-# INLINE fromBaseMaybe #-}+++toBaseMaybe :: Maybe a -> BaseMaybe.Maybe a+toBaseMaybe = maybe BaseMaybe.Nothing BaseMaybe.Just+{-# INLINE toBaseMaybe #-}
src/Proto/Internal/SizedBuilder.hs view
@@ -2,9 +2,6 @@  {- | Church-encoded sized builder: fuses size calculation with serialization. -__Stability:__ exposed for use by wireform-proto-generated code; not-part of the stable public API.- A 'SizedBuilder' carries both the computed byte size and the builder in a single value. This avoids the need for a separate size-computation pass when encoding submessages — the size is accumulated alongside@@ -110,7 +107,7 @@   let !payloadSize = sbSize sb       !lenPrefixBuilder = putVarint (fromIntegral payloadSize)   in SizedBuilder-      { sbSize = varintSize (fromIntegral payloadSize) + payloadSize-      , sbBuilder = lenPrefixBuilder <> sbBuilder sb-      }+       { sbSize = varintSize (fromIntegral payloadSize) + payloadSize+       , sbBuilder = lenPrefixBuilder <> sbBuilder sb+       } {-# INLINE withSubMessage #-}
src/Proto/Internal/Wire.hs view
@@ -2,11 +2,6 @@  The protobuf wire format uses a tag-length-value scheme where each field is preceded by a tag encoding the field number and wire type.--__Stability:__ this module is exposed so that code generated by-@protoc-gen-wireform@, 'Proto.TH', and 'Proto.Setup' can import it.-It is not part of the stable public API and may change between minor-versions. -} module Proto.Internal.Wire (   -- * Wire types
src/Proto/Internal/Wire/Decode.hs view
@@ -5,9 +5,6 @@  {- | Low-level, high-performance wire format decoding primitives. -__Stability:__ exposed for use by wireform-proto-generated code; not-part of the stable public API.- The decoder uses unboxed sums for the result type, avoiding heap allocation for intermediate decode results. Each decode operation returns @(# (# a, Int# #) | DecodeError #)@ — either a value with@@ -72,10 +69,6 @@   withTagM,   skipWireType, -  -- * In-order tag prediction (hyperpb-style fast path)-  inOrderStage,-  inOrderStage1,-   -- * Non-throwing UTF-8 validation   validateUtf8, ) where@@ -89,11 +82,11 @@ import Data.Int (Int32, Int64) import Data.Text (Text) import Data.Text.Encoding qualified as TE-import Data.Word (Word8, Word32, Word64)+import Data.Word (Word32, Word64) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr (Ptr, castPtr, plusPtr) import Foreign.Storable (peek)-import GHC.Exts (Int (I#), Int#, isTrue#, (+#), (-#), (<=#), (>=#), (>#))+import GHC.Exts (Int (I#), Int#, isTrue#, (+#), (>=#)) import GHC.Float (castWord32ToFloat, castWord64ToDouble) import Proto.Internal.Wire (Tag (..), WireType (..), decodeTag) import System.IO.Unsafe (unsafeDupablePerformIO)@@ -204,51 +197,51 @@ getVarint = Decoder $ \bs off ->   let len = bsLen bs   in if isTrue# (off >=# len)-      then (# | UnexpectedEnd #)-      else-        let !b0 = fromIntegral (BSU.unsafeIndex bs (I# off)) :: Word64-        in if b0 < 0x80-            then (# (# b0, off +# 1# #) | #)-            else-              let off1 = off +# 1#-              in if isTrue# (off1 >=# len)-                  then (# | UnexpectedEnd #)-                  else-                    let !b1 = fromIntegral (BSU.unsafeIndex bs (I# off1)) :: Word64-                    in if b1 < 0x80-                        then (# (# (b0 .&. 0x7F) .|. (b1 `shiftL` 7), off +# 2# #) | #)-                        else-                          let off2 = off +# 2#-                          in if isTrue# (off2 >=# len)-                              then (# | UnexpectedEnd #)-                              else-                                let !b2 = fromIntegral (BSU.unsafeIndex bs (I# off2)) :: Word64-                                in if b2 < 0x80-                                    then-                                      (#-                                        (#-                                          (b0 .&. 0x7F) .|. ((b1 .&. 0x7F) `shiftL` 7) .|. (b2 `shiftL` 14)-                                          , off +# 3#-                                        #) |-                                      #)-                                    else-                                      let off3 = off +# 3#-                                      in if isTrue# (off3 >=# len)-                                          then (# | UnexpectedEnd #)+       then (# | UnexpectedEnd #)+       else+         let !b0 = fromIntegral (BSU.unsafeIndex bs (I# off)) :: Word64+         in if b0 < 0x80+              then (# (# b0, off +# 1# #) | #)+              else+                let off1 = off +# 1#+                in if isTrue# (off1 >=# len)+                     then (# | UnexpectedEnd #)+                     else+                       let !b1 = fromIntegral (BSU.unsafeIndex bs (I# off1)) :: Word64+                       in if b1 < 0x80+                            then (# (# (b0 .&. 0x7F) .|. (b1 `shiftL` 7), off +# 2# #) | #)+                            else+                              let off2 = off +# 2#+                              in if isTrue# (off2 >=# len)+                                   then (# | UnexpectedEnd #)+                                   else+                                     let !b2 = fromIntegral (BSU.unsafeIndex bs (I# off2)) :: Word64+                                     in if b2 < 0x80+                                          then+                                            (#+                                              (#+                                                (b0 .&. 0x7F) .|. ((b1 .&. 0x7F) `shiftL` 7) .|. (b2 `shiftL` 14)+                                                , off +# 3#+                                              #) |+                                            #)                                           else-                                            let !b3 = fromIntegral (BSU.unsafeIndex bs (I# off3)) :: Word64-                                            in if b3 < 0x80-                                                then-                                                  (#-                                                    (#-                                                      (b0 .&. 0x7F)-                                                        .|. ((b1 .&. 0x7F) `shiftL` 7)-                                                        .|. ((b2 .&. 0x7F) `shiftL` 14)-                                                        .|. (b3 `shiftL` 21)-                                                      , off +# 4#-                                                    #) |-                                                  #)-                                                else getVarintSlow bs off+                                            let off3 = off +# 3#+                                            in if isTrue# (off3 >=# len)+                                                 then (# | UnexpectedEnd #)+                                                 else+                                                   let !b3 = fromIntegral (BSU.unsafeIndex bs (I# off3)) :: Word64+                                                   in if b3 < 0x80+                                                        then+                                                          (#+                                                            (#+                                                              (b0 .&. 0x7F)+                                                                .|. ((b1 .&. 0x7F) `shiftL` 7)+                                                                .|. ((b2 .&. 0x7F) `shiftL` 14)+                                                                .|. (b3 `shiftL` 21)+                                                              , off +# 4#+                                                            #) |+                                                          #)+                                                        else getVarintSlow bs off {-# INLINE getVarint #-}  @@ -264,8 +257,8 @@           let !b = BSU.unsafeIndex bs (I# pos)               !val = acc .|. ((fromIntegral b .&. 0x7F) `shiftL` shift)           in if b < 0x80-              then (# (# val, pos +# 1# #) | #)-              else go val (shift + 7) (pos +# 1#)+               then (# (# val, pos +# 1# #) | #)+               else go val (shift + 7) (pos +# 1#) {-# INLINE getVarintSlow #-}  @@ -361,17 +354,13 @@     (# (# lenW, off' #) | #) ->       let !len = fromIntegral lenW :: Int       in if len < 0-          then (# | NegativeLength #)-          else-            if I# off' + len > BS.length bs-              then (# | UnexpectedEnd #)-              else-                -- Build the slice as a single ByteString allocation by advancing-                -- the ForeignPtr directly. BSU.unsafeDrop + BSU.unsafeTake would-                -- allocate two intermediate ByteString headers; this allocates one.-                let !i = I# off'-                    !slice = case bs of BSI.BS fp _ -> BSI.BS (BSI.plusForeignPtr fp i) len-                in (# (# slice, case i + len of I# r -> r #) | #)+           then (# | NegativeLength #)+           else+             if I# off' + len > BS.length bs+               then (# | UnexpectedEnd #)+               else+                 let !i = I# off'+                 in (# (# BSU.unsafeTake len (BSU.unsafeDrop i bs), case i + len of I# r -> r #) | #)     (# | e #) -> (# | e #) {-# INLINE getLengthDelimited #-} @@ -392,12 +381,9 @@ getText = Decoder $ \bs off ->   case runDecoder# getLengthDelimited bs off of     (# (# bytes, off' #) | #) ->-      -- decodeUtf8Lenient avoids the runRW#/catch# wrapper that-      -- decodeUtf8' uses. For valid UTF-8 (required by proto3) this-      -- is semantically identical; invalid bytes get the U+FFFD-      -- replacement character rather than a DecodeError. The catch#-      -- overhead was measurable (~5–10 ns per string field).-      (# (# TE.decodeUtf8Lenient bytes, off' #) | #)+      case TE.decodeUtf8' bytes of+        Right t -> (# (# t, off' #) | #)+        Left _ -> (# | InvalidUtf8 #)     (# | e #) -> (# | e #) {-# INLINE getText #-} @@ -435,8 +421,8 @@       (# (# lenW, off' #) | #) ->         let !len = fromIntegral lenW :: Int         in if I# off' + len > BS.length bs-            then (# | UnexpectedEnd #)-            else (# (# (), case I# off' + len of I# r -> r #) | #)+             then (# | UnexpectedEnd #)+             else (# (# (), case I# off' + len of I# r -> r #) | #)       (# | e #) -> (# | e #)   WireStartGroup -> skipGroup   WireEndGroup -> pure ()@@ -547,8 +533,8 @@   let fn = fromIntegral (w `shiftR` 3) :: Int       wt = fromIntegral (w .&. 0x07) :: Int   in case fn of-      I# fn# -> case wt of-        I# wt# -> (# fn#, wt# #)+       I# fn# -> case wt of+         I# wt# -> (# fn#, wt# #) {-# INLINE decodeTagParts #-}  @@ -579,141 +565,6 @@ {-# INLINE withTagM #-}  -{- | One step of the hyperpb-style in-order tag predictor.--The wire format encodes each field tag-first as a varint, and-@protoc@-generated serialisers emit fields in field-number order, so-the next-tag-bytes at every position of a decode loop are-/predictable/ for well-formed input. Predicting them and-short-circuiting the varint-decode + wire-type-decode + case-dispatch-pipeline is what hyperpb calls its "tag stamp" / "predicted next-field" fast path.--'inOrderStage' implements one step of that predictor with the-generalised /multi-byte/ shape (i.e. it doesn't restrict to field-numbers ≤ 15):--* if at end of input, run @kEnd@ (typically @pure result@);-* if the next 1..5 bytes of input equal the field's-  precomputed varint-encoded tag, consume them, run the field's-  value decoder, and hand the value to @kHit@;-* otherwise, run @kMiss@ /without consuming any bytes/, handing-  control back to the generic 'withTagM'-based loop, which then-  re-reads the tag the normal way.--The expected tag is supplied as a 'Word64' packing of the-varint bytes in little-endian order (low byte = first byte on-the wire). @expectedTag@ and @tagMask@ are both precomputed by-the codegen as compile-time constants; the helper does a single-unaligned 'readWord64LE' (or a byte-by-byte fallback near the end-of the buffer where an 8-byte load would overrun), masks it,-and compares against @expectedTag@.--@INLINE@ is essential — each call site has constant-@(expectedTag, tagMask, tagLen)@, and inlining lets GHC specialise-the loads, masks, and value decoder into a few straight-line-instructions per stage.--}-inOrderStage-  :: Word64-  -- ^ Expected varint-encoded tag, with the @tagLen@ bytes packed-  --   little-endian into the low bits and zeros above. Codegen builds-  --   this with @foldr (\\(i, b) acc -> acc .|. (fromIntegral b \`shiftL\` (8*i))) 0 (zip [0..] bytes)@.-  -> Word64-  -- ^ Mask: @(1 \`shiftL\` (8 * tagLen)) - 1@. Used to ignore the-  --   bytes the 'readWord64LE' load picks up beyond the tag length.-  -> Int-  -- ^ Tag length in bytes (1..5 for any valid proto field number).-  -> Decoder v-  -- ^ Value decoder for the predicted field (runs after the tag-  --   bytes are consumed).-  -> (v -> Decoder a)-  -- ^ @kHit@: continuation with the decoded value.-  -> Decoder a-  -- ^ @kEnd@: continuation when input is exhausted (e.g.-  --   @pure result@).-  -> Decoder a-  -- ^ @kMiss@: fallback for any non-matching tag prefix (no input-  --   is consumed before this runs).-  -> Decoder a-inOrderStage !expectedTag !tagMask (I# tagLen#) !valueDecoder kHit kEnd kMiss =-  Decoder $ \bs off ->-    let !len = bsLen bs-    in if isTrue# (off >=# len)-        then runDecoder# kEnd bs off-        else-          if isTrue# ((off +# tagLen#) ># len)-            then-              -- Not enough bytes left for even the tag — punt to-              -- the general loop. (It will surface UnexpectedEnd if-              -- the truncated input is genuinely malformed.)-              runDecoder# kMiss bs off-            else-              let !w =-                    if isTrue# ((off +# 8#) <=# len)-                      then readWord64LE bs (I# off) .&. tagMask-                      -- We've already verified off + tagLen <= len above, so-                      -- reading exactly tagLen bytes is safe. Reading all-                      -- remaining bytes (len - off) was wasteful for short-                      -- messages where len - off >> tagLen.-                      else readPartialWord64LE bs (I# off) (I# tagLen#) .&. tagMask-              in if w == expectedTag-                  then case runDecoder# valueDecoder bs (off +# tagLen#) of-                    (# (# v, off' #) | #) -> runDecoder# (kHit v) bs off'-                    (# | e #) -> (# | e #)-                  else runDecoder# kMiss bs off-{-# INLINE inOrderStage #-}---{- | Specialised 'inOrderStage' for 1-byte tags (field numbers 1–15,-wire types 0–5). Replaces the Word64 load+mask with a single byte-comparison, which is measurably faster for short messages where the-full 8-byte unaligned load path is unavailable.--The codegen emits this variant when @tagLen == 1@.--}-inOrderStage1-  :: Word8-  -- ^ Expected single-byte tag (@fieldNum \`shiftL\` 3 .|. wireType@).-  -> Decoder v-  -> (v -> Decoder a)-  -> Decoder a -- ^ kEnd-  -> Decoder a -- ^ kMiss-  -> Decoder a-inOrderStage1 !expectedByte !valueDecoder kHit kEnd kMiss =-  Decoder $ \bs off ->-    let !len = bsLen bs-    in if isTrue# (off >=# len)-        then runDecoder# kEnd bs off-        else-          if BSU.unsafeIndex bs (I# off) == expectedByte-            then case runDecoder# valueDecoder bs (off +# 1#) of-              (# (# v, off' #) | #) -> runDecoder# (kHit v) bs off'-              (# | e #) -> (# | e #)-            else runDecoder# kMiss bs off-{-# INLINE inOrderStage1 #-}---{- | Read up to @n@ (1..7) bytes starting at @off@, packing them-little-endian into a 'Word64' with zeros above. Used by 'inOrderStage'-when the buffer doesn't have a full 8 bytes left for an unaligned-'readWord64LE' load.--Not exported — only called when the caller has verified that-@off + n <= length bs@.--}-readPartialWord64LE :: ByteString -> Int -> Int -> Word64-readPartialWord64LE bs off n = go 0 0-  where-    go :: Int -> Word64 -> Word64-    go !i !acc-      | i >= n = acc-      | otherwise =-          let !b = fromIntegral (BSU.unsafeIndex bs (off + i)) :: Word64-          in go (i + 1) (acc .|. (b `shiftL` (8 * i)))-{-# INLINE readPartialWord64LE #-}-- -- | Skip a field given its wire type as an 'Int' (for use with 'withTagM'). skipWireType :: Int -> Decoder () skipWireType wt = case wt of@@ -724,8 +575,8 @@       (# (# lenW, off' #) | #) ->         let !len = fromIntegral lenW :: Int         in if I# off' + len > BS.length bs-            then (# | UnexpectedEnd #)-            else (# (# (), case I# off' + len of I# r -> r #) | #)+             then (# | UnexpectedEnd #)+             else (# (# (), case I# off' + len of I# r -> r #) | #)       (# | e #) -> (# | e #)   5 -> skip 4   _ -> Decoder $ \_ _ -> (# | InvalidWireType wt #)
src/Proto/Internal/Wire/Encode.hs view
@@ -3,9 +3,6 @@  {- | Low-level, high-performance wire format encoding primitives. -__Stability:__ exposed for use by wireform-proto-generated code; not-part of the stable public API.- All encoding is done via 'Wireform.Builder' for zero-copy concatenation and efficient output. Varint encoding is unrolled for common small values.
+ src/Proto/JSONSchema.hs view
@@ -0,0 +1,587 @@+{-# LANGUAGE OverloadedStrings #-}++{- | Proto → JSON Schema (draft 2020-12, the dialect OpenAPI 3.1 embeds).++This is the /transport-agnostic/ half of schema-derived doc generation: it+turns a parsed '.proto' schema into the @#\/components\/schemas@ objects an+OpenAPI (or bare JSON Schema) document references. It knows nothing about+HTTP, Connect, gRPC, paths, or content-types — a gRPC-Web or Twirp OpenAPI+emitter would reuse it verbatim. The Connect-specific HTTP shaping lives in+@Network.Connect.OpenAPI@ (in @wireform-connect@).++== Fidelity contract++OpenAPI describes the /JSON codec/, not the protobuf wire format, so every+schema here must match the bytes the proto3-canonical-JSON codec actually+emits (see "Proto.Internal.JSON" / "Proto.Internal.JSON.WellKnown"). The+load-bearing consequences:++* Property names are the proto3 JSON names — 'protoJsonName' (lowerCamelCase,+  the exact function the codegen uses), overridden by an explicit+  @[json_name = "..."]@ field option.+* 64-bit integers (@int64@\/@uint64@\/@fixed64@\/@sfixed64@\/@sint64@) are+  __strings__, not numbers (JS precision), matching the codec.+* @bytes@ is a base64 string (@format: byte@).+* Well-known types are __inlined__ at their reference sites with their+  canonical JSON shape (@Timestamp@→date-time string, @Duration@→string,+  @Struct@→object, @Value@→any, wrappers→their bare inner value, …) rather+  than emitted as components.+* Enums render as a string @enum@ of value names (the canonical JSON form).+* @oneof@ members flatten into the enclosing object as optional properties+  (how the codec serialises them); proto3 has no JSON-required fields, so no+  @required@ list is emitted.+-}+module Proto.JSONSchema (+  -- * Building the type environment+  SchemaEnv,+  buildSchemaEnv,++  -- * Emitting schemas+  componentSchemas,+  componentSchemasWith,+  messageSchemaFor,+  messageSchemaForWith,+  enumSchemaFor,+  fieldTypeSchema,++  -- * External annotation (composable — 'SchemaOptions' is a 'Monoid')+  SchemaOptions (..),+  defaultSchemaOptions,+  FieldConstraints (..),+  fieldConstraints,+  jsonNameOf,++  -- * Built-in annotators+  deprecationSchemaOptions,++  -- * Name resolution+  resolveTypeFqn,+  refForFqn,++  -- * Well-known types+  wellKnownSchema,+  isWellKnown,+) where++import Data.Aeson (Value (..), object, (.=))+import Data.Aeson.Types (Pair)+import Data.Aeson.Key qualified as AKey+import Data.Aeson.KeyMap qualified as AKM+import Data.List (tails)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe, mapMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Vector qualified as V+import Proto.CodeGen (protoJsonName)+import Proto.IDL.AST+import Proto.IDL.Annotations (lookupSimpleOption, optionAsString)+import Proto.IDL.Options (isDeprecated)+++-- ---------------------------------------------------------------------------+-- Type environment+-- ---------------------------------------------------------------------------++{- | A resolved-name environment: every message and enum reachable from the+target file(s), keyed by fully-qualified proto name (@pkg.Outer.Inner@),+carrying the scope needed to resolve /relative/ type references that appear+inside it.+-}+newtype SchemaEnv = SchemaEnv {seTypes :: Map Text TypeEntry}+++data TypeEntry+  = -- | message def + package + scope-including-own-name+    TEMessage MessageDef Text [Text]+  | -- | enum def + package + scope-including-own-name+    TEEnum EnumDef Text [Text]+++{- | Build a 'SchemaEnv' from a set of parsed proto files (typically the+target file plus its transitive imports, flattened). Nested messages and+enums are recorded under their own fully-qualified names.+-}+buildSchemaEnv :: [ProtoFile] -> SchemaEnv+buildSchemaEnv files =+  SchemaEnv (Map.unions (fmap fileTypes files))+  where+    fileTypes pf =+      let pkg = fromMaybe "" (protoPackage pf)+      in Map.unions (fmap (topLevelTypes pkg []) (protoTopLevels pf))+++topLevelTypes :: Text -> [Text] -> TopLevel -> Map Text TypeEntry+topLevelTypes pkg scope = \case+  TLMessage m -> messageTypes pkg scope m+  TLEnum e -> enumTypes pkg scope e+  _ -> Map.empty+++messageTypes :: Text -> [Text] -> MessageDef -> Map Text TypeEntry+messageTypes pkg scope m =+  let scope' = scope <> [msgName m]+      fqn = qualify pkg scope'+      nested = Map.unions (fmap (elementTypes pkg scope') (msgElements m))+  in Map.insert fqn (TEMessage m pkg scope') nested+++elementTypes :: Text -> [Text] -> MessageElement -> Map Text TypeEntry+elementTypes pkg scope = \case+  MEMessage inner -> messageTypes pkg scope inner+  MEEnum e -> enumTypes pkg scope e+  _ -> Map.empty+++enumTypes :: Text -> [Text] -> EnumDef -> Map Text TypeEntry+enumTypes pkg scope e =+  let scope' = scope <> [enumName e]+  in Map.singleton (qualify pkg scope') (TEEnum e pkg scope')+++qualify :: Text -> [Text] -> Text+qualify pkg scope+  | T.null pkg = T.intercalate "." scope+  | otherwise = pkg <> "." <> T.intercalate "." scope+++-- ---------------------------------------------------------------------------+-- Name resolution (mirrors Proto.CodeGen.resolveTypeWithScope)+-- ---------------------------------------------------------------------------++{- | Resolve a (possibly relative) proto type name to a fully-qualified name,+given the package and enclosing scope of the reference site. Tries a+fully-qualified match, then package-prefixed, then each enclosing-scope+prefix, then a unique dotted-suffix match — the same candidate order the+Haskell codegen uses.+-}+resolveTypeFqn :: SchemaEnv -> Text -> [Text] -> Text -> Maybe Text+resolveTypeFqn env pkg scope name =+  let reg = seTypes env+      scopedCandidates =+        fmap (\s -> pkg <> "." <> T.intercalate "." s <> "." <> name) (nonEmptyTails scope)+      candidates = name : (pkg <> "." <> name) : scopedCandidates+  in case firstMember reg candidates of+       Just fqn -> Just fqn+       Nothing ->+         let suffix = "." <> name+             matches = filter (\k -> k == name || suffix `T.isSuffixOf` k) (Map.keys reg)+         in case matches of+              (fqn : _) -> Just fqn+              [] -> Nothing+  where+    nonEmptyTails xs = filter (not . null) (tails xs)+    firstMember _ [] = Nothing+    firstMember reg (c : cs)+      | Map.member c reg = Just c+      | otherwise = firstMember reg cs+++-- | A @$ref@ to a named component schema by fully-qualified proto name.+refForFqn :: Text -> Value+refForFqn fqn = object ["$ref" .= ("#/components/schemas/" <> fqn)]+++-- ---------------------------------------------------------------------------+-- Component emission+-- ---------------------------------------------------------------------------++{- | The @#\/components\/schemas@ map: one entry per user-defined (non+well-known) message and enum in the environment, keyed by fully-qualified+proto name. Well-known types are inlined at reference sites, so they never+appear here.+-}+componentSchemas :: SchemaEnv -> [(Text, Value)]+componentSchemas = componentSchemasWith defaultSchemaOptions+++-- | Like 'componentSchemas' but merges external per-field / per-message+-- annotations (e.g. protovalidate rules → JSON Schema validation keywords).+componentSchemasWith :: SchemaOptions -> SchemaEnv -> [(Text, Value)]+componentSchemasWith opts env =+  mapMaybe component (Map.toList (seTypes env))+  where+    component (fqn, entry)+      | isWellKnown fqn = Nothing+      | otherwise = Just (fqn, schemaForEntry opts env fqn entry)++-- | How an external annotator contributes to a field's schema: extra JSON+-- Schema keywords merged into the field's schema object, and whether the field+-- is required (added to the message's @required@ list).+data FieldConstraints = FieldConstraints+  { fcKeywords :: ![Pair]+  -- ^ JSON Schema keywords to merge into the field schema (e.g. @minLength@).+  , fcRequired :: !Bool+  -- ^ Whether the field is required (contributes to the object's @required@).+  }+  deriving stock (Show)+++-- | Combine two field contributions: concatenate keywords (left wins on key+-- clash at merge time), OR the required flags.+instance Semigroup FieldConstraints where+  FieldConstraints k1 r1 <> FieldConstraints k2 r2 = FieldConstraints (k1 <> k2) (r1 || r2)+++instance Monoid FieldConstraints where+  mempty = FieldConstraints [] False+++-- | Smart constructor for a field contribution.+fieldConstraints :: [Pair] -> Bool -> FieldConstraints+fieldConstraints = FieldConstraints+++{- | Hooks for enriching the emitted schema with information the proto AST alone+doesn't carry (protovalidate rules, deprecation, arbitrary @x-@ extensions).+All are keyed by the fully-qualified type name; the field hook additionally by+the /proto/ field name (not the JSON name).++'SchemaOptions' is a 'Monoid': compose independent annotators with @<>@ (field+contributions combine via 'FieldConstraints'' 'Semigroup'; message / enum+keyword lists concatenate). 'mempty' / 'defaultSchemaOptions' is the no-op that+leaves the base walk untouched.+-}+data SchemaOptions = SchemaOptions+  { soFieldAnnotator :: Text -> Text -> Maybe FieldConstraints+  -- ^ @messageFqn -> protoFieldName -> constraints@.+  , soMessageAnnotator :: Text -> [Pair]+  -- ^ @messageFqn -> extra message-level keywords@ (e.g. @x-cel@).+  , soEnumAnnotator :: Text -> [Pair]+  -- ^ @enumFqn -> extra enum-level keywords@ (e.g. @deprecated@).+  }+++instance Semigroup SchemaOptions where+  a <> b =+    SchemaOptions+      { soFieldAnnotator = \fqn fld -> soFieldAnnotator a fqn fld <> soFieldAnnotator b fqn fld+      , soMessageAnnotator = \fqn -> soMessageAnnotator a fqn <> soMessageAnnotator b fqn+      , soEnumAnnotator = \fqn -> soEnumAnnotator a fqn <> soEnumAnnotator b fqn+      }+++instance Monoid SchemaOptions where+  mempty = SchemaOptions (\_ _ -> Nothing) (const []) (const [])+++-- | No external annotations (@= 'mempty'@).+defaultSchemaOptions :: SchemaOptions+defaultSchemaOptions = mempty+++{- | A built-in annotator that carries the standard proto @deprecated@ option+through as OpenAPI\/JSON-Schema @deprecated: true@, on messages, fields, and+enums. Pass the same files used to build the 'SchemaEnv'. Compose it with+others (e.g. protovalidate) via @<>@:++> deprecationSchemaOptions files <> protovalidateSchemaOptions rules+-}+deprecationSchemaOptions :: [ProtoFile] -> SchemaOptions+deprecationSchemaOptions files =+  mempty+    { soFieldAnnotator = \fqn fld ->+        if Set.member (fqn, fld) depFields+          then Just (fieldConstraints ["deprecated" .= True] False)+          else Nothing+    , soMessageAnnotator = \fqn -> if Set.member fqn depMsgs then ["deprecated" .= True] else []+    , soEnumAnnotator = \fqn -> if Set.member fqn depEnums then ["deprecated" .= True] else []+    }+  where+    (depMsgs, depFields, depEnums) = collectDeprecated files+++-- | Collect the FQNs of deprecated messages / enums and @(msgFqn, fieldName)@+-- of deprecated fields, walking nested types (same scoping as 'buildSchemaEnv').+collectDeprecated :: [ProtoFile] -> (Set Text, Set (Text, Text), Set Text)+collectDeprecated files =+  mconcat (fmap fileDep files)+  where+    fileDep pf = foldMap (topDep (fromMaybe "" (protoPackage pf)) []) (protoTopLevels pf)+    topDep pkg scope = \case+      TLMessage m -> msgDep pkg scope m+      TLEnum e -> enumDep pkg scope e+      _ -> mempty+    msgDep pkg scope m =+      let scope' = scope <> [msgName m]+          fqn = qualify pkg scope'+          msgs = if any msgOptionDeprecated (msgElements m) then Set.singleton fqn else Set.empty+          flds = Set.fromList (fmap ((,) fqn) (deprecatedFieldNames m))+          nested = foldMap (elemDep pkg scope') (msgElements m)+      in (msgs, flds, Set.empty) <> nested+    elemDep pkg scope = \case+      MEMessage inner -> msgDep pkg scope inner+      MEEnum e -> enumDep pkg scope e+      _ -> mempty+    enumDep pkg scope e =+      let fqn = qualify pkg (scope <> [enumName e])+      in (Set.empty, Set.empty, if isDeprecated (enumOptions e) then Set.singleton fqn else Set.empty)+++msgOptionDeprecated :: MessageElement -> Bool+msgOptionDeprecated (MEOption o) = isDeprecated [o]+msgOptionDeprecated _ = False+++-- | The /proto/ names of a message's deprecated fields (regular, map, oneof).+deprecatedFieldNames :: MessageDef -> [Text]+deprecatedFieldNames m = concatMap go (msgElements m)+  where+    go = \case+      MEField fd -> keepIf (isDeprecated (fieldOptions fd)) (fieldName fd)+      MEMapField mf -> keepIf (isDeprecated (mapOptions mf)) (mapFieldName mf)+      MEOneof od -> mapMaybe oneofDep (oneofFields od)+      _ -> []+    keepIf cond nm = if cond then [nm] else []+    oneofDep f = if isDeprecated (oneofFieldOptions f) then Just (oneofFieldName f) else Nothing+++schemaForEntry :: SchemaOptions -> SchemaEnv -> Text -> TypeEntry -> Value+schemaForEntry opts env fqn = \case+  TEMessage m pkg scope -> messageSchema opts env fqn pkg scope m+  TEEnum e _ _ -> enumSchema opts fqn e++++-- | Build the object schema for a message, given its resolution scope.+messageSchemaFor :: SchemaEnv -> Text -> [Text] -> MessageDef -> Value+messageSchemaFor env pkg scope m =+  messageSchema defaultSchemaOptions env (qualify pkg scope) pkg scope m+++-- | 'messageSchemaFor' with external annotations.+messageSchemaForWith :: SchemaOptions -> SchemaEnv -> Text -> [Text] -> MessageDef -> Value+messageSchemaForWith opts env pkg scope m =+  messageSchema opts env (qualify pkg scope) pkg scope m+++messageSchema :: SchemaOptions -> SchemaEnv -> Text -> Text -> [Text] -> MessageDef -> Value+messageSchema opts env fqn pkg scope m =+  withDescription (msgDoc m) $+    Object (AKM.fromList (base <> requiredKw <> soMessageAnnotator opts fqn))+  where+    emits = concatMap (fieldEmits opts env fqn pkg scope) (msgElements m)+    base =+      [ ("type", String "object")+      , ("properties", Object (AKM.fromList (fmap (\(k, v, _) -> (k, v)) emits)))+      ]+    reqNames = mapMaybe (\(k, _, req) -> if req then Just (String (AKey.toText k)) else Nothing) emits+    requiredKw = if null reqNames then [] else [("required", Array (V.fromList reqNames))]+++{- | Emit the @(jsonKey, schema, required)@ triples contributed by one message+element, applying any external field annotations.+-}+fieldEmits :: SchemaOptions -> SchemaEnv -> Text -> Text -> [Text] -> MessageElement -> [(AKey.Key, Value, Bool)]+fieldEmits opts env fqn pkg scope = \case+  MEField fd ->+    [annotated (fieldName fd) (jsonKey (fieldName fd) (fieldOptions fd)) (fieldSchema env pkg scope fd)]+  MEMapField mf ->+    [annotated (mapFieldName mf) (jsonKey (mapFieldName mf) (mapOptions mf)) (mapSchema env pkg scope mf)]+  MEOneof od ->+    -- oneof members flatten into the enclosing object (codec serialises the+    -- set member as an ordinary field); at most one is present at a time.+    fmap oneofEmit (oneofFields od)+  _ -> []+  where+    oneofEmit f =+      annotated+        (oneofFieldName f)+        (jsonKey (oneofFieldName f) (oneofFieldOptions f))+        (withDescription (oneofFieldDoc f) (fieldTypeSchema env pkg scope (oneofFieldType f)))+    annotated protoName key base = case soFieldAnnotator opts fqn protoName of+      Nothing -> (key, base, False)+      Just fc -> (key, mergeKeywords base (fcKeywords fc), fcRequired fc)+++-- | Merge extra keywords into a schema object (no-op if the schema isn't an+-- object or the keyword list is empty; existing keys win).+mergeKeywords :: Value -> [Pair] -> Value+mergeKeywords v [] = v+mergeKeywords (Object o) kws = Object (AKM.union o (AKM.fromList kws))+mergeKeywords v _ = v+++-- | The proto3 JSON property name for a field (honouring @json_name@).+jsonKey :: Text -> [OptionDef] -> AKey.Key+jsonKey nm opts = AKey.fromText (jsonNameOf nm opts)+++-- | The proto3 JSON name for a field name + its options (honouring @json_name@).+jsonNameOf :: Text -> [OptionDef] -> Text+jsonNameOf nm opts =+  fromMaybe (protoJsonName nm) (lookupSimpleOption "json_name" opts >>= optionAsString)+++-- | Schema for a single (non-map) field, applying the repeated wrapper.+fieldSchema :: SchemaEnv -> Text -> [Text] -> FieldDef -> Value+fieldSchema env pkg scope fd =+  withDescription (fieldDoc fd) $+    case fieldLabel fd of+      Just Repeated -> object ["type" .= ("array" :: Text), "items" .= base]+      _ -> base+  where+    base = fieldTypeSchema env pkg scope (fieldType fd)+++-- | @map\<K,V\>@ → a JSON object with string keys and @additionalProperties@+-- describing the value type. (proto3 JSON always stringifies map keys.)+mapSchema :: SchemaEnv -> Text -> [Text] -> MapField -> Value+mapSchema env pkg scope mf =+  withDescription (mapDoc mf) $+    object+      [ "type" .= ("object" :: Text)+      , "additionalProperties" .= fieldTypeSchema env pkg scope (mapValueType mf)+      ]+++-- | Schema for a field's declared type: a scalar, an inlined WKT, or a+-- @$ref@ to a named component.+fieldTypeSchema :: SchemaEnv -> Text -> [Text] -> FieldType -> Value+fieldTypeSchema env pkg scope = \case+  FTScalar s -> scalarSchema s+  FTNamed nm ->+    -- Well-known types inline by name, whether or not their .proto was parsed+    -- into the environment (they are recognised by fully-qualified name).+    case wellKnownSchema (stripLeadingDot nm) of+      Just wkt -> wkt+      Nothing -> case resolveTypeFqn env pkg scope nm of+        Just fqn -> case wellKnownSchema fqn of+          Just wkt -> wkt+          Nothing -> refForFqn fqn+        Nothing ->+          -- Unresolved (e.g. a type from a not-supplied import): emit a+          -- permissive, clearly-labelled schema rather than crash.+          object ["description" .= ("unresolved type: " <> nm)]+++-- | Enum schema without external annotations.+enumSchemaFor :: EnumDef -> Value+enumSchemaFor = enumSchema defaultSchemaOptions ""+++{- | Proto3 JSON renders enums as their value /name/ (a string); it also+accepts the integer form on input, but the canonical output is the name, so+the schema is a string @enum@ of the declared value names. External+enum-level keywords (from 'soEnumAnnotator', keyed by @fqn@) are merged in.+-}+enumSchema :: SchemaOptions -> Text -> EnumDef -> Value+enumSchema opts fqn e =+  withDescription (enumDoc e) $+    Object+      ( AKM.fromList+          ( [ ("type", String "string")+            , ("enum", Array (V.fromList (fmap (String . evName) (enumValues e))))+            ]+              <> soEnumAnnotator opts fqn+          )+      )+++-- ---------------------------------------------------------------------------+-- Scalars+-- ---------------------------------------------------------------------------++{- | proto3-canonical-JSON scalar schemas. The 64-bit integer types map to+__strings__ (JS number precision), and @bytes@ to a base64 string, matching+what the codec emits. 32-bit ints stay JSON numbers.+-}+scalarSchema :: ScalarType -> Value+scalarSchema = \case+  SDouble -> numberWith "double"+  SFloat -> numberWith "float"+  SInt32 -> integerWith "int32" False+  SSInt32 -> integerWith "int32" False+  SSFixed32 -> integerWith "int32" False+  SUInt32 -> integerWith "int64" True+  SFixed32 -> integerWith "int64" True+  SInt64 -> stringWith "int64"+  SSInt64 -> stringWith "int64"+  SSFixed64 -> stringWith "int64"+  SUInt64 -> stringWith "uint64"+  SFixed64 -> stringWith "uint64"+  SBool -> object ["type" .= ("boolean" :: Text)]+  SString -> object ["type" .= ("string" :: Text)]+  SBytes -> object ["type" .= ("string" :: Text), "format" .= ("byte" :: Text)]+  where+    numberWith fmt = object ["type" .= ("number" :: Text), "format" .= (fmt :: Text)]+    stringWith fmt = object ["type" .= ("string" :: Text), "format" .= (fmt :: Text)]+    integerWith fmt unsigned =+      object $+        ["type" .= ("integer" :: Text), "format" .= (fmt :: Text)]+          <> (if unsigned then ["minimum" .= (0 :: Int)] else [])+++-- ---------------------------------------------------------------------------+-- Well-known types (inlined at reference sites)+-- ---------------------------------------------------------------------------++-- | Is this fully-qualified name a protobuf well-known type?+isWellKnown :: Text -> Bool+isWellKnown fqn = fqn `Map.member` wellKnownTable+++{- | The canonical proto3-JSON schema for a well-known type, or 'Nothing' if+the name is a user type. These are __inlined__ wherever referenced (rather+than emitted as components) because their JSON shape is not their message+structure.+-}+wellKnownSchema :: Text -> Maybe Value+wellKnownSchema fqn = Map.lookup fqn wellKnownTable+++wellKnownTable :: Map Text Value+wellKnownTable =+  Map.fromList+    [ ("google.protobuf.Timestamp", str "date-time")+    , ("google.protobuf.Duration", strDesc "A duration string, e.g. \"3.5s\".")+    , ("google.protobuf.FieldMask", strDesc "Comma-separated lowerCamelCase field paths.")+    , ("google.protobuf.Struct", object ["type" .= ("object" :: Text)])+    , ("google.protobuf.Value", object [])+    , ("google.protobuf.ListValue", object ["type" .= ("array" :: Text), "items" .= object []])+    , ("google.protobuf.NullValue", object ["type" .= ("null" :: Text)])+    , ("google.protobuf.Empty", object ["type" .= ("object" :: Text)])+    , ("google.protobuf.Any", anySchema)+    , ("google.protobuf.BoolValue", object ["type" .= ("boolean" :: Text)])+    , ("google.protobuf.Int32Value", scalarSchema SInt32)+    , ("google.protobuf.UInt32Value", scalarSchema SUInt32)+    , ("google.protobuf.Int64Value", scalarSchema SInt64)+    , ("google.protobuf.UInt64Value", scalarSchema SUInt64)+    , ("google.protobuf.FloatValue", scalarSchema SFloat)+    , ("google.protobuf.DoubleValue", scalarSchema SDouble)+    , ("google.protobuf.StringValue", object ["type" .= ("string" :: Text)])+    , ("google.protobuf.BytesValue", scalarSchema SBytes)+    ]+  where+    str fmt = object ["type" .= ("string" :: Text), "format" .= (fmt :: Text)]+    strDesc d = object ["type" .= ("string" :: Text), "description" .= (d :: Text)]+++anySchema :: Value+anySchema =+  object+    [ "type" .= ("object" :: Text)+    , "properties" .= object ["@type" .= object ["type" .= ("string" :: Text)]]+    , "additionalProperties" .= True+    ]+++-- ---------------------------------------------------------------------------+-- Helpers+-- ---------------------------------------------------------------------------+++-- | Drop a single leading @.@ from a fully-qualified proto name (@.pkg.Msg@).+stripLeadingDot :: Text -> Text+stripLeadingDot t = fromMaybe t (T.stripPrefix "." t)+++-- | Attach a @description@ to an object schema when the proto doc-comment is+-- present (and non-empty). No-op for non-object schemas.+withDescription :: Maybe Text -> Value -> Value+withDescription mdoc v = case (fmap T.strip mdoc, v) of+  (Just d, Object o) | not (T.null d) -> Object (AKM.insert "description" (String d) o)+  _ -> v
src/Proto/Lens.hs view
@@ -1,118 +1,143 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}--- | Optional van Laarhoven lenses for protobuf message fields.------ These lenses are __not__ the primary interface — plain record access--- and 'Proto.Schema.HasField' get\/set are the default. Import this--- module only when you want to use lens combinators.------ The lenses are compatible with both @lens@ and @microlens@ since they--- use the van Laarhoven encoding directly (no dependency on either package).------ @--- import Proto.Lens (field)------ -- Get a field:--- view (field \@\"seconds\") timestamp------ -- Set a field:--- set (field \@\"seconds\") 42 timestamp------ -- Modify:--- over (field \@\"seconds\") (+1) timestamp------ -- Compose:--- view (field \@\"inner\" . field \@\"name\") nested--- @------ The 'field' function produces a 'Lens'' that works with any lens library.-module Proto.Lens-  ( -- * Generic field lens-    field -    -- * Van Laarhoven lens type (no dependency on lens/microlens)-  , Lens'-  , Getting-  , ASetter+{- | Optional van Laarhoven lenses for protobuf message fields. -    -- * Operators (standalone, no lens dependency needed)-  , view-  , set-  , over-  , (^.)-  , (.~)-  , (%~)-  , (&)-  ) where+These lenses are __not__ the primary interface — plain record access+and 'Proto.Schema.HasField' get\/set are the default. Import this+module only when you want to use lens combinators. -import Data.Functor.Const (Const(..))-import Data.Functor.Identity (Identity(..))-import Proto.Schema (HasField(..))+The lenses are compatible with both @lens@ and @microlens@ since they+use the van Laarhoven encoding directly (no dependency on either package). --- | A van Laarhoven lens. Compatible with @lens@, @microlens@, @optics@--- (via adapter), and any library that understands @Functor f => (a -> f a) -> s -> f s@.+@+import Proto.Lens (field)++-- Get a field:+view (field \@\"seconds\") timestamp++-- Set a field:+set (field \@\"seconds\") 42 timestamp++-- Modify:+over (field \@\"seconds\") (+1) timestamp++-- Compose:+view (field \@\"inner\" . field \@\"name\") nested+@++The 'field' function produces a 'Lens'' that works with any lens library.+-}+module Proto.Lens (+  -- * Generic field lens+  field,++  -- * Van Laarhoven lens type (no dependency on lens/microlens)+  Lens',+  Getting,+  ASetter,++  -- * Operators (standalone, no lens dependency needed)+  view,+  set,+  over,+  (^.),+  (.~),+  (%~),+  (&),+) where++import Data.Functor.Const (Const (..))+import Data.Functor.Identity (Identity (..))+import Proto.Schema (HasField (..))+++{- | A van Laarhoven lens. Compatible with @lens@, @microlens@, @optics@+(via adapter), and any library that understands @Functor f => (a -> f a) -> s -> f s@.+-} type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s + -- | A getter (read-only lens). type Getting r s a = (a -> Const r a) -> s -> Const r s + -- | A setter. type ASetter s a = (a -> Identity a) -> s -> Identity s --- | Produce a lens for a proto field, identified by its type-level name.------ @--- field \@\"seconds\" :: Lens' Timestamp Int64--- field \@\"name\"    :: Lens' Person Text--- @------ This works for any message type that has a 'HasField' instance for the--- given field name (i.e., all generated message types).++{- | Produce a lens for a proto field, identified by its type-level name.++@+field \@\"seconds\" :: Lens' Timestamp Int64+field \@\"name\"    :: Lens' Person Text+@++This works for any message type that has a 'HasField' instance for the+given field name (i.e., all generated message types).+-} field :: forall name msg a f. (HasField msg name a, Functor f) => (a -> f a) -> msg -> f msg field k msg = fmap (\a' -> setField @msg @name a' msg) (k (getField @msg @name msg)) {-# INLINE field #-} --- | Extract the field value through a getter.------ @view (field \@\"seconds\") ts == getField \@Timestamp \@\"seconds\" ts@++{- | Extract the field value through a getter.++@view (field \@\"seconds\") ts == getField \@Timestamp \@\"seconds\" ts@+-} view :: Getting a s a -> s -> a view l s = getConst (l Const s) {-# INLINE view #-} + -- | Set a field to a specific value. set :: ASetter s a -> a -> s -> s set l a s = runIdentity (l (const (Identity a)) s) {-# INLINE set #-} + -- | Modify a field with a function. over :: ASetter s a -> (a -> a) -> s -> s over l f s = runIdentity (l (Identity . f) s) {-# INLINE over #-} + -- | Infix view. (^.) :: s -> Getting a s a -> a s ^. l = view l s {-# INLINE (^.) #-}++ infixl 8 ^. + -- | Infix set. (.~) :: ASetter s a -> a -> s -> s l .~ a = set l a {-# INLINE (.~) #-}++ infixr 4 .~ + -- | Infix over (modify). (%~) :: ASetter s a -> (a -> a) -> s -> s l %~ f = over l f {-# INLINE (%~) #-}++ infixr 4 %~ --- | Reverse application (flip ($)), for chaining setters.--- Re-exported for convenience; equivalent to Data.Function.(&).++{- | Reverse application (flip ($)), for chaining setters.+Re-exported for convenience; equivalent to Data.Function.(&).+-} (&) :: a -> (a -> b) -> b x & f = f x {-# INLINE (&) #-}++ infixl 1 &
src/Proto/Registry.hs view
@@ -9,17 +9,21 @@ and JSON codecs. It is passed explicitly rather than stored in global mutable state. -'IsMessage' is a marker class; it has no methods of its own. Its job is+== The 'IsMessage' marker++'IsMessage' is a marker class — it has no methods of its own. Its job is to bundle together every typeclass a message needs in order to be 'register'ed into a 'TypeRegistry': -* 'MessageEncode' \/ 'MessageDecode' provide the wire codec.-* 'ProtoMessage' provides the FQN, package, and schema metadata.-* 'Aeson.ToJSON' \/ 'Aeson.FromJSON' provide the JSON codec.-* 'Typeable' gives us runtime type identity for 'lookupDecoder' downcasting.+* 'MessageEncode' \/ 'MessageDecode' — wire codec.+* 'ProtoMessage' — the FQN, package, and schema metadata.+* 'Aeson.ToJSON' \/ 'Aeson.FromJSON' — JSON codec (proto3 canonical).+* 'Typeable' — runtime type identity for 'lookupDecoder' downcasting.  Generated message types ship with an empty @instance IsMessage Foo@-declaration that says "all of the above superclasses are supported by the type". +declaration that says "all of the above superclasses are in scope". The+generated code does not need to mention any of the superclasses+individually; the marker instance is the contract.  == Discovering instances @@ -38,8 +42,10 @@ myRegistry = $$discoverRegistry @ -Caveat: TH only sees instances that are in scope when the-splice runs.+Caveat: TH only sees instances that have already been compiled when the+splice runs. Instances defined in the same module as @$$discoverRegistry@+will not be picked up. Put the splice in a leaf module that imports the+message modules. -} module Proto.Registry (   -- * Marker class@@ -53,6 +59,11 @@   registerMessage,   registerCodec, +  -- * Process-global Any registry (for runtime-extensible Any JSON)+  globalAnyRegistry,+  registerGlobalAnyCodecs,+  readGlobalAnyRegistry,+   -- * Lookup   lookupCodec,   lookupDecoder,@@ -69,16 +80,18 @@  import Data.Aeson qualified as Aeson import Data.ByteString (ByteString)+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map+import System.IO.Unsafe (unsafePerformIO) import Data.Maybe (mapMaybe) import Data.Proxy (Proxy (..)) import Data.Text (Text) import Data.Typeable (Typeable, cast)-import Language.Haskell.TH (Dec (..), Exp (..), Info (..), Q, Type (..), mkName, reify)+import Language.Haskell.TH (Dec (..), Exp (..), Info (..), Name, Q, Type (..), mkName, reify) import Language.Haskell.TH.Syntax (Code, unsafeCodeCoerce)-import Proto.Internal.Decode (DecodeError (..), MessageDecode (..), decodeMessage)-import Proto.Internal.Encode (MessageEncode (..), encodeMessage)+import Proto.Decode (DecodeError, MessageDecode (..), decodeMessage)+import Proto.Encode (MessageEncode (..), encodeMessage) import Proto.Schema (ProtoMessage (..))  @@ -107,8 +120,9 @@   , acFromJSON :: !(Aeson.Value -> Either String ByteString)   -- ^ Encode a JSON value to wire bytes.   , acIsWkt :: !Bool-  -- ^ True for well-known types that use the-  -- @{"\@type": …, "value": …}@ envelope.+  {- ^ True for well-known types that use the+  @{"\@type": …, "value": …}@ envelope.+  -}   }  @@ -164,9 +178,9 @@           , acIsWkt = False           }   in reg-      { trCodecs = Map.insert name codec (trCodecs reg)-      , trDecoders = Map.insert name (SomeDecoder p) (trDecoders reg)-      }+       { trCodecs = Map.insert name codec (trCodecs reg)+       , trDecoders = Map.insert name (SomeDecoder p) (trDecoders reg)+       }   {- | Register a raw JSON codec (for well-known types with custom JSON@@ -178,6 +192,41 @@   reg {trCodecs = Map.insert name codec (trCodecs reg)}  +{- | A process-global 'TypeRegistry' for runtime-extensible @Any@ JSON.++Generated code serialises @Any@-typed fields with a registry that+unions the standard well-known types with whatever has been registered+here (see 'Proto.Internal.JSON.WellKnown.anyJsonRegistry'). An+application that handles @Any@ values wrapping its own message types —+e.g. a Connect/gRPC conformance harness echoing requests packed into+@google.protobuf.Any@ — registers those types once at startup via+'registerGlobalAnyCodecs' so the canonical @{"\@type": …, …inlined…}@+JSON form is produced instead of the degenerate @{"value": <base64>}@+fallback.++This is a deliberately small piece of process-global state: it is+written once during initialisation and only read thereafter. Empty by+default, so libraries that never register anything are unaffected (the+@Any@ registry is exactly 'standardWktRegistry').+-}+{-# NOINLINE globalAnyRegistry #-}+globalAnyRegistry :: IORef TypeRegistry+globalAnyRegistry = unsafePerformIO (newIORef emptyRegistry)+++{- | Merge additional codecs into the process-global 'Any' registry.+Call once at process startup, before any @Any@ value is (de)serialised.+-}+registerGlobalAnyCodecs :: TypeRegistry -> IO ()+registerGlobalAnyCodecs reg =+  atomicModifyIORef' globalAnyRegistry (\g -> (g <> reg, ()))+++-- | Read the current process-global 'Any' registry.+readGlobalAnyRegistry :: IO TypeRegistry+readGlobalAnyRegistry = readIORef globalAnyRegistry++ -- | Look up a JSON codec by proto type name. lookupCodec :: Text -> TypeRegistry -> Maybe AnyCodec lookupCodec name = Map.lookup name . trCodecs@@ -188,7 +237,7 @@ -} lookupDecoder   :: forall a-   . (Typeable a)+   . (Typeable a, IsMessage a)   => Text   -> TypeRegistry   -> Maybe (ByteString -> Either DecodeError a)
src/Proto/Repr.hs view
@@ -227,7 +227,6 @@ import Data.Text.Lazy.Encoding qualified as TLE import Data.Vector qualified as V import Data.Vector.Unboxed qualified as VU-import Data.Word (Word8) import Language.Haskell.TH (Exp, Q, Type) import Proto.IDL.AST (Constant (..), OptionDef, OptionName (..), OptionNamePart (..), optName, optValue) import Proto.Internal.Wire (WireType (..))@@ -262,23 +261,26 @@   { stringType :: Q Type   -- ^ The Haskell type (e.g. @[t| Text |]@, @[t| Url |]@).   , stringEncode :: Q Exp-  -- ^ @Int -> a -> Builder@. The 'Int' is the proto field number.-  -- The adapter is responsible for emitting the tag + payload.+  {- ^ @Int -> a -> Builder@. The 'Int' is the proto field number.+  The adapter is responsible for emitting the tag + payload.+  -}   , stringSize :: Q Exp   -- ^ @a -> Int@. Wire size of the field /including/ the tag byte.   , stringDecode :: Q Exp-  -- ^ @Text -> a@. Post-processing function applied after the wire-  -- decoder produces a strict 'Text'. For the default (strict text)-  -- this is 'id'.+  {- ^ @Text -> a@. Post-processing function applied after the wire+  decoder produces a strict 'Text'. For the default (strict text)+  this is 'id'.+  -}   , stringEmpty :: Q Exp   -- ^ @a@. The proto default / zero value.   , stringIsEmpty :: Q Exp   -- ^ @a -> Bool@. For the proto3 default-skip rule.   , stringBaseRep :: !StringRep-  -- ^ The underlying base representation, used by the JSON/metadata-  -- codegen to select the right serialisation path. Custom adapters-  -- wrapping a base type should set this to the corresponding enum-  -- (e.g. a newtype over 'Text' should use 'StrictTextRep').+  {- ^ The underlying base representation, used by the JSON/metadata+  codegen to select the right serialisation path. Custom adapters+  wrapping a base type should set this to the corresponding enum+  (e.g. a newtype over 'Text' should use 'StrictTextRep').+  -}   }  @@ -290,24 +292,27 @@   , bytesSize :: Q Exp   -- ^ @a -> Int@. Wire size including tag byte.   , bytesDecode :: Q Exp-  -- ^ @ByteString -> a@. Post-processing function applied after the-  -- wire decoder produces a strict 'ByteString'. For the default-  -- (strict bytes) this is 'id'.+  {- ^ @ByteString -> a@. Post-processing function applied after the+  wire decoder produces a strict 'ByteString'. For the default+  (strict bytes) this is 'id'.+  -}   , bytesEmpty :: Q Exp   -- ^ @a@.   , bytesIsEmpty :: Q Exp   -- ^ @a -> Bool@.   , bytesBaseRep :: !BytesRep-  -- ^ The underlying base representation, used by JSON/metadata-  -- codegen to select the right serialisation path.+  {- ^ The underlying base representation, used by JSON/metadata+  codegen to select the right serialisation path.+  -}   }   -- | A recipe for the container backing a proto @repeated@ field. data RepeatedAdapter = RepeatedAdapter   { repeatedType :: Q Type -> Q Type-  -- ^ Given an element type, produce the container type.-  -- E.g. @\\t -> [t| V.Vector $t |]@.+  {- ^ Given an element type, produce the container type.+  E.g. @\\t -> [t| V.Vector $t |]@.+  -}   , repeatedEmpty :: Q Exp   -- ^ @f a@. Empty container.   , repeatedSnoc :: Q Exp@@ -317,8 +322,9 @@   , repeatedIsEmpty :: Q Exp   -- ^ @f a -> Bool@.   , repeatedBaseRep :: !RepeatedRep-  -- ^ The underlying base representation, used by JSON/metadata-  -- codegen to select the right serialisation path.+  {- ^ The underlying base representation, used by JSON/metadata+  codegen to select the right serialisation path.+  -}   }  @@ -568,18 +574,21 @@   { configDefault :: !FieldRep   -- ^ Default representation for all fields.   , configUnboxedRepeated :: !Bool-  -- ^ When 'True', repeated fields whose element type is 'Unbox'-able-  -- (all numeric scalars and Bool) default to @Data.Vector.Unboxed@-  -- instead of @Data.Vector@. Zero per-element heap overhead for-  -- packed repeated fields. Default: 'False' (for backwards compat).+  {- ^ When 'True', repeated fields whose element type is 'Unbox'-able+  (all numeric scalars and Bool) default to @Data.Vector.Unboxed@+  instead of @Data.Vector@. Zero per-element heap overhead for+  packed repeated fields. Default: 'False' (for backwards compat).+  -}   , configMessageOverrides :: !(Map Text FieldRep)   -- ^ Per-message override (applies to all fields in the message).   , configFieldOverrides :: !(Map (Text, Text) FieldRep)-  -- ^ Per-field override. Key is (messageName, fieldName).-  -- Haskell-side overrides take precedence over .proto annotations.+  {- ^ Per-field override. Key is (messageName, fieldName).+  Haskell-side overrides take precedence over .proto annotations.+  -}   , configAdapterRegistry :: !AdapterRegistry-  -- ^ Maps string names (from .proto annotations like-  -- @[(wireform.haskell_bytes) = \"lazy\"]@) to adapters.+  {- ^ Maps string names (from .proto annotations like+  @[(wireform.haskell_bytes) = \"lazy\"]@) to adapters.+  -}   }  @@ -901,43 +910,6 @@ {-# INLINE sizeShortBytes #-}  --- Decoder wrappers for adapters (produce the decoded Haskell value--- from strict ByteString wire bytes). These are referenced by--- stringDecode / bytesDecode. Note: the actual Decoder integration is done--- by the codegen which wraps these in the appropriate Decoder--- combinator. For now these are just conversion functions used by--- the TH splices.--decodeToLazyTextD :: Text -> TL.Text-decodeToLazyTextD = TL.fromStrict-{-# INLINE decodeToLazyTextD #-}---decodeToShortTextD :: Text -> SBS.ShortByteString-decodeToShortTextD = SBS.toShort . TE.encodeUtf8-{-# INLINE decodeToShortTextD #-}---decodeToHsStringD :: Text -> String-decodeToHsStringD = T.unpack-{-# INLINE decodeToHsStringD #-}---decodeToStrictBytesD :: ByteString -> ByteString-decodeToStrictBytesD = id-{-# INLINE decodeToStrictBytesD #-}---decodeToLazyBytesD :: ByteString -> BL.ByteString-decodeToLazyBytesD = BL.fromStrict-{-# INLINE decodeToLazyBytesD #-}---decodeToShortBytesD :: ByteString -> SBS.ShortByteString-decodeToShortBytesD = SBS.toShort-{-# INLINE decodeToShortBytesD #-}-- -- Legacy field-number encode helpers (Int -> a -> Builder). -- Kept for existing code that references them. @@ -1128,7 +1100,7 @@ {-# INLINE insertOrdMap #-}  -insertHashMap :: (Eq k, Hashable k) => k -> v -> HM.HashMap k v -> HM.HashMap k v+insertHashMap :: Hashable k => k -> v -> HM.HashMap k v -> HM.HashMap k v insertHashMap = HM.insert {-# INLINE insertHashMap #-}
src/Proto/Schema.hs view
@@ -50,9 +50,9 @@ ) where  import Data.ByteString (ByteString)-import Data.IntMap.Strict (IntMap)-import Data.IntMap.Strict qualified as IntMap import Data.Kind (Type)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map import Data.Proxy (Proxy (..)) import Data.Text (Text) import GHC.TypeLits (Symbol)@@ -74,11 +74,12 @@     -- | All field descriptors, keyed by field number.-  protoFieldDescriptors :: Proxy a -> IntMap (SomeFieldDescriptor a)+  protoFieldDescriptors :: Proxy a -> Map Int (SomeFieldDescriptor a)  -  -- | The raw serialized FileDescriptorProto bytes.-  -- Can be fed to other proto tools for interop.+  {- | The raw serialized FileDescriptorProto bytes.+  Can be fed to other proto tools for interop.+  -}   protoFileDescriptorBytes :: Proxy a -> ByteString   protoFileDescriptorBytes _ = "" @@ -217,22 +218,22 @@ -- | Look up a field descriptor by name. lookupFieldDescriptor :: ProtoMessage a => Text -> Proxy a -> Maybe (SomeFieldDescriptor a) lookupFieldDescriptor name p =-  let descs = IntMap.elems (protoFieldDescriptors p)+  let descs = Map.elems (protoFieldDescriptors p)   in case filter (\(SomeField fd) -> fdName fd == name) descs of-      (d : _) -> Just d-      [] -> Nothing+       (d : _) -> Just d+       [] -> Nothing   -- | Look up a field descriptor by field number. fieldDescriptorByNumber :: ProtoMessage a => Int -> Proxy a -> Maybe (SomeFieldDescriptor a)-fieldDescriptorByNumber num p = IntMap.lookup num (protoFieldDescriptors p)+fieldDescriptorByNumber num p = Map.lookup num (protoFieldDescriptors p)   -- | All field names in a message. messageFieldNames :: ProtoMessage a => Proxy a -> [Text]-messageFieldNames p = fmap (\(SomeField fd) -> fdName fd) (IntMap.elems (protoFieldDescriptors p))+messageFieldNames p = fmap (\(SomeField fd) -> fdName fd) (Map.elems (protoFieldDescriptors p))   -- | All field numbers in a message. messageFieldNumbers :: ProtoMessage a => Proxy a -> [Int]-messageFieldNumbers p = IntMap.keys (protoFieldDescriptors p)+messageFieldNumbers p = Map.keys (protoFieldDescriptors p)
src/Proto/Setup.hs view
@@ -105,7 +105,7 @@   , pgcModulePrefix :: T.Text   -- ^ Haskell module prefix for generated code (e.g. @\"Proto.Gen\"@).   , pgcLazySub :: Bool-  -- ^ When 'True', generate lazy submessage decoders using 'LazyMessage'.+  -- ^ When 'True', generate lazy submessage decoders using 'Proto.Decode.LazyMessage'.   , pgcHooks :: CodeGenHooks   -- ^ Codegen hooks that fire based on proto attributes.   }
src/Proto/TH.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskellQuotes #-}-{-# OPTIONS_GHC -Wno-unused-matches #-}+{-# OPTIONS_GHC -Wno-unused-matches -Wno-partial-fields #-}  {- | Template Haskell support for generating protobuf types at compile time. @@ -16,7 +16,7 @@    * A record data type plus a @default\<TypeName\>@ value with all fields     at their proto default values.-  * @MessageEncode@ \/ @MessageDecode@ wire codecs+  * @MessageEncode@ \/ @MessageSize@ \/ @MessageDecode@ wire codecs     (via "Proto.Internal.Derive").   * @HasExtensions@ (proto2 extension support).   * 'Proto.Schema.ProtoMessage' schema metadata@@ -108,8 +108,8 @@ ) where  import Control.Applicative ((<|>))+import Control.DeepSeq (NFData) import Data.ByteString (ByteString)-import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BL import Data.ByteString.Short qualified as SBS import Data.Char qualified@@ -118,17 +118,16 @@ import Data.Map.Strict qualified as Map import Data.Maybe (mapMaybe) import Data.Maybe qualified-import Data.Sequence (Seq)-import Data.Sequence qualified as Seq import Data.Text (Text) import Data.Text qualified as T import Data.Text.IO qualified as TIO import Data.Text.Lazy qualified as TL-import Data.Vector qualified as V import Data.Word (Word32, Word64) import GHC.Generics (Generic) import Language.Haskell.TH import Language.Haskell.TH.Syntax (addDependentFile, addModFinalizer)+import System.Directory (doesFileExist)+import System.FilePath ((</>)) import Proto.CodeGen (   FieldNaming (..),   escapeReserved,@@ -139,8 +138,19 @@   snakeToPascal,  ) import Proto.CodeGen.Hooks-import Proto.Internal.Decode qualified as Decode+import Proto.Decode qualified as Decode import Proto.Extension qualified as Ext+-- Well-Known-Type modules. Imported here so 'lookupWkt' can hand back+-- fully-resolved (quoted) 'Name's for the WKT types it references, which+-- makes the generated code self-contained: the user no longer has to import+-- the matching @Proto.Google.Protobuf.*@ module at the @loadProto@ call site.+import Proto.Google.Protobuf.Any qualified as WktAny+import Proto.Google.Protobuf.Duration qualified as WktDuration+import Proto.Google.Protobuf.Empty qualified as WktEmpty+import Proto.Google.Protobuf.FieldMask qualified as WktFieldMask+import Proto.Google.Protobuf.Struct qualified as WktStruct+import Proto.Google.Protobuf.Timestamp qualified as WktTimestamp+import Proto.Google.Protobuf.Wrappers qualified as WktWrappers import Proto.IDL.AST import Proto.IDL.Annotations (lookupSimpleOption, optionAsBool, optionAsString) import Proto.IDL.Options.Custom (emptyCustomOptionRegistry, extractExtensionOptions, registerCustomOption)@@ -153,17 +163,6 @@ import Wireform.Derive.Modifier (MapKeyScalar (..))  -{- | Produce a Haskell-valid record-field name from a proto field.-The proto-side name is snake_cased (@file_path@, @num_rows@); we-convert to camelCase and escape reserved keywords with a-trailing prime (@data@ → @data'@, @type@ → @type'@, …). Without-the escape, TH splices produce @data :: Foo -> Bar@ which is a-parse error.--}-hsFieldName :: Text -> Text-hsFieldName = escapeReserved . snakeToCamel-- {- | Message-scoped field name, mirroring the convention the pure- text codegen in 'Proto.CodeGen.scopedFieldName' uses: @@ -208,7 +207,7 @@ unknownConNameFor parents enumNm =   mkName     ( T.unpack-        (scopedHsTypeName parents enumNm <> T.pack "'Unknown")+        (scopedHsTypeName parents enumNm <> T.pack "''Unrecognized")     )  @@ -256,10 +255,6 @@   _ -> True  -hsEnumCon :: Text -> Text -> Text-hsEnumCon _enumName = snakeToPascal-- {- | Options for compile-time proto loading.  Use 'loTHHooks' to register hooks that produce extra TH declarations@@ -273,18 +268,22 @@ -} data LoadOpts = LoadOpts   { loIncludeDirs :: [FilePath]-  -- ^ Directories to search when resolving @import@ statements in-  -- @.proto@ files. Default: @[\"proto\/\", \".\"]@.+  {- ^ Directories to search when resolving @import@ statements in+  @.proto@ files. Default: @[\"proto\/\", \".\"]@.+  -}   , loFieldNaming :: FieldNaming-  -- ^ How to name generated record fields. 'PrefixedFields' (default)-  -- prefixes each field with the lowercased message name.-  -- 'UnprefixedFields' uses bare names (requires @DuplicateRecordFields@).+  {- ^ How to name generated record fields. 'PrefixedFields' (default)+  prefixes each field with the lowercased message name.+  'UnprefixedFields' uses bare names (requires @DuplicateRecordFields@).+  -}   , loRepConfig :: RepConfig-  -- ^ Controls how proto field types map to Haskell types. See-  -- "Proto.Repr" for the adapter system and per-field overrides.+  {- ^ Controls how proto field types map to Haskell types. See+  "Proto.Repr" for the adapter system and per-field overrides.+  -}   , loTHHooks :: THHooks-  -- ^ Callbacks that produce extra TH declarations. See-  -- 'Proto.CodeGen.Hooks.THHooks'.+  {- ^ Callbacks that produce extra TH declarations. See+  'Proto.CodeGen.Hooks.THHooks'.+  -}   }  @@ -335,7 +334,8 @@               , fhcFileOptions = protoOptions pf               , fhcCustomOptions = customOpts               }-      decls <- protoFileToDecls' (loFieldNaming opts) (loRepConfig opts) hooks pf+      importedTLs <- resolveImportedTopLevels (loIncludeDirs opts) pf+      decls <- protoFileToDeclsScoped (loFieldNaming opts) (loRepConfig opts) hooks importedTLs pf       hookDecls <- thOnFile hooks fileCtx       pure (decls <> hookDecls) @@ -348,19 +348,78 @@   protoFileToDecls' :: FieldNaming -> RepConfig -> THHooks -> ProtoFile -> Q [Dec]-protoFileToDecls' naming cfg hooks pf = do+protoFileToDecls' naming cfg hooks = protoFileToDeclsScoped naming cfg hooks []+++{- | Like 'protoFileToDecls'' but with extra top-level declarations from+imported files folded into the resolution 'ScopeCtx'. Only the target+file's own top-levels are generated; the imported ones exist solely so+cross-file named-type references resolve correctly (enum vs. submessage+classification via 'isEnumName', and the scoped Haskell type name via+'resolveScopedHsType'). The target file's own top-levels take precedence+on name clashes.+-}+protoFileToDeclsScoped :: FieldNaming -> RepConfig -> THHooks -> [TopLevel] -> ProtoFile -> Q [Dec]+protoFileToDeclsScoped naming cfg hooks importedTopLevels pf = do   let scope =         ScopeCtx           { scSyntax = protoSyntax pf-          , scTopLevels = protoTopLevels pf+          , scTopLevels = protoTopLevels pf <> importedTopLevels           , scPackage = Data.Maybe.fromMaybe T.empty (protoPackage pf)           , scParents = []           , scFieldNaming = naming-          , scFileOptions = protoOptions pf           }   concat <$> mapM (topLevelToDecls scope cfg hooks) (protoTopLevels pf)  +{- | Transitively resolve a parsed file's non-WKT @import@s against the+'loIncludeDirs', returning the imported files' top-level declarations so+the generator can see cross-file types. @google/protobuf/*@ imports are+Well-Known Types resolved by 'lookupWkt', so those files are not read.+Imports that cannot be located in the include dirs (or fail to parse)+are skipped — the legacy leaf-name fallback still applies — so adding+this resolution never hard-fails a build that worked before. Every file+read is registered with 'addDependentFile' for correct recompilation.+-}+resolveImportedTopLevels :: [FilePath] -> ProtoFile -> Q [TopLevel]+resolveImportedTopLevels includeDirs pf0 = do+  (tls, deps) <- runIO (go [] [] [] (nonWktImports pf0))+  mapM_ addDependentFile deps+  pure tls+  where+    nonWktImports pf =+      [importPath i | i <- protoImports pf, not (isWkt (importPath i))]+    isWkt p = T.pack "google/protobuf/" `T.isPrefixOf` p+    go _ accTL accDeps [] = pure (accTL, accDeps)+    go visited accTL accDeps (ip : rest)+      | ip `elem` visited = go visited accTL accDeps rest+      | otherwise = do+          mfp <- findInclude includeDirs (T.unpack ip)+          case mfp of+            Nothing -> go (ip : visited) accTL accDeps rest+            Just fp -> do+              src <- TIO.readFile fp+              case parseProtoFile fp src of+                Left _ -> go (ip : visited) accTL accDeps rest+                Right ipf ->+                  go+                    (ip : visited)+                    (accTL <> protoTopLevels ipf)+                    (fp : accDeps)+                    (nonWktImports ipf <> rest)+++-- | First existing @dir '</>' rel@ across the include dirs, if any.+findInclude :: [FilePath] -> FilePath -> IO (Maybe FilePath)+findInclude dirs rel = go dirs+  where+    go [] = pure Nothing+    go (d : ds) = do+      let p = d </> rel+      ok <- doesFileExist p+      if ok then pure (Just p) else go ds++ {- | Lookup table built once per file: lets the bridge tell whether a named-type reference points at an enum (which the bridge encodes as a varint via 'PFEnum') or a message (encoded as a@@ -372,23 +431,23 @@   { scSyntax :: !Syntax   , scTopLevels :: ![TopLevel]   , scPackage :: !Text-  -- ^ Proto package as declared in the file (empty string when-  -- the file has no @package@ statement). Drives the-  -- @protoMessageName@ \/ @protoPackageName@ outputs in the-  -- generated 'PS.ProtoMessage' instance.+  {- ^ Proto package as declared in the file (empty string when+  the file has no @package@ statement). Drives the+  @protoMessageName@ \/ @protoPackageName@ outputs in the+  generated 'PS.ProtoMessage' instance.+  -}   , scParents :: ![Text]-  -- ^ Parent message names accumulated as we recurse into-  -- nested types. Used to scope-prefix the generated Haskell-  -- type / constructor / field names so two messages from-  -- different .proto files (or different parents within the-  -- same file) can declare an inner @NestedMessage@ without-  -- colliding at the Haskell level.+  {- ^ Parent message names accumulated as we recurse into+  nested types. Used to scope-prefix the generated Haskell+  type / constructor / field names so two messages from+  different .proto files (or different parents within the+  same file) can declare an inner @NestedMessage@ without+  colliding at the Haskell level.+  -}   , scFieldNaming :: !FieldNaming-  -- ^ How to name record fields (prefixed with message name-  -- or bare).-  , scFileOptions :: ![OptionDef]-  -- ^ File-level option definitions. Used to resolve edition-  -- feature overrides (e.g. @option features.repeated_field_encoding = EXPANDED@).+  {- ^ How to name record fields (prefixed with message name+  or bare).+  -}   }  @@ -505,7 +564,6 @@           , scPackage = T.empty           , scParents = []           , scFieldNaming = PrefixedFields-          , scFileOptions = []           }   in messageToDecls'' scope cfg hooks msg @@ -546,6 +604,7 @@                 (scParents childScope)                 hooks                 ed+            MEExtend owner fields -> extendToDecls (scPackage childScope) owner fields             _ -> pure []         )         (msgElements msg)@@ -557,7 +616,7 @@   oneofDecs <- mkOneofDataDecs scopeCtx tyName fields   dataDec <- mkDataDec scopeCtx tyName fields   defaultDec <- mkDefaultDec scopeCtx tyName fields-  -- All wire codecs (MessageEncode / MessageDecode)+  -- All wire codecs (MessageEncode / MessageSize / MessageDecode)   -- now come from 'Proto.Internal.Derive' via the IDL bridge,   -- including oneofs (whose sum types are emitted by   -- 'mkOneofDataDecs' just above). The bridge handles every@@ -566,15 +625,15 @@   -- splice fails with a clear message rather than silently   -- generating broken code.   pfs <- traverse (fieldSpecToProtoField scopeCtx tyName) fields-  codecDecs <- messageCodecsViaBridge tyName pfs-  hasExtDec <- mkHasExtensionsInstance tyName (msgName msg)+  codecDecs <- messageCodecsViaBridge (scFieldNaming scopeCtx == UnprefixedFields) tyName pfs+  hasExtDec <- mkHasExtensionsInstance (scFieldNaming scopeCtx == UnprefixedFields) tyName (msgName msg)   hookDecls <- thOnMessage hooks hookCtx    let defName = mkName ("default" <> nameBase tyName)-      fqName = case scPackage scopeCtx of-        p-          | T.null p -> msgName msg-          | otherwise -> p <> T.singleton '.' <> msgName msg+      fqName =+        T.intercalate+          (T.singleton '.')+          (filter (not . T.null) ([scPackage scopeCtx] <> scParents scopeCtx <> [msgName msg]))       metaFields = fmap (fieldSpecToMetaField scopeCtx tyName) fields   protoMsgDecs <-     PTM.mkProtoMessageInstance@@ -589,12 +648,19 @@   -- registry. We use the same naming convention as   -- 'unknownFieldsName'.   let ufSelName = unknownFieldsName tyName+      hasExts = any isExt (msgElements msg)+        where+          isExt (MEExtensions _ _) = True+          isExt _ = False+      aesonUfSel = if hasExts then Just ufSelName else Nothing+  let recDot = scFieldNaming scopeCtx == UnprefixedFields   aesonDecs <-     PTM.mkAesonInstancesForMessage       tyName       fqName-      (Just ufSelName)+      aesonUfSel       defName+      recDot       metaFields   hashableDec <- PTM.mkHashableInstanceForMessage tyName metaFields @@ -613,6 +679,9 @@         )     ) +  -- HasField instances for lens-style access via Proto.Schema.HasField+  hasFieldDecs <- mkHasFieldInstances scopeCtx tyName fields+   -- Monoid: mempty = defaultFoo (must come after Semigroup in codecDecs)   let monoidDec =         InstanceD@@ -634,6 +703,7 @@         <> defaultDec         <> codecDecs         <> [monoidDec]+        <> hasFieldDecs         <> hasExtDec         <> protoMsgDecs         <> aesonDecs@@ -644,21 +714,23 @@     )  -{- | Synthesise the @MessageEncode \/ MessageDecode@ pair via-'Proto.Internal.Derive.synthesiseProtoInstancesWith' with-unknown-field preservation enabled. Used for every+{- | Synthesise the @MessageEncode \/ MessageSize \/ MessageDecode@+triple via 'Proto.Internal.Derive.synthesiseProtoInstancesWith'+with unknown-field preservation enabled. Used for every 'loadProto'-generated message. -}-messageCodecsViaBridge :: Name -> [PDI.ProtoField] -> Q [Dec]-messageCodecsViaBridge tyName pfs = do+messageCodecsViaBridge :: Bool -> Name -> [PDI.ProtoField] -> Q [Dec]+messageCodecsViaBridge recDot tyName pfs = do   let meta =         PDI.MessageMeta           { PDI.mmUnknownFieldsSel = Just (unknownFieldsName tyName)+          , PDI.mmRecordDotReads = recDot           }   enc <- PDI.mkEncodeInstanceWith meta (ConT tyName) pfs+  siz <- PDI.mkSizeInstanceWith meta (ConT tyName) pfs   dec <- PDI.mkDecodeInstanceWith meta (ConT tyName) tyName pfs   semi <- PDI.mkSemigroupInstanceWith meta (ConT tyName) tyName pfs-  pure [enc, dec, semi]+  pure [enc, siz, dec, semi]   messageHaddock :: MessageDef -> [FieldSpec] -> String@@ -744,19 +816,21 @@       , fsMapKey :: ScalarType       , fsMapVal :: FieldType       , fsMapRep :: FieldRep-      -- ^ Resolved per-field 'FieldRep'. Drives the bytes / string-      -- rep of the value type and the JSON helper choice, the-      -- same way 'fsRep' does for 'FSField'.+      {- ^ Resolved per-field 'FieldRep'. Drives the bytes / string+      rep of the value type and the JSON helper choice, the+      same way 'fsRep' does for 'FSField'.+      -}       }   | FSOneof       { fsName :: Text       , fsOneofFields :: [(OneofField, FieldRep)]-      -- ^ Each variant paired with its resolved 'FieldRep'.-      -- The string / bytes / repeated rep choices come from the-      -- same 'RepConfig' lookup machinery as regular fields, keyed-      -- by @(parentMessage, oneofFieldName)@. This lets users-      -- override one variant of a oneof to lazy / short / hsString-      -- without affecting siblings.+      {- ^ Each variant paired with its resolved 'FieldRep'.+      The string / bytes / repeated rep choices come from the+      same 'RepConfig' lookup machinery as regular fields, keyed+      by @(parentMessage, oneofFieldName)@. This lets users+      override one variant of a oneof to lazy / short / hsString+      without affecting siblings.+      -}       }  @@ -832,7 +906,9 @@     []     Nothing     [con]-    [derivClause (Just StockStrategy) [conT ''Show, conT ''Eq, conT ''Generic]]+    [ derivClause (Just StockStrategy) [conT ''Show, conT ''Eq, conT ''Generic]+    , derivClause (Just AnyclassStrategy) [conT ''NFData]+    ]   where     parentName = T.pack (nameBase tyName)     mkField :: FieldSpec -> Q [VarBangType]@@ -854,6 +930,68 @@   -- ===========================================================+-- HasField instances (Proto.Schema.HasField)+-- ===========================================================++mkHasFieldInstances :: ScopeCtx -> Name -> [FieldSpec] -> Q [Dec]+mkHasFieldInstances scope tyName fields =+  fmap concat (mapM mkOne fields)+  where+    parentName = T.pack (nameBase tyName)+    recDot = scFieldNaming scope == UnprefixedFields+    mkOne :: FieldSpec -> Q [Dec]+    mkOne (FSField name _ lbl ft rep _) = do+      let hsName = scopedHsFieldName (scFieldNaming scope) parentName name+          fname = mkName (T.unpack hsName)+      ty <- fieldTypeToTH scope lbl ft rep+      mkHasFieldDec recDot tyName (snakeToCamel name) fname ty+    mkOne (FSMap name _ kt vt rep) = do+      let hsName = scopedHsFieldName (scFieldNaming scope) parentName name+          fname = mkName (T.unpack hsName)+      kty <- scalarToTH kt+      vty <- fieldTypeInnerScopedQ scope rep vt+      ty <- appT (appT (conT ''Map) (pure kty)) (pure vty)+      mkHasFieldDec recDot tyName (snakeToCamel name) fname ty+    mkOne (FSOneof name _) = do+      let hsName = scopedHsFieldName (scFieldNaming scope) parentName name+          fname = mkName (T.unpack hsName)+          oneofTyName = oneofSumName tyName name+      ty <- appT (conT ''Maybe) (conT oneofTyName)+      mkHasFieldDec recDot tyName (snakeToCamel name) fname ty+++mkHasFieldDec :: Bool -> Name -> Text -> Name -> Type -> Q [Dec]+mkHasFieldDec recDot tyName fnameStr fname ty = do+  msgVar <- newName "msg"+  aVar <- newName "a"+  let nameLit = LitT (StrTyLit (T.unpack fnameStr))+      instTy = foldl AppT (ConT ''PS.HasField) [ConT tyName, nameLit, ty]+      -- Under 'UnprefixedFields' ('NoFieldSelectors', names shared across+      -- messages) the bare selector does not exist and an un-annotated+      -- update is ambiguous: read through the auto-derived record-dot+      -- (GHC 'HasField', distinct from this 'PS.HasField') on a typed+      -- binder, and annotate the update's result. Prefixed keeps the+      -- plain forms.+      msgBinder+        | recDot = SigP (VarP msgVar) (ConT tyName)+        | otherwise = VarP msgVar+      getBody+        | recDot = GetFieldE (VarE msgVar) (nameBase fname)+        | otherwise = AppE (VarE fname) (VarE msgVar)+      updE = RecUpdE (VarE msgVar) [(fname, VarE aVar)]+      setBody+        | recDot = SigE updE (ConT tyName)+        | otherwise = updE+      getFld = FunD 'PS.getField [Clause [msgBinder] (NormalB getBody) []]+      setFld = FunD 'PS.setField [Clause [VarP aVar, msgBinder] (NormalB setBody) []]+      fdesc =+        FunD+          'PS.fieldDescriptor+          [Clause [WildP, WildP] (NormalB (VarE 'undefined)) []]+  pure [InstanceD Nothing [] instTy [getFld, setFld, fdesc]]+++-- =========================================================== -- Oneof sum types -- =========================================================== --@@ -908,7 +1046,9 @@         []         Nothing         (fmap pure cons)-        [derivClause (Just StockStrategy) [conT ''Show, conT ''Eq, conT ''Generic]]+        [ derivClause (Just StockStrategy) [conT ''Show, conT ''Eq, conT ''Generic]+        , derivClause (Just AnyclassStrategy) [conT ''NFData]+        ]      mkCon :: Text -> (OneofField, FieldRep) -> Q Con     mkCon ooName (f, rep) = do@@ -960,30 +1100,6 @@     _ -> fieldTypeInnerScopedQ scope rep ft  -{- | 'fieldTypeInnerQ' ignores the per-field 'FieldRep'; used for map-keys/values where we haven't threaded a rep config through yet.-Prefer 'fieldTypeInnerQWithRep' for message fields so that-custom bytes/string representations (@fieldBytes@ / @fieldString@)-actually materialize in the generated Haskell type.--}-fieldTypeInnerQ :: FieldType -> Q Type-fieldTypeInnerQ = fieldTypeInnerQWithRep defaultFieldRep---{- | Scope-unaware variant kept for callers that don't have a-'ScopeCtx' handy (e.g. map key resolution, where the key-type is always a built-in scalar).--}-fieldTypeInnerQWithRep :: FieldRep -> FieldType -> Q Type-fieldTypeInnerQWithRep rep = \case-  FTScalar SString -> stringTypeQ (fieldString rep)-  FTScalar SBytes -> bytesTypeQ (fieldBytes rep)-  FTScalar s -> scalarToTH s-  FTNamed n-    | Just (tyN, _) <- lookupWkt n -> conT tyN-    | otherwise -> conT (mkName (T.unpack (hsTypeName n)))-- {- | Scope-aware variant used for normal singular / repeated / optional / oneof-variant fields. Resolves named types through the file's 'ScopeCtx' so a reference to a nested message gets@@ -1008,44 +1124,41 @@ existing modules whenever a @.proto@ file references a WKT (which @loadProto@ doesn't yet follow imports for). -Adding a WKT is a one-line entry here plus an import of the-corresponding pre-generated module from any consumer of-@loadProto@ (the imports are silent because the @ConT@ name we-spit out resolves at GHC's renamer phase, not at TH-splice-time, so consumers just have to make sure the module is in-scope at the call site).+The returned 'Name's are fully-resolved (produced by the @''Type@ \/+@'value@ name quotes against the imported @Wkt*@ modules above), so the+generated code references the WKT type by its global name and does /not/+require the consumer to import the corresponding+@Proto.Google.Protobuf.*@ module at the @loadProto@ call site. Adding a+WKT is a one-line entry here plus the matching qualified import above. -} lookupWkt :: Text -> Maybe (Name, Name) lookupWkt n = case T.unpack n of   -- Single-message WKTs.-  "google.protobuf.Timestamp" -> Just (mkPGP "Timestamp" "Timestamp", defPGP "Timestamp" "Timestamp")-  "google.protobuf.Duration" -> Just (mkPGP "Duration" "Duration", defPGP "Duration" "Duration")-  "google.protobuf.Empty" -> Just (mkPGP "Empty" "Empty", defPGP "Empty" "Empty")-  "google.protobuf.FieldMask" -> Just (mkPGP "FieldMask" "FieldMask", defPGP "FieldMask" "FieldMask")-  "google.protobuf.Any" -> Just (mkPGP "Any" "Any", defPGP "Any" "Any")-  "google.protobuf.Struct" -> Just (mkPGP "Struct" "Struct", defPGP "Struct" "Struct")-  "google.protobuf.Value" -> Just (mkPGP "Struct" "Value", defPGP "Struct" "Value")-  "google.protobuf.ListValue" -> Just (mkPGP "Struct" "ListValue", defPGP "Struct" "ListValue")+  "google.protobuf.Timestamp" -> Just (''WktTimestamp.Timestamp, 'WktTimestamp.defaultTimestamp)+  "google.protobuf.Duration" -> Just (''WktDuration.Duration, 'WktDuration.defaultDuration)+  "google.protobuf.Empty" -> Just (''WktEmpty.Empty, 'WktEmpty.defaultEmpty)+  "google.protobuf.FieldMask" -> Just (''WktFieldMask.FieldMask, 'WktFieldMask.defaultFieldMask)+  "google.protobuf.Any" -> Just (''WktAny.Any, 'WktAny.defaultAny)+  "google.protobuf.Struct" -> Just (''WktStruct.Struct, 'WktStruct.defaultStruct)+  "google.protobuf.Value" -> Just (''WktStruct.Value, 'WktStruct.defaultValue)+  "google.protobuf.ListValue" -> Just (''WktStruct.ListValue, 'WktStruct.defaultListValue)   "google.protobuf.NullValue" ->     Just-      ( mkPGP "Struct" "NullValue"+      ( ''WktStruct.NullValue       , -- NullValue is an enum; default is its single value.-        mkName "Proto.Google.Protobuf.WellKnownTypes.Struct.NullValue'NullValue"+        'WktStruct.NullValue'NullValue       )-  -- Wrapper messages (all in Proto.Google.Protobuf.WellKnownTypes.Wrappers).-  "google.protobuf.DoubleValue" -> Just (mkPGP "Wrappers" "DoubleValue", defPGP "Wrappers" "DoubleValue")-  "google.protobuf.FloatValue" -> Just (mkPGP "Wrappers" "FloatValue", defPGP "Wrappers" "FloatValue")-  "google.protobuf.Int64Value" -> Just (mkPGP "Wrappers" "Int64Value", defPGP "Wrappers" "Int64Value")-  "google.protobuf.UInt64Value" -> Just (mkPGP "Wrappers" "UInt64Value", defPGP "Wrappers" "UInt64Value")-  "google.protobuf.Int32Value" -> Just (mkPGP "Wrappers" "Int32Value", defPGP "Wrappers" "Int32Value")-  "google.protobuf.UInt32Value" -> Just (mkPGP "Wrappers" "UInt32Value", defPGP "Wrappers" "UInt32Value")-  "google.protobuf.BoolValue" -> Just (mkPGP "Wrappers" "BoolValue", defPGP "Wrappers" "BoolValue")-  "google.protobuf.StringValue" -> Just (mkPGP "Wrappers" "StringValue", defPGP "Wrappers" "StringValue")-  "google.protobuf.BytesValue" -> Just (mkPGP "Wrappers" "BytesValue", defPGP "Wrappers" "BytesValue")+  -- Wrapper messages (all in Proto.Google.Protobuf.Wrappers).+  "google.protobuf.DoubleValue" -> Just (''WktWrappers.DoubleValue, 'WktWrappers.defaultDoubleValue)+  "google.protobuf.FloatValue" -> Just (''WktWrappers.FloatValue, 'WktWrappers.defaultFloatValue)+  "google.protobuf.Int64Value" -> Just (''WktWrappers.Int64Value, 'WktWrappers.defaultInt64Value)+  "google.protobuf.UInt64Value" -> Just (''WktWrappers.UInt64Value, 'WktWrappers.defaultUInt64Value)+  "google.protobuf.Int32Value" -> Just (''WktWrappers.Int32Value, 'WktWrappers.defaultInt32Value)+  "google.protobuf.UInt32Value" -> Just (''WktWrappers.UInt32Value, 'WktWrappers.defaultUInt32Value)+  "google.protobuf.BoolValue" -> Just (''WktWrappers.BoolValue, 'WktWrappers.defaultBoolValue)+  "google.protobuf.StringValue" -> Just (''WktWrappers.StringValue, 'WktWrappers.defaultStringValue)+  "google.protobuf.BytesValue" -> Just (''WktWrappers.BytesValue, 'WktWrappers.defaultBytesValue)   _ -> Nothing-  where-    mkPGP modSuffix tyN = mkName ("Proto.Google.Protobuf.WellKnownTypes." <> modSuffix <> "." <> tyN)-    defPGP modSuffix tyN = mkName ("Proto.Google.Protobuf.WellKnownTypes." <> modSuffix <> ".default" <> tyN)   stringTypeQ :: StringAdapter -> Q Type@@ -1166,8 +1279,8 @@     lookupZero ed =       let zeros = filter (\ev -> evNumber ev == 0) (enumValues ed)       in case zeros of-          (ev : _) -> Just (scopedHsEnumCon enumParents (enumName ed) (evName ev))-          [] -> Nothing+           (ev : _) -> Just (scopedHsEnumCon enumParents (enumName ed) (evName ev))+           [] -> Nothing   emptyRepeatedQ :: RepeatedAdapter -> Q Exp@@ -1261,6 +1374,7 @@           , conT ''Ord           , conT ''Generic           ]+      , derivClause (Just AnyclassStrategy) [conT ''NFData]       ]   enumInst <- mkEnumInstance tyName parents ed   let@@ -1372,9 +1486,9 @@           )           primaryByNum           <> [ Clause-                [ConP unknownCon [] [VarP nVar]]-                (NormalB (AppE (VarE 'fromIntegral) (VarE nVar)))-                []+                 [ConP unknownCon [] [VarP nVar]]+                 (NormalB (AppE (VarE 'fromIntegral) (VarE nVar)))+                 []              ]       fromEnumDec = FunD 'fromEnum fromEnumClauses   pure $@@ -1421,27 +1535,32 @@ -- ============================================================  {- | Emit the @HasExtensions@ instance for a generated record. The-instance's two methods read and write the record's-unknown-fields slot, which is where extension payloads (and any-other forward-compatible unknown tags) live.--The class and method names are referenced via their bound 'Name's-('Ext.messageUnknownFields' / 'Ext.setMessageUnknownFields') so-the generated splice doesn't require the user's module to-already have @import qualified Proto.Extension@ in scope.+instance's two methods read and write the record's unknown-fields+slot, which is where extension payloads (and any unrecognised tags)+are preserved. -}-mkHasExtensionsInstance :: Name -> Text -> Q [Dec]-mkHasExtensionsInstance tyName _protoName = do+mkHasExtensionsInstance :: Bool -> Name -> Text -> Q [Dec]+mkHasExtensionsInstance recDot tyName _protoName = do   let ufName = unknownFieldsName tyName   msgVar <- newName "msg"   ufsVar <- newName "ufs"+  -- Under 'UnprefixedFields' ('NoFieldSelectors') the bare unknown-fields+  -- selector does not exist, so read it through record-dot on a typed+  -- binder. The selector is unique (always message-prefixed), so the+  -- 'setMessageUnknownFields' record update needs no annotation.+  ufReader <-+    if recDot+      then do+        m <- newName "m"+        pure (LamE [SigP (VarP m) (ConT tyName)] (GetFieldE (VarE m) (nameBase ufName)))+      else pure (VarE ufName)   inst <-     instanceD       (pure [])       [t|Ext.HasExtensions $(conT tyName)|]       [ funD           'Ext.messageUnknownFields-          [clause [] (normalB (varE ufName)) []]+          [clause [] (normalB (pure ufReader)) []]       , funD           'Ext.setMessageUnknownFields           [ clause@@ -1729,10 +1848,10 @@           inner = innerHsType scope vt rep           base = PDI.protoField sel num (PDI.FKMap mks) pft inner       in pure-          base-            { PDI.pfStringAdapter = fieldString rep-            , PDI.pfBytesAdapter = fieldBytes rep-            }+           base+             { PDI.pfStringAdapter = fieldString rep+             , PDI.pfBytesAdapter = fieldBytes rep+             } fieldSpecToProtoField scope parentTy (FSOneof name ofs) = do   let parentName = T.pack (nameBase parentTy)       sel = mkName (T.unpack (scopedHsFieldName (scFieldNaming scope) parentName name))@@ -1756,16 +1875,12 @@ packedModeFor :: ScopeCtx -> [OptionDef] -> PDI.RepeatedMode packedModeFor scope opts =   let explicit = lookupSimpleOption (T.pack "packed") opts >>= optionAsBool-      -- For editions, apply file-level then field-level features.* overrides.       defaultPacked = case scSyntax scope of         Proto3 -> True         Proto2 -> False-        Editions ed ->-          let fileFs  = resolveFileFeatures (Editions ed) (scFileOptions scope)-              fieldFs = resolveFieldFeatures fileFs opts-          in case featureRepeatedFieldEncoding fieldFs of-               PackedEncoding   -> True-               ExpandedEncoding -> False+        Editions ed -> case featureRepeatedFieldEncoding (featuresForEdition ed) of+          PackedEncoding -> True+          ExpandedEncoding -> False       packed = Data.Maybe.fromMaybe defaultPacked explicit   in if packed then PDI.ModePacked else PDI.ModeUnpacked @@ -1787,9 +1902,9 @@           (innerHsType scope (oneofFieldType f) rep)           (fieldTypeToBridge scope (oneofFieldType f))   in base-      { PDI.ovStringAdapter = fieldString rep-      , PDI.ovBytesAdapter = fieldBytes rep-      }+       { PDI.ovStringAdapter = fieldString rep+       , PDI.ovBytesAdapter = fieldBytes rep+       }   -- | Project the AST 'ScalarType' onto the bridge's wire 'Scalar'.@@ -1947,17 +2062,18 @@             | isEnumName scope n -> PTM.JSEnum             | otherwise -> PTM.JSMessage     in PTM.MetaField-        { PTM.mfSelector = sel-        , PTM.mfProtoName = name-        , PTM.mfJsonName = jsonNm-        , PTM.mfNumber = num-        , PTM.mfTypeDesc = fieldTypeDescE scope ft-        , PTM.mfLabel = protoLabelE lbl-        , PTM.mfKind = kind-        , PTM.mfJsonKind = jsonKind-        , PTM.mfBytesShape = bytesShape-        , PTM.mfJsonShape = jsonShape-        }+         { PTM.mfSelector = sel+         , PTM.mfProtoName = name+         , PTM.mfJsonName = jsonNm+         , PTM.mfNumber = num+         , PTM.mfTypeDesc = fieldTypeDescE scope ft+         , PTM.mfLabel = protoLabelE lbl+         , PTM.mfKind = kind+         , PTM.mfJsonKind = jsonKind+         , PTM.mfBytesShape = bytesShape+         , PTM.mfJsonShape = jsonShape+         , PTM.mfRecordDot = scFieldNaming scope == UnprefixedFields+         }   FSMap name num kt vt rep ->     let sel = mkName (T.unpack (scopedHsFieldName (scFieldNaming scope) parentName name))         jsonNm = protoJsonName name@@ -1974,33 +2090,35 @@             | isEnumName scope n -> PTM.JSMapEnum (jsScalarOf kt)             | otherwise -> PTM.JSMapMessage (jsScalarOf kt)     in PTM.MetaField-        { PTM.mfSelector = sel-        , PTM.mfProtoName = name-        , PTM.mfJsonName = jsonNm-        , PTM.mfNumber = num-        , PTM.mfTypeDesc = mapTypeDescE scope kt vt-        , PTM.mfLabel = [|PS.LabelOptional|]-        , PTM.mfKind = PTM.MFKMap-        , PTM.mfJsonKind = jsonKind-        , PTM.mfBytesShape = bytesShape-        , PTM.mfJsonShape = jsonShape-        }+         { PTM.mfSelector = sel+         , PTM.mfProtoName = name+         , PTM.mfJsonName = jsonNm+         , PTM.mfNumber = num+         , PTM.mfTypeDesc = mapTypeDescE scope kt vt+         , PTM.mfLabel = [|PS.LabelOptional|]+         , PTM.mfKind = PTM.MFKMap+         , PTM.mfJsonKind = jsonKind+         , PTM.mfBytesShape = bytesShape+         , PTM.mfJsonShape = jsonShape+         , PTM.mfRecordDot = scFieldNaming scope == UnprefixedFields+         }   FSOneof name ofs ->     let sel = mkName (T.unpack (scopedHsFieldName (scFieldNaming scope) parentName name))         jsonNm = protoJsonName name         variants = fmap (oneofVariantJson scope parentTy name) ofs     in PTM.MetaField-        { PTM.mfSelector = sel-        , PTM.mfProtoName = name-        , PTM.mfJsonName = jsonNm-        , PTM.mfNumber = 0-        , PTM.mfTypeDesc = [|PS.MessageType $(textLitE name)|]-        , PTM.mfLabel = [|PS.LabelOptional|]-        , PTM.mfKind = PTM.MFKOneof-        , PTM.mfJsonKind = PTM.JKNormal-        , PTM.mfBytesShape = PTM.SBStrict-        , PTM.mfJsonShape = PTM.JSOneof variants-        }+         { PTM.mfSelector = sel+         , PTM.mfProtoName = name+         , PTM.mfJsonName = jsonNm+         , PTM.mfNumber = 0+         , PTM.mfTypeDesc = [|PS.MessageType $(textLitE name)|]+         , PTM.mfLabel = [|PS.LabelOptional|]+         , PTM.mfKind = PTM.MFKOneof+         , PTM.mfJsonKind = PTM.JKNormal+         , PTM.mfBytesShape = PTM.SBStrict+         , PTM.mfJsonShape = PTM.JSOneof variants+         , PTM.mfRecordDot = scFieldNaming scope == UnprefixedFields+         }   where     parentName = T.pack (nameBase parentTy) @@ -2035,10 +2153,10 @@           | isEnumName scope n -> PTM.OVEnum           | otherwise -> PTM.OVMessage   in PTM.OneofVariantJson-      { PTM.ovjConstructor = conN-      , PTM.ovjJsonKey = jsonKey-      , PTM.ovjShape = shape-      }+       { PTM.ovjConstructor = conN+       , PTM.ovjJsonKey = jsonKey+       , PTM.ovjShape = shape+       }   {- | Project a proto FQN to the metadata-bridge's 'WktShape' tag
src/Proto/TH/Derive.hs view
@@ -29,7 +29,7 @@ * Singular fields of one of the recognized scalar types   (@Int32 \/ Int64 \/ Word32 \/ Word64 \/ Bool \/ Float \/ Double \/   Text \/ ByteString@) or a submessage with existing-  'MessageEncode' \/ 'MessageDecode' instances.+  'MessageEncode' \/ 'MessageDecode' \/ 'MessageSize' instances. * @Maybe a@ for explicit field presence (proto2 optional or proto3   @optional@). * Repeated containers — outer 'Data.Vector.Vector' / list \/@@ -62,8 +62,8 @@  == Generated instances -* 'MessageEncode' — @buildSized@ with proto3 default-value skip;-  size is computed inline via the sized-builder machinery.+* 'MessageEncode' — @buildMessage@ with proto3 default-value skip.+* 'MessageSize'   — mirror of the encoder for two-pass output. * 'MessageDecode' — accumulator loop with field-number dispatch. * 'IsMessage'     — provides 'messageTypeName'. Defaults to the   Haskell type's base name; override via the @customModifier@@ -83,6 +83,7 @@   -- * Annotation-driven entry points   deriveProto,   deriveProtoEncode,+  deriveProtoSize,   deriveProtoDecode,    -- * Pre-translated entry point (for IDL bridges)@@ -129,14 +130,15 @@ -- Public entry points (annotation-driven) -- --------------------------------------------------------------------------- -{- | Derive 'MessageEncode', 'MessageDecode', and+{- | Derive 'MessageEncode', 'MessageSize', 'MessageDecode', and 'IsMessage' for a record type. -} deriveProto :: Name -> Q [Dec] deriveProto nm = do   enc <- deriveProtoEncode nm+  siz <- deriveProtoSize nm   dec <- deriveProtoDecode nm-  pure (enc ++ dec)+  pure (enc ++ siz ++ dec)   -- | Derive only the 'MessageEncode' instance for a record type.@@ -149,6 +151,16 @@   pure [inst]  +-- | Derive only the 'MessageSize' instance for a record type.+deriveProtoSize :: Name -> Q [Dec]+deriveProtoSize nm = do+  ti <- recordOnly nm =<< reifyTypeInfo nm+  fis <- protoFields ti+  let typ = applyTypeArgs (ConT (typeInfoName ti)) (typeInfoVarTypes ti)+  inst <- I.mkSizeInstance typ fis+  pure [inst]++ -- | Derive only the 'MessageDecode' instance for a record type. deriveProtoDecode :: Name -> Q [Dec] deriveProtoDecode nm = do@@ -176,52 +188,63 @@ -} data TranslatedField = TranslatedField   { tfSelector :: !Name-  -- ^ Record selector to be used for this field. Must match the-  -- accompanying record constructor that the caller emits.+  {- ^ Record selector to be used for this field. Must match the+  accompanying record constructor that the caller emits.+  -}   , tfInnerType :: !Type-  -- ^ For singular fields: the value type (with 'Maybe' stripped).-  -- For repeated fields: the element type.-  -- For map fields: the value type.-  -- For oneof fields: ignored (each variant carries its own).+  {- ^ For singular fields: the value type (with 'Maybe' stripped).+  For repeated fields: the element type.+  For map fields: the value type.+  For oneof fields: ignored (each variant carries its own).+  -}   , tfOptional :: !Bool-  -- ^ True iff the Haskell field is wrapped in 'Maybe' (and is-  -- not a oneof or repeated/map; those have their own kinds).+  {- ^ True iff the Haskell field is wrapped in 'Maybe' (and is+  not a oneof or repeated/map; those have their own kinds).+  -}   , tfRepeated :: !(Maybe RepeatedAdapter)-  -- ^ When @Just@, this field is a @repeated@ backed by the-  -- given container adapter.+  {- ^ When @Just@, this field is a @repeated@ backed by the+  given container adapter.+  -}   , tfPacked :: !(Maybe Bool)-  -- ^ Override for the packed-encoding choice on this repeated-  -- field. @Nothing@ (the default) lets the bridge decide:-  -- packable scalars (everything except @string@ \/ @bytes@ \/-  -- submessage \/ enum) get 'I.ModePacked'; non-packable-  -- elements stay unpacked. @Just True@ forces packed (only-  -- legal for packable scalars). @Just False@ forces the-  -- one-record-per-element \"expanded\" shape — useful for-  -- proto2 fields without @[packed = true]@ or for-  -- byte-compat with very old wire data.+  {- ^ Override for the packed-encoding choice on this repeated+  field. @Nothing@ (the default) lets the bridge decide:+  packable scalars (everything except @string@ \/ @bytes@ \/+  submessage \/ enum) get 'I.ModePacked'; non-packable+  elements stay unpacked. @Just True@ forces packed (only+  legal for packable scalars). @Just False@ forces the+  one-record-per-element \"expanded\" shape — useful for+  proto2 fields without @[packed = true]@ or for+  byte-compat with very old wire data.+  -}   , tfMapKey :: !(Maybe MapKeyScalar)-  -- ^ When @Just@, this field is a proto3 @map<K, V>@. The key-  -- wire encoding is supplied here; the value's wire encoding-  -- is inferred from 'tfInnerType' \/ 'tfModifiers' as usual.+  {- ^ When @Just@, this field is a proto3 @map<K, V>@. The key+  wire encoding is supplied here; the value's wire encoding+  is inferred from 'tfInnerType' \/ 'tfModifiers' as usual.+  -}   , tfIsEnum :: !Bool-  -- ^ True iff the inner type is encoded as a varint via-  -- 'fromEnum' \/ 'toEnum'. Bridges should set this for all-  -- proto enum types.+  {- ^ True iff the inner type is encoded as a varint via+  'fromEnum' \/ 'toEnum'. Bridges should set this for all+  proto enum types.+  -}   , tfOneofVariants :: ![TranslatedOneofVariant]-  -- ^ Non-empty iff this field is a proto @oneof@. Each variant-  -- pairs a sum-type constructor with its tag and payload type.+  {- ^ Non-empty iff this field is a proto @oneof@. Each variant+  pairs a sum-type constructor with its tag and payload type.+  -}   , tfStringAdapter :: !StringAdapter-  -- ^ Adapter for proto @string@ fields. Defaults to-  -- 'strictTextAdapter'. Only consulted when the field is a-  -- string-typed scalar.+  {- ^ Adapter for proto @string@ fields. Defaults to+  'strictTextAdapter'. Only consulted when the field is a+  string-typed scalar.+  -}   , tfBytesAdapter :: !BytesAdapter-  -- ^ Adapter for proto @bytes@ fields. Defaults to-  -- 'strictBytesAdapter'. Only consulted when the field is a-  -- bytes-typed scalar.+  {- ^ Adapter for proto @bytes@ fields. Defaults to+  'strictBytesAdapter'. Only consulted when the field is a+  bytes-typed scalar.+  -}   , tfModifiers :: ![Modifier]-  -- ^ Additional modifiers (tag for non-oneof fields, wire-  -- override, custom payloads, etc.). The proto backend is-  -- consulted via 'foldModifiers'.+  {- ^ Additional modifiers (tag for non-oneof fields, wire+  override, custom payloads, etc.). The proto backend is+  consulted via 'foldModifiers'.+  -}   }  @@ -265,28 +288,30 @@   { tmType :: !Type   -- ^ Fully applied type, e.g. @ConT ''Person@.   , tmConstructor :: !Name-  -- ^ Record constructor; for single-constructor records this is-  -- usually the type name.+  {- ^ Record constructor; for single-constructor records this is+  usually the type name.+  -}   , tmProtoName :: !Text   -- ^ Logical proto name returned by 'PM.messageTypeName'.   , tmFields :: ![TranslatedField]   , tmUnknownFieldsSel :: !(Maybe Name)-  -- ^ Optional selector for an @[Decode.UnknownField]@ field on-  -- the record. When set, the synthesised codecs preserve-  -- unknown tags through that slot. 'Nothing' means unknown-  -- fields are silently dropped (the original-  -- 'Proto.TH.Derive.deriveProto' behaviour).+  {- ^ Optional selector for an @[Decode.UnknownField]@ field on+  the record. When set, the synthesised codecs preserve+  unknown tags through that slot. 'Nothing' means unknown+  fields are silently dropped (the original+  'Proto.TH.Derive.deriveProto' behaviour).+  -}   }  -{- | Derive 'MessageEncode', 'MessageDecode', and 'IsMessage' for a-'TranslatedMessage' without consulting the reify graph. Intended for-IDL-driven splices that synthesise a fresh @data@ declaration alongside-the instance group.+{- | Derive 'MessageEncode', 'MessageSize', 'MessageDecode', and+'IsMessage' for a 'TranslatedMessage' without consulting the+reify graph. Intended for IDL-driven splices that synthesise a+fresh @data@ declaration alongside the instance group. -} deriveProtoFromTranslated :: TranslatedMessage -> Q [Dec] deriveProtoFromTranslated tm = do-  let meta = I.MessageMeta {I.mmUnknownFieldsSel = tmUnknownFieldsSel tm}+  let meta = I.MessageMeta {I.mmUnknownFieldsSel = tmUnknownFieldsSel tm, I.mmRecordDotReads = False}   deriveProtoFromTranslatedWith meta tm  @@ -391,10 +416,10 @@                   (Just "ByteString", _) -> I.PFScalar I.SBytes                   _ -> I.PFSubmessage             in I.oneofVariant-                (tovConstructor tov)-                vt-                (tovInnerType tov)-                vpft+                 (tovConstructor tov)+                 vt+                 (tovInnerType tov)+                 vpft   -- ---------------------------------------------------------------------------@@ -478,16 +503,19 @@ data DetectedShape   = -- | Outer container; carries the element type.     ShapeRepeated RepeatedAdapter !Type-  | -- | Outer @Map.Map K V@ where @K@ is a permitted proto map-    -- key scalar; carries the value type.+  | {- | Outer @Map.Map K V@ where @K@ is a permitted proto map+    key scalar; carries the value type.+    -}     ShapeMap !MapKeyScalar !Type-  | -- | A Haskell sum type (or @Maybe@-wrapped sum) every-    -- constructor of which has exactly one argument and a-    -- @tag N@ annotation. The variant list is built once at-    -- detect time so 'analyseField' doesn't need to re-reify.+  | {- | A Haskell sum type (or @Maybe@-wrapped sum) every+    constructor of which has exactly one argument and a+    @tag N@ annotation. The variant list is built once at+    detect time so 'analyseField' doesn't need to re-reify.+    -}     ShapeOneof !Type ![I.OneofVariant]-  | -- | Anything else: an @FKBare@ singular field, or @FKMaybe@-    -- if the outer constructor was @Maybe@.+  | {- | Anything else: an @FKBare@ singular field, or @FKMaybe@+    if the outer constructor was @Maybe@.+    -}     ShapeSingular !I.ProtoFieldKind !Type  @@ -511,8 +539,8 @@     Nothing ->       let (kind, innerTy) = unwrapMaybe fieldTy       in detectOneof selName innerTy >>= \case-          Just variants -> pure (ShapeOneof fieldTy variants)-          Nothing -> pure (ShapeSingular kind innerTy)+           Just variants -> pure (ShapeOneof fieldTy variants)+           Nothing -> pure (ShapeSingular kind innerTy)   -- | Strip a single outer 'Maybe' constructor.
src/Proto/TH/Metadata.hs view
@@ -50,8 +50,9 @@    -- * Internal helpers used by spliced code -  -- | Re-exported so the splice doesn't have to qualify them-  -- across module boundaries.+  {- | Re-exported so the splice doesn't have to qualify them+  across module boundaries.+  -}   bytesVectorToJSON,   bytesListToJSON,   parseBytesVectorMaybe,@@ -77,7 +78,6 @@ import Data.Hashable (Hashable, hashWithSalt) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Int (Int32, Int64)-import Data.IntMap.Strict qualified as IntMap import Data.Map.Strict qualified as Map import Data.Maybe qualified import Data.Reflection (Given, given)@@ -90,22 +90,15 @@ import Data.Word (Word32, Word64) import GHC.IO.Unsafe (unsafePerformIO) import Language.Haskell.TH-import Proto.Internal.Decode qualified as PD-import Proto.Google.Protobuf.WellKnownTypes.Any qualified-import Proto.Google.Protobuf.WellKnownTypes.Duration qualified-import Proto.Google.Protobuf.WellKnownTypes.Empty qualified-import Proto.Google.Protobuf.WellKnownTypes.FieldMask qualified-import Proto.Google.Protobuf.WellKnownTypes.Struct (NullValue (NullValue'NullValue))-import Proto.Google.Protobuf.WellKnownTypes.Struct qualified as PGS-import Proto.Google.Protobuf.WellKnownTypes.Timestamp qualified-import Proto.Google.Protobuf.WellKnownTypes.Wrappers qualified-import Proto.Internal.JSON (-  OneofVariantNullSemantics (-    OneofVariantNullIsUnset,-    OneofVariantNullIsValue-  ),-  parseOneofVariants,- )+import Proto.Decode qualified as PD+import Proto.Google.Protobuf.Any qualified+import Proto.Google.Protobuf.Duration qualified+import Proto.Google.Protobuf.Empty qualified+import Proto.Google.Protobuf.FieldMask qualified+import Proto.Google.Protobuf.Struct (NullValue (NullValue'NullValue))+import Proto.Google.Protobuf.Struct qualified as PGS+import Proto.Google.Protobuf.Timestamp qualified+import Proto.Google.Protobuf.Wrappers qualified import Proto.Internal.JSON qualified as PJ import Proto.Internal.JSON qualified as PJI import Proto.Internal.JSON.Extension qualified as PJExt@@ -128,37 +121,53 @@   , mfProtoName :: !Text   -- ^ Proto-side field name (snake_case).   , mfJsonName :: !Text-  -- ^ JSON key (proto3 default: camelCase form of the proto name,-  -- overridable via the @json_name@ proto option — the caller is-  -- responsible for resolving that).+  {- ^ JSON key (proto3 default: camelCase form of the proto name,+  overridable via the @json_name@ proto option — the caller is+  responsible for resolving that).+  -}   , mfNumber :: !Int   -- ^ Proto field number.   , mfTypeDesc :: !(Q Exp)-  -- ^ Splice-time builder for the field's-  -- 'Proto.Schema.FieldTypeDescriptor' literal.+  {- ^ Splice-time builder for the field's+  'Proto.Schema.FieldTypeDescriptor' literal.+  -}   , mfLabel :: !(Q Exp)-  -- ^ Splice-time builder for the field's-  -- 'Proto.Schema.FieldLabel'' literal.+  {- ^ Splice-time builder for the field's+  'Proto.Schema.FieldLabel'' literal.+  -}   , mfKind :: !MetaFieldKind-  -- ^ Container / wrap shape on the Haskell side. Drives default-  -- value, JSON encoding, and the per-shape branch in-  -- @hashWithSalt@.+  {- ^ Container / wrap shape on the Haskell side. Drives default+  value, JSON encoding, and the per-shape branch in+  @hashWithSalt@.+  -}   , mfJsonKind :: !JsonKind-  -- ^ Whether the field needs the bytes-aware JSON helpers from-  -- "Proto.Internal.JSON" (because either the value type or the map value-  -- type is @bytes@).+  {- ^ Whether the field needs the bytes-aware JSON helpers from+  "Proto.Internal.JSON" (because either the value type or the map value+  type is @bytes@).+  -}   , mfBytesShape :: !BytesShape-  -- ^ When the field carries proto @bytes@ (either directly or as-  -- the value of a @repeated bytes@ \/ @map\<K, bytes\>@), which-  -- physical 'Proto.Repr.BytesRep' it uses on the Haskell side.-  -- Drives the default-skip predicate, the toJSON helper, and-  -- the parseFieldMaybe helper picked by the JSON splice.-  -- Defaults to 'SBStrict' (and is ignored entirely for-  -- 'JKNormal' fields).+  {- ^ When the field carries proto @bytes@ (either directly or as+  the value of a @repeated bytes@ \/ @map\<K, bytes\>@), which+  physical 'Proto.Repr.BytesRep' it uses on the Haskell side.+  Drives the default-skip predicate, the toJSON helper, and+  the parseFieldMaybe helper picked by the JSON splice.+  Defaults to 'SBStrict' (and is ignored entirely for+  'JKNormal' fields).+  -}   , mfJsonShape :: !JsonShape-  -- ^ Proto3-canonical-JSON encoding shape for this field. Drives-  -- default-skip, the per-scalar @toJSON@ \/ @parseJSON@ helper,-  -- and oneof-variant key resolution.+  {- ^ Proto3-canonical-JSON encoding shape for this field. Drives+  default-skip, the per-scalar @toJSON@ \/ @parseJSON@ helper,+  and oneof-variant key resolution.+  -}+  , mfRecordDot :: !Bool+  {- ^ Read this field with record-dot syntax (@msg.field@) rather+  than a bare selector application. Set when the record was+  generated with 'Proto.CodeGen.UnprefixedFields', where bare+  field names shared across messages are ambiguous and+  'NoFieldSelectors' removes the selectors; the enclosing module+  then needs @OverloadedRecordDot@. 'False' for the default+  prefixed layout, keeping output byte-identical.+  -}   }  @@ -172,36 +181,43 @@     JSScalar !JsonScalar   | -- | @Maybe@-wrapped scalar.     JSMaybe !JsonScalar-  | -- | Singular submessage field-    --   (carrier is @Maybe T@).+  | {- | Singular submessage field+    (carrier is @Maybe T@).+    -}     JSMessage-  | -- | Singular enum field.-    --   Skip when @fromEnum x == 0@.+  | {- | Singular enum field.+    Skip when @fromEnum x == 0@.+    -}     JSEnum-  | -- | @Maybe Enum@ (proto2-    --   optional enum, proto3-    --   explicit-optional enum).+  | {- | @Maybe Enum@ (proto2+    optional enum, proto3+    explicit-optional enum).+    -}     JSEnumMaybe   | -- | Repeated scalar; skip when empty.     JSRepeatedScalar !JsonScalar-  | -- | Repeated submessage / enum;-    --   element-encoded via 'Aeson.toJSON'.+  | {- | Repeated submessage / enum;+    element-encoded via 'Aeson.toJSON'.+    -}     JSRepeatedMessage   | JSRepeatedEnum-  | -- | Map with both scalar key and-    --   scalar value. Keys always-    --   stringify (proto3 spec).+  | {- | Map with both scalar key and+    scalar value. Keys always+    stringify (proto3 spec).+    -}     JSMapScalar !JsonScalar !JsonScalar   | -- | Map with submessage values.     JSMapMessage !JsonScalar   | -- | Map with enum values.     JSMapEnum !JsonScalar-  | -- | Oneof carrier — emit at most-    --   one entry under the chosen-    --   variant's JSON key.+  | {- | Oneof carrier — emit at most+    one entry under the chosen+    variant's JSON key.+    -}     JSOneof ![OneofVariantJson]-  | -- | Singular WKT field — route-    --   through "Proto.Internal.JSON.WellKnown".+  | {- | Singular WKT field — route+    through "Proto.Internal.JSON.WellKnown".+    -}     JSWkt !WktShape   | -- | @Maybe Wkt@: skip Nothing.     JSWktMaybe !WktShape@@ -282,11 +298,12 @@   = OVScalar !JsonScalar   | OVMessage -- payload is a submessage; emit via 'Aeson.toJSON'   | OVEnum -- payload is an enum; emit via 'Aeson.toJSON'-  | -- | Oneof variant whose payload is the-    --   @google.protobuf.NullValue@ WKT. JSON-    --   @null@ is the variant's /value/ (mapped to-    --   the singleton enum constant), not the-    --   "variant unset" marker.+  | {- | Oneof variant whose payload is the+    @google.protobuf.NullValue@ WKT. JSON+    @null@ is the variant's /value/ (mapped to+    the singleton enum constant), not the+    "variant unset" marker.+    -}     OVNullValue   deriving stock (Eq, Show) @@ -301,8 +318,9 @@   | MFKList   | MFKSeq   | MFKMap-  | -- | Carrier is @Maybe SumType@ but the JSON / hash-    --   shape differs from a plain @MFKMaybe@.+  | {- | Carrier is @Maybe SumType@ but the JSON / hash+    shape differs from a plain @MFKMaybe@.+    -}     MFKOneof  @@ -313,18 +331,21 @@ data JsonKind   = -- | Standard 'Aeson.toJSON' / 'parseFieldMaybe' path.     JKNormal-  | -- | A @bytes@-typed field. JSON wants base64 via the-    -- 'PJ.bytesFieldToJSON' / 'PJ.parseBytesFieldMaybe' helpers.-    -- Pair with 'mfBytesShape' to pick the right rep-aware helper-    -- ('protoBytesToJSON' vs. 'protoLazyBytesToJSON' vs.-    -- 'protoShortBytesToJSON').+  | {- | A @bytes@-typed field. JSON wants base64 via the+    'PJ.bytesFieldToJSON' / 'PJ.parseBytesFieldMaybe' helpers.+    Pair with 'mfBytesShape' to pick the right rep-aware helper+    ('protoBytesToJSON' vs. 'protoLazyBytesToJSON' vs.+    'protoShortBytesToJSON').+    -}     JKBytes-  | -- | A @map\<K, bytes\>@ — values must base64.-    -- Currently always strict bytes; per-element rep overrides-    -- aren't honoured for map values.+  | {- | A @map\<K, bytes\>@ — values must base64.+    Currently always strict bytes; per-element rep overrides+    aren't honoured for map values.+    -}     JKBytesMap-  | -- | A @repeated bytes@ field carried as @Vector ByteString@.-    -- JSON shape is an array of base64 strings.+  | {- | A @repeated bytes@ field carried as @Vector ByteString@.+    JSON shape is an array of base64 strings.+    -}     JKBytesVector   | -- | A @repeated bytes@ field carried as @[ByteString]@.     JKBytesList@@ -368,7 +389,7 @@   -> Q [Dec] mkProtoMessageInstance tyName fqName pkg defName fields = do   descrEntries <- traverse (oneFieldDescriptor tyName) fields-  let descrMap = AppE (VarE 'IntMap.fromList) (ListE descrEntries)+  let descrMap = AppE (VarE 'Map.fromList) (ListE descrEntries)       protoNameDec =         FunD           'PS.protoMessageName@@ -394,6 +415,22 @@     ]  +-- | Read a record field expression: record-dot @msg.field@ when the+-- record uses the unprefixed layout ('NoFieldSelectors' + shared field+-- names), else the bare selector application @field msg@. The label for+-- the record-dot form is the selector's base name — the field name in+-- either layout.+dotRead :: Bool -> Name -> Name -> Exp+dotRead recDot sel msgVar+  | recDot = GetFieldE (VarE msgVar) (nameBase sel)+  | otherwise = AppE (VarE sel) (VarE msgVar)+++-- | 'dotRead' driven by a field's own 'mfRecordDot' flag.+readFieldE :: MetaField -> Name -> Exp+readFieldE mf = dotRead (mfRecordDot mf) (mfSelector mf)++ -- | One @(fieldNumber, SomeField FieldDescriptor { ... })@ pair. oneFieldDescriptor :: Name -> MetaField -> Q Exp oneFieldDescriptor tyName MetaField {..} = do@@ -401,16 +438,25 @@   vVar <- newName "v"   tdesc <- mfTypeDesc   lbl <- mfLabel-  let getter = LamE [VarP msgVar] (AppE (VarE mfSelector) (VarE msgVar))-      setter =-        LamE-          [VarP vVar, VarP msgVar]-          (RecUpdE (VarE msgVar) [(mfSelector, VarE vVar)])-      -- 'tyName' is needed to force the right setter target type-      -- (RecUpdE doesn't carry it explicitly); GHC infers it from-      -- the surrounding 'Map.fromList' literal once the FieldDescriptor-      -- is annotated.-      _ = tyName+  -- Under 'UnprefixedFields' the bare selector does not exist+  -- ('NoFieldSelectors') and an un-annotated record update is+  -- ambiguous when the field name recurs across messages, so pin the+  -- message type: read with record-dot on a typed binder, and annotate+  -- the update's *result* — a typed binder alone does not disambiguate a+  -- 'RecUpdE' inside the polymorphic 'FieldDescriptor' \/ 'SomeField'+  -- wrapper. The prefixed layout keeps the plain forms.+  let msgBinder+        | mfRecordDot = SigP (VarP msgVar) (ConT tyName)+        | otherwise = VarP msgVar+      getBody+        | mfRecordDot = GetFieldE (VarE msgVar) (nameBase mfSelector)+        | otherwise = AppE (VarE mfSelector) (VarE msgVar)+      updateE = RecUpdE (VarE msgVar) [(mfSelector, VarE vVar)]+      setBody+        | mfRecordDot = SigE updateE (ConT tyName)+        | otherwise = updateE+      getter = LamE [msgBinder] getBody+      setter = LamE [VarP vVar, msgBinder] setBody       record =         RecConE           'PS.FieldDescriptor@@ -444,24 +490,28 @@   :: Name   -- ^ Type name.   -> Text-  -- ^ Fully-qualified proto name (drives the-  --   proto2 extension JSON registry lookup).+  {- ^ Fully-qualified proto name (drives the+  proto2 extension JSON registry lookup).+  -}   -> Maybe Name-  -- ^ Unknown-fields selector ('Nothing' for-  --   types that don't carry one — currently-  --   none, but kept for forward compat).+  {- ^ Unknown-fields selector ('Nothing' for+  types that don't carry one — currently+  none, but kept for forward compat).+  -}   -> Name   -- ^ @default<Tyname>@.+  -> Bool+  -- ^ Read fields with record-dot (unprefixed layout).   -> [MetaField]   -> Q [Dec]-mkAesonInstancesForMessage tyName fqName ufSel defName fields = do-  toJSONDec <- mkToJSONForMessage tyName fqName ufSel fields-  fromJSONDec <- mkFromJSONForMessage tyName fqName ufSel defName fields+mkAesonInstancesForMessage tyName fqName ufSel defName recDot fields = do+  toJSONDec <- mkToJSONForMessage tyName fqName ufSel recDot fields+  fromJSONDec <- mkFromJSONForMessage tyName fqName ufSel defName recDot fields   pure [toJSONDec, fromJSONDec]  -mkToJSONForMessage :: Name -> Text -> Maybe Name -> [MetaField] -> Q Dec-mkToJSONForMessage tyName fqName mUfSel fields = do+mkToJSONForMessage :: Name -> Text -> Maybe Name -> Bool -> [MetaField] -> Q Dec+mkToJSONForMessage tyName fqName mUfSel recDot fields = do   msgVar <- newName "msg"   -- Each field contributes a @[(Text, Aeson.Value)]@ — a singleton   -- when we want to emit the field, an empty list when we want to@@ -478,7 +528,7 @@         Just ufN ->           AppE             (AppE (VarE 'extEntries) (textLit fqName))-            (AppE (VarE ufN) (VarE msgVar))+            (dotRead recDot ufN msgVar)       bodyExp =         AppE           (VarE 'PJ.jsonObject)@@ -487,10 +537,13 @@               (VarE '(<>))               (Just extensionEntries)           )+      ctx = case mUfSel of+        Nothing -> []+        Just _ -> [AppT (ConT ''Given) (ConT ''PJExt.ExtensionRegistry)]   pure $     InstanceD       Nothing-      []+      ctx       (AppT (ConT ''Aeson.ToJSON) (ConT tyName))       [ FunD           'Aeson.toJSON@@ -515,7 +568,7 @@ -} toJSONEntry :: Name -> MetaField -> Q Exp toJSONEntry msgVar mf =-  let fieldExpr = AppE (VarE (mfSelector mf)) (VarE msgVar)+  let fieldExpr = readFieldE mf msgVar       jsonKey = textLit (mfJsonName mf)       one valE = ListE [TupE [Just jsonKey, Just valE]]       shape = mfBytesShape mf@@ -534,70 +587,70 @@         SBLazy -> 'PJ.protoLazyBytesToJSON         SBShort -> 'PJ.protoShortBytesToJSON   in case mfJsonKind mf of-      JKBytes -> case mfKind mf of-        MFKMaybe ->-          -- @Maybe <Bytes>@ carrier (proto2 optional bytes, proto3-          -- explicit-optional bytes): emit when @Just@, skip on-          -- @Nothing@. The bytes shape picks the rep-aware-          -- 'proto*BytesToJSON' helper.-          [|-            case $(pure fieldExpr) of-              Nothing -> []-              Just bs ->-                [($(pure jsonKey), $(varE bytesToJSONN) bs)]-            |]-        _ ->-          [|-            if $(bytesIsNullE)-              then []-              else-                $( pure-                    ( one-                        (AppE (VarE bytesToJSONN) fieldExpr)-                    )-                 )-            |]-      JKBytesVector ->-        let toJSONHelper = case shape of-              SBStrict -> VarE 'bytesVectorToJSON-              SBLazy -> VarE 'lazyBytesVectorToJSON-              SBShort -> VarE 'shortBytesVectorToJSON-        in [|-            if V.null $(pure fieldExpr)-              then []-              else $(pure (one (AppE toJSONHelper fieldExpr)))-            |]-      JKBytesList ->-        let toJSONHelper = case shape of-              SBStrict -> VarE 'bytesListToJSON-              SBLazy -> VarE 'lazyBytesListToJSON-              SBShort -> VarE 'shortBytesListToJSON-        in [|-            if null $(pure fieldExpr)-              then []-              else $(pure (one (AppE toJSONHelper fieldExpr)))-            |]-      JKBytesSeq ->-        let toJSONHelper = case shape of-              SBStrict -> VarE 'bytesSeqToJSON-              SBLazy -> VarE 'lazyBytesSeqToJSON-              SBShort -> VarE 'shortBytesSeqToJSON-        in [|-            if Seq.null $(pure fieldExpr)-              then []-              else $(pure (one (AppE toJSONHelper fieldExpr)))-            |]-      JKBytesMap ->-        let mapHelper = case shape of-              SBStrict -> VarE 'PJI.bytesMapFieldToJSON-              SBLazy -> VarE 'PJ.lazyBytesMapFieldToJSON-              SBShort -> VarE 'PJ.shortBytesMapFieldToJSON-        in [|-            if Map.null $(pure fieldExpr)-              then []-              else [$(pure (AppE (AppE mapHelper jsonKey) fieldExpr))]-            |]-      JKNormal -> jsonShapeEntry msgVar mf fieldExpr jsonKey one+       JKBytes -> case mfKind mf of+         MFKMaybe ->+           -- @Maybe <Bytes>@ carrier (proto2 optional bytes, proto3+           -- explicit-optional bytes): emit when @Just@, skip on+           -- @Nothing@. The bytes shape picks the rep-aware+           -- 'proto*BytesToJSON' helper.+           [|+             case $(pure fieldExpr) of+               Nothing -> []+               Just bs ->+                 [($(pure jsonKey), $(varE bytesToJSONN) bs)]+             |]+         _ ->+           [|+             if $(bytesIsNullE)+               then []+               else+                 $( pure+                      ( one+                          (AppE (VarE bytesToJSONN) fieldExpr)+                      )+                  )+             |]+       JKBytesVector ->+         let toJSONHelper = case shape of+               SBStrict -> VarE 'bytesVectorToJSON+               SBLazy -> VarE 'lazyBytesVectorToJSON+               SBShort -> VarE 'shortBytesVectorToJSON+         in [|+              if V.null $(pure fieldExpr)+                then []+                else $(pure (one (AppE toJSONHelper fieldExpr)))+              |]+       JKBytesList ->+         let toJSONHelper = case shape of+               SBStrict -> VarE 'bytesListToJSON+               SBLazy -> VarE 'lazyBytesListToJSON+               SBShort -> VarE 'shortBytesListToJSON+         in [|+              if null $(pure fieldExpr)+                then []+                else $(pure (one (AppE toJSONHelper fieldExpr)))+              |]+       JKBytesSeq ->+         let toJSONHelper = case shape of+               SBStrict -> VarE 'bytesSeqToJSON+               SBLazy -> VarE 'lazyBytesSeqToJSON+               SBShort -> VarE 'shortBytesSeqToJSON+         in [|+              if Seq.null $(pure fieldExpr)+                then []+                else $(pure (one (AppE toJSONHelper fieldExpr)))+              |]+       JKBytesMap ->+         let mapHelper = case shape of+               SBStrict -> VarE 'PJI.bytesMapFieldToJSON+               SBLazy -> VarE 'PJ.lazyBytesMapFieldToJSON+               SBShort -> VarE 'PJ.shortBytesMapFieldToJSON+         in [|+              if Map.null $(pure fieldExpr)+                then []+                else [$(pure (AppE (AppE mapHelper jsonKey) fieldExpr))]+              |]+       JKNormal -> jsonShapeEntry msgVar mf fieldExpr jsonKey one   {- | The @JKNormal@ arm of 'toJSONEntry' factored out so the@@ -658,15 +711,15 @@           then []           else             $( pure-                ( one-                    ( AppE-                        ( AppE-                            (VarE 'scalarListToJSON)-                            (scalarTagE sc)-                        )-                        fieldExpr-                    )-                )+                 ( one+                     ( AppE+                         ( AppE+                             (VarE 'scalarListToJSON)+                             (scalarTagE sc)+                         )+                         fieldExpr+                     )+                 )              )         |]     MFKSeq ->@@ -675,15 +728,15 @@           then []           else             $( pure-                ( one-                    ( AppE-                        ( AppE-                            (VarE 'scalarSeqToJSON)-                            (scalarTagE sc)-                        )-                        fieldExpr-                    )-                )+                 ( one+                     ( AppE+                         ( AppE+                             (VarE 'scalarSeqToJSON)+                             (scalarTagE sc)+                         )+                         fieldExpr+                     )+                 )              )         |]     _ ->@@ -692,15 +745,15 @@           then []           else             $( pure-                ( one-                    ( AppE-                        ( AppE-                            (VarE 'scalarVectorToJSON)-                            (scalarTagE sc)-                        )-                        fieldExpr-                    )-                )+                 ( one+                     ( AppE+                         ( AppE+                             (VarE 'scalarVectorToJSON)+                             (scalarTagE sc)+                         )+                         fieldExpr+                     )+                 )              )         |]   JSRepeatedMessage -> case mfKind mf of@@ -747,18 +800,18 @@         then []         else           $( pure-              ( one-                  ( AppE-                      ( AppE-                          ( AppE-                              (VarE 'scalarMapToJSON)-                              (scalarTagE kSc)-                          )-                          (scalarTagE vSc)-                      )-                      fieldExpr-                  )-              )+               ( one+                   ( AppE+                       ( AppE+                           ( AppE+                               (VarE 'scalarMapToJSON)+                               (scalarTagE kSc)+                           )+                           (scalarTagE vSc)+                       )+                       fieldExpr+                   )+               )            )       |]   JSMapMessage kSc ->@@ -857,7 +910,7 @@             (PGS.listValueValues $(pure e))         )       |]-  WktAny -> [|WK.anyToJSON WK.standardWktRegistry $(pure e)|]+  WktAny -> [|WK.anyToJSON WK.anyJsonRegistry $(pure e)|]   WktEmpty -> [|WK.emptyToJSON $(pure e)|]   WktNullValue -> [|WK.nullValueToJSON $(pure e)|]   WktWrapBool -> [|WK.wrapBoolValue $(pure e)|]@@ -889,7 +942,7 @@           . PGS.listValueValues       )       |]-  WktAny -> [|WK.anyToJSON WK.standardWktRegistry|]+  WktAny -> [|WK.anyToJSON WK.anyJsonRegistry|]   WktEmpty -> [|WK.emptyToJSON|]   WktNullValue -> [|WK.nullValueToJSON|]   WktWrapBool -> [|WK.wrapBoolValue|]@@ -988,8 +1041,8 @@   mkFromJSONForMessage-  :: Name -> Text -> Maybe Name -> Name -> [MetaField] -> Q Dec-mkFromJSONForMessage tyName fqName mUfSel defName fields = do+  :: Name -> Text -> Maybe Name -> Name -> Bool -> [MetaField] -> Q Dec+mkFromJSONForMessage tyName fqName mUfSel defName recDot fields = do   objVar <- newName "obj"   fldNames <- mapM (\mf -> (,) mf <$> newName ("fld_" ++ nameBase (mfSelector mf))) fields   binds <- traverse (uncurry (parseBindStmt objVar)) fldNames@@ -997,8 +1050,11 @@       -- Build the record-update target. For empty messages we       -- can't use 'RecUpdE def []' (GHC rejects it as "Empty       -- record update"), so fall back to the bare default.+      -- Under the unprefixed layout a record update whose fields recur+      -- across messages is ambiguous; pin it with a type annotation.       baseE         | null assigns = VarE defName+        | recDot = SigE (RecUpdE (VarE defName) assigns) (ConT tyName)         | otherwise = RecUpdE (VarE defName) assigns       typeNameLit = LitE (StringL (nameBase tyName))   case mUfSel of@@ -1035,7 +1091,7 @@                 , AppE                     ( AppE                         (VarE '(<>))-                        (AppE (VarE ufN) (VarE baseVar))+                        (dotRead recDot ufN baseVar)                     )                     ufs                 )@@ -1077,7 +1133,7 @@       pure $         InstanceD           Nothing-          []+          [AppT (ConT ''Given) (ConT ''PJExt.ExtensionRegistry)]           (AppT (ConT ''Aeson.FromJSON) (ConT tyName))           [FunD 'Aeson.parseJSON [Clause [] (NormalB body) []]] @@ -1102,8 +1158,8 @@             Just (Right uf) -> Right (uf : acc)             Just (Left e) -> Left e       in case foldlEither go [] (AesonKM.toList obj) of-          Right xs -> Right (reverse xs)-          Left e -> Left e+           Right xs -> Right (reverse xs)+           Left e -> Left e   where     reg = given :: PJExt.ExtensionRegistry     foldlEither _ z [] = Right z@@ -1324,8 +1380,8 @@     finite n =       let d = Sci.toRealFloat n :: a       in if isInfinite d-          then fail ("float/double overflow: " <> show n)-          else pure d+           then fail ("float/double overflow: " <> show n)+           else pure d   {- | Parse @Maybe (Map Text v)@ where @v@ is a generated@@ -1683,21 +1739,21 @@ parseTimestampMaybe   :: Aeson.Object   -> Text-  -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.WellKnownTypes.Timestamp.Timestamp))+  -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.Timestamp.Timestamp)) parseTimestampMaybe = parseWktMaybe WK.timestampFromJSON   parseDurationMaybe   :: Aeson.Object   -> Text-  -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.WellKnownTypes.Duration.Duration))+  -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.Duration.Duration)) parseDurationMaybe = parseWktMaybe WK.durationFromJSON   parseFieldMaskMaybe   :: Aeson.Object   -> Text-  -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.WellKnownTypes.FieldMask.FieldMask))+  -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.FieldMask.FieldMask)) parseFieldMaskMaybe = parseWktMaybe WK.fieldMaskFromJSON  @@ -1740,14 +1796,14 @@ parseAnyMaybe   :: Aeson.Object   -> Text-  -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.WellKnownTypes.Any.Any))-parseAnyMaybe = parseWktMaybe (WK.anyFromJSON WK.standardWktRegistry)+  -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.Any.Any))+parseAnyMaybe = parseWktMaybe (WK.anyFromJSON WK.anyJsonRegistry)   parseEmptyMaybe   :: Aeson.Object   -> Text-  -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.WellKnownTypes.Empty.Empty))+  -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.Empty.Empty)) parseEmptyMaybe = parseWktMaybe WK.emptyFromJSON  @@ -1755,39 +1811,39 @@ parseNullValueMaybe = parseWktMaybe WK.nullValueFromJSON  -parseBoolWrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.WellKnownTypes.Wrappers.BoolValue))+parseBoolWrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.Wrappers.BoolValue)) parseBoolWrapperMaybe = parseWktMaybe WK.unwrapBoolValue  -parseInt32WrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.WellKnownTypes.Wrappers.Int32Value))+parseInt32WrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.Wrappers.Int32Value)) parseInt32WrapperMaybe = parseWktMaybe WK.unwrapInt32Value  -parseInt64WrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.WellKnownTypes.Wrappers.Int64Value))+parseInt64WrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.Wrappers.Int64Value)) parseInt64WrapperMaybe = parseWktMaybe WK.unwrapInt64Value  -parseUInt32WrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.WellKnownTypes.Wrappers.UInt32Value))+parseUInt32WrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.Wrappers.UInt32Value)) parseUInt32WrapperMaybe = parseWktMaybe WK.unwrapUInt32Value  -parseUInt64WrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.WellKnownTypes.Wrappers.UInt64Value))+parseUInt64WrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.Wrappers.UInt64Value)) parseUInt64WrapperMaybe = parseWktMaybe WK.unwrapUInt64Value  -parseFloatWrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.WellKnownTypes.Wrappers.FloatValue))+parseFloatWrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.Wrappers.FloatValue)) parseFloatWrapperMaybe = parseWktMaybe WK.unwrapFloatValue  -parseDoubleWrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.WellKnownTypes.Wrappers.DoubleValue))+parseDoubleWrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.Wrappers.DoubleValue)) parseDoubleWrapperMaybe = parseWktMaybe WK.unwrapDoubleValue  -parseStringWrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.WellKnownTypes.Wrappers.StringValue))+parseStringWrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.Wrappers.StringValue)) parseStringWrapperMaybe = parseWktMaybe WK.unwrapStringValue  -parseBytesWrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.WellKnownTypes.Wrappers.BytesValue))+parseBytesWrapperMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (Maybe Proto.Google.Protobuf.Wrappers.BytesValue)) parseBytesWrapperMaybe = parseWktMaybe WK.unwrapBytesValue  @@ -1822,15 +1878,15 @@ -- WKT vector parsers (repeated fields) -- --------------------------------------------------------------------------- -parseTimestampVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.WellKnownTypes.Timestamp.Timestamp))+parseTimestampVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.Timestamp.Timestamp)) parseTimestampVectorMaybe = parseWktVectorMaybe WK.timestampFromJSON  -parseDurationVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.WellKnownTypes.Duration.Duration))+parseDurationVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.Duration.Duration)) parseDurationVectorMaybe = parseWktVectorMaybe WK.durationFromJSON  -parseFieldMaskVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.WellKnownTypes.FieldMask.FieldMask))+parseFieldMaskVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.FieldMask.FieldMask)) parseFieldMaskVectorMaybe = parseWktVectorMaybe WK.fieldMaskFromJSON  @@ -1868,11 +1924,11 @@     Just _ -> fail "Expected JSON array for repeated ListValue"  -parseAnyVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.WellKnownTypes.Any.Any))-parseAnyVectorMaybe = parseWktVectorMaybe (WK.anyFromJSON WK.standardWktRegistry)+parseAnyVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.Any.Any))+parseAnyVectorMaybe = parseWktVectorMaybe (WK.anyFromJSON WK.anyJsonRegistry)  -parseEmptyVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.WellKnownTypes.Empty.Empty))+parseEmptyVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.Empty.Empty)) parseEmptyVectorMaybe = parseWktVectorMaybe WK.emptyFromJSON  @@ -1880,39 +1936,39 @@ parseNullValueVectorMaybe = parseWktVectorMaybe WK.nullValueFromJSON  -parseBoolWrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.WellKnownTypes.Wrappers.BoolValue))+parseBoolWrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.Wrappers.BoolValue)) parseBoolWrapperVectorMaybe = parseWktVectorMaybe WK.unwrapBoolValue  -parseInt32WrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.WellKnownTypes.Wrappers.Int32Value))+parseInt32WrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.Wrappers.Int32Value)) parseInt32WrapperVectorMaybe = parseWktVectorMaybe WK.unwrapInt32Value  -parseInt64WrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.WellKnownTypes.Wrappers.Int64Value))+parseInt64WrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.Wrappers.Int64Value)) parseInt64WrapperVectorMaybe = parseWktVectorMaybe WK.unwrapInt64Value  -parseUInt32WrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.WellKnownTypes.Wrappers.UInt32Value))+parseUInt32WrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.Wrappers.UInt32Value)) parseUInt32WrapperVectorMaybe = parseWktVectorMaybe WK.unwrapUInt32Value  -parseUInt64WrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.WellKnownTypes.Wrappers.UInt64Value))+parseUInt64WrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.Wrappers.UInt64Value)) parseUInt64WrapperVectorMaybe = parseWktVectorMaybe WK.unwrapUInt64Value  -parseFloatWrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.WellKnownTypes.Wrappers.FloatValue))+parseFloatWrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.Wrappers.FloatValue)) parseFloatWrapperVectorMaybe = parseWktVectorMaybe WK.unwrapFloatValue  -parseDoubleWrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.WellKnownTypes.Wrappers.DoubleValue))+parseDoubleWrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.Wrappers.DoubleValue)) parseDoubleWrapperVectorMaybe = parseWktVectorMaybe WK.unwrapDoubleValue  -parseStringWrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.WellKnownTypes.Wrappers.StringValue))+parseStringWrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.Wrappers.StringValue)) parseStringWrapperVectorMaybe = parseWktVectorMaybe WK.unwrapStringValue  -parseBytesWrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.WellKnownTypes.Wrappers.BytesValue))+parseBytesWrapperVectorMaybe :: Aeson.Object -> Text -> AesonT.Parser (Maybe (V.Vector Proto.Google.Protobuf.Wrappers.BytesValue)) parseBytesWrapperVectorMaybe = parseWktVectorMaybe WK.unwrapBytesValue  @@ -1941,7 +1997,7 @@     (mfSelector mf, VarE fldVar)   _ ->     -- mfSelector mf = maybe (mfSelector defName) id fld_var-    let dflt = AppE (VarE (mfSelector mf)) (VarE defName)+    let dflt = readFieldE mf defName         e = AppE (AppE (AppE (VarE 'maybe) dflt) (VarE 'id)) (VarE fldVar)     in (mfSelector mf, e) @@ -1978,32 +2034,32 @@ -} hashStep :: Name -> Exp -> MetaField -> Exp hashStep msgVar acc mf =-  let fieldExpr = AppE (VarE (mfSelector mf)) (VarE msgVar)+  let fieldExpr = readFieldE mf msgVar   in case mfKind mf of-      MFKVector ->-        AppE (AppE (AppE (VarE 'V.foldl') (VarE 'hashWithSalt)) acc) fieldExpr-      MFKList ->-        AppE (AppE (AppE (VarE 'foldl) (VarE 'hashWithSalt)) acc) fieldExpr-      MFKSeq ->-        AppE (AppE (AppE (VarE 'foldlSeq) (VarE 'hashWithSalt)) acc) fieldExpr-      MFKMap ->-        -- \s k v -> s `hashWithSalt` k `hashWithSalt` v-        let s = mkName "s"-            k = mkName "k"-            v = mkName "v"-            step =-              LamE-                [VarP s, VarP k, VarP v]-                ( AppE-                    ( AppE-                        (VarE 'hashWithSalt)-                        (AppE (AppE (VarE 'hashWithSalt) (VarE s)) (VarE k))-                    )-                    (VarE v)-                )-        in AppE (AppE (AppE (VarE 'Map.foldlWithKey') step) acc) fieldExpr-      _ ->-        AppE (AppE (VarE 'hashWithSalt) acc) fieldExpr+       MFKVector ->+         AppE (AppE (AppE (VarE 'V.foldl') (VarE 'hashWithSalt)) acc) fieldExpr+       MFKList ->+         AppE (AppE (AppE (VarE 'foldl) (VarE 'hashWithSalt)) acc) fieldExpr+       MFKSeq ->+         AppE (AppE (AppE (VarE 'foldlSeq) (VarE 'hashWithSalt)) acc) fieldExpr+       MFKMap ->+         -- \s k v -> s `hashWithSalt` k `hashWithSalt` v+         let s = mkName "s"+             k = mkName "k"+             v = mkName "v"+             step =+               LamE+                 [VarP s, VarP k, VarP v]+                 ( AppE+                     ( AppE+                         (VarE 'hashWithSalt)+                         (AppE (AppE (VarE 'hashWithSalt) (VarE s)) (VarE k))+                     )+                     (VarE v)+                 )+         in AppE (AppE (AppE (VarE 'Map.foldlWithKey') step) acc) fieldExpr+       _ ->+         AppE (AppE (VarE 'hashWithSalt) acc) fieldExpr   {- | A 'Data.List.foldl''-shaped foldl over a 'Seq', exposed as a@@ -2428,12 +2484,14 @@   -> Text   -- ^ Fully-qualified proto enum name.   -> [(Name, Text, Int)]-  -- ^ @(haskellCon, protoName, evNumber)@-  --   for every declared value (aliases-  --   included).+  {- ^ @(haskellCon, protoName, evNumber)@+  for every declared value (aliases+  included).+  -}   -> Name-  -- ^ Synthetic @<EnumName>'Unknown !Int32@-  --   constructor for open-enum semantics.+  {- ^ Synthetic @<EnumName>'Unknown !Int32@+  constructor for open-enum semantics.+  -}   -> Q Dec mkProtoEnumInstance tyName fqName values unknownCon = do   nVar <- newName "n"@@ -2458,15 +2516,15 @@     -- yields its carried int.     toClauses =       [ Clause-        [ConP con [] []]-        (NormalB (intLit num))-        []+          [ConP con [] []]+          (NormalB (intLit num))+          []       | (con, _, num) <- values       ]         <> [ Clause-              [ConP unknownCon [] [VarP nVar]]-              (NormalB (AppE (VarE 'fromIntegral) (VarE nVar)))-              []+               [ConP unknownCon [] [VarP nVar]]+               (NormalB (AppE (VarE 'fromIntegral) (VarE nVar)))+               []            ]     toDec = FunD 'PS.toProtoEnumValue toClauses     -- fromProtoEnumValue: one Just clause per primary number,@@ -2483,20 +2541,20 @@         )         primaries         <> [ Clause-              [VarP nVar]-              ( NormalB-                  ( AppE-                      (ConE 'Just)-                      ( AppE-                          (ConE unknownCon)-                          ( SigE-                              (AppE (VarE 'fromIntegral) (VarE nVar))-                              (ConT ''Int32)-                          )-                      )-                  )-              )-              []+               [VarP nVar]+               ( NormalB+                   ( AppE+                       (ConE 'Just)+                       ( AppE+                           (ConE unknownCon)+                           ( SigE+                               (AppE (VarE 'fromIntegral) (VarE nVar))+                               (ConT ''Int32)+                           )+                       )+                   )+               )+               []            ]     fromDec = FunD 'PS.fromProtoEnumValue fromClauses   pure $@@ -2528,18 +2586,18 @@   let primaries = primaryByNumber values       toClauses =         [ Clause-          [ConP con [] []]-          (NormalB (AppE (ConE 'Aeson.String) (textLit pname)))-          []+            [ConP con [] []]+            (NormalB (AppE (ConE 'Aeson.String) (textLit pname)))+            []         | (con, pname, _) <- primaries         ]           -- Open-enum representation: @<EnumName>'Unknown n@           -- serialises as the bare numeric value (proto3           -- canonical-JSON for unrecognised enum values).           <> [ Clause-                [ConP unknownCon [] [VarP nVar]]-                (NormalB (AppE (VarE 'Aeson.toJSON) (VarE nVar)))-                []+                 [ConP unknownCon [] [VarP nVar]]+                 (NormalB (AppE (VarE 'Aeson.toJSON) (VarE nVar)))+                 []              ]       toDec = FunD 'Aeson.toJSON toClauses @@ -2552,9 +2610,9 @@       -- conformance tests).       stringClauses =         [ Match-          (ConP 'Aeson.String [] [LitP (StringL (T.unpack pname))])-          (NormalB (AppE (VarE 'pure) (ConE con)))-          []+            (ConP 'Aeson.String [] [LitP (StringL (T.unpack pname))])+            (NormalB (AppE (VarE 'pure) (ConE con)))+            []         | (con, pname, _) <- values         ]       -- 'toEnum' is the open-enum-aware constructor: known@@ -2738,11 +2796,41 @@     isPrefixOf p s = take (length p) s == p  --- 'OneofVariantNullSemantics' and 'parseOneofVariants' moved to--- "Proto.Internal.JSON" so the pure-text codegen can share the--- helper. They're re-imported (and re-exported) here for--- back-compat with downstream code that referenced them via--- 'Proto.TH.Metadata'.+{- | Per-variant interpretation of JSON @null@ for oneofs. For+most variants, @null@ means "this variant is unset" (proto3+spec). For a 'google.protobuf.NullValue' variant, @null@+is the variant's value.+-}+data OneofVariantNullSemantics+  = OneofVariantNullIsUnset+  | OneofVariantNullIsValue+++{- | Runtime helper backing 'buildOneofParseExp'. Lives outside+the splice so the 'parseFnFor' table doesn't have to.+-}+parseOneofVariants+  :: Aeson.Object+  -> [(Text, OneofVariantNullSemantics, Aeson.Value -> AesonT.Parser a)]+  -> AesonT.Parser (Maybe a)+parseOneofVariants obj variants =+  let present =+        [ (k, v, p)+        | (k, sem, p) <- variants+        , Just v <- [AesonKM.lookup (AesonKey.fromText k) obj]+        , keep sem v+        ]+      keep OneofVariantNullIsUnset Aeson.Null = False+      keep _ _ = True+  in case present of+       [] -> pure Nothing+       [(_, v, p)] -> Just <$> p v+       _ ->+         fail+           ( "Multiple oneof variants set: "+               <> show (fmap (\(k, _, _) -> k) present)+           )+{-# INLINE parseOneofVariants #-}   -- ---------------------------------------------------------------------------
src/Proto/TH/QQ.hs view
@@ -26,7 +26,7 @@ import Data.Text qualified as T import Language.Haskell.TH import Language.Haskell.TH.Quote-+import Proto.IDL.AST (stripSpans) import Proto.IDL.Parser (parseProtoFile, renderParseError) import Proto.TH (protoFileToDecls)
src/Proto/TextFormat.hs view
@@ -23,32 +23,25 @@    -- * Parsing   textToDynamic,-  textToTyped,    -- * Text format value type   TextValue (..),   TextField (..), ) where -import Data.Aeson ((.=))-import Data.Aeson qualified as A-import Data.Aeson.Key qualified as AesonKey import Data.ByteString.Base16 qualified as Base16-import Data.ByteString.Base64 qualified as B64 import Data.ByteString.Lazy qualified as BL import Data.Char (isDigit) import Data.Int (Int64)-import Data.IntMap.Strict qualified as IntMap import Data.Map.Strict qualified as Map import Data.Proxy (Proxy) import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding qualified as TE import Data.Text.Read qualified as TR-import Data.Vector qualified as V import Data.Word (Word64) import Proto.Dynamic-import Proto qualified as PE+import Proto.Encode qualified as PE import Proto.Schema qualified as PS import Wireform.Builder qualified as BB @@ -87,10 +80,6 @@ 'dynamicToTextPretty' produces). Resolves the names from the message's 'PS.ProtoMessage' descriptor. -Returns 'Nothing' only if re-encoding the message and decoding it-back as a dynamic message fails, which should never happen in-practice for a well-formed value.- Implementation: re-encodes the typed value to bytes (so we have a single source of truth for the wire shape), decodes those bytes as a 'DynamicMessage', and walks the result with@@ -101,22 +90,22 @@    . (PE.MessageEncode a, PS.ProtoMessage a)   => Proxy a   -> a-  -> Maybe Text+  -> Text typedToTextPretty p msg =   let !bytes = BL.toStrict (BB.toLazyByteString (PE.buildMessage msg))   in case decodeDynamic bytes of-      Left _ -> Nothing-      Right dyn ->-        let descriptors = PS.protoFieldDescriptors p-            nameOf fn = case IntMap.lookup fn descriptors of-              Just (PS.SomeField fd) -> PS.fdName fd-              Nothing -> intToText fn-        in Just (renderDynNamed nameOf 0 dyn)+       Left _ -> "" -- shouldn't happen: we just re-encoded a valid value+       Right dyn ->+         let descriptors = PS.protoFieldDescriptors p+             nameOf fn = case Map.lookup fn descriptors of+               Just (PS.SomeField fd) -> PS.fdName fd+               Nothing -> intToText fn+         in renderDynNamed nameOf 0 dyn   renderDynNamed :: (Int -> Text) -> Int -> DynamicMessage -> Text renderDynNamed nameOf depth (DynamicMessage fs _) =-  IntMap.foldlWithKey'+  Map.foldlWithKey'     ( \acc fn val ->         acc <> renderDynField depth True (nameOf fn) val <> "\n"     )@@ -128,7 +117,7 @@ renderDyn depth pretty (DynamicMessage fs _) =   let sep = if pretty then "\n" else " "       fieldTexts =-        IntMap.foldlWithKey'+        Map.foldlWithKey'           ( \acc fn val ->               acc <> renderDynField depth pretty (intToText fn) val <> sep           )@@ -141,34 +130,34 @@ renderDynField depth pretty name val =   let ind = if pretty then T.replicate (depth * 2) " " else ""   in case val of-      DynMessage m ->-        ind-          <> name-          <> " {"-          <> (if pretty then "\n" else " ")-          <> renderDyn (depth + 1) pretty m-          <> (if pretty then T.replicate (depth * 2) " " else "")-          <> "}"-      DynRepeated vs ->-        T.concat-          ( fmap-              ( \v ->-                  renderDynField depth pretty name v-                    <> (if pretty then "\n" else " ")-              )-              vs-          )-      DynString s -> ind <> name <> ": \"" <> escapeText s <> "\""-      DynBytes bs -> ind <> name <> ": \"" <> TE.decodeUtf8 (Base16.encode bs) <> "\""-      DynBool b -> ind <> name <> ": " <> (if b then "true" else "false")-      DynVarint v -> ind <> name <> ": " <> word64ToText v-      DynSVarint v -> ind <> name <> ": " <> int64ToText v-      DynFixed32 v -> ind <> name <> ": " <> word64ToText (fromIntegral v)-      DynFixed64 v -> ind <> name <> ": " <> word64ToText v-      DynFloat v -> ind <> name <> ": " <> T.pack (show v)-      DynDouble v -> ind <> name <> ": " <> T.pack (show v)-      DynEnum v -> ind <> name <> ": " <> intToText v-      DynMap _ -> ind <> name <> " {}"+       DynMessage m ->+         ind+           <> name+           <> " {"+           <> (if pretty then "\n" else " ")+           <> renderDyn (depth + 1) pretty m+           <> (if pretty then T.replicate (depth * 2) " " else "")+           <> "}"+       DynRepeated vs ->+         T.concat+           ( fmap+               ( \v ->+                   renderDynField depth pretty name v+                     <> (if pretty then "\n" else " ")+               )+               vs+           )+       DynString s -> ind <> name <> ": \"" <> escapeText s <> "\""+       DynBytes bs -> ind <> name <> ": \"" <> TE.decodeUtf8 (Base16.encode bs) <> "\""+       DynBool b -> ind <> name <> ": " <> (if b then "true" else "false")+       DynVarint v -> ind <> name <> ": " <> word64ToText v+       DynSVarint v -> ind <> name <> ": " <> int64ToText v+       DynFixed32 v -> ind <> name <> ": " <> word64ToText (fromIntegral v)+       DynFixed64 v -> ind <> name <> ": " <> word64ToText v+       DynFloat v -> ind <> name <> ": " <> T.pack (show v)+       DynDouble v -> ind <> name <> ": " <> T.pack (show v)+       DynEnum v -> ind <> name <> ": " <> intToText v+       DynMap _ -> ind <> name <> " {}"   escapeText :: Text -> Text@@ -190,93 +179,6 @@   Left e -> Left e  -{- | Parse a proto text format (@pbtxt@) string into a typed message.--Uses the 'PS.ProtoMessage' schema to map field names to field numbers-and wire types, then converts through the proto3 JSON mapping-(via 'fromJSON') to produce the typed value.--Limitations:--  * Bytes fields at the top level are handled correctly: the raw-    string from the text format is re-encoded as base64 for the-    JSON path. Bytes inside nested submessages are passed through-    as-is; callers should pre-encode nested bytes values as base64.--  * Proto text format extensions (@[foo.bar]: value@) and unknown-    fields are silently ignored.--  * Repeated fields with scalar payloads listed on a single line-    (packed text format) are not supported; each element must appear-    as a separate @field: value@ line.--Returns 'Left' on parse failure or if 'fromJSON' rejects the value.--}-textToTyped-  :: forall a-   . (A.FromJSON a, PS.ProtoMessage a)-  => Proxy a-  -> Text-  -> Either String a-textToTyped p src = do-  (fields, _) <- parseFields (T.strip src)-  let schema  = PS.protoFieldDescriptors p-      nameMap = buildNameMap schema-      jsonVal = textFieldsToJSON nameMap fields-  case A.fromJSON jsonVal of-    A.Error e   -> Left ("JSON decode failed: " <> e)-    A.Success a -> Right a----- | Build a field-name → 'PS.FieldTypeDescriptor' map from the schema.-buildNameMap :: IntMap.IntMap (PS.SomeFieldDescriptor a) -> Map.Map Text PS.FieldTypeDescriptor-buildNameMap =-  IntMap.foldl'-    (\acc (PS.SomeField fd) -> Map.insert (PS.fdName fd) (PS.fdTypeDesc fd) acc)-    Map.empty----- | Convert a list of text format fields to an Aeson 'A.Value' (always an Object).--- Repeated fields (multiple entries with the same name) are collected into an Array.-textFieldsToJSON :: Map.Map Text PS.FieldTypeDescriptor -> [TextField] -> A.Value-textFieldsToJSON nameMap fields =-  let grouped =-        foldl-          (\acc tf -> Map.insertWith (<>) (tfName tf) [tfValue tf] acc)-          Map.empty-          fields-  in A.object-      [ AesonKey.fromText name .= valToJSON (Map.lookup name nameMap) vals-      | (name, vals) <- Map.toList grouped-      ]---valToJSON :: Maybe PS.FieldTypeDescriptor -> [TextValue] -> A.Value-valToJSON mftd vals =-  let conv = textValueToJSON mftd-  in case vals of-      [v] -> conv v-      vs  -> A.Array (V.fromList (fmap conv vs))---textValueToJSON :: Maybe PS.FieldTypeDescriptor -> TextValue -> A.Value-textValueToJSON mftd = \case-  TVString s ->-    case mftd of-      Just (PS.ScalarType PS.BytesField) ->-        -- Bytes in text format are raw strings; JSON needs base64.-        A.String (TE.decodeUtf8 (B64.encode (TE.encodeUtf8 s)))-      _ -> A.String s-  TVNumber n  -> A.Number (realToFrac n)-  TVInteger n -> A.Number (fromInteger n)-  TVBool b    -> A.Bool b-  TVIdent t   -> A.String t  -- enum name or bare identifier-  TVMessage subfields ->-    -- Nested message: recurse without sub-schema (bytes inside nested-    -- messages are passed through as-is; callers should pre-encode them).-    textFieldsToJSON Map.empty subfields-- fieldsToDynamic :: [TextField] -> DynamicMessage fieldsToDynamic tfs =   let numbered =@@ -286,7 +188,7 @@               _ -> (0, textValueToDyn (tfValue tf))           )           tfs-  in DynamicMessage (IntMap.fromList numbered) []+  in DynamicMessage (Map.fromList numbered) []   textValueToDyn :: TextValue -> DynamicValue@@ -305,10 +207,10 @@     go acc t =       let s = T.stripStart t       in if T.null s || T.head s == '}'-          then Right (reverse acc, s)-          else case parseField s of-            Right (f, rest) -> go (f : acc) rest-            Left e -> Left e+           then Right (reverse acc, s)+           else case parseField s of+             Right (f, rest) -> go (f : acc) rest+             Left e -> Left e   parseField :: Text -> Either String (TextField, Text)@@ -369,12 +271,12 @@ parseTextNumber t =   let (numStr, rest) = T.span (\c -> c == '-' || c == '+' || c == '.' || c == 'e' || c == 'E' || isDigit c) t   in if T.any (== '.') numStr || T.any (\c -> c == 'e' || c == 'E') numStr-      then case TR.signed TR.double numStr of-        Right (n, leftover) | T.null leftover -> Right (TVNumber n, rest)-        _ -> Left ("Invalid number: " <> T.unpack numStr)-      else case TR.signed TR.decimal numStr of-        Right (n, leftover) | T.null leftover -> Right (TVInteger n, rest)-        _ -> Left ("Invalid integer: " <> T.unpack numStr)+       then case TR.signed TR.double numStr of+         Right (n, leftover) | T.null leftover -> Right (TVNumber n, rest)+         _ -> Left ("Invalid number: " <> T.unpack numStr)+       else case TR.signed TR.decimal numStr of+         Right (n, leftover) | T.null leftover -> Right (TVInteger n, rest)+         _ -> Left ("Invalid integer: " <> T.unpack numStr)   intToText :: Int -> Text
test-conformance/Driver.hs view
@@ -1,104 +1,119 @@ {-# LANGUAGE OverloadedStrings #-} --- | Tasty driver for the upstream protobuf conformance suite.------ The suite is a separate test target ('protobuf-conformance-test')--- because it depends on an external binary (the upstream--- @conformance_test_runner@ from--- <https://github.com/protocolbuffers/protobuf>) that we can't--- ship through Hackage.------ == How the suite finds the runner------ 1. If the @CONFORMANCE_TEST_RUNNER@ environment variable points---    at an executable, that's used.--- 2. Otherwise, look for the runner under---    @dist-newstyle/conformance/conformance_test_runner@. The---    helper script @scripts\/build-conformance-runner.sh@ clones---    + builds the upstream tree to that location.--- 3. Otherwise, the suite skips with an instructive message.------ The skip path keeps the test green in environments without a--- C++ toolchain or network (CI sandboxes, fresh dev VMs, etc.).--- A non-skipped run rebuilds @wireform-conformance-runner@ via--- @cabal list-bin@ and pipes it to the upstream runner.------ == What \"pass\" means------ The upstream runner emits one summary line of the form------ @--- CONFORMANCE TEST BEGIN ====================================--- ...--- CONFORMANCE SUITE PASSED: ... successes, ... skipped.--- @------ (or @FAILED@). We assert on the @PASSED@ marker, capturing the--- runner's stderr into the test failure when the assertion--- fires so the failure list is visible without re-running.------ A small @failure_list_proto3.txt@ file lists tests we--- knowingly don't support (JSON conformance for messages whose--- schema we omit; JSPB; TEXT_FORMAT). The runner's--- @--failure_list@ flag treats those as expected failures so the--- net assertion is on regressions rather than absolute coverage.+{- | Tasty driver for the upstream protobuf conformance suite.++The suite is a separate test target ('protobuf-conformance-test')+because it depends on an external binary (the upstream+@conformance_test_runner@ from+<https://github.com/protocolbuffers/protobuf>) that we can't+ship through Hackage.++== How the suite finds the runner++1. If the @CONFORMANCE_TEST_RUNNER@ environment variable points+   at an executable, that's used.+2. Otherwise, look for the runner under+   @dist-newstyle/conformance/conformance_test_runner@. The+   helper script @scripts\/build-conformance-runner.sh@ clones+   + builds the upstream tree to that location.+3. Otherwise, the suite skips with an instructive message.++The skip path keeps the test green in environments without a+C++ toolchain or network (CI sandboxes, fresh dev VMs, etc.).+A non-skipped run rebuilds @wireform-conformance-runner@ via+@cabal list-bin@ and pipes it to the upstream runner.++== What \"pass\" means++The upstream runner emits one summary line of the form++@+CONFORMANCE TEST BEGIN ====================================+...+CONFORMANCE SUITE PASSED: ... successes, ... skipped.+@++(or @FAILED@). We assert on the @PASSED@ marker, capturing the+runner's stderr into the test failure when the assertion+fires so the failure list is visible without re-running.++A small @failure_list_proto3.txt@ file lists tests we+knowingly don't support (JSON conformance for messages whose+schema we omit; JSPB; TEXT_FORMAT). The runner's+@--failure_list@ flag treats those as expected failures so the+net assertion is on regressions rather than absolute coverage.+-} module Main (main) where  import Control.Exception (IOException, try)-import qualified Data.ByteString.Char8 as BS8-import System.Directory (doesFileExist, getPermissions, executable)+import Data.ByteString.Char8 qualified as BS8+import Data.Maybe qualified+import System.Directory (doesFileExist, executable, getPermissions) import System.Environment (lookupEnv) import System.Exit (ExitCode (..)) import System.FilePath ((</>)) import System.IO (hPutStrLn, stderr)-import System.Process-  ( CreateProcess (..)-  , StdStream (..)-  , createProcess-  , proc-  , waitForProcess-  )-import qualified Data.Maybe+import System.Process (+  CreateProcess (..),+  StdStream (..),+  createProcess,+  proc,+  waitForProcess,+ )+import Test.Syd -import Test.Tasty (TestTree, defaultMain, testGroup)-import Test.Tasty.HUnit (assertFailure, testCase)  main :: IO ()-main = defaultMain =<< buildTree+main = sydTest =<< buildTree -buildTree :: IO TestTree++buildTree :: IO Spec buildTree = do   mRunner <- locateUpstreamRunner   case mRunner of-    Nothing -> pure (testGroup "protobuf-conformance"-      [ testCase "skipped (no upstream runner)" $ do-          hPutStrLn stderr ""-          hPutStrLn stderr instructions-      ])-    Just runner -> pure (testGroup "protobuf-conformance"-      [ testCase ("upstream runner: " <> runner) (runConformance runner) ])+    Nothing ->+      pure+        ( describe "protobuf-conformance" $+            sequence_+              [ it "skipped (no upstream runner)" $ do+                  hPutStrLn stderr ""+                  hPutStrLn stderr instructions+              ]+        )+    Just runner ->+      pure+        ( describe "protobuf-conformance" $+            sequence_+              [it ("upstream runner: " <> runner) (runConformance runner)]+        ) --- | Probe order: @CONFORMANCE_TEST_RUNNER@ env var first, then--- the helper-script's default install path.++{- | Probe order: @CONFORMANCE_TEST_RUNNER@ env var first, then+the helper-script's default install path.+-} locateUpstreamRunner :: IO (Maybe FilePath) locateUpstreamRunner = do   envPath <- lookupEnv "CONFORMANCE_TEST_RUNNER"   case envPath of-    Just p  -> ifExists p+    Just p -> ifExists p     Nothing -> ifExists defaultRunnerPath + defaultRunnerPath :: FilePath defaultRunnerPath =   "dist-newstyle" </> "conformance" </> "conformance_test_runner" + ifExists :: FilePath -> IO (Maybe FilePath) ifExists p = do   exists <- doesFileExist p-  if not exists then pure Nothing-  else do-    perm <- getPermissions p-    pure (if executable perm then Just p else Nothing)+  if not exists+    then pure Nothing+    else do+      perm <- getPermissions p+      pure (if executable perm then Just p else Nothing) + instructions :: String instructions =   unlines@@ -112,51 +127,64 @@     , "    cabal test wireform-proto:protobuf-conformance-test"     ] --- | Locate the freshly-built @wireform-conformance-runner@--- binary via @cabal list-bin@. This is more reliable than--- guessing dist-newstyle paths (which differ by GHC version,--- platform, and project file), and it'll refuse to run if the--- binary isn't built.++{- | Locate the freshly-built @wireform-conformance-runner@+binary via @cabal list-bin@. This is more reliable than+guessing dist-newstyle paths (which differ by GHC version,+platform, and project file), and it'll refuse to run if the+binary isn't built.+-} locateWireformRunner :: IO (Either String FilePath) locateWireformRunner = do   res <- try @IOException $ do-    (_, _, _, ph) <- createProcess-      (proc "cabal" ["build", "wireform-proto:exe:wireform-conformance-runner"])-        { std_out = Inherit, std_err = Inherit }+    (_, _, _, ph) <-+      createProcess+        (proc "cabal" ["build", "wireform-proto:exe:wireform-conformance-runner"])+          { std_out = Inherit+          , std_err = Inherit+          }     code <- waitForProcess ph     case code of       ExitSuccess -> pure ()       _ -> error "cabal build wireform-conformance-runner failed" -    (_, mout, _, ph2) <- createProcess-      (proc "cabal" ["list-bin", "wireform-proto:exe:wireform-conformance-runner"])-        { std_out = CreatePipe, std_err = Inherit }+    (_, mout, _, ph2) <-+      createProcess+        (proc "cabal" ["list-bin", "wireform-proto:exe:wireform-conformance-runner"])+          { std_out = CreatePipe+          , std_err = Inherit+          }     code2 <- waitForProcess ph2     case code2 of       ExitSuccess -> pure ()       _ -> error "cabal list-bin failed"     case mout of       Nothing -> error "cabal list-bin produced no output"-      Just h  -> do+      Just h -> do         bs <- BS8.hGetContents h         case lines (BS8.unpack bs) of-          (path:_) -> pure path-          []       -> error "cabal list-bin returned empty"-  pure (case res of-          Left e  -> Left (show e)-          Right p -> Right p)+          (path : _) -> pure path+          [] -> error "cabal list-bin returned empty"+  pure+    ( case res of+        Left e -> Left (show e)+        Right p -> Right p+    ) + runConformance :: FilePath -> IO () runConformance runner = do   eRunnerBin <- locateWireformRunner   case eRunnerBin of-    Left e -> assertFailure ("could not build wireform-conformance-runner: " <> e)+    Left e -> expectationFailure ("could not build wireform-conformance-runner: " <> e)     Right wireformBin -> do       failureList <- failureListPath-      let args = [ "--enforce_recommended"-                 , "--failure_list", failureList-                 , wireformBin-                 ]+      let args =+            [ "--enforce_recommended"+            , "--failure_list"+            , failureList+            , wireformBin+            ]       hPutStrLn stderr ("> " <> runner <> " " <> unwords args)       -- Capture stderr so we can salvage a real pass/fail       -- decision from the summary line. The runner exits non-zero@@ -164,8 +192,12 @@       -- when one iteration of the suite skips a test that another       -- iteration's failure list references). Those are noise; the       -- actual signal is "N unexpected failures" in the summary.-      (_, _, Just hErr, ph) <- createProcess (proc runner args)-        { std_out = Inherit, std_err = CreatePipe }+      (_, _, Just hErr, ph) <-+        createProcess+          (proc runner args)+            { std_out = Inherit+            , std_err = CreatePipe+            }       errBytes <- BS8.hGetContents hErr       hPutStrLn stderr (BS8.unpack errBytes)       code <- waitForProcess ph@@ -176,47 +208,55 @@           -- Exit non-zero is the runner complaining about           -- "doesn't exist" entries in the failure list; that's           -- a stale-list issue, not a wireform regression.-          hPutStrLn stderr+          hPutStrLn+            stderr             "upstream runner exited non-zero but reported 0 unexpected failures; \             \treating as PASS."-        (ExitFailure n, _) -> assertFailure-          ("upstream conformance_test_runner exited with code "-            <> show n-            <> "; failures listed above. See "-            <> failureList-            <> " to add expected failures.")+        (ExitFailure n, _) ->+          expectationFailure+            ( "upstream conformance_test_runner exited with code "+                <> show n+                <> "; failures listed above. See "+                <> failureList+                <> " to add expected failures."+            ) --- | Parse the runner's @CONFORMANCE SUITE (PASSED|FAILED): N successes, ...,--- M unexpected failures.@ summary line out of stderr. Returns--- 'Nothing' if the line isn't found (treat as a failure to be safe).++{- | Parse the runner's @CONFORMANCE SUITE (PASSED|FAILED): N successes, ...,+M unexpected failures.@ summary line out of stderr. Returns+'Nothing' if the line isn't found (treat as a failure to be safe).+-} parseUnexpectedFailures :: BS8.ByteString -> Maybe Int parseUnexpectedFailures bs =   let summaryLine =         Data.Maybe.listToMaybe-          [ l | l <- BS8.lines bs, BS8.isInfixOf (BS8.pack "unexpected failures") l ]+          [l | l <- BS8.lines bs, BS8.isInfixOf (BS8.pack "unexpected failures") l]   in case summaryLine of-    Nothing -> Nothing-    Just l  ->-      -- Extract the integer immediately preceding " unexpected failures".-      let parts = BS8.split ',' l-          uf   = filter (BS8.isInfixOf (BS8.pack "unexpected failures")) parts-      in case uf of-        (x:_) -> case BS8.words x of-          (n:_) -> Just (read (BS8.unpack n))-          _     -> Nothing-        _     -> Nothing+       Nothing -> Nothing+       Just l ->+         -- Extract the integer immediately preceding " unexpected failures".+         let parts = BS8.split ',' l+             uf = filter (BS8.isInfixOf (BS8.pack "unexpected failures")) parts+         in case uf of+              (x : _) -> case BS8.words x of+                (n : _) -> Just (read (BS8.unpack n))+                _ -> Nothing+              _ -> Nothing + failureListPath :: IO FilePath failureListPath = do   envPath <- lookupEnv "CONFORMANCE_FAILURE_LIST"   case envPath of-    Just p  -> pure p+    Just p -> pure p     Nothing -> pickDefaultFailureList --- | The default failure-list path is hairier than it looks--- because cabal's test runner doesn't fix the working--- directory in any consistent way across versions. Try several--- candidates in order of likelihood.++{- | The default failure-list path is hairier than it looks+because cabal's test runner doesn't fix the working+directory in any consistent way across versions. Try several+candidates in order of likelihood.+-} pickDefaultFailureList :: IO FilePath pickDefaultFailureList = do   let candidates =@@ -224,8 +264,8 @@         , "test-conformance" </> "failure_list_proto3.txt"         , ".." </> "test-conformance" </> "failure_list_proto3.txt"         ]-      first []     = pure (head candidates)  -- give up; runner will say-      first (c:cs) = do+      first [] = pure (head candidates) -- give up; runner will say+      first (c : cs) = do         ex <- doesFileExist c         if ex then pure c else first cs   first candidates
test-conformance/Runner.hs view
@@ -30,8 +30,8 @@ import Data.Proxy (Proxy (..)) import Data.Text qualified as T import Data.Word (Word32)-import Proto qualified as PD-import Proto qualified as PE+import Proto.Decode qualified as PD+import Proto.Encode qualified as PE import Proto.Internal.JSON.WellKnown qualified as WK import Proto.Registry (AnyCodec (..), TypeRegistry, registerCodec) import System.IO (
test-conformance/Test/Conformance/Handler.hs view
@@ -45,8 +45,8 @@ import Data.Text qualified as T import Data.Text.Lazy qualified as TL import Data.Text.Lazy.Encoding qualified as TLE-import Proto qualified as PD-import Proto qualified as PE+import Proto.Decode qualified as PD+import Proto.Encode qualified as PE import Proto.Internal.JSON.Extension qualified as PJExt import Proto.TH.Metadata qualified as PTM import Proto.TextFormat qualified as PTF@@ -79,9 +79,9 @@ failureSetResponse =   let payload = PE.encodeMessage defaultFailureSet   in defaultConformanceResponse-      { conformanceResponseResult =-          Just (ConformanceResponse'Result'ProtobufPayload payload)-      }+       { conformanceResponseResult =+           Just (ConformanceResponse'Result'ProtobufPayload payload)+       }   handleTestAllTypesProto3 :: ConformanceRequest -> IO ConformanceResponse@@ -167,19 +167,16 @@                         (ConformanceResponse'Result'JsonPayload t)                   }   WireFormat'TextFormat -> trySerialize "TEXT_FORMAT" $ do-    pbtxt <- evaluate (PTF.typedToTextPretty (Proxy :: Proxy TestAllTypesProto3) tm)-    case pbtxt of-      Nothing -> pure (serializeError "TEXT_FORMAT: re-encode/decode failed")-      Just t ->-        pure-          defaultConformanceResponse-            { conformanceResponseResult =-                Just-                  (ConformanceResponse'Result'TextPayload t)-            }+    !pbtxt <- evaluate (PTF.typedToTextPretty (Proxy :: Proxy TestAllTypesProto3) tm)+    pure+      defaultConformanceResponse+        { conformanceResponseResult =+            Just+              (ConformanceResponse'Result'TextPayload pbtxt)+        }   WireFormat'Jspb -> pure (skipped "JSPB output not supported")   WireFormat'Unspecified -> pure (serializeError "UNSPECIFIED requested_output_format")-  WireFormat'Unknown _ -> pure (serializeError "Unknown WireFormat enum value")+  WireFormat''Unrecognized _ -> pure (serializeError "Unknown WireFormat enum value")   {- | Wrap an IO action that builds a 'ConformanceResponse' so@@ -267,19 +264,16 @@                         (ConformanceResponse'Result'JsonPayload t)                   }   WireFormat'TextFormat -> trySerialize "TEXT_FORMAT" $ do-    pbtxt <- evaluate (PTF.typedToTextPretty (Proxy :: Proxy TestAllTypesProto2) tm)-    case pbtxt of-      Nothing -> pure (serializeError "TEXT_FORMAT: re-encode/decode failed")-      Just t ->-        pure-          defaultConformanceResponse-            { conformanceResponseResult =-                Just-                  (ConformanceResponse'Result'TextPayload t)-            }+    !pbtxt <- evaluate (PTF.typedToTextPretty (Proxy :: Proxy TestAllTypesProto2) tm)+    pure+      defaultConformanceResponse+        { conformanceResponseResult =+            Just+              (ConformanceResponse'Result'TextPayload pbtxt)+        }   WireFormat'Jspb -> pure (skipped "JSPB output not supported")   WireFormat'Unspecified -> pure (serializeError "UNSPECIFIED requested_output_format")-  WireFormat'Unknown _ -> pure (serializeError "Unknown WireFormat enum value")+  WireFormat''Unrecognized _ -> pure (serializeError "Unknown WireFormat enum value")   hasUnknownFields2 :: TestAllTypesProto2 -> Bool
test-conformance/Test/Conformance/Schema.hs view
@@ -1,4 +1,6 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-missing-export-lists #-} {-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-matches -Wno-unused-top-binds -Wno-orphans -Wno-missing-signatures #-} @@ -53,20 +55,20 @@ -- reference @Proto.Google.Protobuf.X@ types; those modules must -- be in scope at the call site for GHC's renamer to resolve the -- spliced 'ConT' references. We bring them in unqualified so the--- spliced ConT names ('Proto.Google.Protobuf.WellKnownTypes.Timestamp.Timestamp'+-- spliced ConT names ('Proto.Google.Protobuf.Timestamp.Timestamp' -- etc., as constructed by 'Proto.TH.lookupWkt') resolve.-import Proto.Google.Protobuf.WellKnownTypes.Any (Any)-import Proto.Google.Protobuf.WellKnownTypes.Duration (Duration)-import Proto.Google.Protobuf.WellKnownTypes.Empty (Empty)-import Proto.Google.Protobuf.WellKnownTypes.FieldMask (FieldMask)-import Proto.Google.Protobuf.WellKnownTypes.Struct (+import Proto.Google.Protobuf.Any (Any)+import Proto.Google.Protobuf.Duration (Duration)+import Proto.Google.Protobuf.Empty (Empty)+import Proto.Google.Protobuf.FieldMask (FieldMask)+import Proto.Google.Protobuf.Struct (   ListValue,   NullValue (..),   Struct,   Value,  )-import Proto.Google.Protobuf.WellKnownTypes.Timestamp (Timestamp)-import Proto.Google.Protobuf.WellKnownTypes.Wrappers (+import Proto.Google.Protobuf.Timestamp (Timestamp)+import Proto.Google.Protobuf.Wrappers (   BoolValue,   BytesValue,   DoubleValue,
− test-conformance/protos/conformance.proto 
@@ -1,87 +0,0 @@-// Vendored from https://github.com/protocolbuffers/protobuf/blob/main/conformance/conformance.proto-//-// This is the wire protocol the upstream conformance_test_runner-// uses to drive any test program. Each test sends one-// ConformanceRequest over stdin and expects one ConformanceResponse-// back over stdout. See the upstream README for the runner's-// command-line interface and the test categories it covers.-//-// We pull this in with loadProto in-// `Test.Conformance.RunnerInstances` so the runner binary's-// codecs come from the same machinery the rest of wireform-proto-// uses (and consequently a regression in the deriver shows up-// immediately as a conformance-suite mismatch).--syntax = "proto3";--package conformance;--enum WireFormat {-  UNSPECIFIED = 0;-  PROTOBUF = 1;-  JSON = 2;-  JSPB = 3;-  TEXT_FORMAT = 4;-}--enum TestCategory {-  UNSPECIFIED_TEST = 0;-  BINARY_TEST = 1;-  JSON_TEST = 2;-  JSON_IGNORE_UNKNOWN_PARSING_TEST = 3;-  JSPB_TEST = 4;-  TEXT_FORMAT_TEST = 5;-}--message TestStatus {-  string name = 1;-  string failure_message = 2;-  string matched_name = 3;-}--message FailureSet {-  repeated TestStatus test = 2;-}--message ConformanceRequest {-  // The upstream schema models payload as a oneof; we honour-  // that. The bridge's auto-detected oneof codec generates a-  // sum-of-tagged-singletons carrier (ConformanceRequest'Payload)-  // plus the wire round-trip in 'Proto.Derive.Internal'.-  oneof payload {-    bytes  protobuf_payload = 1;-    string json_payload     = 2;-    string jspb_payload     = 7;-    string text_payload     = 8;-  }--  WireFormat requested_output_format = 3;-  string message_type = 4;-  TestCategory test_category = 5;--  JspbEncodingConfig jspb_encoding_options = 6;-  bool print_unknown_fields = 9;-}--message ConformanceResponse {-  // The upstream schema is also a oneof. Routing our response-  // through the oneof carrier means the wire-format presence of-  // the chosen arm is preserved end-to-end, which the conformance-  // runner relies on (an empty 'protobuf_payload' must be-  // distinguishable from an absent one).-  oneof result {-    string parse_error      = 1;-    string serialize_error  = 6;-    string timeout_error    = 9;-    string runtime_error    = 2;-    bytes  protobuf_payload = 3;-    string json_payload     = 4;-    string skipped          = 5;-    string jspb_payload     = 7;-    string text_payload     = 8;-  }-}--message JspbEncodingConfig {-  bool use_jspb_array_any_format = 1;-}
− test-conformance/protos/test_messages_proto2.proto 
@@ -1,233 +0,0 @@-// Stripped vendor of upstream protobuf-// src/google/protobuf/test_messages_proto2.proto. We drop the-// proto2 features 'loadProto' doesn't yet support and that the-// conformance suite doesn't strictly require:-//-//   * 'group' declarations and group-typed fields (legacy-//     proto2-only wire format using START_GROUP / END_GROUP).-//     Tests targeting them stay 'skipped'.-//   * 'message_set_wire_format' (proto1-era extension layout).-//-// The remaining surface (singular optional/required scalars,-// repeated, packed/unpacked, maps, enums, oneofs, recursive-// messages, default field values, extensions declarations,-// and the FieldName1..18 stress-test fields) is the spec area-// the binary/json conformance suite exercises.--syntax = "proto2";--package protobuf_test_messages.proto2;--message TestAllTypesProto2 {-  message NestedMessage {-    optional int32 a = 1;-    optional TestAllTypesProto2 corecursive = 2;-  }--  enum NestedEnum {-    FOO = 0;-    BAR = 1;-    BAZ = 2;-    NEG = -1;-  }--  // Singular-  optional int32 optional_int32 = 1;-  optional int64 optional_int64 = 2;-  optional uint32 optional_uint32 = 3;-  optional uint64 optional_uint64 = 4;-  optional sint32 optional_sint32 = 5;-  optional sint64 optional_sint64 = 6;-  optional fixed32 optional_fixed32 = 7;-  optional fixed64 optional_fixed64 = 8;-  optional sfixed32 optional_sfixed32 = 9;-  optional sfixed64 optional_sfixed64 = 10;-  optional float optional_float = 11;-  optional double optional_double = 12;-  optional bool optional_bool = 13;-  optional string optional_string = 14;-  optional bytes optional_bytes = 15;--  optional NestedMessage optional_nested_message = 18;-  optional ForeignMessageProto2 optional_foreign_message = 19;--  optional NestedEnum optional_nested_enum = 21;-  optional ForeignEnumProto2 optional_foreign_enum = 22;--  optional TestAllTypesProto2 recursive_message = 27;--  // Repeated-  repeated int32 repeated_int32 = 31;-  repeated int64 repeated_int64 = 32;-  repeated uint32 repeated_uint32 = 33;-  repeated uint64 repeated_uint64 = 34;-  repeated sint32 repeated_sint32 = 35;-  repeated sint64 repeated_sint64 = 36;-  repeated fixed32 repeated_fixed32 = 37;-  repeated fixed64 repeated_fixed64 = 38;-  repeated sfixed32 repeated_sfixed32 = 39;-  repeated sfixed64 repeated_sfixed64 = 40;-  repeated float repeated_float = 41;-  repeated double repeated_double = 42;-  repeated bool repeated_bool = 43;-  repeated string repeated_string = 44;-  repeated bytes repeated_bytes = 45;--  repeated NestedMessage repeated_nested_message = 48;-  repeated ForeignMessageProto2 repeated_foreign_message = 49;--  repeated NestedEnum repeated_nested_enum = 51;-  repeated ForeignEnumProto2 repeated_foreign_enum = 52;--  // Packed-  repeated int32 packed_int32 = 75 [packed = true];-  repeated int64 packed_int64 = 76 [packed = true];-  repeated uint32 packed_uint32 = 77 [packed = true];-  repeated uint64 packed_uint64 = 78 [packed = true];-  repeated sint32 packed_sint32 = 79 [packed = true];-  repeated sint64 packed_sint64 = 80 [packed = true];-  repeated fixed32 packed_fixed32 = 81 [packed = true];-  repeated fixed64 packed_fixed64 = 82 [packed = true];-  repeated sfixed32 packed_sfixed32 = 83 [packed = true];-  repeated sfixed64 packed_sfixed64 = 84 [packed = true];-  repeated float packed_float = 85 [packed = true];-  repeated double packed_double = 86 [packed = true];-  repeated bool packed_bool = 87 [packed = true];-  repeated NestedEnum packed_nested_enum = 88 [packed = true];--  // Unpacked-  repeated int32 unpacked_int32 = 89 [packed = false];-  repeated int64 unpacked_int64 = 90 [packed = false];-  repeated uint32 unpacked_uint32 = 91 [packed = false];-  repeated uint64 unpacked_uint64 = 92 [packed = false];-  repeated sint32 unpacked_sint32 = 93 [packed = false];-  repeated sint64 unpacked_sint64 = 94 [packed = false];-  repeated fixed32 unpacked_fixed32 = 95 [packed = false];-  repeated fixed64 unpacked_fixed64 = 96 [packed = false];-  repeated sfixed32 unpacked_sfixed32 = 97 [packed = false];-  repeated sfixed64 unpacked_sfixed64 = 98 [packed = false];-  repeated float unpacked_float = 99 [packed = false];-  repeated double unpacked_double = 100 [packed = false];-  repeated bool unpacked_bool = 101 [packed = false];-  repeated NestedEnum unpacked_nested_enum = 102 [packed = false];--  // Map-  map<int32, int32> map_int32_int32 = 56;-  map<int64, int64> map_int64_int64 = 57;-  map<uint32, uint32> map_uint32_uint32 = 58;-  map<uint64, uint64> map_uint64_uint64 = 59;-  map<sint32, sint32> map_sint32_sint32 = 60;-  map<sint64, sint64> map_sint64_sint64 = 61;-  map<fixed32, fixed32> map_fixed32_fixed32 = 62;-  map<fixed64, fixed64> map_fixed64_fixed64 = 63;-  map<sfixed32, sfixed32> map_sfixed32_sfixed32 = 64;-  map<sfixed64, sfixed64> map_sfixed64_sfixed64 = 65;-  map<int32, float> map_int32_float = 66;-  map<int32, double> map_int32_double = 67;-  map<bool, bool> map_bool_bool = 68;-  map<string, string> map_string_string = 69;-  map<string, bytes> map_string_bytes = 70;-  map<string, NestedMessage> map_string_nested_message = 71;-  map<string, ForeignMessageProto2> map_string_foreign_message = 72;-  map<string, NestedEnum> map_string_nested_enum = 73;-  map<string, ForeignEnumProto2> map_string_foreign_enum = 74;--  oneof oneof_field {-    uint32 oneof_uint32 = 111;-    NestedMessage oneof_nested_message = 112;-    string oneof_string = 113;-    bytes oneof_bytes = 114;-    bool oneof_bool = 115;-    uint64 oneof_uint64 = 116;-    float oneof_float = 117;-    double oneof_double = 118;-    NestedEnum oneof_enum = 119;-  }--  // Extensions placeholder (parser supports the declaration;-  // the actual extension fields are in the `extend` blocks-  // below).-  extensions 120 to 200;--  // Default values-  optional int32 default_int32 = 241 [default = -123456789];-  optional int64 default_int64 = 242 [default = -9123456789123456789];-  optional uint32 default_uint32 = 243 [default = 2123456789];-  optional uint64 default_uint64 = 244 [default = 10123456789123456789];-  optional sint32 default_sint32 = 245 [default = -123456789];-  optional sint64 default_sint64 = 246 [default = -9123456789123456789];-  optional fixed32 default_fixed32 = 247 [default = 2123456789];-  optional fixed64 default_fixed64 = 248 [default = 10123456789123456789];-  optional sfixed32 default_sfixed32 = 249 [default = -123456789];-  optional sfixed64 default_sfixed64 = 250 [default = -9123456789123456789];-  optional float default_float = 251 [default = 9e9];-  optional double default_double = 252 [default = 7e22];-  optional bool default_bool = 253 [default = true];-  optional string default_string = 254 [default = "Rosebud"];-  optional bytes default_bytes = 255 [default = "joshua"];--  // FieldName1..18 stress test (proto3 spec for snake_case <->-  // lowerCamelCase JSON name conversion applies to proto2 too).-  optional int32 fieldname1 = 401;-  optional int32 field_name2 = 402;-  optional int32 _field_name3 = 403;-  optional int32 field__name4_ = 404;-  optional int32 field0name5 = 405;-  optional int32 field_0_name6 = 406;-  optional int32 fieldName7 = 407;-  optional int32 FieldName8 = 408;-  optional int32 field_Name9 = 409;-  optional int32 Field_Name10 = 410;-  optional int32 FIELD_NAME11 = 411;-  optional int32 FIELD_name12 = 412;-  optional int32 __field_name13 = 413;-  optional int32 __Field_name14 = 414;-  optional int32 field__name15 = 415;-  optional int32 field__Name16 = 416;-  optional int32 field_name17__ = 417;-  optional int32 Field_name18__ = 418;--  // Reserved for unknown fields test.-  reserved 1000 to 9999;-}--message ForeignMessageProto2 {-  optional int32 c = 1;-}--enum ForeignEnumProto2 {-  FOREIGN_FOO = 0;-  FOREIGN_BAR = 1;-  FOREIGN_BAZ = 2;-}--extend TestAllTypesProto2 {-  optional int32 extension_int32 = 120;-}--message UnknownToTestAllTypes {-  optional int32 optional_int32 = 1001;-  optional string optional_string = 1002;-  optional ForeignMessageProto2 nested_message = 1003;-  optional bool optional_bool = 1006;-  repeated int32 repeated_int32 = 1011;-}--message NullHypothesisProto2 {}--message EnumOnlyProto2 {-  enum Bool {-    kFalse = 0;-    kTrue = 1;-  }-}--message OneStringProto2 {-  optional string data = 1;-}--message ProtoWithKeywords {-  optional int32 inline = 1;-  optional string concept = 2;-  repeated string requires = 3;-}
− test-conformance/protos/test_messages_proto3.proto 
@@ -1,253 +0,0 @@-// Vendored (subset) from-// https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/test_messages_proto3.proto-//-// We carry the full structural shape of TestAllTypesProto3-// including the Well-Known-Types arms (Timestamp, Duration, Any,-// Struct, Wrappers, FieldMask, Empty, Value, ListValue,-// NullValue). 'loadProto' doesn't follow proto @import@s, so we-// can't @import "google/protobuf/timestamp.proto"@ here; instead-// the bridge has a hard-coded WKT registry (see-// 'Proto.TH.lookupWkt') that resolves any @FTNamed-// "google.protobuf.X"@ reference to the corresponding pre--// generated 'Proto.Google.Protobuf.X' type.-//-// To avoid duplicating the WKT type names in this file (the-// parser doesn't know they're WKTs), we cite them by their-// fully-qualified proto names. The bridge's WKT registry then-// maps each FQN to the right Haskell type.--syntax = "proto3";--package protobuf_test_messages.proto3;--message TestAllTypesProto3 {-  message NestedMessage {-    int32 a = 1;-    TestAllTypesProto3 corecursive = 2;-  }--  enum NestedEnum {-    FOO = 0;-    BAR = 1;-    BAZ = 2;-    NEG = -1;-  }--  // Mirrors upstream test_messages_proto3 — multiple proto-side-  // names share wire number 2 (allow_alias). The conformance-  // EnumFieldWithAlias{*} tests fire on this enum.-  enum AliasedEnum {-    option allow_alias = true;--    ALIAS_FOO = 0;-    ALIAS_BAR = 1;-    ALIAS_BAZ = 2;-    MOO = 2;-    moo = 2;-    bAz = 2;-  }--  // Singular scalars.-  int32    optional_int32    = 1;-  int64    optional_int64    = 2;-  uint32   optional_uint32   = 3;-  uint64   optional_uint64   = 4;-  sint32   optional_sint32   = 5;-  sint64   optional_sint64   = 6;-  fixed32  optional_fixed32  = 7;-  fixed64  optional_fixed64  = 8;-  sfixed32 optional_sfixed32 = 9;-  sfixed64 optional_sfixed64 = 10;-  float    optional_float    = 11;-  double   optional_double   = 12;-  bool     optional_bool     = 13;-  string   optional_string   = 14;-  bytes    optional_bytes    = 15;--  NestedMessage  optional_nested_message  = 18;-  ForeignMessage optional_foreign_message = 19;--  NestedEnum  optional_nested_enum  = 21;-  ForeignEnum optional_foreign_enum = 22;-  AliasedEnum optional_aliased_enum = 23;--  TestAllTypesProto3 recursive_message = 27;--  // Repeated scalars (default proto3 = packed).-  repeated int32    repeated_int32    = 31;-  repeated int64    repeated_int64    = 32;-  repeated uint32   repeated_uint32   = 33;-  repeated uint64   repeated_uint64   = 34;-  repeated sint32   repeated_sint32   = 35;-  repeated sint64   repeated_sint64   = 36;-  repeated fixed32  repeated_fixed32  = 37;-  repeated fixed64  repeated_fixed64  = 38;-  repeated sfixed32 repeated_sfixed32 = 39;-  repeated sfixed64 repeated_sfixed64 = 40;-  repeated float    repeated_float    = 41;-  repeated double   repeated_double   = 42;-  repeated bool     repeated_bool     = 43;-  repeated string   repeated_string   = 44;-  repeated bytes    repeated_bytes    = 45;--  repeated NestedMessage  repeated_nested_message  = 48;-  repeated ForeignMessage repeated_foreign_message = 49;--  repeated NestedEnum  repeated_nested_enum  = 51;-  repeated ForeignEnum repeated_foreign_enum = 52;--  // Packed (explicit) — same wire format as proto3 default-  // for packable scalars; exercised separately to make sure the-  // packed encoder path is hit when the user writes [packed = true].-  repeated int32    packed_int32    = 75 [packed = true];-  repeated int64    packed_int64    = 76 [packed = true];-  repeated uint32   packed_uint32   = 77 [packed = true];-  repeated uint64   packed_uint64   = 78 [packed = true];-  repeated sint32   packed_sint32   = 79 [packed = true];-  repeated sint64   packed_sint64   = 80 [packed = true];-  repeated fixed32  packed_fixed32  = 81 [packed = true];-  repeated fixed64  packed_fixed64  = 82 [packed = true];-  repeated sfixed32 packed_sfixed32 = 83 [packed = true];-  repeated sfixed64 packed_sfixed64 = 84 [packed = true];-  repeated float    packed_float    = 85 [packed = true];-  repeated double   packed_double   = 86 [packed = true];-  repeated bool     packed_bool     = 87 [packed = true];-  repeated NestedEnum packed_nested_enum = 88 [packed = true];--  // Unpacked (explicit).-  repeated int32    unpacked_int32    = 89  [packed = false];-  repeated int64    unpacked_int64    = 90  [packed = false];-  repeated uint32   unpacked_uint32   = 91  [packed = false];-  repeated uint64   unpacked_uint64   = 92  [packed = false];-  repeated sint32   unpacked_sint32   = 93  [packed = false];-  repeated sint64   unpacked_sint64   = 94  [packed = false];-  repeated fixed32  unpacked_fixed32  = 95  [packed = false];-  repeated fixed64  unpacked_fixed64  = 96  [packed = false];-  repeated sfixed32 unpacked_sfixed32 = 97  [packed = false];-  repeated sfixed64 unpacked_sfixed64 = 98  [packed = false];-  repeated float    unpacked_float    = 99  [packed = false];-  repeated double   unpacked_double   = 100 [packed = false];-  repeated bool     unpacked_bool     = 101 [packed = false];-  repeated NestedEnum unpacked_nested_enum = 102 [packed = false];--  // Maps. Submessage / enum-valued maps come through as proto-  // sub-messages whose value type is one of the FTNamed shapes;-  // loadProto currently treats those as opaque submessages on-  // the value side, which is enough for wire-format round-trip.-  map<int32,    int32>          map_int32_int32          = 56;-  map<int64,    int64>          map_int64_int64          = 57;-  map<uint32,   uint32>         map_uint32_uint32        = 58;-  map<uint64,   uint64>         map_uint64_uint64        = 59;-  map<sint32,   sint32>         map_sint32_sint32        = 60;-  map<sint64,   sint64>         map_sint64_sint64        = 61;-  map<fixed32,  fixed32>        map_fixed32_fixed32      = 62;-  map<fixed64,  fixed64>        map_fixed64_fixed64      = 63;-  map<sfixed32, sfixed32>       map_sfixed32_sfixed32    = 64;-  map<sfixed64, sfixed64>       map_sfixed64_sfixed64    = 65;-  map<int32,    float>          map_int32_float          = 66;-  map<int32,    double>         map_int32_double         = 67;-  map<bool,     bool>           map_bool_bool            = 68;-  map<string,   string>         map_string_string        = 69;-  map<string,   bytes>          map_string_bytes         = 70;-  // Submessage / enum-valued maps. The wire form is a repeated-  // MapEntry message; the JSON form is a JSON object whose-  // values are recursively the inner message / enum's JSON-  // shape. Conformance MessageMapField.* exercises the message-  // case; IgnoreUnknownEnumStringValueInMap*, etc. exercise the-  // enum case.-  map<string,   NestedMessage>  map_string_nested_message = 71;-  map<string,   NestedEnum>     map_string_nested_enum    = 73;--  // Oneof.-  oneof oneof_field {-    uint32        oneof_uint32         = 111;-    NestedMessage oneof_nested_message = 112;-    string        oneof_string         = 113;-    bytes         oneof_bytes          = 114;-    bool          oneof_bool           = 115;-    uint64        oneof_uint64         = 116;-    float         oneof_float          = 117;-    double        oneof_double         = 118;-    NestedEnum    oneof_enum           = 119;-    google.protobuf.NullValue oneof_null_value = 120;-  }--  // FieldName1..18 stress test: exercises proto3's spec for-  // converting between snake_case proto names and the JSON-  // canonical camelCase form. The bridge handles both keys (the-  // 'parseBindStmt' fallback in 'Proto.TH.Metadata') and the-  // proto3-canonical-JSON output writes the camelCase form.-  int32 fieldname1     = 401;-  int32 field_name2    = 402;-  int32 _field_name3   = 403;-  int32 field__name4_  = 404;-  int32 field0name5    = 405;-  int32 field_0_name6  = 406;-  int32 fieldName7     = 407;-  int32 FieldName8     = 408;-  int32 field_Name9    = 409;-  int32 Field_Name10   = 410;-  int32 FIELD_NAME11   = 411;-  int32 FIELD_name12   = 412;-  int32 __field_name13 = 413;-  int32 __Field_name14 = 414;-  int32 field__name15  = 415;-  int32 field__Name16  = 416;-  int32 field_name17__ = 417;-  int32 Field_name18__ = 418;--  // Well-known-types: routed through the WKT registry in-  // 'Proto.TH'. The proto AST sees these as FTNamed types; the-  // bridge resolves each FQN to the corresponding pre-generated-  // 'Proto.Google.Protobuf.X' Haskell type.-  google.protobuf.BoolValue   optional_bool_wrapper   = 201;-  google.protobuf.Int32Value  optional_int32_wrapper  = 202;-  google.protobuf.Int64Value  optional_int64_wrapper  = 203;-  google.protobuf.UInt32Value optional_uint32_wrapper = 204;-  google.protobuf.UInt64Value optional_uint64_wrapper = 205;-  google.protobuf.FloatValue  optional_float_wrapper  = 206;-  google.protobuf.DoubleValue optional_double_wrapper = 207;-  google.protobuf.StringValue optional_string_wrapper = 208;-  google.protobuf.BytesValue  optional_bytes_wrapper  = 209;--  repeated google.protobuf.BoolValue   repeated_bool_wrapper   = 211;-  repeated google.protobuf.Int32Value  repeated_int32_wrapper  = 212;-  repeated google.protobuf.Int64Value  repeated_int64_wrapper  = 213;-  repeated google.protobuf.UInt32Value repeated_uint32_wrapper = 214;-  repeated google.protobuf.UInt64Value repeated_uint64_wrapper = 215;-  repeated google.protobuf.FloatValue  repeated_float_wrapper  = 216;-  repeated google.protobuf.DoubleValue repeated_double_wrapper = 217;-  repeated google.protobuf.StringValue repeated_string_wrapper = 218;-  repeated google.protobuf.BytesValue  repeated_bytes_wrapper  = 219;--  google.protobuf.Duration   optional_duration   = 301;-  google.protobuf.Timestamp  optional_timestamp  = 302;-  google.protobuf.FieldMask  optional_field_mask = 303;-  google.protobuf.Struct     optional_struct     = 304;-  google.protobuf.Any        optional_any        = 305;-  google.protobuf.Value      optional_value      = 306;-  google.protobuf.NullValue  optional_null_value = 307;-  google.protobuf.Empty      optional_empty      = 308;--  repeated google.protobuf.Duration  repeated_duration  = 311;-  repeated google.protobuf.Timestamp repeated_timestamp = 312;-  repeated google.protobuf.FieldMask repeated_fieldmask = 313;-  repeated google.protobuf.Struct    repeated_struct    = 324;-  repeated google.protobuf.Any       repeated_any       = 315;-  repeated google.protobuf.Value     repeated_value     = 316;-  repeated google.protobuf.ListValue repeated_list_value = 317;-  repeated google.protobuf.Empty     repeated_empty     = 318;--  reserved 501 to 510;-  reserved 999999;-}--message ForeignMessage {-  int32 c = 1;-}--enum ForeignEnum {-  FOREIGN_FOO = 0;-  FOREIGN_BAR = 1;-  FOREIGN_BAZ = 2;-}
test-integration/Main.hs view
@@ -1,9 +1,7 @@ module Main (main) where  import Test.CodeGen (codeGenTests)-import Test.Editions (editionsTests)-import Test.Plugin (pluginTests)-import Test.TextFormatParsed (textFormatParsedTests)+import Test.Collect (collectTests) import Test.Compat (compatTests) import Test.Hooks (hooksTests) import Test.JSON (jsonTests)@@ -15,8 +13,8 @@ import Test.Roundtrip (roundtripTests) import Test.Schema (schemaTests) import Test.StreamCodec (streamCodecTests)+import Test.Syd import Test.TDP (dynamicSchemaTests)-import Test.Tasty import Test.WellKnown (wellKnownTests) import Test.WellKnownUtil (wellKnownUtilTests) import Test.Wire (wireTests)@@ -24,16 +22,14 @@  main :: IO () main =-  defaultMain $-    testGroup+  sydTest+    $ describe       "wireform-proto"+    $ sequence_       [ parserTests       , wireTests       , roundtripTests       , codeGenTests-      , pluginTests-      , textFormatParsedTests-      , editionsTests       , wellKnownTests       , wellKnownUtilTests       , printInspectTests@@ -46,4 +42,5 @@       , hooksTests       , dynamicSchemaTests       , resolverTests+      , collectTests       ]
test-integration/Test/CodeGen.hs view
@@ -8,153 +8,150 @@ import Proto.IDL.AST import Proto.IDL.Annotations import Proto.IDL.Parser-import Test.Tasty-import Test.Tasty.HUnit+import Test.Syd  -codeGenTests :: TestTree+codeGenTests :: Spec codeGenTests =-  testGroup+  describe     "Code Generation"-    [ testGroup-        "Type name conversion"-        [ testCase "simple name" $-            hsTypeName "person" @?= "Person"-        , testCase "already capitalized" $-            hsTypeName "Person" @?= "Person"-        , testCase "field name conversion" $-            hsFieldName "first_name" @?= "firstName"-        , testCase "field name no underscore" $-            hsFieldName "name" @?= "name"-        , testCase "enum constructor" $-            hsEnumCon "Status" "STATUS_ACTIVE" @?= "StatusActive"-        , testCase "module name" $-            hsModuleName "com.example.api" @?= "Com.Example.Api"-        ]-    , testGroup-        "Code generation from parsed proto"-        [ testCase "generates module for simple message" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "package test;"-                    , "message Person {"-                    , "  string name = 1;"-                    , "  int32 age = 2;"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> do-                let emptyReg = Map.empty :: TypeRegistry-                    code = generateModuleText defaultGenerateOpts emptyReg "<test>" pf-                assertBool "Should contain data Person" (T.isInfixOf "data Person" code)-                assertBool "Should contain name field" (T.isInfixOf "name" code)-                assertBool "Should contain module header" (T.isInfixOf "module" code)-        , testCase "proto3 optional scalar gets Maybe wrapper" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "package test;"-                    , "message Presence {"-                    , "  int32 required_field = 1;"-                    , "  optional int32 optional_field = 2;"-                    , "  optional string optional_name = 3;"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> do-                let emptyReg = Map.empty :: TypeRegistry-                    code = generateModuleText defaultGenerateOpts emptyReg "<test>" pf-                assertBool-                  "optional int32 should be Maybe Int32"-                  (T.isInfixOf "Maybe Int32" code)-                assertBool-                  "optional string should be Maybe Text"-                  (T.isInfixOf "Maybe Text" code)-                assertBool-                  "required int32 should not be Maybe (bare Int32)"-                  (T.isInfixOf "Int32" code)-        , testCase "generates enum" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "enum Status {"-                    , "  UNKNOWN = 0;"-                    , "  ACTIVE = 1;"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> do-                let emptyReg = Map.empty :: TypeRegistry-                    code = generateModuleText defaultGenerateOpts emptyReg "<test>" pf-                assertBool "Should contain data Status" (T.isInfixOf "data Status" code)-                assertBool "Should contain Active" (T.isInfixOf "Active" code)-        ]-    , testGroup-        "Annotations"-        [ testCase "extract custom annotation" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "option (my_annotation) = true;"-                    , "option (another_opt) = { key: \"value\" };"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> do-                let anns = extractAnnotations (protoOptions pf)-                length anns @?= 2-                case lookupAnnotation "my_annotation" anns of-                  Just (CBool True) -> pure ()-                  other -> assertFailure ("Expected CBool True, got: " <> show other)-        , testCase "lookup simple option" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "option java_package = \"com.example\";"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> do-                case lookupSimpleOption "java_package" (protoOptions pf) of-                  Just (CString "com.example") -> pure ()-                  other -> assertFailure ("Expected CString, got: " <> show other)-        , testCase "extension option lookup" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "option (custom.opt) = 42;"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> do-                case lookupExtensionOption "custom.opt" (protoOptions pf) of-                  Just (CInt 42) -> pure ()-                  other -> assertFailure ("Expected CInt 42, got: " <> show other)-        , testCase "hasOption check" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "option deprecated = true;"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> do-                assertBool "Should have deprecated" (hasOption "deprecated" (protoOptions pf))-                assertBool "Should not have java_package" (not (hasOption "java_package" (protoOptions pf)))-        , testCase "typed option extraction" $ do-            optionAsInt (CInt 42) @?= Just 42-            optionAsFloat (CFloat 3.14) @?= Just 3.14-            optionAsBool (CBool True) @?= Just True-            optionAsString (CString "hello") @?= Just "hello"-            optionAsIdent (CIdent "FOO") @?= Just "FOO"-            optionAsAggregate (CAggregate [("k", CInt 1)]) @?= Just [("k", CInt 1)]-            optionAsInt (CString "nope") @?= Nothing-        ]-    ]+    $ sequence_+      [ describe+          "Type name conversion"+          $ sequence_+            [ it "simple name" $+                hsTypeName "person" `shouldBe` "Person"+            , it "already capitalized" $+                hsTypeName "Person" `shouldBe` "Person"+            , it "field name conversion" $+                hsFieldName "first_name" `shouldBe` "firstName"+            , it "field name no underscore" $+                hsFieldName "name" `shouldBe` "name"+            , it "enum constructor" $+                hsEnumCon "Status" "STATUS_ACTIVE" `shouldBe` "StatusActive"+            , it "module name" $+                hsModuleName "com.example.api" `shouldBe` "Com.Example.Api"+            ]+      , describe+          "Code generation from parsed proto"+          $ sequence_+            [ it "generates module for simple message" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "package test;"+                        , "message Person {"+                        , "  string name = 1;"+                        , "  int32 age = 2;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    let emptyReg = Map.empty :: TypeRegistry+                        code = generateModuleText defaultGenerateOpts emptyReg "<test>" pf+                    (T.isInfixOf "data Person" code) `shouldBe` True+                    (T.isInfixOf "name" code) `shouldBe` True+                    (T.isInfixOf "module" code) `shouldBe` True+            , it "proto3 optional scalar gets Maybe wrapper" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "package test;"+                        , "message Presence {"+                        , "  int32 required_field = 1;"+                        , "  optional int32 optional_field = 2;"+                        , "  optional string optional_name = 3;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    let emptyReg = Map.empty :: TypeRegistry+                        code = generateModuleText defaultGenerateOpts emptyReg "<test>" pf+                    (T.isInfixOf "Maybe Int32" code) `shouldBe` True+                    (T.isInfixOf "Maybe Text" code) `shouldBe` True+                    (T.isInfixOf "Int32" code) `shouldBe` True+            , it "generates enum" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "enum Status {"+                        , "  UNKNOWN = 0;"+                        , "  ACTIVE = 1;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    let emptyReg = Map.empty :: TypeRegistry+                        code = generateModuleText defaultGenerateOpts emptyReg "<test>" pf+                    (T.isInfixOf "data Status" code) `shouldBe` True+                    (T.isInfixOf "Active" code) `shouldBe` True+            ]+      , describe+          "Annotations"+          $ sequence_+            [ it "extract custom annotation" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "option (my_annotation) = true;"+                        , "option (another_opt) = { key: \"value\" };"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    let anns = extractAnnotations (protoOptions pf)+                    length anns `shouldBe` 2+                    case lookupAnnotation "my_annotation" anns of+                      Just (CBool True) -> pure ()+                      other -> expectationFailure ("Expected CBool True, got: " <> show other)+            , it "lookup simple option" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "option java_package = \"com.example\";"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    case lookupSimpleOption "java_package" (protoOptions pf) of+                      Just (CString "com.example") -> pure ()+                      other -> expectationFailure ("Expected CString, got: " <> show other)+            , it "extension option lookup" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "option (custom.opt) = 42;"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    case lookupExtensionOption "custom.opt" (protoOptions pf) of+                      Just (CInt 42) -> pure ()+                      other -> expectationFailure ("Expected CInt 42, got: " <> show other)+            , it "hasOption check" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "option deprecated = true;"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    (hasOption "deprecated" (protoOptions pf)) `shouldBe` True+                    (not (hasOption "java_package" (protoOptions pf))) `shouldBe` True+            , it "typed option extraction" $ do+                optionAsInt (CInt 42) `shouldBe` Just 42+                optionAsFloat (CFloat 3.14) `shouldBe` Just 3.14+                optionAsBool (CBool True) `shouldBe` Just True+                optionAsString (CString "hello") `shouldBe` Just "hello"+                optionAsIdent (CIdent "FOO") `shouldBe` Just "FOO"+                optionAsAggregate (CAggregate [("k", CInt 1)]) `shouldBe` Just [("k", CInt 1)]+                optionAsInt (CString "nope") `shouldBe` Nothing+            ]+      ]   unlines' :: [Text] -> Text
+ test-integration/Test/Collect.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Tests for the error-accumulating decoder ('Proto.Decode.Collect').+module Test.Collect (collectTests) where++import Data.ByteString qualified as BS+import Data.Word (Word8)+import Proto.Decode (DecodeError (..))+import Proto.Decode.Collect (DecodeIssue (..), decodeCollecting)+import Proto.Google.Protobuf.Wrappers (StringValue (..))+import Test.Syd+++-- Encode a length-delimited field (wire type 2).+lenField :: Int -> [Word8] -> [Word8]+lenField fn bs = [fromIntegral (fn * 8 + 2), fromIntegral (length bs)] ++ bs+++collectStringValue :: BS.ByteString -> ([DecodeIssue], Maybe StringValue)+collectStringValue = decodeCollecting+++collectTests :: Spec+collectTests =+  describe+    "Proto.Decode.Collect"+    $ sequence_+      [ it "clean message: no issues, value decoded" $+          collectStringValue (BS.pack (lenField 1 [0x6F, 0x6B]))+            `shouldBe` ([], Just (StringValue "ok" []))+      , it "invalid UTF-8 string field is reported with its path" $+          let (issues, val) = collectStringValue (BS.pack (lenField 1 [0xFF]))+          in do+               val `shouldBe` Nothing+               issues `shouldBe` [DecodeIssue ["value"] InvalidUtf8]+      , it "truncated top-level field is reported structurally" $+          let (issues, val) = collectStringValue (BS.pack [0x0A, 0x05, 0x61]) -- len=5 but 1 byte+          in do+               val `shouldBe` Nothing+               map issuePath issues `shouldBe` [[]]+      ]
test-integration/Test/Compat.hs view
@@ -5,330 +5,338 @@ import Proto.Compat import Proto.IDL.AST import Proto.IDL.Parser-import Test.Tasty-import Test.Tasty.HUnit+import Test.Syd  -compatTests :: TestTree+compatTests :: Spec compatTests =-  testGroup+  describe     "Schema Compatibility"-    [ testGroup-        "BACKWARD compatibility"-        [ testCase "identical schemas are compatible" $ do-            let schema = parseOrDie simpleSchema-            assertCompatible (checkBackward schema schema)-        , testCase "adding optional field is backward compatible" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; }"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; int32 age = 2; }"-                      ]-            assertCompatible (checkBackward new old)-        , testCase "removing field without reserving breaks backward" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; int32 age = 2; }"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; }"-                      ]-            assertIncompatible (checkBackward new old)-            assertHasRule "FIELD_REMOVED_NOT_RESERVED" (checkBackward new old)-        , testCase "removing field with reservation is backward compatible" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; int32 age = 2; }"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; reserved 2; }"-                      ]-            assertCompatible (checkBackward new old)-        , testCase "changing field type (incompatible wire) breaks backward" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { int32 value = 1; }"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string value = 1; }"-                      ]-            assertIncompatible (checkBackward new old)-            assertHasRule "FIELD_TYPE_CHANGED_INCOMPATIBLE" (checkBackward new old)-        , testCase "changing between wire-compatible types warns" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { int32 value = 1; }"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { int64 value = 1; }"-                      ]-            let result = checkBackward new old-            assertCompatible result-            assertHasRule "FIELD_TYPE_CHANGED_COMPATIBLE" result-        , testCase "adding required field breaks backward" $ do-            -- Simulate required by checking the rule directly-            let fd = FieldDef () Nothing (Just Required) (FTScalar SInt32) "user_id" (FieldNumber 2) []-                oldMsg = MessageDef () Nothing "Msg" [MEField (FieldDef () Nothing Nothing (FTScalar SString) "name" (FieldNumber 1) [])]-                newMsg = MessageDef () Nothing "Msg" [MEField (FieldDef () Nothing Nothing (FTScalar SString) "name" (FieldNumber 1) []), MEField fd]-            assertIncompatible (checkMessageCompat BackwardDir "Msg" newMsg oldMsg)-            assertHasRule "REQUIRED_FIELD_ADDED" (checkMessageCompat BackwardDir "Msg" newMsg oldMsg)-        ]-    , testGroup-        "FORWARD compatibility"-        [ testCase "adding field is forward compatible (old ignores new)" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; }"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; int32 age = 2; }"-                      ]-            assertCompatible (checkForward new old)-        , testCase "removing field is forward compatible" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; int32 age = 2; }"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; }"-                      ]-            assertCompatible (checkForward new old)-        , testCase "type change (incompatible wire) breaks forward" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { int32 value = 1; }"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { double value = 1; }"-                      ]-            assertIncompatible (checkForward new old)-        ]-    , testGroup-        "FULL compatibility"-        [ testCase "adding optional field is full compatible" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; }"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; int32 age = 2; }"-                      ]-            assertCompatible (checkFull new old)-        , testCase "removing field without reserving breaks full" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; int32 age = 2; }"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; }"-                      ]-            assertIncompatible (checkFull new old)-        ]-    , testGroup-        "Enum compatibility"-        [ testCase "adding enum value warns for forward" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "enum Status { UNKNOWN = 0; ACTIVE = 1; }"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "enum Status { UNKNOWN = 0; ACTIVE = 1; INACTIVE = 2; }"-                      ]-            let result = checkForward new old-            assertCompatible result-            assertHasRule "ENUM_VALUE_ADDED" result-        , testCase "removing enum value breaks backward" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "enum Status { UNKNOWN = 0; ACTIVE = 1; INACTIVE = 2; }"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "enum Status { UNKNOWN = 0; ACTIVE = 1; }"-                      ]-            assertIncompatible (checkBackward new old)-            assertHasRule "ENUM_VALUE_REMOVED" (checkBackward new old)-        , testCase "renaming enum value warns" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "enum Status { UNKNOWN = 0; ACTIVE = 1; }"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "enum Status { UNKNOWN = 0; ENABLED = 1; }"-                      ]-            assertHasRule "ENUM_VALUE_RENAMED" (checkBackward new old)-        ]-    , testGroup-        "Transitive compatibility"-        [ testCase "checkCompatAll with multiple versions" $ do-            let v1 =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; }"-                      ]-                v2 =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; int32 age = 2; }"-                      ]-                v3 =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; int32 age = 2; bool active = 3; }"-                      ]-            assertCompatible (checkCompatAll BackwardTransitive v3 [v2, v1])-        , testCase "transitive fails if any version is incompatible" $ do-            let v1 =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; int32 value = 2; }"-                      ]-                v2 =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; int32 value = 2; bool active = 3; }"-                      ]-                v3 =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; string value = 2; bool active = 3; }"-                      ]-            assertIncompatible (checkCompatAll BackwardTransitive v3 [v2, v1])-        ]-    , testGroup-        "NONE level"-        [ testCase "NONE always passes" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; }"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { double name = 1; }"-                      ]-            assertCompatible (checkCompat None new old)-        ]-    , testGroup-        "Field name changes"-        [ testCase "renaming a field warns" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string name = 1; }"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg { string full_name = 1; }"-                      ]-            assertHasRule "FIELD_NAME_CHANGED" (checkBackward new old)-        ]-    , testGroup-        "Complex schema evolution"-        [ testCase "safe evolution: add fields, reserve removed" $ do-            let old =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message User {"-                      , "  string name = 1;"-                      , "  string email = 2;"-                      , "  int32 age = 3;"-                      , "}"-                      ]-                new =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message User {"-                      , "  string name = 1;"-                      , "  string email = 2;"-                      , "  reserved 3;"-                      , "  string phone = 4;"-                      , "  bool active = 5;"-                      , "}"-                      ]-            assertCompatible (checkFull new old)-        ]-    ]+    $ sequence_+      [ describe+          "BACKWARD compatibility"+          $ sequence_+            [ it "identical schemas are compatible" $ do+                let schema = parseOrDie simpleSchema+                assertCompatible (checkBackward schema schema)+            , it "adding optional field is backward compatible" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; }"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; int32 age = 2; }"+                          ]+                assertCompatible (checkBackward new old)+            , it "removing field without reserving breaks backward" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; int32 age = 2; }"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; }"+                          ]+                assertIncompatible (checkBackward new old)+                assertHasRule "FIELD_REMOVED_NOT_RESERVED" (checkBackward new old)+            , it "removing field with reservation is backward compatible" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; int32 age = 2; }"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; reserved 2; }"+                          ]+                assertCompatible (checkBackward new old)+            , it "changing field type (incompatible wire) breaks backward" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { int32 value = 1; }"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string value = 1; }"+                          ]+                assertIncompatible (checkBackward new old)+                assertHasRule "FIELD_TYPE_CHANGED_INCOMPATIBLE" (checkBackward new old)+            , it "changing between wire-compatible types warns" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { int32 value = 1; }"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { int64 value = 1; }"+                          ]+                let result = checkBackward new old+                assertCompatible result+                assertHasRule "FIELD_TYPE_CHANGED_COMPATIBLE" result+            , it "adding required field breaks backward" $ do+                -- Simulate required by checking the rule directly+                let fd = FieldDef () Nothing (Just Required) (FTScalar SInt32) "user_id" (FieldNumber 2) []+                    oldMsg = MessageDef () Nothing "Msg" [MEField (FieldDef () Nothing Nothing (FTScalar SString) "name" (FieldNumber 1) [])]+                    newMsg = MessageDef () Nothing "Msg" [MEField (FieldDef () Nothing Nothing (FTScalar SString) "name" (FieldNumber 1) []), MEField fd]+                assertIncompatible (checkMessageCompat BackwardDir "Msg" newMsg oldMsg)+                assertHasRule "REQUIRED_FIELD_ADDED" (checkMessageCompat BackwardDir "Msg" newMsg oldMsg)+            ]+      , describe+          "FORWARD compatibility"+          $ sequence_+            [ it "adding field is forward compatible (old ignores new)" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; }"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; int32 age = 2; }"+                          ]+                assertCompatible (checkForward new old)+            , it "removing field is forward compatible" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; int32 age = 2; }"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; }"+                          ]+                assertCompatible (checkForward new old)+            , it "type change (incompatible wire) breaks forward" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { int32 value = 1; }"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { double value = 1; }"+                          ]+                assertIncompatible (checkForward new old)+            ]+      , describe+          "FULL compatibility"+          $ sequence_+            [ it "adding optional field is full compatible" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; }"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; int32 age = 2; }"+                          ]+                assertCompatible (checkFull new old)+            , it "removing field without reserving breaks full" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; int32 age = 2; }"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; }"+                          ]+                assertIncompatible (checkFull new old)+            ]+      , describe+          "Enum compatibility"+          $ sequence_+            [ it "adding enum value warns for forward" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "enum Status { UNKNOWN = 0; ACTIVE = 1; }"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "enum Status { UNKNOWN = 0; ACTIVE = 1; INACTIVE = 2; }"+                          ]+                let result = checkForward new old+                assertCompatible result+                assertHasRule "ENUM_VALUE_ADDED" result+            , it "removing enum value breaks backward" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "enum Status { UNKNOWN = 0; ACTIVE = 1; INACTIVE = 2; }"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "enum Status { UNKNOWN = 0; ACTIVE = 1; }"+                          ]+                assertIncompatible (checkBackward new old)+                assertHasRule "ENUM_VALUE_REMOVED" (checkBackward new old)+            , it "renaming enum value warns" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "enum Status { UNKNOWN = 0; ACTIVE = 1; }"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "enum Status { UNKNOWN = 0; ENABLED = 1; }"+                          ]+                assertHasRule "ENUM_VALUE_RENAMED" (checkBackward new old)+            ]+      , describe+          "Transitive compatibility"+          $ sequence_+            [ it "checkCompatAll with multiple versions" $ do+                let v1 =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; }"+                          ]+                    v2 =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; int32 age = 2; }"+                          ]+                    v3 =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; int32 age = 2; bool active = 3; }"+                          ]+                assertCompatible (checkCompatAll BackwardTransitive v3 [v2, v1])+            , it "transitive fails if any version is incompatible" $ do+                let v1 =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; int32 value = 2; }"+                          ]+                    v2 =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; int32 value = 2; bool active = 3; }"+                          ]+                    v3 =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; string value = 2; bool active = 3; }"+                          ]+                assertIncompatible (checkCompatAll BackwardTransitive v3 [v2, v1])+            ]+      , describe+          "NONE level"+          $ sequence_+            [ it "NONE always passes" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; }"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { double name = 1; }"+                          ]+                assertCompatible (checkCompat None new old)+            ]+      , describe+          "Field name changes"+          $ sequence_+            [ it "renaming a field warns" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string name = 1; }"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg { string full_name = 1; }"+                          ]+                assertHasRule "FIELD_NAME_CHANGED" (checkBackward new old)+            ]+      , describe+          "Complex schema evolution"+          $ sequence_+            [ it "safe evolution: add fields, reserve removed" $ do+                let old =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message User {"+                          , "  string name = 1;"+                          , "  string email = 2;"+                          , "  int32 age = 3;"+                          , "}"+                          ]+                    new =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message User {"+                          , "  string name = 1;"+                          , "  string email = 2;"+                          , "  reserved 3;"+                          , "  string phone = 4;"+                          , "  bool active = 5;"+                          , "}"+                          ]+                assertCompatible (checkFull new old)+            ]+      ]   -- Helpers@@ -352,20 +360,14 @@  assertCompatible :: CompatResult -> IO () assertCompatible result =-  assertBool-    ("Expected compatible, got errors: " <> show (compatErrors result))-    (isCompatible result)+  (if (isCompatible result) then pure () else expectationFailure ("Expected compatible, got errors: " <> show (compatErrors result)))   assertIncompatible :: CompatResult -> IO () assertIncompatible result =-  assertBool-    "Expected incompatible, but was compatible"-    (not (isCompatible result))+  (not (isCompatible result)) `shouldBe` True   assertHasRule :: Text -> CompatResult -> IO () assertHasRule rule result =-  assertBool-    ("Expected rule '" <> T.unpack rule <> "' in errors: " <> show (compatErrors result))-    (any (\e -> ceRule e == rule) (compatErrors result))+  (if (any (\e -> ceRule e == rule) (compatErrors result)) then pure () else expectationFailure ("Expected rule '" <> T.unpack rule <> "' in errors: " <> show (compatErrors result)))
− test-integration/Test/Editions.hs 
@@ -1,394 +0,0 @@-module Test.Editions (editionsTests) where--import Data.Map.Strict qualified as Map-import Data.Maybe (isJust)-import Data.Text qualified as T-import Test.Tasty-import Test.Tasty.HUnit--import Proto.CodeGen-import Proto.IDL.AST-import Proto.IDL.Parser (parseProtoFile)-import Proto.IDL.Parser.Resolver (ResolvedProto (..))---editionsTests :: TestTree-editionsTests =-  testGroup-    "Proto editions"-    [ featureResolutionTests-    , fieldPresenceTests-    , repeatedEncodingTests-    , enumTypeTests-    , codegenOutputTests-    ]----- ------------------------------------------------------------------------------ Feature resolution: applyFeatureOptions / resolveFileFeatures / resolveFieldFeatures--- -----------------------------------------------------------------------------featureResolutionTests :: TestTree-featureResolutionTests =-  testGroup-    "Feature resolution"-    [ testCase "edition 2023 defaults to proto3 semantics" $ do-        let fs = featuresForEdition (Edition "2023")-        featureFieldPresence fs @?= ExplicitPresence-        featureEnumType fs @?= OpenEnum-        featureRepeatedFieldEncoding fs @?= PackedEncoding-        featureUtf8Validation fs @?= Utf8Verify-        featureMessageEncoding fs @?= LengthPrefixedEncoding-        featureJsonFormat fs @?= JsonAllow--    , testCase "applyFeatureOptions: field_presence IMPLICIT" $ do-        let opts =-              [ OptionDef-                  ()-                  (OptionName [SimpleOption "features", SimpleOption "field_presence"])-                  (CIdent "IMPLICIT")-              ]-            fs = applyFeatureOptions opts defaultFeatureSet-        featureFieldPresence fs @?= ImplicitPresence--    , testCase "applyFeatureOptions: field_presence EXPLICIT" $ do-        let opts =-              [ OptionDef-                  ()-                  (OptionName [SimpleOption "features", SimpleOption "field_presence"])-                  (CIdent "EXPLICIT")-              ]-            fs = applyFeatureOptions opts defaultFeatureSet-        featureFieldPresence fs @?= ExplicitPresence--    , testCase "applyFeatureOptions: field_presence LEGACY_REQUIRED" $ do-        let opts =-              [ OptionDef-                  ()-                  (OptionName [SimpleOption "features", SimpleOption "field_presence"])-                  (CIdent "LEGACY_REQUIRED")-              ]-            fs = applyFeatureOptions opts defaultFeatureSet-        featureFieldPresence fs @?= LegacyRequired--    , testCase "applyFeatureOptions: enum_type CLOSED" $ do-        let opts =-              [ OptionDef-                  ()-                  (OptionName [SimpleOption "features", SimpleOption "enum_type"])-                  (CIdent "CLOSED")-              ]-            fs = applyFeatureOptions opts defaultFeatureSet-        featureEnumType fs @?= ClosedEnum--    , testCase "applyFeatureOptions: repeated_field_encoding EXPANDED" $ do-        let opts =-              [ OptionDef-                  ()-                  (OptionName [SimpleOption "features", SimpleOption "repeated_field_encoding"])-                  (CIdent "EXPANDED")-              ]-            fs = applyFeatureOptions opts defaultFeatureSet-        featureRepeatedFieldEncoding fs @?= ExpandedEncoding--    , testCase "applyFeatureOptions: unknown options are silently ignored" $ do-        let opts =-              [ OptionDef-                  ()-                  (OptionName [SimpleOption "features", SimpleOption "nonexistent_feature"])-                  (CIdent "SOME_VALUE")-              ]-            fs = applyFeatureOptions opts defaultFeatureSet-        fs @?= defaultFeatureSet--    , testCase "resolveFileFeatures: non-editions returns defaultFeatureSet" $ do-        let fs3 = resolveFileFeatures Proto3 []-            fs2 = resolveFileFeatures Proto2 []-        fs3 @?= defaultFeatureSet-        fs2 @?= defaultFeatureSet--    , testCase "resolveFileFeatures: edition 2023 with override" $ do-        let opts =-              [ OptionDef-                  ()-                  (OptionName [SimpleOption "features", SimpleOption "repeated_field_encoding"])-                  (CIdent "EXPANDED")-              ]-            fs = resolveFileFeatures (Editions (Edition "2023")) opts-        featureRepeatedFieldEncoding fs @?= ExpandedEncoding-        -- Other features stay at edition 2023 defaults-        featureFieldPresence fs @?= ExplicitPresence--    , testCase "resolveFieldFeatures: field overrides parent" $ do-        let parent = defaultFeatureSet { featureEnumType = OpenEnum }-            fieldOpts =-              [ OptionDef-                  ()-                  (OptionName [SimpleOption "features", SimpleOption "enum_type"])-                  (CIdent "CLOSED")-              ]-            fs = resolveFieldFeatures parent fieldOpts-        featureEnumType fs @?= ClosedEnum-        -- Non-overridden features stay from parent-        featureFieldPresence fs @?= featureFieldPresence parent-    ]----- ------------------------------------------------------------------------------ Field presence normalization (applyEditionFieldPresence)--- -----------------------------------------------------------------------------fieldPresenceTests :: TestTree-fieldPresenceTests =-  testGroup-    "field_presence normalization"-    [ testCase "non-editions files are unmodified" $ do-        let src = "syntax = \"proto3\"; message M { int32 x = 1; }"-        case parseProtoFile "<test>" src of-          Left e -> assertFailure (show e)-          Right pf ->-            let pf' = applyEditionFieldPresence pf-            in protoTopLevels pf' @?= protoTopLevels pf--    , testCase "editions EXPLICIT presence → Optional label" $ do-        let src = T.unlines-              [ "edition = \"2023\";"-              , "option features.field_presence = EXPLICIT;"-              , "message M { int32 x = 1; }"-              ]-        case parseProtoFile "<test>" src of-          Left e -> assertFailure (show e)-          Right pf -> do-            let pf' = applyEditionFieldPresence pf-            fieldLabelOf pf' "x" @?= Just Optional--    , testCase "editions IMPLICIT presence → Nothing (plain singular)" $ do-        let src = T.unlines-              [ "edition = \"2023\";"-              , "option features.field_presence = IMPLICIT;"-              , "message M { int32 x = 1; }"-              ]-        case parseProtoFile "<test>" src of-          Left e -> assertFailure (show e)-          Right pf -> do-            let pf' = applyEditionFieldPresence pf-            fieldLabelOf pf' "x" @?= Nothing--    , testCase "editions LEGACY_REQUIRED → Required label" $ do-        let src = T.unlines-              [ "edition = \"2023\";"-              , "option features.field_presence = LEGACY_REQUIRED;"-              , "message M { int32 x = 1; }"-              ]-        case parseProtoFile "<test>" src of-          Left e -> assertFailure (show e)-          Right pf -> do-            let pf' = applyEditionFieldPresence pf-            fieldLabelOf pf' "x" @?= Just Required--    , testCase "repeated fields are unaffected by field_presence" $ do-        let src = T.unlines-              [ "edition = \"2023\";"-              , "option features.field_presence = EXPLICIT;"-              , "message M { repeated int32 xs = 1; }"-              ]-        case parseProtoFile "<test>" src of-          Left e -> assertFailure (show e)-          Right pf -> do-            let pf' = applyEditionFieldPresence pf-            fieldLabelOf pf' "xs" @?= Just Repeated--    , testCase "per-field override takes precedence over file default" $ do-        -- File is IMPLICIT, but this specific field is EXPLICIT-        let src = T.unlines-              [ "edition = \"2023\";"-              , "option features.field_presence = IMPLICIT;"-              , "message M {"-              , "  int32 x = 1;"-              , "  int32 y = 2 [features.field_presence = EXPLICIT];"-              , "}"-              ]-        case parseProtoFile "<test>" src of-          Left e -> assertFailure (show e)-          Right pf -> do-            let pf' = applyEditionFieldPresence pf-            fieldLabelOf pf' "x" @?= Nothing        -- IMPLICIT-            fieldLabelOf pf' "y" @?= Just Optional  -- field-level EXPLICIT-    ]-  where-    fieldLabelOf :: ProtoFile -> T.Text -> Maybe FieldLabel-    fieldLabelOf pf fname =-      let findField [] = Nothing-          findField (TLMessage msg : _) =-            let fields = [fd | MEField fd <- msgElements msg, fieldName fd == fname]-            in case fields of-                 (fd : _) -> Just (fieldLabel fd)-                 [] -> Nothing-          findField (_ : rest) = findField rest-      in case findField (protoTopLevels pf) of-           Just ml -> ml-           Nothing -> Nothing----- ------------------------------------------------------------------------------ repeated_field_encoding in the text codegen path--- -----------------------------------------------------------------------------repeatedEncodingTests :: TestTree-repeatedEncodingTests =-  testGroup-    "repeated_field_encoding in codegen"-    [ testCase "default opts: repeated scalar uses packed encoding" $ do-        let src = "syntax = \"proto3\"; package t; message M { repeated int32 xs = 1; }"-        case parseProtoFile "<test>" src of-          Left e -> assertFailure (show e)-          Right pf -> do-            let reg = buildTypeRegistry defaultGenerateOpts [("<test>", ResolvedProto pf "<test>" Map.empty)]-                code = generateModuleText defaultGenerateOpts reg "<test>" pf-            assertBool "packed encoder present" (T.isInfixOf "encodePackedInt32" code || T.isInfixOf "encodePacked" code)--    , testCase "genPackedRepeated=False: repeated scalar uses expanded encoding" $ do-        let src = "syntax = \"proto3\"; package t; message M { repeated int32 xs = 1; }"-            opts = defaultGenerateOpts { genPackedRepeated = False }-        case parseProtoFile "<test>" src of-          Left e -> assertFailure (show e)-          Right pf -> do-            let reg = buildTypeRegistry opts [("<test>", ResolvedProto pf "<test>" Map.empty)]-                code = generateModuleText opts reg "<test>" pf-            -- Expanded encoding uses foldl' per element-            assertBool "expanded foldl present" (T.isInfixOf "foldl'" code)-            -- Should NOT call a pack function-            assertBool "no packed encoder" (not (T.isInfixOf "encodePacked" code))--    , testCase "edition 2023 EXPANDED override uses expanded encoding" $ do-        let src = T.unlines-              [ "edition = \"2023\";"-              , "package t;"-              , "option features.repeated_field_encoding = EXPANDED;"-              , "message M { repeated int32 xs = 1; }"-              ]-        case parseProtoFile "<test>" src of-          Left e -> assertFailure (show e)-          Right pf -> do-            let reg = buildTypeRegistry defaultGenerateOpts [("<test>", ResolvedProto pf "<test>" Map.empty)]-                code = generateModuleText defaultGenerateOpts reg "<test>" pf-            assertBool "expanded foldl present" (T.isInfixOf "foldl'" code)-            assertBool "no packed encoder" (not (T.isInfixOf "encodePacked" code))-    ]----- ------------------------------------------------------------------------------ enum_type=CLOSED in codegen--- -----------------------------------------------------------------------------enumTypeTests :: TestTree-enumTypeTests =-  testGroup-    "enum_type in codegen"-    [ testCase "default (OPEN): enum decode uses decodeFieldEnum" $ do-        let src = T.unlines-              [ "syntax = \"proto3\";"-              , "package t;"-              , "enum E { E_ZERO = 0; E_ONE = 1; }"-              , "message M { E e = 1; }"-              ]-        case parseProtoFile "<test>" src of-          Left e -> assertFailure (show e)-          Right pf -> do-            let reg = buildTypeRegistry defaultGenerateOpts [("<test>", ResolvedProto pf "<test>" Map.empty)]-                code = generateModuleText defaultGenerateOpts reg "<test>" pf-            assertBool "open enum uses decodeFieldEnum" (T.isInfixOf "decodeFieldEnum" code)--    , testCase "genClosedEnums=True: enum decode uses fromProtoEnum + decodeFail" $ do-        let src = T.unlines-              [ "syntax = \"proto3\";"-              , "package t;"-              , "enum E { E_ZERO = 0; E_ONE = 1; }"-              , "message M { E e = 1; }"-              ]-            opts = defaultGenerateOpts { genClosedEnums = True }-        case parseProtoFile "<test>" src of-          Left e -> assertFailure (show e)-          Right pf -> do-            let reg = buildTypeRegistry opts [("<test>", ResolvedProto pf "<test>" Map.empty)]-                code = generateModuleText opts reg "<test>" pf-            assertBool "closed enum uses fromProtoEnum" (T.isInfixOf "fromProtoEnum" code)-            assertBool "closed enum uses decodeFail" (T.isInfixOf "decodeFail" code)-            assertBool "closed enum does not use decodeFieldEnum" (not (T.isInfixOf "decodeFieldEnum" code))--    , testCase "edition 2023 CLOSED override generates closed decode" $ do-        let src = T.unlines-              [ "edition = \"2023\";"-              , "package t;"-              , "option features.enum_type = CLOSED;"-              , "enum E { E_ZERO = 0; E_ONE = 1; }"-              , "message M { E e = 1; }"-              ]-        case parseProtoFile "<test>" src of-          Left e -> assertFailure (show e)-          Right pf -> do-            let reg = buildTypeRegistry defaultGenerateOpts [("<test>", ResolvedProto pf "<test>" Map.empty)]-                code = generateModuleText defaultGenerateOpts reg "<test>" pf-            assertBool "edition closed enum uses fromProtoEnum" (T.isInfixOf "fromProtoEnum" code)-            assertBool "edition closed enum uses decodeFail" (T.isInfixOf "decodeFail" code)-    ]----- ------------------------------------------------------------------------------ General codegen output checks for editions--- -----------------------------------------------------------------------------codegenOutputTests :: TestTree-codegenOutputTests =-  testGroup-    "Edition codegen output"-    [ testCase "edition = 2023 parses and generates a module" $ do-        let src = T.unlines-              [ "edition = \"2023\";"-              , "package test.ed;"-              , "message Person { string name = 1; int32 age = 2; }"-              ]-        case parseProtoFile "<test>" src of-          Left e -> assertFailure ("parse failed: " <> show e)-          Right pf -> do-            let reg = buildTypeRegistry defaultGenerateOpts [("<test>", ResolvedProto pf "<test>" Map.empty)]-                code = generateModuleText defaultGenerateOpts reg "<test>" pf-            assertBool "data Person" (T.isInfixOf "data Person" code)-            assertBool "MessageEncode instance" (T.isInfixOf "MessageEncode Person" code)-            assertBool "MessageDecode instance" (T.isInfixOf "MessageDecode Person" code)--    , testCase "edition EXPLICIT presence generates Maybe field" $ do-        let src = T.unlines-              [ "edition = \"2023\";"-              , "package test.ed;"-              , "option features.field_presence = EXPLICIT;"-              , "message M { int32 x = 1; }"-              ]-        case parseProtoFile "<test>" src of-          Left e -> assertFailure ("parse failed: " <> show e)-          Right pf -> do-            let pf' = applyEditionFieldPresence pf-                reg = buildTypeRegistry defaultGenerateOpts [("<test>", ResolvedProto pf' "<test>" Map.empty)]-                code = generateModuleText defaultGenerateOpts reg "<test>" pf'-            assertBool "Maybe field for EXPLICIT presence" (T.isInfixOf "Maybe" code)--    , testCase "edition IMPLICIT presence generates plain (non-Maybe) scalar field" $ do-        let src = T.unlines-              [ "edition = \"2023\";"-              , "package test.ed;"-              , "option features.field_presence = IMPLICIT;"-              , "message M { int32 x = 1; }"-              ]-        case parseProtoFile "<test>" src of-          Left e -> assertFailure ("parse failed: " <> show e)-          Right pf -> do-            let pf' = applyEditionFieldPresence pf-                reg = buildTypeRegistry defaultGenerateOpts [("<test>", ResolvedProto pf' "<test>" Map.empty)]-                code = generateModuleText defaultGenerateOpts reg "<test>" pf'-            -- x :: !Int32 (not Maybe)-            assertBool "plain Int32 for IMPLICIT presence" (T.isInfixOf "Int32" code)-            -- The field should NOT be Maybe-wrapped (just a bare Int32 field)-            let lines' = T.lines code-                xLine = filter (\l -> T.isInfixOf "mX " l || T.isInfixOf ":: !Int32" l) lines'-            assertBool "non-Maybe scalar field" (not (null xLine))-    ]
test-integration/Test/Hooks.hs view
@@ -7,280 +7,270 @@ import Proto.CodeGen.Hooks import Proto.IDL.AST import Proto.IDL.Parser-import Test.Tasty-import Test.Tasty.HUnit+import Test.Syd  -hooksTests :: TestTree+hooksTests :: Spec hooksTests =-  testGroup+  describe     "CodeGen Hooks"-    [ testGroup-        "Hook context construction"-        [ testCase "message hook receives correct type name" $ do-            let hook =-                  mempty-                    { onMessageCodeGen = \ctx ->-                        ["-- type: " <> mhcHsTypeName ctx]-                    }-                opts = defaultGenerateOpts {genHooks = hook}-                pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "package test;"-                      , "message Person {"-                      , "  string name = 1;"-                      , "}"-                      ]-                code = generateModuleText opts Map.empty "<test>" pf-            assertBool-              "Hook output should appear in generated code"-              (T.isInfixOf "-- type: Person" code)-        , testCase "message hook receives FQ proto name" $ do-            let hook =-                  mempty-                    { onMessageCodeGen = \ctx ->-                        ["-- fq: " <> mhcFqProtoName ctx]-                    }-                opts = defaultGenerateOpts {genHooks = hook}-                pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "package my.pkg;"-                      , "message Foo {"-                      , "  int32 x = 1;"-                      , "}"-                      ]-                code = generateModuleText opts Map.empty "<test>" pf-            assertBool-              "Hook output should contain FQ name"-              (T.isInfixOf "-- fq: my.pkg.Foo" code)-        , testCase "enum hook receives correct type name" $ do-            let hook =-                  mempty-                    { onEnumCodeGen = \ctx ->-                        ["-- enum: " <> ehcHsTypeName ctx]-                    }-                opts = defaultGenerateOpts {genHooks = hook}-                pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "enum Status {"-                      , "  UNKNOWN = 0;"-                      , "  ACTIVE = 1;"-                      , "}"-                      ]-                code = generateModuleText opts Map.empty "<test>" pf-            assertBool-              "Hook output should appear for enum"-              (T.isInfixOf "-- enum: Status" code)-        , testCase "file hook receives module name" $ do-            let hook =-                  mempty-                    { onFileCodeGen = \ctx ->-                        ["-- module: " <> fhcModuleName ctx]-                    }-                opts = defaultGenerateOpts {genHooks = hook}-                pf = parseOrDie "syntax = \"proto3\";\n"-                code = generateModuleText opts Map.empty "<test>" pf-            assertBool-              "Hook output should appear at file level"-              (T.isInfixOf "-- module: Proto.Gen" code)-        ]-    , testGroup-        "Attribute-driven hooks"-        [ testCase "onMessageAttribute fires when attribute present" $ do-            let hook = onMessageAttribute "my_custom" $ \val ctx ->-                  case val of-                    CBool True -> ["-- custom triggered on " <> mhcHsTypeName ctx]-                    _ -> []-                opts = defaultGenerateOpts {genHooks = hook}-                pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Annotated {"-                      , "  option (my_custom) = true;"-                      , "  string name = 1;"-                      , "}"-                      ]-                code = generateModuleText opts Map.empty "<test>" pf-            assertBool-              "Attribute hook should fire"-              (T.isInfixOf "-- custom triggered on Annotated" code)-        , testCase "onMessageAttribute does not fire without attribute" $ do-            let hook = onMessageAttribute "my_custom" $ \_ ctx ->-                  ["-- should not appear for " <> mhcHsTypeName ctx]-                opts = defaultGenerateOpts {genHooks = hook}-                pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Plain {"-                      , "  string name = 1;"-                      , "}"-                      ]-                code = generateModuleText opts Map.empty "<test>" pf-            assertBool-              "Attribute hook should not fire"-              (not (T.isInfixOf "-- should not appear" code))-        , testCase "onEnumAttribute fires with matching option" $ do-            let hook = onEnumAttribute "special_enum" $ \val ctx ->-                  case val of-                    CString s -> ["-- special: " <> s <> " on " <> ehcHsTypeName ctx]-                    _ -> []-                opts = defaultGenerateOpts {genHooks = hook}-                pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "enum Color {"-                      , "  option (special_enum) = \"rainbow\";"-                      , "  RED = 0;"-                      , "  GREEN = 1;"-                      , "}"-                      ]-                code = generateModuleText opts Map.empty "<test>" pf-            assertBool-              "Enum attribute hook should fire"-              (T.isInfixOf "-- special: rainbow on Color" code)-        , testCase "onFileAttribute fires with matching file option" $ do-            let hook = onFileAttribute "codegen_extra" $ \val ctx ->-                  case val of-                    CBool True -> ["-- extra codegen for " <> fhcModuleName ctx]-                    _ -> []-                opts = defaultGenerateOpts {genHooks = hook}-                pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "option (codegen_extra) = true;"-                      ]-                code = generateModuleText opts Map.empty "<test>" pf-            assertBool-              "File attribute hook should fire"-              (T.isInfixOf "-- extra codegen for" code)-        ]-    , testGroup-        "Hook composition"-        [ testCase "composed hooks both produce output" $ do-            let hook1 =-                  mempty-                    { onMessageCodeGen = \ctx ->-                        ["-- hook1: " <> mhcHsTypeName ctx]-                    }-                hook2 =-                  mempty-                    { onMessageCodeGen = \ctx ->-                        ["-- hook2: " <> mhcHsTypeName ctx]-                    }-                opts = defaultGenerateOpts {genHooks = hook1 <> hook2}-                pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg {"-                      , "  int32 x = 1;"-                      , "}"-                      ]-                code = generateModuleText opts Map.empty "<test>" pf-            assertBool "hook1 output present" (T.isInfixOf "-- hook1: Msg" code)-            assertBool "hook2 output present" (T.isInfixOf "-- hook2: Msg" code)-        , testCase "mempty produces no extra output" $ do-            let opts1 = defaultGenerateOpts-                opts2 = defaultGenerateOpts {genHooks = mempty}-                pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message M { int32 x = 1; }"-                      ]-                code1 = generateModuleText opts1 Map.empty "<test>" pf-                code2 = generateModuleText opts2 Map.empty "<test>" pf-            code1 @?= code2-        ]-    , testGroup-        "Attribute query helpers"-        [ testCase "lookupAttribute finds extension option" $ do-            let opts = [OptionDef () (OptionName [ExtensionOption "my_opt"]) (CInt 42)]-            lookupAttribute "my_opt" opts @?= Just (CInt 42)-        , testCase "lookupAttribute returns Nothing for missing" $ do-            let opts = [OptionDef () (OptionName [SimpleOption "java_package"]) (CString "com.example")]-            lookupAttribute "java_package" opts @?= Nothing-        , testCase "hasAttribute" $ do-            let opts = [OptionDef () (OptionName [ExtensionOption "present"]) (CBool True)]-            hasAttribute "present" opts @?= True-            hasAttribute "absent" opts @?= False-        , testCase "attributeAsText" $ do-            let opts = [OptionDef () (OptionName [ExtensionOption "tag"]) (CString "hello")]-            attributeAsText "tag" opts @?= Just "hello"-            attributeAsText "missing" opts @?= Nothing-        , testCase "attributeAsBool" $ do-            let opts = [OptionDef () (OptionName [ExtensionOption "flag"]) (CBool True)]-            attributeAsBool "flag" opts @?= Just True-        , testCase "attributeAsInt" $ do-            let opts = [OptionDef () (OptionName [ExtensionOption "count"]) (CInt 99)]-            attributeAsInt "count" opts @?= Just 99-        , testCase "attributeAsFloat" $ do-            let opts = [OptionDef () (OptionName [ExtensionOption "rate"]) (CFloat 3.14)]-            attributeAsFloat "rate" opts @?= Just 3.14-        , testCase "attributeAsAggregate" $ do-            let agg = [("key", CString "val")]-                opts = [OptionDef () (OptionName [ExtensionOption "meta"]) (CAggregate agg)]-            attributeAsAggregate "meta" opts @?= Just agg-        , testCase "type mismatch returns Nothing" $ do-            let opts = [OptionDef () (OptionName [ExtensionOption "x"]) (CInt 1)]-            attributeAsText "x" opts @?= Nothing-            attributeAsBool "x" opts @?= Nothing-        ]-    , testGroup-        "messageOptions extraction"-        [ testCase "extracts MEOption from message elements" $ do-            let pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg {"-                      , "  option (my_opt) = true;"-                      , "  option deprecated = true;"-                      , "  string name = 1;"-                      , "}"-                      ]-            case protoTopLevels pf of-              [TLMessage msg] -> do-                let opts = messageOptions msg-                length opts @?= 2-              _ -> assertFailure "expected one message"-        ]-    , testGroup-        "THHooks construction"-        [ testCase "defaultTHHooks is mempty" $ do-            let h1 = defaultTHHooks-                h2 = mempty :: THHooks-            -- Both should be constructible (type-checks)-            assertBool "defaultTHHooks should be the identity" True-        , testCase "THHooks compose with <>" $ do-            let h1 = defaultTHHooks-                h2 = defaultTHHooks-                combined = h1 <> h2-            assertBool "THHooks should compose" True-        , testCase "thOnMessageAttribute constructs without error" $ do-            let hook = thOnMessageAttribute "my_attr" $ \_val _ctx ->-                  pure []-            assertBool "thOnMessageAttribute should construct" True-        , testCase "thOnEnumAttribute constructs without error" $ do-            let hook = thOnEnumAttribute "my_attr" $ \_val _ctx ->-                  pure []-            assertBool "thOnEnumAttribute should construct" True-        , testCase "thOnFileAttribute constructs without error" $ do-            let hook = thOnFileAttribute "my_attr" $ \_val _ctx ->-                  pure []-            assertBool "thOnFileAttribute should construct" True-        ]-    ]+    $ sequence_+      [ describe+          "Hook context construction"+          $ sequence_+            [ it "message hook receives correct type name" $ do+                let hook =+                      mempty+                        { onMessageCodeGen = \ctx ->+                            ["-- type: " <> mhcHsTypeName ctx]+                        }+                    opts = defaultGenerateOpts {genHooks = hook}+                    pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "package test;"+                          , "message Person {"+                          , "  string name = 1;"+                          , "}"+                          ]+                    code = generateModuleText opts Map.empty "<test>" pf+                (T.isInfixOf "-- type: Person" code) `shouldBe` True+            , it "message hook receives FQ proto name" $ do+                let hook =+                      mempty+                        { onMessageCodeGen = \ctx ->+                            ["-- fq: " <> mhcFqProtoName ctx]+                        }+                    opts = defaultGenerateOpts {genHooks = hook}+                    pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "package my.pkg;"+                          , "message Foo {"+                          , "  int32 x = 1;"+                          , "}"+                          ]+                    code = generateModuleText opts Map.empty "<test>" pf+                (T.isInfixOf "-- fq: my.pkg.Foo" code) `shouldBe` True+            , it "enum hook receives correct type name" $ do+                let hook =+                      mempty+                        { onEnumCodeGen = \ctx ->+                            ["-- enum: " <> ehcHsTypeName ctx]+                        }+                    opts = defaultGenerateOpts {genHooks = hook}+                    pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "enum Status {"+                          , "  UNKNOWN = 0;"+                          , "  ACTIVE = 1;"+                          , "}"+                          ]+                    code = generateModuleText opts Map.empty "<test>" pf+                (T.isInfixOf "-- enum: Status" code) `shouldBe` True+            , it "file hook receives module name" $ do+                let hook =+                      mempty+                        { onFileCodeGen = \ctx ->+                            ["-- module: " <> fhcModuleName ctx]+                        }+                    opts = defaultGenerateOpts {genHooks = hook}+                    pf = parseOrDie "syntax = \"proto3\";\n"+                    code = generateModuleText opts Map.empty "<test>" pf+                (T.isInfixOf "-- module: Proto.Gen" code) `shouldBe` True+            ]+      , describe+          "Attribute-driven hooks"+          $ sequence_+            [ it "onMessageAttribute fires when attribute present" $ do+                let hook = onMessageAttribute "my_custom" $ \val ctx ->+                      case val of+                        CBool True -> ["-- custom triggered on " <> mhcHsTypeName ctx]+                        _ -> []+                    opts = defaultGenerateOpts {genHooks = hook}+                    pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Annotated {"+                          , "  option (my_custom) = true;"+                          , "  string name = 1;"+                          , "}"+                          ]+                    code = generateModuleText opts Map.empty "<test>" pf+                (T.isInfixOf "-- custom triggered on Annotated" code) `shouldBe` True+            , it "onMessageAttribute does not fire without attribute" $ do+                let hook = onMessageAttribute "my_custom" $ \_ ctx ->+                      ["-- should not appear for " <> mhcHsTypeName ctx]+                    opts = defaultGenerateOpts {genHooks = hook}+                    pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Plain {"+                          , "  string name = 1;"+                          , "}"+                          ]+                    code = generateModuleText opts Map.empty "<test>" pf+                (not (T.isInfixOf "-- should not appear" code)) `shouldBe` True+            , it "onEnumAttribute fires with matching option" $ do+                let hook = onEnumAttribute "special_enum" $ \val ctx ->+                      case val of+                        CString s -> ["-- special: " <> s <> " on " <> ehcHsTypeName ctx]+                        _ -> []+                    opts = defaultGenerateOpts {genHooks = hook}+                    pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "enum Color {"+                          , "  option (special_enum) = \"rainbow\";"+                          , "  RED = 0;"+                          , "  GREEN = 1;"+                          , "}"+                          ]+                    code = generateModuleText opts Map.empty "<test>" pf+                (T.isInfixOf "-- special: rainbow on Color" code) `shouldBe` True+            , it "onFileAttribute fires with matching file option" $ do+                let hook = onFileAttribute "codegen_extra" $ \val ctx ->+                      case val of+                        CBool True -> ["-- extra codegen for " <> fhcModuleName ctx]+                        _ -> []+                    opts = defaultGenerateOpts {genHooks = hook}+                    pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "option (codegen_extra) = true;"+                          ]+                    code = generateModuleText opts Map.empty "<test>" pf+                (T.isInfixOf "-- extra codegen for" code) `shouldBe` True+            ]+      , describe+          "Hook composition"+          $ sequence_+            [ it "composed hooks both produce output" $ do+                let hook1 =+                      mempty+                        { onMessageCodeGen = \ctx ->+                            ["-- hook1: " <> mhcHsTypeName ctx]+                        }+                    hook2 =+                      mempty+                        { onMessageCodeGen = \ctx ->+                            ["-- hook2: " <> mhcHsTypeName ctx]+                        }+                    opts = defaultGenerateOpts {genHooks = hook1 <> hook2}+                    pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg {"+                          , "  int32 x = 1;"+                          , "}"+                          ]+                    code = generateModuleText opts Map.empty "<test>" pf+                (T.isInfixOf "-- hook1: Msg" code) `shouldBe` True+                (T.isInfixOf "-- hook2: Msg" code) `shouldBe` True+            , it "mempty produces no extra output" $ do+                let opts1 = defaultGenerateOpts+                    opts2 = defaultGenerateOpts {genHooks = mempty}+                    pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message M { int32 x = 1; }"+                          ]+                    code1 = generateModuleText opts1 Map.empty "<test>" pf+                    code2 = generateModuleText opts2 Map.empty "<test>" pf+                code1 `shouldBe` code2+            ]+      , describe+          "Attribute query helpers"+          $ sequence_+            [ it "lookupAttribute finds extension option" $ do+                let opts = [OptionDef () (OptionName [ExtensionOption "my_opt"]) (CInt 42)]+                lookupAttribute "my_opt" opts `shouldBe` Just (CInt 42)+            , it "lookupAttribute returns Nothing for missing" $ do+                let opts = [OptionDef () (OptionName [SimpleOption "java_package"]) (CString "com.example")]+                lookupAttribute "java_package" opts `shouldBe` Nothing+            , it "hasAttribute" $ do+                let opts = [OptionDef () (OptionName [ExtensionOption "present"]) (CBool True)]+                hasAttribute "present" opts `shouldBe` True+                hasAttribute "absent" opts `shouldBe` False+            , it "attributeAsText" $ do+                let opts = [OptionDef () (OptionName [ExtensionOption "tag"]) (CString "hello")]+                attributeAsText "tag" opts `shouldBe` Just "hello"+                attributeAsText "missing" opts `shouldBe` Nothing+            , it "attributeAsBool" $ do+                let opts = [OptionDef () (OptionName [ExtensionOption "flag"]) (CBool True)]+                attributeAsBool "flag" opts `shouldBe` Just True+            , it "attributeAsInt" $ do+                let opts = [OptionDef () (OptionName [ExtensionOption "count"]) (CInt 99)]+                attributeAsInt "count" opts `shouldBe` Just 99+            , it "attributeAsFloat" $ do+                let opts = [OptionDef () (OptionName [ExtensionOption "rate"]) (CFloat 3.14)]+                attributeAsFloat "rate" opts `shouldBe` Just 3.14+            , it "attributeAsAggregate" $ do+                let agg = [("key", CString "val")]+                    opts = [OptionDef () (OptionName [ExtensionOption "meta"]) (CAggregate agg)]+                attributeAsAggregate "meta" opts `shouldBe` Just agg+            , it "type mismatch returns Nothing" $ do+                let opts = [OptionDef () (OptionName [ExtensionOption "x"]) (CInt 1)]+                attributeAsText "x" opts `shouldBe` Nothing+                attributeAsBool "x" opts `shouldBe` Nothing+            ]+      , describe+          "messageOptions extraction"+          $ sequence_+            [ it "extracts MEOption from message elements" $ do+                let pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg {"+                          , "  option (my_opt) = true;"+                          , "  option deprecated = true;"+                          , "  string name = 1;"+                          , "}"+                          ]+                case protoTopLevels pf of+                  [TLMessage msg] -> do+                    let opts = messageOptions msg+                    length opts `shouldBe` 2+                  _ -> expectationFailure "expected one message"+            ]+      , describe+          "THHooks construction"+          $ sequence_+            [ it "defaultTHHooks is mempty" $ do+                let h1 = defaultTHHooks+                    h2 = mempty :: THHooks+                -- Both should be constructible (type-checks)+                (True) `shouldBe` True+            , it "THHooks compose with <>" $ do+                let h1 = defaultTHHooks+                    h2 = defaultTHHooks+                    combined = h1 <> h2+                (True) `shouldBe` True+            , it "thOnMessageAttribute constructs without error" $ do+                let hook = thOnMessageAttribute "my_attr" $ \_val _ctx ->+                      pure []+                (True) `shouldBe` True+            , it "thOnEnumAttribute constructs without error" $ do+                let hook = thOnEnumAttribute "my_attr" $ \_val _ctx ->+                      pure []+                (True) `shouldBe` True+            , it "thOnFileAttribute constructs without error" $ do+                let hook = thOnFileAttribute "my_attr" $ \_val _ctx ->+                      pure []+                (True) `shouldBe` True+            ]+      ]   parseOrDie :: Text -> ProtoFile
test-integration/Test/JSON.hs view
@@ -1,10 +1,10 @@ module Test.JSON (jsonTests) where -import qualified Data.Bifunctor import Data.Aeson qualified as Aeson import Data.Aeson.Key qualified as AesonKey import Data.Aeson.KeyMap qualified as AesonKM import Data.Aeson.Types qualified as AesonT+import Data.Bifunctor qualified import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BL import Data.ByteString.Short qualified as SBS@@ -18,253 +18,267 @@ import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range import Proto.Internal.JSON-import Test.Tasty-import Test.Tasty.HUnit hiding (assert)-import Test.Tasty.Hedgehog+import Test.Syd+import Test.Syd.Hedgehog ()  -jsonTests :: TestTree+jsonTests :: Spec jsonTests =-  testGroup+  describe     "JSON representation helpers"-    [ testGroup-        "Strict ByteString (base64)"-        [ testProperty "roundtrip via Value" $ property $ do-            bs <- forAll $ Gen.bytes (Range.linear 0 200)-            let val = protoBytesToJSON bs-            parsed <- evalEither (AesonT.parseEither protoBytesFromJSON val)-            parsed === bs-        , testCase "encodes as base64 string" $ do-            let val = protoBytesToJSON (BS.pack [0x00, 0xFF, 0x42])-            case val of-              Aeson.String _ -> pure ()-              other -> assertFailure ("Expected String, got " <> show other)-        , testProperty "field helper roundtrip" $ property $ do-            bs <- forAll $ Gen.bytes (Range.linear 0 200)-            let (_, val) = bytesFieldToJSON "data" bs-                obj = mkObj [("data", val)]-            result <- evalEither (AesonT.parseEither (parseBytesFieldMaybe obj) "data")-            result === Just bs-        ]-    , testGroup-        "Lazy ByteString (base64)"-        [ testProperty "roundtrip via Value" $ property $ do-            bs <- forAll $ Gen.bytes (Range.linear 0 200)-            let lbs = BL.fromStrict bs-                val = protoLazyBytesToJSON lbs-            parsed <- evalEither (AesonT.parseEither protoLazyBytesFromJSON val)-            parsed === lbs-        , testProperty "field helper roundtrip" $ property $ do-            bs <- forAll $ Gen.bytes (Range.linear 0 200)-            let lbs = BL.fromStrict bs-                (_, val) = lazyBytesFieldToJSON "blob" lbs-                obj = mkObj [("blob", val)]-            result <- evalEither (AesonT.parseEither (parseLazyBytesFieldMaybe obj) "blob")-            result === Just lbs-        ]-    , testGroup-        "ShortByteString (base64)"-        [ testProperty "roundtrip via Value" $ property $ do-            bs <- forAll $ Gen.bytes (Range.linear 0 200)-            let sbs = SBS.toShort bs-                val = protoShortBytesToJSON sbs-            parsed <- evalEither (AesonT.parseEither protoShortBytesFromJSON val)-            parsed === sbs-        , testProperty "field helper roundtrip" $ property $ do-            bs <- forAll $ Gen.bytes (Range.linear 0 200)-            let sbs = SBS.toShort bs-                (_, val) = shortBytesFieldToJSON "compact" sbs-                obj = mkObj [("compact", val)]-            result <- evalEither (AesonT.parseEither (parseShortBytesFieldMaybe obj) "compact")-            result === Just sbs-        ]-    , testGroup-        "Strict Text"-        [ testProperty ".=: / parseFieldMaybe roundtrip" $ property $ do-            t <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode-            let (_, val) = "name" .=: t-                obj = mkObj [("name", val)]-            result <- evalEither (AesonT.parseEither (parseFieldMaybe obj) "name")-            result === Just t-        ]-    , testGroup-        "Lazy Text"-        [ testProperty "field helper roundtrip" $ property $ do-            t <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode-            let lt = TL.fromStrict t-                (_, val) = lazyTextFieldToJSON "desc" lt-                obj = mkObj [("desc", val)]-            result <- evalEither (AesonT.parseEither (parseLazyTextFieldMaybe obj) "desc")-            result === Just lt-        ]-    , testGroup-        "ShortByteString as text (UTF-8)"-        [ testProperty "field helper roundtrip" $ property $ do-            t <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode-            let sbs = SBS.toShort (TE.encodeUtf8 t)-                (_, val) = shortTextFieldToJSON "tag" sbs-                obj = mkObj [("tag", val)]-            result <- evalEither (AesonT.parseEither (parseShortTextFieldMaybe obj) "tag")-            result === Just sbs-        ]-    , testGroup-        "Haskell String"-        [ testProperty "field helper roundtrip" $ property $ do-            t <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode-            let s = T.unpack t-                (_, val) = hsStringFieldToJSON "label" s-                obj = mkObj [("label", val)]-            result <- evalEither (AesonT.parseEither (parseHsStringFieldMaybe obj) "label")-            result === Just s-        ]-    , testGroup-        "Missing / null field handling"-        [ testCase "parseBytesFieldMaybe missing -> Nothing" $ do-            let obj = mkObj []-            runParserOK (parseBytesFieldMaybe obj "x") >>= (@?= Nothing)-        , testCase "parseBytesFieldMaybe null -> Nothing" $ do-            let obj = mkObj [("x", Aeson.Null)]-            runParserOK (parseBytesFieldMaybe obj "x") >>= (@?= Nothing)-        , testCase "parseLazyBytesFieldMaybe missing -> Nothing" $ do-            let obj = mkObj []-            runParserOK (parseLazyBytesFieldMaybe obj "x") >>= (@?= Nothing)-        , testCase "parseShortBytesFieldMaybe missing -> Nothing" $ do-            let obj = mkObj []-            runParserOK (parseShortBytesFieldMaybe obj "x") >>= (@?= Nothing)-        , testCase "parseLazyTextFieldMaybe missing -> Nothing" $ do-            let obj = mkObj []-            runParserOK (parseLazyTextFieldMaybe obj "x") >>= (@?= Nothing)-        , testCase "parseShortTextFieldMaybe missing -> Nothing" $ do-            let obj = mkObj []-            runParserOK (parseShortTextFieldMaybe obj "x") >>= (@?= Nothing)-        , testCase "parseHsStringFieldMaybe missing -> Nothing" $ do-            let obj = mkObj []-            runParserOK (parseHsStringFieldMaybe obj "x") >>= (@?= Nothing)-        ]-    , testGroup-        "Type mismatch errors"-        [ testCase "parseBytesFieldMaybe non-string -> fail" $-            assertParserFails (parseBytesFieldMaybe (mkObj [("x", Aeson.Number 42)]) "x")-        , testCase "parseLazyTextFieldMaybe non-string -> fail" $-            assertParserFails (parseLazyTextFieldMaybe (mkObj [("x", Aeson.Bool True)]) "x")-        , testCase "parseShortTextFieldMaybe non-string -> fail" $-            assertParserFails (parseShortTextFieldMaybe (mkObj [("x", Aeson.Number 1)]) "x")-        , testCase "parseHsStringFieldMaybe non-string -> fail" $-            assertParserFails (parseHsStringFieldMaybe (mkObj [("x", Aeson.Array mempty)]) "x")-        ]-    , testGroup-        "Cross-representation consistency"-        [ testProperty "all bytes reps produce same base64" $ property $ do-            bs <- forAll $ Gen.bytes (Range.linear 0 200)-            let strict = protoBytesToJSON bs-                lazy = protoLazyBytesToJSON (BL.fromStrict bs)-                short = protoShortBytesToJSON (SBS.toShort bs)-            strict === lazy-            strict === short-        , testProperty "all text reps produce same JSON string" $ property $ do-            t <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode-            let (_, strictVal) = "k" .=: t-                (_, lazyVal) = lazyTextFieldToJSON "k" (TL.fromStrict t)-                (_, shortVal) = shortTextFieldToJSON "k" (SBS.toShort (TE.encodeUtf8 t))-                (_, stringVal) = hsStringFieldToJSON "k" (T.unpack t)-            strictVal === lazyVal-            strictVal === shortVal-            strictVal === stringVal-        ]-    , testGroup-        "Map representations"-        [ testGroup-            "Ordered Map (Map.Map)"-            [ testProperty "ordMapToJSON roundtrip" $ property $ do-                keys <--                  forAll $-                    Gen.list-                      (Range.linear 0 10)-                      (Gen.text (Range.linear 1 20) Gen.alphaNum)-                vals <--                  forAll $-                    Gen.list-                      (Range.linear 0 10)-                      (Gen.int32 (Range.linear (-1000) 1000))-                let m = Map.fromList (zip keys vals)-                    encoded = ordMapToJSON m-                parsed <- evalEither (AesonT.parseEither parseOrdMapFromJSON encoded)-                parsed === m-            , testCase "ordMapToJSON empty" $ do-                let m = Map.empty :: Map.Map Text Int-                    encoded = ordMapToJSON m-                encoded @?= Aeson.object []-            , testCase "ordMapToJSON preserves entries" $ do-                let m = Map.fromList [("a" :: Text, 1 :: Int), ("b", 2)]-                    Aeson.Object o = ordMapToJSON m-                AesonT.parseEither (parseOrdMapFromJSON . Aeson.Object) o @?= Right m+    $ sequence_+      [ describe+          "Strict ByteString (base64)"+          $ sequence_+            [ it "roundtrip via Value" $ property $ do+                bs <- forAll $ Gen.bytes (Range.linear 0 200)+                let val = protoBytesToJSON bs+                parsed <- evalEither (AesonT.parseEither protoBytesFromJSON val)+                parsed === bs+            , it "encodes as base64 string" $ do+                let val = protoBytesToJSON (BS.pack [0x00, 0xFF, 0x42])+                case val of+                  Aeson.String _ -> pure ()+                  other -> expectationFailure ("Expected String, got " <> show other)+            , it "field helper roundtrip" $ property $ do+                bs <- forAll $ Gen.bytes (Range.linear 0 200)+                let (_, val) = bytesFieldToJSON "data" bs+                    obj = mkObj [("data", val)]+                result <- evalEither (AesonT.parseEither (parseBytesFieldMaybe obj) "data")+                result === Just bs             ]-        , testGroup-            "HashMap"-            [ testProperty "hashMapToJSON roundtrip" $ property $ do-                keys <--                  forAll $-                    Gen.list-                      (Range.linear 0 10)-                      (Gen.text (Range.linear 1 20) Gen.alphaNum)-                vals <--                  forAll $-                    Gen.list-                      (Range.linear 0 10)-                      (Gen.int32 (Range.linear (-1000) 1000))-                let m = HM.fromList (zip keys vals)-                    encoded = hashMapToJSON m-                parsed <- evalEither (AesonT.parseEither parseHashMapFromJSON encoded)-                parsed === m-            , testCase "hashMapToJSON empty" $ do-                let m = HM.empty :: HM.HashMap Text Int-                    encoded = hashMapToJSON m-                encoded @?= Aeson.object []-            , testCase "hashMapToJSON preserves entries" $ do-                let m = HM.fromList [("x" :: Text, True), ("y", False)]-                    Aeson.Object o = hashMapToJSON m-                AesonT.parseEither (parseHashMapFromJSON . Aeson.Object) o @?= Right m+      , describe+          "Lazy ByteString (base64)"+          $ sequence_+            [ it "roundtrip via Value" $ property $ do+                bs <- forAll $ Gen.bytes (Range.linear 0 200)+                let lbs = BL.fromStrict bs+                    val = protoLazyBytesToJSON lbs+                parsed <- evalEither (AesonT.parseEither protoLazyBytesFromJSON val)+                parsed === lbs+            , it "field helper roundtrip" $ property $ do+                bs <- forAll $ Gen.bytes (Range.linear 0 200)+                let lbs = BL.fromStrict bs+                    (_, val) = lazyBytesFieldToJSON "blob" lbs+                    obj = mkObj [("blob", val)]+                result <- evalEither (AesonT.parseEither (parseLazyBytesFieldMaybe obj) "blob")+                result === Just lbs             ]-        , testGroup-            "Cross-representation consistency"-            [ testProperty "ordMap and hashMap produce same JSON" $ property $ do-                keys <--                  forAll $-                    Gen.list-                      (Range.linear 0 10)-                      (Gen.text (Range.linear 1 20) Gen.alphaNum)-                vals <--                  forAll $-                    Gen.list-                      (Range.linear 0 10)-                      (Gen.int32 (Range.linear (-1000) 1000))-                let ordM = Map.fromList (zip keys vals)-                    hashM = HM.fromList (zip keys vals)-                    ordJSON = ordMapToJSON ordM-                    hashJSON = hashMapToJSON hashM-                normalizeObject ordJSON === normalizeObject hashJSON-            , testProperty "ordMap JSON parses as hashMap and vice versa" $ property $ do-                keys <--                  forAll $-                    Gen.list-                      (Range.linear 0 10)-                      (Gen.text (Range.linear 1 20) Gen.alphaNum)-                vals <--                  forAll $-                    Gen.list-                      (Range.linear 0 10)-                      (Gen.int32 (Range.linear (-1000) 1000))-                let ordM = Map.fromList (zip keys vals)-                    encoded = ordMapToJSON ordM-                parsedAsHash <- evalEither (AesonT.parseEither parseHashMapFromJSON encoded)-                Map.fromList (HM.toList parsedAsHash) === ordM+      , describe+          "ShortByteString (base64)"+          $ sequence_+            [ it "roundtrip via Value" $ property $ do+                bs <- forAll $ Gen.bytes (Range.linear 0 200)+                let sbs = SBS.toShort bs+                    val = protoShortBytesToJSON sbs+                parsed <- evalEither (AesonT.parseEither protoShortBytesFromJSON val)+                parsed === sbs+            , it "field helper roundtrip" $ property $ do+                bs <- forAll $ Gen.bytes (Range.linear 0 200)+                let sbs = SBS.toShort bs+                    (_, val) = shortBytesFieldToJSON "compact" sbs+                    obj = mkObj [("compact", val)]+                result <- evalEither (AesonT.parseEither (parseShortBytesFieldMaybe obj) "compact")+                result === Just sbs             ]-        , testCase "parseOrdMapFromJSON non-object -> fail" $-            assertParserFails (parseOrdMapFromJSON (Aeson.String "nope") :: AesonT.Parser (Map.Map Text Int))-        , testCase "parseHashMapFromJSON non-object -> fail" $-            assertParserFails (parseHashMapFromJSON (Aeson.Number 42) :: AesonT.Parser (HM.HashMap Text Int))-        ]-    ]+      , describe+          "Strict Text"+          $ sequence_+            [ it ".=: / parseFieldMaybe roundtrip" $ property $ do+                t <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode+                let (_, val) = "name" .=: t+                    obj = mkObj [("name", val)]+                result <- evalEither (AesonT.parseEither (parseFieldMaybe obj) "name")+                result === Just t+            ]+      , describe+          "Lazy Text"+          $ sequence_+            [ it "field helper roundtrip" $ property $ do+                t <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode+                let lt = TL.fromStrict t+                    (_, val) = lazyTextFieldToJSON "desc" lt+                    obj = mkObj [("desc", val)]+                result <- evalEither (AesonT.parseEither (parseLazyTextFieldMaybe obj) "desc")+                result === Just lt+            ]+      , describe+          "ShortByteString as text (UTF-8)"+          $ sequence_+            [ it "field helper roundtrip" $ property $ do+                t <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode+                let sbs = SBS.toShort (TE.encodeUtf8 t)+                    (_, val) = shortTextFieldToJSON "tag" sbs+                    obj = mkObj [("tag", val)]+                result <- evalEither (AesonT.parseEither (parseShortTextFieldMaybe obj) "tag")+                result === Just sbs+            ]+      , describe+          "Haskell String"+          $ sequence_+            [ it "field helper roundtrip" $ property $ do+                t <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode+                let s = T.unpack t+                    (_, val) = hsStringFieldToJSON "label" s+                    obj = mkObj [("label", val)]+                result <- evalEither (AesonT.parseEither (parseHsStringFieldMaybe obj) "label")+                result === Just s+            ]+      , describe+          "Missing / null field handling"+          $ sequence_+            [ it "parseBytesFieldMaybe missing -> Nothing" $ do+                let obj = mkObj []+                runParserOK (parseBytesFieldMaybe obj "x") >>= (`shouldBe` Nothing)+            , it "parseBytesFieldMaybe null -> Nothing" $ do+                let obj = mkObj [("x", Aeson.Null)]+                runParserOK (parseBytesFieldMaybe obj "x") >>= (`shouldBe` Nothing)+            , it "parseLazyBytesFieldMaybe missing -> Nothing" $ do+                let obj = mkObj []+                runParserOK (parseLazyBytesFieldMaybe obj "x") >>= (`shouldBe` Nothing)+            , it "parseShortBytesFieldMaybe missing -> Nothing" $ do+                let obj = mkObj []+                runParserOK (parseShortBytesFieldMaybe obj "x") >>= (`shouldBe` Nothing)+            , it "parseLazyTextFieldMaybe missing -> Nothing" $ do+                let obj = mkObj []+                runParserOK (parseLazyTextFieldMaybe obj "x") >>= (`shouldBe` Nothing)+            , it "parseShortTextFieldMaybe missing -> Nothing" $ do+                let obj = mkObj []+                runParserOK (parseShortTextFieldMaybe obj "x") >>= (`shouldBe` Nothing)+            , it "parseHsStringFieldMaybe missing -> Nothing" $ do+                let obj = mkObj []+                runParserOK (parseHsStringFieldMaybe obj "x") >>= (`shouldBe` Nothing)+            ]+      , describe+          "Type mismatch errors"+          $ sequence_+            [ it "parseBytesFieldMaybe non-string -> fail" $+                assertParserFails (parseBytesFieldMaybe (mkObj [("x", Aeson.Number 42)]) "x")+            , it "parseLazyTextFieldMaybe non-string -> fail" $+                assertParserFails (parseLazyTextFieldMaybe (mkObj [("x", Aeson.Bool True)]) "x")+            , it "parseShortTextFieldMaybe non-string -> fail" $+                assertParserFails (parseShortTextFieldMaybe (mkObj [("x", Aeson.Number 1)]) "x")+            , it "parseHsStringFieldMaybe non-string -> fail" $+                assertParserFails (parseHsStringFieldMaybe (mkObj [("x", Aeson.Array mempty)]) "x")+            ]+      , describe+          "Cross-representation consistency"+          $ sequence_+            [ it "all bytes reps produce same base64" $ property $ do+                bs <- forAll $ Gen.bytes (Range.linear 0 200)+                let strict = protoBytesToJSON bs+                    lazy = protoLazyBytesToJSON (BL.fromStrict bs)+                    short = protoShortBytesToJSON (SBS.toShort bs)+                strict === lazy+                strict === short+            , it "all text reps produce same JSON string" $ property $ do+                t <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode+                let (_, strictVal) = "k" .=: t+                    (_, lazyVal) = lazyTextFieldToJSON "k" (TL.fromStrict t)+                    (_, shortVal) = shortTextFieldToJSON "k" (SBS.toShort (TE.encodeUtf8 t))+                    (_, stringVal) = hsStringFieldToJSON "k" (T.unpack t)+                strictVal === lazyVal+                strictVal === shortVal+                strictVal === stringVal+            ]+      , describe+          "Map representations"+          $ sequence_+            [ describe+                "Ordered Map (Map.Map)"+                $ sequence_+                  [ it "ordMapToJSON roundtrip" $ property $ do+                      keys <-+                        forAll $+                          Gen.list+                            (Range.linear 0 10)+                            (Gen.text (Range.linear 1 20) Gen.alphaNum)+                      vals <-+                        forAll $+                          Gen.list+                            (Range.linear 0 10)+                            (Gen.int32 (Range.linear (-1000) 1000))+                      let m = Map.fromList (zip keys vals)+                          encoded = ordMapToJSON m+                      parsed <- evalEither (AesonT.parseEither parseOrdMapFromJSON encoded)+                      parsed === m+                  , it "ordMapToJSON empty" $ do+                      let m = Map.empty :: Map.Map Text Int+                          encoded = ordMapToJSON m+                      encoded `shouldBe` Aeson.object []+                  , it "ordMapToJSON preserves entries" $ do+                      let m = Map.fromList [("a" :: Text, 1 :: Int), ("b", 2)]+                          Aeson.Object o = ordMapToJSON m+                      AesonT.parseEither (parseOrdMapFromJSON . Aeson.Object) o `shouldBe` Right m+                  ]+            , describe+                "HashMap"+                $ sequence_+                  [ it "hashMapToJSON roundtrip" $ property $ do+                      keys <-+                        forAll $+                          Gen.list+                            (Range.linear 0 10)+                            (Gen.text (Range.linear 1 20) Gen.alphaNum)+                      vals <-+                        forAll $+                          Gen.list+                            (Range.linear 0 10)+                            (Gen.int32 (Range.linear (-1000) 1000))+                      let m = HM.fromList (zip keys vals)+                          encoded = hashMapToJSON m+                      parsed <- evalEither (AesonT.parseEither parseHashMapFromJSON encoded)+                      parsed === m+                  , it "hashMapToJSON empty" $ do+                      let m = HM.empty :: HM.HashMap Text Int+                          encoded = hashMapToJSON m+                      encoded `shouldBe` Aeson.object []+                  , it "hashMapToJSON preserves entries" $ do+                      let m = HM.fromList [("x" :: Text, True), ("y", False)]+                          Aeson.Object o = hashMapToJSON m+                      AesonT.parseEither (parseHashMapFromJSON . Aeson.Object) o `shouldBe` Right m+                  ]+            , describe+                "Cross-representation consistency"+                $ sequence_+                  [ it "ordMap and hashMap produce same JSON" $ property $ do+                      keys <-+                        forAll $+                          Gen.list+                            (Range.linear 0 10)+                            (Gen.text (Range.linear 1 20) Gen.alphaNum)+                      vals <-+                        forAll $+                          Gen.list+                            (Range.linear 0 10)+                            (Gen.int32 (Range.linear (-1000) 1000))+                      let ordM = Map.fromList (zip keys vals)+                          hashM = HM.fromList (zip keys vals)+                          ordJSON = ordMapToJSON ordM+                          hashJSON = hashMapToJSON hashM+                      normalizeObject ordJSON === normalizeObject hashJSON+                  , it "ordMap JSON parses as hashMap and vice versa" $ property $ do+                      keys <-+                        forAll $+                          Gen.list+                            (Range.linear 0 10)+                            (Gen.text (Range.linear 1 20) Gen.alphaNum)+                      vals <-+                        forAll $+                          Gen.list+                            (Range.linear 0 10)+                            (Gen.int32 (Range.linear (-1000) 1000))+                      let ordM = Map.fromList (zip keys vals)+                          encoded = ordMapToJSON ordM+                      parsedAsHash <- evalEither (AesonT.parseEither parseHashMapFromJSON encoded)+                      Map.fromList (HM.toList parsedAsHash) === ordM+                  ]+            , it "parseOrdMapFromJSON non-object -> fail" $+                assertParserFails (parseOrdMapFromJSON (Aeson.String "nope") :: AesonT.Parser (Map.Map Text Int))+            , it "parseHashMapFromJSON non-object -> fail" $+                assertParserFails (parseHashMapFromJSON (Aeson.Number 42) :: AesonT.Parser (HM.HashMap Text Int))+            ]+      ]   mkObj :: [(Text, Aeson.Value)] -> Aeson.Object@@ -276,13 +290,13 @@ runParserOK :: (Show a, Eq a) => AesonT.Parser a -> IO a runParserOK p = case AesonT.parseEither (const p) () of   Right a -> pure a-  Left e -> assertFailure ("Parser failed: " <> e) >> error "unreachable"+  Left e -> expectationFailure ("Parser failed: " <> e) >> error "unreachable"   assertParserFails :: AesonT.Parser a -> IO () assertParserFails p = case AesonT.parseEither (const p) () of   Left _ -> pure ()-  Right _ -> assertFailure "Expected parser to fail"+  Right _ -> expectationFailure "Expected parser to fail"   normalizeObject :: Aeson.Value -> Map.Map Text Aeson.Value
test-integration/Test/Lens.hs view
@@ -1,31 +1,30 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE TypeApplications #-}+ module Test.Lens (lensTests) where  import Data.Int (Int32, Int64)-import Test.Tasty-import Test.Tasty.HUnit+import Proto.Google.Protobuf.Timestamp (Timestamp (..), defaultTimestamp)+import Test.Syd -import Proto.Google.Protobuf.WellKnownTypes.Timestamp (Timestamp(..), defaultTimestamp) -lensTests :: TestTree-lensTests = testGroup "Proto.Lens (record field access)"-  [ testCase "read timestampSeconds" $ do-      let ts = defaultTimestamp { timestampSeconds = 42, timestampNanos = 99 }-      timestampSeconds ts @?= (42 :: Int64)--  , testCase "read timestampNanos" $ do-      let ts = defaultTimestamp { timestampSeconds = 42, timestampNanos = 99 }-      timestampNanos ts @?= (99 :: Int32)--  , testCase "update via record syntax" $ do-      let ts = defaultTimestamp { timestampSeconds = 42, timestampNanos = 99 }-          ts' = ts { timestampSeconds = 100, timestampNanos = 200 }-      timestampSeconds ts' @?= 100-      timestampNanos ts' @?= 200--  , testCase "default values" $ do-      timestampSeconds defaultTimestamp @?= 0-      timestampNanos defaultTimestamp @?= 0-  ]+lensTests :: Spec+lensTests =+  describe "Proto.Lens (record field access)" $+    sequence_+      [ it "read timestampSeconds" $ do+          let ts = defaultTimestamp {timestampSeconds = 42, timestampNanos = 99}+          timestampSeconds ts `shouldBe` (42 :: Int64)+      , it "read timestampNanos" $ do+          let ts = defaultTimestamp {timestampSeconds = 42, timestampNanos = 99}+          timestampNanos ts `shouldBe` (99 :: Int32)+      , it "update via record syntax" $ do+          let ts = defaultTimestamp {timestampSeconds = 42, timestampNanos = 99}+              ts' = ts {timestampSeconds = 100, timestampNanos = 200}+          timestampSeconds ts' `shouldBe` 100+          timestampNanos ts' `shouldBe` 200+      , it "default values" $ do+          timestampSeconds defaultTimestamp `shouldBe` 0+          timestampNanos defaultTimestamp `shouldBe` 0+      ]
test-integration/Test/Options.hs view
@@ -5,159 +5,164 @@ import Proto.IDL.AST import Proto.IDL.Options import Proto.IDL.Parser-import Test.Tasty-import Test.Tasty.HUnit+import Test.Syd  -optionsTests :: TestTree+optionsTests :: Spec optionsTests =-  testGroup+  describe     "Standard Options"-    [ testGroup-        "File options"-        [ testCase "java_package" $ do-            let pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "option java_package = \"com.example\";"-                      ]-                fo = extractFileOptions (protoOptions pf)-            foJavaPackage fo @?= Just "com.example"-        , testCase "go_package" $ do-            let pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "option go_package = \"example.com/pkg\";"-                      ]-                fo = extractFileOptions (protoOptions pf)-            foGoPackage fo @?= Just "example.com/pkg"-        , testCase "optimize_for" $ do-            let pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "option optimize_for = LITE_RUNTIME;"-                      ]-                fo = extractFileOptions (protoOptions pf)-            foOptimizeFor fo @?= LiteRuntime-        , testCase "deprecated file" $ do-            let pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "option deprecated = true;"-                      ]-                fo = extractFileOptions (protoOptions pf)-            foDeprecated fo @?= True-        , testCase "defaults when no options" $ do-            let pf = parseOrDie "syntax = \"proto3\";\n"-                fo = extractFileOptions (protoOptions pf)-            foJavaPackage fo @?= Nothing-            foGoPackage fo @?= Nothing-            foOptimizeFor fo @?= Speed-            foDeprecated fo @?= False-        ]-    , testGroup-        "Field options"-        [ testCase "deprecated field" $ do-            let pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg {"-                      , "  string old_name = 1 [deprecated = true];"-                      , "}"-                      ]-            case protoTopLevels pf of-              [TLMessage msg] -> case msgElements msg of-                [MEField fd] -> do-                  let fo = extractFieldOptions (fieldOptions fd)-                  fldDeprecated fo @?= True-                _ -> assertFailure "expected one field"-              _ -> assertFailure "expected one message"-        , testCase "json_name" $ do-            let pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg {"-                      , "  string full_name = 1 [json_name = \"fullName\"];"-                      , "}"-                      ]-            case protoTopLevels pf of-              [TLMessage msg] -> case msgElements msg of-                [MEField fd] -> do-                  let fo = extractFieldOptions (fieldOptions fd)-                  fldJsonName fo @?= Just "fullName"-                _ -> assertFailure "expected one field"-              _ -> assertFailure "expected one message"-        ]-    , testGroup-        "Enum options"-        [ testCase "allow_alias" $ do-            let pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "enum Foo {"-                      , "  option allow_alias = true;"-                      , "  A = 0;"-                      , "  B = 1;"-                      , "  C = 1;"-                      , "}"-                      ]-            case protoTopLevels pf of-              [TLEnum ed] -> do-                let eo = extractEnumOptions (enumOptions ed)-                eoAllowAlias eo @?= True-              _ -> assertFailure "expected one enum"-        ]-    , testGroup-        "Cross-language packages"-        [ testCase "extractLanguagePackages" $ do-            let pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "package example.api;"-                      , "option java_package = \"com.example.api\";"-                      , "option go_package = \"example.com/api\";"-                      , "option csharp_namespace = \"Example.Api\";"-                      ]-                lp = extractLanguagePackages pf-            lpProtoPackage lp @?= Just "example.api"-            lpJavaPackage lp @?= Just "com.example.api"-            lpGoPackage lp @?= Just "example.com/api"-            lpCsharpNamespace lp @?= Just "Example.Api"-            lpHaskellModule lp @?= "Example.Api"-        ]-    , testGroup-        "Deprecation helpers"-        [ testCase "deprecatedFields" $ do-            let pf =-                  parseOrDie $-                    T.unlines-                      [ "syntax = \"proto3\";"-                      , "message Msg {"-                      , "  string name = 1;"-                      , "  string old = 2 [deprecated = true];"-                      , "  int32 value = 3;"-                      , "}"-                      ]-            case protoTopLevels pf of-              [TLMessage msg] -> do-                let deps = deprecatedFields msg-                length deps @?= 1-                fieldName (head deps) @?= "old"-              _ -> assertFailure "expected one message"-        , testCase "isDeprecated" $ do-            isDeprecated [] @?= False-            let opt = OptionDef () (OptionName [SimpleOption "deprecated"]) (CBool True)-            isDeprecated [opt] @?= True-        ]-    ]+    $ sequence_+      [ describe+          "File options"+          $ sequence_+            [ it "java_package" $ do+                let pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "option java_package = \"com.example\";"+                          ]+                    fo = extractFileOptions (protoOptions pf)+                foJavaPackage fo `shouldBe` Just "com.example"+            , it "go_package" $ do+                let pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "option go_package = \"example.com/pkg\";"+                          ]+                    fo = extractFileOptions (protoOptions pf)+                foGoPackage fo `shouldBe` Just "example.com/pkg"+            , it "optimize_for" $ do+                let pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "option optimize_for = LITE_RUNTIME;"+                          ]+                    fo = extractFileOptions (protoOptions pf)+                foOptimizeFor fo `shouldBe` LiteRuntime+            , it "deprecated file" $ do+                let pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "option deprecated = true;"+                          ]+                    fo = extractFileOptions (protoOptions pf)+                foDeprecated fo `shouldBe` True+            , it "defaults when no options" $ do+                let pf = parseOrDie "syntax = \"proto3\";\n"+                    fo = extractFileOptions (protoOptions pf)+                foJavaPackage fo `shouldBe` Nothing+                foGoPackage fo `shouldBe` Nothing+                foOptimizeFor fo `shouldBe` Speed+                foDeprecated fo `shouldBe` False+            ]+      , describe+          "Field options"+          $ sequence_+            [ it "deprecated field" $ do+                let pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg {"+                          , "  string old_name = 1 [deprecated = true];"+                          , "}"+                          ]+                case protoTopLevels pf of+                  [TLMessage msg] -> case msgElements msg of+                    [MEField fd] -> do+                      let fo = extractFieldOptions (fieldOptions fd)+                      fldDeprecated fo `shouldBe` True+                    _ -> expectationFailure "expected one field"+                  _ -> expectationFailure "expected one message"+            , it "json_name" $ do+                let pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg {"+                          , "  string full_name = 1 [json_name = \"fullName\"];"+                          , "}"+                          ]+                case protoTopLevels pf of+                  [TLMessage msg] -> case msgElements msg of+                    [MEField fd] -> do+                      let fo = extractFieldOptions (fieldOptions fd)+                      fldJsonName fo `shouldBe` Just "fullName"+                    _ -> expectationFailure "expected one field"+                  _ -> expectationFailure "expected one message"+            ]+      , describe+          "Enum options"+          $ sequence_+            [ it "allow_alias" $ do+                let pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "enum Foo {"+                          , "  option allow_alias = true;"+                          , "  A = 0;"+                          , "  B = 1;"+                          , "  C = 1;"+                          , "}"+                          ]+                case protoTopLevels pf of+                  [TLEnum ed] -> do+                    let eo = extractEnumOptions (enumOptions ed)+                    eoAllowAlias eo `shouldBe` True+                  _ -> expectationFailure "expected one enum"+            ]+      , describe+          "Cross-language packages"+          $ sequence_+            [ it "extractLanguagePackages" $ do+                let pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "package example.api;"+                          , "option java_package = \"com.example.api\";"+                          , "option go_package = \"example.com/api\";"+                          , "option csharp_namespace = \"Example.Api\";"+                          ]+                    lp = extractLanguagePackages pf+                lpProtoPackage lp `shouldBe` Just "example.api"+                lpJavaPackage lp `shouldBe` Just "com.example.api"+                lpGoPackage lp `shouldBe` Just "example.com/api"+                lpCsharpNamespace lp `shouldBe` Just "Example.Api"+                lpHaskellModule lp `shouldBe` "Example.Api"+            ]+      , describe+          "Deprecation helpers"+          $ sequence_+            [ it "deprecatedFields" $ do+                let pf =+                      parseOrDie $+                        T.unlines+                          [ "syntax = \"proto3\";"+                          , "message Msg {"+                          , "  string name = 1;"+                          , "  string old = 2 [deprecated = true];"+                          , "  int32 value = 3;"+                          , "}"+                          ]+                case protoTopLevels pf of+                  [TLMessage msg] -> do+                    let deps = deprecatedFields msg+                    length deps `shouldBe` 1+                    fieldName (head deps) `shouldBe` "old"+                  _ -> expectationFailure "expected one message"+            , it "isDeprecated" $ do+                isDeprecated [] `shouldBe` False+                let opt = OptionDef () (OptionName [SimpleOption "deprecated"]) (CBool True)+                isDeprecated [opt] `shouldBe` True+            ]+      ]   parseOrDie :: Text -> ProtoFile
test-integration/Test/Parser.hs view
@@ -5,592 +5,1068 @@ import Data.Text (Text) import Proto.IDL.AST import Proto.IDL.Parser-import Test.Tasty-import Test.Tasty.HUnit---parserTests :: TestTree-parserTests =-  testGroup-    "Parser"-    [ testGroup-        "Syntax declaration"-        [ testCase "proto3 syntax" $ do-            let input = "syntax = \"proto3\";\n"-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> protoSyntax pf @?= Proto3-        , testCase "proto2 syntax" $ do-            let input = "syntax = \"proto2\";\n"-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> protoSyntax pf @?= Proto2-        , testCase "default syntax is proto3" $ do-            case parseProtoFile "<test>" "" of-              Left e -> assertFailure (show e)-              Right pf -> protoSyntax pf @?= Proto3-        ]-    , testGroup-        "Package declaration"-        [ testCase "simple package" $ do-            let input = "syntax = \"proto3\";\npackage mypackage;\n"-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> protoPackage pf @?= Just "mypackage"-        , testCase "dotted package" $ do-            let input = "syntax = \"proto3\";\npackage com.example.api;\n"-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> protoPackage pf @?= Just "com.example.api"-        ]-    , testGroup-        "Import declarations"-        [ testCase "simple import" $ do-            let input = "syntax = \"proto3\";\nimport \"other.proto\";\n"-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoImports pf of-                [imp] -> importPath imp @?= "other.proto"-                _ -> assertFailure "Expected exactly one import"-        , testCase "public import" $ do-            let input = "syntax = \"proto3\";\nimport public \"other.proto\";\n"-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoImports pf of-                [imp] -> importModifier imp @?= Just ImportPublic-                _ -> assertFailure "Expected exactly one import"-        ]-    , testGroup-        "Message definitions"-        [ testCase "simple message with scalar fields" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "message Person {"-                    , "  string name = 1;"-                    , "  int32 age = 2;"-                    , "  bool active = 3;"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoTopLevels pf of-                [TLMessage msg] -> do-                  msgName msg @?= "Person"-                  length (msgElements msg) @?= 3-                _ -> assertFailure "Expected one message"-        , testCase "message with all scalar types" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "message AllTypes {"-                    , "  double f1 = 1;"-                    , "  float f2 = 2;"-                    , "  int32 f3 = 3;"-                    , "  int64 f4 = 4;"-                    , "  uint32 f5 = 5;"-                    , "  uint64 f6 = 6;"-                    , "  sint32 f7 = 7;"-                    , "  sint64 f8 = 8;"-                    , "  fixed32 f9 = 9;"-                    , "  fixed64 f10 = 10;"-                    , "  sfixed32 f11 = 11;"-                    , "  sfixed64 f12 = 12;"-                    , "  bool f13 = 13;"-                    , "  string f14 = 14;"-                    , "  bytes f15 = 15;"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoTopLevels pf of-                [TLMessage msg] -> length (msgElements msg) @?= 15-                _ -> assertFailure "Expected one message"-        , testCase "nested message" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "message Outer {"-                    , "  message Inner {"-                    , "    int32 value = 1;"-                    , "  }"-                    , "  Inner inner = 1;"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoTopLevels pf of-                [TLMessage msg] -> do-                  msgName msg @?= "Outer"-                  let hasNestedMsg = any isNestedMsg (msgElements msg)-                  assertBool "Should have nested message" hasNestedMsg-                _ -> assertFailure "Expected one message"-        , testCase "repeated fields" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "message Msg {"-                    , "  repeated string tags = 1;"-                    , "  repeated int32 values = 2;"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoTopLevels pf of-                [TLMessage msg] ->-                  let fields = extractFieldDefs (msgElements msg)-                  in all (\f -> fieldLabel f == Just Repeated) fields @?= True-                _ -> assertFailure "Expected one message"-        , testCase "map fields" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "message Msg {"-                    , "  map<string, int32> counts = 1;"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoTopLevels pf of-                [TLMessage msg] -> case msgElements msg of-                  [MEMapField mf] -> do-                    mapKeyType mf @?= SString-                    mapValueType mf @?= FTScalar SInt32-                    mapFieldName mf @?= "counts"-                  _ -> assertFailure "Expected one map field"-                _ -> assertFailure "Expected one message"-        ]-    , testGroup-        "Oneof"-        [ testCase "oneof definition" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "message Msg {"-                    , "  oneof value {"-                    , "    string name = 1;"-                    , "    int32 id = 2;"-                    , "  }"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoTopLevels pf of-                [TLMessage msg] -> case msgElements msg of-                  [MEOneof od] -> do-                    oneofName od @?= "value"-                    length (oneofFields od) @?= 2-                  _ -> assertFailure "Expected one oneof"-                _ -> assertFailure "Expected one message"-        ]-    , testGroup-        "Enum definitions"-        [ testCase "simple enum" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "enum Status {"-                    , "  UNKNOWN = 0;"-                    , "  ACTIVE = 1;"-                    , "  INACTIVE = 2;"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoTopLevels pf of-                [TLEnum ed] -> do-                  enumName ed @?= "Status"-                  length (enumValues ed) @?= 3-                _ -> assertFailure "Expected one enum"-        , testCase "enum with allow_alias option" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "enum Status {"-                    , "  option allow_alias = true;"-                    , "  UNKNOWN = 0;"-                    , "  ACTIVE = 1;"-                    , "  RUNNING = 1;"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoTopLevels pf of-                [TLEnum ed] -> do-                  length (enumOptions ed) @?= 1-                  length (enumValues ed) @?= 3-                _ -> assertFailure "Expected one enum"-        ]-    , testGroup-        "Service definitions"-        [ testCase "simple service" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "service Greeter {"-                    , "  rpc SayHello (HelloRequest) returns (HelloReply);"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoTopLevels pf of-                [TLService svc] -> do-                  svcName svc @?= "Greeter"-                  case svcRpcs svc of-                    [rpc] -> do-                      rpcName rpc @?= "SayHello"-                      rpcInput rpc @?= "HelloRequest"-                      rpcOutput rpc @?= "HelloReply"-                      rpcInputStr rpc @?= NoStream-                      rpcOutputStr rpc @?= NoStream-                    _ -> assertFailure "Expected one RPC"-                _ -> assertFailure "Expected one service"-        , testCase "streaming rpc" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "service Chat {"-                    , "  rpc Stream (stream Msg) returns (stream Msg);"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoTopLevels pf of-                [TLService svc] -> case svcRpcs svc of-                  [rpc] -> do-                    rpcInputStr rpc @?= Streaming-                    rpcOutputStr rpc @?= Streaming-                  _ -> assertFailure "Expected one RPC"-                _ -> assertFailure "Expected one service"-        ]-    , testGroup-        "Options and annotations"-        [ testCase "file-level option" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "option java_package = \"com.example\";"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoOptions pf of-                [opt] -> do-                  optValue opt @?= CString "com.example"-                _ -> assertFailure "Expected one option"-        , testCase "custom extension option" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "option (my_custom_opt) = true;"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoOptions pf of-                [opt] -> do-                  case optNameParts (optName opt) of-                    [ExtensionOption n] -> n @?= "my_custom_opt"-                    _ -> assertFailure "Expected extension option"-                  optValue opt @?= CBool True-                _ -> assertFailure "Expected one option"-        , testCase "field options" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "message Msg {"-                    , "  string name = 1 [deprecated = true, json_name = \"Name\"];"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoTopLevels pf of-                [TLMessage msg] -> case msgElements msg of-                  [MEField fd] -> length (fieldOptions fd) @?= 2-                  _ -> assertFailure "Expected one field"-                _ -> assertFailure "Expected one message"-        , testCase "aggregate option value" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "option (my_opt) = { foo: 1 bar: \"hello\" };"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoOptions pf of-                [opt] -> case optValue opt of-                  CAggregate kvs -> length kvs @?= 2-                  _ -> assertFailure "Expected aggregate constant"-                _ -> assertFailure "Expected one option"-        ]-    , testGroup-        "Reserved"-        [ testCase "reserved field numbers" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "message Msg {"-                    , "  reserved 2, 15, 9 to 11;"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoTopLevels pf of-                [TLMessage msg] -> case msgElements msg of-                  [MEReserved (ReservedNumbers ranges)] ->-                    length ranges @?= 3-                  _ -> assertFailure "Expected reserved numbers"-                _ -> assertFailure "Expected one message"-        , testCase "reserved field names" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "message Msg {"-                    , "  reserved \"foo\", \"bar\";"-                    , "}"-                    ]-            case parseProtoFile "<test>" input of-              Left e -> assertFailure (show e)-              Right pf -> case protoTopLevels pf of-                [TLMessage msg] -> case msgElements msg of-                  [MEReserved (ReservedNames names)] ->-                    names @?= ["foo", "bar"]-                  _ -> assertFailure "Expected reserved names"-                _ -> assertFailure "Expected one message"-        ]-    , testGroup-        "Complex proto files"-        [ testCase "full proto file" $ do-            let input = complexProto-            assertBool "Should parse complex proto" (isRight (parseProtoFile "<test>" input))-        ]-    , testGroup-        "Comments"-        [ testCase "line comments" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\"; // this is a comment"-                    , "// another comment"-                    , "message Msg {"-                    , "  int32 x = 1; // field comment"-                    , "}"-                    ]-            assertBool "Should parse with line comments" (isRight (parseProtoFile "<test>" input))-        , testCase "block comments" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "/* block comment */"-                    , "message Msg {"-                    , "  /* multi"-                    , "     line"-                    , "     comment */"-                    , "  int32 x = 1;"-                    , "}"-                    ]-            assertBool "Should parse with block comments" (isRight (parseProtoFile "<test>" input))-        ]-    , testGroup-        "Error message quality"-        [ testCase "missing semicolon points to correct location" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "message Foo {"-                    , "  string name = 1"-                    , "}"-                    ]-            case parseProtoFile "test.proto" input of-              Left e -> do-                let msg = renderParseError e-                assertBool "should mention ';'" ("';'" `isInfixOf` msg)-                assertBool "should show file location" ("test.proto:4:" `isInfixOf` msg)-                assertBool "should show source context" ("string name = 1" `isInfixOf` msg)-                assertBool "should have caret pointer" ("^" `isInfixOf` msg)-              Right _ -> assertFailure "Should have failed to parse"-        , testCase "missing field number gives helpful message" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "message Foo {"-                    , "  string name = ;"-                    , "}"-                    ]-            case parseProtoFile "test.proto" input of-              Left e -> do-                let msg = renderParseError e-                assertBool "should mention field number" ("field number" `isInfixOf` msg || "integer" `isInfixOf` msg)-                assertBool "should show source line" ("string name" `isInfixOf` msg)-              Right _ -> assertFailure "Should have failed to parse"-        , testCase "missing equals sign gives helpful message" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "message Foo {"-                    , "  string name 1;"-                    , "}"-                    ]-            case parseProtoFile "test.proto" input of-              Left e -> do-                let msg = renderParseError e-                assertBool "should mention '='" ("'='" `isInfixOf` msg)-                assertBool "should point to correct column" ("test.proto:3:15" `isInfixOf` msg)-              Right _ -> assertFailure "Should have failed to parse"-        , testCase "invalid syntax version gives clear message" $ do-            let input = "syntax = \"proto4\";\n"-            case parseProtoFile "test.proto" input of-              Left e -> do-                let msg = renderParseError e-                assertBool "should mention proto4" ("proto4" `isInfixOf` msg)-                assertBool "should mention expected versions" ("proto2" `isInfixOf` msg && "proto3" `isInfixOf` msg)-              Right _ -> assertFailure "Should have failed to parse"-        , testCase "unclosed string literal gives clear message" $ do-            let input = "syntax = \"proto3;\n"-            case parseProtoFile "test.proto" input of-              Left e -> do-                let msg = renderParseError e-                assertBool "should mention newline" ("newline" `isInfixOf` msg)-                assertBool "should point to correct location" ("test.proto:1:" `isInfixOf` msg)-              Right _ -> assertFailure "Should have failed to parse"-        , testCase "missing message name gives clear message" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "message {"-                    , "  string name = 1;"-                    , "}"-                    ]-            case parseProtoFile "test.proto" input of-              Left e -> do-                let msg = renderParseError e-                assertBool "should mention message name" ("message name" `isInfixOf` msg)-              Right _ -> assertFailure "Should have failed to parse"-        , testCase "unexpected token at top level gives clear message" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "12345"-                    ]-            case parseProtoFile "test.proto" input of-              Left e -> do-                let msg = renderParseError e-                assertBool "should mention expected declarations" ("message" `isInfixOf` msg || "top-level" `isInfixOf` msg)-              Right _ -> assertFailure "Should have failed to parse"-        , testCase "missing comma in map type gives clear message" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "message Foo {"-                    , "  map<string int32> x = 1;"-                    , "}"-                    ]-            case parseProtoFile "test.proto" input of-              Left e -> do-                let msg = renderParseError e-                assertBool "should mention comma" ("','" `isInfixOf` msg)-                assertBool "should point to correct location" ("test.proto:3:14" `isInfixOf` msg)-              Right _ -> assertFailure "Should have failed to parse"-        , testCase "error messages include source context with line numbers" $ do-            let input =-                  unlines'-                    [ "syntax = \"proto3\";"-                    , "package myapp;"-                    , ""-                    , "message User {"-                    , "  string name = 1;"-                    , "  int32 age = 2;"-                    , "  string email = 3"-                    , "}"-                    ]-            case parseProtoFile "api/user.proto" input of-              Left e -> do-                let msg = renderParseError e-                assertBool "should have file:line:col format" ("api/user.proto:" `isInfixOf` msg)-                assertBool "should have --> arrow" ("-->" `isInfixOf` msg)-                assertBool "should have pipe separator" (" | " `isInfixOf` msg)-                assertBool "should have caret pointer" ("^" `isInfixOf` msg)-              Right _ -> assertFailure "Should have failed to parse"-        , testCase "error output rejects invalid inputs" $ do-            let cases =-                  [ ("empty message body missing brace", "syntax = \"proto3\";\nmessage Foo {\n")-                  , ("unknown keyword at top level", "syntax = \"proto3\";\nfoobar baz;\n")-                  , ("missing closing brace for enum", "syntax = \"proto3\";\nenum Foo {\n  A = 0;\n")-                  ]-            mapM_-              ( \(desc, input) ->-                  assertBool desc (isLeft (parseProtoFile "test.proto" input))-              )-              cases-        ]-    ]---complexProto :: Text-complexProto =-  unlines'-    [ "syntax = \"proto3\";"-    , "package example.api;"-    , ""-    , "import \"google/protobuf/timestamp.proto\";"-    , "import public \"common.proto\";"-    , ""-    , "option java_package = \"com.example.api\";"-    , "option (custom_file_opt) = true;"-    , ""-    , "enum Status {"-    , "  STATUS_UNKNOWN = 0;"-    , "  STATUS_ACTIVE = 1;"-    , "  STATUS_INACTIVE = 2;"-    , "}"-    , ""-    , "message Person {"-    , "  string name = 1;"-    , "  int32 id = 2;"-    , "  string email = 3;"-    , ""-    , "  enum PhoneType {"-    , "    MOBILE = 0;"-    , "    HOME = 1;"-    , "    WORK = 2;"-    , "  }"-    , ""-    , "  message PhoneNumber {"-    , "    string number = 1;"-    , "    PhoneType type = 2;"-    , "  }"-    , ""-    , "  repeated PhoneNumber phones = 4;"-    , "  Status status = 5;"-    , "  map<string, string> metadata = 6;"-    , ""-    , "  oneof contact {"-    , "    string phone = 7;"-    , "    string email_alt = 8;"-    , "  }"-    , ""-    , "  reserved 10, 12 to 15;"-    , "  reserved \"old_field\";"-    , "}"-    , ""-    , "service PersonService {"-    , "  rpc GetPerson (GetPersonRequest) returns (Person);"-    , "  rpc ListPersons (ListRequest) returns (stream Person);"-    , "  rpc UpdatePerson (stream Person) returns (UpdateResponse) {"-    , "    option deprecated = true;"-    , "  }"-    , "}"-    ]---isNestedMsg :: MessageElement -> Bool-isNestedMsg (MEMessage _) = True-isNestedMsg _ = False---extractFieldDefs :: [MessageElement] -> [FieldDef]-extractFieldDefs = concatMap go-  where-    go (MEField fd) = [fd]-    go _ = []---unlines' :: [Text] -> Text-unlines' = mconcat . fmap (<> "\n")+import Test.Syd+++parserTests :: Spec+parserTests =+  describe+    "Parser"+    $ sequence_+      [ describe+          "Syntax declaration"+          $ sequence_+            [ it "proto3 syntax" $ do+                let input = "syntax = \"proto3\";\n"+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> protoSyntax pf `shouldBe` Proto3+            , it "proto2 syntax" $ do+                let input = "syntax = \"proto2\";\n"+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> protoSyntax pf `shouldBe` Proto2+            , it "default syntax is proto3" $ do+                case parseProtoFile "<test>" "" of+                  Left e -> expectationFailure (show e)+                  Right pf -> protoSyntax pf `shouldBe` Proto3+            ]+      , describe+          "Package declaration"+          $ sequence_+            [ it "simple package" $ do+                let input = "syntax = \"proto3\";\npackage mypackage;\n"+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> protoPackage pf `shouldBe` Just "mypackage"+            , it "dotted package" $ do+                let input = "syntax = \"proto3\";\npackage com.example.api;\n"+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> protoPackage pf `shouldBe` Just "com.example.api"+            ]+      , describe+          "Import declarations"+          $ sequence_+            [ it "simple import" $ do+                let input = "syntax = \"proto3\";\nimport \"other.proto\";\n"+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoImports pf of+                    [imp] -> importPath imp `shouldBe` "other.proto"+                    _ -> expectationFailure "Expected exactly one import"+            , it "public import" $ do+                let input = "syntax = \"proto3\";\nimport public \"other.proto\";\n"+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoImports pf of+                    [imp] -> importModifier imp `shouldBe` Just ImportPublic+                    _ -> expectationFailure "Expected exactly one import"+            ]+      , describe+          "Message definitions"+          $ sequence_+            [ it "simple message with scalar fields" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Person {"+                        , "  string name = 1;"+                        , "  int32 age = 2;"+                        , "  bool active = 3;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage msg] -> do+                      msgName msg `shouldBe` "Person"+                      length (msgElements msg) `shouldBe` 3+                    _ -> expectationFailure "Expected one message"+            , it "message with all scalar types" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message AllTypes {"+                        , "  double f1 = 1;"+                        , "  float f2 = 2;"+                        , "  int32 f3 = 3;"+                        , "  int64 f4 = 4;"+                        , "  uint32 f5 = 5;"+                        , "  uint64 f6 = 6;"+                        , "  sint32 f7 = 7;"+                        , "  sint64 f8 = 8;"+                        , "  fixed32 f9 = 9;"+                        , "  fixed64 f10 = 10;"+                        , "  sfixed32 f11 = 11;"+                        , "  sfixed64 f12 = 12;"+                        , "  bool f13 = 13;"+                        , "  string f14 = 14;"+                        , "  bytes f15 = 15;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage msg] -> length (msgElements msg) `shouldBe` 15+                    _ -> expectationFailure "Expected one message"+            , it "nested message" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Outer {"+                        , "  message Inner {"+                        , "    int32 value = 1;"+                        , "  }"+                        , "  Inner inner = 1;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage msg] -> do+                      msgName msg `shouldBe` "Outer"+                      let hasNestedMsg = any isNestedMsg (msgElements msg)+                      (hasNestedMsg) `shouldBe` True+                    _ -> expectationFailure "Expected one message"+            , it "repeated fields" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Msg {"+                        , "  repeated string tags = 1;"+                        , "  repeated int32 values = 2;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage msg] ->+                      let fields = extractFieldDefs (msgElements msg)+                      in all (\f -> fieldLabel f == Just Repeated) fields `shouldBe` True+                    _ -> expectationFailure "Expected one message"+            , it "map fields" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Msg {"+                        , "  map<string, int32> counts = 1;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage msg] -> case msgElements msg of+                      [MEMapField mf] -> do+                        mapKeyType mf `shouldBe` SString+                        mapValueType mf `shouldBe` FTScalar SInt32+                        mapFieldName mf `shouldBe` "counts"+                      _ -> expectationFailure "Expected one map field"+                    _ -> expectationFailure "Expected one message"+            ]+      , describe+          "Oneof"+          $ sequence_+            [ it "oneof definition" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Msg {"+                        , "  oneof value {"+                        , "    string name = 1;"+                        , "    int32 id = 2;"+                        , "  }"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage msg] -> case msgElements msg of+                      [MEOneof od] -> do+                        oneofName od `shouldBe` "value"+                        length (oneofFields od) `shouldBe` 2+                      _ -> expectationFailure "Expected one oneof"+                    _ -> expectationFailure "Expected one message"+            ]+      , describe+          "Enum definitions"+          $ sequence_+            [ it "simple enum" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "enum Status {"+                        , "  UNKNOWN = 0;"+                        , "  ACTIVE = 1;"+                        , "  INACTIVE = 2;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLEnum ed] -> do+                      enumName ed `shouldBe` "Status"+                      length (enumValues ed) `shouldBe` 3+                    _ -> expectationFailure "Expected one enum"+            , it "enum with allow_alias option" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "enum Status {"+                        , "  option allow_alias = true;"+                        , "  UNKNOWN = 0;"+                        , "  ACTIVE = 1;"+                        , "  RUNNING = 1;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLEnum ed] -> do+                      length (enumOptions ed) `shouldBe` 1+                      length (enumValues ed) `shouldBe` 3+                    _ -> expectationFailure "Expected one enum"+            ]+      , describe+          "Service definitions"+          $ sequence_+            [ it "simple service" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "service Greeter {"+                        , "  rpc SayHello (HelloRequest) returns (HelloReply);"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLService svc] -> do+                      svcName svc `shouldBe` "Greeter"+                      case svcRpcs svc of+                        [rpc] -> do+                          rpcName rpc `shouldBe` "SayHello"+                          rpcInput rpc `shouldBe` "HelloRequest"+                          rpcOutput rpc `shouldBe` "HelloReply"+                          rpcInputStr rpc `shouldBe` NoStream+                          rpcOutputStr rpc `shouldBe` NoStream+                        _ -> expectationFailure "Expected one RPC"+                    _ -> expectationFailure "Expected one service"+            , it "streaming rpc" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "service Chat {"+                        , "  rpc Stream (stream Msg) returns (stream Msg);"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLService svc] -> case svcRpcs svc of+                      [rpc] -> do+                        rpcInputStr rpc `shouldBe` Streaming+                        rpcOutputStr rpc `shouldBe` Streaming+                      _ -> expectationFailure "Expected one RPC"+                    _ -> expectationFailure "Expected one service"+            ]+      , describe+          "Options and annotations"+          $ sequence_+            [ it "file-level option" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "option java_package = \"com.example\";"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoOptions pf of+                    [opt] -> do+                      optValue opt `shouldBe` CString "com.example"+                    _ -> expectationFailure "Expected one option"+            , it "custom extension option" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "option (my_custom_opt) = true;"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoOptions pf of+                    [opt] -> do+                      case optNameParts (optName opt) of+                        [ExtensionOption n] -> n `shouldBe` "my_custom_opt"+                        _ -> expectationFailure "Expected extension option"+                      optValue opt `shouldBe` CBool True+                    _ -> expectationFailure "Expected one option"+            , it "field options" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Msg {"+                        , "  string name = 1 [deprecated = true, json_name = \"Name\"];"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage msg] -> case msgElements msg of+                      [MEField fd] -> length (fieldOptions fd) `shouldBe` 2+                      _ -> expectationFailure "Expected one field"+                    _ -> expectationFailure "Expected one message"+            , it "aggregate option value" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "option (my_opt) = { foo: 1 bar: \"hello\" };"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoOptions pf of+                    [opt] -> case optValue opt of+                      CAggregate kvs -> length kvs `shouldBe` 2+                      _ -> expectationFailure "Expected aggregate constant"+                    _ -> expectationFailure "Expected one option"+            ]+      , describe+          "Reserved"+          $ sequence_+            [ it "reserved field numbers" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Msg {"+                        , "  reserved 2, 15, 9 to 11;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage msg] -> case msgElements msg of+                      [MEReserved (ReservedNumbers ranges)] ->+                        length ranges `shouldBe` 3+                      _ -> expectationFailure "Expected reserved numbers"+                    _ -> expectationFailure "Expected one message"+            , it "reserved field names" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Msg {"+                        , "  reserved \"foo\", \"bar\";"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage msg] -> case msgElements msg of+                      [MEReserved (ReservedNames names)] ->+                        names `shouldBe` [QuotedReservedName "foo", QuotedReservedName "bar"]+                      _ -> expectationFailure "Expected reserved names"+                    _ -> expectationFailure "Expected one message"+            ]+      , describe+          "Empty statements (trailing/stray semicolons)"+          $ sequence_+            [ it "trailing ';' after a message block (protoc tolerates '};')" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Foo {"+                        , "  string name = 1;"+                        , "};"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage msg] -> do+                      msgName msg `shouldBe` "Foo"+                      length (msgElements msg) `shouldBe` 1+                    _ -> expectationFailure "Expected exactly one message"+            , it "trailing ';' after an enum block" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "enum Status {"+                        , "  UNKNOWN = 0;"+                        , "  ACTIVE = 1;"+                        , "};"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLEnum ed] -> do+                      enumName ed `shouldBe` "Status"+                      length (enumValues ed) `shouldBe` 2+                    _ -> expectationFailure "Expected exactly one enum"+            , it "trailing ';' after a service block" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "service Greeter {"+                        , "  rpc SayHello (HelloRequest) returns (HelloReply);"+                        , "};"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLService svc] -> svcName svc `shouldBe` "Greeter"+                    _ -> expectationFailure "Expected exactly one service"+            , it "trailing ';' after a nested message inside a message body" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Outer {"+                        , "  message Inner {"+                        , "    int32 value = 1;"+                        , "  };"+                        , "  enum E {"+                        , "    A = 0;"+                        , "  };"+                        , "  Inner inner = 1;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage msg] -> do+                      msgName msg `shouldBe` "Outer"+                      let nested = filter isNestedMsg (msgElements msg)+                      length nested `shouldBe` 1+                    _ -> expectationFailure "Expected exactly one message"+            , it "trailing ';' after a oneof block" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Msg {"+                        , "  oneof value {"+                        , "    string name = 1;"+                        , "    int32 id = 2;"+                        , "  };"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage msg] -> case msgElements msg of+                      [MEOneof od] -> length (oneofFields od) `shouldBe` 2+                      _ -> expectationFailure "Expected exactly one oneof"+                    _ -> expectationFailure "Expected exactly one message"+            , it "stray ';' between top-level declarations" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , ";"+                        , "message A { int32 x = 1; };"+                        , ";"+                        , "message B { int32 y = 1; }"+                        , ";"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> length (protoTopLevels pf) `shouldBe` 2+            , it "stray ';' between message elements" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Msg {"+                        , "  ;"+                        , "  int32 x = 1;"+                        , "  ;"+                        , "  int32 y = 2;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage msg] ->+                      length (extractFieldDefs (msgElements msg)) `shouldBe` 2+                    _ -> expectationFailure "Expected exactly one message"+            , it "stray ';' inside an enum body" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "enum E {"+                        , "  ;"+                        , "  A = 0;"+                        , "  ;"+                        , "  B = 1;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLEnum ed] -> length (enumValues ed) `shouldBe` 2+                    _ -> expectationFailure "Expected exactly one enum"+            , it "stray ';' inside a service body and after an rpc block" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "service S {"+                        , "  ;"+                        , "  rpc A (Req) returns (Resp) {"+                        , "    option deprecated = true;"+                        , "    ;"+                        , "  };"+                        , "  rpc B (Req) returns (Resp);"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLService svc] -> length (svcRpcs svc) `shouldBe` 2+                    _ -> expectationFailure "Expected exactly one service"+            , it "trailing ';' after an extend block" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto2\";"+                        , "extend Foo {"+                        , "  optional int32 bar = 100;"+                        , "};"+                        ]+                (isRight (parseProtoFile "<test>" input)) `shouldBe` True+            , it "still rejects a genuinely missing closing brace" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Foo {"+                        , "  string name = 1;"+                        , ";"+                        ]+                (isLeft (parseProtoFile "<test>" input)) `shouldBe` True+            ]+      , describe+          "Lexical & grammar conformance"+          $ sequence_+            [ it "enum reserved numeric ranges (to / to max)" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "enum E {"+                        , "  A = 0;"+                        , "  reserved 2, 5 to 9, 100 to max;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLEnum ed] -> length (enumValues ed) `shouldBe` 1+                    _ -> expectationFailure "Expected one enum"+            , it "identifier prefixed by 'true' is an identifier, not a bool" $+                fileOptValue "trueish" `shouldBe` Just (CIdent "trueish")+            , it "identifier prefixed by 'inf' is an identifier, not infinity" $+                fileOptValue "information" `shouldBe` Just (CIdent "information")+            , it "bare 'true' is still a boolean" $+                fileOptValue "true" `shouldBe` Just (CBool True)+            , it "bare 'inf' is still infinity" $+                case fileOptValue "inf" of+                  Just (CFloat d) -> (isInfinite d && d > 0) `shouldBe` True+                  other -> expectationFailure ("expected +inf, got " <> show other)+            , it "bare 'nan' is still NaN" $+                case fileOptValue "nan" of+                  Just (CFloat d) -> isNaN d `shouldBe` True+                  other -> expectationFailure ("expected NaN, got " <> show other)+            , it "leading-dot float (.5)" $+                fileOptValue ".5" `shouldBe` Just (CFloat 0.5)+            , it "trailing-dot float (5.)" $+                fileOptValue "5." `shouldBe` Just (CFloat 5.0)+            , it "negative leading-dot float (-.25)" $+                fileOptValue "-.25" `shouldBe` Just (CFloat (-0.25))+            , it "single-hex-digit escape (\\xA)" $+                fileOptValue "\"\\xA\"" `shouldBe` Just (CString "\n")+            , it "two-hex-digit escape still works (\\x41)" $+                fileOptValue "\"\\x41\"" `shouldBe` Just (CString "A")+            , it "BMP unicode escape (\\u00e9)" $+                fileOptValue "\"caf\\u00e9\"" `shouldBe` Just (CString "caf\233")+            , it "full unicode escape (\\U0001F600)" $+                fileOptValue "\"\\U0001F600\"" `shouldBe` Just (CString "\128512")+            , it "nested extension option name (a).(b).c" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "option (a).(b).c = 1;"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoOptions pf of+                    [opt] ->+                      optNameParts (optName opt)+                        `shouldBe` [ExtensionOption "a", ExtensionOption "b", SimpleOption "c"]+                    _ -> expectationFailure "Expected one option"+            ]+      , describe+          "Groups and extension-range options"+          $ sequence_+            [ it "proto2 group desugars to a nested message plus a field" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto2\";"+                        , "message M {"+                        , "  repeated group Result = 1 {"+                        , "    optional int32 x = 1;"+                        , "  }"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage m] -> case msgElements m of+                      [MEMessage nested, MEField fld] -> do+                        msgName nested `shouldBe` "Result"+                        length (msgElements nested) `shouldBe` 1+                        fieldName fld `shouldBe` "result"+                        fieldType fld `shouldBe` FTNamed "Result"+                        fieldNumber fld `shouldBe` FieldNumber 1+                        fieldLabel fld `shouldBe` Just Repeated+                      _ -> expectationFailure "Expected a nested message followed by a field"+                    _ -> expectationFailure "Expected one message"+            , it "unlabeled group parses" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto2\";"+                        , "message M {"+                        , "  group G = 2 {"+                        , "    optional int32 y = 1;"+                        , "  }"+                        , "}"+                        ]+                (isRight (parseProtoFile "<test>" input)) `shouldBe` True+            , it "a field whose name starts with 'group' is still a field" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message M {"+                        , "  int32 grouping = 1;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage m] -> case msgElements m of+                      [MEField fld] -> fieldName fld `shouldBe` "grouping"+                      _ -> expectationFailure "Expected a single field"+                    _ -> expectationFailure "Expected one message"+            , it "extensions with a verification option" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto2\";"+                        , "message M {"+                        , "  extensions 4 to 8 [verification = UNVERIFIED];"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage m] -> case msgElements m of+                      [MEExtensions ranges opts] -> do+                        length ranges `shouldBe` 1+                        length opts `shouldBe` 1+                      _ -> expectationFailure "Expected an extensions declaration"+                    _ -> expectationFailure "Expected one message"+            , it "extensions with a declaration aggregate option" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto2\";"+                        , "message M {"+                        , "  extensions 100 to max [declaration = { number: 100 full_name: \".foo.bar\" type: \".Baz\" }];"+                        , "}"+                        ]+                (isRight (parseProtoFile "<test>" input)) `shouldBe` True+            , it "extensions without options still parse (empty option list)" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto2\";"+                        , "message M {"+                        , "  extensions 4 to 8;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage m] -> case msgElements m of+                      [MEExtensions _ opts] -> length opts `shouldBe` 0+                      _ -> expectationFailure "Expected an extensions declaration"+                    _ -> expectationFailure "Expected one message"+            ]+      , describe+          "Nested extends"+          $ sequence_+            [ it "extend inside a message body is retained as MEExtend" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto2\";"+                        , "message M {"+                        , "  extend N {"+                        , "    optional int32 e = 100;"+                        , "  }"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage m] -> case msgElements m of+                      [MEExtend owner fields] -> do+                        owner `shouldBe` "N"+                        length fields `shouldBe` 1+                      _ -> expectationFailure "Expected a single MEExtend element"+                    _ -> expectationFailure "Expected one message"+            , it "group inside a nested extend hoists the group message" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto2\";"+                        , "message M {"+                        , "  extend N {"+                        , "    optional group G = 100 {"+                        , "      optional int32 x = 1;"+                        , "    }"+                        , "  }"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage m] -> do+                      let exts = filter isExtendElem (msgElements m)+                          msgs = filter isMsgElem (msgElements m)+                      length exts `shouldBe` 1+                      length msgs `shouldBe` 1+                    _ -> expectationFailure "Expected one message"+            , it "group inside a top-level extend hoists a top-level message" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto2\";"+                        , "extend N {"+                        , "  optional group G = 1 {"+                        , "    optional int32 x = 1;"+                        , "  }"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    let tops = protoTopLevels pf+                    length tops `shouldBe` 2+                    any isTopExtend tops `shouldBe` True+                    any isTopMessage tops `shouldBe` True+            ]+      , describe+          "Rich aggregate option values"+          $ sequence_+            [ it "list values desugar to repeated key/value pairs" $+                fileOptValue "{ tags: [\"a\", \"b\"] }"+                  `shouldBe` Just (CAggregate [("tags", CString "a"), ("tags", CString "b")])+            , it "extension keys keep their brackets" $+                fileOptValue "{ [foo.bar]: 1 }"+                  `shouldBe` Just (CAggregate [("[foo.bar]", CInt 1)])+            , it "Any-URL keys are accepted" $+                (isRight (parseProtoFile "<test>" (unlines' ["syntax = \"proto3\";", "option (x) = { [type.googleapis.com/foo.Bar]: { a: 1 } };"])))+                  `shouldBe` True+            , it "angle-bracket message values are accepted" $+                case fileOptValue "{ sub < a: 1 > }" of+                  Just (CAggregate [("sub", CAggregate [("a", CInt 1)])]) -> pure ()+                  other -> expectationFailure ("unexpected: " <> show other)+            ]+      , describe+          "Editions reserved identifiers"+          $ sequence_+            [ it "message reserved accepts bare identifiers" $ do+                let input =+                      unlines'+                        [ "edition = \"2023\";"+                        , "message M {"+                        , "  reserved foo, bar;"+                        , "}"+                        ]+                case parseProtoFile "<test>" input of+                  Left e -> expectationFailure (show e)+                  Right pf -> case protoTopLevels pf of+                    [TLMessage m] -> case msgElements m of+                      [MEReserved (ReservedNames names)] ->+                        names `shouldBe` [IdentReservedName "foo", IdentReservedName "bar"]+                      _ -> expectationFailure "Expected reserved names"+                    _ -> expectationFailure "Expected one message"+            , it "enum reserved accepts a bare identifier" $ do+                let input =+                      unlines'+                        [ "edition = \"2023\";"+                        , "enum E {"+                        , "  A = 0;"+                        , "  reserved FOO;"+                        , "}"+                        ]+                (isRight (parseProtoFile "<test>" input)) `shouldBe` True+            ]+      , describe+          "Complex proto files"+          $ sequence_+            [ it "full proto file" $ do+                let input = complexProto+                (isRight (parseProtoFile "<test>" input)) `shouldBe` True+            ]+      , describe+          "Comments"+          $ sequence_+            [ it "line comments" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\"; // this is a comment"+                        , "// another comment"+                        , "message Msg {"+                        , "  int32 x = 1; // field comment"+                        , "}"+                        ]+                (isRight (parseProtoFile "<test>" input)) `shouldBe` True+            , it "block comments" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "/* block comment */"+                        , "message Msg {"+                        , "  /* multi"+                        , "     line"+                        , "     comment */"+                        , "  int32 x = 1;"+                        , "}"+                        ]+                (isRight (parseProtoFile "<test>" input)) `shouldBe` True+            ]+      , describe+          "Error message quality"+          $ sequence_+            [ it "missing semicolon points to correct location" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Foo {"+                        , "  string name = 1"+                        , "}"+                        ]+                case parseProtoFile "test.proto" input of+                  Left e -> do+                    let msg = renderParseError e+                    ("';'" `isInfixOf` msg) `shouldBe` True+                    ("test.proto:4:" `isInfixOf` msg) `shouldBe` True+                    ("string name = 1" `isInfixOf` msg) `shouldBe` True+                    ("^" `isInfixOf` msg) `shouldBe` True+                  Right _ -> expectationFailure "Should have failed to parse"+            , it "missing field number gives helpful message" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Foo {"+                        , "  string name = ;"+                        , "}"+                        ]+                case parseProtoFile "test.proto" input of+                  Left e -> do+                    let msg = renderParseError e+                    ("field number" `isInfixOf` msg || "integer" `isInfixOf` msg) `shouldBe` True+                    ("string name" `isInfixOf` msg) `shouldBe` True+                  Right _ -> expectationFailure "Should have failed to parse"+            , it "missing equals sign gives helpful message" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Foo {"+                        , "  string name 1;"+                        , "}"+                        ]+                case parseProtoFile "test.proto" input of+                  Left e -> do+                    let msg = renderParseError e+                    ("'='" `isInfixOf` msg) `shouldBe` True+                    ("test.proto:3:15" `isInfixOf` msg) `shouldBe` True+                  Right _ -> expectationFailure "Should have failed to parse"+            , it "invalid syntax version gives clear message" $ do+                let input = "syntax = \"proto4\";\n"+                case parseProtoFile "test.proto" input of+                  Left e -> do+                    let msg = renderParseError e+                    ("proto4" `isInfixOf` msg) `shouldBe` True+                    ("proto2" `isInfixOf` msg && "proto3" `isInfixOf` msg) `shouldBe` True+                  Right _ -> expectationFailure "Should have failed to parse"+            , it "unclosed string literal gives clear message" $ do+                let input = "syntax = \"proto3;\n"+                case parseProtoFile "test.proto" input of+                  Left e -> do+                    let msg = renderParseError e+                    ("newline" `isInfixOf` msg) `shouldBe` True+                    ("test.proto:1:" `isInfixOf` msg) `shouldBe` True+                  Right _ -> expectationFailure "Should have failed to parse"+            , it "missing message name gives clear message" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message {"+                        , "  string name = 1;"+                        , "}"+                        ]+                case parseProtoFile "test.proto" input of+                  Left e -> do+                    let msg = renderParseError e+                    ("message name" `isInfixOf` msg) `shouldBe` True+                  Right _ -> expectationFailure "Should have failed to parse"+            , it "unexpected token at top level gives clear message" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "12345"+                        ]+                case parseProtoFile "test.proto" input of+                  Left e -> do+                    let msg = renderParseError e+                    ("message" `isInfixOf` msg || "top-level" `isInfixOf` msg) `shouldBe` True+                  Right _ -> expectationFailure "Should have failed to parse"+            , it "missing comma in map type gives clear message" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "message Foo {"+                        , "  map<string int32> x = 1;"+                        , "}"+                        ]+                case parseProtoFile "test.proto" input of+                  Left e -> do+                    let msg = renderParseError e+                    ("','" `isInfixOf` msg) `shouldBe` True+                    ("test.proto:3:14" `isInfixOf` msg) `shouldBe` True+                  Right _ -> expectationFailure "Should have failed to parse"+            , it "error messages include source context with line numbers" $ do+                let input =+                      unlines'+                        [ "syntax = \"proto3\";"+                        , "package myapp;"+                        , ""+                        , "message User {"+                        , "  string name = 1;"+                        , "  int32 age = 2;"+                        , "  string email = 3"+                        , "}"+                        ]+                case parseProtoFile "api/user.proto" input of+                  Left e -> do+                    let msg = renderParseError e+                    ("api/user.proto:" `isInfixOf` msg) `shouldBe` True+                    ("-->" `isInfixOf` msg) `shouldBe` True+                    (" | " `isInfixOf` msg) `shouldBe` True+                    ("^" `isInfixOf` msg) `shouldBe` True+                  Right _ -> expectationFailure "Should have failed to parse"+            , it "error output rejects invalid inputs" $ do+                let cases =+                      [ ("empty message body missing brace", "syntax = \"proto3\";\nmessage Foo {\n")+                      , ("unknown keyword at top level", "syntax = \"proto3\";\nfoobar baz;\n")+                      , ("missing closing brace for enum", "syntax = \"proto3\";\nenum Foo {\n  A = 0;\n")+                      ]+                mapM_+                  ( \(desc, input) ->+                      (if (isLeft (parseProtoFile "test.proto" input)) then pure () else expectationFailure (desc))+                  )+                  cases+            ]+      ]+++complexProto :: Text+complexProto =+  unlines'+    [ "syntax = \"proto3\";"+    , "package example.api;"+    , ""+    , "import \"google/protobuf/timestamp.proto\";"+    , "import public \"common.proto\";"+    , ""+    , "option java_package = \"com.example.api\";"+    , "option (custom_file_opt) = true;"+    , ""+    , "enum Status {"+    , "  STATUS_UNKNOWN = 0;"+    , "  STATUS_ACTIVE = 1;"+    , "  STATUS_INACTIVE = 2;"+    , "}"+    , ""+    , "message Person {"+    , "  string name = 1;"+    , "  int32 id = 2;"+    , "  string email = 3;"+    , ""+    , "  enum PhoneType {"+    , "    MOBILE = 0;"+    , "    HOME = 1;"+    , "    WORK = 2;"+    , "  }"+    , ""+    , "  message PhoneNumber {"+    , "    string number = 1;"+    , "    PhoneType type = 2;"+    , "  }"+    , ""+    , "  repeated PhoneNumber phones = 4;"+    , "  Status status = 5;"+    , "  map<string, string> metadata = 6;"+    , ""+    , "  oneof contact {"+    , "    string phone = 7;"+    , "    string email_alt = 8;"+    , "  }"+    , ""+    , "  reserved 10, 12 to 15;"+    , "  reserved \"old_field\";"+    , "}"+    , ""+    , "service PersonService {"+    , "  rpc GetPerson (GetPersonRequest) returns (Person);"+    , "  rpc ListPersons (ListRequest) returns (stream Person);"+    , "  rpc UpdatePerson (stream Person) returns (UpdateResponse) {"+    , "    option deprecated = true;"+    , "  }"+    , "}"+    ]+++isNestedMsg :: MessageElement -> Bool+isNestedMsg (MEMessage _) = True+isNestedMsg _ = False+++isExtendElem :: MessageElement -> Bool+isExtendElem (MEExtend _ _) = True+isExtendElem _ = False+++isMsgElem :: MessageElement -> Bool+isMsgElem (MEMessage _) = True+isMsgElem _ = False+++isTopExtend :: TopLevel -> Bool+isTopExtend (TLExtend _ _) = True+isTopExtend _ = False+++isTopMessage :: TopLevel -> Bool+isTopMessage (TLMessage _) = True+isTopMessage _ = False+++extractFieldDefs :: [MessageElement] -> [FieldDef]+extractFieldDefs = concatMap go+  where+    go (MEField fd) = [fd]+    go _ = []+++unlines' :: [Text] -> Text+unlines' = mconcat . fmap (<> "\n")+++{- | Parse a single file-level @option (x) = <rhs>;@ and return the parsed+constant value. Used to exercise the constant/literal lexer in isolation.+-}+fileOptValue :: Text -> Maybe Constant+fileOptValue rhs =+  let input = unlines' ["syntax = \"proto3\";", "option (x) = " <> rhs <> ";"]+  in case parseProtoFile "<test>" input of+       Right pf -> case protoOptions pf of+         [opt] -> Just (optValue opt)+         _ -> Nothing+       Left _ -> Nothing
− test-integration/Test/Plugin.hs 
@@ -1,250 +0,0 @@-module Test.Plugin (pluginTests) where--import Control.Concurrent (forkIO)-import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)-import Control.Monad (when)-import Data.ByteString (ByteString)-import Data.ByteString qualified as BS-import Data.Map.Strict qualified as Map-import Data.Maybe (fromMaybe)-import Data.Text (Text)-import Data.Text qualified as T-import Data.Vector qualified as V-import System.Directory (findExecutable)-import System.IO (hClose, hSetBinaryMode)-import System.Process (CreateProcess (..), StdStream (..), createProcess, proc, waitForProcess)-import Test.Tasty-import Test.Tasty.HUnit--import Proto.CodeGen-import Proto (decodeMessage)-import Proto (encodeMessage)-import Proto.Google.Protobuf.Compiler.Plugin-import Proto.IDL.AST (ProtoFile)-import Proto.IDL.Descriptor (astToFileDescriptor, fileDescriptorToAST)-import Proto.IDL.Parser (parseProtoFile)-import Proto.IDL.Parser.Resolver (ResolvedProto (..))---testProtoSrc :: Text-testProtoSrc =-  T.unlines-    [ "syntax = \"proto3\";"-    , "package test.plugin;"-    , ""-    , "enum Status {"-    , "  STATUS_UNSPECIFIED = 0;"-    , "  STATUS_ACTIVE = 1;"-    , "  STATUS_BANNED = 2;"-    , "}"-    , ""-    , "message Person {"-    , "  string name = 1;"-    , "  int32  age  = 2;"-    , "  Status status = 3;"-    , "  map<string,int32> scores = 4;"-    , "}"-    , ""-    , "message Team {"-    , "  string name = 1;"-    , "  repeated Person members = 2;"-    , "}"-    ]--testProtoPath :: FilePath-testProtoPath = "test/plugin/fixture.proto"---parseFixture :: IO ProtoFile-parseFixture =-  case parseProtoFile testProtoPath testProtoSrc of-    Left e -> assertFailure ("parse failed: " <> show e) >> error "unreachable"-    Right pf -> pure pf---pluginTests :: TestTree-pluginTests =-  testGroup-    "protoc-gen-wireform plugin"-    [ descriptorRoundTripTests-    , binaryPluginTest-    ]---{- | The plugin path goes:--  parse → FileDescriptorProto (astToFileDescriptor)-        → ProtoFile (fileDescriptorToAST)-        → generateModuleText--  The direct path (loadProto / Proto.Setup) goes:--  parse → generateModuleText--  These must produce identical output for the plugin to be a-  transparent substitute for the other code-generation entry points.--}-descriptorRoundTripTests :: TestTree-descriptorRoundTripTests =-  testGroup-    "Descriptor round-trip (direct == via FileDescriptorProto)"-    [ testCase "enum and message structure preserved" $ do-        pf <- parseFixture-        let reg = buildTypeRegistry defaultGenerateOpts [(testProtoPath, ResolvedProto pf testProtoPath Map.empty)]-            directCode = generateModuleText defaultGenerateOpts reg testProtoPath pf-            fdp = astToFileDescriptor testProtoPath pf-            roundPf = fileDescriptorToAST fdp-            -- Use a registry built from the round-tripped file since its-            -- type names must match what the codegen will address.-            roundReg = buildTypeRegistry defaultGenerateOpts [(testProtoPath, ResolvedProto roundPf testProtoPath Map.empty)]-            roundCode = generateModuleText defaultGenerateOpts roundReg testProtoPath roundPf-        -- FileDescriptorProto stores messages and enums in separate lists so-        -- the top-level declaration order differs from the parsed source (all-        -- messages first, then all enums). Haskell modules are order--        -- independent, so we compare sets of declarations rather than exact-        -- text. The key check is that the same data types and instances are-        -- present regardless of order.-        let directDecls = extractDecls directCode-            roundDecls  = extractDecls roundCode-        directDecls @?= roundDecls--    , testCase "expected declarations present" $ do-        pf <- parseFixture-        let reg = buildTypeRegistry defaultGenerateOpts [(testProtoPath, ResolvedProto pf testProtoPath Map.empty)]-            code = generateModuleText defaultGenerateOpts reg testProtoPath pf-        assertBool "data Person"  (T.isInfixOf "data Person"  code)-        assertBool "data Team"    (T.isInfixOf "data Team"    code)-        assertBool "data Status"  (T.isInfixOf "data Status"  code)-        assertBool "StatusActive" (T.isInfixOf "StatusActive" code)-        assertBool "MessageEncode instance for Person"  (T.isInfixOf "MessageEncode Person"  code)-        assertBool "MessageDecode instance for Person"  (T.isInfixOf "MessageDecode Person"  code)-        assertBool "map field (Map)" (T.isInfixOf "Map." code)--    , testCase "round-tripped code also has expected declarations" $ do-        pf <- parseFixture-        let fdp = astToFileDescriptor testProtoPath pf-            roundPf = fileDescriptorToAST fdp-            reg = buildTypeRegistry defaultGenerateOpts [(testProtoPath, ResolvedProto roundPf testProtoPath Map.empty)]-            code = generateModuleText defaultGenerateOpts reg testProtoPath roundPf-        assertBool "data Person (round-tripped)"  (T.isInfixOf "data Person"  code)-        assertBool "data Team (round-tripped)"    (T.isInfixOf "data Team"    code)-        assertBool "data Status (round-tripped)"  (T.isInfixOf "data Status"  code)-    ]---{- | End-to-end test for the 'protoc-gen-wireform' binary.--Constructs a 'CodeGeneratorRequest' from the test fixture, sends it-to the plugin binary on stdin, reads the 'CodeGeneratorResponse'-from stdout, and asserts the generated file content matches what-'generateModuleText' produces directly.--Skipped when the binary is not found in PATH. Run-@cabal build protoc-gen-wireform@ first, then add the binary to PATH-or point PATH at @$(cabal list-bin protoc-gen-wireform)@.--}-binaryPluginTest :: TestTree-binaryPluginTest = testCase "End-to-end: binary stdin→stdout round-trip" $ do-  mBin <- findExecutable "protoc-gen-wireform"-  case mBin of-    Nothing ->-      putStrLn-        "\n  (skipped: protoc-gen-wireform not in PATH;\-        \ run 'cabal build wireform-proto:protoc-gen-wireform' then add to PATH)"-    Just binPath -> runBinaryTest binPath---runBinaryTest :: FilePath -> IO ()-runBinaryTest binPath = do-  pf <- parseFixture-  let fdp = astToFileDescriptor testProtoPath pf-      req =-        defaultCodeGeneratorRequest-          { codeGeneratorRequestFileToGenerate = V.singleton (T.pack testProtoPath)-          , codeGeneratorRequestProtoFile = V.singleton fdp-          }-      reqBytes = encodeMessage req-      reg = buildTypeRegistry defaultGenerateOpts [(testProtoPath, ResolvedProto pf testProtoPath Map.empty)]-      expected = generateModuleText defaultGenerateOpts reg testProtoPath pf--  resp <- invokePlugin binPath reqBytes--  case codeGeneratorResponseError resp of-    Just e -> assertFailure ("Plugin returned error: " <> T.unpack e)-    Nothing -> pure ()--  let files = V.toList (codeGeneratorResponseFile resp)-  case files of-    [] -> assertFailure "Plugin produced no output files"-    (f : _) -> do-      let actual = fromMaybe "" (codeGeneratorResponseFileContent f)-          expectedDecls = extractDecls expected-          actualDecls   = extractDecls actual-      when (expectedDecls /= actualDecls) $ do-        let diff = diffLines-              (T.unlines expectedDecls)-              (T.unlines actualDecls)-        assertFailure ("Plugin declarations differ from generateModuleText:\n" <> T.unpack diff)---invokePlugin :: FilePath -> ByteString -> IO CodeGeneratorResponse-invokePlugin binPath reqBytes = do-  let cp =-        (proc binPath [])-          { std_in = CreatePipe-          , std_out = CreatePipe-          , std_err = Inherit-          }-  (Just inH, Just outH, Nothing, ph) <- createProcess cp-  hSetBinaryMode inH True-  hSetBinaryMode outH True-  -- Read stdout concurrently with writing stdin to prevent pipe buffer deadlock.-  resultVar <- newEmptyMVar-  _ <- forkIO $ do-    out <- BS.hGetContents outH-    putMVar resultVar out-  BS.hPut inH reqBytes-  hClose inH-  respBytes <- takeMVar resultVar-  _ <- waitForProcess ph-  case decodeMessage respBytes of-    Left err -> assertFailure ("Plugin response decode failed: " <> show err) >> error "unreachable"-    Right resp -> pure resp----- | Extract the set of top-level declarations from generated Haskell source.--- Lines starting with @data @, @newtype @, @type @, @instance @, or--- @defaultFoo@ are collected and sorted. This normalises declaration--- order differences while still catching missing or wrong declarations.-extractDecls :: Text -> [Text]-extractDecls src =-  let ls = T.lines src-      isDecl l =-        any (`T.isPrefixOf` l)-          ["data ", "newtype ", "type ", "instance ", "default"]-  in sort (filter isDecl ls)-  where-    sort = foldr insertSorted []-    insertSorted x [] = [x]-    insertSorted x (y : ys)-      | x <= y = x : y : ys-      | otherwise = y : insertSorted x ys---diffLines :: Text -> Text -> Text-diffLines expected actual =-  let expLines = T.lines expected-      actLines = T.lines actual-      pairs = zip3 [(1 :: Int) ..] (padTo (max (length expLines) (length actLines)) expLines) (padTo (max (length expLines) (length actLines)) actLines)-      diffs = filter (\(_, e, a) -> e /= a) pairs-      showDiff (n, e, a) = T.pack (show n) <> ":\n  expected: " <> e <> "\n  actual:   " <> a-  in if null diffs-       then "(no line differences found)"-       else T.intercalate "\n" (fmap showDiff (take 20 diffs))-            <> if length diffs > 20-                 then "\n... (" <> T.pack (show (length diffs - 20)) <> " more differing lines)"-                 else ""---padTo :: Int -> [Text] -> [Text]-padTo n xs = xs <> replicate (n - length xs) ""
test-integration/Test/PrintInspect.hs view
@@ -7,246 +7,389 @@ import Proto.IDL.Inspect import Proto.IDL.Parser import Proto.IDL.Print-import Test.Tasty-import Test.Tasty.HUnit+import Test.Syd  -printInspectTests :: TestTree+printInspectTests :: Spec printInspectTests =-  testGroup+  describe     "Print & Inspect"-    [ testGroup-        "Exact printing"-        [ testCase "roundtrip: parse -> print -> parse yields same AST" $ do-            let original = complexProto-            case parseProtoFile "<test>" original of-              Left e -> assertFailure (show e)-              Right ast1 -> do-                let printed = printProtoFile ast1-                case parseProtoFile "<printed>" printed of-                  Left e -> assertFailure ("Re-parse failed: " <> show e <> "\n\nPrinted:\n" <> T.unpack printed)-                  Right ast2 -> ast1 @?= ast2-        , testCase "syntax declaration" $ do-            let ast = ProtoFile Proto3 Nothing [] [] [] Nothing-            T.isInfixOf "syntax = \"proto3\";" (printProtoFile ast) @?= True-        , testCase "syntax proto2" $ do-            let ast = ProtoFile Proto2 Nothing [] [] [] Nothing-            T.isInfixOf "syntax = \"proto2\";" (printProtoFile ast) @?= True-        , testCase "package declaration" $ do-            let ast = ProtoFile Proto3 (Just "my.package") [] [] [] Nothing-            T.isInfixOf "package my.package;" (printProtoFile ast) @?= True-        , testCase "import" $ do-            let ast = ProtoFile Proto3 Nothing [ImportDef () Nothing "other.proto"] [] [] Nothing-            T.isInfixOf "import \"other.proto\";" (printProtoFile ast) @?= True-        , testCase "public import" $ do-            let ast = ProtoFile Proto3 Nothing [ImportDef () (Just ImportPublic) "other.proto"] [] [] Nothing-            T.isInfixOf "import public \"other.proto\";" (printProtoFile ast) @?= True-        , testCase "simple message roundtrip" $ do-            let src =+    $ sequence_+      [ describe+          "Exact printing"+          $ sequence_+            [ it "roundtrip: parse -> print -> parse yields same AST" $ do+                let original = complexProto+                case parseProtoFile "<test>" original of+                  Left e -> expectationFailure (show e)+                  Right ast1 -> do+                    let printed = printProtoFile ast1+                    case parseProtoFile "<printed>" printed of+                      Left e -> expectationFailure ("Re-parse failed: " <> show e <> "\n\nPrinted:\n" <> T.unpack printed)+                      Right ast2 -> ast1 `shouldBe` ast2+            , it "syntax declaration" $ do+                let ast = ProtoFile Proto3 Nothing [] [] [] Nothing+                T.isInfixOf "syntax = \"proto3\";" (printProtoFile ast) `shouldBe` True+            , it "syntax proto2" $ do+                let ast = ProtoFile Proto2 Nothing [] [] [] Nothing+                T.isInfixOf "syntax = \"proto2\";" (printProtoFile ast) `shouldBe` True+            , it "package declaration" $ do+                let ast = ProtoFile Proto3 (Just "my.package") [] [] [] Nothing+                T.isInfixOf "package my.package;" (printProtoFile ast) `shouldBe` True+            , it "import" $ do+                let ast = ProtoFile Proto3 Nothing [ImportDef () Nothing "other.proto"] [] [] Nothing+                T.isInfixOf "import \"other.proto\";" (printProtoFile ast) `shouldBe` True+            , it "public import" $ do+                let ast = ProtoFile Proto3 Nothing [ImportDef () (Just ImportPublic) "other.proto"] [] [] Nothing+                T.isInfixOf "import public \"other.proto\";" (printProtoFile ast) `shouldBe` True+            , it "simple message roundtrip" $ do+                let src =+                      T.unlines+                        [ "syntax = \"proto3\";"+                        , "message Foo {"+                        , "  string name = 1;"+                        , "  int32 value = 2;"+                        , "}"+                        ]+                roundtripTest src+            , it "enum roundtrip" $ do+                let src =+                      T.unlines+                        [ "syntax = \"proto3\";"+                        , "enum Status {"+                        , "  UNKNOWN = 0;"+                        , "  ACTIVE = 1;"+                        , "}"+                        ]+                roundtripTest src+            , it "service roundtrip" $ do+                let src =+                      T.unlines+                        [ "syntax = \"proto3\";"+                        , "service Greeter {"+                        , "  rpc SayHello (HelloReq) returns (HelloReply);"+                        , "}"+                        ]+                roundtripTest src+            , it "map field roundtrip" $ do+                let src =+                      T.unlines+                        [ "syntax = \"proto3\";"+                        , "message Foo {"+                        , "  map<string, int32> labels = 1;"+                        , "}"+                        ]+                roundtripTest src+            , it "oneof roundtrip" $ do+                let src =+                      T.unlines+                        [ "syntax = \"proto3\";"+                        , "message Foo {"+                        , "  oneof val {"+                        , "    string text = 1;"+                        , "    int32 number = 2;"+                        , "  }"+                        , "}"+                        ]+                roundtripTest src+            , it "reserved roundtrip" $ do+                let src =+                      T.unlines+                        [ "syntax = \"proto3\";"+                        , "message Foo {"+                        , "  reserved 2, 10 to 20;"+                        , "  reserved \"old_field\";"+                        , "}"+                        ]+                roundtripTest src+            , it "field options roundtrip" $ do+                let src =+                      T.unlines+                        [ "syntax = \"proto3\";"+                        , "message Foo {"+                        , "  string name = 1 [deprecated = true];"+                        , "}"+                        ]+                roundtripTest src+            , it "option with extension name roundtrip" $ do+                let src =+                      T.unlines+                        [ "syntax = \"proto3\";"+                        , "option (my_custom_opt) = true;"+                        , "message Foo {"+                        , "  string name = 1;"+                        , "}"+                        ]+                roundtripTest src+            , it "nested message roundtrip" $ do+                let src =+                      T.unlines+                        [ "syntax = \"proto3\";"+                        , "message Outer {"+                        , "  message Inner {"+                        , "    int32 x = 1;"+                        , "  }"+                        , "  Inner inner = 1;"+                        , "}"+                        ]+                roundtripTest src+            , it "streaming rpc roundtrip" $ do+                let src =+                      T.unlines+                        [ "syntax = \"proto3\";"+                        , "service Chat {"+                        , "  rpc Stream (stream Msg) returns (stream Msg);"+                        , "}"+                        ]+                roundtripTest src+            , it "proto2 group roundtrip (desugared to message + field)" $ do+                let src =+                      T.unlines+                        [ "syntax = \"proto2\";"+                        , "message M {"+                        , "  repeated group Result = 1 {"+                        , "    optional int32 x = 1;"+                        , "  }"+                        , "}"+                        ]+                roundtripTest src+            , it "extensions with options roundtrip" $ do+                let src =+                      T.unlines+                        [ "syntax = \"proto2\";"+                        , "message M {"+                        , "  extensions 4 to 8 [verification = UNVERIFIED];"+                        , "}"+                        ]+                roundtripTest src+            , it "nested extend roundtrip" $ do+                let src =+                      T.unlines+                        [ "syntax = \"proto2\";"+                        , "message M {"+                        , "  extend N {"+                        , "    optional int32 e = 100;"+                        , "  }"+                        , "}"+                        ]+                roundtripTest src+            , it "aggregate with list / extension-key values roundtrip" $ do+                let src =+                      T.unlines+                        [ "syntax = \"proto3\";"+                        , "option (x) = { tags: [\"a\", \"b\"] };"+                        , "option (y) = { [foo.bar]: 1 };"+                        ]+                roundtripTest src+            , it "editions reserved identifiers roundtrip" $ do+                let src =+                      T.unlines+                        [ "edition = \"2023\";"+                        , "message M {"+                        , "  reserved foo, bar;"+                        , "}"+                        ]+                roundtripTest src+            , it "editions reserved identifiers print unquoted" $ do+                let src =+                      T.unlines+                        [ "edition = \"2023\";"+                        , "message M {"+                        , "  reserved foo, bar;"+                        , "}"+                        ]+                case parseProtoFile "<test>" src of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    let printed = printProtoFile pf+                    T.isInfixOf "reserved foo, bar;" printed `shouldBe` True+                    T.isInfixOf "\"foo\"" printed `shouldBe` False+            , it "proto3 reserved names still print quoted" $ do+                let src =+                      T.unlines+                        [ "syntax = \"proto3\";"+                        , "message M {"+                        , "  reserved \"foo\", \"bar\";"+                        , "}"+                        ]+                case parseProtoFile "<test>" src of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    let printed = printProtoFile pf+                    T.isInfixOf "reserved \"foo\", \"bar\";" printed `shouldBe` True+            ]+      , describe+          "Exact printing (byte-for-byte)"+          $ sequence_+            [ it "reproduces a complex file byte-for-byte" $+                exactPrintTest complexProto+            , it "preserves a trailing ';' after a message block" $+                exactPrintTest $                   T.unlines                     [ "syntax = \"proto3\";"                     , "message Foo {"                     , "  string name = 1;"-                    , "  int32 value = 2;"-                    , "}"+                    , "};"                     ]-            roundtripTest src-        , testCase "enum roundtrip" $ do-            let src =+            , it "preserves a trailing ';' after enum and service blocks" $+                exactPrintTest $                   T.unlines                     [ "syntax = \"proto3\";"                     , "enum Status {"                     , "  UNKNOWN = 0;"-                    , "  ACTIVE = 1;"-                    , "}"-                    ]-            roundtripTest src-        , testCase "service roundtrip" $ do-            let src =-                  T.unlines-                    [ "syntax = \"proto3\";"+                    , "};"                     , "service Greeter {"-                    , "  rpc SayHello (HelloReq) returns (HelloReply);"-                    , "}"+                    , "  rpc SayHello (Req) returns (Resp);"+                    , "};"                     ]-            roundtripTest src-        , testCase "map field roundtrip" $ do-            let src =+            , it "preserves stray ';' between and inside declarations" $+                exactPrintTest $                   T.unlines                     [ "syntax = \"proto3\";"-                    , "message Foo {"-                    , "  map<string, int32> labels = 1;"+                    , ";"+                    , "message A {"+                    , "  ;"+                    , "  int32 x = 1;"+                    , "  ;"+                    , "  message Inner {"+                    , "    int32 y = 1;"+                    , "  };"                     , "}"+                    , ";"                     ]-            roundtripTest src-        , testCase "oneof roundtrip" $ do-            let src =+            , it "preserves proto2 group source verbatim" $+                exactPrintTest $                   T.unlines-                    [ "syntax = \"proto3\";"-                    , "message Foo {"-                    , "  oneof val {"-                    , "    string text = 1;"-                    , "    int32 number = 2;"+                    [ "syntax = \"proto2\";"+                    , "message M {"+                    , "  repeated group Result = 1 {"+                    , "    optional int32 x = 1;"                     , "  }"                     , "}"                     ]-            roundtripTest src-        , testCase "reserved roundtrip" $ do-            let src =-                  T.unlines-                    [ "syntax = \"proto3\";"-                    , "message Foo {"-                    , "  reserved 2, 10 to 20;"-                    , "  reserved \"old_field\";"-                    , "}"-                    ]-            roundtripTest src-        , testCase "field options roundtrip" $ do-            let src =-                  T.unlines-                    [ "syntax = \"proto3\";"-                    , "message Foo {"-                    , "  string name = 1 [deprecated = true];"-                    , "}"-                    ]-            roundtripTest src-        , testCase "option with extension name roundtrip" $ do-            let src =-                  T.unlines-                    [ "syntax = \"proto3\";"-                    , "option (my_custom_opt) = true;"-                    , "message Foo {"-                    , "  string name = 1;"-                    , "}"-                    ]-            roundtripTest src-        , testCase "nested message roundtrip" $ do-            let src =-                  T.unlines-                    [ "syntax = \"proto3\";"-                    , "message Outer {"-                    , "  message Inner {"-                    , "    int32 x = 1;"-                    , "  }"-                    , "  Inner inner = 1;"-                    , "}"-                    ]-            roundtripTest src-        , testCase "streaming rpc roundtrip" $ do-            let src =+            , it "preserves extensions options source verbatim" $+                exactPrintTest $                   T.unlines-                    [ "syntax = \"proto3\";"-                    , "service Chat {"-                    , "  rpc Stream (stream Msg) returns (stream Msg);"+                    [ "syntax = \"proto2\";"+                    , "message M {"+                    , "  extensions 4 to 8 [verification = UNVERIFIED];"                     , "}"                     ]-            roundtripTest src-        ]-    , testGroup-        "AST inspection"-        [ testCase "allMessages finds top-level and nested" $ do-            case parseProtoFile "<test>" complexProto of-              Left e -> assertFailure (show e)-              Right pf -> do-                let msgs = allMessages pf-                assertBool "Should find Person" (any (\m -> msgName m == "Person") msgs)-                assertBool "Should find PhoneNumber" (any (\m -> msgName m == "PhoneNumber") msgs)-                assertBool "Should find Address" (any (\m -> msgName m == "Address") msgs)-                assertBool "Should find AddressBook" (any (\m -> msgName m == "AddressBook") msgs)-        , testCase "findMessage" $ do-            case parseProtoFile "<test>" complexProto of-              Left e -> assertFailure (show e)-              Right pf -> do-                assertBool "Find Person" (isJust (findMessage "Person" pf))-                assertBool "No Nonexistent" (isNothing (findMessage "Nonexistent" pf))-        , testCase "allEnums" $ do-            case parseProtoFile "<test>" complexProto of-              Left e -> assertFailure (show e)-              Right pf -> do-                let enums = allEnums pf-                assertBool "Should find Status" (any (\e -> enumName e == "Status") enums)-                assertBool "Should find PhoneType" (any (\e -> enumName e == "PhoneType") enums)-        , testCase "allServices" $ do-            case parseProtoFile "<test>" complexProto of-              Left e -> assertFailure (show e)-              Right pf -> do-                let svcs = allServices pf-                length svcs @?= 1-                svcName (head svcs) @?= "PersonService"-        , testCase "messageFields" $ do-            case parseProtoFile "<test>" complexProto of-              Left e -> assertFailure (show e)-              Right pf -> case findMessage "Person" pf of-                Nothing -> assertFailure "Person not found"-                Just msg -> do-                  let fields = messageFields msg-                  assertBool "Has name field" (any (\f -> fieldName f == "name") fields)-                  assertBool "Has id field" (any (\f -> fieldName f == "id") fields)-                  assertBool "Has email field" (any (\f -> fieldName f == "email") fields)-        , testCase "nestedMessages" $ do-            case parseProtoFile "<test>" complexProto of-              Left e -> assertFailure (show e)-              Right pf -> case findMessage "Person" pf of-                Nothing -> assertFailure "Person not found"-                Just msg -> do-                  let nested = nestedMessages msg-                  assertBool "Has PhoneNumber" (any (\m -> msgName m == "PhoneNumber") nested)-                  assertBool "Has Address" (any (\m -> msgName m == "Address") nested)-        , testCase "messageOneofs" $ do-            case parseProtoFile "<test>" complexProto of-              Left e -> assertFailure (show e)-              Right pf -> case findMessage "Person" pf of-                Nothing -> assertFailure "Person not found"-                Just msg -> do-                  let oneofs = messageOneofs msg-                  length oneofs @?= 1-                  oneofName (head oneofs) @?= "contact"-        , testCase "messageMapFields" $ do-            case parseProtoFile "<test>" complexProto of-              Left e -> assertFailure (show e)-              Right pf -> case findMessage "Person" pf of-                Nothing -> assertFailure "Person not found"-                Just msg -> do-                  let maps = messageMapFields msg-                  length maps @?= 1-                  mapFieldName (head maps) @?= "metadata"-        , testCase "allTypeNames" $ do-            case parseProtoFile "<test>" complexProto of-              Left e -> assertFailure (show e)-              Right pf -> do-                let types = allTypeNames pf-                assertBool "Has Person" ("Person" `elem` types)-                assertBool "Has Status" ("Status" `elem` types)-        , testCase "referencedTypes" $ do-            case parseProtoFile "<test>" complexProto of-              Left e -> assertFailure (show e)-              Right pf -> do-                let refs = referencedTypes pf-                assertBool "References PhoneNumber" ("PhoneNumber" `elem` refs)-                assertBool "References Status" ("Status" `elem` refs)-        , testCase "summarize" $ do-            case parseProtoFile "<test>" complexProto of-              Left e -> assertFailure (show e)-              Right pf -> do-                let s = summarize pf-                summSyntax s @?= Proto3-                summPackage s @?= Just "example.api"-                summMessageCount s > 0 @?= True-                summEnumCount s > 0 @?= True-                summServiceCount s @?= 1-        ]-    ]+            ]+      , describe+          "AST inspection"+          $ sequence_+            [ it "allMessages finds top-level and nested" $ do+                case parseProtoFile "<test>" complexProto of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    let msgs = allMessages pf+                    (any (\m -> msgName m == "Person") msgs) `shouldBe` True+                    (any (\m -> msgName m == "PhoneNumber") msgs) `shouldBe` True+                    (any (\m -> msgName m == "Address") msgs) `shouldBe` True+                    (any (\m -> msgName m == "AddressBook") msgs) `shouldBe` True+            , it "findMessage" $ do+                case parseProtoFile "<test>" complexProto of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    (isJust (findMessage "Person" pf)) `shouldBe` True+                    (isNothing (findMessage "Nonexistent" pf)) `shouldBe` True+            , it "allEnums" $ do+                case parseProtoFile "<test>" complexProto of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    let enums = allEnums pf+                    (any (\e -> enumName e == "Status") enums) `shouldBe` True+                    (any (\e -> enumName e == "PhoneType") enums) `shouldBe` True+            , it "allServices" $ do+                case parseProtoFile "<test>" complexProto of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    let svcs = allServices pf+                    length svcs `shouldBe` 1+                    svcName (head svcs) `shouldBe` "PersonService"+            , it "messageFields" $ do+                case parseProtoFile "<test>" complexProto of+                  Left e -> expectationFailure (show e)+                  Right pf -> case findMessage "Person" pf of+                    Nothing -> expectationFailure "Person not found"+                    Just msg -> do+                      let fields = messageFields msg+                      (any (\f -> fieldName f == "name") fields) `shouldBe` True+                      (any (\f -> fieldName f == "id") fields) `shouldBe` True+                      (any (\f -> fieldName f == "email") fields) `shouldBe` True+            , it "nestedMessages" $ do+                case parseProtoFile "<test>" complexProto of+                  Left e -> expectationFailure (show e)+                  Right pf -> case findMessage "Person" pf of+                    Nothing -> expectationFailure "Person not found"+                    Just msg -> do+                      let nested = nestedMessages msg+                      (any (\m -> msgName m == "PhoneNumber") nested) `shouldBe` True+                      (any (\m -> msgName m == "Address") nested) `shouldBe` True+            , it "messageOneofs" $ do+                case parseProtoFile "<test>" complexProto of+                  Left e -> expectationFailure (show e)+                  Right pf -> case findMessage "Person" pf of+                    Nothing -> expectationFailure "Person not found"+                    Just msg -> do+                      let oneofs = messageOneofs msg+                      length oneofs `shouldBe` 1+                      oneofName (head oneofs) `shouldBe` "contact"+            , it "messageMapFields" $ do+                case parseProtoFile "<test>" complexProto of+                  Left e -> expectationFailure (show e)+                  Right pf -> case findMessage "Person" pf of+                    Nothing -> expectationFailure "Person not found"+                    Just msg -> do+                      let maps = messageMapFields msg+                      length maps `shouldBe` 1+                      mapFieldName (head maps) `shouldBe` "metadata"+            , it "allTypeNames" $ do+                case parseProtoFile "<test>" complexProto of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    let types = allTypeNames pf+                    ("Person" `elem` types) `shouldBe` True+                    ("Status" `elem` types) `shouldBe` True+            , it "referencedTypes" $ do+                case parseProtoFile "<test>" complexProto of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    let refs = referencedTypes pf+                    ("PhoneNumber" `elem` refs) `shouldBe` True+                    ("Status" `elem` refs) `shouldBe` True+            , it "summarize" $ do+                case parseProtoFile "<test>" complexProto of+                  Left e -> expectationFailure (show e)+                  Right pf -> do+                    let s = summarize pf+                    summSyntax s `shouldBe` Proto3+                    summPackage s `shouldBe` Just "example.api"+                    summMessageCount s > 0 `shouldBe` True+                    summEnumCount s > 0 `shouldBe` True+                    summServiceCount s `shouldBe` 1+            ]+      ]   roundtripTest :: Text -> IO () roundtripTest src =   case parseProtoFile "<test>" src of-    Left e -> assertFailure ("Initial parse failed: " <> show e)+    Left e -> expectationFailure ("Initial parse failed: " <> show e)     Right ast1 -> do       let printed = printProtoFile ast1       case parseProtoFile "<printed>" printed of-        Left e -> assertFailure ("Re-parse failed: " <> show e <> "\n\nPrinted:\n" <> T.unpack printed)-        Right ast2 -> ast1 @?= ast2+        Left e -> expectationFailure ("Re-parse failed: " <> show e <> "\n\nPrinted:\n" <> T.unpack printed)+        Right ast2 -> ast1 `shouldBe` ast2+++-- | Parse with spans, then assert 'exactPrint' reproduces the source byte-for-byte.+exactPrintTest :: Text -> IO ()+exactPrintTest src =+  case parseProtoFileWithSpans "<test>" src of+    Left e -> expectationFailure ("Parse failed: " <> show e)+    Right ast -> exactPrint ast `shouldBe` src   complexProto :: Text
test-integration/Test/Resolver.hs view
@@ -1,6 +1,6 @@ module Test.Resolver (resolverTests) where -import qualified Control.Monad+import Control.Monad qualified import Data.ByteString qualified as BS import Data.Map.Strict qualified as Map import Data.Text qualified as T@@ -13,168 +13,166 @@   removeDirectoryRecursive,  ) import System.FilePath ((</>))-import Test.Tasty-import Test.Tasty.HUnit+import Test.Syd  -resolverTests :: TestTree+resolverTests :: Spec resolverTests =-  testGroup+  describe     "Proto.IDL.Parser.Resolver"-    [ testCase "resolve simple proto with no imports" $ do-        withTempProtoDir $ \dir -> do-          writeProtoFile (dir </> "simple.proto") $-            T.unlines-              [ "syntax = \"proto3\";"-              , "package test;"-              , "message Foo {"-              , "  string name = 1;"-              , "}"-              ]-          result <- resolveProtoImports [dir] (dir </> "simple.proto")-          case result of-            Left e -> assertFailure ("resolve failed: " <> show e)-            Right rp -> do-              rpPath rp @?= dir </> "simple.proto"-              Map.null (rpImports rp) @?= True-              protoPackage (rpFile rp) @?= Just "test"-    , testCase "resolve proto with local import" $ do-        withTempProtoDir $ \dir -> do-          writeProtoFile (dir </> "dep.proto") $-            T.unlines-              [ "syntax = \"proto3\";"-              , "package dep;"-              , "message Bar {"-              , "  int32 id = 1;"-              , "}"-              ]-          writeProtoFile (dir </> "main.proto") $-            T.unlines-              [ "syntax = \"proto3\";"-              , "package main;"-              , "import \"dep.proto\";"-              , "message Foo {"-              , "  string name = 1;"-              , "}"-              ]-          result <- resolveProtoImports [dir] (dir </> "main.proto")-          case result of-            Left e -> assertFailure ("resolve failed: " <> show e)-            Right rp -> do-              Map.size (rpImports rp) @?= 1-              assertBool "import dep.proto present" (Map.member "dep.proto" (rpImports rp))-              case Map.lookup "dep.proto" (rpImports rp) of-                Nothing -> assertFailure "dep.proto not in imports"-                Just dep -> protoPackage (rpFile dep) @?= Just "dep"-    , testCase "resolve proto with subdirectory import" $ do-        withTempProtoDir $ \dir -> do-          createDirectoryIfMissing True (dir </> "sub")-          writeProtoFile (dir </> "sub" </> "dep.proto") $-            T.unlines-              [ "syntax = \"proto3\";"-              , "package sub;"-              , "message Inner {"-              , "  bool flag = 1;"-              , "}"-              ]-          writeProtoFile (dir </> "main.proto") $-            T.unlines-              [ "syntax = \"proto3\";"-              , "import \"sub/dep.proto\";"-              , "message Outer {"-              , "  string val = 1;"-              , "}"-              ]-          result <- resolveProtoImports [dir] (dir </> "main.proto")-          case result of-            Left e -> assertFailure ("resolve failed: " <> show e)-            Right rp -> do-              assertBool "sub/dep.proto imported" (Map.member "sub/dep.proto" (rpImports rp))-    , testCase "well-known import google/protobuf/timestamp.proto resolves" $ do-        withTempProtoDir $ \dir -> do-          writeProtoFile (dir </> "with_ts.proto") $-            T.unlines-              [ "syntax = \"proto3\";"-              , "import \"google/protobuf/timestamp.proto\";"-              , "message Event {"-              , "  string name = 1;"-              , "}"-              ]-          result <- resolveProtoImports [dir] (dir </> "with_ts.proto")-          case result of-            Left e -> assertFailure ("resolve failed: " <> show e)-            Right rp -> do-              assertBool-                "timestamp.proto imported"-                (Map.member "google/protobuf/timestamp.proto" (rpImports rp))-              let tsProto = rpImports rp Map.! "google/protobuf/timestamp.proto"-              protoPackage (rpFile tsProto) @?= Just "google.protobuf"-    , testCase "types from imported files available via registry" $ do-        withTempProtoDir $ \dir -> do-          writeProtoFile (dir </> "dep.proto") $-            T.unlines-              [ "syntax = \"proto3\";"-              , "package mypkg;"-              , "message Payload {"-              , "  bytes data = 1;"-              , "}"-              ]-          writeProtoFile (dir </> "main.proto") $-            T.unlines-              [ "syntax = \"proto3\";"-              , "package mypkg;"-              , "import \"dep.proto\";"-              , "message Request {"-              , "  string id = 1;"-              , "}"-              ]-          result <- resolveProtoImports [dir] (dir </> "main.proto")-          case result of-            Left e -> assertFailure ("resolve failed: " <> show e)-            Right rp -> do-              let importedProtos = rpImports rp-              assertBool "dep.proto imported" (Map.member "dep.proto" importedProtos)-              let depPf = rpFile (importedProtos Map.! "dep.proto")-                  topLevels = protoTopLevels depPf-              assertBool "Payload message found" $ any isPayloadMsg topLevels-    , testCase "missing import returns FileNotFound" $ do-        withTempProtoDir $ \dir -> do-          writeProtoFile (dir </> "bad.proto") $-            T.unlines-              [ "syntax = \"proto3\";"-              , "import \"nonexistent.proto\";"-              , "message Foo {"-              , "  int32 x = 1;"-              , "}"-              ]-          result <- resolveProtoImports [dir] (dir </> "bad.proto")-          case result of-            Left (FileNotFound {}) -> pure ()-            Left e -> assertFailure ("unexpected error: " <> show e)-            Right _ -> assertFailure "expected FileNotFound error"-    , testCase "circular import detected" $ do-        withTempProtoDir $ \dir -> do-          writeProtoFile (dir </> "a.proto") $-            T.unlines-              [ "syntax = \"proto3\";"-              , "import \"b.proto\";"-              , "message A { int32 x = 1; }"-              ]-          writeProtoFile (dir </> "b.proto") $-            T.unlines-              [ "syntax = \"proto3\";"-              , "import \"a.proto\";"-              , "message B { int32 y = 1; }"-              ]-          result <- resolveProtoImports [dir] (dir </> "a.proto")-          case result of-            Left (CircularImport _) -> pure ()-            Left e -> assertFailure ("unexpected error: " <> show e)-            Right _ -> assertFailure "expected CircularImport error"-    , testCase "getBundledIncludeDir returns valid path" $ do-        dir <- getBundledIncludeDir-        assertBool "bundled dir is non-empty" (not (null dir))-    ]+    $ sequence_+      [ it "resolve simple proto with no imports" $ do+          withTempProtoDir $ \dir -> do+            writeProtoFile (dir </> "simple.proto") $+              T.unlines+                [ "syntax = \"proto3\";"+                , "package test;"+                , "message Foo {"+                , "  string name = 1;"+                , "}"+                ]+            result <- resolveProtoImports [dir] (dir </> "simple.proto")+            case result of+              Left e -> expectationFailure ("resolve failed: " <> show e)+              Right rp -> do+                rpPath rp `shouldBe` dir </> "simple.proto"+                Map.null (rpImports rp) `shouldBe` True+                protoPackage (rpFile rp) `shouldBe` Just "test"+      , it "resolve proto with local import" $ do+          withTempProtoDir $ \dir -> do+            writeProtoFile (dir </> "dep.proto") $+              T.unlines+                [ "syntax = \"proto3\";"+                , "package dep;"+                , "message Bar {"+                , "  int32 id = 1;"+                , "}"+                ]+            writeProtoFile (dir </> "main.proto") $+              T.unlines+                [ "syntax = \"proto3\";"+                , "package main;"+                , "import \"dep.proto\";"+                , "message Foo {"+                , "  string name = 1;"+                , "}"+                ]+            result <- resolveProtoImports [dir] (dir </> "main.proto")+            case result of+              Left e -> expectationFailure ("resolve failed: " <> show e)+              Right rp -> do+                Map.size (rpImports rp) `shouldBe` 1+                (Map.member "dep.proto" (rpImports rp)) `shouldBe` True+                case Map.lookup "dep.proto" (rpImports rp) of+                  Nothing -> expectationFailure "dep.proto not in imports"+                  Just dep -> protoPackage (rpFile dep) `shouldBe` Just "dep"+      , it "resolve proto with subdirectory import" $ do+          withTempProtoDir $ \dir -> do+            createDirectoryIfMissing True (dir </> "sub")+            writeProtoFile (dir </> "sub" </> "dep.proto") $+              T.unlines+                [ "syntax = \"proto3\";"+                , "package sub;"+                , "message Inner {"+                , "  bool flag = 1;"+                , "}"+                ]+            writeProtoFile (dir </> "main.proto") $+              T.unlines+                [ "syntax = \"proto3\";"+                , "import \"sub/dep.proto\";"+                , "message Outer {"+                , "  string val = 1;"+                , "}"+                ]+            result <- resolveProtoImports [dir] (dir </> "main.proto")+            case result of+              Left e -> expectationFailure ("resolve failed: " <> show e)+              Right rp -> do+                (Map.member "sub/dep.proto" (rpImports rp)) `shouldBe` True+      , it "well-known import google/protobuf/timestamp.proto resolves" $ do+          withTempProtoDir $ \dir -> do+            writeProtoFile (dir </> "with_ts.proto") $+              T.unlines+                [ "syntax = \"proto3\";"+                , "import \"google/protobuf/timestamp.proto\";"+                , "message Event {"+                , "  string name = 1;"+                , "}"+                ]+            result <- resolveProtoImports [dir] (dir </> "with_ts.proto")+            case result of+              Left e -> expectationFailure ("resolve failed: " <> show e)+              Right rp -> do+                (Map.member "google/protobuf/timestamp.proto" (rpImports rp)) `shouldBe` True+                let tsProto = rpImports rp Map.! "google/protobuf/timestamp.proto"+                protoPackage (rpFile tsProto) `shouldBe` Just "google.protobuf"+      , it "types from imported files available via registry" $ do+          withTempProtoDir $ \dir -> do+            writeProtoFile (dir </> "dep.proto") $+              T.unlines+                [ "syntax = \"proto3\";"+                , "package mypkg;"+                , "message Payload {"+                , "  bytes data = 1;"+                , "}"+                ]+            writeProtoFile (dir </> "main.proto") $+              T.unlines+                [ "syntax = \"proto3\";"+                , "package mypkg;"+                , "import \"dep.proto\";"+                , "message Request {"+                , "  string id = 1;"+                , "}"+                ]+            result <- resolveProtoImports [dir] (dir </> "main.proto")+            case result of+              Left e -> expectationFailure ("resolve failed: " <> show e)+              Right rp -> do+                let importedProtos = rpImports rp+                (Map.member "dep.proto" importedProtos) `shouldBe` True+                let depPf = rpFile (importedProtos Map.! "dep.proto")+                    topLevels = protoTopLevels depPf+                any isPayloadMsg topLevels `shouldBe` True+      , it "missing import returns FileNotFound" $ do+          withTempProtoDir $ \dir -> do+            writeProtoFile (dir </> "bad.proto") $+              T.unlines+                [ "syntax = \"proto3\";"+                , "import \"nonexistent.proto\";"+                , "message Foo {"+                , "  int32 x = 1;"+                , "}"+                ]+            result <- resolveProtoImports [dir] (dir </> "bad.proto")+            case result of+              Left (FileNotFound {}) -> pure ()+              Left e -> expectationFailure ("unexpected error: " <> show e)+              Right _ -> expectationFailure "expected FileNotFound error"+      , it "circular import detected" $ do+          withTempProtoDir $ \dir -> do+            writeProtoFile (dir </> "a.proto") $+              T.unlines+                [ "syntax = \"proto3\";"+                , "import \"b.proto\";"+                , "message A { int32 x = 1; }"+                ]+            writeProtoFile (dir </> "b.proto") $+              T.unlines+                [ "syntax = \"proto3\";"+                , "import \"a.proto\";"+                , "message B { int32 y = 1; }"+                ]+            result <- resolveProtoImports [dir] (dir </> "a.proto")+            case result of+              Left (CircularImport _) -> pure ()+              Left e -> expectationFailure ("unexpected error: " <> show e)+              Right _ -> expectationFailure "expected CircularImport error"+      , it "getBundledIncludeDir returns valid path" $ do+          dir <- getBundledIncludeDir+          (not (null dir)) `shouldBe` True+      ]   isPayloadMsg :: TopLevel -> Bool
test-integration/Test/Roundtrip.hs view
@@ -9,378 +9,365 @@ import Hedgehog import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range-import Proto-import Proto.Internal.Decode (-  captureUnknownField,-  decodeFail,-  decodeFieldLazyMessage,-  decodeFieldMessage,-  decodePackedDouble,-  decodePackedFixed32,-  decodePackedSVarint32,-  decodePackedVarint,- )-import Proto.Internal.Encode (-  MessageEncode (..),-  encodePackedDouble,-  encodePackedFixed32,-  encodePackedSVarint32,-  encodePackedVarint,-  fieldBool,-  fieldBytes,-  fieldDouble,-  fieldMessage,-  fieldString,-  fieldVarint,- )+import Proto.Decode+import Proto.Encode import Proto.Internal.SizedBuilder qualified as SB import Proto.Internal.Wire (Tag (..), WireType (..)) import Proto.Internal.Wire.Decode import Proto.Internal.Wire.Encode-import Test.Tasty-import Test.Tasty.HUnit hiding (assert)-import Test.Tasty.Hedgehog+import Test.Syd+import Test.Syd.Hedgehog () import Wireform.Builder qualified as B  -roundtripTests :: TestTree+roundtripTests :: Spec roundtripTests =-  testGroup+  describe     "Roundtrip Encoding/Decoding"-    [ testGroup-        "Hand-crafted message roundtrip"-        [ testCase "simple message encode/decode" $ do-            let encoded =-                  buildToBS $-                    putTag 1 WireVarint-                      <> putVarint 42-                      <> putTag 2 WireLengthDelimited-                      <> putText "hello"-                      <> putTag 3 WireVarint-                      <> putVarint 1--            case runDecoder decodeSimpleMsg encoded of-              Left e -> assertFailure (show e)-              Right (val, name, active) -> do-                val @?= 42-                name @?= "hello"-                active @?= True-        , testCase "message with missing optional fields" $ do-            let encoded =-                  buildToBS $-                    putTag 1 WireVarint <> putVarint 99--            case runDecoder decodeSimpleMsgDefaults encoded of-              Left e -> assertFailure (show e)-              Right (val, name, active) -> do-                val @?= 99-                name @?= ""-                active @?= False-        , testCase "message with unknown fields" $ do-            let encoded =-                  buildToBS $-                    putTag 1 WireVarint-                      <> putVarint 42-                      <> putTag 99 WireVarint-                      <> putVarint 999-                      <> putTag 2 WireLengthDelimited-                      <> putText "hello"-                      <> putTag 100 Wire32Bit-                      <> putFixed32 0-                      <> putTag 3 WireVarint-                      <> putVarint 1+    $ sequence_+      [ describe+          "Hand-crafted message roundtrip"+          $ sequence_+            [ it "simple message encode/decode" $ do+                let encoded =+                      buildToBS $+                        putTag 1 WireVarint+                          <> putVarint 42+                          <> putTag 2 WireLengthDelimited+                          <> putText "hello"+                          <> putTag 3 WireVarint+                          <> putVarint 1 -            case runDecoder decodeSimpleMsg encoded of-              Left e -> assertFailure (show e)-              Right (val, name, active) -> do-                val @?= 42-                name @?= "hello"-                active @?= True-        , testCase "message with repeated field" $ do-            let encoded =-                  buildToBS $-                    putTag 1 WireVarint-                      <> putVarint 1-                      <> putTag 1 WireVarint-                      <> putVarint 2-                      <> putTag 1 WireVarint-                      <> putVarint 3+                case runDecoder decodeSimpleMsg encoded of+                  Left e -> expectationFailure (show e)+                  Right (val, name, active) -> do+                    val `shouldBe` 42+                    name `shouldBe` "hello"+                    active `shouldBe` True+            , it "message with missing optional fields" $ do+                let encoded =+                      buildToBS $+                        putTag 1 WireVarint <> putVarint 99 -            case runDecoder decodeRepeatedMsg encoded of-              Left e -> assertFailure (show e)-              Right vals -> vals @?= [1, 2, 3]-        , testCase "packed repeated field" $ do-            let payload = buildToBS (putVarint 10 <> putVarint 20 <> putVarint 30)-                encoded =-                  buildToBS $-                    putTag 1 WireLengthDelimited <> putLengthDelimited payload+                case runDecoder decodeSimpleMsgDefaults encoded of+                  Left e -> expectationFailure (show e)+                  Right (val, name, active) -> do+                    val `shouldBe` 99+                    name `shouldBe` ""+                    active `shouldBe` False+            , it "message with unknown fields" $ do+                let encoded =+                      buildToBS $+                        putTag 1 WireVarint+                          <> putVarint 42+                          <> putTag 99 WireVarint+                          <> putVarint 999+                          <> putTag 2 WireLengthDelimited+                          <> putText "hello"+                          <> putTag 100 Wire32Bit+                          <> putFixed32 0+                          <> putTag 3 WireVarint+                          <> putVarint 1 -            case runDecoder decodePackedRepeatedMsg encoded of-              Left e -> assertFailure (show e)-              Right vals -> VU.toList vals @?= [10, 20, 30]-        , testCase "nested message encode/decode" $ do-            let innerPayload =-                  buildToBS $-                    putTag 1 WireLengthDelimited <> putText "inner value"-                encoded =-                  buildToBS $-                    putTag 1 WireVarint-                      <> putVarint 1-                      <> putTag 2 WireLengthDelimited-                      <> putLengthDelimited innerPayload+                case runDecoder decodeSimpleMsg encoded of+                  Left e -> expectationFailure (show e)+                  Right (val, name, active) -> do+                    val `shouldBe` 42+                    name `shouldBe` "hello"+                    active `shouldBe` True+            , it "message with repeated field" $ do+                let encoded =+                      buildToBS $+                        putTag 1 WireVarint+                          <> putVarint 1+                          <> putTag 1 WireVarint+                          <> putVarint 2+                          <> putTag 1 WireVarint+                          <> putVarint 3 -            case runDecoder decodeNestedMsg encoded of-              Left e -> assertFailure (show e)-              Right (outerVal, innerText) -> do-                outerVal @?= 1-                innerText @?= "inner value"-        ]-    , testGroup-        "Field type roundtrips"-        [ testProperty "int32 field roundtrip" $ property $ do-            n <- forAll $ Gen.int32 Range.linearBounded-            let encoded = buildToBS $ putTag 1 WireVarint <> putVarintSigned (fromIntegral n)-            case runDecoder (getTag >> getVarintSigned) encoded of-              Left e -> do-                annotate (show e)-                failure-              Right v -> fromIntegral v === n-        , testProperty "fixed32 field roundtrip" $ property $ do-            n <- forAll $ Gen.word32 Range.linearBounded-            let encoded = buildToBS $ putTag 1 Wire32Bit <> putFixed32 n-            case runDecoder (getTag >> getFixed32) encoded of-              Left e -> do-                annotate (show e)-                failure-              Right v -> v === n-        , testProperty "string field roundtrip" $ property $ do-            t <- forAll $ Gen.text (Range.linear 0 500) Gen.unicode-            let encoded = buildToBS $ putTag 1 WireLengthDelimited <> putText t-            case runDecoder (getTag >> getText) encoded of-              Left e -> do-                annotate (show e)-                failure-              Right v -> v === t-        , testProperty "bytes field roundtrip" $ property $ do-            bs <- forAll $ Gen.bytes (Range.linear 0 500)-            let encoded = buildToBS $ putTag 1 WireLengthDelimited <> putByteString bs-            case runDecoder (getTag >> getByteString) encoded of-              Left e -> do-                annotate (show e)-                failure-              Right v -> v === bs-        ]-    , testGroup-        "Multi-field message roundtrip"-        [ testProperty "multi-field roundtrip" $ property $ do-            v1 <- forAll $ Gen.word64 (Range.linear 0 maxBound)-            v2 <- forAll $ Gen.text (Range.linear 0 100) Gen.alphaNum-            v3 <- forAll Gen.bool-            v4 <- forAll $ Gen.double (Range.linearFrac (-1e10) 1e10)+                case runDecoder decodeRepeatedMsg encoded of+                  Left e -> expectationFailure (show e)+                  Right vals -> vals `shouldBe` [1, 2, 3]+            , it "packed repeated field" $ do+                let payload = buildToBS (putVarint 10 <> putVarint 20 <> putVarint 30)+                    encoded =+                      buildToBS $+                        putTag 1 WireLengthDelimited <> putLengthDelimited payload -            let encoded =-                  buildToBS $-                    putTag 1 WireVarint-                      <> putVarint v1-                      <> putTag 2 WireLengthDelimited-                      <> putText v2-                      <> putTag 3 WireVarint-                      <> putVarint (if v3 then 1 else 0)-                      <> putTag 4 Wire64Bit-                      <> putDouble v4+                case runDecoder decodePackedRepeatedMsg encoded of+                  Left e -> expectationFailure (show e)+                  Right vals -> VU.toList vals `shouldBe` [10, 20, 30]+            , it "nested message encode/decode" $ do+                let innerPayload =+                      buildToBS $+                        putTag 1 WireLengthDelimited <> putText "inner value"+                    encoded =+                      buildToBS $+                        putTag 1 WireVarint+                          <> putVarint 1+                          <> putTag 2 WireLengthDelimited+                          <> putLengthDelimited innerPayload -            case runDecoder (decodeMultiField v1 v2 v3 v4) encoded of-              Left e -> do-                annotate (show e)-                failure-              Right () -> success-        ]-    , testGroup-        "Packed encoding helpers"-        [ testProperty "packed varint roundtrip" $ property $ do-            vals <- forAll $ Gen.list (Range.linear 0 50) (Gen.word64 (Range.linear 0 maxBound))-            let vec = VU.fromList vals-                encoded = SB.toByteString (encodePackedVarint 1 vec)-            if VU.null vec-              then assert (BS.null encoded)-              else case runDecoder (getTag >> decodePackedVarint) encoded of-                Left e -> do-                  annotate (show e)-                  failure-                Right decoded -> VU.toList decoded === vals-        , testProperty "packed fixed32 roundtrip" $ property $ do-            vals <- forAll $ Gen.list (Range.linear 0 50) (Gen.word32 Range.linearBounded)-            let vec = VU.fromList vals-                encoded = SB.toByteString (encodePackedFixed32 1 vec)-            if VU.null vec-              then assert (BS.null encoded)-              else case runDecoder (getTag >> decodePackedFixed32) encoded of-                Left e -> do-                  annotate (show e)-                  failure-                Right decoded -> VU.toList decoded === vals-        , testProperty "packed double roundtrip" $ property $ do-            vals <- forAll $ Gen.list (Range.linear 0 50) (Gen.double (Range.linearFrac (-1e100) 1e100))-            let vec = VU.fromList vals-                encoded = SB.toByteString (encodePackedDouble 1 vec)-            if VU.null vec-              then assert (BS.null encoded)-              else case runDecoder (getTag >> decodePackedDouble) encoded of-                Left e -> do-                  annotate (show e)-                  failure-                Right decoded -> VU.toList decoded === vals-        , testProperty "packed sint32 roundtrip" $ property $ do-            vals <- forAll $ Gen.list (Range.linear 0 50) (Gen.int32 Range.linearBounded)-            let vec = VU.fromList vals-                encoded = SB.toByteString (encodePackedSVarint32 1 vec)-            if VU.null vec-              then assert (BS.null encoded)-              else case runDecoder (getTag >> decodePackedSVarint32) encoded of-                Left e -> do-                  annotate (show e)-                  failure-                Right decoded -> VU.toList decoded === vals-        ]-    , testGroup-        "MessageEncode/MessageDecode typeclass roundtrip"-        [ testProperty "TestMsg roundtrip" $ property $ do-            v <- forAll $ Gen.word64 (Range.linear 0 1000000)-            t <- forAll $ Gen.text (Range.linear 0 100) Gen.alphaNum-            b <- forAll Gen.bool-            let msg = TestMsg v t b-                encoded = encodeMessage msg-            case decodeMessage encoded of-              Left e -> do-                annotate (show e)-                failure-              Right decoded -> decoded === msg-        , testProperty "TestMsg with submessage roundtrip" $ property $ do-            outerVal <- forAll $ Gen.word64 (Range.linear 0 1000)-            innerVal <- forAll $ Gen.word64 (Range.linear 0 1000)-            innerName <- forAll $ Gen.text (Range.linear 0 50) Gen.alphaNum-            let inner = TestMsg innerVal innerName True-                outer = TestOuter outerVal (Just inner)-                encoded = encodeMessage outer-            case decodeMessage encoded of-              Left e -> do-                annotate (show e)-                failure-              Right decoded -> decoded === outer-        , testCase "TestMsg size calculation matches encoding" $ do-            let msg = TestMsg 42 "hello" True-                encoded = encodeMessage msg-                calculatedSize = messageSize msg-            BS.length encoded @?= calculatedSize-        , testProperty "TestMsg size always matches" $ property $ do-            v <- forAll $ Gen.word64 (Range.linear 0 maxBound)-            t <- forAll $ Gen.text (Range.linear 0 200) Gen.alphaNum-            b <- forAll Gen.bool-            let msg = TestMsg v t b-                encoded = encodeMessage msg-            BS.length encoded === messageSize msg-        ]-    , testGroup-        "Lazy submessage decoding"-        [ testCase "lazy message captures bytes" $ do-            let inner = TestMsg 42 "lazy" True-                innerBS = encodeMessage inner-                encoded =-                  buildToBS $-                    putTag 1 WireVarint-                      <> putVarint 1-                      <> putTag 2 WireLengthDelimited-                      <> putLengthDelimited innerBS+                case runDecoder decodeNestedMsg encoded of+                  Left e -> expectationFailure (show e)+                  Right (outerVal, innerText) -> do+                    outerVal `shouldBe` 1+                    innerText `shouldBe` "inner value"+            ]+      , describe+          "Field type roundtrips"+          $ sequence_+            [ it "int32 field roundtrip" $ property $ do+                n <- forAll $ Gen.int32 Range.linearBounded+                let encoded = buildToBS $ putTag 1 WireVarint <> putVarintSigned (fromIntegral n)+                case runDecoder (getTag >> getVarintSigned) encoded of+                  Left e -> do+                    annotate (show e)+                    failure+                  Right v -> fromIntegral v === n+            , it "fixed32 field roundtrip" $ property $ do+                n <- forAll $ Gen.word32 Range.linearBounded+                let encoded = buildToBS $ putTag 1 Wire32Bit <> putFixed32 n+                case runDecoder (getTag >> getFixed32) encoded of+                  Left e -> do+                    annotate (show e)+                    failure+                  Right v -> v === n+            , it "string field roundtrip" $ property $ do+                t <- forAll $ Gen.text (Range.linear 0 500) Gen.unicode+                let encoded = buildToBS $ putTag 1 WireLengthDelimited <> putText t+                case runDecoder (getTag >> getText) encoded of+                  Left e -> do+                    annotate (show e)+                    failure+                  Right v -> v === t+            , it "bytes field roundtrip" $ property $ do+                bs <- forAll $ Gen.bytes (Range.linear 0 500)+                let encoded = buildToBS $ putTag 1 WireLengthDelimited <> putByteString bs+                case runDecoder (getTag >> getByteString) encoded of+                  Left e -> do+                    annotate (show e)+                    failure+                  Right v -> v === bs+            ]+      , describe+          "Multi-field message roundtrip"+          $ sequence_+            [ it "multi-field roundtrip" $ property $ do+                v1 <- forAll $ Gen.word64 (Range.linear 0 maxBound)+                v2 <- forAll $ Gen.text (Range.linear 0 100) Gen.alphaNum+                v3 <- forAll Gen.bool+                v4 <- forAll $ Gen.double (Range.linearFrac (-1e10) 1e10) -            case runDecoder decodeLazyOuter encoded of-              Left e -> assertFailure (show e)-              Right (outerVal, lazyInner) -> do-                outerVal @?= 1-                case forceLazyMessage lazyInner of-                  Left e -> assertFailure (show e)-                  Right msg -> msg @?= TestMsg 42 "lazy" True-        ]-    , testGroup-        "Unknown field preservation"-        [ testCase "capture and re-encode unknown fields" $ do-            let encoded =-                  buildToBS $-                    putTag 1 WireVarint-                      <> putVarint 42-                      <> putTag 99 WireVarint-                      <> putVarint 999-                      <> putTag 100 Wire32Bit-                      <> putFixed32 0xDEADBEEF-                      <> putTag 101 WireLengthDelimited-                      <> putByteString "unknown data"-                      <> putTag 2 WireLengthDelimited-                      <> putText "hello"+                let encoded =+                      buildToBS $+                        putTag 1 WireVarint+                          <> putVarint v1+                          <> putTag 2 WireLengthDelimited+                          <> putText v2+                          <> putTag 3 WireVarint+                          <> putVarint (if v3 then 1 else 0)+                          <> putTag 4 Wire64Bit+                          <> putDouble v4 -            case runDecoder decodeWithUnknowns encoded of-              Left e -> assertFailure (show e)-              Right (val, name, unknowns) -> do-                val @?= 42-                name @?= "hello"-                length unknowns @?= 3+                case runDecoder (decodeMultiField v1 v2 v3 v4) encoded of+                  Left e -> do+                    annotate (show e)+                    failure+                  Right () -> success+            ]+      , describe+          "Packed encoding helpers"+          $ sequence_+            [ it "packed varint roundtrip" $ property $ do+                vals <- forAll $ Gen.list (Range.linear 0 50) (Gen.word64 (Range.linear 0 maxBound))+                let vec = VU.fromList vals+                    encoded = buildToBS (encodePackedVarint 1 vec)+                if VU.null vec+                  then assert (BS.null encoded)+                  else case runDecoder (getTag >> decodePackedVarint) encoded of+                    Left e -> do+                      annotate (show e)+                      failure+                    Right decoded -> VU.toList decoded === vals+            , it "packed fixed32 roundtrip" $ property $ do+                vals <- forAll $ Gen.list (Range.linear 0 50) (Gen.word32 Range.linearBounded)+                let vec = VU.fromList vals+                    encoded = buildToBS (encodePackedFixed32 1 vec)+                if VU.null vec+                  then assert (BS.null encoded)+                  else case runDecoder (getTag >> decodePackedFixed32) encoded of+                    Left e -> do+                      annotate (show e)+                      failure+                    Right decoded -> VU.toList decoded === vals+            , it "packed double roundtrip" $ property $ do+                vals <- forAll $ Gen.list (Range.linear 0 50) (Gen.double (Range.linearFrac (-1e100) 1e100))+                let vec = VU.fromList vals+                    encoded = buildToBS (encodePackedDouble 1 vec)+                if VU.null vec+                  then assert (BS.null encoded)+                  else case runDecoder (getTag >> decodePackedDouble) encoded of+                    Left e -> do+                      annotate (show e)+                      failure+                    Right decoded -> VU.toList decoded === vals+            , it "packed sint32 roundtrip" $ property $ do+                vals <- forAll $ Gen.list (Range.linear 0 50) (Gen.int32 Range.linearBounded)+                let vec = VU.fromList vals+                    encoded = buildToBS (encodePackedSVarint32 1 vec)+                if VU.null vec+                  then assert (BS.null encoded)+                  else case runDecoder (getTag >> decodePackedSVarint32) encoded of+                    Left e -> do+                      annotate (show e)+                      failure+                    Right decoded -> VU.toList decoded === vals+            ]+      , describe+          "MessageEncode/MessageDecode typeclass roundtrip"+          $ sequence_+            [ it "TestMsg roundtrip" $ property $ do+                v <- forAll $ Gen.word64 (Range.linear 0 1000000)+                t <- forAll $ Gen.text (Range.linear 0 100) Gen.alphaNum+                b <- forAll Gen.bool+                let msg = TestMsg v t b+                    encoded = encodeMessage msg+                case decodeMessage encoded of+                  Left e -> do+                    annotate (show e)+                    failure+                  Right decoded -> decoded === msg+            , it "TestMsg with submessage roundtrip" $ property $ do+                outerVal <- forAll $ Gen.word64 (Range.linear 0 1000)+                innerVal <- forAll $ Gen.word64 (Range.linear 0 1000)+                innerName <- forAll $ Gen.text (Range.linear 0 50) Gen.alphaNum+                let inner = TestMsg innerVal innerName True+                    outer = TestOuter outerVal (Just inner)+                    encoded = encodeMessage outer+                case decodeMessage encoded of+                  Left e -> do+                    annotate (show e)+                    failure+                  Right decoded -> decoded === outer+            , it "TestMsg size calculation matches encoding" $ do+                let msg = TestMsg 42 "hello" True+                    encoded = encodeMessage msg+                    calculatedSize = messageSize msg+                BS.length encoded `shouldBe` calculatedSize+            , it "TestMsg size always matches" $ property $ do+                v <- forAll $ Gen.word64 (Range.linear 0 maxBound)+                t <- forAll $ Gen.text (Range.linear 0 200) Gen.alphaNum+                b <- forAll Gen.bool+                let msg = TestMsg v t b+                    encoded = encodeMessage msg+                BS.length encoded === messageSize msg+            ]+      , describe+          "Lazy submessage decoding"+          $ sequence_+            [ it "lazy message captures bytes" $ do+                let inner = TestMsg 42 "lazy" True+                    innerBS = encodeMessage inner+                    encoded =+                      buildToBS $+                        putTag 1 WireVarint+                          <> putVarint 1+                          <> putTag 2 WireLengthDelimited+                          <> putLengthDelimited innerBS -                let reencoded =+                case runDecoder decodeLazyOuter encoded of+                  Left e -> expectationFailure (show e)+                  Right (outerVal, lazyInner) -> do+                    outerVal `shouldBe` 1+                    case forceLazyMessage lazyInner of+                      Left e -> expectationFailure (show e)+                      Right msg -> msg `shouldBe` TestMsg 42 "lazy" True+            ]+      , describe+          "Unknown field preservation"+          $ sequence_+            [ it "capture and re-encode unknown fields" $ do+                let encoded =                       buildToBS $                         putTag 1 WireVarint                           <> putVarint 42+                          <> putTag 99 WireVarint+                          <> putVarint 999+                          <> putTag 100 Wire32Bit+                          <> putFixed32 0xDEADBEEF+                          <> putTag 101 WireLengthDelimited+                          <> putByteString "unknown data"                           <> putTag 2 WireLengthDelimited                           <> putText "hello"-                          <> encodeUnknownFields unknowns-                BS.length reencoded > 0 @?= True-        ]-    , testGroup-        "Size calculation"-        [ testProperty "varintSize correct" $ property $ do-            n <- forAll $ Gen.word64 (Range.linear 0 maxBound)-            let encoded = buildToBS (putVarint n)-            BS.length encoded === varintSize n-        , testProperty "tagSize correct" $ property $ do-            fn <- forAll $ Gen.int (Range.linear 1 10000)-            let tagVal = fromIntegral fn * 8-                encoded = buildToBS (putVarint tagVal)-            BS.length encoded === tagSize fn-        ]-    , testGroup-        "SizedBuilder (fused size+builder)"-        [ testProperty "fieldVarint size matches" $ property $ do-            fn <- forAll $ Gen.int (Range.linear 1 100)-            val <- forAll $ Gen.word64 (Range.linear 0 maxBound)-            let sb = fieldVarint fn val-                bs = SB.toByteString sb-            BS.length bs === SB.size sb-        , testProperty "fieldString size matches" $ property $ do-            fn <- forAll $ Gen.int (Range.linear 1 100)-            t <- forAll $ Gen.text (Range.linear 0 200) Gen.alphaNum-            let sb = fieldString fn t-                bs = SB.toByteString sb-            BS.length bs === SB.size sb-        , testProperty "fieldMessage size matches" $ property $ do-            val <- forAll $ Gen.word64 (Range.linear 0 1000)-            name <- forAll $ Gen.text (Range.linear 0 50) Gen.alphaNum-            let innerSB = fieldVarint 1 val <> fieldString 2 name-                outerSB = fieldMessage 1 innerSB-                bs = SB.toByteString outerSB-            BS.length bs === SB.size outerSB-        , testProperty "fieldBool size matches" $ property $ do-            fn <- forAll $ Gen.int (Range.linear 1 100)-            b <- forAll Gen.bool-            let sb = fieldBool fn b-                bs = SB.toByteString sb-            BS.length bs === SB.size sb-        , testProperty "fieldDouble size matches" $ property $ do-            fn <- forAll $ Gen.int (Range.linear 1 100)-            d <- forAll $ Gen.double (Range.linearFrac (-1e100) 1e100)-            let sb = fieldDouble fn d-                bs = SB.toByteString sb-            BS.length bs === SB.size sb-        ]-    ] +                case runDecoder decodeWithUnknowns encoded of+                  Left e -> expectationFailure (show e)+                  Right (val, name, unknowns) -> do+                    val `shouldBe` 42+                    name `shouldBe` "hello"+                    length unknowns `shouldBe` 3 +                    let reencoded =+                          buildToBS $+                            putTag 1 WireVarint+                              <> putVarint 42+                              <> putTag 2 WireLengthDelimited+                              <> putText "hello"+                              <> encodeUnknownFields unknowns+                    BS.length reencoded > 0 `shouldBe` True+            ]+      , describe+          "Size calculation"+          $ sequence_+            [ it "varintSize correct" $ property $ do+                n <- forAll $ Gen.word64 (Range.linear 0 maxBound)+                let encoded = buildToBS (putVarint n)+                BS.length encoded === varintSize n+            , it "tagSize correct" $ property $ do+                fn <- forAll $ Gen.int (Range.linear 1 10000)+                let tagVal = fromIntegral fn * 8+                    encoded = buildToBS (putVarint tagVal)+                BS.length encoded === tagSize fn+            ]+      , describe+          "SizedBuilder (fused size+builder)"+          $ sequence_+            [ it "sizedFieldVarint size matches" $ property $ do+                fn <- forAll $ Gen.int (Range.linear 1 100)+                val <- forAll $ Gen.word64 (Range.linear 0 maxBound)+                let sb = sizedFieldVarint fn val+                    bs = SB.toByteString sb+                BS.length bs === SB.size sb+            , it "sizedFieldString size matches" $ property $ do+                fn <- forAll $ Gen.int (Range.linear 1 100)+                t <- forAll $ Gen.text (Range.linear 0 200) Gen.alphaNum+                let sb = sizedFieldString fn t+                    bs = SB.toByteString sb+                BS.length bs === SB.size sb+            , it "sizedFieldMessage size matches" $ property $ do+                val <- forAll $ Gen.word64 (Range.linear 0 1000)+                name <- forAll $ Gen.text (Range.linear 0 50) Gen.alphaNum+                let innerSB = sizedFieldVarint 1 val <> sizedFieldString 2 name+                    outerSB = sizedFieldMessage 1 innerSB+                    bs = SB.toByteString outerSB+                BS.length bs === SB.size outerSB+            , it "sizedFieldBool size matches" $ property $ do+                fn <- forAll $ Gen.int (Range.linear 1 100)+                b <- forAll Gen.bool+                let sb = sizedFieldBool fn b+                    bs = SB.toByteString sb+                BS.length bs === SB.size sb+            , it "sizedFieldDouble size matches" $ property $ do+                fn <- forAll $ Gen.int (Range.linear 1 100)+                d <- forAll $ Gen.double (Range.linearFrac (-1e100) 1e100)+                let sb = sizedFieldDouble fn d+                    bs = SB.toByteString sb+                BS.length bs === SB.size sb+            ]+      ]++ -- Test message type using the encode/decode typeclasses data TestMsg = TestMsg   { tmValue :: {-# UNPACK #-} !Word64@@ -391,12 +378,19 @@   instance MessageEncode TestMsg where-  buildSized msg =-    (if tmValue msg /= 0 then fieldVarint 1 (tmValue msg) else mempty)-      <> (if tmName msg /= "" then fieldString 2 (tmName msg) else mempty)-      <> (if tmActive msg then fieldBool 3 True else mempty)+  buildMessage msg =+    (if tmValue msg /= 0 then encodeFieldVarint 1 (tmValue msg) else mempty)+      <> (if tmName msg /= "" then encodeFieldString 2 (tmName msg) else mempty)+      <> (if tmActive msg then encodeFieldBool 3 True else mempty)  +instance MessageSize TestMsg where+  messageSize msg =+    (if tmValue msg /= 0 then fieldVarintSize 1 (tmValue msg) else 0)+      + (if tmName msg /= "" then fieldTextSize 2 (tmName msg) else 0)+      + (if tmActive msg then fieldBoolSize 3 else 0)++ instance MessageDecode TestMsg where   messageDecoder = loop 0 "" False     where@@ -419,9 +413,15 @@   instance MessageEncode TestOuter where-  buildSized msg =-    (if toValue msg /= 0 then fieldVarint 1 (toValue msg) else mempty)-      <> maybe mempty (fieldMessage 2 . buildSized) (toInner msg)+  buildMessage msg =+    (if toValue msg /= 0 then encodeFieldVarint 1 (toValue msg) else mempty)+      <> maybe mempty (encodeFieldMessageSized 2) (toInner msg)+++instance MessageSize TestOuter where+  messageSize msg =+    (if toValue msg /= 0 then fieldVarintSize 1 (toValue msg) else 0)+      + maybe 0 (fieldMessageSize 2 . messageSize) (toInner msg)   instance MessageDecode TestOuter where
test-integration/Test/Schema.hs view
@@ -1,28 +1,28 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE TypeApplications #-}+ module Test.Schema (schemaTests) where  import Data.Int (Int32, Int64)-import Test.Tasty-import Test.Tasty.HUnit+import Proto.Google.Protobuf.Timestamp+import Test.Syd -import Proto.Google.Protobuf.WellKnownTypes.Timestamp -schemaTests :: TestTree-schemaTests = testGroup "Schema (generated record fields)"-  [ testCase "generated field names" $ do-      let ts = defaultTimestamp { timestampSeconds = 42, timestampNanos = 99 }-      timestampSeconds ts @?= (42 :: Int64)-      timestampNanos ts @?= (99 :: Int32)--  , testCase "default value" $ do-      timestampSeconds defaultTimestamp @?= (0 :: Int64)-      timestampNanos defaultTimestamp @?= (0 :: Int32)--  , testCase "record update" $ do-      let ts = defaultTimestamp { timestampSeconds = 100, timestampNanos = 200 }-          ts' = ts { timestampSeconds = 300 }-      timestampSeconds ts' @?= (300 :: Int64)-      timestampNanos ts' @?= (200 :: Int32)-  ]+schemaTests :: Spec+schemaTests =+  describe "Schema (generated record fields)" $+    sequence_+      [ it "generated field names" $ do+          let ts = defaultTimestamp {timestampSeconds = 42, timestampNanos = 99}+          timestampSeconds ts `shouldBe` (42 :: Int64)+          timestampNanos ts `shouldBe` (99 :: Int32)+      , it "default value" $ do+          timestampSeconds defaultTimestamp `shouldBe` (0 :: Int64)+          timestampNanos defaultTimestamp `shouldBe` (0 :: Int32)+      , it "record update" $ do+          let ts = defaultTimestamp {timestampSeconds = 100, timestampNanos = 200}+              ts' = ts {timestampSeconds = 300}+          timestampSeconds ts' `shouldBe` (300 :: Int64)+          timestampNanos ts' `shouldBe` (200 :: Int32)+      ]
test-integration/Test/StreamCodec.hs view
@@ -7,230 +7,236 @@ import Hedgehog import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range-import Proto (MessageDecode (..))+import Proto.Decode (MessageDecode (..)) import Proto.Decode.Stream (   IDecode (..),   decodeMessageIncremental,   decodeMessageLazy,   decodeMessageStream,  )-import Proto (MessageEncode (..), encodeMessage, encodeMessageLazy, encodeMessageStream, encodeMessageStreamSized)-import Proto.Internal.Encode (fieldBool, fieldString, fieldVarint)+import Proto.Encode (MessageEncode (..), MessageSize (..), encodeMessage, encodeMessageLazy, encodeMessageSized, encodeMessageStream, encodeMessageStreamSized) import Proto.Internal.Wire (Tag (..), WireType (..)) import Proto.Internal.Wire.Decode (DecodeError (..), Decoder, getTagOr, getText, getVarint, skipField)-import Proto.Internal.Wire.Encode (putVarint)-import Test.Tasty-import Test.Tasty.HUnit hiding (assert)-import Test.Tasty.Hedgehog+import Proto.Internal.Wire.Encode (fieldBoolSize, fieldTextSize, fieldVarintSize, putTag, putText, putVarint)+import Test.Syd+import Test.Syd.Hedgehog () import Wireform.Builder qualified as B  -streamCodecTests :: TestTree+streamCodecTests :: Spec streamCodecTests =-  testGroup+  describe     "Streaming & Lazy Codecs"-    [ lazyEncodeTests-    , lazyDecodeTests-    , streamRoundtripTests-    , incrementalDecodeTests-    ]+    $ sequence_+      [ lazyEncodeTests+      , lazyDecodeTests+      , streamRoundtripTests+      , incrementalDecodeTests+      ]   -- ----------------------------------------------------------------------- -- Lazy single-message encoding -- ----------------------------------------------------------------------- -lazyEncodeTests :: TestTree+lazyEncodeTests :: Spec lazyEncodeTests =-  testGroup+  describe     "Lazy encoding"-    [ testProperty "encodeMessageLazy matches strict" $ property $ do-        msg <- genSMsg-        BL.toStrict (encodeMessageLazy msg) === encodeMessage msg-    , testProperty "encodeMessageLazy matches encodeMessageLazy" $ property $ do-        msg <- genSMsg-        encodeMessageLazy msg === encodeMessageLazy msg-    ]+    $ sequence_+      [ it "encodeMessageLazy matches strict" $ property $ do+          msg <- genSMsg+          BL.toStrict (encodeMessageLazy msg) === encodeMessage msg+      , it "encodeMessageLazy matches strict" $ property $ do+          msg <- genSMsg+          BL.toStrict (encodeMessageLazy msg) === encodeMessageSized msg+      , it "encodeMessageLazy matches encodeMessageLazy" $ property $ do+          msg <- genSMsg+          encodeMessageLazy msg === encodeMessageLazy msg+      ]   -- ----------------------------------------------------------------------- -- Lazy single-message decoding -- ----------------------------------------------------------------------- -lazyDecodeTests :: TestTree+lazyDecodeTests :: Spec lazyDecodeTests =-  testGroup+  describe     "Lazy decoding"-    [ testProperty "decodeMessageLazy roundtrip" $ property $ do-        msg <- genSMsg-        let lbs = encodeMessageLazy msg-        decodeMessageLazy lbs === Right msg-    , testCase "decodeMessageLazy empty" $ do-        let lbs = BL.empty-        decodeMessageLazy lbs @?= Right (SMsg 0 "" False)-    , testCase "decodeMessageLazy multi-chunk" $ do-        let strict = encodeMessage (SMsg 42 "hello" True)-            (a, b) = BS.splitAt (BS.length strict `div` 2) strict-            lbs = BL.fromChunks [a, b]-        decodeMessageLazy lbs @?= Right (SMsg 42 "hello" True)-    ]+    $ sequence_+      [ it "decodeMessageLazy roundtrip" $ property $ do+          msg <- genSMsg+          let lbs = encodeMessageLazy msg+          decodeMessageLazy lbs === Right msg+      , it "decodeMessageLazy empty" $ do+          let lbs = BL.empty+          decodeMessageLazy lbs `shouldBe` Right (SMsg 0 "" False)+      , it "decodeMessageLazy multi-chunk" $ do+          let strict = encodeMessage (SMsg 42 "hello" True)+              (a, b) = BS.splitAt (BS.length strict `div` 2) strict+              lbs = BL.fromChunks [a, b]+          decodeMessageLazy lbs `shouldBe` Right (SMsg 42 "hello" True)+      ]   -- ----------------------------------------------------------------------- -- Stream framing roundtrip -- ----------------------------------------------------------------------- -streamRoundtripTests :: TestTree+streamRoundtripTests :: Spec streamRoundtripTests =-  testGroup+  describe     "Stream framing roundtrip"-    [ testProperty "stream roundtrip (no size)" $ property $ do-        msgs <- forAll $ Gen.list (Range.linear 0 20) genSMsg'-        let encoded = encodeMessageStream msgs-            decoded = decodeMessageStream encoded-        fmap fromRight' decoded === msgs-    , testProperty "stream roundtrip (sized)" $ property $ do-        msgs <- forAll $ Gen.list (Range.linear 0 20) genSMsg'-        let encoded = encodeMessageStreamSized msgs-            decoded = decodeMessageStream encoded-        fmap fromRight' decoded === msgs-    , testProperty "sized stream matches non-sized stream" $ property $ do-        msgs <- forAll $ Gen.list (Range.linear 0 20) genSMsg'-        encodeMessageStreamSized msgs === encodeMessageStream msgs-    , testCase "empty stream" $ do-        let encoded = encodeMessageStream ([] :: [SMsg])-        BL.null encoded @?= True-        decodeMessageStream @SMsg encoded @?= []-    , testCase "single-message stream" $ do-        let msg = SMsg 99 "solo" True-            encoded = encodeMessageStream [msg]-            decoded = decodeMessageStream encoded-        decoded @?= [Right msg]-    , testCase "stream decode truncated length" $ do-        let lbs = BL.pack [0x80]-        case decodeMessageStream @SMsg lbs of-          [Left UnexpectedEnd] -> pure ()-          other -> assertFailure ("Expected [Left UnexpectedEnd], got: " <> show other)-    , testCase "stream decode truncated payload" $ do-        let lbs = BL.pack [0x0A, 0x01]-        case decodeMessageStream @SMsg lbs of-          [Left UnexpectedEnd] -> pure ()-          other -> assertFailure ("Expected [Left UnexpectedEnd], got: " <> show other)-    , testProperty "stream framing matches manual framing" $ property $ do-        msgs <- forAll $ Gen.list (Range.linear 1 10) genSMsg'-        let autoFramed = encodeMessageStream msgs-            manualFramed = BL.fromChunks $ do-              msg <- msgs-              let payload = encodeMessage msg-              pure $ buildToBS (putVarint (fromIntegral (BS.length payload)) <> B.byteString payload)-        autoFramed === BL.fromStrict (BL.toStrict manualFramed)-    ]+    $ sequence_+      [ it "stream roundtrip (no size)" $ property $ do+          msgs <- forAll $ Gen.list (Range.linear 0 20) genSMsg'+          let encoded = encodeMessageStream msgs+              decoded = decodeMessageStream encoded+          fmap fromRight' decoded === msgs+      , it "stream roundtrip (sized)" $ property $ do+          msgs <- forAll $ Gen.list (Range.linear 0 20) genSMsg'+          let encoded = encodeMessageStreamSized msgs+              decoded = decodeMessageStream encoded+          fmap fromRight' decoded === msgs+      , it "sized stream matches non-sized stream" $ property $ do+          msgs <- forAll $ Gen.list (Range.linear 0 20) genSMsg'+          encodeMessageStreamSized msgs === encodeMessageStream msgs+      , it "empty stream" $ do+          let encoded = encodeMessageStream ([] :: [SMsg])+          BL.null encoded `shouldBe` True+          decodeMessageStream @SMsg encoded `shouldBe` []+      , it "single-message stream" $ do+          let msg = SMsg 99 "solo" True+              encoded = encodeMessageStream [msg]+              decoded = decodeMessageStream encoded+          decoded `shouldBe` [Right msg]+      , it "stream decode truncated length" $ do+          let lbs = BL.pack [0x80]+          case decodeMessageStream @SMsg lbs of+            [Left UnexpectedEnd] -> pure ()+            other -> expectationFailure ("Expected [Left UnexpectedEnd], got: " <> show other)+      , it "stream decode truncated payload" $ do+          let lbs = BL.pack [0x0A, 0x01]+          case decodeMessageStream @SMsg lbs of+            [Left UnexpectedEnd] -> pure ()+            other -> expectationFailure ("Expected [Left UnexpectedEnd], got: " <> show other)+      , it "stream framing matches manual framing" $ property $ do+          msgs <- forAll $ Gen.list (Range.linear 1 10) genSMsg'+          let autoFramed = encodeMessageStream msgs+              manualFramed = BL.fromChunks $ do+                msg <- msgs+                let payload = encodeMessage msg+                pure $ buildToBS (putVarint (fromIntegral (BS.length payload)) <> B.byteString payload)+          autoFramed === BL.fromStrict (BL.toStrict manualFramed)+      ]   -- ----------------------------------------------------------------------- -- Incremental decoder -- ----------------------------------------------------------------------- -incrementalDecodeTests :: TestTree+incrementalDecodeTests :: Spec incrementalDecodeTests =-  testGroup+  describe     "Incremental decoder"-    [ testProperty "single message fed all at once" $ property $ do-        msg <- genSMsg-        let framed = frameMessage msg-        case feed decodeMessageIncremental framed of-          IDone decoded leftover -> do-            decoded === msg-            BS.null leftover === True-          other -> do-            annotate (show other)-            failure-    , testProperty "single message fed byte-by-byte" $ property $ do-        msg <- genSMsg-        let framed = frameMessage msg-            chunks = fmap BS.singleton (BS.unpack framed)-        case feedAll decodeMessageIncremental chunks of-          IDone decoded leftover -> do-            decoded === msg-            BS.null leftover === True-          other -> do-            annotate (show other)-            failure-    , testProperty "preserves leftover bytes" $ property $ do-        msg <- genSMsg-        extra <- forAll $ Gen.bytes (Range.linear 1 50)-        let framed = frameMessage msg <> extra-        case feed decodeMessageIncremental framed of-          IDone decoded leftover -> do-            decoded === msg-            leftover === extra-          other -> do-            annotate (show other)-            failure-    , testProperty "two messages fed together" $ property $ do-        msg1 <- genSMsg-        msg2 <- genSMsg-        let framed = frameMessage msg1 <> frameMessage msg2-        case feed decodeMessageIncremental framed of-          IDone decoded1 leftover1 -> do-            decoded1 === msg1-            case feed decodeMessageIncremental leftover1 of-              IDone decoded2 leftover2 -> do-                decoded2 === msg2-                BS.null leftover2 === True-              other -> do-                annotate ("second: " <> show other)-                failure-          other -> do-            annotate ("first: " <> show other)-            failure-    , testProperty "split at arbitrary byte boundary" $ property $ do-        msg <- genSMsg-        let framed = frameMessage msg-        splitPos <- forAll $ Gen.int (Range.linear 0 (BS.length framed))-        let (chunk1, chunk2) = BS.splitAt splitPos framed-            dec0 = feed decodeMessageIncremental chunk1-        case dec0 of-          IDone decoded _ -> decoded === msg-          IPartial _ ->-            case feed dec0 chunk2 of-              IDone decoded leftover -> do-                decoded === msg-                BS.null leftover === True-              other -> do-                annotate (show other)-                failure-          other -> do-            annotate (show other)-            failure-    , testCase "empty message" $ do-        let framed = BS.singleton 0-        case feed decodeMessageIncremental framed of-          IDone decoded leftover -> do-            decoded @?= SMsg 0 "" False-            BS.null leftover @?= True-          other -> assertFailure (show other)-    , testCase "Nothing at start yields IFail" $ do-        case decodeMessageIncremental @SMsg of-          IPartial k -> case k Nothing of-            IFail UnexpectedEnd _ -> pure ()-            other -> assertFailure ("Expected IFail UnexpectedEnd, got: " <> show other)-          other -> assertFailure ("Expected IPartial, got: " <> show other)-    , testCase "truncated varint" $ do-        let chunk = BS.pack [0x80, 0x80]-        case feed decodeMessageIncremental chunk of-          IPartial k -> case k Nothing of-            IFail UnexpectedEnd _ -> pure ()-            other -> assertFailure ("Expected IFail UnexpectedEnd, got: " <> show (other :: IDecode SMsg))-          other -> assertFailure ("Expected IPartial, got: " <> show (other :: IDecode SMsg))-    , testCase "truncated payload" $ do-        let chunk = BS.pack [0x0A, 0x01]-        case feed decodeMessageIncremental chunk of-          IPartial k -> case k Nothing of-            IFail UnexpectedEnd _ -> pure ()-            other -> assertFailure ("Expected IFail, got: " <> show (other :: IDecode SMsg))-          other -> assertFailure ("Expected IPartial, got: " <> show (other :: IDecode SMsg))-    ]+    $ sequence_+      [ it "single message fed all at once" $ property $ do+          msg <- genSMsg+          let framed = frameMessage msg+          case feed decodeMessageIncremental framed of+            IDone decoded leftover -> do+              decoded === msg+              BS.null leftover === True+            other -> do+              annotate (show other)+              failure+      , it "single message fed byte-by-byte" $ property $ do+          msg <- genSMsg+          let framed = frameMessage msg+              chunks = fmap BS.singleton (BS.unpack framed)+          case feedAll decodeMessageIncremental chunks of+            IDone decoded leftover -> do+              decoded === msg+              BS.null leftover === True+            other -> do+              annotate (show other)+              failure+      , it "preserves leftover bytes" $ property $ do+          msg <- genSMsg+          extra <- forAll $ Gen.bytes (Range.linear 1 50)+          let framed = frameMessage msg <> extra+          case feed decodeMessageIncremental framed of+            IDone decoded leftover -> do+              decoded === msg+              leftover === extra+            other -> do+              annotate (show other)+              failure+      , it "two messages fed together" $ property $ do+          msg1 <- genSMsg+          msg2 <- genSMsg+          let framed = frameMessage msg1 <> frameMessage msg2+          case feed decodeMessageIncremental framed of+            IDone decoded1 leftover1 -> do+              decoded1 === msg1+              case feed decodeMessageIncremental leftover1 of+                IDone decoded2 leftover2 -> do+                  decoded2 === msg2+                  BS.null leftover2 === True+                other -> do+                  annotate ("second: " <> show other)+                  failure+            other -> do+              annotate ("first: " <> show other)+              failure+      , it "split at arbitrary byte boundary" $ property $ do+          msg <- genSMsg+          let framed = frameMessage msg+          splitPos <- forAll $ Gen.int (Range.linear 0 (BS.length framed))+          let (chunk1, chunk2) = BS.splitAt splitPos framed+              dec0 = feed decodeMessageIncremental chunk1+          case dec0 of+            IDone decoded _ -> decoded === msg+            IPartial _ ->+              case feed dec0 chunk2 of+                IDone decoded leftover -> do+                  decoded === msg+                  BS.null leftover === True+                other -> do+                  annotate (show other)+                  failure+            other -> do+              annotate (show other)+              failure+      , it "empty message" $ do+          let framed = BS.singleton 0+          case feed decodeMessageIncremental framed of+            IDone decoded leftover -> do+              decoded `shouldBe` SMsg 0 "" False+              BS.null leftover `shouldBe` True+            other -> expectationFailure (show other)+      , it "Nothing at start yields IFail" $ do+          case decodeMessageIncremental @SMsg of+            IPartial k -> case k Nothing of+              IFail UnexpectedEnd _ -> pure ()+              other -> expectationFailure ("Expected IFail UnexpectedEnd, got: " <> show other)+            other -> expectationFailure ("Expected IPartial, got: " <> show other)+      , it "truncated varint" $ do+          let chunk = BS.pack [0x80, 0x80]+          case feed decodeMessageIncremental chunk of+            IPartial k -> case k Nothing of+              IFail UnexpectedEnd _ -> pure ()+              other -> expectationFailure ("Expected IFail UnexpectedEnd, got: " <> show (other :: IDecode SMsg))+            other -> expectationFailure ("Expected IPartial, got: " <> show (other :: IDecode SMsg))+      , it "truncated payload" $ do+          let chunk = BS.pack [0x0A, 0x01]+          case feed decodeMessageIncremental chunk of+            IPartial k -> case k Nothing of+              IFail UnexpectedEnd _ -> pure ()+              other -> expectationFailure ("Expected IFail, got: " <> show (other :: IDecode SMsg))+            other -> expectationFailure ("Expected IPartial, got: " <> show (other :: IDecode SMsg))+      ]   -- -----------------------------------------------------------------------@@ -250,10 +256,17 @@   instance MessageEncode SMsg where-  buildSized msg =-    (if smValue msg /= 0 then fieldVarint 1 (smValue msg) else mempty)-      <> (if smName msg /= "" then fieldString 2 (smName msg) else mempty)-      <> (if smActive msg then fieldBool 3 (smActive msg) else mempty)+  buildMessage msg =+    (if smValue msg /= 0 then putTag 1 WireVarint <> putVarint (smValue msg) else mempty)+      <> (if smName msg /= "" then putTag 2 WireLengthDelimited <> putText (smName msg) else mempty)+      <> (if smActive msg then putTag 3 WireVarint <> putVarint 1 else mempty)+++instance MessageSize SMsg where+  messageSize msg =+    (if smValue msg /= 0 then fieldVarintSize 1 (smValue msg) else 0)+      + (if smName msg /= "" then fieldTextSize 2 (smName msg) else 0)+      + (if smActive msg then fieldBoolSize 3 else 0)   instance MessageDecode SMsg where
test-integration/Test/TDP.hs view
@@ -15,834 +15,646 @@ import Hedgehog import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range-import Proto (decodeMessage, DecodeError (..))-import Proto.Dynamic-import Proto.Internal.Dynamic (FieldParser (..), FieldThunk, ParseTable (..))-import Proto (encodeMessage)-import Proto.Internal.Decode (-  decodeMapEntry,-  decodePackedDouble,-  decodePackedFixed32,-  decodePackedFixed64,-  decodePackedFloat,-  decodePackedSVarint32,-  decodePackedSVarint64,-  decodePackedVarint,- )-import Proto.Internal.Encode (-  MessageEncode (..),-  encodePackedDouble,-  encodePackedFixed32,-  encodePackedFixed64,-  encodePackedFloat,-  encodePackedSVarint32,-  encodePackedSVarint64,-  encodePackedWord64,-  fieldBool,-  fieldString,-  fieldVarint,- )-import Proto.Internal.SizedBuilder qualified as SB-import Proto.Internal.Wire (Tag (..), WireType (..), fieldTag)-import Proto.Internal.Wire.Decode (-  DecodeResult (..),-  getFixed32,-  getFixed64,-  getLengthDelimited,-  getTag,-  getText,-  getVarint,-  runDecoder,-  runDecoder',-  skipWireType,-  withTagM,- )-import Proto.Internal.Wire.Encode-import Proto.Schema-import Test.Tasty-import Test.Tasty.HUnit hiding (assert)-import Test.Tasty.Hedgehog-import Wireform.Builder qualified as B-import Wireform.FFI (countPackedVarints, packedAllSingleByte, validateUtf8SWAR)---dynamicSchemaTests :: TestTree-dynamicSchemaTests =-  testGroup-    "Dynamic Schema-Driven Decoder"-    [ coreTests-    , compileTests-    , schemalessTests-    , streamingTests-    , errorHandlingTests-    , wireFFITests-    , packedTests-    , utf8Tests-    , withTagMTests-    ]----- ============================================================--- TDP core interpreter tests--- ============================================================--coreTests :: TestTree-coreTests =-  testGroup-    "Core interpreter"-    [ testCase "empty message" $ do-        let result = decodeDynamicWithSchema emptyTable BS.empty-        case result of-          Right msg -> IntMap.null (dynFields msg) @?= True-          Left e -> assertFailure (show e)-    , testCase "single varint field" $ do-        let bs = buildToBS $ putTag 1 WireVarint <> putVarint 42-            result = decodeDynamicWithSchema testSimpleTable bs-        case result of-          Right msg -> do-            case IntMap.lookup 1 (dynFields msg) of-              Just (DynVarint 42) -> pure ()-              other -> assertFailure ("Expected DynVarint 42, got: " <> show other)-          Left e -> assertFailure (show e)-    , testCase "multiple fields in order" $ do-        let bs =-              buildToBS $-                putTag 1 WireVarint-                  <> putVarint 100-                  <> putTag 2 WireLengthDelimited-                  <> putText "hello"-                  <> putTag 3 WireVarint-                  <> putVarint 1-            result = decodeDynamicWithSchema testMultiTable bs-        case result of-          Right msg -> do-            IntMap.lookup 1 (dynFields msg) @?= Just (DynVarint 100)-            IntMap.lookup 2 (dynFields msg) @?= Just (DynBytes (buildToBS (B.byteString "hello")))-            IntMap.lookup 3 (dynFields msg) @?= Just (DynVarint 1)-          Left e -> assertFailure (show e)-    , testCase "fields out of order" $ do-        let bs =-              buildToBS $-                putTag 3 WireVarint-                  <> putVarint 99-                  <> putTag 1 WireVarint-                  <> putVarint 42-            result = decodeDynamicWithSchema testMultiTable bs-        case result of-          Right msg -> do-            IntMap.lookup 1 (dynFields msg) @?= Just (DynVarint 42)-            IntMap.lookup 3 (dynFields msg) @?= Just (DynVarint 99)-          Left e -> assertFailure (show e)-    , testCase "unknown fields are skipped" $ do-        let bs =-              buildToBS $-                putTag 1 WireVarint-                  <> putVarint 42-                  <> putTag 99 WireVarint-                  <> putVarint 999-                  <> putTag 2 WireLengthDelimited-                  <> putText "hi"-            result = decodeDynamicWithSchema testMultiTable bs-        case result of-          Right msg -> do-            IntMap.lookup 1 (dynFields msg) @?= Just (DynVarint 42)-            IntMap.member 99 (dynFields msg) @?= False-          Left e -> assertFailure (show e)-    , testCase "last value wins for scalar fields" $ do-        let bs =-              buildToBS $-                putTag 1 WireVarint-                  <> putVarint 10-                  <> putTag 1 WireVarint-                  <> putVarint 20-            result = decodeDynamicWithSchema testSimpleTable bs-        case result of-          Right msg ->-            IntMap.lookup 1 (dynFields msg) @?= Just (DynVarint 20)-          Left e -> assertFailure (show e)-    , testCase "fixed32 field" $ do-        let bs = buildToBS $ putTag 1 Wire32Bit <> putFixed32 0xDEADBEEF-            table = makeSimpleTable 1 Wire32Bit (thunkFixed32Pub DynFixed32)-            result = decodeDynamicWithSchema table bs-        case result of-          Right msg ->-            IntMap.lookup 1 (dynFields msg) @?= Just (DynFixed32 0xDEADBEEF)-          Left e -> assertFailure (show e)-    , testCase "fixed64 field" $ do-        let bs = buildToBS $ putTag 1 Wire64Bit <> putFixed64 0xCAFEBABEDEADBEEF-            table = makeSimpleTable 1 Wire64Bit (thunkFixed64Pub DynFixed64)-            result = decodeDynamicWithSchema table bs-        case result of-          Right msg ->-            IntMap.lookup 1 (dynFields msg) @?= Just (DynFixed64 0xCAFEBABEDEADBEEF)-          Left e -> assertFailure (show e)-    , testProperty "varint field roundtrip through TDP" $ property $ do-        val <- forAll $ Gen.word64 (Range.linear 0 maxBound)-        let bs = buildToBS $ putTag 1 WireVarint <> putVarint val-            result = decodeDynamicWithSchema testSimpleTable bs-        case result of-          Right msg ->-            IntMap.lookup 1 (dynFields msg) === Just (DynVarint val)-          Left e -> do-            annotate (show e)-            failure-    , testProperty "multiple varint fields roundtrip" $ property $ do-        v1 <- forAll $ Gen.word64 (Range.linear 0 maxBound)-        v2 <- forAll $ Gen.word64 (Range.linear 0 maxBound)-        v3 <- forAll $ Gen.word64 (Range.linear 0 maxBound)-        let bs =-              buildToBS $-                putTag 1 WireVarint-                  <> putVarint v1-                  <> putTag 2 WireVarint-                  <> putVarint v2-                  <> putTag 3 WireVarint-                  <> putVarint v3-            result = decodeDynamicWithSchema testThreeVarintTable bs-        case result of-          Right msg -> do-            IntMap.lookup 1 (dynFields msg) === Just (DynVarint v1)-            IntMap.lookup 2 (dynFields msg) === Just (DynVarint v2)-            IntMap.lookup 3 (dynFields msg) === Just (DynVarint v3)-          Left e -> do-            annotate (show e)-            failure-    ]----- ============================================================--- Compile from schema tests--- ============================================================--compileTests :: TestTree-compileTests =-  testGroup-    "Compilation from schema"-    [ testCase "compileParseTable produces non-empty table" $ do-        let table = compileParseTable (Proxy :: Proxy TestSchemaMsg)-        V.length (ptFields table) @?= 3-        BS.length (ptTagLUT table) @?= 128-    , testCase "TagLUT has entries for small field numbers" $ do-        let table = compileParseTable (Proxy :: Proxy TestSchemaMsg)-            -- Field 1, varint: tag = 0x08-            lut08 = BS.index (ptTagLUT table) 0x08-            -- Field 2, length-delimited: tag = 0x12-            lut12 = BS.index (ptTagLUT table) 0x12-        lut08 /= 0xFF @?= True-        lut12 /= 0xFF @?= True-    , testCase "compiled table decodes matching wire data" $ do-        let table = compileParseTable (Proxy :: Proxy TestSchemaMsg)-            bs =-              buildToBS $-                putTag 1 WireVarint-                  <> putVarint 42-                  <> putTag 2 WireLengthDelimited-                  <> putText "test"-                  <> putTag 3 WireVarint-                  <> putVarint 1-            result = decodeDynamicWithSchema table bs-        case result of-          Right msg -> do-            IntMap.lookup 1 (dynFields msg) @?= Just (DynVarint 42)-            IntMap.lookup 3 (dynFields msg) @?= Just (DynBool True)-          Left e -> assertFailure (show e)-    , testProperty "compiled table roundtrips with encodeMessage" $ property $ do-        val <- forAll $ Gen.word64 (Range.linear 0 1000)-        name <- forAll $ Gen.text (Range.linear 0 50) Gen.alphaNum-        active <- forAll Gen.bool-        let msg = TestSchemaMsg val name active-            encoded = encodeMessage msg-            table = compileParseTable (Proxy :: Proxy TestSchemaMsg)-            result = decodeDynamicWithSchema table encoded-        case result of-          Right tdpMsg -> do-            case IntMap.lookup 1 (dynFields tdpMsg) of-              Just (DynVarint v) -> v === val-              Nothing | val == 0 -> success-              other -> do-                annotate ("field 1: " <> show other)-                failure-          Left e -> do-            annotate (show e)-            failure-    ]----- ============================================================--- Schemaless (decodeDynamic / decodeRaw) tests--- ============================================================--schemalessTests :: TestTree-schemalessTests =-  testGroup-    "Schemaless decoder (decodeDynamic)"-    [ testCase "empty bytes" $ do-        decodeDynamic BS.empty @?= Right emptyDynamic-    , testCase "single varint field" $ do-        let bs = buildToBS $ putTag 1 WireVarint <> putVarint 99-        case decodeDynamic bs of-          Right msg -> IntMap.lookup 1 (dynFields msg) @?= Just (DynVarint 99)-          Left e -> assertFailure (show e)-    , testCase "string field decoded as bytes" $ do-        let bs = buildToBS $ putTag 2 WireLengthDelimited <> putText "hello"-        case decodeDynamic bs of-          Right msg -> case IntMap.lookup 2 (dynFields msg) of-            Just (DynBytes _) -> pure ()-            other -> assertFailure ("Expected DynBytes, got: " <> show other)-          Left e -> assertFailure (show e)-    , testCase "fixed32 field" $ do-        let bs = buildToBS $ putTag 5 Wire32Bit <> putFixed32 0x12345678-        case decodeDynamic bs of-          Right msg -> IntMap.lookup 5 (dynFields msg) @?= Just (DynFixed32 0x12345678)-          Left e -> assertFailure (show e)-    , testCase "repeated field accumulates" $ do-        let bs =-              buildToBS $-                putTag 1 WireVarint <> putVarint 10-                  <> putTag 1 WireVarint <> putVarint 20-        case decodeDynamic bs of-          Right msg -> case IntMap.lookup 1 (dynFields msg) of-            Just (DynRepeated [DynVarint 10, DynVarint 20]) -> pure ()-            other -> assertFailure ("Expected DynRepeated, got: " <> show other)-          Left e -> assertFailure (show e)-    , testProperty "encode/decode roundtrip" $ property $ do-        val <- forAll $ Gen.word64 (Range.linear 0 maxBound)-        let bs = buildToBS $ putTag 1 WireVarint <> putVarint val-        case decodeDynamic bs of-          Right msg -> IntMap.lookup 1 (dynFields msg) === Just (DynVarint val)-          Left _ -> failure-    , testProperty "encodeDynamic . decodeDynamic is identity on varint fields" $ property $ do-        val <- forAll $ Gen.word64 (Range.linear 1 maxBound)-        let msg = DynamicMessage (IntMap.singleton 1 (DynVarint val)) []-            encoded = encodeDynamic msg-        case decodeDynamic encoded of-          Right msg2 -> IntMap.lookup 1 (dynFields msg2) === Just (DynVarint val)-          Left _ -> failure-    , testCase "decodeDynamicWithSchema empty table falls back to raw decode" $ do-        let bs = buildToBS $ putTag 1 WireVarint <> putVarint 77-            result = decodeDynamicWithSchema (ParseTable V.empty (BS.replicate 128 0xFF) IntMap.empty 0) bs-        case result of-          Right msg -> IntMap.lookup 1 (dynFields msg) @?= Just (DynVarint 77)-          Left e -> assertFailure (show e)-    ]----- ============================================================--- Streaming decode tests--- ============================================================--streamingTests :: TestTree-streamingTests =-  testGroup-    "Streaming decode (decodeDynamicStream)"-    [ testCase "empty input yields no messages" $-        decodeDynamicStream BS.empty @?= []-    , testCase "single framed message" $ do-        let payload = buildToBS $ putTag 1 WireVarint <> putVarint 42-            frame = buildToBS $ putVarint (fromIntegral (BS.length payload)) <> B.byteString payload-        case decodeDynamicStream frame of-          [Right msg] -> IntMap.lookup 1 (dynFields msg) @?= Just (DynVarint 42)-          other -> assertFailure ("Expected [Right msg], got: " <> show (length other) <> " results")-    , testCase "multiple framed messages" $ do-        let mkFrame bs = buildToBS $ putVarint (fromIntegral (BS.length bs)) <> B.byteString bs-            p1 = buildToBS $ putTag 1 WireVarint <> putVarint 10-            p2 = buildToBS $ putTag 2 WireVarint <> putVarint 20-            frames = mkFrame p1 <> mkFrame p2-        case decodeDynamicStream frames of-          [Right m1, Right m2] -> do-            IntMap.lookup 1 (dynFields m1) @?= Just (DynVarint 10)-            IntMap.lookup 2 (dynFields m2) @?= Just (DynVarint 20)-          results -> assertFailure ("Expected 2 results, got: " <> show (length results))-    , testCase "empty framed message" $ do-        let frame = buildToBS $ putVarint 0-        case decodeDynamicStream frame of-          [Right msg] -> IntMap.null (dynFields msg) @?= True-          other -> assertFailure ("Expected [Right emptyDynamic], got: " <> show (length other))-    , testCase "truncated frame returns Left" $ do-        let frame = buildToBS $ putVarint 100  -- claims 100 bytes but provides 0-        case decodeDynamicStream frame of-          [Left _] -> pure ()-          other -> assertFailure ("Expected [Left error], got: " <> show (length other))-    , testProperty "stream roundtrip: N messages encode/decode" $ property $ do-        vals <- forAll $ Gen.list (Range.linear 0 10) (Gen.word64 (Range.linear 0 maxBound))-        let mkFrame v =-              let payload = buildToBS $ putTag 1 WireVarint <> putVarint v-              in buildToBS $ putVarint (fromIntegral (BS.length payload)) <> B.byteString payload-            frames = BS.concat (fmap mkFrame vals)-            results = decodeDynamicStream frames-        length results === length vals-        sequence_ $ zipWith (\v r -> case r of-          Right msg -> IntMap.lookup 1 (dynFields msg) === Just (DynVarint v)-          Left _ -> failure) vals results-    , testCase "lazy stream equivalent to strict" $ do-        let payload = buildToBS $ putTag 1 WireVarint <> putVarint 42-            frame = buildToBS $ putVarint (fromIntegral (BS.length payload)) <> B.byteString payload-        decodeDynamicStreamLazy (BL.fromStrict frame) @?= decodeDynamicStream frame-    , testCase "schema-driven stream decodes correctly" $ do-        let table = compileParseTable (Proxy :: Proxy TestSchemaMsg)-            payload = encodeMessage (TestSchemaMsg 99 "x" False)-            frame = buildToBS $ putVarint (fromIntegral (BS.length payload)) <> B.byteString payload-        case decodeDynamicStreamWithSchema table frame of-          [Right msg] -> case IntMap.lookup 1 (dynFields msg) of-            Just (DynVarint 99) -> pure ()-            other -> assertFailure ("Expected DynVarint 99, got: " <> show other)-          other -> assertFailure ("Expected [Right msg], got: " <> show (length other))-    ]----- ============================================================--- Error handling tests--- ============================================================--errorHandlingTests :: TestTree-errorHandlingTests =-  testGroup-    "Error handling"-    [ testCase "truncated varint returns Left, not crash" $ do-        -- A varint with continuation bit set but no next byte-        let bs = BS.pack [0x80]-            table = makeSimpleTable 1 WireVarint (thunkVarintPub DynVarint)-        -- Should either succeed (skip malformed) or return Left; must NOT crash-        case decodeDynamicWithSchema table bs of-          Right _ -> pure ()  -- skipped gracefully-          Left _ -> pure ()   -- propagated as error-    , testCase "truncated length-delimited field returns Left" $ do-        -- Tag says 100-byte payload but only 3 bytes follow-        let bs = buildToBS $ putTag 2 WireLengthDelimited <> putVarint 100 <> B.byteString "hi"-        case decodeDynamic bs of-          Right _ -> pure ()  -- raw decoder skips gracefully-          Left _ -> pure ()-    , testCase "decodeDynamic on garbage bytes does not crash" $ do-        let bs = BS.pack [0xFF, 0xFE, 0xFD, 0xFC]-        case decodeDynamic bs of-          Right _ -> pure ()-          Left _ -> pure ()-    , testCase "malformed UTF-8 in string field returns Left" $ do-        let badUtf8 = BS.pack [0xFF, 0xFE]-            bs = buildToBS $ putTag 1 WireLengthDelimited <> putVarint 2 <> B.byteString badUtf8-            -- String thunk rejects invalid UTF-8-            table = makeSimpleTable 1 WireLengthDelimited-              (thunkLenDelimPub (\b -> if b == badUtf8 then Left InvalidUtf8 else Right (DynBytes b)))-        case decodeDynamicWithSchema table bs of-          Left InvalidUtf8 -> pure ()-          Left _ -> pure ()  -- some other error is also fine-          Right _ -> pure ()  -- raw bytes thunk would succeed; depends on thunk-    , testProperty "decodeDynamic never crashes on arbitrary bytes" $ property $ do-        bs <- forAll $ Gen.bytes (Range.linear 0 200)-        case decodeDynamic bs of-          Right _ -> success-          Left _ -> success-    , testProperty "decodeDynamicWithSchema never crashes on arbitrary bytes" $ property $ do-        bs <- forAll $ Gen.bytes (Range.linear 0 200)-        let table = compileParseTable (Proxy :: Proxy TestSchemaMsg)-        case decodeDynamicWithSchema table bs of-          Right _ -> success-          Left _ -> success-    ]----- ============================================================--- Wire FFI tests (SWAR routines)--- ============================================================--wireFFITests :: TestTree-wireFFITests =-  testGroup-    "Wire FFI (SWAR)"-    [ testCase "countPackedVarints empty" $-        countPackedVarints BS.empty @?= 0-    , testCase "countPackedVarints single byte" $-        countPackedVarints (BS.pack [42]) @?= 1-    , testCase "countPackedVarints all single byte" $-        countPackedVarints (BS.pack [0, 1, 2, 3, 4, 5, 6, 7]) @?= 8-    , testCase "countPackedVarints two-byte varints" $-        countPackedVarints (BS.pack [0x80, 0x01, 0x80, 0x02]) @?= 2-    , testCase "countPackedVarints mixed" $-        countPackedVarints (BS.pack [42, 0x80, 0x01, 99]) @?= 3-    , testProperty "countPackedVarints matches manual count" $ property $ do-        vals <- forAll $ Gen.list (Range.linear 0 100) (Gen.word64 (Range.linear 0 0xFFFF))-        let encoded = BL.toStrict $ B.toLazyByteString $ foldMap putVarint vals-            expected = length vals-        countPackedVarints encoded === expected-    , testCase "packedAllSingleByte empty" $-        packedAllSingleByte BS.empty @?= True-    , testCase "packedAllSingleByte all small" $-        packedAllSingleByte (BS.pack [0, 1, 42, 127]) @?= True-    , testCase "packedAllSingleByte has continuation" $-        packedAllSingleByte (BS.pack [0, 0x80, 1]) @?= False-    , testProperty "packedAllSingleByte correct for small values" $ property $ do-        vals <- forAll $ Gen.list (Range.linear 0 200) (Gen.word8 (Range.linear 0 127))-        let bs = BS.pack vals-        packedAllSingleByte bs === True-    , testProperty "packedAllSingleByte false when large varint present" $ property $ do-        vals <- forAll $ Gen.list (Range.linear 1 50) (Gen.word64 (Range.linear 128 0xFFFF))-        let encoded = BL.toStrict $ B.toLazyByteString $ foldMap putVarint vals-        packedAllSingleByte encoded === False-    ]----- ============================================================--- Packed field decode tests (zero-copy, bulk memcpy paths)--- ============================================================--packedTests :: TestTree-packedTests =-  testGroup-    "Packed field optimizations"-    [ testProperty "packed varint single-byte fast path" $ property $ do-        vals <- forAll $ Gen.list (Range.linear 0 200) (Gen.word64 (Range.linear 0 127))-        let vec = VU.fromList vals-            encoded = SB.toByteString (encodePackedWord64 1 vec)-        if VU.null vec-          then assert (BS.null encoded)-          else case runDecoder (getTag >> decodePackedVarint) encoded of-            Left e -> do-              annotate (show e)-              failure-            Right decoded -> VU.toList decoded === vals-    , testProperty "packed varint multi-byte values" $ property $ do-        vals <- forAll $ Gen.list (Range.linear 0 100) (Gen.word64 (Range.linear 128 0xFFFFFFFF))-        let vec = VU.fromList vals-            encoded = SB.toByteString (encodePackedWord64 1 vec)-        if VU.null vec-          then assert (BS.null encoded)-          else case runDecoder (getTag >> decodePackedVarint) encoded of-            Left e -> do-              annotate (show e)-              failure-            Right decoded -> VU.toList decoded === vals-    , testProperty "packed fixed32 bulk memcpy path" $ property $ do-        vals <- forAll $ Gen.list (Range.linear 0 200) (Gen.word32 Range.linearBounded)-        let vec = VU.fromList vals-            encoded = SB.toByteString (encodePackedFixed32 1 vec)-        if VU.null vec-          then assert (BS.null encoded)-          else case runDecoder (getTag >> decodePackedFixed32) encoded of-            Left e -> do-              annotate (show e)-              failure-            Right decoded -> VU.toList decoded === vals-    , testProperty "packed fixed64 bulk memcpy path" $ property $ do-        vals <- forAll $ Gen.list (Range.linear 0 200) (Gen.word64 Range.linearBounded)-        let vec = VU.fromList vals-            encoded = SB.toByteString (encodePackedFixed64 1 vec)-        if VU.null vec-          then assert (BS.null encoded)-          else case runDecoder (getTag >> decodePackedFixed64) encoded of-            Left e -> do-              annotate (show e)-              failure-            Right decoded -> VU.toList decoded === vals-    , testProperty "packed float bulk memcpy path" $ property $ do-        vals <- forAll $ Gen.list (Range.linear 0 200) (Gen.float (Range.linearFrac (-1e30) 1e30))-        let vec = VU.fromList vals-            encoded = SB.toByteString (encodePackedFloat 1 vec)-        if VU.null vec-          then assert (BS.null encoded)-          else case runDecoder (getTag >> decodePackedFloat) encoded of-            Left e -> do-              annotate (show e)-              failure-            Right decoded -> VU.toList decoded === vals-    , testProperty "packed double bulk memcpy path" $ property $ do-        vals <- forAll $ Gen.list (Range.linear 0 200) (Gen.double (Range.linearFrac (-1e300) 1e300))-        let vec = VU.fromList vals-            encoded = SB.toByteString (encodePackedDouble 1 vec)-        if VU.null vec-          then assert (BS.null encoded)-          else case runDecoder (getTag >> decodePackedDouble) encoded of-            Left e -> do-              annotate (show e)-              failure-            Right decoded -> VU.toList decoded === vals-    , testProperty "packed sint32 pre-allocated path" $ property $ do-        vals <- forAll $ Gen.list (Range.linear 0 100) (Gen.int32 Range.linearBounded)-        let vec = VU.fromList vals-            encoded = SB.toByteString (encodePackedSVarint32 1 vec)-        if VU.null vec-          then assert (BS.null encoded)-          else case runDecoder (getTag >> decodePackedSVarint32) encoded of-            Left e -> do-              annotate (show e)-              failure-            Right decoded -> VU.toList decoded === vals-    , testProperty "packed sint64 pre-allocated path" $ property $ do-        vals <- forAll $ Gen.list (Range.linear 0 100) (Gen.int64 Range.linearBounded)-        let vec = VU.fromList vals-            encoded = SB.toByteString (encodePackedSVarint64 1 vec)-        if VU.null vec-          then assert (BS.null encoded)-          else case runDecoder (getTag >> decodePackedSVarint64) encoded of-            Left e -> do-              annotate (show e)-              failure-            Right decoded -> VU.toList decoded === vals-    ]----- ============================================================--- SWAR UTF-8 validation tests--- ============================================================--utf8Tests :: TestTree-utf8Tests =-  testGroup-    "SWAR UTF-8 validation"-    [ testCase "empty is valid" $-        validateUtf8SWAR BS.empty @?= True-    , testCase "ASCII is valid" $-        validateUtf8SWAR "hello world" @?= True-    , testCase "long ASCII string" $-        validateUtf8SWAR (BS.replicate 1000 0x41) @?= True-    , testCase "valid 2-byte UTF-8" $-        validateUtf8SWAR (BS.pack [0xC3, 0xA9]) @?= True -- é-    , testCase "valid 3-byte UTF-8" $-        validateUtf8SWAR (BS.pack [0xE2, 0x80, 0x99]) @?= True -- '-    , testCase "valid 4-byte UTF-8" $-        validateUtf8SWAR (BS.pack [0xF0, 0x9F, 0x98, 0x80]) @?= True -- 😀-    , testCase "invalid: bare continuation byte" $-        validateUtf8SWAR (BS.pack [0x80]) @?= False-    , testCase "invalid: overlong 2-byte" $-        validateUtf8SWAR (BS.pack [0xC0, 0xAF]) @?= False-    , testCase "invalid: surrogate" $-        validateUtf8SWAR (BS.pack [0xED, 0xA0, 0x80]) @?= False-    , testCase "invalid: truncated 2-byte" $-        validateUtf8SWAR (BS.pack [0xC3]) @?= False-    , testCase "invalid: truncated 3-byte" $-        validateUtf8SWAR (BS.pack [0xE2, 0x80]) @?= False-    , testCase "invalid: byte 0xFF" $-        validateUtf8SWAR (BS.pack [0xFF]) @?= False-    , testCase "mixed ASCII and multibyte" $-        validateUtf8SWAR "hello \xC3\xA9 world \xF0\x9F\x98\x80" @?= True-    , testProperty "all generated unicode text is valid" $ property $ do-        t <- forAll $ Gen.text (Range.linear 0 500) Gen.unicode-        let bs = encodeUtf8 t-        validateUtf8SWAR bs === True-    ]-  where-    encodeUtf8 = Data.Text.Encoding.encodeUtf8----- ============================================================--- withTagM CPS tests--- ============================================================--withTagMTests :: TestTree-withTagMTests =-  testGroup-    "withTagM CPS dispatch"-    [ testCase "withTagM at EOF returns kEOF" $ do-        let decoder = withTagM (pure True) (\_ _ -> pure False)-        runDecoder decoder BS.empty @?= Right True-    , testCase "withTagM on varint field" $ do-        let bs = buildToBS $ putTag 1 WireVarint <> putVarint 42-            decoder =-              withTagM-                (pure (0 :: Int, 0 :: Word64))-                ( \fn _wt -> do-                    val <- getVarint-                    pure (fn, val)-                )-        case runDecoder decoder bs of-          Right (fn, val) -> do-            fn @?= 1-            val @?= 42-          Left e -> assertFailure (show e)-    , testCase "withTagM dispatches correctly on wire type" $ do-        let bs = buildToBS $ putTag 5 Wire32Bit <> putFixed32 999-            decoder =-              withTagM-                (pure Nothing)-                ( \fn wt -> do-                    if wt == 5 -- Wire32Bit-                      then do-                        v <- getFixed32-                        pure (Just (fn, v))-                      else do-                        skipWireType wt-                        pure Nothing-                )-        case runDecoder decoder bs of-          Right (Just (5, 999)) -> pure ()-          other -> assertFailure ("Unexpected: " <> show other)-    , testCase "map entry decode via withTagM" $ do-        let keyEnc = putTag 1 WireVarint <> putVarint 42-            valEnc = putTag 2 WireLengthDelimited <> putText "value"-            encoded = buildToBS (keyEnc <> valEnc)-        case runDecoder (decodeMapEntry getVarint getText 0 "") encoded of-          Right (k, v) -> do-            k @?= 42-            v @?= "value"-          Left e -> assertFailure (show e)-    , testCase "map entry with reversed field order" $ do-        let valEnc = putTag 2 WireLengthDelimited <> putText "first"-            keyEnc = putTag 1 WireVarint <> putVarint 7-            encoded = buildToBS (valEnc <> keyEnc)-        case runDecoder (decodeMapEntry getVarint getText 0 "") encoded of-          Right (k, v) -> do-            k @?= 7-            v @?= "first"-          Left e -> assertFailure (show e)-    ]----- ============================================================--- Helpers--- ============================================================--buildToBS :: B.Builder -> ByteString-buildToBS = BL.toStrict . B.toLazyByteString----- | Pure thunk builders for tests — match the new FieldThunk = pure Either.-thunkVarintPub :: (Word64 -> DynamicValue) -> FieldThunk-thunkVarintPub f bs off =-  case runDecoder' getVarint bs off of-    DecodeOK v off' -> Right (f v, off')-    DecodeFail e -> Left e---thunkFixed32Pub :: (Word32 -> DynamicValue) -> FieldThunk-thunkFixed32Pub f bs off =-  case runDecoder' getFixed32 bs off of-    DecodeOK v off' -> Right (f v, off')-    DecodeFail e -> Left e---thunkFixed64Pub :: (Word64 -> DynamicValue) -> FieldThunk-thunkFixed64Pub f bs off =-  case runDecoder' getFixed64 bs off of-    DecodeOK v off' -> Right (f v, off')-    DecodeFail e -> Left e---thunkLenDelimPub :: (ByteString -> Either DecodeError DynamicValue) -> FieldThunk-thunkLenDelimPub f bs off =-  case runDecoder' getLengthDelimited bs off of-    DecodeOK v off' -> case f v of-      Right dv -> Right (dv, off')-      Left e -> Left e-    DecodeFail e -> Left e---emptyTable :: ParseTable-emptyTable = ParseTable V.empty (BS.replicate 128 0xFF) IntMap.empty 0---testSimpleTable :: ParseTable-testSimpleTable = makeSimpleTable 1 WireVarint (thunkVarintPub DynVarint)---testMultiTable :: ParseTable-testMultiTable =-  makeMultiTable-    [ (1, WireVarint, thunkVarintPub DynVarint)-    , (2, WireLengthDelimited, thunkLenDelimPub (Right . DynBytes))-    , (3, WireVarint, thunkVarintPub DynVarint)-    ]---testThreeVarintTable :: ParseTable-testThreeVarintTable =-  makeMultiTable-    [ (1, WireVarint, thunkVarintPub DynVarint)-    , (2, WireVarint, thunkVarintPub DynVarint)-    , (3, WireVarint, thunkVarintPub DynVarint)-    ]---makeSimpleTable :: Int -> WireType -> FieldThunk -> ParseTable-makeSimpleTable fn wt thunk = makeMultiTable [(fn, wt, thunk)]---makeMultiTable :: [(Int, WireType, FieldThunk)] -> ParseTable-makeMultiTable entries =-  let n = length entries-      parsers =-        V.fromList-          [ FieldParser-            { fpTag = fieldTag fn wt-            , fpFieldNum = fn-            , fpNextOk = (i + 1) `mod` n-            , fpNextErr = (i + 1) `mod` n-            , fpParse = thunk-            , fpLabel = LabelOptional-            , fpSubmsg = Nothing-            }-          | (i, (fn, wt, thunk)) <- zip [0 ..] entries-          ]-      tagMap =-        IntMap.fromList-          [ (fromIntegral (fieldTag fn wt), i)-          | (i, (fn, wt, _)) <- zip [0 ..] entries-          ]-      lut =-        BS.pack-          [ case IntMap.lookup (fromIntegral b) tagMap of-            Just idx | idx < 256 -> fromIntegral idx-            _ -> 0xFF-          | b <- [0 .. 127 :: Int]-          ]-  in ParseTable parsers lut tagMap (min 4 n)----- A test message type with ProtoMessage instance for compile tests-data TestSchemaMsg = TestSchemaMsg-  { tsmValue :: {-# UNPACK #-} !Word64-  , tsmName :: !Text-  , tsmActive :: !Bool-  }-  deriving stock (Show, Eq)---instance MessageEncode TestSchemaMsg where-  buildSized msg =-    (if tsmValue msg /= 0 then fieldVarint 1 (tsmValue msg) else mempty)-      <> (if tsmName msg /= "" then fieldString 2 (tsmName msg) else mempty)-      <> (if tsmActive msg then fieldBool 3 True else mempty)---instance ProtoMessage TestSchemaMsg where-  protoMessageName _ = "test.TestSchemaMsg"-  protoPackageName _ = "test"-  protoDefaultValue = TestSchemaMsg 0 "" False-  protoFieldDescriptors _ =-    IntMap.fromList-      [-        ( 1-        , SomeField-            FieldDescriptor-              { fdName = "value"-              , fdNumber = 1-              , fdTypeDesc = ScalarType UInt64Field-              , fdLabel = LabelOptional-              , fdGet = tsmValue-              , fdSet = \v m -> m {tsmValue = v}-              }-        )-      ,-        ( 2-        , SomeField-            FieldDescriptor-              { fdName = "name"-              , fdNumber = 2-              , fdTypeDesc = ScalarType StringField-              , fdLabel = LabelOptional-              , fdGet = tsmName-              , fdSet = \v m -> m {tsmName = v}-              }-        )-      ,-        ( 3-        , SomeField-            FieldDescriptor-              { fdName = "active"-              , fdNumber = 3-              , fdTypeDesc = ScalarType BoolField-              , fdLabel = LabelOptional-              , fdGet = tsmActive-              , fdSet = \v m -> m {tsmActive = v}-              }-        )-      ]-  protoFileDescriptorBytes _ = BS.empty+import Proto.Decode+import Proto.Dynamic+import Proto.Encode+import Proto.Internal.Wire (Tag (..), WireType (..), fieldTag)+import Proto.Internal.Wire.Decode (+  DecodeError (..),+  DecodeResult (..),+  Decoder,+  getFixed32,+  getFixed64,+  getLengthDelimited,+  getTag,+  getText,+  getVarint,+  runDecoder,+  runDecoder',+  skipWireType,+  withTagM,+ )+import Proto.Internal.Wire.Decode qualified as WD+import Proto.Internal.Wire.Encode+import Proto.Schema+import Test.Syd+import Test.Syd.Hedgehog ()+import Wireform.Builder qualified as B+import Wireform.FFI (countPackedVarints, packedAllSingleByte, validateUtf8SWAR)+++dynamicSchemaTests :: Spec+dynamicSchemaTests =+  describe+    "Dynamic Schema-Driven Decoder"+    $ sequence_+      [ coreTests+      , compileTests+      , wireFFITests+      , packedTests+      , utf8Tests+      , withTagMTests+      ]+++-- ============================================================+-- TDP core interpreter tests+-- ============================================================++coreTests :: Spec+coreTests =+  describe+    "Core interpreter"+    $ sequence_+      [ it "empty message" $ do+          let result = decodeDynamicWithSchema emptyTable BS.empty+          case result of+            Right msg -> Map.null (dynFields msg) `shouldBe` True+            Left e -> expectationFailure (show e)+      , it "single varint field" $ do+          let bs = buildToBS $ putTag 1 WireVarint <> putVarint 42+              result = decodeDynamicWithSchema testSimpleTable bs+          case result of+            Right msg -> do+              case Map.lookup 1 (dynFields msg) of+                Just (DynVarint 42) -> pure ()+                other -> expectationFailure ("Expected DynVarint 42, got: " <> show other)+            Left e -> expectationFailure (show e)+      , it "multiple fields in order" $ do+          let bs =+                buildToBS $+                  putTag 1 WireVarint+                    <> putVarint 100+                    <> putTag 2 WireLengthDelimited+                    <> putText "hello"+                    <> putTag 3 WireVarint+                    <> putVarint 1+              result = decodeDynamicWithSchema testMultiTable bs+          case result of+            Right msg -> do+              Map.lookup 1 (dynFields msg) `shouldBe` Just (DynVarint 100)+              Map.lookup 2 (dynFields msg) `shouldBe` Just (DynBytes (buildToBS (B.byteString "hello")))+              Map.lookup 3 (dynFields msg) `shouldBe` Just (DynVarint 1)+            Left e -> expectationFailure (show e)+      , it "fields out of order" $ do+          let bs =+                buildToBS $+                  putTag 3 WireVarint+                    <> putVarint 99+                    <> putTag 1 WireVarint+                    <> putVarint 42+              result = decodeDynamicWithSchema testMultiTable bs+          case result of+            Right msg -> do+              Map.lookup 1 (dynFields msg) `shouldBe` Just (DynVarint 42)+              Map.lookup 3 (dynFields msg) `shouldBe` Just (DynVarint 99)+            Left e -> expectationFailure (show e)+      , it "unknown fields are skipped" $ do+          let bs =+                buildToBS $+                  putTag 1 WireVarint+                    <> putVarint 42+                    <> putTag 99 WireVarint+                    <> putVarint 999+                    <> putTag 2 WireLengthDelimited+                    <> putText "hi"+              result = decodeDynamicWithSchema testMultiTable bs+          case result of+            Right msg -> do+              Map.lookup 1 (dynFields msg) `shouldBe` Just (DynVarint 42)+              Map.member 99 (dynFields msg) `shouldBe` False+            Left e -> expectationFailure (show e)+      , it "last value wins for scalar fields" $ do+          let bs =+                buildToBS $+                  putTag 1 WireVarint+                    <> putVarint 10+                    <> putTag 1 WireVarint+                    <> putVarint 20+              result = decodeDynamicWithSchema testSimpleTable bs+          case result of+            Right msg ->+              Map.lookup 1 (dynFields msg) `shouldBe` Just (DynVarint 20)+            Left e -> expectationFailure (show e)+      , it "fixed32 field" $ do+          let bs = buildToBS $ putTag 1 Wire32Bit <> putFixed32 0xDEADBEEF+              table = makeSimpleTable 1 Wire32Bit (thunkFixed32Pub DynFixed32)+              result = decodeDynamicWithSchema table bs+          case result of+            Right msg ->+              Map.lookup 1 (dynFields msg) `shouldBe` Just (DynFixed32 0xDEADBEEF)+            Left e -> expectationFailure (show e)+      , it "fixed64 field" $ do+          let bs = buildToBS $ putTag 1 Wire64Bit <> putFixed64 0xCAFEBABEDEADBEEF+              table = makeSimpleTable 1 Wire64Bit (thunkFixed64Pub DynFixed64)+              result = decodeDynamicWithSchema table bs+          case result of+            Right msg ->+              Map.lookup 1 (dynFields msg) `shouldBe` Just (DynFixed64 0xCAFEBABEDEADBEEF)+            Left e -> expectationFailure (show e)+      , it "varint field roundtrip through TDP" $ property $ do+          val <- forAll $ Gen.word64 (Range.linear 0 maxBound)+          let bs = buildToBS $ putTag 1 WireVarint <> putVarint val+              result = decodeDynamicWithSchema testSimpleTable bs+          case result of+            Right msg ->+              Map.lookup 1 (dynFields msg) === Just (DynVarint val)+            Left e -> do+              annotate (show e)+              failure+      , it "multiple varint fields roundtrip" $ property $ do+          v1 <- forAll $ Gen.word64 (Range.linear 0 maxBound)+          v2 <- forAll $ Gen.word64 (Range.linear 0 maxBound)+          v3 <- forAll $ Gen.word64 (Range.linear 0 maxBound)+          let bs =+                buildToBS $+                  putTag 1 WireVarint+                    <> putVarint v1+                    <> putTag 2 WireVarint+                    <> putVarint v2+                    <> putTag 3 WireVarint+                    <> putVarint v3+              result = decodeDynamicWithSchema testThreeVarintTable bs+          case result of+            Right msg -> do+              Map.lookup 1 (dynFields msg) === Just (DynVarint v1)+              Map.lookup 2 (dynFields msg) === Just (DynVarint v2)+              Map.lookup 3 (dynFields msg) === Just (DynVarint v3)+            Left e -> do+              annotate (show e)+              failure+      ]+++-- ============================================================+-- Compile from schema tests+-- ============================================================++compileTests :: Spec+compileTests =+  describe+    "Compilation from schema"+    $ sequence_+      [ it "compileParseTable produces non-empty table" $ do+          let table = compileParseTable (Proxy :: Proxy TestSchemaMsg)+          V.length (ptFields table) `shouldBe` 3+          BS.length (ptTagLUT table) `shouldBe` 128+      , it "TagLUT has entries for small field numbers" $ do+          let table = compileParseTable (Proxy :: Proxy TestSchemaMsg)+              -- Field 1, varint: tag = 0x08+              lut08 = BS.index (ptTagLUT table) 0x08+              -- Field 2, length-delimited: tag = 0x12+              lut12 = BS.index (ptTagLUT table) 0x12+          lut08 /= 0xFF `shouldBe` True+          lut12 /= 0xFF `shouldBe` True+      , it "compiled table decodes matching wire data" $ do+          let table = compileParseTable (Proxy :: Proxy TestSchemaMsg)+              bs =+                buildToBS $+                  putTag 1 WireVarint+                    <> putVarint 42+                    <> putTag 2 WireLengthDelimited+                    <> putText "test"+                    <> putTag 3 WireVarint+                    <> putVarint 1+              result = decodeDynamicWithSchema table bs+          case result of+            Right msg -> do+              Map.lookup 1 (dynFields msg) `shouldBe` Just (DynVarint 42)+              Map.lookup 3 (dynFields msg) `shouldBe` Just (DynBool True)+            Left e -> expectationFailure (show e)+      , it "compiled table roundtrips with encodeMessage" $ property $ do+          val <- forAll $ Gen.word64 (Range.linear 0 1000)+          name <- forAll $ Gen.text (Range.linear 0 50) Gen.alphaNum+          active <- forAll Gen.bool+          let msg = TestSchemaMsg val name active+              encoded = encodeMessage msg+              table = compileParseTable (Proxy :: Proxy TestSchemaMsg)+              result = decodeDynamicWithSchema table encoded+          case result of+            Right tdpMsg -> do+              case Map.lookup 1 (dynFields tdpMsg) of+                Just (DynVarint v) -> v === val+                Nothing | val == 0 -> success+                other -> do+                  annotate ("field 1: " <> show other)+                  failure+            Left e -> do+              annotate (show e)+              failure+      ]+++-- ============================================================+-- Wire FFI tests (SWAR routines)+-- ============================================================++wireFFITests :: Spec+wireFFITests =+  describe+    "Wire FFI (SWAR)"+    $ sequence_+      [ it "countPackedVarints empty" $+          countPackedVarints BS.empty `shouldBe` 0+      , it "countPackedVarints single byte" $+          countPackedVarints (BS.pack [42]) `shouldBe` 1+      , it "countPackedVarints all single byte" $+          countPackedVarints (BS.pack [0, 1, 2, 3, 4, 5, 6, 7]) `shouldBe` 8+      , it "countPackedVarints two-byte varints" $+          countPackedVarints (BS.pack [0x80, 0x01, 0x80, 0x02]) `shouldBe` 2+      , it "countPackedVarints mixed" $+          countPackedVarints (BS.pack [42, 0x80, 0x01, 99]) `shouldBe` 3+      , it "countPackedVarints matches manual count" $ property $ do+          vals <- forAll $ Gen.list (Range.linear 0 100) (Gen.word64 (Range.linear 0 0xFFFF))+          let encoded = BL.toStrict $ B.toLazyByteString $ foldMap putVarint vals+              expected = length vals+          countPackedVarints encoded === expected+      , it "packedAllSingleByte empty" $+          packedAllSingleByte BS.empty `shouldBe` True+      , it "packedAllSingleByte all small" $+          packedAllSingleByte (BS.pack [0, 1, 42, 127]) `shouldBe` True+      , it "packedAllSingleByte has continuation" $+          packedAllSingleByte (BS.pack [0, 0x80, 1]) `shouldBe` False+      , it "packedAllSingleByte correct for small values" $ property $ do+          vals <- forAll $ Gen.list (Range.linear 0 200) (Gen.word8 (Range.linear 0 127))+          let bs = BS.pack vals+          packedAllSingleByte bs === True+      , it "packedAllSingleByte false when large varint present" $ property $ do+          vals <- forAll $ Gen.list (Range.linear 1 50) (Gen.word64 (Range.linear 128 0xFFFF))+          let encoded = BL.toStrict $ B.toLazyByteString $ foldMap putVarint vals+          packedAllSingleByte encoded === False+      ]+++-- ============================================================+-- Packed field decode tests (zero-copy, bulk memcpy paths)+-- ============================================================++packedTests :: Spec+packedTests =+  describe+    "Packed field optimizations"+    $ sequence_+      [ it "packed varint single-byte fast path" $ property $ do+          vals <- forAll $ Gen.list (Range.linear 0 200) (Gen.word64 (Range.linear 0 127))+          let vec = VU.fromList vals+              encoded = buildToBS (encodePackedWord64 1 vec)+          if VU.null vec+            then assert (BS.null encoded)+            else case runDecoder (getTag >> decodePackedVarint) encoded of+              Left e -> do+                annotate (show e)+                failure+              Right decoded -> VU.toList decoded === vals+      , it "packed varint multi-byte values" $ property $ do+          vals <- forAll $ Gen.list (Range.linear 0 100) (Gen.word64 (Range.linear 128 0xFFFFFFFF))+          let vec = VU.fromList vals+              encoded = buildToBS (encodePackedWord64 1 vec)+          if VU.null vec+            then assert (BS.null encoded)+            else case runDecoder (getTag >> decodePackedVarint) encoded of+              Left e -> do+                annotate (show e)+                failure+              Right decoded -> VU.toList decoded === vals+      , it "packed fixed32 bulk memcpy path" $ property $ do+          vals <- forAll $ Gen.list (Range.linear 0 200) (Gen.word32 Range.linearBounded)+          let vec = VU.fromList vals+              encoded = buildToBS (encodePackedFixed32 1 vec)+          if VU.null vec+            then assert (BS.null encoded)+            else case runDecoder (getTag >> decodePackedFixed32) encoded of+              Left e -> do+                annotate (show e)+                failure+              Right decoded -> VU.toList decoded === vals+      , it "packed fixed64 bulk memcpy path" $ property $ do+          vals <- forAll $ Gen.list (Range.linear 0 200) (Gen.word64 Range.linearBounded)+          let vec = VU.fromList vals+              encoded = buildToBS (encodePackedFixed64 1 vec)+          if VU.null vec+            then assert (BS.null encoded)+            else case runDecoder (getTag >> decodePackedFixed64) encoded of+              Left e -> do+                annotate (show e)+                failure+              Right decoded -> VU.toList decoded === vals+      , it "packed float bulk memcpy path" $ property $ do+          vals <- forAll $ Gen.list (Range.linear 0 200) (Gen.float (Range.linearFrac (-1e30) 1e30))+          let vec = VU.fromList vals+              encoded = buildToBS (encodePackedFloat 1 vec)+          if VU.null vec+            then assert (BS.null encoded)+            else case runDecoder (getTag >> decodePackedFloat) encoded of+              Left e -> do+                annotate (show e)+                failure+              Right decoded -> VU.toList decoded === vals+      , it "packed double bulk memcpy path" $ property $ do+          vals <- forAll $ Gen.list (Range.linear 0 200) (Gen.double (Range.linearFrac (-1e300) 1e300))+          let vec = VU.fromList vals+              encoded = buildToBS (encodePackedDouble 1 vec)+          if VU.null vec+            then assert (BS.null encoded)+            else case runDecoder (getTag >> decodePackedDouble) encoded of+              Left e -> do+                annotate (show e)+                failure+              Right decoded -> VU.toList decoded === vals+      , it "packed sint32 pre-allocated path" $ property $ do+          vals <- forAll $ Gen.list (Range.linear 0 100) (Gen.int32 Range.linearBounded)+          let vec = VU.fromList vals+              encoded = buildToBS (encodePackedSVarint32 1 vec)+          if VU.null vec+            then assert (BS.null encoded)+            else case runDecoder (getTag >> decodePackedSVarint32) encoded of+              Left e -> do+                annotate (show e)+                failure+              Right decoded -> VU.toList decoded === vals+      , it "packed sint64 pre-allocated path" $ property $ do+          vals <- forAll $ Gen.list (Range.linear 0 100) (Gen.int64 Range.linearBounded)+          let vec = VU.fromList vals+              encoded = buildToBS (encodePackedSVarint64 1 vec)+          if VU.null vec+            then assert (BS.null encoded)+            else case runDecoder (getTag >> decodePackedSVarint64) encoded of+              Left e -> do+                annotate (show e)+                failure+              Right decoded -> VU.toList decoded === vals+      ]+++-- ============================================================+-- SWAR UTF-8 validation tests+-- ============================================================++utf8Tests :: Spec+utf8Tests =+  describe+    "SWAR UTF-8 validation"+    $ sequence_+      [ it "empty is valid" $+          validateUtf8SWAR BS.empty `shouldBe` True+      , it "ASCII is valid" $+          validateUtf8SWAR "hello world" `shouldBe` True+      , it "long ASCII string" $+          validateUtf8SWAR (BS.replicate 1000 0x41) `shouldBe` True+      , it "valid 2-byte UTF-8" $+          validateUtf8SWAR (BS.pack [0xC3, 0xA9]) `shouldBe` True -- é+      , it "valid 3-byte UTF-8" $+          validateUtf8SWAR (BS.pack [0xE2, 0x80, 0x99]) `shouldBe` True -- '+      , it "valid 4-byte UTF-8" $+          validateUtf8SWAR (BS.pack [0xF0, 0x9F, 0x98, 0x80]) `shouldBe` True -- 😀+      , it "invalid: bare continuation byte" $+          validateUtf8SWAR (BS.pack [0x80]) `shouldBe` False+      , it "invalid: overlong 2-byte" $+          validateUtf8SWAR (BS.pack [0xC0, 0xAF]) `shouldBe` False+      , it "invalid: surrogate" $+          validateUtf8SWAR (BS.pack [0xED, 0xA0, 0x80]) `shouldBe` False+      , it "invalid: truncated 2-byte" $+          validateUtf8SWAR (BS.pack [0xC3]) `shouldBe` False+      , it "invalid: truncated 3-byte" $+          validateUtf8SWAR (BS.pack [0xE2, 0x80]) `shouldBe` False+      , it "invalid: byte 0xFF" $+          validateUtf8SWAR (BS.pack [0xFF]) `shouldBe` False+      , it "mixed ASCII and multibyte" $+          validateUtf8SWAR "hello \xC3\xA9 world \xF0\x9F\x98\x80" `shouldBe` True+      , it "all generated unicode text is valid" $ property $ do+          t <- forAll $ Gen.text (Range.linear 0 500) Gen.unicode+          let bs = encodeUtf8 t+          validateUtf8SWAR bs === True+      ]+  where+    encodeUtf8 = Data.Text.Encoding.encodeUtf8+++-- ============================================================+-- withTagM CPS tests+-- ============================================================++withTagMTests :: Spec+withTagMTests =+  describe+    "withTagM CPS dispatch"+    $ sequence_+      [ it "withTagM at EOF returns kEOF" $ do+          let decoder = withTagM (pure True) (\_ _ -> pure False)+          runDecoder decoder BS.empty `shouldBe` Right True+      , it "withTagM on varint field" $ do+          let bs = buildToBS $ putTag 1 WireVarint <> putVarint 42+              decoder =+                withTagM+                  (pure (0 :: Int, 0 :: Word64))+                  ( \fn _wt -> do+                      val <- getVarint+                      pure (fn, val)+                  )+          case runDecoder decoder bs of+            Right (fn, val) -> do+              fn `shouldBe` 1+              val `shouldBe` 42+            Left e -> expectationFailure (show e)+      , it "withTagM dispatches correctly on wire type" $ do+          let bs = buildToBS $ putTag 5 Wire32Bit <> putFixed32 999+              decoder =+                withTagM+                  (pure Nothing)+                  ( \fn wt -> do+                      if wt == 5 -- Wire32Bit+                        then do+                          v <- getFixed32+                          pure (Just (fn, v))+                        else do+                          skipWireType wt+                          pure Nothing+                  )+          case runDecoder decoder bs of+            Right (Just (5, 999)) -> pure ()+            other -> expectationFailure ("Unexpected: " <> show other)+      , it "map entry decode via withTagM" $ do+          let keyEnc = putTag 1 WireVarint <> putVarint 42+              valEnc = putTag 2 WireLengthDelimited <> putText "value"+              encoded = buildToBS (keyEnc <> valEnc)+          case runDecoder (decodeMapEntry getVarint getText 0 "") encoded of+            Right (k, v) -> do+              k `shouldBe` 42+              v `shouldBe` "value"+            Left e -> expectationFailure (show e)+      , it "map entry with reversed field order" $ do+          let valEnc = putTag 2 WireLengthDelimited <> putText "first"+              keyEnc = putTag 1 WireVarint <> putVarint 7+              encoded = buildToBS (valEnc <> keyEnc)+          case runDecoder (decodeMapEntry getVarint getText 0 "") encoded of+            Right (k, v) -> do+              k `shouldBe` 7+              v `shouldBe` "first"+            Left e -> expectationFailure (show e)+      ]+++-- ============================================================+-- Helpers+-- ============================================================++buildToBS :: B.Builder -> ByteString+buildToBS = BL.toStrict . B.toLazyByteString+++-- Expose thunk builders for tests+thunkVarintPub :: (Word64 -> DynamicValue) -> FieldThunk+thunkVarintPub f bs off =+  case runDecoder' getVarint bs off of+    DecodeOK v off' -> pure (f v, off')+    DecodeFail e -> error (show e)+++thunkFixed32Pub :: (Word32 -> DynamicValue) -> FieldThunk+thunkFixed32Pub f bs off =+  case runDecoder' getFixed32 bs off of+    DecodeOK v off' -> pure (f v, off')+    DecodeFail e -> error (show e)+++thunkFixed64Pub :: (Word64 -> DynamicValue) -> FieldThunk+thunkFixed64Pub f bs off =+  case runDecoder' getFixed64 bs off of+    DecodeOK v off' -> pure (f v, off')+    DecodeFail e -> error (show e)+++emptyTable :: ParseTable+emptyTable = ParseTable V.empty (BS.replicate 128 0xFF) IntMap.empty 0+++testSimpleTable :: ParseTable+testSimpleTable = makeSimpleTable 1 WireVarint (thunkVarintPub DynVarint)+++testMultiTable :: ParseTable+testMultiTable =+  makeMultiTable+    [ (1, WireVarint, thunkVarintPub DynVarint)+    , (2, WireLengthDelimited, thunkLenDelimPub)+    , (3, WireVarint, thunkVarintPub DynVarint)+    ]+++testThreeVarintTable :: ParseTable+testThreeVarintTable =+  makeMultiTable+    [ (1, WireVarint, thunkVarintPub DynVarint)+    , (2, WireVarint, thunkVarintPub DynVarint)+    , (3, WireVarint, thunkVarintPub DynVarint)+    ]+++thunkLenDelimPub :: FieldThunk+thunkLenDelimPub bs off =+  case runDecoder' getLengthDelimited bs off of+    DecodeOK v off' -> pure (DynBytes v, off')+    DecodeFail e -> error (show e)+++makeSimpleTable :: Int -> WireType -> FieldThunk -> ParseTable+makeSimpleTable fn wt thunk = makeMultiTable [(fn, wt, thunk)]+++makeMultiTable :: [(Int, WireType, FieldThunk)] -> ParseTable+makeMultiTable entries =+  let n = length entries+      parsers =+        V.fromList+          [ FieldParser+              { fpTag = fieldTag fn wt+              , fpFieldNum = fn+              , fpNextOk = (i + 1) `mod` n+              , fpNextErr = (i + 1) `mod` n+              , fpParse = thunk+              , fpLabel = LabelOptional+              , fpSubmsg = Nothing+              }+          | (i, (fn, wt, thunk)) <- zip [0 ..] entries+          ]+      tagMap =+        IntMap.fromList+          [ (fromIntegral (fieldTag fn wt), i)+          | (i, (fn, wt, _)) <- zip [0 ..] entries+          ]+      lut =+        BS.pack+          [ case IntMap.lookup (fromIntegral b) tagMap of+              Just idx | idx < 256 -> fromIntegral idx+              _ -> 0xFF+          | b <- [0 .. 127 :: Int]+          ]+  in ParseTable parsers lut tagMap (min 4 n)+++-- A test message type with ProtoMessage instance for compile tests+data TestSchemaMsg = TestSchemaMsg+  { tsmValue :: {-# UNPACK #-} !Word64+  , tsmName :: !Text+  , tsmActive :: !Bool+  }+  deriving stock (Show, Eq)+++instance MessageEncode TestSchemaMsg where+  buildMessage msg =+    (if tsmValue msg /= 0 then encodeFieldVarint 1 (tsmValue msg) else mempty)+      <> (if tsmName msg /= "" then encodeFieldString 2 (tsmName msg) else mempty)+      <> (if tsmActive msg then encodeFieldBool 3 True else mempty)+++instance MessageSize TestSchemaMsg where+  messageSize msg =+    (if tsmValue msg /= 0 then fieldVarintSize 1 (tsmValue msg) else 0)+      + (if tsmName msg /= "" then fieldTextSize 2 (tsmName msg) else 0)+      + (if tsmActive msg then fieldBoolSize 3 else 0)+++instance ProtoMessage TestSchemaMsg where+  protoMessageName _ = "test.TestSchemaMsg"+  protoPackageName _ = "test"+  protoDefaultValue = TestSchemaMsg 0 "" False+  protoFieldDescriptors _ =+    Map.fromList+      [+        ( 1+        , SomeField+            FieldDescriptor+              { fdName = "value"+              , fdNumber = 1+              , fdTypeDesc = ScalarType UInt64Field+              , fdLabel = LabelOptional+              , fdGet = tsmValue+              , fdSet = \v m -> m {tsmValue = v}+              }+        )+      ,+        ( 2+        , SomeField+            FieldDescriptor+              { fdName = "name"+              , fdNumber = 2+              , fdTypeDesc = ScalarType StringField+              , fdLabel = LabelOptional+              , fdGet = tsmName+              , fdSet = \v m -> m {tsmName = v}+              }+        )+      ,+        ( 3+        , SomeField+            FieldDescriptor+              { fdName = "active"+              , fdNumber = 3+              , fdTypeDesc = ScalarType BoolField+              , fdLabel = LabelOptional+              , fdGet = tsmActive+              , fdSet = \v m -> m {tsmActive = v}+              }+        )+      ]
− test-integration/Test/TextFormatParsed.hs 
@@ -1,144 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-module Test.TextFormatParsed (textFormatParsedTests) where--import Data.Aeson qualified as Aeson-import Data.Proxy (Proxy (..))-import Proto.Schema (ProtoMessage (..))-import Data.Text qualified as T-import Data.Vector qualified as V-import Test.Tasty-import Test.Tasty.HUnit--import Proto (decodeMessage, MessageDecode (..))-import Proto (encodeMessage)-import Proto.Internal.Encode (MessageEncode (..))-import Proto.TextFormat (textToTyped, typedToTextPretty)-import Proto.TH.QQ (proto)-import Data.Reflection (Given (..))-import Proto.Internal.JSON.Extension (ExtensionRegistry, emptyExtensionRegistry)----- Generated types for these tests.-[proto|-  syntax = "proto3";-  package test.textfmt;--  enum Color {-    COLOR_UNSPECIFIED = 0;-    COLOR_RED         = 1;-    COLOR_GREEN       = 2;-    COLOR_BLUE        = 3;-  }--  message Point {-    int32  x = 1;-    int32  y = 2;-    string label = 3;-    Color  color = 4;-    bytes  data  = 5;-    repeated int32 values = 6;-  }--  message Outer {-    string name  = 1;-    Point  inner = 2;-  }-|]--instance Given ExtensionRegistry where-  given = emptyExtensionRegistry---textFormatParsedTests :: TestTree-textFormatParsedTests =-  testGroup-    "textToTyped"-    [ testCase "empty message round-trips" $ do-        let msg = defaultPoint-            pbtxt = typedToTextPretty (Proxy @Point) msg-        case pbtxt of-          Nothing -> assertFailure "typedToTextPretty returned Nothing for empty message"-          Just t -> case textToTyped (Proxy @Point) t of-            Left e -> assertFailure ("textToTyped failed: " <> e)-            Right p -> p @?= msg--    , testCase "scalar fields round-trip" $ do-        let msg = defaultPoint-              { pointX = 42-              , pointY = -7-              , pointLabel = "hello world"-              }-        roundTrip (Proxy @Point) msg--    , testCase "enum field round-trips" $ do-        let msg = defaultPoint { pointColor = Color'ColorRed }-        roundTrip (Proxy @Point) msg--    , testCase "all enum values round-trip" $-        mapM_-          (\c -> roundTrip (Proxy @Point) (defaultPoint { pointColor = c }))-          [Color'ColorUnspecified, Color'ColorRed, Color'ColorGreen, Color'ColorBlue]--    , testCase "nested message round-trips" $ do-        let inner = defaultPoint { pointX = 10, pointY = 20, pointLabel = "inner" }-            msg = defaultOuter { outerName = "outer", outerInner = Just inner }-        roundTrip (Proxy @Outer) msg--    , testCase "repeated field round-trips" $ do-        let msg = defaultPoint { pointValues = V.fromList [1, 2, 3, 100, -5] }-        roundTrip (Proxy @Point) msg--    , testCase "parse known text format" $-        -- Build text format manually without round-tripping through typedToTextPretty.-        -- This tests that the parser itself works for user-provided pbtxt.-        case textToTyped (Proxy @Point) "x: 99\ny: -3\nlabel: \"foo\"" of-          Left e -> assertFailure ("textToTyped failed: " <> e)-          Right p -> do-            pointX p @?= 99-            pointY p @?= -3-            pointLabel p @?= "foo"--    , testCase "parse nested message text format" $ do-        let src = T.unlines-              [ "name: \"test\""-              , "inner {"-              , "  x: 5"-              , "  y: 10"-              , "}"-              ]-        case textToTyped (Proxy @Outer) src of-          Left e -> assertFailure ("textToTyped failed: " <> e)-          Right o -> do-            outerName o @?= "test"-            fmap pointX (outerInner o) @?= Just 5-            fmap pointY (outerInner o) @?= Just 10--    , testCase "wire-format ↔ text format ↔ wire-format consistency" $ do-        -- textToTyped ∘ typedToTextPretty ∘ decodeMessage ∘ encodeMessage == id-        let msg = defaultPoint { pointX = 7, pointY = -3, pointLabel = "wire", pointColor = Color'ColorBlue }-            bytes = encodeMessage msg-        case decodeMessage @Point bytes of-          Left e -> assertFailure ("decode failed: " <> show e)-          Right decoded -> roundTrip (Proxy @Point) decoded--    , testCase "empty string returns default" $-        case textToTyped (Proxy @Point) "" of-          Left e -> assertFailure ("textToTyped empty failed: " <> e)-          Right p -> p @?= defaultPoint--    , testCase "unknown field names are ignored" $-        -- Graceful: unknown names result in fields staying at default,-        -- but the parse itself succeeds (fromJSON ignores unknown keys).-        case textToTyped (Proxy @Point) "not_a_field: 42\nx: 5" of-          Left _ -> pure ()   -- also acceptable to fail-          Right p -> pointX p @?= 5-    ]-  where-    roundTrip :: (Given ExtensionRegistry, MessageEncode a, MessageDecode a, ProtoMessage a, Aeson.ToJSON a, Aeson.FromJSON a, Eq a, Show a) => Proxy a -> a -> IO ()-    roundTrip p msg =-      case typedToTextPretty p msg of-        Nothing -> assertFailure "typedToTextPretty returned Nothing"-        Just t ->-          case textToTyped p t of-            Left e -> assertFailure ("textToTyped failed: " <> e)-            Right r -> r @?= msg
test-integration/Test/WellKnown.hs view
@@ -8,257 +8,280 @@ import Hedgehog import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range-import Proto-import Proto-import Proto.Google.Protobuf.WellKnownTypes.Any-import Proto.Google.Protobuf.WellKnownTypes.Any.Util-import Proto.Google.Protobuf.WellKnownTypes.Duration-import Proto.Google.Protobuf.WellKnownTypes.Empty-import Proto.Google.Protobuf.WellKnownTypes.FieldMask-import Proto.Google.Protobuf.WellKnownTypes.SourceContext-import Proto.Google.Protobuf.WellKnownTypes.Struct-import Proto.Google.Protobuf.WellKnownTypes.Timestamp-import Proto.Google.Protobuf.WellKnownTypes.Wrappers+import Proto.Decode+import Proto.Encode+import Proto.Google.Protobuf.Any+import Proto.Google.Protobuf.Any.Util+import Proto.Google.Protobuf.Duration+import Proto.Google.Protobuf.Empty+import Proto.Google.Protobuf.FieldMask+import Proto.Google.Protobuf.SourceContext+import Proto.Google.Protobuf.Struct+import Proto.Google.Protobuf.Timestamp+import Proto.Google.Protobuf.Wrappers import Proto.Registry (TypeRegistry, emptyRegistry, lookupCodec, lookupDecoder, registerMessage)-import Test.Tasty-import Test.Tasty.HUnit hiding (assert)-import Test.Tasty.Hedgehog+import Test.Syd+import Test.Syd.Hedgehog ()  -wellKnownTests :: TestTree+wellKnownTests :: Spec wellKnownTests =-  testGroup+  describe     "Well-Known Types"-    [ testGroup-        "Timestamp"-        [ testProperty "roundtrip" $ property $ do-            s <- forAll $ Gen.int64 (Range.linear (-1000000000) 1000000000)-            n <- forAll $ Gen.int32 (Range.linear 0 999999999)-            let msg = defaultTimestamp {timestampSeconds = s, timestampNanos = n}-                encoded = encodeMessage msg-            decodeMessage encoded === Right msg-        , testCase "default is zero-length" $ do-            let encoded = encodeMessage defaultTimestamp-            BS.length encoded @?= 0-        , testCase "sized encoding matches" $ do-            let msg = defaultTimestamp {timestampSeconds = 1234567890, timestampNanos = 123456789}-            BS.length (encodeMessage msg) @?= messageSize msg-        , testCase "JSON canonical RFC 3339" $ do-            let msg = defaultTimestamp {timestampSeconds = 1708000000, timestampNanos = 0}-            Aeson.toJSON msg @?= Aeson.String "2024-02-15T12:26:40Z"-        , testCase "JSON with nanos" $ do-            let msg = defaultTimestamp {timestampSeconds = 0, timestampNanos = 123456789}-            Aeson.toJSON msg @?= Aeson.String "1970-01-01T00:00:00.123456789Z"-        , testCase "JSON nanos trailing zeros trimmed" $ do-            let msg = defaultTimestamp {timestampSeconds = 0, timestampNanos = 100000000}-            Aeson.toJSON msg @?= Aeson.String "1970-01-01T00:00:00.1Z"-        ]-    , testGroup-        "Duration"-        [ testProperty "roundtrip" $ property $ do-            s <- forAll $ Gen.int64 (Range.linear (-315576000000) 315576000000)-            n <- forAll $ Gen.int32 (Range.linear (-999999999) 999999999)-            let msg = defaultDuration {durationSeconds = s, durationNanos = n}-                encoded = encodeMessage msg-            decodeMessage encoded === Right msg-        , testCase "JSON canonical seconds" $ do-            let msg = defaultDuration {durationSeconds = 3600, durationNanos = 0}-            Aeson.toJSON msg @?= Aeson.String "3600s"-        , testCase "JSON with nanos" $ do-            let msg = defaultDuration {durationSeconds = 1, durationNanos = 500000000}-            Aeson.toJSON msg @?= Aeson.String "1.5s"-        , testCase "JSON negative" $ do-            let msg = defaultDuration {durationSeconds = -1, durationNanos = -500000000}-            Aeson.toJSON msg @?= Aeson.String "-1.5s"-        ]-    , testGroup-        "Any"-        [ testProperty "raw Any roundtrip" $ property $ do-            tu <- forAll $ Gen.text (Range.linear 0 100) Gen.alphaNum-            v <- forAll $ Gen.bytes (Range.linear 0 200)-            let msg = defaultAny {anyTypeUrl = tu, anyValue = v}-                encoded = encodeMessage msg-            decodeMessage encoded === Right msg-        , testProperty "packAny Timestamp roundtrip" $ property $ do-            s <- forAll $ Gen.int64 (Range.linear 0 2000000000)-            n <- forAll $ Gen.int32 (Range.linear 0 999999999)-            let ts = defaultTimestamp {timestampSeconds = s, timestampNanos = n}-                packed = packAny ts-            anyTypeUrl packed === "type.googleapis.com/google.protobuf.Timestamp"-            case unpackAny packed of-              Just (Right decoded) -> decoded === ts-              Just (Left err) -> do annotate (show err); failure-              Nothing -> do annotate "type mismatch"; failure-        , testProperty "packAny Duration roundtrip" $ property $ do-            s <- forAll $ Gen.int64 (Range.linear 0 1000000)-            n <- forAll $ Gen.int32 (Range.linear 0 999999999)-            let dur = defaultDuration {durationSeconds = s, durationNanos = n}-                packed = packAny dur-            case unpackAny packed of-              Just (Right decoded) -> decoded === dur-              _ -> failure-        , testCase "packAny Empty" $ do-            let packed = packAny defaultEmpty-            anyTypeUrl packed @?= "type.googleapis.com/google.protobuf.Empty"-            case unpackAny packed :: Maybe (Either DecodeError Empty) of-              Just (Right _) -> pure ()-              other -> assertFailure ("Expected Just (Right Empty), got " <> show other)-        , testCase "unpackAny type mismatch returns Nothing" $ do-            let packed = packAny (defaultTimestamp {timestampSeconds = 100})-            case unpackAny packed :: Maybe (Either DecodeError Duration) of-              Nothing -> pure ()-              Just _ -> assertFailure "Should not match Duration"-        , testCase "isMessageType" $ do-            let packed = packAny (defaultDuration {durationSeconds = 60})-            isMessageType (Proxy :: Proxy Duration) packed @?= True-            isMessageType (Proxy :: Proxy Timestamp) packed @?= False-        , testCase "typeNameFromUrl strips prefix" $ do-            typeNameFromUrl "type.googleapis.com/google.protobuf.Timestamp"-              @?= "google.protobuf.Timestamp"-            typeNameFromUrl "mycompany.com/types/example.Foo"-              @?= "example.Foo"-            typeNameFromUrl "google.protobuf.Timestamp"-              @?= "google.protobuf.Timestamp"-        , testCase "packAnyWithPrefix custom prefix" $ do-            let packed = packAnyWithPrefix "myhost/" (defaultTimestamp {timestampSeconds = 1})-            anyTypeUrl packed @?= "myhost/google.protobuf.Timestamp"-            case unpackAny packed of-              Just (Right ts) -> ts @?= defaultTimestamp {timestampSeconds = 1}-              _ -> assertFailure "Should unpack with any prefix"-        , testCase "Any wire roundtrip preserves content" $ do-            let ts = defaultTimestamp {timestampSeconds = 1234567890, timestampNanos = 500000000}-                packed = packAny ts-                encodedAny = encodeMessage packed-            case decodeMessage encodedAny of-              Left err -> assertFailure (show err)-              Right decodedAny -> case unpackAny decodedAny of-                Just (Right (decoded :: Timestamp)) -> decoded @?= ts-                _ -> assertFailure "Should unpack after wire roundtrip"-        , testCase "TypeRegistry codec lookup" $ do-            let registry =-                  registerMessage (Proxy :: Proxy Timestamp)-                    . registerMessage (Proxy :: Proxy Duration)-                    . registerMessage (Proxy :: Proxy Empty)-                    $ emptyRegistry-            case lookupDecoder @Timestamp "google.protobuf.Timestamp" registry of-              Just decode' -> case decode' (encodeMessage (defaultTimestamp {timestampSeconds = 42})) of-                Right ts -> timestampSeconds ts @?= 42-                Left e -> assertFailure (show e)-              Nothing -> assertFailure "Should find Timestamp decoder"-        , testCase "TypeRegistry unknown type returns Nothing" $ do-            let registry = registerMessage (Proxy :: Proxy Timestamp) emptyRegistry-            case lookupCodec "unknown.Type" registry of-              Nothing -> pure ()-              Just _ -> assertFailure "Should return Nothing for unknown type"-        ]-    , testGroup-        "Empty"-        [ testCase "empty roundtrip" $ do-            let encoded = encodeMessage defaultEmpty-            BS.length encoded @?= 0-            case decodeMessage encoded :: Either DecodeError Empty of-              Right _ -> pure ()-              Left e -> assertFailure (show e)-        ]-    , testGroup-        "Wrappers"-        [ testProperty "Int64Value roundtrip" $ property $ do-            v <- forAll $ Gen.int64 Range.linearBounded-            let msg = defaultInt64Value {int64ValueValue = v}-            decodeMessage (encodeMessage msg) === Right msg-        , testProperty "UInt64Value roundtrip" $ property $ do-            v <- forAll $ Gen.word64 (Range.linear 0 maxBound)-            let msg = defaultUInt64Value {uInt64ValueValue = v}-            decodeMessage (encodeMessage msg) === Right msg-        , testProperty "Int32Value roundtrip" $ property $ do-            v <- forAll $ Gen.int32 Range.linearBounded-            let msg = defaultInt32Value {int32ValueValue = v}-            decodeMessage (encodeMessage msg) === Right msg-        , testProperty "BoolValue roundtrip" $ property $ do-            v <- forAll Gen.bool-            let msg = defaultBoolValue {boolValueValue = v}-            decodeMessage (encodeMessage msg) === Right msg-        , testProperty "StringValue roundtrip" $ property $ do-            v <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode-            let msg = defaultStringValue {stringValueValue = v}-            decodeMessage (encodeMessage msg) === Right msg-        , testProperty "BytesValue roundtrip" $ property $ do-            v <- forAll $ Gen.bytes (Range.linear 0 200)-            let msg = defaultBytesValue {bytesValueValue = v}-            decodeMessage (encodeMessage msg) === Right msg-        , testProperty "DoubleValue roundtrip" $ property $ do-            v <- forAll $ Gen.double (Range.linearFrac (-1e100) 1e100)-            let msg = defaultDoubleValue {doubleValueValue = v}-            decodeMessage (encodeMessage msg) === Right msg-        , testProperty "FloatValue roundtrip" $ property $ do-            v <- forAll $ Gen.float (Range.linearFrac (-1e30) 1e30)-            let msg = defaultFloatValue {floatValueValue = v}-            decodeMessage (encodeMessage msg) === Right msg-        ]-    , testGroup-        "FieldMask"-        [ testCase "roundtrip" $ do-            let msg = defaultFieldMask {fieldMaskPaths = V.fromList ["foo.bar", "baz"]}-                encoded = encodeMessage msg-            decodeMessage encoded @?= Right msg-        ]-    , testGroup-        "SourceContext"-        [ testProperty "roundtrip" $ property $ do-            fn <- forAll $ Gen.text (Range.linear 0 100) Gen.alphaNum-            let msg = defaultSourceContext {sourceContextFileName = fn}-            decodeMessage (encodeMessage msg) === Right msg-        ]-    , testGroup-        "Struct"-        [ testCase "empty struct roundtrip" $ do-            let msg = defaultStruct-            decodeMessage (encodeMessage msg) @?= Right msg-        , testCase "value null roundtrip" $ do-            let v = defaultValue {valueKind = Just (Value'Kind'NullValue NullValue'NullValue)}-            decodeMessage (encodeMessage v) @?= Right v-        , testCase "value number roundtrip" $ do-            let v = defaultValue {valueKind = Just (Value'Kind'NumberValue 3.14)}-            decodeMessage (encodeMessage v) @?= Right v-        , testCase "value string roundtrip" $ do-            let v = defaultValue {valueKind = Just (Value'Kind'StringValue "hello")}-            decodeMessage (encodeMessage v) @?= Right v-        , testCase "value bool roundtrip" $ do-            let v = defaultValue {valueKind = Just (Value'Kind'BoolValue True)}-            decodeMessage (encodeMessage v) @?= Right v-        , testCase "list value roundtrip" $ do-            let lv =-                  defaultListValue-                    { listValueValues =-                        V.fromList-                          [ defaultValue {valueKind = Just (Value'Kind'NumberValue 1)}-                          , defaultValue {valueKind = Just (Value'Kind'StringValue "two")}-                          , defaultValue {valueKind = Just (Value'Kind'BoolValue False)}-                          ]-                    }-            decodeMessage (encodeMessage lv) @?= Right lv-        ]-    , testGroup-        "Hashable instances"-        [ testProperty "Timestamp: equal values have equal hashes" $ property $ do-            s <- forAll $ Gen.int64 (Range.linear 0 1000000)-            n <- forAll $ Gen.int32 (Range.linear 0 999999)-            let msg = defaultTimestamp {timestampSeconds = s, timestampNanos = n}-            hash msg === hash msg-        , testCase "Timestamp: different values have different hashes" $ do-            let m1 = defaultTimestamp {timestampSeconds = 100}-                m2 = defaultTimestamp {timestampSeconds = 200}-            assertBool "hashes should differ" (hash m1 /= hash m2)-        , testCase "Duration: hashWithSalt works" $ do-            let msg = defaultDuration {durationSeconds = 42, durationNanos = 123}-            hashWithSalt 0 msg `seq` pure ()-        , testCase "Empty: hashable" $ do-            hash defaultEmpty `seq` pure ()-        , testProperty "FieldMask: hashable with vector field" $ property $ do-            ps <- forAll $ Gen.list (Range.linear 0 5) (Gen.text (Range.linear 1 10) Gen.alphaNum)-            let msg = defaultFieldMask {fieldMaskPaths = V.fromList ps}-            hash msg `seq` pure ()-        , testProperty "Struct: hashable with map field" $ property $ do-            hash defaultStruct `seq` pure ()-        ]-    ]+    $ sequence_+      [ describe+          "Timestamp"+          $ sequence_+            [ it "roundtrip" $ property $ do+                s <- forAll $ Gen.int64 (Range.linear (-1000000000) 1000000000)+                n <- forAll $ Gen.int32 (Range.linear 0 999999999)+                let msg = defaultTimestamp {timestampSeconds = s, timestampNanos = n}+                    encoded = encodeMessage msg+                decodeMessage encoded === Right msg+            , it "default is zero-length" $ do+                let encoded = encodeMessage defaultTimestamp+                BS.length encoded `shouldBe` 0+            , it "sized encoding matches" $ do+                let msg = defaultTimestamp {timestampSeconds = 1234567890, timestampNanos = 123456789}+                BS.length (encodeMessage msg) `shouldBe` messageSize msg+            , it "JSON canonical RFC 3339" $ do+                let msg = defaultTimestamp {timestampSeconds = 1708000000, timestampNanos = 0}+                Aeson.toJSON msg `shouldBe` Aeson.String "2024-02-15T12:26:40Z"+            , it "JSON with nanos" $ do+                let msg = defaultTimestamp {timestampSeconds = 0, timestampNanos = 123456789}+                Aeson.toJSON msg `shouldBe` Aeson.String "1970-01-01T00:00:00.123456789Z"+            , it "JSON nanos trailing zeros trimmed" $ do+                let msg = defaultTimestamp {timestampSeconds = 0, timestampNanos = 100000000}+                Aeson.toJSON msg `shouldBe` Aeson.String "1970-01-01T00:00:00.1Z"+            ]+      , describe+          "Duration"+          $ sequence_+            [ it "roundtrip" $ property $ do+                s <- forAll $ Gen.int64 (Range.linear (-315576000000) 315576000000)+                n <- forAll $ Gen.int32 (Range.linear (-999999999) 999999999)+                let msg = defaultDuration {durationSeconds = s, durationNanos = n}+                    encoded = encodeMessage msg+                decodeMessage encoded === Right msg+            , it "JSON canonical seconds" $ do+                let msg = defaultDuration {durationSeconds = 3600, durationNanos = 0}+                Aeson.toJSON msg `shouldBe` Aeson.String "3600s"+            , it "JSON with nanos" $ do+                let msg = defaultDuration {durationSeconds = 1, durationNanos = 500000000}+                Aeson.toJSON msg `shouldBe` Aeson.String "1.5s"+            , it "JSON negative" $ do+                let msg = defaultDuration {durationSeconds = -1, durationNanos = -500000000}+                Aeson.toJSON msg `shouldBe` Aeson.String "-1.5s"+            ]+      , describe+          "Any"+          $ sequence_+            [ it "raw Any roundtrip" $ property $ do+                tu <- forAll $ Gen.text (Range.linear 0 100) Gen.alphaNum+                v <- forAll $ Gen.bytes (Range.linear 0 200)+                let msg = defaultAny {anyTypeUrl = tu, anyValue = v}+                    encoded = encodeMessage msg+                decodeMessage encoded === Right msg+            , it "packAny Timestamp roundtrip" $ property $ do+                s <- forAll $ Gen.int64 (Range.linear 0 2000000000)+                n <- forAll $ Gen.int32 (Range.linear 0 999999999)+                let ts = defaultTimestamp {timestampSeconds = s, timestampNanos = n}+                    packed = packAny ts+                anyTypeUrl packed === "type.googleapis.com/google.protobuf.Timestamp"+                case unpackAny packed of+                  Just (Right decoded) -> decoded === ts+                  Just (Left err) -> do annotate (show err); failure+                  Nothing -> do annotate "type mismatch"; failure+            , it "packAny Duration roundtrip" $ property $ do+                s <- forAll $ Gen.int64 (Range.linear 0 1000000)+                n <- forAll $ Gen.int32 (Range.linear 0 999999999)+                let dur = defaultDuration {durationSeconds = s, durationNanos = n}+                    packed = packAny dur+                case unpackAny packed of+                  Just (Right decoded) -> decoded === dur+                  _ -> failure+            , it "packAny Empty" $ do+                let packed = packAny defaultEmpty+                anyTypeUrl packed `shouldBe` "type.googleapis.com/google.protobuf.Empty"+                case unpackAny packed :: Maybe (Either DecodeError Empty) of+                  Just (Right _) -> pure ()+                  other -> expectationFailure ("Expected Just (Right Empty), got " <> show other)+            , it "unpackAny type mismatch returns Nothing" $ do+                let packed = packAny (defaultTimestamp {timestampSeconds = 100})+                case unpackAny packed :: Maybe (Either DecodeError Duration) of+                  Nothing -> pure ()+                  Just _ -> expectationFailure "Should not match Duration"+            , it "isMessageType" $ do+                let packed = packAny (defaultDuration {durationSeconds = 60})+                isMessageType (Proxy :: Proxy Duration) packed `shouldBe` True+                isMessageType (Proxy :: Proxy Timestamp) packed `shouldBe` False+            , it "typeNameFromUrl strips prefix" $ do+                typeNameFromUrl "type.googleapis.com/google.protobuf.Timestamp"+                  `shouldBe` "google.protobuf.Timestamp"+                typeNameFromUrl "mycompany.com/types/example.Foo"+                  `shouldBe` "example.Foo"+                typeNameFromUrl "google.protobuf.Timestamp"+                  `shouldBe` "google.protobuf.Timestamp"+            , it "packAnyWithPrefix custom prefix" $ do+                let packed = packAnyWithPrefix "myhost/" (defaultTimestamp {timestampSeconds = 1})+                anyTypeUrl packed `shouldBe` "myhost/google.protobuf.Timestamp"+                case unpackAny packed of+                  Just (Right ts) -> ts `shouldBe` defaultTimestamp {timestampSeconds = 1}+                  _ -> expectationFailure "Should unpack with any prefix"+            , it "Any wire roundtrip preserves content" $ do+                let ts = defaultTimestamp {timestampSeconds = 1234567890, timestampNanos = 500000000}+                    packed = packAny ts+                    encodedAny = encodeMessage packed+                case decodeMessage encodedAny of+                  Left err -> expectationFailure (show err)+                  Right decodedAny -> case unpackAny decodedAny of+                    Just (Right (decoded :: Timestamp)) -> decoded `shouldBe` ts+                    _ -> expectationFailure "Should unpack after wire roundtrip"+            , it "TypeRegistry codec lookup" $ do+                let registry =+                      registerMessage (Proxy :: Proxy Timestamp)+                        . registerMessage (Proxy :: Proxy Duration)+                        . registerMessage (Proxy :: Proxy Empty)+                        $ emptyRegistry+                case lookupDecoder @Timestamp "google.protobuf.Timestamp" registry of+                  Just decode' -> case decode' (encodeMessage (defaultTimestamp {timestampSeconds = 42})) of+                    Right ts -> timestampSeconds ts `shouldBe` 42+                    Left e -> expectationFailure (show e)+                  Nothing -> expectationFailure "Should find Timestamp decoder"+            , it "TypeRegistry unknown type returns Nothing" $ do+                let registry = registerMessage (Proxy :: Proxy Timestamp) emptyRegistry+                case lookupCodec "unknown.Type" registry of+                  Nothing -> pure ()+                  Just _ -> expectationFailure "Should return Nothing for unknown type"+            ]+      , describe+          "Empty"+          $ sequence_+            [ it "empty roundtrip" $ do+                let encoded = encodeMessage defaultEmpty+                BS.length encoded `shouldBe` 0+                case decodeMessage encoded :: Either DecodeError Empty of+                  Right _ -> pure ()+                  Left e -> expectationFailure (show e)+            ]+      , describe+          "Wrappers"+          $ sequence_+            [ it "Int64Value roundtrip" $ property $ do+                v <- forAll $ Gen.int64 Range.linearBounded+                let msg = defaultInt64Value {int64ValueValue = v}+                decodeMessage (encodeMessage msg) === Right msg+            , it "UInt64Value roundtrip" $ property $ do+                v <- forAll $ Gen.word64 (Range.linear 0 maxBound)+                let msg = defaultUInt64Value {uInt64ValueValue = v}+                decodeMessage (encodeMessage msg) === Right msg+            , it "Int32Value roundtrip" $ property $ do+                v <- forAll $ Gen.int32 Range.linearBounded+                let msg = defaultInt32Value {int32ValueValue = v}+                decodeMessage (encodeMessage msg) === Right msg+            , it "BoolValue roundtrip" $ property $ do+                v <- forAll Gen.bool+                let msg = defaultBoolValue {boolValueValue = v}+                decodeMessage (encodeMessage msg) === Right msg+            , it "StringValue roundtrip" $ property $ do+                v <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode+                let msg = defaultStringValue {stringValueValue = v}+                decodeMessage (encodeMessage msg) === Right msg+            , it "BytesValue roundtrip" $ property $ do+                v <- forAll $ Gen.bytes (Range.linear 0 200)+                let msg = defaultBytesValue {bytesValueValue = v}+                decodeMessage (encodeMessage msg) === Right msg+            , it "DoubleValue roundtrip" $ property $ do+                v <- forAll $ Gen.double (Range.linearFrac (-1e100) 1e100)+                let msg = defaultDoubleValue {doubleValueValue = v}+                decodeMessage (encodeMessage msg) === Right msg+            , it "FloatValue roundtrip" $ property $ do+                v <- forAll $ Gen.float (Range.linearFrac (-1e30) 1e30)+                let msg = defaultFloatValue {floatValueValue = v}+                decodeMessage (encodeMessage msg) === Right msg+            ]+      , describe+          "FieldMask"+          $ sequence_+            [ it "roundtrip" $ do+                let msg = defaultFieldMask {fieldMaskPaths = V.fromList ["foo.bar", "baz"]}+                    encoded = encodeMessage msg+                decodeMessage encoded `shouldBe` Right msg+            ]+      , describe+          "SourceContext"+          $ sequence_+            [ it "roundtrip" $ property $ do+                fn <- forAll $ Gen.text (Range.linear 0 100) Gen.alphaNum+                let msg = defaultSourceContext {sourceContextFileName = fn}+                decodeMessage (encodeMessage msg) === Right msg+            ]+      , describe+          "Struct"+          $ sequence_+            [ it "empty struct roundtrip" $ do+                let msg = defaultStruct+                decodeMessage (encodeMessage msg) `shouldBe` Right msg+            , it "value null roundtrip" $ do+                let v = defaultValue {valueKind = Just (Value'Kind'NullValue NullValue'NullValue)}+                decodeMessage (encodeMessage v) `shouldBe` Right v+            , it "value number roundtrip" $ do+                let v = defaultValue {valueKind = Just (Value'Kind'NumberValue 3.14)}+                decodeMessage (encodeMessage v) `shouldBe` Right v+            , it "value string roundtrip" $ do+                let v = defaultValue {valueKind = Just (Value'Kind'StringValue "hello")}+                decodeMessage (encodeMessage v) `shouldBe` Right v+            , it "value bool roundtrip" $ do+                let v = defaultValue {valueKind = Just (Value'Kind'BoolValue True)}+                decodeMessage (encodeMessage v) `shouldBe` Right v+            , it "list value roundtrip" $ do+                let lv =+                      defaultListValue+                        { listValueValues =+                            V.fromList+                              [ defaultValue {valueKind = Just (Value'Kind'NumberValue 1)}+                              , defaultValue {valueKind = Just (Value'Kind'StringValue "two")}+                              , defaultValue {valueKind = Just (Value'Kind'BoolValue False)}+                              ]+                        }+                decodeMessage (encodeMessage lv) `shouldBe` Right lv+            ]+      , describe+          "Exact-size encoding"+          $ sequence_+            [ it "encodeMessageSized matches encodeMessage for Timestamp" $ property $ do+                s <- forAll $ Gen.int64 (Range.linear 0 1000000)+                n <- forAll $ Gen.int32 (Range.linear 0 999999)+                let msg = defaultTimestamp {timestampSeconds = s, timestampNanos = n}+                encodeMessageSized msg === encodeMessage msg+            , it "encodeMessageSized matches encodeMessage for Duration" $ property $ do+                s <- forAll $ Gen.int64 (Range.linear 0 1000000)+                n <- forAll $ Gen.int32 (Range.linear 0 999999)+                let msg = defaultDuration {durationSeconds = s, durationNanos = n}+                encodeMessageSized msg === encodeMessage msg+            ]+      , describe+          "Hashable instances"+          $ sequence_+            [ it "Timestamp: equal values have equal hashes" $ property $ do+                s <- forAll $ Gen.int64 (Range.linear 0 1000000)+                n <- forAll $ Gen.int32 (Range.linear 0 999999)+                let msg = defaultTimestamp {timestampSeconds = s, timestampNanos = n}+                hash msg === hash msg+            , it "Timestamp: different values have different hashes" $ do+                let m1 = defaultTimestamp {timestampSeconds = 100}+                    m2 = defaultTimestamp {timestampSeconds = 200}+                (hash m1 /= hash m2) `shouldBe` True+            , it "Duration: hashWithSalt works" $ do+                let msg = defaultDuration {durationSeconds = 42, durationNanos = 123}+                hashWithSalt 0 msg `seq` pure () :: IO ()+            , it "Empty: hashable" $ do+                hash defaultEmpty `seq` pure () :: IO ()+            , it "FieldMask: hashable with vector field" $ property $ do+                ps <- forAll $ Gen.list (Range.linear 0 5) (Gen.text (Range.linear 1 10) Gen.alphaNum)+                let msg = defaultFieldMask {fieldMaskPaths = V.fromList ps}+                hash msg `seq` pure ()+            , it "Struct: hashable with map field" $ property $ do+                hash defaultStruct `seq` pure ()+            ]+      ]
test-integration/Test/WellKnownUtil.hs view
@@ -1,402 +1,361 @@ module Test.WellKnownUtil (wellKnownUtilTests) where +import Data.Aeson qualified as Aeson import Data.Int (Int32, Int64)-import Data.Proxy (Proxy(..))-import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map+import Data.Proxy (Proxy (..)) import Data.Text (Text)-import qualified Data.Text as T-import Data.Time.Clock (UTCTime, NominalDiffTime)+import Data.Text qualified as T+import Data.Time.Clock (NominalDiffTime, UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import qualified Data.Vector as V-import qualified Data.Aeson as Aeson+import Data.Vector qualified as V import Hedgehog-import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range-import Test.Tasty-import Test.Tasty.HUnit hiding (assert)-import Test.Tasty.Hedgehog+import Hedgehog.Gen qualified as Gen+import Hedgehog.Range qualified as Range+import Proto.Google.Protobuf.Duration+import Proto.Google.Protobuf.Duration.Util+import Proto.Google.Protobuf.FieldMask+import Proto.Google.Protobuf.FieldMask.Util+import Proto.Google.Protobuf.Struct+import Proto.Google.Protobuf.Struct.Util+import Proto.Google.Protobuf.Timestamp+import Proto.Google.Protobuf.Timestamp.Util+import Proto.Google.Protobuf.Wrappers+import Proto.Google.Protobuf.Wrappers.Util+import Test.Syd+import Test.Syd.Hedgehog () -import Proto.Google.Protobuf.WellKnownTypes.Timestamp-import Proto.Google.Protobuf.WellKnownTypes.Timestamp.Util-import Proto.Google.Protobuf.WellKnownTypes.Duration-import Proto.Google.Protobuf.WellKnownTypes.Duration.Util-import Proto.Google.Protobuf.WellKnownTypes.FieldMask-import Proto.Google.Protobuf.WellKnownTypes.FieldMask.Util-import Proto.Google.Protobuf.WellKnownTypes.Wrappers-import Proto.Google.Protobuf.WellKnownTypes.Wrappers.Util-import Proto.Google.Protobuf.WellKnownTypes.Struct-import Proto.Google.Protobuf.WellKnownTypes.Struct.Util -wellKnownUtilTests :: TestTree-wellKnownUtilTests = testGroup "Well-Known Type Utilities"-  [ timestampUtilTests-  , durationUtilTests-  , fieldMaskUtilTests-  , wrappersUtilTests-  , structUtilTests-  ]+wellKnownUtilTests :: Spec+wellKnownUtilTests =+  describe "Well-Known Type Utilities" $+    sequence_+      [ timestampUtilTests+      , durationUtilTests+      , fieldMaskUtilTests+      , wrappersUtilTests+      , structUtilTests+      ] + -- -------------------------------------------------------------------------- -- Timestamp.Util -- -------------------------------------------------------------------------- -timestampUtilTests :: TestTree-timestampUtilTests = testGroup "Timestamp.Util"-  [ testProperty "POSIXTime roundtrip" $ property $ do-      s <- forAll $ Gen.int64 (Range.linear 0 2000000000)-      n <- forAll $ Gen.int32 (Range.linear 0 999999999)-      let ts = defaultTimestamp { timestampSeconds = s, timestampNanos = n }-          rt = timestampFromPOSIXTime (timestampToPOSIXTime ts)-      timestampSeconds rt === s-      timestampNanos rt === n+timestampUtilTests :: Spec+timestampUtilTests =+  describe "Timestamp.Util" $+    sequence_+      [ it "POSIXTime roundtrip" $ property $ do+          s <- forAll $ Gen.int64 (Range.linear 0 2000000000)+          n <- forAll $ Gen.int32 (Range.linear 0 999999999)+          let ts = defaultTimestamp {timestampSeconds = s, timestampNanos = n}+              rt = timestampFromPOSIXTime (timestampToPOSIXTime ts)+          timestampSeconds rt === s+          timestampNanos rt === n+      , it "UTCTime roundtrip" $ property $ do+          s <- forAll $ Gen.int64 (Range.linear 0 2000000000)+          n <- forAll $ Gen.int32 (Range.linear 0 999999999)+          let ts = defaultTimestamp {timestampSeconds = s, timestampNanos = n}+              rt = timestampFromUTCTime (timestampToUTCTime ts)+          timestampSeconds rt === s+          timestampNanos rt === n+      , it "epoch is zero" $ do+          let ts = timestampFromPOSIXTime 0+          timestampSeconds ts `shouldBe` 0+          timestampNanos ts `shouldBe` 0+      , it "specific POSIX time" $ do+          let ts = timestampFromPOSIXTime 1708000000.5+          timestampSeconds ts `shouldBe` 1708000000+          timestampNanos ts `shouldBe` 500000000+      , it "addDuration" $ do+          let ts = defaultTimestamp {timestampSeconds = 100, timestampNanos = 500000000}+              dur = defaultDuration {durationSeconds = 1, durationNanos = 700000000}+              result = addDuration ts dur+          timestampSeconds result `shouldBe` 102+          timestampNanos result `shouldBe` 200000000+      , it "subtractTimestamps" $ do+          let a = defaultTimestamp {timestampSeconds = 102, timestampNanos = 200000000}+              b = defaultTimestamp {timestampSeconds = 100, timestampNanos = 500000000}+              dur = subtractTimestamps a b+          durationSeconds dur `shouldBe` 1+          durationNanos dur `shouldBe` 700000000+      , it "addDuration then subtract gives identity" $ property $ do+          s <- forAll $ Gen.int64 (Range.linear 0 1000000000)+          n <- forAll $ Gen.int32 (Range.linear 0 999999999)+          ds <- forAll $ Gen.int64 (Range.linear 0 1000000)+          dn <- forAll $ Gen.int32 (Range.linear 0 999999999)+          let ts = defaultTimestamp {timestampSeconds = s, timestampNanos = n}+              dur = defaultDuration {durationSeconds = ds, durationNanos = dn}+              result = subtractTimestamps (addDuration ts dur) ts+          durationToNanos result === durationToNanos dur+      , it "isValidTimestamp valid" $ do+          isValidTimestamp (defaultTimestamp {timestampSeconds = 0, timestampNanos = 0}) `shouldBe` True+          isValidTimestamp (defaultTimestamp {timestampSeconds = 1708000000, timestampNanos = 123456789}) `shouldBe` True+      , it "isValidTimestamp invalid nanos" $ do+          isValidTimestamp (defaultTimestamp {timestampSeconds = 0, timestampNanos = -1}) `shouldBe` False+          isValidTimestamp (defaultTimestamp {timestampSeconds = 0, timestampNanos = 1000000000}) `shouldBe` False+      , it "Ord is consistent with compareTimestamp" $ property $ do+          s1 <- forAll $ Gen.int64 (Range.linear 0 2000000000)+          n1 <- forAll $ Gen.int32 (Range.linear 0 999999999)+          s2 <- forAll $ Gen.int64 (Range.linear 0 2000000000)+          n2 <- forAll $ Gen.int32 (Range.linear 0 999999999)+          let ts1 = defaultTimestamp {timestampSeconds = s1, timestampNanos = n1}+              ts2 = defaultTimestamp {timestampSeconds = s2, timestampNanos = n2}+          compare ts1 ts2 === compareTimestamp ts1 ts2+      ] -  , testProperty "UTCTime roundtrip" $ property $ do-      s <- forAll $ Gen.int64 (Range.linear 0 2000000000)-      n <- forAll $ Gen.int32 (Range.linear 0 999999999)-      let ts = defaultTimestamp { timestampSeconds = s, timestampNanos = n }-          rt = timestampFromUTCTime (timestampToUTCTime ts)-      timestampSeconds rt === s-      timestampNanos rt === n -  , testCase "epoch is zero" $ do-      let ts = timestampFromPOSIXTime 0-      timestampSeconds ts @?= 0-      timestampNanos ts @?= 0--  , testCase "specific POSIX time" $ do-      let ts = timestampFromPOSIXTime 1708000000.5-      timestampSeconds ts @?= 1708000000-      timestampNanos ts @?= 500000000--  , testCase "addDuration" $ do-      let ts = defaultTimestamp { timestampSeconds = 100, timestampNanos = 500000000 }-          dur = defaultDuration { durationSeconds = 1, durationNanos = 700000000 }-          result = addDuration ts dur-      timestampSeconds result @?= 102-      timestampNanos result @?= 200000000--  , testCase "subtractTimestamps" $ do-      let a = defaultTimestamp { timestampSeconds = 102, timestampNanos = 200000000 }-          b = defaultTimestamp { timestampSeconds = 100, timestampNanos = 500000000 }-          dur = subtractTimestamps a b-      durationSeconds dur @?= 1-      durationNanos dur @?= 700000000--  , testProperty "addDuration then subtract gives identity" $ property $ do-      s <- forAll $ Gen.int64 (Range.linear 0 1000000000)-      n <- forAll $ Gen.int32 (Range.linear 0 999999999)-      ds <- forAll $ Gen.int64 (Range.linear 0 1000000)-      dn <- forAll $ Gen.int32 (Range.linear 0 999999999)-      let ts = defaultTimestamp { timestampSeconds = s, timestampNanos = n }-          dur = defaultDuration { durationSeconds = ds, durationNanos = dn }-          result = subtractTimestamps (addDuration ts dur) ts-      durationToNanos result === durationToNanos dur--  , testCase "isValidTimestamp valid" $ do-      isValidTimestamp (defaultTimestamp { timestampSeconds = 0, timestampNanos = 0 }) @?= True-      isValidTimestamp (defaultTimestamp { timestampSeconds = 1708000000, timestampNanos = 123456789 }) @?= True--  , testCase "isValidTimestamp invalid nanos" $ do-      isValidTimestamp (defaultTimestamp { timestampSeconds = 0, timestampNanos = -1 }) @?= False-      isValidTimestamp (defaultTimestamp { timestampSeconds = 0, timestampNanos = 1000000000 }) @?= False--  , testProperty "Ord is consistent with compareTimestamp" $ property $ do-      s1 <- forAll $ Gen.int64 (Range.linear 0 2000000000)-      n1 <- forAll $ Gen.int32 (Range.linear 0 999999999)-      s2 <- forAll $ Gen.int64 (Range.linear 0 2000000000)-      n2 <- forAll $ Gen.int32 (Range.linear 0 999999999)-      let ts1 = defaultTimestamp { timestampSeconds = s1, timestampNanos = n1 }-          ts2 = defaultTimestamp { timestampSeconds = s2, timestampNanos = n2 }-      compare ts1 ts2 === compareTimestamp ts1 ts2-  ]- -- -------------------------------------------------------------------------- -- Duration.Util -- -------------------------------------------------------------------------- -durationUtilTests :: TestTree-durationUtilTests = testGroup "Duration.Util"-  [ testProperty "NominalDiffTime roundtrip" $ property $ do-      s <- forAll $ Gen.int64 (Range.linear (-1000000) 1000000)-      n <- forAll $ Gen.int32 (Range.linear 0 999999999)-      let dur = defaultDuration { durationSeconds = s, durationNanos = n }-          rt = durationFromNominalDiffTime (durationToNominalDiffTime dur)-      durationToNanos rt === durationToNanos dur+durationUtilTests :: Spec+durationUtilTests =+  describe "Duration.Util" $+    sequence_+      [ it "NominalDiffTime roundtrip" $ property $ do+          s <- forAll $ Gen.int64 (Range.linear (-1000000) 1000000)+          n <- forAll $ Gen.int32 (Range.linear 0 999999999)+          let dur = defaultDuration {durationSeconds = s, durationNanos = n}+              rt = durationFromNominalDiffTime (durationToNominalDiffTime dur)+          durationToNanos rt === durationToNanos dur+      , it "durationFromSeconds" $ do+          let dur = durationFromSeconds 42+          durationSeconds dur `shouldBe` 42+          durationNanos dur `shouldBe` 0+      , it "durationFromMillis" $ do+          let dur = durationFromMillis 1500+          durationSeconds dur `shouldBe` 1+          durationNanos dur `shouldBe` 500000000+      , it "durationFromMillis negative" $ do+          let dur = durationFromMillis (-1500)+          durationSeconds dur `shouldBe` (-1)+          durationNanos dur `shouldBe` (-500000000)+      , it "durationFromMicros" $ do+          let dur = durationFromMicros 2500000+          durationSeconds dur `shouldBe` 2+          durationNanos dur `shouldBe` 500000000+      , it "durationFromNanos" $ do+          let dur = durationFromNanos 1500000000+          durationSeconds dur `shouldBe` 1+          durationNanos dur `shouldBe` 500000000+      , it "durationToMillis" $ do+          durationToMillis (defaultDuration {durationSeconds = 1, durationNanos = 500000000}) `shouldBe` 1500+      , it "durationToMicros" $ do+          durationToMicros (defaultDuration {durationSeconds = 1, durationNanos = 500000000}) `shouldBe` 1500000+      , it "durationToNanos" $ do+          durationToNanos (defaultDuration {durationSeconds = 1, durationNanos = 500000000}) `shouldBe` 1500000000+      , it "fromNanos . toNanos is identity" $ property $ do+          s <- forAll $ Gen.int64 (Range.linear (-1000000) 1000000)+          n <- forAll $ Gen.int32 (Range.linear 0 999999999)+          let dur = defaultDuration {durationSeconds = s, durationNanos = n}+          durationToNanos (durationFromNanos (durationToNanos dur)) === durationToNanos dur+      , it "addDurations" $ do+          let a = defaultDuration {durationSeconds = 1, durationNanos = 700000000}+              b = defaultDuration {durationSeconds = 2, durationNanos = 500000000}+          durationToNanos (addDurations a b) `shouldBe` 4200000000+      , it "negateDuration" $ do+          let dur = defaultDuration {durationSeconds = 1, durationNanos = 500000000}+              neg = negateDuration dur+          durationSeconds neg `shouldBe` (-1)+          durationNanos neg `shouldBe` (-500000000)+      , it "absDuration of negative" $ do+          let dur = defaultDuration {durationSeconds = (-3), durationNanos = (-500000000)}+              abs' = absDuration dur+          durationSeconds abs' `shouldBe` 3+          durationNanos abs' `shouldBe` 500000000+      , it "normalizeDuration" $ do+          let dur = defaultDuration {durationSeconds = 0, durationNanos = 2000000000}+              norm = normalizeDuration dur+          durationSeconds norm `shouldBe` 2+          durationNanos norm `shouldBe` 0+      , it "isValidDuration valid" $ do+          isValidDuration (defaultDuration {durationSeconds = 3600, durationNanos = 0}) `shouldBe` True+          isValidDuration (defaultDuration {durationSeconds = (-3600), durationNanos = 0}) `shouldBe` True+      , it "isValidDuration invalid sign mismatch" $ do+          isValidDuration (defaultDuration {durationSeconds = 1, durationNanos = (-500000000)}) `shouldBe` False+      , it "isValidDuration invalid range" $ do+          isValidDuration (defaultDuration {durationSeconds = 315576000001, durationNanos = 0}) `shouldBe` False+      , it "Ord is consistent with compareDuration" $ property $ do+          s1 <- forAll $ Gen.int64 (Range.linear (-1000000) 1000000)+          n1 <- forAll $ Gen.int32 (Range.linear 0 999999999)+          s2 <- forAll $ Gen.int64 (Range.linear (-1000000) 1000000)+          n2 <- forAll $ Gen.int32 (Range.linear 0 999999999)+          let d1 = defaultDuration {durationSeconds = s1, durationNanos = n1}+              d2 = defaultDuration {durationSeconds = s2, durationNanos = n2}+          compare d1 d2 === compareDuration d1 d2+      ] -  , testCase "durationFromSeconds" $ do-      let dur = durationFromSeconds 42-      durationSeconds dur @?= 42-      durationNanos dur @?= 0 -  , testCase "durationFromMillis" $ do-      let dur = durationFromMillis 1500-      durationSeconds dur @?= 1-      durationNanos dur @?= 500000000--  , testCase "durationFromMillis negative" $ do-      let dur = durationFromMillis (-1500)-      durationSeconds dur @?= (-1)-      durationNanos dur @?= (-500000000)--  , testCase "durationFromMicros" $ do-      let dur = durationFromMicros 2500000-      durationSeconds dur @?= 2-      durationNanos dur @?= 500000000--  , testCase "durationFromNanos" $ do-      let dur = durationFromNanos 1500000000-      durationSeconds dur @?= 1-      durationNanos dur @?= 500000000--  , testCase "durationToMillis" $ do-      durationToMillis (defaultDuration { durationSeconds = 1, durationNanos = 500000000 }) @?= 1500--  , testCase "durationToMicros" $ do-      durationToMicros (defaultDuration { durationSeconds = 1, durationNanos = 500000000 }) @?= 1500000--  , testCase "durationToNanos" $ do-      durationToNanos (defaultDuration { durationSeconds = 1, durationNanos = 500000000 }) @?= 1500000000--  , testProperty "fromNanos . toNanos is identity" $ property $ do-      s <- forAll $ Gen.int64 (Range.linear (-1000000) 1000000)-      n <- forAll $ Gen.int32 (Range.linear 0 999999999)-      let dur = defaultDuration { durationSeconds = s, durationNanos = n }-      durationToNanos (durationFromNanos (durationToNanos dur)) === durationToNanos dur--  , testCase "addDurations" $ do-      let a = defaultDuration { durationSeconds = 1, durationNanos = 700000000 }-          b = defaultDuration { durationSeconds = 2, durationNanos = 500000000 }-      durationToNanos (addDurations a b) @?= 4200000000--  , testCase "negateDuration" $ do-      let dur = defaultDuration { durationSeconds = 1, durationNanos = 500000000 }-          neg = negateDuration dur-      durationSeconds neg @?= (-1)-      durationNanos neg @?= (-500000000)--  , testCase "absDuration of negative" $ do-      let dur = defaultDuration { durationSeconds = (-3), durationNanos = (-500000000) }-          abs' = absDuration dur-      durationSeconds abs' @?= 3-      durationNanos abs' @?= 500000000--  , testCase "normalizeDuration" $ do-      let dur = defaultDuration { durationSeconds = 0, durationNanos = 2000000000 }-          norm = normalizeDuration dur-      durationSeconds norm @?= 2-      durationNanos norm @?= 0--  , testCase "isValidDuration valid" $ do-      isValidDuration (defaultDuration { durationSeconds = 3600, durationNanos = 0 }) @?= True-      isValidDuration (defaultDuration { durationSeconds = (-3600), durationNanos = 0 }) @?= True--  , testCase "isValidDuration invalid sign mismatch" $ do-      isValidDuration (defaultDuration { durationSeconds = 1, durationNanos = (-500000000) }) @?= False--  , testCase "isValidDuration invalid range" $ do-      isValidDuration (defaultDuration { durationSeconds = 315576000001, durationNanos = 0 }) @?= False--  , testProperty "Ord is consistent with compareDuration" $ property $ do-      s1 <- forAll $ Gen.int64 (Range.linear (-1000000) 1000000)-      n1 <- forAll $ Gen.int32 (Range.linear 0 999999999)-      s2 <- forAll $ Gen.int64 (Range.linear (-1000000) 1000000)-      n2 <- forAll $ Gen.int32 (Range.linear 0 999999999)-      let d1 = defaultDuration { durationSeconds = s1, durationNanos = n1 }-          d2 = defaultDuration { durationSeconds = s2, durationNanos = n2 }-      compare d1 d2 === compareDuration d1 d2-  ]- -- -------------------------------------------------------------------------- -- FieldMask.Util -- -------------------------------------------------------------------------- -fieldMaskUtilTests :: TestTree-fieldMaskUtilTests = testGroup "FieldMask.Util"-  [ testCase "fromPaths / toPaths" $ do-      let fm = fromPaths ["a", "b.c"]-      toPaths fm @?= ["a", "b.c"]+fieldMaskUtilTests :: Spec+fieldMaskUtilTests =+  describe "FieldMask.Util" $+    sequence_+      [ it "fromPaths / toPaths" $ do+          let fm = fromPaths ["a", "b.c"]+          toPaths fm `shouldBe` ["a", "b.c"]+      , it "union deduplicates" $ do+          let a = fromPaths ["x", "y"]+              b = fromPaths ["y", "z"]+          toPaths (union a b) `shouldBe` ["x", "y", "z"]+      , it "union removes sub-paths" $ do+          let a = fromPaths ["a.b"]+              b = fromPaths ["a"]+          toPaths (union a b) `shouldBe` ["a"]+      , it "intersection" $ do+          let a = fromPaths ["x", "y"]+              b = fromPaths ["y", "z"]+          toPaths (intersection a b) `shouldBe` ["y"]+      , it "intersection with parent coverage" $ do+          let a = fromPaths ["a"]+              b = fromPaths ["a.b"]+          toPaths (intersection a b) `shouldBe` ["a.b"]+      , it "subtractMask" $ do+          let a = fromPaths ["x", "y", "z"]+              b = fromPaths ["y"]+          toPaths (subtractMask a b) `shouldBe` ["x", "z"]+      , it "normalize sorts and deduplicates" $ do+          let fm = fromPaths ["c", "a", "b", "a"]+          toPaths (normalize fm) `shouldBe` ["a", "b", "c"]+      , it "normalize removes sub-paths" $ do+          let fm = fromPaths ["a.b.c", "a.b", "a", "d"]+          toPaths (normalize fm) `shouldBe` ["a", "d"]+      , it "contains direct" $ do+          contains (fromPaths ["a", "b"]) "a" `shouldBe` True+          contains (fromPaths ["a", "b"]) "c" `shouldBe` False+      , it "contains parent covers child" $ do+          contains (fromPaths ["a"]) "a.b.c" `shouldBe` True+          contains (fromPaths ["a.b"]) "a" `shouldBe` False+      , it "isEmpty" $ do+          isEmpty (fromPaths []) `shouldBe` True+          isEmpty (fromPaths ["a"]) `shouldBe` False+      , it "allFieldMask for Timestamp" $ do+          let fm = allFieldMask (Proxy :: Proxy Timestamp)+              paths = toPaths fm+          ("seconds" `elem` paths) `shouldBe` True+          ("nanos" `elem` paths) `shouldBe` True+      , it "isValid against Timestamp" $ do+          isValid (Proxy :: Proxy Timestamp) (fromPaths ["seconds"]) `shouldBe` True+          isValid (Proxy :: Proxy Timestamp) (fromPaths ["seconds", "nanos"]) `shouldBe` True+          isValid (Proxy :: Proxy Timestamp) (fromPaths ["nonexistent"]) `shouldBe` False+      , it "isValid accepts sub-paths when top-level matches" $ do+          isValid (Proxy :: Proxy Timestamp) (fromPaths ["seconds.foo"]) `shouldBe` True+      , it "canonicalForm" $ do+          canonicalForm (fromPaths ["c", "a.b", "a"]) `shouldBe` "a,c"+      , it "toCamelCase" $ do+          toCamelCase "foo_bar" `shouldBe` "fooBar"+          toCamelCase "foo_bar.baz_qux" `shouldBe` "fooBar.bazQux"+          toCamelCase "simple" `shouldBe` "simple"+      , it "toSnakeCase" $ do+          toSnakeCase "fooBar" `shouldBe` "foo_bar"+          toSnakeCase "fooBar.bazQux" `shouldBe` "foo_bar.baz_qux"+          toSnakeCase "simple" `shouldBe` "simple"+      ] -  , testCase "union deduplicates" $ do-      let a = fromPaths ["x", "y"]-          b = fromPaths ["y", "z"]-      toPaths (union a b) @?= ["x", "y", "z"] -  , testCase "union removes sub-paths" $ do-      let a = fromPaths ["a.b"]-          b = fromPaths ["a"]-      toPaths (union a b) @?= ["a"]--  , testCase "intersection" $ do-      let a = fromPaths ["x", "y"]-          b = fromPaths ["y", "z"]-      toPaths (intersection a b) @?= ["y"]--  , testCase "intersection with parent coverage" $ do-      let a = fromPaths ["a"]-          b = fromPaths ["a.b"]-      toPaths (intersection a b) @?= ["a.b"]--  , testCase "subtractMask" $ do-      let a = fromPaths ["x", "y", "z"]-          b = fromPaths ["y"]-      toPaths (subtractMask a b) @?= ["x", "z"]--  , testCase "normalize sorts and deduplicates" $ do-      let fm = fromPaths ["c", "a", "b", "a"]-      toPaths (normalize fm) @?= ["a", "b", "c"]--  , testCase "normalize removes sub-paths" $ do-      let fm = fromPaths ["a.b.c", "a.b", "a", "d"]-      toPaths (normalize fm) @?= ["a", "d"]--  , testCase "contains direct" $ do-      contains (fromPaths ["a", "b"]) "a" @?= True-      contains (fromPaths ["a", "b"]) "c" @?= False--  , testCase "contains parent covers child" $ do-      contains (fromPaths ["a"]) "a.b.c" @?= True-      contains (fromPaths ["a.b"]) "a" @?= False--  , testCase "isEmpty" $ do-      isEmpty (fromPaths []) @?= True-      isEmpty (fromPaths ["a"]) @?= False--  , testCase "allFieldMask for Timestamp" $ do-      let fm = allFieldMask (Proxy :: Proxy Timestamp)-          paths = toPaths fm-      assertBool "contains seconds" ("seconds" `elem` paths)-      assertBool "contains nanos" ("nanos" `elem` paths)--  , testCase "isValid against Timestamp" $ do-      isValid (Proxy :: Proxy Timestamp) (fromPaths ["seconds"]) @?= True-      isValid (Proxy :: Proxy Timestamp) (fromPaths ["seconds", "nanos"]) @?= True-      isValid (Proxy :: Proxy Timestamp) (fromPaths ["nonexistent"]) @?= False--  , testCase "isValid accepts sub-paths when top-level matches" $ do-      isValid (Proxy :: Proxy Timestamp) (fromPaths ["seconds.foo"]) @?= True--  , testCase "canonicalForm" $ do-      canonicalForm (fromPaths ["c", "a.b", "a"]) @?= "a,c"--  , testCase "toCamelCase" $ do-      toCamelCase "foo_bar" @?= "fooBar"-      toCamelCase "foo_bar.baz_qux" @?= "fooBar.bazQux"-      toCamelCase "simple" @?= "simple"--  , testCase "toSnakeCase" $ do-      toSnakeCase "fooBar" @?= "foo_bar"-      toSnakeCase "fooBar.bazQux" @?= "foo_bar.baz_qux"-      toSnakeCase "simple" @?= "simple"-  ]- -- -------------------------------------------------------------------------- -- Wrappers.Util -- -------------------------------------------------------------------------- -wrappersUtilTests :: TestTree-wrappersUtilTests = testGroup "Wrappers.Util"-  [ testProperty "DoubleValue roundtrip" $ property $ do-      v <- forAll $ Gen.double (Range.linearFrac (-1e10) 1e10)-      fromDoubleValue (toDoubleValue v) === v+wrappersUtilTests :: Spec+wrappersUtilTests =+  describe "Wrappers.Util" $+    sequence_+      [ it "DoubleValue roundtrip" $ property $ do+          v <- forAll $ Gen.double (Range.linearFrac (-1e10) 1e10)+          fromDoubleValue (toDoubleValue v) === v+      , it "FloatValue roundtrip" $ property $ do+          v <- forAll $ Gen.float (Range.linearFrac (-1e5) 1e5)+          fromFloatValue (toFloatValue v) === v+      , it "Int64Value roundtrip" $ property $ do+          v <- forAll $ Gen.int64 Range.linearBounded+          fromInt64Value (toInt64Value v) === v+      , it "UInt64Value roundtrip" $ property $ do+          v <- forAll $ Gen.word64 (Range.linear 0 maxBound)+          fromUInt64Value (toUInt64Value v) === v+      , it "Int32Value roundtrip" $ property $ do+          v <- forAll $ Gen.int32 Range.linearBounded+          fromInt32Value (toInt32Value v) === v+      , it "UInt32Value roundtrip" $ property $ do+          v <- forAll $ Gen.word32 (Range.linear 0 maxBound)+          fromUInt32Value (toUInt32Value v) === v+      , it "BoolValue roundtrip" $ property $ do+          v <- forAll Gen.bool+          fromBoolValue (toBoolValue v) === v+      , it "StringValue roundtrip" $ property $ do+          v <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode+          fromStringValue (toStringValue v) === v+      , it "BytesValue roundtrip" $ property $ do+          v <- forAll $ Gen.bytes (Range.linear 0 100)+          fromBytesValue (toBytesValue v) === v+      , it "Maybe conversions" $ do+          doubleValueToMaybe (maybeToDoubleValue (Just 3.14)) `shouldBe` Just 3.14+          doubleValueToMaybe (maybeToDoubleValue Nothing) `shouldBe` Nothing+          int64ValueToMaybe (maybeToInt64Value (Just 42)) `shouldBe` Just 42+          boolValueToMaybe (maybeToBoolValue (Just True)) `shouldBe` Just True+          stringValueToMaybe (maybeToStringValue (Just "hello")) `shouldBe` Just "hello"+          bytesValueToMaybe (maybeToBytesValue (Just "bytes")) `shouldBe` Just "bytes"+      ] -  , testProperty "FloatValue roundtrip" $ property $ do-      v <- forAll $ Gen.float (Range.linearFrac (-1e5) 1e5)-      fromFloatValue (toFloatValue v) === v -  , testProperty "Int64Value roundtrip" $ property $ do-      v <- forAll $ Gen.int64 Range.linearBounded-      fromInt64Value (toInt64Value v) === v--  , testProperty "UInt64Value roundtrip" $ property $ do-      v <- forAll $ Gen.word64 (Range.linear 0 maxBound)-      fromUInt64Value (toUInt64Value v) === v--  , testProperty "Int32Value roundtrip" $ property $ do-      v <- forAll $ Gen.int32 Range.linearBounded-      fromInt32Value (toInt32Value v) === v--  , testProperty "UInt32Value roundtrip" $ property $ do-      v <- forAll $ Gen.word32 (Range.linear 0 maxBound)-      fromUInt32Value (toUInt32Value v) === v--  , testProperty "BoolValue roundtrip" $ property $ do-      v <- forAll Gen.bool-      fromBoolValue (toBoolValue v) === v--  , testProperty "StringValue roundtrip" $ property $ do-      v <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode-      fromStringValue (toStringValue v) === v--  , testProperty "BytesValue roundtrip" $ property $ do-      v <- forAll $ Gen.bytes (Range.linear 0 100)-      fromBytesValue (toBytesValue v) === v--  , testCase "Maybe conversions" $ do-      doubleValueToMaybe (maybeToDoubleValue (Just 3.14)) @?= Just 3.14-      doubleValueToMaybe (maybeToDoubleValue Nothing) @?= Nothing-      int64ValueToMaybe (maybeToInt64Value (Just 42)) @?= Just 42-      boolValueToMaybe (maybeToBoolValue (Just True)) @?= Just True-      stringValueToMaybe (maybeToStringValue (Just "hello")) @?= Just "hello"-      bytesValueToMaybe (maybeToBytesValue (Just "bytes")) @?= Just "bytes"-  ]- -- -------------------------------------------------------------------------- -- Struct.Util -- -------------------------------------------------------------------------- -structUtilTests :: TestTree-structUtilTests = testGroup "Struct.Util"-  [ testCase "fromPairs / toMap" $ do-      let s = fromPairs [("x", numberValue 1), ("y", stringValue "hello")]-      Map.size (toMap s) @?= 2--  , testCase "nullValue extraction" $ do-      asNull nullValue @?= Just ()-      asNull (numberValue 1) @?= Nothing--  , testCase "numberValue extraction" $ do-      asNumber (numberValue 3.14) @?= Just 3.14-      asNumber (stringValue "nope") @?= Nothing--  , testCase "stringValue extraction" $ do-      asString (stringValue "hello") @?= Just "hello"-      asString (boolValue True) @?= Nothing--  , testCase "boolValue extraction" $ do-      asBool (boolValue True) @?= Just True-      asBool nullValue @?= Nothing--  , testCase "structValue extraction" $ do-      let inner = fromPairs [("k", numberValue 42)]-          v = structValue inner-      case asStruct v of-        Just s -> Map.size (toMap s) @?= 1-        Nothing -> assertFailure "expected struct"--  , testCase "listValue extraction" $ do-      let v = listValue [numberValue 1, numberValue 2, numberValue 3]-      case asList v of-        Just vs -> length vs @?= 3-        Nothing -> assertFailure "expected list"--  , testCase "Aeson roundtrip via Value" $ do-      let original = Aeson.object-            [ "name" Aeson..= ("test" :: Text)-            , "count" Aeson..= (42 :: Int)-            , "active" Aeson..= True-            , "tags" Aeson..= (["a", "b"] :: [Text])-            , "nothing" Aeson..= Aeson.Null-            ]-          pbValue = valueFromAeson original-          back = valueToAeson pbValue-      back @?= original--  , testCase "Aeson roundtrip via Struct" $ do-      let original = Aeson.object-            [ "x" Aeson..= (1.0 :: Double)-            , "y" Aeson..= ("hello" :: Text)-            ]-          s = structFromAeson original-          back = structToAeson s-      back @?= original-  ]+structUtilTests :: Spec+structUtilTests =+  describe "Struct.Util" $+    sequence_+      [ it "fromPairs / toMap" $ do+          let s = fromPairs [("x", numberValue 1), ("y", stringValue "hello")]+          Map.size (toMap s) `shouldBe` 2+      , it "nullValue extraction" $ do+          asNull nullValue `shouldBe` Just ()+          asNull (numberValue 1) `shouldBe` Nothing+      , it "numberValue extraction" $ do+          asNumber (numberValue 3.14) `shouldBe` Just 3.14+          asNumber (stringValue "nope") `shouldBe` Nothing+      , it "stringValue extraction" $ do+          asString (stringValue "hello") `shouldBe` Just "hello"+          asString (boolValue True) `shouldBe` Nothing+      , it "boolValue extraction" $ do+          asBool (boolValue True) `shouldBe` Just True+          asBool nullValue `shouldBe` Nothing+      , it "structValue extraction" $ do+          let inner = fromPairs [("k", numberValue 42)]+              v = structValue inner+          case asStruct v of+            Just s -> Map.size (toMap s) `shouldBe` 1+            Nothing -> expectationFailure "expected struct"+      , it "listValue extraction" $ do+          let v = listValue [numberValue 1, numberValue 2, numberValue 3]+          case asList v of+            Just vs -> length vs `shouldBe` 3+            Nothing -> expectationFailure "expected list"+      , it "Aeson roundtrip via Value" $ do+          let original =+                Aeson.object+                  [ "name" Aeson..= ("test" :: Text)+                  , "count" Aeson..= (42 :: Int)+                  , "active" Aeson..= True+                  , "tags" Aeson..= (["a", "b"] :: [Text])+                  , "nothing" Aeson..= Aeson.Null+                  ]+              pbValue = valueFromAeson original+              back = valueToAeson pbValue+          back `shouldBe` original+      , it "Aeson roundtrip via Struct" $ do+          let original =+                Aeson.object+                  [ "x" Aeson..= (1.0 :: Double)+                  , "y" Aeson..= ("hello" :: Text)+                  ]+              s = structFromAeson original+              back = structToAeson s+          back `shouldBe` original+      ]
test-integration/Test/Wire.hs view
@@ -11,304 +11,319 @@ import Proto.Internal.Wire import Proto.Internal.Wire.Decode import Proto.Internal.Wire.Encode-import Test.Tasty-import Test.Tasty.HUnit hiding (assert)-import Test.Tasty.Hedgehog+import Test.Syd+import Test.Syd.Hedgehog () import Wireform.Builder qualified as B  -wireTests :: TestTree+wireTests :: Spec wireTests =-  testGroup+  describe     "Wire Format"-    [ testGroup-        "Varint encoding/decoding"-        [ testCase "encode 0" $ do-            let bs = buildToBS (putVarint 0)-            bs @?= BS.pack [0x00]-        , testCase "encode 1" $ do-            let bs = buildToBS (putVarint 1)-            bs @?= BS.pack [0x01]-        , testCase "encode 127" $ do-            let bs = buildToBS (putVarint 127)-            bs @?= BS.pack [0x7F]-        , testCase "encode 128" $ do-            let bs = buildToBS (putVarint 128)-            bs @?= BS.pack [0x80, 0x01]-        , testCase "encode 300" $ do-            let bs = buildToBS (putVarint 300)-            bs @?= BS.pack [0xAC, 0x02]-        , testCase "encode 16384" $ do-            let bs = buildToBS (putVarint 16384)-            bs @?= BS.pack [0x80, 0x80, 0x01]-        , testCase "decode 0" $ do-            let bs = BS.pack [0x00]-            runDecoder getVarint bs @?= Right 0-        , testCase "decode 1" $ do-            let bs = BS.pack [0x01]-            runDecoder getVarint bs @?= Right 1-        , testCase "decode 300" $ do-            let bs = BS.pack [0xAC, 0x02]-            runDecoder getVarint bs @?= Right 300-        , testProperty "varint roundtrip" $ property $ do-            n <- forAll $ Gen.word64 (Range.linear 0 maxBound)-            let encoded = buildToBS (putVarint n)-            runDecoder getVarint encoded === Right n-        , testProperty "varint size bound" $ property $ do-            n <- forAll $ Gen.word64 (Range.linear 0 maxBound)-            let encoded = buildToBS (putVarint n)-            assert (BS.length encoded <= 10)-        ]-    , testGroup-        "ZigZag encoding"-        [ testCase "zigzag 0" $ zigZag32 0 @?= 0-        , testCase "zigzag -1" $ zigZag32 (-1) @?= 1-        , testCase "zigzag 1" $ zigZag32 1 @?= 2-        , testCase "zigzag -2" $ zigZag32 (-2) @?= 3-        , testProperty "zigzag32 roundtrip" $ property $ do-            n <- forAll $ Gen.int32 Range.linearBounded-            unZigZag32 (zigZag32 n) === n-        , testProperty "zigzag64 roundtrip" $ property $ do-            n <- forAll $ Gen.int64 Range.linearBounded-            unZigZag64 (zigZag64 n) === n-        , testProperty "sint32 roundtrip" $ property $ do-            n <- forAll $ Gen.int32 Range.linearBounded-            let encoded = buildToBS (putSVarint32 n)-            runDecoder getSVarint32 encoded === Right n-        , testProperty "sint64 roundtrip" $ property $ do-            n <- forAll $ Gen.int64 Range.linearBounded-            let encoded = buildToBS (putSVarint64 n)-            runDecoder getSVarint64 encoded === Right n-        ]-    , testGroup-        "Fixed-width encoding"-        [ testProperty "fixed32 roundtrip" $ property $ do-            n <- forAll $ Gen.word32 Range.linearBounded-            let encoded = buildToBS (putFixed32 n)-            assert (BS.length encoded == 4)-            runDecoder getFixed32 encoded === Right n-        , testProperty "fixed64 roundtrip" $ property $ do-            n <- forAll $ Gen.word64 Range.linearBounded-            let encoded = buildToBS (putFixed64 n)-            assert (BS.length encoded == 8)-            runDecoder getFixed64 encoded === Right n-        , testProperty "float roundtrip" $ property $ do-            n <- forAll $ Gen.float (Range.linearFrac (-1e30) 1e30)-            let encoded = buildToBS (putFloat n)-            runDecoder getFloat encoded === Right n-        , testProperty "double roundtrip" $ property $ do-            n <- forAll $ Gen.double (Range.linearFrac (-1e300) 1e300)-            let encoded = buildToBS (putDouble n)-            runDecoder getDouble encoded === Right n-        ]-    , testGroup-        "Length-delimited"-        [ testProperty "bytestring roundtrip" $ property $ do-            bs <- forAll $ Gen.bytes (Range.linear 0 1000)-            let encoded = buildToBS (putByteString bs)-            runDecoder getByteString encoded === Right bs-        , testProperty "text roundtrip" $ property $ do-            t <- forAll $ Gen.text (Range.linear 0 200) Gen.unicode-            let encoded = buildToBS (putText t)-            runDecoder getText encoded === Right t-        , testCase "zero-copy bytestring" $ do-            let payload = "hello world"-                encoded = buildToBS (putByteString payload)-            case runDecoder getByteString encoded of-              Right decoded -> decoded @?= payload-              Left e -> assertFailure (show e)-        ]-    , testGroup-        "Tag encoding"-        [ testCase "tag field 1 varint" $ do-            let tag = makeTag 1 WireVarint-            encodeTag tag @?= 0x08-        , testCase "tag field 1 length-delimited" $ do-            let tag = makeTag 1 WireLengthDelimited-            encodeTag tag @?= 0x0A-        , testCase "tag field 2 varint" $ do-            let tag = makeTag 2 WireVarint-            encodeTag tag @?= 0x10-        , testProperty "tag roundtrip" $ property $ do-            fn <- forAll $ Gen.int (Range.linear 1 ((2 :: Int) ^ (29 :: Int) - 1))-            wt <- forAll $ Gen.element [WireVarint, Wire64Bit, WireLengthDelimited, Wire32Bit]-            let tag = makeTag fn wt-                encoded = encodeTag tag-            decodeTag encoded === Just tag-        ]-    , testGroup-        "Skip unknown fields"-        [ testCase "skip varint" $ do-            let bs = buildToBS (putVarint 12345)-            case runDecoder (skipField WireVarint) bs of-              Right () -> pure ()-              Left e -> assertFailure (show e)-        , testCase "skip fixed32" $ do-            let bs = buildToBS (putFixed32 42)-            case runDecoder (skipField Wire32Bit) bs of-              Right () -> pure ()-              Left e -> assertFailure (show e)-        , testCase "skip fixed64" $ do-            let bs = buildToBS (putFixed64 42)-            case runDecoder (skipField Wire64Bit) bs of-              Right () -> pure ()-              Left e -> assertFailure (show e)-        , testCase "skip length-delimited" $ do-            let bs = buildToBS (putByteString "hello")-            case runDecoder (skipField WireLengthDelimited) bs of-              Right () -> pure ()-              Left e -> assertFailure (show e)-        ]-    , testGroup-        "Error handling"-        [ testCase "unexpected end on varint" $ do-            runDecoder getVarint BS.empty @?= Left UnexpectedEnd-        , testCase "unexpected end on fixed32" $ do-            runDecoder getFixed32 (BS.pack [1, 2]) @?= Left UnexpectedEnd-        , testCase "unexpected end on fixed64" $ do-            runDecoder getFixed64 (BS.pack [1, 2, 3, 4]) @?= Left UnexpectedEnd-        , testCase "extra bytes after decode" $ do-            let bs = BS.pack [0x00, 0xFF]-            case runDecoder getVarint bs of-              Left ExtraBytes -> pure ()-              other -> assertFailure ("Expected ExtraBytes, got: " <> show other)-        ]-    , testGroup-        "Protobuf spec conformance vectors"-        [ testGroup-            "Varint edge cases"-            [ testCase "varint 0 = [0x00]" $-                buildToBS (putVarint 0) @?= BS.pack [0x00]-            , testCase "varint 1 = [0x01]" $-                buildToBS (putVarint 1) @?= BS.pack [0x01]-            , testCase "varint max uint64 (10 bytes)" $ do-                let bs = buildToBS (putVarint (maxBound :: Word64))-                BS.length bs @?= 10-                runDecoder getVarint bs @?= Right (maxBound :: Word64)-            , testCase "varint 150 = [0x96, 0x01]" $-                buildToBS (putVarint 150) @?= BS.pack [0x96, 0x01]-            , testCase "negative int32 as 10-byte varint" $ do-                let n = fromIntegral (-1 :: Int32) :: Word64-                    bs = buildToBS (putVarint n)-                BS.length bs @?= 10-                runDecoder getVarint bs @?= Right n-            , testCase "negative int32 -150 via zigzag" $ do-                let n = -150 :: Int32-                    bs = buildToBS (putSVarint32 n)-                runDecoder getSVarint32 bs @?= Right n+    $ sequence_+      [ describe+          "Varint encoding/decoding"+          $ sequence_+            [ it "encode 0" $ do+                let bs = buildToBS (putVarint 0)+                bs `shouldBe` BS.pack [0x00]+            , it "encode 1" $ do+                let bs = buildToBS (putVarint 1)+                bs `shouldBe` BS.pack [0x01]+            , it "encode 127" $ do+                let bs = buildToBS (putVarint 127)+                bs `shouldBe` BS.pack [0x7F]+            , it "encode 128" $ do+                let bs = buildToBS (putVarint 128)+                bs `shouldBe` BS.pack [0x80, 0x01]+            , it "encode 300" $ do+                let bs = buildToBS (putVarint 300)+                bs `shouldBe` BS.pack [0xAC, 0x02]+            , it "encode 16384" $ do+                let bs = buildToBS (putVarint 16384)+                bs `shouldBe` BS.pack [0x80, 0x80, 0x01]+            , it "decode 0" $ do+                let bs = BS.pack [0x00]+                runDecoder getVarint bs `shouldBe` Right 0+            , it "decode 1" $ do+                let bs = BS.pack [0x01]+                runDecoder getVarint bs `shouldBe` Right 1+            , it "decode 300" $ do+                let bs = BS.pack [0xAC, 0x02]+                runDecoder getVarint bs `shouldBe` Right 300+            , it "varint roundtrip" $ property $ do+                n <- forAll $ Gen.word64 (Range.linear 0 maxBound)+                let encoded = buildToBS (putVarint n)+                runDecoder getVarint encoded === Right n+            , it "varint size bound" $ property $ do+                n <- forAll $ Gen.word64 (Range.linear 0 maxBound)+                let encoded = buildToBS (putVarint n)+                assert (BS.length encoded <= 10)             ]-        , testGroup-            "Fixed-width exact bytes"-            [ testCase "fixed32 little-endian 1" $-                buildToBS (putFixed32 1) @?= BS.pack [0x01, 0x00, 0x00, 0x00]-            , testCase "fixed32 little-endian 256" $-                buildToBS (putFixed32 256) @?= BS.pack [0x00, 0x01, 0x00, 0x00]-            , testCase "fixed64 little-endian 1" $-                buildToBS (putFixed64 1) @?= BS.pack [0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00]-            , testCase "float 0.0 = [0,0,0,0]" $-                buildToBS (putFloat 0.0) @?= BS.pack [0x00, 0x00, 0x00, 0x00]-            , testCase "double 0.0 = 8 zero bytes" $-                buildToBS (putDouble 0.0) @?= BS.pack [0, 0, 0, 0, 0, 0, 0, 0]+      , describe+          "ZigZag encoding"+          $ sequence_+            [ it "zigzag 0" $ zigZag32 0 `shouldBe` 0+            , it "zigzag -1" $ zigZag32 (-1) `shouldBe` 1+            , it "zigzag 1" $ zigZag32 1 `shouldBe` 2+            , it "zigzag -2" $ zigZag32 (-2) `shouldBe` 3+            , it "zigzag32 roundtrip" $ property $ do+                n <- forAll $ Gen.int32 Range.linearBounded+                unZigZag32 (zigZag32 n) === n+            , it "zigzag64 roundtrip" $ property $ do+                n <- forAll $ Gen.int64 Range.linearBounded+                unZigZag64 (zigZag64 n) === n+            , it "sint32 roundtrip" $ property $ do+                n <- forAll $ Gen.int32 Range.linearBounded+                let encoded = buildToBS (putSVarint32 n)+                runDecoder getSVarint32 encoded === Right n+            , it "sint64 roundtrip" $ property $ do+                n <- forAll $ Gen.int64 Range.linearBounded+                let encoded = buildToBS (putSVarint64 n)+                runDecoder getSVarint64 encoded === Right n             ]-        , testGroup-            "Packed repeated fields"-            [ testCase "empty packed = just length 0" $ do-                let bs = buildToBS (putLengthDelimited BS.empty)-                runDecoder getByteString bs @?= Right BS.empty-            , testCase "packed varints [1,2,3]" $ do-                let payload = buildToBS (putVarint 1 <> putVarint 2 <> putVarint 3)-                    bs = buildToBS (putLengthDelimited payload)-                case runDecoder getByteString bs of-                  Right inner -> BS.length inner @?= 3-                  Left e -> assertFailure (show e)-            , testCase "packed fixed32 [1,2]" $ do-                let payload = buildToBS (putFixed32 1 <> putFixed32 2)-                    bs = buildToBS (putLengthDelimited payload)-                case runDecoder getByteString bs of-                  Right inner -> BS.length inner @?= 8-                  Left e -> assertFailure (show e)+      , describe+          "Fixed-width encoding"+          $ sequence_+            [ it "fixed32 roundtrip" $ property $ do+                n <- forAll $ Gen.word32 Range.linearBounded+                let encoded = buildToBS (putFixed32 n)+                assert (BS.length encoded == 4)+                runDecoder getFixed32 encoded === Right n+            , it "fixed64 roundtrip" $ property $ do+                n <- forAll $ Gen.word64 Range.linearBounded+                let encoded = buildToBS (putFixed64 n)+                assert (BS.length encoded == 8)+                runDecoder getFixed64 encoded === Right n+            , it "float roundtrip" $ property $ do+                n <- forAll $ Gen.float (Range.linearFrac (-1e30) 1e30)+                let encoded = buildToBS (putFloat n)+                runDecoder getFloat encoded === Right n+            , it "double roundtrip" $ property $ do+                n <- forAll $ Gen.double (Range.linearFrac (-1e300) 1e300)+                let encoded = buildToBS (putDouble n)+                runDecoder getDouble encoded === Right n             ]-        , testGroup-            "Tag format correctness"-            [ testCase "field 1 varint = 0x08" $-                encodeTag (makeTag 1 WireVarint) @?= 0x08-            , testCase "field 1 64-bit = 0x09" $-                encodeTag (makeTag 1 Wire64Bit) @?= 0x09-            , testCase "field 1 length-delimited = 0x0A" $-                encodeTag (makeTag 1 WireLengthDelimited) @?= 0x0A-            , testCase "field 1 32-bit = 0x0D" $-                encodeTag (makeTag 1 Wire32Bit) @?= 0x0D-            , testCase "field 2 varint = 0x10" $-                encodeTag (makeTag 2 WireVarint) @?= 0x10-            , testCase "field 15 varint = 0x78" $-                encodeTag (makeTag 15 WireVarint) @?= 0x78-            , testCase "field 16 varint = 0x80 0x01 (2-byte tag)" $ do-                let tag = makeTag 16 WireVarint-                    encoded = encodeTag tag-                encoded @?= 0x80+      , describe+          "Length-delimited"+          $ sequence_+            [ it "bytestring roundtrip" $ property $ do+                bs <- forAll $ Gen.bytes (Range.linear 0 1000)+                let encoded = buildToBS (putByteString bs)+                runDecoder getByteString encoded === Right bs+            , it "text roundtrip" $ property $ do+                t <- forAll $ Gen.text (Range.linear 0 200) Gen.unicode+                let encoded = buildToBS (putText t)+                runDecoder getText encoded === Right t+            , it "zero-copy bytestring" $ do+                let payload = "hello world"+                    encoded = buildToBS (putByteString payload)+                case runDecoder getByteString encoded of+                  Right decoded -> decoded `shouldBe` payload+                  Left e -> expectationFailure (show e)             ]-        , testGroup-            "Nested messages (length-delimited)"-            [ testCase "3-level nesting roundtrip" $ do-                let inner = buildToBS (putTag 1 WireVarint <> putVarint 42)-                    mid = buildToBS (putTag 1 WireLengthDelimited <> putByteString inner)-                    outer = buildToBS (putTag 1 WireLengthDelimited <> putByteString mid)-                assertBool "outer is non-empty" (not (BS.null outer))-                assertBool "outer > mid" (BS.length outer > BS.length mid)-                assertBool "mid > inner" (BS.length mid > BS.length inner)+      , describe+          "Tag encoding"+          $ sequence_+            [ it "tag field 1 varint" $ do+                let tag = makeTag 1 WireVarint+                encodeTag tag `shouldBe` 0x08+            , it "tag field 1 length-delimited" $ do+                let tag = makeTag 1 WireLengthDelimited+                encodeTag tag `shouldBe` 0x0A+            , it "tag field 2 varint" $ do+                let tag = makeTag 2 WireVarint+                encodeTag tag `shouldBe` 0x10+            , it "tag roundtrip" $ property $ do+                fn <- forAll $ Gen.int (Range.linear 1 ((2 :: Int) ^ (29 :: Int) - 1))+                wt <- forAll $ Gen.element [WireVarint, Wire64Bit, WireLengthDelimited, Wire32Bit]+                let tag = makeTag fn wt+                    encoded = encodeTag tag+                decodeTag encoded === Just tag             ]-        , testGroup-            "Unknown field skipping"-            [ testCase "skip unknown varint field" $ do-                let bs =-                      buildToBS-                        ( putTag 99 WireVarint-                            <> putVarint 12345-                            <> putTag 1 WireVarint-                            <> putVarint 42-                        )-                case runDecoder (skipField WireVarint >> getVarint) (BS.drop 1 bs) of-                  Right _ -> pure ()-                  Left _ -> pure ()-            , testCase "skip unknown length-delimited" $ do-                let payload = "hello world"-                    bs = buildToBS (putByteString payload)-                case runDecoder (skipField WireLengthDelimited) bs of+      , describe+          "Skip unknown fields"+          $ sequence_+            [ it "skip varint" $ do+                let bs = buildToBS (putVarint 12345)+                case runDecoder (skipField WireVarint) bs of                   Right () -> pure ()-                  Left e -> assertFailure (show e)-            , testCase "skip unknown fixed32" $ do-                let bs = buildToBS (putFixed32 0xDEADBEEF)+                  Left e -> expectationFailure (show e)+            , it "skip fixed32" $ do+                let bs = buildToBS (putFixed32 42)                 case runDecoder (skipField Wire32Bit) bs of                   Right () -> pure ()-                  Left e -> assertFailure (show e)-            , testCase "skip unknown fixed64" $ do-                let bs = buildToBS (putFixed64 0xDEADBEEFCAFEBABE)+                  Left e -> expectationFailure (show e)+            , it "skip fixed64" $ do+                let bs = buildToBS (putFixed64 42)                 case runDecoder (skipField Wire64Bit) bs of                   Right () -> pure ()-                  Left e -> assertFailure (show e)+                  Left e -> expectationFailure (show e)+            , it "skip length-delimited" $ do+                let bs = buildToBS (putByteString "hello")+                case runDecoder (skipField WireLengthDelimited) bs of+                  Right () -> pure ()+                  Left e -> expectationFailure (show e)             ]-        , testGroup-            "ZigZag spec compliance"-            [ testCase "zigzag(0) = 0" $ zigZag32 0 @?= 0-            , testCase "zigzag(-1) = 1" $ zigZag32 (-1) @?= 1-            , testCase "zigzag(1) = 2" $ zigZag32 1 @?= 2-            , testCase "zigzag(-2) = 3" $ zigZag32 (-2) @?= 3-            , testCase "zigzag(2147483647) = 4294967294" $-                zigZag32 2147483647 @?= 4294967294-            , testCase "zigzag(-2147483648) = 4294967295" $-                zigZag32 (-2147483648) @?= 4294967295-            , testCase "zigzag64(0) = 0" $ zigZag64 0 @?= 0-            , testCase "zigzag64(-1) = 1" $ zigZag64 (-1) @?= 1-            , testCase "zigzag64(1) = 2" $ zigZag64 1 @?= 2-            , testCase "zigzag64(max int64) roundtrip" $ do-                let n = maxBound :: Int64-                unZigZag64 (zigZag64 n) @?= n-            , testCase "zigzag64(min int64) roundtrip" $ do-                let n = minBound :: Int64-                unZigZag64 (zigZag64 n) @?= n+      , describe+          "Error handling"+          $ sequence_+            [ it "unexpected end on varint" $ do+                runDecoder getVarint BS.empty `shouldBe` Left UnexpectedEnd+            , it "unexpected end on fixed32" $ do+                runDecoder getFixed32 (BS.pack [1, 2]) `shouldBe` Left UnexpectedEnd+            , it "unexpected end on fixed64" $ do+                runDecoder getFixed64 (BS.pack [1, 2, 3, 4]) `shouldBe` Left UnexpectedEnd+            , it "extra bytes after decode" $ do+                let bs = BS.pack [0x00, 0xFF]+                case runDecoder getVarint bs of+                  Left ExtraBytes -> pure ()+                  other -> expectationFailure ("Expected ExtraBytes, got: " <> show other)             ]-        ]-    ]+      , describe+          "Protobuf spec conformance vectors"+          $ sequence_+            [ describe+                "Varint edge cases"+                $ sequence_+                  [ it "varint 0 = [0x00]" $+                      buildToBS (putVarint 0) `shouldBe` BS.pack [0x00]+                  , it "varint 1 = [0x01]" $+                      buildToBS (putVarint 1) `shouldBe` BS.pack [0x01]+                  , it "varint max uint64 (10 bytes)" $ do+                      let bs = buildToBS (putVarint (maxBound :: Word64))+                      BS.length bs `shouldBe` 10+                      runDecoder getVarint bs `shouldBe` Right (maxBound :: Word64)+                  , it "varint 150 = [0x96, 0x01]" $+                      buildToBS (putVarint 150) `shouldBe` BS.pack [0x96, 0x01]+                  , it "negative int32 as 10-byte varint" $ do+                      let n = fromIntegral (-1 :: Int32) :: Word64+                          bs = buildToBS (putVarint n)+                      BS.length bs `shouldBe` 10+                      runDecoder getVarint bs `shouldBe` Right n+                  , it "negative int32 -150 via zigzag" $ do+                      let n = -150 :: Int32+                          bs = buildToBS (putSVarint32 n)+                      runDecoder getSVarint32 bs `shouldBe` Right n+                  ]+            , describe+                "Fixed-width exact bytes"+                $ sequence_+                  [ it "fixed32 little-endian 1" $+                      buildToBS (putFixed32 1) `shouldBe` BS.pack [0x01, 0x00, 0x00, 0x00]+                  , it "fixed32 little-endian 256" $+                      buildToBS (putFixed32 256) `shouldBe` BS.pack [0x00, 0x01, 0x00, 0x00]+                  , it "fixed64 little-endian 1" $+                      buildToBS (putFixed64 1) `shouldBe` BS.pack [0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00]+                  , it "float 0.0 = [0,0,0,0]" $+                      buildToBS (putFloat 0.0) `shouldBe` BS.pack [0x00, 0x00, 0x00, 0x00]+                  , it "double 0.0 = 8 zero bytes" $+                      buildToBS (putDouble 0.0) `shouldBe` BS.pack [0, 0, 0, 0, 0, 0, 0, 0]+                  ]+            , describe+                "Packed repeated fields"+                $ sequence_+                  [ it "empty packed = just length 0" $ do+                      let bs = buildToBS (putLengthDelimited BS.empty)+                      runDecoder getByteString bs `shouldBe` Right BS.empty+                  , it "packed varints [1,2,3]" $ do+                      let payload = buildToBS (putVarint 1 <> putVarint 2 <> putVarint 3)+                          bs = buildToBS (putLengthDelimited payload)+                      case runDecoder getByteString bs of+                        Right inner -> BS.length inner `shouldBe` 3+                        Left e -> expectationFailure (show e)+                  , it "packed fixed32 [1,2]" $ do+                      let payload = buildToBS (putFixed32 1 <> putFixed32 2)+                          bs = buildToBS (putLengthDelimited payload)+                      case runDecoder getByteString bs of+                        Right inner -> BS.length inner `shouldBe` 8+                        Left e -> expectationFailure (show e)+                  ]+            , describe+                "Tag format correctness"+                $ sequence_+                  [ it "field 1 varint = 0x08" $+                      encodeTag (makeTag 1 WireVarint) `shouldBe` 0x08+                  , it "field 1 64-bit = 0x09" $+                      encodeTag (makeTag 1 Wire64Bit) `shouldBe` 0x09+                  , it "field 1 length-delimited = 0x0A" $+                      encodeTag (makeTag 1 WireLengthDelimited) `shouldBe` 0x0A+                  , it "field 1 32-bit = 0x0D" $+                      encodeTag (makeTag 1 Wire32Bit) `shouldBe` 0x0D+                  , it "field 2 varint = 0x10" $+                      encodeTag (makeTag 2 WireVarint) `shouldBe` 0x10+                  , it "field 15 varint = 0x78" $+                      encodeTag (makeTag 15 WireVarint) `shouldBe` 0x78+                  , it "field 16 varint = 0x80 0x01 (2-byte tag)" $ do+                      let tag = makeTag 16 WireVarint+                          encoded = encodeTag tag+                      encoded `shouldBe` 0x80+                  ]+            , describe+                "Nested messages (length-delimited)"+                $ sequence_+                  [ it "3-level nesting roundtrip" $ do+                      let inner = buildToBS (putTag 1 WireVarint <> putVarint 42)+                          mid = buildToBS (putTag 1 WireLengthDelimited <> putByteString inner)+                          outer = buildToBS (putTag 1 WireLengthDelimited <> putByteString mid)+                      (not (BS.null outer)) `shouldBe` True+                      (BS.length outer > BS.length mid) `shouldBe` True+                      (BS.length mid > BS.length inner) `shouldBe` True+                  ]+            , describe+                "Unknown field skipping"+                $ sequence_+                  [ it "skip unknown varint field" $ do+                      let bs =+                            buildToBS+                              ( putTag 99 WireVarint+                                  <> putVarint 12345+                                  <> putTag 1 WireVarint+                                  <> putVarint 42+                              )+                      case runDecoder (skipField WireVarint >> getVarint) (BS.drop 1 bs) of+                        Right _ -> pure ()+                        Left _ -> pure () :: IO ()+                  , it "skip unknown length-delimited" $ do+                      let payload = "hello world"+                          bs = buildToBS (putByteString payload)+                      case runDecoder (skipField WireLengthDelimited) bs of+                        Right () -> pure ()+                        Left e -> expectationFailure (show e)+                  , it "skip unknown fixed32" $ do+                      let bs = buildToBS (putFixed32 0xDEADBEEF)+                      case runDecoder (skipField Wire32Bit) bs of+                        Right () -> pure ()+                        Left e -> expectationFailure (show e)+                  , it "skip unknown fixed64" $ do+                      let bs = buildToBS (putFixed64 0xDEADBEEFCAFEBABE)+                      case runDecoder (skipField Wire64Bit) bs of+                        Right () -> pure ()+                        Left e -> expectationFailure (show e)+                  ]+            , describe+                "ZigZag spec compliance"+                $ sequence_+                  [ it "zigzag(0) = 0" $ zigZag32 0 `shouldBe` 0+                  , it "zigzag(-1) = 1" $ zigZag32 (-1) `shouldBe` 1+                  , it "zigzag(1) = 2" $ zigZag32 1 `shouldBe` 2+                  , it "zigzag(-2) = 3" $ zigZag32 (-2) `shouldBe` 3+                  , it "zigzag(2147483647) = 4294967294" $+                      zigZag32 2147483647 `shouldBe` 4294967294+                  , it "zigzag(-2147483648) = 4294967295" $+                      zigZag32 (-2147483648) `shouldBe` 4294967295+                  , it "zigzag64(0) = 0" $ zigZag64 0 `shouldBe` 0+                  , it "zigzag64(-1) = 1" $ zigZag64 (-1) `shouldBe` 1+                  , it "zigzag64(1) = 2" $ zigZag64 1 `shouldBe` 2+                  , it "zigzag64(max int64) roundtrip" $ do+                      let n = maxBound :: Int64+                      unZigZag64 (zigZag64 n) `shouldBe` n+                  , it "zigzag64(min int64) roundtrip" $ do+                      let n = minBound :: Int64+                      unZigZag64 (zigZag64 n) `shouldBe` n+                  ]+            ]+      ]   buildToBS :: B.Builder -> ByteString
test/Main.hs view
@@ -6,14 +6,15 @@ import Test.Proto.Derive.Metadata qualified import Test.Proto.Derive.Oneof qualified import Test.Proto.Derive.TopEnum qualified-import Test.Tasty (defaultMain, testGroup)+import Test.Syd   main :: IO () main =-  defaultMain $-    testGroup+  sydTest+    $ describe       "wireform-proto:Derive"+    $ sequence_       [ Test.Proto.Derive.tests       , Test.Proto.Derive.Auto.tests       , Test.Proto.Derive.Golden.tests
test/Test/Proto/Derive.hs view
@@ -14,8 +14,8 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Vector qualified as V-import Proto qualified as PD-import Proto qualified as PE+import Proto.Decode qualified as PD+import Proto.Encode qualified as PE import Test.Proto.Derive.Instances () import Test.Proto.Derive.RegressionInstances (   RegInventory (..),@@ -41,270 +41,268 @@ import Test.Proto.Derive.TranslatedInstances () import Test.Proto.Derive.TranslatedTypes (AddressT (..), UserT (..)) import Test.Proto.Derive.Types (Address (..), User (..))-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (assertBool, testCase, (@?=))+import Test.Syd  -tests :: TestTree+tests :: Spec tests =-  testGroup+  describe     "Proto.TH.Derive"-    [ testCase "default User round-trips" $ do-        let u = defaultUser-        let bs = PE.encodeMessage u-        bs @?= BS.empty -- proto3 default: every field skipped-        PD.decodeMessage bs @?= Right u-    , testCase "scalar fields round-trip" $ do-        let u =-              defaultUser-                { userId = 42-                , userName = T.pack "alice"-                , userActive = True-                , userScore = 3.14-                , userTagBits = 0xDEADBEEFCAFEBABE-                , userBlob = BS.pack [0, 1, 2, 3, 254, 255]-                }-        roundTrip u-    , testCase "ZigZag override on negative sint32" $ do-        let u = defaultUser {userOffset = -123456}-        roundTrip u-    , testCase "fixed32 override on uint32" $ do-        let u = defaultUser {userPort = 0xCAFEBABE}-        roundTrip u-        -- The fixed32 wire payload always occupies 4 bytes plus 1 tag byte;-        -- assert the encoded length to confirm we picked the right encoding.-        BS.length (PE.encodeMessage u) @?= 5-    , testCase "Maybe Address present round-trips" $ do-        let addr =-              Address-                { addrStreet = T.pack "1 Wireform Way"-                , addrCity = T.pack "Berlin"-                , addrZip = 10119-                }-        let u = defaultUser {userId = 7, userAddr = Just addr}-        roundTrip u-    , testCase "Maybe Address absent skips field" $ do-        let u = defaultUser {userId = 7}-        let bs = PE.encodeMessage u-        -- Tag for field 9 is (9 << 3) | 2 = 74; assert it's NOT in the stream.-        assertBool "address tag should be absent" (74 `BS.notElem` bs)-        PD.decodeMessage bs @?= Right u-    , testCase "deriveProtoFromTranslated: round-trip preserves UserT" $ do-        let u =-              (defaultUserT :: UserT)-                { tuserId = 99-                , tuserName = T.pack "carol"-                , tuserActive = True-                , tuserScore = 2.71-                , tuserTagBits = 0xFEEDFACECAFEBEEF-                , tuserBlob = BS.pack [0xDE, 0xAD, 0xBE, 0xEF]-                , tuserOffset = -98765-                , tuserPort = 0xCAFEBABE-                , tuserAddr =-                    Just-                      AddressT-                        { taddrStreet = T.pack "1 Wireform Way"-                        , taddrCity = T.pack "Berlin"-                        , taddrZip = 10119-                        }-                }-        PD.decodeMessage (PE.encodeMessage u) @?= Right u-    , testCase "deriveProtoFromTranslated: byte-identical to deriveProto" $ do-        let u =-              defaultUser-                { userId = 99-                , userName = T.pack "carol"-                , userActive = True-                , userScore = 2.71-                , userTagBits = 0xFEEDFACECAFEBEEF-                , userBlob = BS.pack [0xDE, 0xAD, 0xBE, 0xEF]-                , userOffset = -98765-                , userPort = 0xCAFEBABE-                , userAddr =-                    Just-                      Address-                        { addrStreet = T.pack "1 Wireform Way"-                        , addrCity = T.pack "Berlin"-                        , addrZip = 10119-                        }-                }-            uT =-              (defaultUserT :: UserT)-                { tuserId = userId u-                , tuserName = userName u-                , tuserActive = userActive u-                , tuserScore = userScore u-                , tuserTagBits = userTagBits u-                , tuserBlob = userBlob u-                , tuserOffset = userOffset u-                , tuserPort = userPort u-                , tuserAddr =-                    fmap-                      ( \a ->-                          AddressT-                            { taddrStreet = addrStreet a-                            , taddrCity = addrCity a-                            , taddrZip = addrZip a-                            }-                      )-                      (userAddr u)-                }-        PE.encodeMessage uT @?= PE.encodeMessage u-    , -- ----------------------------------------------------------------      -- Enum-      -- ----------------------------------------------------------------      testCase "Painting (enum field): default round-trips" $ do-        let p = Painting {pTitle = T.empty, pColor = ColRed}-        let bs = PE.encodeMessage p-        bs @?= BS.empty-        PD.decodeMessage bs @?= Right p-    , testCase "Painting (enum field): non-default round-trips" $ do-        let p = Painting {pTitle = T.pack "Composition VIII", pColor = ColBlue}-        PD.decodeMessage (PE.encodeMessage p) @?= Right p-    , testCase "Painting (enum field): zero-valued enum is skipped" $ do-        let p = Painting {pTitle = T.pack "X", pColor = ColRed}-        let bs = PE.encodeMessage p-        -- field 2 (color) has tag byte (2 << 3) | 0 = 16; assert it's-        -- absent because ColRed = 0 is the proto default.-        assertBool-          "color tag should be absent for default enum"-          (16 `BS.notElem` bs)-    , -- ----------------------------------------------------------------      -- Repeated-      -- ----------------------------------------------------------------      testCase "Inventory (Vector-repeated submessages): empty round-trips" $ do-        let inv = Inventory {invName = T.empty, invItems = V.empty}-        PD.decodeMessage (PE.encodeMessage inv) @?= Right inv-    , testCase "Inventory (Vector-repeated submessages): three elements" $ do-        let items =-              V.fromList-                [ Item {iName = T.pack "alpha", iCount = 1}-                , Item {iName = T.pack "beta", iCount = 2}-                , Item {iName = T.pack "gamma", iCount = 3}-                ]-            inv = Inventory {invName = T.pack "warehouse", invItems = items}-        PD.decodeMessage (PE.encodeMessage inv) @?= Right inv-    , testCase "LooseInventory (list-repeated strings): preserves order" $ do-        let li =-              LooseInventory-                { liId = 99-                , liTags = [T.pack "a", T.pack "b", T.pack "c"]-                }-        PD.decodeMessage (PE.encodeMessage li) @?= Right li-    , -- ----------------------------------------------------------------      -- Map-      -- ----------------------------------------------------------------      testCase "Tagged (map<string, string>): empty map round-trips" $ do-        let t = Tagged {tagName = T.empty, tagAttrs = Map.empty}-        let bs = PE.encodeMessage t-        bs @?= BS.empty-        PD.decodeMessage bs @?= Right t-    , testCase "Tagged (map<string, string>): three entries round-trip" $ do-        let attrs =-              Map.fromList-                [ (T.pack "color", T.pack "red")-                , (T.pack "size", T.pack "large")-                , (T.pack "shape", T.pack "round")-                ]-            t = Tagged {tagName = T.pack "demo", tagAttrs = attrs}-        PD.decodeMessage (PE.encodeMessage t) @?= Right t-    , -- ----------------------------------------------------------------      -- Oneof-      -- ----------------------------------------------------------------      testCase "Profile (oneof): unset oneof round-trips" $ do-        let p = Profile {profName = T.empty, profAvatar = Nothing}-        let bs = PE.encodeMessage p-        bs @?= BS.empty-        PD.decodeMessage bs @?= Right p-    , testCase "Profile (oneof): AvatarUrl variant round-trips" $ do-        let p =-              Profile-                { profName = T.pack "ada"-                , profAvatar = Just (AvatarUrl (T.pack "https://example.test/x.png"))-                }-        PD.decodeMessage (PE.encodeMessage p) @?= Right p-    , testCase "Profile (oneof): AvatarBlob variant round-trips" $ do-        let p =-              Profile-                { profName = T.pack "grace"-                , profAvatar = Just (AvatarBlob (BS.pack [0xDE, 0xAD, 0xBE, 0xEF]))-                }-        PD.decodeMessage (PE.encodeMessage p) @?= Right p-    , testCase "Profile (oneof): AvatarSeed variant round-trips" $ do-        let p =-              Profile-                { profName = T.pack "joan"-                , profAvatar = Just (AvatarSeed 42)-                }-        PD.decodeMessage (PE.encodeMessage p) @?= Right p-    , testCase "Profile (oneof): later variant wins on the wire" $ do-        -- Concatenate two oneof field encodings; per proto3 spec the-        -- last-wins, so encoding a Seed-only profile and decoding a-        -- Url+Seed concatenation should yield the Seed variant.-        let pUrl =-              Profile-                { profName = T.empty-                , profAvatar = Just (AvatarUrl (T.pack "old"))-                }-            pSeed =-              Profile-                { profName = T.empty-                , profAvatar = Just (AvatarSeed 7)-                }-            combined = PE.encodeMessage pUrl `BS.append` PE.encodeMessage pSeed-        PD.decodeMessage combined @?= Right pSeed-    , -- ----------------------------------------------------------------      -- Byte-equivalence regression: deriveProtoFromTranslated vs. loadProto-      -- ----------------------------------------------------------------      ---      -- 'Proto.TH.loadProto' is the long-standing proto code generator-      -- and the implementation of record. The new IDL bridge-      -- ('deriveProtoFromTranslated') must produce wire bytes that-      -- match it for the same logical message; otherwise downstream-      -- consumers that switch from one to the other would observe-      -- silent corruption.+    $ sequence_+      [ it "default User round-trips" $ do+          let u = defaultUser+          let bs = PE.encodeMessage u+          bs `shouldBe` BS.empty -- proto3 default: every field skipped+          PD.decodeMessage bs `shouldBe` Right u+      , it "scalar fields round-trip" $ do+          let u =+                defaultUser+                  { userId = 42+                  , userName = T.pack "alice"+                  , userActive = True+                  , userScore = 3.14+                  , userTagBits = 0xDEADBEEFCAFEBABE+                  , userBlob = BS.pack [0, 1, 2, 3, 254, 255]+                  }+          roundTrip u+      , it "ZigZag override on negative sint32" $ do+          let u = defaultUser {userOffset = -123456}+          roundTrip u+      , it "fixed32 override on uint32" $ do+          let u = defaultUser {userPort = 0xCAFEBABE}+          roundTrip u+          -- The fixed32 wire payload always occupies 4 bytes plus 1 tag byte;+          -- assert the encoded length to confirm we picked the right encoding.+          BS.length (PE.encodeMessage u) `shouldBe` 5+      , it "Maybe Address present round-trips" $ do+          let addr =+                Address+                  { addrStreet = T.pack "1 Wireform Way"+                  , addrCity = T.pack "Berlin"+                  , addrZip = 10119+                  }+          let u = defaultUser {userId = 7, userAddr = Just addr}+          roundTrip u+      , it "Maybe Address absent skips field" $ do+          let u = defaultUser {userId = 7}+          let bs = PE.encodeMessage u+          -- Tag for field 9 is (9 << 3) | 2 = 74; assert it's NOT in the stream.+          (74 `BS.notElem` bs) `shouldBe` True+          PD.decodeMessage bs `shouldBe` Right u+      , it "deriveProtoFromTranslated: round-trip preserves UserT" $ do+          let u =+                (defaultUserT :: UserT)+                  { tuserId = 99+                  , tuserName = T.pack "carol"+                  , tuserActive = True+                  , tuserScore = 2.71+                  , tuserTagBits = 0xFEEDFACECAFEBEEF+                  , tuserBlob = BS.pack [0xDE, 0xAD, 0xBE, 0xEF]+                  , tuserOffset = -98765+                  , tuserPort = 0xCAFEBABE+                  , tuserAddr =+                      Just+                        AddressT+                          { taddrStreet = T.pack "1 Wireform Way"+                          , taddrCity = T.pack "Berlin"+                          , taddrZip = 10119+                          }+                  }+          PD.decodeMessage (PE.encodeMessage u) `shouldBe` Right u+      , it "deriveProtoFromTranslated: byte-identical to deriveProto" $ do+          let u =+                defaultUser+                  { userId = 99+                  , userName = T.pack "carol"+                  , userActive = True+                  , userScore = 2.71+                  , userTagBits = 0xFEEDFACECAFEBEEF+                  , userBlob = BS.pack [0xDE, 0xAD, 0xBE, 0xEF]+                  , userOffset = -98765+                  , userPort = 0xCAFEBABE+                  , userAddr =+                      Just+                        Address+                          { addrStreet = T.pack "1 Wireform Way"+                          , addrCity = T.pack "Berlin"+                          , addrZip = 10119+                          }+                  }+              uT =+                (defaultUserT :: UserT)+                  { tuserId = userId u+                  , tuserName = userName u+                  , tuserActive = userActive u+                  , tuserScore = userScore u+                  , tuserTagBits = userTagBits u+                  , tuserBlob = userBlob u+                  , tuserOffset = userOffset u+                  , tuserPort = userPort u+                  , tuserAddr =+                      fmap+                        ( \a ->+                            AddressT+                              { taddrStreet = addrStreet a+                              , taddrCity = addrCity a+                              , taddrZip = addrZip a+                              }+                        )+                        (userAddr u)+                  }+          PE.encodeMessage uT `shouldBe` PE.encodeMessage u+      , -- ---------------------------------------------------------------+        -- Enum+        -- ---------------------------------------------------------------+        it "Painting (enum field): default round-trips" $ do+          let p = Painting {pTitle = T.empty, pColor = ColRed}+          let bs = PE.encodeMessage p+          bs `shouldBe` BS.empty+          PD.decodeMessage bs `shouldBe` Right p+      , it "Painting (enum field): non-default round-trips" $ do+          let p = Painting {pTitle = T.pack "Composition VIII", pColor = ColBlue}+          PD.decodeMessage (PE.encodeMessage p) `shouldBe` Right p+      , it "Painting (enum field): zero-valued enum is skipped" $ do+          let p = Painting {pTitle = T.pack "X", pColor = ColRed}+          let bs = PE.encodeMessage p+          -- field 2 (color) has tag byte (2 << 3) | 0 = 16; assert it's+          -- absent because ColRed = 0 is the proto default.+          (16 `BS.notElem` bs) `shouldBe` True+      , -- ---------------------------------------------------------------+        -- Repeated+        -- ---------------------------------------------------------------+        it "Inventory (Vector-repeated submessages): empty round-trips" $ do+          let inv = Inventory {invName = T.empty, invItems = V.empty}+          PD.decodeMessage (PE.encodeMessage inv) `shouldBe` Right inv+      , it "Inventory (Vector-repeated submessages): three elements" $ do+          let items =+                V.fromList+                  [ Item {iName = T.pack "alpha", iCount = 1}+                  , Item {iName = T.pack "beta", iCount = 2}+                  , Item {iName = T.pack "gamma", iCount = 3}+                  ]+              inv = Inventory {invName = T.pack "warehouse", invItems = items}+          PD.decodeMessage (PE.encodeMessage inv) `shouldBe` Right inv+      , it "LooseInventory (list-repeated strings): preserves order" $ do+          let li =+                LooseInventory+                  { liId = 99+                  , liTags = [T.pack "a", T.pack "b", T.pack "c"]+                  }+          PD.decodeMessage (PE.encodeMessage li) `shouldBe` Right li+      , -- ---------------------------------------------------------------+        -- Map+        -- ---------------------------------------------------------------+        it "Tagged (map<string, string>): empty map round-trips" $ do+          let t = Tagged {tagName = T.empty, tagAttrs = Map.empty}+          let bs = PE.encodeMessage t+          bs `shouldBe` BS.empty+          PD.decodeMessage bs `shouldBe` Right t+      , it "Tagged (map<string, string>): three entries round-trip" $ do+          let attrs =+                Map.fromList+                  [ (T.pack "color", T.pack "red")+                  , (T.pack "size", T.pack "large")+                  , (T.pack "shape", T.pack "round")+                  ]+              t = Tagged {tagName = T.pack "demo", tagAttrs = attrs}+          PD.decodeMessage (PE.encodeMessage t) `shouldBe` Right t+      , -- ---------------------------------------------------------------+        -- Oneof+        -- ---------------------------------------------------------------+        it "Profile (oneof): unset oneof round-trips" $ do+          let p = Profile {profName = T.empty, profAvatar = Nothing}+          let bs = PE.encodeMessage p+          bs `shouldBe` BS.empty+          PD.decodeMessage bs `shouldBe` Right p+      , it "Profile (oneof): AvatarUrl variant round-trips" $ do+          let p =+                Profile+                  { profName = T.pack "ada"+                  , profAvatar = Just (AvatarUrl (T.pack "https://example.test/x.png"))+                  }+          PD.decodeMessage (PE.encodeMessage p) `shouldBe` Right p+      , it "Profile (oneof): AvatarBlob variant round-trips" $ do+          let p =+                Profile+                  { profName = T.pack "grace"+                  , profAvatar = Just (AvatarBlob (BS.pack [0xDE, 0xAD, 0xBE, 0xEF]))+                  }+          PD.decodeMessage (PE.encodeMessage p) `shouldBe` Right p+      , it "Profile (oneof): AvatarSeed variant round-trips" $ do+          let p =+                Profile+                  { profName = T.pack "joan"+                  , profAvatar = Just (AvatarSeed 42)+                  }+          PD.decodeMessage (PE.encodeMessage p) `shouldBe` Right p+      , it "Profile (oneof): later variant wins on the wire" $ do+          -- Concatenate two oneof field encodings; per proto3 spec the+          -- last-wins, so encoding a Seed-only profile and decoding a+          -- Url+Seed concatenation should yield the Seed variant.+          let pUrl =+                Profile+                  { profName = T.empty+                  , profAvatar = Just (AvatarUrl (T.pack "old"))+                  }+              pSeed =+                Profile+                  { profName = T.empty+                  , profAvatar = Just (AvatarSeed 7)+                  }+              combined = PE.encodeMessage pUrl `BS.append` PE.encodeMessage pSeed+          PD.decodeMessage combined `shouldBe` Right pSeed+      , -- ---------------------------------------------------------------+        -- Byte-equivalence regression: deriveProtoFromTranslated vs. loadProto+        -- ---------------------------------------------------------------+        --+        -- 'Proto.TH.loadProto' is the long-standing proto code generator+        -- and the implementation of record. The new IDL bridge+        -- ('deriveProtoFromTranslated') must produce wire bytes that+        -- match it for the same logical message; otherwise downstream+        -- consumers that switch from one to the other would observe+        -- silent corruption. -      testCase "regression: empty RegInventory matches BridgeRegInventory bytes" $ do-        let pBridge = BridgeRegInventory {briName = T.empty, briItems = V.empty}-            pProto = defaultRegInventory-        PE.encodeMessage pBridge @?= PE.encodeMessage pProto-    , testCase "regression: name-only RegInventory matches" $ do-        let pBridge =-              BridgeRegInventory-                { briName = T.pack "warehouse-7"-                , briItems = V.empty-                }-            pProto = defaultRegInventory {regInventoryReginvName = T.pack "warehouse-7"}-        PE.encodeMessage pBridge @?= PE.encodeMessage pProto-    , testCase "regression: repeated submessages produce identical bytes" $ do-        let bridgeItems =-              V.fromList-                [ BridgeRegItem (T.pack "alpha") 1-                , BridgeRegItem (T.pack "beta") 2-                , BridgeRegItem (T.pack "gamma") 3-                ]-            protoItems =-              V.fromList-                [ defaultRegItem {regItemRegiName = T.pack "alpha", regItemRegiCount = 1}-                , defaultRegItem {regItemRegiName = T.pack "beta", regItemRegiCount = 2}-                , defaultRegItem {regItemRegiName = T.pack "gamma", regItemRegiCount = 3}-                ]-            pBridge =-              BridgeRegInventory-                { briName = T.pack "depot"-                , briItems = bridgeItems-                }-            pProto =-              defaultRegInventory-                { regInventoryReginvName = T.pack "depot"-                , regInventoryReginvItems = protoItems-                }-        PE.encodeMessage pBridge @?= PE.encodeMessage pProto-    , testCase "regression: single RegItem matches BridgeRegItem bytes" $ do-        let pBridge = BridgeRegItem (T.pack "widget") 99-            pProto = defaultRegItem {regItemRegiName = T.pack "widget", regItemRegiCount = 99}-        PE.encodeMessage pBridge @?= PE.encodeMessage pProto-    ]+        it "regression: empty RegInventory matches BridgeRegInventory bytes" $ do+          let pBridge = BridgeRegInventory {briName = T.empty, briItems = V.empty}+              pProto = defaultRegInventory+          PE.encodeMessage pBridge `shouldBe` PE.encodeMessage pProto+      , it "regression: name-only RegInventory matches" $ do+          let pBridge =+                BridgeRegInventory+                  { briName = T.pack "warehouse-7"+                  , briItems = V.empty+                  }+              pProto = defaultRegInventory {regInventoryReginvName = T.pack "warehouse-7"}+          PE.encodeMessage pBridge `shouldBe` PE.encodeMessage pProto+      , it "regression: repeated submessages produce identical bytes" $ do+          let bridgeItems =+                V.fromList+                  [ BridgeRegItem (T.pack "alpha") 1+                  , BridgeRegItem (T.pack "beta") 2+                  , BridgeRegItem (T.pack "gamma") 3+                  ]+              protoItems =+                V.fromList+                  [ defaultRegItem {regItemRegiName = T.pack "alpha", regItemRegiCount = 1}+                  , defaultRegItem {regItemRegiName = T.pack "beta", regItemRegiCount = 2}+                  , defaultRegItem {regItemRegiName = T.pack "gamma", regItemRegiCount = 3}+                  ]+              pBridge =+                BridgeRegInventory+                  { briName = T.pack "depot"+                  , briItems = bridgeItems+                  }+              pProto =+                defaultRegInventory+                  { regInventoryReginvName = T.pack "depot"+                  , regInventoryReginvItems = protoItems+                  }+          PE.encodeMessage pBridge `shouldBe` PE.encodeMessage pProto+      , it "regression: single RegItem matches BridgeRegItem bytes" $ do+          let pBridge = BridgeRegItem (T.pack "widget") 99+              pProto = defaultRegItem {regItemRegiName = T.pack "widget", regItemRegiCount = 99}+          PE.encodeMessage pBridge `shouldBe` PE.encodeMessage pProto+      ]   defaultUserT :: UserT@@ -338,4 +336,4 @@   roundTrip :: User -> IO ()-roundTrip u = PD.decodeMessage (PE.encodeMessage u) @?= Right u+roundTrip u = PD.decodeMessage (PE.encodeMessage u) `shouldBe` Right u
test/Test/Proto/Derive/Auto.hs view
@@ -11,8 +11,8 @@ import Data.Text qualified as T import Data.Vector qualified as V import Data.Word (Word8)-import Proto qualified as PD-import Proto qualified as PE+import Proto.Decode qualified as PD+import Proto.Encode qualified as PE import Test.Proto.Derive.AutoInstances () import Test.Proto.Derive.AutoTypes (   AutoCard (..),@@ -22,119 +22,122 @@   AutoPackedNums (..),   AutoTagged (..),  )-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (assertBool, testCase, (@?=))+import Test.Syd  -tests :: TestTree+tests :: Spec tests =-  testGroup+  describe     "Proto.TH.Derive auto-detection (analyseField)"-    [ testGroup-        "auto-detected enum (Maybe AutoColor)"-        [ testCase "default round-trips" $ do-            let c = AutoCard 0 Nothing []-            PD.decodeMessage (PE.encodeMessage c) @?= Right c-        , testCase "Just AutoBlue round-trips" $ do-            let c = AutoCard 7 (Just AutoBlue) [T.pack "n1", T.pack "n2"]-            PD.decodeMessage (PE.encodeMessage c) @?= Right c-        , testCase "Just AutoRed (zero-valued enum) still encodes" $ do-            -- Field-presence semantics: a Just at the zero enum is-            -- still observably present, because the carrier is Maybe.-            let c = AutoCard 0 (Just AutoRed) []-            PD.decodeMessage (PE.encodeMessage c) @?= Right c-        ]-    , testGroup-        "auto-detected list-repeated string (FKRepeated RepList)"-        [ testCase "empty list round-trips" $ do-            let c = AutoCard 0 Nothing []-            PD.decodeMessage (PE.encodeMessage c) @?= Right c-        , testCase "preserves order" $ do-            let c =-                  AutoCard-                    1-                    Nothing-                    [T.pack "alpha", T.pack "beta", T.pack "gamma"]-            PD.decodeMessage (PE.encodeMessage c) @?= Right c-        ]-    , testGroup-        "auto-detected map (FKMap MapKeyString)"-        [ testCase "empty map round-trips" $ do-            let t = AutoTagged T.empty Map.empty-            PE.encodeMessage t @?= BS.empty-            PD.decodeMessage (PE.encodeMessage t) @?= Right t-        , testCase "two entries round-trip" $ do-            let attrs =-                  Map.fromList-                    [ (T.pack "color", T.pack "red")-                    , (T.pack "size", T.pack "L")-                    ]-                t = AutoTagged (T.pack "demo") attrs-            PD.decodeMessage (PE.encodeMessage t) @?= Right t-        ]-    , testGroup-        "auto-detected oneof (sum of tagged single-arg constructors)"-        [ testCase "no variant set: round-trips empty payload" $ do-            let e = AutoEnvelope T.empty Nothing-            PE.encodeMessage e @?= BS.empty-            PD.decodeMessage (PE.encodeMessage e) @?= Right e-        , testCase "AutoUrl variant round-trips" $ do-            let e =-                  AutoEnvelope-                    (T.pack "x")-                    (Just (AutoUrl (T.pack "https://example/x")))-            PD.decodeMessage (PE.encodeMessage e) @?= Right e-        , testCase "AutoSeed variant round-trips" $ do-            let e = AutoEnvelope T.empty (Just (AutoSeed 42))-            PD.decodeMessage (PE.encodeMessage e) @?= Right e-        , testCase "later variant on wire wins (proto3 oneof semantics)" $ do-            let urlE = AutoEnvelope T.empty (Just (AutoUrl (T.pack "old")))-                seedE = AutoEnvelope T.empty (Just (AutoSeed 7))-                combined = PE.encodeMessage urlE `BS.append` PE.encodeMessage seedE-            PD.decodeMessage combined @?= Right seedE-        ]-    , testGroup-        "auto-detected Vector Int32 — packed encoding by default"-        [ testCase "empty vector encodes to 0 bytes" $ do-            let p = AutoPackedNums T.empty V.empty-            PE.encodeMessage p @?= BS.empty-        , testCase "Vector [1,2,3] encodes as a packed length-delimited block" $ do-            -- field 1 (tag) is empty (default), so all bytes belong-            -- to field 2's packed block. Wire shape:-            --   tag = (2<<3)|2 = 0x12-            --   len = 3 (three 1-byte varints)-            --   payload = 0x01 0x02 0x03-            let p = AutoPackedNums T.empty (V.fromList [1, 2, 3])-            PE.encodeMessage p @?= BS.pack [0x12, 0x03, 0x01, 0x02, 0x03]-            -- And the decoder accepts it.-            PD.decodeMessage (PE.encodeMessage p) @?= Right p-        , testCase "decoder accepts unpacked encoding (proto3 spec)" $ do-            -- Hand-craft an unpacked stream of three int32s and-            -- assert the decoder still produces the same Vector.-            let unpacked =-                  BS.pack-                    [ 0x10-                    , 0x01 -- field 2 varint, value 1-                    , 0x10-                    , 0x02 -- field 2 varint, value 2-                    , 0x10-                    , 0x03 -- field 2 varint, value 3-                    ]-                expected = AutoPackedNums T.empty (V.fromList [1, 2, 3])-            PD.decodeMessage unpacked @?= Right expected-        , testCase "Vector with a tag field also round-trips" $ do-            let p = AutoPackedNums (T.pack "k") (V.fromList [42, 99, 1])-            PD.decodeMessage (PE.encodeMessage p) @?= Right p-        , testCase "packed bytes have only one tag for the whole vector" $ do-            let p = AutoPackedNums T.empty (V.fromList [1, 2, 3, 4, 5])-                bs = PE.encodeMessage p-            -- Count occurrences of the tag byte 0x12. Packed: exactly 1.-            -- Unpacked would emit 5 (one per element).-            assertBool-              ("expected exactly one 0x12 tag, got " <> show (countOf 0x12 bs))-              (countOf 0x12 bs == 1)-        ]-    ]+    $ sequence_+      [ describe+          "auto-detected enum (Maybe AutoColor)"+          $ sequence_+            [ it "default round-trips" $ do+                let c = AutoCard 0 Nothing []+                PD.decodeMessage (PE.encodeMessage c) `shouldBe` Right c+            , it "Just AutoBlue round-trips" $ do+                let c = AutoCard 7 (Just AutoBlue) [T.pack "n1", T.pack "n2"]+                PD.decodeMessage (PE.encodeMessage c) `shouldBe` Right c+            , it "Just AutoRed (zero-valued enum) still encodes" $ do+                -- Field-presence semantics: a Just at the zero enum is+                -- still observably present, because the carrier is Maybe.+                let c = AutoCard 0 (Just AutoRed) []+                PD.decodeMessage (PE.encodeMessage c) `shouldBe` Right c+            ]+      , describe+          "auto-detected list-repeated string (FKRepeated RepList)"+          $ sequence_+            [ it "empty list round-trips" $ do+                let c = AutoCard 0 Nothing []+                PD.decodeMessage (PE.encodeMessage c) `shouldBe` Right c+            , it "preserves order" $ do+                let c =+                      AutoCard+                        1+                        Nothing+                        [T.pack "alpha", T.pack "beta", T.pack "gamma"]+                PD.decodeMessage (PE.encodeMessage c) `shouldBe` Right c+            ]+      , describe+          "auto-detected map (FKMap MapKeyString)"+          $ sequence_+            [ it "empty map round-trips" $ do+                let t = AutoTagged T.empty Map.empty+                PE.encodeMessage t `shouldBe` BS.empty+                PD.decodeMessage (PE.encodeMessage t) `shouldBe` Right t+            , it "two entries round-trip" $ do+                let attrs =+                      Map.fromList+                        [ (T.pack "color", T.pack "red")+                        , (T.pack "size", T.pack "L")+                        ]+                    t = AutoTagged (T.pack "demo") attrs+                PD.decodeMessage (PE.encodeMessage t) `shouldBe` Right t+            ]+      , describe+          "auto-detected oneof (sum of tagged single-arg constructors)"+          $ sequence_+            [ it "no variant set: round-trips empty payload" $ do+                let e = AutoEnvelope T.empty Nothing+                PE.encodeMessage e `shouldBe` BS.empty+                PD.decodeMessage (PE.encodeMessage e) `shouldBe` Right e+            , it "AutoUrl variant round-trips" $ do+                let e =+                      AutoEnvelope+                        (T.pack "x")+                        (Just (AutoUrl (T.pack "https://example/x")))+                PD.decodeMessage (PE.encodeMessage e) `shouldBe` Right e+            , it "AutoSeed variant round-trips" $ do+                let e = AutoEnvelope T.empty (Just (AutoSeed 42))+                PD.decodeMessage (PE.encodeMessage e) `shouldBe` Right e+            , it "later variant on wire wins (proto3 oneof semantics)" $ do+                let urlE = AutoEnvelope T.empty (Just (AutoUrl (T.pack "old")))+                    seedE = AutoEnvelope T.empty (Just (AutoSeed 7))+                    combined = PE.encodeMessage urlE `BS.append` PE.encodeMessage seedE+                PD.decodeMessage combined `shouldBe` Right seedE+            ]+      , describe+          "auto-detected Vector Int32 — packed encoding by default"+          $ sequence_+            [ it "empty vector encodes to 0 bytes" $ do+                let p = AutoPackedNums T.empty V.empty+                PE.encodeMessage p `shouldBe` BS.empty+            , it "Vector [1,2,3] encodes as a packed length-delimited block" $ do+                -- field 1 (tag) is empty (default), so all bytes belong+                -- to field 2's packed block. Wire shape:+                --   tag = (2<<3)|2 = 0x12+                --   len = 3 (three 1-byte varints)+                --   payload = 0x01 0x02 0x03+                let p = AutoPackedNums T.empty (V.fromList [1, 2, 3])+                PE.encodeMessage p `shouldBe` BS.pack [0x12, 0x03, 0x01, 0x02, 0x03]+                -- And the decoder accepts it.+                PD.decodeMessage (PE.encodeMessage p) `shouldBe` Right p+            , it "decoder accepts unpacked encoding (proto3 spec)" $ do+                -- Hand-craft an unpacked stream of three int32s and+                -- assert the decoder still produces the same Vector.+                let unpacked =+                      BS.pack+                        [ 0x10+                        , 0x01 -- field 2 varint, value 1+                        , 0x10+                        , 0x02 -- field 2 varint, value 2+                        , 0x10+                        , 0x03 -- field 2 varint, value 3+                        ]+                    expected = AutoPackedNums T.empty (V.fromList [1, 2, 3])+                PD.decodeMessage unpacked `shouldBe` Right expected+            , it "Vector with a tag field also round-trips" $ do+                let p = AutoPackedNums (T.pack "k") (V.fromList [42, 99, 1])+                PD.decodeMessage (PE.encodeMessage p) `shouldBe` Right p+            , it "packed bytes have only one tag for the whole vector" $ do+                let p = AutoPackedNums T.empty (V.fromList [1, 2, 3, 4, 5])+                    bs = PE.encodeMessage p+                -- Count occurrences of the tag byte 0x12. Packed: exactly 1.+                -- Unpacked would emit 5 (one per element).+                (if (countOf 0x12 bs == 1) then pure () else expectationFailure ("expected exactly one 0x12 tag, got " <> show (countOf 0x12 bs)))+            ]+      ]   countOf :: Word8 -> BS.ByteString -> Int
test/Test/Proto/Derive/Golden.hs view
@@ -19,127 +19,127 @@ import Data.Text qualified as T import Data.Vector qualified as V import Data.Word (Word8)-import Proto qualified as PE+import Proto.Encode qualified as PE import Test.Proto.Derive.RegressionInstances (   RegInventory (..),   RegItem (..),   defaultRegInventory,   defaultRegItem,  )-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (testCase, (@?=))+import Test.Syd  -tests :: TestTree+tests :: Spec tests =-  testGroup+  describe     "Proto.TH.Derive byte-exact golden vectors"-    [ testCase "empty RegItem encodes to 0 bytes" $ do-        let p = defaultRegItem-        PE.encodeMessage p @?= BS.empty-    , testCase "RegItem { regi_name = \"widget\", regi_count = 99 }" $ do-        let p =-              defaultRegItem-                { regItemRegiName = T.pack "widget"-                , regItemRegiCount = 99-                }-        PE.encodeMessage p-          @?= bytes-            [ 0x0A-            , 0x06 -- field 1 (string), len 6-            , 0x77-            , 0x69-            , 0x64 -- "wid"-            , 0x67-            , 0x65-            , 0x74 -- "get"-            , 0x10-            , 0x63 -- field 2 (varint int32), 99-            ]-    , testCase "RegItem { regi_count = 1 } skips empty name" $ do-        let p = defaultRegItem {regItemRegiCount = 1}-        PE.encodeMessage p-          @?= bytes-            [0x10, 0x01]-    , testCase "empty RegInventory encodes to 0 bytes" $ do-        let p = defaultRegInventory-        PE.encodeMessage p @?= BS.empty-    , testCase "RegInventory { name = \"warehouse-7\" }" $ do-        let p = defaultRegInventory {regInventoryReginvName = T.pack "warehouse-7"}-        PE.encodeMessage p-          @?= bytes-            [ 0x0A-            , 0x0B-            , 0x77-            , 0x61-            , 0x72-            , 0x65-            , 0x68-            , 0x6F-            , 0x75-            , 0x73-            , 0x65-            , 0x2D-            , 0x37-            ]-    , testCase "RegInventory { name = \"depot\", items = 3 entries }" $ do-        let p =-              defaultRegInventory-                { regInventoryReginvName = T.pack "depot"-                , regInventoryReginvItems =-                    V.fromList-                      [ defaultRegItem {regItemRegiName = T.pack "alpha", regItemRegiCount = 1}-                      , defaultRegItem {regItemRegiName = T.pack "beta", regItemRegiCount = 2}-                      , defaultRegItem {regItemRegiName = T.pack "gamma", regItemRegiCount = 3}-                      ]-                }-        PE.encodeMessage p-          @?= bytes-            -- field 1 (name): tag, len, "depot"-            [ 0x0A-            , 0x05-            , 0x64-            , 0x65-            , 0x70-            , 0x6F-            , 0x74-            , -- field 2 (item): tag, len, payload  -- "alpha" + 1-              0x12-            , 0x09-            , 0x0A-            , 0x05-            , 0x61-            , 0x6C-            , 0x70-            , 0x68-            , 0x61-            , 0x10-            , 0x01-            , -- field 2 (item): tag, len, payload  -- "beta" + 2-              0x12-            , 0x08-            , 0x0A-            , 0x04-            , 0x62-            , 0x65-            , 0x74-            , 0x61-            , 0x10-            , 0x02-            , -- field 2 (item): tag, len, payload  -- "gamma" + 3-              0x12-            , 0x09-            , 0x0A-            , 0x05-            , 0x67-            , 0x61-            , 0x6D-            , 0x6D-            , 0x61-            , 0x10-            , 0x03-            ]-    ]+    $ sequence_+      [ it "empty RegItem encodes to 0 bytes" $ do+          let p = defaultRegItem+          PE.encodeMessage p `shouldBe` BS.empty+      , it "RegItem { regi_name = \"widget\", regi_count = 99 }" $ do+          let p =+                defaultRegItem+                  { regItemRegiName = T.pack "widget"+                  , regItemRegiCount = 99+                  }+          PE.encodeMessage p+            `shouldBe` bytes+              [ 0x0A+              , 0x06 -- field 1 (string), len 6+              , 0x77+              , 0x69+              , 0x64 -- "wid"+              , 0x67+              , 0x65+              , 0x74 -- "get"+              , 0x10+              , 0x63 -- field 2 (varint int32), 99+              ]+      , it "RegItem { regi_count = 1 } skips empty name" $ do+          let p = defaultRegItem {regItemRegiCount = 1}+          PE.encodeMessage p+            `shouldBe` bytes+              [0x10, 0x01]+      , it "empty RegInventory encodes to 0 bytes" $ do+          let p = defaultRegInventory+          PE.encodeMessage p `shouldBe` BS.empty+      , it "RegInventory { name = \"warehouse-7\" }" $ do+          let p = defaultRegInventory {regInventoryReginvName = T.pack "warehouse-7"}+          PE.encodeMessage p+            `shouldBe` bytes+              [ 0x0A+              , 0x0B+              , 0x77+              , 0x61+              , 0x72+              , 0x65+              , 0x68+              , 0x6F+              , 0x75+              , 0x73+              , 0x65+              , 0x2D+              , 0x37+              ]+      , it "RegInventory { name = \"depot\", items = 3 entries }" $ do+          let p =+                defaultRegInventory+                  { regInventoryReginvName = T.pack "depot"+                  , regInventoryReginvItems =+                      V.fromList+                        [ defaultRegItem {regItemRegiName = T.pack "alpha", regItemRegiCount = 1}+                        , defaultRegItem {regItemRegiName = T.pack "beta", regItemRegiCount = 2}+                        , defaultRegItem {regItemRegiName = T.pack "gamma", regItemRegiCount = 3}+                        ]+                  }+          PE.encodeMessage p+            `shouldBe` bytes+              -- field 1 (name): tag, len, "depot"+              [ 0x0A+              , 0x05+              , 0x64+              , 0x65+              , 0x70+              , 0x6F+              , 0x74+              , -- field 2 (item): tag, len, payload  -- "alpha" + 1+                0x12+              , 0x09+              , 0x0A+              , 0x05+              , 0x61+              , 0x6C+              , 0x70+              , 0x68+              , 0x61+              , 0x10+              , 0x01+              , -- field 2 (item): tag, len, payload  -- "beta" + 2+                0x12+              , 0x08+              , 0x0A+              , 0x04+              , 0x62+              , 0x65+              , 0x74+              , 0x61+              , 0x10+              , 0x02+              , -- field 2 (item): tag, len, payload  -- "gamma" + 3+                0x12+              , 0x09+              , 0x0A+              , 0x05+              , 0x67+              , 0x61+              , 0x6D+              , 0x6D+              , 0x61+              , 0x10+              , 0x03+              ]+      ]   bytes :: [Word8] -> BS.ByteString
test/Test/Proto/Derive/Metadata.hs view
@@ -18,7 +18,7 @@ import Data.Aeson.Key qualified as AesonKey import Data.Aeson.KeyMap qualified as AesonKM import Data.Hashable (hash, hashWithSalt)-import Data.IntMap.Strict qualified as IntMap+import Data.Map.Strict qualified as Map import Data.Proxy (Proxy (..)) import Data.Text qualified as T import Data.Vector qualified as V@@ -30,147 +30,143 @@   defaultAccount,   defaultPackedBag,  )-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (assertBool, testCase, (@?=))+import Test.Syd  -tests :: TestTree+tests :: Spec tests =-  testGroup+  describe     "loadProto satellite instances"-    [ testGroup-        "ProtoMessage"-        [ testCase "Account name + package + default" $ do-            PS.protoMessageName (Proxy :: Proxy Account) @?= "Account"-            PS.protoPackageName (Proxy :: Proxy Account) @?= ""-            PS.protoDefaultValue @?= defaultAccount-        , testCase "Account field descriptors expose names + numbers" $ do-            let fields = PS.protoFieldDescriptors (Proxy :: Proxy Account)-            IntMap.keys fields @?= [1, 2]-            PS.messageFieldNumbers (Proxy :: Proxy Account) @?= [1, 2]-            let names = PS.messageFieldNames (Proxy :: Proxy Account)-            names @?= ["acct_name", "acct_status"]-        , testCase "Account field descriptor by name returns acct_status" $ do-            case PS.lookupFieldDescriptor "acct_status" (Proxy :: Proxy Account) of-              Just (PS.SomeField fd) -> do-                PS.fdNumber fd @?= 2-                -- Top-level enum fields appear as EnumType in the-                -- schema descriptor (not MessageType — that was the-                -- whole point of the top-level-enum loadProto fix).-                PS.fdTypeDesc fd @?= PS.EnumType "Status"-              Nothing -> error "lookupFieldDescriptor returned Nothing"-        , testCase "PackedBag schema describes a repeated int32" $ do-            case PS.lookupFieldDescriptor "bag_nums" (Proxy :: Proxy PackedBag) of-              Just (PS.SomeField fd) -> do-                PS.fdLabel fd @?= PS.LabelRepeated-                PS.fdTypeDesc fd @?= PS.ScalarType PS.Int32Field-              Nothing -> error "PackedBag bag_nums descriptor missing"-        ]-    , testGroup-        "ProtoEnum (Status)"-        [ testCase "primary names round-trip through to/fromProtoEnumValue" $ do-            PS.toProtoEnumValue Status'StatusUnspecified @?= 0-            PS.toProtoEnumValue Status'StatusActive @?= 1-            PS.toProtoEnumValue Status'StatusRetired @?= 2-            PS.toProtoEnumValue Status'StatusBanned @?= 3-            PS.fromProtoEnumValue 0 @?= Just Status'StatusUnspecified-            PS.fromProtoEnumValue 1 @?= Just Status'StatusActive-            -- Open-enum representation: an unknown wire value-            -- now round-trips through the synthetic 'Unknown'-            -- variant rather than disappearing as 'Nothing'.-            PS.fromProtoEnumValue 99 @?= Just (Status'Unknown 99)-        , testCase "protoEnumValues lists every declared value" $ do-            let values = PS.protoEnumValues (Proxy :: Proxy Status)-            values-              @?= [ ("STATUS_UNSPECIFIED", 0)-                  , ("STATUS_ACTIVE", 1)-                  , ("STATUS_RETIRED", 2)-                  , ("STATUS_BANNED", 3)-                  ]-        , testCase "fully qualified protoEnumName" $ do-            PS.protoEnumName (Proxy :: Proxy Status) @?= "Status"-        ]-    , testGroup-        "Aeson.ToJSON / FromJSON for messages (camelCase keys)"-        [ testCase "default Account encodes to {} (proto3 canonical: defaults skipped)" $ do-            let a = defaultAccount-            let v = Aeson.toJSON a-            case v of-              Aeson.Object km -> do-                -- Proto3 canonical JSON omits fields at default value-                -- (empty string for acctName, STATUS_UNSPECIFIED for-                -- acctStatus). The result is an empty object.-                assertBool-                  "acctName key absent (default empty string)"-                  (not (hasKey "acctName" km))-                assertBool-                  "acctStatus key absent (default STATUS_UNSPECIFIED)"-                  (not (hasKey "acctStatus" km))-              _ -> error "expected Object"-        , testCase "non-default Account emits both fields with camelCase keys" $ do-            let a =-                  defaultAccount-                    { accountAcctName = T.pack "ada"-                    , accountAcctStatus = Status'StatusActive-                    }-            let v = Aeson.toJSON a-            case v of-              Aeson.Object km -> do-                assertBool "acctName key present" (hasKey "acctName" km)-                assertBool "acctStatus key present" (hasKey "acctStatus" km)-              _ -> error "expected Object"-        , testCase "Account ToJSON / FromJSON round-trip" $ do-            let a =-                  defaultAccount-                    { accountAcctName = T.pack "alice"-                    , accountAcctStatus = Status'StatusActive-                    }-            let v = Aeson.toJSON a-            case Aeson.fromJSON v of-              Aeson.Success a' -> a' @?= a-              Aeson.Error e -> error ("fromJSON failed: " <> e)-        , testCase "Status enum encodes as its primary name string" $ do-            Aeson.toJSON Status'StatusActive @?= Aeson.String "STATUS_ACTIVE"-            Aeson.toJSON Status'StatusBanned @?= Aeson.String "STATUS_BANNED"-        , testCase "Status enum FromJSON accepts both name and number" $ do-            Aeson.fromJSON (Aeson.String "STATUS_RETIRED") @?= Aeson.Success Status'StatusRetired-            Aeson.fromJSON (Aeson.Number 1) @?= Aeson.Success Status'StatusActive-        , testCase "PackedBag ToJSON / FromJSON round-trip" $ do-            let p = defaultPackedBag {packedBagBagNums = V.fromList [1, 2, 3, 4, 5]}-            case Aeson.fromJSON (Aeson.toJSON p) of-              Aeson.Success p' -> p' @?= p-              Aeson.Error e -> error ("fromJSON failed: " <> e)-        , testCase "PackedBag with empty bagNums encodes to {} (proto3-canonical)" $ do-            let p = defaultPackedBag-            case Aeson.toJSON p of-              Aeson.Object km -> assertBool "no bagNums key" (not (hasKey "bagNums" km))-              _ -> error "expected Object"-        ]-    , testGroup-        "Hashable"-        [ testCase "equal Accounts hash equal" $ do-            let a1 = defaultAccount {accountAcctName = T.pack "x", accountAcctStatus = Status'StatusActive}-                a2 = defaultAccount {accountAcctName = T.pack "x", accountAcctStatus = Status'StatusActive}-            hash a1 @?= hash a2-        , testCase "different Accounts hash differently (sanity)" $ do-            let a1 = defaultAccount {accountAcctName = T.pack "x", accountAcctStatus = Status'StatusActive}-                a2 = defaultAccount {accountAcctName = T.pack "y", accountAcctStatus = Status'StatusActive}-            assertBool-              "names differ -> hashes should differ"-              (hash a1 /= hash a2)-        , testCase "Status hashes match its proto wire number" $ do-            -- The enum Hashable implementation hashes the proto-            -- wire number, so this is observable.-            hashWithSalt 0 Status'StatusUnspecified @?= hashWithSalt 0 (0 :: Int)-            hashWithSalt 0 Status'StatusActive @?= hashWithSalt 0 (1 :: Int)-        , testCase "PackedBag hashes survive vector permutation differences" $ do-            let p1 = defaultPackedBag {packedBagBagNums = V.fromList [1, 2, 3]}-                p2 = defaultPackedBag {packedBagBagNums = V.fromList [3, 2, 1]}-            assertBool-              "vector order matters in the hash"-              (hash p1 /= hash p2)-        ]-    ]+    $ sequence_+      [ describe+          "ProtoMessage"+          $ sequence_+            [ it "Account name + package + default" $ do+                PS.protoMessageName (Proxy :: Proxy Account) `shouldBe` "Account"+                PS.protoPackageName (Proxy :: Proxy Account) `shouldBe` ""+                PS.protoDefaultValue `shouldBe` defaultAccount+            , it "Account field descriptors expose names + numbers" $ do+                let fields = PS.protoFieldDescriptors (Proxy :: Proxy Account)+                Map.keys fields `shouldBe` [1, 2]+                PS.messageFieldNumbers (Proxy :: Proxy Account) `shouldBe` [1, 2]+                let names = PS.messageFieldNames (Proxy :: Proxy Account)+                names `shouldBe` ["acct_name", "acct_status"]+            , it "Account field descriptor by name returns acct_status" $ do+                case PS.lookupFieldDescriptor "acct_status" (Proxy :: Proxy Account) of+                  Just (PS.SomeField fd) -> do+                    PS.fdNumber fd `shouldBe` 2+                    -- Top-level enum fields appear as EnumType in the+                    -- schema descriptor (not MessageType — that was the+                    -- whole point of the top-level-enum loadProto fix).+                    PS.fdTypeDesc fd `shouldBe` PS.EnumType "Status"+                  Nothing -> error "lookupFieldDescriptor returned Nothing"+            , it "PackedBag schema describes a repeated int32" $ do+                case PS.lookupFieldDescriptor "bag_nums" (Proxy :: Proxy PackedBag) of+                  Just (PS.SomeField fd) -> do+                    PS.fdLabel fd `shouldBe` PS.LabelRepeated+                    PS.fdTypeDesc fd `shouldBe` PS.ScalarType PS.Int32Field+                  Nothing -> error "PackedBag bag_nums descriptor missing"+            ]+      , describe+          "ProtoEnum (Status)"+          $ sequence_+            [ it "primary names round-trip through to/fromProtoEnumValue" $ do+                PS.toProtoEnumValue Status'StatusUnspecified `shouldBe` 0+                PS.toProtoEnumValue Status'StatusActive `shouldBe` 1+                PS.toProtoEnumValue Status'StatusRetired `shouldBe` 2+                PS.toProtoEnumValue Status'StatusBanned `shouldBe` 3+                PS.fromProtoEnumValue 0 `shouldBe` Just Status'StatusUnspecified+                PS.fromProtoEnumValue 1 `shouldBe` Just Status'StatusActive+                -- Open-enum representation: an unknown wire value+                -- now round-trips through the synthetic 'Unknown'+                -- variant rather than disappearing as 'Nothing'.+                PS.fromProtoEnumValue 99 `shouldBe` Just (Status''Unrecognized 99)+            , it "protoEnumValues lists every declared value" $ do+                let values = PS.protoEnumValues (Proxy :: Proxy Status)+                values+                  `shouldBe` [ ("STATUS_UNSPECIFIED", 0)+                             , ("STATUS_ACTIVE", 1)+                             , ("STATUS_RETIRED", 2)+                             , ("STATUS_BANNED", 3)+                             ]+            , it "fully qualified protoEnumName" $ do+                PS.protoEnumName (Proxy :: Proxy Status) `shouldBe` "Status"+            ]+      , describe+          "Aeson.ToJSON / FromJSON for messages (camelCase keys)"+          $ sequence_+            [ it "default Account encodes to {} (proto3 canonical: defaults skipped)" $ do+                let a = defaultAccount+                let v = Aeson.toJSON a+                case v of+                  Aeson.Object km -> do+                    -- Proto3 canonical JSON omits fields at default value+                    -- (empty string for acctName, STATUS_UNSPECIFIED for+                    -- acctStatus). The result is an empty object.+                    (not (hasKey "acctName" km)) `shouldBe` True+                    (not (hasKey "acctStatus" km)) `shouldBe` True+                  _ -> error "expected Object"+            , it "non-default Account emits both fields with camelCase keys" $ do+                let a =+                      defaultAccount+                        { accountAcctName = T.pack "ada"+                        , accountAcctStatus = Status'StatusActive+                        }+                let v = Aeson.toJSON a+                case v of+                  Aeson.Object km -> do+                    (hasKey "acctName" km) `shouldBe` True+                    (hasKey "acctStatus" km) `shouldBe` True+                  _ -> error "expected Object"+            , it "Account ToJSON / FromJSON round-trip" $ do+                let a =+                      defaultAccount+                        { accountAcctName = T.pack "alice"+                        , accountAcctStatus = Status'StatusActive+                        }+                let v = Aeson.toJSON a+                case Aeson.fromJSON v of+                  Aeson.Success a' -> a' `shouldBe` a+                  Aeson.Error e -> error ("fromJSON failed: " <> e)+            , it "Status enum encodes as its primary name string" $ do+                Aeson.toJSON Status'StatusActive `shouldBe` Aeson.String "STATUS_ACTIVE"+                Aeson.toJSON Status'StatusBanned `shouldBe` Aeson.String "STATUS_BANNED"+            , it "Status enum FromJSON accepts both name and number" $ do+                Aeson.fromJSON (Aeson.String "STATUS_RETIRED") `shouldBe` Aeson.Success Status'StatusRetired+                Aeson.fromJSON (Aeson.Number 1) `shouldBe` Aeson.Success Status'StatusActive+            , it "PackedBag ToJSON / FromJSON round-trip" $ do+                let p = defaultPackedBag {packedBagBagNums = V.fromList [1, 2, 3, 4, 5]}+                case Aeson.fromJSON (Aeson.toJSON p) of+                  Aeson.Success p' -> p' `shouldBe` p+                  Aeson.Error e -> error ("fromJSON failed: " <> e)+            , it "PackedBag with empty bagNums encodes to {} (proto3-canonical)" $ do+                let p = defaultPackedBag+                case Aeson.toJSON p of+                  Aeson.Object km -> (not (hasKey "bagNums" km)) `shouldBe` True+                  _ -> error "expected Object"+            ]+      , describe+          "Hashable"+          $ sequence_+            [ it "equal Accounts hash equal" $ do+                let a1 = defaultAccount {accountAcctName = T.pack "x", accountAcctStatus = Status'StatusActive}+                    a2 = defaultAccount {accountAcctName = T.pack "x", accountAcctStatus = Status'StatusActive}+                hash a1 `shouldBe` hash a2+            , it "different Accounts hash differently (sanity)" $ do+                let a1 = defaultAccount {accountAcctName = T.pack "x", accountAcctStatus = Status'StatusActive}+                    a2 = defaultAccount {accountAcctName = T.pack "y", accountAcctStatus = Status'StatusActive}+                (hash a1 /= hash a2) `shouldBe` True+            , it "Status hashes match its proto wire number" $ do+                -- The enum Hashable implementation hashes the proto+                -- wire number, so this is observable.+                hashWithSalt 0 Status'StatusUnspecified `shouldBe` hashWithSalt 0 (0 :: Int)+                hashWithSalt 0 Status'StatusActive `shouldBe` hashWithSalt 0 (1 :: Int)+            , it "PackedBag hashes survive vector permutation differences" $ do+                let p1 = defaultPackedBag {packedBagBagNums = V.fromList [1, 2, 3]}+                    p2 = defaultPackedBag {packedBagBagNums = V.fromList [3, 2, 1]}+                (hash p1 /= hash p2) `shouldBe` True+            ]+      ]   hasKey :: T.Text -> AesonKM.KeyMap Aeson.Value -> Bool
test/Test/Proto/Derive/Oneof.hs view
@@ -7,8 +7,8 @@  import Data.ByteString qualified as BS import Data.Text qualified as T-import Proto qualified as PD-import Proto qualified as PE+import Proto.Decode qualified as PD+import Proto.Encode qualified as PE import Test.Proto.Derive.OneofInstances (   Envelope (..),   Envelope'EnvelopeChoice (..),@@ -16,72 +16,72 @@   defaultEnvelope,   defaultInner,  )-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (testCase, (@?=))+import Test.Syd  -tests :: TestTree+tests :: Spec tests =-  testGroup+  describe     "Proto.TH oneof bridge"-    [ testCase "no choice variant set: round-trips empty payload" $ do-        let e = defaultEnvelope-        let bs = PE.encodeMessage e-        bs @?= BS.empty-        PD.decodeMessage bs @?= Right e-    , testCase "label only: round-trips" $ do-        let e = defaultEnvelope {envelopeEnvelopeLabel = T.pack "labelled"}-        PD.decodeMessage (PE.encodeMessage e) @?= Right e-    , testCase "choice_url variant round-trips" $ do-        let e =-              defaultEnvelope-                { envelopeEnvelopeLabel = T.pack "withUrl"-                , envelopeEnvelopeChoice =-                    Just-                      ( Envelope'EnvelopeChoice'ChoiceUrl-                          (T.pack "https://example.test/x")-                      )-                }-        PD.decodeMessage (PE.encodeMessage e) @?= Right e-    , testCase "choice_blob variant round-trips" $ do-        let e =-              defaultEnvelope-                { envelopeEnvelopeChoice =-                    Just-                      ( Envelope'EnvelopeChoice'ChoiceBlob-                          (BS.pack [0xCA, 0xFE, 0xBA, 0xBE])-                      )-                }-        PD.decodeMessage (PE.encodeMessage e) @?= Right e-    , testCase "choice_seed variant round-trips" $ do-        let e =-              defaultEnvelope-                { envelopeEnvelopeChoice = Just (Envelope'EnvelopeChoice'ChoiceSeed 12345)-                }-        PD.decodeMessage (PE.encodeMessage e) @?= Right e-    , testCase "choice_inner submessage variant round-trips" $ do-        let inner = defaultInner {innerInnerId = 99}-            e =-              defaultEnvelope-                { envelopeEnvelopeLabel = T.pack "nested"-                , envelopeEnvelopeChoice = Just (Envelope'EnvelopeChoice'ChoiceInner inner)-                }-        PD.decodeMessage (PE.encodeMessage e) @?= Right e-    , testCase "later variant on the wire wins (proto3 oneof semantics)" $ do-        -- Concatenate two encodings that each set a different-        -- variant; per proto3 the last one wins on decode.-        let eUrl =-              defaultEnvelope-                { envelopeEnvelopeChoice =-                    Just-                      ( Envelope'EnvelopeChoice'ChoiceUrl-                          (T.pack "old")-                      )-                }-            eSeed =-              defaultEnvelope-                { envelopeEnvelopeChoice = Just (Envelope'EnvelopeChoice'ChoiceSeed 7)-                }-            combined = PE.encodeMessage eUrl `BS.append` PE.encodeMessage eSeed-        PD.decodeMessage combined @?= Right eSeed-    ]+    $ sequence_+      [ it "no choice variant set: round-trips empty payload" $ do+          let e = defaultEnvelope+          let bs = PE.encodeMessage e+          bs `shouldBe` BS.empty+          PD.decodeMessage bs `shouldBe` Right e+      , it "label only: round-trips" $ do+          let e = defaultEnvelope {envelopeEnvelopeLabel = T.pack "labelled"}+          PD.decodeMessage (PE.encodeMessage e) `shouldBe` Right e+      , it "choice_url variant round-trips" $ do+          let e =+                defaultEnvelope+                  { envelopeEnvelopeLabel = T.pack "withUrl"+                  , envelopeEnvelopeChoice =+                      Just+                        ( Envelope'EnvelopeChoice'ChoiceUrl+                            (T.pack "https://example.test/x")+                        )+                  }+          PD.decodeMessage (PE.encodeMessage e) `shouldBe` Right e+      , it "choice_blob variant round-trips" $ do+          let e =+                defaultEnvelope+                  { envelopeEnvelopeChoice =+                      Just+                        ( Envelope'EnvelopeChoice'ChoiceBlob+                            (BS.pack [0xCA, 0xFE, 0xBA, 0xBE])+                        )+                  }+          PD.decodeMessage (PE.encodeMessage e) `shouldBe` Right e+      , it "choice_seed variant round-trips" $ do+          let e =+                defaultEnvelope+                  { envelopeEnvelopeChoice = Just (Envelope'EnvelopeChoice'ChoiceSeed 12345)+                  }+          PD.decodeMessage (PE.encodeMessage e) `shouldBe` Right e+      , it "choice_inner submessage variant round-trips" $ do+          let inner = defaultInner {innerInnerId = 99}+              e =+                defaultEnvelope+                  { envelopeEnvelopeLabel = T.pack "nested"+                  , envelopeEnvelopeChoice = Just (Envelope'EnvelopeChoice'ChoiceInner inner)+                  }+          PD.decodeMessage (PE.encodeMessage e) `shouldBe` Right e+      , it "later variant on the wire wins (proto3 oneof semantics)" $ do+          -- Concatenate two encodings that each set a different+          -- variant; per proto3 the last one wins on decode.+          let eUrl =+                defaultEnvelope+                  { envelopeEnvelopeChoice =+                      Just+                        ( Envelope'EnvelopeChoice'ChoiceUrl+                            (T.pack "old")+                        )+                  }+              eSeed =+                defaultEnvelope+                  { envelopeEnvelopeChoice = Just (Envelope'EnvelopeChoice'ChoiceSeed 7)+                  }+              combined = PE.encodeMessage eUrl `BS.append` PE.encodeMessage eSeed+          PD.decodeMessage combined `shouldBe` Right eSeed+      ]
test/Test/Proto/Derive/OneofInstances.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -32,6 +33,7 @@ import Data.Vector qualified as V import Proto.Internal.JSON.Extension (ExtensionRegistry, emptyExtensionRegistry) import Proto.TH (loadProto)+  -- TH-generated JSON instances carry a 'Given ExtensionRegistry' constraint -- for proto2 extensions; this test target has none, so satisfy it with
test/Test/Proto/Derive/RegressionInstances.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -41,6 +42,7 @@   BridgeRegItem (..),  ) import Wireform.Derive (tag)+  -- TH-generated JSON instances carry a 'Given ExtensionRegistry' constraint -- for proto2 extensions; this test target has none, so satisfy it with
test/Test/Proto/Derive/TopEnum.hs view
@@ -6,8 +6,8 @@ import Data.ByteString qualified as BS import Data.Text qualified as T import Data.Vector qualified as V-import Proto qualified as PD-import Proto qualified as PE+import Proto.Decode qualified as PD+import Proto.Encode qualified as PE import Test.Proto.Derive.TopEnumInstances (   Account (..),   PackedBag (..),@@ -15,105 +15,110 @@   defaultAccount,   defaultPackedBag,  )-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))+import Test.Syd  -tests :: TestTree+tests :: Spec tests =-  testGroup+  describe     "Proto.TH top-level enum + packed scalar"-    [ testGroup-        "top-level enum field encodes as varint, not submessage"-        [ testCase "default Status (UNSPECIFIED = 0) is skipped" $ do-            let a = defaultAccount-            PE.encodeMessage a @?= BS.empty-        , testCase "Status = STATUS_ACTIVE encodes as varint 1, not as a submessage" $ do-            let a = defaultAccount {accountAcctStatus = Status'StatusActive}-            -- field 2 (varint) tag = (2<<3)|0 = 0x10; payload = 1.-            -- If the bridge had wrongly chosen PFSubmessage we'd-            -- see 0x12 ((2<<3)|2) followed by a length prefix here.-            PE.encodeMessage a @?= BS.pack [0x10, 0x01]-        , testCase "Status = STATUS_BANNED round-trips" $ do-            let a =-                  defaultAccount-                    { accountAcctName = T.pack "anon"-                    , accountAcctStatus = Status'StatusBanned-                    }-            PD.decodeMessage (PE.encodeMessage a) @?= Right a-        , testCase "all four Status values round-trip" $ do-            let go st = do-                  let a = defaultAccount {accountAcctStatus = st}-                  PD.decodeMessage (PE.encodeMessage a) @?= Right a-            mapM_-              go-              [ Status'StatusUnspecified-              , Status'StatusActive-              , Status'StatusRetired-              , Status'StatusBanned-              ]-        , testCase "enum decoder truncates oversized varint to int32" $ do-            -- Proto3 wire spec: enum values are int32 on the wire-            -- even though varints can carry larger values. A sender-            -- that writes a 10-byte varint of @kInt64Max@ for an-            -- enum field is expected to be parsed as the int32-            -- truncation (low 32 bits, sign-extended). For-            -- 0xFFFFFFFFFFFFFFFF (the proto3-canonical encoding of-            -- -1 as a 10-byte varint), the int32 truncation is -1,-            -- which our generated 'Status' has no constructor for —-            -- so it falls through to the catch-all (the first-            -- declared, Status'StatusUnspecified). The point of this test-            -- is to confirm we don't crash and the message-            -- round-trips.-            let bs =-                  BS.pack-                    [ 0x10 -- field 2 (acct_status) varint-                    , 0xFF-                    , 0xFF-                    , 0xFF-                    , 0xFF-                    , 0xFF-                    , 0xFF-                    , 0xFF-                    , 0xFF-                    , 0xFF-                    , 0x01 -- 10-byte varint of -1-                    ]-            case PD.decodeMessage bs :: Either PD.DecodeError Account of-              Right _ -> pure () -- decode succeeded; that's what matters-              Left e -> assertFailure ("expected decode success, got " <> show e)-        ]-    , testGroup-        "packed scalar (proto3 spec default for repeated int32)"-        [ testCase "empty bag encodes to 0 bytes" $ do-            PE.encodeMessage defaultPackedBag @?= BS.empty-        , testCase "Vector [1,2,3] is one length-delimited block" $ do-            let p = defaultPackedBag {packedBagBagNums = V.fromList [1, 2, 3]}-            PE.encodeMessage p @?= BS.pack [0x0A, 0x03, 0x01, 0x02, 0x03]-            PD.decodeMessage (PE.encodeMessage p) @?= Right p-        , testCase "decoder still accepts unpacked encoding" $ do-            -- Hand-craft an unpacked stream, assert it produces-            -- the same Vector.-            let unpacked =-                  BS.pack-                    [0x08, 0x01, 0x08, 0x02, 0x08, 0x03]-                expected = defaultPackedBag {packedBagBagNums = V.fromList [1, 2, 3]}-            PD.decodeMessage unpacked @?= Right expected-        , testCase "encoded length stays small as element count grows" $ do-            -- Strongest packed-vs-unpacked check that doesn't depend-            -- on counting tag bytes (which can collide with payload-            -- values for small ints). Unpacked would emit-            --   1 tag byte + 1 payload byte = 2 bytes per element.-            -- Packed emits-            --   1 tag byte + 1 length byte + 1 payload byte each.-            -- So 100 single-byte values should fit in well under-            -- the 200 bytes an unpacked stream would take.-            let p = defaultPackedBag {packedBagBagNums = V.fromList [1 .. 100]}-                bs = PE.encodeMessage p-            assertBool-              ( "expected packed encoding (≤ 110 bytes), got "-                  <> show (BS.length bs)-              )-              (BS.length bs <= 110)-        ]-    ]+    $ sequence_+      [ describe+          "top-level enum field encodes as varint, not submessage"+          $ sequence_+            [ it "default Status (UNSPECIFIED = 0) is skipped" $ do+                let a = defaultAccount+                PE.encodeMessage a `shouldBe` BS.empty+            , it "Status = STATUS_ACTIVE encodes as varint 1, not as a submessage" $ do+                let a = defaultAccount {accountAcctStatus = Status'StatusActive}+                -- field 2 (varint) tag = (2<<3)|0 = 0x10; payload = 1.+                -- If the bridge had wrongly chosen PFSubmessage we'd+                -- see 0x12 ((2<<3)|2) followed by a length prefix here.+                PE.encodeMessage a `shouldBe` BS.pack [0x10, 0x01]+            , it "Status = STATUS_BANNED round-trips" $ do+                let a =+                      defaultAccount+                        { accountAcctName = T.pack "anon"+                        , accountAcctStatus = Status'StatusBanned+                        }+                PD.decodeMessage (PE.encodeMessage a) `shouldBe` Right a+            , it "all four Status values round-trip" $ do+                let go st = do+                      let a = defaultAccount {accountAcctStatus = st}+                      PD.decodeMessage (PE.encodeMessage a) `shouldBe` Right a+                mapM_+                  go+                  [ Status'StatusUnspecified+                  , Status'StatusActive+                  , Status'StatusRetired+                  , Status'StatusBanned+                  ]+            , it "enum decoder truncates oversized varint to int32" $ do+                -- Proto3 wire spec: enum values are int32 on the wire+                -- even though varints can carry larger values. A sender+                -- that writes a 10-byte varint of @kInt64Max@ for an+                -- enum field is expected to be parsed as the int32+                -- truncation (low 32 bits, sign-extended). For+                -- 0xFFFFFFFFFFFFFFFF (the proto3-canonical encoding of+                -- -1 as a 10-byte varint), the int32 truncation is -1,+                -- which our generated 'Status' has no constructor for —+                -- so it falls through to the catch-all (the first+                -- declared, Status'StatusUnspecified). The point of this test+                -- is to confirm we don't crash and the message+                -- round-trips.+                let bs =+                      BS.pack+                        [ 0x10 -- field 2 (acct_status) varint+                        , 0xFF+                        , 0xFF+                        , 0xFF+                        , 0xFF+                        , 0xFF+                        , 0xFF+                        , 0xFF+                        , 0xFF+                        , 0xFF+                        , 0x01 -- 10-byte varint of -1+                        ]+                case PD.decodeMessage bs :: Either PD.DecodeError Account of+                  Right _ -> pure () -- decode succeeded; that's what matters+                  Left e -> expectationFailure ("expected decode success, got " <> show e)+            ]+      , describe+          "packed scalar (proto3 spec default for repeated int32)"+          $ sequence_+            [ it "empty bag encodes to 0 bytes" $ do+                PE.encodeMessage defaultPackedBag `shouldBe` BS.empty+            , it "Vector [1,2,3] is one length-delimited block" $ do+                let p = defaultPackedBag {packedBagBagNums = V.fromList [1, 2, 3]}+                PE.encodeMessage p `shouldBe` BS.pack [0x0A, 0x03, 0x01, 0x02, 0x03]+                PD.decodeMessage (PE.encodeMessage p) `shouldBe` Right p+            , it "decoder still accepts unpacked encoding" $ do+                -- Hand-craft an unpacked stream, assert it produces+                -- the same Vector.+                let unpacked =+                      BS.pack+                        [0x08, 0x01, 0x08, 0x02, 0x08, 0x03]+                    expected = defaultPackedBag {packedBagBagNums = V.fromList [1, 2, 3]}+                PD.decodeMessage unpacked `shouldBe` Right expected+            , it "encoded length stays small as element count grows" $ do+                -- Strongest packed-vs-unpacked check that doesn't depend+                -- on counting tag bytes (which can collide with payload+                -- values for small ints). Unpacked would emit+                --   1 tag byte + 1 payload byte = 2 bytes per element.+                -- Packed emits+                --   1 tag byte + 1 length byte + 1 payload byte each.+                -- So 100 single-byte values should fit in well under+                -- the 200 bytes an unpacked stream would take.+                let p = defaultPackedBag {packedBagBagNums = V.fromList [1 .. 100]}+                    bs = PE.encodeMessage p+                ( if (BS.length bs <= 110)+                    then pure ()+                    else+                      expectationFailure+                        ( "expected packed encoding (≤ 110 bytes), got "+                            <> show (BS.length bs)+                        )+                  )+            ]+      ]
test/Test/Proto/Derive/TopEnumInstances.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-}  {- | Splice site for the top-level-enum + packed-scalar@@ -17,6 +18,7 @@ import Data.Vector qualified as V import Proto.Internal.JSON.Extension (ExtensionRegistry, emptyExtensionRegistry) import Proto.TH (loadProto)+  -- TH-generated JSON instances carry a 'Given ExtensionRegistry' constraint -- for proto2 extensions; this test target has none, so satisfy it with
wireform-proto.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: wireform-proto-version: 0.1.0.0+version: 0.2.0.0 synopsis: Protocol Buffers (proto2/proto3) with IDL parser, code generation, JSON mapping description:   A high-performance Protocol Buffers implementation for Haskell.@@ -18,7 +18,7 @@   * @protoc@ plugin (@protoc-gen-wireform@), Cabal @Setup.hs@ hook     (@Proto.Setup@), and an inline @[proto|...|]@ quasi-quoter   * Proto3 canonical JSON mapping, well-known types-    (@Timestamp@, @Duration@, @Any@, @FieldMask@, @Struct@, @Wrappers@, ...),+    (@Timestamp@, @Duration@, @Any@, @FieldMask@, @Struct@, @Wrappers@, …),     @.pbtxt@ text format, proto2 typed extensions, dynamic / untyped     messages, and a runtime @TypeRegistry@   * gRPC service-method codegen (the wire framing lives in@@ -28,12 +28,6 @@   .   See the umbrella package @wireform@ for the multi-format facade and the   @wireform-gen@ codegen CLI.-  .-  __Performance tip__: compiling with @ghc-options: -fllvm@ alongside-  @-O2@ typically yields 20-30% throughput gains on the encode\/decode hot-  paths.  LLVM produces better instruction scheduling and vectorisation for-  the unboxed-sum decoder and the sized-builder arithmetic.  The default-  native code generator works correctly; LLVM is strictly optional. homepage: https://github.com/iand675/wireform- bug-reports: https://github.com/iand675/wireform-/issues license: BSD-3-Clause@@ -47,10 +41,6 @@ extra-doc-files:   CHANGELOG.md   README.md-extra-source-files:-  test-conformance/protos/conformance.proto-  test-conformance/protos/test_messages_proto2.proto-  test-conformance/protos/test_messages_proto3.proto data-dir: data data-files: proto/google/protobuf/*.proto @@ -58,14 +48,6 @@   type:     git   location: https://github.com/iand675/wireform- -flag python-interop-  description:-    Build the wireform-proto-python-interop executable that round-trips-    messages with the official Python google-protobuf library.-    Requires @python3@ and @pip install protobuf@ in the Python environment.-  default: False-  manual:  True- common defaults   ghc-options:     -Wall@@ -90,31 +72,27 @@   hs-source-dirs: src   ghc-options: -O2   autogen-modules: Paths_wireform_proto-  other-modules:-    -- Pure implementation details: only used by other library src modules,-    -- not by test suites, executables, or downstream packages.-    Proto.Internal.CodeGen.Combinators-    Paths_wireform_proto+  other-modules: Paths_wireform_proto   exposed-modules:     -- Convenience re-export     Proto      -- Encoding & decoding+    Proto.Encode+    Proto.Decode+    Proto.Decode.Collect     Proto.Decode.Stream -    -- These modules are exposed so that code generated by-    -- protoc-gen-wireform, Proto.TH, and Proto.Setup can import them-    -- at compile time. They are NOT part of the stable public API;-    -- each module carries a haddock stability note to that effect.-    Proto.Internal.Decode-    Proto.Internal.Encode+    -- Internal wire format primitives (for generated code & advanced use)     Proto.Internal.Wire     Proto.Internal.Wire.Decode     Proto.Internal.Wire.Encode     Proto.Internal.SizedBuilder     Proto.Internal.Encode.Archetype-    Proto.Internal.Dynamic     Proto.Internal.GrowList+    Proto.Internal.CodeGen.Combinators++    -- Internal JSON helpers (used by generated code)     Proto.Internal.JSON     Proto.Internal.JSON.Extension     Proto.Internal.JSON.WellKnown@@ -146,6 +124,9 @@     Proto.CodeGen.Types     Proto.Repr +    -- Schema-derived docs (transport-agnostic JSON Schema)+    Proto.JSONSchema+     -- TH splices     Proto.TH     Proto.TH.Metadata@@ -159,40 +140,40 @@     -- Compatibility     Proto.Compat -    -- Well-known types — path mirrors the canonical-    -- @csharp_namespace = "Google.Protobuf.WellKnownTypes"@ option in-    -- each upstream @.proto@. Compiler.Plugin and Reflection.Descriptor-    -- are regen-managed (@regen-wkt@); Plugin.Util is hand-written IO glue.+    -- Well-known types+    Proto.Google.Protobuf.Any+    Proto.Google.Protobuf.Any.Util     Proto.Google.Protobuf.Compiler.Plugin-    Proto.Google.Protobuf.Compiler.Plugin.Util-    Proto.Google.Protobuf.Reflection.Descriptor-    Proto.Google.Protobuf.WellKnownTypes.Any-    Proto.Google.Protobuf.WellKnownTypes.Any.Util-    Proto.Google.Protobuf.WellKnownTypes.Duration-    Proto.Google.Protobuf.WellKnownTypes.Duration.Util-    Proto.Google.Protobuf.WellKnownTypes.Empty-    Proto.Google.Protobuf.WellKnownTypes.FieldMask-    Proto.Google.Protobuf.WellKnownTypes.FieldMask.Util-    Proto.Google.Protobuf.WellKnownTypes.SourceContext-    Proto.Google.Protobuf.WellKnownTypes.Struct-    Proto.Google.Protobuf.WellKnownTypes.Struct.Util-    Proto.Google.Protobuf.WellKnownTypes.Timestamp-    Proto.Google.Protobuf.WellKnownTypes.Timestamp.Util-    Proto.Google.Protobuf.WellKnownTypes.Wrappers-    Proto.Google.Protobuf.WellKnownTypes.Wrappers.Util+    Proto.Google.Protobuf.Descriptor+    Proto.Google.Protobuf.Duration+    Proto.Google.Protobuf.Duration.Util+    Proto.Google.Protobuf.Empty+    Proto.Google.Protobuf.FieldMask+    Proto.Google.Protobuf.FieldMask.Util+    Proto.Google.Protobuf.SourceContext+    Proto.Google.Protobuf.Struct+    Proto.Google.Protobuf.Struct.Util+    Proto.Google.Protobuf.Timestamp+    Proto.Google.Protobuf.Timestamp.Util+    Proto.Google.Protobuf.Wrappers+    Proto.Google.Protobuf.Wrappers.Util    other-modules:     -- Internal codegen sub-modules (used only by Proto.CodeGen)+    Proto.CodeGen.Decode+    Proto.CodeGen.Encode     Proto.CodeGen.Service     -- Internal derive implementation (used by Proto.TH and Proto.TH.Derive)     Proto.Internal.Derive     -- Conformance test harness (used only by conformance runner)     Proto.Conformance     -- Unboxed sum types for zero-allocation decode (not yet wired)+    Proto.Internal.Either+    Proto.Internal.Maybe   build-depends:     base >= 4.16 && < 5,-    wireform-core == 0.1.*,-    wireform-derive == 0.1.*,+    wireform-core == 0.2.*,+    wireform-derive == 0.2.*,     bytestring >= 0.11 && < 0.13,     containers >= 0.6 && < 0.9,     megaparsec >= 9.0 && < 10,@@ -203,7 +184,7 @@     filepath >= 1.4 && < 1.6,     directory >= 1.3 && < 1.4,     deepseq >= 1.4 && < 1.6,-    template-haskell >= 2.18 && < 2.24,+    template-haskell >= 2.18 && < 2.25,     prettyprinter >= 1.7 && < 1.8,     base16-bytestring >= 1.0 && < 1.1,     base64-bytestring >= 1.2 && < 1.3,@@ -211,7 +192,7 @@     scientific >= 0.3 && < 0.4,     hashable >= 1.3 && < 1.6,     unordered-containers >= 0.2.16 && < 0.3,-    time >= 1.9 && < 1.15,+    time >= 1.9 && < 1.16,     cryptohash-md5 >= 0.11 && < 0.12,     stm >= 2.5 && < 2.6,     reflection >= 2.1 && < 2.2@@ -229,6 +210,7 @@   other-modules:     Test.Wire     Test.Roundtrip+    Test.Collect     Test.StreamCodec     Test.TDP     Test.JSON@@ -236,9 +218,6 @@     Test.WellKnownUtil     Test.Parser     Test.CodeGen-    Test.Plugin-    Test.TextFormatParsed-    Test.Editions     Test.Resolver     Test.Schema     Test.Options@@ -251,23 +230,18 @@     wireform-proto,     wireform-core,     aeson,-    base64-bytestring   >= 1.2  && < 1.3,     bytestring,     containers,     directory,     filepath,     hashable,-    process              >= 1.6  && < 1.7,-    reflection          >= 2.1  && < 2.2,     unordered-containers,-    template-haskell,     text,     time,     vector,     hedgehog             >= 1.0  && < 1.8,-    tasty                >= 1.4  && < 1.6,-    tasty-hedgehog       >= 1.0  && < 1.8,-    tasty-hunit          >= 0.10 && < 0.11+    sydtest,+    sydtest-hedgehog  -- =========================================================== -- Regenerate well-known types from .proto files.@@ -287,23 +261,6 @@     text  -- ===========================================================--- Regenerate wireform codegen for compare-bench (Messages.proto → HS).--- Run: cabal run regen-compare-bench-wireform--- ===========================================================--executable regen-compare-bench-wireform-  import: defaults-  main-is: Main.hs-  hs-source-dirs: regen-compare-bench-wireform-  build-depends:-    base,-    wireform-proto,-    containers,-    directory,-    filepath,-    text---- =========================================================== -- Conformance suite: drives the upstream protobuf -- conformance_test_runner against a wireform-conformance binary. -- See `test-conformance/README.md` for setup.@@ -381,8 +338,7 @@     template-haskell,     text,     vector,-    tasty,-    tasty-hunit+    sydtest  test-suite wireform-proto-derive-test   import: defaults@@ -420,8 +376,7 @@     template-haskell,     reflection,     vector,-    tasty,-    tasty-hunit+    sydtest  -- =========================================================== -- protoc plugin: reads CodeGeneratorRequest, writes Haskell@@ -443,29 +398,6 @@     optparse-applicative   >= 0.17 && < 0.20  -- ===========================================================--- Accumulator strategy micro-benchmark--- Compares GrowList (current), RevList, Seq, and ST/IO doubling--- arrays across different element types and list sizes.--- Run: cabal bench accum-bench--- ===========================================================--benchmark accum-bench-  import: defaults-  type: exitcode-stdio-1.0-  hs-source-dirs: bench-  main-is: AccumBench.hs-  ghc-options: -O2 -rtsopts-  -- No wireform-proto dep: GrowList is inlined in the bench file itself-  -- so this compiles and runs without touching any generated code.-  build-depends:-      base               >= 4.16 && < 5-    , bytestring-    , containers-    , deepseq-    , criterion          >= 1.5  && < 1.7-    , vector---- =========================================================== -- proto-lens comparison benchmark -- =========================================================== @@ -474,7 +406,7 @@   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:-    Proto.Bench.Wireform.Messages+    WireformTypes     Proto.Bench     Proto.Bench_Fields   build-depends:@@ -484,42 +416,9 @@     , bytestring     , text     , vector-    , containers-    , hashable-    , aeson     , deepseq     , criterion          >= 1.5  && < 1.7     , proto-lens         >= 0.7  && < 0.8     , proto-lens-runtime >= 0.7  && < 0.8     , lens-family        >= 2.1  && < 2.2-  hs-source-dirs:-    bench/compare,-    bench/compare/gen,-    bench/compare/gen-wireform---- ===========================================================--- Python interop: round-trips with google-protobuf.--- Build with: cabal build -f+python-interop wireform-proto:wireform-proto-python-interop--- Run with:   cabal run  -f+python-interop wireform-proto:wireform-proto-python-interop--- Requires python3 + pip install protobuf in PATH.--- ===========================================================--executable wireform-proto-python-interop-  import: defaults-  if !flag(python-interop)-    buildable: False-  hs-source-dirs: python-interop-  main-is: Main.hs-  ghc-options: -O0-  build-depends:-    base                >= 4.16 && < 5,-    wireform-proto,-    aeson,-    base64-bytestring   >= 1.2  && < 1.3,-    bytestring,-    containers,-    directory,-    process             >= 1.6  && < 1.7,-    reflection          >= 2.1  && < 2.2,-    text,-    vector+  hs-source-dirs: bench/compare, bench/compare/gen