有没有一种方法可以使用派生和模板Haskell或其他方法来派生Vinyl记录类型的二进制实例

Question

我一直在试用Vinyl package，它使用类型级别的类型来创建具有字段级别多态性的记录结构，并自动提供镜头。这两个功能对我的项目来说都非常方便，因为前者允许记录结构是彼此的子类型，而不会出现名称冲突，而后者则大大简化了嵌套结构的更新。

问题来自于序列化结果结构。通常我使用Data.DeriveTH自动派生二进制实例，但它似乎无法处理这些结构。下面的代码

{-# LANGUAGE DataKinds, TypeOperators #-}
{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}

import Data.Vinyl

import Data.Binary
import Data.DeriveTH

eID          = Field :: "eID"      ::: Int
location     = Field :: "location" ::: (Double, Double)

type Entity = Rec 
    [   "eID"      ::: Int
    ,   "location" ::: (Double, Double)
    ]

$(derive makeBinary ''Entity)

在GHCI中导致此错误

Exception when trying to run compile-time code:
  Could not convert Dec to Decl
TySynD Main.Entity [] (AppT (ConT Data.Vinyl.Rec.Rec) (AppT (AppT PromotedConsT (AppT (AppT (ConT Data.Vinyl.Field.:::) (LitT (StrTyLit "eID"))) (ConT GHC.Types.Int))) (AppT (AppT PromotedConsT (AppT (AppT (ConT Data.Vinyl.Field.:::) (LitT (StrTyLit "location"))) (AppT (AppT (TupleT 2) (ConT GHC.Types.Double)) (ConT GHC.Types.Double)))) PromotedNilT)))
Language/Haskell/Convert.hs:(37,14)-(40,8): Non-exhaustive patterns in case

  Code: derive makeBinary ''Entity
Failed, modules loaded: none.

这似乎与派生转换模块中的这段代码有关：

instance Convert TH.Dec HS.Decl where
    conv x = case x of
        DataD cxt n vs con ds -> f DataType cxt n vs con ds
        NewtypeD cxt n vs con ds -> f NewType cxt n vs [con] ds
        where
            f t cxt n vs con ds = DataDecl sl t (c cxt) (c n) (c vs) (c con) []

现在我真的不知道如何阅读模板Haskell，所以我不能在这里取得太大进展。我突然想到，我提供的是一个类型同义词，而不是一个数据类型，这可能会破坏它，所以我尝试将它包装在一个新类型中：

newtype Entity2 = Entity2 {entity :: Entity}

$(derive makeBinary ''Entity2)

这导致了这个更加迟钝的错误：

Exception when trying to run compile-time code:
    Could not convert Type to Type
AppT (AppT PromotedConsT (AppT (AppT (ConT Data.Vinyl.Field.:::) (LitT (StrTyLit "eID"))) (ConT GHC.Types.Int))) (AppT (AppT PromotedConsT (AppT (AppT (ConT Data.Vinyl.Field.:::) (LitT (StrTyLit "location"))) (AppT (AppT (TupleT 2) (ConT GHC.Types.Double)) (ConT GHC.Types.Double)))) PromotedNilT)
Could not convert Type to Type
AppT PromotedConsT (AppT (AppT (ConT Data.Vinyl.Field.:::) (LitT (StrTyLit "eID"))) (ConT GHC.Types.Int))
Could not convert Type to Type
PromotedConsT
Language/Haskell/Convert.hs:(71,5)-(80,26): Non-exhaustive patterns in function conv

在Convert.hs中查找我们有

instance Convert TH.Type HS.Type where
    conv (ForallT xs cxt t) = TyForall (Just $ c xs) (c cxt) (c t)
    conv (VarT x) = TyVar $ c x
    conv (ConT x) | ',' `elem` show x = TyTuple Boxed []
                  | otherwise = TyCon $ c x
    conv (AppT (AppT ArrowT x) y) = TyFun (c x) (c y)
    conv (AppT ListT x) = TyList $ c x
    conv (TupleT _) = TyTuple Boxed []
    conv (AppT x y) = case c x of
        TyTuple b xs -> TyTuple b $ xs ++ [c y]
        x -> TyApp x $ c y

现在我猜测问题出在GHC 7.6引入了派生模板Haskell没有考虑到的新语言构造，导致了非穷举模式。

所以我的问题是，有没有什么方法可以通过添加到派生，或者编写我自己的从Vinyl记录类型的派生，或者类似的东西？如果乙烯的好处不得不与手写所有的序列化进行权衡，那将是一种耻辱。

Answer 1

我预计在编写Binary实例时会遇到一些问题，所有的类型技巧都在进行中，但它再简单不过了：

instance Binary (Rec '[]) where
  put RNil = return ()
  get = return RNil

instance (Binary t, Binary (Rec fs)) => Binary (Rec ((sy ::: t) ': fs)) where
  put ((_,x) :& xs) = put x >> put xs
  get = do
    x <- get
    xs <- get
    return ((Field, x) :& xs)