haskell - 泛型 - 创建组合所有字段的记录产品

Question

在工作中，我使用泛型为我的 API 和数据库类型轻松派生 Data.Aeson.ToJSON 和 Database.Selda.SqlRow 的实例。它非常有用，但我经常希望我可以组合类型。

作为一个简单的例子，也许用户想要创建一个新帐户。它们提供基本信息，其中不包括数据库 ID。但我需要用一个 ID 将它发回给他们。

data AccountInfo = AccountInfo
    { firstName :: Text
    , lastName :: Text
    } deriving (Show, Eq, Generic)

data Account = Account
    { accountId :: Id Account
    , firstName :: Text
    , lastName :: Text
    } deriving (Show, Eq, Generic)

我不能简单地将 AccountInfo 嵌套在 Account 中，因为我希望 Aeson 实例是扁平的(所有字段都在顶层)，而 Selda 要求它是扁平的以将其存储在数据库中。

-- This won't work because the Aeson and Selda outputs aren't flat
data Account = Account
    { accountId :: Id Account
    , info :: AccountInfo
    } deriving (Show, Eq, Generic)

我想创建一个产品类型，让我可以组合两种类型，但将字段展平。

data Aggregate a b = Aggregate a b

data AccountId = AccountId
    { accountId :: Id Account
    } deriving (Show, Eq, Generic)

type Account = Aggregate AccountId AccountInfo

我知道如何为这种类型手动编写 ToJSON 和 FromJSON 实例，但我不知道如何编写 SQLRow 实例。

相反，作为学习泛型的练习，我想为 Aggregate 编写一个通用实例，其中 Aggregate AccountId AccountInfo 具有与第一个定义完全相同的表示Account，上面(所有三个字段都展平了)

我该怎么做？我已经阅读了一天有关泛型的内容，但我完全被困住了。

Answer 1

使用泛型，用户 定义了一种数据类型，该数据类型将根据在其泛型派生结构上定义的操作继承某些操作(例如 toJSON)。它不会根据旧类型创建新类型。如果您正在寻找基于旧类型创建新类型的 Genrics，您会感到沮丧。

更明确地说，“我想为聚合编写一个通用实例”这句话没有意义。我们制作类(class ToJSON)的通用表示实例，而不是数据结构。并且已经编写了通用的 JSON 实例......

幸运的是，一个好的解决方案可能很容易。您只需要一种处理 JSON 对象集合的方法。下面我将演示如何组合具有 JSON.Object 表示的两种数据类型。由于 JSON.Object 只是一个 hashmap，可以通过 union 组合，我只是将我的 haskell 值转换为对象并执行联合。有改进的余地，但就是这个想法。

import qualified Data.Aeson as JSON
import qualified Data.Aeson.Types as JSON
import GHC.Generics
import qualified Data.HashMap.Lazy as HashMap

data A = A { fieldA :: String } deriving (Show,Eq,Generic)
data B = B { fieldB :: String } deriving (Show,Eq,Generic)

instance ToJSON A
instance ToJSON B
instance FromJSON A
instance FromJSON B

toObj :: ToJSON a => a -> Maybe JSON.Object
toObj = JSON.parseMaybe parseJSON . toJSON

toJSONAB :: A -> B -> Maybe JSON.Value
toJSONAB a b = do
   aObj <- toObj a
   bObj <- toObj b
   return . JSON.Value $ HashMap.union aObj bObj 

此时，当你需要输出JSON时，你会调用toJSONAB而不是toJSON。包括从输出中检索 A 或 B。也就是说，

(toJSONAB a b >>= JSON.parseMaybe parseJSON) :: Maybe <Desired Type>

将根据提供(推导)的类型签名解析 A 或 B。

上面就是你想要的核心。您可以为您喜欢的任何数据组合创建这样的函数。缺少的是创建如下新类型:

data AB = AB A B

为您的代码提供类型安全。毕竟，您感兴趣的是特定类型，而不是类型的 JSON 表示的临时集合。要通过泛型做到这一点，我建议使用一个新类，如下所示(未经测试且不完整)，

class ToFlatJSON a where
  toFlatJSON :: a -> JSON.Value
  default toFlatJSON :: (Generic a, GToFlatJSON (Rep a)) => a -> JSON.Value
  toFlatJSON = gToFlatJSON . from

class GToFlatJSON a where
  gToFlatJSON :: a p -> JSON.Value

并为 GHC.Generics 中找到的任何必要的通用表示提供 GToFlatJSON 实例。

instance (ToJSON a) => GToFlatJSON (K1 i a) where
  gToFlatJSON (K1 a) = toJSON a

instance (GToFlatJSON a) => GToFlatJSON (a :*: a') where
  gToFlatJSON (a :*: a') = cmb (gToFlatJSON a) (toFlatJSON a')
    where
      cmb = someFunctionLike_toJSONAB

instance (GToFlatJSON a) => GToFlatJSON (M1 t i a) where
  gToFlatJSON (M1 _ _ a) = gToFlatJSON a
    where
      cmb = someFunctionLike_toJSONAB

然后，您将能够像使用 ToJSON 一样定义空白 ToFlatJSON 实例

instance ToFlatJSON a

并使用 toFlatJSON 而不是 toJSON。您可以用 toFlatJSON 来定义 toJSON。那么，对于每种数据类型，您需要:

instance ToFlatJSON AB 
instance ToFlatJSON AB => ToJSON AB where
  toJSON = toFlatJSON 

因此，总而言之，您可以通过使用 JSON 表示本身轻松创建组合类型，即它们的对象表示的联合。您可以直接使用它们的 fromJSON 恢复您的原始类型。无法重载 To/FromJSON 通用实例，但您可以创建一个新的类似类及其通用实例。我个人建议此应用程序远离泛型。我认为为您的数据类型自定义 To/FromJSON 将是最直接的方法。