如何为这个 GADT 编写一个 Serialize 实例？

如何解决如何为这个 GADT 编写一个 Serialize 实例？

下面是一个尝试为简单 GADT 实现 Serialize 实例的模块。不幸的是，get 构造函数的 Reorder 实现抱怨没有 Ixed a 约束。有什么方法可以实现这一点，无论是美的还是丑的？我无法将 Ixed a 添加到实例上下文中，因为 Update 构造函数需要为不满足此约束的值工作。

{-# LANGUAGE GADTs #-}

import Control.Lens (Index,Ixed)
import Data.Serialize

-- | Two different ways of updating a value - replacing it completely or,-- if it is an instance of Ixed,re-ordering it.
data Op a where
  Update :: Serialize a => a -> Op a
  Reorder :: (Ixed a,Serialize (Index a)) => [Index a] -> Op a

instance Serialize a => Serialize (Op a) where
  put (Update a) = putWord8 1 >> put a
  put (Reorder ks) = putWord8 2 >> put ks
  get = do
    i <- getWord8
    case i of
      1 -> Update <$> get
      2 -> Reorder <$> get
      _ -> error "instance Serialize (Op a) - corrupt data"

---

附录：对此的一种简化可能是使类型变量 a 成为幻像类型，使 Op 看起来像这样：

data Op a where
  Update :: Serialize a => ByteString -> Op a
  Reorder :: (Ixed a,Serialize (Index a)) => [ByteString] -> Op a

然后可以使用该类型正确解码字节字符串。不确定这是否有帮助

解决方法

您尝试做的事情通常是不可能的。本质上，您试图让 GHC 推导出 Ixed a 和 Serialize (Index a) 仅给出 Serialize a。当然，这可能适用于您想到的任何用例，但它通常不起作用，这就是 GHC 拒绝您的实例的原因。

我说“一般不可能”，因为如果您指定您关心的类型，那么这绝对是可能的。这意味着您必须列出可以从 Reorder 序列化的所有类型，但这确实与您将要获得的一样好。

有多种方法可以做到这一点，但我认为最简单的方法是使用 constraints 包在 Dict 中捕获您想要的内容。您首先要定义：

class MaybeSerializeIndexed a where
  canSerializeIndex :: Maybe (Dict (Ixed a,Serialize (Index a)))
  default canSerializeIndex :: (Ixed a,Serialize (Index a)) -> Maybe (Dict (Ixed a,Serialize (Index a)))
  canSerializeIndex = Just Dict

默认签名（需要 DefaultSignatures 编译指示）是让您的生活变得简单的关键，因为这意味着您可以使用简单的单行代码列出您关心的类型，如下所示：

instance Serialize a => MaybeSerializeIndexed [a]
instance Serialize k => MaybeSerializeIndexed (Map k a)

除此之外，您可以创建一个重叠实例来处理不与Reorder一起使用的类型：

instance {-# OVERLAPPABLE #-} MaybeSerializeIndexed a where
  canSerializeIndex = Nothing

有了这个机制，你就可以编写你的实例了：

instance (MaybeSerializeIndexed a,Serialize a) => Serialize (Op a) where
  put (Update a) = putWord8 1 >> put a
  put (Reorder ks) = putWord8 2 >> put ks
  get = do
    i <- getWord8
    case (i,canSerializeIndex @a) of
      (1,_)         -> Update <$> get
      (2,Just Dict) -> Reorder <$> get
      _ -> error "instance Serialize (Op a) - corrupt data"

请注意，将 MaybeSerializeIndexed a 约束添加到您的实例实际上并不是什么大问题，因为每种类型都有一个实例。这也意味着，如果您在系统中添加一个新类型而不为其添加 MaybeSerializeIndexed 实例，那么当您尝试反序列化它时不会出现类型错误——只会出现运行时错误。例如，如果您添加一个新类型 Foo，其中您知道 Ixed Foo 和 Serialize (Index Foo) 但您没有添加 instance MaybeSerializeIndexed Foo，那么如果您编写的程序试图 get 一个 Foo 值，但在运行时会出现运行时错误。

,

根据@AntC 的评论，可能值得重新思考为什么需要 Op 作为 GADT。但是，这是一种似乎有效的方法......

Haskell 的基本原则是您可以要求一个实例 Ixed a，但不能根据实例 Ixed a 是否存在而有条件地采取行动。因此，以一种或另一种方式，您将不得不显式枚举要在此序列化中使用的所有类型 a，并手动指示哪些类型将被视为和不会被视为 Ixed。

一旦你接受了这一点，就会有一个显而易见的解决方案。如果您想为 Op a（不是 a ~ Int）和 Ixed（带 a ~ [Int]）支持 Ixed，您可以定义两个实例：

instance Serialize (Op Int) where
  put (Update a) = putWord8 1 >> put a
  put (Reorder ks) = putWord8 2 >> put ks
  get = do
    i <- getWord8
    case i of
      1 -> Update <$> get
      _ -> error "instance Serialize (Op a) - corrupt data"

instance Serialize (Op [Int]) where
  put (Update a) = putWord8 1 >> put a
  put (Reorder ks) = putWord8 2 >> put ks
  get = do
    i <- getWord8
    case i of
      1 -> Update <$> get
      2 -> Reorder <$> get
      _ -> error "instance Serialize (Op a) - corrupt data"

主要问题就解决了。剩下的问题是如何让这个样板变得可口。

这是一种方法。我们可以定义一个类型类来提供 getOp :: Op a 操作，配备两个实例，一个用于 Ixed，一个用于非 Ixed 类型。类型类在数据类型 Bool 中针对 Ixed 的存在和底层类型进行参数化，如下所示：

class OpVal' (hasixed :: Bool) a where
  getOp :: Get (Op a)

并且这两个实例是通过hasixed类型选择的，它指定了a的能力：

instance (Serialize a) => OpVal' False a where
  getOp = do
    i <- getWord8
    case i of
      1 -> Update <$> get
      _ -> error "instance Serialize (Op a) - corrupt data"
instance (Ixed a,Serialize (Index a),Serialize a) => OpVal' True a where
  getOp = do
    i <- getWord8
    case i of
      1 -> Update <$> get
      2 -> Reorder <$> get
      _ -> error "instance Serialize (Op a) - corrupt data"

为了为类型选择合适的实例，我们定义了一个类型系列：

type family HasIxed a :: Bool

指定类型 a 是否具有 Ixed a。然后，我们可以使用另一个类型族根据 OpVal' 选择正确的 HasIxed 实例：

type family OpVal a where
  OpVal a = OpVal' (HasIxed a) a

最后，我们可以定义我们的 Serialize (Op a) 实例：

instance OpVal a => Serialize (Op a) where
  put (Update a) = putWord8 1 >> put a
  put (Reorder ks) = putWord8 2 >> put ks
  get = getOp @(HasIxed a)

有了这个，您可以将类型 a 添加到开放的 HasIxed 类型系列：

type instance HasIxed Int = False
type instance HasIxed [Int] = True

而且这一切都有效：

instance OpVal a => Serialize (Op a) where
  put (Update a) = putWord8 1 >> put a
  put (Reorder ks) = putWord8 2 >> put ks
  get = getOp @(HasIxed a)

data BigThing a b = BigThing (Op a) (Op b) deriving (Generic)
instance (OpVal a,OpVal b) => Serialize (BigThing a b)

main = do
  let s = runPut $ put (BigThing (Update (5 :: Int)) (Reorder @[Int] [1,2,3]))
      Right (BigThing (Update x) (Reorder xs)) = runGet (get :: Get (BigThing Int [Int])) s
  print (x,xs)

完整示例：

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

import GHC.Generics (Generic)
import Control.Lens (Index,Ixed)
import Data.Serialize

data Op a where
  Update :: Serialize a => a -> Op a
  Reorder :: (Ixed a,Serialize (Index a)) => [Index a] -> Op a

class OpVal' (hasixed :: Bool) a where
  getOp :: Get (Op a)
instance (Serialize a) => OpVal' False a where
  getOp = do
    i <- getWord8
    case i of
      1 -> Update <$> get
      _ -> error "instance Serialize (Op a) - corrupt data"
instance (Ixed a,Serialize a) => OpVal' True a where
  getOp = do
    i <- getWord8
    case i of
      1 -> Update <$> get
      2 -> Reorder <$> get
      _ -> error "instance Serialize (Op a) - corrupt data"

type family HasIxed a :: Bool
type instance HasIxed Int = False
type instance HasIxed [Int] = True

type family OpVal a where
  OpVal a = OpVal' (HasIxed a) a

instance OpVal a => Serialize (Op a) where
  put (Update a) = putWord8 1 >> put a
  put (Reorder ks) = putWord8 2 >> put ks
  get = getOp @(HasIxed a)

data BigThing a b = BigThing (Op a) (Op b) deriving (Generic)
instance (OpVal a,xs)