Параметризованные, но типобезопасные ключи в обработке JSON

(Редактировать: попытка дать полный ответ на пересмотренный вопрос.)

Пример кода ниже может быть близок к тому, что вы хотите. В этом примере определяются OutgoingJSON и IncomingJSON с пользовательскими экземплярами ToJSON и FromJSON соответственно. (Я также включил ToJSON для типа данных IncomingJSON, хотя подозреваю, что он вам не нужен.) Он основан на том, что каждому типу данных назначается ключ JSON через короткий экземпляр KeyedJSON. Можно использовать GHC.Generics или какую-либо альтернативу для автоматизации этого, но это кажется уродливым и опрометчивым. (Вы на самом деле не хотите, чтобы ваши ключи JSON были напрямую привязаны к именам типов данных Haskell, не так ли?)

Если вы загрузите это и посмотрите на типы inExample1 и outExample1, они должны соответствовать вашим ожиданиям. inExample2 и inExample3 демонстрируют типобезопасный синтаксический анализ блока JSON — он завершается успешно, если в блоке JSON существует ключ для ожидаемого типа, и завершается ошибкой, если его нет. Наконец, outExample1AsJSON показывает, как пример OutgoingJSON будет сериализован с нужными первичным и вторичным ключами.

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module JsonExample where

import GHC.Generics
import Data.Aeson
import Data.Text (Text)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy.Char8 as C

data Address = Address String deriving (Generic, ToJSON, FromJSON, Show)
data OrderItem = OrderItem Int String deriving (Generic, ToJSON, FromJSON, Show)
data Order = Order { address :: Address
                   , items   :: [OrderItem]
                   } deriving (Generic, ToJSON, FromJSON, Show)

class KeyedJSON a              where jsonKey :: a -> Text
instance KeyedJSON Address     where jsonKey _ = "address"
instance KeyedJSON [OrderItem] where jsonKey _ = "orderitems"
instance KeyedJSON Order       where jsonKey _ = "order"

--
-- OutgoingJSON
--

data OutgoingJSON primary secondary
  = OutgoingJSON primary secondary deriving (Show)
instance (ToJSON primary,   KeyedJSON primary,
          ToJSON secondary, KeyedJSON secondary) => 
         ToJSON (OutgoingJSON primary secondary) where
  toJSON (OutgoingJSON prim sec) = 
    object [ jsonKey prim .= toJSON prim
           , jsonKey sec  .= toJSON sec
           ]

--
-- IncomingJSON
--

data IncomingJSON primary 
  = IncomingJSON primary deriving (Show)
-- don't know if ToJSON instance is needed?
instance (ToJSON primary,   KeyedJSON primary) => ToJSON (IncomingJSON primary) where
  toJSON (IncomingJSON prim) =
    object [ jsonKey prim .= toJSON prim ]
instance (FromJSON primary, KeyedJSON primary) => FromJSON (IncomingJSON primary) where
  parseJSON (Object v) = do
    let key = jsonKey (undefined :: primary)
    IncomingJSON <$> (v .: key >>= parseJSON)

-- Simple examples of typed `IncomingJSON` and `OutgoingJSON` values

-- inExample1 :: IncomingJSON Address
inExample1  = IncomingJSON
              (Address "123 New Street")

-- outExample1 :: OutgoingJSON Address Order
outExample1 = OutgoingJSON 
              (Address "15 Old Street") 
              (Order (Address "15 Old Street") [OrderItem 1 "partridge", OrderItem 5 "golden rings"])

-- Reading a JSON address in a type-safe manner
aJSONAddress :: ByteString
aJSONAddress = C.pack "{\"address\":\"123 New Street\"}"

-- This returns a `Just (IncomingJSON Address)`
inExample2 :: Maybe (IncomingJSON Address)
inExample2 = decode aJSONAddress

-- This returns `Nothing`
inExample3 :: Maybe (IncomingJSON Order)
inExample3 = decode aJSONAddress

-- This demonstrates the JSON serialization of outExample1
outExample1AsJSON = encode outExample1