[Haskell-cafe] Quickcheck examples and Data.Word32

2005-10-27 Thread Joel Reymont
Folks, Does anyone have QuickCheck examples they could send me? Also, how can I check Word32, Word64, etc. properties? It looks like the built-in random generator only works with Int values and for the life of me I cannot figure out how to extend it. Last but not least, I'm trying to

Re: [Haskell-cafe] Quickcheck examples and Data.Word32

2005-10-27 Thread Sebastian Sylvan
On 10/27/05, Joel Reymont [EMAIL PROTECTED] wrote: Folks, Does anyone have QuickCheck examples they could send me? Also, how can I check Word32, Word64, etc. properties? It looks like the built-in random generator only works with Int values and for the life of me I cannot figure out how to

Re: [Haskell-cafe] Quickcheck examples and Data.Word32

2005-10-27 Thread Joel Reymont
Would it cover the range between minBound :: Word32 and maxBound :: Word32? I cannot figure out how to do this since maxBound :: Int32 is less that that of Word32. Also, I get the following error with ghci -fglasgow-exts foo.hs:7:52: parse error on input `.' -- module Foo where import

Re: [Haskell-cafe] Quickcheck examples and Data.Word32

2005-10-27 Thread Sebastian Sylvan
On 10/27/05, Joel Reymont [EMAIL PROTECTED] wrote: Would it cover the range between minBound :: Word32 and maxBound :: Word32? I cannot figure out how to do this since maxBound :: Int32 is less that that of Word32. Also, I get the following error with ghci -fglasgow-exts foo.hs:7:52: parse

Re: [Haskell-cafe] Quickcheck examples and Data.Word32

2005-10-27 Thread Sebastian Sylvan
On 10/27/05, Sebastian Sylvan [EMAIL PROTECTED] wrote: On 10/27/05, Joel Reymont [EMAIL PROTECTED] wrote: Would it cover the range between minBound :: Word32 and maxBound :: Word32? I cannot figure out how to do this since maxBound :: Int32 is less that that of Word32. Also, I get the

Re: [Haskell-cafe] Quickcheck examples and Data.Word32

2005-10-27 Thread Joel Reymont
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

Re: [Haskell-cafe] Quickcheck examples and Data.Word32

2005-10-27 Thread Bryn Keller
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

Re: [Haskell-cafe] Quickcheck examples and Data.Word32

2005-10-27 Thread Joel Reymont
This requires {-# OPTIONS_GHC -fallow-undecidable-instances #-} but since I'm using -fglasgow-exts in a lot of places I'm wondering if adding undecidable instances would be a bad habit. I guess not... not until I shoot myself in the foot :-). Any explanation of undecidable instances, the

Re: [Haskell-cafe] Quickcheck examples and Data.Word32

2005-10-27 Thread Bryn Keller
I've not had any problems with them, though of course your mileage may vary. Have a look at section 7.4.4.3 in http://www.haskell.org/ghc/docs/latest/html/users_guide/type-extensions.html#multi-param-type-classes for an explanation. Basically, if you have a cyclic class dependency graph, the

Re: [Haskell-cafe] Quickcheck examples and Data.Word32

2005-10-27 Thread Nils Anders Danielsson
On Thu, 27 Oct 2005, Sebastian Sylvan [EMAIL PROTECTED] wrote: instance Arbitrary Word32 where arbitrary = do c - arbitrary :: Gen Integer return (fromIntegral c) This definition will usually only generate very small or very large Word32 values. The reason is the wrapping

Re: [Haskell-cafe] Quickcheck examples and Data.Word32

2005-10-27 Thread Joel Reymont
Just one more question... data Prop = forall a b. (Eq a, Eq b, Show a, Packet b, Convertible a b) = Attr a b := a deriving (Typeable) data Attr a b = Attr String (a - Dynamic, Dynamic - Maybe a) (a - b, b - a) makeAttr :: (Typeable a, Convertible a b) = String - Attr a b

Re: [Haskell-cafe] Quickcheck examples and Data.Word32

2005-10-27 Thread Joel Reymont
This compiles: instance (Typeable a, Arbitrary a, Typeable b, Arbitrary b, Convertible a b) = Arbitrary (Attr a b) where arbitrary = makeAttr `fmap` arbitrary coarbitrary a = error Not implemented arbitraryProp :: forall a b.(Eq a, Packet b, Show a, Convertible a b, Arbitrary a,

Re: [Haskell-cafe] Quickcheck examples and Data.Word32

2005-10-27 Thread John Meacham
On Thu, Oct 27, 2005 at 07:06:12PM +0100, Joel Reymont wrote: This requires {-# OPTIONS_GHC -fallow-undecidable-instances #-} but since I'm using -fglasgow-exts in a lot of places I'm wondering if adding undecidable instances would be a bad habit. I guess not... not until I shoot