From 8bd84e11369775d9096bcb558281e4488777bbff Mon Sep 17 00:00:00 2001 From: Liam Goodacre Date: Tue, 3 Jan 2017 20:51:03 +0000 Subject: [PATCH] Add genericArbitrary and genericCoarbitrary --- bower.json | 3 +- src/Test/QuickCheck/Arbitrary.purs | 71 +++++++++++++++++++++++++++++- test/Main.purs | 12 ++++- 3 files changed, 83 insertions(+), 3 deletions(-) diff --git a/bower.json b/bower.json index e3b103c..0499b6a 100644 --- a/bower.json +++ b/bower.json @@ -31,6 +31,7 @@ "purescript-partial": "^1.2.0", "purescript-random": "^3.0.0", "purescript-strings": "^3.0.0", - "purescript-transformers": "^3.0.0" + "purescript-transformers": "^3.0.0", + "purescript-generics-rep": "^5.0.0" } } diff --git a/src/Test/QuickCheck/Arbitrary.purs b/src/Test/QuickCheck/Arbitrary.purs index 89e4743..76a0ca6 100644 --- a/src/Test/QuickCheck/Arbitrary.purs +++ b/src/Test/QuickCheck/Arbitrary.purs @@ -3,6 +3,10 @@ module Test.QuickCheck.Arbitrary , arbitrary , class Coarbitrary , coarbitrary + , genericArbitrary + , genericCoarbitrary + , class ArbitraryGenericSum + , arbitraryGenericSum ) where import Prelude @@ -23,8 +27,9 @@ import Data.Newtype (wrap) import Data.NonEmpty (NonEmpty(..), (:|)) import Data.String (charCodeAt, fromCharArray, split) import Data.Tuple (Tuple(..)) +import Data.Generic.Rep (class Generic, to, from, NoArguments(..), Sum(..), Product(..), Constructor(..), Argument(..), Rec(..), Field(..)) -import Test.QuickCheck.Gen (Gen, elements, listOf, chooseInt, sized, perturbGen, repeatable, arrayOf, uniform) +import Test.QuickCheck.Gen (Gen, elements, listOf, chooseInt, sized, perturbGen, repeatable, arrayOf, oneOf, uniform) -- | The `Arbitrary` class represents those types whose values can be -- | _randomly-generated_. @@ -154,3 +159,67 @@ instance arbNonEmptyList :: Arbitrary a => Arbitrary (NonEmptyList a) where instance coarbNonEmptyList :: Coarbitrary a => Coarbitrary (NonEmptyList a) where coarbitrary (NonEmptyList nel) = coarbitrary nel + +instance arbitraryNoArguments :: Arbitrary NoArguments where + arbitrary = pure NoArguments + +instance coarbitraryNoArguments :: Coarbitrary NoArguments where + coarbitrary NoArguments = id + +-- | To be able to evenly distribute over chains of Sum types we build up +-- | a collection of generators and choose between. Each right component +-- | of a Sum is either a Constructor or another Sum. +class ArbitraryGenericSum t where + arbitraryGenericSum :: Array (Gen t) + +instance arbGenSumSum :: (Arbitrary l, ArbitraryGenericSum r) => ArbitraryGenericSum (Sum l r) where + arbitraryGenericSum = [Inl <$> arbitrary] <> (map Inr <$> arbitraryGenericSum) + +instance arbGenSumConstructor :: Arbitrary a => ArbitraryGenericSum (Constructor s a) where + arbitraryGenericSum = [arbitrary] + +instance arbitrarySum :: (Arbitrary l, ArbitraryGenericSum r) => Arbitrary (Sum l r) where + arbitrary = oneOf $ (Inl <$> arbitrary) :| (map Inr <$> arbitraryGenericSum) + +instance coarbitrarySum :: (Coarbitrary l, Coarbitrary r) => Coarbitrary (Sum l r) where + coarbitrary (Inl l) = coarbitrary l + coarbitrary (Inr r) = coarbitrary r + +instance arbitraryProduct :: (Arbitrary l, Arbitrary r) => Arbitrary (Product l r) where + arbitrary = Product <$> arbitrary <*> arbitrary + +instance coarbitraryProduct :: (Coarbitrary l, Coarbitrary r) => Coarbitrary (Product l r) where + coarbitrary (Product a b) = coarbitrary a >>> coarbitrary b + +instance arbitraryConstructor :: Arbitrary a => Arbitrary (Constructor s a) where + arbitrary = Constructor <$> arbitrary + +instance coarbitraryConstructor :: Coarbitrary a => Coarbitrary (Constructor s a) where + coarbitrary (Constructor a) = coarbitrary a + +instance arbitraryArgument :: Arbitrary a => Arbitrary (Argument a) where + arbitrary = Argument <$> arbitrary + +instance coarbitraryArgument :: Coarbitrary a => Coarbitrary (Argument a) where + coarbitrary (Argument a) = coarbitrary a + +instance arbitraryRec :: Arbitrary a => Arbitrary (Rec a) where + arbitrary = Rec <$> arbitrary + +instance coarbitraryRec :: Coarbitrary a => Coarbitrary (Rec a) where + coarbitrary (Rec a) = coarbitrary a + +instance arbitraryField :: Arbitrary a => Arbitrary (Field s a) where + arbitrary = Field <$> arbitrary + +instance coarbitraryField :: Coarbitrary a => Coarbitrary (Field s a) where + coarbitrary (Field a) = coarbitrary a + +-- | A `Generic` implementation of the `arbitrary` member from the `Arbitrary` type class. +genericArbitrary :: forall a rep. Generic a rep => Arbitrary rep => Gen a +genericArbitrary = to <$> (arbitrary :: Gen rep) + +-- | A `Generic` implementation of the `coarbitrary` member from the `Coarbitrary` type class. +genericCoarbitrary :: forall a rep. Generic a rep => Coarbitrary rep => a -> Gen a -> Gen a +genericCoarbitrary x g = to <$> coarbitrary (from x) (from <$> g) + diff --git a/test/Main.purs b/test/Main.purs index 038c025..776c1a3 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -8,12 +8,19 @@ import Control.Monad.Eff.Random (RANDOM) import Data.Array.Partial (head) import Data.Foldable (sum) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) import Partial.Unsafe (unsafePartial) -import Test.QuickCheck.Arbitrary (arbitrary) +import Test.QuickCheck.Arbitrary (arbitrary, genericArbitrary, class Arbitrary) import Test.QuickCheck.Gen (Gen, vectorOf, randomSample') +data Foo a = F0 a | F1 a a | F2 { foo :: a, bar :: Array a } +derive instance genericFoo :: Generic (Foo a) _ +instance showFoo :: Show a => Show (Foo a) where show = genericShow +instance arbitraryFoo :: Arbitrary a => Arbitrary (Foo a) where arbitrary = genericArbitrary + main :: Eff (console :: CONSOLE, random :: RANDOM) Unit main = do log "Try with some little Gens first" @@ -26,6 +33,9 @@ main = do logShow =<< go 20000 logShow =<< go 100000 + log "Generating via Generic" + logShow =<< randomSample' 10 (arbitrary :: Gen (Foo Int)) + where go n = map (sum <<< unsafeHead) $ randomSample' 1 (vectorOf n (arbitrary :: Gen Int))