From 4ca48e739e98edd30ecc95e1eaf98064fb59132d Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 5 Jun 2017 17:42:42 +0100 Subject: [PATCH 1/2] Add generators for `Map` and `StrMap` --- src/Data/Map/Gen.purs | 24 ++++++++++++++++++++++++ src/Data/StrMap/Gen.purs | 23 +++++++++++++++++++++++ test/Test/Data/Map.purs | 11 ++++++----- test/Test/Data/StrMap.purs | 8 +++----- 4 files changed, 56 insertions(+), 10 deletions(-) create mode 100644 src/Data/Map/Gen.purs create mode 100644 src/Data/StrMap/Gen.purs diff --git a/src/Data/Map/Gen.purs b/src/Data/Map/Gen.purs new file mode 100644 index 00000000..6398a2db --- /dev/null +++ b/src/Data/Map/Gen.purs @@ -0,0 +1,24 @@ +module Data.Map.Gen where + +import Prelude + +import Control.Monad.Gen (class MonadGen, chooseInt, resize, sized, unfoldable) +import Control.Monad.Rec.Class (class MonadRec) +import Data.Map (Map, fromFoldable) +import Data.Tuple (Tuple(..)) +import Data.List (List) + +-- | Generates a `Map` using the specified key and value generators. +genMap + :: forall m a b + . MonadRec m + => MonadGen m + => Ord a + => m a + -> m b + -> m (Map a b) +genMap genKey genValue = sized \size -> do + newSize <- chooseInt 0 size + resize (const newSize) $ + (fromFoldable :: List (Tuple a b) -> Map a b) + <$> unfoldable (Tuple <$> genKey <*> genValue) diff --git a/src/Data/StrMap/Gen.purs b/src/Data/StrMap/Gen.purs new file mode 100644 index 00000000..f44385d2 --- /dev/null +++ b/src/Data/StrMap/Gen.purs @@ -0,0 +1,23 @@ +module Data.StrMap.Gen where + +import Prelude + +import Control.Monad.Gen (class MonadGen, chooseInt, resize, sized, unfoldable) +import Control.Monad.Rec.Class (class MonadRec) +import Data.StrMap (StrMap, fromFoldable) +import Data.Tuple (Tuple(..)) +import Data.List (List) + +-- | Generates a `StrMap` using the specified key and value generators. +genStrMap + :: forall m a + . MonadRec m + => MonadGen m + => m String + -> m a + -> m (StrMap a) +genStrMap genKey genValue = sized \size -> do + newSize <- chooseInt 0 size + resize (const newSize) $ + (fromFoldable :: List (Tuple String a) -> StrMap a) + <$> unfoldable (Tuple <$> genKey <*> genValue) diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index d4a6a272..ee803345 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -1,29 +1,30 @@ module Test.Data.Map where import Prelude -import Data.List.NonEmpty as NEL -import Data.Map as M import Control.Alt ((<|>)) import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (log, CONSOLE) import Control.Monad.Eff.Exception (EXCEPTION) import Control.Monad.Eff.Random (RANDOM) import Data.Array as A -import Data.NonEmpty ((:|)) import Data.Foldable (foldl, for_, all) import Data.Function (on) import Data.List (List(Cons), groupBy, length, nubBy, singleton, sort, sortBy) +import Data.List.NonEmpty as NEL +import Data.Map as M +import Data.Map.Gen (genMap) import Data.Maybe (Maybe(..), fromMaybe) +import Data.NonEmpty ((:|)) import Data.Tuple (Tuple(..), fst, uncurry) import Partial.Unsafe (unsafePartial) import Test.QuickCheck ((), (===), quickCheck, quickCheck') -import Test.QuickCheck.Gen (elements, oneOf) import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) +import Test.QuickCheck.Gen (elements, oneOf) newtype TestMap k v = TestMap (M.Map k v) instance arbTestMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (TestMap k v) where - arbitrary = TestMap <<< (M.fromFoldable :: List (Tuple k v) -> M.Map k v) <$> arbitrary + arbitrary = TestMap <$> genMap arbitrary arbitrary data SmallKey = A | B | C | D | E | F | G | H | I | J derive instance eqSmallKey :: Eq SmallKey diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 3ce6fbda..54cf3901 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -6,7 +6,6 @@ import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (log, CONSOLE) import Control.Monad.Eff.Exception (EXCEPTION) import Control.Monad.Eff.Random (RANDOM) - import Data.Array as A import Data.Foldable (foldl) import Data.Function (on) @@ -15,11 +14,10 @@ import Data.List.NonEmpty as NEL import Data.Maybe (Maybe(..)) import Data.NonEmpty ((:|)) import Data.StrMap as M -import Data.Tuple (Tuple(..), fst, uncurry) +import Data.StrMap.Gen (genStrMap) import Data.Traversable (sequence) - +import Data.Tuple (Tuple(..), fst, uncurry) import Partial.Unsafe (unsafePartial) - import Test.QuickCheck ((), quickCheck, quickCheck', (===)) import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) import Test.QuickCheck.Gen as Gen @@ -27,7 +25,7 @@ import Test.QuickCheck.Gen as Gen newtype TestStrMap v = TestStrMap (M.StrMap v) instance arbTestStrMap :: (Arbitrary v) => Arbitrary (TestStrMap v) where - arbitrary = TestStrMap <<< (M.fromFoldable :: L.List (Tuple String v) -> M.StrMap v) <$> arbitrary + arbitrary = TestStrMap <$> genStrMap arbitrary arbitrary newtype SmallArray v = SmallArray (Array v) From 654cf9086bf003a94b8d04000d60800254112486 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 5 Jun 2017 17:47:03 +0100 Subject: [PATCH 2/2] Add `purescript-gen` dependency --- bower.json | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/bower.json b/bower.json index 4527f5a7..c3501a22 100644 --- a/bower.json +++ b/bower.json @@ -24,7 +24,8 @@ "purescript-arrays": "^4.0.0", "purescript-functions": "^3.0.0", "purescript-lists": "^4.0.0", - "purescript-st": "^3.0.0" + "purescript-st": "^3.0.0", + "purescript-gen": "^1.1.0" }, "devDependencies": { "purescript-quickcheck": "^4.0.0"