packages feed

smallcheck-lens (empty) → 0.1

raw patch · 18 files changed

+530/−0 lines, 18 filesdep +basedep +lensdep +smallchecksetup-changed

Dependencies added: base, lens, smallcheck, smallcheck-lens, smallcheck-series, tasty, tasty-smallcheck, transformers

Files

+ CHANGELOG.markdown view
@@ -0,0 +1,13 @@+# Change Log+All notable changes to this project will be documented in this file. This file+follows the formatting recommendations from [Keep a+CHANGELOG](http://keepachangelog.com/). This project adheres to [Semantic+Versioning](http://semver.org/).++## [0.1] - 2015-05-27+### Added+- `SmallCheck` properties for each lens laws.+- `tasty` test trees for each `Lens` type.+- Tests for some `Lens`.++[0.1]: https://github.com/jdnavarro/smallcheck-series/compare/1df060..v0.1
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, J Daniel Navarro++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 J. Daniel Navarro 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.markdown view
@@ -0,0 +1,16 @@+# Lens SmallCheck++[![Hackage Version](https://img.shields.io/hackage/v/smallcheck-lens.svg)](https://hackage.haskell.org/package/smallcheck-lens) [![Build Status](https://img.shields.io/travis/jdnavarro/smallcheck-lens.svg)](https://travis-ci.org/jdnavarro/smallcheck-lens)++[`smallcheck`](https://hackage.haskell.org/package/smallcheck) properties+ported from+[`lens-properties`](https://hackage.haskell.org/package/lens-properties)+and [`tasty`](https://hackage.haskell.org/package/tasty tasty) test trees+to validate `Lens`es, `Setter`s, `Traversal`s, `Iso`s and `Prism`s.++Most likely, you will only need the `Test.Tasty.SmallCheck.Lens` module,+which includes test trees ready to be run.++Check the+[tests](https://github.com/jdnavarro/smallcheck-lens/blob/master/tests/tasty.hs)+in this package for examples.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Test/SmallCheck/Lens.hs view
@@ -0,0 +1,34 @@+{-|+'Test.SmallCheck.Property' creators for every individual /Lens law/ using+explicit 'Test.SmallCheck.Series'.++Use this module when you need different 'Test.SmallCheck.Series' to the ones+implicitly in "Test.Tasty.SmallCheck.Lens" or when you don't want to use+@tasty@ as the test runner.+-}+module Test.SmallCheck.Lens+  (+  -- * Setter+    setterId+  , setterSetSet+  , setterComposition+  -- * Traversal+  , traversePure+  , traversePureMaybe+  , traverseCompose+  -- * Lens+  , lensSetView+  , lensViewSet+  -- * Prism+  , prismYin+  , prismYang+  -- * Iso+  , isoHither+  , isoYon+  ) where++import Test.SmallCheck.Lens.Iso+import Test.SmallCheck.Lens.Lens+import Test.SmallCheck.Lens.Prism+import Test.SmallCheck.Lens.Setter+import Test.SmallCheck.Lens.Traversal
+ Test/SmallCheck/Lens/Iso.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE RankNTypes #-}+module Test.SmallCheck.Lens.Iso where++import Control.Lens+import Test.SmallCheck (Property)+import qualified Test.SmallCheck as SC (over)+import Test.SmallCheck.Series (Series, Serial)++isoHither+  :: (Eq s, Show s, Eq a, Show a, Serial m a)+  => AnIso' s a -> Series m s -> Property m+isoHither l ss = SC.over ss $ \s ->+    s ^. cloneIso l . from l == s++isoYon+  :: (Eq s, Show s, Eq a, Show a, Serial m a)+  => AnIso' s a -> Series m a -> Property m+isoYon l as = SC.over as $ \a -> a ^. from l . cloneIso l == a
+ Test/SmallCheck/Lens/Lens.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE RankNTypes #-}+module Test.SmallCheck.Lens.Lens where++import Control.Lens+import Test.SmallCheck (Property)+import qualified Test.SmallCheck as SC (over)+import Test.SmallCheck.Series (Series)++lensSetView :: (Monad m, Eq s, Show s) => Lens' s a -> Series m s -> Property m+lensSetView l ss = SC.over ss $ \s -> set l (view l s) s == s++lensViewSet+  :: (Monad m, Eq s, Eq a, Show s, Show a)+  => Lens' s a -> Series m s -> Series m a -> Property m+lensViewSet l ss as = SC.over ss $ \s -> SC.over as $ \a ->+    view l (set l a s) == a
+ Test/SmallCheck/Lens/Prism.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE RankNTypes #-}+module Test.SmallCheck.Lens.Prism where++import Control.Lens+import Test.SmallCheck (Property)+import qualified Test.SmallCheck as SC (over)+import Test.SmallCheck.Series (Series)++prismYin+  :: (Monad m, Eq s, Show s, Eq a, Show a)+  => Prism' s a -> Series m a -> Property m+prismYin l as = SC.over as $ \a -> preview l (review l a) == Just a++prismYang+  :: (Monad m, Eq s, Show s, Eq a, Show a)+  => Prism' s a -> Series m s -> Property m+prismYang l ss = SC.over ss $ \s -> maybe s (review l) (preview l s) == s
+ Test/SmallCheck/Lens/Setter.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE FlexibleContexts #-}+module Test.SmallCheck.Lens.Setter where++import Control.Lens+import Test.SmallCheck (Property)+import qualified Test.SmallCheck as SC (over)+import Test.SmallCheck.Series (Series, Serial)+import Test.SmallCheck.Series.Utils (zipLogic3)++setterId+  :: (Eq s, Monad m, Show s)+  => ASetter' s a -> Series m s -> Property m+setterId l se = SC.over se $ \s -> over l id s == s++setterSetSet+  :: (Monad m, Eq s, Show s, Show a)+  => ASetter' s a -> Series m s -> Series m a -> Series m a -> Property m+setterSetSet l ss as bs =+    SC.over ss $ \s ->+        SC.over as $ \a ->+            SC.over bs $ \b ->+    set l b (set l a s) == set l b s++setterComposition+  :: (Monad m, Eq s, Show s, Show a, Serial Identity a)+  => ASetter' s a+  -> Series m s+  -> Series m (a -> a)+  -> Series m (a -> a)+  -> Property m+setterComposition l ss fs gs = SC.over (zipLogic3 ss fs gs) $ \(s,f,g) ->+    over l f (over l g s) == over l (f . g) s
+ Test/SmallCheck/Lens/Traversal.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Test.SmallCheck.Lens.Traversal where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative (Applicative, pure)+#endif+import Control.Lens+import Data.Functor.Compose (Compose(..), getCompose)+import Test.SmallCheck (Property)+import qualified Test.SmallCheck as SC (over)+import Test.SmallCheck.Series (Serial, Series)+import Test.SmallCheck.Series.Utils (zipLogic3)++traversePure+  :: forall m f s a. (Monad m, Show s, Applicative f, Eq (f s))+  => LensLike' f s a -> Series m s -> Property m+traversePure l ss = SC.over ss $ \s -> l pure s == (pure s :: f s)++traversePureMaybe+  :: (Monad m, Show s, Eq s)+  => LensLike' Maybe s a -> Series m s -> Property m+traversePureMaybe = traversePure++traverseCompose+  :: ( Monad m, Show s, Show a, Show (f a), Show (g a)+     , Applicative f, Applicative g, Eq (g (f s)), Serial Identity a+     )+  => Traversal' s a+  -> Series m s+  -> Series m (a -> f a)+  -> Series m (a -> g a)+  -> Property m+traverseCompose t ss fs gs = SC.over (zipLogic3 ss fs gs) $ \(s,f,g) ->+    (fmap (t f) . t g) s == (getCompose . t (Compose . fmap f . g)) s
+ Test/Tasty/SmallCheck/Lens.hs view
@@ -0,0 +1,26 @@+{-|+Preassembled tasty test trees using 'Test.SmallCheck.Serial' instances and+one-to-one zipping of elements in 'Test.SmallCheck.Series' (see+'Test.SmallCheck.Series.Utils.zipLogic') when 'Test.SmallCheck.Serial'+functions are needed.++If you need more exhaustive testing coverage or if you experience combinatorial+explosion you can either override the default 'Test.SmallCheck.Serial'+instances with custom ones or you can create your own tasty test trees using+the functions at "Test.SmallCheck.Lens".+-}+module Test.Tasty.SmallCheck.Lens+  (+  -- * Test Trees+    testIso+  , testLens+  , testPrism+  , testSetter+  , testTraversal+  ) where++import Test.Tasty.SmallCheck.Lens.Iso+import Test.Tasty.SmallCheck.Lens.Lens+import Test.Tasty.SmallCheck.Lens.Prism+import Test.Tasty.SmallCheck.Lens.Setter+import Test.Tasty.SmallCheck.Lens.Traversal
+ Test/Tasty/SmallCheck/Lens/Iso.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+module Test.Tasty.SmallCheck.Lens.Iso where++import Control.Lens+import Test.SmallCheck.Series (Serial(series), CoSerial)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.SmallCheck (testProperty)++import Test.SmallCheck.Lens.Iso+import Test.Tasty.SmallCheck.Lens.Lens++-- | An 'Iso'' is only legal if the following laws hold:+--+-- 1. @s ^. l . from l ≡ s@+--+-- 2. @s ^. from l . l ≡ s@+--+-- An 'Iso'' is also a valid 'Lens'' in both normal and reverse form. Check+-- 'testLens'.+testIso+  :: ( Eq s, Eq a, Show s, Show a+     , Serial IO a, Serial Identity a, CoSerial IO a+     , Serial IO s, Serial Identity s, CoSerial IO s+     )+  => Iso' s a -> TestTree+testIso l = testGroup "Iso Laws"+  [ testProperty "s ^. l . from l ≡ s" $ isoHither l series+  , testProperty "s ^. from l . l ≡ s" $ isoYon l series+  , testLens l+  , testLens (from l)+  ]
+ Test/Tasty/SmallCheck/Lens/Lens.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+module Test.Tasty.SmallCheck.Lens.Lens where++import Control.Lens+import Test.SmallCheck.Series (Serial(series), CoSerial)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.SmallCheck (testProperty)++import Test.SmallCheck.Lens.Lens+import Test.Tasty.SmallCheck.Lens.Traversal++-- | A 'Lens'' is only legal if it is a valid 'Traversal'' (see+--   'testTraversal'), and if the following laws hold:+--+-- 1. @view l (set l b a)  ≡ b@+--+-- 2. @set l (view l a) a  ≡ a@+--+-- 3. @set l c (set l b a) ≡ set l c a@+testLens+  :: ( Eq s, Eq a, Show s, Show a+     , Serial IO a, Serial Identity a, CoSerial IO a+     , Serial IO s+     )+  => Lens' s a -> TestTree+testLens l = testGroup "Lens Laws"+  [ testProperty "view l (set l b a) ≡ b" $+      lensSetView l series+  , testProperty "set l (view l a) a ≡ a" $+      lensViewSet l series series+  , testTraversal l+  ]
+ Test/Tasty/SmallCheck/Lens/Prism.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+module Test.Tasty.SmallCheck.Lens.Prism where++import Control.Lens+import Test.SmallCheck.Series (Serial(series), CoSerial)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.SmallCheck (testProperty)++import Test.SmallCheck.Lens.Prism+import Test.Tasty.SmallCheck.Lens.Traversal++-- | A 'Prism'' is only legal if it is a valid 'Traversal'' (see+--   'testTraversal'), and if the following laws hold:+--+-- 1. @preview l (review l b) ≡ Just b"@+--+-- 2. @maybe s (review l) (preview l s) ≡ s@+testPrism+  :: ( Eq s, Eq a, Show s, Show a+     , Serial IO a, Serial Identity a, CoSerial IO a+     , Serial IO s+     )+  => Prism' s a -> TestTree+testPrism l = testGroup "Prism Laws"+  [ testTraversal l+  , testProperty "preview l (review l b) ≡ Just b" $+      prismYin l series+  , testProperty "maybe s (review l) (preview l s) ≡ s" $+      prismYang l series+  ]
+ Test/Tasty/SmallCheck/Lens/Setter.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE FlexibleContexts #-}+module Test.Tasty.SmallCheck.Lens.Setter where++import Control.Lens+import Test.SmallCheck.Series (Serial(series), CoSerial)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.SmallCheck (testProperty)++import Test.SmallCheck.Lens.Setter++-- | A 'Setter' is only legal if the following 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)@+testSetter+  :: ( Eq s, Show s, Show a+     , Serial IO a, Serial Identity a, CoSerial IO a+     , Serial IO s+     )+  => ASetter' s a -> TestTree+testSetter l = testGroup "Setter Laws"+  [ testProperty "over l id ≡ id" $ setterId l series+  , testProperty "set l y (set l x a) ≡ set l y a" $+      setterSetSet l series series series+  , testProperty "over l f . over l g ≡ over l (f . g)" $+      setterComposition l series series series+  ]
+ Test/Tasty/SmallCheck/Lens/Traversal.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Test.Tasty.SmallCheck.Lens.Traversal where++import Control.Lens+import Test.SmallCheck.Series (Serial(series), CoSerial, Series)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.SmallCheck (testProperty)++import Test.SmallCheck.Lens.Traversal+import Test.Tasty.SmallCheck.Lens.Setter++-- | A 'Traversal'' is only legal if it is a valid 'Setter'' (see+-- 'testSetter'), and if the following laws hold:+--+-- 1. @t pure ≡ pure@+--+-- 2. @fmap (t f) . t g ≡ getCompose . t (Compose . fmap f . g)@+testTraversal+  :: forall s a. ( Eq s, Show s, Show a+                 , Serial IO a, Serial Identity a, CoSerial IO a+                 , Serial IO s+                 )+  => Traversal' s a -> TestTree+testTraversal t = testGroup "Traversal Laws"+  [ testProperty "t pure ≡ pure" $ traversePureMaybe t series+  , testProperty "fmap (t f) . t g ≡ getCompose . t (Compose . fmap f . g)" $+       traverseCompose t series (series :: Series IO (a -> [a]))+                                (series :: Series IO (a -> Maybe a))+  , testSetter t+  ]
+ smallcheck-lens.cabal view
@@ -0,0 +1,65 @@+name:                smallcheck-lens+version:             0.1+synopsis:            SmallCheck lens laws+description:+  @<https://hackage.haskell.org/package/smallcheck smallcheck>@ properties+  ported from+  @<https://hackage.haskell.org/package/lens-properties lens-properties>@+  and @<https://hackage.haskell.org/package/tasty tasty>@ test trees to validate @Lens@es, @Setter@s, @Traversal@s, @Iso@s and @Prism@s.+  .+  Most likely, you will only need the "Test.Tasty.SmallCheck.Lens"+  module, which includes test trees ready to be run.+  .+  Check the+  <https://github.com/jdnavarro/smallcheck-lens/blob/master/tests/tasty.hs tests>+  in this package for examples.+homepage:            https://github.com/jdnavarro/smallcheck-lens+bug-reports:         https://github.com/jdnavarro/smallcheck-lens/issues+license:             BSD3+license-file:        LICENSE+author:              Danny Navarro+maintainer:          j@dannynavarro.net+category:            Testing, Lenses+build-type:          Simple+extra-source-files:  README.markdown CHANGELOG.markdown+cabal-version:       >=1.10++source-repository head+  type: git+  location: git://github.com/jdnavarro/smallcheck-lens.git++library+  default-language:    Haskell2010+  ghc-options:         -Wall+  exposed-modules:     Test.SmallCheck.Lens+                       Test.SmallCheck.Lens.Iso+                       Test.SmallCheck.Lens.Lens+                       Test.SmallCheck.Lens.Prism+                       Test.SmallCheck.Lens.Setter+                       Test.SmallCheck.Lens.Traversal+                       Test.Tasty.SmallCheck.Lens+                       Test.Tasty.SmallCheck.Lens.Iso+                       Test.Tasty.SmallCheck.Lens.Lens+                       Test.Tasty.SmallCheck.Lens.Prism+                       Test.Tasty.SmallCheck.Lens.Setter+                       Test.Tasty.SmallCheck.Lens.Traversal+  build-depends:       base >=4.6 && <4.9,+                       transformers,+                       lens,+                       smallcheck >= 1.1,+                       smallcheck-series >=0.3,+                       tasty,+                       tasty-smallcheck++test-suite tasty+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  hs-source-dirs:      tests+  main-is:             tasty.hs+  ghc-options:         -Wall -threaded+  build-depends:       base >= 4.6 && <4.9,+                       lens >=4.1.2.1,+                       tasty,+                       tasty-smallcheck,+                       smallcheck,+                       smallcheck-lens
+ tests/tasty.hs view
@@ -0,0 +1,66 @@+module Main where++import Control.Lens+import Numeric.Lens (hex, negated, adding)+import Test.Tasty (TestTree, defaultMain, testGroup)++import Test.Tasty.SmallCheck.Lens++main :: IO ()+main = defaultMain $ testGroup "Lens tests"+  [ tupleTests+  , maybeTests+  , numTests+  ]++tupleTests :: TestTree+tupleTests = testGroup "Tuples"+  [ testGroup "_1"+    [ testGroup "Lens' (Char,Char) Char"+        [ testLens (_1 :: Lens' (Char,Char) Char) ]+    , testGroup "Lens' (Int,Char) Int"+        [ testLens (_1 :: Lens' (Int,Char) Int) ]+    ]+  , testGroup "_2"+     [ testGroup "Lens' (Char,Char,Char) Char"+         [ testLens (_2 :: Lens' (Char,Char,Char) Char) ]+     ]+  ]++maybeTests :: TestTree+maybeTests = testGroup "Maybe"+  [ testGroup "_Nothing"+    [ testGroup "Prism' (Maybe Char) ()"+      [ testPrism (_Nothing :: Prism' (Maybe Char) ()) ]+    , testGroup "Prism' (Maybe Int) ()"+      [ testPrism (_Nothing :: Prism' (Maybe Int) ()) ]+    ]+  , testGroup "_Just"+    [ testGroup "Prism' (Maybe Char) Char"+      [ testPrism (_Just :: Prism' (Maybe Char) Char) ]+    , testGroup "Prism' (Maybe Int) Int"+      [ testPrism (_Just :: Prism' (Maybe Int) Int) ]+    ]+  ]++numTests :: TestTree+numTests = testGroup "Numeric"+  [ testGroup "negated"+    [ testGroup "Iso' Int Int"+      [ testIso (negated :: Iso' Int Int) ]+    , testGroup "Iso' Float Float"+      [ testIso (negated :: Iso' Float Float) ]+    ]+  , testGroup "hex"+    [ testGroup "Prism'' String Int"+      [ testPrism (hex :: Prism' String Int) ]+    , testGroup "Prism'' String Integer"+      [ testPrism (hex :: Prism' String Integer) ]+    ]+  , testGroup "adding"+    [ testGroup "Iso' Int Int"+      [ testIso (adding 2 :: Iso' Int Int) ]+    , testGroup "Iso' Integer Integer"+      [ testIso (adding 3 :: Iso' Integer Integer) ]+    ]+  ]