vary 0.1.0.5 → 0.1.1.0

raw patch · 9 files changed

+218/−4 lines, 9 filesdep +binarydep +bytestringdep +cerealdep ~QuickCheckPVP ok

version bump matches the API change (PVP)

Dependencies added: binary, bytestring, cereal

Dependency ranges changed: QuickCheck

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +1/−0
• src/Vary.hs +14/−0
• src/Vary/Core.hs +91/−0
• src/Vary/VEither.hs +16/−0
• test/README.lhs +1/−0
• test/doctest/doctests.hs +1/−0
• test/spec/spec.hs +39/−2
• vary.cabal +50/−2

@@ -8,6 +8,11 @@  ## Unreleased +## 0.1.1.0 - 2025-02-05++- Add serialization support of `Vary` for `binary`'s `Data.Binary` and `cereal`'s `Data.Serialize`.+- Document `Data.Aeson` round-tripping behaviour (namely: only round-trippable if encodings do not overlap, the `UntaggedValue` sum encoding).+ ## 0.1.0.5 - 2025-02-05  - Relax max allowed versions of DeepSeq (<1.6), Hashable (<1.6), QuickCheck (<2.16)

@@ -313,6 +313,7 @@ but we don't want it to be visible to human readers:  ```haskell top:1+{-# OPTIONS_GHC -Wno-missing-export-lists #-} {-# OPTIONS_GHC -fdefer-type-errors #-} -- We want to show some incorrect examples! module Main where 

@@ -27,6 +27,7 @@     -- $setup     -- $motivating_example     -- $vary_and_exceptions+    -- $vary_and_serialization      -- * Core type definition     Vary,@@ -149,6 +150,19 @@ -- >>> catcher (throw AllocationLimitExceeded) -- *** Exception: allocation limit exceeded ++-- $vary_and_serialization+--+-- == (De)Serializing Vary values+--+-- `Vary` has optional dependencies to enable `aeson`'s `Data.Aeson`, `binary`'s `Data.Binary` and `cereal`'s `Data.Serealize` serialization.+--+-- Specifically for Aeson serialization, Vary datatypes are encoded+-- as their ['UntaggedValue'](https://hackage.haskell.org/package/aeson-2.0.3.0/docs/Data-Aeson-Types.html#t:SumEncoding) encoding.+-- This means that serialization to JSON only round-trips when the encodings are disjoint;+-- on decoding, the first variant to succeed is used.+--+-- The Binary and Serialize instances always round-trip, as their encoding contains the variant's tag index.  -- | Builds a Vary from the given value. --

@@ -30,6 +30,14 @@ import Test.QuickCheck.Arbitrary (GSubterms, RecursivelyShrink) # endif +# ifdef FLAG_BINARY+import Data.Binary qualified as Binary+# endif++# ifdef FLAG_CEREAL+import Data.Serialize qualified as Cereal+# endif+ -- $setup -- >>> :set -XGHC2021 -- >>> :set -XDataKinds@@ -231,6 +239,10 @@  deriving instance (Aeson.FromJSON a) => Aeson.FromJSON (Vary '[a]) +-- | This instance round-trips iff there is no overlap between the encodings of the element types.+--+-- For example, a `Vary '[Int, String] is round-trippable+-- but a `Vary '[String, Char]` is not. instance (Aeson.FromJSON a, Aeson.FromJSON (Vary (b : bs))) => Aeson.FromJSON (Vary (a : b : bs)) where   {-# INLINE parseJSON #-}   parseJSON val = (pushHead <$> Aeson.parseJSON val) <|> (pushTail <$> Aeson.parseJSON val)@@ -239,6 +251,10 @@  deriving instance (Aeson.ToJSON a) => Aeson.ToJSON (Vary '[a]) +-- | This instance round-trips iff there is no overlap between the encodings of the element types.+--+-- For example, a `Vary '[Int, String] is round-trippable+-- but a `Vary '[String, Char]` is not. instance (Aeson.ToJSON a, Aeson.ToJSON (Vary (b : bs))) => Aeson.ToJSON (Vary (a : b : bs)) where   {-# INLINE toJSON #-}   toJSON vary =@@ -291,4 +307,79 @@   where   hashWithSalt salt vary@(Vary tag _inner) = fromIntegral tag `hashWithSalt` badHashWithSalt salt vary   hash vary@(Vary tag _inner) = badHashWithSalt (fromIntegral tag) vary+#endif++#ifdef FLAG_BINARY+class BinaryHelper a where+  binaryPutVariant :: a -> Binary.Put+  binaryGetVariant :: Word -> Binary.Get a++instance BinaryHelper (Vary '[]) where+  {-# INLINE binaryPutVariant #-}+  binaryPutVariant emptyVary = case from emptyVary of {}++  {-# INLINE binaryGetVariant #-}+  binaryGetVariant = emptyVaryError "binaryGetVariant" undefined++instance+  ( Binary.Binary a+  , BinaryHelper (Vary as)+  ) =>+  BinaryHelper (Vary (a : as))+  where+  {-# INLINE binaryPutVariant #-}+  binaryPutVariant vary = case pop vary of+    Right val -> Binary.put val+    Left val -> binaryPutVariant val++  {-# INLINE binaryGetVariant #-}+  binaryGetVariant 0 = pushHead <$> Binary.get @a+  binaryGetVariant n = pushTail <$> binaryGetVariant @(Vary as) (n - 1)++instance (BinaryHelper (Vary as)) => Binary.Binary (Vary as) where+  {-# INLINE put #-}+  put vary@(Vary n _) = do+    Binary.put n+    binaryPutVariant vary+  {-# INLINE get #-}+  get = do+    tag <- Binary.get+    binaryGetVariant tag+#endif++#ifdef FLAG_CEREAL+class SerializeHelper a where+  cerealPutVariant :: a -> Cereal.Put+  cerealGetVariant :: Word -> Cereal.Get a++instance SerializeHelper (Vary '[]) where+  {-# INLINE cerealPutVariant #-}+  cerealPutVariant emptyVary = case from emptyVary of {} +  {-# INLINE cerealGetVariant #-}+  cerealGetVariant = emptyVaryError "cerealGetVariant" undefined++instance+  ( Cereal.Serialize a+  , SerializeHelper (Vary as)+  ) =>+  SerializeHelper (Vary (a : as))+  where+  {-# INLINE cerealPutVariant #-}+  cerealPutVariant vary = case pop vary of+    Right val -> Cereal.put val+    Left val -> cerealPutVariant val++  {-# INLINE cerealGetVariant #-}+  cerealGetVariant 0 = pushHead <$> Cereal.get @a+  cerealGetVariant n = pushTail <$> cerealGetVariant @(Vary as) (n - 1)++instance (SerializeHelper (Vary as)) => Cereal.Serialize (Vary as) where+  {-# INLINE put #-}+  put vary@(Vary n _) = do+    Cereal.putWord64le (fromIntegral n)+    cerealPutVariant vary+  {-# INLINE get #-}+  get = do+    tag <- Cereal.getWord64le+    cerealGetVariant (fromIntegral tag) #endif

@@ -62,6 +62,14 @@ import Test.QuickCheck # endif +# ifdef FLAG_CEREAL+import Data.Serialize qualified as Cereal+# endif++# ifdef FLAG_BINARY+import Data.Binary qualified as Binary+# endif+ -- $setup -- -- This module is intended to be used qualified:@@ -353,4 +361,12 @@  #ifdef FLAG_QUICKCHECK deriving instance (Arbitrary (Vary (a : errs))) => Test.QuickCheck.Arbitrary (VEither errs a)+#endif++#ifdef FLAG_CEREAL+deriving instance (Cereal.Serialize (Vary (a : errs))) => Cereal.Serialize (VEither errs a)+#endif++#ifdef FLAG_BINARY+deriving instance (Binary.Binary (Vary (a : errs))) => Binary.Binary (VEither errs a) #endif

@@ -313,6 +313,7 @@ but we don't want it to be visible to human readers:  ```haskell top:1+{-# OPTIONS_GHC -Wno-missing-export-lists #-} {-# OPTIONS_GHC -fdefer-type-errors #-} -- We want to show some incorrect examples! module Main where 

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Main where  import Test.DocTest (mainFromCabal)

@@ -1,3 +1,40 @@-module Main where+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main (main) where++import Test.Hspec+import Test.Hspec.QuickCheck++import Data.Aeson qualified as Aeson+import Data.Binary qualified as Binary+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as LBS+import Data.Serialize qualified as Cereal++import Vary (Vary)++type TestVariant = Vary '[Int, String, Maybe [Bool]]+ main :: IO ()-main = putStrLn "(No separate unit tests yet)"+main = hspec $ do+  describe "Serialization with aeson" $ do+    prop "encodes properly" $ \(v :: TestVariant) -> do+      Aeson.encode v `shouldSatisfy` (not . LBS.null)+    prop "encode - decode roundtrips" $ \(v :: TestVariant) -> do+      -- NOTE: `TestVariant` is chosen so the JSON encodings do not overlap.+      -- Without that, this property would not hold+      Aeson.eitherDecode (Aeson.encode v) `shouldBe` Right v++  describe "Serialization with binary" $ do+    prop "encodes properly" $ \(v :: TestVariant) -> do+      Binary.encode v `shouldSatisfy` (not . LBS.null)+    prop "encode - decode roundtrips" $ \(v :: TestVariant) -> do+      Binary.decode (Binary.encode v) `shouldBe` v++  describe "Serialization with cereal" $ do+    prop "encodes properly" $ \(v :: TestVariant) -> do+      Cereal.encode v `shouldSatisfy` (not . BS.null)+    prop "encode - decode roundtrips" $ \(v :: TestVariant) -> do+      Cereal.decode (Cereal.encode v) `shouldBe` Right v

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           vary-version:        0.1.0.5+version:        0.1.1.0 synopsis:       Vary: Friendly and fast polymorphic variants (open unions/coproducts/extensible sums) description:    Vary: Friendly and fast Variant types for Haskell                 .@@ -40,6 +40,16 @@   manual: True   default: True +flag binary+  description: When enabled implements the @Binary@ typeclass from the binary library. When disabled, does not depend on the binary library.+  manual: True+  default: True++flag cereal+  description: When enabled implements the @Serialize@ typeclass from the cereal library. When disabled, does not depend on the cereal library.+  manual: True+  default: True+ flag hashable   description: When enabled implements the @Hashable@ typeclass from the hashable library. When disabled, does not depend on the @hashable@ library.   manual: True@@ -72,6 +82,14 @@     cpp-options: -DFLAG_AESON     build-depends:         aeson >=2.0.0 && <2.3+  if flag(binary)+    cpp-options: -DFLAG_BINARY+    build-depends:+        binary >=0.8.0.0 && <0.9.0.0+  if flag(cereal)+    cpp-options: -DFLAG_CEREAL+    build-depends:+        cereal >=0.5.0.0 && <0.6.0.0   if flag(quickcheck)     cpp-options: -DFLAG_QUICKCHECK     build-depends:@@ -99,6 +117,14 @@     cpp-options: -DFLAG_AESON     build-depends:         aeson >=2.0.0 && <2.3+  if flag(binary)+    cpp-options: -DFLAG_BINARY+    build-depends:+        binary >=0.8.0.0 && <0.9.0.0+  if flag(cereal)+    cpp-options: -DFLAG_CEREAL+    build-depends:+        cereal >=0.5.0.0 && <0.6.0.0   if flag(quickcheck)     cpp-options: -DFLAG_QUICKCHECK     build-depends:@@ -128,6 +154,14 @@     cpp-options: -DFLAG_AESON     build-depends:         aeson >=2.0.0 && <2.3+  if flag(binary)+    cpp-options: -DFLAG_BINARY+    build-depends:+        binary >=0.8.0.0 && <0.9.0.0+  if flag(cereal)+    cpp-options: -DFLAG_CEREAL+    build-depends:+        cereal >=0.5.0.0 && <0.6.0.0   if flag(quickcheck)     cpp-options: -DFLAG_QUICKCHECK     build-depends:@@ -142,8 +176,14 @@       test/spec   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N   build-depends:-      base >=4.7 && <5+      QuickCheck >=2.12 && <2.15+    , aeson >=2.0.0 && <2.3+    , base >=4.7 && <5+    , binary+    , bytestring+    , cereal     , deepseq >=1.4.0 && <1.6+    , hspec     , vary   default-language: Haskell2010   if flag(hashable)@@ -154,6 +194,14 @@     cpp-options: -DFLAG_AESON     build-depends:         aeson >=2.0.0 && <2.3+  if flag(binary)+    cpp-options: -DFLAG_BINARY+    build-depends:+        binary >=0.8.0.0 && <0.9.0.0+  if flag(cereal)+    cpp-options: -DFLAG_CEREAL+    build-depends:+        cereal >=0.5.0.0 && <0.6.0.0   if flag(quickcheck)     cpp-options: -DFLAG_QUICKCHECK     build-depends: