+58 -46

README.md

reviewed

··· 1 1 - Jsont – Declarative JSON data manipulation for OCaml 2 2 - ==================================================== 1 1 + Json - Declarative JSON data manipulation for OCaml 2 2 + =================================================== 3 3 4 4 - Jsont is an OCaml library for declarative JSON data manipulation. It 5 5 - provides: 4 4 + Json is an OCaml library for declarative JSON data manipulation. It provides: 6 5 7 7 - - Combinators for describing JSON data using the OCaml values of your 8 8 - choice. The descriptions can be used by generic functions to 9 9 - decode, encode, query and update JSON data without having to 10 10 - construct a generic JSON representation. 11 11 - - A JSON codec with optional text location tracking and layout 6 6 + - Codecs for describing JSON data with OCaml values of your choice. 7 7 + These descriptions can decode, encode, query, and update JSON data without 8 8 + requiring callers to construct a generic JSON representation. 9 9 + - `Json.t`, the generic JSON value type. AST helper constructors and operations 10 10 + live in `Json.Value`. 11 11 + - A byte-stream JSON codec with optional text-location tracking and layout 12 12 preservation. The codec is compatible with effect-based concurrency. 13 13 + - Browser-native JSON support through the `json.brr` library. 13 14 14 14 - The descriptions are independent from the codec and can be used by 15 15 - third-party processors or codecs. 16 16 - 17 17 - Jsont is distributed under the ISC license. It has no dependencies. 18 18 - The codec is optional and depends on the [`bytesrw`] library. The JavaScript 19 19 - support is optional and depends on the [`brr`] library. 15 15 + The typed combinator API lives under `Json.Codec`. In particular, 16 16 + `Json.Codec.Object` is the object-codec module; top-level `Json.Object` is only 17 17 + the `Json.t` variant constructor. The main `Json` module keeps `Json.t` as the 18 18 + primary generic JSON value type and provides byte-level helpers such as 19 19 + `Json.of_string`, `Json.to_string`, `Json.decode`, and `Json.encode`. 20 20 21 21 - Homepage: <https://erratique.ch/software/jsont/> 21 21 + Json is distributed under the ISC license and is a fork of the excellent Jsont 22 22 + library. The core engine is exactly the same; the public API is slightly 23 23 + different. 22 24 23 23 - [`bytesrw`]: https://erratique.ch/software/bytesrw 24 24 - [`brr`]: https://erratique.ch/software/brr 25 25 + Homepage: <https://tangled.org/gazagnaire.org/ocaml-json> 25 26 26 27 ## Installation 27 28 28 28 - Jsont can be installed with `opam`: 29 29 + Json can be installed with `opam`: 29 30 30 30 - opam install jsont 31 31 - opam install jsont bytesrw # For the optional codec support 32 32 - opam install jsont brr # For the optional JavaScript support 33 33 - opam install jsont bytesrw cmdliner # For the jsont tool 31 31 + opam install json 32 32 + 33 33 + The main library depends on `bytesrw`, `fmt`, and `loc`. Browser support is 34 34 + provided by the optional Dune library `json.brr`, which depends on `brr`. 34 35 35 36 ## Documentation 36 37 37 37 - The documentation can be consulted [online] or via `odig doc jsont`. 38 38 + Build and browse the API documentation locally with: 38 39 39 39 - Questions are welcome but better asked on the [OCaml forum] than on the 40 40 - issue tracker. 40 40 + dune build @doc 41 41 42 42 - [online]: https://erratique.ch/software/jsont/doc 43 43 - [OCaml forum]: https://discuss.ocaml.org/ 42 42 + If the package is installed in a switch with `odig`, use: 44 43 45 45 - ## Examples 44 44 + odig doc json 46 45 47 47 - A few examples can be found in the [documentation][online] and in the 48 48 - [test](test/) directory. The [`test/topojson.ml`], 49 49 - [`test/geojson.ml`], [`test/json_rpc.ml`], show use of the library on 50 50 - concrete JSON data formats. 46 46 + ## Quick Example 51 47 52 52 - [`test/topojson.ml`]: test/topojson.ml 53 53 - [`test/geojson.ml`]: test/geojson.ml 54 54 - [`test/json_rpc.ml`]: test/json_rpc.ml 48 48 + ```ocaml 49 49 + module C = Json.Codec 55 50 56 56 - ## Paper & technique 51 51 + type item = { task : string; done_ : bool } 57 52 58 58 - If you want to understand the *finally tagged* technique used by the 59 59 - library, the [`paper/soup.ml`] source implements the abridged version 60 60 - of the underlying data type used in [the paper]. 53 53 + let item task done_ = { task; done_ } 61 54 62 62 - [the paper]: paper/ 63 63 - [`paper/soup.ml`]: paper/soup.ml 55 55 + let item_codec = 56 56 + C.Object.map ~kind:"item" item 57 57 + |> C.Object.member "task" C.string ~enc:(fun i -> i.task) 58 58 + |> C.Object.member "done" C.bool ~enc:(fun i -> i.done_) 59 59 + |> C.Object.seal 64 60 65 65 - ## Acknowledgments 61 61 + let decode s = Json.of_string item_codec s 62 62 + let encode item = Json.to_string item_codec item 63 63 + ``` 66 64 67 67 - A grant from the [OCaml Software Foundation] helped to bring the first 68 68 - public release of `jsont`. 65 65 + For generic `Json.t` values, use `Json.Value` constructors: 69 66 70 70 - [OCaml Software Foundation]: http://ocaml-sf.org/ 67 67 + ```ocaml 68 68 + let value = 69 69 + let open Json.Value in 70 70 + object' [ name "ok", bool true ] 71 71 + 72 72 + let text = Json.Value.to_string value 73 73 + ``` 74 74 + 75 75 + ## Examples 76 76 + 77 77 + More complete examples live in the [`test/codecs`](test/codecs/) directory: 78 78 + 79 79 + - [`test/codecs/quickstart.ml`](test/codecs/quickstart.ml) 80 80 + - [`test/codecs/topojson.ml`](test/codecs/topojson.ml) 81 81 + - [`test/codecs/geojson.ml`](test/codecs/geojson.ml) 82 82 + - [`test/codecs/json_rpc.ml`](test/codecs/json_rpc.ml)

+29 -37

lib/brr/json_brr.ml

reviewed

··· 3 3 SPDX-License-Identifier: ISC 4 4 ---------------------------------------------------------------------------*) 5 5 6 6 - open Json.Codec 7 7 - open Json.Codec.Private 6 6 + module I = Json.Codec.Internal__ 7 7 + open I 8 8 9 9 let jv_error_to_error e = 10 10 let ctx = Json.Context.empty and meta = Json.Meta.none in ··· 59 59 (* Decoding *) 60 60 61 61 let fail_push_array map i e = 62 62 - Json.Codec.Private.fail_push_array Json.Meta.none map (i, Json.Meta.none) e 62 62 + I.fail_push_array Json.Meta.none map (i, Json.Meta.none) e 63 63 64 64 let fail_push_object map n e = 65 65 - Json.Codec.Private.fail_push_object Json.Meta.none map (n, Json.Meta.none) e 65 65 + I.fail_push_object Json.Meta.none map (n, Json.Meta.none) e 66 66 67 67 - let fail_type_mismatch t ~fnd = 68 68 - Json.Codec.Private.fail_type_mismatch Json.Meta.none t ~fnd 67 67 + let fail_type_mismatch t ~fnd = I.fail_type_mismatch Json.Meta.none t ~fnd 69 68 70 69 let all_unexpected ~mem_decs mems = 71 70 let unexpected (n, _jname) = ··· 77 76 78 77 let rec decode : type a. a Json.Codec.t -> Jv.t -> a = 79 78 fun t jv -> 80 80 - match t with 79 79 + match I.repr t with 81 80 | Null map -> ( 82 81 match jv_sort jv with 83 82 | Null -> map.dec Json.Meta.none () ··· 108 107 | Rec t -> decode (Lazy.force t) jv 109 108 | Ignore -> () 110 109 111 111 - and decode_array : type a e b. (a, e, b) array_map -> Jv.t -> a = 110 110 + and decode_array : type a e b. (a, e, b) array_map_ -> Jv.t -> a = 112 111 fun map jv -> 113 112 let len = Jv.Jarray.length jv in 114 113 let b = ref (map.dec_empty ()) in ··· 120 119 done; 121 120 map.dec_finish Json.Meta.none len !b 122 121 123 123 - and decode_object : type o. (o, o) object_map -> Jv.t -> o = 122 122 + and decode_object : type o. (o, o) object_map_ -> Jv.t -> o = 124 123 fun map jv -> 125 124 let names = jv_mem_name_map jv in 126 125 let umems = Unknown_mems None in ··· 128 127 apply_dict map.dec dict 129 128 130 129 and decode_object_map : type o. 131 131 - (o, o) object_map -> 132 132 - unknown_mems_option -> 133 133 - mem_dec String_map.t -> 130 130 + (o, o) object_map_ -> 131 131 + unknown_mems_option_ -> 132 132 + mem_dec_ String_map.t -> 134 133 Dict.t -> 135 134 Jstr.t String_map.t -> 136 135 Jv.t -> ··· 144 143 match map.shape with 145 144 | Object_cases (umems', cases) -> 146 145 let umems' = Unknown_mems umems' in 147 147 - let umems, dict = 148 148 - Json.Codec.Private.override_unknown_mems ~by:umems umems' dict 149 149 - in 146 146 + let umems, dict = I.override_unknown_mems ~by:umems umems' dict in 150 147 decode_object_cases map umems cases mem_decs dict names jv 151 148 | Object_basic umems' -> ( 152 149 let umems' = Unknown_mems (Some umems') in 153 153 - let umems, dict = 154 154 - Json.Codec.Private.override_unknown_mems ~by:umems umems' dict 155 155 - in 150 150 + let umems, dict = I.override_unknown_mems ~by:umems umems' dict in 156 151 match umems with 157 152 | Unknown_mems (Some Unknown_skip | None) -> 158 153 let u = Unknown_skip in ··· 168 163 decode_object_basic map u umap mem_decs dict names jv) 169 164 170 165 and decode_object_basic : type o p m b. 171 171 - (o, o) object_map -> 172 172 - (p, m, b) unknown_mems -> 166 166 + (o, o) object_map_ -> 167 167 + (p, m, b) unknown_mems_ -> 173 168 b -> 174 174 - mem_dec String_map.t -> 169 169 + mem_dec_ String_map.t -> 175 170 Dict.t -> 176 171 (string * Jstr.t) list -> 177 172 Jv.t -> 178 173 Dict.t = 179 174 fun map umems umap mem_decs dict names jv -> 180 175 match names with 181 181 - | [] -> 182 182 - Json.Codec.Private.finish_object_decode map Json.Meta.none umems umap 183 183 - mem_decs dict 176 176 + | [] -> I.finish_object_decode map Json.Meta.none umems umap mem_decs dict 184 177 | (n, jname) :: names -> ( 185 178 match String_map.find_opt n mem_decs with 186 179 | Some (Mem_dec m) -> ··· 196 189 decode_object_basic map umems umap mem_decs dict names jv 197 190 | Unknown_error -> 198 191 let fnd = (n, Json.Meta.none) :: all_unexpected ~mem_decs names in 199 199 - Json.Codec.Private.fail_unexpected_members Json.Meta.none map ~fnd 192 192 + I.fail_unexpected_members Json.Meta.none map ~fnd 200 193 | Unknown_keep (mmap, _) -> 201 194 let umap = 202 195 let v = ··· 208 201 decode_object_basic map umems umap mem_decs dict names jv)) 209 202 210 203 and decode_object_cases : type o cs t. 211 211 - (o, o) object_map -> 212 212 - unknown_mems_option -> 213 213 - (o, cs, t) object_cases -> 214 214 - mem_dec String_map.t -> 204 204 + (o, o) object_map_ -> 205 205 + unknown_mems_option_ -> 206 206 + (o, cs, t) object_cases_ -> 207 207 + mem_dec_ String_map.t -> 215 208 Dict.t -> 216 209 Jstr.t String_map.t -> 217 210 Jv.t -> ··· 220 213 let decode_case_tag tag = 221 214 let eq_tag (Case c) = cases.tag_compare c.tag tag = 0 in 222 215 match List.find_opt eq_tag cases.cases with 223 223 - | None -> 224 224 - Json.Codec.Private.fail_unexpected_case_tag Json.Meta.none map cases tag 216 216 + | None -> I.fail_unexpected_case_tag Json.Meta.none map cases tag 225 217 | Some (Case case) -> 226 218 let mems = String_map.remove cases.tag.name names in 227 219 let dict = ··· 239 231 | None -> 240 232 let exp = String_map.singleton cases.tag.name (Mem_dec cases.tag) in 241 233 let fnd = jv_mem_name_list jv in 242 242 - Json.Codec.Private.fail_missing_members Json.Meta.none map ~exp ~fnd) 234 234 + I.fail_missing_members Json.Meta.none map ~exp ~fnd) 243 235 244 244 - and decode_any : type a. a t -> a any_map -> Jv.t -> a = 236 236 + and decode_any : type a. a Json.Codec.t -> a any_map_ -> Jv.t -> a = 245 237 fun t map jv -> 246 238 let case t map sort jv = 247 239 match map with ··· 258 250 259 251 (* Encoding *) 260 252 261 261 - let rec encode : type a. a t -> a -> Jv.t = 253 253 + let rec encode : type a. a Json.Codec.t -> a -> Jv.t = 262 254 fun t v -> 263 263 - match t with 255 255 + match I.repr t with 264 256 | Null map -> 265 257 map.enc v; 266 258 Jv.null ··· 282 274 | Ignore -> Json.Error.failf Json.Meta.none "Cannot encode Ignore value" 283 275 284 276 and encode_object : type o. 285 285 - (o, o) Json.Codec.object_map -> do_unknown:bool -> o -> Jv.t -> Jv.t = 277 277 + (o, o) object_map_ -> do_unknown:bool -> o -> Jv.t -> Jv.t = 286 278 fun map ~do_unknown o jv -> 287 279 let encode_mem map o jv (Mem_enc mmap) = 288 280 try ··· 316 308 | _ -> encode_object case.object_map ~do_unknown v jv) 317 309 318 310 and encode_unknown_mems : type o mems a builder. 319 319 - (o, o) object_map -> (mems, a, builder) mems_map -> mems -> Jv.t -> Jv.t = 311 311 + (o, o) object_map_ -> (mems, a, builder) mems_map_ -> mems -> Jv.t -> Jv.t = 320 312 fun map umap mems jv -> 321 313 let encode_mem map _meta name v jv = 322 314 try

+3 -1

lib/brr/json_brr.mli

reviewed

··· 15 15 {{:https://developer.mozilla.org/en/docs/Web/JavaScript/Reference/Global_Objects/JSON/stringify} 16 16 [JSON.stringify]}. Source locations and layout preservation are not 17 17 supported by the browser runtime; the [~preserve] flag is accepted for 18 18 - signature compatibility but falls back to [~indent] behaviour. *) 18 18 + signature compatibility but falls back to [~indent] behaviour. Decoding and 19 19 + encoding [Jv.t] values walks native JavaScript values directly; it does not 20 20 + materialize {!Json.Value.t}. *) 19 21 20 22 (** {1:jstr From / to browser strings} *) 21 23

+143 -4

lib/codec.ml

reviewed

··· 1105 1105 1106 1106 let check_case_mem map cases ~dec_absent ~tag_compare ~tag_to_string = 1107 1107 match map.shape with 1108 1108 - | Object_cases _ -> invalid_arg "Multiple calls to Json.Object.case_member" 1108 1108 + | Object_cases _ -> 1109 1109 + invalid_arg "Multiple calls to Json.Codec.Object.case_member" 1109 1110 | _ -> ( 1110 1111 match dec_absent with 1111 1112 | None -> () ··· 1199 1200 let set_shape_unknown_mems shape u = 1200 1201 match shape with 1201 1202 | Object_basic (Unknown_keep _) | Object_cases (Some (Unknown_keep _), _) -> 1202 1202 - invalid_arg "Json.Object.keep_unknown already called on object" 1203 1203 + invalid_arg "Json.Codec.Object.keep_unknown already called on object" 1203 1204 | Object_basic _ -> Object_basic u 1204 1205 | Object_cases (_, cases) -> Object_cases (Some u, cases) 1205 1206 ··· 1956 1957 let absent = if allow_absent then Some v else None in 1957 1958 update_path ?stub ?absent p (const t v) 1958 1959 1959 1959 - module Private = struct 1960 1960 + module Internal__ = struct 1961 1961 + module String_map = String_map 1962 1962 + 1963 1963 + type ('ret, 'f) dec_fun_ = ('ret, 'f) dec_fun = 1964 1964 + | Dec_fun : 'f -> ('ret, 'f) dec_fun_ 1965 1965 + | Dec_app : ('ret, 'a -> 'b) dec_fun_ * 'a Type.Id.t -> ('ret, 'b) dec_fun_ 1966 1966 + 1967 1967 + type nonrec ('a, 'b) base_map = ('a, 'b) base_map = { 1968 1968 + kind : string; 1969 1969 + doc : string; 1970 1970 + dec : Meta.t -> 'a -> 'b; 1971 1971 + enc : 'b -> 'a; 1972 1972 + enc_meta : 'b -> Meta.t; 1973 1973 + } 1974 1974 + 1975 1975 + type 'a repr = 'a t = 1976 1976 + | Null : (unit, 'a) base_map -> 'a repr 1977 1977 + | Bool : (bool, 'a) base_map -> 'a repr 1978 1978 + | Number : (float, 'a) base_map -> 'a repr 1979 1979 + | String : (string, 'a) base_map -> 'a repr 1980 1980 + | Array : ('a, 'elt, 'builder) array_map_ -> 'a repr 1981 1981 + | Object : ('o, 'o) object_map_ -> 'o repr 1982 1982 + | Any : 'a any_map_ -> 'a repr 1983 1983 + | Map : ('a, 'b) map_ -> 'b repr 1984 1984 + | Rec : 'a t Lazy.t -> 'a repr 1985 1985 + | Ignore : unit repr 1986 1986 + 1987 1987 + and ('array, 'elt, 'builder) array_map_ = 1988 1988 + ('array, 'elt, 'builder) array_map = { 1989 1989 + kind : string; 1990 1990 + doc : string; 1991 1991 + elt : 'elt t; 1992 1992 + dec_empty : unit -> 'builder; 1993 1993 + dec_skip : int -> 'builder -> bool; 1994 1994 + dec_add : int -> 'elt -> 'builder -> 'builder; 1995 1995 + dec_finish : Meta.t -> int -> 'builder -> 'array; 1996 1996 + enc : 'acc. ('acc -> int -> 'elt -> 'acc) -> 'acc -> 'array -> 'acc; 1997 1997 + enc_meta : 'array -> Meta.t; 1998 1998 + } 1999 1999 + 2000 2000 + and ('o, 'dec) object_map_ = ('o, 'dec) object_map = { 2001 2001 + kind : string; 2002 2002 + doc : string; 2003 2003 + dec : ('o, 'dec) dec_fun_; 2004 2004 + mem_decs : mem_dec_ String_map.t; 2005 2005 + mem_encs : 'o mem_enc_ list; 2006 2006 + enc_meta : 'o -> Meta.t; 2007 2007 + shape : 'o object_shape_; 2008 2008 + } 2009 2009 + 2010 2010 + and mem_dec_ = mem_dec = Mem_dec : ('o, 'a) mem_map_ -> mem_dec_ 2011 2011 + and 'o mem_enc_ = 'o mem_enc = Mem_enc : ('o, 'a) mem_map_ -> 'o mem_enc_ 2012 2012 + 2013 2013 + and ('o, 'a) mem_map_ = ('o, 'a) mem_map = { 2014 2014 + name : string; 2015 2015 + doc : string; 2016 2016 + type' : 'a t; 2017 2017 + id : 'a Type.Id.t; 2018 2018 + dec_absent : 'a option; 2019 2019 + enc : 'o -> 'a; 2020 2020 + enc_omit : 'a -> bool; 2021 2021 + } 2022 2022 + 2023 2023 + and 'o object_shape_ = 'o object_shape = 2024 2024 + | Object_basic : ('o, 'mems, 'builder) unknown_mems_ -> 'o object_shape_ 2025 2025 + | Object_cases : 2026 2026 + ('o, 'mems, 'builder) unknown_mems_ option 2027 2027 + * ('o, 'cases, 'tag) object_cases_ 2028 2028 + -> 'o object_shape_ 2029 2029 + 2030 2030 + and ('o, 'mems, 'builder) unknown_mems_ = ('o, 'mems, 'builder) unknown_mems = 2031 2031 + | Unknown_skip : ('o, unit, unit) unknown_mems_ 2032 2032 + | Unknown_error : ('o, unit, unit) unknown_mems_ 2033 2033 + | Unknown_keep : 2034 2034 + ('mems, 'a, 'builder) mems_map_ * ('o -> 'mems) 2035 2035 + -> ('o, 'mems, 'builder) unknown_mems_ 2036 2036 + 2037 2037 + and ('mems, 'a, 'builder) mems_map_ = ('mems, 'a, 'builder) mems_map = { 2038 2038 + kind : string; 2039 2039 + doc : string; 2040 2040 + mems_type : 'a t; 2041 2041 + id : 'mems Type.Id.t; 2042 2042 + dec_empty : unit -> 'builder; 2043 2043 + dec_add : Meta.t -> string -> 'a -> 'builder -> 'builder; 2044 2044 + dec_finish : Meta.t -> 'builder -> 'mems; 2045 2045 + enc : 2046 2046 + 'acc. (Meta.t -> string -> 'a -> 'acc -> 'acc) -> 'mems -> 'acc -> 'acc; 2047 2047 + } 2048 2048 + 2049 2049 + and ('o, 'cases, 'tag) object_cases_ = ('o, 'cases, 'tag) object_cases = { 2050 2050 + tag : ('tag, 'tag) mem_map_; 2051 2051 + tag_compare : 'tag -> 'tag -> int; 2052 2052 + tag_to_string : ('tag -> string) option; 2053 2053 + id : 'cases Type.Id.t; 2054 2054 + cases : ('cases, 'tag) case_ list; 2055 2055 + enc : 'o -> 'cases; 2056 2056 + enc_case : 'cases -> ('cases, 'tag) case_value_; 2057 2057 + } 2058 2058 + 2059 2059 + and ('cases, 'case, 'tag) case_map_ = ('cases, 'case, 'tag) case_map = { 2060 2060 + tag : 'tag; 2061 2061 + object_map : ('case, 'case) object_map_; 2062 2062 + dec : 'case -> 'cases; 2063 2063 + } 2064 2064 + 2065 2065 + and ('cases, 'tag) case_value_ = ('cases, 'tag) case_value = 2066 2066 + | Case_value : 2067 2067 + ('cases, 'case, 'tag) case_map_ * 'case 2068 2068 + -> ('cases, 'tag) case_value_ 2069 2069 + 2070 2070 + and ('cases, 'tag) case_ = ('cases, 'tag) case = 2071 2071 + | Case : ('cases, 'case, 'tag) case_map_ -> ('cases, 'tag) case_ 2072 2072 + 2073 2073 + and 'a any_map_ = 'a any_map = { 2074 2074 + kind : string; 2075 2075 + doc : string; 2076 2076 + dec_null : 'a t option; 2077 2077 + dec_bool : 'a t option; 2078 2078 + dec_number : 'a t option; 2079 2079 + dec_string : 'a t option; 2080 2080 + dec_array : 'a t option; 2081 2081 + dec_object : 'a t option; 2082 2082 + enc : 'a -> 'a t; 2083 2083 + } 2084 2084 + 2085 2085 + and ('a, 'b) map_ = ('a, 'b) map = { 2086 2086 + kind : string; 2087 2087 + doc : string; 2088 2088 + dom : 'a t; 2089 2089 + dec : 'a -> 'b; 2090 2090 + enc : 'b -> 'a; 2091 2091 + } 2092 2092 + 2093 2093 + type unknown_mems_option_ = unknown_mems_option = 2094 2094 + | Unknown_mems : 2095 2095 + ('o, 'mems, 'builder) unknown_mems_ option 2096 2096 + -> unknown_mems_option_ 2097 2097 + 2098 2098 + let repr t = t 1960 2099 let array_kinded_sort = array_kinded_sort 1961 2100 let object_kinded_sort = object_kinded_sort 1962 2101 let pp_kind = pp_kind ··· 2620 2759 semantics. Structural contract (bracket nesting, string termination) 2621 2760 is enforced; content (escape correctness, exact hex digits after 2622 2761 [\u]) is NOT validated. Consumers needing strict content 2623 2623 - validation should decode with [Json.json] and then discard rather 2762 2762 + validation should decode with [Json.Codec.Value.t] and then discard rather 2624 2763 than [ignore]. *) 2625 2764 let done_ = ref false in 2626 2765 while not !done_ do

+288 -433

lib/codec.mli

reviewed

··· 1 1 - (** Internal codec representation. This is the GADT that json.ml's combinators 2 2 - walk at decode/encode time. The public alias is 3 3 - [type 'a Json.codec = 'a Codec.t] in json.ml. *) 1 1 + (** Typed JSON codecs. 4 2 5 5 - module Meta = Loc.Meta 6 6 - module Path = Loc.Path 7 7 - module Sort = Sort 3 3 + A codec value of type ['a t] describes how JSON is mapped to an OCaml value 4 4 + of type ['a]. The same description is used for: 5 5 + - decoding JSON to OCaml values, 6 6 + - encoding OCaml values to JSON, 7 7 + - querying and updating JSON without forcing callers to build a generic JSON 8 8 + tree. 8 9 9 9 - type 'a node = 'a * Meta.t 10 10 + The usual entry point is to compose small codecs: 10 11 11 11 - module String_map : module type of Map.Make (String) 12 12 - (** A [Map.Make(String)] instance. *) 12 12 + {[ 13 13 + module C = Json.Codec 13 14 14 14 - (** The type for decoding functions. *) 15 15 - type ('ret, 'f) dec_fun = 16 16 - | Dec_fun : 'f -> ('ret, 'f) dec_fun (** The function and its return type. *) 17 17 - | Dec_app : ('ret, 'a -> 'b) dec_fun * 'a Type.Id.t -> ('ret, 'b) dec_fun 18 18 - (** Application of an argument to a function witnessed by a type 19 19 - identifier. The type identifier can be used to lookup a value of the 20 20 - right type in an heterogenous dictionary. *) 15 15 + type person = { name : string; age : int } 21 16 22 22 - (** {1:base Base value maps} *) 17 17 + let person name age = { name; age } 23 18 24 24 - type ('a, 'b) base_map = { 25 25 - kind : string; (** The kind of JSON value that are mapped (documentation) *) 26 26 - doc : string; (** A doc string for the kind of JSON value. *) 27 27 - dec : Meta.t -> 'a -> 'b; 28 28 - (** [dec] decodes a base value represented by its metadata and ['a] to 29 29 - ['b]. *) 30 30 - enc : 'b -> 'a; 31 31 - (** [enc] encodes a value of type ['b] to a base JSON value represented by 32 32 - ['a]. *) 33 33 - enc_meta : 'b -> Meta.t; 34 34 - (** [enc_meta] recovers the base JSON value metadata from ['b] (if any). 35 35 - *) 36 36 - } 37 37 - (** The type for mapping JSON base values represented in OCaml by ['a] (these 38 38 - values are fixed by the cases in {!t}) to a value of type ['b]. *) 19 19 + let person_codec = 20 20 + C.Object.map person 21 21 + |> C.Object.member "name" C.string ~enc:(fun p -> p.name) 22 22 + |> C.Object.member "age" C.int ~enc:(fun p -> p.age) 23 23 + |> C.Object.seal 24 24 + ]} 39 25 40 40 - (** {1:types JSON types} *) 26 26 + Decode and encode with {!Json.of_string} and {!Json.to_string}, or use the 27 27 + runtime functions in this module when you already have a {!Json.t}. *) 41 28 42 42 - (** The type for JSON types. *) 43 43 - type 'a t = 44 44 - | Null : (unit, 'a) base_map -> 'a t (** Null maps. *) 45 45 - | Bool : (bool, 'a) base_map -> 'a t (** Boolean maps. *) 46 46 - | Number : (float, 'a) base_map -> 'a t (** Number maps. *) 47 47 - | String : (string, 'a) base_map -> 'a t (** String maps. *) 48 48 - | Array : ('a, 'elt, 'builder) array_map -> 'a t (** Array maps. *) 49 49 - | Object : ('o, 'o) object_map -> 'o t (** Object maps. *) 50 50 - | Any : 'a any_map -> 'a t (** Map for different sorts of JSON values. *) 51 51 - | Map : ('b, 'a) map -> 'a t 52 52 - (** Map from JSON type ['b] to JSON type ['a]. *) 53 53 - | Rec : 'a t Lazy.t -> 'a t (** Recursive definition. *) 54 54 - | Ignore : unit t 55 55 - (** Skip-parse any JSON value. The bytesrw decoder consumes the value at 56 56 - the byte level without materialising strings, numbers or nested DOM; 57 57 - this is the fast path for {!Json.ignore}. *) 29 29 + module Meta = Loc.Meta 30 30 + (** Node metadata. *) 58 31 59 59 - (** {1:array Array maps} *) 32 32 + module Path = Loc.Path 33 33 + (** JSON paths used by query and update codecs. *) 60 34 61 61 - and ('array, 'elt, 'builder) array_map = { 62 62 - kind : string; (** The kind of JSON array mapped (documentation). *) 63 63 - doc : string; (** Documentation string for the JSON array. *) 64 64 - elt : 'elt t; (** The type for the array elements. *) 65 65 - dec_empty : unit -> 'builder; 66 66 - (** [dec_empty ()] creates a new empty array builder. *) 67 67 - dec_skip : int -> 'builder -> bool; 68 68 - (** [dec_skip i b] determines if the [i]th index of the JSON array can be 69 69 - skipped. *) 70 70 - dec_add : int -> 'elt -> 'builder -> 'builder; 71 71 - (** [dec_add] adds the [i]th index value of the JSON array as decoded by 72 72 - [elt] to the builder. *) 73 73 - dec_finish : Meta.t -> int -> 'builder -> 'array; 74 74 - (** [dec_finish] turns the builder into an array given its metadata and 75 75 - length. *) 76 76 - enc : 'acc. ('acc -> int -> 'elt -> 'acc) -> 'acc -> 'array -> 'acc; 77 77 - (** [enc] folds over the elements of the array for encoding. *) 78 78 - enc_meta : 'array -> Meta.t; 79 79 - (** [enc_meta] recovers the metadata of an array (if any). *) 80 80 - } 81 81 - (** The type for mapping JSON arrays to values of type ['array] with array 82 82 - elements mapped to type ['elt] and using a ['builder] value to construct the 83 83 - array. *) 35 35 + module Sort = Sort 36 36 + (** JSON sorts used in diagnostics. *) 84 37 85 85 - (** {1:object_map Object maps} *) 86 86 - 87 87 - and ('o, 'dec) object_map = { 88 88 - kind : string; (** The kind of JSON object (documentation). *) 89 89 - doc : string; (** A doc string for the JSON member. *) 90 90 - dec : ('o, 'dec) dec_fun; 91 91 - (** The object decoding function to construct an ['o] value. *) 92 92 - mem_decs : mem_dec String_map.t; 93 93 - (** [mem_decs] are the member decoders sorted by member name. *) 94 94 - mem_encs : 'o mem_enc list; (** [mem_encs] is the list of member encoders. *) 95 95 - enc_meta : 'o -> Meta.t; 96 96 - (** [enc_meta] recovers the metadata of an object (if any). *) 97 97 - shape : 'o object_shape; 98 98 - (** [shape] is the {{!object_shape}shape} of the object. *) 99 99 - } 100 100 - (** The type for mapping a JSON object to values of type ['o] using a decoding 101 101 - function of type ['dec]. [mem_decs] and [mem_encs] have the same {!mem_map} 102 102 - values they are just sorted differently for decoding and encoding purposes. 103 103 - *) 104 104 - 105 105 - and mem_dec = 106 106 - | Mem_dec : ('o, 'a) mem_map -> mem_dec 107 107 - (** The type for member maps in decoding position. *) 108 108 - 109 109 - and 'o mem_enc = 110 110 - | Mem_enc : ('o, 'a) mem_map -> 'o mem_enc 111 111 - (** The type for member maps in encoding position. *) 112 112 - 113 113 - and ('o, 'a) mem_map = { 114 114 - name : string; (** The JSON member name. *) 115 115 - doc : string; (** Documentation for the JSON member. *) 116 116 - type' : 'a t; (** The type for the member value. *) 117 117 - id : 'a Type.Id.t; 118 118 - (** A type identifier for the member. This allows to store the decode in a 119 119 - {!Dict.t} on decode and give it in time to the object decoding 120 120 - function of the object map. *) 121 121 - dec_absent : 'a option; (** The value to use if absent (if any). *) 122 122 - enc : 'o -> 'a; (** [enc] recovers the value to encode from ['o]. *) 123 123 - (* enc_name_meta : 'a -> Meta.t; 124 124 - XXX This should have been the meta found for the name, but 125 125 - that does not fit so well in the member combinators, it's 126 126 - not impossible to fit it in but likely increases the cost 127 127 - for decoding objects. The layout preserving updates occur 128 128 - via generic JSON which uses [mems_map] in which the meta 129 129 - is available in [dec_add]. Let's leave it that way for now. *) 130 130 - enc_omit : 'a -> bool; 131 131 - (** [enc_omit] is [true] if the result of [enc] should not be encoded. *) 132 132 - } 133 133 - (** The type for mapping a JSON member to a value of type ['a] in an object 134 134 - represented by a value of type ['o]. *) 38 38 + type 'a node = 'a * Meta.t 39 39 + (** A payload with node metadata. *) 135 40 136 136 - (** The type for object shapes. *) 137 137 - and 'o object_shape = 138 138 - | Object_basic : ('o, 'mems, 'builder) unknown_mems -> 'o object_shape 139 139 - (** A basic object, possibly indicating how to handle unknown members *) 140 140 - | Object_cases : 141 141 - ('o, 'mems, 'builder) unknown_mems option 142 142 - * ('o, 'cases, 'tag) object_cases 143 143 - -> 'o object_shape 144 144 - (** An object with a case member each case further describing an object 145 145 - map. *) 41 41 + (** {1:core Core concepts} *) 146 42 147 147 - (** {2:unknown_mems Unknown members} *) 148 148 - 149 149 - (** The type for specifying decoding behaviour on unknown JSON object members. 150 150 - *) 151 151 - and ('o, 'mems, 'builder) unknown_mems = 152 152 - | Unknown_skip : ('o, unit, unit) unknown_mems (** Skip unknown members. *) 153 153 - | Unknown_error : ('o, unit, unit) unknown_mems 154 154 - (** Error on unknown members. *) 155 155 - | Unknown_keep : 156 156 - ('mems, 'a, 'builder) mems_map * ('o -> 'mems) 157 157 - -> ('o, 'mems, 'builder) unknown_mems 158 158 - (** Gather unknown members in a member map. *) 159 159 - 160 160 - and ('mems, 'a, 'builder) mems_map = { 161 161 - kind : string; (** The kind for unknown members (documentation). *) 162 162 - doc : string; (** Documentation string for the unknown members. *) 163 163 - mems_type : 'a t; 164 164 - (** The uniform type according which unknown members are typed. *) 165 165 - id : 'mems Type.Id.t; (** A type identifier for the unknown member map. *) 166 166 - dec_empty : unit -> 'builder; 167 167 - (** [dec_empty] create a new empty member map builder. *) 168 168 - dec_add : Meta.t -> string -> 'a -> 'builder -> 'builder; 169 169 - (** [dec_add] adds a member named [n] with metadata [meta] and value 170 170 - parsed by [mems_type] to the builder. *) 171 171 - dec_finish : Meta.t -> 'builder -> 'mems; 172 172 - (** [dec_finish] turns the builder into an unknown member map. The [meta] 173 173 - is the meta data of the object in which they were found. *) 174 174 - enc : 'acc. (Meta.t -> string -> 'a -> 'acc -> 'acc) -> 'mems -> 'acc -> 'acc; 175 175 - (** [enc] folds over the member map for encoding. *) 176 176 - } 177 177 - (** The type for gathering unknown JSON members uniformly typed according to 178 178 - ['a] in a map ['mems] constructed with ['builder]. *) 179 179 - 180 180 - (** {2:case_objects Case objects} *) 181 181 - 182 182 - and ('o, 'cases, 'tag) object_cases = { 183 183 - tag : ('tag, 'tag) mem_map; 184 184 - (** The JSON member used to decide cases. The [enc] field of this 185 185 - [mem_map] should be the identity, this allows encoders to reuse 186 186 - generic encoding code for members. We don't have [('o, 'tag) mem_map] 187 187 - here because the tag is not stored we recover the case via [enc] and 188 188 - [enc_case] below. *) 189 189 - tag_compare : 'tag -> 'tag -> int; (** The function to compare tags. *) 190 190 - tag_to_string : ('tag -> string) option; 191 191 - (** The function to stringify tags for error reporting. *) 192 192 - id : 'cases Type.Id.t; (** A type identifier for the tag. *) 193 193 - cases : ('cases, 'tag) case list; (** The list of possible cases. *) 194 194 - enc : 'o -> 'cases; 195 195 - (** [enc] is the function to recover case values from the value ['o] the 196 196 - object is mapped to. *) 197 197 - enc_case : 'cases -> ('cases, 'tag) case_value; 198 198 - (** [enc_case] retrieves the concrete case from the common [cases] values. 199 199 - You can see it as preforming a match. *) 200 200 - } 201 201 - (** The type for object cases mapped to a common type ['cases] stored in a vlue 202 202 - of type ['o] and identified by tag values of type ['tag]. *) 203 203 - 204 204 - and ('cases, 'case, 'tag) case_map = { 205 205 - tag : 'tag; (** The tag value for the case. *) 206 206 - object_map : ('case, 'case) object_map; (** The object map for the case. *) 207 207 - dec : 'case -> 'cases; 208 208 - (** [dec] is the function used on decoding to inject the case into the 209 209 - common ['cases] type. *) 210 210 - } 211 211 - (** The type for an object case with common type ['cases] specific type ['case] 212 212 - and tag type ['tag]. *) 213 213 - 214 214 - and ('cases, 'tag) case_value = 215 215 - | Case_value : 216 216 - ('cases, 'case, 'tag) case_map * 'case 217 217 - -> ('cases, 'tag) case_value 218 218 - (** The type for case values. This packs a case value and its description. 219 219 - *) 220 220 - 221 221 - and ('cases, 'tag) case = 222 222 - | Case : ('cases, 'case, 'tag) case_map -> ('cases, 'tag) case 223 223 - (** The type for hiding the the concrete type of a case . *) 224 224 - 225 225 - (** {1:any Any maps} *) 226 226 - 227 227 - and 'a any_map = { 228 228 - kind : string; (** The kind of JSON values mapped (documentation). *) 229 229 - doc : string; (** Documentation string for the kind of values. *) 230 230 - dec_null : 'a t option; 231 231 - (** [dec_null], if any, is used for decoding JSON nulls. *) 232 232 - dec_bool : 'a t option; 233 233 - (** [dec_bool], if any, is used for decoding JSON bools. *) 234 234 - dec_number : 'a t option; 235 235 - (** [dec_number], if any, is used for decoding JSON numbers. *) 236 236 - dec_string : 'a t option; 237 237 - (** [dec_string], if any, is used for decoding JSON strings. *) 238 238 - dec_array : 'a t option; 239 239 - (** [dec_array], if any, is used for decoding JSON arrays. *) 240 240 - dec_object : 'a t option; 241 241 - (** [dec_object], if any, is used for decoding JSON objects. *) 242 242 - enc : 'a -> 'a t; (** [enc] specifies the encoder to use on a given value. *) 243 243 - } 244 244 - (** The type for mapping JSON values with multiple sorts to a value of type 245 245 - ['a]. If a decoding case is [None], the decoding errors on these JSON 246 246 - values. *) 247 247 - 248 248 - (** {1:type_map Type maps} *) 249 249 - 250 250 - and ('a, 'b) map = { 251 251 - kind : string; (** The kind of JSON values mapped (documentation). *) 252 252 - doc : string; (** Documentation string for the kind of values. *) 253 253 - dom : 'a t; (** The domain of the map. *) 254 254 - dec : 'a -> 'b; (** [dec] decodes ['a] to ['b]. *) 255 255 - enc : 'b -> 'a; (** [enc] encodes ['b] to ['a]. *) 256 256 - } 257 257 - (** The type for mapping JSON types of type ['a] to a JSON type of type ['b]. *) 258 258 - 259 259 - (** {1:kinds Kinds and doc} *) 43 43 + type 'a t 44 44 + (** The type of codecs mapping JSON values to OCaml values of type ['a]. *) 260 45 261 46 val kinded_sort : 'a t -> string 262 262 - (** [kinded_sort t] is kinded sort of [t], see {!Json.kinded_sort}. *) 47 47 + (** [kinded_sort c] is a human-readable description of the JSON sort expected by 48 48 + [c], including the codec kind when one was provided. It is mainly used in 49 49 + diagnostics. *) 263 50 264 51 val kind : 'a t -> string 265 265 - (** [kind t] is the kind of the underlying map, see {!Json.kind}. *) 52 52 + (** [kind c] is the short kind name used in diagnostics for [c]. *) 266 53 267 54 val doc : 'a t -> string 268 268 - (** See {!Json.doc}. *) 55 55 + (** [doc c] is the documentation string attached to [c], if any. *) 269 56 270 57 val with_doc : ?kind:string -> ?doc:string -> 'a t -> 'a t 271 271 - (** See {!Json.with_doc}. *) 272 272 - 273 273 - (** {1:private Internal runtime} 274 274 - 275 275 - The contents of {!Private} are the primitives used by the bytesrw parser and 276 276 - the codec runtime. They are not part of the stable public API; do not depend 277 277 - on them from application code. *) 278 278 - 279 279 - type unknown_mems_option = 280 280 - | Unknown_mems : 281 281 - ('o, 'mems, 'builder) unknown_mems option 282 282 - -> unknown_mems_option 283 283 - (** Internal. Used by {!Private.override_unknown_mems}. *) 284 284 - 285 285 - module Private : sig 286 286 - val array_kinded_sort : ('a, 'elt, 'builder) array_map -> string 287 287 - (** [array_kinded_sort map] is like {!kinded_sort} but acts directly on the 288 288 - array [map]. *) 289 289 - 290 290 - val object_kinded_sort : ('o, 'dec) object_map -> string 291 291 - (** [object_kinded_sort map] is like {!kinded_sort} but acts directly on the 292 292 - object [map]. *) 293 293 - 294 294 - val pp_kind : string Fmt.t 295 295 - (** [pp_kind] formats kinds. *) 296 296 - 297 297 - val pp_code : string Fmt.t 298 298 - (** [pp_code] formats strings like code (in bold). *) 299 299 - 300 300 - (** {1:errors Errors} *) 301 301 - 302 302 - val fail_push_array : 303 303 - Meta.t -> ('array, 'elt, 'builder) array_map -> int node -> Error.t -> 'a 304 304 - (** [fail_push_array] is like {!Error.fail_push_array} but uses the given 305 305 - array [meta] and array map to caracterize the context. *) 306 306 - 307 307 - val fail_push_object : 308 308 - Meta.t -> ('o, 'dec) object_map -> string node -> Error.t -> 'a 309 309 - (** [fail_push_object] is like {!Error.fail_push_object} but uses the given 310 310 - object [meta] and object map to caracterize the context. *) 58 58 + (** [with_doc c] is [c] with updated [kind] and [doc] metadata. *) 311 59 312 312 - val fail_type_mismatch : Meta.t -> 'a t -> fnd:Sort.t -> 'b 313 313 - (** [fail_type_mismatch meta t ~fnd] errors when the kind expected by codec 314 314 - [t] does not match the actually-parsed sort [fnd]. *) 315 315 - 316 316 - val fail_missing_members : 317 317 - Meta.t -> 318 318 - ('o, 'o) object_map -> 319 319 - exp:mem_dec String_map.t -> 320 320 - fnd:string list -> 321 321 - 'a 322 322 - (** [fail_missing_members m map exp fnd] errors when [exp] cannot be found, 323 323 - [fnd] can list a few members that were found. *) 324 324 - 325 325 - val fail_unexpected_members : 326 326 - Meta.t -> ('o, 'o) object_map -> fnd:(string * Meta.t) list -> 'a 327 327 - (** [fail_unexpected_members meta map ~fnd] errors when [fnd] are unexpected 328 328 - members for object [map]. *) 329 329 - 330 330 - val fail_unexpected_case_tag : 331 331 - Meta.t -> ('o, 'o) object_map -> ('o, 'd, 'tag) object_cases -> 'tag -> 'a 332 332 - (** [fail_unexpected_case_tag meta map cases tag] is when a [tag] of a case 333 333 - member has no corresponding case. *) 334 334 - 335 335 - (** {1:toolbox Processor toolbox} *) 336 336 - 337 337 - val object_meta_arg : Meta.t Type.Id.t 338 338 - (** [object_meta_arg] is the type identifier used to thread an object's 339 339 - {!Meta.t} through an object map decode via {!Dict.t}. *) 340 340 - 341 341 - (** Heterogeneous dictionaries. *) 342 342 - module Dict : sig 343 343 - type binding = B : 'a Type.Id.t * 'a -> binding 344 344 - type t 345 345 - 346 346 - val empty : t 347 347 - val mem : 'a Type.Id.t -> t -> bool 348 348 - val add : 'a Type.Id.t -> 'a -> t -> t 349 349 - val remove : 'a Type.Id.t -> t -> t 350 350 - val find : 'a Type.Id.t -> t -> 'a option 351 351 - end 352 352 - 353 353 - val apply_dict : ('ret, 'f) dec_fun -> Dict.t -> 'f 354 354 - (** [apply_dict dec dict] applies [dict] to [f]. *) 355 355 - 356 356 - val override_unknown_mems : 357 357 - by:unknown_mems_option -> 358 358 - unknown_mems_option -> 359 359 - Dict.t -> 360 360 - unknown_mems_option * Dict.t 361 361 - (** [override_unknown_mems ~by current dict] performs the unknown-member 362 362 - overriding logic for case objects. *) 363 363 - 364 364 - val finish_object_decode : 365 365 - ('o, 'o) object_map -> 366 366 - Meta.t -> 367 367 - ('p, 'mems, 'builder) unknown_mems -> 368 368 - 'builder -> 369 369 - mem_dec String_map.t -> 370 370 - Dict.t -> 371 371 - Dict.t 372 372 - (** [finish_object_decode map meta unknown_mems umap rem_mems dict] finishes 373 373 - an object-map decode. *) 374 374 - end 375 375 - 376 376 - (* ======================================================================== 377 377 - Codec combinators (moved from json.mli). 378 378 - ======================================================================== *) 379 379 - 380 380 - (** {1:combinators Codec combinators} *) 60 60 + (** {1:combinators Building codecs} *) 381 61 382 62 module Ast = Value 383 63 (** Alias for the generic JSON AST module. This stays accessible inside ··· 403 83 type number_format = Value.number_format 404 84 (** The type for JSON number formatters. *) 405 85 406 406 - (** {1:base Base types} 407 407 - 408 408 - Read the {{!page-cookbook.base_types}cookbook} on base types. *) 86 86 + (** {1:base Base types} *) 409 87 410 88 (** Mapping JSON base types. *) 411 89 module Base : sig ··· 458 136 val number : (float, 'a) map -> 'a t 459 137 (** [number map] maps with [map] JSON nulls or numbers represented by [float] 460 138 values to values of type ['a]. The [float] representation decodes JSON 461 461 - nulls to {!Float.nan} and lossily encodes any 462 462 - {{!Float.is_finite}non-finite} to JSON null 463 463 - ({{!page-cookbook.non_finite_numbers}explanation}). See also 464 464 - {!Codec.number}. *) 139 139 + nulls to [Float.nan] and lossily encodes any non-finite number to JSON 140 140 + null. See also {!Codec.number}. *) 465 141 466 142 val string : (string, 'a) map -> 'a t 467 143 (** [string map] maps with [map] {e unescaped} JSON strings represented by ··· 499 175 *) 500 176 end 501 177 502 502 - (** {2:option Nulls and options} 503 503 - 504 504 - Read the {{!page-cookbook.dealing_with_null}cookbook} on [null]s. *) 178 178 + (** {2:option Nulls and options} *) 505 179 506 180 val null : ?kind:string -> ?doc:string -> 'a -> 'a t 507 181 (** [null v] maps JSON nulls to [v]. On encodes any value of type ['a] is 508 508 - encoded by null. [doc] and [kind] are given to the underlying 509 509 - {!Base.type-map}. See also {!Base.null}. *) 182 182 + encoded by null. [doc] and [kind] are given to the underlying base map. See 183 183 + also {!Base.null}. *) 510 184 511 185 val none : 'a option t 512 186 (** [none] maps JSON nulls to [None]. *) ··· 524 198 val bool : bool t 525 199 (** [bool] maps JSON booleans to [bool] values. See also {!Base.bool}. *) 526 200 527 527 - (** {2:numbers Numbers} 528 528 - 529 529 - Read the {{!page-cookbook.dealing_with_numbers}cookbook} on JSON numbers and 530 530 - their many pitfalls. *) 201 201 + (** {2:numbers Numbers} *) 531 202 532 203 val number : float t 533 204 (** [number] maps JSON nulls or numbers to [float] values. On decodes JSON null 534 534 - is mapped to {!Float.nan}. On encodes any {{!Float.is_finite}non- finite} 535 535 - float is lossily mapped to JSON null 536 536 - ({{!page-cookbook.non_finite_numbers}explanation}). See also {!Base.number}, 537 537 - {!any_float} and the integer combinators below. *) 205 205 + is mapped to [Float.nan]. On encodes any non-finite float is lossily mapped 206 206 + to JSON null. See also {!Base.number}, {!any_float} and the integer 207 207 + combinators below. *) 538 208 539 209 val any_float : float t 540 210 (** [any_float] is a lossless representation for IEEE 754 doubles. It maps 541 541 - {{!Float.is_finite}non-finite} floats by the JSON strings defined by 542 542 - {!Float.to_string}. This contrasts with {!val-number} which maps them to 543 543 - JSON null values ({{!page-cookbook.non_finite_numbers}explanation}). Note 544 544 - that on decodes this still maps JSON nulls to {!Float.nan} and any 545 545 - successful string decode of {!Float.of_string_opt} (so numbers can also be 546 546 - written as strings). See also {!val-number}. 211 211 + non-finite floats by the JSON strings defined by [Float.to_string]. This 212 212 + contrasts with {!val-number} which maps them to JSON null values. Note that 213 213 + on decodes this still maps JSON nulls to [Float.nan] and any successful 214 214 + string decode of [Float.of_string_opt] (so numbers can also be written as 215 215 + strings). See also {!val-number}. 547 216 548 217 {b Warning.} [any_float] should only be used between parties that have 549 218 agreed on such an encoding. To maximize interoperability you should use the ··· 553 222 (** [float_as_hex_string] maps JSON strings made of IEEE 754 doubles in hex 554 223 notation to float values. On encodes strings this uses the ["%h"] format 555 224 string. On decodes it accepts anything sucessfully decoded by 556 556 - {!Float.of_string_opt}. *) 225 225 + [Float.of_string_opt]. *) 557 226 558 227 val uint8 : int t 559 228 (** [uint8] maps JSON numbers to unsigned 8-bit integers. JSON numbers are ··· 586 255 represented on the [int64] range, otherwise the decoder errors. [int64] 587 256 values are encoded as JSON numbers if the integer is in the 588 257 \[-2{^ 53};2{^ 53}\] range. 589 589 - - JSON strings are decoded using {!int_of_string_opt}, this allows binary, 258 258 + - JSON strings are decoded using [int_of_string_opt], this allows binary, 590 259 octal, decimal and hex syntaxes and errors on overflow and syntax errors. 591 591 - [int64] values are encoded as JSON strings with {!Int64.to_string} when 592 592 - the integer is outside the \[-2{^ 53};2{^ 53}\] range. *) 260 260 + [int64] values are encoded as JSON strings with [Int64.to_string] when the 261 261 + integer is outside the \[-2{^ 53};2{^ 53}\] range. *) 593 262 594 263 val int64_as_string : int64 t 595 264 (** [int64_as_string] maps JSON strings to 64-bit integers. On decodes this uses 596 596 - {!Int64.of_string_opt} which allows binary, octal, decimal and hex syntaxes 597 597 - and errors on overflow and syntax errors. On encodes uses 598 598 - {!Int64.to_string}. *) 265 265 + [Int64.of_string_opt] which allows binary, octal, decimal and hex syntaxes 266 266 + and errors on overflow and syntax errors. On encodes uses [Int64.to_string]. 267 267 + *) 599 268 600 269 val int : int t 601 270 (** [int] maps truncated JSON numbers or JSON strings to [int] values. ··· 603 272 represented on the [int] range, otherwise the decoder errors. [int] values 604 273 are encoded as JSON numbers if the integer is in the \[-2{^ 53};2{^ 53}\] 605 274 range. 606 606 - - JSON strings are decoded using {!int_of_string_opt}, this allows binary, 275 275 + - JSON strings are decoded using [int_of_string_opt], this allows binary, 607 276 octal, decimal and hex syntaxes and errors on overflow and syntax errors. 608 608 - [int] values are encoded as JSON strings with {!Int.to_string} when the 277 277 + [int] values are encoded as JSON strings with [Int.to_string] when the 609 278 integer is outside the \[-2{^ 53};2{^ 53}\] range 610 279 611 280 {b Warning.} The behaviour of this function is platform dependent, it 612 612 - depends on the value of {!Sys.int_size}. *) 281 281 + depends on the value of [Sys.int_size]. *) 613 282 614 283 val int_as_string : int t 615 284 (** [int_as_string] maps JSON strings to [int] values. On decodes this uses 616 616 - {!int_of_string_opt} which allows binary, octal, decimal and hex syntaxes 617 617 - and errors on overflow and syntax errors. On encodes uses {!Int.to_string}. 285 285 + [int_of_string_opt] which allows binary, octal, decimal and hex syntaxes and 286 286 + errors on overflow and syntax errors. On encodes uses [Int.to_string]. 618 287 619 288 {b Warning.} The behaviour of this function is platform dependent, it 620 620 - depends on the value of {!Sys.int_size}. *) 289 289 + depends on the value of [Sys.int_size]. *) 621 290 622 622 - (** {2:enums Strings and enums} 623 623 - 624 624 - Read the {{!page-cookbook.transform_strings}cookbook} on transforming 625 625 - strings. *) 291 291 + (** {2:enums Strings and enums} *) 626 292 627 293 val string : string t 628 294 (** [string] maps unescaped JSON strings to UTF-8 encoded [string] values. See ··· 637 303 ?enc:('a -> string) -> 638 304 (string -> ('a, string) result) -> 639 305 'a t 640 640 - (** [of_of_string of_string] maps JSON string with a {{!Base.type-map}base map} 641 641 - using [of_string] for decoding and [enc] for encoding. See the 642 642 - {{!page-cookbook.transform_strings}cookbook}. *) 306 306 + (** [of_of_string of_string] maps JSON string with a base map using [of_string] 307 307 + for decoding and [enc] for encoding. *) 643 308 644 309 val enum : 645 310 ?cmp:('a -> 'a -> int) -> ··· 649 314 'a t 650 315 (** [enum assoc] maps JSON strings member of the [assoc] list to the 651 316 corresponding OCaml value and vice versa in log(n). [cmp] is used to compare 652 652 - the OCaml values, it defaults to {!Stdlib.compare}. Decoding and encoding 317 317 + the OCaml values, it defaults to [Stdlib.compare]. Decoding and encoding 653 318 errors on strings or values not part of [assoc]. *) 654 319 655 320 val binary_string : string t ··· 658 323 encoding uses only lower case hexadecimal digits to encode the byte 659 324 sequence. *) 660 325 661 661 - (** {1:arrays Arrays and tuples} 662 662 - 663 663 - Read the {{!page-cookbook.dealing_with_arrays}cookbok} on arrays. *) 326 326 + (** {1:arrays Arrays and tuples} *) 664 327 665 328 (** Mapping JSON arrays. *) 666 329 module Array : sig ··· 688 351 'elt t -> 689 352 ('array, 'elt, 'builder) map 690 353 (** [map elt] maps JSON arrays of type ['elt] to arrays of type ['array] built 691 691 - with type ['builder]. See the {!Json.Codec.Array} documentation for 692 692 - argument descriptions. *) 354 354 + with type ['builder]. See the [Array] module documentation for argument 355 355 + descriptions. *) 693 356 694 357 val list_map : 695 358 ?kind:string -> ··· 710 373 'a t -> 711 374 ('a array, 'a, 'a array_builder) map 712 375 (** [array_map elt] maps JSON arrays with elements of type [elt] to [array] 713 713 - values. See also {!Codec.array}. *) 376 376 + values. See also [array]. *) 714 377 715 378 type ('a, 'b, 'c) bigarray_builder 716 379 (** The type for bigarray_builders. *) ··· 800 463 (** [tn ~n t] maps JSON arrays of exactly [n] elements of type [t] to [array] 801 464 values. This is {!val-array} limited by [n]. *) 802 465 803 803 - (** {1:objects Objects} 804 804 - 805 805 - Read the {{!page-cookbook.dealing_with_objects}cookbook} on objects. *) 466 466 + (** {1:objects Objects} *) 806 467 807 468 (** Mapping JSON objects. *) 808 469 module Object : sig ··· 810 471 811 472 type ('o, 'dec) map 812 473 (** The type for mapping JSON objects to values of type ['o]. The ['dec] type 813 813 - is used to construct ['o] from members see {!val-mem}. *) 474 474 + is used to construct ['o] from members; see {!val-member}. *) 814 475 815 476 val map : ?kind:string -> ?doc:string -> 'dec -> ('o, 'dec) map 816 477 (** [map dec] is an empty JSON object decoded by function [dec]. 817 478 - [kind] names the entities represented by the map and [doc] documents 818 479 them. Both default to [""]. 819 480 - [dec] is a constructor eventually returning a value of type ['o] to be 820 820 - saturated with calls to {!val-mem}, {!val-case_mem} or 481 481 + saturated with calls to {!val-member}, {!val-case_member} or 821 482 {!val-keep_unknown}. This is needed for decoding. Use {!enc_only} if the 822 483 result is only used for encoding. *) 823 484 ··· 836 497 ?enc_meta:('o -> Meta.t) -> 837 498 unit -> 838 499 ('o, 'a) map 839 839 - (** [enc_only ()] is like {!val-map'} but can only be used for encoding. *) 500 500 + (** [enc_only ()] is like {!val-map} but can only be used for encoding. *) 840 501 841 502 val seal : ('o, 'o) map -> 'o t 842 503 (** [seal map] is a JSON type for objects mapped by [map]. Raises ··· 908 569 ~enc_omit 909 570 ]} *) 910 571 911 911 - (** {1:cases Case objects} 912 912 - 913 913 - Read the {{!page-cookbook.cases}cookbook} on case objects. *) 572 572 + (** {1:cases Case objects} *) 914 573 915 574 (** Case objects. *) 916 575 module Case : sig ··· 970 629 member [name] selects an object representation according to the member 971 630 value of type [t]. *) 972 631 973 973 - (** {1:unknown_members Unknown members} 974 974 - 975 975 - Read the {{!page-cookbook.unknown_members}cookbook}. *) 632 632 + (** {1:unknown_members Unknown members} *) 976 633 977 634 (** Uniform members. *) 978 635 module Members : sig ··· 1069 726 'a t -> 1070 727 'b t 1071 728 (** [map t] changes the type of [t] from ['a] to ['b]. For mapping base types 1072 1072 - use {!Base.map}. *) 729 729 + use [Base.map]. *) 1073 730 1074 731 val iter : 1075 732 ?kind:string -> ··· 1122 779 *) 1123 780 1124 781 val array : value t 1125 1125 - (** [array] decodes JSON arrays to {!Array} and encodes {!Array} values. *) 782 782 + (** [array] decodes JSON arrays to [Array] and encodes [Array] values. *) 1126 783 1127 784 val object' : value t 1128 1128 - (** [object'] decodes JSON objects to {!Object} and encodes {!Object} values. 1129 1129 - *) 785 785 + (** [object'] decodes JSON objects to [Object] and encodes [Object] values. *) 1130 786 1131 787 val members : (value, value, member list) Object.Members.map 1132 1132 - (** [members] is a {!Object.Members.map} for the generic {!member list} type. 788 788 + (** [members] is an [Object.Members.map] for the generic [member list] type. 1133 789 *) 1134 790 end 1135 791 ··· 1199 855 (** {2:index_queries Indices} *) 1200 856 1201 857 val index : ?absent:'a -> Path.step -> 'a t -> 'a t 1202 1202 - (** [index] uses {!val-nth} or {!val-mem} on the given index. *) 858 858 + (** [index] uses {!val-nth} or {!val-member} on the given index. *) 1203 859 1204 860 val set_index : ?allow_absent:bool -> 'a t -> Path.step -> 'a -> value t 1205 1205 - (** [set_index] uses {!set_nth} or {!set_mem} on the given index. *) 861 861 + (** [set_index] uses {!val-set_nth} or {!val-set_member} on the given index. *) 1206 862 1207 863 val update_index : ?stub:value -> ?absent:'a -> Path.step -> 'a t -> value t 1208 1208 - (** [update_index] uses {!update_nth} or {!update_mem}. *) 864 864 + (** [update_index] uses {!val-update_nth} or {!val-update_member}. *) 1209 865 1210 866 val delete_index : ?allow_absent:bool -> Path.step -> value t 1211 1211 - (** [delete_index] uses {!delete_nth} or {!delete_mem}. *) 867 867 + (** [delete_index] uses {!val-delete_nth} or {!val-delete_member}. *) 1212 868 1213 869 (** {2:path_queries Paths} *) 1214 870 ··· 1231 887 (** [decode t v] decodes [v] as a value of type ['a] according to [t]. *) 1232 888 1233 889 val decode_exn : 'a t -> value -> 'a 1234 1234 - (** [decode_exn] is like {!val-decode} but raises the exception {!Error}. *) 890 890 + (** [decode_exn] is like {!val-decode} but raises [Json.Error]. *) 1235 891 1236 892 val encode : 'a t -> 'a -> value 1237 893 (** [encode t v] encodes [v] as a generic JSON value according to [t]. *) ··· 1290 946 'a -> 1291 947 string 1292 948 end 949 949 + 950 950 + (**/**) 951 951 + 952 952 + module Internal__ : sig 953 953 + module String_map : module type of Map.Make (String) 954 954 + 955 955 + type ('ret, 'f) dec_fun_ = 956 956 + | Dec_fun : 'f -> ('ret, 'f) dec_fun_ 957 957 + | Dec_app : ('ret, 'a -> 'b) dec_fun_ * 'a Type.Id.t -> ('ret, 'b) dec_fun_ 958 958 + 959 959 + type ('a, 'b) base_map = { 960 960 + kind : string; 961 961 + doc : string; 962 962 + dec : Meta.t -> 'a -> 'b; 963 963 + enc : 'b -> 'a; 964 964 + enc_meta : 'b -> Meta.t; 965 965 + } 966 966 + 967 967 + type 'a repr = 968 968 + | Null : (unit, 'a) base_map -> 'a repr 969 969 + | Bool : (bool, 'a) base_map -> 'a repr 970 970 + | Number : (float, 'a) base_map -> 'a repr 971 971 + | String : (string, 'a) base_map -> 'a repr 972 972 + | Array : ('a, 'elt, 'builder) array_map_ -> 'a repr 973 973 + | Object : ('o, 'o) object_map_ -> 'o repr 974 974 + | Any : 'a any_map_ -> 'a repr 975 975 + | Map : ('a, 'b) map_ -> 'b repr 976 976 + | Rec : 'a t Lazy.t -> 'a repr 977 977 + | Ignore : unit repr 978 978 + 979 979 + and ('array, 'elt, 'builder) array_map_ = { 980 980 + kind : string; 981 981 + doc : string; 982 982 + elt : 'elt t; 983 983 + dec_empty : unit -> 'builder; 984 984 + dec_skip : int -> 'builder -> bool; 985 985 + dec_add : int -> 'elt -> 'builder -> 'builder; 986 986 + dec_finish : Meta.t -> int -> 'builder -> 'array; 987 987 + enc : 'acc. ('acc -> int -> 'elt -> 'acc) -> 'acc -> 'array -> 'acc; 988 988 + enc_meta : 'array -> Meta.t; 989 989 + } 990 990 + 991 991 + and ('o, 'dec) object_map_ = { 992 992 + kind : string; 993 993 + doc : string; 994 994 + dec : ('o, 'dec) dec_fun_; 995 995 + mem_decs : mem_dec_ String_map.t; 996 996 + mem_encs : 'o mem_enc_ list; 997 997 + enc_meta : 'o -> Meta.t; 998 998 + shape : 'o object_shape_; 999 999 + } 1000 1000 + 1001 1001 + and mem_dec_ = Mem_dec : ('o, 'a) mem_map_ -> mem_dec_ 1002 1002 + and 'o mem_enc_ = Mem_enc : ('o, 'a) mem_map_ -> 'o mem_enc_ 1003 1003 + 1004 1004 + and ('o, 'a) mem_map_ = { 1005 1005 + name : string; 1006 1006 + doc : string; 1007 1007 + type' : 'a t; 1008 1008 + id : 'a Type.Id.t; 1009 1009 + dec_absent : 'a option; 1010 1010 + enc : 'o -> 'a; 1011 1011 + enc_omit : 'a -> bool; 1012 1012 + } 1013 1013 + 1014 1014 + and 'o object_shape_ = 1015 1015 + | Object_basic : ('o, 'mems, 'builder) unknown_mems_ -> 'o object_shape_ 1016 1016 + | Object_cases : 1017 1017 + ('o, 'mems, 'builder) unknown_mems_ option 1018 1018 + * ('o, 'cases, 'tag) object_cases_ 1019 1019 + -> 'o object_shape_ 1020 1020 + 1021 1021 + and ('o, 'mems, 'builder) unknown_mems_ = 1022 1022 + | Unknown_skip : ('o, unit, unit) unknown_mems_ 1023 1023 + | Unknown_error : ('o, unit, unit) unknown_mems_ 1024 1024 + | Unknown_keep : 1025 1025 + ('mems, 'a, 'builder) mems_map_ * ('o -> 'mems) 1026 1026 + -> ('o, 'mems, 'builder) unknown_mems_ 1027 1027 + 1028 1028 + and ('mems, 'a, 'builder) mems_map_ = { 1029 1029 + kind : string; 1030 1030 + doc : string; 1031 1031 + mems_type : 'a t; 1032 1032 + id : 'mems Type.Id.t; 1033 1033 + dec_empty : unit -> 'builder; 1034 1034 + dec_add : Meta.t -> string -> 'a -> 'builder -> 'builder; 1035 1035 + dec_finish : Meta.t -> 'builder -> 'mems; 1036 1036 + enc : 1037 1037 + 'acc. (Meta.t -> string -> 'a -> 'acc -> 'acc) -> 'mems -> 'acc -> 'acc; 1038 1038 + } 1039 1039 + 1040 1040 + and ('o, 'cases, 'tag) object_cases_ = { 1041 1041 + tag : ('tag, 'tag) mem_map_; 1042 1042 + tag_compare : 'tag -> 'tag -> int; 1043 1043 + tag_to_string : ('tag -> string) option; 1044 1044 + id : 'cases Type.Id.t; 1045 1045 + cases : ('cases, 'tag) case_ list; 1046 1046 + enc : 'o -> 'cases; 1047 1047 + enc_case : 'cases -> ('cases, 'tag) case_value_; 1048 1048 + } 1049 1049 + 1050 1050 + and ('cases, 'case, 'tag) case_map_ = { 1051 1051 + tag : 'tag; 1052 1052 + object_map : ('case, 'case) object_map_; 1053 1053 + dec : 'case -> 'cases; 1054 1054 + } 1055 1055 + 1056 1056 + and ('cases, 'tag) case_value_ = 1057 1057 + | Case_value : 1058 1058 + ('cases, 'case, 'tag) case_map_ * 'case 1059 1059 + -> ('cases, 'tag) case_value_ 1060 1060 + 1061 1061 + and ('cases, 'tag) case_ = 1062 1062 + | Case : ('cases, 'case, 'tag) case_map_ -> ('cases, 'tag) case_ 1063 1063 + 1064 1064 + and 'a any_map_ = { 1065 1065 + kind : string; 1066 1066 + doc : string; 1067 1067 + dec_null : 'a t option; 1068 1068 + dec_bool : 'a t option; 1069 1069 + dec_number : 'a t option; 1070 1070 + dec_string : 'a t option; 1071 1071 + dec_array : 'a t option; 1072 1072 + dec_object : 'a t option; 1073 1073 + enc : 'a -> 'a t; 1074 1074 + } 1075 1075 + 1076 1076 + and ('a, 'b) map_ = { 1077 1077 + kind : string; 1078 1078 + doc : string; 1079 1079 + dom : 'a t; 1080 1080 + dec : 'a -> 'b; 1081 1081 + enc : 'b -> 'a; 1082 1082 + } 1083 1083 + 1084 1084 + type unknown_mems_option_ = 1085 1085 + | Unknown_mems : 1086 1086 + ('o, 'mems, 'builder) unknown_mems_ option 1087 1087 + -> unknown_mems_option_ 1088 1088 + 1089 1089 + val repr : 'a t -> 'a repr 1090 1090 + val array_kinded_sort : ('a, 'elt, 'builder) array_map_ -> string 1091 1091 + val object_kinded_sort : ('o, 'dec) object_map_ -> string 1092 1092 + val pp_kind : string Fmt.t 1093 1093 + val pp_code : string Fmt.t 1094 1094 + 1095 1095 + val fail_push_array : 1096 1096 + Meta.t -> ('array, 'elt, 'builder) array_map_ -> int node -> Error.t -> 'a 1097 1097 + 1098 1098 + val fail_push_object : 1099 1099 + Meta.t -> ('o, 'dec) object_map_ -> string node -> Error.t -> 'a 1100 1100 + 1101 1101 + val fail_type_mismatch : Meta.t -> 'a t -> fnd:Sort.t -> 'b 1102 1102 + 1103 1103 + val fail_missing_members : 1104 1104 + Meta.t -> 1105 1105 + ('o, 'o) object_map_ -> 1106 1106 + exp:mem_dec_ String_map.t -> 1107 1107 + fnd:string list -> 1108 1108 + 'a 1109 1109 + 1110 1110 + val fail_unexpected_members : 1111 1111 + Meta.t -> ('o, 'o) object_map_ -> fnd:(string * Meta.t) list -> 'a 1112 1112 + 1113 1113 + val fail_unexpected_case_tag : 1114 1114 + Meta.t -> ('o, 'o) object_map_ -> ('o, 'd, 'tag) object_cases_ -> 'tag -> 'a 1115 1115 + 1116 1116 + val object_meta_arg : Meta.t Type.Id.t 1117 1117 + 1118 1118 + module Dict : sig 1119 1119 + type binding = B : 'a Type.Id.t * 'a -> binding 1120 1120 + type t 1121 1121 + 1122 1122 + val empty : t 1123 1123 + val mem : 'a Type.Id.t -> t -> bool 1124 1124 + val add : 'a Type.Id.t -> 'a -> t -> t 1125 1125 + val remove : 'a Type.Id.t -> t -> t 1126 1126 + val find : 'a Type.Id.t -> t -> 'a option 1127 1127 + end 1128 1128 + 1129 1129 + val apply_dict : ('ret, 'f) dec_fun_ -> Dict.t -> 'f 1130 1130 + 1131 1131 + val override_unknown_mems : 1132 1132 + by:unknown_mems_option_ -> 1133 1133 + unknown_mems_option_ -> 1134 1134 + Dict.t -> 1135 1135 + unknown_mems_option_ * Dict.t 1136 1136 + 1137 1137 + val finish_object_decode : 1138 1138 + ('o, 'o) object_map_ -> 1139 1139 + Meta.t -> 1140 1140 + ('p, 'mems, 'builder) unknown_mems_ -> 1141 1141 + 'builder -> 1142 1142 + mem_dec_ String_map.t -> 1143 1143 + Dict.t -> 1144 1144 + Dict.t 1145 1145 + end 1146 1146 + 1147 1147 + (**/**)

+1 -1

lib/error.mli

reviewed

··· 48 48 message. *) 49 49 50 50 val raise : t -> 'a 51 51 - (** [raise e] raises {!Json.exception-Error} (shadows {!Stdlib.raise}; use with 51 51 + (** [raise e] raises {!Json.exception-Error} (shadows [Stdlib.raise]; use with 52 52 care when [open Error]). *) 53 53 54 54 val fail : ctx:Context.t -> meta:Meta.t -> kind -> 'a

+117 -111

lib/json.mli

reviewed

··· 3 3 SPDX-License-Identifier: ISC 4 4 ---------------------------------------------------------------------------*) 5 5 6 6 - (** Types for JSON values. 6 6 + (** JSON values and typed codecs. 7 7 8 8 - This module provides a type for describing subsets of JSON values as 9 9 - bidirectional maps with arbitrary OCaml values. We call these values 10 10 - {e JSON types}. 8 8 + Json has two public layers: 9 9 + - {!type-t}, the generic JSON value type. Use it when you need to keep or 10 10 + construct arbitrary JSON data. Constructors are available at the top 11 11 + level, and helper constructors, queries and pretty-printers live in 12 12 + {!module-Value}. 13 13 + - {!module-Codec}, the typed codec API. Use it when JSON data should map 14 14 + directly to ordinary OCaml values without making callers build a generic 15 15 + tree. 11 16 12 12 - In these maps the {e decoding} direction maps from JSON values to OCaml 13 13 - values and the {e encoding} direction maps from OCaml values to JSON values. 14 14 - Depending on your needs, one direction or the other can be left unspecified. 15 15 - Some of the decoding maps may be lossy or creative which leads to JSON 16 16 - queries and transforms. 17 17 + A typical typed codec is built with [Json.Codec]: 17 18 18 18 - The combinator vocabulary follows 19 19 - {{:https://www.rfc-editor.org/rfc/rfc8259}RFC 8259} (STD 90, the JSON Data 20 20 - Interchange Format) and 21 21 - {{:https://www.ecma-international.org/publications-and-standards/standards/ecma-404/} 22 22 - ECMA-404}: a JSON {e value} is [null], [true]/[false] (literal names 23 23 - grouped as booleans here), a {e number}, a {e string}, an {e array} of 24 24 - values, or an {e object} -- a collection of {e members}, each a name/value 25 25 - pair. {!Codec.number} decodes to OCaml [float] because RFC 8259 § 6 26 26 - identifies IEEE 754 binary64 as the interoperability baseline for the number 27 27 - grammar. 19 19 + {[ 20 20 + module C = Json.Codec 28 21 29 29 - Read the {{!page-index.quick_start}quick start} and the 30 30 - {{!page-cookbook}cookbook}. *) 22 22 + type person = { name : string; age : int } 31 23 32 32 - (** {1:preliminaries Preliminaries} *) 24 24 + let person name age = { name; age } 33 25 34 34 - module Meta = Loc.Meta 35 35 - (** Node metadata (source location + surrounding whitespace). *) 26 26 + let person_codec = 27 27 + C.Object.map person 28 28 + |> C.Object.member "name" C.string ~enc:(fun p -> p.name) 29 29 + |> C.Object.member "age" C.int ~enc:(fun p -> p.age) 30 30 + |> C.Object.seal 36 31 37 37 - type 'a node = 'a * Meta.t 38 38 - (** An AST node: data plus its metadata. *) 32 32 + let decode s = Json.of_string person_codec s 33 33 + let encode person = Json.to_string person_codec person 34 34 + ]} 39 35 40 40 - module Path = Loc.Path 41 41 - (** Structural paths (object members, array indices). *) 36 36 + For generic values: 42 37 43 43 - module Context = Loc.Context 44 44 - (** Navigation contexts (path + source loc + active sort). *) 38 38 + {[ 39 39 + let value = 40 40 + let open Json.Value in 41 41 + object' [ (name "ok", bool true) ] 42 42 + ]} 45 43 46 46 - type fpath = Loc.fpath 47 47 - (** File path used by decoders for error reporting. *) 44 44 + The JSON vocabulary follows 45 45 + {{:https://www.rfc-editor.org/rfc/rfc8259}RFC 8259} and 46 46 + {{:https://www.ecma-international.org/publications-and-standards/standards/ecma-404/} 47 47 + ECMA-404}. *) 48 48 + 49 49 + open Bytesrw 48 50 49 49 - module Sort = Sort 50 50 - (** Sorts of JSON values ({!Sort.Null}, {!Sort.Bool}, {!Sort.Number}, 51 51 - {!Sort.String}, {!Sort.Array}, {!Sort.Object}). Labels used in structured 52 52 - error contexts and {!Path} frames. *) 51 51 + (** {1:types Generic JSON values} 53 52 54 54 - module Error = Error 55 55 - (** Typed JSON errors. Every error shape ships as a pair: [foo] builds a {!t}, 56 56 - [fail_foo] raises it. See {!Error} for the full menu. *) 53 53 + [Json.t] is the primary generic JSON value type. Its variant constructors 54 54 + are available at the top level; helper constructors and AST operations live 55 55 + in {!module-Value}. The typed object combinators live under 56 56 + [Json.Codec.Object]. *) 57 57 58 58 - exception Error of Error.t 59 59 - (** The exception raised on map errors. *) 58 58 + module Meta = Loc.Meta 59 59 + (** Node metadata: source location and surrounding whitespace. Most callers only 60 60 + inspect this when preserving layout or reporting precise errors. *) 60 61 61 61 - (** {1:types Generic JSON values} 62 62 + type 'a node = 'a * Meta.t 63 63 + (** A generic JSON node: payload plus metadata. Constructors of {!type-t} carry 64 64 + nodes so parsed values can preserve source information when requested. *) 62 65 63 63 - The AST lives in {!module-Value}. Types are re-exported at the top level so 64 64 - callers can write [Json.t] without reaching into [Json.Value]. *) 66 66 + type fpath = Loc.fpath 67 67 + (** File path used by decoders for error reporting. *) 65 68 66 69 type name = Value.name 67 70 (** The type for JSON member names. *) ··· 72 75 type object' = Value.object' 73 76 (** The type for generic JSON objects. *) 74 77 75 75 - (** The type for generic JSON values. *) 78 78 + (** The primary generic JSON value type. *) 76 79 type t = Value.t = 77 80 | Null of unit node 78 81 | Bool of bool node 79 82 | Number of float node 80 80 - (** Encoders must use [Null] if float is {{!Float.is_finite}not finite}. 81 81 - *) 83 83 + (** Encoders must use [Null] if float is not finite. *) 82 84 | String of string node 83 85 | Array of t list node 84 86 | Object of object' node (** *) ··· 86 88 type number_format = Value.number_format 87 89 (** The type for JSON number formatters. *) 88 90 91 91 + (** {1:codecs Typed codecs} *) 92 92 + 89 93 module Codec = Codec 90 90 - (** Codec combinators. See {!module:Codec}. *) 94 94 + (** Typed codec combinators. Build codecs here, then pass them to {!of_string}, 95 95 + {!to_string}, {!decode}, {!encode}, or the browser-native functions from 96 96 + [json.brr]. *) 91 97 92 98 type 'a codec = 'a Codec.t 93 99 (** The type for JSON codecs: a bidirectional map between JSON values and OCaml 94 100 values. Build codecs with {!module-Codec}. *) 95 101 96 96 - val pp : t Fmt.t 97 97 - (** [pp] formats JSON values. Alias of {!Value.pp}. *) 98 98 - 99 99 - val pp_value : ?number_format:number_format -> 'a codec -> unit -> 'a Fmt.t 100 100 - (** [pp_value c ()] formats values of type ['a] by encoding them with codec [c] 101 101 - and pretty-printing the resulting JSON. A codec error is formatted as a JSON 102 102 - string carrying the error message, so this function always produces valid 103 103 - JSON. *) 104 104 - 105 105 - (** {1:tape Tape} *) 106 106 - 107 107 - module Tape = Tape 108 108 - (** Simdjson-compatible tape format. A columnar representation of a JSON value 109 109 - laid out for random access by word index. *) 110 110 - (*--------------------------------------------------------------------------- 111 111 - Copyright (c) 2024 The jsont programmers. All rights reserved. 112 112 - SPDX-License-Identifier: ISC 113 113 - ---------------------------------------------------------------------------*) 114 114 - 115 115 - (** JSON codec. 116 116 - 117 117 - According to {{:https://www.rfc-editor.org/rfc/rfc8259}RFC 8259}. 118 118 - 119 119 - See notes about {{!layout}layout preservation} and behaviour on 120 120 - {{!duplicate}duplicate members}. 121 121 - 122 122 - {b Tip.} For maximal performance decode with [~layout:false] and 123 123 - [~locs:false], this is the default. However using [~locs:true] improves some 124 124 - error reports. *) 125 125 - 126 126 - open Bytesrw 127 127 - 128 128 - (** {1:decode_generic Decode and encode over {!t}} 129 129 - 130 130 - Convert between generic JSON values {!t} and typed values via a codec. These 131 131 - are the pure form: the heavy IO (reading from bytes, writing to bytes) is in 132 132 - {{!section:decode}Decode} / {{!section:encode}Encode} below. *) 102 102 + (** {1:runtime Runtime over {!t}} *) 133 103 134 104 val decode : 'a codec -> t -> ('a, Error.t) result 135 105 (** [decode c j] decodes [j] as a value of type ['a] according to codec [c]. *) ··· 141 111 (** [encode c v] encodes OCaml value [v] as a generic JSON value according to 142 112 codec [c]. *) 143 113 144 144 - (** {1:decode Decode} *) 114 114 + (** {1:decode Byte-stream decoding} 115 115 + 116 116 + These functions decode bytes directly to typed OCaml values through a codec. 117 117 + Use {!Value.of_string} if you specifically want a generic {!type-t} tree. *) 145 118 146 119 val of_reader : 147 120 ?layout:bool -> ··· 170 143 'a codec -> 171 144 string -> 172 145 ('a, Error.t) result 173 173 - (** [of_string] is like {!val-of_reader} but decodes directly from a string. *) 146 146 + (** [of_string c s] decodes [s] directly with codec [c]. *) 174 147 175 148 val of_string_exn : 176 149 ?layout:bool -> ?locs:bool -> ?file:fpath -> 'a codec -> string -> 'a 177 150 (** [of_string_exn] is like {!val-of_string} but raises {!Json.exception-Error}. 178 151 *) 179 152 180 180 - (** {1:encode Encode} *) 153 153 + (** {1:encode Byte-stream encoding} *) 181 154 182 155 val to_writer : 183 156 ?buf:Bytes.t -> ··· 193 166 {!Json.exception-Error} if the codec has no encoder (a codec bug, not a 194 167 runtime condition). 195 168 - If [buf] is specified it is used as a buffer for the slices written on 196 196 - [w]. Defaults to a buffer of length {!Bytes.Writer.slice_length}[ w]. 169 169 + [w]. Defaults to a buffer of length [Bytesrw.Bytes.Writer.slice_length w]. 197 170 - [indent] controls pretty-printing for nodes without source {!Meta.t}. 198 171 Defaults to [None] (compact: no whitespace, no newlines). [Some n] indents 199 172 nested structures by [n] spaces per level. ··· 201 174 {!Meta.none} {!Meta.t} reproduce their source whitespace byte-for-byte; 202 175 nodes with {!Meta.none} fall back to the [indent] behaviour. 203 176 - [number_format] specifies the format string to format numbers. Defaults to 204 204 - {!default_number_format}. 205 205 - - [eod] indicates whether {!Bytesrw.Bytes.Slice.eod} should be written on 177 177 + {!Value.default_number_format}. 178 178 + - [eod] indicates whether [Bytesrw.Bytes.Slice.eod] should be written on 206 179 [w]. *) 207 180 208 181 val to_string : ··· 216 189 (** [to_string] is like {!val-to_writer} but writes to a string. Raises 217 190 {!Json.exception-Error} on broken codecs. *) 218 191 219 219 - (** {1:layout Layout preservation} 220 220 - 221 221 - In order to simplify the implementation not all layout is preserved. In 222 222 - particular: 223 223 - - White space in empty arrays and objects is dropped. 224 224 - - Unicode escapes are replaced by their UTF-8 encoding. 225 225 - - The format of numbers is not preserved. *) 226 226 - 227 227 - (** {1:duplicate Duplicate object members} 228 228 - 229 229 - Duplicate object members are undefined behaviour in JSON. We follow the 230 230 - behaviour of 231 231 - {{:https://262.ecma-international.org/6.0/#sec-internalizejsonproperty} 232 232 - [JSON.parse]} and the last one takes over, however duplicate members all 233 233 - have to parse with the specified type as we error as soon as possible. Also 234 234 - {{!Json.Object.case_member}case members} are not allowed to duplicate. *) 235 235 - 236 192 (** {1:value_api Generic value API} 237 193 238 194 {!module-Value} is the AST layer: constructors, queries, pretty-printers, 239 239 - plus convenience I/O entry points (skip the codec argument, the identity 240 240 - codec is used). For typed values use the codec-taking forms at the top 241 241 - level. *) 195 195 + plus convenience I/O entry points that use the identity codec 196 196 + ({!Codec.Value.t}). For typed OCaml values use the codec-taking forms at the 197 197 + top level. *) 242 198 243 199 module Value : sig 244 200 include module type of Value with type t = t and type name = name ··· 290 246 unit 291 247 (** [to_writer v ~eod w] encodes [v] to [w]. *) 292 248 end 249 249 + 250 250 + (** {1:formatting Formatting} *) 251 251 + 252 252 + val pp : t Fmt.t 253 253 + (** [pp] formats JSON values. Alias of {!Value.pp}. *) 254 254 + 255 255 + val pp_value : ?number_format:number_format -> 'a codec -> unit -> 'a Fmt.t 256 256 + (** [pp_value c ()] formats values of type ['a] by encoding them with codec [c] 257 257 + and pretty-printing the resulting JSON. A codec error is formatted as a JSON 258 258 + string carrying the error message, so this function always produces valid 259 259 + JSON. *) 260 260 + 261 261 + (** {1:layout Layout preservation} 262 262 + 263 263 + In order to simplify the implementation not all layout is preserved. In 264 264 + particular: 265 265 + - White space in empty arrays and objects is dropped. 266 266 + - Unicode escapes are replaced by their UTF-8 encoding. 267 267 + - The format of numbers is not preserved. *) 268 268 + 269 269 + (** {1:duplicate Duplicate object members} 270 270 + 271 271 + Duplicate object members are undefined behaviour in JSON. We follow the 272 272 + behaviour of 273 273 + {{:https://262.ecma-international.org/6.0/#sec-internalizejsonproperty} 274 274 + [JSON.parse]} and the last one takes over, however duplicate members all 275 275 + have to parse with the specified type as we error as soon as possible. Also 276 276 + [Codec.Object.case_member] case members are not allowed to duplicate. *) 277 277 + 278 278 + (** {1:support Support modules} *) 279 279 + 280 280 + module Path = Loc.Path 281 281 + (** Structural paths for query and update codecs. *) 282 282 + 283 283 + module Context = Loc.Context 284 284 + (** Navigation contexts: path, source location and active JSON sort. *) 285 285 + 286 286 + module Sort = Sort 287 287 + (** Sorts of JSON values ({!Sort.Null}, {!Sort.Bool}, {!Sort.Number}, 288 288 + {!Sort.String}, {!Sort.Array}, {!Sort.Object}) used in diagnostics. *) 289 289 + 290 290 + module Error = Error 291 291 + (** Typed JSON errors. See {!module-Error} for the full set. *) 292 292 + 293 293 + exception Error of Error.t 294 294 + (** The exception raised by [_exn] functions and failing codec maps. *) 295 295 + 296 296 + module Tape = Tape 297 297 + (** Simdjson-compatible tape format. A columnar representation of a JSON value 298 298 + laid out for random access by word index. *)

+2 -2

lib/tape.mli

reviewed

··· 67 67 val tag_at : t -> int -> tag 68 68 (** [tag_at t i] is the tag at word [i]. 69 69 70 70 - @raise Invalid_argument if [i] is out of bounds. *) 70 70 + Raises [Invalid_argument] if [i] is out of bounds. *) 71 71 72 72 val payload_at : t -> int -> int64 73 73 (** [payload_at t i] is the 56-bit payload (zero-extended to 64 bits). *) ··· 75 75 val string_at : t -> int -> string 76 76 (** [string_at t i] reads the string at word [i] (tag must be [String]). 77 77 78 78 - @raise Invalid_argument if the word is not a string. *) 78 78 + Raises [Invalid_argument] if the word is not a string. *) 79 79 80 80 (** {1:interop Interop with {!Value.t}} *) 81 81

+87 -85

test/codecs/cookbook.ml

reviewed

··· 6 6 (* Dealing with null values. *) 7 7 8 8 let string_null_is_empty = 9 9 - let null = Json.Value.null "" in 10 10 - let enc = function "" -> null | _ -> Json.Value.string in 11 11 - Json.any ~dec_null:null ~dec_string:Json.Value.string ~enc () 9 9 + let null = Json.Codec.null "" in 10 10 + let enc = function "" -> null | _ -> Json.Codec.string in 11 11 + Json.Codec.any ~dec_null:null ~dec_string:Json.Codec.string ~enc () 12 12 13 13 (* Base maps *) 14 14 ··· 21 21 end 22 22 23 23 let m_jsont = 24 24 - let dec = Json.Base.dec_result M.result_of_string in 25 25 - let enc = Json.Base.enc M.to_string in 26 26 - Json.Base.string (Json.Base.map ~kind:"M.t" ~dec ~enc ()) 24 24 + let dec = Json.Codec.Base.dec_result M.result_of_string in 25 25 + let enc = Json.Codec.Base.enc M.to_string in 26 26 + Json.Codec.Base.string (Json.Codec.Base.map ~kind:"M.t" ~dec ~enc ()) 27 27 28 28 let m_jsont' = 29 29 - let dec = Json.Base.dec_failure M.of_string_or_failure in 30 30 - let enc = Json.Base.enc M.to_string in 31 31 - Json.Base.string (Json.Base.map ~kind:"M.t" ~dec ~enc ()) 29 29 + let dec = Json.Codec.Base.dec_failure M.of_string_or_failure in 30 30 + let enc = Json.Codec.Base.enc M.to_string in 31 31 + Json.Codec.Base.string (Json.Codec.Base.map ~kind:"M.t" ~dec ~enc ()) 32 32 33 33 let m_jsont'' = 34 34 - Json.of_of_string ~kind:"M.t" M.result_of_string ~enc:M.to_string 34 34 + Json.Codec.of_of_string ~kind:"M.t" M.result_of_string ~enc:M.to_string 35 35 36 36 (* Objects as records *) 37 37 ··· 43 43 let age p = p.age 44 44 45 45 let jsont = 46 46 - Json.Object.map ~kind:"Person" make 47 47 - |> Json.Object.member "name" Json.Value.string ~enc:name 48 48 - |> Json.Object.member "age" Json.Value.int ~enc:age 49 49 - |> Json.Object.seal 46 46 + Json.Codec.Object.map ~kind:"Person" make 47 47 + |> Json.Codec.Object.member "name" Json.Codec.string ~enc:name 48 48 + |> Json.Codec.Object.member "age" Json.Codec.int ~enc:age 49 49 + |> Json.Codec.Object.seal 50 50 end 51 51 52 52 (* Objects as key-value maps *) ··· 55 55 56 56 let map : ?kind:string -> 'a Json.codec -> 'a String_map.t Json.codec = 57 57 fun ?kind t -> 58 58 - Json.Object.map ?kind Fun.id 59 59 - |> Json.Object.keep_unknown (Json.Object.Members.string_map t) ~enc:Fun.id 60 60 - |> Json.Object.seal 58 58 + Json.Codec.Object.map ?kind Fun.id 59 59 + |> Json.Codec.Object.keep_unknown 60 60 + (Json.Codec.Object.Members.string_map t) 61 61 + ~enc:Fun.id 62 62 + |> Json.Codec.Object.seal 61 63 62 64 (* Optional members *) 63 65 ··· 69 71 let age p = p.age 70 72 71 73 let jsont = 72 72 - Json.Object.map ~kind:"Person" make 73 73 - |> Json.Object.member "name" Json.Value.string ~enc:name 74 74 - |> Json.Object.member "age" 75 75 - Json.(some int) 74 74 + Json.Codec.Object.map ~kind:"Person" make 75 75 + |> Json.Codec.Object.member "name" Json.Codec.string ~enc:name 76 76 + |> Json.Codec.Object.member "age" 77 77 + Json.Codec.(some int) 76 78 ~dec_absent:None ~enc_omit:Option.is_none ~enc:age 77 77 - |> Json.Object.seal 79 79 + |> Json.Codec.Object.seal 78 80 end 79 81 80 82 (* Unknown object members *) ··· 87 89 let age p = p.age 88 90 89 91 let jsont = 90 90 - Json.Object.map ~kind:"Person" make 91 91 - |> Json.Object.member "name" Json.Value.string ~enc:name 92 92 - |> Json.Object.member "age" Json.Value.int ~enc:age 93 93 - |> Json.Object.error_unknown |> Json.Object.seal 92 92 + Json.Codec.Object.map ~kind:"Person" make 93 93 + |> Json.Codec.Object.member "name" Json.Codec.string ~enc:name 94 94 + |> Json.Codec.Object.member "age" Json.Codec.int ~enc:age 95 95 + |> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal 94 96 end 95 97 96 98 module Person_keep = struct ··· 102 104 let unknown v = v.unknown 103 105 104 106 let jsont = 105 105 - Json.Object.map ~kind:"Person" make 106 106 - |> Json.Object.member "name" Json.Value.string ~enc:name 107 107 - |> Json.Object.member "age" Json.Value.int ~enc:age 108 108 - |> Json.Object.keep_unknown Json.json_mems ~enc:unknown 109 109 - |> Json.Object.seal 107 107 + Json.Codec.Object.map ~kind:"Person" make 108 108 + |> Json.Codec.Object.member "name" Json.Codec.string ~enc:name 109 109 + |> Json.Codec.Object.member "age" Json.Codec.int ~enc:age 110 110 + |> Json.Codec.Object.keep_unknown Json.Codec.Value.members ~enc:unknown 111 111 + |> Json.Codec.Object.seal 110 112 end 111 113 112 114 (* Dealing with recursive JSON *) ··· 121 123 let jsont value_type = 122 124 let rec t = 123 125 lazy 124 124 - (Json.Object.map ~kind:"Tree" make 125 125 - |> Json.Object.member "value" value_type ~enc:value 126 126 - |> Json.Object.member "children" 127 127 - (Json.Value.list (Json.fix t)) 126 126 + (Json.Codec.Object.map ~kind:"Tree" make 127 127 + |> Json.Codec.Object.member "value" value_type ~enc:value 128 128 + |> Json.Codec.Object.member "children" 129 129 + (Json.Codec.list (Json.Codec.fix t)) 128 130 ~enc:children 129 129 - |> Json.Object.seal) 131 131 + |> Json.Codec.Object.seal) 130 132 in 131 133 Lazy.force t 132 134 end ··· 142 144 let radius c = c.radius 143 145 144 146 let jsont = 145 145 - Json.Object.map ~kind:"Circle" make 146 146 - |> Json.Object.member "name" Json.Value.string ~enc:name 147 147 - |> Json.Object.member "radius" Json.Value.number ~enc:radius 148 148 - |> Json.Object.seal 147 147 + Json.Codec.Object.map ~kind:"Circle" make 148 148 + |> Json.Codec.Object.member "name" Json.Codec.string ~enc:name 149 149 + |> Json.Codec.Object.member "radius" Json.Codec.number ~enc:radius 150 150 + |> Json.Codec.Object.seal 149 151 end 150 152 151 153 module Rect = struct ··· 157 159 let height r = r.height 158 160 159 161 let jsont = 160 160 - Json.Object.map ~kind:"Rect" make 161 161 - |> Json.Object.member "name" Json.Value.string ~enc:name 162 162 - |> Json.Object.member "width" Json.Value.number ~enc:width 163 163 - |> Json.Object.member "height" Json.Value.number ~enc:height 164 164 - |> Json.Object.seal 162 162 + Json.Codec.Object.map ~kind:"Rect" make 163 163 + |> Json.Codec.Object.member "name" Json.Codec.string ~enc:name 164 164 + |> Json.Codec.Object.member "width" Json.Codec.number ~enc:width 165 165 + |> Json.Codec.Object.member "height" Json.Codec.number ~enc:height 166 166 + |> Json.Codec.Object.seal 165 167 end 166 168 167 169 type t = Circle of Circle.t | Rect of Rect.t ··· 170 172 let rect r = Rect r 171 173 172 174 let jsont = 173 173 - let circle = Json.Object.Case.map "Circle" Circle.jsont ~dec:circle in 174 174 - let rect = Json.Object.Case.map "Rect" Rect.jsont ~dec:rect in 175 175 + let circle = Json.Codec.Object.Case.map "Circle" Circle.jsont ~dec:circle in 176 176 + let rect = Json.Codec.Object.Case.map "Rect" Rect.jsont ~dec:rect in 175 177 let enc_case = function 176 176 - | Circle c -> Json.Object.Case.value circle c 177 177 - | Rect r -> Json.Object.Case.value rect r 178 178 + | Circle c -> Json.Codec.Object.Case.value circle c 179 179 + | Rect r -> Json.Codec.Object.Case.value rect r 178 180 in 179 179 - let cases = Json.Object.Case.[ make circle; make rect ] in 180 180 - Json.Object.map ~kind:"Geometry" Fun.id 181 181 - |> Json.Object.case_member "type" Json.Value.string ~enc:Fun.id ~enc_case 182 182 - cases 183 183 - |> Json.Object.seal 181 181 + let cases = Json.Codec.Object.Case.[ make circle; make rect ] in 182 182 + Json.Codec.Object.map ~kind:"Geometry" Fun.id 183 183 + |> Json.Codec.Object.case_member "type" Json.Codec.string ~enc:Fun.id 184 184 + ~enc_case cases 185 185 + |> Json.Codec.Object.seal 184 186 end 185 187 186 188 module Geometry_record = struct ··· 191 193 let radius c = c.radius 192 194 193 195 let jsont = 194 194 - Json.Object.map ~kind:"Circle" make 195 195 - |> Json.Object.member "radius" Json.Value.number ~enc:radius 196 196 - |> Json.Object.seal 196 196 + Json.Codec.Object.map ~kind:"Circle" make 197 197 + |> Json.Codec.Object.member "radius" Json.Codec.number ~enc:radius 198 198 + |> Json.Codec.Object.seal 197 199 end 198 200 199 201 module Rect = struct ··· 204 206 let height r = r.height 205 207 206 208 let jsont = 207 207 - Json.Object.map ~kind:"Rect" make 208 208 - |> Json.Object.member "width" Json.Value.number ~enc:width 209 209 - |> Json.Object.member "height" Json.Value.number ~enc:height 210 210 - |> Json.Object.seal 209 209 + Json.Codec.Object.map ~kind:"Rect" make 210 210 + |> Json.Codec.Object.member "width" Json.Codec.number ~enc:width 211 211 + |> Json.Codec.Object.member "height" Json.Codec.number ~enc:height 212 212 + |> Json.Codec.Object.seal 211 213 end 212 214 213 215 type type' = Circle of Circle.t | Rect of Rect.t ··· 222 224 let type' g = g.type' 223 225 224 226 let jsont = 225 225 - let circle = Json.Object.Case.map "Circle" Circle.jsont ~dec:circle in 226 226 - let rect = Json.Object.Case.map "Rect" Rect.jsont ~dec:rect in 227 227 + let circle = Json.Codec.Object.Case.map "Circle" Circle.jsont ~dec:circle in 228 228 + let rect = Json.Codec.Object.Case.map "Rect" Rect.jsont ~dec:rect in 227 229 let enc_case = function 228 228 - | Circle c -> Json.Object.Case.value circle c 229 229 - | Rect r -> Json.Object.Case.value rect r 230 230 + | Circle c -> Json.Codec.Object.Case.value circle c 231 231 + | Rect r -> Json.Codec.Object.Case.value rect r 230 232 in 231 231 - let cases = Json.Object.Case.[ make circle; make rect ] in 232 232 - Json.Object.map ~kind:"Geometry" make 233 233 - |> Json.Object.member "name" Json.Value.string ~enc:name 234 234 - |> Json.Object.case_member "type" Json.Value.string ~enc:type' ~enc_case 235 235 - cases 236 236 - |> Json.Object.seal 233 233 + let cases = Json.Codec.Object.Case.[ make circle; make rect ] in 234 234 + Json.Codec.Object.map ~kind:"Geometry" make 235 235 + |> Json.Codec.Object.member "name" Json.Codec.string ~enc:name 236 236 + |> Json.Codec.Object.case_member "type" Json.Codec.string ~enc:type' 237 237 + ~enc_case cases 238 238 + |> Json.Codec.Object.seal 237 239 end 238 240 239 241 (* Untagged object types *) ··· 242 244 type t = { id : int; value : (Json.t, string) result } 243 245 244 246 let make id result error = 245 245 - let pp_mem = Json.Codec.pp_code in 247 247 + let pp_mem = Format.pp_print_string in 246 248 match (result, error) with 247 249 | Some result, None -> { id; value = Ok result } 248 250 | None, Some error -> { id; value = Error error } ··· 257 259 let error r = match r.value with Ok _ -> None | Error e -> Some e 258 260 259 261 let jsont = 260 260 - Json.Object.map make 261 261 - |> Json.Object.member "id" Json.Value.int ~enc:(fun r -> r.id) 262 262 - |> Json.Object.opt_member "result" Json.json ~enc:result 263 263 - |> Json.Object.opt_member "error" Json.Value.string ~enc:error 264 264 - |> Json.Object.seal 262 262 + Json.Codec.Object.map make 263 263 + |> Json.Codec.Object.member "id" Json.Codec.int ~enc:(fun r -> r.id) 264 264 + |> Json.Codec.Object.opt_member "result" Json.Codec.Value.t ~enc:result 265 265 + |> Json.Codec.Object.opt_member "error" Json.Codec.string ~enc:error 266 266 + |> Json.Codec.Object.seal 265 267 end 266 268 267 269 (* Flattening objects on queries *) ··· 272 274 let make id name persons = { id; name; persons } 273 275 274 276 let info_jsont = 275 275 - Json.Object.map make 276 276 - |> Json.Object.member "id" Json.Value.int 277 277 - |> Json.Object.member "name" Json.Value.string 278 278 - |> Json.Object.seal 277 277 + Json.Codec.Object.map make 278 278 + |> Json.Codec.Object.member "id" Json.Codec.int 279 279 + |> Json.Codec.Object.member "name" Json.Codec.string 280 280 + |> Json.Codec.Object.seal 279 281 280 282 let jsont = 281 281 - Json.Object.map (fun k persons -> k persons) 282 282 - |> Json.Object.member "info" info_jsont 283 283 - |> Json.Object.member "persons" (Json.Value.list Person.jsont) 284 284 - |> Json.Object.seal 283 283 + Json.Codec.Object.map (fun k persons -> k persons) 284 284 + |> Json.Codec.Object.member "info" info_jsont 285 285 + |> Json.Codec.Object.member "persons" (Json.Codec.list Person.jsont) 286 286 + |> Json.Codec.Object.seal 285 287 end

+71 -68

test/codecs/geojson.ml

reviewed

··· 18 18 19 19 type float_array = float array 20 20 21 21 - let float_array_jsont ~kind = Json.Value.array ~kind Json.Value.number 21 21 + let float_array_jsont ~kind = Json.Codec.array ~kind Json.Codec.number 22 22 23 23 type 'a garray = 'a array 24 24 25 25 - let garray = Json.Value.array 25 25 + let garray = Json.Codec.array 26 26 27 27 module Bbox = struct 28 28 type t = float_array ··· 46 46 47 47 let finish_jsont map = 48 48 map 49 49 - |> Json.Object.opt_member "bbox" Bbox.jsont ~enc:bbox 50 50 - |> Json.Object.keep_unknown Json.json_mems ~enc:unknown 51 51 - |> Json.Object.seal 49 49 + |> Json.Codec.Object.opt_member "bbox" Bbox.jsont ~enc:bbox 50 50 + |> Json.Codec.Object.keep_unknown Json.Codec.Value.members ~enc:unknown 51 51 + |> Json.Codec.Object.seal 52 52 53 53 let geometry ~kind coordinates = 54 54 - Json.Object.map ~kind make 55 55 - |> Json.Object.member "coordinates" coordinates ~enc:type' 54 54 + Json.Codec.Object.map ~kind make 55 55 + |> Json.Codec.Object.member "coordinates" coordinates ~enc:type' 56 56 |> finish_jsont 57 57 end 58 58 ··· 148 148 149 149 let feature_id_jsont = 150 150 let number = 151 151 - let dec = Json.Base.dec (fun n -> `Number n) in 152 152 - let enc = Json.Base.enc (function `Number n -> n | _ -> assert false) in 153 153 - Json.Base.number (Json.Base.map ~enc ~dec ()) 151 151 + let dec = Json.Codec.Base.dec (fun n -> `Number n) in 152 152 + let enc = 153 153 + Json.Codec.Base.enc (function `Number n -> n | _ -> assert false) 154 154 + in 155 155 + Json.Codec.Base.number (Json.Codec.Base.map ~enc ~dec ()) 154 156 in 155 157 let string = 156 156 - let dec = Json.Base.dec (fun n -> `String n) in 157 157 - let enc = Json.Base.enc (function `String n -> n | _ -> assert false) in 158 158 - Json.Base.string (Json.Base.map ~enc ~dec ()) 158 158 + let dec = Json.Codec.Base.dec (fun n -> `String n) in 159 159 + let enc = 160 160 + Json.Codec.Base.enc (function `String n -> n | _ -> assert false) 161 161 + in 162 162 + Json.Codec.Base.string (Json.Codec.Base.map ~enc ~dec ()) 159 163 in 160 164 let enc = function `Number _ -> number | `String _ -> string in 161 161 - Json.any ~kind:"id" ~dec_number:number ~dec_string:string ~enc () 165 165 + Json.Codec.any ~kind:"id" ~dec_number:number ~dec_string:string ~enc () 162 166 163 167 (* The first two Json types below handle subtyping by redoing 164 168 cases for subsets of types. *) 165 169 166 166 - let case_map obj dec = Json.Object.Case.map (Json.kind obj) obj ~dec 170 170 + let case_map obj dec = 171 171 + Json.Codec.Object.Case.map (Json.Codec.kind obj) obj ~dec 167 172 168 173 let rec geometry_jsont = 169 174 lazy begin ··· 179 184 case_map (Lazy.force geometry_collection_jsont) geometry_collection 180 185 in 181 186 let enc_case = function 182 182 - | `Point v -> Json.Object.Case.value case_point v 183 183 - | `Multi_point v -> Json.Object.Case.value case_multi_point v 184 184 - | `Line_string v -> Json.Object.Case.value case_line_string v 187 187 + | `Point v -> Json.Codec.Object.Case.value case_point v 188 188 + | `Multi_point v -> Json.Codec.Object.Case.value case_multi_point v 189 189 + | `Line_string v -> Json.Codec.Object.Case.value case_line_string v 185 190 | `Multi_line_string v -> 186 186 - Json.Object.Case.value case_multi_line_string v 187 187 - | `Polygon v -> Json.Object.Case.value case_polygon v 188 188 - | `Multi_polygon v -> Json.Object.Case.value case_multi_polygon v 191 191 + Json.Codec.Object.Case.value case_multi_line_string v 192 192 + | `Polygon v -> Json.Codec.Object.Case.value case_polygon v 193 193 + | `Multi_polygon v -> Json.Codec.Object.Case.value case_multi_polygon v 189 194 | `Geometry_collection v -> 190 190 - Json.Object.Case.value case_geometry_collection v 195 195 + Json.Codec.Object.Case.value case_geometry_collection v 191 196 in 192 197 let cases = 193 193 - Json.Object.Case. 198 198 + Json.Codec.Object.Case. 194 199 [ 195 200 make case_point; 196 201 make case_multi_point; ··· 201 206 make case_geometry_collection; 202 207 ] 203 208 in 204 204 - Json.Object.map ~kind:"Geometry object" Fun.id 205 205 - |> Json.Object.case_member "type" Json.Value.string ~enc:Fun.id ~enc_case 206 206 - cases ~tag_to_string:Fun.id ~tag_compare:String.compare 207 207 - |> Json.Object.seal 209 209 + Json.Codec.Object.map ~kind:"Geometry object" Fun.id 210 210 + |> Json.Codec.Object.case_member "type" Json.Codec.string ~enc:Fun.id 211 211 + ~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare 212 212 + |> Json.Codec.Object.seal 208 213 end 209 214 210 215 and feature_jsont : Feature.t object' Json.codec Lazy.t = 211 216 lazy begin 212 217 let case_feature = case_map (Lazy.force case_feature_jsont) Fun.id in 213 213 - let enc_case v = Json.Object.Case.value case_feature v in 214 214 - let cases = Json.Object.Case.[ make case_feature ] in 215 215 - Json.Object.map ~kind:"Feature" Fun.id 216 216 - |> Json.Object.case_member "type" Json.Value.string ~enc:Fun.id ~enc_case 217 217 - cases ~tag_to_string:Fun.id ~tag_compare:String.compare 218 218 - |> Json.Object.seal 218 218 + let enc_case v = Json.Codec.Object.Case.value case_feature v in 219 219 + let cases = Json.Codec.Object.Case.[ make case_feature ] in 220 220 + Json.Codec.Object.map ~kind:"Feature" Fun.id 221 221 + |> Json.Codec.Object.case_member "type" Json.Codec.string ~enc:Fun.id 222 222 + ~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare 223 223 + |> Json.Codec.Object.seal 219 224 end 220 225 221 226 and case_feature_jsont : Feature.t object' Json.codec Lazy.t = 222 227 lazy begin 223 223 - Json.Object.map ~kind:"Feature" Feature.make_geojson_object 224 224 - |> Json.Object.opt_member "id" feature_id_jsont ~enc:(fun o -> 228 228 + Json.Codec.Object.map ~kind:"Feature" Feature.make_geojson_object 229 229 + |> Json.Codec.Object.opt_member "id" feature_id_jsont ~enc:(fun o -> 225 230 Feature.id (Geojson_object.type' o)) 226 226 - |> Json.Object.member "geometry" 227 227 - (Json.Value.option (Json.fix geometry_jsont)) 231 231 + |> Json.Codec.Object.member "geometry" 232 232 + (Json.Codec.option (Json.Codec.fix geometry_jsont)) 228 233 ~enc:(fun o -> Feature.geometry (Geojson_object.type' o)) 229 229 - |> Json.Object.member "properties" (Json.Value.option Json.json_object) 230 230 - ~enc:(fun o -> Feature.properties (Geojson_object.type' o)) 234 234 + |> Json.Codec.Object.member "properties" 235 235 + (Json.Codec.option Json.Codec.Value.object') ~enc:(fun o -> 236 236 + Feature.properties (Geojson_object.type' o)) 231 237 |> Geojson_object.finish_jsont 232 238 end 233 239 234 240 and geometry_collection_jsont = 235 241 lazy begin 236 236 - Json.Object.map ~kind:"GeometryCollection" Geojson_object.make 237 237 - |> Json.Object.member "geometries" 238 238 - (Json.Value.list (Json.fix geometry_jsont)) 242 242 + Json.Codec.Object.map ~kind:"GeometryCollection" Geojson_object.make 243 243 + |> Json.Codec.Object.member "geometries" 244 244 + (Json.Codec.list (Json.Codec.fix geometry_jsont)) 239 245 ~enc:Geojson_object.type' 240 246 |> Geojson_object.finish_jsont 241 247 end 242 248 243 249 and feature_collection_json = 244 250 lazy begin 245 245 - Json.Object.map ~kind:"FeatureCollection" Geojson_object.make 246 246 - |> Json.Object.member "features" 247 247 - Json.(list (Json.fix feature_jsont)) 251 251 + Json.Codec.Object.map ~kind:"FeatureCollection" Geojson_object.make 252 252 + |> Json.Codec.Object.member "features" 253 253 + Json.Codec.(list (Json.Codec.fix feature_jsont)) 248 254 ~enc:Geojson_object.type' 249 255 |> Geojson_object.finish_jsont 250 256 end ··· 267 273 case_map (Lazy.force feature_collection_json) feature_collection 268 274 in 269 275 let enc_case = function 270 270 - | `Point v -> Json.Object.Case.value case_point v 271 271 - | `Multi_point v -> Json.Object.Case.value case_multi_point v 272 272 - | `Line_string v -> Json.Object.Case.value case_line_string v 276 276 + | `Point v -> Json.Codec.Object.Case.value case_point v 277 277 + | `Multi_point v -> Json.Codec.Object.Case.value case_multi_point v 278 278 + | `Line_string v -> Json.Codec.Object.Case.value case_line_string v 273 279 | `Multi_line_string v -> 274 274 - Json.Object.Case.value case_multi_line_string v 275 275 - | `Polygon v -> Json.Object.Case.value case_polygon v 276 276 - | `Multi_polygon v -> Json.Object.Case.value case_multi_polygon v 280 280 + Json.Codec.Object.Case.value case_multi_line_string v 281 281 + | `Polygon v -> Json.Codec.Object.Case.value case_polygon v 282 282 + | `Multi_polygon v -> Json.Codec.Object.Case.value case_multi_polygon v 277 283 | `Geometry_collection v -> 278 278 - Json.Object.Case.value case_geometry_collection v 279 279 - | `Feature v -> Json.Object.Case.value case_feature v 284 284 + Json.Codec.Object.Case.value case_geometry_collection v 285 285 + | `Feature v -> Json.Codec.Object.Case.value case_feature v 280 286 | `Feature_collection v -> 281 281 - Json.Object.Case.value case_feature_collection v 287 287 + Json.Codec.Object.Case.value case_feature_collection v 282 288 in 283 289 let cases = 284 284 - Json.Object.Case. 290 290 + Json.Codec.Object.Case. 285 291 [ 286 292 make case_point; 287 293 make case_multi_point; ··· 294 300 make case_feature_collection; 295 301 ] 296 302 in 297 297 - Json.Object.map ~kind:"GeoJSON" Fun.id 298 298 - |> Json.Object.case_member "type" Json.Value.string ~enc:Fun.id ~enc_case 299 299 - cases ~tag_to_string:Fun.id ~tag_compare:String.compare 300 300 - |> Json.Object.seal 303 303 + Json.Codec.Object.map ~kind:"GeoJSON" Fun.id 304 304 + |> Json.Codec.Object.case_member "type" Json.Codec.string ~enc:Fun.id 305 305 + ~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare 306 306 + |> Json.Codec.Object.seal 301 307 end 302 308 303 309 let jsont = Lazy.force jsont ··· 329 335 | file -> In_channel.with_open_bin file (process file) 330 336 with Sys_error e -> Error e 331 337 332 332 - let trip ~file ~format ~locs ~dec_only = 338 338 + let trip ~file ~indent ~locs ~dec_only = 333 339 log_if_error ~use:1 @@ with_infile file 334 340 @@ fun r -> 335 341 log_if_error ~use:1 ··· 338 344 if dec_only then Ok 0 339 345 else 340 346 let w = Bytesrw.Bytes.Writer.of_out_channel stdout in 341 341 - let* () = Json.to_writer ~format ~eod:true Geojson.jsont t w in 347 347 + Json.to_writer ?indent ~eod:true Geojson.jsont t w; 342 348 Ok 0 343 349 344 350 open Cmdliner ··· 353 359 and+ locs = 354 360 let doc = "Preserve locations (better errors)." in 355 361 Arg.(value & flag & info [ "l"; "locs" ] ~doc) 356 356 - and+ format = 357 357 - let fmt = [ ("indent", Json.Indent); ("minify", Json.Minify) ] in 362 362 + and+ indent = 363 363 + let fmt = [ ("indent", Some 2); ("minify", None) ] in 358 364 let doc = strf "Output style. Must be %s." (Arg.doc_alts_enum fmt) in 359 359 - Arg.( 360 360 - value 361 361 - & opt (enum fmt) Json.Minify 362 362 - & info [ "f"; "format" ] ~doc ~docv:"FMT") 365 365 + Arg.(value & opt (enum fmt) None & info [ "f"; "format" ] ~doc ~docv:"FMT") 363 366 and+ dec_only = 364 367 let doc = "Decode only." in 365 368 Arg.(value & flag & info [ "d" ] ~doc) 366 369 in 367 367 - trip ~file ~format ~locs ~dec_only 370 370 + trip ~file ~indent ~locs ~dec_only 368 371 369 372 let main () = Cmd.eval' geojson 370 373 let () = if !Sys.interactive then () else exit (main ())

+32 -27

test/codecs/json_rpc.ml

reviewed

··· 9 9 10 10 type jsonrpc = [ `V2 ] 11 11 12 12 - let jsonrpc_jsont = Json.enum [ ("2.0", `V2) ] 12 12 + let jsonrpc_jsont = Json.Codec.enum [ ("2.0", `V2) ] 13 13 14 14 (* JSON-RPC identifiers *) 15 15 16 16 type id = [ `String of string | `Number of float | `Null ] 17 17 18 18 let id_jsont : id Json.codec = 19 19 - let null = Json.Value.null `Null in 19 19 + let null = Json.Codec.null `Null in 20 20 let string = 21 21 let dec s = `String s in 22 22 let enc = function `String s -> s | _ -> assert false in 23 23 - Json.map ~dec ~enc Json.Value.string 23 23 + Json.Codec.map ~dec ~enc Json.Codec.string 24 24 in 25 25 let number = 26 26 let dec n = `Number n in 27 27 let enc = function `Number n -> n | _ -> assert false in 28 28 - Json.map ~dec ~enc Json.Value.number 28 28 + Json.Codec.map ~dec ~enc Json.Codec.number 29 29 in 30 30 let enc = function 31 31 | `Null -> null 32 32 | `String _ -> string 33 33 | `Number _ -> number 34 34 in 35 35 - Json.any ~dec_null:null ~dec_string:string ~dec_number:number ~enc () 35 35 + Json.Codec.any ~dec_null:null ~dec_string:string ~dec_number:number ~enc () 36 36 37 37 (* JSON-RPC request object *) 38 38 39 39 - type params = Json.json (* An array or object *) 39 39 + type params = Json.t (* An array or object *) 40 40 41 41 let params_jsont = 42 42 let enc = function 43 43 - | Json.Object _ | Json.Array _ -> Json.t 43 43 + | Json.Value.Object _ | Json.Value.Array _ -> Json.Codec.Value.t 44 44 | j -> 45 45 let meta = Json.Meta.none in 46 46 let fnd = Json.Sort.to_string (Json.Value.sort j) in 47 47 Json.Error.fail_expected meta "object or array" ~fnd 48 48 in 49 49 let kind = "JSON-RPC params" in 50 50 - Json.any ~kind ~dec_array:Json.json ~dec_object:Json.json ~enc () 50 50 + Json.Codec.any ~kind ~dec_array:Json.Codec.Value.t 51 51 + ~dec_object:Json.Codec.Value.t ~enc () 51 52 52 53 type request = { 53 54 jsonrpc : jsonrpc; ··· 59 60 let request jsonrpc method' params id = { jsonrpc; method'; params; id } 60 61 61 62 let request_jsont : request Json.codec = 62 62 - Json.Object.map request 63 63 - |> Json.Object.member "jsonrpc" jsonrpc_jsont ~enc:(fun r -> r.jsonrpc) 64 64 - |> Json.Object.member "method" Json.Value.string ~enc:(fun r -> r.method') 65 65 - |> Json.Object.opt_member "params" params_jsont ~enc:(fun r -> r.params) 66 66 - |> Json.Object.opt_member "id" id_jsont ~enc:(fun r -> r.id) 67 67 - |> Json.Object.seal 63 63 + Json.Codec.Object.map request 64 64 + |> Json.Codec.Object.member "jsonrpc" jsonrpc_jsont ~enc:(fun r -> r.jsonrpc) 65 65 + |> Json.Codec.Object.member "method" Json.Codec.string ~enc:(fun r -> 66 66 + r.method') 67 67 + |> Json.Codec.Object.opt_member "params" params_jsont ~enc:(fun r -> r.params) 68 68 + |> Json.Codec.Object.opt_member "id" id_jsont ~enc:(fun r -> r.id) 69 69 + |> Json.Codec.Object.seal 68 70 69 71 (* JSON-RPC error objects *) 70 72 ··· 73 75 let error code message data = { code; message; data } 74 76 75 77 let error_jsont = 76 76 - Json.Object.map error 77 77 - |> Json.Object.member "code" Json.Value.int ~enc:(fun e -> e.code) 78 78 - |> Json.Object.member "message" Json.Value.string ~enc:(fun e -> e.message) 79 79 - |> Json.Object.opt_member "data" Json.json ~enc:(fun e -> e.data) 80 80 - |> Json.Object.seal 78 78 + Json.Codec.Object.map error 79 79 + |> Json.Codec.Object.member "code" Json.Codec.int ~enc:(fun e -> e.code) 80 80 + |> Json.Codec.Object.member "message" Json.Codec.string ~enc:(fun e -> 81 81 + e.message) 82 82 + |> Json.Codec.Object.opt_member "data" Json.Codec.Value.t ~enc:(fun e -> 83 83 + e.data) 84 84 + |> Json.Codec.Object.seal 81 85 82 86 (* JSON-RPC response object *) 83 87 ··· 86 90 let response jsonrpc result error id : response = 87 91 let err_both () = 88 92 Json.Error.msgf Json.Meta.none "Both %a and %a members are defined" 89 89 - Json.Codec.pp_code "result" Json.Codec.pp_code "error" 93 93 + Format.pp_print_string "result" Format.pp_print_string "error" 90 94 in 91 95 let err_none () = 92 96 Json.Error.msgf Json.Meta.none "Missing either %a or %a member" 93 93 - Json.Codec.pp_code "result" Json.Codec.pp_code "error" 97 97 + Format.pp_print_string "result" Format.pp_print_string "error" 94 98 in 95 99 match (result, error) with 96 100 | Some result, None -> { jsonrpc; value = Ok result; id } ··· 102 106 let response_error r = match r.value with Ok _ -> None | Error e -> Some e 103 107 104 108 let response_jsont : response Json.codec = 105 105 - Json.Object.map response 106 106 - |> Json.Object.member "jsonrpc" jsonrpc_jsont ~enc:(fun r -> r.jsonrpc) 107 107 - |> Json.Object.opt_member "result" Json.json ~enc:response_result 108 108 - |> Json.Object.opt_member "error" error_jsont ~enc:response_error 109 109 - |> Json.Object.member "id" id_jsont ~enc:(fun r -> r.id) 110 110 - |> Json.Object.seal 109 109 + Json.Codec.Object.map response 110 110 + |> Json.Codec.Object.member "jsonrpc" jsonrpc_jsont ~enc:(fun r -> r.jsonrpc) 111 111 + |> Json.Codec.Object.opt_member "result" Json.Codec.Value.t 112 112 + ~enc:response_result 113 113 + |> Json.Codec.Object.opt_member "error" error_jsont ~enc:response_error 114 114 + |> Json.Codec.Object.member "id" id_jsont ~enc:(fun r -> r.id) 115 115 + |> Json.Codec.Object.seal

+6 -6

test/codecs/jsont_tool.ml

reviewed

··· 145 145 pf ppf "@[<v>%s:@,%a@]@," label Loc.pp_ocaml (Json.Meta.loc m) 146 146 in 147 147 let rec value ppf = function 148 148 - | Json.Null ((), m) -> 148 148 + | Json.Value.Null ((), m) -> 149 149 loc (strf "%a" pp_code (strf "%a" Json.Value.pp_null ())) ppf m 150 150 - | Json.Bool (b, m) -> 150 150 + | Json.Value.Bool (b, m) -> 151 151 loc (strf "Bool %a" pp_code (strf "%a" Json.Value.pp_bool b)) ppf m 152 152 - | Json.Number (n, m) -> 152 152 + | Json.Value.Number (n, m) -> 153 153 loc 154 154 (strf "Number %a" pp_code (strf "%a" Json.Value.pp_number n)) 155 155 ppf m 156 156 - | Json.String (s, m) -> 156 156 + | Json.Value.String (s, m) -> 157 157 loc 158 158 (strf "String %a" pp_code (strf "%a" Json.Value.pp_string s)) 159 159 ppf m 160 160 - | Json.Array (l, m) -> 160 160 + | Json.Value.Array (l, m) -> 161 161 Format.pp_open_vbox ppf indent; 162 162 loc "Array" ppf m; 163 163 (Format.pp_print_list value) ppf l; 164 164 Format.pp_close_box ppf () 165 165 - | Json.Object (o, m) -> 165 165 + | Json.Value.Object (o, m) -> 166 166 let mem ppf ((name, m), v) = 167 167 let l = 168 168 strf "Member %a" pp_code (strf "%a" Json.Value.pp_string name)

+10 -10

test/codecs/quickstart.ml

reviewed

··· 12 12 13 13 let () = 14 14 let p = Json.Path.(root |> mem "tags" |> nth 1) in 15 15 - let update = Json.(set_path string p "software") in 15 15 + let update = Json.Codec.(set_path string p "software") in 16 16 let correct = 17 17 Result.map 18 18 (fun v -> Json.to_string ~preserve:true update v) ··· 24 24 type t = Todo | Done | Cancelled 25 25 26 26 let assoc = [ ("todo", Todo); ("done", Done); ("cancelled", Cancelled) ] 27 27 - let jsont = Json.enum ~kind:"Status" assoc 27 27 + let jsont = Json.Codec.enum ~kind:"Status" assoc 28 28 end 29 29 30 30 module Item = struct ··· 36 36 let tags i = i.tags 37 37 38 38 let jsont = 39 39 - Json.Object.map ~kind:"Item" make 40 40 - |> Json.Object.member "task" Json.Value.string ~enc:task 41 41 - |> Json.Object.member "status" Status.jsont ~enc:status 42 42 - |> Json.Object.member "tags" 43 43 - Json.(list string) 39 39 + Json.Codec.Object.map ~kind:"Item" make 40 40 + |> Json.Codec.Object.member "task" Json.Codec.string ~enc:task 41 41 + |> Json.Codec.Object.member "status" Status.jsont ~enc:status 42 42 + |> Json.Codec.Object.member "tags" 43 43 + Json.Codec.(list string) 44 44 ~enc:tags ~dec_absent:[] ~enc_omit:(( = ) []) 45 45 - |> Json.Object.seal 45 45 + |> Json.Codec.Object.seal 46 46 end 47 47 48 48 - let items = Json.Value.list Item.jsont 48 48 + let items = Json.Codec.list Item.jsont 49 49 let items_of_json s = Json.of_string items s 50 50 - let items_to_json ?format is = Json.to_string ?format items is 50 50 + let items_to_json ?indent is = Json.to_string ?indent items is

+111 -95

test/codecs/test_common_samples.ml

reviewed

··· 11 11 type t = Todo | Done | Cancelled 12 12 13 13 let assoc = [ ("todo", Todo); ("done", Done); ("cancelled", Cancelled) ] 14 14 - let jsont = Json.enum ~kind:"Status" assoc 14 14 + let jsont = Json.Codec.enum ~kind:"Status" assoc 15 15 end 16 16 17 17 module Item = struct ··· 23 23 let tags i = i.tags 24 24 25 25 let jsont = 26 26 - Json.Object.map ~kind:"Item" make 27 27 - |> Json.Object.member "task" Json.Value.string ~enc:task 28 28 - |> Json.Object.member "status" Status.jsont ~enc:status 29 29 - |> Json.Object.member "tags" 30 30 - Json.(list string) 26 26 + Json.Codec.Object.map ~kind:"Item" make 27 27 + |> Json.Codec.Object.member "task" Json.Codec.string ~enc:task 28 28 + |> Json.Codec.Object.member "status" Status.jsont ~enc:status 29 29 + |> Json.Codec.Object.member "tags" 30 30 + Json.Codec.(list string) 31 31 ~dec_absent:[] ~enc:tags ~enc_omit:(( = ) []) 32 32 - |> Json.Object.seal 32 32 + |> Json.Codec.Object.seal 33 33 end 34 34 35 35 module Item_data = struct 36 36 let i0 = Item.{ task = "Hey"; status = Todo; tags = [ "huhu"; "haha" ] } 37 37 38 38 let i0_json = 39 39 - (* in Json.Indent format *) 39 39 + (* Indented JSON format. *) 40 40 "{\n\ 41 41 \ \"task\": \"Hey\",\n\ 42 42 \ \"status\": \"todo\",\n\ ··· 49 49 let i1 = Item.{ task = "Ho"; status = Done; tags = [] } 50 50 51 51 let i1_json = 52 52 - (* in Json.Indent format *) 52 52 + (* Indented JSON format. *) 53 53 "{\n \"task\": \"Ho\",\n \"status\": \"done\"\n}" 54 54 end 55 55 ··· 62 62 let m v = v.m 63 63 64 64 let skip_jsont = 65 65 - Json.Object.map ~kind:"unknown-skip" make 66 66 - |> Json.Object.member "m" Json.Value.bool ~enc:m 67 67 - |> Json.Object.skip_unknown |> Json.Object.seal 65 65 + Json.Codec.Object.map ~kind:"unknown-skip" make 66 66 + |> Json.Codec.Object.member "m" Json.Codec.bool ~enc:m 67 67 + |> Json.Codec.Object.skip_unknown |> Json.Codec.Object.seal 68 68 69 69 let error_jsont = 70 70 - Json.Object.map ~kind:"unknown-skip" make 71 71 - |> Json.Object.member "m" Json.Value.bool ~enc:m 72 72 - |> Json.Object.error_unknown |> Json.Object.seal 70 70 + Json.Codec.Object.map ~kind:"unknown-skip" make 71 71 + |> Json.Codec.Object.member "m" Json.Codec.bool ~enc:m 72 72 + |> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal 73 73 74 74 let keep_jsont : (t * int String_map.t) Json.codec = 75 75 - let unknown = Json.Object.Members.string_map Json.Value.int in 76 76 - Json.Object.map ~kind:"unknown-keep" (fun m imap -> (make m, imap)) 77 77 - |> Json.Object.member "m" Json.Value.bool ~enc:(fun (v, _) -> m v) 78 78 - |> Json.Object.keep_unknown unknown ~enc:snd 79 79 - |> Json.Object.seal 75 75 + let unknown = Json.Codec.Object.Members.string_map Json.Codec.int in 76 76 + Json.Codec.Object.map ~kind:"unknown-keep" (fun m imap -> (make m, imap)) 77 77 + |> Json.Codec.Object.member "m" Json.Codec.bool ~enc:(fun (v, _) -> m v) 78 78 + |> Json.Codec.Object.keep_unknown unknown ~enc:snd 79 79 + |> Json.Codec.Object.seal 80 80 end 81 81 82 82 module Unknown_data = struct ··· 112 112 let pseudo a = a.pseudo 113 113 114 114 let jsont = 115 115 - Json.Object.map ~kind:"Author" make 116 116 - |> Json.Object.member "name" Json.Value.string ~enc:name 117 117 - |> Json.Object.member "book_count" Json.Value.int ~enc:book_count 118 118 - |> Json.Object.member "pseudo" Json.Value.string ~enc:pseudo 119 119 - |> Json.Object.seal 115 115 + Json.Codec.Object.map ~kind:"Author" make 116 116 + |> Json.Codec.Object.member "name" Json.Codec.string ~enc:name 117 117 + |> Json.Codec.Object.member "book_count" Json.Codec.int ~enc:book_count 118 118 + |> Json.Codec.Object.member "pseudo" Json.Codec.string ~enc:pseudo 119 119 + |> Json.Codec.Object.seal 120 120 end 121 121 122 122 module Editor = struct ··· 127 127 let publisher e = e.publisher 128 128 129 129 let jsont = 130 130 - Json.Object.map ~kind:"Editor" make 131 131 - |> Json.Object.member "name" Json.Value.string ~enc:name 132 132 - |> Json.Object.member "publisher" Json.Value.string ~enc:publisher 133 133 - |> Json.Object.seal 130 130 + Json.Codec.Object.map ~kind:"Editor" make 131 131 + |> Json.Codec.Object.member "name" Json.Codec.string ~enc:name 132 132 + |> Json.Codec.Object.member "publisher" Json.Codec.string ~enc:publisher 133 133 + |> Json.Codec.Object.seal 134 134 end 135 135 136 136 type t = Author of Author.t | Editor of Editor.t ··· 139 139 let editor e = Editor e 140 140 141 141 let jsont = 142 142 - let case_a = Json.Object.Case.map "author" Author.jsont ~dec:author in 143 143 - let case_e = Json.Object.Case.map "editor" Editor.jsont ~dec:editor in 144 144 - let cases = Json.Object.Case.[ make case_a; make case_e ] in 142 142 + let case_a = 143 143 + Json.Codec.Object.Case.map "author" Author.jsont ~dec:author 144 144 + in 145 145 + let case_e = 146 146 + Json.Codec.Object.Case.map "editor" Editor.jsont ~dec:editor 147 147 + in 148 148 + let cases = Json.Codec.Object.Case.[ make case_a; make case_e ] in 145 149 let enc_case = function 146 146 - | Author a -> Json.Object.Case.value case_a a 147 147 - | Editor e -> Json.Object.Case.value case_e e 150 150 + | Author a -> Json.Codec.Object.Case.value case_a a 151 151 + | Editor e -> Json.Codec.Object.Case.value case_e e 148 152 in 149 149 - Json.Object.map ~kind:"Person" Fun.id 150 150 - |> Json.Object.case_member "type" Json.Value.string ~tag_to_string:Fun.id 151 151 - ~enc:Fun.id ~enc_case cases 152 152 - |> Json.Object.seal 153 153 + Json.Codec.Object.map ~kind:"Person" Fun.id 154 154 + |> Json.Codec.Object.case_member "type" Json.Codec.string 155 155 + ~tag_to_string:Fun.id ~enc:Fun.id ~enc_case cases 156 156 + |> Json.Codec.Object.seal 153 157 end 154 158 155 159 module Person_field = struct ··· 161 165 let book_count a = a.book_count 162 166 163 167 let author_jsont = 164 164 - Json.Object.map ~kind:"Author" make_author 165 165 - |> Json.Object.member "pseudo" Json.Value.string ~enc:pseudo 166 166 - |> Json.Object.member "book_count" Json.Value.int ~enc:book_count 167 167 - |> Json.Object.seal 168 168 + Json.Codec.Object.map ~kind:"Author" make_author 169 169 + |> Json.Codec.Object.member "pseudo" Json.Codec.string ~enc:pseudo 170 170 + |> Json.Codec.Object.member "book_count" Json.Codec.int ~enc:book_count 171 171 + |> Json.Codec.Object.seal 168 172 169 173 type editor = { publisher : string } 170 174 ··· 172 176 let publisher e = e.publisher 173 177 174 178 let editor_jsont = 175 175 - Json.Object.map ~kind:"Editor" make_editor 176 176 - |> Json.Object.member "publisher" Json.Value.string ~enc:publisher 177 177 - |> Json.Object.seal 179 179 + Json.Codec.Object.map ~kind:"Editor" make_editor 180 180 + |> Json.Codec.Object.member "publisher" Json.Codec.string ~enc:publisher 181 181 + |> Json.Codec.Object.seal 178 182 179 183 type type' = Author of author | Editor of editor 180 184 ··· 188 192 let name v = v.name 189 193 190 194 let jsont = 191 191 - let case_a = Json.Object.Case.map "author" author_jsont ~dec:author in 192 192 - let case_e = Json.Object.Case.map "editor" editor_jsont ~dec:editor in 193 193 - let cases = Json.Object.Case.[ make case_a; make case_e ] in 195 195 + let case_a = 196 196 + Json.Codec.Object.Case.map "author" author_jsont ~dec:author 197 197 + in 198 198 + let case_e = 199 199 + Json.Codec.Object.Case.map "editor" editor_jsont ~dec:editor 200 200 + in 201 201 + let cases = Json.Codec.Object.Case.[ make case_a; make case_e ] in 194 202 let enc_case = function 195 195 - | Author a -> Json.Object.Case.value case_a a 196 196 - | Editor e -> Json.Object.Case.value case_e e 203 203 + | Author a -> Json.Codec.Object.Case.value case_a a 204 204 + | Editor e -> Json.Codec.Object.Case.value case_e e 197 205 in 198 198 - Json.Object.map ~kind:"Person" make 199 199 - |> Json.Object.case_member "type" ~tag_to_string:Fun.id Json.Value.string 200 200 - ~enc:type' ~enc_case cases 201 201 - |> Json.Object.member "name" Json.Value.string ~enc:name 202 202 - |> Json.Object.seal 206 206 + Json.Codec.Object.map ~kind:"Person" make 207 207 + |> Json.Codec.Object.case_member "type" ~tag_to_string:Fun.id 208 208 + Json.Codec.string ~enc:type' ~enc_case cases 209 209 + |> Json.Codec.Object.member "name" Json.Codec.string ~enc:name 210 210 + |> Json.Codec.Object.seal 203 211 end 204 212 205 213 module Keep_unknown = struct 206 214 type a = string String_map.t 207 215 208 216 let a_jsont = 209 209 - let unknown = Json.Object.Members.string_map Json.Value.string in 210 210 - Json.Object.map ~kind:"A" Fun.id 211 211 - |> Json.Object.keep_unknown unknown ~enc:Fun.id 212 212 - |> Json.Object.seal 217 217 + let unknown = Json.Codec.Object.Members.string_map Json.Codec.string in 218 218 + Json.Codec.Object.map ~kind:"A" Fun.id 219 219 + |> Json.Codec.Object.keep_unknown unknown ~enc:Fun.id 220 220 + |> Json.Codec.Object.seal 213 221 214 222 type b = { name : string } 215 223 216 224 let name b = b.name 217 225 218 226 let b_jsont = 219 219 - Json.Object.map ~kind:"B" (fun name -> { name }) 220 220 - |> Json.Object.member "name" Json.Value.string ~enc:name 221 221 - |> Json.Object.error_unknown |> Json.Object.seal 227 227 + Json.Codec.Object.map ~kind:"B" (fun name -> { name }) 228 228 + |> Json.Codec.Object.member "name" Json.Codec.string ~enc:name 229 229 + |> Json.Codec.Object.error_unknown |> Json.Codec.Object.seal 222 230 223 231 type type' = A of a | B of b 224 232 ··· 243 251 let pp ppf v = B0_std.Fmt.string ppf "<value>" 244 252 245 253 let jsont = 246 246 - let case_a = Json.Object.Case.map "A" a_jsont ~dec:a in 247 247 - let case_b = Json.Object.Case.map "B" b_jsont ~dec:b in 248 248 - let cases = Json.Object.Case.[ make case_a; make case_b ] in 254 254 + let case_a = Json.Codec.Object.Case.map "A" a_jsont ~dec:a in 255 255 + let case_b = Json.Codec.Object.Case.map "B" b_jsont ~dec:b in 256 256 + let cases = Json.Codec.Object.Case.[ make case_a; make case_b ] in 249 257 let enc_case = function 250 250 - | A a -> Json.Object.Case.value case_a a 251 251 - | B b -> Json.Object.Case.value case_b b 258 258 + | A a -> Json.Codec.Object.Case.value case_a a 259 259 + | B b -> Json.Codec.Object.Case.value case_b b 252 260 in 253 253 - Json.Object.map ~kind:"Keep_unknown" make 254 254 - |> Json.Object.case_member "type" ~tag_to_string:Fun.id Json.Value.string 255 255 - ~enc:type' ~enc_case cases 256 256 - |> Json.Object.keep_unknown Json.json_mems ~enc:unknown 257 257 - |> Json.Object.seal 261 261 + Json.Codec.Object.map ~kind:"Keep_unknown" make 262 262 + |> Json.Codec.Object.case_member "type" ~tag_to_string:Fun.id 263 263 + Json.Codec.string ~enc:type' ~enc_case cases 264 264 + |> Json.Codec.Object.keep_unknown Json.Codec.Value.members ~enc:unknown 265 265 + |> Json.Codec.Object.seal 258 266 end 259 267 end 260 268 ··· 296 304 let unknown_a_value = 297 305 let unknown = 298 306 Json.Value.( 299 299 - object' [ mem (name "m0") (string "o"); mem (name "m1") (string "n") ]) 307 307 + object' 308 308 + [ member (name "m0") (string "o"); member (name "m1") (string "n") ]) 300 309 in 301 310 Cases.Keep_unknown.make (A String_map.empty) unknown 302 311 ··· 314 323 let unknown_b_value = 315 324 let unknown = 316 325 Json.Value.( 317 317 - object' [ mem (name "m1") (string "v1"); mem (name "m2") (number 0.0) ]) 326 326 + object' 327 327 + [ member (name "m1") (string "v1"); member (name "m2") (number 0.0) ]) 318 328 in 319 329 Cases.Keep_unknown.make (B { name = "ha" }) unknown 320 330 end ··· 340 350 let jsont_with_null t = 341 351 let rec tree = 342 352 lazy begin 343 343 - let empty = Json.Value.null Empty in 353 353 + let empty = Json.Codec.null Empty in 344 354 let node = 345 355 let not_a_node () = failwith "not a node" in 346 356 let value = function Node (_, v, _) -> v | _ -> not_a_node () in 347 357 let left = function Node (l, _, _) -> l | _ -> not_a_node () in 348 358 let right = function Node (_, _, r) -> r | _ -> not_a_node () in 349 349 - Json.Object.map ~kind:"node" (fun l v r -> Node (l, v, r)) 350 350 - |> Json.Object.member ~enc:left "left" (Json.fix tree) 351 351 - |> Json.Object.member ~enc:value "value" t 352 352 - |> Json.Object.member ~enc:right "right" (Json.fix tree) 353 353 - |> Json.Object.seal 359 359 + Json.Codec.Object.map ~kind:"node" (fun l v r -> Node (l, v, r)) 360 360 + |> Json.Codec.Object.member ~enc:left "left" (Json.Codec.fix tree) 361 361 + |> Json.Codec.Object.member ~enc:value "value" t 362 362 + |> Json.Codec.Object.member ~enc:right "right" (Json.Codec.fix tree) 363 363 + |> Json.Codec.Object.seal 354 364 in 355 365 let enc = function Empty -> empty | Node _ -> node in 356 356 - Json.any ~kind:"tree" ~dec_null:empty ~dec_object:node ~enc () 366 366 + Json.Codec.any ~kind:"tree" ~dec_null:empty ~dec_object:node ~enc () 357 367 end 358 368 in 359 369 Lazy.force tree ··· 370 380 let jsont_with_cases t = 371 381 let rec tree = 372 382 lazy begin 373 373 - let leaf_jsont = Json.Object.map Empty |> Json.Object.seal in 383 383 + let leaf_jsont = 384 384 + Json.Codec.Object.map Empty |> Json.Codec.Object.seal 385 385 + in 374 386 let node_jsont = 375 387 let not_a_node () = failwith "not a node" in 376 388 let value = function Node (_, v, _) -> v | _ -> not_a_node () in 377 389 let left = function Node (l, _, _) -> l | _ -> not_a_node () in 378 390 let right = function Node (_, _, r) -> r | _ -> not_a_node () in 379 379 - Json.Object.map (fun l v r -> Node (l, v, r)) 380 380 - |> Json.Object.member ~enc:left "left" (Json.fix tree) 381 381 - |> Json.Object.member ~enc:value "value" t 382 382 - |> Json.Object.member ~enc:right "right" (Json.fix tree) 383 383 - |> Json.Object.seal 391 391 + Json.Codec.Object.map (fun l v r -> Node (l, v, r)) 392 392 + |> Json.Codec.Object.member ~enc:left "left" (Json.Codec.fix tree) 393 393 + |> Json.Codec.Object.member ~enc:value "value" t 394 394 + |> Json.Codec.Object.member ~enc:right "right" (Json.Codec.fix tree) 395 395 + |> Json.Codec.Object.seal 396 396 + in 397 397 + let case_leaf = 398 398 + Json.Codec.Object.Case.map "empty" leaf_jsont ~dec:Fun.id 399 399 + in 400 400 + let case_node = 401 401 + Json.Codec.Object.Case.map "node" node_jsont ~dec:Fun.id 384 402 in 385 385 - let case_leaf = Json.Object.Case.map "empty" leaf_jsont ~dec:Fun.id in 386 386 - let case_node = Json.Object.Case.map "node" node_jsont ~dec:Fun.id in 387 403 let enc_case = function 388 388 - | Empty as v -> Json.Object.Case.value case_leaf v 389 389 - | Node _ as v -> Json.Object.Case.value case_node v 404 404 + | Empty as v -> Json.Codec.Object.Case.value case_leaf v 405 405 + | Node _ as v -> Json.Codec.Object.Case.value case_node v 390 406 in 391 391 - let cases = Json.Object.Case.[ make case_leaf; make case_node ] in 392 392 - Json.Object.map ~kind:"tree" Fun.id 393 393 - |> Json.Object.case_member "type" Json.Value.string ~enc:Fun.id 407 407 + let cases = Json.Codec.Object.Case.[ make case_leaf; make case_node ] in 408 408 + Json.Codec.Object.map ~kind:"tree" Fun.id 409 409 + |> Json.Codec.Object.case_member "type" Json.Codec.string ~enc:Fun.id 394 410 ~enc_case cases 395 395 - |> Json.Object.seal 411 411 + |> Json.Codec.Object.seal 396 412 end 397 413 in 398 414 Lazy.force tree

+86 -75

test/codecs/topojson.ml

reviewed

··· 10 10 module Position = struct 11 11 type t = float array 12 12 13 13 - let jsont = Json.(array ~kind:"Position" number) 13 13 + let jsont = Json.Codec.(array ~kind:"Position" number) 14 14 end 15 15 16 16 module Bbox = struct 17 17 type t = float array 18 18 19 19 - let jsont = Json.(array ~kind:"Bbox" number) 19 19 + let jsont = Json.Codec.(array ~kind:"Bbox" number) 20 20 end 21 21 22 22 module Arcs = struct 23 23 type t = Position.t array array 24 24 25 25 - let jsont = Json.(array ~kind:"Arcs" (array Position.jsont)) 25 25 + let jsont = Json.Codec.(array ~kind:"Arcs" (array Position.jsont)) 26 26 end 27 27 28 28 module Transform = struct ··· 36 36 let v2_jsont = 37 37 let dec x y = (x, y) in 38 38 let enc (x, y) i = if i = 0 then x else y in 39 39 - Json.t2 ~dec ~enc Json.Value.number 39 39 + Json.Codec.t2 ~dec ~enc Json.Codec.number 40 40 41 41 let jsont = 42 42 - Json.Object.map ~kind:"Transform" make 43 43 - |> Json.Object.member "scale" v2_jsont ~enc:scale 44 44 - |> Json.Object.member "translate" v2_jsont ~enc:translate 45 45 - |> Json.Object.seal 42 42 + Json.Codec.Object.map ~kind:"Transform" make 43 43 + |> Json.Codec.Object.member "scale" v2_jsont ~enc:scale 44 44 + |> Json.Codec.Object.member "translate" v2_jsont ~enc:translate 45 45 + |> Json.Codec.Object.seal 46 46 end 47 47 48 48 module Point = struct ··· 52 52 let coordinates v = v.coordinates 53 53 54 54 let jsont = 55 55 - Json.Object.map ~kind:"Point" make 56 56 - |> Json.Object.member "coordinates" Position.jsont ~enc:coordinates 57 57 - |> Json.Object.seal 55 55 + Json.Codec.Object.map ~kind:"Point" make 56 56 + |> Json.Codec.Object.member "coordinates" Position.jsont ~enc:coordinates 57 57 + |> Json.Codec.Object.seal 58 58 end 59 59 60 60 module Multi_point = struct ··· 64 64 let coordinates v = v.coordinates 65 65 66 66 let jsont = 67 67 - Json.Object.map ~kind:"MultiPoint" make 68 68 - |> Json.Object.member "coordinates" 69 69 - (Json.Value.list Position.jsont) 67 67 + Json.Codec.Object.map ~kind:"MultiPoint" make 68 68 + |> Json.Codec.Object.member "coordinates" 69 69 + (Json.Codec.list Position.jsont) 70 70 ~enc:coordinates 71 71 - |> Json.Object.seal 71 71 + |> Json.Codec.Object.seal 72 72 end 73 73 74 74 module Line_string = struct ··· 78 78 let arcs v = v.arcs 79 79 80 80 let jsont = 81 81 - Json.Object.map ~kind:"LineString" make 82 82 - |> Json.Object.member "arcs" Json.(list int32) ~enc:arcs 83 83 - |> Json.Object.seal 81 81 + Json.Codec.Object.map ~kind:"LineString" make 82 82 + |> Json.Codec.Object.member "arcs" Json.Codec.(list int32) ~enc:arcs 83 83 + |> Json.Codec.Object.seal 84 84 end 85 85 86 86 module Multi_line_string = struct ··· 90 90 let arcs v = v.arcs 91 91 92 92 let jsont = 93 93 - Json.Object.map ~kind:"MultiLineString" make 94 94 - |> Json.Object.member "arcs" Json.(list (list int32)) ~enc:arcs 95 95 - |> Json.Object.seal 93 93 + Json.Codec.Object.map ~kind:"MultiLineString" make 94 94 + |> Json.Codec.Object.member "arcs" Json.Codec.(list (list int32)) ~enc:arcs 95 95 + |> Json.Codec.Object.seal 96 96 end 97 97 98 98 module Polygon = struct ··· 102 102 let arcs v = v.arcs 103 103 104 104 let jsont = 105 105 - Json.Object.map ~kind:"Polygon" make 106 106 - |> Json.Object.member "arcs" Json.(list (list int32)) ~enc:arcs 107 107 - |> Json.Object.seal 105 105 + Json.Codec.Object.map ~kind:"Polygon" make 106 106 + |> Json.Codec.Object.member "arcs" Json.Codec.(list (list int32)) ~enc:arcs 107 107 + |> Json.Codec.Object.seal 108 108 end 109 109 110 110 module Multi_polygon = struct ··· 114 114 let arcs v = v.arcs 115 115 116 116 let jsont = 117 117 - Json.Object.map ~kind:"MultiPolygon" make 118 118 - |> Json.Object.member "arcs" Json.(list (list (list int32))) ~enc:arcs 119 119 - |> Json.Object.seal 117 117 + Json.Codec.Object.map ~kind:"MultiPolygon" make 118 118 + |> Json.Codec.Object.member "arcs" 119 119 + Json.Codec.(list (list (list int32))) 120 120 + ~enc:arcs 121 121 + |> Json.Codec.Object.seal 120 122 end 121 123 122 124 module Geometry = struct ··· 124 126 125 127 let id_jsont = 126 128 let number = 127 127 - let dec = Json.Base.dec (fun n -> `Number n) in 128 128 - let enc = Json.Base.enc (function `Number n -> n | _ -> assert false) in 129 129 - Json.Base.number (Json.Base.map ~enc ~dec ()) 129 129 + let dec = Json.Codec.Base.dec (fun n -> `Number n) in 130 130 + let enc = 131 131 + Json.Codec.Base.enc (function `Number n -> n | _ -> assert false) 132 132 + in 133 133 + Json.Codec.Base.number (Json.Codec.Base.map ~enc ~dec ()) 130 134 in 131 135 let string = 132 132 - let dec = Json.Base.dec (fun n -> `String n) in 133 133 - let enc = Json.Base.enc (function `String n -> n | _ -> assert false) in 134 134 - Json.Base.string (Json.Base.map ~enc ~dec ()) 136 136 + let dec = Json.Codec.Base.dec (fun n -> `String n) in 137 137 + let enc = 138 138 + Json.Codec.Base.enc (function `String n -> n | _ -> assert false) 139 139 + in 140 140 + Json.Codec.Base.string (Json.Codec.Base.map ~enc ~dec ()) 135 141 in 136 142 let enc = function `Number _ -> number | `String _ -> string in 137 137 - Json.any ~kind:"id" ~dec_number:number ~dec_string:string ~enc () 143 143 + Json.Codec.any ~kind:"id" ~dec_number:number ~dec_string:string ~enc () 138 144 139 145 type t = { 140 146 type' : type'; 141 147 id : id option; 142 142 - properties : Json.json String_map.t option; 148 148 + properties : Json.t String_map.t option; 143 149 bbox : Bbox.t option; 144 150 unknown : Json.t; 145 151 } ··· 168 174 let polygon v = Polygon v 169 175 let multi_polygon v = Multi_polygon v 170 176 let collection vs = Geometry_collection vs 171 171 - let properties_type = Json.Object.as_string_map ~kind:"properties" Json.t 177 177 + 178 178 + let properties_type = 179 179 + Json.Codec.Object.as_string_map ~kind:"properties" Json.Codec.Value.t 172 180 173 181 let rec collection_jsont = 174 182 lazy begin 175 175 - Json.Object.map ~kind:"GeometryCollection" Fun.id 176 176 - |> Json.Object.member "geometries" 177 177 - (Json.Value.list (Json.fix jsont)) 183 183 + Json.Codec.Object.map ~kind:"GeometryCollection" Fun.id 184 184 + |> Json.Codec.Object.member "geometries" 185 185 + (Json.Codec.list (Json.Codec.fix jsont)) 178 186 ~enc:Fun.id 179 179 - |> Json.Object.seal 187 187 + |> Json.Codec.Object.seal 180 188 end 181 189 182 190 and jsont = 183 191 lazy begin 184 184 - let case_map obj dec = Json.Object.Case.map (Json.kind obj) obj ~dec in 192 192 + let case_map obj dec = 193 193 + Json.Codec.Object.Case.map (Json.Codec.kind obj) obj ~dec 194 194 + in 185 195 let case_point = case_map Point.jsont point in 186 196 let case_multi_point = case_map Multi_point.jsont multi_point in 187 197 let case_line_string = case_map Line_string.jsont line_string in ··· 190 200 let case_multi_polygon = case_map Multi_polygon.jsont multi_polygon in 191 201 let case_coll = case_map (Lazy.force collection_jsont) collection in 192 202 let enc_case = function 193 193 - | Point p -> Json.Object.Case.value case_point p 194 194 - | Multi_point m -> Json.Object.Case.value case_multi_point m 195 195 - | Line_string l -> Json.Object.Case.value case_line_string l 196 196 - | Multi_line_string m -> Json.Object.Case.value case_multi_linestr m 197 197 - | Polygon p -> Json.Object.Case.value case_polygon p 198 198 - | Multi_polygon m -> Json.Object.Case.value case_multi_polygon m 199 199 - | Geometry_collection gs -> Json.Object.Case.value case_coll gs 203 203 + | Point p -> Json.Codec.Object.Case.value case_point p 204 204 + | Multi_point m -> Json.Codec.Object.Case.value case_multi_point m 205 205 + | Line_string l -> Json.Codec.Object.Case.value case_line_string l 206 206 + | Multi_line_string m -> 207 207 + Json.Codec.Object.Case.value case_multi_linestr m 208 208 + | Polygon p -> Json.Codec.Object.Case.value case_polygon p 209 209 + | Multi_polygon m -> Json.Codec.Object.Case.value case_multi_polygon m 210 210 + | Geometry_collection gs -> Json.Codec.Object.Case.value case_coll gs 200 211 and cases = 201 201 - Json.Object.Case. 212 212 + Json.Codec.Object.Case. 202 213 [ 203 214 make case_point; 204 215 make case_multi_point; ··· 209 220 make case_coll; 210 221 ] 211 222 in 212 212 - Json.Object.map ~kind:"Geometry" make 213 213 - |> Json.Object.case_member "type" Json.Value.string ~enc:type' ~enc_case 214 214 - cases ~tag_to_string:Fun.id ~tag_compare:String.compare 215 215 - |> Json.Object.opt_member "id" id_jsont ~enc:id 216 216 - |> Json.Object.opt_member "properties" properties_type ~enc:properties 217 217 - |> Json.Object.opt_member "bbox" Bbox.jsont ~enc:bbox 218 218 - |> Json.Object.keep_unknown Json.json_mems ~enc:unknown 219 219 - |> Json.Object.seal 223 223 + Json.Codec.Object.map ~kind:"Geometry" make 224 224 + |> Json.Codec.Object.case_member "type" Json.Codec.string ~enc:type' 225 225 + ~enc_case cases ~tag_to_string:Fun.id ~tag_compare:String.compare 226 226 + |> Json.Codec.Object.opt_member "id" id_jsont ~enc:id 227 227 + |> Json.Codec.Object.opt_member "properties" properties_type 228 228 + ~enc:properties 229 229 + |> Json.Codec.Object.opt_member "bbox" Bbox.jsont ~enc:bbox 230 230 + |> Json.Codec.Object.keep_unknown Json.Codec.Value.members ~enc:unknown 231 231 + |> Json.Codec.Object.seal 220 232 end 221 233 222 234 let jsont = Lazy.force jsont 223 235 224 236 type objects = t String_map.t 225 237 226 226 - let objects_jsont = Json.Object.as_string_map ~kind:"objects map" jsont 238 238 + let objects_jsont = Json.Codec.Object.as_string_map ~kind:"objects map" jsont 227 239 end 228 240 229 241 module Topology = struct ··· 246 258 247 259 let jsont = 248 260 let kind = "Topology" in 249 249 - Json.Object.map ~kind (fun () -> make) 250 250 - |> Json.Object.member "type" (Json.enum [ (kind, ()) ]) ~enc:(Fun.const ()) 251 251 - |> Json.Object.member "objects" Geometry.objects_jsont ~enc:objects 252 252 - |> Json.Object.member "arcs" Arcs.jsont ~enc:arcs 253 253 - |> Json.Object.opt_member "transform" Transform.jsont ~enc:transform 254 254 - |> Json.Object.opt_member "bbox" Bbox.jsont ~enc:bbox 255 255 - |> Json.Object.keep_unknown Json.json_mems ~enc:unknown 256 256 - |> Json.Object.seal 261 261 + Json.Codec.Object.map ~kind (fun () -> make) 262 262 + |> Json.Codec.Object.member "type" 263 263 + (Json.Codec.enum [ (kind, ()) ]) 264 264 + ~enc:(Fun.const ()) 265 265 + |> Json.Codec.Object.member "objects" Geometry.objects_jsont ~enc:objects 266 266 + |> Json.Codec.Object.member "arcs" Arcs.jsont ~enc:arcs 267 267 + |> Json.Codec.Object.opt_member "transform" Transform.jsont ~enc:transform 268 268 + |> Json.Codec.Object.opt_member "bbox" Bbox.jsont ~enc:bbox 269 269 + |> Json.Codec.Object.keep_unknown Json.Codec.Value.members ~enc:unknown 270 270 + |> Json.Codec.Object.seal 257 271 end 258 272 259 273 (* Command line interface *) ··· 282 296 | file -> In_channel.with_open_bin file (process file) 283 297 with Sys_error e -> Error e 284 298 285 285 - let trip ~file ~format ~locs ~dec_only = 299 299 + let trip ~file ~indent ~locs ~dec_only = 286 300 log_if_error ~use:1 @@ with_infile file 287 301 @@ fun r -> 288 302 log_if_error ~use:1 ··· 291 305 if dec_only then Ok 0 292 306 else 293 307 let w = Bytesrw.Bytes.Writer.of_out_channel stdout in 294 294 - let* () = Json.to_writer ~format ~eod:true Topology.jsont t w in 308 308 + Json.to_writer ?indent ~eod:true Topology.jsont t w; 295 309 Ok 0 296 310 297 311 open Cmdliner ··· 306 320 and+ locs = 307 321 let doc = "Preserve locations (better errors)." in 308 322 Arg.(value & flag & info [ "l"; "locs" ] ~doc) 309 309 - and+ format = 310 310 - let fmt = [ ("indent", Json.Indent); ("minify", Json.Minify) ] in 323 323 + and+ indent = 324 324 + let fmt = [ ("indent", Some 2); ("minify", None) ] in 311 325 let doc = strf "Output style. Must be %s." (Arg.doc_alts_enum fmt) in 312 312 - Arg.( 313 313 - value 314 314 - & opt (enum fmt) Json.Minify 315 315 - & info [ "f"; "format" ] ~doc ~docv:"FMT") 326 326 + Arg.(value & opt (enum fmt) None & info [ "f"; "format" ] ~doc ~docv:"FMT") 316 327 and+ dec_only = 317 328 let doc = "Decode only." in 318 329 Arg.(value & flag & info [ "d" ] ~doc) 319 330 in 320 320 - trip ~file ~format ~locs ~dec_only 331 331 + trip ~file ~indent ~locs ~dec_only 321 332 322 333 let main () = Cmd.eval' topojson 323 334 let () = if !Sys.interactive then () else exit (main ())

+4 -4

test/codecs/trials.ml

reviewed

··· 11 11 let public msg = msg.public 12 12 13 13 let jsont : t Json.codec = 14 14 - Json.Object.map make 15 15 - |> Json.Object.member "content" Json.Value.string ~enc:content 16 16 - |> Json.Object.member "public" Json.Value.bool ~enc:public 17 17 - |> Json.Object.seal 14 14 + Json.Codec.Object.map make 15 15 + |> Json.Codec.Object.member "content" Json.Codec.string ~enc:content 16 16 + |> Json.Codec.Object.member "public" Json.Codec.bool ~enc:public 17 17 + |> Json.Codec.Object.seal 18 18 end 19 19 20 20 type ('ret, 'f) app =