Module Jsont

Types for JSON values.

This module provides a type for describing JSON values as a bidirectional map between subset of JSON values and arbitrary OCaml values. We call these values JSON types.

In these maps we call decoding the direction from JSON values to OCaml values and encoding the direction from OCaml values to JSON values. Depending on your usage one direction or the other can be left unspecified. Some of the maps may be lossy or creative which leads to JSON queries and transforms.

See the quick start and the cookbook.

Preliminaries

type 'a fmt = Stdlib.Format.formatter -> 'a -> unit

The type for formatters of type 'a.

module Textloc : sig ... end

Text locations.

module Meta : sig ... end

Node metadata.

type 'a node = 'a * Meta.t

The type for JSON nodes. The data of type 'a and its metadata.

module Sort : sig ... end

JSON sorts.

module Path : sig ... end

JSON paths.

module Context : sig ... end

JSON encoding and decoding contexts.

module Error : sig ... end

Encoding, decoding and query errors.

exception Error of Error.t

The exception for errors.

Types

type 'a t

The type for JSON types. A subset of JSON values mapped to values of type 'a.

val kind : 'a t -> string

kind t is a human readable string describing the JSON values typed by t.

val doc : 'a t -> string

doc t is a documentation string for the JSON values typed by t.

module Base : sig ... end

Mapping JSON base types.

module Array : sig ... end

Mapping JSON arrays.

module Obj : sig ... end

Mapping JSON objects.

val any : ?kind:string -> ?doc:string -> ?dec_null:'a t -> ?dec_bool:'a t -> ?dec_number:'a t -> ?dec_string:'a t -> ?dec_array:'a t -> ?dec_obj:'a t -> ?enc:(Context.t -> 'a -> 'a t) -> unit -> 'a t

any () maps subsets of JSON value of different sorts to values of type 'a. The unspecified cases are not part of the subset and error on decoding. enc selects the type on encoding and errors if ommited. kind is the kind of JSON value represented and doc a documentation string.

val map : ?kind:string -> ?doc:string -> ?dec:(Context.t -> 'a -> 'b) -> ?enc:(Context.t -> 'b -> 'a) -> 'a t -> 'b t

map t changes the type of t from 'a to 'b.

  • kind names the entities represented by type 'b. Defaults to "".
  • doc is a documentation string for kind. Defaults to "".
  • dec decodes values of type 'a to values of type 'b. Can be omitted if the result is only used for encoding. The default errors.
  • enc encodes values of type 'b to values of type 'a. Can be omitted if the result is only used for decoding. The default errors.
val rec' : 'a t Stdlib.Lazy.t -> 'a t

rec' maps recursive JSON values. See the cookbook.

Ignoring

val ignore : unit t

ignore lossily maps all JSON values to () on decoding and errors on encoding.

val todo : ?kind:string -> ?doc:string -> ?dec_stub:'a -> unit -> 'a t

todo ?dec_stub () maps all JSON values to dec_stub if specified (errors otherwise) and errors on encoding.

Base types

val null : ?kind:string -> ?doc:string -> 'a -> 'a t

null v maps JSON nulls to v. On encodes any value of type 'a is encoded by null. doc and kind are given to the underlying Base.map. See also Base.null.

val bool : bool t

bool maps JSON booleans to bool values. See also Base.bool.

val number : float t

number maps JSON nulls or numbers to float values. On decodes JSON null is mapped to Float.nan. On encodes any non-finite float is lossily mapped to JSON null (explanation). See also Base.number, any_float and integer combinators.

val string : string t

string maps JSON strings to unescaped and UTF-8 encoded string values. See also Base.string.

Warning. Encoders assume OCaml strings may not be checked for UTF-8 validity.

Options

val none : 'a option t

none maps JSON nulls to None.

val some : 'a t -> 'a option t

some t maps JSON like t does but wraps results in Some. Encoding fails if the value is None.

val option : ?kind:string -> ?doc:string -> 'a t -> 'a option t

option t maps JSON nulls to None and other values by t.

Integers

See this note about (not) representing integers by JSON number values.

val int : int t

int maps truncated JSON numbers or JSON strings to int values.

  • JSON numbers are sucessfully decoded if after truncation they can be represented on the int range, otherwise the decoder errors. int values are encoded as JSON numbers if the integer is in the [-253;253] range.
  • JSON strings are decoded using int_of_string_opt, this allows binary, octal, decimal and hex syntaxes and errors on overflow and syntax errors. int values are encoded as JSON strings with Int.to_string when the integer is outside the [-253;253] range
val uint8 : int t

uint8 maps JSON numbers to unsigned 8-bit integers. JSON numbers are sucessfully decoded if after truncation they can be represented on the [0;255] range. Encoding errors if the integer is out of range.

val uint16 : int t

uint16 maps JSON numbers to unsigned 16-bit integers. JSON numbers are sucessfully decoded if after truncation they can be represented on the [0;65535] range. Encoding errors if the integer is out of range.

val int8 : int t

int8 maps JSON numbers to 8-bit integers. JSON numbers are sucessfully decoded if after truncation they can be represented on the [-128;127] range. Encoding errors if the integer is out of range.

val int16 : int t

int16 maps JSON numbers to 16-bit integers. JSON numbers are sucessfully decoded if after truncation they can be represented on the [-32768;32767] range. Encoding errors if the integer is out of range.

val int32 : int32 t

int32 maps JSON numbers to 32-bit integers. JSON numbers are sucessfully decoded if after truncation they can be represented on the int32 range, otherwise the decoder errors.

val int64 : int64 t

int maps truncated JSON numbers or JSON strings to 64-bit integers.

  • JSON numbers are sucessfully decoded if after truncation they can be represented on the int64 range, otherwise the decoder errors. int64 values are encoded as JSON numbers if the integer is in the [-253;253] range.
  • JSON strings are decoded using int_of_string_opt, this allows binary, octal, decimal and hex syntaxes and errors on overflow and syntax errors. int values are encoded as JSON strings with Int.to_string when the integer is outside the [-253;253] range
val int_as_string : int t

int_as_string maps JSON strings to int values. On decodes this uses int_of_string_opt which allows binary, octal, decimal and hex syntaxes and errors on overflow and syntax errors. On encodes uses Int.to_string.

val int64_as_string : int64 t

int64_as_string maps JSON strings to 64-bit integers. On decodes this uses Int64.of_string_opt which allows binary, octal, decimal and hex syntaxes and errors on overflow and syntax errors. On encodes uses Int.to_string.

Floats

val any_float : float t

any_float is a lossless representation for IEEE 754 doubles. It maps non-finite floats by the JSON strings defined by Float.to_string. This contrasts with number which maps them to JSON null values (explanation). Note that on decodes this still maps JSON nulls to Float.nan. On decoding strings it accepts anything successful decode of Float.of_string_opt. See also number.

Warning. any_float should only be used between parties that have agreed on such an encoding. To maximize interoperability you should use the lossy number map.

val float_as_hex_string : float t

float_as_hex_string maps JSON strings by IEEE 754 doubles in hex notation ("%h" format string). On decodes it accepts anything sucessfully decoded by Float.of_string_opt.

Strings and enums

val enum : ?cmp:('a -> 'a -> int) -> ?kind:string -> ?doc:string -> (string * 'a) list -> 'a t

enum assoc maps JSON strings member of the assoc list to the corresponding OCaml value and vice versa (in log(n)). cmp is used to compare the OCaml values, it defaults to Stdlib.compare. Decoding and encoding error on strings or values not part of assoc

Arrays and tuples

See also queries and updates.

val list : ?kind:string -> ?doc:string -> 'a t -> 'a list t

list t maps JSON arrays of type t to list values. This is Array.type' (Array.list t).

val array : ?kind:string -> ?doc:string -> 'a t -> 'a array t

array t maps JSON arrays of type t to array values. This is Array.type' (Array.array t).

val bigarray : ?kind:string -> ?doc:string -> ('a, 'b) Bigarray.kind -> 'a t -> ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t t

bigarray k t maps JSON arrays of type t to Bigarray.Array1.t values. This is Array.type' (Array.bigarray t).

val t2 : ?kind:string -> ?doc:string -> ?dec:('a -> 'a -> 't2) -> ?enc:('t2 -> int -> 'a) -> 'a t -> 't2 t

t2 ?enc ?dec t maps JSON arrays with exactly 2 elements of type t to value of type 't2. Decodes error if there are more elements.

val t3 : ?kind:string -> ?doc:string -> ?dec:('a -> 'a -> 'a -> 't3) -> ?enc:('t3 -> int -> 'a) -> 'a t -> 't3 t

t3 is like t2 but for 3 elements.

val t4 : ?kind:string -> ?doc:string -> ?dec:('a -> 'a -> 'a -> 'a -> 't4) -> ?enc:('t4 -> int -> 'a) -> 'a t -> 't4 t

t4 is like t2 but for 4 elements.

val tn : ?kind:string -> ?doc:string -> n:int -> 'a t -> 'a array t

tn ~n t maps JSON arrays of exactly n elements of type t to array values. This is array limited by n.

Context

val context : Context.t t

context maps any JSON to its decoding context and errors on encoding.

val with_context : 'a t -> ('a * Context.t) t

with_context t maps JSON like t does but on decodes returns the context in which t is used. On encodes the context is ignored and dropped.

Generic JSON

type name = string node

The type for JSON member names.

type mem = name * json

The type for JSON object members.

and obj = mem list

The type for JSON objects.

and json =
  1. | Null of unit node
  2. | Bool of bool node
  3. | Number of float node
    (*

    Encoders must use Null if float is not finite.

    *)
  4. | String of string node
  5. | Array of json list node
  6. | Obj of obj node

The type for generic JSON values.

module Json : sig ... end

Generic JSON values.

Types

val json : json t

json maps any JSON value to its generic representation.

val json_null : json t

null maps JSON nulls to their generic representation.

val json_bool : json t

bool maps JSON bools to their generic representation.

val json_number : json t

number maps JSON nulls or numbers (explanation) to their generic representation.

val json_string : json t

string represents JSON strings by their generic representation.

val json_array : json t

array represents JSON arrays by their generic representation.

val json_obj : json t

obj represents JSON objects by their generic representation.

val json_mems : (json, json, mem list) Obj.Mems.map

json_mems is a members map collecting unknown members into a generic JSON object.

Queries and updates

Queries are lossy or aggregating decodes. Updates decode to json values but transform the data along the way. They allow to process JSON data without having to fully model it (example).

val const : 'a t -> 'a -> 'a t

const t v maps any JSON value to v on decoding and encodes like t on encoding.

val coerce : dec:'a t -> (Context.t -> 'a -> 'b) -> enc:'b t -> 'b t

coerce ~dec f ~enc on decode maps like dec does followed by f and on encodes uses enc. This can be used to change the JSON sort of value. For example coerce ~dec:int (fun _ i -> string_of_int s) ~enc:string can be used to update a value from a integer to string.

val update : 'a t -> json t

update t decodes any JSON with t and replaces it with an encoding of the result. Encodes any JSON like json does.

Arrays

val nth : ?absent:'a -> int -> 'a t -> 'a t

nth n t decodes the nth index of a JSON array with t. Other indices are skipped. The decode errors if there is no such index unless absent is specified in which case this value is returned. Encodes a singleton array.

val set_nth : ?stub:json -> ?allow_absent:bool -> 'a t -> int -> 'a -> json t

set_nth t n v sets the nth value of a JSON array to v encoded by t on both decodes and encodes. Errors if there is no such index unless ~allow_absent:true is specified in which case the index is created preceeded by as many stub indices as needed. stub defaults to Json.stub applied to the recode.

val update_nth : ?stub:json -> ?absent:json -> int -> 'a t -> json t

update_nth n t on decode recodes the nth value of a JSON array with t. Errors if there is no such index unless absent is specified in which case the index is created with absent, recoded with t and preceeded by as many stub values as needed. stub defaults to Json.stub applied to the recode.

val delete_nth : ?allow_absent:bool -> int -> json t

delete_nth n drops the nth index of a JSON array on both decode and encodes. Other indices are left untouched. Errors if there is no such index unless ~allow_absent:true is specified in which case the data is left untouched.

val filter_map_array : 'a t -> 'b t -> (Context.t -> int -> 'a -> 'b option) -> json t

filter_map_array a b f maps the a elements of a JSON array with f to b elements or deletes them on None. Encodes generic JSON arrays like json_array does.

val fold_array : 'a t -> (Context.t -> int -> 'a -> 'b -> 'b) -> 'b -> 'b t

fold_array t f acc fold f over the t elements of a JSON array starting with acc. Encodes an empty JSON array.

Objects

val mem : ?absent:'a -> string -> 'a t -> 'a t

mem name t decodes the member named name of a JSON object with t. Other members are skipped. The decode errors if there is no such member unless absent is specified in which case this value is returned. Encodes an object with a single name member.

val set_mem : ?allow_absent:bool -> 'a t -> string -> 'a -> json t

set_mem t name v sets the member value of name of a JSON object to an encoding of v with t. This happens both on decodes and encodes. Errors if there is no such member unless allow_absent:true is specified in which case a member is added to the object.

val update_mem : ?absent:json -> string -> 'a t -> json t

update_mem name t recodes the member value of name of a JSON object with t. This happens both on decodes and encodes. Errors if there is no such member unless absent is specified in which case a member with this value is added to the object and recoded with t.

val delete_mem : ?allow_absent:bool -> string -> json t

delete_mem name deletes the member named name of a JSON object on decode. Other members are left untouched. The decode errors if there is no such member unless ~allow_absent:true is specified in which case the data is left untouched. Encodes generic JSON objects like json_obj does.

val fold_obj : 'a t -> (Context.t -> Meta.t -> string -> 'a -> 'b -> 'b) -> 'b -> 'b t

fold_obj t f acc folds f over the t members of a JSON object starting with acc. Encodes an empty JSON object.

val filter_map_obj : 'a t -> 'b t -> (Context.t -> Meta.t -> string -> 'a -> (string * 'b) option) -> json t

filter_map_obj a b f maps the a membrs of a JSON object with f to (n, b) members or deletes them on None. Encodes generic JSON arrays like json_obj does.

filter_map_obj

Indices

val index : ?absent:'a -> Path.index -> 'a t -> 'a t

index uses nth or mem on the given index.

val set_index : ?allow_absent:bool -> 'a t -> Path.index -> 'a -> json t

set_index uses set_nth or set_mem on the given index.

val update_index : ?stub:json -> ?absent:json -> Path.index -> 'a t -> json t

update_index uses update_nth or update_mem on the given index.

val delete_index : ?allow_absent:bool -> Path.index -> json t

delete_index uses delete_nth or delete_mem on the given index.

Paths

val path : ?absent:'a -> Path.t -> 'a t -> 'a t

path p t decodes with t on the last index of p. On the empty path this is t.

val set_path : ?stub:json -> ?allow_absent:bool -> 'a t -> Path.t -> 'a -> json t

set_path p sets the last index of p. On the empty path this results in a itself.

val update_path : ?stub:json -> ?absent:json -> Path.t -> 'a t -> json t
val delete_path : ?allow_absent:bool -> Path.t -> json t

delete_path p deletes the last index of p. On the empty path this results in Json.null ().

TODO

module Caret : sig ... end

JSON carets

Formatters

type number_format = (float -> unit, Stdlib.Format.formatter, unit) Stdlib.format

The type for JSON number formatters.

val default_number_format : number_format

default_number_format is ".17g".

type format =
  1. | Minify
    (*

    Compact. No whitespace, no newlines.

    *)
  2. | Indent
    (*

    Indented output.

    *)
  3. | Layout
    (*

    Follow Meta layout information.

    *)

The type JSON encoding formats.

val pp_null : unit fmt

pp_null formats a JSON null.

val pp_bool : bool fmt

pp_null formats a JSON bool.

val pp_number : float fmt

pp_number formats a JSON number of a JSON null if the float is not finite. Uses the default_number_format.

val pp_number' : number_format -> float fmt

pp_number fmt is like pp_number but uses fmt to format the number.

val pp_string : string fmt

pp_string formats a JSON string (quoted and escaped).

val pp_json : json fmt

pp_json is pp_json' ().

val pp_json' : ?format:format -> ?number_format:number_format -> unit -> json fmt

pp' ~format ~number_format () ppf j formats j on ppf.

  • format specifies how the output is formatted. Defaults to `Indent.
  • number_format is used to format JSON numbers. Defaults to default_number_format
  • Non-finite numbers are output as JSON nulls (explanation).
  • Strings are assumed to be valid UTF-8.
val pp_value : ?format:format -> ?number_format:number_format -> 'a t -> unit -> 'a fmt

pp_value t () formats the JSON representation of values as described by t. See pp_json'. If the encoding of the value errors the error is printed as a JSON string.

Low-level representation

module Repr : sig ... end

Low level representation (unstable).