更新时间:2023-11-25 21:51:58
在HDBC
库中似乎没有任何标准方法.如果您特别热衷,可以使用 GHC.Generics
为此,尽管治愈可能比疾病还差!
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 = _
-}