且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

从SQL数据库反序列化数据

更新时间: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 = _
-}