{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Test.Validity.Optics
( lensSpec,
lensSpecOnArbitrary,
lensSpecOnGen,
lensLaw1,
lensLaw2,
lensLaw3,
lensGettingProducesValid,
lensGettingProducesValidOnArbitrary,
lensGettingProducesValidOnGen,
lensSettingProducesValid,
lensSettingProducesValidOnArbitrary,
lensSettingProducesValidOnGen,
)
where
import Data.GenValidity
import Lens.Micro
import Lens.Micro.Extras
import Test.Hspec
import Test.QuickCheck
import Test.Validity.Utils
lensSpec ::
forall s b.
( Show b,
Eq b,
GenValid b,
Show s,
Eq s,
GenValid s
) =>
Lens s s b b ->
Spec
lensSpec :: Lens s s b b -> Spec
lensSpec Lens s s b b
l =
Lens s s b b
-> Gen b
-> String
-> (b -> [b])
-> Gen s
-> String
-> (s -> [s])
-> Spec
forall b s.
(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
Lens s s b b
l
(GenValid b => Gen b
forall a. GenValid a => Gen a
genValid @b)
String
"valid values"
b -> [b]
forall a. GenValid a => a -> [a]
shrinkValid
(GenValid s => Gen s
forall a. GenValid a => Gen a
genValid @s)
String
"valid values"
s -> [s]
forall a. GenValid a => a -> [a]
shrinkValid
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 :: Lens s s b b -> Spec
lensSpecOnArbitrary Lens s s b b
l =
Lens s s b b
-> Gen b
-> String
-> (b -> [b])
-> Gen s
-> String
-> (s -> [s])
-> Spec
forall b s.
(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
Lens s s b b
l
(Arbitrary b => Gen b
forall a. Arbitrary a => Gen a
arbitrary @b)
String
"arbitrary values"
b -> [b]
forall a. Arbitrary a => a -> [a]
shrink
(Arbitrary s => Gen s
forall a. Arbitrary a => Gen a
arbitrary @s)
String
"arbitrary values"
s -> [s]
forall a. Arbitrary a => a -> [a]
shrink
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 :: Lens s s b b
-> Gen b
-> String
-> (b -> [b])
-> Gen s
-> String
-> (s -> [s])
-> Spec
lensSpecOnGen Lens s s b b
l Gen b
genB String
genBName b -> [b]
shrinkB Gen s
genS String
genSName s -> [s]
shrinkS = do
Spec -> Spec
forall a. SpecWith a -> SpecWith a
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
( [String] -> String
unwords
[String
"satisfies the first lens law for", String
genBName, String
"and", String
genSName]
)
(Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ Lens s s b b
-> Gen b -> (b -> [b]) -> Gen s -> (s -> [s]) -> Property
forall b s.
(Show b, Eq b, Show s) =>
Lens s s b b
-> Gen b -> (b -> [b]) -> Gen s -> (s -> [s]) -> Property
lensLaw1 Lens s s b b
l Gen b
genB b -> [b]
shrinkB Gen s
genS s -> [s]
shrinkS
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it ([String] -> String
unwords [String
"satisfies the second lens law for", String
genSName]) (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
Lens s s b b -> Gen s -> (s -> [s]) -> Property
forall s b.
(Show s, Eq s) =>
Lens s s b b -> Gen s -> (s -> [s]) -> Property
lensLaw2 Lens s s b b
l Gen s
genS s -> [s]
shrinkS
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
( [String] -> String
unwords
[String
"satisfies the third lens law for", String
genBName, String
"and", String
genSName]
)
(Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ Lens s s b b
-> Gen b -> (b -> [b]) -> Gen s -> (s -> [s]) -> Property
forall b s a.
(Show b, Show s, Eq s) =>
Lens s s a b
-> Gen b -> (b -> [b]) -> Gen s -> (s -> [s]) -> Property
lensLaw3 Lens s s b b
l Gen b
genB b -> [b]
shrinkB Gen s
genS s -> [s]
shrinkS
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it ([String] -> String
unwords [String
"gets valid values from", String
genSName, String
"values"]) (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
Lens s s b b -> Gen s -> (s -> [s]) -> Property
forall b s.
(Validity b, Show b, Show s) =>
Lens s s b b -> Gen s -> (s -> [s]) -> Property
lensGettingProducesValidOnGen Lens s s b b
l Gen s
genS s -> [s]
shrinkS
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
( [String] -> String
unwords
[ String
"produces valid values when it is used to set",
String
genBName,
String
"values on",
String
genSName,
String
"values"
]
)
(Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ Lens s s b b
-> Gen b -> (b -> [b]) -> Gen s -> (s -> [s]) -> Property
forall s b t a.
(Show s, Show b, Show t, Validity t) =>
Lens s t a b
-> Gen b -> (b -> [b]) -> Gen s -> (s -> [s]) -> Property
lensSettingProducesValidOnGen Lens s s b b
l Gen b
genB b -> [b]
shrinkB Gen s
genS s -> [s]
shrinkS
lensLaw1 ::
(Show b, Eq b, Show s) =>
Lens s s b b ->
Gen b ->
(b -> [b]) ->
Gen s ->
(s -> [s]) ->
Property
lensLaw1 :: Lens s s b b
-> Gen b -> (b -> [b]) -> Gen s -> (s -> [s]) -> Property
lensLaw1 Lens s s b b
l Gen b
genB b -> [b]
shrinkB Gen s
genS s -> [s]
shrinkS =
Gen b -> (b -> [b]) -> (b -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen b
genB b -> [b]
shrinkB ((b -> Property) -> Property) -> (b -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \b
b ->
Gen s -> (s -> [s]) -> (s -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen s
genS s -> [s]
shrinkS ((s -> Expectation) -> Property) -> (s -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \s
s -> Getting b s b -> s -> b
forall a s. Getting a s a -> s -> a
view Getting b s b
Lens s s b b
l (ASetter s s b b -> b -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s s b b
Lens s s b b
l b
b s
s) b -> b -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` b
b
lensLaw2 :: (Show s, Eq s) => Lens s s b b -> Gen s -> (s -> [s]) -> Property
lensLaw2 :: Lens s s b b -> Gen s -> (s -> [s]) -> Property
lensLaw2 Lens s s b b
l Gen s
genS s -> [s]
shrinkS =
Gen s -> (s -> [s]) -> (s -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen s
genS s -> [s]
shrinkS ((s -> Expectation) -> Property) -> (s -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \s
s -> ASetter s s b b -> b -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s s b b
Lens s s b b
l (Getting b s b -> s -> b
forall a s. Getting a s a -> s -> a
view Getting b s b
Lens s s b b
l s
s) s
s s -> s -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` s
s
lensLaw3 ::
(Show b, Show s, Eq s) =>
Lens s s a b ->
Gen b ->
(b -> [b]) ->
Gen s ->
(s -> [s]) ->
Property
lensLaw3 :: Lens s s a b
-> Gen b -> (b -> [b]) -> Gen s -> (s -> [s]) -> Property
lensLaw3 Lens s s a b
l Gen b
genB b -> [b]
shrinkB Gen s
genS s -> [s]
shrinkS =
Gen b -> (b -> [b]) -> (b -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen b
genB b -> [b]
shrinkB ((b -> Property) -> Property) -> (b -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \b
b ->
Gen b -> (b -> [b]) -> (b -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen b
genB b -> [b]
shrinkB ((b -> Property) -> Property) -> (b -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \b
b' ->
Gen s -> (s -> [s]) -> (s -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen s
genS s -> [s]
shrinkS ((s -> Expectation) -> Property) -> (s -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \s
s ->
ASetter s s a b -> b -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s s a b
Lens s s a b
l b
b' (ASetter s s a b -> b -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s s a b
Lens s s a b
l b
b s
s) s -> s -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` ASetter s s a b -> b -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s s a b
Lens s s a b
l b
b' s
s
lensGettingProducesValid ::
(Show s, GenValid s, Show b, Validity b) => Lens s s b b -> Property
lensGettingProducesValid :: Lens s s b b -> Property
lensGettingProducesValid Lens s s b b
l =
Lens s s b b -> Gen s -> (s -> [s]) -> Property
forall b s.
(Validity b, Show b, Show s) =>
Lens s s b b -> Gen s -> (s -> [s]) -> Property
lensGettingProducesValidOnGen Lens s s b b
l Gen s
forall a. GenValid a => Gen a
genValid s -> [s]
forall a. GenValid a => a -> [a]
shrinkValid
lensGettingProducesValidOnArbitrary ::
(Show s, Arbitrary s, Show b, Validity b) =>
Lens s s b b ->
Property
lensGettingProducesValidOnArbitrary :: Lens s s b b -> Property
lensGettingProducesValidOnArbitrary Lens s s b b
l =
Lens s s b b -> Gen s -> (s -> [s]) -> Property
forall b s.
(Validity b, Show b, Show s) =>
Lens s s b b -> Gen s -> (s -> [s]) -> Property
lensGettingProducesValidOnGen Lens s s b b
l Gen s
forall a. Arbitrary a => Gen a
arbitrary s -> [s]
forall a. Arbitrary a => a -> [a]
shrink
lensGettingProducesValidOnGen ::
(Validity b, Show b, Show s) =>
Lens s s b b ->
Gen s ->
(s -> [s]) ->
Property
lensGettingProducesValidOnGen :: Lens s s b b -> Gen s -> (s -> [s]) -> Property
lensGettingProducesValidOnGen Lens s s b b
l Gen s
genS s -> [s]
shrinkS =
Gen s -> (s -> [s]) -> (s -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen s
genS s -> [s]
shrinkS ((s -> Expectation) -> Property) -> (s -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \s
s -> b -> Expectation
forall a. (Show a, Validity a) => a -> Expectation
shouldBeValid (b -> Expectation) -> b -> Expectation
forall a b. (a -> b) -> a -> b
$ Getting b s b -> s -> b
forall a s. Getting a s a -> s -> a
view Getting b s b
Lens s s b b
l s
s
lensSettingProducesValid ::
(Show s, GenValid s, Show b, GenValid b, Show t, Validity t) =>
Lens s t a b ->
Property
lensSettingProducesValid :: Lens s t a b -> Property
lensSettingProducesValid Lens s t a b
l =
Lens s t a b
-> Gen b -> (b -> [b]) -> Gen s -> (s -> [s]) -> Property
forall s b t a.
(Show s, Show b, Show t, Validity t) =>
Lens s t a b
-> Gen b -> (b -> [b]) -> Gen s -> (s -> [s]) -> Property
lensSettingProducesValidOnGen
Lens s t a b
l
Gen b
forall a. GenValid a => Gen a
genValid
b -> [b]
forall a. GenValid a => a -> [a]
shrinkValid
Gen s
forall a. GenValid a => Gen a
genValid
s -> [s]
forall a. GenValid a => a -> [a]
shrinkValid
lensSettingProducesValidOnArbitrary ::
(Show s, Arbitrary s, Show b, Arbitrary b, Show t, Validity t) =>
Lens s t a b ->
Property
lensSettingProducesValidOnArbitrary :: Lens s t a b -> Property
lensSettingProducesValidOnArbitrary Lens s t a b
l =
Lens s t a b
-> Gen b -> (b -> [b]) -> Gen s -> (s -> [s]) -> Property
forall s b t a.
(Show s, Show b, Show t, Validity t) =>
Lens s t a b
-> Gen b -> (b -> [b]) -> Gen s -> (s -> [s]) -> Property
lensSettingProducesValidOnGen Lens s t a b
l Gen b
forall a. Arbitrary a => Gen a
arbitrary b -> [b]
forall a. Arbitrary a => a -> [a]
shrink Gen s
forall a. Arbitrary a => Gen a
arbitrary s -> [s]
forall a. Arbitrary a => a -> [a]
shrink
lensSettingProducesValidOnGen ::
(Show s, Show b, Show t, Validity t) =>
Lens s t a b ->
Gen b ->
(b -> [b]) ->
Gen s ->
(s -> [s]) ->
Property
lensSettingProducesValidOnGen :: Lens s t a b
-> Gen b -> (b -> [b]) -> Gen s -> (s -> [s]) -> Property
lensSettingProducesValidOnGen Lens s t a b
l Gen b
genB b -> [b]
shrinkB Gen s
genS s -> [s]
shrinkS =
Gen s -> (s -> [s]) -> (s -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen s
genS s -> [s]
shrinkS ((s -> Property) -> Property) -> (s -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \s
s ->
Gen b -> (b -> [b]) -> (b -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen b
genB b -> [b]
shrinkB ((b -> Expectation) -> Property) -> (b -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \b
b -> t -> Expectation
forall a. (Show a, Validity a) => a -> Expectation
shouldBeValid (t -> Expectation) -> t -> Expectation
forall a b. (a -> b) -> a -> b
$ ASetter s t a b -> b -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s t a b
Lens s t a b
l b
b s
s