hedgehog-lens (empty) → 0.1.0.0

raw patch · 4 files changed

+310/−0 lines, 4 filesdep +basedep +hedgehogdep +lens

Dependencies added: base, hedgehog, lens

Files

CHANGELOG.md +5/−0
LICENSE.txt +18/−0
hedgehog-lens.cabal +43/−0
src/Hedgehog/Lens.hs +244/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for hedgehog-lens++## 0.1.0.0 -- 2022-04-14++* Initial Commit

+ LICENSE.txt view

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

+ hedgehog-lens.cabal view

@@ -0,0 +1,43 @@+cabal-version: 2.4++name: hedgehog-lens+version: 0.1.0.0+category: Testing, Lens++synopsis:+  Hedgehog properties for lens laws.++copyright: 2021 Mission Valley Software LLC, 2022 Solomon Bothwell+license: MIT+license-file: LICENSE.txt++author: solomon+maintainer: ssbothwell@gmail.com++homepage: https://github.com/solomon-b/hedgehog-lens+bug-reports: https://github.com/solomon-b/hedgehog-lens/issues++build-type: Simple+                +extra-source-files: CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/solomon-b/hedgehog-lens+++library+    default-language: Haskell2010+    ghc-options: -Wall+    hs-source-dirs: src++    default-extensions:+        NoImplicitPrelude++    exposed-modules:+        Hedgehog.Lens++    build-depends:+        base        ^>= 4.13 || ^>= 4.14 || ^>= 4.15 || ^>= 4.16+      , hedgehog    ^>= 1.0.4 || ^>= 1.1+      , lens        >= 5.1 && < 5.2

+ src/Hedgehog/Lens.hs view

@@ -0,0 +1,244 @@+{-# LANGUAGE RankNTypes #-}++module Hedgehog.Lens+  ( wellFormedPrism,+    wellFormedLens,+    wellFormedIso,+    prismExample,+  )+where++import Control.Lens+  ( Iso',+    Lens',+    Prism',+    matching,+    preview,+    review,+    set,+    view,+  )+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, annotate, forAll, (===))+import Text.Show (Show)++-- | Checks whether a prism respects the well-formedness laws:+--+-- 1) Get-Set Prism Law+-- 2) Set-Get Prism Law+wellFormedPrism ::+  Monad m =>+  (Show large, Eq large) =>+  (Show small, Eq small) =>+  Gen large ->+  Gen small ->+  -- | Prism signifying that the+  --          @small@ type is a subset of the @large@ type+  Prism' large small ->+  PropertyT m ()+wellFormedPrism genLarge genSmall o =+  do+    getSetPrismLaw genLarge o+    setGetPrismLaw genSmall o++-- | Get-Set Prism Law+--+-- @+-- 'matching' o s ≡ 'Right' a => 'review' o a ≡ s+-- @+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 ()++-- | Set-Get Prism Law+--+-- @+-- 'matching' o ('review' o b) ≡ 'Right' b+-- @+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:+--+-- 1) Get-Put Lens Law+-- 2) Put-Get Lens Law+-- 3) Put-Put Lens Law+wellFormedLens ::+  Monad m =>+  (Show large, Eq large) =>+  (Show small, Eq small) =>+  Gen large ->+  Gen small ->+  -- | Lens signifying that the @small@+  --          type is a constituent part of the @large@ type+  Lens' large small ->+  PropertyT m ()+wellFormedLens genLarge genSmall o =+  do+    getPutLensLaw genLarge genSmall o+    putGetLensLaw genLarge o+    putPutLensLaw genLarge genSmall o++-- | Get-Put Lens Law+-- You get back what you put in:+--+-- @+-- 'view' l ('set' l v s) ≡ v+-- @+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++-- | Put-Get Lens Law+-- Putting back what you got doesn't change anything:+--+-- @+-- 'set' l ('view' l s) s ≡ s+-- @+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++-- | Put-Put Lens Law+-- Setting twice is the same as setting once:+--+-- @+-- 'set' l v' ('set' l v s) ≡ 'set' l v' s+-- @+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:+--+-- 1) Set-Get Iso Law+-- 2) Get-Set Iso Law+wellFormedIso ::+  Monad m =>+  (Show a, Eq a) =>+  (Show b, Eq b) =>+  Gen a ->+  Gen b ->+  -- | Isomorphism signifying that types+  --          @a@ and @b@ are basically the same thing+  Iso' a b ->+  PropertyT m ()+wellFormedIso genA genB o =+  do+    setGetIsoLaw genB o+    getSetIsoLaw genA o++-- | Set-Get Iso Law+-- You get back what you put in:+--+-- @+-- 'view' i . 'review' i ≡ 'id'+-- @+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++-- | Get-Set Iso Law+-- You get back what you put in:+--+-- @+-- 'review' i . 'view' i ≡ 'id'+-- @+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+-- a 'preview' of the @large@ value should produce the @small@ value.+prismExample ::+  Monad m =>+  (Show large, Eq large) =>+  (Show small, Eq small) =>+  -- | Prism signifying that the+  --          @small@ type is a subset of the @large@ type+  Prism' large small ->+  large ->+  small ->+  PropertyT m ()+prismExample o large small =+  do+    review o small === large+    preview o large === Just small