genvalidity-hspec-optics (empty) → 0.0.0.0
raw patch · 7 files changed
+321/−0 lines, 7 filesdep +QuickCheckdep +basedep +doctestsetup-changed
Dependencies added: QuickCheck, base, doctest, genvalidity, genvalidity-hspec, genvalidity-hspec-optics, hspec, microlens
Files
- LICENSE +21/−0
- Setup.hs +3/−0
- doctest/DocTest.hs +4/−0
- genvalidity-hspec-optics.cabal +75/−0
- src/Test/Validity/Optics.hs +163/−0
- test/Spec.hs +1/−0
- test/Test/Validity/OpticsSpec.hs +54/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2016 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.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ doctest/DocTest.hs view
@@ -0,0 +1,4 @@+import Test.DocTest++main :: IO ()+main = doctest ["-isrc", "src", "-XTypeApplications"]
+ genvalidity-hspec-optics.cabal view
@@ -0,0 +1,75 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: ecb9b0d1832fdff54efd2e5d6f1c72a9329c9bbdc19155ebd06520044b80dbee++name: genvalidity-hspec-optics+version: 0.0.0.0+synopsis: Standard spec's for optics+description: Standard spec's for optics+category: Testing+homepage: http://cs-syd.eu+bug-reports: https://github.com/NorfairKing/validity/issues+author: Tom Sydney Kerckhove+maintainer: syd.kerckhove@gmail.com,+ nick.van.den.broeck666@gmail.com+copyright: Copyright: (c) 2018 Tom Sydney Kerckhove+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++source-repository head+ type: git+ location: https://github.com/NorfairKing/validity++library+ exposed-modules:+ Test.Validity.Optics+ other-modules:+ Paths_genvalidity_hspec_optics+ hs-source-dirs:+ src/+ ghc-options: -Wall+ build-depends:+ QuickCheck+ , base >=4.9 && <=5+ , genvalidity >=0.5+ , genvalidity-hspec+ , hspec+ , microlens+ default-language: Haskell2010++test-suite genvalidity-hspec-optics-doctests+ type: exitcode-stdio-1.0+ main-is: DocTest.hs+ other-modules:+ Paths_genvalidity_hspec_optics+ hs-source-dirs:+ doctest+ ghc-options: -threaded+ build-depends:+ base+ , doctest+ , genvalidity-hspec-optics+ , hspec+ default-language: Haskell2010++test-suite genvalidity-hspec-optics-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Test.Validity.OpticsSpec+ Paths_genvalidity_hspec_optics+ hs-source-dirs:+ test/+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ build-depends:+ base+ , genvalidity+ , genvalidity-hspec+ , genvalidity-hspec-optics+ , hspec+ , microlens+ default-language: Haskell2010
+ src/Test/Validity/Optics.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- | Standard test `Spec`s for optics+--+-- You will need @TypeApplications@ to use these.+module Test.Validity.Optics+ ( lensSpecOnValid+ , lensSpec+ , lensSpecOnArbitrary+ , lensSpecOnGen+ , lensLaw1+ , lensLaw2+ , lensLaw3+ ) where++import Lens.Micro+import Lens.Micro.Extras++import Data.GenValidity++import Test.Hspec+import Test.QuickCheck+import Test.Validity.Utils++-- | Standard test spec for properties lenses for valid values+--+-- Example usage:+--+-- lensSpecOnValid ((_2) :: Lens (Double, Double) (Double, Double) Double Double)+lensSpecOnValid ::+ forall s b. (Show b, Eq b, GenValid b, Show s, Eq s, GenValid s)+ => Lens s s b b+ -> Spec+lensSpecOnValid l =+ lensSpecOnGen+ l+ (genValid @b)+ "valid values"+ shrinkValid+ (genValid @s)+ "valid values"+ shrinkValid++-- | Standard test spec for properties lenses for unchecked values+--+-- Example usage:+--+-- lensSpec ((_2) :: Lens (Int, Int) (Int, Int) Int Int)+lensSpec ::+ forall s b. (Show b, Eq b, GenUnchecked b, Show s, Eq s, GenUnchecked s)+ => Lens s s b b+ -> Spec+lensSpec l =+ lensSpecOnGen+ l+ (genUnchecked @b)+ "unchecked values"+ shrinkUnchecked+ (genUnchecked @s)+ "unchecked values"+ shrinkUnchecked++-- | Standard test spec for properties lenses for arbitrary values+--+-- Example usage:+--+-- lensSpecOnArbitrary ((_2) :: Lens (Double, Double) (Double, Double) Double Double)+lensSpecOnArbitrary ::+ forall s b. (Show b, Eq b, Arbitrary b, Show s, Eq s, Arbitrary s)+ => Lens s s b b+ -> Spec+lensSpecOnArbitrary l =+ lensSpecOnGen+ l+ (arbitrary @b)+ "arbitrary values"+ shrink+ (arbitrary @s)+ "arbitrary values"+ shrink++-- | Standard test spec for properties lenses for values generated by given generators+--+-- Example usage:+--+-- > lensSpecOnGen+-- > ((_2) :: Lens (Double, Double) (Double, Double) Double Double)+-- > (abs <$> genValid)+-- > "positive valid doubles"+-- > (filter (0.0 >=) . shrinkValid)+-- > ((,) <$> (negate . abs <$> genValid) <*> (negate . abs <$> genValid))+-- > "tuples of negative valid doubles"+-- > (const [])+lensSpecOnGen ::+ (Show b, Eq b, Show s, Eq s)+ => Lens s s b b+ -> Gen b+ -> String+ -> (b -> [b])+ -> Gen s+ -> String+ -> (s -> [s])+ -> Spec+lensSpecOnGen l genB genBName shrinkB genS genSName shrinkS = do+ parallel $ do+ it+ (unwords+ ["satisfies the first lens law for", genBName, "and", genSName]) $+ lensLaw1 l genB shrinkB genS shrinkS+ it (unwords ["satisfies the second lens law for", genSName]) $+ lensLaw2 l genS shrinkS+ it+ (unwords+ ["satisfies the third lens law for", genBName, "and", genSName]) $+ lensLaw3 l genB shrinkB genS shrinkS++-- | A property combinator for the first lens law:+--+-- > view l (set l v s) ≡ v+--+-- prop> lensLaw1 ((_2) :: Lens (Double, Double) (Double, Double) Double Double) genValid shrinkValid genValid shrinkValid+lensLaw1 ::+ (Show b, Eq b, Show s)+ => Lens s s b b+ -> Gen b+ -> (b -> [b])+ -> Gen s+ -> (s -> [s])+ -> Property+lensLaw1 l genB shrinkB genS shrinkS =+ forAllShrink genB shrinkB $ \b ->+ forAllShrink genS shrinkS $ \s -> view l (set l b s) `shouldBe` b++-- | A property combinator for the second lens law:+--+-- > set l (view l s) s ≡ s+--+-- prop> lensLaw2 ((_2) :: Lens (Double, Double) (Double, Double) Double Double) genValid shrinkValid+lensLaw2 :: (Show s, Eq s) => Lens s s b b -> Gen s -> (s -> [s]) -> Property+lensLaw2 l genS shrinkS =+ forAllShrink genS shrinkS $ \s -> set l (view l s) s `shouldBe` s++-- | A property combinator for the third lens law:+--+-- > set l v' (set l v s) ≡ set l v' s+--+-- prop> lensLaw3 ((_2) :: Lens (Double, Double) (Double, Double) Double Double) genValid shrinkValid genValid shrinkValid+lensLaw3 ::+ (Show b, Eq b, Show s, Eq s)+ => Lens s s a b+ -> Gen b+ -> (b -> [b])+ -> Gen s+ -> (s -> [s])+ -> Property+lensLaw3 l genB shrinkB genS shrinkS =+ forAllShrink genB shrinkB $ \b ->+ forAllShrink genB shrinkB $ \b' ->+ forAllShrink genS shrinkS $ \s ->+ set l b' (set l b s) `shouldBe` set l b' s
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/Test/Validity/OpticsSpec.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module Test.Validity.OpticsSpec where++import GHC.Generics (Generic)++import Test.Hspec++import Test.Validity+import Test.Validity.Optics++import Lens.Micro++spec :: Spec+spec = do+ describe "lensSpecOnValid" $+ lensSpecOnValid+ ((_2) :: Lens (Double, Double) (Double, Double) Double Double)+ describe "lensSpec" $ lensSpec ((_2) :: Lens (Int, Int) (Int, Int) Int Int)+ describe "lensSpecOnArbitrary" $+ lensSpecOnArbitrary+ ((_2) :: Lens (Double, Double) (Double, Double) Double Double)+ describe "lensSpecOnGen" $+ lensSpecOnGen+ ((_2) :: Lens (Double, Double) (Double, Double) Double Double)+ (abs <$> genValid)+ "positive valid doubles"+ (filter (0.0 >=) . shrinkValid)+ ((,) <$> (negate . abs <$> genValid) <*> (negate . abs <$> genValid))+ "tuples of negative valid doubles"+ (const [])+ describe "myBoolLens" $+ lensSpec myBoolLens -- For any unchecked value, prefer this version if you can.+ describe "myRationalLens" $+ lensSpecOnValid myRationalLens -- Only for valid values++data MyRecord = MyRecord+ { myBool :: Bool+ , myRational :: Rational+ } deriving (Show, Eq, Generic)++instance Validity MyRecord++instance GenUnchecked MyRecord++instance GenValid MyRecord++myBoolLens :: Lens' MyRecord Bool+myBoolLens = lens myBool $ \mr b -> mr {myBool = b}++myRationalLens :: Lens' MyRecord Rational+myRationalLens = lens myRational $ \mr r -> mr {myRational = r}