应对数据形成SQL数据库



我有一个由数据库支持的小应用程序(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 = _
-}

相关内容

  • 没有找到相关文章

最新更新