[Haskell-cafe] Quickcheck examples and Data.Word32

Bryn Keller xoltar at xoltar.org
Thu Oct 27 13:49:30 EDT 2005


How about this?

class ArbitraryDefault a where {}

instance (Integral a, Bounded a, ArbitraryDefault a) => Arbitrary a where
    arbitrary = arbitraryBound
    coarbitrary a = error "Not implemented"

instance ArbitraryDefault Word16   
instance ArbitraryDefault Word32
instance ArbitraryDefault Word64   


arbitraryBound :: forall a.(Integral a, Bounded a) => Gen a
arbitraryBound = do let mx,mn :: Integer
                        mx = fromIntegral (maxBound :: a)
                        mn = fromIntegral (minBound :: a)
                    c <- choose (mx, mn)
                    return (fromIntegral c)


Joel Reymont wrote:
> I came up with this but can it be done better? I'm wishing for 
> "default class methods" :-).
>
> instance Arbitrary Word16 where
>     arbitrary = arbitraryBound
>     coarbitrary a = error "Not implemented"
>
> instance Arbitrary Word32 where
>     arbitrary = arbitraryBound
>     coarbitrary a = error "Not implemented"
>
> instance Arbitrary Word64 where
>     arbitrary = arbitraryBound
>     coarbitrary a = error "Not implemented"
>
> arbitraryBound :: forall a.(Integral a, Bounded a) => Gen a
> arbitraryBound = do let mx,mn :: Integer
>                         mx = fromIntegral (maxBound :: a)
>                         mn = fromIntegral (minBound :: a)
>                     c <- choose (mx, mn)
>                     return (fromIntegral c)
>
> On Oct 27, 2005, at 6:13 PM, Joel Reymont wrote:
>
>> Is there a way to squeeze this boilerplate code?
>>
>> class Arbitrary
>> instance Arbitrary Word16 where
>>     arbitrary = do let mx,mn :: Integer
>>                        mx = fromIntegral (maxBound :: Word16)
>>                        mn = fromIntegral (minBound :: Word16)
>>                    c <- choose (mx, mn)
>>                    return (fromIntegral c)
>>     coarbitrary a = error "Not implemented"
>>
>> instance Arbitrary Word32 where
>>     arbitrary = do let mx,mn :: Integer
>>                        mx = fromIntegral (maxBound :: Word32)
>>                        mn = fromIntegral (minBound :: Word32)
>>                    c <- choose (mx, mn)
>>                    return (fromIntegral c)
>>     coarbitrary a = error "Not implemented"
>>
>> instance Arbitrary Word64 where
>>     arbitrary = do let mx,mn :: Integer
>>                        mx = fromIntegral (maxBound :: Word64)
>>                        mn = fromIntegral (minBound :: Word64)
>>                    c <- choose (mx, mn)
>>                    return (fromIntegral c)
>>     coarbitrary a = error "Not implemented"
>>
>
> -- 
> http://wagerlabs.com/
>
>
>
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>



More information about the Haskell-Cafe mailing list