Merge pull request #109 from purescript/gen

Add generators for `Map` and `StrMap`

Author: garyb

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"

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)

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)

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

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,19 +14,18 @@ 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
 
 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)