如何处理Haskell中记录字段中的保留关键字？

Question

Github Gists Rest API 返回的 JSON 包含了 Haskell 中的关键字 type。但是 type 不能用作记录字段。

因此，在实现Aeson 的通用 FromJSON/ToJSON 实例时，不能使用它。

import Data.Text (Text)

import GHC.Generics (Generic)

type URL = Text

data OwnerType = User deriving (Show)

data Owner = Owner {
      id :: Int,
      gravatar_id :: Text,
      login :: Text,
      avatar_url :: Text,
      events_url :: URL,
      followers_url :: URL,
      following_url :: URL,
      gists_url :: URL,
      html_url :: URL,
      organizations_url :: URL,
      received_events_url :: URL,
      repos_url :: URL,
      starred_url :: URL,
      subscriptions_url :: URL,
      url :: URL,
      -- type :: Text,
      site_admin :: Bool
  } deriving (Generic, Show)

instance ToJSON Owner
instance FromJSON Owner

问题： 有没有一种适当的方法来处理这种冲突？

- palik

---

你可以实现自己的 ToJSON 和 FromJSON，从而进行“键转换”。 - Willem Van Onsem

我也会尝试这种方法。顺便说一下，感谢你的TemplateHaskell答案。 - palik

Answer 1

我们可以使用TemplateHaskell来解决这个问题。我们可以使用特定的键值映射，而不是编写ToJSON和FromJSON。

首先，我们必须为字段构造一个名称，该名称不是类型，例如：

data Owner = Owner {
      id :: Int,
      gravatar_id :: Text,
      login :: Text,
      avatar_url :: Text,
      events_url :: URL,
      followers_url :: URL,
      following_url :: URL,
      gists_url :: URL,
      html_url :: URL,
      organizations_url :: URL,
      received_events_url :: URL,
      repos_url :: URL,
      starred_url :: URL,
      subscriptions_url :: URL,
      url :: URL,
      <b>owner_type</b> :: Text,
      site_admin :: Bool
  } deriving (Generic, Show)

现在我们可以使用deriveJSON :: Options -> Name -> Q [Dec]函数，它将构建一个fromJSON和toJSON实例。

关键在于Options参数：它包含一个fieldLabelModifier :: String -> String字段，可以重写字段名称并映射到JSON中的键。因此，我们可以在这里生成一个函数来重命名它们。

所以我们首先构造一个ownerFieldRename :: String -> String函数：

ownerFieldRename :: String -> String
ownerFieldRename "owner_type" = "type"
ownerFieldRename name = name

这个函数作为一个身份函数，除了将"owner_type"映射到"type"以外。

现在我们可以使用自定义选项调用deriveJSON函数，例如：

$(deriveJSON defaultOptions {fieldLabelModifier = ownerFieldRename} ''Owner)

全文如下：

RenameUtils.hs：

<b>module RenameUtils where

ownerFieldRename :: String -> String
ownerFieldRename "owner_type" = "type"
ownerFieldRename name = name</b>

MainFile.hs:

<b>{-# LANGUAGE TemplateHaskell #-}</b>
{-# LANGUAGE DeriveGeneric #-}

<b>import Data.Aeson.TH(deriveJSON, defaultOptions, Options(fieldLabelModifier))</b>
<b>import RenameUtils(ownerFieldRename)</b>

import Data.Text (Text)

type URL = Text

data Owner = Owner {
      id :: Int,
      gravatar_id :: Text,
      login :: Text,
      avatar_url :: Text,
      events_url :: URL,
      followers_url :: URL,
      following_url :: URL,
      gists_url :: URL,
      html_url :: URL,
      organizations_url :: URL,
      received_events_url :: URL,
      repos_url :: URL,
      starred_url :: URL,
      subscriptions_url :: URL,
      url :: URL,
      <b>owner_type</b> :: Text,
      site_admin :: Bool
  } deriving (Show)

<b>$(deriveJSON defaultOptions {fieldLabelModifier = ownerFieldRename} ''Owner)</b>

现在我们获得一个JSON对象，其中type是键：

Prelude Main Data.Aeson> encode (Owner 1 "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" True)
"{\"id\":1,\"gravatar_id\":\"\",\"login\":\"\",\"avatar_url\":\"\",\"events_url\":\"\",\"followers_url\":\"\",\"following_url\":\"\",\"gists_url\":\"\",\"html_url\":\"\",\"organizations_url\":\"\",\"received_events_url\":\"\",\"repos_url\":\"\",\"starred_url\":\"\",\"subscriptions_url\":\"\",\"url\":\"\",\"type\":\"\",\"site_admin\":true}"

对于一个简单的fieldLabelModifier函数，我们不需要编写一个特定的函数（我们必须在特定模块中定义），我们也可以在这里使用一个lambda表达式：

MainFile.hs：

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}

import Data.Aeson.TH(deriveJSON, defaultOptions, Options(fieldLabelModifier))
import Data.Text (Text)

type URL = Text

data Owner = Owner {
      id :: Int,
      gravatar_id :: Text,
      login :: Text,
      avatar_url :: Text,
      events_url :: URL,
      followers_url :: URL,
      following_url :: URL,
      gists_url :: URL,
      html_url :: URL,
      organizations_url :: URL,
      received_events_url :: URL,
      repos_url :: URL,
      starred_url :: URL,
      subscriptions_url :: URL,
      url :: URL,
      <b>owner_type</b> :: Text,
      site_admin :: Bool
  } deriving (Show)

$(deriveJSON defaultOptions {fieldLabelModifier = <b>\x -> if x == "owner_type" then "type" else x</b>} ''Owner)

- Willem Van Onsem

---

请在 MainFile.hs 中添加 import Data.Text (Text) type URL = T 以完成代码。 - palik

Answer 2

Willem的答案可能更为恰当，也可能更符合您的要求，但这里有另一种方法，允许您定义非冲突数据而无需编写ToJSON和FromJSON实例，定义类型。

data OwnerData = OwnerData {
    oid :: Int
    -- ... other data with non-conflicting names
  } deriving (Show, Generic)

并且

data Owner = Owner {
  owner_data :: OwnerData,
  user_type :: Text
} deriving (Show)

我们现在可以定义以下实例：

-- nothing special for OwnerData: 
instance ToJSON OwnerData
instance FromJSON OwnerData

-- a little helper function to extract the hashmap(Object) from a value
toObject :: ToJSON a => a -> Object
toObject a = case toJSON a of
  Object o -> o
  _        -> error "toObject: value isn't an Object"

-- the instances for Owner
instance ToJSON Owner where
  toJSON (Owner {owner_data = ownerData, user_type = userType}) = 
    Object $ 
    toObject ownerData <> HML.fromList ["type" .= userType]

  toEncoding (Owner {owner_data = ownerData, user_type = userType}) = 
    pairs . foldMap (uncurry (.=)) . HML.toList $ 
    toObject ownerData <> HML.fromList ["type" .= userType]

instance FromJSON Owner where
  parseJSON = withObject "Owner" $ \v -> do
    ownerData <- parseJSON (Object v)
    userType <- v .: "type"
    return Owner { owner_data = ownerData, user_type = userType }

我使用的导入和语言指令：

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}

import Data.Aeson
import Data.Text (Text)
import Data.Monoid ((<>))
import GHC.Generics (Generic)
import qualified Data.HashMap.Lazy as HML (fromList, toList)

- Mor A.