为更高级别的数据派生实例

Question

这个问题是基于这种合理多态的博客文章中描述的高级数据模式.

在下面的代码块中,我定义了一个类型系列HKD和一个数据类型Person,其中的字段可以是Maybe或Identity.

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies  #-}

import           Data.Aeson

-- "Higher Kinded Data" (http://reasonablypolymorphic.com//blog/higher-kinded-data)
type family HKD f a where
    HKD Identity a = a
    HKD Maybe a = Maybe a

data Person f = Person
  { pName :: HKD f String
  , pAge  :: HKD f Int
  } deriving (Generic)

然后我尝试派生ToJSON这种类型的实例.

-- Already provided in imports:
-- instance ToJSON String
-- instance ToJSON Int
-- instance ToJSON a => ToJSON (Maybe a)

instance ToJSON (Person f) where
  toJSON = genericToJSON defaultOptions

不幸的是我收到以下错误:

没有实例(ToJSON (HKD f Int))从使用而产生的genericToJSON.

鉴于我已经拥有ToJSON Int并且ToJSON (Maybe Int),GHC是否应该能够派生出一个实例ToJSON (HKD f Int)？我的理解是类型系列就实例而言就像类型别名一样.如果是这样的话,那么我无法定义自己的情况下进行,但它应该从definions收到的情况下,在这种情况下Int和Maybe Int.不幸的是,错误似乎与此相矛盾.

如何ToJSON为我的类型定义实例？

Answer 1

类型族HKD需要应用于已知Identity或Maybe减少.否则,只有卡住HKD f Int了未知f,我们无法解决HKD f a所有字段类型的约束a,除非在上下文中列出它们,例如(ToJSON (HKD f Int), ToJSON (HKD f String)),这是一种可能的解决方案,但不能很好地扩展到大量字段.

解决方案1:导出上下文

主要的问题是编写和维护的领域限制名单的沉闷,这是由提的是,它是真正的记录类型的功能,我们可以在Haskell使用泛型GHC定义它解决.

type GToJSONFields a = GFields' ToJSON (Rep a)

-- Every field satisfies constraint c
type family GFields' (c :: * -> Constraint) (f :: * -> *) :: Constraint
type instance GFields' c (M1 i d f) = GFields' c f
type instance GFields' c (f :+: g) = (GFields' c f, GFields' c g)
type instance GFields' c (f :*: g) = (GFields' c f, GFields' c g)
type instance GFields' c U1 = ()
type instance GFields' c (K1 i a) = c a

instance (GToJSONFields (Person f)) => ToJSON (Person f) where
  toJSON = genericToJSON defaultOptions

然而,这个实例是非模块化和低效的,因为它仍然暴露了记录的内部结构(其字段类型),并且每次使用时必须重新解决每个字段的约束ToJSON (Person f).

解决方案的要点1

解决方案2:概括上下文

我们真正想要写的是一个实例

instance (forall a. ToJSON a => ToJSON (HKD f a)) => ToJSON (Person f) where
  -- ...

它使用量化约束,这是GHC目前正在实施的一项新功能; 希望语法是自我描述的.但由于它尚未发布,我们能在此期间做些什么呢？

目前,量化约束可使用类型类进行编码.

class ToJSON_HKD f where
  toJSON_HKD :: ToJSON a => f a -> Value  -- AllowAmbiguousTypes, or wrap this in a newtype (which we will define next anyway)

instance ToJSON_HKD Identity where
  toJSON_HKD = toJSON

instance ToJSON_HKD Maybe where
  toJSON_HKD = toJSON

但是genericToJSON会ToJSON在田地上使用,而不是ToJSON_HKD.我们可以使用约束将字段包装在一个newtype调度约束中.ToJSONToJSON_HKD

newtype Apply f a = Apply (HKD f a)

instance ToJSON_HKD f => ToJSON (Apply f a) where
  toJSON (Apply x) = toJSON_HKD @f @a x

Person只能用HKD Identity或包裹的字段HKD Maybe.我们应该再增加一个案例HKD.实际上,让我们打开它,并重构类型构造函数的情况.我们写HKD (Tc Maybe) a而不是HKD Maybe a; 这个更长,但Tc标签可以重用于任何其他类型的构造函数,例如HKD (Tc (Apply f)) a.

-- Redefining HKD
type family HKD f a
type instance HKD Identity a = a
type instance HKD (Tc f) a = f a

data Tc (f :: * -> *)  -- Type-level tag for type constructors

aeson有一个ToJSON1类型类,其作用非常相似ToJSON_HKD,作为编码forall a. ToJSON a => ToJSON (f a).偶然,这Tc是连接这些类的正确类型.

instance ToJSON1 f => ToJSON_HKD (Tc f) where
  toJSON1_HKD = toJSON1

下一步是包装器本身.

wrapApply :: Person f -> Person (Tc (Apply f))
wrapApply = gcoerce

我们所做的就是将字段包装成a newtype(from HKD f ato HKD (Tc (Apply f)) a,等于Apply f a和表示等价HKD f a).所以这真的是一种强制.不幸的是,coerce这里不会进行Person f类型检查,因为它具有标称类型参数(因为它使用HKD,它与名称 匹配f以减少).但是,它Person是一种Generic类型,输入和预期输出的通用表示wrapApply实际上是可强制的.这导致了以下"通用强制",这使得wrapApply多余:

gcoerce :: forall a b
        .  (Generic a, Generic b, Coercible (Rep a ()) (Rep b ()))
        => a -> b
gcoerce = to . (coerce :: Rep a () -> Rep b ()) . from

我们得出结论:将字段包装起来Apply并使用genericToJSON.

instance ToJSON_HKD f => ToJSON (Person f) where
  toJSON = genericToJSON defaultOptions . gcoerce @_ @(Person (Tc (Apply f)))

解决方案的要点2.

关于要点的注意事项:HKD重命名为(@@),从单例借用的名称,并被HKD Identity a重写为HKD Id a,明确区分类型构造函数Identity和Id身份函数的defunctionalized符号.它看起来更整洁.

解决方案3:没有类型系列

HKD博客文章结合了两个想法:

1. 通过类型构造函数f(也称为"函子函子模式")来参数化记录;

2. 概括f是一种类型的函数,这是可能的,即使Haskell没有一流功能在类型级别,这要归功于的技术去官能化.

第二个想法的主要目标是能够使用Person未包装的字段重用记录.对于家庭引入的复杂类型来说,这似乎是一个美容问题.

仔细观察,可以说,确实没有那么多额外的复杂性.到底值得吗？我还没有一个好的答案.

仅供参考,这是将上述技术应用于没有HKD类型族的更简单记录的结果.

data Person f = Person
  { name :: f String
  , age :: f Int
  }

我们可以删除两个定义:ToJSON_HKD(ToJSON1就足够了),以及gcoerce(coerce就足够了).我们Apply用其他新类型连接代替,ToJSON并且ToJSON1:

newtype Apply' f a = Apply' (f a)  -- no HKD

instance (ToJSON1 f, ToJSON a) => ToJSON (Apply' f a) where
  toJSON (Apply' x) = toJSON1 x

我们得出ToJSON如下:

instance ToJSON1 f => ToJSON (Person f) where
  toJSON = genericToJSON defaultOptions . coerce @_ @(Person (Apply' f))

警告:特殊字段类型

aeson有一个选项可以使Maybe字段可选,因此允许它们在相应的JSON对象中丢失.那么,该选项不适用于上述方法.它只影响已知Maybe在实例定义中的字段,因此解决方案2和3因为所有字段的新类型而失败.

此外,对于解决方案1,这

instance {-# OVERLAPPING #-} ToJSON (Person Maybe) where
  toJSON = genericToJSON defaultOptions{omitNothingFields=True}

会表现得不同于本专业其他实例事后到Person Maybe:

instance ... => ToJSON (Person f) where
  toJSON = genericToJSON defaultOptions{omitNothingFields=True}