我有一个由数据库支持的小应用程序(sqlite,但与问题并不相关)。我定义了一些类型,例如:
data Whatever = Whatever Int Int String String
data ImportantStuff = ImportantStuff { id :: Int, count :: Int, name :: String, description :: String }
类型映射到DB中的表。当我阅读数据时,我最终会像这样编写功能:
whateverFromDB :: [SqlValue] -> Whatever
whateverFromDB (a:b:c:d:_) = Whatever (fromSql a) (fromSql b) (fromSql c) (fromSql d)
(为了清楚起见,我正在遵守处理错误。)
像这样的写作功能确实是宣传的,感觉就像创建大量的样板。是否有一种更惯用的方法将一组SQLVALUE转换为Haskell数据?
为此,HDBC
库中似乎没有任何标准方式。如果您感到特别敏锐,则可以使用GHC.Generics
滚动自己的机械,尽管治愈方法可能比疾病差!
我还添加了反向转换,但是如果需要
{-# 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 = _
-}