如何编写通用实例（-s）以避免大量手动编码？

Question

我有这样的东西：

data MsgDir = InMD | OutMD

data Msg
  = ResourcesM
  | TagsM
  deriving (Enum, Eq, Show)

data MsgPkt (msg::Msg) (msgDir::MsgDir) where
  GetResourcesMP :: MsgPkt 'ResourcesM 'OutMD
  MyResourcesMP :: Int -> Int -> String -> MsgPkt 'ResourcesM 'InMD

  GetTagsMP :: MsgPkt 'TagsM 'OutMD
  MyTagsMP :: [String] -> MsgPkt 'TagsM 'InMD

class MsgId (msg::Msg) (msgDir::MsgDir) where msgId :: Word8

instance MsgId 'ResourcesM 'OutMD where msgId = fromIntegral $ fromEnum ResourcesM
instance MsgId 'TagsM 'OutMD where msgId = fromIntegral $ fromEnum TagsM

我为 'TagsM 写了几个实例（对于 'OutMD、'InMD）：

instance forall m d. (m ~ 'TagsM, d ~ 'OutMD) => MessagePack (MsgPkt 'TagsM 'OutMD) where
  toObject GetTagsMP = toObject (msgId @m @d)
  fromObject o = do
    msg::Word8 <- fromObject o
    when (msg /= msgId @m @d) (fail $ "Unexpected MESSAGE: " <> show msg)
    pure GetTagsMP


instance forall m d. (m ~ 'TagsM, d ~ 'InMD) => MessagePack (MsgPkt 'TagsM 'InMD) where
  toObject (MyTagsMP a) = toObject (msgId @m @d, a)
  fromObject o = do
    (msg::Word8, a) <- fromObject o
    when (msg /= msgId @m @d) (fail $ "Unexpected MESSAGE: " <> show msg)
    pure $ MyTagsMP a

在为 'ResourcesM 编写相同的几个实例之前，我在想 - 是否有可能减少手动工作 - 也许使用一些通用的？其实我有不止TagsM，ResourcesM，所以手动编码会很繁琐。这些构造函数（如 GetResourcesMP、MyResourcesMP）可以有不同数量的参数（和不同类型的参数）。我什至不确定是否可以使用泛型（或类似的东西）来简化它。

如何写出这样一个泛型实例，所以要用一个简单的“自动”/“半自动”来导出所有这些实例 MessagePack ?

Answer 1

一种方法是为唯一部分创建一个 class，并根据它实现共享部分。这种方法的缺点是它需要您控制消息包对象格式；如果你需要兼容其他一些工具，这种方式就不行了。

class Packable a where
    type Packed a
    pack :: a -> Packed a
    unpack :: Packed a -> a

instance Packable (MsgPkt 'TagsM 'OutMD) where
    type Packed (MsgPkt 'TagsM 'OutMD) = ()
    pack _ = ()
    unpack _ = GetTagsMP

instance Packable (MsgPkt 'TagsM 'InMD) where
    type Packed (MsgPkt 'TagsM 'InMD) = [String]
    pack (MyTagsMP ss) = ss
    unpack = MyTagsMP

instance (Packable (MsgPkt m d), MessagePack (Packed (MsgPkt m d)))
    => MessagePack (MsgPkt m d) where
    toObject mp = toObject (msgId @m @d, pack mp)
    fromObject o = do
        (msg, packed) <- fromObject o
        when (msg /= msgId @m @d) (fail $ "Unexpected MESSAGE: " <> show msg)
        pure (unpack packed)

如何编写通用实例（-s）以避免大量手动编码？

How to write generic instance (-s) to avoid large manual coding?

haskell