hedgehog-optics 1.0.0 → 1.0.0.1
raw patch · 3 files changed
+97/−64 lines, 3 filesdep ~basedep ~hedgehogPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, hedgehog
API changes (from Hackage documentation)
Files
- changelog.txt +2/−0
- hedgehog-optics.cabal +3/−1
- src/Hedgehog/Optics.hs +92/−63
+ changelog.txt view
@@ -0,0 +1,2 @@+1.0.0 - Initial release+1.0.0.1 - Employ Hedgehog's 'annotate' function for better error output
hedgehog-optics.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 name: hedgehog-optics-version: 1.0.0+version: 1.0.0.1 category: Testing, Optics synopsis:@@ -21,6 +21,8 @@ bug-reports: https://github.com/typeclasses/hedgehog-optics/issues build-type: Simple++extra-source-files: changelog.txt source-repository head type: git
src/Hedgehog/Optics.hs view
@@ -1,12 +1,14 @@-module Hedgehog.Optics where+module Hedgehog.Optics+ ( wellFormedPrism, wellFormedLens, wellFormedIso+ , prismExample+ ) where -import Control.Applicative (Applicative ((*>))) import Control.Monad (Monad (return)) import Data.Either (Either (Left, Right)) import Data.Eq (Eq) import Data.Function ((.)) import Data.Maybe (Maybe (Just))-import Hedgehog (Gen, PropertyT, forAll, (===))+import Hedgehog (Gen, PropertyT, annotate, forAll, (===)) import Optics.AffineFold (preview) import Optics.AffineTraversal (matching) import Optics.Getter (view)@@ -19,88 +21,115 @@ {- | Checks whether a prism respects the well-formedness laws given in "Optics.Prism" -}-wellFormedPrism ::- Monad m =>- (Show large, Eq large) =>- (Show small, Eq small) =>-- Gen large- -> Gen small+wellFormedPrism :: Monad m => (Show large, Eq large) =>+ (Show small, Eq small) =>+ Gen large -> Gen small -> Prism' large small {- ^ Prism signifying that the @small@ type is a subset of the @large@ type -} -> PropertyT m ()+wellFormedPrism genLarge genSmall o =+ do+ getSetPrismLaw genLarge o+ setGetPrismLaw genSmall o -wellFormedPrism genLarge genSmall o = part1 *> part2- where- part1 =- do- large <- forAll genLarge- case matching o large of- Right small -> review o small === large- Left _ -> return ()+getSetPrismLaw :: Monad m => (Show large, Eq large) =>+ (Show small, Eq small) =>+ Gen large -> Prism' large small -> PropertyT m ()+getSetPrismLaw genLarge o =+ do+ large <- forAll genLarge+ case matching o large of+ Right small ->+ do+ annotate "The get-set law must hold for a Prism"+ review o small === large+ Left _ -> return () - part2 =- do- small <- forAll genSmall- matching o (review o small) === Right small+setGetPrismLaw :: Monad m => (Show large, Eq large) =>+ (Show small, Eq small) =>+ Gen small -> Prism' large small -> PropertyT m ()+setGetPrismLaw genSmall o =+ do+ small <- forAll genSmall+ annotate "The set-get law must hold for a Prism"+ matching o (review o small) === Right small {- | Checks whether a lens respects the well-formedness laws given in "Optics.Lens" -}-wellFormedLens ::- Monad m =>- (Show large, Eq large) =>- (Show small, Eq small) =>-- Gen large- -> Gen small+wellFormedLens :: Monad m => (Show large, Eq large) =>+ (Show small, Eq small) =>+ Gen large -> Gen small -> Lens' large small {- ^ Lens signifying that the @small@ type is a constituent part of the @large@ type -} -> PropertyT m ()+wellFormedLens genLarge genSmall o =+ do+ getPutLensLaw genLarge genSmall o+ putGetLensLaw genLarge o+ putPutLensLaw genLarge genSmall o -wellFormedLens genLarge genSmall o = getPut *> putGet *> putPut- where- getPut =- do- large <- forAll genLarge- small <- forAll genSmall- view o (set o small large) === small+getPutLensLaw :: Monad m => (Show large, Eq large) =>+ (Show small, Eq small) =>+ Gen large -> Gen small -> Lens' large small+ -> PropertyT m ()+getPutLensLaw genLarge genSmall o =+ do+ large <- forAll genLarge+ small <- forAll genSmall+ annotate "The set-get law must hold for a Lens"+ view o (set o small large) === small - putGet =- do- large <- forAll genLarge- set o (view o large) large === large+putGetLensLaw :: Monad m => (Show large, Eq large) =>+ (Show small, Eq small) =>+ Gen large -> Lens' large small -> PropertyT m ()+putGetLensLaw genLarge o =+ do+ large <- forAll genLarge+ annotate "The get-set law must hold for a Lens"+ set o (view o large) large === large - putPut =- do- large <- forAll genLarge- small1 <- forAll genSmall- small2 <- forAll genSmall- set o small2 (set o small1 large) === set o small2 large+putPutLensLaw :: Monad m => (Show large, Eq large) =>+ (Show small, Eq small) =>+ Gen large -> Gen small -> Lens' large small+ -> PropertyT m ()+putPutLensLaw genLarge genSmall o =+ do+ large <- forAll genLarge+ small1 <- forAll genSmall+ small2 <- forAll genSmall+ annotate "The set-set law must hold for a Lens"+ set o small2 (set o small1 large) === set o small2 large {- | Checks whether an isomorphism respects the well-formedness laws given in "Optics.Iso" -}-wellFormedIso ::- Monad m =>- (Show a, Eq a) =>- (Show b, Eq b) =>-- Gen a- -> Gen b+wellFormedIso :: Monad m => (Show a, Eq a) =>+ (Show b, Eq b) =>+ Gen a -> Gen b -> Iso' a b {- ^ Isomorphism signifying that types @a@ and @b@ are basically the same thing -} -> PropertyT m ()+wellFormedIso genA genB o =+ do+ setGetIsoLaw genB o+ getSetIsoLaw genA o -wellFormedIso genA genB o = part1 *> part2- where- part1 =- do- b <- forAll genB- (view o . review o) b === b+setGetIsoLaw :: Monad m => (Show a, Eq a) =>+ (Show b, Eq b) =>+ Gen b -> Iso' a b -> PropertyT m ()+setGetIsoLaw genB o =+ do+ b <- forAll genB+ annotate "The set-get law must hold for an Iso"+ (view o . review o) b === b - part2 =- do- a <- forAll genA- (review o . view o) a === a+getSetIsoLaw :: Monad m => (Show a, Eq a) =>+ (Show b, Eq b) =>+ Gen a -> Iso' a b -> PropertyT m ()+getSetIsoLaw genA o =+ do+ a <- forAll genA+ annotate "The get-set law must hold for an Iso"+ (review o . view o) a === a {- | Assert that a prism matches for a particular set of values: A 'review' of the @small@ value should produce the @large@ value, and