Question

我正在尝试blog post中列出的JSON解码方法。基本上，我们使用KnownSymbol和typefamilies处理JSON编码和解码的数据类型。到现在为止还挺好。我试用了polymorphic containers的代码，但指定了实际的解码类型（Message String）：

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

现在，我希望解码工作而不指定实际类型 - 所以，我添加了代码 - 而不是Message String，现在我们有Message 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

我会很感激指出我在这里做错了什么。我们认为ghci无法打印，因为Show没有KnownSymbol (TypeKey a)的实例。

Answer 1

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

这里可以利用的简单事情是满足TypeKey x ~ a的类型集是有限的。不要将其表示为类型族，而应考虑以下表示：

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

请注意，您可以代表一个通用的有限地图，例如： *到Symbol但为了简单起见，请保持具体。

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

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

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

data Payload where
  Payload :: a `TypeKeyOf` s -> a -> Payload 

instance ToJSON Payload where
    toJSON (Payload k a) = 
      object [ "type" .= k 
             , isTypeKey k $ "data" .= a
             ]

instance FromJSON Payload where
    parseJSON (Object v) = 
      (v .: "type") >>= \(TK q) -> isTypeKey q (Payload q <$> v .: "data") 
    parseJSON _ = mzero

注意在各个点isTypeKey如何用来证明各种事物都是适当类的实例。

如果您尝试编写show instance：

instance Show Payload where
    show (Payload k a) = isTypeKey k $ 
      "Payload " <> symbolVal (keyOf k) <> " " <> show a

你得到No instance for 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')

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

1 个答案: