{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
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
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
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
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
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
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
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
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