sqlhaskellhdbc

Deserializing data form a SQL Database


I've a little application, backed by a database (SQLite, but it's not really relevant to the question). I've defined some types like:

data Whatever = Whatever Int Int String String
data ImportantStuff = ImportantStuff { id :: Int, count :: Int, name :: String, description :: String }

The types are mapped to tables in the DB. When I read the data, I end up writing functions like this one:

whateverFromDB :: [SqlValue] -> Whatever
whateverFromDB (a:b:c:d:_) = Whatever (fromSql a) (fromSql b) (fromSql c) (fromSql d)

(I'm ommiting handling errors for the sake of clarity.)

Writing functions like these is really annoing and feels like creating a lot of boilerplate. Is there a more idiomatic way to convert a group of SqlValues into a Haskell data?


Solution

  • There doesn't seem to be any standard way in the HDBC library for this. If you're feeling particularly keen, you can roll your own machinery with GHC.Generics for this, though the cure may be worse than the disease!

    I also added the reverse conversion, but you can leave that out/split the classes if you want:

    {-# LANGUAGE DeriveAnyClass, DeriveGeneric, DefaultSignatures
               , TypeOperators, FlexibleContexts, FlexibleInstances
               , TypeSynonymInstances #-}
    
    import Data.Convertible
    import Database.HDBC
    
    
    import Data.Coercible -- not strictly necessary
    import GHC.Generics
    
    -- serialization for Generic Rep-resentations
    class GSqlConvert f where
        gFromSqlValuesImpl :: [SqlValue] -> (f a, [SqlValue])
        gToSqlValuesImpl :: f a -> [SqlValue] -> [SqlValue]
    
    -- no data, no representation
    instance GSqlConvert U1 where
        gFromSqlValuesImpl vs = (U1, vs)
        gToSqlValuesImpl U1 vs = vs
    
    -- multiple things are stored in order
    instance (GSqlConvert a, GSqlConvert b) => GSqlConvert (a :*: b) where
        gFromSqlValuesImpl vs =
            let (a, vs1) = gFromSqlValuesImpl vs
                (b, vs2) = gFromSqlValuesImpl vs1
             in (a :*: b, vs2)
        gToSqlValuesImpl (a :*: b) = gToSqlValuesImpl a . gToSqlValuesImpl b
    
    -- note no instance for a :+: b, so no support for unions
    
    -- ignore metadata
    instance GSqlConvert a => GSqlConvert (M1 i c a) where
        gFromSqlValuesImpl = coerce . gFromSqlValuesImpl
        gToSqlValuesImpl = gToSqlValuesImpl . unM1
    
    -- delegate to the members' serializers
    instance SqlConvert a => GSqlConvert (K1 i a) where
        gFromSqlValuesImpl = coerce . fromSqlValuesImpl
        gToSqlValuesImpl = toSqlValuesImpl . unK1
    
    -- serialization for normal data types
    -- some types are "primitive" and have their own serialization code
    -- other types are serialized via the default implementations,
    -- which are based on Generic
    -- the defaults convert the data into a generic representation and let
    -- the GSqlConvert class decide how to serialize the generic representation
    class SqlConvert a where
        fromSqlValuesImpl :: [SqlValue] -> (a, [SqlValue])
        default fromSqlValuesImpl :: (Generic a, GSqlConvert (Rep a))
                                  => [SqlValue] -> (a, [SqlValue])
        fromSqlValuesImpl vs =
            let (rep, vs1) = gFromSqlValuesImpl vs
             in (to rep, vs1)
    
        toSqlValuesImpl :: a -> [SqlValue] -> [SqlValue]
        default toSqlValuesImpl :: (Generic a, GSqlConvert (Rep a))
                                => a -> [SqlValue] -> [SqlValue]
        toSqlValuesImpl a vs = gToSqlValuesImpl (from a) vs
    
    fromSqlValuesImplPrim :: Convertible SqlValue a
                          => [SqlValue] -> (a, [SqlValue])
    -- no error checking
    fromSqlValuesImplPrim (v:vs) = (fromSql v, vs)
    
    toSqlValuesImplPrim :: Convertible a SqlValue
                        => a -> [SqlValue] -> [SqlValue]
    toSqlValuesImplPrim a vs = toSql a:vs
    
    instance SqlConvert Int where
        fromSqlValuesImpl = fromSqlValuesImplPrim
        toSqlValuesImpl = toSqlValuesImplPrim
    instance SqlConvert String where
        fromSqlValuesImpl = fromSqlValuesImplPrim
        toSqlValuesImpl = toSqlValuesImplPrim
    
    fromSqlValues :: SqlConvert t => [SqlValue] -> t
     -- no error checking for unused values
    fromSqlValues = fst . fromSqlValuesImpl
    
    toSqlValues :: SqlConvert t => t -> [SqlValue]
    toSqlValues v = toSqlValuesImpl v []
    
    -- and now given all the above machinery, the conversion
    -- for Whatever comes for free:
    data Whatever = Whatever Int Int String String
        deriving (Show, Generic, SqlConvert)
    
    {-
    -- DeriveGeneric produces:
    instance Generic Whatever where
      type Rep Whatever = D1 _ (C1 _ (
                                (S1 _ (Rec0 Int) :*: S1 _ (Rec0 Int))
                            :*: (S1 _ (Rec0 String) :*: S1 _ (Rec0 String))
                          ))
      to = _; from = _
    -- There is an instance for GSqlConvert (Rep Whatever)
    -- DeriveAnyClass produces
    instance SqlConvert Whatever where
    -- DefaultSignatures uses the default implementations from the class declaration
    -- to implement the methods
       fromSqlValuesImpl = _; toSqlValuesImpl = _
    -}