hedgehog-checkers-lens (empty) → 0.1.0.0
raw patch · 6 files changed
+386/−0 lines, 6 filesdep +basedep +hedgehogdep +hedgehog-checkerssetup-changed
Dependencies added: base, hedgehog, hedgehog-checkers, hedgehog-checkers-lens, lens
Files
- LICENSE +30/−0
- README.md +1/−0
- Setup.hs +2/−0
- hedgehog-checkers-lens.cabal +41/−0
- src/Hedgehog/Checkers/Lens/Properties.hs +258/−0
- tests/tests.hs +54/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# hedgehog-checkers-lens
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hedgehog-checkers-lens.cabal view
@@ -0,0 +1,41 @@+name: hedgehog-checkers-lens+version: 0.1.0.0+cabal-version: >=1.10+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: 2017, Chris Allen+maintainer: cma@bitemyapp.com+homepage: https://github.com/bitemyapp/hedgehog-checkers#readme+description:+ hedgehog-checkers-lens provides the various lens, prism, setter, and traversal laws as ready-to-use properties.+category: Web+author: Chris Allen+extra-source-files:+ README.md++library+ exposed-modules:+ Hedgehog.Checkers.Lens.Properties+ build-depends:+ base >=4.7 && <5,+ hedgehog ==0.5.*,+ hedgehog-checkers -any,+ lens ==4.*+ default-language: Haskell2010+ hs-source-dirs: src+ other-modules:+ Paths_hedgehog_checkers_lens++test-suite tests+ type: exitcode-stdio-1.0+ main-is: tests.hs+ build-depends:+ base >=4.7 && <5,+ hedgehog ==0.5.*,+ hedgehog-checkers -any,+ lens ==4.*,+ hedgehog-checkers-lens -any+ default-language: Haskell2010+ hs-source-dirs: tests+ ghc-options: -threaded -Wall -rtsopts -with-rtsopts=-N
+ src/Hedgehog/Checkers/Lens/Properties.hs view
@@ -0,0 +1,258 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}++module Hedgehog.Checkers.Lens.Properties+ ( isSetter+ , isLens+ , isIso+ , isPrism+ , isTraversal+ ) where++import Control.Applicative+import Data.Functor.Compose++import Control.Lens++import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Hedgehog.Checkers.Ugly.Function.Hack++-----------------------------------------------------------+-- | A 'Setter' is only legal if the following 3 laws hold:+--+-- 1. @set l y (set l x a) ≡ set l y a@+--+-- 2. @over l id ≡ id@+--+-- 3. @over l f . over l g ≡ over l (f . g)@+isSetter :: (Show s, Show a, Eq s)+ => Setter' s a+ -> Gen a+ -> Gen s+ -> Gen (a -> a)+ -> PropertyT IO ()+isSetter setter genv gens genf = do+ settee <- forAll gens+ val <- forAll genv+ val' <- forAll genv+ f <- funcForAllWtf genf+ g <- funcForAllWtf genf+ assert $ setter_id setter settee+ assert $ setter_composition setter settee f g+ assert $ setter_set_set setter val val' settee++-- The first setter law:+setter_id :: Eq s => Setter' s a -> s -> Bool+setter_id l s = over l id s == s++-- The second setter law:+setter_composition :: Eq s+ => Setter' s a+ -> s+ -> (a -> a)+ -> (a -> a)+ -> Bool+setter_composition l s f g =+ over l f (over l g s) == over l (f . g) s++setter_set_set :: ( Eq s+ , Show a+ , Show s+ )+ => Setter' s a+ -> a+ -> a+ -> s+ -> Bool+setter_set_set setter val val' s =+ (set setter val' (set setter val s)) == set setter val' s++-- type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t++isLens :: ( Eq a+ , Eq s+ , Show a+ , Show s+ )+ => Lens' s a+ -> Gen a+ -> Gen s+ -> Gen (a -> a)+ -> PropertyT IO ()+isLens lens genv gens genf = do+ settee <- forAll gens+ val <- forAll genv+ assert $ lens_set_view lens val settee+ assert $ lens_view_set lens settee+ isSetter lens genv gens genf++-- 1) You get back what you put in:+-- view l (set l v s) ≡ v++lens_set_view :: ( Eq a+ , Show a+ , Show s+ )+ => Lens' s a+ -> a+ -> s+ -> Bool+lens_set_view setter val s = do+ (view setter (set setter val s)) == val++-- 2) Putting back what you got doesn't change anything:+-- set l (view l s) s ≡ s++lens_view_set :: ( Eq s+ , Show s+ )+ => Lens' s a+ -> s+ -> Bool+lens_view_set setter s = do+ (set setter (view setter s) s) == s+++isIso :: ( Eq a+ , Eq s+ , Show a+ , Show s+ )+ => Iso' s a+ -> Gen a+ -> Gen s+ -> Gen (a -> a)+ -> Gen (s -> s)+ -> PropertyT IO ()+isIso l gena gens genf genfs = do+ a <- forAll gena+ s <- forAll gens+ assert $ iso_hither l s+ assert $ iso_yon l a+ isLens l gena gens genf+ isLens (from l) gens gena genfs++-- isIso :: (Arbitrary s, Arbitrary a, CoArbitrary s, CoArbitrary a, Show s, Show a, Eq s, Eq a, Function s, Function a)+-- => Iso' s a -> Property+-- isIso l = iso_hither l .&. iso_yon l .&. isLens l .&. isLens (from l)++iso_hither :: Eq s => AnIso' s a -> s -> Bool+iso_hither l s = s ^. cloneIso l . from l == s++iso_yon :: Eq a => AnIso' s a -> a -> Bool+iso_yon l a = a ^. from l . cloneIso l == a++-- 3) Setting twice is the same as setting once:+-- set l v' (set l v s) ≡ set l v' s++-- type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)++isPrism :: ( Show s+ , Show a+ , Eq s+ , Eq a+ )+ => Prism' s a+ -> Gen a+ -> Gen s+ -> Gen (a -> a)+ -> PropertyT IO ()+isPrism l gena gens genf = do+ a <- forAll gena+ s <- forAll gens+ assert $ prism_yin l a+ assert $ prism_yang l s+ isTraversal l gena gens genf++-- isPrism :: (Arbitrary s, Arbitrary a, CoArbitrary a, Show s, Show a, Eq s, Eq a, Function a)+-- => Prism' s a -> Property+-- isPrism l = isTraversal l .&. prism_yin l .&. prism_yang l++prism_yin :: Eq a => Prism' s a -> a -> Bool+prism_yin l a = preview l (review l a) == Just a++prism_yang :: Eq s => Prism' s a -> s -> Bool+prism_yang l s = maybe s (review l) (preview l s) == s++-- First, if I re or review a value with a Prism and then preview or use (^?), I will get it back:+-- preview l (review l b) ≡ Just b+-- previewOfReviewIdentity ::+-- ( Eq b+-- , Show b+-- )+-- => Prism' s b+-- -> Gen b+-- -> PropertyT IO ()+-- previewOfReviewIdentity prism genb = do+-- b <- forAll genb+-- (preview prism (review prism b)) === (Just b)++-- Second, if you can extract a value a using a Prism l from a value s, then the value s is completely described by l and a:+-- If preview l s ≡ Just a then review l a ≡ s+-- previewJustReviewIdentity :: PropertyT IO ()+-- previewJustReviewIdentity = undefined++-- | A 'Traversal' is only legal if it is a valid 'Setter' (see 'isSetter' for+-- what makes a 'Setter' valid), and the following laws hold:+--+-- 1. @t pure ≡ pure@+--+-- 2. @fmap (t f) . t g ≡ getCompose . t (Compose . fmap f . g)@+isTraversal :: ( Eq s+ , Show a+ , Show s+ )+ => Traversal' s a+ -> Gen a+ -> Gen s+ -> Gen (a -> a)+ -> PropertyT IO ()+isTraversal l gena gens genf = do+ s <- forAll gens+ as <- forAll (Gen.list (Range.linear 0 50) gena)+ bs <- forAll (Gen.list (Range.linear 0 50) gena)+ t <- forAll Gen.bool+ assert $ traverse_pureMaybe l s+ assert $ traverse_pureList l s+ assert $ traverse_compose+ l+ (\x -> as ++ [x] ++ bs)+ (\x -> if t then Just x else Nothing)+ s+ isSetter l gena gens genf++traverse_pure :: forall f s a+ . ( Applicative f+ , Eq (f s)+ )+ => LensLike' f s a+ -> s+ -> Bool+traverse_pure l s = l pure s == (pure s :: f s)++traverse_pureMaybe :: Eq s+ => LensLike' Maybe s a+ -> s+ -> Bool+traverse_pureMaybe = traverse_pure++traverse_pureList :: Eq s+ => LensLike' [] s a+ -> s+ -> Bool+traverse_pureList = traverse_pure++traverse_compose :: ( Applicative f+ , Applicative g+ , Eq (f (g s))+ )+ => Traversal' s a+ -> (a -> g a)+ -> (a -> f a)+ -> s+ -> Bool+traverse_compose t f g s =+ (fmap (t f) . t g) s == (getCompose . t (Compose . fmap f . g)) s
+ tests/tests.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Main where++import Data.Functor (void)++import Control.Lens++import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Hedgehog.Checkers.Ugly.Function.Hack++import Hedgehog.Checkers.Lens.Properties++data Foo =+ Foo+ { _bar :: Int+ , _baz :: Int+ , _dunno :: String }+ deriving (Eq, Show)++makeLenses ''Foo++genFoo' :: Gen Int -> Gen String -> Gen Foo+genFoo' gi gs = do+ i <- gi+ i' <- gi+ s <- gs+ return (Foo i i' s)++genFoo :: Gen Foo+genFoo =+ let string = Gen.string (Range.linear 0 100) Gen.ascii+ int = Gen.int (Range.linear 0 100)+ in genFoo' int string++allLensLawsFoo :: Property+allLensLawsFoo = property $ do+ let string = Gen.string (Range.linear 0 100) Gen.ascii+ int = Gen.int (Range.linear 0 100)+ isLens bar int genFoo (ordFuncWtf' int int)+ isLens baz int genFoo (ordFuncWtf' int int)+ isLens dunno string genFoo (ordFuncWtf' string string)++main :: IO ()+main = do+ void $+ checkParallel $+ Group "Control.Lens.Lens" [ ("all laws applied to foo's lenses"+ , allLensLawsFoo)+ ]