hedgehog-classes 0.1.0.0 → 0.1.1.0
raw patch · 38 files changed
+1125/−82 lines, 38 filesdep +hedgehog-classesdep ~aesondep ~basedep ~containersPVP ok
version bump matches the API change (PVP)
Dependencies added: hedgehog-classes
Dependency ranges changed: aeson, base, containers, hedgehog, pretty-show, transformers, wl-pprint-annotated
API changes (from Hackage documentation)
Files
- README.md +153/−6
- hedgehog-classes.cabal +43/−43
- src/Hedgehog/Classes.hs +3/−4
- src/Hedgehog/Classes/Common/Laws.hs +2/−0
- src/Hedgehog/Classes/Foldable.hs +2/−0
- src/Hedgehog/Classes/Ord.hs +4/−4
- src/Hedgehog/Classes/Semigroup.hs +10/−10
- src/Hedgehog/Classes/Show.hs +4/−4
- src/Hedgehog/Classes/ShowRead.hs +8/−6
- src/Hedgehog/Classes/Storable.hs +9/−5
- test/Spec.hs +82/−0
- test/Spec/Alternative.hs +19/−0
- test/Spec/Applicative.hs +76/−0
- test/Spec/Arrow.hs +6/−0
- test/Spec/Bifoldable.hs +37/−0
- test/Spec/Bifunctor.hs +31/−0
- test/Spec/Bitraversable.hs +31/−0
- test/Spec/Bits.hs +37/−0
- test/Spec/Category.hs +9/−0
- test/Spec/Contravariant.hs +74/−0
- test/Spec/Enum.hs +60/−0
- test/Spec/Eq.hs +59/−0
- test/Spec/Foldable.hs +40/−0
- test/Spec/Functor.hs +46/−0
- test/Spec/Generic.hs +45/−0
- test/Spec/Integral.hs +37/−0
- test/Spec/Json.hs +29/−0
- test/Spec/Monad.hs +39/−0
- test/Spec/MonadIO.hs +6/−0
- test/Spec/MonadPlus.hs +6/−0
- test/Spec/MonadZip.hs +6/−0
- test/Spec/Monoid.hs +46/−0
- test/Spec/Ord.hs +7/−0
- test/Spec/Semigroup.hs +35/−0
- test/Spec/Show.hs +6/−0
- test/Spec/ShowRead.hs +6/−0
- test/Spec/Storable.hs +6/−0
- test/Spec/Traversable.hs +6/−0
README.md view
@@ -1,8 +1,155 @@-# hedgehog-classes+hedgehog-classes [![Hackage][hackage-shield]][hackage]+================ -[](https://hackage.haskell.org/package/hedgehog-classes)-[](LICENSE)-<!--- [](http://stackage.org/lts/package/hedgehog-classes)--->-<!--- [](http://stackage.org/nightly/package/hedgehog-classes) --->+> Hedgehog will eat your typeclass bugs. -Hedgehog will eat your typeclass bugs+<img src="https://github.com/hedgehogqa/haskell-hedgehog/raw/master/img/hedgehog-logo.png" width="307" align="right"/>++## Motivation++`hedgehog-classes` is a wrapper around [Hedgehog](http://hedgehog.qa/) that aims to provide a simple, straightforward API for testing common typeclass laws <i>quickly</i>, while providing good error messages in helping debug any failing tests. It is inspired by the [quickcheck-classes](http://hackage.haskell.org/package/quickcheck-classes) library.++## API Overview++The API of `hedgehog-classes` is dead simple. There are three parts.++The first part is a datatype, called 'Laws', which looks like this:++```haskell+data Laws = Laws+ { lawsTypeclass :: String+ , lawsProperties :: [(String,Property)]+ }+```++It is a typeclass name along with a list of named property tests.++The second part of `hedgehog-classes` are the functions, which follow a simple structure. All functions in `hedgehog-classes` have one of the following three type signatures, based on the kind of the type which the corresponding typeclass parameterises. Below, 'Ctx' refers to the typeclass in question:++```haskell+-- Typeclasses that have kind 'Type -> Constraint', e.g. 'Eq'+tcLaw :: (Ctx a, Eq a, Show a) => Gen a -> Laws++-- Typeclasses that have kind '(Type -> Type) -> Constraint', e.g. 'Functor'+tcLaw1 ::+ ( Ctx f+ , forall x. Eq x => Eq (f x)+ , forall x. Show x => Show (f x)+ ) => (forall x. Gen x -> Gen (f x)) -> Laws++-- Typeclasses that have kind '(Type -> Type -> Type) -> Constraint', e.g. 'Bifunctor'+tcLaw2 ::+ ( Ctx f+ , forall x y. (Eq x, Eq y) => Eq (f x y)+ , forall x y. (Show x, Show y) => Show (f x y)+ ) => (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Laws+```++The third and last part of `hedgehog-classes` are the three convenience functions used to run++your tests. They all return an `IO Bool`, where `True` is returned if all the tests pass, and `False` otherwise. They are as following:++```haskell+-- Test a single typeclasses' laws.+lawsCheck :: Laws -> IO Bool++-- Test multiple typeclass laws for a single type.+lawsCheckOne :: Gen a -> [Gen a -> Laws] -> IO Bool++-- Test mutliple typeclass laws for multiple types.+-- The argument is pairs of type names and their associated laws to test.+lawsCheckMany :: [(String, [Laws])] -> IO Bool+```++That is all there is to using `hedgehog-classes` in your test suite. For usage examples, see the [haddocks](http://hackage.haskell.org/package/hedgehog-classes)++## Distributing your own `Laws`++`hedgehog-classes` also exports some functions which you may find useful for writing functions that allow users to test the laws of typeclasses you define in your own libraries, along with utilities for providing custom error messages. They can be found [here](http://hackage.haskell.org/package/hedgehog-classes-0.1.0.0/docs/Hedgehog.-Classes.html#g:6).++## Example error messages+Below is an example of an error message one might get from a failed test from `hedgehog-classes`:++++++## Differences from similar libraries+There are a number of libraries that have similar goals to `hedgehog-classes`, and I will discuss only those that wrap `hedgehog`, not `QuickCheck`.++ - [hedgehog-checkers](https://github.com/bitemyapp/hedgehog-checkers):+ - Incomplete+ - Not actively developed+ - Less typeclasses+ - Hasn't been uploaded to hackage, even with a sufficient starting-point API+ - API is slightly more complex+ - Does not make an effort to provide custom error messages+ - Currently the only thing `hedgehog-checkers` can do that this library cannot+ is test properties of higher-kinded typeclass laws where the construction of+ the type + + - [hedgehog-laws](https://github.com/qfpl/hedgehog-laws):+ - All of the things that apply to `hedgehog-checkers`, but even more incomplete.++## Supported Typeclasses++ - `base`+ - Alternative+ - Applicative+ - Arrow+ - Bifoldable+ - Bifunctor+ - Bitraversable+ - Bits/FiniteBits+ - Category+ - Contravariant+ - Enum+ - Eq+ - Foldable+ - Functor+ - Generic+ - Integral+ - Monad+ - MonadIO+ - MonadPlus+ - MonadZip+ - Ord+ - Semigroup+ - Show+ - ShowRead+ - Storable+ - Traversable+ - `aeson`+ - ToJSON+ - ToJSON/FromJSON++Some typeclasses can have additional laws, which are not part of their sufficient definition. A common example is commutativity of a monoid. In such cases where this is sensible, `hedgehog-classes` provides functions such `commutativeMonoidLaws`, `commutativeSemigroupLaws`, etc. `hedgehog-classes` also tests that `foldl'`/`foldr'` actually accumulate strictly. There are other such cases that are documented on Hackage.++Support will be added for the typeclasses from [semigroupoids](http://hackage.haskell.org/package/semigroupoids).++Support will be added for the `Semiring`/`Ring` typeclasses from [semirings](http://hackage.haskell.org/package/semirings).++## Building++Currently, you need GHC >= 8.5 to build this (because of `-XQuantifiedConstraints`). Some CPP can be used to make this buildable with older GHCs, I just have not done so yet. I would gladly take a PR that does so, but only for GHC 8.2.2 and newer.++To use this library for testing, just add it to a test stanza of your cabal file.++To use this library to export your own `Laws` functions which you wish to distribute, add it to the library stanza of your cabal file.++ [hackage]: http://hackage.haskell.org/package/hedgehog-classes+ [hackage-shield]: https://img.shields.io/badge/hackage-v0.6.1-blue.svg++## Improvements++There are a number of improvements that can be made to the API of `hedgehog-classes`:++ - Traversable needs better error messages, without exposing library internals.+ - Arrow Laws 5/6/7 need names.+ - Some laws could use better names, as some of them I had to make up.+ - ixLaws can accidentally be extremely inefficient and I'm not sure how to fix that.+ - The test suite is incomplete.+ - There is no 'bad' test suite, for testing error messages.+ - There could be spelling mistakes/grammatical errors/inconsistencies in the custom error messages.++You can help fix any of the above by opening an issue/PR! Thanks.
hedgehog-classes.cabal view
@@ -2,7 +2,7 @@ name: hedgehog-classes version:- 0.1.0.0+ 0.1.1.0 synopsis: Hedgehog will eat your typeclass bugs description:@@ -141,46 +141,46 @@ -- build-depends: vector >= 0.12.0.0 && < 0.13.0.0 -- cpp-options: -DHAVE_VECTOR ---test-suite spec--- type: exitcode-stdio-1.0--- hs-source-dirs: test--- main-is: Spec.hs------ other-modules: Spec.Alternative--- Spec.Applicative--- Spec.Arrow--- Spec.Bifoldable--- Spec.Bifunctor--- Spec.Bitraversable--- Spec.Bits--- Spec.Category--- Spec.Contravariant--- Spec.Enum--- Spec.Eq--- Spec.Foldable--- Spec.Functor--- Spec.Generic--- Spec.Integral+test-suite spec+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs++ other-modules: Spec.Alternative+ Spec.Applicative+ Spec.Arrow+ Spec.Bifoldable+ Spec.Bifunctor+ Spec.Bitraversable+ Spec.Bits+ Spec.Category+ Spec.Contravariant+ Spec.Enum+ Spec.Eq+ Spec.Foldable+ Spec.Functor+ Spec.Generic+ Spec.Integral -- Spec.Ix--- Spec.Json--- Spec.Monad--- Spec.MonadIO--- Spec.MonadPlus--- Spec.MonadZip--- Spec.Monoid--- Spec.Ord--- Spec.Semigroup--- Spec.Show--- Spec.ShowRead--- Spec.Storable--- Spec.Traversable------ build-depends: base >= 4.12.0.0 && < 4.13--- , aeson --- , containers --- , hedgehog --- , hedgehog-classes------ ghc-options: -Wall--- --- default-language: Haskell2010+ Spec.Json+ Spec.Monad+ Spec.MonadIO+ Spec.MonadPlus+ Spec.MonadZip+ Spec.Monoid+ Spec.Ord+ Spec.Semigroup+ Spec.Show+ Spec.ShowRead+ Spec.Storable+ Spec.Traversable++ build-depends: base >= 4.12.0.0 && < 4.13+ , aeson + , containers + , hedgehog + , hedgehog-classes++ ghc-options: -Wall+ + default-language: Haskell2010
src/Hedgehog/Classes.hs view
@@ -1,10 +1,9 @@ {-| This library provides sets of properties that should hold for common typeclasses. - /Note:/ on GHC < 8.5, this library uses the higher-kinded typeclasses- ('Data.Functor.Classes.Show1', 'Data.Functor.Classes.Eq1', 'Data.Functor.Classes.Ord1', etc.),- but on GHC >= 8.5, it uses `-XQuantifiedConstraints` to express these- constraints more cleanly.+ /Note:/ functions that test laws of a subclass never test the laws of+ a superclass. For example, 'commutativeSemigroupLaws' never tests+ the laws provided by 'semigroupLaws'. -} module Hedgehog.Classes ( -- * Running
src/Hedgehog/Classes/Common/Laws.hs view
@@ -160,6 +160,7 @@ -- -- >>> lawsCheckMany tests --+-- @ -- Testing properties for common typeclasses... -- -- -------------@@ -189,6 +190,7 @@ -- -- All tests succeeded -- True+-- @ lawsCheckMany :: [(String, [Laws])] -- ^ Pairs of type names and their associated laws to test. -> IO Bool -- ^ 'True' if your tests pass. 'False' otherwise.
src/Hedgehog/Classes/Foldable.hs view
@@ -26,6 +26,8 @@ -- [__ToList__]: @'Foldable.toList' ≡ 'Foldable.foldr' (:) []@ -- [__Null__]: @'Foldable.null' ≡ 'Foldable.foldr' ('const' ('const' 'False')) 'True'@ -- [__Length__]: @'Foldable.length' ≡ 'getSum' '.' 'Foldable.foldMap' ('const' ('Sum' 1))@+--+-- This additionally tests that the user's implementations of 'Foldable.foldr'' and 'Foldable.foldl'' are strict in their accumulators. foldableLaws :: ( Foldable f , forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
src/Hedgehog/Classes/Ord.hs view
@@ -7,10 +7,10 @@ -- | Tests the following 'Ord' laws: ----- [__Antisymmetry__]: @@ ≡ @@--- [__Transitivity__]: @@ ≡ @@--- [__Reflexivity__]: @@ ≡ @@--- [__Totality__]: @@ ≡ @@+-- [__Antisymmetry__]: @x '<=' y '&&' y '<=' x@ ≡ @x '==' y@+-- [__Transitivity__]: @x '<=' y '&&' y '<=' z@ ≡ @x '<=' z@+-- [__Reflexivity__]: @x '<=' x@ ≡ @'True'@+-- [__Totality__]: @x '<=' y '||' y '<=' x@ ≡ @'True'@ ordLaws :: forall a. (Ord a, Show a) => Gen a -> Laws ordLaws gen = Laws "Ord" [ ("Antisymmetry", ordAntisymmetric gen)
src/Hedgehog/Classes/Semigroup.hs view
@@ -18,9 +18,9 @@ -- | Tests the following 'Semigroup' laws: ----- [__Associativity__]: @@ ≡ @@--- [__Concatenation__]: @@ ≡ @@--- [__Times__]: @@ ≡ @@+-- [__Associativity__]: @a '<>' (b '<>' c)@ ≡ @(a '<>' b) '<>' c@+-- [__Concatenation__]: @'sconcat'@ ≡ @'Foldable.foldr1' ('<>')@+-- [__Times__]: @'stimes' n a@ ≡ @'foldr1' ('<>') ('replicate' n a)@ semigroupLaws :: (Eq a, Semigroup a, Show a) => Gen a -> Laws semigroupLaws gen = Laws "Semigroup" [ ("Associativity", semigroupAssociative gen)@@ -30,7 +30,7 @@ -- | Tests the following 'Semigroup' laws: ----- [__Commutativity__]: @@ ≡ @@+-- [__Commutativity__]: @a '<>' b@ ≡ @b '<>' a@ commutativeSemigroupLaws :: (Eq a, Semigroup a, Show a) => Gen a -> Laws commutativeSemigroupLaws gen = Laws "Commutative Semigroup" [ ("Commutative", semigroupCommutative gen)@@ -38,7 +38,7 @@ -- | Tests the following 'Semigroup' laws: ----- [__Exponential__]: @@ ≡ @@+-- [__Exponentiality__]: @'stimes' n (a '<>' b)@ ≡ @'stimes' n a '<>' 'stimes' n b@ exponentialSemigroupLaws :: (Eq a, Semigroup a, Show a) => Gen a -> Laws exponentialSemigroupLaws gen = Laws "Exponential Semigroup" [ ("Exponential", semigroupExponential gen)@@ -46,7 +46,7 @@ -- | Tests the following 'Semigroup' laws: ----- [__Idempotent__]: @@ ≡ @@+-- [__Idempotency__]: @a '<>' a@ ≡ @a@ idempotentSemigroupLaws :: (Eq a, Semigroup a, Show a) => Gen a -> Laws idempotentSemigroupLaws gen = Laws "Idempotent Semigroup" [ ("Idempotent", semigroupIdempotent gen)@@ -54,7 +54,7 @@ -- | Tests the following 'Semigroup' laws: ----- [__Rectangular Band__]: @@ ≡ @@+-- [__Rectangular Bandedness__]: @a '<>' b '<>' a@ ≡ @a@ rectangularBandSemigroupLaws :: (Eq a, Semigroup a, Show a) => Gen a -> Laws rectangularBandSemigroupLaws gen = Laws "Rectangular Band Semigroup" [ ("Rectangular Band", semigroupRectangularBand gen)@@ -125,12 +125,12 @@ semigroupTimes :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property semigroupTimes gen = property $ do a <- forAll gen- n <- forAll (Gen.int Range.constantBounded)+ n <- forAll (Gen.int (Range.linear 2 5)) let lhs = stimes n a let rhs = Foldable.foldr1 (<>) (replicate n a) let ctx = contextualise $ LawContext { lawContextLawName = "Times", lawContextTcName = "Semigroup"- , lawContextLawBody = "stimes" `congruency` "(foldr1 (<>) .) . replicate"+ , lawContextLawBody = "stimes n a" `congruency` "foldr1 (<>) (replicate n a)" , lawContextReduced = reduced lhs rhs , lawContextTcProp = let showN = show n; showA = show a;@@ -146,7 +146,7 @@ semigroupExponential gen = property $ do a <- forAll gen b <- forAll gen- n <- forAll (Gen.int Range.constantBounded)+ n <- forAll (Gen.int (Range.linear 2 5)) let lhs = stimes n (a <> b) let rhs = stimes n a <> stimes n b let ctx = contextualise $ LawContext
src/Hedgehog/Classes/Show.hs view
@@ -7,12 +7,12 @@ -- | Tests the following 'Show' laws: ----- [__ __]: @@ ≡ @@--- [__ __]: @@ ≡ @@--- [__ __]: @@ ≡ @@+-- [__ShowsPrec Zero__]: @'show' a@ ≡ @'showsPrec' 0 a \"\"@+-- [__ShowsPrec Equivariance__]: @'showsPrec' p a r '++' s@ ≡ @'showsPrec p a (r '++' s)@+-- [__ShowsPrec ShowList__]: @'showList' as r '++' s@ ≡ @'showList' as (r '++' s)@ showLaws :: (Show a) => Gen a -> Laws showLaws gen = Laws "Show"- [ ("Show", showShowsPrecZero gen)+ [ ("ShowsPrec Zero", showShowsPrecZero gen) , ("Equivariance: showsPrec", equivarianceShowsPrec gen) , ("Equivariance: showList", equivarianceShowList gen) ]
src/Hedgehog/Classes/ShowRead.hs view
@@ -10,16 +10,18 @@ -- | Tests the following 'Show' / 'Read' laws: ----- [__ __]: @@ ≡ @@--- [__ __]: @@ ≡ @@--- [__ __]: @@ ≡ @@+-- [__Partial Isomorphism: show/read__]: @'readMaybe' '.' 'show'@ ≡ @'Just'@+-- [__Partial Isomorphism: show/read with initial space__]: @'readMaybe' '.' (\" \" '++') '.' 'show'@ ≡ @'Just'@+-- [__Partial Isomorphism: showsPrec/readPrec__]: @(a,\"\") `elem` 'readsPrec' p ('showsPrec' p a \"\")@ ≡ @'True'@+-- [__Partial Isomorphism: showList/readList__]: @(as,\"\") `elem` 'readList' ('showList' as \"\")@ ≡ @'True'@+-- [__Partial Isomorphism: showListWith shows/readListDefault__]: @(as,\"\") `elem` 'readListDefault' ('showListWith' 'shows' as \"\")@ ≡ @'True'@ showReadLaws :: (Eq a, Read a, Show a) => Gen a -> Laws showReadLaws gen = Laws "Show/Read" [ ("Partial Isomorphism: show/read", showReadPartialIsomorphism gen) , ("Partial Isomorphism: show/read with initial space", showReadSpacePartialIsomorphism gen) , ("Partial Isomorphism: showsPrec/readsPrec", showsPrecReadsPrecPartialIsomorphism gen) , ("Partial Isomorphism: showList/readList", showListReadListPartialIsomorphism gen)- , ("Partial Isomorphism: showListWith shows / readListDefault", showListWithShowsReadListDefaultPartialIsomorphism gen)+ , ("Partial Isomorphism: showListWith shows/readListDefault", showListWithShowsReadListDefaultPartialIsomorphism gen) ] showReadPartialIsomorphism :: forall a. (Eq a, Read a, Show a) => Gen a -> Property@@ -47,12 +49,12 @@ let rhs = Just a let ctx = contextualise $ LawContext { lawContextLawName = "Show/Read Partial Isomorphism With Initial Space", lawContextTcName = "Show/Read"- , lawContextLawBody = "readMaybe . (\" \" ++ show)" `congruency` "Just"+ , lawContextLawBody = "readMaybe . (\" \" ++) . show" `congruency` "Just" , lawContextReduced = reduced lhs rhs , lawContextTcProp = let showA = show a; in lawWhere- [ "readMaybe . (\" \" ++ show) $ a" `congruency` "Just a, where"+ [ "readMaybe . (\" \" ++) . show $ a" `congruency` "Just a, where" , "a = " ++ showA ] }
src/Hedgehog/Classes/Storable.hs view
@@ -18,18 +18,22 @@ -- | Tests the following 'Storable' laws: ----- [__ __]: @@ ≡ @@--- [__ __]: @@ ≡ @@--- [__ __]: @@ ≡ @@+-- [__Set-Get__]: @'pokeElemOff' ptr ix a '>>' 'peekElemOff' ptr ix@ ≡ @'pure' a@+-- [__Get-Set__]: @'peekElemOff' ptr ix '>>=' 'pokeElemOff' ptr ix@ ≡ @'pure' ()@ (Putting back what you got out has no effect)+-- [__List Conversion Roundtrips__]: Mallocing a list and then reconstructing it gives you the same list+-- [__PeekElemOff/Peek__]: @'peekElemOff' a i@ ≡ @'peek' ('plusPtr' a (i '*' 'sizeOf' 'undefined'))@+-- [__PokeElemOff/Poke__]: @'pokeElemOff' a i x@ ≡ @'poke' ('plusPtr' a (i '*' 'sizeOf' 'undefined')) x@+-- [__PeekByteOff/Peek__]: @'peekByteOff' a i@ ≡ @'peek' ('plusPtr' a i)@+-- [__PokeByteOff/Peek__]: @'pokeByteOff' a i x@ ≡ @'poke' ('plusPtr' a i) x@ storableLaws :: (Eq a, Show a, Storable a) => Gen a -> Laws storableLaws gen = Laws "Storable" [ ("Set-Get (you get back what you put in)", storableSetGet gen) , ("Get-Set (putting back what you got out has no effect)", storableGetSet gen) , ("List Conversion Roundtrips", storableList gen) , ("peekElemOff a i ≡ peek (plusPtr a (i * sizeOf undefined))", storablePeekElem gen)- , ("peekElemOff a i x ≡ poke (plusPtr a (i * sizeOf undefined)) x ≡ id ", storablePokeElem gen)+ , ("pokeElemOff a i x ≡ poke (plusPtr a (i * sizeOf undefined)) x ≡ id ", storablePokeElem gen) , ("peekByteOff a i ≡ peek (plusPtr a i)", storablePeekByte gen)- , ("peekByteOff a i x ≡ poke (plusPtr a i) x ≡ id ", storablePokeByte gen)+ , ("pokeByteOff a i x ≡ poke (plusPtr a i) x ≡ id ", storablePokeByte gen) ] genArray :: forall a. (Storable a) => Gen a -> Int -> IO (Ptr a)
+ test/Spec.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE LambdaCase #-}++module Main (main) where++import Hedgehog.Classes++import Spec.Alternative+import Spec.Applicative+import Spec.Arrow+import Spec.Bifoldable+import Spec.Bifunctor+import Spec.Bitraversable+import Spec.Bits+import Spec.Category+import Spec.Contravariant+import Spec.Enum+import Spec.Eq+import Spec.Foldable+import Spec.Functor+import Spec.Generic+import Spec.Integral+--import Spec.Ix+import Spec.Json+import Spec.Monad+import Spec.MonadIO+import Spec.MonadPlus+import Spec.MonadZip+import Spec.Monoid+import Spec.Ord+import Spec.Semigroup+import Spec.Show+import Spec.ShowRead+import Spec.Storable+import Spec.Traversable++main :: IO Bool+main = lawsCheckMany allLaws++allNullaryLaws :: [(String, [Laws])]+allNullaryLaws = testBits+ ++ testEnum+ ++ testBoundedEnum+ ++ testEq+ ++ testGeneric+ ++ testIntegral+-- ++ testIx+ ++ testJson+ ++ testMonoid+ ++ testCommutativeMonoid+ ++ testOrd+ ++ testSemigroup+ ++ testCommutativeSemigroup+ ++ testExponentialSemigroup+ ++ testIdempotentSemigroup+ ++ testRectangularBandSemigroup+ ++ testShow+ ++ testShowRead+ ++ testStorable++allUnaryLaws :: [(String, [Laws])]+allUnaryLaws = testAlternative+ ++ testApplicative+ ++ testContravariant+ ++ testFoldable+ ++ testFunctor+ ++ testMonad+ ++ testMonadIO+ ++ testMonadPlus+ ++ testMonadZip+ ++ testTraversable++allBinaryLaws :: [(String, [Laws])]+allBinaryLaws = testArrow+ ++ testBifoldable+ ++ testBifoldableFunctor+ ++ testBifunctor+ ++ testBitraversable+ ++ testCategory+ ++ testCommutativeCategory++allLaws :: [(String, [Laws])]+allLaws = allNullaryLaws ++ allUnaryLaws ++ allBinaryLaws
+ test/Spec/Alternative.hs view
@@ -0,0 +1,19 @@+module Spec.Alternative (testAlternative) where++import Hedgehog.Classes++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++testAlternative :: [(String, [Laws])]+testAlternative =+ [ ("[]", lawsList)+ , ("Maybe", lawsMaybe)+ ]++lawsList :: [Laws]+lawsList = [alternativeLaws (Gen.list (Range.linear 0 6))]++lawsMaybe :: [Laws]+lawsMaybe = [alternativeLaws Gen.maybe]+
+ test/Spec/Applicative.hs view
@@ -0,0 +1,76 @@+module Spec.Applicative (testApplicative) where++import Data.Functor.Compose (Compose(..))+import Data.Functor.Identity (Identity(..))++import Hedgehog+import Hedgehog.Classes++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Prelude hiding (either)++testApplicative :: [(String, [Laws])]+testApplicative =+ [ ("[]", lawsList)+ , ("Maybe", lawsMaybe)+ , ("Either e", lawsEither)+ , ("Compose", lawsCompose)+-- , ("Bin", lawsBin)+ ]++lawsList :: [Laws]+lawsList = [applicativeLaws (Gen.list (Range.linear 0 6))]++lawsMaybe :: [Laws]+lawsMaybe = [applicativeLaws Gen.maybe]++lawsEither :: [Laws]+lawsEither = [applicativeLaws eitherInteger]++lawsCompose :: [Laws]+lawsCompose = [applicativeLaws genCompose]++genCompose :: Gen a -> Gen (Compose Identity Identity a)+genCompose = fmap (Compose . Identity . Identity)++eitherInteger :: MonadGen m => m a -> m (Either Integer a)+eitherInteger = either (Gen.integral (Range.linear 0 20))++either :: MonadGen m => m e -> m a -> m (Either e a)+either genE genA =+ Gen.sized $ \n ->+ Gen.frequency [+ (2, Left <$> genE)+ , (1 + fromIntegral n, Right <$> genA)+ ]++{-+data Bin a = Leaf | Node (Bin a) a (Bin a)+ deriving (Eq, Show)++instance Functor Bin where+ fmap _ Leaf = Leaf+ fmap f (Node l x r) = Node (fmap f l) (f x) (fmap f r)++instance Applicative Bin where+ pure x = Node Leaf x Leaf+ Leaf <*> _ = Leaf+ _ <*> Leaf = Leaf+ Node fl fx fr <*> Node l x r = Node (fl <*> l) (fx x) (fr <*> r)++genBin' :: Gen a -> Gen (Bin a)+genBin' gen = do+ x <- gen+ pure $ Node (Node Leaf x (Node Leaf x Leaf)) x (Node (Node Leaf x Leaf) x Leaf)++genBin :: Gen a -> Gen (Bin a)+genBin gen = Gen.frequency+ [ (1, pure Leaf)+ , (6, genBin' gen)+ ]++lawsBin :: [Laws]+lawsBin = [applicativeLaws genBin]+-}
+ test/Spec/Arrow.hs view
@@ -0,0 +1,6 @@+module Spec.Arrow (testArrow) where++import Hedgehog.Classes++testArrow :: [(String, [Laws])]+testArrow = []
+ test/Spec/Bifoldable.hs view
@@ -0,0 +1,37 @@+module Spec.Bifoldable (testBifoldable, testBifoldableFunctor) where++import Data.Functor.Const (Const(..))+import Hedgehog+import Hedgehog.Classes++import qualified Hedgehog.Gen as Gen+import Prelude hiding (either, const)++testBifoldable :: [(String, [Laws])]+testBifoldable =+ [ ("Either", lawsEither)+ , ("Const", lawsConst) + ]++testBifoldableFunctor :: [(String, [Laws])]+testBifoldableFunctor =+ [ ("Either", lawsEither)+ , ("Const", lawsConst)+ ]++lawsEither :: [Laws]+lawsEither = [bifoldableLaws either]++lawsConst :: [Laws]+lawsConst = [bifoldableLaws const]++const :: MonadGen m => m a -> m b -> m (Const a b)+const genA _genB = fmap Const genA++either :: MonadGen m => m e -> m a -> m (Either e a)+either genE genA =+ Gen.sized $ \n ->+ Gen.frequency [+ (2, Left <$> genE)+ , (1 + fromIntegral n, Right <$> genA)+ ]
+ test/Spec/Bifunctor.hs view
@@ -0,0 +1,31 @@+module Spec.Bifunctor (testBifunctor) where++import Data.Functor.Const (Const(..))+import Hedgehog+import Hedgehog.Classes++import qualified Hedgehog.Gen as Gen+import Prelude hiding (either, const)++testBifunctor :: [(String, [Laws])]+testBifunctor =+ [ ("Either", lawsEither)+ , ("Const", lawsConst) + ]++lawsEither :: [Laws]+lawsEither = [bifunctorLaws either]++lawsConst :: [Laws]+lawsConst = [bifunctorLaws const]++const :: MonadGen m => m a -> m b -> m (Const a b)+const genA _genB = fmap Const genA++either :: MonadGen m => m e -> m a -> m (Either e a)+either genE genA =+ Gen.sized $ \n ->+ Gen.frequency [+ (2, Left <$> genE)+ , (1 + fromIntegral n, Right <$> genA)+ ]
+ test/Spec/Bitraversable.hs view
@@ -0,0 +1,31 @@+module Spec.Bitraversable (testBitraversable) where++import Data.Functor.Const (Const(..))+import Hedgehog+import Hedgehog.Classes++import qualified Hedgehog.Gen as Gen+import Prelude hiding (either, const)++testBitraversable :: [(String, [Laws])]+testBitraversable =+ [ ("Either", lawsEither)+ , ("Const", lawsConst) + ]++lawsEither :: [Laws]+lawsEither = [bitraversableLaws either]++lawsConst :: [Laws]+lawsConst = [bitraversableLaws const]++const :: MonadGen m => m a -> m b -> m (Const a b)+const genA _genB = fmap Const genA++either :: MonadGen m => m e -> m a -> m (Either e a)+either genE genA =+ Gen.sized $ \n ->+ Gen.frequency [+ (2, Left <$> genE)+ , (1 + fromIntegral n, Right <$> genA)+ ]
+ test/Spec/Bits.hs view
@@ -0,0 +1,37 @@+module Spec.Bits (testBits) where++import Hedgehog.Classes++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++ranged :: (Bounded a, Num a) => (Range.Range a -> b) -> b+ranged f = f (Range.constantBounded)++testBits :: [(String, [Laws])]+testBits =+ [ ("Int", listInt)+ , ("Int8", listInt8)+ , ("Int16", listInt16)+ , ("Int32", listInt32)+ , ("Int64", listInt64)+ , ("Word", listWord)+ , ("Word8", listWord8)+ , ("Word16", listWord16)+ , ("Word32", listWord32)+ , ("Word64", listWord64) + ]++listInt, listInt8, listInt16, listInt32, listInt64 :: [Laws]+listInt = [bitsLaws (ranged Gen.int)]+listInt8 = [bitsLaws (ranged Gen.int8)]+listInt16 = [bitsLaws (ranged Gen.int16)]+listInt32 = [bitsLaws (ranged Gen.int32)]+listInt64 = [bitsLaws (ranged Gen.int64)]++listWord, listWord8, listWord16, listWord32, listWord64 :: [Laws]+listWord = [bitsLaws (ranged Gen.word)]+listWord8 = [bitsLaws (ranged Gen.word8)]+listWord16 = [bitsLaws (ranged Gen.word16)]+listWord32 = [bitsLaws (ranged Gen.word32)]+listWord64 = [bitsLaws (ranged Gen.word64)]
+ test/Spec/Category.hs view
@@ -0,0 +1,9 @@+module Spec.Category (testCategory, testCommutativeCategory) where++import Hedgehog.Classes++testCategory :: [(String, [Laws])]+testCategory = []++testCommutativeCategory :: [(String, [Laws])]+testCommutativeCategory = []
+ test/Spec/Contravariant.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE DerivingVia #-}++module Spec.Contravariant (testContravariant) where++import Hedgehog+import Hedgehog.Classes++import Data.Functor.Contravariant+import Data.Functor.Const (Const(..))+import Data.Functor.Sum (Sum(..))+import Data.Functor.Product (Product(..))+import Data.Proxy (Proxy(..))++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++testContravariant :: [(String, [Laws])]+testContravariant =+ [ ("Proxy", listProxy)+ , ("Const", listConst)+ , ("Sum", listSum)+ , ("Product", listProduct)+-- , ("Bad Contravariant", listBadContravariant) + ]++listProxy :: [Laws]+listProxy = [contravariantLaws genProxy]++listConst :: [Laws]+listConst = [contravariantLaws genConst]++listSum :: [Laws]+listSum = [contravariantLaws genSum]++listProduct :: [Laws]+listProduct = [contravariantLaws genProduct]++--listBadContravariant :: [Laws]+--listBadContravariant = [contravariantLaws genBadContravariant]++genProxy :: Gen a -> Gen (Proxy a)+genProxy = const (pure Proxy)++genConst :: Gen b -> Gen (Const Integer b)+genConst _ = fmap Const (Gen.integral (Range.linear 0 20))++genSum :: Gen a -> Gen (Sum (Const ()) (Const ()) a)+genSum _genA =+ Gen.sized $ \n ->+ Gen.frequency [+ (2, pure $ InL (Const ()))+ , (1 + fromIntegral n, pure $ InR (Const ()))+ ]++genProduct :: Gen a -> Gen (Product (Const ()) (Const ()) a)+genProduct _genA = do+ pure (Pair (Const ()) (Const ()))++{-+newtype BadContravariant a = BadContravariant (a -> a)++instance Show (BadContravariant a) where+ show _ = "BadContravariant <<Endo>>"++instance Eq a => Eq (BadContravariant a) where+ BadContravariant f == BadContravariant g = False++instance Contravariant BadContravariant where+ contramap f _ = BadContravariant id++genBadContravariant :: Gen a -> Gen (BadContravariant a)+genBadContravariant = fmap (BadContravariant . const)+-}+
+ test/Spec/Enum.hs view
@@ -0,0 +1,60 @@+module Spec.Enum (testEnum, testBoundedEnum) where++import Hedgehog+import Hedgehog.Classes++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++testEnum :: [(String, [Laws])]+testEnum = []++testBoundedEnum :: [(String, [Laws])]+testBoundedEnum =+ [ ("E", listE)+ , ("Int", listInt)+ , ("Int8", listInt8)+ , ("Int16", listInt16)+ , ("Int32", listInt32)+ , ("Int64", listInt64)+ , ("Word", listWord)+ , ("Word8", listWord8)+ , ("Word16", listWord16)+ , ("Word32", listWord32)+ , ("Word64", listWord64) + ]++listE :: [Laws]+listE = [boundedEnumLaws genE]++data E = E1 | E2 | E3 | E4 | E5 | E6 | E7 | E8+ deriving (Eq, Show, Enum, Bounded)++genE :: Gen E+genE = Gen.frequency+ [ (1, pure E1)+ , (1, pure E2)+ , (1, pure E3)+ , (1, pure E4)+ , (1, pure E5)+ , (1, pure E6)+ , (1, pure E7)+ , (1, pure E8)+ ]++ranged :: (Bounded a, Num a) => (Range.Range a -> b) -> b+ranged f = f (Range.constantBounded)++listInt, listInt8, listInt16, listInt32, listInt64 :: [Laws]+listInt = [boundedEnumLaws (ranged Gen.int)]+listInt8 = [boundedEnumLaws (ranged Gen.int8)]+listInt16 = [boundedEnumLaws (ranged Gen.int16)]+listInt32 = [boundedEnumLaws (ranged Gen.int32)]+listInt64 = [boundedEnumLaws (ranged Gen.int64)]++listWord, listWord8, listWord16, listWord32, listWord64 :: [Laws]+listWord = [boundedEnumLaws (ranged Gen.word)]+listWord8 = [boundedEnumLaws (ranged Gen.word8)]+listWord16 = [boundedEnumLaws (ranged Gen.word16)]+listWord32 = [boundedEnumLaws (ranged Gen.word32)]+listWord64 = [boundedEnumLaws (ranged Gen.word64)]
+ test/Spec/Eq.hs view
@@ -0,0 +1,59 @@+module Spec.Eq (testEq) where++import Hedgehog.Classes++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++ranged :: (Bounded a, Num a) => (Range.Range a -> b) -> b+ranged f = f (Range.constantBounded)++testEq :: [(String, [Laws])]+testEq =+ [ ("Int", listInt)+ , ("Int8", listInt8)+ , ("Int16", listInt16)+ , ("Int32", listInt32)+ , ("Int64", listInt64)+ , ("Word", listWord)+ , ("Word8", listWord8)+ , ("Word16", listWord16)+ , ("Word32", listWord32)+ , ("Word64", listWord64)+-- , ("BadEq", listBadEq)+ ]++listInt, listInt8, listInt16, listInt32, listInt64 :: [Laws]+listInt = [eqLaws (ranged Gen.int)]+listInt8 = [eqLaws (ranged Gen.int8)]+listInt16 = [eqLaws (ranged Gen.int16)]+listInt32 = [eqLaws (ranged Gen.int32)]+listInt64 = [eqLaws (ranged Gen.int64)]++listWord, listWord8, listWord16, listWord32, listWord64 :: [Laws]+listWord = [eqLaws (ranged Gen.word)]+listWord8 = [eqLaws (ranged Gen.word8)]+listWord16 = [eqLaws (ranged Gen.word16)]+listWord32 = [eqLaws (ranged Gen.word32)]+listWord64 = [eqLaws (ranged Gen.word64)]++{-+listBadEq :: [Laws]+listBadEq = [ eqLaws $ pure BadReflexive ]+ ++ [ eqLaws $ Gen.frequency [(1, pure BadSymmetric1),(1,pure BadSymmetric2)] ]++data BadReflexive = BadReflexive+ deriving (Show)++instance Eq BadReflexive where+ _ == _ = False++data BadSymmetric = BadSymmetric1 | BadSymmetric2+ deriving (Show)++instance Eq BadSymmetric where+ BadSymmetric1 == BadSymmetric1 = True+ BadSymmetric2 == BadSymmetric2 = True+ BadSymmetric2 == BadSymmetric1 = True+ BadSymmetric1 == BadSymmetric2 = False+-}
+ test/Spec/Foldable.hs view
@@ -0,0 +1,40 @@+module Spec.Foldable (testFoldable) where++import Hedgehog+import Hedgehog.Classes++import Data.Set (Set)+import qualified Data.Set as Set++import qualified Data.List as List+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++testFoldable :: [(String, [Laws])]+testFoldable =+ [ ("Set", listSet)+-- , ("BadList", listBadList) + ]++listSet :: [Laws]+listSet = [foldableLaws genSet]++genSet :: Gen a -> Gen (Set a)+genSet gen = do+ x <- gen+ pure (Set.singleton x)++{-+listBadList :: [Laws]+listBadList = [foldableLaws genBadList]++genBadList :: Gen a -> Gen (BadList a)+genBadList gen = BadList <$> Gen.list (Range.linear 0 20) gen++newtype BadList a = BadList [a]+ deriving (Eq, Show)++instance Foldable BadList where+ foldMap f (BadList x) = foldMap f x+ foldl' = List.foldl+-}
+ test/Spec/Functor.hs view
@@ -0,0 +1,46 @@+module Spec.Functor (testFunctor) where++import Data.Functor.Compose (Compose(..))+import Data.Functor.Identity (Identity(..))++import Hedgehog+import Hedgehog.Classes++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Prelude hiding (either)++testFunctor :: [(String, [Laws])]+testFunctor =+ [ ("[]", lawsList)+ , ("Maybe", lawsMaybe)+ , ("Either e", lawsEither)+ , ("Compose", lawsCompose)+ ]++lawsList :: [Laws]+lawsList = [functorLaws (Gen.list (Range.linear 0 6))]++lawsMaybe :: [Laws]+lawsMaybe = [functorLaws Gen.maybe]++lawsEither :: [Laws]+lawsEither = [functorLaws eitherInteger]++lawsCompose :: [Laws]+lawsCompose = [functorLaws genCompose]++genCompose :: Gen a -> Gen (Compose Identity Identity a)+genCompose = fmap (Compose . Identity . Identity)++eitherInteger :: MonadGen m => m a -> m (Either Integer a)+eitherInteger = either (Gen.integral (Range.linear 0 20))++either :: MonadGen m => m e -> m a -> m (Either e a)+either genE genA =+ Gen.sized $ \n ->+ Gen.frequency [+ (2, Left <$> genE)+ , (1 + fromIntegral n, Right <$> genA)+ ]
+ test/Spec/Generic.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE DeriveGeneric #-}++module Spec.Generic (testGeneric) where++import Hedgehog+import Hedgehog.Classes+import qualified Hedgehog.Gen as Gen++import GHC.Generics (Generic(..))++testGeneric :: [(String, [Laws])]+testGeneric =+ [ ("E", listE)+ , ("Bool", listBool) + , ("Maybe Bool", listMaybe) + ]++listE :: [Laws]+listE = [genericLaws genE (genRep genE)]++listBool :: [Laws]+listBool = [genericLaws Gen.bool (genRep Gen.bool)]++listMaybe :: [Laws]+listMaybe = [genericLaws (Gen.maybe Gen.bool) (genRep (Gen.maybe Gen.bool))]++data E = E1 | E2 | E3 | E4 | E5 | E6 | E7 | E8+ deriving (Eq, Show, Generic)++genRep :: Generic a => Gen a -> Gen (Rep a ())+genRep gen = do+ x <- gen+ pure (from x)++genE :: Gen E+genE = Gen.frequency+ [ (1, pure E1)+ , (1, pure E2)+ , (1, pure E3)+ , (1, pure E4)+ , (1, pure E5)+ , (1, pure E6)+ , (1, pure E7)+ , (1, pure E8)+ ]
+ test/Spec/Integral.hs view
@@ -0,0 +1,37 @@+module Spec.Integral (testIntegral) where++import Hedgehog.Classes++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++ranged :: (Bounded a, Integral a) => (Range.Range a -> b) -> b+ranged f = f (Range.linear 1 maxBound)++testIntegral :: [(String, [Laws])]+testIntegral =+ [ ("Int", listInt)+ , ("Int8", listInt8)+ , ("Int16", listInt16)+ , ("Int32", listInt32)+ , ("Int64", listInt64)+ , ("Word", listWord)+ , ("Word8", listWord8)+ , ("Word16", listWord16)+ , ("Word32", listWord32)+ , ("Word64", listWord64) + ]++listInt, listInt8, listInt16, listInt32, listInt64 :: [Laws]+listInt = [integralLaws (ranged Gen.int)]+listInt8 = [integralLaws (ranged Gen.int8)]+listInt16 = [integralLaws (ranged Gen.int16)]+listInt32 = [integralLaws (ranged Gen.int32)]+listInt64 = [integralLaws (ranged Gen.int64)]++listWord, listWord8, listWord16, listWord32, listWord64 :: [Laws]+listWord = [integralLaws (ranged Gen.word)]+listWord8 = [integralLaws (ranged Gen.word8)]+listWord16 = [integralLaws (ranged Gen.word16)]+listWord32 = [integralLaws (ranged Gen.word32)]+listWord64 = [integralLaws (ranged Gen.word64)]
+ test/Spec/Json.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE DeriveGeneric #-}++module Spec.Json (testJson) where++import Hedgehog+import Hedgehog.Classes+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import GHC.Generics (Generic)++import Data.Aeson (FromJSON, ToJSON)++testJson :: [(String, [Laws])]+testJson =+ [ ("Person", listPerson)+ ]++data Person = Person { name :: String, age :: Int }+ deriving (Eq, Show, Generic)++instance FromJSON Person where+instance ToJSON Person where++listPerson :: [Laws]+listPerson = [jsonLaws genPerson]++genPerson :: Gen Person+genPerson = Person <$> (Gen.string (Range.linear 3 7) Gen.alpha) <*> (Gen.int (Range.linear 0 65))
+ test/Spec/Monad.hs view
@@ -0,0 +1,39 @@+module Spec.Monad (testMonad) where++import Data.Functor.Compose (Compose(..))+import Data.Functor.Identity (Identity(..))++import Hedgehog+import Hedgehog.Classes++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Prelude hiding (either)++testMonad :: [(String, [Laws])]+testMonad =+ [ ("[]", lawsList)+ , ("Maybe", lawsMaybe)+ , ("Either e", lawsEither)+ ]++lawsList :: [Laws]+lawsList = [monadLaws (Gen.list (Range.linear 0 6))]++lawsMaybe :: [Laws]+lawsMaybe = [monadLaws Gen.maybe]++lawsEither :: [Laws]+lawsEither = [monadLaws eitherInteger]++eitherInteger :: MonadGen m => m a -> m (Either Integer a)+eitherInteger = either (Gen.integral (Range.linear 0 20))++either :: MonadGen m => m e -> m a -> m (Either e a)+either genE genA =+ Gen.sized $ \n ->+ Gen.frequency [+ (2, Left <$> genE)+ , (1 + fromIntegral n, Right <$> genA)+ ]
+ test/Spec/MonadIO.hs view
@@ -0,0 +1,6 @@+module Spec.MonadIO (testMonadIO) where++import Hedgehog.Classes++testMonadIO :: [(String, [Laws])]+testMonadIO = []
+ test/Spec/MonadPlus.hs view
@@ -0,0 +1,6 @@+module Spec.MonadPlus (testMonadPlus) where++import Hedgehog.Classes++testMonadPlus :: [(String, [Laws])]+testMonadPlus = []
+ test/Spec/MonadZip.hs view
@@ -0,0 +1,6 @@+module Spec.MonadZip (testMonadZip) where++import Hedgehog.Classes++testMonadZip :: [(String, [Laws])]+testMonadZip = []
+ test/Spec/Monoid.hs view
@@ -0,0 +1,46 @@+module Spec.Monoid (testMonoid, testCommutativeMonoid) where++import Hedgehog (Gen)+import Hedgehog.Classes++import Data.Coerce (coerce)+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Data.Monoid++testMonoid :: [(String, [Laws])]+testMonoid =+ [ ("Sum Integer", lawsSum)+ , ("Product Integer", lawsProduct)+ , ("Maybe Integer", lawsMaybe)+ , ("Ap Maybe Integer", lawsAp)+ ]++testCommutativeMonoid :: [(String, [Laws])]+testCommutativeMonoid =+ [ ("Sum Integer", lawsSum)+ , ("Product Integer", lawsProduct)+ , ("Maybe Integer", lawsMaybe)+ ]++lawsSum, lawsProduct, lawsMaybe, lawsAp :: [Laws]++lawsSum = [monoidLaws genSum]+lawsProduct = [monoidLaws genProduct]+lawsMaybe = [monoidLaws genMaybe]+lawsAp = [monoidLaws genAp]++genInteger :: Gen Integer+genInteger = Gen.integral (Range.linear (-3) 20)++genSum :: Gen (Sum Integer)+genSum = fmap coerce genInteger++genProduct :: Gen (Product Integer)+genProduct = fmap coerce genInteger++genMaybe :: Gen (Maybe (Sum Integer))+genMaybe = Gen.maybe genSum++genAp :: Gen (Ap Maybe (Sum Integer))+genAp = fmap coerce genMaybe
+ test/Spec/Ord.hs view
@@ -0,0 +1,7 @@+module Spec.Ord (testOrd) where++import Hedgehog.Classes++testOrd :: [(String, [Laws])]+testOrd = []+
+ test/Spec/Semigroup.hs view
@@ -0,0 +1,35 @@+module Spec.Semigroup+ ( testSemigroup+ , testCommutativeSemigroup+ , testExponentialSemigroup+ , testIdempotentSemigroup+ , testRectangularBandSemigroup+ ) where++import Hedgehog.Classes++import Data.Monoid (Sum(..))+import Hedgehog (Gen)+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++testSemigroup :: [(String, [Laws])]+testSemigroup = [("Maybe", listMaybe)]++listMaybe :: [Laws]+listMaybe = map ($ genMaybe) [semigroupLaws, commutativeSemigroupLaws]++genMaybe :: Gen (Maybe (Sum Int))+genMaybe = Gen.maybe (fmap Sum $ Gen.int Range.constantBounded)++testCommutativeSemigroup :: [(String, [Laws])]+testCommutativeSemigroup = []++testExponentialSemigroup :: [(String, [Laws])]+testExponentialSemigroup = []++testIdempotentSemigroup :: [(String, [Laws])]+testIdempotentSemigroup = []++testRectangularBandSemigroup :: [(String, [Laws])]+testRectangularBandSemigroup = []
+ test/Spec/Show.hs view
@@ -0,0 +1,6 @@+module Spec.Show (testShow) where++import Hedgehog.Classes++testShow :: [(String, [Laws])]+testShow = []
+ test/Spec/ShowRead.hs view
@@ -0,0 +1,6 @@+module Spec.ShowRead (testShowRead) where++import Hedgehog.Classes++testShowRead :: [(String, [Laws])]+testShowRead = []
+ test/Spec/Storable.hs view
@@ -0,0 +1,6 @@+module Spec.Storable (testStorable) where++import Hedgehog.Classes++testStorable :: [(String, [Laws])]+testStorable = []
+ test/Spec/Traversable.hs view
@@ -0,0 +1,6 @@+module Spec.Traversable (testTraversable) where++import Hedgehog.Classes++testTraversable :: [(String, [Laws])]+testTraversable = []