hedgehog-optics (empty) → 1.0.0

raw patch · 3 files changed

+183/−0 lines, 3 filesdep +basedep +hedgehogdep +optics-core

Dependencies added: base, hedgehog, optics-core

Files

• hedgehog-optics.cabal +43/−0
• license.txt +18/−0
• src/Hedgehog/Optics.hs +122/−0

@@ -0,0 +1,43 @@+cabal-version: 3.0++name: hedgehog-optics+version: 1.0.0+category: Testing, Optics++synopsis:+    Hedgehog properties for optics laws++description:+    Are your prisms well-formed? Test and be confident.++copyright: 2021 Mission Valley Software LLC+license: MIT+license-file: license.txt++author:     Chris Martin+maintainer: Chris Martin, Julie Moronuki++homepage:    https://github.com/typeclasses/hedgehog-optics+bug-reports: https://github.com/typeclasses/hedgehog-optics/issues++build-type: Simple++source-repository head+  type: git+  location: https://github.com/typeclasses/hedgehog-optics++library+    default-language: Haskell2010+    ghc-options: -Wall+    hs-source-dirs: src++    default-extensions:+        NoImplicitPrelude++    exposed-modules:+        Hedgehog.Optics++    build-depends:+        base        ^>= 4.14 || ^>= 4.15+      , hedgehog    ^>= 1.0.4+      , optics-core ^>= 0.4

@@ -0,0 +1,18 @@+Copyright 2021 Mission Valley Software LLC++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.

@@ -0,0 +1,122 @@+module Hedgehog.Optics 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 Optics.AffineFold (preview)+import Optics.AffineTraversal (matching)+import Optics.Getter (view)+import Optics.Iso (Iso')+import Optics.Lens (Lens')+import Optics.Prism (Prism')+import Optics.Review (review)+import Optics.Setter (set)+import Text.Show (Show)++{- | 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+    -> Prism' large small {- ^ Prism signifying that the+          @small@ type is a subset of the @large@ type -}+    -> PropertyT m ()++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 ()++    part2 =+      do+        small <- forAll genSmall+        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+    -> Lens' large small {- ^ Lens signifying that the @small@+          type is a constituent part of the @large@ type -}+    -> PropertyT m ()++wellFormedLens genLarge genSmall o = getPut *> putGet *> putPut+  where+    getPut =+      do+        large <- forAll genLarge+        small <- forAll genSmall+        view o (set o small large) === small++    putGet =+      do+        large <- forAll genLarge+        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++{- | 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+    -> Iso' a b {- ^ Isomorphism signifying that types+          @a@ and @b@ are basically the same thing -}+    -> PropertyT m ()++wellFormedIso genA genB o = part1 *> part2+  where+    part1 =+      do+        b <- forAll genB+        (view o . review o) b === b++    part2 =+      do+        a <- forAll genA+        (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+a 'preview' of the @large@ value should produce the @small@ value. -}+prismExample ::+    Monad m =>+    (Show large, Eq large) =>+    (Show small, Eq small) =>++       Prism' large small {- ^ Prism signifying that the+          @small@ type is a subset of the @large@ type -}+    -> large+    -> small+    -> PropertyT m ()++prismExample o large small =+  do+    review o small === large+    preview o large === Just small