Parameterised, but type-safe keys in JSON processing

Question

How do I express the following idea in Haskell? While, the syntax is completely made up, here's what I'm trying to achieve:

• My app has highly nested core data-types with each "level" having FromJson/ToJson instances
• The JSON API powering the UI has the ability to manipulate individual "levels of nesting", eg. to edit the address, you don't need to edit the complete order.
• However, I want to make sure that along with the data that was modified by the UI, the complete order is also sent back. This ensures that, if the edit has resulted in some dependent field in another part of the object being changed, it is communicated back to the UI.

Edit: The core question is not about the app logic, per-se. The core question is how to represent JSON keys in a type-safe manner while having the ability to parameterise over them. The simple solution is to have a different concrete type for each API return type, eg {orderItems :: [OrderItem], order :: Order} or {address :: Address, order :: Order} or {email :: Email, customer :: Customer}. But these will get repetitive quickly. I want to have a data-type which represents the idea of a JSON with a primary key-value pair and a secondary/supporting key-value pair, where the key names can be easily changed.

The pseudo-code given below is a generalisation of this idea:

data IncomingJson rootname payload = (FromJson payload, ToString rootname) => IncomingJson
  {
    rootname :: payload
  }

data OutgoingJson rootname payload sidename sidepayload = (ToJson payload, ToString rootname, ToJson sidepayload, ToString sidename) => IncomingJson
  {
    rootname :: payload
  , sidename :: sidepayload
  }

createOrder :: IncomingJson "order" NewOrder -> OutgoingJson "order" Order Nothing ()

editOrderItems :: IncomingJson "items" [OrderItem] -> OutgoingJson "items" [OrderItem] "order" Order

editOrderAddress :: IncomingJson "address" Address -> OutgoingJson "address" Address "order" Order

Answer 1

(Edit: an attempt at a full answer to the revised question.)

The example code below may be close to what you want. This example defines OutgoingJSON and IncomingJSON with custom ToJSON and FromJSON instances respectively. (I included a ToJSON for the IncomingJSON datatype, too, though I suspect you don't need it.) It relies on each datatype being assigned a JSON key via a short KeyedJSON instance. It's possible to use GHC.Generics or some alternative to automate this, but that seems both ugly and ill-advised. (You don't really want your JSON keys directly tied to Haskell data type names, do you?)

If you load this up and look at the types of inExample1 and outExample1, they should match what you expect. inExample2 and inExample3 demonstrate type-safe parsing of a block of JSON -- it succeeds if the key for the expected type exists in the JSON block and fails if it doesn't. Finally, outExample1AsJSON shows how an OutgoingJSON example will be serialized with the desired primary and secondary keys.

{-# 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