ocaml-json: fix codec/t mismatch between Repr sig and impl

+2 -2

lib/bytesrw/json_bytesrw.ml

··· 898 898 try 899 899 let t = Json.Repr.unsafe_to_t m.type' in 900 900 let v = 901 - match Json.Json.decode' t v with 901 + match Json.Value.decode' t v with 902 902 | Ok v -> v 903 903 | Error e -> raise_notrace (Json.Error e) 904 904 in ··· 949 949 try 950 950 let t = Json.Repr.unsafe_to_t umap.mems_type in 951 951 let v = 952 - match Json.Json.decode' t v with 952 + match Json.Value.decode' t v with 953 953 | Ok v -> v 954 954 | Error e -> raise_notrace (Json.Error e) 955 955 in

+51 -51

lib/json.ml

··· 1622 1622 | Ignore -> () 1623 1623 1624 1624 and decode_array : type a elt b. 1625 - (a, elt, b) array_map -> Meta.t -> t list -> a = 1625 + (a, elt, b) array_map -> Meta.t -> json list -> a = 1626 1626 fun map meta vs -> 1627 1627 let rec next (map : (a, elt, b) array_map) meta b i = function 1628 1628 | [] -> map.dec_finish meta i b ··· 1768 1768 decode_object_cases map meta umems cases mem_miss mem_decs dict 1769 1769 delay mems) 1770 1770 1771 - and decode_any : type a. a Repr.t -> a any_map -> t -> a = 1771 + and decode_any : type a. a Repr.t -> a any_map -> json -> a = 1772 1772 fun t map j -> 1773 1773 let dec t map j = 1774 1774 match map with Some t -> decode t j | None -> error_type t j ··· 1787 1787 1788 1788 (* Encode *) 1789 1789 1790 - let rec encode : type a. a Repr.t -> a -> t = 1790 + let rec encode : type a. a Repr.t -> a -> json = 1791 1791 fun t v -> 1792 1792 match t with 1793 1793 | Null map -> null ~meta:(map.enc_meta v) (map.enc v) ··· 1869 1869 end 1870 1870 1871 1871 let json_null = 1872 - let dec meta () = Json.null ~meta () in 1872 + let dec meta () = Value.null ~meta () in 1873 1873 let enc = function 1874 1874 | Null ((), _) -> () 1875 - | j -> Json.error_sort ~exp:Sort.Null j 1875 + | j -> Value.error_sort ~exp:Sort.Null j 1876 1876 in 1877 - Repr.Null (Base.map ~dec ~enc ~enc_meta:Json.meta ()) 1877 + Repr.Null (Base.map ~dec ~enc ~enc_meta:Value.meta ()) 1878 1878 1879 1879 let json_bool = 1880 - let dec meta b = Json.bool ~meta b in 1880 + let dec meta b = Value.bool ~meta b in 1881 1881 let enc = function 1882 1882 | Bool (b, _) -> b 1883 - | j -> Json.error_sort ~exp:Sort.Bool j 1883 + | j -> Value.error_sort ~exp:Sort.Bool j 1884 1884 in 1885 - Repr.Bool (Base.map ~dec ~enc ~enc_meta:Json.meta ()) 1885 + Repr.Bool (Base.map ~dec ~enc ~enc_meta:Value.meta ()) 1886 1886 1887 1887 let json_number = 1888 - let dec meta n = Json.number ~meta n in 1888 + let dec meta n = Value.number ~meta n in 1889 1889 let enc = function 1890 1890 | Number (n, _) -> n 1891 - | j -> Json.error_sort ~exp:Sort.Number j 1891 + | j -> Value.error_sort ~exp:Sort.Number j 1892 1892 in 1893 - Repr.Number (Base.map ~dec ~enc ~enc_meta:Json.meta ()) 1893 + Repr.Number (Base.map ~dec ~enc ~enc_meta:Value.meta ()) 1894 1894 1895 1895 let json_string = 1896 - let dec meta s = Json.string ~meta s in 1896 + let dec meta s = Value.string ~meta s in 1897 1897 let enc = function 1898 1898 | String (s, _) -> s 1899 - | j -> Json.error_sort ~exp:Sort.String j 1899 + | j -> Value.error_sort ~exp:Sort.String j 1900 1900 in 1901 - Repr.String (Base.map ~dec ~enc ~enc_meta:Json.meta ()) 1901 + Repr.String (Base.map ~dec ~enc ~enc_meta:Value.meta ()) 1902 1902 1903 1903 let json, json_array, mem_list, json_object = 1904 1904 let rec elt = Repr.Rec any ··· 1906 1906 lazy begin 1907 1907 let dec_empty () = [] in 1908 1908 let dec_add _i v a = v :: a in 1909 - let dec_finish meta _len a = Json.list ~meta (List.rev a) in 1909 + let dec_finish meta _len a = Value.list ~meta (List.rev a) in 1910 1910 let enc f acc = function 1911 1911 | Array (a, _) -> Array.list_enc f acc a 1912 - | j -> Json.error_sort ~exp:Sort.Array j 1912 + | j -> Value.error_sort ~exp:Sort.Array j 1913 1913 in 1914 1914 let enc = { Array.enc } in 1915 - Array.map ~dec_empty ~dec_add ~dec_finish ~enc ~enc_meta:Json.meta elt 1915 + Array.map ~dec_empty ~dec_add ~dec_finish ~enc ~enc_meta:Value.meta elt 1916 1916 end 1917 1917 and array = lazy (Array.array (Lazy.force array_map)) 1918 1918 and mems = ··· 1928 1928 lazy begin 1929 1929 let enc_meta = function 1930 1930 | Object (_, meta) -> meta 1931 - | j -> Json.error_sort ~exp:Sort.Object j 1931 + | j -> Value.error_sort ~exp:Sort.Object j 1932 1932 in 1933 1933 let enc = function 1934 1934 | Object (mems, _) -> mems 1935 - | j -> Json.error_sort ~exp:Sort.Object j 1935 + | j -> Value.error_sort ~exp:Sort.Object j 1936 1936 in 1937 1937 let dec meta mems = Object (mems, meta) in 1938 1938 Object.map' dec ~enc_meta ··· 1975 1975 match j with 1976 1976 | Object (ms, _) -> 1977 1977 List.fold_left (fun acc ((n, m), v) -> f m n v acc) acc ms 1978 - | j -> Json.error_sort ~exp:Sort.Object j 1978 + | j -> Value.error_sort ~exp:Sort.Object j 1979 1979 in 1980 1980 let enc = { Object.Mems.enc } in 1981 1981 Object.Mems.map ~dec_empty ~dec_add ~dec_finish ~enc json ··· 2002 2002 ~dec_object:m ~enc () 2003 2003 2004 2004 let update t = 2005 - let dec v = Json.update t v in 2005 + let dec v = Value.update t v in 2006 2006 Repr.Map { kind = ""; doc = ""; dom = json; dec; enc = Fun.id } 2007 2007 2008 2008 (* Array queries *) ··· 2026 2026 Array.array (Array.map ~dec_empty ~dec_skip ~dec_add ~dec_finish ~enc t) 2027 2027 2028 2028 let update_nth ?stub ?absent n t = 2029 - let update_elt n t v = Json.copy_layout v ~dst:(Json.update t v) in 2029 + let update_elt n t v = Value.copy_layout v ~dst:(Value.update t v) in 2030 2030 let rec update_array ~seen n t i acc = function 2031 2031 | v :: vs when i = n -> 2032 - let elt = update_elt (i, Json.meta v) t v in 2032 + let elt = update_elt (i, Value.meta v) t v in 2033 2033 update_array ~seen:true n t (i + 1) (elt :: acc) vs 2034 2034 | v :: vs -> update_array ~seen n t (i + 1) (v :: acc) vs 2035 2035 | [] when seen -> Either.Right (List.rev acc) ··· 2044 2044 match absent with 2045 2045 | None -> Error.index_out_of_range meta ~n ~len 2046 2046 | Some absent -> 2047 - let elt = Json.enc t absent in 2047 + let elt = Value.enc t absent in 2048 2048 let stub = 2049 - match stub with None -> Json.zero elt | Some j -> j 2049 + match stub with None -> Value.zero elt | Some j -> j 2050 2050 in 2051 2051 Array (List.rev (elt :: list_repeat (n - len) stub acc), meta)) 2052 2052 end 2053 - | j -> Json.error_sort ~exp:Sort.Array j 2053 + | j -> Value.error_sort ~exp:Sort.Array j 2054 2054 in 2055 2055 let dec = update ?stub ?absent n t in 2056 2056 let enc j = j in ··· 2064 2064 let dec_empty () = [] in 2065 2065 let dec_add i v a = if i = n then a else v :: a in 2066 2066 let dec_finish meta len a = 2067 - if n < len || allow_absent then Json.list ~meta (List.rev a) 2067 + if n < len || allow_absent then Value.list ~meta (List.rev a) 2068 2068 else Error.index_out_of_range meta ~n ~len 2069 2069 in 2070 2070 let enc f acc = function 2071 2071 | Array (a, _) -> Array.list_enc f acc a 2072 - | j -> Json.error_sort ~exp:Sort.Array j 2072 + | j -> Value.error_sort ~exp:Sort.Array j 2073 2073 in 2074 - let enc_meta j = Json.meta j in 2074 + let enc_meta j = Value.meta j in 2075 2075 let enc = { Array.enc } in 2076 2076 Array.array (Array.map ~dec_empty ~dec_add ~dec_finish ~enc ~enc_meta json) 2077 2077 2078 2078 let filter_map_array a b f = 2079 2079 let dec_empty () = [] in 2080 2080 let dec_add i v acc = 2081 - match f i (Json.dec a v) with 2081 + match f i (Value.dec a v) with 2082 2082 | None -> acc 2083 - | Some v' -> Json.enc b v' :: acc 2083 + | Some v' -> Value.enc b v' :: acc 2084 2084 in 2085 - let dec_finish meta _len acc = Json.list ~meta (List.rev acc) in 2085 + let dec_finish meta _len acc = Value.list ~meta (List.rev acc) in 2086 2086 let enc f acc = function 2087 2087 | Array (a, _) -> Array.list_enc f acc a 2088 - | j -> Json.error_sort ~exp:Sort.Array j 2088 + | j -> Value.error_sort ~exp:Sort.Array j 2089 2089 in 2090 2090 let enc = { Array.enc } in 2091 - let enc_meta j = Json.meta j in 2091 + let enc_meta j = Value.meta j in 2092 2092 Array.array (Array.map ~dec_empty ~dec_add ~dec_finish ~enc ~enc_meta json) 2093 2093 2094 2094 let fold_array t f acc = ··· 2107 2107 |> Object.finish 2108 2108 2109 2109 let update_mem ?absent name t = 2110 - let update_mem n t v = (n, Json.copy_layout v ~dst:(Json.update t v)) in 2110 + let update_mem n t v = (n, Value.copy_layout v ~dst:(Value.update t v)) in 2111 2111 let rec update_object ~seen name t acc = function 2112 2112 | (((name', _) as n), v) :: mems when String.equal name name' -> 2113 2113 update_object ~seen:true name t (update_mem n t v :: acc) mems ··· 2123 2123 | Either.Left acc -> ( 2124 2124 match absent with 2125 2125 | None -> 2126 - let fnd = Json.object_names mems in 2126 + let fnd = Value.object_names mems in 2127 2127 Error.missing_mems meta ~kinded_sort:"" ~exp:[ name ] ~fnd 2128 2128 | Some absent -> 2129 - let m = ((name, Meta.none), Json.enc t absent) in 2129 + let m = ((name, Meta.none), Value.enc t absent) in 2130 2130 List.rev (m :: acc)) 2131 2131 in 2132 2132 Object (mems, meta) 2133 - | j -> Json.error_sort ~exp:Sort.Object j 2133 + | j -> Value.error_sort ~exp:Sort.Object j 2134 2134 in 2135 2135 let update = update ?absent name t in 2136 2136 let enc j = j in ··· 2149 2149 in 2150 2150 let enc_meta = function 2151 2151 | Object (_, meta) -> meta 2152 - | j -> Json.error_sort ~exp:Sort.Object j 2152 + | j -> Value.error_sort ~exp:Sort.Object j 2153 2153 in 2154 2154 let enc = function 2155 2155 | Object (mems, _) -> (false, mems) 2156 - | j -> Json.error_sort ~exp:Sort.Object j 2156 + | j -> Value.error_sort ~exp:Sort.Object j 2157 2157 in 2158 2158 let dec meta (ok, mems) = 2159 - let fnd = Json.object_names mems in 2159 + let fnd = Value.object_names mems in 2160 2160 if not ok then Error.missing_mems meta ~kinded_sort:"" ~exp:[ name ] ~fnd 2161 2161 else Object (List.rev mems, meta) 2162 2162 in ··· 2181 2181 2182 2182 let filter_map_object a b f = 2183 2183 let dec_add meta n v (_, mems) = 2184 - match f meta n (Json.dec a v) with 2184 + match f meta n (Value.dec a v) with 2185 2185 | None -> (true, mems) 2186 - | Some (n', v') -> (true, (n', Json.enc b v') :: mems) 2186 + | Some (n', v') -> (true, (n', Value.enc b v') :: mems) 2187 2187 in 2188 2188 let dec_finish _meta acc = acc in 2189 2189 update_json_object ~name:"" (* irrelevant *) ~dec_add ~dec_finish ··· 2225 2225 | Some absent -> ( 2226 2226 let rec loop absent t = function 2227 2227 | Path.Nth (n, _) :: is -> 2228 - loop Json.empty_array (update_nth ~absent n t) is 2228 + loop Value.empty_array (update_nth ~absent n t) is 2229 2229 | Path.Mem (n, _) :: is -> 2230 - loop Json.empty_object (update_mem ~absent n t) is 2230 + loop Value.empty_object (update_mem ~absent n t) is 2231 2231 | [] -> t 2232 2232 in 2233 2233 match i with 2234 2234 | Path.Nth (n, _) -> 2235 - loop Json.empty_array (update_nth ?stub ~absent n t) is 2235 + loop Value.empty_array (update_nth ?stub ~absent n t) is 2236 2236 | Path.Mem (n, _) -> 2237 - loop Json.empty_object (update_mem ~absent n t) is)) 2237 + loop Value.empty_object (update_mem ~absent n t) is)) 2238 2238 2239 2239 let delete_path ?allow_absent p = 2240 2240 match Path.rev_indices p with 2241 - | [] -> recode ~dec:ignore (fun () -> Json.null') ~enc:json 2241 + | [] -> recode ~dec:ignore (fun () -> Value.null') ~enc:json 2242 2242 | i :: is -> 2243 2243 let upd del i = update_index i del in 2244 2244 List.fold_left upd (delete_index ?allow_absent i) is 2245 2245 2246 2246 let set_path ?stub ?(allow_absent = false) t p v = 2247 2247 match Path.rev_indices p with 2248 - | [] -> recode ~dec:ignore (fun () -> Json.enc t v) ~enc:json 2248 + | [] -> recode ~dec:ignore (fun () -> Value.enc t v) ~enc:json 2249 2249 | i :: is -> 2250 2250 let absent = if allow_absent then Some v else None in 2251 2251 update_path ?stub ?absent p (const t v) ··· 2259 2259 2260 2260 let pp_value ?number_format t () = 2261 2261 fun ppf v -> 2262 - match Json.encode t v with 2262 + match Value.encode t v with 2263 2263 | Ok j -> pp_json' ?number_format () ppf j 2264 2264 | Error e -> pp_string ppf e

+28 -29

lib/json.mli

··· 1450 1450 (** {1:types JSON types} *) 1451 1451 1452 1452 (** The type for JSON types. *) 1453 - type 'a codec = 1454 - | Null : (unit, 'a) base_map -> 'a codec (** Null maps. *) 1455 - | Bool : (bool, 'a) base_map -> 'a codec (** Boolean maps. *) 1456 - | Number : (float, 'a) base_map -> 'a codec (** Number maps. *) 1457 - | String : (string, 'a) base_map -> 'a codec (** String maps. *) 1458 - | Array : ('a, 'elt, 'builder) array_map -> 'a codec (** Array maps. *) 1459 - | Object : ('o, 'o) object_map -> 'o codec (** Object maps. *) 1460 - | Any : 'a any_map -> 'a codec 1461 - (** Map for different sorts of JSON values. *) 1462 - | Map : ('b, 'a) map -> 'a codec 1453 + type 'a t = 1454 + | Null : (unit, 'a) base_map -> 'a t (** Null maps. *) 1455 + | Bool : (bool, 'a) base_map -> 'a t (** Boolean maps. *) 1456 + | Number : (float, 'a) base_map -> 'a t (** Number maps. *) 1457 + | String : (string, 'a) base_map -> 'a t (** String maps. *) 1458 + | Array : ('a, 'elt, 'builder) array_map -> 'a t (** Array maps. *) 1459 + | Object : ('o, 'o) object_map -> 'o t (** Object maps. *) 1460 + | Any : 'a any_map -> 'a t (** Map for different sorts of JSON values. *) 1461 + | Map : ('b, 'a) map -> 'a t 1463 1462 (** Map from JSON type ['b] to JSON type ['a]. *) 1464 - | Rec : 'a codec Lazy.t -> 'a codec (** Recursive definition. *) 1465 - | Ignore : unit codec 1463 + | Rec : 'a t Lazy.t -> 'a t (** Recursive definition. *) 1464 + | Ignore : unit t 1466 1465 (** Skip-parse any JSON value. The bytesrw decoder consumes the value at 1467 1466 the byte level without materialising strings, numbers or nested DOM; 1468 1467 this is the fast path for {!Json.ignore}. *) ··· 1472 1471 and ('array, 'elt, 'builder) array_map = { 1473 1472 kind : string; (** The kind of JSON array mapped (documentation). *) 1474 1473 doc : string; (** Documentation string for the JSON array. *) 1475 - elt : 'elt codec; (** The type for the array elements. *) 1474 + elt : 'elt t; (** The type for the array elements. *) 1476 1475 dec_empty : unit -> 'builder; 1477 1476 (** [dec_empty ()] creates a new empty array builder. *) 1478 1477 dec_skip : int -> 'builder -> bool; ··· 1525 1524 and ('o, 'a) mem_map = { 1526 1525 name : string; (** The JSON member name. *) 1527 1526 doc : string; (** Documentation for the JSON member. *) 1528 - type' : 'a codec; (** The type for the member value. *) 1527 + type' : 'a t; (** The type for the member value. *) 1529 1528 id : 'a Type.Id.t; 1530 1529 (** A type identifier for the member. This allows to store the decode in 1531 1530 a {!Dict.t} on decode and give it in time to the object decoding ··· 1573 1572 and ('mems, 'a, 'builder) mems_map = { 1574 1573 kind : string; (** The kind for unknown members (documentation). *) 1575 1574 doc : string; (** Documentation string for the unknown members. *) 1576 - mems_type : 'a codec; 1575 + mems_type : 'a t; 1577 1576 (** The uniform type according which unknown members are typed. *) 1578 1577 id : 'mems Type.Id.t; (** A type identifier for the unknown member map. *) 1579 1578 dec_empty : unit -> 'builder; ··· 1641 1640 and 'a any_map = { 1642 1641 kind : string; (** The kind of JSON values mapped (documentation). *) 1643 1642 doc : string; (** Documentation string for the kind of values. *) 1644 - dec_null : 'a codec option; 1643 + dec_null : 'a t option; 1645 1644 (** [dec_null], if any, is used for decoding JSON nulls. *) 1646 - dec_bool : 'a codec option; 1645 + dec_bool : 'a t option; 1647 1646 (** [dec_bool], if any, is used for decoding JSON bools. *) 1648 - dec_number : 'a codec option; 1647 + dec_number : 'a t option; 1649 1648 (** [dec_number], if any, is used for decoding JSON numbers. *) 1650 - dec_string : 'a codec option; 1649 + dec_string : 'a t option; 1651 1650 (** [dec_string], if any, is used for decoding JSON strings. *) 1652 - dec_array : 'a codec option; 1651 + dec_array : 'a t option; 1653 1652 (** [dec_array], if any, is used for decoding JSON arrays. *) 1654 - dec_object : 'a codec option; 1653 + dec_object : 'a t option; 1655 1654 (** [dec_object], if any, is used for decoding JSON objects. *) 1656 - enc : 'a -> 'a codec; 1655 + enc : 'a -> 'a t; 1657 1656 (** [enc] specifies the encoder to use on a given value. *) 1658 1657 } 1659 1658 (** The type for mapping JSON values with multiple sorts to a value of type ··· 1665 1664 and ('a, 'b) map = { 1666 1665 kind : string; (** The kind of JSON values mapped (documentation). *) 1667 1666 doc : string; (** Documentation string for the kind of values. *) 1668 - dom : 'a codec; (** The domain of the map. *) 1667 + dom : 'a t; (** The domain of the map. *) 1669 1668 dec : 'a -> 'b; (** [dec] decodes ['a] to ['b]. *) 1670 1669 enc : 'b -> 'a; (** [enc] encodes ['b] to ['a]. *) 1671 1670 } ··· 1674 1673 1675 1674 (** {1:conv Convert} *) 1676 1675 1677 - val of_t : 'a t' -> 'a codec 1676 + val of_t : 'a t' -> 'a t 1678 1677 (** [of_t] is {!Stdlib.Fun.id}. *) 1679 1678 1680 - val unsafe_to_t : 'a codec -> 'a t' 1679 + val unsafe_to_t : 'a t -> 'a t' 1681 1680 (** [unsafe_to_t r] converts the representation to a type [r]. It is unsafe 1682 1681 because constructors of the {!Json} module do maintain some invariants. *) 1683 1682 1684 1683 (** {1:kinds Kinds and doc} *) 1685 1684 1686 - val kinded_sort : 'a codec -> string 1685 + val kinded_sort : 'a t -> string 1687 1686 (** [kinded_sort t] is kinded sort of [t], see {!Json.kinded_sort}. *) 1688 1687 1689 1688 val array_map_kinded_sort : ('a, 'elt, 'builder) array_map -> string ··· 1697 1696 val pp_kind : string fmt 1698 1697 (** [pp_kind] formats kinds. *) 1699 1698 1700 - val doc : 'a codec -> string 1699 + val doc : 'a t -> string 1701 1700 (** See {!Json.doc}. *) 1702 1701 1703 - val with_doc : ?kind:string -> ?doc:string -> 'a codec -> 'a codec 1702 + val with_doc : ?kind:string -> ?doc:string -> 'a t -> 'a t 1704 1703 (** See {!Json.with_doc}. *) 1705 1704 1706 1705 (** {1:errors Errors} *) ··· 1715 1714 (** [error_push_object] is like {!Error.push_object} but uses the given object 1716 1715 [meta] and object map to caracterize the context. *) 1717 1716 1718 - val type_error : Meta.t -> 'a codec -> fnd:Sort.t -> 'b 1717 + val type_error : Meta.t -> 'a t -> fnd:Sort.t -> 'b 1719 1718 (** [type_error meta ~exp ~fnd] errors when kind [exp] was expected but sort 1720 1719 [fnd] was found. *) 1721 1720

Configure Feed

Configure Feed