如何在FromJSON / ToJSON行上自定义Show / Read实例

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

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

请注意，我知道我可以做以下事情，但我正在寻找避免这种样板的方法。

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

Answer 1

（我已经编辑了我的答案以获得更多解释。如果您只是想要一个包含代码的模块，那就是still available。

该问题旨在更改默认的Show和Read个实例 枚举类型，例如OrderType和提供自定义类型。我会表现出来 下面怎么做，虽然原则上我建议不要这样做， 因为Show和Read通常被认为会产生Haskell 价值的表示。我还建议一个不同的解决方案， 但是，通过新的类型。

我的解决方案类似于Li-yao Xia提出的解决方案，但是基于generics-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

让我们从计算产品的功能（列表）开始 所有的静态已知数量的元素 构造函数名称。

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视为空产品，将:*视为＆＃34; cons＆＃34;。每个元素 被包装在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类的实例。对于 generics-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来组合a 兼容产品（n值的乘积）和总和（选项的选择 我有n个可能的选项），它将选择我的第i个位置 产品并将两者结合起来。通过使用const将两者结合起来， 效果是我们只返回相应的构造函数名称 从我们的conNames产品到给定的构造函数。 hcollapse 应用程序最后提取单个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))做的事情。

最后，我们使用hmap和to来转换每个构建的 值从他们的通用表示返回到原始表示 形状

让我们看看例子：

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，我们会收到错误消息a <{1}}的{​​{1}}实例缺乏。

如果我们通过

派生一个

Show

我们获得：

OrderType

如果我们使用了所需的自定义deriving instance Show OrderType 实例 问题和我展示如何定义下面，我们改为

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

这也说明了为什么它可能不是一个好主意 改变实例，因为我们现在看到了输出 GHCi使用Show打印结果混合标准 带有特殊符号的Haskell表示法 在一个特定的领域。

然而，在我们去那里之前，让我们先做一个决赛 解析方向我们需要的效用函数：

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

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将其转换为 一个普通的Haskell列表。

(,)

最后一个示例使用默认/派生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类的readPrec方法。 这会生成类型为Read的解析器：

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，然后期望优先权 level（在这种情况下无关）和输入字符串并返回 包含可能的解析对和剩余对的列表 字符串：

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行为，或我们的自定义行为，以便 我们可以提供空实例或使用派生中更常见的 两个案例。

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

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