[Haskell-cafe] Generic typeclass for converting between types

John Goerzen jgoerzen at complete.org
Fri Jan 23 10:01:59 EST 2009


Hi folks,

I've been thinking today that I frequently need to convert data beween
types:

 * Between various numeric types

 * Between various calendar types (both within the new calendar
   system, and between the old and new)

 * Marshalling data back and forth to a database in HDBC

It's hard to remember all the functions to use to do these.  I often
resort to a chart I made for numeric conversions.

It occurs to me that it would be nice to be able to

  (convert (5.8::Double))::Int

or

  (convert calendarTime)::ZonedTime

So, the first question is: does something like this exist already?
I'm not aware of it, but I'm not sure how to search either.

I'm thinking of something like the below.  With a little magic, it's
quite possible to make errors easy to generate in the safe fashion
(for instance, when converting from String to Integer using reads).

{-# LANGUAGE MultiParamTypeClasses #-}
import Control.Monad.Error

type ConvertResult a = Either ConvertError a

class Convertible a b where
    safeConvert :: a -> ConvertResult b

instance Convertible Int Double where
    safeConvert = return . fromIntegral
instance Convertible Double Int where
    safeConvert = return . truncate         -- could do bounds checking here
instance Convertible Integer Double where
    safeConvert = return . fromIntegral
instance Convertible Double Integer where
    safeConvert = return . truncate

convert :: Convertible a b => a -> b
convert inp = case safeConvert inp of
                Left e -> error (show e)
                Right x -> x

-- rudimentary error type for this example

data ConvertError = ConvertError {
      sourceValue :: String,
      errorMessage :: String
    }
    deriving (Eq, Read, Show)

instance Error ConvertError where
    strMsg x = ConvertError "(unknown)" x

The other option is to use an approach more like I have in HDBC.  In
HDBC, there is a direct need to encapsulate data for transport, so
I've got this:

class (Show a) => SqlType a where
    toSql :: a -> SqlValue
    safeFromSql :: SqlValue -> FromSqlResult a

data SqlValue = SqlString String 
              | SqlByteString B.ByteString
              | SqlWord32 Word32
              | SqlWord64 Word64
              ... many more ....

... 

instance SqlType Int32 where
    sqlTypeName _ = "Int32"
    toSql = SqlInt32
    safeFromSql (SqlString x) = read' x
    safeFromSql (SqlByteString x) = (read' . byteString2String) x
    safeFromSql (SqlInt32 x) = return x
    safeFromSql (SqlInt64 x) = return . fromIntegral $ x

The advantage of this is that if you've got a whole slew of types and
you're going to be converting between all of them (for instance,
numeric types), if you turn on -Wall the compiler will help you know
when your safeFromSql instance doesn't convert everything.  The
disadvantage is that the type system doesn't enforce whether or not it
is even possible to convert certain things (for instance, a TimeOfDay
to a Char), and so we have to return a Left for those.

Any thoughts?

-- John


More information about the Haskell-Cafe mailing list