既知のシンボル/プロキシのアプローチを使用したJSONデータ型のデコード

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の、今

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 

我々は Message aタイプを持っています

私がここで間違っていることを指摘してくれるでしょう。 KnownSymbol (TypeKey a)の場合はShowのインスタンスが存在しないため、ghciは印刷できません。

Answer 1

問題の核心は、型変数をパラメータとして残して、必要に応じてそれらのパラメータにクラス制約を設定したいということですが、その型は実在するように量的にしたい）。

ここで利用できる簡単なことは、TypeKey x ~ aを満たすタイプのセットが有限であることです。これをタイプファミリで表現する代わりに、次の表現を考えてみましょう：

たとえば、次のような一般的な有限マップを表すことができます。 *〜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は様々なものが適切なクラスのインスタンスであることを証明するために使用される方法に注意してください。

あなたはショーのインスタンスを記述しようとした場合：

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

あなたはNo instance for Show a ...を取得します。あなたが「知っていればという

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

注：

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

そして今のタイプは本当に完全に解析によって決定されますが、それは単に存在量化されています。これは、IsTypeKeyに必要な制約を加えることで固定されています。実際のタイプのペイロードでは、タイプセーフな方法でその値を に引き出すことができます。実際にはがすべてタイプを知っているので、常に正確に何かを見つけることができます。

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')