jsonschema: JSON Schema derivation and validation

[ data, json, library, mpl ] [ Propose Tags ] [ Report a vulnerability ]

Provides the ToJSONSchema type class and validation helpers for generating JSON Schema 2020-12 documents from Haskell types and validating JSON values at runtime. The library includes a generic deriving strategy that handles recursive data types, sum-tag encoding, and refined handling of arrays and enumerations. Validation implements the core and applicator vocabularies, including `$defs` and local `$ref` resolution, pragmatic support for `unevaluated*` keywords, and detailed error traces.


[Skip to Readme]

Downloads

Maintainer's Corner

Package maintainers

For package maintainers and hackage trustees

Candidates

Versions [RSS] 0.2.0.0
Change log CHANGELOG.md
Dependencies aeson (>=2.2 && <2.3), base (>=4.18 && <4.19), containers (>=0.6.7 && <0.6.8), regex-tdfa (>=1.3.2 && <1.3.3), scientific (>=0.3.8 && <0.3.9), text (>=2.0 && <2.1), vector (>=0.13 && <0.14) [details]
License MPL-2.0
Author DPella AB
Maintainer matti@dpella.io, lobo@dpella.io
Category Data, JSON
Home page https://github.com/DPella/jsonschema
Bug tracker https://github.com/DPella/jsonschema/issues
Uploaded by tritlo at 2025-10-21T14:26:30Z
Distributions
Downloads 2 total (2 in the last 30 days)
Rating (no votes yet) [estimated by Bayesian average]
Your Rating
  • λ
  • λ
  • λ
Status Docs uploaded by user
Build status unknown [no reports yet]

Readme for jsonschema-0.2.0.0

[back to package description]

jsonschema

Haskell library for deriving and validating JSON Schema (2020-12).

This library provides:

  • Automatic JSON Schema derivation from Haskell types via GHC.Generics.
  • Sensible encodings for records, products, and sum types (with tags).
  • $defs/$ref support for recursive types.
  • A validator that implements the core 2020-12 validation + applicator vocabularies.
  • Helpful error reporting with instance paths when you want detailed feedback.
  • High-level API exposed through Data.JSON.JSONSchema (re-exporting ToJSONSchema and helpers).

Features

  • Derive schemas with the ToJSONSchema type class; generic default handles most ADTs.
  • Records become JSON objects with named properties, emit "required" for every field, and forbid extras via additionalProperties: false. Non-record products become arrays with prefixItems and items: false.
  • Sum types are modeled with discriminator tags:
    • Record constructors: object with a required tag (constructor name) and the record fields.
    • Non-record constructors: object { tag, contents }, both required, where contents carries the constructor’s payload (array/object).
  • Recursive types are emitted under "$defs" and referenced with "$ref".
  • Validation covers: type, const, enum, numeric and string constraints, arrays (prefixItems, items, contains, minContains, maxContains), objects (properties, patternProperties, additionalProperties, propertyNames, required, dependentSchemas, dependentRequired), combinators (anyOf, oneOf, allOf, not), conditionals (if/then/else), and pragmatic unevaluated*.
  • Local $ref resolution using JSON Pointers within the same document.

Notes and limits:

  • JSON Schema version: 2020-12. format and content* are treated as annotations (not asserted).
  • $ref resolution is local (#...) only; external URIs/anchors are not resolved.
  • unevaluatedProperties/unevaluatedItems are implemented with a practical, local approximation.

Quick Start

Add the library to your build, then import the high-level module:

import GHC.Generics (Generic)
import Data.Aeson (ToJSON, Value, object, (.=))
import Data.Proxy (Proxy(..))
import Data.Text (Text)
import Data.JSON.JSONSchema      -- ToJSONSchema(..), Proxy(..), validateJSONSchema
import JSONSchema.Validation     -- validate / validateWithErrors (optional)

1) Derive a schema for your type

data Person = Person
  { name :: Text
  , age  :: Int
  } deriving (Show, Eq, Generic)

instance ToJSON Person
instance ToJSONSchema Person

-- Produce the JSON Schema (as an Aeson Value)
personSchema :: Value
personSchema = toJSONSchema (Proxy :: Proxy Person)

What you get (shape, simplified):

{
  "$defs": {
    "Person": {
      "type": "object",
      "properties": {
        "name": {"type": "string"},
        "age":  {"type": "integer"}
      },
      "additionalProperties": false,
      "required": ["name", "age"]
    }
  },
  "$ref": "#/$defs/Person"
}

Sum types are tagged. For example:

data Shape
  = Circle Double
  | Rectangle Double Double
  deriving (Show, Eq, Generic)

instance ToJSON Shape
instance ToJSONSchema Shape

shapeSchema :: Value
shapeSchema = toJSONSchema (Proxy :: Proxy Shape)

Non-record constructors encode as objects like { tag: { const: "Circle" }, contents: <payload> }. Record constructors encode as objects with a tag plus their named fields.

2) Validate data against a schema

Use the simple boolean check:

import Data.Aeson (toJSON)

valid :: Bool
valid = validateJSONSchema personSchema (toJSON (Person "Alice" 30))

Or collect all validation errors:

import JSONSchema.Validation (validate, validateWithErrors, ValidationError(..))

case validate personSchema (toJSON (Person "Alice" 30)) of
  Right ()   -> putStrLn "OK"
  Left errs  -> mapM_ print errs  -- includes JSON Pointer-like paths

You can validate any Value against any schema, including hand-written schemas:

let schema = object
      [ "type" .= ("object" :: Text)
      , "properties" .= object ["name" .= object ["type" .= ("string" :: Text)]]
      , "required" .= (["name"] :: [Text])
      ]
in validateJSONSchema schema (object ["name" .= ("Bob" :: Text)])

3) Custom schemas for special types

Provide an explicit instance when you need a specific schema shape:

newtype UUID = UUID Text

instance ToJSONSchema UUID where
  toJSONSchema _ = object
    [ "type"      .= ("string" :: Text)
    , "minLength" .= (36 :: Int)
    , "maxLength" .= (36 :: Int)
    ]

Tips

  • Pretty-print schemas with aeson-pretty if you want human-friendly output.
  • For Maybe a, the schema is anyOf [schema(a), {"type":"null"}].
  • For [a], the schema is { "type": "array", "items": schema(a) }.
  • For Either a b, the schema is anyOf with { "Left": a } and { "Right": b } object encodings.

Development

  • Build and test with Cabal:
    • cabal build
    • cabal test

License

Released under the Mozilla Public License 2.0 by DPella AB. See LICENSE for details.