diff --git a/src/Json.ml b/src/Json.ml index fc2a21f..a1599b8 100644 --- a/src/Json.ml +++ b/src/Json.ml @@ -1,82 +1,102 @@ -module Decode = struct - external _unsafeCreateUninitializedArray : int -> 'a array = "Array" - [@@mel.new] +type t = Js.Json.t +type json = t - external _stringify : Js.Json.t -> string = "JSON.stringify" +let to_json t = t +let of_json t = t - let _isInteger value = - Js.Float.isFinite value && Js.Math.floor_float value == value +type 'a of_json = Js.Json.t -> 'a +type 'a to_json = 'a -> Js.Json.t +type of_json_error = Json_error of string | Unexpected_variant of string - type 'a decoder = Js.Json.t -> 'a - type error = Json_error of string | Unexpected_variant of string +let of_json_error_to_string = function + | Json_error msg -> msg + | Unexpected_variant tag -> "unexpected variant: " ^ tag - let error_to_string = function - | Json_error msg -> msg - | Unexpected_variant tag -> "unexpected variant: " ^ tag +exception Of_json_error of of_json_error - exception DecodeError of error +let of_json_error msg = raise (Of_json_error (Json_error msg)) +let to_string t = Js.Json.stringify t - let error msg = raise (DecodeError (Json_error msg)) - let id json = json +exception Of_string_error of string - let bool json = - if Js.typeof json = "boolean" then - (Obj.magic (json : Js.Json.t) : bool) - else error ("Expected boolean, got " ^ _stringify json) +let of_string s = + try Js.Json.parseExn s + with exn -> + let msg = + match Js.Exn.asJsExn exn with + | Some jsexn -> Js.Exn.message jsexn + | None -> None + in + let msg = + (* msg really cannot be None in browser or any sane JS runtime *) + Option.value msg ~default:"JSON error" + in + raise (Of_string_error msg) - let float json = - if Js.typeof json = "number" then - (Obj.magic (json : Js.Json.t) : float) - else error ("Expected number, got " ^ _stringify json) +module Of_json = struct + external _stringify : Js.Json.t -> string = "JSON.stringify" - let int json = - let f = float json in - if _isInteger f then (Obj.magic (f : float) : int) - else error ("Expected integer, got " ^ _stringify json) + let string (json : t) : string = + if Js.typeof json = "string" then (Obj.magic json : string) + else of_json_error "expected a string" - let string json = + let char (json : t) = if Js.typeof json = "string" then - (Obj.magic (json : Js.Json.t) : string) - else error ("Expected string, got " ^ _stringify json) + let s = (Obj.magic json : string) in + if String.length s = 1 then String.get s 0 + else of_json_error "expected a single-character string" + else of_json_error "expected a string" - let char json = - let s = string json in - if String.length s = 1 then String.get s 0 - else error ("Expected single-character string, got " ^ _stringify json) + let bool (json : t) : bool = + if Js.typeof json = "boolean" then (Obj.magic json : bool) + else of_json_error "expected a boolean" - let date json = json |> string |> Js.Date.fromString + let is_int value = + Js.Float.isFinite value && Js.Math.floor_float value == value - let nullable decode json = - if (Obj.magic json : 'a Js.null) == Js.null then Js.null - else Js.Null.return (decode json) + let int (json : t) : int = + if Js.typeof json = "number" then + let v = (Obj.magic json : float) in + if is_int v then (Obj.magic v : int) + else of_json_error "expected an integer" + else of_json_error "expected an integer" - (* TODO: remove this? *) - let nullAs value json = - if (Obj.magic json : 'a Js.null) == Js.null then value - else error ("Expected null, got " ^ _stringify json) + let int64 (json : t) : int64 = + if Js.typeof json = "string" then + let v = (Obj.magic json : string) in + match Int64.of_string_opt v with + | Some v -> v + | None -> of_json_error "expected int64 as string" + else of_json_error "expected int64 as string" - let array decode json = - if Js.Array.isArray json then ( - let source = (Obj.magic (json : Js.Json.t) : Js.Json.t array) in - let length = Js.Array.length source in - let target = _unsafeCreateUninitializedArray length in - for i = 0 to length - 1 do - let value = - try decode (Array.unsafe_get source i) - with DecodeError err -> - error - (error_to_string err - ^ "\n\tin array at index " - ^ string_of_int i) - in - Array.unsafe_set target i value - done; - target) - else error ("Expected array, got " ^ _stringify json) + let float (json : t) : float = + if Js.typeof json = "number" then (Obj.magic json : float) + else of_json_error "expected a float" - let list decode json = json |> array decode |> Array.to_list + let unit (json : t) : unit = + if (Obj.magic json : 'a Js.null) == Js.null then () + else of_json_error "expected null" - let pair decodeA decodeB json = + let array v_of_json (json : t) : _ array = + if Js.Array.isArray json then + let json = (Obj.magic json : Js.Json.t array) in + Js.Array.map ~f:v_of_json json + else of_json_error "expected a JSON array" + + let list v_of_json (json : t) : _ list = + array v_of_json json |> Array.to_list + + let option v_of_json (json : t) : _ option = + if (Obj.magic json : 'a Js.null) == Js.null then None + else Some (v_of_json json) + + let js_null v_of_json (json : t) : _ Js.null = + if (Obj.magic json : 'a Js.null) == Js.null then Js.null + else Js.Null.return (v_of_json json) + + let js_date json : Js.Date.t = Js.Date.fromString (string json) + + let tuple2 decodeA decodeB json : _ * _ = if Js.Array.isArray json then let source = (Obj.magic (json : Js.Json.t) : Js.Json.t array) in let length = Js.Array.length source in @@ -84,17 +104,16 @@ module Decode = struct try ( decodeA (Array.unsafe_get source 0), decodeB (Array.unsafe_get source 1) ) - with DecodeError err -> - error (error_to_string err ^ "\n\tin pair/tuple2") + with Of_json_error err -> + of_json_error + (of_json_error_to_string err ^ "\n\tin pair/tuple2") else let length = Js.String.make length in - error + of_json_error {j|Expected array of length 2, got array of length $length|j} - else error ("Expected array, got " ^ _stringify json) - - let tuple2 = pair + else of_json_error ("Expected array, got " ^ _stringify json) - let tuple3 decodeA decodeB decodeC json = + let tuple3 decodeA decodeB decodeC json : _ * _ * _ = if Js.Array.isArray json then let source = (Obj.magic (json : Js.Json.t) : Js.Json.t array) in let length = Js.Array.length source in @@ -103,15 +122,15 @@ module Decode = struct ( decodeA (Array.unsafe_get source 0), decodeB (Array.unsafe_get source 1), decodeC (Array.unsafe_get source 2) ) - with DecodeError err -> - error (error_to_string err ^ "\n\tin tuple3") + with Of_json_error err -> + of_json_error (of_json_error_to_string err ^ "\n\tin tuple3") else let length = Js.String.make length in - error + of_json_error {j|Expected array of length 3, got array of length $length|j} - else error ("Expected array, got " ^ _stringify json) + else of_json_error ("Expected array, got " ^ _stringify json) - let tuple4 decodeA decodeB decodeC decodeD json = + let tuple4 decodeA decodeB decodeC decodeD json : _ * _ * _ * _ = if Js.Array.isArray json then let source = (Obj.magic (json : Js.Json.t) : Js.Json.t array) in let length = Js.Array.length source in @@ -121,15 +140,15 @@ module Decode = struct decodeB (Array.unsafe_get source 1), decodeC (Array.unsafe_get source 2), decodeD (Array.unsafe_get source 3) ) - with DecodeError err -> - error (error_to_string err ^ "\n\tin tuple4") + with Of_json_error err -> + of_json_error (of_json_error_to_string err ^ "\n\tin tuple4") else let length = Js.String.make length in - error + of_json_error {j|Expected array of length 4, got array of length $length|j} - else error ("Expected array, got " ^ _stringify json) + else of_json_error ("Expected array, got " ^ _stringify json) - let dict decode json = + let js_dict decode json : _ Js.Dict.t = if Js.typeof json = "object" && (not (Js.Array.isArray json)) @@ -143,15 +162,38 @@ module Decode = struct let key = Array.unsafe_get keys i in let value = try decode (Js.Dict.unsafeGet source key) - with DecodeError err -> - error (error_to_string err ^ "\n\tin dict") + with Of_json_error err -> + of_json_error (of_json_error_to_string err ^ "\n\tin dict") in Js.Dict.set target key value done; target) - else error ("Expected object, got " ^ _stringify json) + else of_json_error ("Expected object, got " ^ _stringify json) - let field key decode json = + let result ok_of_json err_of_json (json : t) : (_, _) result = + if Js.Array.isArray json then + let array = (Obj.magic json : Js.Json.t array) in + let len = Js.Array.length array in + if Stdlib.( > ) len 0 then + let tag = Js.Array.unsafe_get array 0 in + if Stdlib.( = ) (Js.typeof tag) "string" then + let tag = (Obj.magic tag : string) in + if Stdlib.( = ) tag "Ok" then ( + if Stdlib.( <> ) len 2 then + of_json_error "expected a JSON array of length 2"; + Ok (ok_of_json (Js.Array.unsafe_get array 1))) + else if Stdlib.( = ) tag "Error" then ( + if Stdlib.( <> ) len 2 then + of_json_error "expected a JSON array of length 2"; + Error (err_of_json (Js.Array.unsafe_get array 1))) + else of_json_error "invalid JSON" + else + of_json_error + "expected a non empty JSON array with element being a string" + else of_json_error "expected a non empty JSON array" + else of_json_error "expected a non empty JSON array" + + let at' key decode json = if Js.typeof json = "object" && (not (Js.Array.isArray json)) @@ -161,24 +203,23 @@ module Decode = struct match Js.Dict.get dict key with | Some value -> ( try decode value - with DecodeError err -> - error (error_to_string err ^ "\n\tat field '" ^ key ^ "'")) - | None -> error {j|Expected field '$(key)'|j} - else error ("Expected object, got " ^ _stringify json) + with Of_json_error err -> + of_json_error + (of_json_error_to_string err ^ "\n\tat field '" ^ key ^ "'") + ) + | None -> of_json_error {j|Expected field '$(key)'|j} + else of_json_error ("Expected object, got " ^ _stringify json) let rec at key_path decoder = match key_path with - | [ key ] -> field key decoder - | first :: rest -> field first (at rest decoder) + | [ key ] -> at' key decoder + | first :: rest -> at' first (at rest decoder) | [] -> raise @@ Invalid_argument "Expected key_path to contain at least one element" - let optional decode json = - try Some (decode json) with DecodeError _ -> None - - let oneOf decoders json = + let one_of decoders json = let rec inner decoders errors = match decoders with | [] -> @@ -186,77 +227,169 @@ module Decode = struct "\n- " ^ Js.Array.join ~sep:"\n- " (Array.of_list (List.rev errors)) in - error + of_json_error ({j|All decoders given to oneOf failed. Here are all the errors: $formattedErrors\nAnd the JSON being decoded: |j} ^ _stringify json) | decode :: rest -> ( - try decode json with DecodeError e -> inner rest (e :: errors)) + try decode json + with Of_json_error e -> inner rest (e :: errors)) in inner decoders [] - let either a b = oneOf [ a; b ] + let either a b = one_of [ a; b ] + + let try_or_none decode json = + try Some (decode json) with Of_json_error _ -> None - let withDefault default decode json = - try decode json with DecodeError _ -> default + let try_of_default default decode json = + try decode json with Of_json_error _ -> default let map f decode json = f (decode json) - let andThen b a json = b (a json) json end -module Encode = struct - type 'a encoder = 'a -> Js.Json.t +module To_json = struct + external string : string -> t = "%identity" + external bool : bool -> t = "%identity" + external int : int -> t = "%identity" - external null : Js.Json.t = "null" - external string : string -> Js.Json.t = "%identity" - external float : float -> Js.Json.t = "%identity" - external int : int -> Js.Json.t = "%identity" - external bool : bool -> Js.Json.t = "%identity" + let int64 : int64 -> t = fun v -> Obj.magic (Int64.to_string v) - let char c = c |> String.make 1 |> string - let date d = d |> Js.Date.toJSONUnsafe |> string - let nullable encode = function None -> null | Some v -> encode v - let withDefault d encode = function None -> d | Some v -> encode v + external float : float -> t = "%identity" - external jsonDict : Js.Json.t Js.Dict.t -> Js.Json.t = "%identity" + let unit () : t = Obj.magic Js.null - let dict encode d = - let pairs = Js.Dict.entries d in - let encodedPairs = Array.map (fun (k, v) -> k, encode v) pairs in - jsonDict (Js.Dict.fromArray encodedPairs) + let array v_to_json vs : t = + let vs : Js.Json.t array = Js.Array.map ~f:v_to_json vs in + Obj.magic vs - let object_ props : Js.Json.t = props |> Js.Dict.fromList |> jsonDict + let list v_to_json vs : t = + let vs = Array.of_list vs in + array v_to_json vs - external jsonArray : Js.Json.t array -> Js.Json.t = "%identity" + let option v_to_json v : t = + match v with None -> Obj.magic Js.null | Some v -> v_to_json v - let array encode l = l |> Array.map encode |> jsonArray + let result a_to_json b_to_json v : t = + match v with + | Ok x -> Obj.magic [| string "Ok"; a_to_json x |] + | Error x -> Obj.magic [| string "Error"; b_to_json x |] - let list encode = function - | [] -> jsonArray [||] - | hd :: tl as l -> - let a = Array.make (List.length l) (encode hd) in - let rec fill i = function - | [] -> a - | hd :: tl -> - Array.unsafe_set a i (encode hd); - fill (i + 1) tl - in - jsonArray (fill 1 tl) + let char c = string (String.make 1 c) + let js_date d = string (Js.Date.toJSONUnsafe d) - let pair encodeA encodeB (a, b) = jsonArray [| encodeA a; encodeB b |] - let tuple2 = pair + let js_null v_to_json v = + match Js.Null.toOption v with + | None -> Obj.magic Js.null + | Some v -> v_to_json v + + external json_dict : Js.Json.t Js.Dict.t -> Js.Json.t = "%identity" + + let js_dict encode d = + let pairs = Js.Dict.entries d in + let encodedPairs = Array.map (fun (k, v) -> k, encode v) pairs in + json_dict (Js.Dict.fromArray encodedPairs) + + external json_array : Js.Json.t array -> Js.Json.t = "%identity" + + let tuple2 encodeA encodeB (a, b) = + json_array [| encodeA a; encodeB b |] let tuple3 encodeA encodeB encodeC (a, b, c) = - jsonArray [| encodeA a; encodeB b; encodeC c |] + json_array [| encodeA a; encodeB b; encodeC c |] let tuple4 encodeA encodeB encodeC encodeD (a, b, c, d) = - jsonArray [| encodeA a; encodeB b; encodeC c; encodeD d |] + json_array [| encodeA a; encodeB b; encodeC c; encodeD d |] - external stringArray : string array -> Js.Json.t = "%identity" - external numberArray : float array -> Js.Json.t = "%identity" - external boolArray : bool array -> Js.Json.t = "%identity" + external string_array : string array -> Js.Json.t = "%identity" + external float_array : float array -> Js.Json.t = "%identity" + external int_array : int array -> Js.Json.t = "%identity" + external bool_array : bool array -> Js.Json.t = "%identity" +end + +module Primitives = struct + let string_of_json = Of_json.string + let bool_of_json = Of_json.bool + let float_of_json = Of_json.float + let int_of_json = Of_json.int + let int64_of_json = Of_json.int64 + let option_of_json = Of_json.option + let unit_of_json = Of_json.unit + let result_of_json = Of_json.result + let list_of_json = Of_json.list + let array_of_json = Of_json.array + let string_to_json = To_json.string + let bool_to_json = To_json.bool + let float_to_json = To_json.float + let int_to_json = To_json.int + let int64_to_json = To_json.int64 + let option_to_json = To_json.option + let unit_to_json = To_json.unit + let result_to_json = To_json.result + let list_to_json = To_json.list + let array_to_json = To_json.array +end + +module Decode = struct + type 'a decoder = 'a of_json + + let id json = json + let bool = Of_json.bool + let float = Of_json.float + let int = Of_json.int + let string = Of_json.string + let char = Of_json.char + let date json = Of_json.js_date json + let nullable = Of_json.js_null + let array = Of_json.array + let list = Of_json.list + let pair = Of_json.tuple2 + let tuple2 = Of_json.tuple2 + let tuple3 = Of_json.tuple3 + let tuple4 = Of_json.tuple4 + let dict = Of_json.js_dict + let field = Of_json.at' + let at = Of_json.at + let optional = Of_json.try_or_none + let withDefault = Of_json.try_of_default + let oneOf = Of_json.one_of + let either = Of_json.either + let map = Of_json.map + let andThen b a json = b (a json) json + + let nullAs value json = + if (Obj.magic json : 'a Js.null) == Js.null then value + else of_json_error "Expected null" +end + +module Encode = struct + type 'a encoder = 'a to_json + + external null : t = "null" + + let string = To_json.string + let float = To_json.float + let int = To_json.int + let bool = To_json.bool + let char = To_json.char + let date = To_json.js_date + let list = To_json.list + let array = To_json.array + let nullable = To_json.option + let withDefault d encode = function None -> d | Some v -> encode v + let jsonDict = To_json.json_dict + let dict = To_json.js_dict + let object_ props = To_json.json_dict (Js.Dict.fromList props) + let jsonArray = To_json.json_array + let pair = To_json.tuple2 + let tuple2 = To_json.tuple2 + let tuple3 = To_json.tuple3 + let tuple4 = To_json.tuple4 + let stringArray = To_json.string_array + let numberArray = To_json.float_array + let boolArray = To_json.bool_array end -exception ParseError of string +exception ParseError = Of_string_error let parse s = try Some (Js.Json.parseExn s) with _ -> None diff --git a/src/Json.mli b/src/Json.mli index 5be9684..b77fc9f 100644 --- a/src/Json.mli +++ b/src/Json.mli @@ -101,618 +101,312 @@ let _ = ]} *) -module Decode : sig - (** Provides a set of low level combinator primitives to decode - Js.Json.t data structures A decoder combinator will return the - decoded value if successful, or raise a [DecodeError of string] if - unsuccessful, where the string argument contains the error message. - Decoders are designed to be combined to produce more complex - decoders that can decode arbitrary data structures, though the - emphasis for this library is for it to be {i possible} to decode any - given data structure, not necessarily for it to be {i convenient}. - For convenience you should look towards opinionated third-party - libraries. *) - - type 'a decoder = Js.Json.t -> 'a - (** The type of a decoder combinator *) - - type error = Json_error of string | Unexpected_variant of string +type t = Js.Json.t +(** The type of a JSON data structure *) - val error_to_string : error -> string +type json = t +(** Defined for convenience. *) - exception DecodeError of error +val to_string : json -> string +(** JSON can be encoded as a string. *) - val id : Js.Json.t decoder - (** Identity decoder. +type exn += + | Of_string_error of string + (** The exception raised when parsing JSON error occurs *) - {b Returns} the input JSON value. +val of_string : string -> json +(** JSON can be parsed from a string. Raises {Of_string_error}. *) - Always succeeds. You would use this if you wanted to partially decode - some JSON in stages; in the first stage you could decode some portion - of the input, while using [id] to keep the rest as JSON and decoding - that in subsequent stages. +type 'a to_json = 'a -> json +(** Describe how to encode a value into JSON. *) - @example {[ - open Json - (* returns [(1 : int, {"a": true} : Js.Json.t)] *) - let json = parseOrRaise {|{"id": 1, {"a": true}}|} - let _ = Decode.(int json, id json) - ]} *) +val to_json : json to_json +(** JSON can be encoded as JSON, trivially. *) - val bool : bool decoder - (** Decodes a JSON value into a [bool] - -{b Returns} a [bool] if the JSON value is a [true] or [false]. +(** The type of a error which occurs during decoding JSON values. *) +type of_json_error = Json_error of string | Unexpected_variant of string -@raise [DecodeError] if unsuccessful - -@example {[ - open Json - (* returns true *) - let _ = Json.parseOrRaise "true" |> Decode.bool - (* returns false *) - let _ = Json.parseOrRaise "false" |> Decode.bool - (* raises DecodeError *) - let _ = Json.parseOrRaise "123" |> Decode.bool - (* raises DecodeError *) - let _ = Json.parseOrRaise "null" |> Decode.bool -]} -*) +type exn += + | Of_json_error of of_json_error + (** The exception raised when a decoding error occurs *) - val float : float decoder - (** Decodes a JSON value into a [float] - -{b Returns} a [float] if the JSON value is a number. - -@raise [DecodeError] if unsuccessful - -@example {[ - open Json - (* returns 1.23 *) - let _ = Json.parseOrRaise "1.23" |> Decode.float - (* returns 23. *) - let _ = Json.parseOrRaise "23" |> Decode.float - (* raises DecodeError *) - let _ = Json.parseOrRaise "true" |> Decode.float - (* raises DecodeError *) - let _ = Json.parseOrRaise "null" |> Decode.float -]} -*) - - val int : int decoder - (** Decodes a JSON value into an [int] - -{b Returns} an [int] if the JSON value is a number. - -@raise [DecodeError] if unsuccessful - -@example {[ - open Json - (* returns 23 *) - let _ = Json.parseOrRaise "23" |> Decode.int - (* raises DecodeError *) - let _ = Json.parseOrRaise "1.23" |> Decode.int - (* raises DecodeError *) - let _ = Json.parseOrRaise "true" |> Decode.int - (* raises DecodeError *) - let _ = Json.parseOrRaise "null" |> Decode.int -]} -*) - - val string : string decoder - (** Decodes a JSON value into a [string] - -{b Returns} a [string] if the JSON value is a string. - -@raise [DecodeError] if unsuccessful - -@example {[ - open Json - (* returns "foo" *) - let _ = Json.parseOrRaise "\"foo\"" |> Decode.string - (* raises DecodeError *) - let _ = Json.parseOrRaise "1.23" |> Decode.string - (* raises DecodeError *) - let _ = Json.parseOrRaise "null" |> Decode.string -]} -*) - - val char : char decoder - (** Decodes a JSON value into a [char] - -{b Returns} a [char] if the JSON value is a single-character string. - -@raise [DecodeError] if unsuccessful. - -@example {[ - open Json - (* returns 'a' *) - let _ = Json.parseOrRaise "\"a\"" |> Decode.char - (* raises DecodeError *) - let _ = Json.parseOrRaise "\"abc\"" |> Decode.char - (* raises DecodeError *) - let _ = Json.parseOrRaise "null" |> Decode.char -]} -*) - - val date : Js.Date.t decoder - (** Decodes an ISO8601-formatted JSON string into a [Js.Date.t] - - {b Returns} a [Js.Date.t] if the JSON value is an IS8601-formatted - string. - - @raise [DecodeError] if unsuccessful *) - - val nullable : 'a decoder -> 'a Js.null decoder - (** Decodes a JSON value into an ['a Js.null] - -{b Returns} [Js.null] if the JSON value is [null], or an ['a Js.null] if the -given decoder succeeds, - -@raise [DecodeError] if unsuccessful - -@example {[ - open Json - (* returns (Js.Null.return 23) *) - let _ = Json.parseOrRaise "23" |> Decode.(nullable int) - (* raises DecodeError *) - let _ = Json.parseOrRaise "1.23" |> Decode.(nullable int) - (* returns Js.null *) - let _ = Json.parseOrRaise "null" |> Decode.(nullable int) -]} -*) - - val nullAs : 'a -> 'a decoder - (** Returns the given value if the JSON value is [null] - -{b Returns} an ['a] if the JSON value is [null]. - -@raise [DecodeError] if unsuccessful - -@example {[ - open Json - (* raises DecodeError *) - let _ = Json.parseOrRaise "\"x\"" |> Decode.nullAs "x" - (* returns "x" *) - let _ = Json.parseOrRaise "null" |> Decode.nullAs "x" - (* returns None *) - let _ = Json.parseOrRaise "null" |> Decode.nullAs None -]} -*) - - val array : 'a decoder -> 'a array decoder - (** Decodes a JSON array into an ['a array] using the given decoder on each element - -{b Returns} an ['a array] if the JSON value is a JSON array and all its -elements are successfully decoded. - -@raise [DecodeError] if unsuccessful - -@example {[ - open Json - (* returns [| 1; 2; 3 |] *) - let _ = Json.parseOrRaise "[1, 2, 3]" |> Decode.(array int) - (* raises DecodeError *) - let _ = Json.parseOrRaise "[1, 2, "c"]" |> Decode.(array int) - (* raises DecodeError *) - let _ = Json.parseOrRaise "123" |> Decode.(array int) - (* raises DecodeError *) - let _ = Json.parseOrRaise "null" |> Decode.(array int) -]} -*) - - val list : 'a decoder -> 'a list decoder - (** Decodes a JSON array into an ['a list] using the given decoder on each element - -{b Returns} an ['a list] if the JSON value is a JSON array and all its -elements are successfully decoded. - -@raise [DecodeError] if unsuccessful - -@example {[ - open Json - (* returns [1; 2; 3] *) - let _ = Json.parseOrRaise "[1, 2, 3]" |> Decode.(list int) - (* raises DecodeError *) - let _ = Json.parseOrRaise "[1, 2, "c"]" |> Decode.(list int) - (* raises DecodeError *) - let _ = Json.parseOrRaise "123" |> Decode.(list int) - (* raises DecodeError *) - let _ = Json.parseOrRaise "null" |> Decode.(list int) -]} -*) +type 'a of_json = json -> 'a +(** Describes how to decode a value out of JSON. *) - val pair : 'a decoder -> 'b decoder -> ('a * 'b) decoder - (** Decodes a JSON array with two elements into an ['a * 'b] tuple using - each of the given decoders in order. +val of_json : json of_json +(** JSON can be decoded from JSON, trivially. *) -{b Returns} an ['a * 'b] if the JSON value is a JSON array of length 2 and both - its elements are successfully decoded. - -@raise [DecodeError] if unsuccessful - -@example {[ - open Json - (* returns (1, "bar") *) - let _ = Json.parseOrRaise "[1, \"bar\"]" |> Decode.(pair int string) - (* raises DecodeError *) - let _ = Json.parseOrRaise "[1, 2]" |> Decode.(pair int string) - (* raises DecodeError *) - let _ = Json.parseOrRaise "[1, 2, 3]" |> Decode.(pair int int) -]} -*) - - val tuple2 : 'a decoder -> 'b decoder -> ('a * 'b) decoder - (** Decodes a JSON array with two elements into an ['a * 'b] tuple using - each of the given decoders in order. - -{b Alias of [pair]} - -{b Returns} an ['a * 'b] if the JSON value is a JSON array of length 2 and both - its elements are successfully decoded. - -@raise [DecodeError] if unsuccessful +module Of_json : sig + (** Provides a set of low level combinator primitives to decode + Js.Json.t data structures A decoder combinator will return the + decoded value if successful, or raise a [DecodeError of string] if + unsuccessful, where the string argument contains the error message. + Decoders are designed to be combined to produce more complex + decoders that can decode arbitrary data structures, though the + emphasis for this library is for it to be {i possible} to decode any + given data structure, not necessarily for it to be {i convenient}. + For convenience you should look towards opinionated third-party + libraries. *) -@example {[ - open Json - (* returns (1, "bar") *) - let _ = Json.parseOrRaise "[1, \"bar\"]" |> Decode.(tuple2 int string) - (* raises DecodeError *) - let _ = Json.parseOrRaise "[1, 2]" |> Decode.(tuple2 int string) - (* raises DecodeError *) - let _ = Json.parseOrRaise "[1, 2, 3]" |> Decode.(tuple2 int int) -]} -*) + val string : string of_json + val char : char of_json + val bool : bool of_json + val int : int of_json + val int64 : int64 of_json + val float : float of_json + val unit : unit of_json + val array : 'a of_json -> 'a array of_json + val list : 'a of_json -> 'a list of_json + val option : 'a of_json -> 'a option of_json + val tuple2 : 'a of_json -> 'b of_json -> ('a * 'b) of_json val tuple3 : - 'a decoder -> 'b decoder -> 'c decoder -> ('a * 'b * 'c) decoder - (** Decodes a JSON array with three elements into an ['a * 'b * 'c] - tuple using each of the given decoders in order. - - {b Returns} an ['a * 'b * 'c] if the JSON value is a JSON array of - length 3 and all its elements are successfully decoded. - - @raise [DecodeError] if unsuccessful *) + 'a of_json -> 'b of_json -> 'c of_json -> ('a * 'b * 'c) of_json val tuple4 : - 'a decoder -> - 'b decoder -> - 'c decoder -> - 'd decoder -> - ('a * 'b * 'c * 'd) decoder - (** Decodes a JSON array with four elements into an ['a * 'b * 'c * 'd] - tuple using each of the given decoders in order. + 'a of_json -> + 'b of_json -> + 'c of_json -> + 'd of_json -> + ('a * 'b * 'c * 'd) of_json - {b Returns} an ['a * 'b * 'c * 'd] if the JSON value is a JSON array - of length 4 and all its elements are successfully decoded. + val result : 'a of_json -> 'b of_json -> ('a, 'b) result of_json - @raise [DecodeError] if unsuccessful *) + (** Auxiliary combinators *) - val dict : 'a decoder -> 'a Js.Dict.t decoder - (** Decodes a JSON object into a dict using the given decoder on each of its values - -{b Returns} an ['a Js.Dict.t] if the JSON value is a JSON object and all its -values are successfully decoded. + val at' : string -> 'a of_json -> 'a of_json + val at : string list -> 'a of_json -> 'a of_json + val one_of : 'a of_json list -> 'a of_json + val either : 'a of_json -> 'a of_json -> 'a of_json + val try_or_none : 'a of_json -> 'a option of_json + val try_of_default : 'a -> 'a of_json -> 'a of_json + val map : ('a -> 'b) -> 'a of_json -> 'b of_json -@raise [DecodeError] if unsuccessful + (** Some JS specific combinators. *) -@example {[ - open Json - (* returns (Js.Dict.fromList [("x", 23); ("y", 42)]) *) - let _ = Json.parseOrRaise {| { "x": 23, "y": 42 } |} |> Decode.(dict int) - (* raises DecodeError *) - let _ = Json.parseOrRaise {| { "x": 23, "y": "b" } |} |> Decode.(dict int) - (* raises DecodeError *) - let _ = Json.parseOrRaise "123" |> Decode.(dict int) - (* raises DecodeError *) - let _ = Json.parseOrRaise "null" |> Decode.(dict int) -]} -*) + val js_dict : 'a of_json -> 'a Js.Dict.t of_json + val js_null : 'a of_json -> 'a Js.null of_json + val js_date : Js.Date.t of_json +end - val field : string -> 'a decoder -> 'a decoder - (** Decodes a JSON object with a specific field into the value of that field - -{b Returns} an ['a] if the JSON value is a JSON object with the given field -and a value that is successfully decoded with the given decoder. +module To_json : sig + external string : string -> json = "%identity" + external bool : bool -> json = "%identity" + external int : int -> json = "%identity" + val int64 : int64 -> json + external float : float -> json = "%identity" + val unit : unit to_json + val array : 'a to_json -> 'a array to_json + val list : 'a to_json -> 'a list to_json + val option : 'a to_json -> 'a option to_json + val result : 'a to_json -> 'b to_json -> ('a, 'b) result to_json + val char : char to_json + val tuple2 : 'a to_json -> 'b to_json -> ('a * 'b) to_json -@raise [DecodeError] if unsuccessful + val tuple3 : + 'a to_json -> 'b to_json -> 'c to_json -> ('a * 'b * 'c) to_json -@example {[ - open Json - (* returns 23 *) - let _ = Json.parseOrRaise {| { "x": 23, "y": 42 } |} |> Decode.(field "x" int) - (* returns 23 *) - let _ = Json.parseOrRaise {| { "x": 23, "y": "b" } |} |> Decode.(field "x" int) - (* raises DecodeError *) - let _ = Json.parseOrRaise {| { "x": 23, "y": "b" } |} |> Decode.(field "y" int) - (* raises DecodeError *) - let _ = Json.parseOrRaise "123" |> Decode.(field "x" int) - (* raises DecodeError *) - let _ = Json.parseOrRaise "null" |> Decode.(field "x" int) -]} -*) + val tuple4 : + 'a to_json -> + 'b to_json -> + 'c to_json -> + 'd to_json -> + ('a * 'b * 'c * 'd) to_json + + (** JS specific combinators. *) + + val js_date : Js.Date.t to_json + val js_null : 'a to_json -> 'a Js.null to_json + val js_dict : 'a to_json -> 'a Js.dict to_json + + (** More JS specific to_json converters which exploit JSON runtime + representation in JS runtimes. *) + + external json_dict : json Js.dict -> json = "%identity" + external json_array : json array -> json = "%identity" + external string_array : string array -> json = "%identity" + external float_array : float array -> json = "%identity" + external int_array : int array -> json = "%identity" + external bool_array : bool array -> json = "%identity" +end - val at : string list -> 'a decoder -> 'a decoder - (** Same as [field] but takes a top level field and a list of nested fields for decoding nested values. - -{b Returns} an ['a] if the JSON value is a JSON object with the given field -and a value that is successfully decoded with the given decoder. +module Primitives : sig + val string_of_json : json -> string + val bool_of_json : json -> bool + val float_of_json : json -> float + val int_of_json : json -> int + val int64_of_json : json -> int64 + val option_of_json : (json -> 'a) -> json -> 'a option + val unit_of_json : json -> unit + + val result_of_json : + (json -> 'a) -> (json -> 'b) -> json -> ('a, 'b) result + + val list_of_json : (json -> 'a) -> json -> 'a list + val array_of_json : (json -> 'a) -> json -> 'a array + val string_to_json : string -> json + val bool_to_json : bool -> json + val float_to_json : float -> json + val int_to_json : int -> json + val int64_to_json : int64 -> json + val option_to_json : ('a -> json) -> 'a option -> json + val unit_to_json : unit -> json + + val result_to_json : + ('a -> json) -> ('b -> json) -> ('a, 'b) result -> json + + val list_to_json : ('a -> json) -> 'a list -> json + val array_to_json : ('a -> json) -> 'a array -> json +end -@raise [DecodeError] if unsuccessful -@raise [Invalid_argument] if list of fields is empty +module Decode : sig + type 'a decoder = 'a of_json [@@deprecated "Use `of_json` instead"] + (** The type of a decoder combinator *) -@example {[ - open Json - (* returns 23 *) - let _ = Json.parseOrRaise {| { "x": {"foo": 23}, "y": 42 } |} |> Decode.(at ["x"; "foo"] int) - (* raises DecodeError *) - let _ = Json.parseOrRaise {| { "x": null, "y": "b" } |} |> Decode.(at ["x"; "foo"] int) -]} -*) + val id : t of_json [@@deprecated "Use `of_json` instead"] + val bool : bool of_json [@@deprecated "Use `Of_json.bool` instead"] + val float : float of_json [@@deprecated "Use `Of_json.float` instead"] + val int : int of_json [@@deprecated "Use `Of_json.int` instead"] - val optional : 'a decoder -> 'a option decoder - (** Maps a decoder [result] to an option - -{b Returns} [Some of 'a] if the given decoder is successful, [None] if -it is not. + val string : string of_json + [@@deprecated "Use `Of_json.string` instead"] -This decoder will never raise a [DecodeError]. Its purpose is to catch and -transform [DecodeError]'s of a given decoder into [None]s by mapping its -[result] into an [option]. This prevents a decoder error from terminating -a composite decoder, and is useful to decode optional JSON object fields. + val char : char of_json [@@deprecated "Use `Of_json.char` instead"] -@example {[ - open Json - (* returns (Some 23) *) - let _ = Json.parseOrRaise "23" |> Decode.(optional int) - (* returns None *) - let _ = Json.parseOrRaise 1.23 |> Decode.(optional int) - (* returns None *) - let _ = Json.parseOrRaise "null" |> Decode.(optional int) - (* returns (Some 23) *) - let _ = Json.parseOrRaise {| { "x": 23, "y": "b" } |} |> Decode.(optional (field "x" int)) - (* returns None *) - let _ = Json.parseOrRaise {| { "x": 23, "y": "b" } |} |> Decode.(optional (field "y" int)) - (* returns None *) - let _ = Json.parseOrRaise {| { "x": 23, "y": "b" } |} |> Decode.(optional (field "z" int)) - (* returns (Some 23) *) - let _ = Json.parseOrRaise {| { "x": 23, "y": "b" } |} |> Decode.(field "x" (optional int)) - (* returns None *) - let _ = Json.parseOrRaise {| { "x": 23, "y": "b" } |} |> Decode.(field "y" (optional int)) - (* raises DecodeError *) - let _ = Json.parseOrRaise {| { "x": 23, "y": "b" } |} |> Decode.(field "z" (optional int)) -]} -*) + val date : Js.Date.t of_json + [@@deprecated "Use `Of_json.js_date` instead"] - val oneOf : 'a decoder list -> 'a decoder - (** Tries each [decoder] in order, retunring the result of the first that succeeds + val nullable : 'a of_json -> 'a Js.null of_json + [@@deprecated "Use `Of_json.js_null` instead"] -{b Returns} an ['a] if one of the decoders succeed. + val array : 'a of_json -> 'a array of_json + [@@deprecated "Use `Of_json.array` instead"] -@raise [DecodeError] if unsuccessful + val list : 'a of_json -> 'a list of_json + [@@deprecated "Use `Of_json.list` instead"] -@example {[ - open Json - (* returns 23 *) - let _ = Json.parseOrRaise "23" |> Decode.(oneOf [int; field "x" int]) - (* returns 42 *) - let _ = Json.parseOrRaise {| { "x": 42 } |} |> Decode.(oneOf [int; field "x" int]) - (* raises DecodeError *) - let _ = Json.parseOrRaise "null" |> Decode.(oneOf [int; field "x" int] -]} -*) + val pair : 'a of_json -> 'b of_json -> ('a * 'b) of_json + [@@deprecated "Use `Of_json.tuple2` instead"] - val either : 'a decoder -> 'a decoder -> 'a decoder - (** Tries each [decoder] in order, retunring the result of the first that succeeds + val tuple2 : 'a of_json -> 'b of_json -> ('a * 'b) of_json + [@@deprecated "Use `Of_json.tuple2` instead"] -{b Returns} an ['a] if one of the decoders succeed. + val tuple3 : + 'a of_json -> 'b of_json -> 'c of_json -> ('a * 'b * 'c) of_json + [@@deprecated "Use `Of_json.tuple3` instead"] -@raise [DecodeError] if unsuccessful + val tuple4 : + ('a of_json -> + 'b of_json -> + 'c of_json -> + 'd of_json -> + ('a * 'b * 'c * 'd) of_json + [@deprecated "Use `Of_json.tuple4` instead"]) -@example {[ - open Json - (* returns 23 *) - let _ = Json.parseOrRaise "23" |> Decode.(either int (field "x" int)) - (* returns 42 *) - let _ = Json.parseOrRaise {| { "x": 42 } |} |> Decode.(either int (field "x" int)) - (* raises DecodeError *) - let _ = Json.parseOrRaise "null" |> Decode.(either int (field "x" int)) -]} -*) + val dict : 'a of_json -> 'a Js.Dict.t of_json + [@@deprecated "Use `Of_json.js_dict` instead"] - val withDefault : 'a -> 'a decoder -> 'a decoder - (** Tries the given [decoder] and returns its result if it succeeds, or the -given default value if it fails. + val field : string -> 'a of_json -> 'a of_json + [@@deprecated "Use `Of_json.at'` instead"] -{b Returns} an ['a]. + val at : string list -> 'a of_json -> 'a of_json + [@@deprecated "Use `Of_json.at` instead"] -@example {[ - open Json - (* returns 23 *) - let _ = Json.parseOrRaise "23" |> Decode.withDefault 0 int - (* returns 0 *) - let _ = Json.parseOrRaise "\"x\"" |> Decode.withDefault 0 int - (* returns 0 *) - let _ = Json.parseOrRaise "null" |> Decode.withDefault 0 int -]} -*) + val optional : 'a of_json -> 'a option of_json + [@@deprecated "Use `Of_json.try_or_none instead"] - val map : ('a -> 'b) -> 'a decoder -> 'b decoder - (** Returns a decoder that maps the result of the given decoder if successful + val oneOf : 'a of_json list -> 'a of_json + [@@deprecated "Use `Of_json.one_of` instead"] -{b Returns} a ['b] if the given decoder succeeds. + val either : 'a of_json -> 'a of_json -> 'a of_json + [@@deprecated "Use `Of_json.either` instead"] -@example {[ - open Json - (* returns 46 *) - let _ = Json.parseOrRaise "23" |> Decode.map (fun x -> x + x) int -]} -*) + val withDefault : 'a -> 'a of_json -> 'a of_json + [@@deprecated "Use `Of_json.try_of_default` instead"] - val andThen : ('a -> 'b decoder) -> 'a decoder -> 'b decoder - (** Returns a decoder that maps the result of the given decoder if successful + val map : ('a -> 'b) -> 'a of_json -> 'b of_json + [@@deprecated "Use `Of_json.map` instead"] -{b Returns} an ['a] if both decoders succeed. + val andThen : ('a -> 'b of_json) -> 'a of_json -> 'b of_json + [@@deprecated "Use `Of_json.map` instead"] -@example {[ - (* Decode a JSON tree structure *) - type 'a tree = - | Node of 'a * 'a tree list - | Leaf of 'a - - module Decode = struct - open Json.Decode - - let rec tree decoder = - field "type" string |> andThen ( - function | "node" -> node decoder - | "leaf" -> leaf decoder - | _ -> failwith "unknown node type" - ) - - and node decoder json = - Node ( - (json |> field "value" decoder), - (json |> field "children" (array (tree decoder) |> map Array.to_list)) - ) - - and leaf decoder json = - Leaf (json |> field "value" decoder) - end - - let json = {| { - "type": "node", - "value": 9, - "children": [{ - "type": "node", - "value": 5, - "children": [{ - "type": "leaf", - "value": 3 - }, { - "type": "leaf", - "value": 2 - }] - }, { - "type": "leaf", - "value": 4 - }] - } |} - - let myTree = - json |> Json.parseOrRaise - |> Decode.tree Json.Decode.int -]} -*) + val nullAs : 'a -> 'a of_json + [@@deprecated "Use `Of_json.option f |> Option.value ~default` instead"] end +[@@deprecated "Use `Of_json` instead"] module Encode : sig - (** Provides functions for encoding a JSON data structure *) + type 'a encoder = 'a to_json [@@deprecated "Use `to_json` instead"] - type 'a encoder = 'a -> Js.Json.t - (** The type of a encoder combinator *) + external null : t = "null" [@@deprecated "Use `Js.Json.null` instead"] - external null : Js.Json.t = "null" + val string : string to_json + [@@deprecated "Use `To_json.string` instead"] - (** [null] is the singleton null JSON value *) + val float : float to_json [@@deprecated "Use `To_json.float` instead"] + val int : int to_json [@@deprecated "Use `To_json.int` instead"] + val bool : bool to_json [@@deprecated "Use `To_json.bool` instead"] + val char : char to_json [@@deprecated "Use `To_json.char instead"] - external string : string -> Js.Json.t = "%identity" - (** [string s] makes a JSON string of the [string] [s] *) + val date : Js.Date.t to_json + [@@deprecated "Use `To_json.js_date` instead"] - external float : float -> Js.Json.t = "%identity" - (** [float n] makes a JSON number of the [float] [n] *) + val nullable : 'a to_json -> 'a option to_json + [@@deprecated "Use `To_json.option instead"] - external int : int -> Js.Json.t = "%identity" - (** [int n] makes a JSON number of the [int] [n] *) + val withDefault : Js.Json.t -> 'a to_json -> 'a option -> Js.Json.t + [@@deprecated "Use `To_json.option` instead"] - external bool : bool -> Js.Json.t = "%identity" - (** [bool b] makes a JSON boolean of the [bool] [b] *) + val pair : 'a to_json -> 'b to_json -> ('a * 'b) to_json + [@@deprecated "Use `To_json.tuple2` instead"] - val char : char -> Js.Json.t - (** [char c] makes a JSON string of the [char] [c] *) - - val date : Js.Date.t -> Js.Json.t - (** [date d] makes an ISO 8601 JSON string of the [Js.Date.t] [d] *) - - val nullable : 'a encoder -> 'a option -> Js.Json.t - (** [nullable encoder option] returns either the encoded value or [null] - *) - - val withDefault : Js.Json.t -> 'a encoder -> 'a option -> Js.Json.t - (** [withDefault default encoder option] returns the encoded value if - present, oterwise [default] *) - - val pair : 'a encoder -> 'b encoder -> 'a * 'b -> Js.Json.t - (** [pair encoder encoder tuple] creates a JSON array from a tuple of - size 2 *) - - val tuple2 : 'a encoder -> 'b encoder -> 'a * 'b -> Js.Json.t - (** [tuple2 encoder encoder tuple] creates a JSON array from a tuple of - size 2. Alias of [pair] *) + val tuple2 : 'a to_json -> 'b to_json -> ('a * 'b) to_json + [@@deprecated "Use `To_json.tuple2` instead"] val tuple3 : - 'a encoder -> 'b encoder -> 'c encoder -> 'a * 'b * 'c -> Js.Json.t - (** [tuple3 enc enc enc tuple] creates a JSON array from a tuple of size - 3 *) + 'a to_json -> 'b to_json -> 'c to_json -> ('a * 'b * 'c) to_json + [@@deprecated "Use `To_json.tuple3` instead"] val tuple4 : - 'a encoder -> - 'b encoder -> - 'c encoder -> - 'd encoder -> - 'a * 'b * 'c * 'd -> - Js.Json.t - (** [tuple4 enc enc enc enc tuple] creates a JSON array from a tuple of - size 4 *) - - external jsonDict : Js.Json.t Js.Dict.t -> Js.Json.t = "%identity" - (** [jsonDict d] makes a JSON object of the [Js.Dict.t] [d] *) - - val dict : 'a encoder -> 'a Js.Dict.t encoder - (** [dict encoder d] makes a JSON object of the [Js.Dict.t] [d] with the - given [encoder] *) + 'a to_json -> + 'b to_json -> + 'c to_json -> + 'd to_json -> + ('a * 'b * 'c * 'd) to_json + [@@deprecated "Use `To_json.tuple4` instead"] + + val dict : 'a to_json -> 'a Js.Dict.t to_json + [@@deprecated "Use `To_json.js_dict` instead"] val object_ : (string * Js.Json.t) list -> Js.Json.t - (** [object_ props] makes a JSON object of the [props] list of - properties *) + [@@deprecated "Use 'To_json.json_dict (Js.Dict.fromList x)' instead"] - val array : 'a encoder -> 'a array encoder - (** [array encoder l] makes a JSON array of the [list] [l] using the - given [encoder] * NOTE: This will be renamed `array` once the - existing and deprecated `array` function * has been removed. *) + val array : 'a to_json -> 'a array to_json + [@@deprecated "Use `To_json.array` instead"] - val list : 'a encoder -> 'a list encoder - (** [list encoder a] makes a JSON array of the [array] [a] using the - given [encoder] *) + val list : 'a to_json -> 'a list to_json + [@@deprecated "Use `To_json.list` instead"] - (** The functions below are specialized for specific array type which - happened to be already JSON object in the BuckleScript runtime. - Therefore they are more efficient (constant time rather than linear - conversion). *) + val jsonDict : t Js.Dict.t to_json + [@@deprecated "Use `To_json.json_dict` instead"] - external jsonArray : Js.Json.t array -> Js.Json.t = "%identity" - (** [jsonArray a] makes a JSON array of the [Js.Json.t array] [a] *) + val jsonArray : t array to_json + [@@deprecated "Use `To_json.json_array` instead"] - external stringArray : string array -> Js.Json.t = "%identity" - (** [stringArray a] makes a JSON array of the [string array] [a] *) + val stringArray : string array to_json + [@@deprecated "Use `To_json.string_array` instead"] - external numberArray : float array -> Js.Json.t = "%identity" - (** [numberArray a] makes a JSON array of the [float array] [a] *) + val numberArray : float array to_json + [@@deprecated "Use `To_json.number_array` instead"] - external boolArray : bool array -> Js.Json.t = "%identity" - (** [boolArray] makes a JSON array of the [bool array] [a] *) + val boolArray : bool array to_json + [@@deprecated "Use `To_json.bool_array` instead"] end +[@@deprecated "Use `To_json` instead"] -exception ParseError of string - -val parse : string -> Js.Json.t option -(** [parse s] returns [Some json] if s is a valid json string, [None] - otherwise *) - -val parseOrRaise : string -> Js.Json.t -(** [parse s] returns a [Js.Json.t] if s is a valid json string, raises - [ParseError] otherwise *) +type exn += ParseError of string + [@@deprecated "Use `Of_string_error` instead"] -val stringify : Js.Json.t -> string -(** [stringify json] returns the [string] representation of the given - [Js.Json.t] value *) +val parse : string -> json option [@@deprecated "Use `of_string` instead"] +val parseOrRaise : string -> json [@@deprecated "Use `of_string` instead"] +val stringify : json -> string [@@deprecated "Use `to_string` instead"]