+12 -12

README.md

reviewed

··· 1 1 # loc 2 2 3 3 - Source locations and structured errors for text-based codecs in OCaml, 4 4 - extracted from Daniel Bünzli's 5 5 - [jsont](https://erratique.ch/software/jsont). Packaging the shared base 6 6 - as a standalone library lets non-JSON text codecs (`xml`, `csv`, `sexp`, 7 7 - `toml`, ...) report error positions uniformly without pulling in 8 8 - `jsont`. 3 3 + Source locations and structured errors shared across text codecs 4 4 + (JSON, TOML, YAML, XML, CSV, S-expression, ...). 9 5 10 10 - A direct copy of `jsont_base.ml` and the `Error` module of `jsont.ml`, 11 11 - with JSON-specific pieces (the `Number` module, the JSON `Sort.t` enum, 12 12 - JSON-shaped predefined errors) removed; everything else is verbatim. 6 6 + Every OCaml codec library needs the same plumbing: byte ranges, line 7 7 + positions, context-aware error paths, and a printer that matches the 8 8 + OCaml compiler / GNU error convention. `loc` provides that plumbing as 9 9 + one small library so codecs depend on it instead of each reinventing 10 10 + it — or, worse, exposing a private error type that upstream tools 11 11 + cannot compose. 13 12 14 13 Provides: 15 14 16 15 - `Loc` — byte and line ranges for UTF-8 source text 17 16 - `Loc.Meta` — node metadata: source location and surrounding whitespace 18 17 - `Loc.Path` — structural paths (`Mem of string node | Nth of int node`) 19 19 - - `Loc.Error` — structured errors: extensible kind, source location, 20 20 - contextual path; formatted per the OCaml compiler / GNU error 21 21 - conventions 18 18 + - `Loc.Context` — navigation contexts accumulated during descent 19 19 + - `Loc.Error` — structured errors with an {i extensible} kind, source 20 20 + location, and contextual path; formatted per the OCaml compiler / 21 21 + GNU error conventions 22 22 - `exception Loc.Error of Loc.Error.t` — single shared exception for 23 23 cross-package error propagation 24 24

+16 -18

lib/loc.ml

reviewed

··· 191 191 (* Node metadata *) 192 192 193 193 module Meta = struct 194 194 - type textloc = t 195 195 - type t = { textloc : textloc; ws_before : string; ws_after : string } 196 196 - 197 197 - let make ?(ws_before = "") ?(ws_after = "") textloc = 198 198 - { textloc; ws_before; ws_after } 194 194 + type location = t 195 195 + type t = { loc : location; ws_before : string; ws_after : string } 199 196 200 200 - let none = { textloc = none; ws_before = ""; ws_after = "" } 197 197 + let make ?(ws_before = "") ?(ws_after = "") loc = { loc; ws_before; ws_after } 198 198 + let none = { loc = none; ws_before = ""; ws_after = "" } 201 199 let is_none m = none == m 202 202 - let textloc m = m.textloc 200 200 + let loc m = m.loc 203 201 let ws_before m = m.ws_before 204 202 let ws_after m = m.ws_after 205 205 - let with_textloc m textloc = { m with textloc } 203 203 + let with_loc m loc = { m with loc } 206 204 let clear_ws m = { m with ws_before = ""; ws_after = "" } 207 207 - let clear_textloc m = { m with textloc = none.textloc } 205 205 + let clear_loc m = { m with loc = none.loc } 208 206 209 207 let copy_ws src ~dst = 210 208 { dst with ws_before = src.ws_before; ws_after = src.ws_after } ··· 240 238 241 239 let default_pp_step_trace ppf = function 242 240 | Mem (n, meta) -> 243 243 - Fmt.pf ppf "%a: in member %a" pp (Meta.textloc meta) pp_name n 241 241 + Fmt.pf ppf "%a: in member %a" pp (Meta.loc meta) pp_name n 244 242 | Nth (n, meta) -> 245 245 - Fmt.pf ppf "%a: at index %a" pp (Meta.textloc meta) pp_step_num n 243 243 + Fmt.pf ppf "%a: at index %a" pp (Meta.loc meta) pp_step_num n 246 244 | s -> pp_step ppf s 247 245 248 246 let pp_step_trace = default_pp_step_trace ··· 349 347 350 348 let pp ppf ctx = 351 349 let pp_meta ppf meta = 352 352 - if Meta.is_none meta then () else Fmt.pf ppf "%a: " pp (Meta.textloc meta) 350 350 + if Meta.is_none meta then () else Fmt.pf ppf "%a: " pp (Meta.loc meta) 353 351 in 354 352 let pp_el ppf { sort; step } = 355 353 match step with ··· 423 421 match e.ctx with 424 422 | [] -> raise_notrace (Error e) 425 423 | { sort = name, smeta; step } :: is -> 426 426 - let textloc = Meta.textloc smeta in 427 427 - let textloc = 428 428 - if is_none textloc then textloc 429 429 - else set_first textloc ~first_byte ~first_line_num ~first_line_byte 424 424 + let loc = Meta.loc smeta in 425 425 + let loc = 426 426 + if is_none loc then loc 427 427 + else set_first loc ~first_byte ~first_line_num ~first_line_byte 430 428 in 431 431 - let smeta = Meta.with_textloc smeta textloc in 429 429 + let smeta = Meta.with_loc smeta loc in 432 430 let ctx = { Context.sort = (name, smeta); step } :: is in 433 431 raise_notrace (Error { e with ctx }) 434 432 435 433 let pp ppf e = 436 434 let pp_meta ppf m = 437 437 - if not (Meta.is_none m) then Fmt.pf ppf "@,%a:" pp (Meta.textloc m) 435 435 + if not (Meta.is_none m) then Fmt.pf ppf "@,%a:" pp (Meta.loc m) 438 436 in 439 437 Fmt.pf ppf "@[<v>%a%a%a@]" pp_kind e.kind pp_meta e.meta Context.pp e.ctx 440 438

+6 -6

lib/loc.mli

reviewed

··· 176 176 val is_none : t -> bool 177 177 (** [is_none m] is [true] iff [m] is {!none} (physical equality). *) 178 178 179 179 - val textloc : t -> loc 180 180 - (** [textloc m] is the source location of [m]. *) 179 179 + val loc : t -> loc 180 180 + (** [loc m] is the source location of [m]. *) 181 181 182 182 val ws_before : t -> string 183 183 (** [ws_before m] is the whitespace preceding the node. *) ··· 185 185 val ws_after : t -> string 186 186 (** [ws_after m] is the whitespace following the node. *) 187 187 188 188 - val with_textloc : t -> loc -> t 189 189 - (** [with_textloc m loc] is [m] with source location set to [loc]. *) 188 188 + val with_loc : t -> loc -> t 189 189 + (** [with_loc m loc] is [m] with source location set to [loc]. *) 190 190 191 191 val clear_ws : t -> t 192 192 (** [clear_ws m] is [m] with both whitespace fields cleared. *) 193 193 194 194 - val clear_textloc : t -> t 195 195 - (** [clear_textloc m] is [m] with its source location set to {!none}. *) 194 194 + val clear_loc : t -> t 195 195 + (** [clear_loc m] is [m] with its source location set to {!none}. *) 196 196 197 197 val copy_ws : t -> dst:t -> t 198 198 (** [copy_ws src ~dst] is [dst] with its whitespace fields copied from [src].

+8 -14

test/test_loc.ml

reviewed

··· 129 129 Alcotest.(check bool) "is_none false" false (Loc.Meta.is_none m); 130 130 Alcotest.(check string) "ws_before" " " (Loc.Meta.ws_before m); 131 131 Alcotest.(check string) "ws_after" "\n" (Loc.Meta.ws_after m); 132 132 - Alcotest.(check bool) 133 133 - "textloc eq" true 134 134 - (Loc.equal sample (Loc.Meta.textloc m)) 132 132 + Alcotest.(check bool) "loc eq" true (Loc.equal sample (Loc.Meta.loc m)) 135 133 136 134 let meta_none () = 137 135 Alcotest.(check bool) "none is_none" true (Loc.Meta.is_none Loc.Meta.none); 138 136 Alcotest.(check string) "none ws_before" "" (Loc.Meta.ws_before Loc.Meta.none) 139 137 140 140 - let meta_with_textloc () = 138 138 + let meta_with_loc () = 141 139 let m = Loc.Meta.make ~ws_before:"a" sample in 142 142 - let m' = Loc.Meta.with_textloc m Loc.none in 143 143 - Alcotest.(check bool) 144 144 - "textloc replaced" true 145 145 - (Loc.is_none (Loc.Meta.textloc m')); 140 140 + let m' = Loc.Meta.with_loc m Loc.none in 141 141 + Alcotest.(check bool) "loc replaced" true (Loc.is_none (Loc.Meta.loc m')); 146 142 Alcotest.(check string) "ws preserved" "a" (Loc.Meta.ws_before m') 147 143 148 144 let meta_clear () = ··· 150 146 let m1 = Loc.Meta.clear_ws m in 151 147 Alcotest.(check string) "ws_before cleared" "" (Loc.Meta.ws_before m1); 152 148 Alcotest.(check string) "ws_after cleared" "" (Loc.Meta.ws_after m1); 153 153 - let m2 = Loc.Meta.clear_textloc m in 154 154 - Alcotest.(check bool) 155 155 - "textloc cleared" true 156 156 - (Loc.is_none (Loc.Meta.textloc m2)) 149 149 + let m2 = Loc.Meta.clear_loc m in 150 150 + Alcotest.(check bool) "loc cleared" true (Loc.is_none (Loc.Meta.loc m2)) 157 151 158 152 let meta_copy_ws () = 159 153 let src = Loc.Meta.make ~ws_before:"x" ~ws_after:"y" sample in ··· 300 294 Alcotest.test_case "pp_ocaml none" `Quick pp_none; 301 295 Alcotest.test_case "Meta.make/accessors" `Quick meta_basic; 302 296 Alcotest.test_case "Meta.none is_none" `Quick meta_none; 303 303 - Alcotest.test_case "Meta.with_textloc" `Quick meta_with_textloc; 304 304 - Alcotest.test_case "Meta.clear_ws / clear_textloc" `Quick meta_clear; 297 297 + Alcotest.test_case "Meta.with_loc" `Quick meta_with_loc; 298 298 + Alcotest.test_case "Meta.clear_ws / clear_loc" `Quick meta_clear; 305 299 Alcotest.test_case "Meta.copy_ws" `Quick meta_copy_ws; 306 300 Alcotest.test_case "Path.root" `Quick path_root; 307 301 Alcotest.test_case "Path.mem/nth/rev_indices" `Quick path_build;