packages feed

genvalidity-sydtest-lens (empty) → 0.0.0.0

raw patch · 5 files changed

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

Dependencies added: QuickCheck, base, genvalidity, genvalidity-sydtest, genvalidity-sydtest-lens, microlens, sydtest, 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-lens.cabal view
@@ -0,0 +1,61 @@+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-lens+version:        0.0.0.0+synopsis:       Standard spec's for lens for sydtest+description:    Standard spec's for lens (van Laarhoven encoding)+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.Lens+  other-modules:+      Paths_genvalidity_sydtest_lens+  hs-source-dirs:+      src/+  ghc-options: -Wall+  build-depends:+      QuickCheck+    , base >=4.9 && <=5+    , genvalidity >=0.5+    , genvalidity-sydtest+    , microlens+    , sydtest+  default-language: Haskell2010++test-suite genvalidity-sydtest-optics-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Test.Syd.Validity.LensSpec+      Paths_genvalidity_sydtest_lens+  hs-source-dirs:+      test/+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  build-tool-depends:+      sydtest-discover:sydtest-discover+  build-depends:+      base+    , genvalidity >=0.7+    , genvalidity-sydtest+    , genvalidity-sydtest-lens+    , microlens+    , sydtest+    , validity >=0.9+  default-language: Haskell2010
+ src/Test/Syd/Validity/Lens.hs view
@@ -0,0 +1,315 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- | Standard test `Spec`s for optics+module Test.Syd.Validity.Lens+  ( lensSpecOnValid,+    lensSpec,+    lensSpecOnArbitrary,+    lensSpecOnGen,+    lensLaw1,+    lensLaw2,+    lensLaw3,+    lensGettingProducesValidOnValid,+    lensGettingProducesValid,+    lensGettingProducesValidOnArbitrary,+    lensGettingProducesValidOnGen,+    lensSettingProducesValidOnValid,+    lensSettingProducesValid,+    lensSettingProducesValidOnArbitrary,+    lensSettingProducesValidOnGen,+  )+where++import Data.GenValidity+import Lens.Micro+import Lens.Micro.Extras+import Test.QuickCheck+import Test.Syd+import Test.Syd.Validity.Utils++-- | Standard test spec for properties lenses for valid values+--+-- Example usage:+--+-- > lensSpecOnValid ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational)+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,+    Validity b,+    Show s,+    Eq s,+    GenUnchecked s,+    Validity 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 (Rational, Rational) (Rational, Rational) Rational Rational)+lensSpecOnArbitrary ::+  forall s b.+  ( Show b,+    Eq b,+    Arbitrary b,+    Validity b,+    Show s,+    Eq s,+    Arbitrary s,+    Validity 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 (Rational, Rational) (Rational, Rational) Rational Rational)+-- >      (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, Validity b, Show s, Eq s, Validity 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+    it (unwords ["gets valid values from", genSName, "values"]) $+      lensGettingProducesValidOnGen l genS shrinkS+    it+      ( unwords+          [ "produces valid values when it is used to set",+            genBName,+            "values on",+            genSName,+            "values"+          ]+      )+      $ lensSettingProducesValidOnGen l genB shrinkB genS shrinkS++-- | A property combinator for the first lens law:+--+-- > view l (set l v s)  ≡ v+--+-- Example usage:+--+-- prop> lensLaw1 ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational) 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+--+-- Example usage:+--+-- prop> lensLaw2 ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational) 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+--+-- Example usage:+--+-- prop> lensLaw3 ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational) genValid shrinkValid genValid shrinkValid+lensLaw3 ::+  (Show 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++-- | A property combinator to test whether getting values via a lens on valid values produces valid values.+--+-- Example Usage:+--+-- prop> lensGettingProducesValidOnValid ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational)+lensGettingProducesValidOnValid ::+  (Show s, GenValid s, Show b, GenValid b) => Lens s s b b -> Property+lensGettingProducesValidOnValid l =+  lensGettingProducesValidOnGen l genValid shrinkValid++-- | A property combinator to test whether getting values via a lens on unchecked values produces valid values.+--+-- Example Usage:+--+-- prop> lensGettingProducesValid ((_2) :: Lens (Int, Int) (Int, Int) Int Int)+lensGettingProducesValid ::+  (Show s, GenUnchecked s, Show b, Validity b) => Lens s s b b -> Property+lensGettingProducesValid l =+  lensGettingProducesValidOnGen l genUnchecked shrinkUnchecked++-- | A property combinator to test whether getting values via a lens on arbitrary values produces valid values.+--+-- Example Usage:+--+-- prop> lensGettingProducesValidOnArbitrary ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational)+lensGettingProducesValidOnArbitrary ::+  (Show s, Arbitrary s, Show b, Validity b) =>+  Lens s s b b ->+  Property+lensGettingProducesValidOnArbitrary l =+  lensGettingProducesValidOnGen l arbitrary shrink++-- | A property combinator to test whether getting values generated by given a generator via a lens on values generated by a given generator produces valid values.+--+-- > isValid (view l s)+--+-- Example Usage:+--+-- prop> lensGettingProducesValidOnGen ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational) genValid shrinkValid+lensGettingProducesValidOnGen ::+  (Validity b, Show b, Show s) =>+  Lens s s b b ->+  Gen s ->+  (s -> [s]) ->+  Property+lensGettingProducesValidOnGen l genS shrinkS =+  forAllShrink genS shrinkS $ \s -> shouldBeValid $ view l s++-- | A property combinator to test whether setting valid values via a lens on valid values produces valid values.+--+-- Example usage:+--+-- prop> lensSettingProducesValidOnValid ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational)+lensSettingProducesValidOnValid ::+  (Show s, GenValid s, Show b, GenValid b, Show t, Validity t) =>+  Lens s t a b ->+  Property+lensSettingProducesValidOnValid l =+  lensSettingProducesValidOnGen l genValid shrinkValid genValid shrinkValid++-- | A property combinator to test whether setting unchecked values via a lens on unchecked values produces valid values.+--+-- Example usage:+--+-- prop> lensSettingProducesValid ((_2) :: Lens (Int, Int) (Int, Int) Int Int)+lensSettingProducesValid ::+  (Show s, GenUnchecked s, Show b, GenUnchecked b, Show t, Validity t) =>+  Lens s t a b ->+  Property+lensSettingProducesValid l =+  lensSettingProducesValidOnGen+    l+    genUnchecked+    shrinkUnchecked+    genUnchecked+    shrinkUnchecked++-- | A property combinator to test whether setting arbitrary values via a lens on arbitrary values produces valid values.+--+-- Example usage:+--+-- prop> lensSettingProducesValidOnArbitrary ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational)+lensSettingProducesValidOnArbitrary ::+  (Show s, Arbitrary s, Show b, Arbitrary b, Show t, Validity t) =>+  Lens s t a b ->+  Property+lensSettingProducesValidOnArbitrary l =+  lensSettingProducesValidOnGen l arbitrary shrink arbitrary shrink++-- | A property combinator to test whether setting values generated by given a generator via a lens on values generated by a given generator produces valid values.+--+-- > isValid (set l b s)+--+-- Example usage:+--+-- prop> lensSettingProducesValidOnGen ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational) genValid shrinkValid genValid shrinkValid+lensSettingProducesValidOnGen ::+  (Show s, Show b, Show t, Validity t) =>+  Lens s t a b ->+  Gen b ->+  (b -> [b]) ->+  Gen s ->+  (s -> [s]) ->+  Property+lensSettingProducesValidOnGen l genB shrinkB genS shrinkS =+  forAllShrink genS shrinkS $ \s ->+    forAllShrink genB shrinkB $ \b -> shouldBeValid $ set l b s
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF sydtest-discover #-}
+ test/Test/Syd/Validity/LensSpec.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Test.Syd.Validity.LensSpec where++import GHC.Generics (Generic)+import Lens.Micro+import Test.Syd+import Test.Syd.Validity+import Test.Syd.Validity.Lens++spec :: Spec+spec = do+  describe "lensSpecOnValid" $+    lensSpecOnValid+      ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational)+  describe "lensSpec" $ lensSpec ((_2) :: Lens (Int, Int) (Int, Int) Int Int)+  describe "lensSpecOnArbitrary" $+    lensSpecOnArbitrary+      ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational)+  describe "lensSpecOnGen" $+    lensSpecOnGen+      ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational)+      (abs <$> genValid)+      "positive valid doubles"+      (filter (0.0 >=) . shrinkValid)+      ((,) <$> (negate . abs <$> genValid) <*> (negate . abs <$> genValid))+      "tuples of negative valid doubles"+      (const [])+  describe "lensGettingProducesValidOnValid" $+    it "holds for (_2) for doubles" $+      lensGettingProducesValidOnValid+        ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational)+  describe "lensGettingProducesValid" $+    it "holds for (_2) for ints" $+      lensGettingProducesValid ((_2) :: Lens (Int, Int) (Int, Int) Int Int)+  describe "lensGettingProducesValidOnArbitrary" $+    it "holds for (_2) for doubles" $+      lensGettingProducesValidOnArbitrary+        ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational)+  describe "lensGettingProducesValidOnGen" $+    it "holds for (_2) for special generators" $+      lensGettingProducesValidOnGen+        ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational)+        ((,) <$> (negate . abs <$> genValid) <*> (negate . abs <$> genValid))+        (const [])+  describe "lensSettingProducesValidOnValid" $+    it "holds for (_2) for doubles" $+      lensSettingProducesValidOnValid+        ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational)+  describe "lensSettingProducesValid" $+    it "holds for (_2) for ints" $+      lensSettingProducesValid ((_2) :: Lens (Int, Int) (Int, Int) Int Int)+  describe "lensSettingProducesValidOnArbitrary" $+    it "holds for (_2) for doubles" $+      lensSettingProducesValidOnArbitrary+        ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational)+  describe "lensSettingProducesValidOnGen" $+    it "holds for (_2) for special generators" $+      lensSettingProducesValidOnGen+        ((_2) :: Lens (Rational, Rational) (Rational, Rational) Rational Rational)+        (abs <$> genValid)+        (filter (0.0 >=) . shrinkValid)+        ((,) <$> (negate . abs <$> genValid) <*> (negate . abs <$> genValid))+        (const [])+  describe "myBoolLens" $+    lensSpecOnValid myBoolLens+  describe "myRationalLens" $+    lensSpecOnValid myRationalLens++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}