Tagged JSON Deriving

Haskell Generic JSON deriving library developed for Flow: Scrive.Aeson.Generic in scrive-commons.

Motivation

A generic Aeson deriving library which:

  • Works naturally with sum types
  • Allows encoding existing and new APIs with no manual instances
    • properties besides tags in Objects
  • Allows storage in the database (good backwards compatibility of encoding)
  • Provides good ToSchema instances

Haskell Structures

Name Haskell Aeson tagged-deriving
Product type (with named fields) 
data Human = MkHuman
  { name :: Text
  , email :: Maybe Text
  }
  deriving stock (Generic)
  deriving (FromJSON, ToKeyMap, ToJSON) via GUntaggedJSON Human

{
  "name": "Pavel",
  "email": "pavel.potocek@scrive.com"
}

{
  "name": "Pavel",
  "email": "pavel.potocek@scrive.com"
}
Product type (with unnamed fields) 
data Person = Person Name Hobbies
  deriving stock (Generic)
  deriving (FromJSON, ToKeyMap, ToJSON) via GUntaggedJSON Person


data Name = Name
  { name :: Text
  }

data Hobbies = Hobbies
  { hobbies :: [Text]
  }

[
  { 
    "name": "Pavel",
  },
  { 
    "hobbies": []
  }
]

{
  "name": "Pavel",
  "hobbies": []
}
Sum type 
data Animal
  = Human Human
  | Cat
  | Dog
  deriving stock (Generic)
  deriving (FromJSON, ToJSON) via GTaggedJSON "species" Human

{
  "tag": "human",
  "contents": {
    "email": "pavel.potocek@scrive.com"
  }
}

{
  "tag": "cat"
}

{
  "species": "human",
  "email": "pavel.potocek@scrive.com"
}

{
  "species": "cat"
}
Sum of products type 
data Animal
  = Human
    { name :: Text
    , email :: Text
    }
  | Cat
    { numberOfLegs :: Int
    }
  | Dog
  deriving stock (Generic)
  deriving (FromJSON, ToJSON) via GTaggedJSON "species" Person

no serialization

?

Special Cases

Untagged Newtype 
data Cat = MkCat
  { numberOfLegs :: Int
  }
  deriving stock (Generic)
  deriving (FromJSON, ToJSON) via GUntaggedJSON Cat

{
  "number_of_legs": 2
}
Tagged Newtype 
data Cat = MkCat
  { numberOfLegs :: Int
  }
  deriving stock (Generic)
  deriving (FromJSON, ToJSON) via GTaggedJSON "species" Cat

{
  "species": "cat",
  "number_of_legs": 2
}
Product type with unnamed fields 
data Cat = Cat Int Text Bool
  deriving stock (Generic)
  deriving (FromJSON, ToJSON) via GTaggedJSON "species" Cat

Can’t serialize. Aeson-deriving would produce a heterogeneous list: 

[5, "abcd", True]

Configuration

Configuration structure: 

data TaggedOptions = TaggedOptions
  { tagKey :: Maybe Key
  -- ^ no tag is needed for product types
  , fieldLabelModifier :: String -> String
  , constructorTagModifier :: String -> String
  , omitNothingFields :: Bool
  -- ^ only affects the ToKeyMap, ToJSON instances
  }

GTaggedJSON definition: 

type GTaggedJSON tagKey = T.GTaggedJSON (TaggedOptions tagKey)

data TaggedOptions (tagKey :: Symbol)

instance (KnownSymbol prefix, KnownSymbol tagKey) => HasTaggedOptions (TaggedOptions tagKey) where
  taggedOptions =
    TaggedOptions
      { tagKey = fromString . symbolVal $ Proxy @tagKey
      , fieldLabelModifier = snakeCase
      , constructorTagModifier = snakeCase
      , omitNothingFields = True
      }

OpenAPI Schemas

TODO

Flow Conventions

  • Use prefixes if necessary, strip it in the representation
  • snake_case in JSON, camelCase in Haskell. Capitalize accordingly:
    • HttpUrlSchema -> http_url_schema
    • HttpURLSchema -> http_u_r_l_schema
  • Use Mk prefix for product type constructors when it’s necessary to avoid name clashes with sum type constructors 
data Animal
  = Person Person

data Person = MkPerson
  { ...
  }
  • Factor out common fields
BetterWorse
data Animal = Animal Name Kind

data Name = MkName
  { name :: Text
  }

data Kind
  = Human
  | Cat Cat
  | Dog

data Cat = MkCat
  { numberOfLegs :: Int
  }

getName :: Animal -> Text
getName (Animal n _) = n

data Animal
  = Human Human
  | Cat Cat
  | Dog Dog

data Human = MkHuman
  { name :: Text
  }

data Cat = MkCat
  { name :: Text
  , numberOfLegs :: Int
  }

data Dog = MkDog
  { name :: Text
  , numberOfLegs :: Int
  }

getName :: Animal -> Text
getName = \case
  Human h -> h.name
  Cat c -> c.name
  Dog d -> d.name

Multiple tags in one object

HaskellJSON
data Notification = Notification Recipient Template
  deriving stock (Generic)
  deriving (FromJSON, ToJSON) via GUntaggedJSON Notification

data Recipient
  = User User
  | Email Email
  deriving stock (Generic)
  deriving (FromJSON, ToKeyMap, ToJSON) via GTaggedJSON "recipient" Recipient

data Template
  = Default
  | Custom CustomTemplate
  deriving stock (Generic)
  deriving (FromJSON, ToKeyMap, ToJSON) via GTaggedJSON "template" Template

newtype User = MkUser { userId :: UserId }
  deriving ...
newtype Email = MkEmail { email :: Text }
  deriving ...
newtype CustomTemplate = CustomTemplate { text :: Text }
  deriving ...

{
  "recipient": "user",
  "user": "123020892430",
  "template": "default"
}

{
  "recipient": "email",
  "email": "pavel.potocek@scrive.com",
  "template": "custom",
  "text": "Hello, {world}!"
}

Use-cases

In Flow, we use TaggedJSON for almost all serializations.

APIs

  • Can model most exiting APIs

Database

  • Backwards compatible representation in regards to adding sum constructors, and adding Maybe fields

Downsides

  • Your types are informed by the serialization. You sometimes need to do a bit of type juggling.
alt text
#programming