如何在 FromJSON/ToJSON 的行上自定义显示/读取实例

Question

我有以下总和类型

import Data.Aeson
import Data.Aeson.Casing
import GHC.Generics
data OrderType = Confirmed | AwaitingShipping | Shipped
deriving (Eq, Generic)
instance ToJSON OrderType where
toJSON = genericToJSON $ (aesonPrefix snakeCase){constructorTagModifier=(camelTo2 '_')}

这会导致在 JSON 编码期间进行以下转换：

Confirmed => confirmed
AwaitingShipping => awaiting_shipping
Shipped => shipped

如何快速生成具有完全相同OrderType=>String转换的Show实例？

请注意，我知道我可以执行以下操作，但我正在寻找一种避免此样板的方法。

instance Show OrderType where
show Confirmed = "confirmed"
show AwaitingShipping = "awaiting_shipping"
show Shipped = "shipped"

Answer 1

(我已经编辑了我的答案，以获得更多的解释。如果你只需要一个包含代码的模块，它仍然可用。

该问题旨在更改默认Show和Read实例 枚举类型，例如OrderType和提供自定义类型。我会展示 下面如何做到这一点，尽管原则上我建议不要这样做， 因为Show和Read通常应该产生Haskell。 值的表示形式。我还会建议一个不同的解决方案， 但是，通过新的类型类。

我的解决方案类似于夏立耀提出的解决方案，但基于泛型SOP而不是内置的GHC泛型。

我们使用以下模块标头。

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module CustomShowEnum where
import Data.Aeson
import Data.Aeson.Types
import Data.Maybe
import Generics.SOP
import Generics.SOP.NS
import Generics.SOP.TH
import Text.Read

让我们从一个计算乘积的函数(列表 具有静态已知数量的元素 S)的所有 构造函数名称。

conNames ::
forall a proxy .
(Generic a, HasDatatypeInfo a)
=> proxy a -> NP (K String) (Code a)
conNames _ =
hmap
(K . constructorName)
(constructorInfo (datatypeInfo (Proxy @a)))

datatypeInfo功能提供所有元信息 关于给定的数据类型，constructorInfo函数提取 从那是一个产品，其中包含有关每个元的信息 构造 函数。我们只对名字感兴趣，没有别的， 所以我们在产品上使用hmap来提取构造函数 每个职位的名称。

让我们看看如何使用它：

GHCi> conNames (Proxy @Bool)
K "False" :* (K "True" :* Nil)

将Nil读作空产品，:*读作"缺点"。每个元素 包装在K构造函数中，因为它是包含 数据类型的每个构造函数的 (常量)字符串。

这同样适用于其他数据类型：

GHCi> conNames (Proxy @Ordering)
K "LT" :* (K "EQ" :* (K "GT" :* Nil))
GHCi> conNames (Proxy @(Maybe ()))
K "Nothing" :* (K "Just" :* Nil)

我们还可以使它适用于问题中提到的OrderType：

data OrderType = Confirmed | AwaitingShipping | Shipped

但是如果我们盲目地尝试这样做，那么我们就会得到一个错误，我们没有Generic类和HasDatatypeInfo类的实例。为 泛型-SOP 函数才能工作，类型必须是这些函数的实例 类。实现此目的的一种方法是使用 Template Haskell：

deriveGeneric ''OrderType

(对于不喜欢模板Haskell的人来说，另一种方式在 库文档。

现在，我们可以使用conNames：

GHCi> conNames (Proxy @OrderType)
K "Confirmed" :* (K "AwaitingShipping" :* (K "Shipped" :* Nil))

其变体是采用特定值并计算 构建该值的最外层构造函数。

conName ::
forall a .
(Generic a, HasDatatypeInfo a)
=> a -> String
conName x =
hcollapse
(hzipWith
const
(conNames (Proxy @a))
(unSOP (from x))
)

在这里，我们使用from来计算给定的泛型表示 值，即产品的总和。总和编码一个之间的选择 数据类型的构造函数。我们可以使用hzipWith来组合 兼容乘积(n 值的乘积)和总和(选项选择 i 从 n 个可能的选项中)，它将选择 i 的第 i 个位置 产品并将两者结合起来。通过使用const将两者结合起来， 效果是，我们只返回相应的构造函数名称 到我们conNames产品的给定构造函数。Thehcollapse应用程序最终提取单个String值。

让我们再看一些例子：

GHCi> conName Confirmed
"Confirmed"
GHCi> conName (Just 3)
"Just"
GHCi> conName [1,2,3]
":"

请注意，在上一个示例中，列表在顶层只是一个 缺点的应用。

接下来，我们定义一个函数enum，用于计算所有乘积 枚举类型的值。这类似于conNames， 但是我们不是返回构造函数名称(作为字符串)，而是返回 返回实际的构造函数。

enum ::
forall a .
(Generic a, HasDatatypeInfo a, All ((~) '[]) (Code a))
=> NP (K a) (Code a)
enum =
hmap
(mapKK to)
(apInjs'_POP (POP (hcpure (Proxy @((~) '[])) Nil)))

apInks'_POP函数生成所有构造函数的乘积 函数在其泛型表示形式中。这些仍然必须是 应用于他们的论点的表示，我们需要提供 这些参数作为产品的乘积(二维表 每个构造函数一行，每行包含参数 应用于该特定构造函数)。

幸运的是，我们在这里将自己限制为枚举类型。这些 是没有任何构造函数参数的类型。这是表达的 通过约束All ((~) '[]) (Code a).类型的代码是 类型列表。外部列表包含每个条目 构造函数，内部列表给出构造函数的类型 参数。约束声明每个内部列表必须 为空，这相当于每个构造函数具有 没有参数。

因此，我们可以生成空参数列表的乘积， 这就是我们通过POP (hcpure (Proxy (@((~) '[])) Nil))所做的。

最后，我们使用带有to的hmap来转动每个构建的 值从其泛型表示形式返回到其原始表示形式 形状。

让我们看一些例子：

GHCi> enum @Bool
K False :* (K True :* Nil)

再次将其与

GHCi> conNames (Proxy @Bool)
K "False" :* (K "True" :* Nil)

请注意，在一种情况下，我们返回字符串，在另一种情况下，我们 返回实际值。

GHCi> enum @Ordering
K LT :* (K EQ :* (K GT :* Nil))

如果我们尝试将enum应用于不是枚举的类型 类型，我们得到一个类型错误。

如果我们尝试将enum应用于OrderType，我们得到一个错误Show缺少OrderType的例子。

如果我们通过

deriving instance Show OrderType

我们获得：

GHCi> enum @OrderType
K Confirmed :* (K AwaitingShipping :* (K Shipped :* Nil))

如果我们使用所需的自定义Show实例 问题，我在下面展示了如何定义，我们反而得到了

GHCi> enum @OrderType
K confirmed :* K awaiting_shipping :* K shipped :* Nil

这也说明了为什么它可能不是一个好主意。 来更改实例，因为我们现在看到 GHCi 用于打印结果混合物标准show哈斯克尔符号与拟使用的特殊符号 在特定域中。

但是，在我们去那里之前，让我们首先实现一个最终 解析方向需要的实用程序函数：

conTable ::
forall a .
(Generic a, HasDatatypeInfo a, All ((~) '[]) (Code a))
=> [(String, a)]
conTable =
hcollapse
(hzipWith
(mapKKK (,))
(conNames (Proxy @a))
enum
)

conTable函数计算一个查找表，该查找表与 具有实际值的字符串构造函数名称。我们有 计算两个乘积的函数，conNames和enum.我们使用hzipWith与(,)配对它们。结果 是另一个产品，但因为该产品包含相同的 在每个位置输入，我们可以用hcollapse把它变成 一个正常的哈斯克尔列表。

GHCi> conTable @Bool
[("False", False), ("True", True)]
GHCi> conTable @Ordering
[("LT", LT), ("EQ", EQ), ("GT", GT)]
GHCi> conTable @OrderType
[("Confirmed", Confirmed), ("AwaitingShipping", AwaitingShipping), ("Shipped", Shipped)]

最后一个示例是使用默认/派生Show实例。

有了这些要素，我们现在能够实施 枚举类型的自定义show和read替换。show方向非常简单：

customShowEnum ::
forall a .
(Generic a, HasDatatypeInfo a, All ((~) '[]) (Code a))
=> (String -> String)
-> a -> String
customShowEnum f = f . conName

给定一个值，我们使用conName来确定其构造函数和 然后将给定的转换函数应用于结果。

此函数适用于Generic中的所有类型HasDatatypeInfo，所以All ((~) '[]) (Code a)约束 将其限制为枚举类型是可选的。

以下是一些示例：

GHCi> customShowEnum id AwaitingShipping
"AwaitingShipping"
GHCi> customShowEnum reverse Confirmed
"demrifnoC"
GHCi> customShowEnum (camelTo2 '_') AwaitingShipping
"awaiting_shipping"

对于read替换，我们实现了一个函数，可以 用于定义Read类的readPrec方法。 这将生成一个类型为ReadPrec a的解析器：

readPrec :: Read a => ReadPrec a

基本策略如下：我们从查找表开始 由conTable给出。我们调整此查找表中的字符串 使用与我们同样使用的转换函数customShowEnum.给定一个输入字符串，然后我们尝试找到 它在调整后的查找表中，如果我们找到它，我们返回 关联的值。代码如下所示：

customReadEnum ::
forall a .
(Generic a, HasDatatypeInfo a, All ((~) '[]) (Code a))
=> (String -> String)
-> ReadPrec a
customReadEnum f =
let
adjustedTable :: [(Lexeme, a)]
adjustedTable = map ( (n, x) -> (Ident (f n), x)) conTable
in
parens $ do
n <- lexP
maybe pfail return (lookup n adjustedTable)

这基本上遵循上面的描述：parens此外，还允许将构造函数名称包装在 括号，通常由read允许，以及使用 的lexP另外处理空格。如果lookup在表中失败，我们使用pfail让解析器失败。

如果我们想尝试这个，我们必须运行ReadPrec解析器 通过应用readPrec_to_S，然后期望优先级 级别(在本例中无关紧要)和输入字符串并返回 包含可能的解析对和剩余解析对的列表 字符串：

GHCi> readPrec_to_S (customReadEnum @OrderType id) 0 "AwaitingShipping"
[(AwaitingShipping, "")]
GHCi> readPrec_to_S (customReadEnum @OrderType (camelTo2 '_')) 0 "AwaitingShipping"
[]
GHCi> readPrec_to_S (customReadEnum @OrderType (camelTo2 '_')) 0 "awaiting_shipping"
[(AwaitingShipping, "")]
>>> readPrec_to_S (customReadEnum @OrderType (camelTo2 '_')) 0 "   ( awaiting_shipping)  "
[(AwaitingShipping, "  ")]

如果我们现在想使用customReadShow和customReadEnum定义Show并Read实例OrderType，我们可以做 这很简单，如下所示：

instance Show OrderType where
show = customShowEnum (camelTo2 '_')
instance Read OrderType where
readPrec = customReadEnum (camelTo2 '_')

但是，正如我上面所说，我建议只使用派生实例 这里为了避免混淆，并且对于特定于领域的文本表示， 我只想介绍新类，例如：

class ToString a where
toString :: a -> String
class FromString a where
fromString :: String -> Maybe a
instance ToString OrderType where
toString = customShowEnum (camelTo2 '_')
customFromString ::
forall a .
(Generic a, HasDatatypeInfo a, All ((~) '[]) (Code a))
=> (String -> String)
-> String -> Maybe a
customFromString f x =
case readPrec_to_S (customReadEnum f) 0 x of
[(r, "")] -> Just r
_         -> Nothing
instance FromString OrderType where
fromString = customFromString (camelTo2 '_')

我们还可以更进一步：

• 我们可以使用默认签名来映射toString并fromString默认Show/Read行为，或我们的自定义行为，以便 我们可以提供空实例或使用派生在更常见的 两种情况。

• 我们可以使用第三个类将特定的转换函数与 一个给定的类型，并在我们的泛型定义中使用此类，以使其更多 显然，两个方向都使用相同的函数，从而删除 潜在错误的来源。

Answer 2

我认为它必须是Show的实例是有原因的，否则camelTo2 '_' . show似乎可以完成这项工作。

无论如何，这是您可以使用GHC.Generics获取构造函数名称的方法。然后，您可以编写camelTo2 '_' . constructorName，无需其他设置;特别是，您可以自由地将其用作show的实现。

import GHC.Generics
-- Constructor name of the value of an ADT.
-- Using 'Generic.from', we map it to a generic representation.
constructorName :: (Generic a, CName (Rep a)) => a -> String
constructorName = cname . from
-- Class of generic representations of ADTs, built using
-- types in GHC.Generics.
-- 'cname' extracts the constructor name from it.
class CName f where
cname :: f p -> String
-- M1 is a newtype to attach metadata about the type
-- being represented at the type level.
-- The first parameter marks the kind of the data
-- in the second one. 'D' indicates general information
-- like the type name and whether it is a newtype.
-- Here we ignore it and look in the rest of the representation.
instance CName f => CName (M1 D c f) where
cname (M1 f) = cname f
-- '(:+:)' represents sums.
instance (CName f, CName g) => CName (f :+: g) where
cname (L1 f) = cname f
cname (R1 g) = cname g
-- 'M1' again, but 'C' indicates information about a specific
-- constructor, we extract it using the 'GHC.Generics.Constructor'
-- type class.
instance Constructor c => CName (M1 C c f) where
cname = conName