packages feed

genvalidity-sydtest-aeson (empty) → 0.0.0.0

raw patch · 5 files changed

+276/−0 lines, 5 filesdep +QuickCheckdep +aesondep +base

Dependencies added: QuickCheck, aeson, base, bytestring, deepseq, genvalidity, genvalidity-aeson, genvalidity-sydtest, genvalidity-sydtest-aeson, genvalidity-text, sydtest, text, validity

Files

+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2020 Tom Sydney Kerckhove++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ genvalidity-sydtest-aeson.cabal view
@@ -0,0 +1,66 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.2.+--+-- see: https://github.com/sol/hpack++name:           genvalidity-sydtest-aeson+version:        0.0.0.0+synopsis:       Standard spec's for aeson-related instances in sydtest+category:       Testing+homepage:       http://cs-syd.eu+bug-reports:    https://github.com/NorfairKing/validity/issues+author:         Tom Sydney Kerckhove+maintainer:     syd@cs-syd.eu+copyright:      Copyright: (c) 2020 Tom Sydney Kerckhove+license:        MIT+license-file:   LICENSE+build-type:     Simple++source-repository head+  type: git+  location: https://github.com/NorfairKing/validity++library+  exposed-modules:+      Test.Syd.Validity.Aeson+  other-modules:+      Paths_genvalidity_sydtest_aeson+  hs-source-dirs:+      src/+  ghc-options: -Wall+  build-depends:+      QuickCheck+    , aeson+    , base >=4.9 && <=5+    , bytestring+    , deepseq+    , genvalidity >=0.5+    , genvalidity-sydtest+    , sydtest+  default-language: Haskell2010++test-suite genvalidity-sydtest-aeson-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Test.Syd.Validity.AesonSpec+      Paths_genvalidity_sydtest_aeson+  hs-source-dirs:+      test/+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  build-tool-depends:+      sydtest-discover:sydtest-discover+  build-depends:+      QuickCheck+    , aeson+    , base >=4.9 && <=5+    , genvalidity >=0.7+    , genvalidity-aeson+    , genvalidity-sydtest+    , genvalidity-sydtest-aeson+    , genvalidity-text+    , sydtest+    , text+    , validity >=0.9+  default-language: Haskell2010
+ src/Test/Syd/Validity/Aeson.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- | Standard test `Spec`s and raw `Property`s for `FromJSON` and `ToJSON` instances.+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.Aeson+  ( jsonSpecOnValid,+    jsonSpec,+    jsonSpecOnArbitrary,+    jsonSpecOnGen,+    neverFailsToEncodeOnGen,+    encodeAndDecodeAreInversesOnGen,+  )+where++import Control.DeepSeq (deepseq)+import Control.Exception (evaluate)+import Data.Aeson (FromJSON, ToJSON)+import qualified Data.Aeson as JSON+import Data.GenValidity+import Data.Typeable+import Test.QuickCheck+import Test.Syd+import Test.Syd.Validity.Utils++-- | Standard test spec for properties of JSON-related functions for valid values+--+-- Example usage:+--+-- > jsonSpecOnValid @Rational+jsonSpecOnValid ::+  forall a.+  (Show a, Eq a, Typeable a, GenValid a, FromJSON a, ToJSON a) =>+  Spec+jsonSpecOnValid = jsonSpecOnGen (genValid @a) "valid" shrinkValid++-- | Standard test spec for properties of JSON-related functions for unchecked values+--+-- Example usage:+--+-- > jsonSpec @Int+jsonSpec ::+  forall a.+  (Show a, Eq a, Typeable a, GenUnchecked a, FromJSON a, ToJSON a) =>+  Spec+jsonSpec = jsonSpecOnGen (genUnchecked @a) "unchecked" shrinkUnchecked++-- | Standard test spec for properties of JSON-related functions for arbitrary values+--+-- Example usage:+--+-- > jsonSpecOnArbitrary @Int+jsonSpecOnArbitrary ::+  forall a.+  (Show a, Eq a, Typeable a, Arbitrary a, FromJSON a, ToJSON a) =>+  Spec+jsonSpecOnArbitrary = jsonSpecOnGen (arbitrary @a) "arbitrary" shrink++-- | Standard test spec for properties of JSON-related functions for a given generator (and a name for that generator).+--+-- Example usage:+--+-- > jsonSpecOnGen (genListOf $ pure 'a') "sequence of 'a's"+jsonSpecOnGen ::+  forall a.+  (Show a, Eq a, Typeable a, FromJSON a, ToJSON a) =>+  Gen a ->+  String ->+  (a -> [a]) ->+  Spec+jsonSpecOnGen gen genname s =+  parallel $ do+    let name = nameOf @a+    describe ("JSON " ++ name ++ " (" ++ genname ++ ")") $ do+      describe+        ("encode :: " ++ name ++ " -> Data.ByteString.Lazy.ByteString")+        $ it+          ( unwords+              [ "never fails to encode a",+                "\"" ++ genname,+                name ++ "\""+              ]+          )+          $ neverFailsToEncodeOnGen gen s+      describe+        ( "decode :: Data.ByteString.Lazy.ByteString -> Either String "+            ++ name+        )+        $ it+          ( unwords+              [ "ensures that encode and decode are inverses for",+                "\"" ++ genname,+                name ++ "\"" ++ "'s"+              ]+          )+          $ encodeAndDecodeAreInversesOnGen gen s++-- |+--+-- prop> neverFailsToEncodeOnGen @Bool arbitrary shrink+-- prop> neverFailsToEncodeOnGen @Bool genUnchecked shrinkUnchecked+-- prop> neverFailsToEncodeOnGen @Bool genValid shrinkValid+-- prop> neverFailsToEncodeOnGen @Int arbitrary shrink+-- prop> neverFailsToEncodeOnGen @Int genUnchecked shrinkUnchecked+-- prop> neverFailsToEncodeOnGen @Int genValid shrinkValid+neverFailsToEncodeOnGen :: (Show a, ToJSON a) => Gen a -> (a -> [a]) -> Property+neverFailsToEncodeOnGen gen s =+  forAllShrink gen s $ \(a :: a) ->+    evaluate (deepseq (JSON.encode a) ()) `shouldReturn` ()++-- |+--+-- prop> encodeAndDecodeAreInversesOnGen @Bool arbitrary shrink+-- prop> encodeAndDecodeAreInversesOnGen @Bool genUnchecked shrinkUnchecked+-- prop> encodeAndDecodeAreInversesOnGen @Bool genValid shrinkValid+-- prop> encodeAndDecodeAreInversesOnGen @Int arbitrary shrink+-- prop> encodeAndDecodeAreInversesOnGen @Int genUnchecked shrinkUnchecked+-- prop> encodeAndDecodeAreInversesOnGen @Int genValid shrinkValid+encodeAndDecodeAreInversesOnGen ::+  (Show a, Eq a, FromJSON a, ToJSON a) => Gen a -> (a -> [a]) -> Property+encodeAndDecodeAreInversesOnGen gen s =+  forAllShrink gen s $ \(a :: a) ->+    let encoded = JSON.encode a+        errOrDecoded = JSON.eitherDecode encoded+     in case errOrDecoded of+          Left err ->+            expectationFailure $+              unlines+                [ "Decoding failed with error",+                  err,+                  "instead of decoding to",+                  show a,+                  "'encode' encoded it to the json",+                  show encoded+                ]+          Right decoded ->+            let ctx =+                  unlines+                    [ "Decoding succeeded, but the decoded value",+                      show decoded,+                      "differs from expected decoded value",+                      show a,+                      "'encode' encoded it to the json",+                      show encoded+                    ]+             in context ctx $ decoded `shouldBe` a
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF sydtest-discover #-}
+ test/Test/Syd/Validity/AesonSpec.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Test.Syd.Validity.AesonSpec where++import Data.Aeson+import Data.GenValidity+import Data.GenValidity.Aeson ()+import Data.GenValidity.Text ()+import Data.Text (Text)+import GHC.Generics+import Test.Syd+import Test.Syd.Validity.Aeson++spec :: Spec+spec = do+  jsonSpecOnGen (genListOf $ pure 'a') "sequence of 'a's" (const [])+  -- jsonSpec @Double DOES NOT HOLD+  jsonSpecOnValid @Rational+  jsonSpec @Int+  jsonSpecOnArbitrary @Int+  jsonSpecOnValid @ForShow+  jsonSpecOnValid @Value++-- shrinkValidSpec @Value++newtype ForShow+  = ForShow Text+  deriving (Show, Eq, Generic)++instance Validity ForShow++instance GenValid ForShow where+  genValid = genValidStructurally+  shrinkValid = shrinkValidStructurally++instance FromJSON ForShow++instance ToJSON ForShow