packages feed

genvalidity-containers 0.1.0.2 → 1.0.0.2

raw patch · 17 files changed

Files

+ CHANGELOG.md view
@@ -0,0 +1,86 @@+# Changelog++## [1.0.0.2] - 2022-08-30++### Added++* `GenValid a => GenValid (IntMap a)`++## [1.0.0.1] - 2022-08-30++### Added++* `shrinkSetOf`, `shrinkSeqOf`, `shrinkMapOf`, and `shrinkTreeOf`++## [1.0.0.0] - 2021-11-20++### Changed++* Compatibility with `genvalidity >= 1.0.0.0`++### Removed++* `genStructurallyValidMapOf`+* `genStructurallyValidMapOfInvalidValues`+* `genStructurallyInvalidMap`+* `genStructurallyValidSetOf`+* `genStructurallyValidSetOfInvalidValues`+* `genStructurallyInvalidSet`++## [0.9.0.0] - 2020-06-14++### Added++* `genMapOf`+* `genSeqOf`+* `genSetOf`++### Changed++* Improved the generation of Set, Seq and Map to generate more appropriately (bigger) sized collections++## [0.8.0.2] - 2020-02-10++### Changed++* Improved the cabal file+* Removed the show constraint for keys on 'GenUnchecked (Map k v)'+* Removed the shrinking tests for trees++## [0.8.0.1] - 2019-12-04++### Changed++* Changed the way trees are generated.+  They will no longer be as top-heavy or under-sized.++## [0.8.0.0] - 2019-09-23++### Changed++* No longer require a 'Show' instance of the map's key for `GenUnchecked`++## [0.7.0.0] - 2019-09-23++### Changed++* Compatibility with validity-containers >=0.5+* Test suite compatibility with genvalidity-property >=0.5++## [0.6.0.0] - 2019-03-06++### Changed++* Fixed type signatures to be compatible with genvalidity >=0.8++## [0.5.1.1] - 2018-11-07++### Changed++* Test suite compatibility with validity >=0.9++## [0.5.1.0] - 2018-10-06++### Changed++* Sped up `shrinkValid` for `Tree`
LICENSE view
@@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2016 Tom Sydney Kerckhove+Copyright (c) 2016-2021 Tom Sydney Kerckhove  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal
− Setup.hs 
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
+ bench/Main.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Main where++import Criterion.Main as Criterion+import Data.GenValidity+import Data.GenValidity.Containers+import Data.GenValidity.Criterion+import Data.Map (Map)+import Data.Sequence (Seq)+import Data.Set (Set)+import Data.Tree (Forest, Tree)+import Test.QuickCheck++main :: IO ()+main =+  Criterion.defaultMain+    [ bgroup+        "generators"+        [ genValidBench @(Set Int),+          genValidBench @(Seq Int),+          genValidBench @(Tree Int),+          genValidBench @(Forest Int),+          genValidBench @(Map Int Int),+          genBench "genSeqOf" $ genSeqOf (genValid :: Gen Int),+          genBench "genSetOf" $ genSetOf (genValid :: Gen Int),+          genBench "genMapOf" $ genMapOf (genValid :: Gen (Int, Int)),+          genBench "genTreeOf" $ genTreeOf (genValid :: Gen (Int, Int))+        ],+      bgroup+        "shrinkers"+        [ shrinkValidBench @(Set Int),+          shrinkValidBench @(Seq Int),+          shrinkValidBench @(Tree Int),+          shrinkValidBench @(Forest Int),+          shrinkValidBench @(Map Int Int),+          shrinkBench "shrinkSeqOf" $ shrinkSeqOf (shrinkValid :: Int -> [Int]),+          shrinkBench "shrinkSetOf" $ shrinkSetOf (shrinkValid :: Int -> [Int]),+          shrinkBench "shrinkMapOf" $ shrinkMapOf (shrinkValid :: (Int, Int) -> [(Int, Int)]),+          shrinkBench "shrinkTreeOf" $ shrinkTreeOf (shrinkValid :: Int -> [Int])+        ]+    ]
genvalidity-containers.cabal view
@@ -1,33 +1,90 @@-name:                genvalidity-containers-version:             0.1.0.2-synopsis:            GenValidity support for containers-description:         Please see README.md-homepage:            https://github.com/NorfairKing/validity#readme-license:             MIT-license-file:        LICENSE-author:              Tom Sydney Kerckhove-maintainer:          syd.kerckhove@gmail.com-copyright:           Copyright: (c) 2016 Tom Sydney Kerckhove-category:            Testing-build-type:          Simple--- extra-source-files:-cabal-version:       >=1.10+cabal-version: 1.12 +-- This file has been generated from package.yaml by hpack version 0.36.0.+--+-- see: https://github.com/sol/hpack++name:           genvalidity-containers+version:        1.0.0.2+synopsis:       GenValidity support for containers+category:       Testing+homepage:       https://github.com/NorfairKing/validity#readme+bug-reports:    https://github.com/NorfairKing/validity/issues+author:         Tom Sydney Kerckhove+maintainer:     syd@cs-syd.eu+copyright:      Copyright: (c) 2016-2022 Tom Sydney Kerckhove+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    LICENSE+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/NorfairKing/validity+ library-  hs-source-dirs:      src   exposed-modules:       Data.GenValidity.Containers-    , Data.GenValidity.Map-    , Data.GenValidity.Tree+      Data.GenValidity.IntMap+      Data.GenValidity.Map+      Data.GenValidity.Sequence+      Data.GenValidity.Set+      Data.GenValidity.Tree+  other-modules:+      Paths_genvalidity_containers+  hs-source-dirs:+      src   build-depends:-      base       < 5-    , validity-    , validity-containers-    , genvalidity+      QuickCheck+    , base >=4.9 && <=5+    , containers >=0.6.0.1+    , genvalidity >=1.0+    , validity >=0.5+    , validity-containers >=0.3+  default-language: Haskell2010++test-suite genvalidity-containers-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Data.GenValidity.Containers.IntMapSpec+      Data.GenValidity.Containers.MapSpec+      Data.GenValidity.Containers.SeqSpec+      Data.GenValidity.Containers.SetSpec+      Data.GenValidity.Containers.TreeSpec+      Paths_genvalidity_containers+  hs-source-dirs:+      test/+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  build-depends:+      QuickCheck+    , base >=4.9 && <=5     , containers-    , QuickCheck-  default-language:    Haskell2010+    , genvalidity+    , genvalidity-containers+    , genvalidity-hspec+    , genvalidity-property+    , hspec+    , validity >=0.9+    , validity-containers+  default-language: Haskell2010 -source-repository head-  type:     git-  location: https://github.com/NorfairKing/validity+benchmark genvalidity-containers-bench+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Paths_genvalidity_containers+  hs-source-dirs:+      bench/+  ghc-options: -Wall+  build-depends:+      QuickCheck+    , base >=4.9 && <=5+    , containers+    , criterion+    , genvalidity+    , genvalidity-containers+    , genvalidity-criterion >=1.1.0.0+  default-language: Haskell2010
src/Data/GenValidity/Containers.hs view
@@ -1,7 +1,10 @@ module Data.GenValidity.Containers-    ( module Containers-    ) where--import           Data.GenValidity.Map  as Containers ()-import           Data.GenValidity.Tree as Containers+  ( module Containers,+  )+where +import Data.GenValidity.IntMap as Containers+import Data.GenValidity.Map as Containers+import Data.GenValidity.Sequence as Containers+import Data.GenValidity.Set as Containers+import Data.GenValidity.Tree as Containers
+ src/Data/GenValidity/IntMap.hs view
@@ -0,0 +1,23 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Data.GenValidity.IntMap+  ( genIntMapOf,+    shrinkIntMapOf,+  )+where++import Data.GenValidity+import Data.IntMap (IntMap)+import qualified Data.IntMap as M+import Data.Validity.IntMap ()+import Test.QuickCheck++instance (GenValid v) => GenValid (IntMap v) where+  genValid = genIntMapOf genValid+  shrinkValid = shrinkIntMapOf shrinkValid++genIntMapOf :: Gen (Int, v) -> Gen (IntMap v)+genIntMapOf g = M.fromList <$> genListOf g++shrinkIntMapOf :: ((Int, v) -> [(Int, v)]) -> IntMap v -> [IntMap v]+shrinkIntMapOf shrinker = fmap M.fromList . shrinkList shrinker . M.toList
src/Data/GenValidity/Map.hs view
@@ -1,15 +1,23 @@-module Data.GenValidity.Map where--import           Data.GenValidity-import           Data.Validity.Map ()+{-# OPTIONS_GHC -fno-warn-orphans #-} -import           Data.Map         (Map)-import qualified Data.Map         as M+module Data.GenValidity.Map+  ( genMapOf,+    shrinkMapOf,+  )+where -instance (Ord k, GenValidity k, GenValidity v) => GenValidity (Map k v) where-    genUnchecked = M.fromList <$> genUnchecked+import Data.GenValidity+import Data.Map (Map)+import qualified Data.Map as M+import Data.Validity.Map ()+import Test.QuickCheck -    genValid     = M.fromList <$> genValid+instance (Show k, Ord k, GenValid k, GenValid v) => GenValid (Map k v) where+  genValid = genMapOf genValid+  shrinkValid = shrinkMapOf shrinkValid -    genInvalid   = M.fromList <$> genInvalid+genMapOf :: (Ord k) => Gen (k, v) -> Gen (Map k v)+genMapOf g = M.fromList <$> genListOf g +shrinkMapOf :: (Ord k) => ((k, v) -> [(k, v)]) -> Map k v -> [Map k v]+shrinkMapOf shrinker = fmap M.fromList . shrinkList shrinker . M.toList
+ src/Data/GenValidity/Sequence.hs view
@@ -0,0 +1,24 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Data.GenValidity.Sequence+  ( genSeqOf,+    shrinkSeqOf,+  )+where++import Data.Foldable (toList)+import Data.GenValidity+import Data.Sequence (Seq)+import qualified Data.Sequence as S+import Data.Validity.Sequence ()+import Test.QuickCheck++instance (GenValid v) => GenValid (Seq v) where+  genValid = genSeqOf genValid+  shrinkValid = shrinkSeqOf shrinkValid++genSeqOf :: Gen v -> Gen (Seq v)+genSeqOf g = S.fromList <$> genListOf g++shrinkSeqOf :: (v -> [v]) -> Seq v -> [Seq v]+shrinkSeqOf shrinker = fmap S.fromList . shrinkList shrinker . toList
+ src/Data/GenValidity/Set.hs view
@@ -0,0 +1,51 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Data.GenValidity.Set+  ( genSetOf,+    shrinkSetOf,+    genSeperate,+    genSeperateFor,+    genSeperateForNE,+    genValidSeperateFor,+    genValidSeperateForNE,+  )+where++import Data.Containers.ListUtils+import Data.GenValidity+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Set (Set)+import qualified Data.Set as S+import Data.Validity.Set ()+import Test.QuickCheck++instance (Ord v, GenValid v) => GenValid (Set v) where+  genValid = genSetOf genValid+  shrinkValid = shrinkSetOf shrinkValid++genSetOf :: (Ord v) => Gen v -> Gen (Set v)+genSetOf g = S.fromList <$> genListOf g++shrinkSetOf :: (Ord v) => (v -> [v]) -> Set v -> [Set v]+shrinkSetOf shrinker = fmap S.fromList . shrinkList shrinker . S.toList++genValidSeperateFor :: (GenValid b, Eq b) => [a] -> Gen [(b, a)]+genValidSeperateFor = genSeperateFor genValid++genValidSeperateForNE :: (GenValid b, Eq b) => NonEmpty a -> Gen (NonEmpty (b, a))+genValidSeperateForNE = genSeperateForNE genValid++genSeperate :: (Ord a) => Gen a -> Gen [a]+genSeperate g = nubOrd <$> genListOf g++-- TODO these two can likely be optimised+genSeperateFor :: (Eq b) => Gen b -> [a] -> Gen [(b, a)]+genSeperateFor _ [] = pure []+genSeperateFor g (a : as) = NE.toList <$> genSeperateForNE g (a :| as)++genSeperateForNE :: (Eq b) => Gen b -> NonEmpty a -> Gen (NonEmpty (b, a))+genSeperateForNE g (a :| as) = do+  restTups <- genSeperateFor g as+  b <- g `suchThat` (`notElem` map fst restTups)+  pure ((b, a) :| restTups)
src/Data/GenValidity/Tree.hs view
@@ -1,35 +1,50 @@-module Data.GenValidity.Tree where--import           Data.GenValidity-import           Data.Validity.Tree ()--import           Test.QuickCheck+{-# OPTIONS_GHC -fno-warn-orphans #-} -import           Data.Tree+module Data.GenValidity.Tree (genTreeOf, shrinkTreeOf) where -instance GenValidity a => GenValidity (Tree a) where-    genUnchecked = genTreeOf genUnchecked+import Data.GenValidity+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Tree+import Data.Validity.Tree ()+import Test.QuickCheck -    genValid     = genTreeOf genValid+instance (GenValid a) => GenValid (Tree a) where+  genValid = genTreeOf genValid+  shrinkValid = shrinkTreeOf shrinkValid -    -- | There should be at least one invalid element, either it's here or it's-    -- further down the tree.-    genInvalid   = sized $ \n -> do-        size   <- upTo n-        (a, b) <- genSplit size-        oneof-            [ Node <$> resize a genInvalid   <*> resize b genUnchecked-            , Node <$> resize a genUnchecked <*> resize b genInvalid-            ]+shrinkTreeOf :: (a -> [a]) -> Tree a -> [Tree a]+shrinkTreeOf shrinker (Node v ts) =+  [Node v' ts' | (v', ts') <- shrinkTuple shrinker (shrinkList (shrinkTreeOf shrinker)) (v, ts)]  -- | Generate a tree of values that are generated as specified. -- -- This takes the size parameter much better into account genTreeOf :: Gen a -> Gen (Tree a)-genTreeOf func = sized $ \n -> do-    size   <- upTo n-    (a, b) <- genSplit size-    value  <- resize a func-    forest <- resize b $ genListOf $ genTreeOf func-    return $ Node value forest+genTreeOf func = do+  ne <- genNonEmptyOf func+  turnIntoTree ne+  where+    turnIntoTree :: NonEmpty a -> Gen (Tree a)+    turnIntoTree (e :| es) = do+      groups <- turnIntoGroups es+      subtrees <- mapM turnIntoTree groups+      pure (Node e subtrees) +    turnIntoGroups :: [a] -> Gen [NonEmpty a]+    turnIntoGroups = go []+      where+        go :: [a] -> [a] -> Gen [NonEmpty a]+        go acc [] =+          case NE.nonEmpty acc of+            Nothing -> pure []+            Just ne -> pure [ne]+        go acc (e : es) =+          frequency+            [ ( 1,+                do+                  rest <- go [] es+                  pure ((e :| acc) : rest)+              ),+              (4, go (e : acc) es)+            ]
+ test/Data/GenValidity/Containers/IntMapSpec.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE TypeApplications #-}++module Data.GenValidity.Containers.IntMapSpec where++import Data.GenValidity+import Data.GenValidity.IntMap+import Data.IntMap (IntMap)+import Test.Hspec+import Test.Validity.GenValidity++spec :: Spec+spec = do+  describe "genIntMapOf" $+    it "produces valid maps" $+      genGeneratesValid+        (genIntMapOf @Rational genValid)+  genValidSpec @(IntMap Rational)+  genValidSpec @(IntMap Rational)
+ test/Data/GenValidity/Containers/MapSpec.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE TypeApplications #-}++module Data.GenValidity.Containers.MapSpec where++import Data.GenValidity+import Data.GenValidity.Map+import Data.Map (Map)+import Test.Hspec+import Test.Validity.GenValidity++spec :: Spec+spec = do+  describe "genMapOf" $+    it "produces valid maps" $+      genGeneratesValid+        (genMapOf @Rational @Rational genValid)+  genValidSpec @(Map Int Rational)+  genValidSpec @(Map Rational Rational)
+ test/Data/GenValidity/Containers/SeqSpec.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TypeApplications #-}++module Data.GenValidity.Containers.SeqSpec where++import Data.GenValidity.Sequence ()+import Data.Sequence (Seq)+import Test.Hspec+import Test.Validity.GenValidity++spec :: Spec+spec = do+  genValidSpec @(Seq Int)+  genValidSpec @(Seq Rational)
+ test/Data/GenValidity/Containers/SetSpec.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE TypeApplications #-}++module Data.GenValidity.Containers.SetSpec where++import Data.GenValidity+import Data.GenValidity.Set+import Data.Set (Set)+import Data.Validity.Containers+import Test.Hspec+import Test.QuickCheck+import Test.Validity++spec :: Spec+spec = do+  describe "genSetOf" $+    it "produces valid sets" $+      genGeneratesValid+        (genSetOf @Rational genValid)+  genValidSpec @(Set Int)+  genValidSpec @(Set Rational)+  describe "genSeperate" $ do+    it "generates values that are seperate" $+      forAll (genSeperate genValid) $+        \ls -> distinctOrd (ls :: [Int])+    it "generates values that are seperate" $+      forAll (genSeperate genValid) $+        \ls -> distinctOrd (ls :: [Int])+  describe "genSeperateFor" $ do+    it "generates values that are seperate" $+      forAllValid $ \ls ->+        forAll (genSeperateFor genValid ls) $ \tups -> distinctOrd (map fst (tups :: [(Int, Int)]))+    it "generates values that are seperate" $+      forAllValid $ \ls ->+        forAll (genSeperateFor genValid ls) $ \tups -> distinctOrd (map fst (tups :: [(Int, Int)]))+  describe "genValidSeperateFor" $+    it "generates values that are seperate" $+      forAllValid $ \ls ->+        forAll (genValidSeperateFor ls) $ \tups -> distinctOrd (map fst (tups :: [(Int, Int)]))
+ test/Data/GenValidity/Containers/TreeSpec.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TypeApplications #-}++module Data.GenValidity.Containers.TreeSpec where++import Data.GenValidity.Tree ()+import Data.Tree (Tree)+import Test.Hspec+import Test.Validity++spec :: Spec+spec = do+  genValidSpec @(Tree Int)+  genValidSpec @(Tree Rational)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}