From 6dcc557fc9d3ffcbfe45c6bea4969830f9e0de9c Mon Sep 17 00:00:00 2001
From: j6carey <jcarey@arista.com>
Date: Mon, 25 Sep 2023 07:49:14 -0700
Subject: [PATCH 01/10] Support ghc v9.4 and text v2 under Nix. (#100)
For now stack support lags behind.
---
.github/workflows/ci.yml | 1 +
nix/nixpkgs.nix | 7 ++++---
proto3-wire.cabal | 6 ++----
shell.nix | 5 ++---
src/Proto3/Wire/Reverse.hs | 36 +++++++++++++++++++++++++++++++-----
5 files changed, 40 insertions(+), 15 deletions(-)
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 7fa4a95..7693a08 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -15,6 +15,7 @@ jobs:
- 8107
- 902
- 924
+ - 946
runs-on: ${{ matrix.os }}
steps:
diff --git a/nix/nixpkgs.nix b/nix/nixpkgs.nix
index b278184..f1b7458 100644
--- a/nix/nixpkgs.nix
+++ b/nix/nixpkgs.nix
@@ -2,8 +2,9 @@ args:
let
nixpkgs = builtins.fetchTarball {
- # nixos-22.05 as on 2023-07-17
- url = "https://github.com/NixOS/nixpkgs/archive/380be19fbd2d9079f677978361792cb25e8a3635.tar.gz";
- sha256 = "154x9swf494mqwi4z8nbq2f0sp8pwp4fvx51lqzindjfbb9yxxv5";
+ # release: nixpkgs-23.05pre491123.261abe8a44a7
+ # commit: 261abe8a44a7e8392598d038d2e01f7b33cf26d0
+ url = "https://hydra.nixos.org/build/236149912/download/2/nixpkgs-23.05pre491123.261abe8a44a7.tar.xz";
+ sha256 = "0yhf6zbnkj3a7wfas5clli5qk4xl0cw5zq5w4fzvd724za5nb04f";
};
in import nixpkgs ({ config = { }; } // args)
diff --git a/proto3-wire.cabal b/proto3-wire.cabal
index 66dac05..c31ae2b 100644
--- a/proto3-wire.cabal
+++ b/proto3-wire.cabal
@@ -39,13 +39,12 @@ library
, cereal >= 0.5.1 && <0.6
, containers >=0.5 && < 0.7
, deepseq ==1.4.*
- , ghc-prim >=0.5.3 && <0.9
, hashable <1.5
, parameterized >=0.5.0.0 && <1
, primitive >=0.6.4 && <0.8
, safe ==0.3.*
, template-haskell >= 2.15.0 && < 2.20
- , text >= 0.2 && <1.3
+ , text >= 0.2 && <2.1
, text-short ==0.1.*
, transformers >=0.5.6.2 && <0.6
, unordered-containers >= 0.1.0.0 && <0.3
@@ -84,7 +83,7 @@ test-suite tests
, tasty >= 0.11 && <1.5
, tasty-hunit >= 0.9 && <0.11
, tasty-quickcheck >= 0.8.4 && <0.11
- , text >= 0.2 && <1.3
+ , text >= 0.2 && <2.1
, text-short ==0.1.*
, transformers >=0.5.6.2 && <0.6
, vector >=0.12.0.2 && <0.14
@@ -105,4 +104,3 @@ benchmark bench
, criterion
, proto3-wire
, random
-
diff --git a/shell.nix b/shell.nix
index 86e14fd..d9a90d8 100644
--- a/shell.nix
+++ b/shell.nix
@@ -1,4 +1,4 @@
-{ compiler ? "ghc8107" }:
+{ compiler ? "ghc8107", enableStack ? true }:
let
pkgs = import ./nix/pkgs.nix {
@@ -10,6 +10,5 @@ let
in proto3-wire.env.overrideAttrs (old: {
buildInputs = (old.buildInputs or []) ++ [
pkgs.cabal-install
- pkgs.stack
- ];
+ ] ++ (if enableStack then [ pkgs.stack ] else []);
})
diff --git a/src/Proto3/Wire/Reverse.hs b/src/Proto3/Wire/Reverse.hs
index 4501b04..dd35439 100644
--- a/src/Proto3/Wire/Reverse.hs
+++ b/src/Proto3/Wire/Reverse.hs
@@ -25,6 +25,7 @@
-- [6,0,0,0,42,206,187]
{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
module Proto3.Wire.Reverse
( -- * `BuildR` type
@@ -85,7 +86,6 @@ module Proto3.Wire.Reverse
import Data.Bits ( (.&.) )
import qualified Data.ByteString as B
-import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Internal as BLI
import qualified Data.ByteString.Short as BS
@@ -95,15 +95,21 @@ import Data.Char ( ord )
import Data.Int ( Int8, Int16, Int32, Int64 )
import qualified Data.Text as T
import qualified Data.Text.Internal as TI
-import qualified Data.Text.Internal.Fusion as TIF
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Short as TS
import Data.Vector.Generic ( Vector )
import Data.Word ( Word8, Word16, Word32, Word64 )
-import Foreign ( castPtr )
+import Foreign ( castPtr, copyBytes )
import Proto3.Wire.Reverse.Internal
import qualified Proto3.Wire.Reverse.Prim as Prim
+#if MIN_VERSION_text(2,0,0)
+import Control.Monad.ST.Unsafe (unsafeSTToIO)
+import qualified Data.Text.Array as TA
+#else
+import qualified Data.Text.Internal.Fusion as TIF
+#endif
+
-- $setup
-- >>> :set -XOverloadedStrings
-- >>> :module Proto3.Wire.Reverse
@@ -134,7 +140,7 @@ byteString bs = withUnused $ \unused ->
then
unsafeConsume len $ \dst ->
BU.unsafeUseAsCString bs $ \src ->
- BI.memcpy dst (castPtr src) len
+ copyBytes dst (castPtr src) len
else
prependChunk bs
@@ -170,7 +176,7 @@ lazyByteString = etaBuildR $ scan (ReverseChunks BL.empty)
(prepend (ReverseChunks cs) <>) $
unsafeConsume len $ \dst ->
BU.unsafeUseAsCString c $ \src ->
- BI.memcpy dst (castPtr src) len
+ copyBytes dst (castPtr src) len
else
prependReverseChunks (ReverseChunks(BLI.Chunk c cs))
@@ -508,7 +514,26 @@ stringUtf8 = foldMap charUtf8
-- >>> textUtf8 "←↑→↓"
-- Proto3.Wire.Reverse.lazyByteString "\226\134\144\226\134\145\226\134\146\226\134\147"
textUtf8 :: T.Text -> BuildR
+#if MIN_VERSION_text(2,0,0)
+textUtf8 = etaBuildR $ \(TI.Text arr off word8Count) ->
+ -- For version 2 of the "text" package, the in-memory
+ -- representation is UTF-8. We can just write it out.
+ withUnused $ \unused ->
+ if word8Count <= unused
+ then
+ writeChunk arr off word8Count
+ else
+ let rest = word8Count - unused in
+ writeChunk arr off rest <>
+ reallocate rest <> writeChunk arr (off + rest) unused
+ where
+ writeChunk src off len =
+ unsafeConsume len $ \dst -> unsafeSTToIO $
+ TA.copyToPointer src off dst len
+#else
textUtf8 = etaBuildR $ \txt@(TI.Text _ _ word16Count) ->
+ -- For version 1 of the "text" package, the in-memory
+ -- representation is UTF-16. We must transcode to UTF-8.
case TIF.reverseStream txt of
TIF.Stream next t0 _ -> ensure bound (go t0)
where
@@ -533,6 +558,7 @@ textUtf8 = etaBuildR $ \txt@(TI.Text _ _ word16Count) ->
TIF.Skip t2 -> go t2
TIF.Yield !ch t2 ->
go t2 <> Prim.unsafeBuildBoundedPrim (Prim.charUtf8 ch)
+#endif
-- | Convert a Unicode lazy `TL.Text` to a `BuildR` using a @UTF-8@ encoding
--
From 938523213d5de2d0ad9ece051d1a03002ee539cc Mon Sep 17 00:00:00 2001
From: j6carey <jcarey@arista.com>
Date: Wed, 11 Oct 2023 10:20:25 -0700
Subject: [PATCH 02/10] Stop fully inlining of packed field encoders. (#101)
We want to inline the field number because it
is often a constant. But by forcing the entire
fold to be INLINE, not just the field number,
we force an impossible choice on proto3-suite:
inline nothing or everything. Therefore we
leave the actual folds merely INLINABLE.
(If that is insufficient control then we
may have to expose a more complex API.)
Also give the compiler more discretion
about whether to inline varints.
---
src/Proto3/Wire/Encode.hs | 56 +++++++++++++++++++--------------
src/Proto3/Wire/Reverse/Prim.hs | 12 ++++---
2 files changed, 40 insertions(+), 28 deletions(-)
diff --git a/src/Proto3/Wire/Encode.hs b/src/Proto3/Wire/Encode.hs
index c6c7f4f..cf413cc 100644
--- a/src/Proto3/Wire/Encode.hs
+++ b/src/Proto3/Wire/Encode.hs
@@ -535,9 +535,9 @@ shortByteString num = embedded num . MessageBuilder . RB.shortByteString
-- >>> packedVarints 1 [1, 2, 3]
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\ETX\SOH\STX\ETX"
packedVarints :: Foldable f => FieldNumber -> f Word64 -> MessageBuilder
-packedVarints num =
- etaMessageBuilder
- (embedded num . foldMap (liftBoundedPrim . base128Varint64))
+packedVarints num = etaMessageBuilder (embedded num . payload)
+ where
+ payload = foldMap (liftBoundedPrim . base128Varint64)
{-# INLINE packedVarints #-}
-- | A faster but more specialized variant of:
@@ -548,8 +548,9 @@ packedVarints num =
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\ETX\SOH\STX\ETX"
packedVarintsV ::
Vector v a => (a -> Word64) -> FieldNumber -> v a -> MessageBuilder
-packedVarintsV f num =
- embedded num . vectorMessageBuilder (liftBoundedPrim . base128Varint64 . f)
+packedVarintsV f num = embedded num . payload
+ where
+ payload = vectorMessageBuilder (liftBoundedPrim . base128Varint64 . f)
{-# INLINE packedVarintsV #-}
-- | A faster but more specialized variant of:
@@ -560,10 +561,9 @@ packedVarintsV f num =
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\STX\SOH\NUL"
packedBoolsV ::
Vector v a => (a -> Bool) -> FieldNumber -> v a -> MessageBuilder
-packedBoolsV f num =
- embedded num . MessageBuilder . Prim.vectorFixedPrim op
+packedBoolsV f num = embedded num . MessageBuilder . payload
where
- op = Prim.word8 . fromIntegral . fromEnum . f
+ payload = Prim.vectorFixedPrim (Prim.word8 . fromIntegral . fromEnum . f)
{-# INLINE packedBoolsV #-}
-- | Encode fixed-width Word32s in the space-efficient packed format.
@@ -574,8 +574,9 @@ packedBoolsV f num =
-- >>> packedFixed32 1 [1, 2, 3]
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\SOH\NUL\NUL\NUL\STX\NUL\NUL\NUL\ETX\NUL\NUL\NUL"
packedFixed32 :: Foldable f => FieldNumber -> f Word32 -> MessageBuilder
-packedFixed32 num =
- etaMessageBuilder (embedded num . foldMap (MessageBuilder . RB.word32LE))
+packedFixed32 num = etaMessageBuilder (embedded num . payload)
+ where
+ payload = foldMap (MessageBuilder . RB.word32LE)
{-# INLINE packedFixed32 #-}
-- | A faster but more specialized variant of:
@@ -586,8 +587,9 @@ packedFixed32 num =
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\SOH\NUL\NUL\NUL\STX\NUL\NUL\NUL\ETX\NUL\NUL\NUL"
packedFixed32V ::
Vector v a => (a -> Word32) -> FieldNumber -> v a -> MessageBuilder
-packedFixed32V f num =
- embedded num . MessageBuilder . Prim.vectorFixedPrim (Prim.word32LE . f)
+packedFixed32V f num = etaMessageBuilder (embedded num . payload)
+ where
+ payload = MessageBuilder . Prim.vectorFixedPrim (Prim.word32LE . f)
{-# INLINE packedFixed32V #-}
-- | Encode fixed-width Word64s in the space-efficient packed format.
@@ -598,8 +600,9 @@ packedFixed32V f num =
-- >>> packedFixed64 1 [1, 2, 3]
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NUL"
packedFixed64 :: Foldable f => FieldNumber -> f Word64 -> MessageBuilder
-packedFixed64 num =
- etaMessageBuilder (embedded num . foldMap (MessageBuilder . RB.word64LE))
+packedFixed64 num = etaMessageBuilder (embedded num . payload)
+ where
+ payload = foldMap (MessageBuilder . RB.word64LE)
{-# INLINE packedFixed64 #-}
-- | A faster but more specialized variant of:
@@ -610,8 +613,9 @@ packedFixed64 num =
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NUL"
packedFixed64V ::
Vector v a => (a -> Word64) -> FieldNumber -> v a -> MessageBuilder
-packedFixed64V f num =
- embedded num . MessageBuilder . Prim.vectorFixedPrim (Prim.word64LE . f)
+packedFixed64V f num = etaMessageBuilder (embedded num . payload)
+ where
+ payload = MessageBuilder . Prim.vectorFixedPrim (Prim.word64LE . f)
{-# INLINE packedFixed64V #-}
-- | Encode floats in the space-efficient packed format.
@@ -620,8 +624,9 @@ packedFixed64V f num =
-- >>> 1 `packedFloats` [1, 2, 3]
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\NUL\NUL\128?\NUL\NUL\NUL@\NUL\NUL@@"
packedFloats :: Foldable f => FieldNumber -> f Float -> MessageBuilder
-packedFloats num =
- etaMessageBuilder (embedded num . foldMap (MessageBuilder . RB.floatLE))
+packedFloats num = etaMessageBuilder (embedded num . payload)
+ where
+ payload = foldMap (MessageBuilder . RB.floatLE)
{-# INLINE packedFloats #-}
-- | A faster but more specialized variant of:
@@ -632,8 +637,9 @@ packedFloats num =
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\NUL\NUL\128?\NUL\NUL\NUL@\NUL\NUL@@"
packedFloatsV ::
Vector v a => (a -> Float) -> FieldNumber -> v a -> MessageBuilder
-packedFloatsV f num =
- embedded num . MessageBuilder . Prim.vectorFixedPrim (Prim.floatLE . f)
+packedFloatsV f num = etaMessageBuilder (embedded num . payload)
+ where
+ payload = MessageBuilder . Prim.vectorFixedPrim (Prim.floatLE . f)
{-# INLINE packedFloatsV #-}
-- | Encode doubles in the space-efficient packed format.
@@ -642,8 +648,9 @@ packedFloatsV f num =
-- >>> 1 `packedDoubles` [1, 2, 3]
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\NUL\NUL\NUL\NUL\NUL\NUL\240?\NUL\NUL\NUL\NUL\NUL\NUL\NUL@\NUL\NUL\NUL\NUL\NUL\NUL\b@"
packedDoubles :: Foldable f => FieldNumber -> f Double -> MessageBuilder
-packedDoubles num =
- etaMessageBuilder (embedded num . foldMap (MessageBuilder . RB.doubleLE))
+packedDoubles num = etaMessageBuilder (embedded num . payload)
+ where
+ payload = foldMap (MessageBuilder . RB.doubleLE)
{-# INLINE packedDoubles #-}
-- | A faster but more specialized variant of:
@@ -654,8 +661,9 @@ packedDoubles num =
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\NUL\NUL\NUL\NUL\NUL\NUL\240?\NUL\NUL\NUL\NUL\NUL\NUL\NUL@\NUL\NUL\NUL\NUL\NUL\NUL\b@"
packedDoublesV ::
Vector v a => (a -> Double) -> FieldNumber -> v a -> MessageBuilder
-packedDoublesV f num =
- embedded num . MessageBuilder . Prim.vectorFixedPrim (Prim.doubleLE . f)
+packedDoublesV f num = etaMessageBuilder (embedded num . payload)
+ where
+ payload = MessageBuilder . Prim.vectorFixedPrim (Prim.doubleLE . f)
{-# INLINE packedDoublesV #-}
-- | Encode an embedded message.
diff --git a/src/Proto3/Wire/Reverse/Prim.hs b/src/Proto3/Wire/Reverse/Prim.hs
index 33dacec..eda7b58 100644
--- a/src/Proto3/Wire/Reverse/Prim.hs
+++ b/src/Proto3/Wire/Reverse/Prim.hs
@@ -711,8 +711,13 @@ wordBase128LEVar_inline (W# w) = word64Base128LEVar_inline (W64# w)
-- | The bounded primitive implementing
-- `Proto3.Wire.Reverse.word32Base128LEVar`.
word32Base128LEVar :: Word32 -> BoundedPrim 5
-word32Base128LEVar = word32Base128LEVar_inline
-{-# INLINE word32Base128LEVar #-}
+word32Base128LEVar (W32# x0) =
+ ( wordBase128LEVar_choose 1 wordBase128LE_p1 $
+ wordBase128LEVar_choose 2 wordBase128LE_p2 $
+ wordBase128LEVar_choose 3 wordBase128LE_p3 $
+ wordBase128LEVar_choose 4 wordBase128LE_p4 $
+ (\x -> liftFixedPrim (wordBase128LE_p5 0## x))
+ ) x0
-- | Like 'word32Base128LEVar' but inlined, which currently means
-- that it is just the same as 'word32Base128LEVar', which we inline.
@@ -798,14 +803,13 @@ word64Base128LEVar = \(W64# x) ->
pif (W64# x <= fromIntegral (maxBound :: Word32))
(word32Base128LEVar (fromIntegral (W64# x)))
(word64Base128LEVar_big x)
-{-# INLINE word64Base128LEVar #-}
-- | Like 'word64Base128LEVar' but inlined, possibly bloating your code. On
-- the other hand, inlining an application to a constant may shrink your code.
word64Base128LEVar_inline :: Word64 -> BoundedPrim 10
word64Base128LEVar_inline = \(W64# x) ->
pif (W64# x <= fromIntegral (maxBound :: Word32))
- (word32Base128LEVar (fromIntegral (W64# x)))
+ (word32Base128LEVar_inline (fromIntegral (W64# x)))
(inline (word64Base128LEVar_big x))
{-# INLINE word64Base128LEVar_inline #-}
From 2eeb5faaf107f231fa6d33e25f4b791944d5ffae Mon Sep 17 00:00:00 2001
From: dicioccio lucas <lucas@dicioccio.fr>
Date: Wed, 17 Apr 2024 00:53:06 +0200
Subject: [PATCH 03/10] Upgrade bounds to pass compilation with GHC-9.8.2 /
Cabal-3.10.3.0 (#102)
Also add cabal.project.
---
cabal.project | 1 +
proto3-wire.cabal | 6 +++---
2 files changed, 4 insertions(+), 3 deletions(-)
create mode 100644 cabal.project
diff --git a/cabal.project b/cabal.project
new file mode 100644
index 0000000..e6fdbad
--- /dev/null
+++ b/cabal.project
@@ -0,0 +1 @@
+packages: .
diff --git a/proto3-wire.cabal b/proto3-wire.cabal
index c31ae2b..14ec87f 100644
--- a/proto3-wire.cabal
+++ b/proto3-wire.cabal
@@ -38,12 +38,12 @@ library
, bytestring >=0.10.6.0 && <0.12.0
, cereal >= 0.5.1 && <0.6
, containers >=0.5 && < 0.7
- , deepseq ==1.4.*
+ , deepseq >=1.4 && <1.6
, hashable <1.5
, parameterized >=0.5.0.0 && <1
- , primitive >=0.6.4 && <0.8
+ , primitive >=0.6.4 && <0.9
, safe ==0.3.*
- , template-haskell >= 2.15.0 && < 2.20
+ , template-haskell >= 2.15.0 && < 2.22
, text >= 0.2 && <2.1
, text-short ==0.1.*
, transformers >=0.5.6.2 && <0.6
From b3d837f66d97f97f1ad46c5bb0f1d1bb3b7b13c1 Mon Sep 17 00:00:00 2001
From: Parnell Springmeyer <ixmatus@users.noreply.github.com>
Date: Wed, 17 Apr 2024 18:39:04 -0500
Subject: [PATCH 04/10] 1.4.1 -> 1.4.2; update changelog (#103)
---
CHANGELOG.md | 3 +++
proto3-wire.cabal | 2 +-
2 files changed, 4 insertions(+), 1 deletion(-)
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 17ac95f..fd4885c 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,6 @@
+1.4.2
+ - Support GHC 9.4
+
1.4.1
- Support ShortByteString and ShortText
diff --git a/proto3-wire.cabal b/proto3-wire.cabal
index 14ec87f..4a0d0e7 100644
--- a/proto3-wire.cabal
+++ b/proto3-wire.cabal
@@ -1,7 +1,7 @@
cabal-version: >=1.10
name: proto3-wire
-version: 1.4.1
+version: 1.4.2
synopsis: A low-level implementation of the Protocol Buffers (version 3) wire format
license: Apache-2.0
license-file: LICENSE
From d130c70d62b7d8d82bbc767ac98d72ae10fcb6e6 Mon Sep 17 00:00:00 2001
From: alexfmpe <2335822+alexfmpe@users.noreply.github.com>
Date: Wed, 15 May 2024 18:29:11 +0100
Subject: [PATCH 05/10] Bump upper bounds (#104)
* Bump upper bounds
* cabal build all components by default
---
cabal.project | 2 ++
proto3-wire.cabal | 16 ++++++++--------
2 files changed, 10 insertions(+), 8 deletions(-)
diff --git a/cabal.project b/cabal.project
index e6fdbad..51051bb 100644
--- a/cabal.project
+++ b/cabal.project
@@ -1 +1,3 @@
packages: .
+benchmarks: True
+tests: True
diff --git a/proto3-wire.cabal b/proto3-wire.cabal
index 4a0d0e7..c520571 100644
--- a/proto3-wire.cabal
+++ b/proto3-wire.cabal
@@ -35,7 +35,7 @@ library
build-depends:
base >=4.12 && <=5.0
- , bytestring >=0.10.6.0 && <0.12.0
+ , bytestring >=0.10.6.0 && <0.13.0
, cereal >= 0.5.1 && <0.6
, containers >=0.5 && < 0.7
, deepseq >=1.4 && <1.6
@@ -44,9 +44,9 @@ library
, primitive >=0.6.4 && <0.9
, safe ==0.3.*
, template-haskell >= 2.15.0 && < 2.22
- , text >= 0.2 && <2.1
+ , text >= 0.2 && <2.2
, text-short ==0.1.*
- , transformers >=0.5.6.2 && <0.6
+ , transformers >=0.5.6.2 && <0.7
, unordered-containers >= 0.1.0.0 && <0.3
, vector >=0.12.0.2 && <0.14
, QuickCheck >=2.8 && <3.0
@@ -75,17 +75,17 @@ test-suite tests
build-depends:
base >=4.9 && <=5.0
- , bytestring >=0.10.6.0 && <0.12.0
+ , bytestring >=0.10.6.0 && <0.13.0
, cereal >= 0.5.1 && <0.6
- , doctest >= 0.7.0 && <0.21.0
+ , doctest >= 0.7.0 && <0.23.0
, proto3-wire
, QuickCheck >=2.8 && <3.0
- , tasty >= 0.11 && <1.5
+ , tasty >= 0.11 && <1.6
, tasty-hunit >= 0.9 && <0.11
, tasty-quickcheck >= 0.8.4 && <0.11
- , text >= 0.2 && <2.1
+ , text >= 0.2 && <2.2
, text-short ==0.1.*
- , transformers >=0.5.6.2 && <0.6
+ , transformers >=0.5.6.2 && <0.7
, vector >=0.12.0.2 && <0.14
benchmark bench
From cef201d752f57aad90279e072392da6ba56c531b Mon Sep 17 00:00:00 2001
From: j6carey <jcarey@arista.com>
Date: Tue, 21 May 2024 09:20:24 -0700
Subject: [PATCH 06/10] v1.4.3: support GHC 9.6, 9.8 (#105)
v1.4.3: support GHC 9.6, 9.8
Skip GHC 9.0+Darwin due to crypton problem.
---
.github/workflows/ci.yml | 9 +-
CHANGELOG.md | 4 +
README.md | 27 ++++++
nix/haskell-packages.nix | 160 +++++++++++++++++++++++++++++--
nix/nixpkgs.nix | 8 +-
nix/packages/bifunctors.nix | 22 +++++
nix/packages/doctest.nix | 30 ++++++
nix/packages/free.nix | 19 ++++
nix/packages/hpack.nix | 40 ++++++++
nix/packages/http-client-tls.nix | 23 +++++
nix/packages/lens.nix | 37 +++++++
nix/packages/parsec-class.nix | 10 ++
nix/packages/semigroupoids.nix | 19 ++++
nix/packages/tagged.nix | 15 +++
nix/packages/th-abstraction.nix | 14 +++
nix/patches/aeson-2.1.2.1.patch | 11 +++
nix/patches/pantry-0.9.3.2.patch | 13 +++
proto3-wire.cabal | 2 +-
shell.nix | 13 ++-
test/Main.hs | 5 +-
20 files changed, 458 insertions(+), 23 deletions(-)
create mode 100644 nix/packages/bifunctors.nix
create mode 100644 nix/packages/doctest.nix
create mode 100644 nix/packages/free.nix
create mode 100644 nix/packages/hpack.nix
create mode 100644 nix/packages/http-client-tls.nix
create mode 100644 nix/packages/lens.nix
create mode 100644 nix/packages/parsec-class.nix
create mode 100644 nix/packages/semigroupoids.nix
create mode 100644 nix/packages/tagged.nix
create mode 100644 nix/packages/th-abstraction.nix
create mode 100644 nix/patches/aeson-2.1.2.1.patch
create mode 100644 nix/patches/pantry-0.9.3.2.patch
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 7693a08..6bab750 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -14,8 +14,13 @@ jobs:
ghc:
- 8107
- 902
- - 924
- - 946
+ - 928
+ - 948
+ - 962
+ - 981
+ exclude:
+ - os: macos-latest
+ ghc: 902
runs-on: ${{ matrix.os }}
steps:
diff --git a/CHANGELOG.md b/CHANGELOG.md
index fd4885c..05ee2cd 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,7 @@
+1.4.3
+ - Support GHC 9.8
+ - Support GHC 9.6
+
1.4.2
- Support GHC 9.4
diff --git a/README.md b/README.md
index 99aa4c2..e77f8ad 100644
--- a/README.md
+++ b/README.md
@@ -25,3 +25,30 @@ To run tests or generate documentation, use
```text
stack build [--test] [--haddock]
```
+
+### GHC Versions
+
+#### GHC 9.8
+
+Supported on Linux and Darwin.
+
+#### GHC 9.6
+
+Supported on Linux and Darwin.
+
+#### GHC 9.4
+
+Supported on Linux and Darwin.
+
+#### GHC 9.2
+
+Supported on Linux and Darwin.
+
+#### GHC 9.0
+
+Supported only on Linux because "crypton" fails a test on Darwin,
+probably due to [this issue](https://github.com/kazu-yamamoto/crypton/issues/35).
+
+#### GHC 8.10.7
+
+Supported on Linux and Darwin.
diff --git a/nix/haskell-packages.nix b/nix/haskell-packages.nix
index 6580ff6..0b17be9 100644
--- a/nix/haskell-packages.nix
+++ b/nix/haskell-packages.nix
@@ -5,15 +5,157 @@ pkgsNew: pkgsOld:
{
haskellPackages = pkgsOld.haskell.packages."${compiler}".override (old: {
overrides =
- pkgsOld.lib.composeExtensions
+ pkgsNew.lib.fold pkgsNew.lib.composeExtensions
(old.overrides or (_: _: {}))
- (haskellPackagesFinal: haskellPackagesPrev: {
- proto3-wire = haskellPackagesFinal.callCabal2nix "proto3-wire" ../. { };
-
- # ghc-9.2 requires word-compat-0.0.6
- word-compat = haskellPackagesFinal.callPackage ./word-compat.nix { };
- # Use newer version 4.7.1.0 for ghc-9.x support
- data-diverse = haskellPackagesFinal.callPackage ./data-diverse.nix { };
- });
+ [ (pkgsNew.haskell.lib.packagesFromDirectory { directory = ./packages; })
+ (haskellPackagesFinal: haskellPackagesPrev: {
+ # With nixpkgs-23.11 and ghc981, adjunctions wants hspec for testing,
+ # which causes problems.
+ adjunctions =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.adjunctions;
+
+ # With nixpkgs-23.11 and ghc981, aeson-2.1.2.1 thinks that th-abstraction is out of bounds.
+ # Also, in order to avoid the breaking change to package structure in aeson-2.2.0.0,
+ # we patch the import list of aeson-2.1.2.1.
+ aeson =
+ pkgsNew.haskell.lib.doJailbreak
+ ( pkgsNew.haskell.lib.appendPatches haskellPackagesPrev.aeson
+ [ ./patches/aeson-2.1.2.1.patch ] );
+
+ # With nixpkgs-23.11 and ghc981, base-compat-batteries wants hspec for testing,
+ # which causes problems.
+ base-compat-batteries =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.base-compat-batteries;
+
+ # With nixpkgs-23.11 and ghc981, base-orphans wants hspec for testing,
+ # which causes problems.
+ base-orphans =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.base-orphans;
+
+ # With nixpkgs-23.11 and ghc981, bifunctors wants hspec for testing,
+ # which causes problems.
+ bifunctors =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.bifunctors;
+
+ # With nixpkgs-23.11 and ghc981, conduit wants hspec for testing,
+ # which causes problems.
+ conduit =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.conduit;
+
+ # With nixpkgs-23.11 and ghc981, data-diverse wants hspec for testing,
+ # which causes problems.
+ data-diverse =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.data-diverse;
+
+ # With nixpkgs-23.11 and ghc981, distribution-nixpkgs wants hspec for testing,
+ # which causes problems.
+ distribution-nixpkgs =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.distribution-nixpkgs;
+
+ # With nixpkgs-23.11 and ghc981, distributive wants hspec for testing,
+ # which causes problems.
+ distributive =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.distributive;
+
+ # With ghc981, doctest-0.22.2 complains about the version of the base
+ # package and depends on hspec for testing, which causes problems.
+ doctest =
+ pkgsNew.haskell.lib.dontCheck
+ (pkgsNew.haskell.lib.doJailbreak haskellPackagesPrev.doctest);
+
+ # With nixpkgs-23.11 and ghc981, generic-deriving wants hspec for testing,
+ # which causes problems. Also, it generic-deriving thinks that
+ # th-abstraction is out of bounds.
+ generic-deriving =
+ pkgsNew.haskell.lib.dontCheck
+ (pkgsNew.haskell.lib.doJailbreak haskellPackagesPrev.generic-deriving);
+
+ # With nixpkgs-23.11 and ghc981, hourglass does not support the version
+ # of the time package that is provided, but that matters only to tests.
+ hourglass =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.hourglass;
+
+ # With nixpkgs-23.11 and ghc981, hpack-0.36.0 wants hspec for testing,
+ # which causes problems.
+ hpack =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.hpack;
+
+ # With nixpkgs-23.11 and ghc981, http-types wants hspec for testing,
+ # which causes problems.
+ http-types =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.http-types;
+
+ # With nixpkgs-23.11 and ghc981, infer-license wants hspec for testing,
+ # which causes problems.
+ infer-license =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.infer-license;
+
+ # With nixpkgs-23.11 and ghc981, invariant indirectly depends on hspec for testing,
+ # which causes problems. Also, it generic-deriving thinks that
+ # th-abstraction is out of bounds.
+ invariant =
+ pkgsNew.haskell.lib.dontCheck
+ (pkgsNew.haskell.lib.doJailbreak haskellPackagesPrev.invariant);
+
+ # With nixpkgs-23.11 and ghc981, iproute wants hspec for testing,
+ # which causes problems.
+ iproute =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.iproute;
+
+ # With nixpkgs-23.11 and ghc981, monad-par wants test-framework for testing, which
+ # wants language-haskell-extract, which does not support modern template-haskell.
+ monad-par =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.monad-par;
+
+ # With nixpkgs-23.11 and ghc981, mono-traversable wants hspec for testing,
+ # which causes problems.
+ mono-traversable =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.mono-traversable;
+
+ # With nixpkgs-23.11 and ghc981, streaming-commons wants hspec for testing,
+ # which causes problems.
+ streaming-commons =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.streaming-commons;
+
+ # With nixpkgs-23.11 and ghc981, reflection indirectly depends on hspec for testing,
+ # which causes problems.
+ reflection =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.reflection;
+
+ # With nixpkgs-23.11 and ghc981, resourcet wants hspec for testing,
+ # which causes problems.
+ resourcet =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.resourcet;
+
+ # Suppress:
+ # warning: non-portable path to file '"dist/build/Test/autogen/cabal_macros.h"'; specified path differs in case from file name on disk [-Wnonportable-include-path]
+ tasty-golden =
+ pkgsNew.haskell.lib.appendConfigureFlags haskellPackagesPrev.tasty-golden
+ [ "--ghc-option=-Wno-nonportable-include-path" ];
+
+ # With nixpkgs-23.11 and ghc981, text-metrics wants hspec for testing,
+ # which causes problems.
+ text-metrics =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.text-metrics;
+
+ # With nixpkgs-23.11 and ghc981, th-compat wants hspec for testing,
+ # which causes problems.
+ th-compat =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.th-compat;
+
+ # With nixpkgs-23.11 and ghc981, hpack-0.36.0 wants hspec for testing,
+ # which causes problems.
+ unix-time =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.unix-time;
+
+ # With nixpkgs-23.11 and ghc981, yaml wants hspec for testing,
+ # which causes problems.
+ yaml =
+ pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.yaml;
+ })
+ (haskellPackagesFinal: haskellPackagesPrev: {
+ proto3-wire = haskellPackagesFinal.callCabal2nix "proto3-wire" ../. { };
+ })
+ ];
});
}
diff --git a/nix/nixpkgs.nix b/nix/nixpkgs.nix
index f1b7458..fdb1eac 100644
--- a/nix/nixpkgs.nix
+++ b/nix/nixpkgs.nix
@@ -2,9 +2,9 @@ args:
let
nixpkgs = builtins.fetchTarball {
- # release: nixpkgs-23.05pre491123.261abe8a44a7
- # commit: 261abe8a44a7e8392598d038d2e01f7b33cf26d0
- url = "https://hydra.nixos.org/build/236149912/download/2/nixpkgs-23.05pre491123.261abe8a44a7.tar.xz";
- sha256 = "0yhf6zbnkj3a7wfas5clli5qk4xl0cw5zq5w4fzvd724za5nb04f";
+ # build: https://hydra.nixos.org/build/258096332
+ # commit: 0638fe2715d998fa81d173aad264eb671ce2ebc1
+ url = "https://hydra.nixos.org/build/258096332/download/2/nixpkgs-23.11pre558121.0638fe2715d9.tar.xz";
+ sha256 = "1z3s1hqg3b72g608pf9sv474d4y9s00p86nsvfw5i9xgwhjncjjb";
};
in import nixpkgs ({ config = { }; } // args)
diff --git a/nix/packages/bifunctors.nix b/nix/packages/bifunctors.nix
new file mode 100644
index 0000000..f4cf326
--- /dev/null
+++ b/nix/packages/bifunctors.nix
@@ -0,0 +1,22 @@
+{ mkDerivation, assoc, base, comonad, containers
+, foldable1-classes-compat, hspec, hspec-discover, lib, QuickCheck
+, tagged, template-haskell, th-abstraction, transformers
+, transformers-compat
+}:
+mkDerivation {
+ pname = "bifunctors";
+ version = "5.6.2";
+ sha256 = "1086a9285061eed0c2c5d3cb65aa223defd52fca6d0515bb69ddf2dbc3d9697a";
+ libraryHaskellDepends = [
+ assoc base comonad containers foldable1-classes-compat tagged
+ template-haskell th-abstraction transformers
+ ];
+ testHaskellDepends = [
+ base hspec QuickCheck template-haskell transformers
+ transformers-compat
+ ];
+ testToolDepends = [ hspec-discover ];
+ homepage = "http://github.com/ekmett/bifunctors/";
+ description = "Bifunctors";
+ license = lib.licenses.bsd3;
+}
diff --git a/nix/packages/doctest.nix b/nix/packages/doctest.nix
new file mode 100644
index 0000000..9e64520
--- /dev/null
+++ b/nix/packages/doctest.nix
@@ -0,0 +1,30 @@
+{ mkDerivation, base, code-page, deepseq, directory, exceptions
+, filepath, ghc, ghc-paths, hspec, hspec-core, hspec-discover
+, HUnit, lib, mockery, process, QuickCheck, setenv, silently
+, stringbuilder, syb, transformers
+}:
+mkDerivation {
+ pname = "doctest";
+ version = "0.22.2";
+ sha256 = "afb839c14019c17e3ec7900871a9fc104226028858c724932d53225ae382c6e5";
+ isLibrary = true;
+ isExecutable = true;
+ libraryHaskellDepends = [
+ base code-page deepseq directory exceptions filepath ghc ghc-paths
+ process syb transformers
+ ];
+ executableHaskellDepends = [
+ base code-page deepseq directory exceptions filepath ghc ghc-paths
+ process syb transformers
+ ];
+ testHaskellDepends = [
+ base code-page deepseq directory exceptions filepath ghc ghc-paths
+ hspec hspec-core HUnit mockery process QuickCheck setenv silently
+ stringbuilder syb transformers
+ ];
+ testToolDepends = [ hspec-discover ];
+ homepage = "https://github.com/sol/doctest#readme";
+ description = "Test interactive Haskell examples";
+ license = lib.licenses.mit;
+ mainProgram = "doctest";
+}
diff --git a/nix/packages/free.nix b/nix/packages/free.nix
new file mode 100644
index 0000000..f19700e
--- /dev/null
+++ b/nix/packages/free.nix
@@ -0,0 +1,19 @@
+{ mkDerivation, base, comonad, containers, distributive, exceptions
+, indexed-traversable, lib, mtl, profunctors, semigroupoids
+, template-haskell, th-abstraction, transformers, transformers-base
+}:
+mkDerivation {
+ pname = "free";
+ version = "5.2";
+ sha256 = "72867f7c89173263765736e8d395e94291f1aaea626ecb1d673d72ce90b94f89";
+ revision = "4";
+ editedCabalFile = "0vic3p2viip8gjww8fx19ax6ry7y34h7xclvhzkvmbspjh9d219x";
+ libraryHaskellDepends = [
+ base comonad containers distributive exceptions indexed-traversable
+ mtl profunctors semigroupoids template-haskell th-abstraction
+ transformers transformers-base
+ ];
+ homepage = "http://github.com/ekmett/free/";
+ description = "Monads for free";
+ license = lib.licenses.bsd3;
+}
diff --git a/nix/packages/hpack.nix b/nix/packages/hpack.nix
new file mode 100644
index 0000000..8b74b68
--- /dev/null
+++ b/nix/packages/hpack.nix
@@ -0,0 +1,40 @@
+{ mkDerivation, aeson, base, bifunctors, bytestring, Cabal
+, containers, crypton, deepseq, directory, filepath, Glob, hspec
+, hspec-discover, http-client, http-client-tls, http-types, HUnit
+, infer-license, interpolate, lib, mockery, mtl, pretty, QuickCheck
+, scientific, template-haskell, temporary, text, transformers
+, unordered-containers, vector, yaml
+}:
+mkDerivation {
+ pname = "hpack";
+ version = "0.36.0";
+ sha256 = "a0de4e1a0fe587030fa643cad99cd96de81e295923ffb57cfc7b1575f253ea7a";
+ revision = "1";
+ editedCabalFile = "1zh5rsf38xmwp7lf80iifrhnkl80lri4xzlhz2n5df3vc0dqzya8";
+ isLibrary = true;
+ isExecutable = true;
+ libraryHaskellDepends = [
+ aeson base bifunctors bytestring Cabal containers crypton deepseq
+ directory filepath Glob http-client http-client-tls http-types
+ infer-license mtl pretty scientific text transformers
+ unordered-containers vector yaml
+ ];
+ executableHaskellDepends = [
+ aeson base bifunctors bytestring Cabal containers crypton deepseq
+ directory filepath Glob http-client http-client-tls http-types
+ infer-license mtl pretty scientific text transformers
+ unordered-containers vector yaml
+ ];
+ testHaskellDepends = [
+ aeson base bifunctors bytestring Cabal containers crypton deepseq
+ directory filepath Glob hspec http-client http-client-tls
+ http-types HUnit infer-license interpolate mockery mtl pretty
+ QuickCheck scientific template-haskell temporary text transformers
+ unordered-containers vector yaml
+ ];
+ testToolDepends = [ hspec-discover ];
+ homepage = "https://github.com/sol/hpack#readme";
+ description = "A modern format for Haskell packages";
+ license = lib.licenses.mit;
+ mainProgram = "hpack";
+}
diff --git a/nix/packages/http-client-tls.nix b/nix/packages/http-client-tls.nix
new file mode 100644
index 0000000..327b264
--- /dev/null
+++ b/nix/packages/http-client-tls.nix
@@ -0,0 +1,23 @@
+{ mkDerivation, base, bytestring, case-insensitive, containers
+, crypton, crypton-connection, data-default-class, exceptions
+, gauge, hspec, http-client, http-types, lib, memory, network
+, network-uri, text, tls, transformers
+}:
+mkDerivation {
+ pname = "http-client-tls";
+ version = "0.3.6.3";
+ sha256 = "38dcfc3d772eb6898b4a8856d6159824d13f65eb291733619f625a802dad9095";
+ libraryHaskellDepends = [
+ base bytestring case-insensitive containers crypton
+ crypton-connection data-default-class exceptions http-client
+ http-types memory network network-uri text tls transformers
+ ];
+ testHaskellDepends = [
+ base crypton-connection hspec http-client http-types
+ ];
+ benchmarkHaskellDepends = [ base gauge http-client ];
+ doCheck = false;
+ homepage = "https://github.com/snoyberg/http-client";
+ description = "http-client backend using the connection package and tls library";
+ license = lib.licenses.mit;
+}
diff --git a/nix/packages/lens.nix b/nix/packages/lens.nix
new file mode 100644
index 0000000..d495523
--- /dev/null
+++ b/nix/packages/lens.nix
@@ -0,0 +1,37 @@
+{ mkDerivation, array, assoc, base, base-orphans, bifunctors
+, bytestring, call-stack, comonad, containers, contravariant
+, criterion, deepseq, distributive, exceptions, filepath, free
+, generic-deriving, ghc-prim, hashable, HUnit, indexed-traversable
+, indexed-traversable-instances, kan-extensions, lib, mtl, parallel
+, profunctors, QuickCheck, reflection, semigroupoids
+, simple-reflect, strict, tagged, template-haskell, test-framework
+, test-framework-hunit, test-framework-quickcheck2, text
+, th-abstraction, these, transformers, transformers-compat
+, unordered-containers, vector
+}:
+mkDerivation {
+ pname = "lens";
+ version = "5.3.1";
+ sha256 = "dac3ff7abd483ef36956882631fdcde922e086b51f459c0c02e690c6b7f24b6c";
+ libraryHaskellDepends = [
+ array assoc base base-orphans bifunctors bytestring call-stack
+ comonad containers contravariant distributive exceptions filepath
+ free ghc-prim hashable indexed-traversable
+ indexed-traversable-instances kan-extensions mtl parallel
+ profunctors reflection semigroupoids strict tagged template-haskell
+ text th-abstraction these transformers transformers-compat
+ unordered-containers vector
+ ];
+ testHaskellDepends = [
+ base bytestring containers deepseq HUnit mtl QuickCheck
+ simple-reflect test-framework test-framework-hunit
+ test-framework-quickcheck2 text transformers
+ ];
+ benchmarkHaskellDepends = [
+ base bytestring comonad containers criterion deepseq
+ generic-deriving transformers unordered-containers vector
+ ];
+ homepage = "http://github.com/ekmett/lens/";
+ description = "Lenses, Folds and Traversals";
+ license = lib.licenses.bsd2;
+}
diff --git a/nix/packages/parsec-class.nix b/nix/packages/parsec-class.nix
new file mode 100644
index 0000000..ebb55dd
--- /dev/null
+++ b/nix/packages/parsec-class.nix
@@ -0,0 +1,10 @@
+{ mkDerivation, base, lib, parsec }:
+mkDerivation {
+ pname = "parsec-class";
+ version = "1.0.1.0";
+ sha256 = "068686c03627ffca77128a762de295c4a43095b9e8dbe3829efc91fed00c418c";
+ libraryHaskellDepends = [ base parsec ];
+ homepage = "https://github.com/peti/parsec-class";
+ description = "Class of types that can be constructed from their text representation";
+ license = lib.licenses.mit;
+}
diff --git a/nix/packages/semigroupoids.nix b/nix/packages/semigroupoids.nix
new file mode 100644
index 0000000..0058ab1
--- /dev/null
+++ b/nix/packages/semigroupoids.nix
@@ -0,0 +1,19 @@
+{ mkDerivation, base, base-orphans, bifunctors, comonad, containers
+, contravariant, distributive, foldable1-classes-compat, hashable
+, lib, tagged, template-haskell, transformers, transformers-compat
+, unordered-containers
+}:
+mkDerivation {
+ pname = "semigroupoids";
+ version = "6.0.1";
+ sha256 = "1d532030862414f5d4f2f6f001783f77aa14e5f05ee8e3c4a2d2129fca29cc1f";
+ libraryHaskellDepends = [
+ base base-orphans bifunctors comonad containers contravariant
+ distributive foldable1-classes-compat hashable tagged
+ template-haskell transformers transformers-compat
+ unordered-containers
+ ];
+ homepage = "http://github.com/ekmett/semigroupoids";
+ description = "Semigroupoids: Category sans id";
+ license = lib.licenses.bsd2;
+}
diff --git a/nix/packages/tagged.nix b/nix/packages/tagged.nix
new file mode 100644
index 0000000..c773cf6
--- /dev/null
+++ b/nix/packages/tagged.nix
@@ -0,0 +1,15 @@
+{ mkDerivation, base, deepseq, lib, template-haskell, transformers
+}:
+mkDerivation {
+ pname = "tagged";
+ version = "0.8.8";
+ sha256 = "a083fa7835516203c168433a1c8dfc0290a94b05fedab566ad0640fc9137a6a7";
+ revision = "1";
+ editedCabalFile = "0chbxdppgpsrjqzf28z53x9wqwz0ncfimhfc6rr9knixvvxxx4wi";
+ libraryHaskellDepends = [
+ base deepseq template-haskell transformers
+ ];
+ homepage = "http://github.com/ekmett/tagged";
+ description = "Haskell 98 phantom types to avoid unsafely passing dummy arguments";
+ license = lib.licenses.bsd3;
+}
diff --git a/nix/packages/th-abstraction.nix b/nix/packages/th-abstraction.nix
new file mode 100644
index 0000000..abce3dd
--- /dev/null
+++ b/nix/packages/th-abstraction.nix
@@ -0,0 +1,14 @@
+{ mkDerivation, base, containers, ghc-prim, lib, template-haskell
+}:
+mkDerivation {
+ pname = "th-abstraction";
+ version = "0.7.0.0";
+ sha256 = "b2854c612f2fa4adfa1ecbb4089a2211fd9cb3210aec17ba4a455ae486b22721";
+ libraryHaskellDepends = [
+ base containers ghc-prim template-haskell
+ ];
+ testHaskellDepends = [ base containers template-haskell ];
+ homepage = "https://github.com/glguy/th-abstraction";
+ description = "Nicer interface for reified information about data types";
+ license = lib.licenses.isc;
+}
diff --git a/nix/patches/aeson-2.1.2.1.patch b/nix/patches/aeson-2.1.2.1.patch
new file mode 100644
index 0000000..d08277b
--- /dev/null
+++ b/nix/patches/aeson-2.1.2.1.patch
@@ -0,0 +1,11 @@
+--- a/src/Data/Aeson/Internal/Text.hs 2001-09-08 18:46:40.000000000 -0700
++++ b/src/Data/Aeson/Internal/Text.hs 2024-05-09 21:16:49.964743729 -0700
+@@ -8,5 +8,5 @@
+ import qualified Data.Text as T
+
+ #if MIN_VERSION_text(2,0,0)
+-import Data.Text.Array (Array (..))
++import Data.Text.Array
+ import qualified Data.Text.Internal as T (Text (..))
+
+ import qualified Data.ByteString.Short.Internal as SBS
diff --git a/nix/patches/pantry-0.9.3.2.patch b/nix/patches/pantry-0.9.3.2.patch
new file mode 100644
index 0000000..05e1b2f
--- /dev/null
+++ b/nix/patches/pantry-0.9.3.2.patch
@@ -0,0 +1,13 @@
+--- a/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs 2023-11-02 09:37:03.000000000 -0700
++++ b/src/Hackage/Security/Client/Repository/HttpLib/HttpClient.hs 2024-05-14 12:44:48.812084736 -0700
+@@ -81,8 +81,9 @@
+ -- NOTE: The only other exception defined in @http-client@ is @TimeoutTriggered@
+ -- but it is currently disabled <https://github.com/snoyberg/http-client/issues/116>
+ wrapCustomEx ::
++ Throws SomeRemoteError =>
+ (Throws HTTP.HttpException => IO a)
+- -> (Throws SomeRemoteError => IO a)
++ -> IO a
+ wrapCustomEx = handleChecked (\(ex :: HTTP.HttpException) -> go ex)
+ where
+ go ex = throwChecked (SomeRemoteError ex)
diff --git a/proto3-wire.cabal b/proto3-wire.cabal
index c520571..81af856 100644
--- a/proto3-wire.cabal
+++ b/proto3-wire.cabal
@@ -1,7 +1,7 @@
cabal-version: >=1.10
name: proto3-wire
-version: 1.4.2
+version: 1.4.3
synopsis: A low-level implementation of the Protocol Buffers (version 3) wire format
license: Apache-2.0
license-file: LICENSE
diff --git a/shell.nix b/shell.nix
index d9a90d8..93c75c7 100644
--- a/shell.nix
+++ b/shell.nix
@@ -1,14 +1,17 @@
-{ compiler ? "ghc8107", enableStack ? true }:
+{ compiler ? "ghc8107", enableStack ? false }:
let
pkgs = import ./nix/pkgs.nix {
inherit compiler;
};
- proto3-wire = pkgs.haskellPackages.proto3-wire;
+in pkgs.haskellPackages.shellFor {
+ packages = hpkgs: [
+ hpkgs.proto3-wire
+ ];
-in proto3-wire.env.overrideAttrs (old: {
- buildInputs = (old.buildInputs or []) ++ [
+ nativeBuildInputs = [
pkgs.cabal-install
+ pkgs.cabal2nix
] ++ (if enableStack then [ pkgs.stack ] else []);
-})
+}
diff --git a/test/Main.hs b/test/Main.hs
index 9ecd5b1..3fe159d 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -34,7 +34,8 @@ import qualified Data.ByteString.Builder.Internal as BBI
import Data.Either ( isLeft )
import Data.Maybe ( fromMaybe )
import Data.Int
-import Data.List ( group, sort )
+import Data.List ( sort )
+import qualified Data.List.NonEmpty as NE
import qualified Data.Text.Lazy as T
import qualified Data.Text.Short as TS
import qualified Data.Vector as V
@@ -320,7 +321,7 @@ parseWhile p = StateT (Just . BL.span p)
-- | Run-length encode lazy a 'BL.ByteString'
-- for concise display in test results.
rle :: BL.ByteString -> [(Int, Word8)]
-rle = map (length &&& head) . group . BL.unpack
+rle = map (NE.length &&& NE.head) . NE.group . BL.unpack
-- | Please adjust this expected size of the metadata header
-- to match that expected of the current implementation.
From 2d48ee3446858f08a8c75130c90d770c377569bd Mon Sep 17 00:00:00 2001
From: Drew Fenwick <drew.e.fenwick+github@gmail.com>
Date: Thu, 6 Jun 2024 17:10:16 +0100
Subject: [PATCH 07/10] Bumped outdated bounds (#106)
---
proto3-wire.cabal | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/proto3-wire.cabal b/proto3-wire.cabal
index 81af856..1a27dfb 100644
--- a/proto3-wire.cabal
+++ b/proto3-wire.cabal
@@ -37,13 +37,13 @@ library
base >=4.12 && <=5.0
, bytestring >=0.10.6.0 && <0.13.0
, cereal >= 0.5.1 && <0.6
- , containers >=0.5 && < 0.7
+ , containers >=0.5 && < 0.8
, deepseq >=1.4 && <1.6
, hashable <1.5
, parameterized >=0.5.0.0 && <1
- , primitive >=0.6.4 && <0.9
+ , primitive >=0.6.4 && <0.10
, safe ==0.3.*
- , template-haskell >= 2.15.0 && < 2.22
+ , template-haskell >= 2.15.0 && < 2.23
, text >= 0.2 && <2.2
, text-short ==0.1.*
, transformers >=0.5.6.2 && <0.7
From b32f3db6f8d36ea0708fb2f371f62d439ea45b42 Mon Sep 17 00:00:00 2001
From: alexfmpe <2335822+alexfmpe@users.noreply.github.com>
Date: Wed, 15 Jan 2025 16:50:03 +0000
Subject: [PATCH 08/10] Bump outdated bounds (#109)
---
proto3-wire.cabal | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/proto3-wire.cabal b/proto3-wire.cabal
index 1a27dfb..b88eeba 100644
--- a/proto3-wire.cabal
+++ b/proto3-wire.cabal
@@ -39,7 +39,7 @@ library
, cereal >= 0.5.1 && <0.6
, containers >=0.5 && < 0.8
, deepseq >=1.4 && <1.6
- , hashable <1.5
+ , hashable <1.6
, parameterized >=0.5.0.0 && <1
, primitive >=0.6.4 && <0.10
, safe ==0.3.*
@@ -77,12 +77,12 @@ test-suite tests
base >=4.9 && <=5.0
, bytestring >=0.10.6.0 && <0.13.0
, cereal >= 0.5.1 && <0.6
- , doctest >= 0.7.0 && <0.23.0
+ , doctest >= 0.7.0 && <0.24.0
, proto3-wire
, QuickCheck >=2.8 && <3.0
, tasty >= 0.11 && <1.6
, tasty-hunit >= 0.9 && <0.11
- , tasty-quickcheck >= 0.8.4 && <0.11
+ , tasty-quickcheck >= 0.8.4 && <0.12
, text >= 0.2 && <2.2
, text-short ==0.1.*
, transformers >=0.5.6.2 && <0.7
From 6fdf0eb93b2028ade0e3e011ce8429c94546839e Mon Sep 17 00:00:00 2001
From: j6carey <jcarey@arista.com>
Date: Thu, 16 Jan 2025 15:05:04 -0800
Subject: [PATCH 09/10] Support GHC 9.10 (#110)
---
.github/workflows/ci.yml | 5 ++--
CHANGELOG.md | 3 +++
README.md | 4 +++
nix/haskell-packages.nix | 13 +++++-----
nix/nixpkgs.nix | 9 ++++---
nix/packages/free.nix | 19 --------------
nix/packages/hpack.nix | 40 -----------------------------
proto3-wire.cabal | 2 +-
shell.nix | 2 +-
src/Proto3/Wire/Decode.hs | 3 +++
src/Proto3/Wire/Reverse/Internal.hs | 6 ++---
11 files changed, 30 insertions(+), 76 deletions(-)
delete mode 100644 nix/packages/free.nix
delete mode 100644 nix/packages/hpack.nix
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 6bab750..28f362c 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -16,8 +16,9 @@ jobs:
- 902
- 928
- 948
- - 962
- - 981
+ - 965
+ - 982
+ - 9101
exclude:
- os: macos-latest
ghc: 902
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 05ee2cd..4d0798d 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,6 @@
+1.4.4
+ - Support GHC 9.10
+
1.4.3
- Support GHC 9.8
- Support GHC 9.6
diff --git a/README.md b/README.md
index e77f8ad..c433faf 100644
--- a/README.md
+++ b/README.md
@@ -28,6 +28,10 @@ stack build [--test] [--haddock]
### GHC Versions
+#### GHC 9.10
+
+Supported on Linux and Darwin.
+
#### GHC 9.8
Supported on Linux and Darwin.
diff --git a/nix/haskell-packages.nix b/nix/haskell-packages.nix
index 0b17be9..b32bb36 100644
--- a/nix/haskell-packages.nix
+++ b/nix/haskell-packages.nix
@@ -14,13 +14,10 @@ pkgsNew: pkgsOld:
adjunctions =
pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.adjunctions;
- # With nixpkgs-23.11 and ghc981, aeson-2.1.2.1 thinks that th-abstraction is out of bounds.
- # Also, in order to avoid the breaking change to package structure in aeson-2.2.0.0,
- # we patch the import list of aeson-2.1.2.1.
+ # With nixpkgs-24.11 and our overrides, and when building with GHC 8.10,
+ # aeson thinks that th-abstraction is out of bounds.
aeson =
- pkgsNew.haskell.lib.doJailbreak
- ( pkgsNew.haskell.lib.appendPatches haskellPackagesPrev.aeson
- [ ./patches/aeson-2.1.2.1.patch ] );
+ pkgsNew.haskell.lib.doJailbreak haskellPackagesPrev.aeson;
# With nixpkgs-23.11 and ghc981, base-compat-batteries wants hspec for testing,
# which causes problems.
@@ -102,6 +99,10 @@ pkgsNew: pkgsOld:
iproute =
pkgsNew.haskell.lib.dontCheck haskellPackagesPrev.iproute;
+ # With nixpkgs-24.11 and our overrides, lens thinks that template-haskell is out of bounds.
+ lens =
+ pkgsNew.haskell.lib.doJailbreak haskellPackagesPrev.lens;
+
# With nixpkgs-23.11 and ghc981, monad-par wants test-framework for testing, which
# wants language-haskell-extract, which does not support modern template-haskell.
monad-par =
diff --git a/nix/nixpkgs.nix b/nix/nixpkgs.nix
index fdb1eac..f32361d 100644
--- a/nix/nixpkgs.nix
+++ b/nix/nixpkgs.nix
@@ -2,9 +2,10 @@ args:
let
nixpkgs = builtins.fetchTarball {
- # build: https://hydra.nixos.org/build/258096332
- # commit: 0638fe2715d998fa81d173aad264eb671ce2ebc1
- url = "https://hydra.nixos.org/build/258096332/download/2/nixpkgs-23.11pre558121.0638fe2715d9.tar.xz";
- sha256 = "1z3s1hqg3b72g608pf9sv474d4y9s00p86nsvfw5i9xgwhjncjjb";
+ # from: https://hydra.nixos.org/job/nixos/release-24.11/nixpkgs.tarball
+ # build: https://hydra.nixos.org/build/284195557
+ # commit: cbd8ec4de4469333c82ff40d057350c30e9f7d36
+ url = "https://hydra.nixos.org/build/284195557/download/2/nixpkgs-24.11pre712431.cbd8ec4de446.tar.xz";
+ sha256 = "0ljq084fq784fgvm7n9081dmnjhksz20vwzca2zics0kkkzjxh5k";
};
in import nixpkgs ({ config = { }; } // args)
diff --git a/nix/packages/free.nix b/nix/packages/free.nix
deleted file mode 100644
index f19700e..0000000
--- a/nix/packages/free.nix
+++ /dev/null
@@ -1,19 +0,0 @@
-{ mkDerivation, base, comonad, containers, distributive, exceptions
-, indexed-traversable, lib, mtl, profunctors, semigroupoids
-, template-haskell, th-abstraction, transformers, transformers-base
-}:
-mkDerivation {
- pname = "free";
- version = "5.2";
- sha256 = "72867f7c89173263765736e8d395e94291f1aaea626ecb1d673d72ce90b94f89";
- revision = "4";
- editedCabalFile = "0vic3p2viip8gjww8fx19ax6ry7y34h7xclvhzkvmbspjh9d219x";
- libraryHaskellDepends = [
- base comonad containers distributive exceptions indexed-traversable
- mtl profunctors semigroupoids template-haskell th-abstraction
- transformers transformers-base
- ];
- homepage = "http://github.com/ekmett/free/";
- description = "Monads for free";
- license = lib.licenses.bsd3;
-}
diff --git a/nix/packages/hpack.nix b/nix/packages/hpack.nix
deleted file mode 100644
index 8b74b68..0000000
--- a/nix/packages/hpack.nix
+++ /dev/null
@@ -1,40 +0,0 @@
-{ mkDerivation, aeson, base, bifunctors, bytestring, Cabal
-, containers, crypton, deepseq, directory, filepath, Glob, hspec
-, hspec-discover, http-client, http-client-tls, http-types, HUnit
-, infer-license, interpolate, lib, mockery, mtl, pretty, QuickCheck
-, scientific, template-haskell, temporary, text, transformers
-, unordered-containers, vector, yaml
-}:
-mkDerivation {
- pname = "hpack";
- version = "0.36.0";
- sha256 = "a0de4e1a0fe587030fa643cad99cd96de81e295923ffb57cfc7b1575f253ea7a";
- revision = "1";
- editedCabalFile = "1zh5rsf38xmwp7lf80iifrhnkl80lri4xzlhz2n5df3vc0dqzya8";
- isLibrary = true;
- isExecutable = true;
- libraryHaskellDepends = [
- aeson base bifunctors bytestring Cabal containers crypton deepseq
- directory filepath Glob http-client http-client-tls http-types
- infer-license mtl pretty scientific text transformers
- unordered-containers vector yaml
- ];
- executableHaskellDepends = [
- aeson base bifunctors bytestring Cabal containers crypton deepseq
- directory filepath Glob http-client http-client-tls http-types
- infer-license mtl pretty scientific text transformers
- unordered-containers vector yaml
- ];
- testHaskellDepends = [
- aeson base bifunctors bytestring Cabal containers crypton deepseq
- directory filepath Glob hspec http-client http-client-tls
- http-types HUnit infer-license interpolate mockery mtl pretty
- QuickCheck scientific template-haskell temporary text transformers
- unordered-containers vector yaml
- ];
- testToolDepends = [ hspec-discover ];
- homepage = "https://github.com/sol/hpack#readme";
- description = "A modern format for Haskell packages";
- license = lib.licenses.mit;
- mainProgram = "hpack";
-}
diff --git a/proto3-wire.cabal b/proto3-wire.cabal
index b88eeba..3be5d07 100644
--- a/proto3-wire.cabal
+++ b/proto3-wire.cabal
@@ -1,7 +1,7 @@
cabal-version: >=1.10
name: proto3-wire
-version: 1.4.3
+version: 1.4.4
synopsis: A low-level implementation of the Protocol Buffers (version 3) wire format
license: Apache-2.0
license-file: LICENSE
diff --git a/shell.nix b/shell.nix
index 93c75c7..b74e293 100644
--- a/shell.nix
+++ b/shell.nix
@@ -1,4 +1,4 @@
-{ compiler ? "ghc8107", enableStack ? false }:
+{ compiler ? "ghc948", enableStack ? false }:
let
pkgs = import ./nix/pkgs.nix {
diff --git a/src/Proto3/Wire/Decode.hs b/src/Proto3/Wire/Decode.hs
index 20c1b04..2119a65 100644
--- a/src/Proto3/Wire/Decode.hs
+++ b/src/Proto3/Wire/Decode.hs
@@ -23,6 +23,7 @@
-- from the untyped 'Map' representation obtained from 'decodeWire'.
{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -86,7 +87,9 @@ import Data.Bits
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Short as BS
+#if !MIN_VERSION_base(4,20,0)
import Data.Foldable ( foldl' )
+#endif
import qualified Data.IntMap.Strict as M -- TODO intmap
import Data.Maybe ( fromMaybe )
import Data.Serialize.Get ( Get, getWord8, getInt32le
diff --git a/src/Proto3/Wire/Reverse/Internal.hs b/src/Proto3/Wire/Reverse/Internal.hs
index 25e0fbe..ba55552 100644
--- a/src/Proto3/Wire/Reverse/Internal.hs
+++ b/src/Proto3/Wire/Reverse/Internal.hs
@@ -462,7 +462,7 @@ sealBuffer# addr unused s0 =
-- until a state action frees the stable pointer or modifies the state
-- variable, the stable pointer will reference the state variable,
-- which in turn will reference the current buffer.
- let allocation = P.sizeofMutableByteArray buffer - metaDataSize
+ allocation <- subtract metaDataSize <$> P.getSizeofMutableByteArray buffer
if allocation <= I# unused
then
pure (oldSealed, total, stateVar, statePtr, Just buffer)
@@ -573,8 +573,8 @@ afterPrependChunks# SealedState
Just buf -> do
-- Recycle the old current buffer, from which
-- we already copied what we wished to keep.
- let u1 = P.sizeofMutableByteArray buf - metaDataSize
- !(PTR base) = P.mutableByteArrayContents buf
+ u1 <- subtract metaDataSize <$> P.getSizeofMutableByteArray buf
+ let !(PTR base) = P.mutableByteArrayContents buf
!v1 = plusPtr (Ptr base) (metaDataSize + u1)
!m = plusPtr (Ptr base) metaDataSize
writeSpace m (u1 + total)
From d4376fb6f1c1ac03ee8ec5c5793700ca6508ea70 Mon Sep 17 00:00:00 2001
From: j6carey <jcarey@arista.com>
Date: Tue, 18 Mar 2025 12:26:45 -0700
Subject: [PATCH 10/10] 1.4.5: Add reverse encoders for packed repeated fields.
(#108)
When encoding from a Data.Vector.Vector this library
would already encode from right to left in order to
avoid saving all but the final element to the stack.
The relevant encoders would also exploit the fact
that vectors have known element counts in order to
consolidate size checks and associated reallocations
when encoding packed fields with fixed-width elements.
This change adds new encoders that generalize those
two optimizations to other types of container such as
`Data.Sequence.Seq`. When a container does not support
right-to-left iteration and/or length prediction
(for example, a standard list), these new encoders
still support them as efficiently as is practical,
given those restrictions.
Also added:
* bytesIfNonempty
* etaMessageBuilder
* repeatedMessageBuilder
* unsafeFromByteString
* unsafeFromShortByteString
---
.github/workflows/ci.yml | 2 +-
CHANGELOG.md | 7 +
bench/Main.hs | 9 +-
proto3-wire.cabal | 9 +-
shell.nix | 2 +-
src/Proto3/Wire/Encode.hs | 347 ++++++++++++++++++++++++-----
src/Proto3/Wire/Encode/Repeated.hs | 185 +++++++++++++++
src/Proto3/Wire/FoldR.hs | 80 +++++++
src/Proto3/Wire/Reverse.hs | 82 ++++++-
src/Proto3/Wire/Reverse/Prim.hs | 28 +++
test/Main.hs | 91 +++++++-
11 files changed, 767 insertions(+), 75 deletions(-)
create mode 100644 src/Proto3/Wire/Encode/Repeated.hs
create mode 100644 src/Proto3/Wire/FoldR.hs
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 28f362c..f990ba3 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -64,7 +64,7 @@ jobs:
stack-version: 2.11
- name: Cache dependencies
- uses: actions/cache@v3.3.1
+ uses: actions/cache@v3.4.0
with:
path: ~/.stack
key: ${{ runner.os }}-${{ matrix.ghc }}-stack
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 4d0798d..80fc094 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,10 @@
+1.4.5
+ - Add encoders for packed repeated fields that can iterate in
+ reverse order for speed when practical and will predict size
+ when it is inexpensive to do so.
+ - Add bytesIfNonempty, etaMessageBuilder, unsafeFromByteString,
+ unsafeFromShortByteString, repeatedMessageBuilder.
+
1.4.4
- Support GHC 9.10
diff --git a/bench/Main.hs b/bench/Main.hs
index b8aa5c4..6b0649d 100644
--- a/bench/Main.hs
+++ b/bench/Main.hs
@@ -15,7 +15,6 @@ import Proto3.Wire
import Control.Applicative (liftA2, liftA3)
import Control.Monad (forM)
-import Data.Maybe
import Data.Word
import Data.IORef
@@ -39,7 +38,7 @@ instance Foldable Tree where
in a + a1 + a2
instance Foldable Rose where
- foldMap f Bud = mempty
+ foldMap _ Bud = mempty
foldMap f (Rose x rs) = f x <> ((foldMap.foldMap) f rs)
intTreeParser :: De.Parser De.RawMessage (Tree Word64)
@@ -123,9 +122,9 @@ pullInt :: IORef [Word64] -> IO Word64
pullInt xs = do
xs' <- readIORef xs
case xs' of
- [] -> pure (-1)
- x : xs' -> do
- writeIORef xs xs'
+ [] -> pure (negate 1)
+ x : xs'' -> do
+ writeIORef xs xs''
pure x
mkTree0 :: IO Word64 -> IO En.MessageBuilder
diff --git a/proto3-wire.cabal b/proto3-wire.cabal
index 3be5d07..0fb5a9b 100644
--- a/proto3-wire.cabal
+++ b/proto3-wire.cabal
@@ -1,7 +1,7 @@
cabal-version: >=1.10
name: proto3-wire
-version: 1.4.4
+version: 1.4.5
synopsis: A low-level implementation of the Protocol Buffers (version 3) wire format
license: Apache-2.0
license-file: LICENSE
@@ -37,7 +37,7 @@ library
base >=4.12 && <=5.0
, bytestring >=0.10.6.0 && <0.13.0
, cereal >= 0.5.1 && <0.6
- , containers >=0.5 && < 0.8
+ , containers >=0.5 && <0.8
, deepseq >=1.4 && <1.6
, hashable <1.6
, parameterized >=0.5.0.0 && <1
@@ -58,11 +58,13 @@ library
Proto3.Wire.Class
Proto3.Wire.Decode
Proto3.Wire.Encode
+ Proto3.Wire.Encode.Repeated
+ Proto3.Wire.FoldR
Proto3.Wire.Reverse
+ Proto3.Wire.Reverse.Internal
Proto3.Wire.Reverse.Prim
Proto3.Wire.Tutorial
Proto3.Wire.Types
- Proto3.Wire.Reverse.Internal
other-modules:
Proto3.Wire.Reverse.Width
@@ -77,6 +79,7 @@ test-suite tests
base >=4.9 && <=5.0
, bytestring >=0.10.6.0 && <0.13.0
, cereal >= 0.5.1 && <0.6
+ , containers >=0.5 && <0.8
, doctest >= 0.7.0 && <0.24.0
, proto3-wire
, QuickCheck >=2.8 && <3.0
diff --git a/shell.nix b/shell.nix
index b74e293..5c2df74 100644
--- a/shell.nix
+++ b/shell.nix
@@ -1,4 +1,4 @@
-{ compiler ? "ghc948", enableStack ? false }:
+{ compiler ? "ghc982", enableStack ? false }:
let
pkgs = import ./nix/pkgs.nix {
diff --git a/src/Proto3/Wire/Encode.hs b/src/Proto3/Wire/Encode.hs
index cf413cc..1db1d6b 100644
--- a/src/Proto3/Wire/Encode.hs
+++ b/src/Proto3/Wire/Encode.hs
@@ -40,6 +40,9 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -54,10 +57,13 @@ module Proto3.Wire.Encode
( -- * `MessageBuilder` type
MessageBuilder
, reverseMessageBuilder
+ , etaMessageBuilder
, vectorMessageBuilder
, messageLength
, toLazyByteString
, unsafeFromLazyByteString
+ , unsafeFromByteString
+ , unsafeFromShortByteString
-- * Standard Integers
, int32
@@ -79,6 +85,7 @@ module Proto3.Wire.Encode
, bool
-- * Strings
, bytes
+ , bytesIfNonempty
, string
, text
, shortText
@@ -87,17 +94,32 @@ module Proto3.Wire.Encode
, shortByteString
-- * Embedded Messages
, embedded
+ -- * Folds
+ , repeatedMessageBuilder
-- * Packed repeated fields
, packedVarints
, packedVarintsV
+ , packedInt32R
+ , packedInt64R
+ , packedUInt32R
+ , packedUInt64R
+ , packedSInt32R
+ , packedSInt64R
+ , packedBoolsR
, packedBoolsV
, packedFixed32
+ , packedFixed32R
, packedFixed32V
, packedFixed64
+ , packedFixed64R
, packedFixed64V
+ , packedSFixed32R
+ , packedSFixed64R
, packedFloats
+ , packedFloatsR
, packedFloatsV
, packedDoubles
+ , packedDoublesR
, packedDoublesV
-- * ZigZag codec
, zigZagEncode
@@ -118,13 +140,14 @@ import GHC.TypeLits ( KnownNat, Nat, type (+) )
import Parameterized.Data.Semigroup ( PNullary, PSemigroup(..),
(&<>) )
import Parameterized.Data.Monoid ( PMEmpty(..) )
+import Proto3.Wire.Encode.Repeated ( ToRepeated, mapRepeated )
import qualified Proto3.Wire.Reverse as RB
import qualified Proto3.Wire.Reverse.Prim as Prim
import Proto3.Wire.Class
import Proto3.Wire.Types
-- $setup
--- >>> :set -XOverloadedStrings -XOverloadedLists
+-- >>> :set -XOverloadedStrings -XOverloadedLists -XTypeApplications
-- >>> :module Proto3.Wire.Encode Proto3.Wire.Class Data.Word
-- | zigzag-encoded numeric type.
@@ -142,7 +165,7 @@ zigZagEncode i = (i `shiftL` 1) `xor` (i `shiftR` n)
--
-- Use `toLazyByteString` when you're done assembling the `MessageBuilder`
newtype MessageBuilder = MessageBuilder { unMessageBuilder :: RB.BuildR }
- deriving (Monoid, Semigroup)
+ deriving newtype (Monoid, Semigroup)
instance Show MessageBuilder where
showsPrec prec builder =
@@ -176,14 +199,21 @@ messageLength = fromIntegral . fst . RB.runBuildR . unMessageBuilder
toLazyByteString :: MessageBuilder -> BL.ByteString
toLazyByteString = RB.toLazyByteString . unMessageBuilder
--- | This lets you cast an arbitrary `ByteString` to a `MessageBuilder`, whether
+-- | This lets you cast an arbitrary 'BL.ByteString' to a `MessageBuilder`, whether
-- or not the `ByteString` corresponds to a valid serialized protobuf message
--
-- Do not use this function unless you know what you're doing because it lets
--- you assemble malformed protobuf `MessageBuilder`s
+-- you assemble malformed protobuf `MessageBuilder`s.
unsafeFromLazyByteString :: BL.ByteString -> MessageBuilder
-unsafeFromLazyByteString bytes' =
- MessageBuilder { unMessageBuilder = RB.lazyByteString bytes' }
+unsafeFromLazyByteString = coerce RB.lazyByteString
+
+-- | Like 'unsafeFromLazyByteString' only for strict 'B.ByteString's.
+unsafeFromByteString :: B.ByteString -> MessageBuilder
+unsafeFromByteString = coerce RB.byteString
+
+-- | Like 'unsafeFromLazyByteString' only for 'BS.ShortByteString's.
+unsafeFromShortByteString :: BS.ShortByteString -> MessageBuilder
+unsafeFromShortByteString = coerce RB.shortByteString
newtype MessageBoundedPrim w
= MessageBoundedPrim { unMessageBoundedPrim :: Prim.BoundedPrim w }
@@ -276,7 +306,7 @@ fieldHeader = \num wt -> base128Varint64_inline
-- a negative number, the resulting varint is always ten bytes long..."
-- <https://developers.google.com/protocol-buffers/docs/encoding#varints>
int32 :: FieldNumber -> Int32 -> MessageBuilder
-int32 = \num i -> liftBoundedPrim $
+int32 = \(!num) i -> liftBoundedPrim $
fieldHeader num Varint &<> base128Varint64 (fromIntegral i)
{-# INLINE int32 #-}
@@ -289,7 +319,7 @@ int32 = \num i -> liftBoundedPrim $
-- >>> 1 `int64` (-42)
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\214\255\255\255\255\255\255\255\255\SOH"
int64 :: FieldNumber -> Int64 -> MessageBuilder
-int64 = \num i -> liftBoundedPrim $
+int64 = \(!num) i -> liftBoundedPrim $
fieldHeader num Varint &<> base128Varint64 (fromIntegral i)
{-# INLINE int64 #-}
@@ -300,7 +330,7 @@ int64 = \num i -> liftBoundedPrim $
-- >>> 1 `uint32` 42
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\b*"
uint32 :: FieldNumber -> Word32 -> MessageBuilder
-uint32 = \num i -> liftBoundedPrim $
+uint32 = \(!num) i -> liftBoundedPrim $
fieldHeader num Varint &<> base128Varint32 i
{-# INLINE uint32 #-}
@@ -311,7 +341,7 @@ uint32 = \num i -> liftBoundedPrim $
-- >>> 1 `uint64` 42
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\b*"
uint64 :: FieldNumber -> Word64 -> MessageBuilder
-uint64 = \num i -> liftBoundedPrim $
+uint64 = \(!num) i -> liftBoundedPrim $
fieldHeader num Varint &<> base128Varint64 i
{-# INLINE uint64 #-}
@@ -326,7 +356,7 @@ uint64 = \num i -> liftBoundedPrim $
-- >>> 1 `sint32` minBound
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\255\255\255\255\SI"
sint32 :: FieldNumber -> Int32 -> MessageBuilder
-sint32 = \num i ->
+sint32 = \(!num) i ->
uint32 num (fromIntegral (zigZagEncode i))
{-# INLINE sint32 #-}
@@ -341,7 +371,7 @@ sint32 = \num i ->
-- >>> 1 `sint64` minBound
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\255\255\255\255\255\255\255\255\255\SOH"
sint64 :: FieldNumber -> Int64 -> MessageBuilder
-sint64 = \num i ->
+sint64 = \(!num) i ->
uint64 num (fromIntegral (zigZagEncode i))
{-# INLINE sint64 #-}
@@ -352,7 +382,7 @@ sint64 = \num i ->
-- >>> 1 `fixed32` 42
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\r*\NUL\NUL\NUL"
fixed32 :: FieldNumber -> Word32 -> MessageBuilder
-fixed32 = \num i -> liftBoundedPrim $
+fixed32 = \(!num) i -> liftBoundedPrim $
fieldHeader num Fixed32 &<>
MessageBoundedPrim (Prim.liftFixedPrim (Prim.word32LE i))
{-# INLINE fixed32 #-}
@@ -364,7 +394,7 @@ fixed32 = \num i -> liftBoundedPrim $
-- >>> 1 `fixed64` 42
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\t*\NUL\NUL\NUL\NUL\NUL\NUL\NUL"
fixed64 :: FieldNumber -> Word64 -> MessageBuilder
-fixed64 = \num i -> liftBoundedPrim $
+fixed64 = \(!num) i -> liftBoundedPrim $
fieldHeader num Fixed64 &<>
MessageBoundedPrim (Prim.liftFixedPrim (Prim.word64LE i))
{-# INLINE fixed64 #-}
@@ -375,7 +405,7 @@ fixed64 = \num i -> liftBoundedPrim $
--
-- > 1 `sfixed32` (-42)
sfixed32 :: FieldNumber -> Int32 -> MessageBuilder
-sfixed32 = \num i -> liftBoundedPrim $
+sfixed32 = \(!num) i -> liftBoundedPrim $
fieldHeader num Fixed32 &<>
MessageBoundedPrim (Prim.liftFixedPrim (Prim.int32LE i))
{-# INLINE sfixed32 #-}
@@ -387,7 +417,7 @@ sfixed32 = \num i -> liftBoundedPrim $
-- >>> 1 `sfixed64` (-42)
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\t\214\255\255\255\255\255\255\255"
sfixed64 :: FieldNumber -> Int64 -> MessageBuilder
-sfixed64 = \num i -> liftBoundedPrim $
+sfixed64 = \(!num) i -> liftBoundedPrim $
fieldHeader num Fixed64 &<>
MessageBoundedPrim (Prim.liftFixedPrim (Prim.int64LE i))
{-# INLINE sfixed64 #-}
@@ -399,7 +429,7 @@ sfixed64 = \num i -> liftBoundedPrim $
-- >>> 1 `float` 3.14
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\r\195\245H@"
float :: FieldNumber -> Float -> MessageBuilder
-float = \num f -> liftBoundedPrim $
+float = \(!num) f -> liftBoundedPrim $
fieldHeader num Fixed32 &<>
MessageBoundedPrim (Prim.liftFixedPrim (Prim.floatLE f))
{-# INLINE float #-}
@@ -411,7 +441,7 @@ float = \num f -> liftBoundedPrim $
-- >>> 1 `double` 3.14
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\t\US\133\235Q\184\RS\t@"
double :: FieldNumber -> Double -> MessageBuilder
-double = \num d -> liftBoundedPrim $
+double = \(!num) d -> liftBoundedPrim $
fieldHeader num Fixed64 &<>
MessageBoundedPrim (Prim.liftFixedPrim (Prim.doubleLE d))
{-# INLINE double #-}
@@ -440,7 +470,7 @@ double = \num d -> liftBoundedPrim $
-- >>> 1 `enum` Triangle <> 2 `enum` Gap3
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\STX\DLE\ETX"
enum :: ProtoEnum e => FieldNumber -> e -> MessageBuilder
-enum = \num e -> liftBoundedPrim $
+enum = \(!num) e -> liftBoundedPrim $
fieldHeader num Varint &<>
base128Varint32 (fromIntegral @Int32 @Word32 (fromProtoEnum e))
{-# INLINE enum #-}
@@ -452,7 +482,7 @@ enum = \num e -> liftBoundedPrim $
-- >>> 1 `bool` True
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\SOH"
bool :: FieldNumber -> Bool -> MessageBuilder
-bool = \num b -> liftBoundedPrim $
+bool = \(!num) b -> liftBoundedPrim $
fieldHeader num Varint &<>
MessageBoundedPrim
(Prim.liftFixedPrim (Prim.word8 (fromIntegral (fromEnum b))))
@@ -461,12 +491,39 @@ bool = \num b -> liftBoundedPrim $
-- | Encode a sequence of octets as a field of type 'bytes'.
--
+-- But unless the field is @optional@ or part of a @oneof@,
+-- you may wish to to use 'bytesIfNonempty' to skip the field
+-- when the payload built by the argument turns out to be empty.
+--
+-- >>> 1 `bytes` (Proto3.Wire.Reverse.stringUtf8 "")
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\NUL"
-- >>> 1 `bytes` (Proto3.Wire.Reverse.stringUtf8 "testing")
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting"
bytes :: FieldNumber -> RB.BuildR -> MessageBuilder
-bytes num = embedded num . MessageBuilder
+bytes !num = embedded num . MessageBuilder
{-# INLINE bytes #-}
+-- | Like 'bytes' but omits the field if it would be empty, which
+-- is useful when the field is not @optional@ and is not part of
+-- a @oneof@, and therefore may be omitted entirely when empty.
+--
+-- >>> 1 `bytesIfNonempty` (Proto3.Wire.Reverse.stringUtf8 "")
+-- Proto3.Wire.Encode.unsafeFromLazyByteString ""
+-- >>> 1 `bytesIfNonempty` (Proto3.Wire.Reverse.stringUtf8 "testing")
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting"
+bytesIfNonempty :: FieldNumber -> RB.BuildR -> MessageBuilder
+bytesIfNonempty !num bb =
+ MessageBuilder (RB.withLengthOf prefix bb)
+ where
+ prefix len
+ | 0 < len = Prim.liftBoundedPrim $
+ unMessageBoundedPrim (fieldHeader num LengthDelimited) &<>
+ Prim.wordBase128LEVar (fromIntegral @Int @Word len)
+ | otherwise =
+ mempty
+ {-# INLINE prefix #-}
+{-# INLINE bytesIfNonempty #-}
+
-- | Encode a UTF-8 string.
--
-- For example:
@@ -474,7 +531,7 @@ bytes num = embedded num . MessageBuilder
-- >>> 1 `string` "testing"
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting"
string :: FieldNumber -> String -> MessageBuilder
-string num = embedded num . MessageBuilder . RB.stringUtf8
+string !num = embedded num . MessageBuilder . RB.stringUtf8
{-# INLINE string #-}
-- | Encode lazy `Text` as UTF-8
@@ -484,7 +541,7 @@ string num = embedded num . MessageBuilder . RB.stringUtf8
-- >>> 1 `text` "testing"
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting"
text :: FieldNumber -> Text.Lazy.Text -> MessageBuilder
-text num = embedded num . MessageBuilder . RB.lazyTextUtf8
+text !num = embedded num . MessageBuilder . RB.lazyTextUtf8
{-# INLINE text #-}
-- | Encode a `Text.Short.ShortText` as UTF-8.
@@ -494,7 +551,7 @@ text num = embedded num . MessageBuilder . RB.lazyTextUtf8
-- >>> 1 `shortText` "testing"
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting"
shortText :: FieldNumber -> Text.Short.ShortText -> MessageBuilder
-shortText num = embedded num . MessageBuilder . RB.shortTextUtf8
+shortText !num = embedded num . MessageBuilder . RB.shortTextUtf8
{-# INLINE shortText #-}
-- | Encode a collection of bytes in the form of a strict 'B.ByteString'.
@@ -504,7 +561,7 @@ shortText num = embedded num . MessageBuilder . RB.shortTextUtf8
-- >>> 1 `byteString` "testing"
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting"
byteString :: FieldNumber -> B.ByteString -> MessageBuilder
-byteString num = embedded num . MessageBuilder . RB.byteString
+byteString !num = embedded num . unsafeFromByteString
{-# INLINE byteString #-}
-- | Encode a lazy bytestring.
@@ -514,7 +571,7 @@ byteString num = embedded num . MessageBuilder . RB.byteString
-- >>> 1 `lazyByteString` "testing"
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting"
lazyByteString :: FieldNumber -> BL.ByteString -> MessageBuilder
-lazyByteString num = embedded num . MessageBuilder . RB.lazyByteString
+lazyByteString !num = embedded num . unsafeFromLazyByteString
{-# INLINE lazyByteString #-}
-- | Encode a `BS.ShortByteString`.
@@ -524,22 +581,60 @@ lazyByteString num = embedded num . MessageBuilder . RB.lazyByteString
-- >>> 1 `shortByteString` "testing"
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\atesting"
shortByteString :: FieldNumber -> BS.ShortByteString -> MessageBuilder
-shortByteString num = embedded num . MessageBuilder . RB.shortByteString
+shortByteString !num = embedded num . unsafeFromShortByteString
{-# INLINE shortByteString #-}
--- | Encode varints in the space-efficient packed format.
--- But consider 'packedVarintsV', which may be faster.
+-- | Concatenates the given builders, which typically build fields within the same message.
--
--- The values to be encoded are specified by mapping the elements of a vector.
+-- For example:
+--
+-- >>> repeatedMessageBuilder @[MessageBuilder] [1 `bool` True, 2 `int32` 42]
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\b\SOH\DLE*"
+repeatedMessageBuilder :: ToRepeated c MessageBuilder => c -> MessageBuilder
+repeatedMessageBuilder =
+ etaMessageBuilder (MessageBuilder . RB.repeatedBuildR . mapRepeated reverseMessageBuilder)
+{-# INLINE repeatedMessageBuilder #-}
+
+-- | Encodes a packed repeated field whose elements may vary in width.
+packedVariableWidthFieldR ::
+ ToRepeated c a => (a -> RB.BuildR) -> FieldNumber -> c -> MessageBuilder
+packedVariableWidthFieldR f !num =
+ etaMessageBuilder (embedded num . MessageBuilder . RB.repeatedBuildR . mapRepeated f)
+{-# INLINE packedVariableWidthFieldR #-}
+
+-- | Encodes a packed repeated field whose elements never vary in width.
+packedFixedWidthFieldR ::
+ (ToRepeated c a, KnownNat w) => (a -> Prim.FixedPrim w) -> FieldNumber -> c -> MessageBuilder
+packedFixedWidthFieldR f !num =
+ etaMessageBuilder (embedded num . MessageBuilder . RB.repeatedFixedPrimR . mapRepeated f)
+{-# INLINE packedFixedWidthFieldR #-}
+
+-- | Encode varints in the space-efficient packed format.
+-- But consider 'packedVarintsV' or 'packedVarintsR', either of which may be faster.
--
-- >>> packedVarints 1 [1, 2, 3]
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\ETX\SOH\STX\ETX"
packedVarints :: Foldable f => FieldNumber -> f Word64 -> MessageBuilder
-packedVarints num = etaMessageBuilder (embedded num . payload)
+packedVarints !num = etaMessageBuilder (embedded num . payload)
where
payload = foldMap (liftBoundedPrim . base128Varint64)
{-# INLINE packedVarints #-}
+-- | A faster but more specialized variant of 'packedVarints'.
+--
+-- Generalizes 'packedVarintsV', provided that any new instance
+-- of 'Vector' is given a corresponding instance of 'ToRepeated'.
+packedVarints64R :: ToRepeated c Word64 => FieldNumber -> c -> MessageBuilder
+packedVarints64R = packedVariableWidthFieldR RB.word64Base128LEVar
+{-# INLINE packedVarints64R #-}
+
+-- | Like 'packedVarints64R' but supports only 32-bit inputs,
+-- which reduces on executable size in situations where we do
+-- not need to support larger values.
+packedVarints32R :: ToRepeated c Word32 => FieldNumber -> c -> MessageBuilder
+packedVarints32R = packedVariableWidthFieldR RB.word32Base128LEVar
+{-# INLINE packedVarints32R #-}
+
-- | A faster but more specialized variant of:
--
-- > \f num -> packedVarints num . fmap f
@@ -548,37 +643,128 @@ packedVarints num = etaMessageBuilder (embedded num . payload)
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\ETX\SOH\STX\ETX"
packedVarintsV ::
Vector v a => (a -> Word64) -> FieldNumber -> v a -> MessageBuilder
-packedVarintsV f num = embedded num . payload
+packedVarintsV f !num = embedded num . payload
where
payload = vectorMessageBuilder (liftBoundedPrim . base128Varint64 . f)
{-# INLINE packedVarintsV #-}
+-- | Encodes a packed repeated @int32@ field.
+--
+-- >>> packedInt32R @[_] 1 [42, -42]
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\v*\214\255\255\255\255\255\255\255\255\SOH"
+--
+-- NOTE: Protobuf encoding converts an @int32@ to a 64-bit unsigned value
+-- before encoding it, not a 32-bit value (which would be more efficient).
+--
+-- To quote the specification: "If you use int32 or int64 as the type for
+-- a negative number, the resulting varint is always ten bytes long..."
+-- <https://developers.google.com/protocol-buffers/docs/encoding#varints>
+packedInt32R :: ToRepeated c Int32 => FieldNumber -> c -> MessageBuilder
+packedInt32R !num xs =
+ packedVarints64R num (mapRepeated (fromIntegral @Int32 @Word64) xs)
+{-# INLINE packedInt32R #-}
+
+-- | Encodes a packed repeated @int64@ field.
+--
+-- For example:
+--
+-- >>> packedInt64R @[_] 1 [42, -42]
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\v*\214\255\255\255\255\255\255\255\255\SOH"
+packedInt64R :: ToRepeated c Int64 => FieldNumber -> c -> MessageBuilder
+packedInt64R !num xs =
+ packedVarints64R num (mapRepeated (fromIntegral @Int64 @Word64) xs)
+{-# INLINE packedInt64R #-}
+
+-- | Encodes a packed repeated @uint32@ field.
+--
+-- For example:
+--
+-- >>> packedUInt32R @[_] 1 [42, 43, maxBound]
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\a*+\255\255\255\255\SI"
+packedUInt32R :: ToRepeated c Word32 => FieldNumber -> c -> MessageBuilder
+packedUInt32R = packedVarints32R
+{-# INLINE packedUInt32R #-}
+
+-- | Encodes a packed repeated @uint64@ field.
+--
+-- For example:
+--
+-- >>> packedUInt64R @[_] 1 [42, 43, maxBound]
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f*+\255\255\255\255\255\255\255\255\255\SOH"
+packedUInt64R :: ToRepeated c Word64 => FieldNumber -> c -> MessageBuilder
+packedUInt64R = packedVarints64R
+{-# INLINE packedUInt64R #-}
+
+-- | Encodes a packed repeated @sint32@ field.
+--
+-- For example:
+--
+-- >>> packedSInt32R @[_] 1 [-42, maxBound, minBound]
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\vS\254\255\255\255\SI\255\255\255\255\SI"
+packedSInt32R :: ToRepeated c Int32 => FieldNumber -> c -> MessageBuilder
+packedSInt32R !num xs =
+ packedVarints32R num (mapRepeated (fromIntegral @Int32 @Word32 . zigZagEncode) xs)
+{-# INLINE packedSInt32R #-}
+
+-- | Encodes a packed repeated @sint64@ field.
+--
+-- For example:
+--
+-- >>> packedSInt64R @[_] 1 [-42, maxBound, minBound]
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\NAKS\254\255\255\255\255\255\255\255\255\SOH\255\255\255\255\255\255\255\255\255\SOH"
+packedSInt64R :: ToRepeated c Int64 => FieldNumber -> c -> MessageBuilder
+packedSInt64R !num xs =
+ packedVarints64R num (mapRepeated (fromIntegral @Int64 @Word64 . zigZagEncode) xs)
+{-# INLINE packedSInt64R #-}
+
-- | A faster but more specialized variant of:
--
--- > packedVarintsV (fromIntegral . fromEnum) num
+-- > \f -> packedVarintsR (fromIntegral . fromEnum . f)
+--
+-- Generalizes 'packedBoolsV', provided that any new instance
+-- of 'Vector' is given a corresponding instance of 'ToRepeated'.
+--
+-- >>> packedBoolsR @[_] 1 [True, False]
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\STX\SOH\NUL"
+packedBoolsR :: ToRepeated c Bool => FieldNumber -> c -> MessageBuilder
+packedBoolsR = packedFixedWidthFieldR (Prim.word8 . fromIntegral . fromEnum)
+{-# INLINE packedBoolsR #-}
+
+-- | A faster but more specialized variant of:
+--
+-- > \f -> packedVarintsV (fromIntegral . fromEnum . f)
--
-- >>> packedBoolsV not 1 ([False, True] :: Data.Vector.Vector Bool)
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\STX\SOH\NUL"
packedBoolsV ::
Vector v a => (a -> Bool) -> FieldNumber -> v a -> MessageBuilder
-packedBoolsV f num = embedded num . MessageBuilder . payload
+packedBoolsV f !num = embedded num . MessageBuilder . payload
where
payload = Prim.vectorFixedPrim (Prim.word8 . fromIntegral . fromEnum . f)
{-# INLINE packedBoolsV #-}
-- | Encode fixed-width Word32s in the space-efficient packed format.
--- But consider 'packedFixed32V', which may be faster.
---
--- The values to be encoded are specified by mapping the elements of a vector.
+-- But consider 'packedFixed32V' or 'packedFixed32R', either of which may be faster.
--
-- >>> packedFixed32 1 [1, 2, 3]
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\SOH\NUL\NUL\NUL\STX\NUL\NUL\NUL\ETX\NUL\NUL\NUL"
packedFixed32 :: Foldable f => FieldNumber -> f Word32 -> MessageBuilder
-packedFixed32 num = etaMessageBuilder (embedded num . payload)
+packedFixed32 !num = etaMessageBuilder (embedded num . payload)
where
payload = foldMap (MessageBuilder . RB.word32LE)
{-# INLINE packedFixed32 #-}
+-- | A faster but more specialized variant of 'packedFixed32'.
+--
+-- Generalizes 'packedFixed32V', provided that any new instance
+-- of 'Vector' is given a corresponding instance of 'ToRepeated'.
+--
+-- >>> packedFixed32R @[_] 1 [1, 2, 3]
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\SOH\NUL\NUL\NUL\STX\NUL\NUL\NUL\ETX\NUL\NUL\NUL"
+packedFixed32R :: ToRepeated c Word32 => FieldNumber -> c -> MessageBuilder
+packedFixed32R = packedFixedWidthFieldR Prim.word32LE
+{-# INLINE packedFixed32R #-}
+
-- | A faster but more specialized variant of:
--
-- > \f num -> packedFixed32 num . fmap f
@@ -587,24 +773,32 @@ packedFixed32 num = etaMessageBuilder (embedded num . payload)
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\SOH\NUL\NUL\NUL\STX\NUL\NUL\NUL\ETX\NUL\NUL\NUL"
packedFixed32V ::
Vector v a => (a -> Word32) -> FieldNumber -> v a -> MessageBuilder
-packedFixed32V f num = etaMessageBuilder (embedded num . payload)
+packedFixed32V f !num = etaMessageBuilder (embedded num . payload)
where
payload = MessageBuilder . Prim.vectorFixedPrim (Prim.word32LE . f)
{-# INLINE packedFixed32V #-}
--- | Encode fixed-width Word64s in the space-efficient packed format.
--- But consider 'packedFixed64V', which may be faster.
---
--- The values to be encoded are specified by mapping the elements of a vector.
+-- But consider 'packedFixed64V' or 'packedFixed64R', either of which may be faster.
--
-- >>> packedFixed64 1 [1, 2, 3]
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NUL"
packedFixed64 :: Foldable f => FieldNumber -> f Word64 -> MessageBuilder
-packedFixed64 num = etaMessageBuilder (embedded num . payload)
+packedFixed64 !num = etaMessageBuilder (embedded num . payload)
where
payload = foldMap (MessageBuilder . RB.word64LE)
{-# INLINE packedFixed64 #-}
+-- | A faster but more specialized variant of 'packedFixed64'.
+--
+-- Generalizes 'packedFixed64V', provided that any new instance
+-- of 'Vector' is given a corresponding instance of 'ToRepeated'.
+--
+-- >>> packedFixed64R @[_] 1 [1, 2, 3]
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NUL"
+packedFixed64R :: ToRepeated c Word64 => FieldNumber -> c -> MessageBuilder
+packedFixed64R = packedFixedWidthFieldR Prim.word64LE
+{-# INLINE packedFixed64R #-}
+
-- | A faster but more specialized variant of:
--
-- > \f num -> packedFixed64 num . fmap f
@@ -613,22 +807,53 @@ packedFixed64 num = etaMessageBuilder (embedded num . payload)
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NUL"
packedFixed64V ::
Vector v a => (a -> Word64) -> FieldNumber -> v a -> MessageBuilder
-packedFixed64V f num = etaMessageBuilder (embedded num . payload)
+packedFixed64V f !num = etaMessageBuilder (embedded num . payload)
where
payload = MessageBuilder . Prim.vectorFixedPrim (Prim.word64LE . f)
{-# INLINE packedFixed64V #-}
+-- | Encodes a packed repeated @sfixed32@ field.
+--
+-- For example:
+--
+-- >>> packedSFixed32R @[_] 1 [1, -2, 3]
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\SOH\NUL\NUL\NUL\254\255\255\255\ETX\NUL\NUL\NUL"
+packedSFixed32R :: ToRepeated c Int32 => FieldNumber -> c -> MessageBuilder
+packedSFixed32R = packedFixedWidthFieldR Prim.int32LE
+{-# INLINE packedSFixed32R #-}
+
+-- | Encodes a packed repeated @sfixed64@ field.
+--
+-- For example:
+--
+-- >>> packedSFixed64R @[_] 1 [1, -2, 3]
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\254\255\255\255\255\255\255\255\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NUL"
+packedSFixed64R :: ToRepeated c Int64 => FieldNumber -> c -> MessageBuilder
+packedSFixed64R = packedFixedWidthFieldR Prim.int64LE
+{-# INLINE packedSFixed64R #-}
+
-- | Encode floats in the space-efficient packed format.
--- But consider 'packedFloatsV', which may be faster.
+-- But consider 'packedFloatsV' or 'packedFloatsR', either of which may be faster.
--
-- >>> 1 `packedFloats` [1, 2, 3]
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\NUL\NUL\128?\NUL\NUL\NUL@\NUL\NUL@@"
packedFloats :: Foldable f => FieldNumber -> f Float -> MessageBuilder
-packedFloats num = etaMessageBuilder (embedded num . payload)
+packedFloats !num = etaMessageBuilder (embedded num . payload)
where
payload = foldMap (MessageBuilder . RB.floatLE)
{-# INLINE packedFloats #-}
+-- | A faster but more specialized variant of 'packedFloats'.
+--
+-- Generalizes 'packedFloatsV', provided that any new instance
+-- of 'Vector' is given a corresponding instance of 'ToRepeated'.
+--
+-- >>> packedFloatsR @[_] 1 [1, 2, 3]
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\NUL\NUL\128?\NUL\NUL\NUL@\NUL\NUL@@"
+packedFloatsR :: ToRepeated c Float => FieldNumber -> c -> MessageBuilder
+packedFloatsR = packedFixedWidthFieldR Prim.floatLE
+{-# INLINE packedFloatsR #-}
+
-- | A faster but more specialized variant of:
--
-- > \f num -> packedFloats num . fmap f
@@ -637,22 +862,33 @@ packedFloats num = etaMessageBuilder (embedded num . payload)
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\f\NUL\NUL\128?\NUL\NUL\NUL@\NUL\NUL@@"
packedFloatsV ::
Vector v a => (a -> Float) -> FieldNumber -> v a -> MessageBuilder
-packedFloatsV f num = etaMessageBuilder (embedded num . payload)
+packedFloatsV f !num = etaMessageBuilder (embedded num . payload)
where
payload = MessageBuilder . Prim.vectorFixedPrim (Prim.floatLE . f)
{-# INLINE packedFloatsV #-}
-- | Encode doubles in the space-efficient packed format.
--- But consider 'packedDoublesV', which may be faster.
+-- But consider 'packedDoublesV' or 'packedDoublesR', either of which may be faster.
--
-- >>> 1 `packedDoubles` [1, 2, 3]
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\NUL\NUL\NUL\NUL\NUL\NUL\240?\NUL\NUL\NUL\NUL\NUL\NUL\NUL@\NUL\NUL\NUL\NUL\NUL\NUL\b@"
packedDoubles :: Foldable f => FieldNumber -> f Double -> MessageBuilder
-packedDoubles num = etaMessageBuilder (embedded num . payload)
+packedDoubles !num = etaMessageBuilder (embedded num . payload)
where
payload = foldMap (MessageBuilder . RB.doubleLE)
{-# INLINE packedDoubles #-}
+-- | A faster but more specialized variant of 'packedDoubles'.
+--
+-- Generalizes 'packedDoublesV', provided that any new instance
+-- of 'Vector' is given a corresponding instance of 'ToRepeated'.
+--
+-- >>> packedDoublesR @[_] 1 [1, 2, 3]
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\NUL\NUL\NUL\NUL\NUL\NUL\240?\NUL\NUL\NUL\NUL\NUL\NUL\NUL@\NUL\NUL\NUL\NUL\NUL\NUL\b@"
+packedDoublesR :: ToRepeated c Double => FieldNumber -> c -> MessageBuilder
+packedDoublesR = packedFixedWidthFieldR Prim.doubleLE
+{-# INLINE packedDoublesR #-}
+
-- | A faster but more specialized variant of:
--
-- > \f num -> packedDoubles num . fmap f
@@ -661,7 +897,7 @@ packedDoubles num = etaMessageBuilder (embedded num . payload)
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\CAN\NUL\NUL\NUL\NUL\NUL\NUL\240?\NUL\NUL\NUL\NUL\NUL\NUL\NUL@\NUL\NUL\NUL\NUL\NUL\NUL\b@"
packedDoublesV ::
Vector v a => (a -> Double) -> FieldNumber -> v a -> MessageBuilder
-packedDoublesV f num = etaMessageBuilder (embedded num . payload)
+packedDoublesV f !num = etaMessageBuilder (embedded num . payload)
where
payload = MessageBuilder . Prim.vectorFixedPrim (Prim.doubleLE . f)
{-# INLINE packedDoublesV #-}
@@ -673,13 +909,16 @@ packedDoublesV f num = etaMessageBuilder (embedded num . payload)
--
-- For example:
--
+-- >>> 1 `embedded` mempty
+-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\NUL"
-- >>> 1 `embedded` (1 `string` "this message" <> 2 `string` " is embedded")
-- Proto3.Wire.Encode.unsafeFromLazyByteString "\n\FS\n\fthis message\DC2\f is embedded"
embedded :: FieldNumber -> MessageBuilder -> MessageBuilder
-embedded = \num (MessageBuilder bb) ->
- MessageBuilder (RB.withLengthOf (Prim.liftBoundedPrim . prefix num) bb)
+embedded = \(!num) (MessageBuilder bb) ->
+ MessageBuilder (RB.withLengthOf (prefix num) bb)
where
- prefix num len =
+ prefix !num len = Prim.liftBoundedPrim $
unMessageBoundedPrim (fieldHeader num LengthDelimited) &<>
Prim.wordBase128LEVar (fromIntegral @Int @Word len)
+ {-# INLINE prefix #-}
{-# INLINE embedded #-}
diff --git a/src/Proto3/Wire/Encode/Repeated.hs b/src/Proto3/Wire/Encode/Repeated.hs
new file mode 100644
index 0000000..4fe2595
--- /dev/null
+++ b/src/Proto3/Wire/Encode/Repeated.hs
@@ -0,0 +1,185 @@
+{-
+ Copyright 2025 Arista Networks
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+-}
+
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+
+-- | Presents right-associative folds as 'Foldable' sequences.
+module Proto3.Wire.Encode.Repeated
+ ( Repeated(..)
+ , nullRepeated
+ , ToRepeated(..)
+ , mapRepeated
+ ) where
+
+import Data.Functor.Identity (Identity(..))
+import Data.IntMap.Lazy qualified
+import Data.IntSet qualified
+import Data.Kind (Type)
+import Data.List.NonEmpty qualified
+import Data.Map.Lazy qualified
+import Data.Sequence qualified
+import Data.Set qualified
+import Data.Vector qualified
+import Data.Vector.Storable qualified
+import Data.Vector.Unboxed qualified
+import Foreign (Storable)
+import GHC.Exts (Constraint, TYPE)
+import GHC.Generics (Generic)
+import Proto3.Wire.FoldR (FoldR(..), fromFoldR)
+
+-- | Expresses a sequence of values /in reverse order/ for encoding as a repeated field.
+type Repeated :: forall er . TYPE er -> Type
+data Repeated e = ReverseRepeated
+ { countRepeated :: Maybe Int
+ -- ^ Optionally predicts the number of elements in the sequence. Predict
+ -- the count only when it is practical to do so accurately and quickly.
+ --
+ -- A prediction that is too low causes undefined behavior--possibly
+ -- a crash. A length prediction that is too high overallocates
+ -- output space, as if the sequence really were that length.
+ , reverseRepeated :: FoldR e
+ -- ^ A lazy right-associative fold over the /reverse/
+ -- of the desired sequence of field values.
+ --
+ -- Design Note: We could have used a lazy left-associative fold, but
+ -- vectors perform such folds using a left-to-right iteration, instead
+ -- of the right-to-left iteration that would yield best performance.
+ --
+ -- Therefore in order to avoid accidental misuse of 'foldl', we ask
+ -- for sequence reversal explicitly. Thanks to vector fusion rules,
+ -- it is fast to 'foldr' on the result of reversing a vector.
+ }
+ deriving stock (Functor, Generic)
+
+deriving stock instance Eq e => Eq (Repeated e)
+deriving stock instance Read e => Read (Repeated e)
+deriving stock instance Show e => Show (Repeated e)
+
+nullRepeated :: Repeated e -> Bool
+nullRepeated c = null (reverseRepeated c)
+{-# INLINE nullRepeated #-}
+
+-- | For each container type, specifies the optimal method for reverse iteration.
+type ToRepeated :: forall cr . TYPE cr -> forall er . TYPE er -> Constraint
+class ToRepeated c e | c -> e
+ where
+ -- | Converts to a reverse iteration over the elements.
+ toRepeated :: c -> Repeated e
+
+instance forall er (e :: TYPE er) .
+ ToRepeated (Repeated e) e
+ where
+ toRepeated = id
+ {-# INLINE toRepeated #-}
+
+instance ToRepeated (Identity a) a
+ where
+ toRepeated x = ReverseRepeated (Just 1) (FoldR (\f z -> f (runIdentity x) z))
+ {-# INLINE toRepeated #-}
+
+instance ToRepeated [a] a
+ where
+ toRepeated xs = ReverseRepeated Nothing (FoldR (\f z -> foldl (flip f) z xs))
+ -- Unavoidably reads to the end of the list before presenting the last element.
+ {-# INLINE toRepeated #-}
+
+instance ToRepeated (Data.List.NonEmpty.NonEmpty a) a
+ where
+ toRepeated xs = ReverseRepeated Nothing (FoldR (\f z -> foldl (flip f) z xs))
+ -- Unavoidably reads to the end of the list before presenting the last element.
+ {-# INLINE toRepeated #-}
+
+instance ToRepeated (Data.Vector.Vector a) a
+ where
+ toRepeated xs = ReverseRepeated
+ (Just (Data.Vector.length xs))
+ (fromFoldR (Data.Vector.reverse xs))
+ -- Vector fusion should convert this to right-to-left iteration.
+ {-# INLINE toRepeated #-}
+
+instance Storable a =>
+ ToRepeated (Data.Vector.Storable.Vector a) a
+ where
+ toRepeated xs = ReverseRepeated
+ (Just (Data.Vector.Storable.length xs))
+ (FoldR (\f z -> Data.Vector.Storable.foldr f z (Data.Vector.Storable.reverse xs)))
+ -- Vector fusion should convert this to right-to-left iteration.
+ {-# INLINE toRepeated #-}
+
+instance Data.Vector.Unboxed.Unbox a =>
+ ToRepeated (Data.Vector.Unboxed.Vector a) a
+ where
+ toRepeated xs = ReverseRepeated
+ (Just (Data.Vector.Unboxed.length xs))
+ (FoldR (\f z -> Data.Vector.Unboxed.foldr f z (Data.Vector.Unboxed.reverse xs)))
+ -- Vector fusion should convert this to right-to-left iteration.
+ {-# INLINE toRepeated #-}
+
+instance ToRepeated (Data.Sequence.Seq a) a
+ where
+ toRepeated xs = ReverseRepeated
+ (Just (Data.Sequence.length xs))
+ (FoldR (\f z -> foldl (flip f) z xs))
+ -- Should present the last element without having to read through the whole sequence.
+ {-# INLINE toRepeated #-}
+
+instance ToRepeated (Data.Set.Set a) a
+ where
+ toRepeated xs = ReverseRepeated
+ (Just (Data.Set.size xs))
+ (FoldR (\f z -> foldl (flip f) z xs))
+ -- Should present the last element without having to read through the whole sequence.
+ {-# INLINE toRepeated #-}
+
+instance ToRepeated Data.IntSet.IntSet Int
+ where
+ toRepeated xs = ReverseRepeated Nothing (FoldR (\f z -> Data.IntSet.foldl (flip f) z xs))
+ -- Should present the last element without having to read through the whole sequence.
+ {-# INLINE toRepeated #-}
+
+instance ToRepeated (Data.Map.Lazy.Map k a) (k, a)
+ where
+ toRepeated xs = ReverseRepeated
+ (Just (Data.Map.Lazy.size xs))
+ (FoldR (\f z -> Data.Map.Lazy.foldlWithKey (\a k v -> f (k, v) a) z xs))
+ -- Should present the last key-value pair without having to read through the whole map.
+ {-# INLINE toRepeated #-}
+
+instance ToRepeated (Data.IntMap.Lazy.IntMap a) (Int, a)
+ where
+ toRepeated xs = ReverseRepeated
+ Nothing
+ (FoldR (\f z -> Data.IntMap.Lazy.foldlWithKey (\a k v -> f (k, v) a) z xs))
+ -- Should present the last key-value pair without having to read through the whole map.
+ {-# INLINE toRepeated #-}
+
+-- | A convenience function that maps a function over a sequence,
+-- provided that the relevant types are all lifted.
+mapRepeated ::
+ forall (c :: Type) (e :: Type) (a :: Type) . ToRepeated c e => (e -> a) -> c -> Repeated a
+mapRepeated f xs = fmap f (toRepeated xs)
+{-# INLINE mapRepeated #-}
diff --git a/src/Proto3/Wire/FoldR.hs b/src/Proto3/Wire/FoldR.hs
new file mode 100644
index 0000000..314e346
--- /dev/null
+++ b/src/Proto3/Wire/FoldR.hs
@@ -0,0 +1,80 @@
+{-
+ Copyright 2025 Arista Networks
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+-}
+
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- | Presents right-associative folds as 'Foldable' sequences.
+module Proto3.Wire.FoldR
+ ( FoldR(..)
+ , fromFoldR
+ ) where
+
+import Data.Foldable qualified
+import Data.Kind (Type)
+import GHC.Exts (TYPE)
+import GHC.Exts qualified
+import Text.Read (Read(..))
+
+-- | Presents a right-associative fold as a 'Foldable' sequence.
+--
+-- Similar to the @FRList@ example in the documentation for "Data.Foldable",
+-- but for generality the element type may be unlifted. For compatibility
+-- with the 'Foldable' type class and to avoid limitations on runtime
+-- representation polymorphism, the fold supports only lifted results.
+newtype FoldR (a :: TYPE r) = FoldR { applyFoldR :: forall (b :: Type) . (a -> b -> b) -> b -> b }
+ deriving stock (Functor)
+
+instance Foldable FoldR
+ where
+ foldr f z xs = applyFoldR xs f z
+
+instance GHC.Exts.IsList (FoldR a)
+ where
+ type Item (FoldR a) = a
+ fromList = fromFoldR
+ toList = Data.Foldable.toList
+
+instance Eq a =>
+ Eq (FoldR a)
+ where
+ x == y = GHC.Exts.toList x == GHC.Exts.toList y
+
+instance Ord a =>
+ Ord (FoldR a)
+ where
+ x <= y = GHC.Exts.toList x <= GHC.Exts.toList y
+ x `compare` y = GHC.Exts.toList x `compare` GHC.Exts.toList y
+
+instance Read a =>
+ Read (FoldR a)
+ where
+ readPrec = fmap GHC.Exts.fromList readPrec
+
+instance Show a =>
+ Show (FoldR a)
+ where
+ showsPrec d = showsPrec d . GHC.Exts.toList
+
+-- | Creates a 'FoldR' from the 'foldr' of the given 'Foldable' sequence.
+fromFoldR :: Foldable t => t a -> FoldR a
+fromFoldR xs = FoldR { applyFoldR = \f z -> foldr f z xs }
diff --git a/src/Proto3/Wire/Reverse.hs b/src/Proto3/Wire/Reverse.hs
index dd35439..91e57ac 100644
--- a/src/Proto3/Wire/Reverse.hs
+++ b/src/Proto3/Wire/Reverse.hs
@@ -26,6 +26,8 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MagicHash #-}
module Proto3.Wire.Reverse
( -- * `BuildR` type
@@ -79,6 +81,8 @@ module Proto3.Wire.Reverse
-- * Helpful combinators
, foldlRVector
+ , repeatedBuildR
+ , repeatedFixedPrimR
-- * Exported for testing purposes only.
, testWithUnused
@@ -86,6 +90,7 @@ module Proto3.Wire.Reverse
import Data.Bits ( (.&.) )
import qualified Data.ByteString as B
+import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Internal as BLI
import qualified Data.ByteString.Short as BS
@@ -100,6 +105,13 @@ import qualified Data.Text.Short as TS
import Data.Vector.Generic ( Vector )
import Data.Word ( Word8, Word16, Word32, Word64 )
import Foreign ( castPtr, copyBytes )
+import GHC.Exts ( Addr#, Int(..), Int# )
+#if !MIN_VERSION_bytestring(0,11,0)
+import GHC.Exts ( plusAddr# )
+#endif
+import GHC.ForeignPtr ( ForeignPtr(..), ForeignPtrContents )
+import GHC.TypeLits ( KnownNat )
+import Proto3.Wire.Encode.Repeated ( Repeated(..), ToRepeated(..) )
import Proto3.Wire.Reverse.Internal
import qualified Proto3.Wire.Reverse.Prim as Prim
@@ -134,15 +146,32 @@ toLazyByteString = snd . runBuildR
-- >>> byteString "ABC"
-- Proto3.Wire.Reverse.lazyByteString "ABC"
byteString :: B.ByteString -> BuildR
-byteString bs = withUnused $ \unused ->
- let len = B.length bs in
- if len <= unused
- then
- unsafeConsume len $ \dst ->
- BU.unsafeUseAsCString bs $ \src ->
- copyBytes dst (castPtr src) len
- else
- prependChunk bs
+#if MIN_VERSION_bytestring(0,11,0)
+byteString (BI.BS (ForeignPtr ad ct) (I# len)) = byteStringImpl ad ct len
+#else
+byteString (BI.PS (ForeignPtr ad ct) (I# off) (I# len)) = byteStringImpl (plusAddr# ad off) ct len
+#endif
+{-# INLINE byteString #-}
+
+byteStringImpl :: Addr# -> ForeignPtrContents -> Int# -> BuildR
+byteStringImpl ad ct len =
+#if MIN_VERSION_bytestring(0,11,0)
+ let bs = BI.BS (ForeignPtr ad ct) (I# len) in
+#else
+ let bs = BI.PS (ForeignPtr ad ct) 0 (I# len) in
+#endif
+ withUnused $ \unused ->
+ if I# len <= unused
+ then
+ unsafeConsume (I# len) $ \dst ->
+ BU.unsafeUseAsCString bs $ \src ->
+ copyBytes dst (castPtr src) (I# len)
+ else
+ prependChunk bs
+{-# NOINLINE [1] byteStringImpl #-}
+{-# RULES
+ "byteStringImpl/empty" forall ad ct . byteStringImpl ad ct 0# = mempty
+ #-}
-- | Convert a lazy `BL.ByteString` to a `BuildR`
--
@@ -179,6 +208,10 @@ lazyByteString = etaBuildR $ scan (ReverseChunks BL.empty)
copyBytes dst (castPtr src) len
else
prependReverseChunks (ReverseChunks(BLI.Chunk c cs))
+{-# NOINLINE [1] lazyByteString #-}
+{-# RULES
+ "lazyByteString/empty" lazyByteString BLI.Empty = mempty
+ #-}
-- | Convert a `BS.ShortByteString` to a `BuildR`
--
@@ -823,10 +856,41 @@ word64Base128LEVar_inline = \x ->
{-# INLINE word64Base128LEVar_inline #-}
-- | Essentially 'foldMap', but iterates right to left for efficiency.
+--
+-- See also: 'repeatedBuildR'
vectorBuildR :: Vector v a => (a -> BuildR) -> v a -> BuildR
vectorBuildR f = etaBuildR (foldlRVector (\acc x -> acc <> f x) mempty)
{-# INLINE vectorBuildR #-}
+-- | Concatenates the given builders, iterating right to left where practical.
+--
+-- For example:
+--
+-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (repeatedBuildR (map word8 [42,67])))
+-- [42,67]
+--
+-- See also: 'repeatedFixedPrimR', 'vectorBuildR'
+repeatedBuildR :: ToRepeated c BuildR => c -> BuildR
+repeatedBuildR = etaBuildR (foldr (flip (<>)) mempty . reverseRepeated . toRepeated)
+{-# INLINE repeatedBuildR #-}
+
+-- | Concatenates the given fixed-width primitives, iterating right to left where practical
+-- and consolidating space checks if the number of primitives has been predicted.
+--
+-- For example:
+--
+-- >>> Data.ByteString.Lazy.unpack (toLazyByteString (repeatedFixedPrimR (map Proto3.Wire.Reverse.Prim.word8 [42,67])))
+-- [42,67]
+--
+-- See also: 'repeatedBuildR'
+repeatedFixedPrimR :: (ToRepeated c (Prim.FixedPrim w), KnownNat w) => c -> BuildR
+repeatedFixedPrimR = etaBuildR $ \c ->
+ let ReverseRepeated prediction prims = toRepeated c in
+ case prediction of
+ Nothing -> foldr (\p a -> a <> Prim.liftBoundedPrim (Prim.liftFixedPrim p)) mempty prims
+ Just count -> Prim.unsafeReverseFoldMapFixedPrim id count prims
+{-# INLINE repeatedFixedPrimR #-}
+
-- | Exported for testing purposes only.
testWithUnused :: (Int -> BuildR) -> BuildR
testWithUnused = withUnused
diff --git a/src/Proto3/Wire/Reverse/Prim.hs b/src/Proto3/Wire/Reverse/Prim.hs
index eda7b58..68c276c 100644
--- a/src/Proto3/Wire/Reverse/Prim.hs
+++ b/src/Proto3/Wire/Reverse/Prim.hs
@@ -99,6 +99,7 @@ module Proto3.Wire.Reverse.Prim
, word64Base128LEVar
, word64Base128LEVar_inline
, vectorFixedPrim
+ , unsafeReverseFoldMapFixedPrim
) where
import Data.Bits ( Bits(..) )
@@ -844,3 +845,30 @@ vectorFixedPrim f = etaBuildR $ \v ->
where
w = fromInteger (natVal' (proxy# :: Proxy# w))
{-# INLINE vectorFixedPrim #-}
+
+-- | Generalizes 'vectorFixedPrim' by mapping the elements
+-- of a sequence of known length to fixed-width primitives
+-- and concatenating those primitives /in reverse order/.
+--
+-- This action is unsafe because a length prediction that is too short
+-- causes undefined behavior--possibly a crash. By contrast, a length
+-- prediction that is too long merely overallocates output space.
+--
+-- (To see how this function could be used to implement 'vectorFixedPrim',
+-- note that we can iterate over a vector from right to left by reversing
+-- the vector and then performing a right fold on the reversed vector;
+-- vector fusion rules should eliminate the intermediate vector.)
+unsafeReverseFoldMapFixedPrim ::
+ forall w t a .
+ (KnownNat w, Foldable t) =>
+ (a -> FixedPrim w) ->
+ -- | Maximum number of elements. Overapproximation causes
+ -- overallocation; passing an undercount may cause a crash.
+ Int ->
+ t a ->
+ BuildR
+unsafeReverseFoldMapFixedPrim f !n = etaBuildR $ \xs ->
+ ensure (w * n) (foldr (\x acc -> acc <> unsafeBuildBoundedPrim (liftFixedPrim (f x))) mempty xs)
+ where
+ w = fromInteger (natVal' (proxy# :: Proxy# w))
+{-# INLINE unsafeReverseFoldMapFixedPrim #-}
diff --git a/test/Main.hs b/test/Main.hs
index 3fe159d..bc64bb7 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -14,9 +14,11 @@
limitations under the License.
-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-warnings-deprecations #-}
@@ -32,20 +34,34 @@ import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Short as BS
import qualified Data.ByteString.Builder.Internal as BBI
import Data.Either ( isLeft )
-import Data.Maybe ( fromMaybe )
+import Data.Foldable ( toList )
+import Data.Functor.Identity ( Identity )
import Data.Int
+import qualified Data.IntMap.Lazy
+import qualified Data.IntSet
+import qualified Data.Map.Lazy
+import Data.Maybe ( fromMaybe )
import Data.List ( sort )
import qualified Data.List.NonEmpty as NE
+import Data.Proxy ( Proxy(..) )
+import qualified Data.Sequence
+import qualified Data.Set
import qualified Data.Text.Lazy as T
import qualified Data.Text.Short as TS
+import Data.Typeable ( Typeable, showsTypeRep, typeRep )
import qualified Data.Vector as V
+import qualified Data.Vector.Storable as VS
+import qualified Data.Vector.Unboxed as VU
import Data.Word ( Word8, Word64 )
import Foreign ( sizeOf )
+import qualified GHC.Exts
import Proto3.Wire
+import Proto3.Wire.FoldR ( FoldR )
import qualified Proto3.Wire.Builder as Builder
import qualified Proto3.Wire.Reverse as Reverse
import qualified Proto3.Wire.Encode as Encode
+import Proto3.Wire.Encode.Repeated ( Repeated(..), ToRepeated(..), nullRepeated )
import qualified Proto3.Wire.Decode as Decode
import qualified Test.DocTest
@@ -77,6 +93,7 @@ tests = testGroup "Tests" [ roundTripTests
, varIntHeavyTests
, packedLargeTests
, decodeWireRoundTrip
+ , toRepeatedTests
]
data StringOrInt64 = TString T.Text | TInt64 Int64
@@ -783,3 +800,73 @@ packedDoublesV_large = HU.testCase "Large packedDoublesV" $ do
decoded = Decode.parse (one Decode.packedDoubles [] `at` fieldNumber 13)
(BL.toStrict encoded)
HU.assertEqual "round trip" (Right [2 .. count + 1]) decoded
+
+data ExpectedCountPrediction c = NoCP | CorrectCP | SameCP (c -> Maybe Int)
+
+toRepeatedTests :: TestTree
+toRepeatedTests = testGroup "ToRepeated"
+ [ test_nullRepeated
+ , test_ToRepeated (SameCP countRepeated) genRepeated (reverse . toList . reverseRepeated)
+ , test_ToRepeated CorrectCP QC.arbitrary (toList @Identity @Word8)
+ , test_ToRepeated NoCP QC.arbitrary (id @[Word8])
+ , test_ToRepeated NoCP ((NE.:|) <$> QC.arbitrary <*> QC.arbitrary) (toList @NE.NonEmpty @Word8)
+ , test_ToRepeated CorrectCP (fmap V.fromList QC.arbitrary) (V.toList @Word8)
+ , test_ToRepeated CorrectCP (fmap VS.fromList QC.arbitrary) (VS.toList @Word8)
+ , test_ToRepeated CorrectCP (fmap VU.fromList QC.arbitrary) (VU.toList @Word8)
+ , test_ToRepeated CorrectCP QC.arbitrary (toList @Data.Sequence.Seq @Word8)
+ , test_ToRepeated CorrectCP QC.arbitrary (Data.Set.toAscList @Word8)
+ , test_ToRepeated NoCP QC.arbitrary Data.IntSet.toAscList
+ , test_ToRepeated CorrectCP QC.arbitrary (Data.Map.Lazy.toAscList @Int8 @Word8)
+ , test_ToRepeated NoCP QC.arbitrary (Data.IntMap.Lazy.toAscList @Word8)
+ ]
+ where
+ genRepeated :: QC.Gen (Repeated Word8)
+ genRepeated = do
+ predict <- QC.arbitrary
+ xs <- QC.arbitrary
+ pure ReverseRepeated
+ { countRepeated = if predict then Just (length xs) else Nothing
+ , reverseRepeated = GHC.Exts.fromList xs
+ }
+
+ test_nullRepeated :: TestTree
+ test_nullRepeated =
+ QC.testProperty "nullRepeated" $
+ QC.forAll genRepeated $ \c ->
+ nullRepeated c === null (reverseRepeated c)
+
+ test_ToRepeated ::
+ forall c e .
+ ( ToRepeated c e
+ , Show c
+ , Typeable c
+ , Eq e
+ , Show e
+ ) =>
+ ExpectedCountPrediction c ->
+ (QC.Gen c) ->
+ (c -> [e]) ->
+ TestTree
+ test_ToRepeated expectedCP gen cToList =
+ let cRep = typeRep (Proxy :: Proxy c) in
+ QC.testProperty (showString "toRepeated @(" $ showsTypeRep cRep ")") $
+ QC.forAll gen $ \(c :: c) ->
+ let es :: [e]
+ es = cToList c
+
+ prediction :: Maybe Int
+ reversed :: FoldR e
+ ReverseRepeated prediction reversed = toRepeated c
+ in
+ QC.counterexample "correctly reversed elements" (toList reversed === reverse es)
+ QC..&&.
+ QC.counterexample "correct count prediction if any"
+ (all @Maybe (== length es) prediction)
+ QC..&&.
+ case expectedCP of
+ NoCP ->
+ QC.counterexample "no count prediction" (prediction === Nothing)
+ CorrectCP ->
+ QC.counterexample "correct count prediction" (prediction === Just (length es))
+ SameCP expected ->
+ QC.counterexample "unchanged count prediction" (prediction === expected c)