Generic 'arbitrary'

[Francesco Mazzoli]

Actually, I just realized I'm missing CoArbitrary, and also the
implementation can be improved, so I'll send a better patch soon!

Francesco.
-------------- next part --------------
Hi, I wrote a GHC.Generics based 'arbitrary' instance. Writing a 'shrink'
instance might be possible but tricky at the type level.

1 patch for repository http://code.haskell.org/QuickCheck/devel:

Thu Feb 16 12:27:52 GMT 2012  f at mazzo.li
  * Added Generic-based default for Arbitrary


New patches:

[Added Generic-based default for Arbitrary
f at mazzo.li**20120216122752
 Ignore-this: b2b3374c6153434822a085327559d71f
] hunk ./QuickCheck.cabal 101
     Test.QuickCheck.Exception
   GHC-options:
 
+  if impl(ghc >= 7.2.1)
+    cpp-options: -DGENERICS
+    build-depends: ghc-prim >= 0.2, dlist >= 0.2 && < 0.6
+
hunk ./Test/QuickCheck/Arbitrary.hs 1
+{-# LANGUAGE CPP #-}
+#ifdef GENERICS
+{-# LANGUAGE DefaultSignatures, FlexibleContexts, TypeOperators #-}
+#endif
+
 module Test.QuickCheck.Arbitrary
   ( 
   -- * Arbitrary and CoArbitrary classes
hunk ./Test/QuickCheck/Arbitrary.hs 42
 
 import Test.QuickCheck.Gen
 
-{-
-import Data.Generics
-  ( (:*:)(..)
-  , (:+:)(..)
-  , Unit(..)
-  )
--}
+#ifdef GENERICS
+import Control.Applicative ((<$>), (<*>))
+import GHC.Generics
+#endif
 
 import Data.Char
   ( chr
hunk ./Test/QuickCheck/Arbitrary.hs 99
 class Arbitrary a where
   -- | A generator for values of the given type.
   arbitrary :: Gen a
-  arbitrary = error "no default generator"
-  
+
   -- | Produces a (possibly) empty list of all the possible
   -- immediate shrinks of the given value.
   shrink :: a -> [a]
hunk ./Test/QuickCheck/Arbitrary.hs 105
   shrink _ = []
 
+#ifdef GENERICS
+  default arbitrary :: (Generic a, GArbitrary (Rep a)) => Gen a
+  arbitrary = fmap to gArbitrary
+
+class GArbitrary f where
+  gArbitrary :: Gen (f a)
+
+instance GArbitrary U1 where
+  gArbitrary = return U1
+
+instance (GArbitrary a, GArbitrary b) => GArbitrary (a :*: b) where
+  gArbitrary = (:*:) <$> gArbitrary <*> gArbitrary
+
+instance (GArbitrary a, GArbitrary b) => GArbitrary (a :+: b) where
+  gArbitrary = do
+      b <- choose (False, True)
+      if b then L1 <$> gArbitrary else R1 <$> gArbitrary
+
+instance GArbitrary a => GArbitrary (M1 i c a) where
+  gArbitrary = M1 <$> gArbitrary
+
+instance Arbitrary a => GArbitrary (K1 i a) where
+  gArbitrary = K1 <$> arbitrary
+#else
+  arbitrary = error "no default generator"
+#endif
+
 -- instances
 
 instance (CoArbitrary a, Arbitrary b) => Arbitrary (a -> b) where

Context:

[Make Positive and NonNegatve live up to their names
anders.cj.persson at gmail.com**20120207102143
 Ignore-this: 7d2aa7e15c7d81c91e57afc6af5b570f
 
 The modifiers Positive and NonNegative can produce negative values for data types where abs(minBound) == minBound
 This patch adds a suchThat test which fixes the problem.
] 
[added a 'discard' exception that discards the current test case
koen at chalmers.se**20120208112917
 Ignore-this: 376540510c5936bee650ce649eb719d8
] 
[Add coarbitraryEnum to Test.QuickCheck module.
nicsma at chalmers.se**20120206000124
 Ignore-this: eba5193b53ddec128f09f58412e8bb82
] 
[Add 'coarbitrary' helper for Enums.
Antoine Latter <aslatter at gmail.com>**20120204181129
 Ignore-this: fe80d60f84b4396d355cc202217de3f2
] 
[Don't print number of shrink attempts
nicsma at chalmers.se**20120124152755
 Ignore-this: 7d66d2b091f6fca63836bf7599a77c4e
] 
[Rejiggled the formatting code to support multi-line error messages
nicsma at chalmers.se**20120124151813
 Ignore-this: 7fa74e255304b434ad7cde0bc811d4c2
] 
[Put error messages on one line even when using failure{} directly.
nicsma at chalmers.se**20120124134232
 Ignore-this: 8f839e947247bdc7d6818df6f99fc75c
] 
[Tweaks to Arbitrary Ordering instance.
nicsma at chalmers.se**20120109190158
 Ignore-this: 88a275605e85931b3084202656361e99
] 
[Add instances for Ordering and Fixed.
Antoine Latter <aslatter at gmail.com>**20120107195327
 Ignore-this: 72992f089a00f38d66cca0f47441325
] 
[Added arbitraryBoundedEnum generator (thanks to Antoine Latter).
nicsma at chalmers.se**20120109190051
 Ignore-this: 1c1b5221a86314cd0bb6879fdcb1c7f1
] 
[TAG 2.4.2
nicsma at chalmers.se**20111218191220
 Ignore-this: 6dbf881136e0562889d5d0e9dddfec92
] 
[Fix repo information
nicsma at chalmers.se**20111218191212
 Ignore-this: 7031ea26d6699a7d964196dbd2d784e0
] 
[Add verboseCheckAll and polyverboseCheck function for usability.
shelarcy <shelarcy at gmail.com>**20111208164608
 Ignore-this: 8585cde4c3a8b86920220e4c7771d521
] 
[Fix build with GHC 7.3+
Mikhail Vorozhtsov <mikhail.vorozhtsov at gmail.com>**20111028110653
 Ignore-this: f5519490c4a355b877fa6e89fa3f994e
] 
[old tag: 2.4.2
nicsma at chalmers.se**20110914140246
 Ignore-this: 380267a9bb49e4abd618ba213eb77b
] 
[tagged 2.4.2
nicsma at chalmers.se**20110914140239
 Ignore-this: 8f40fde73bbffbe54f7fca481b03f570
] 
[Don't always use the same size when replaying if the test passes
nicsma at chalmers.se**20110914140026
 Ignore-this: d43c5706bd0e96ee2614094094f82cff
] 
[Add printing of number of unsuccessful shrinking attempts at the end of testing
Micha? Pa?ka <michal.palka at chalmers.se>**20110914134446
 Ignore-this: bd935caf619041add82cd7bfd67d9f8d
] 
[TAG 2.4.1.1
nicsma at chalmers.se**20110426185725
 Ignore-this: 609150418b6c0e99bce1360016edcd44
] 
Patch bundle hash:
77fdde83e09e701de3ea2abf42443f83311adf71