genvalidity-sydtest-persistent (empty) → 0.0.0.1

raw patch · 5 files changed

+225/−0 lines, 5 filesdep +QuickCheckdep +basedep +genvalidity

Dependencies added: QuickCheck, base, genvalidity, genvalidity-sydtest, genvalidity-sydtest-persistent, genvalidity-text, persistent, sydtest, text, validity

Files

• LICENSE +21/−0
• genvalidity-sydtest-persistent.cabal +64/−0
• src/Test/Syd/Validity/Persist.hs +124/−0
• test/Spec.hs +1/−0
• test/Test/Syd/Validity/PersistSpec.hs +15/−0

@@ -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.

@@ -0,0 +1,64 @@+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-persistent+version:        0.0.0.1+synopsis:       Standard spec's for persistent-related instances for 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.Persist+  other-modules:+      Paths_genvalidity_sydtest_persistent+  hs-source-dirs:+      src/+  ghc-options: -Wall+  build-depends:+      QuickCheck+    , base >=4.9 && <=5+    , genvalidity >=0.5+    , genvalidity-sydtest+    , persistent+    , sydtest+    , text+  default-language: Haskell2010++test-suite genvalidity-sydtest-persistent-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Test.Syd.Validity.PersistSpec+      Paths_genvalidity_sydtest_persistent+  hs-source-dirs:+      test/+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  build-tool-depends:+      sydtest-discover:sydtest-discover+  build-depends:+      QuickCheck+    , base >=4.9 && <=5+    , genvalidity >=0.7+    , genvalidity-sydtest+    , genvalidity-sydtest-persistent+    , genvalidity-text+    , persistent+    , sydtest+    , text+    , validity >=0.9+  default-language: Haskell2010

@@ -0,0 +1,124 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- | Standard test `Spec`s and raw `Property`s for `PersistField` instances.+--+-- You will need @TypeApplications@ to use these.+module Test.Syd.Validity.Persist+  ( persistSpecOnValid,+    persistSpec,+    persistSpecOnArbitrary,+    persistSpecOnGen,+    fromPersistValueAndToPersistValueAreInversesOnGen,+  )+where++import Data.GenValidity+import qualified Data.Text as T+import Data.Typeable+import Database.Persist (PersistField (..))+import Test.QuickCheck+import Test.Syd+import Test.Syd.Validity.Utils++-- | Standard test spec for properties of persistent-related functions for valid values+--+-- Example usage:+--+-- > persistSpecOnValid @Rational+persistSpecOnValid ::+  forall a.+  (Show a, Eq a, Typeable a, GenValid a, PersistField a) =>+  Spec+persistSpecOnValid = persistSpecOnGen (genValid @a) "valid" shrinkValid++-- | Standard test spec for properties of persistent-related functions for unchecked values+--+-- Example usage:+--+-- > persistSpec @Int+persistSpec ::+  forall a.+  (Show a, Eq a, Typeable a, GenUnchecked a, PersistField a) =>+  Spec+persistSpec = persistSpecOnGen (genUnchecked @a) "unchecked" shrinkUnchecked++-- | Standard test spec for properties of persistent-related functions for arbitrary values+--+-- Example usage:+--+-- > persistSpecOnArbitrary @Int+persistSpecOnArbitrary ::+  forall a.+  (Show a, Eq a, Typeable a, Arbitrary a, PersistField a) =>+  Spec+persistSpecOnArbitrary = persistSpecOnGen (arbitrary @a) "arbitrary" shrink++-- | Standard test spec for properties of persistent-related functions for a given generator (and a name for that generator).+--+-- Example usage:+--+-- > persistSpecOnGen (genListOf $ pure 'a') "sequence of 'a's"+persistSpecOnGen ::+  forall a.+  (Show a, Eq a, Typeable a, PersistField a) =>+  Gen a ->+  String ->+  (a -> [a]) ->+  Spec+persistSpecOnGen gen genname s =+  parallel $ do+    let name = nameOf @a+    describe ("PersistField " ++ name ++ " (" ++ genname ++ ")") $ do+      describe ("fromPersistValue :: PersistValue -> Either Text " ++ name) $+        it+          ( unwords+              [ "ensures that toPersistValue and fromPersistValue are inverses for",+                "\"" ++ genname,+                name ++ "\"" ++ "'s"+              ]+          )+          $ fromPersistValueAndToPersistValueAreInversesOnGen gen s++-- |+--+-- prop> fromPersistValueAndToPersistValueAreInversesOnGen @Bool arbitrary shrink+--+-- prop> fromPersistValueAndToPersistValueAreInversesOnGen @Bool genUnchecked shrinkUnchecked+--+-- prop> fromPersistValueAndToPersistValueAreInversesOnGen @Bool genValid shrinkValid+--+-- prop> fromPersistValueAndToPersistValueAreInversesOnGen @Int arbitrary shrink+--+-- prop> fromPersistValueAndToPersistValueAreInversesOnGen @Int genUnchecked shrinkUnchecked+--+-- prop> fromPersistValueAndToPersistValueAreInversesOnGen @Int genValid shrinkValid+fromPersistValueAndToPersistValueAreInversesOnGen ::+  (Show a, Eq a, PersistField a) => Gen a -> (a -> [a]) -> Property+fromPersistValueAndToPersistValueAreInversesOnGen gen s =+  forAllShrink gen s $ \(a :: a) ->+    let encoded = toPersistValue a+        errOrDecoded = fromPersistValue encoded+     in case errOrDecoded of+          Left err ->+            expectationFailure $+              unlines+                [ "Decoding failed with error",+                  T.unpack err,+                  "instead of decoding to",+                  show a,+                  "'encode' encoded it to the persist",+                  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 persist",+                      show encoded+                    ]+             in context ctx $ decoded `shouldBe` a

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF sydtest-discover #-}

@@ -0,0 +1,15 @@+{-# LANGUAGE TypeApplications #-}++module Test.Syd.Validity.PersistSpec where++import Data.GenValidity+import Test.Syd+import Test.Syd.Validity.Persist++spec :: Spec+spec = do+  persistSpecOnGen (genListOf $ pure 'a') "sequence of 'a's" (const [])+  -- persistSpec @Double -- DOES NOT HOLD+  persistSpecOnValid @Rational+  persistSpec @Int+  persistSpecOnArbitrary @Int