ocaml-json: wire Textloc / Meta / Path to ocaml-loc · gazagnaire.org/ocaml-json@536099b

+3 -8

lib/brr/json_brr.ml

··· 150 150 match map.shape with 151 151 | Object_cases (umems', cases) -> 152 152 let umems' = Unknown_mems umems' in 153 - let umems, dict = 154 - Json.Repr.override_unknown_mems ~by:umems umems' dict 155 - in 153 + let umems, dict = Json.Repr.override_unknown_mems ~by:umems umems' dict in 156 154 decode_object_cases map umems cases mem_decs dict names jv 157 155 | Object_basic umems' -> ( 158 156 let umems' = Unknown_mems (Some umems') in 159 - let umems, dict = 160 - Json.Repr.override_unknown_mems ~by:umems umems' dict 161 - in 157 + let umems, dict = Json.Repr.override_unknown_mems ~by:umems umems' dict in 162 158 match umems with 163 159 | Unknown_mems (Some Unknown_skip | None) -> 164 160 let u = Unknown_skip in ··· 185 181 fun map umems umap mem_decs dict names jv -> 186 182 match names with 187 183 | [] -> 188 - Json.Repr.finish_object_decode map Json.Meta.none umems umap mem_decs 189 - dict 184 + Json.Repr.finish_object_decode map Json.Meta.none umems umap mem_decs dict 190 185 | (n, jname) :: names -> ( 191 186 match String_map.find_opt n mem_decs with 192 187 | Some (Mem_dec m) ->

+2 -2

lib/brr/json_brr.mli

··· 36 36 val encode : 37 37 ?format:Json.format -> 'a Json.t -> 'a -> (Jstr.t, Jv.Error.t) result 38 38 (** [encode t v] encodes [v] to JSON according to [t]. [format] specifies how 39 - the JSON is formatted, defaults to {!Json.Minify}. The {!Json.Layout} 40 - format is unsupported, {!Json.Indent} is used instead. *) 39 + the JSON is formatted, defaults to {!Json.Minify}. The {!Json.Layout} format 40 + is unsupported, {!Json.Indent} is used instead. *) 41 41 42 42 val encode' : 43 43 ?format:Json.format -> 'a Json.t -> 'a -> (Jstr.t, Json.Error.t) result

+19 -18

lib/bytesrw/json_bytesrw.ml

··· 110 110 111 111 (* Decoder errors *) 112 112 113 + let textloc_of_pos d ~first_byte ~last_byte ~first_line:(fln, flb) 114 + ~last_line:(lln, llb) = 115 + Json.Textloc.make ~file:d.file ~first_byte ~last_byte ~first_line_num:fln 116 + ~first_line_byte:flb ~last_line_num:lln ~last_line_byte:llb 117 + 113 118 let error_meta d = 114 119 let first_byte = get_last_byte d and first_line = get_line_pos d in 115 120 let last_byte = first_byte and last_line = first_line in 116 121 Json.Meta.make 117 - @@ Json.Textloc.make ~file:d.file ~first_byte ~last_byte ~first_line 118 - ~last_line 122 + @@ textloc_of_pos d ~first_byte ~last_byte ~first_line ~last_line 119 123 120 124 let error_meta_to_current ~first_byte ~first_line d = 121 125 let last_byte = get_last_byte d and last_line = get_line_pos d in 122 126 Json.Meta.make 123 - @@ Json.Textloc.make ~file:d.file ~first_byte ~last_byte ~first_line 124 - ~last_line 127 + @@ textloc_of_pos d ~first_byte ~last_byte ~first_line ~last_line 125 128 126 129 let err_here d fmt = Json.Error.msgf (error_meta d) fmt 127 130 ··· 340 343 if not d.locs then Json.Textloc.none 341 344 else 342 345 let last_byte = get_last_byte d and last_line = get_line_pos d in 343 - Json.Textloc.make ~file:d.file ~first_byte ~last_byte ~first_line 344 - ~last_line 346 + textloc_of_pos d ~first_byte ~last_byte ~first_line ~last_line 345 347 346 348 let textloc_prev_ascii_char ~first_byte ~first_line d = 347 349 (* N.B. when we call that the line doesn't move and the char was on ··· 350 352 else 351 353 let last_byte = get_last_byte d and last_line = get_line_pos d in 352 354 let last_byte = last_byte - 1 in 353 - Json.Textloc.make ~file:d.file ~first_byte ~last_byte ~first_line 354 - ~last_line 355 + textloc_of_pos d ~first_byte ~last_byte ~first_line ~last_line 355 356 356 357 let meta_make d ?ws_before ?ws_after textloc = 357 358 if (not d.locs) && not d.layout then d.meta_none ··· 627 628 done; 628 629 (!b, !i) 629 630 with Json.Error e -> 630 - Json.Error.adjust_context ~first_byte ~first_line e) 631 + let first_line_num, first_line_byte = first_line in 632 + Json.Error.adjust_context ~first_byte ~first_line_num ~first_line_byte 633 + e) 631 634 in 632 635 let textloc = textloc_to_current d ~first_byte ~first_line in 633 636 let ws_after = ··· 657 660 else meta 658 661 in 659 662 Json.Error.raise ctx meta k 660 - | Json.Error e -> Json.Error.adjust_context ~first_byte ~first_line e 663 + | Json.Error e -> 664 + let first_line_num, first_line_byte = first_line in 665 + Json.Error.adjust_context ~first_byte ~first_line_num ~first_line_byte e 661 666 in 662 667 let textloc = textloc_to_current d ~first_byte ~first_line in 663 668 let ws_after = ··· 717 722 match map.shape with 718 723 | Object_cases (umems', cases) -> 719 724 let umems' = Unknown_mems umems' in 720 - let umems, dict = 721 - Json.Repr.override_unknown_mems ~by:umems umems' dict 722 - in 725 + let umems, dict = Json.Repr.override_unknown_mems ~by:umems umems' dict in 723 726 decode_object_case d map umems cases mem_miss mem_decs delay dict 724 727 | Object_basic umems' -> ( 725 728 let mem_miss, delay, dict = 726 729 decode_object_delayed d map mem_miss mem_decs delay dict 727 730 in 728 731 let umems' = Unknown_mems (Some umems') in 729 - let umems, dict = 730 - Json.Repr.override_unknown_mems ~by:umems umems' dict 731 - in 732 + let umems, dict = Json.Repr.override_unknown_mems ~by:umems umems' dict in 732 733 match umems with 733 734 | Unknown_mems (Some Unknown_skip | None) -> 734 735 decode_object_basic d map Unknown_skip () mem_miss mem_decs dict ··· 826 827 | None -> ( 827 828 try Json.Repr.unexpected_case_tag_error (error_meta d) map cases tag 828 829 with Json.Error e -> 829 - Json.Repr.error_push_object (error_meta d) map 830 - (cases.tag.name, nmeta) e) 830 + Json.Repr.error_push_object (error_meta d) map (cases.tag.name, nmeta) 831 + e) 831 832 | Some (Case case) -> 832 833 if sep then read_json_mem_sep d; 833 834 let dict =

+3 -1

lib/dune

··· 1 1 (library 2 2 (name json) 3 3 (public_name json) 4 - (modules json json_base)) 4 + (modules json json_base) 5 + (libraries 6 + (re_export loc)))

+9 -7

lib/json.ml

··· 12 12 let pp_name = Fmt.code 13 13 let pp_int ppf i = Fmt.code ppf (Int.to_string i) 14 14 15 - module Textloc = Json_base.Textloc 16 - module Meta = Json_base.Meta 15 + module Textloc = Loc 16 + module Meta = Loc.Meta 17 17 18 18 type 'a node = 'a * Meta.t 19 19 20 - module Path = Json_base.Path 20 + module Path = Loc.Path 21 21 module Sort = Json_base.Sort 22 22 23 23 type error_kind = string ··· 76 76 let push_object kinded_sort n (ctx, meta, e) = 77 77 raise_notrace (Error (Context.push_object kinded_sort n ctx, meta, e)) 78 78 79 - let adjust_context ~first_byte ~first_line (ctx, meta, e) = 79 + let adjust_context ~first_byte ~first_line_num ~first_line_byte (ctx, meta, e) 80 + = 80 81 match ctx with 81 82 | [] -> raise_notrace (Error (ctx, meta, e)) 82 83 | ((sort, smeta), idx) :: is -> 83 84 let textloc = Meta.textloc smeta in 84 85 let textloc = 85 86 if Textloc.is_none textloc then textloc 86 - else Textloc.set_first textloc ~first_byte ~first_line 87 + else 88 + Textloc.set_first textloc ~first_byte ~first_line_num 89 + ~first_line_byte 87 90 in 88 91 let smeta = Meta.with_textloc smeta textloc in 89 92 let ctx = ((sort, smeta), idx) :: is in ··· 845 848 846 849 let int = 847 850 let enc v = 848 - if Json_base.Number.can_store_exact_int v then int_number 849 - else int_as_string 851 + if Json_base.Number.can_store_exact_int v then int_number else int_as_string 850 852 in 851 853 let dec_number = int_number and dec_string = int_as_string in 852 854 any ~kind:"OCaml int" ~dec_number ~dec_string ~enc ()

+17 -311

lib/json.mli

··· 23 23 type 'a fmt = Format.formatter -> 'a -> unit 24 24 (** The type for formatters of values of type ['a]. *) 25 25 26 - (** Text locations. 27 - 28 - A text location identifies a text span in a given UTF-8 encoded file by an 29 - inclusive range of absolute {{!Textloc.type-byte_pos}byte} positions and the 30 - {{!Textloc.type-line_pos}line positions} on which those occur. *) 31 - module Textloc : sig 32 - (** {1:fpath File paths} *) 33 - 34 - type fpath = string 35 - (** The type for file paths. *) 36 - 37 - val file_none : fpath 38 - (** [file_none] is ["-"]. A file path to use when there is none. *) 39 - 40 - (** {1:pos Positions} *) 41 - 42 - (** {2:byte_pos Byte positions} *) 43 - 44 - type byte_pos = int 45 - (** The type for zero-based, absolute, byte positions in text. If the text has 46 - [n] bytes, [0] is the first position and [n-1] is the last position. *) 47 - 48 - val byte_pos_none : byte_pos 49 - (** [byte_pos_none] is [-1]. A position to use when there is none. *) 50 - 51 - (** {2:lines Lines} *) 52 - 53 - type line_num = int 54 - (** The type for one-based, line numbers in the text. Lines increment after a 55 - {e newline} which is either a line feed ['\n'] (U+000A), a carriage return 56 - ['\r'] (U+000D) or a carriage return and a line feed ["\r\n"] 57 - (<U+000D,U+000A>). *) 58 - 59 - val line_num_none : line_num 60 - (** [line_num_none] is [-1]. A line number to use when there is none. *) 61 - 62 - (** {2:line_pos Line positions} *) 63 - 64 - type line_pos = line_num * byte_pos 65 - (** The type for line positions. This identifies a line by its line number and 66 - the absolute byte position following its newline (or the start of text for 67 - the first line). That byte position: 68 - - Indexes the first byte of text of the line if the line is non-empty. 69 - - Indexes the first byte of the next {e newline} sequence if the line is 70 - empty. 71 - - Is out of bounds and equal to the text's length for a last empty line. 72 - This is also the case on empty text. *) 26 + module Textloc = Loc 27 + (** Text locations (byte ranges, line positions). *) 73 28 74 - val line_pos_first : line_pos 75 - (** [line_pos_first] is [1, 0]. Note that this is the only line position of 76 - the empty text. *) 77 - 78 - val line_pos_none : line_pos 79 - (** [line_pos_none] is [(line_pos_none, pos_pos_none)]. *) 80 - 81 - (** {1:tloc Text locations} *) 82 - 83 - type t 84 - (** The type for text locations. A text location identifies a text span in an 85 - UTF-8 encoded file by an inclusive range of absolute 86 - {{!type-byte_pos}byte positions} and the {{!type-line_pos}line positions} 87 - on which they occur. 88 - 89 - If the first byte equals the last byte the range contains exactly that 90 - byte. If the first byte is greater than the last byte this represents an 91 - insertion point before the first byte. In this case information about the 92 - last position should be ignored: it can contain anything. *) 93 - 94 - val none : t 95 - (** [none] is a position to use when there is none. *) 96 - 97 - val make : 98 - file:fpath -> 99 - first_byte:byte_pos -> 100 - last_byte:byte_pos -> 101 - first_line:line_pos -> 102 - last_line:line_pos -> 103 - t 104 - (** [v ~file ~first_byte ~last_byte ~first_line ~last_line] is a text location 105 - with the given arguments, see corresponding accessors for the semantics. 106 - If you don't have a file use {!file_none}. *) 107 - 108 - val file : t -> fpath 109 - (** [file l] is [l]'s file. *) 110 - 111 - val set_file : t -> fpath -> t 112 - (** [set_file l file] is [l] with {!file} set to [file]. *) 113 - 114 - val first_byte : t -> byte_pos 115 - (** [first_byte l] is [l]'s first byte. Irrelevant if {!is_none} is [true]. *) 116 - 117 - val last_byte : t -> byte_pos 118 - (** [last_byte l] is [l]'s last byte. Irrelevant if {!is_none} or {!is_empty} 119 - is [true]. *) 120 - 121 - val first_line : t -> line_pos 122 - (** [first_line l] is the line position on which [first_byte l] lies. 123 - Irrelevant if {!is_none} is [true].*) 124 - 125 - val last_line : t -> line_pos 126 - (** [last_line l] is the line position on which [last_byte l] lies. Irrelevant 127 - if {!is_none} or {!is_empty} is [true].*) 128 - 129 - (** {2:preds Predicates and comparisons} *) 130 - 131 - val is_none : t -> bool 132 - (** [is_none t] is [true] iff [first_byte < 0]. *) 133 - 134 - val is_empty : t -> bool 135 - (** [is_empty t] is [true] iff [first_byte t > last_byte t]. *) 136 - 137 - val equal : t -> t -> bool 138 - (** [equal t0 t1] is [true] iff [t0] and [t1] are equal. This checks that 139 - {!file}, {!first_byte} and {!last_byte} are equal. Line information is 140 - ignored. *) 141 - 142 - val compare : t -> t -> int 143 - (** [compare t0 t1] orders [t0] and [t1]. The order is compatible with 144 - {!equal}. Comparison starts with {!file}, follows with {!first_byte} and 145 - ends, if needed, with {!last_byte}. Line information is ignored. *) 146 - 147 - (** {2:shrink_and_stretch Shrink and stretch} *) 148 - 149 - val set_first : t -> first_byte:byte_pos -> first_line:line_pos -> t 150 - (** [set_first l ~first_byte ~first_line] sets the the first position of [l] 151 - to given values. *) 152 - 153 - val set_last : t -> last_byte:byte_pos -> last_line:line_pos -> t 154 - (** [set_last l ~last_byte ~last_line] sets the last position of [l] to given 155 - values. *) 156 - 157 - val to_first : t -> t 158 - (** [to_first l] has both first and last positions set to [l]'s first 159 - position. The range spans {!first_byte}. See also {!before}. *) 160 - 161 - val to_last : t -> t 162 - (** [to_last l] has both first and last positions set to [l]'s last position. 163 - The range spans {!last_byte}. See also {!after}. *) 164 - 165 - val before : t -> t 166 - (** [before t] is the {{!is_empty}empty} text location starting at 167 - {!first_byte}. *) 168 - 169 - val after : t -> t 170 - (** [after t] is the empty {{!is_empty}empty} location starting at 171 - [last_byte t + 1]; note that at the end of input this may be an invalid 172 - byte {e index}. The {!first_line} and {!last_line} of the result is 173 - [last_line t]. *) 174 - 175 - val span : t -> t -> t 176 - (** [span l0 l1] is the span from the smallest byte position of [l0] and [l1] 177 - to the largest byte position of [l0] and [l1]. The file path is taken from 178 - the greatest byte position. *) 179 - 180 - val reloc : first:t -> last:t -> t 181 - (** [reloc ~first ~last] uses the first position of [first], the last position 182 - of [last] and the file of [last]. *) 183 - 184 - (** {2:fmt Formatting} *) 185 - 186 - val pp_ocaml : Format.formatter -> t -> unit 187 - (** [pp_ocaml] formats text locations like the OCaml compiler. *) 188 - 189 - val pp_gnu : Format.formatter -> t -> unit 190 - (** [pp_gnu] formats text locations according to the 191 - {{:https://www.gnu.org/prep/standards/standards.html#Errors}GNU 192 - convention}. *) 193 - 194 - val pp : Format.formatter -> t -> unit 195 - (** [pp] is {!pp_ocaml}. *) 196 - 197 - val pp_dump : Format.formatter -> t -> unit 198 - (** [pp_dump] formats raw data for debugging. *) 199 - end 200 - 201 - (** Abstract syntax tree node metadata. 202 - 203 - This type keeps information about source text locations and whitespace. *) 204 - module Meta : sig 205 - type t 206 - (** The type for node metadata. *) 207 - 208 - val make : ?ws_before:string -> ?ws_after:string -> Textloc.t -> t 209 - (** [make textloc ~ws_before ~ws_after] is metadata with text location 210 - [textloc] whitespace [ws_before] before the node and [ws_after] after the 211 - node. Both default to [""]. *) 212 - 213 - val none : t 214 - (** [none] is metadata for when there is none. Its {!textloc} is 215 - {!Textloc.none} and its whitespace is empty. *) 216 - 217 - val is_none : t -> bool 218 - (** [is_none m] is [true] iff [m] is {!none}. *) 219 - 220 - val textloc : t -> Textloc.t 221 - (** [textloc m] is the text location of [m]. *) 222 - 223 - val ws_before : t -> string 224 - (** [ws_before m] is source whitespace before the node. *) 225 - 226 - val ws_after : t -> string 227 - (** [ws_after m] is source whitespace after the node. *) 228 - 229 - val with_textloc : t -> Textloc.t -> t 230 - (** [with_textloc m l] is [m] with text location [l] *) 231 - 232 - val clear_ws : t -> t 233 - (** [clear_ws m] is [m] with {!ws_before} and {!ws_after} set to [""]. *) 234 - 235 - val clear_textloc : t -> t 236 - (** [clear_textloc m] is [m] with {!textloc} set to {!Textloc.none}. *) 237 - 238 - val copy_ws : t -> dst:t -> t 239 - (** [copy_ws src ~dst] copies {!ws_before} and {!ws_after} of [src] to [dst]. 240 - *) 241 - end 29 + module Meta = Loc.Meta 30 + (** Node metadata (source location + surrounding whitespace). *) 242 31 243 32 type 'a node = 'a * Meta.t 244 - (** The type for abstract syntax tree nodes. The node data of type ['a] and its 245 - metadata. *) 246 - 247 - (** JSON paths. 248 - 249 - Paths are used for keeping track of erroring {{!Error.Context.t}contexts} 250 - and for specifying {{!Json.queries} query and update} locations. *) 251 - module Path : sig 252 - (** {1:indices Indices} *) 253 - 254 - (** The type for indexing operations on JSON values. *) 255 - type index = 256 - | Mem of string node 257 - (** Indexes the value of the member [n] of an object. *) 258 - | Nth of int node 259 - (** Indexes the value of the [n]th element of an array. *) 260 - 261 - val pp_index : index fmt 262 - (** [pp_index] formats indexes. *) 263 - 264 - val pp_index_trace : index fmt 265 - (** [pp_index] formats indexes and their location. *) 266 - 267 - (** {1:path Paths} *) 268 - 269 - type t 270 - (** The type for paths, a sequence of indexing operations. *) 33 + (** An AST node: data plus its metadata. *) 271 34 272 - val root : t 273 - (** [root] is the root path. *) 274 - 275 - val is_root : t -> bool 276 - (** [is_root p] is [true] iff [p] is the root path. *) 277 - 278 - val nth : ?meta:Meta.t -> int -> t -> t 279 - (** [nth n p] indexes the array indexed by [p] at index [n]. *) 280 - 281 - val mem : ?meta:Meta.t -> string -> t -> t 282 - (** [mem n p] indexes the object indexed by [p] at member [n]. *) 283 - 284 - val rev_indices : t -> index list 285 - (** [rev_indices p] are the indices of [p] in reverse order, the last indexing 286 - operation appears first. *) 287 - 288 - val of_string : string -> (t, string) result 289 - (** [of_string s] parses a path according to the 290 - {{!Path.path_syntax}path syntax}. *) 291 - 292 - val pp : t fmt 293 - (** [pp] formats paths. *) 294 - 295 - val pp_trace : t fmt 296 - (** [pp_trace] formats paths as a stack trace, if not empty. *) 297 - 298 - (** {1:path_syntax Path syntax} 299 - 300 - Path provide a way for end users to address JSON and edit locations. 301 - 302 - A {e path} is a sequence of member and list indexing operations. Applying 303 - the path to a JSON value leads to either a JSON value, or nothing if one 304 - of the indices does not exist, or an error if ones tries to index a 305 - non-indexable value. 306 - 307 - Here are a few examples of paths. 308 - 309 - {@json[ 310 - { 311 - "ocaml": { 312 - "libs": ["jsont", "brr", "cmdliner"] 313 - } 314 - } 315 - ]} 316 - 317 - {@shell[ 318 - ocaml.libs # value of member "libs" of member "ocaml" 319 - ocaml.libs.[0] # first element of member "libs" of member "ocaml" 320 - ]} 321 - 322 - More formally a {e path} is a [.] seperated list of indices. An {e index} 323 - is written [[i]]. [i] can a zero-based list index. Or [i] can be an object 324 - member name [n]. If there is no ambiguity, the surrounding brackets can be 325 - dropped. 326 - 327 - {b Notes.} 328 - - The syntax has no form of quoting at the moment this means key names 329 - can't contain, [\[], [\]], or start with a number. 330 - - It would be nice to be able to drop the dots in order to be compatible 331 - with {{:https://www.rfc-editor.org/rfc/rfc9535} JSONPath} syntax. 332 - - Reintroduce and implement negative indices (they are parsed). *) 333 - end 35 + module Path = Loc.Path 36 + (** Structural paths (object members, array indices). *) 334 37 335 38 (** Sorts of JSON values. *) 336 39 module Sort : sig ··· 381 84 (** JSON error contexts. *) 382 85 module Context : sig 383 86 type index = string node * Path.index 384 - (** The type for context indices. The {{!Json.kinded_sort}kinded sort} of 385 - an array or object and its index. *) 87 + (** The type for context indices. The {{!Json.kinded_sort}kinded sort} of an 88 + array or object and its index. *) 386 89 387 90 type t = index list 388 91 (** The type for erroring contexts. The first element indexes the root JSON ··· 434 137 [n] of an object of {{!Json.kinded_sort}kinded sort} [kinded_sort]. *) 435 138 436 139 val adjust_context : 437 - first_byte:Textloc.byte_pos -> first_line:Textloc.line_pos -> t -> 'a 438 - (** [adjust_context ~first_byte ~first_line] adjusts the error's context's 439 - meta to encompass the given positions. *) 140 + first_byte:Textloc.byte_pos -> 141 + first_line_num:Textloc.line_num -> 142 + first_line_byte:Textloc.byte_pos -> 143 + t -> 144 + 'a 145 + (** [adjust_context ~first_byte ~first_line_num ~first_line_byte] adjusts the 146 + error's context's meta to encompass the given positions. *) 440 147 441 148 (** {1:fmt Formatting} *) 442 149 ··· 1961 1668 1962 1669 val unsafe_to_t : 'a t -> 'a t' 1963 1670 (** [unsafe_to_t r] converts the representation to a type [r]. It is unsafe 1964 - because constructors of the {!Json} module do maintain some invariants. 1965 - *) 1671 + because constructors of the {!Json} module do maintain some invariants. *) 1966 1672 1967 1673 (** {1:kinds Kinds and doc} *) 1968 1674

-277

lib/json_base.ml

··· 384 384 char ppf '"' 385 385 end 386 386 387 - (* Text locations *) 388 - 389 - module Textloc = struct 390 - (* File paths *) 391 - 392 - type fpath = string 393 - 394 - let file_none = "-" 395 - let pp_path = Format.pp_print_string 396 - 397 - (* Byte positions *) 398 - 399 - type byte_pos = int (* zero-based *) 400 - 401 - let byte_pos_none = -1 402 - 403 - (* Lines *) 404 - 405 - type line_num = int (* one-based *) 406 - 407 - let line_num_none = -1 408 - 409 - (* Line positions 410 - 411 - We keep the byte position of the first element on the line. This 412 - first element may not exist and be equal to the text length if 413 - the input ends with a newline. Editors expect tools to compute 414 - visual columns (not a very good idea). By keeping these byte 415 - positions we can approximate columns by subtracting the line byte 416 - position data byte location. This will only be correct on 417 - US-ASCII data. *) 418 - 419 - type line_pos = line_num * byte_pos 420 - 421 - let line_pos_first = (1, 0) 422 - let line_pos_none = (line_num_none, byte_pos_none) 423 - 424 - (* Text locations *) 425 - 426 - type t = { 427 - file : fpath; 428 - first_byte : byte_pos; 429 - last_byte : byte_pos; 430 - first_line : line_pos; 431 - last_line : line_pos; 432 - } 433 - 434 - let make ~file ~first_byte ~last_byte ~first_line ~last_line = 435 - { file; first_byte; last_byte; first_line; last_line } 436 - 437 - let file l = l.file 438 - let set_file l file = { l with file } 439 - let first_byte l = l.first_byte 440 - let last_byte l = l.last_byte 441 - let first_line l = l.first_line 442 - let last_line l = l.last_line 443 - 444 - let none = 445 - let first_byte = byte_pos_none and last_byte = byte_pos_none in 446 - let first_line = line_pos_none and last_line = line_pos_none in 447 - make ~file:file_none ~first_byte ~last_byte ~first_line ~last_line 448 - 449 - (* Predicates and comparisons *) 450 - 451 - let is_none l = l.first_byte < 0 452 - let is_empty l = l.first_byte > l.last_byte 453 - 454 - let equal l0 l1 = 455 - String.equal l0.file l1.file 456 - && Int.equal l0.first_byte l1.first_byte 457 - && Int.equal l0.last_byte l1.last_byte 458 - 459 - let compare l0 l1 = 460 - let c = String.compare l0.file l1.file in 461 - if c <> 0 then c 462 - else 463 - let c = Int.compare l0.first_byte l1.first_byte in 464 - if c <> 0 then c else Int.compare l0.last_byte l1.last_byte 465 - 466 - (* Shrink and stretch *) 467 - 468 - let set_first l ~first_byte ~first_line = { l with first_byte; first_line } 469 - let set_last l ~last_byte ~last_line = { l with last_byte; last_line } 470 - 471 - [@@@warning "-6"] 472 - 473 - let to_first l = 474 - make l.file l.first_byte l.first_byte l.first_line l.first_line 475 - 476 - let to_last l = make l.file l.last_byte l.last_byte l.last_line l.last_line 477 - 478 - let before l = 479 - make l.file l.first_byte byte_pos_none l.first_line line_pos_none 480 - 481 - let after l = 482 - make l.file (l.first_byte + 1) byte_pos_none l.last_line line_pos_none 483 - 484 - [@@@warning "+6"] 485 - 486 - let span l0 l1 = 487 - let first_byte, first_line = 488 - if l0.first_byte < l1.first_byte then (l0.first_byte, l0.first_line) 489 - else (l1.first_byte, l1.first_line) 490 - in 491 - let last_byte, last_line, file = 492 - if l0.last_byte < l1.last_byte then (l1.last_byte, l1.last_line, l1.file) 493 - else (l0.last_byte, l0.last_line, l0.file) 494 - in 495 - make ~file ~first_byte ~first_line ~last_byte ~last_line 496 - 497 - [@@@warning "-6"] 498 - 499 - let reloc ~first ~last = 500 - make last.file first.first_byte last.last_byte first.first_line 501 - last.last_line 502 - 503 - [@@@warning "+6"] 504 - 505 - (* Formatters *) 506 - 507 - let pf = Format.fprintf 508 - 509 - let pp_ocaml ppf l = 510 - match is_none l with 511 - | true -> pf ppf "File \"%a\"" pp_path l.file 512 - | false -> 513 - let pp_lines ppf l = 514 - match fst l.first_line = fst l.last_line with 515 - | true -> pf ppf "line %d" (fst l.first_line) 516 - | false -> pf ppf "lines %d-%d" (fst l.first_line) (fst l.last_line) 517 - in 518 - (* "characters" represent positions (insertion points) not columns *) 519 - let pos_s = l.first_byte - snd l.first_line in 520 - let pos_e = l.last_byte - snd l.last_line + 1 in 521 - if pos_s = 0 && pos_e = 0 then 522 - pf ppf "File \"%a\", %a" pp_path l.file pp_lines l 523 - else 524 - pf ppf "File \"%a\", %a, characters %d-%d" pp_path l.file pp_lines l 525 - pos_s pos_e 526 - 527 - let pp_gnu ppf l = 528 - match is_none l with 529 - | true -> pf ppf "%a:" pp_path l.file 530 - | false -> 531 - let pp_lines ppf l = 532 - let col_s = l.first_byte - snd l.first_line + 1 in 533 - let col_e = l.last_byte - snd l.last_line + 1 in 534 - match fst l.first_line = fst l.last_line with 535 - | true -> pf ppf "%d.%d-%d" (fst l.first_line) col_s col_e 536 - | false -> 537 - pf ppf "%d.%d-%d.%d" (fst l.first_line) col_s (fst l.last_line) 538 - col_e 539 - in 540 - pf ppf "%a:%a" pp_path l.file pp_lines l 541 - 542 - let pp = pp_ocaml 543 - 544 - let pp_dump ppf l = 545 - pf ppf "file:%s bytes:%d-%d lines:(%d,%d)-(%d,%d)" l.file l.first_byte 546 - l.last_byte (fst l.first_line) (snd l.first_line) (fst l.last_line) 547 - (snd l.last_line) 548 - end 549 - 550 387 type 'a fmt = Stdlib.Format.formatter -> 'a -> unit 551 388 552 - (* Node meta data *) 553 - 554 - module Meta = struct 555 - type t = { textloc : Textloc.t; ws_before : string; ws_after : string } 556 - 557 - let make ?(ws_before = "") ?(ws_after = "") textloc = 558 - { textloc; ws_before; ws_after } 559 - 560 - let none = { textloc = Textloc.none; ws_before = ""; ws_after = "" } 561 - let is_none m = none == m 562 - let textloc m = m.textloc 563 - let ws_before m = m.ws_before 564 - let ws_after m = m.ws_after 565 - let with_textloc m textloc = { m with textloc } 566 - let clear_ws m = { m with ws_before = ""; ws_after = "" } 567 - let clear_textloc m = { m with textloc = Textloc.none } 568 - 569 - let copy_ws src ~dst = 570 - { dst with ws_before = src.ws_before; ws_after = src.ws_after } 571 - end 572 - 573 - type 'a node = 'a * Meta.t 574 - 575 389 (* JSON numbers *) 576 390 577 391 module Number = struct ··· 637 451 end 638 452 639 453 (* JSON Paths *) 640 - 641 - module Path = struct 642 - (* Indices *) 643 - 644 - type index = Mem of string node | Nth of int node 645 - 646 - let pp_name ppf n = Fmt.code ppf n 647 - let pp_index_num ppf n = Fmt.code ppf (Int.to_string n) 648 - 649 - let pp_index ppf = function 650 - | Mem (n, _) -> pp_name ppf n 651 - | Nth (n, _) -> Fmt.pf ppf "[%a]" pp_index_num n 652 - 653 - let pp_index_trace ppf = function 654 - | Mem (n, meta) -> 655 - Fmt.pf ppf "%a: in member %a" Textloc.pp (Meta.textloc meta) pp_name n 656 - | Nth (n, meta) -> 657 - Fmt.pf ppf "%a: at index %a" Textloc.pp (Meta.textloc meta) pp_index_num 658 - n 659 - 660 - let pp_bracketed_index ppf = function 661 - | Mem (n, _) -> Fmt.pf ppf "[%a]" pp_name n 662 - | Nth (n, _) -> Fmt.pf ppf "[%a]" pp_index_num n 663 - 664 - (* Paths *) 665 - 666 - type t = index list 667 - 668 - let root = [] 669 - let is_root = function [] -> true | _ -> false 670 - let nth ?(meta = Meta.none) n p = Nth (n, meta) :: p 671 - let mem ?(meta = Meta.none) n p = Mem (n, meta) :: p 672 - let rev_indices p = p 673 - 674 - let pp ppf is = 675 - let pp_sep ppf () = Fmt.char ppf '.' in 676 - Fmt.list ~pp_sep pp_index ppf (List.rev is) 677 - 678 - let pp_trace ppf is = 679 - if is <> [] then Fmt.pf ppf "@,@[<v>%a@]" (Fmt.list pp_index_trace) is 680 - 681 - let none = [] 682 - let err i fmt = Format.kasprintf failwith ("%d: " ^^ fmt) i 683 - let err_unexp_eoi i = err i "Unexpected end of input" 684 - let err_unexp_char i s = err i "Unexpected character: %C" s.[i] 685 - let err_illegal_char i s = err i "Illegal character here: %C" s.[i] 686 - let err_unexp i s = err i "Unexpected input: %S" (string_subrange ~first:i s) 687 - 688 - (* Parsing *) 689 - 690 - let parse_eoi s i max = if i > max then () else err_unexp i s 691 - 692 - let parse_index p s i max = 693 - let first, stop = match s.[i] with '[' -> (i + 1, ']') | _ -> (i, '.') in 694 - let last, next = 695 - let rec loop stop s i max = 696 - match i > max with 697 - | true -> if stop = ']' then err_unexp_eoi i else (i - 1, i) 698 - | false -> 699 - let illegal = s.[i] = '[' || (s.[i] = ']' && stop = '.') in 700 - if illegal then err_illegal_char i s 701 - else if s.[i] <> stop then loop stop s (i + 1) max 702 - else (i - 1, if stop = ']' then i + 1 else i) 703 - in 704 - loop stop s first max 705 - in 706 - let idx = string_subrange ~first ~last s in 707 - if idx = "" then err first "illegal empty index" 708 - else 709 - match int_of_string idx with 710 - | exception Failure _ -> (next, Mem (idx, Meta.none) :: p) 711 - | idx -> (next, Nth (idx, Meta.none) :: p) 712 - 713 - let of_string s = 714 - let rec loop p s i max = 715 - if i > max then p 716 - else 717 - let next, p = parse_index p s i max in 718 - if next > max then p 719 - else if s.[next] <> '.' then err_unexp_char next s 720 - else if next + 1 <= max then loop p s (next + 1) max 721 - else err_unexp_eoi next 722 - in 723 - try 724 - if s = "" then Ok [] 725 - else 726 - let start = if s.[0] = '.' then 1 else 0 in 727 - Ok (loop [] s start (String.length s - 1)) 728 - with Failure e -> Error e 729 - end 730 - 731 454 (* JSON sorts *) 732 455 733 456 module Sort = struct

-92

lib/json_base.mli

··· 78 78 val json_string : string t 79 79 end 80 80 81 - (** See {!Json.Textloc} *) 82 - module Textloc : sig 83 - type fpath = string 84 - 85 - val file_none : fpath 86 - 87 - type byte_pos = int 88 - 89 - val byte_pos_none : byte_pos 90 - 91 - type line_num = int 92 - 93 - val line_num_none : line_num 94 - 95 - type line_pos = line_num * byte_pos 96 - 97 - val line_pos_first : line_pos 98 - val line_pos_none : line_pos 99 - 100 - type t 101 - 102 - val none : t 103 - 104 - val make : 105 - file:fpath -> 106 - first_byte:byte_pos -> 107 - last_byte:byte_pos -> 108 - first_line:line_pos -> 109 - last_line:line_pos -> 110 - t 111 - 112 - val file : t -> fpath 113 - val set_file : t -> fpath -> t 114 - val first_byte : t -> byte_pos 115 - val last_byte : t -> byte_pos 116 - val first_line : t -> line_pos 117 - val last_line : t -> line_pos 118 - val is_none : t -> bool 119 - val is_empty : t -> bool 120 - val equal : t -> t -> bool 121 - val compare : t -> t -> int 122 - val set_first : t -> first_byte:byte_pos -> first_line:line_pos -> t 123 - val set_last : t -> last_byte:byte_pos -> last_line:line_pos -> t 124 - val to_first : t -> t 125 - val to_last : t -> t 126 - val before : t -> t 127 - val after : t -> t 128 - val span : t -> t -> t 129 - val reloc : first:t -> last:t -> t 130 - val pp_ocaml : Format.formatter -> t -> unit 131 - val pp_gnu : Format.formatter -> t -> unit 132 - val pp : Format.formatter -> t -> unit 133 - val pp_dump : Format.formatter -> t -> unit 134 - end 135 - 136 81 type 'a fmt = Stdlib.Format.formatter -> 'a -> unit 137 82 138 - (** See {!Json.Meta} *) 139 - module Meta : sig 140 - type t 141 - 142 - val make : ?ws_before:string -> ?ws_after:string -> Textloc.t -> t 143 - val none : t 144 - val is_none : t -> bool 145 - val textloc : t -> Textloc.t 146 - val ws_before : t -> string 147 - val ws_after : t -> string 148 - val with_textloc : t -> Textloc.t -> t 149 - val clear_ws : t -> t 150 - val clear_textloc : t -> t 151 - val copy_ws : t -> dst:t -> t 152 - end 153 - 154 - type 'a node = 'a * Meta.t 155 - 156 83 (** JSON number tools. *) 157 84 module Number : sig 158 85 val number_contains_int : bool ··· 169 96 val in_exact_int16_range : float -> bool 170 97 val in_exact_int32_range : float -> bool 171 98 val in_exact_int64_range : float -> bool 172 - end 173 - 174 - (** See {!Json.Path} *) 175 - module Path : sig 176 - type index = Mem of string node | Nth of int node 177 - 178 - val pp_index : index fmt 179 - val pp_index_trace : index fmt 180 - 181 - type t 182 - 183 - val root : t 184 - val is_root : t -> bool 185 - val nth : ?meta:Meta.t -> int -> t -> t 186 - val mem : ?meta:Meta.t -> string -> t -> t 187 - val rev_indices : t -> index list 188 - val of_string : string -> (t, string) result 189 - val pp : t fmt 190 - val pp_trace : t fmt 191 99 end 192 100 193 101 (** See {!Json.Sort} *)

Configure Feed

Configure Feed