purescript · paf31 · Jun 3, 2017 · Jan 3, 2017
diff --git 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
@@ -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
@@ -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))