New offset utils

.vscode/settings.json

@@ -1,5 +1,6 @@
 {
     "cSpell.words": [
+        "bols",
         "janestreet"
     ]
 }

CHANGES.md

@@ -1,3 +1,19 @@
+## 0.2.1 (2024-11-04)
+
+### Added
+
+- Add utils to build locs from file offsets and ranges (#6, @mbarbin).
+- Make the library build with `ocaml.4.14` (#5, @mbarbin).
+- Add new checks in CI (build checks on windows and macos) (#5, @mbarbin).
+
+### Changed
+
+- Rename `Loc.in_file` to `Loc.of_file`; rename `Loc.in_file_line` to `Loc.of_file_line` (#6, @mbarbin).
+
+### Deprecated
+
+- Prepare `Loc.in_file` and `Loc.in_file_line` for deprecation (#6, @mbarbin).
+
 ## 0.2.0 (2024-09-03)
 
 ### Added

src/loc.ml

@@ -60,7 +60,7 @@ let to_string t =
 
 let to_file_colon_line = Stdune.Loc.to_file_colon_line
 
-let in_file ~path =
+let of_file ~path =
   let p =
     { Lexing.pos_fname = path |> Fpath.to_string
     ; pos_lnum = 1
@@ -74,10 +74,25 @@ let in_file ~path =
 module File_cache = struct
   type t =
     { path : Fpath.t
+    ; length : int
+    ; ends_with_newline : bool
     ; num_lines : int
     ; bols : int array
     }
 
+  let sexp_of_t { path; length; ends_with_newline; num_lines; bols } : Sexp.t =
+    List
+      [ List [ Atom "path"; Atom (path |> Fpath.to_string) ]
+      ; List [ Atom "length"; Atom (length |> Int.to_string) ]
+      ; List [ Atom "ends_with_newline"; Atom (ends_with_newline |> Bool.to_string) ]
+      ; List [ Atom "num_lines"; Atom (num_lines |> Int.to_string) ]
+      ; List
+          [ Atom "bols"
+          ; Sexplib0.Sexp_conv.sexp_of_array Sexplib0.Sexp_conv.sexp_of_int bols
+          ]
+      ]
+  ;;
+
   let path t = t.path
 
   let create ~path ~file_contents =
@@ -86,27 +101,57 @@ module File_cache = struct
       (fun cnum char -> if Char.equal char '\n' then bols := (cnum + 1) :: !bols)
       file_contents;
     let length = String.length file_contents in
+    let ends_with_newline = length > 0 && file_contents.[length - 1] = '\n' in
+    if length > 0 && not ends_with_newline then bols := length :: !bols;
+    let bols = Array.of_list (List.rev !bols) in
     let num_lines =
       if length = 0
       then 1 (* line 1, char 0 is considered the only valid offset. *)
-      else List.length !bols + if file_contents.[length - 1] = '\n' then -1 else 0
+      else Array.length bols - 1
+    in
+    { path; length; ends_with_newline; num_lines; bols }
+  ;;
+
+  let position t ~pos_cnum =
+    let rec binary_search ~from ~to_ =
+      if from > to_
+      then raise (Invalid_argument "Loc.File_cache.position") [@coverage off]
+      else (
+        let mid = (from + to_) / 2 in
+        let pos_bol = t.bols.(mid) in
+        if pos_cnum < pos_bol
+        then binary_search ~from ~to_:(mid - 1)
+        else (
+          let succ = mid + 1 in
+          if succ < Array.length t.bols && pos_cnum >= t.bols.(succ)
+          then binary_search ~from:succ ~to_
+          else
+            { Lexing.pos_fname = t.path |> Fpath.to_string
+            ; pos_lnum = succ
+            ; pos_cnum
+            ; pos_bol
+            }))
     in
-    if length > 0 && file_contents.[length - 1] <> '\n' then bols := (length + 1) :: !bols;
-    { path; num_lines; bols = Array.of_list (List.rev !bols) }
+    if pos_cnum < 0 || pos_cnum >= t.length
+    then raise (Invalid_argument "Loc.File_cache.position")
+    else binary_search ~from:0 ~to_:(Array.length t.bols - 1)
   ;;
 end
 
-let in_file_line ~(file_cache : File_cache.t) ~line =
+let of_file_line ~(file_cache : File_cache.t) ~line =
   if line < 1 || line > file_cache.num_lines
-  then raise (Invalid_argument "Loc.in_file_line");
+  then raise (Invalid_argument "Loc.of_file_line");
   let pos_fname = file_cache.path |> Fpath.to_string in
   let pos_bol = file_cache.bols.(line - 1) in
   let start = { Lexing.pos_fname; pos_lnum = line; pos_cnum = pos_bol; pos_bol } in
   let stop =
     if line >= Array.length file_cache.bols
     then start
     else (
-      let pos_cnum = file_cache.bols.(line) - 1 in
+      let pos_cnum =
+        file_cache.bols.(line)
+        - if line = file_cache.num_lines && not file_cache.ends_with_newline then 0 else 1
+      in
       { Lexing.pos_fname; pos_lnum = line; pos_cnum; pos_bol })
   in
   of_lexbuf_loc { start; stop }
@@ -131,11 +176,16 @@ module Offset = struct
   let equal = Int.equal
   let sexp_of_t = Sexplib0.Sexp_conv.sexp_of_int
   let of_position (t : Lexing.position) = t.pos_cnum
+  let to_position t ~file_cache = File_cache.position file_cache ~pos_cnum:t
 end
 
 let start_offset = Stdune.Loc.start_pos_cnum
 let stop_offset = Stdune.Loc.stop_pos_cnum
 
+let of_file_offset ~file_cache ~offset =
+  Offset.to_position offset ~file_cache |> of_position
+;;
+
 module Range = struct
   type t =
     { start : Offset.t
@@ -165,6 +215,16 @@ let range t =
   Range.of_positions ~start:t.start ~stop:t.stop
 ;;
 
+let of_file_range ~file_cache ~range:{ Range.start; stop } =
+  if start > stop
+  then raise (Invalid_argument "Loc.of_file_range")
+  else
+    of_lexbuf_loc
+      { start = Offset.to_position start ~file_cache
+      ; stop = Offset.to_position stop ~file_cache
+      }
+;;
+
 module Txt = struct
   module Loc = struct
     type nonrec t = t
@@ -198,3 +258,10 @@ module Txt = struct
   let loc t = t.loc
   let txt t = t.txt
 end
+
+let in_file = of_file
+let in_file_line = of_file_line
+
+module Private = struct
+  module File_cache = File_cache
+end

src/loc.mli

@@ -61,7 +61,7 @@ val of_lexbuf : Lexing.lexbuf -> t
 (** Build a location identifying the file as a whole. This is a practical
     location to use when it is not possible to build a more precise location
     rather than the entire file. *)
-val in_file : path:Fpath.t -> t
+val of_file : path:Fpath.t -> t
 
 (** [none] is a special value to be used when no location information is available. *)
 val none : t
@@ -83,7 +83,7 @@ end
 
 (** Create a location that covers the entire line [line] of the file. Lines
     start at [1]. Raises [Invalid_argument] if the line overflows. *)
-val in_file_line : file_cache:File_cache.t -> line:int -> t
+val of_file_line : file_cache:File_cache.t -> line:int -> t
 
 (** {1 Getters} *)
 
@@ -137,11 +137,17 @@ module Offset : sig
 
   (** Reading the [pos_cnum] of a lexing position. *)
   val of_position : Lexing.position -> t
+
+  (** Rebuild the position from a file at the given offset. *)
+  val to_position : t -> file_cache:File_cache.t -> Lexing.position
 end
 
 val start_offset : t -> Offset.t
 val stop_offset : t -> Offset.t
 
+(** A convenient wrapper to build a loc from the position at a given offset. *)
+val of_file_offset : file_cache:File_cache.t -> offset:Offset.t -> t
+
 module Range : sig
   (** A range refers to a chunk of the file, from start (included) to stop
       (excluded). *)
@@ -160,6 +166,9 @@ end
 
 val range : t -> Range.t
 
+(** A convenient wrapper to build a loc from a file range. *)
+val of_file_range : file_cache:File_cache.t -> range:Range.t -> t
+
 module Txt : sig
   (** When the symbol you want to decorate is not already an argument in a
       record, it may be convenient to use this type as a standard way to
@@ -218,3 +227,29 @@ module Txt : sig
   val loc : _ t -> loc
   val txt : 'a t -> 'a
 end
+
+(** {1 Deprecated aliases}
+
+    This part of the API will be deprecated in a future version. *)
+
+(** This was renamed [of_file]. *)
+val in_file : path:Fpath.t -> t
+
+(** This was renamed [of_file_line]. *)
+val in_file_line : file_cache:File_cache.t -> line:int -> t
+
+(** {1 Private} *)
+
+module Private : sig
+  (** Exported for testing only.
+
+      This module is meant for tests only. Its signature may change in breaking ways
+      at any time without prior notice, and outside of the guidelines set by
+      semver. Do not use. *)
+
+  module File_cache : sig
+    type t = File_cache.t
+
+    val sexp_of_t : t -> Sexp.t
+  end
+end