views:

77

answers:

2

I'd like to write a safe version of toEnum:

 safeToEnum :: (Enum t, Bounded t) => Int -> Maybe t

A naive implementation:

safeToEnum :: (Enum t, Bounded t) => Int -> Maybe t
safeToEnum i =
  if (i >= fromEnum (minBound :: t)) && (i <= fromEnum (maxBound :: t))
    then Just . toEnum $ i
    else Nothing

main = do
  print $ (safeToEnum 1 :: Maybe Bool)
  print $ (safeToEnum 2 :: Maybe Bool)

And it doesn't work:

safeToEnum.hs:3:21:
    Could not deduce (Bounded t1) from the context ()
      arising from a use of `minBound' at safeToEnum.hs:3:21-28
    Possible fix:
      add (Bounded t1) to the context of an expression type signature
    In the first argument of `fromEnum', namely `(minBound :: t)'
    In the second argument of `(>=)', namely `fromEnum (minBound :: t)'
    In the first argument of `(&&)', namely
        `(i >= fromEnum (minBound :: t))'

safeToEnum.hs:3:56:
    Could not deduce (Bounded t1) from the context ()
      arising from a use of `maxBound' at safeToEnum.hs:3:56-63
    Possible fix:
      add (Bounded t1) to the context of an expression type signature
    In the first argument of `fromEnum', namely `(maxBound :: t)'
    In the second argument of `(<=)', namely `fromEnum (maxBound :: t)'
    In the second argument of `(&&)', namely
        `(i <= fromEnum (maxBound :: t))'

As well as I understand the message, the compiler does not recognize that minBound and maxBound should produce exactly the same type as in the result type of safeToEnum inspite of the explicit type declaration (:: t). Any idea how to fix it?


Solved

Both camccann's and Dave's solutions work (though Dave's one needs to be adjusted). Thank you both (but I could accept only one). Working example with ScopedTypeVariables:

{-# LANGUAGE ScopedTypeVariables #-}

safeToEnum :: forall t . (Enum t, Bounded t) => Int -> Maybe t
safeToEnum i =
  if (i >= fromEnum (minBound :: t)) && (i <= fromEnum (maxBound :: t))
    then Just . toEnum $ i
    else Nothing
+1  A: 

You need to use scoped type variables

{-# LANGUAGE ScopedTypeVariables #-}

safeToEnum :: (Enum t, Bounded t) => Int -> Maybe t
safeToEnum i =
  if (i >= fromEnum (minBound :: t)) && (i <= fromEnum (maxBound :: t))
    then Just . toEnum $ i
    else Nothing

main = do
  print $ (safeToEnum 1 :: Maybe Bool)
  print $ (safeToEnum 2 :: Maybe Bool)

Without it, t means forall t. t.

Dave Hinton
Still getting `Could not deduce (Bounded t1) from the context ()`. GHC 6.12.1.
jetxee
OK. This works: `safeToEnum :: forall t . (Enum t, Bounded t) => Int -> Maybe t`. Thank you.
jetxee
You can work around the need to use scoped type variables by adding a helper combinator like: asArgTypeOf :: a -> f a -> a; asArgTypeOf = const and and plumbing it through like safeToEnum i = r where r = ... and using (minBound `asArgTypeOf` r) and (maxBound `asArgTypeOf` r).
Edward Kmett
+6  A: 

Scoped type variables aren't necessary here, you just need to make it clear to GHC that you expect all the Enum stuff to be the same type. This is easy to do by passing them all to a function that explicitly takes various Enums of the same type. Here's one way:

enumIfBetween :: (Enum a) => a -> a -> Int -> Maybe a
enumIfBetween a z x = let a' = fromEnum a
                          z' = fromEnum z
                      in if a' <= x && x <= z'
                         then Just $ toEnum x
                         else Nothing

safeToEnum i = enumIfBetween minBound maxBound i

main = do
    print $ (safeToEnum 1 :: Maybe Bool)
    print $ (safeToEnum 2 :: Maybe Bool)

Trying it in GHCi:

> main
Just True
Nothing

A more general solution using the same principle is the standard library function asTypeOf, which has the same behavior as const but requires both arguments to be the same type:

safeToEnum :: (Enum t, Bounded t) => Int -> Maybe t
safeToEnum i = let r = toEnum i
                   max = maxBound `asTypeOf` r
                   min = minBound `asTypeOf` r
               in if i >= fromEnum min && i <= fromEnum max
               then Just r
               else Nothing

This version works as well.

Keep in mind that ScopedTypeVariables is a language extension, and thus not necessarily portable between compilers. In practice almost everyone uses GHC, but it's usually preferred to stick to the standard base language (i.e., Haskell 98) when possible. In this case, ScopedTypeVariables really is overkill; the Haskell wiki suggests asTypeOf as a portable replacement for this kind of scenario.

camccann
Yes. This works too. Nice idea.
jetxee
I like your solutions. It's very nice that `r` is not actually evaluated in `asTypeOf` (second version).
jetxee
@jetxee: Well, it's certainly evaluated if you actually *use* it... which of course won't happen if the result is `Nothing`. Ain't it great to be lazy?
camccann
It is certainly a very cool example of lazy evaluation.
jetxee