{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
-- | Standard test `Spec`s for optics
module Test.Validity.Optics
( lensSpecOnValid
, lensSpec
, lensSpecOnArbitrary
, lensSpecOnGen
, lensLaw1
, lensLaw2
, lensLaw3
, lensGettingProducesValidOnValid
, lensGettingProducesValid
, lensGettingProducesValidOnArbitrary
, lensGettingProducesValidOnGen
, lensSettingProducesValidOnValid
, lensSettingProducesValid
, lensSettingProducesValidOnArbitrary
, lensSettingProducesValidOnGen
) 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 (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, 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
-- | 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