
Peter and Lennart,
Scoped type variables is exactly what I needed to know. Thanks for solving
this annoyance for me!
Michael
On Thu, Apr 2, 2009 at 9:18 PM, Peter Verswyvelen
The type inferer seems to struggle to find the type of minBound and maxBound, and GHC asks to use a type annotation. To only way I see how to add a type annotation here is to use a GHC extension:
{-# LANGUAGE ScopedTypeVariables #-}
randomEnum :: forall a g. (Enum a, Bounded a, RandomGen g) => Rand g a randomEnum = do randVal <- getRandomR (fromEnum (minBound::a), fromEnum (maxBound::a)) return $ toEnum randVal
It is annoying when the type inferer encounters ambiguities - you also get this all the time when using OpenGL e.g. GL.colour - but I don't know how to solve this without adding type annotations
On Thu, Apr 2, 2009 at 8:03 PM, Michael Snoyman
wrote: I've butted into this problem multiple times, so I thought it's finally time to get a good solution. I don't even have the terminology to describe the issue, so I'll just post the code I'm annoyed with and hope someone understands what I mean.
import Control.Monad.Random import System.Random
data Marital = Single | Married | Divorced deriving (Enum, Bounded, Show)
randomEnum :: (Enum a, Bounded a, RandomGen g) => Rand g a randomEnum = do let minb = minBound maxb = maxBound randVal <- getRandomR (fromEnum minb, fromEnum maxb) return $ head [toEnum randVal, minb, maxb] -- if I do the obvious thing (return $ toEnum randVal) I get funny errors
main = do stdGen <- newStdGen let marital = evalRand randomEnum stdGen :: Marital putStrLn $ "Random marital status: " ++ show marital
Any help is appreciated. Thanks! Michael
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe