genvalidity-hspec-persistent (empty) → 0.0.0.1

raw patch · 6 files changed

+228/−0 lines, 6 filesdep +QuickCheckdep +basedep +genvaliditysetup-changed

Dependencies added: QuickCheck, base, genvalidity, genvalidity-hspec, genvalidity-hspec-persistent, genvalidity-property, genvalidity-text, hspec, persistent, text, validity

Files

• LICENSE +21/−0
• Setup.hs +3/−0
• genvalidity-hspec-persistent.cabal +65/−0
• src/Test/Validity/Persist.hs +120/−0
• test/Spec.hs +1/−0
• test/Test/Validity/PersistSpec.hs +18/−0

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2016-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,3 @@+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,65 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: a73cdedb7c072f48e81f2f75a910ab26eb53bce85e595938137996e2b48e15c4++name:           genvalidity-hspec-persistent+version:        0.0.0.1+synopsis:       Standard spec's for persistent-related instances+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) 2019-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.Validity.Persist+  other-modules:+      Paths_genvalidity_hspec_persistent+  hs-source-dirs:+      src/+  ghc-options: -Wall+  build-depends:+      QuickCheck+    , base >=4.9 && <=5+    , genvalidity >=0.5+    , genvalidity-hspec >=0.6+    , hspec+    , persistent+    , text+  default-language: Haskell2010++test-suite genvalidity-hspec-persistent-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Test.Validity.PersistSpec+      Paths_genvalidity_hspec_persistent+  hs-source-dirs:+      test/+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  build-depends:+      QuickCheck+    , base >=4.9 && <=5+    , genvalidity >=0.7+    , genvalidity-hspec+    , genvalidity-hspec-persistent+    , genvalidity-property >=0.3+    , genvalidity-text+    , hspec+    , persistent+    , text+    , validity >=0.9+  default-language: Haskell2010

@@ -0,0 +1,120 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Standard test `Spec`s and raw `Property`s for `PersistField` instances.+--+-- You will need @TypeApplications@ to use these.+module Test.Validity.Persist+  ( persistSpecOnValid+  , persistSpec+  , persistSpecOnArbitrary+  , persistSpecOnGen+  , fromPersistValueAndToPersistValueAreInversesOnGen+  ) where++import Data.GenValidity++import Control.Monad+import qualified Data.Text as T+import Data.Typeable+import Database.Persist (PersistField(..))+import Test.Hspec+import Test.QuickCheck+import Test.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 ->+            unless (decoded == a) $+            expectationFailure $+            unlines+              [ "Decoding succeeded, but the decoded value"+              , show decoded+              , "differs from expected decoded value"+              , show a+              , "'encode' encoded it to the persist"+              , show encoded+              ]

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

@@ -0,0 +1,18 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.PersistSpec where++import Test.Hspec++-- import Numeric.Natural+import Data.GenValidity+import Test.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+  -- persistSpecOnValid @Natural -- DOES NOT HOLD