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

Question

响应Github Gists Rest API的 JSON 包含Haskell的关键字 type.但type不能用作唱片领域.

因此,它不能用于实现Aeson的Generic 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

问题:是否有适当的方法来处理此类冲突？

Answer 1

我们可以通过解决这个TemplateHaskell.相反,写作ToJSON和FromJON,我们可以使用按键的具体映射.

首先,我们必须为非类型的字段构造名称,例如:

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,
      owner_type :: 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:

module RenameUtils where

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

MainFile.hs:

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

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

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,
      owner_type :: Text,
      site_admin :: Bool
  } deriving (Show)

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

现在我们获得一个带有type键的JSON对象:

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,
      owner_type :: Text,
      site_admin :: Bool
  } deriving (Show)

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