Haskell 使用knownsymbol/proxy方法解码JSON数据类型

我正在尝试一种JSON解码方法，如图1所示。基本上，我们使用

KnownSymbol

和

typefamilies

处理JSON编码和解码的数据类型。到现在为止，一直都还不错。我尝试了的代码，但指定了实际解码类型（

消息字符串

）：

*Test> messageStringA
"{ \"payload\": {\"type\": \"string\", \"data\": \"cool\"} }"
*Test> decode messageStringA :: Maybe (Message String)
Just Message ( Payload string "cool" )

现在，我希望解码能够在不指定实际类型的情况下工作-因此，我添加了该代码-而不是

消息字符串

，现在我们有了

消息a

类型：

decode1 :: (s ~ TypeKey a, KnownSymbol s, FromJSON a) => BL.ByteString -> Maybe (Message a)
decode1 = decode

testDecode :: (s ~ TypeKey a, KnownSymbol s, FromJSON a) => Maybe (Message a)
testDecode = decode1 messageStringA

编译很好，但在运行时，我在

ghci

中得到了这个错误：

*Test> :set -XFlexibleContexts
*Test> testDecode

<interactive>:5:1:
    No instance for (KnownSymbol (TypeKey a0))
      arising from a use of ‘it’
    In a stmt of an interactive GHCi command: print it

*Test>：set-XFlexibleContexts
*测试>测试解码
:5:1:
没有（KnownSymbol（TypeKey a0））的实例
因使用“it”而产生的
在交互式GHCi命令的stmt中：打印它

---

我会感谢你指点我做错了什么。在我看来，

ghci

无法打印，因为

KnownSymbol（TypeKey a）

没有

Show

的实例。问题的核心是，您希望保留类型变量作为参数，以便根据需要对这些参数进行类约束，但您还希望对类型进行存在量化（因为类型实际上取决于运行时值）

您可以在这里利用的一个简单问题是满足

TypeKey x~a

的类型集是有限的。而不是代表一个类型族，考虑下面的表示：

data TypeKeyOf (a :: *) (x :: Symbol) where 
  IntK :: Int `TypeKeyOf` "int" 
  StringK :: String `TypeKeyOf` "string" 

请注意，您可以表示从

*

到

符号

的通用有限映射，但为了简单起见，让我们将其具体化

现在，您可以非常轻松地编写一个函数来“证明”有关类型键的各种情况：

type IsTypeKey a x = (ToJSON a, FromJSON a, KnownSymbol x)

isTypeKey :: TypeKeyOf a x -> (IsTypeKey a x => r) -> r 
isTypeKey IntK k = k 
isTypeKey StringK k = k 

keyOf :: TypeKeyOf a x -> Proxy x 
keyOf _ = Proxy 

关键的是，类型类实例不应该有上下文——类型信息都是隐藏的

instance ToJSON (TypeKeyOf a x) where 
  toJSON k = isTypeKey k (A.String . pack . symbolVal . keyOf $ k)

data SomeTypeKey = forall a x . TK (TypeKeyOf a x) 

instance FromJSON SomeTypeKey where 
    parseJSON (A.String s) 
      | s == "int" = return $ TK IntK 
      | s == "string" = return $ TK StringK 
    parseJSON _      = mzero

同样地，

有效载荷

类型变量是存在量化的。这并不意味着你可以用这种类型做得更少（事实上，你可以做得更多）

您没有看到Show a…的实例。通过将所需约束添加到

IsTypeKey

，可以解决此问题：

type IsTypeKey a x = (ToJSON a, FromJSON a, KnownSymbol x, Show a)

现在，类型实际上完全由解析决定，但它只是存在量化的：

>decode "{\"type\": \"string\", \"data\": \"hello\"}" :: Maybe Payload
Just Payload string "hello"
>decode "{\"type\": \"int\", \"data\": 42}" :: Maybe Payload
Just Payload int 42

注意，如果您“知道”有效负载的实际类型，您仍然可以提取 该值是以类型安全的方式提供的，因为您确实了解类型的所有信息，因为您总是可以准确地找到它们是什么

class HasTypeKey a (x :: Symbol) | x -> a where 
  typeKey :: TypeKeyOf a x 

instance HasTypeKey Int "int" where typeKey = IntK 
instance HasTypeKey String "string" where typeKey = StringK 

typeKeyOf :: HasTypeKey a x => Proxy x -> TypeKeyOf a x 
typeKeyOf _ = typeKey 

sameKey :: TypeKeyOf a x -> TypeKeyOf a' x' -> Maybe ('(a, x) :~: '(a', x'))
sameKey IntK IntK = Just Refl 
sameKey StringK StringK = Just Refl 
sameKey _ _ = Nothing 

extractPayload :: HasTypeKey a x => Proxy x -> Payload -> Maybe a 
extractPayload t' (Payload t x) = fmap (\Refl -> x) $ sameKey t (typeKeyOf t')

---

如果“在不指定实际类型的情况下工作”，您的意思是希望编译器确定它是哪种类型，那么这是不可能的。即使在内部存储了该类型的表示，也无法恢复它。无论你用它做什么，它都必须被存在量化。即使如此，您的show实例是

instance show a=>show（Message a）

，因此您有义务提供

show a

的证明来显示消息-您没有任何地方存储或计算这样的证明（即

KnownSymbol

存储在

Message

中的方式）。@user2407038，是的，这是一点。这就是我想知道的。似乎我必须指定解码的确切类型，而不是将其保留为泛型。因此，在不查看

类型

字段的情况下，在不知道实际类型的网络上解码消息时，这种方法不起作用。这种方法有效——可以说，你只需要咬住存在量化的子弹。处理存在量化有时很麻烦，但这是从运行时值键入信息的唯一方法。请参阅我的答案，了解稍作修改的方法。感谢您花时间回答此问题。非常有用。如果您还拥有完整代码的要点，那么可能也会非常有用。这将帮助我把这些问题联系起来。答案中的代码基本上是it，减去导入，这是我从你的代码中复制的。

>decode "{\"type\": \"string\", \"data\": \"hello\"}" :: Maybe Payload
Just Payload string "hello"
>decode "{\"type\": \"int\", \"data\": 42}" :: Maybe Payload
Just Payload int 42

class HasTypeKey a (x :: Symbol) | x -> a where 
  typeKey :: TypeKeyOf a x 

instance HasTypeKey Int "int" where typeKey = IntK 
instance HasTypeKey String "string" where typeKey = StringK 

typeKeyOf :: HasTypeKey a x => Proxy x -> TypeKeyOf a x 
typeKeyOf _ = typeKey 

sameKey :: TypeKeyOf a x -> TypeKeyOf a' x' -> Maybe ('(a, x) :~: '(a', x'))
sameKey IntK IntK = Just Refl 
sameKey StringK StringK = Just Refl 
sameKey _ _ = Nothing 

extractPayload :: HasTypeKey a x => Proxy x -> Payload -> Maybe a 
extractPayload t' (Payload t x) = fmap (\Refl -> x) $ sameKey t (typeKeyOf t')