[Haskell-cafe] How to choose an arbitrary Arbitrary?

Bas van Dijk v.dijk.bas at gmail.com
Wed Dec 17 13:20:43 EST 2008


Hello,

I was playing with the following tree type (attached below) which can
be seen as the reification of an applicative. I wondered if I could
define a QuickCheck Arbitrary instance for it.

The only way I got it to type check however, was to give 'arg' a
monomorphic type (for example: 'Gen (Tree ())'). If I left it
polymorphic I got a "Ambiguous type variable in constraints" error.
This is understandable because if the subtrees have polymorphic types
they can be of any type: Tree Int, Tree Float, Tree String, etc. The
system then doesn't know which Arbitrary to choose.

My question is, is it possible to keep 'arg' polymorphic (i.e. 'Gen
(Tree b)') and let the system somehow choose an arbitrary Arbitrary?

I guess not, however I like to be proven wrong.

regards,

Bas

----------------------------------------------------

{-# LANGUAGE ExistentialQuantification #-}

module Tree where

import Control.Monad
import Test.QuickCheck -- I'm using QuickCheck-2.1.0.1

data Tree a = Val a
            | forall b. Tree (b -> a) :*: Tree b

instance Arbitrary a => Arbitrary (Tree a) where
    arbitrary = sized sizedTree

sizedTree :: (Arbitrary a) => Int -> Gen (Tree a)
sizedTree n | n <= 0    = liftM  Val arbitrary
            | otherwise = liftM2 (:*:) func arg
    where
      m = n `div` 2

      func = sizedTree m

      arg :: Gen (Tree ()) -- how to make this:
                           -- Gen (Tree b) ???
      arg = sizedTree m

----------------------------------------------------


More information about the Haskell-Cafe mailing list