summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorkindaro <>2020-09-15 12:06:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-09-15 12:06:00 (GMT)
commitc6c352dff475180f5d6dceaca05b8a4f410f025c (patch)
tree6df5e748bd266d213462f4a9221ed0ae64066afa
parent1e9b02d110364163d6688d0016b12836b50c3c1a (diff)
version 0.7.0.0HEAD0.7.0.0master
-rw-r--r--CHANGELOG.md4
-rw-r--r--Test/SmallCheck/Series/Instances.hs10
-rw-r--r--Test/SmallCheck/Series/Instances/Internal.hs33
-rw-r--r--smallcheck-series.cabal10
-rw-r--r--tests/Main.hs20
5 files changed, 75 insertions, 2 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 0c298ce..a694637 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -4,6 +4,10 @@ follows the formatting recommendations from [Keep a
CHANGELOG](http://keepachangelog.com/). This project adheres to [Semantic
Versioning](http://semver.org/).
+## [0.7.0.0] — Tuesday, 15 of September 2020
+### Added
+- An instance `Serial` for `Set`.
+
## [0.6.1.1] - Tuesday, 15 of September 2020
### Fixed
- Allow `base` versions up to `4.15`.
diff --git a/Test/SmallCheck/Series/Instances.hs b/Test/SmallCheck/Series/Instances.hs
index 13c3558..0be0789 100644
--- a/Test/SmallCheck/Series/Instances.hs
+++ b/Test/SmallCheck/Series/Instances.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -20,6 +21,7 @@
* 'Data.Text.Text'
* 'Data.Text.Lazy.Text'
* 'Data.Text.Lazy.Text'
+* 'Data.Set.Set'
* 'Data.Map.Map'
By default the most exhaustive series are provided which can lead to
@@ -42,6 +44,9 @@ import Control.Monad.Logic (interleave)
import Data.Int
import Data.Word
#endif
+import Data.Functor.Identity (Identity)
+import qualified Data.Set as Set
+import Data.Set (Set)
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.ByteString as B
@@ -49,7 +54,7 @@ import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Test.SmallCheck.Series
-
+import Test.SmallCheck.Series.Instances.Internal
#if !MIN_VERSION_smallcheck(1,1,4)
instance Monad m => Serial m Int8 where series = ints
@@ -151,6 +156,9 @@ instance Monad m => CoSerial m TL.Text where
Nothing -> y
Just (b,bs') -> f (TL.singleton b) bs'
+instance (Num a, Ord a, Serial m a, Serial Identity a) => Serial m (Set a) where
+ series = fmap Set.fromList sets
+
instance (Serial m k, Serial m v) => Serial m (Map k v) where
series = Map.singleton <$> series <~> series
instance (Ord k, CoSerial m k, CoSerial m v) => CoSerial m (Map k v) where
diff --git a/Test/SmallCheck/Series/Instances/Internal.hs b/Test/SmallCheck/Series/Instances/Internal.hs
new file mode 100644
index 0000000..14b2eb0
--- /dev/null
+++ b/Test/SmallCheck/Series/Instances/Internal.hs
@@ -0,0 +1,33 @@
+{-# language FlexibleContexts #-}
+{-# language CPP #-}
+
+module Test.SmallCheck.Series.Instances.Internal where
+
+import Test.SmallCheck.Series
+import Data.Functor.Identity
+#if !MIN_VERSION_base(4,8,0)
+import Data.Word (Word)
+#endif
+
+sets :: (Ord a, Serial m a, Serial Identity a) => Series m [a]
+sets = do
+ depth <- getDepth
+ let xs = list depth series -- We are going to generate all subsets of this enumeration.
+ i <- localDepth (const (2^min depth (length xs) - 1)) series
+ -- This complicated expression ensures that a number is chosen from just a
+ -- large enough subset of `Word`.
+ -- - For finite types, the enumeration `xs` can inherently be no longer than
+ -- their cardinality.
+ -- - For infinite types, we make sure that `i` has at most `depth` binary
+ -- digits.
+ -- For the depth of −1 the series for `Word` is empty, and for depth n > 0
+ -- it equals {0… n}. So, we adjust depth by −1 to make sure there are
+ -- exactly `depth` elements: |{0… n−1}| = n.
+
+ let pattern = binaryExpansion i
+ ys = snd . unzip . filter fst . zip pattern $ xs
+ return ys
+
+binaryExpansion :: Word -> [Bool]
+binaryExpansion 0 = [ ]
+binaryExpansion i = ((i `mod` 2) == 1): binaryExpansion (i `div` 2)
diff --git a/smallcheck-series.cabal b/smallcheck-series.cabal
index 5087c69..49cc4db 100644
--- a/smallcheck-series.cabal
+++ b/smallcheck-series.cabal
@@ -1,5 +1,5 @@
name: smallcheck-series
-version: 0.6.1.1
+version: 0.7.0.0
synopsis: Extra SmallCheck series and utilities
description:
Orphan
@@ -29,6 +29,7 @@ library
exposed-modules: Test.SmallCheck.Series.ByteString
Test.SmallCheck.Series.ByteString.Lazy
Test.SmallCheck.Series.Instances
+ Test.SmallCheck.Series.Instances.Internal
Test.SmallCheck.Series.Text
Test.SmallCheck.Series.Text.Lazy
Test.SmallCheck.Series.Utils
@@ -49,3 +50,10 @@ test-suite doctests
build-depends: base >=4.6 && <4.15,
Glob >=0.7.5,
doctest >=0.9.10
+
+test-suite checks
+ default-language: Haskell2010
+ type: exitcode-stdio-1.0
+ hs-source-dirs: tests
+ main-is: Main.hs
+ build-depends: base, smallcheck, smallcheck-series, tasty, tasty-smallcheck, tasty-hunit
diff --git a/tests/Main.hs b/tests/Main.hs
new file mode 100644
index 0000000..646a8d7
--- /dev/null
+++ b/tests/Main.hs
@@ -0,0 +1,20 @@
+module Main where
+
+import qualified Data.List as List
+import Test.Tasty
+import Test.Tasty.HUnit
+import Test.Tasty.SmallCheck
+import Test.SmallCheck.Series
+import Test.SmallCheck.Series.Instances.Internal
+
+main :: IO ( )
+main = defaultMain $ testGroup "Verify `sets`."
+ [ testGroup "An element is present in a set at most once"
+ [ testProperty "Int" $ over sets $ \xs -> (xs :: [Int]) == List.nub xs
+ , testProperty "Bool" $ over sets $ \xs -> (xs :: [Bool]) == List.nub xs
+ ]
+ , testProperty "All possible sets within depth limit are generated (for a large enough type)"
+ $ \(NonNegative n) -> length (list n sets :: [[Int]]) == 2^n
+ , testCase "All 4 sets of depth 2 are generated"
+ $ assertEqual "" [[ ], [0], [1], [0, 1]] (list 2 sets :: [[Int]])
+ ]