deps

.gitignore

···
-_build
+# OCaml build artifacts
+_build/
+*.install
+*.merlin
+
+# Third-party sources (fetch locally with opam source)
+third_party/
+
+# Editor and OS files
+.DS_Store
+*.swp
+*~
+.vscode/
+.idea/
+
+# Opam local switch
+_opam/

.ocamlformat

···
+version=0.28.1

.tangled/workflows/build.yml

···
+when:
+  - event: ["push", "pull_request"]
+    branch: ["main"]
+
+engine: nixery
+
+dependencies:
+  nixpkgs:
+    - shell
+    - stdenv
+    - findutils
+    - binutils
+    - libunwind
+    - ncurses
+    - opam
+    - git
+    - gawk
+    - gnupatch
+    - gnum4
+    - gnumake
+    - gnutar
+    - gnused
+    - gnugrep
+    - diffutils
+    - gzip
+    - bzip2
+    - gcc
+    - ocaml
+    - pkg-config
+
+steps:
+  - name: opam
+    command: |
+       opam init --disable-sandboxing -a -y
+  - name: repo
+    command: |
+       opam repo add aoah https://tangled.org/anil.recoil.org/aoah-opam-repo.git
+  - name: switch
+    command: |
+       opam install . --confirm-level=unsafe-yes --deps-only
+  - name: build
+    command: |
+       opam exec -- dune build -p json-pointer
+  - name: switch-test
+    command: |
+       opam install . --confirm-level=unsafe-yes --deps-only --with-test
+  - name: test
+    command: |
+       opam exec -- dune runtest --verbose
+  - name: doc
+    command: |
+       opam install -y odoc
+       opam exec -- dune build @doc

LICENSE.md

···
+ISC License
+
+Copyright (c) 2025 Anil Madhavapeddy <[e-mail]>
+
+Permission to use, copy, modify, and distribute this software for any
+purpose with or without fee is hereby granted, provided that the above
+copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

dune

···
+(data_only_dirs third_party)

dune-project

···
-(lang dune 3.17)
+(lang dune 3.20)
+
 (name jsont-pointer)
-(version 0.1.0)
 
 (generate_opam_files true)
 
-(source (github avsm/jsont-pointer))
 (license ISC)
 (authors "Anil Madhavapeddy")
-(maintainers "[e-mail]")
+(homepage "https://tangled.org/@anil.recoil.org/ocaml-json-pointer")
+(maintainers "Anil Madhavapeddy <[e-mail]>")
+(bug_reports "https://tangled.org/@anil.recoil.org/ocaml-json-pointer/issues")
+(maintenance_intent "(latest)")
 
 (package
  (name jsont-pointer)
  (synopsis "RFC 6901 JSON Pointer implementation for jsont")
- (description "This library provides RFC 6901 JSON Pointer parsing, serialization, and evaluation compatible with jsont codecs. It also provides mutation operations suitable for implementing RFC 6902 JSON Patch.")
+ (description
+  "This library provides RFC 6901 JSON Pointer parsing, serialization, \
+   and evaluation compatible with jsont codecs. It also provides mutation \
+   operations suitable for implementing RFC 6902 JSON Patch.")
  (depends
-  (ocaml (>= 4.14.0))
-  (jsont (>= 0.2.0))))
+  ocaml
+  (jsont (>= 0.2.0))
+  (odoc :with-doc)))

jsont-pointer.opam

···
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "0.1.0"
 synopsis: "RFC 6901 JSON Pointer implementation for jsont"
 description:
   "This library provides RFC 6901 JSON Pointer parsing, serialization, and evaluation compatible with jsont codecs. It also provides mutation operations suitable for implementing RFC 6902 JSON Patch."
-maintainer: ["[e-mail]"]
+maintainer: ["Anil Madhavapeddy <[e-mail]>"]
 authors: ["Anil Madhavapeddy"]
 license: "ISC"
-homepage: "https://github.com/avsm/jsont-pointer"
-bug-reports: "https://github.com/avsm/jsont-pointer/issues"
+homepage: "https://tangled.org/@anil.recoil.org/ocaml-json-pointer"
+bug-reports: "https://tangled.org/@anil.recoil.org/ocaml-json-pointer/issues"
 depends: [
-  "dune" {>= "3.17"}
-  "ocaml" {>= "4.14.0"}
+  "dune" {>= "3.20"}
+  "ocaml"
   "jsont" {>= "0.2.0"}
   "odoc" {with-doc}
 ]
···
     "@doc" {with-doc}
   ]
 ]
-dev-repo: "git+https://github.com/avsm/jsont-pointer.git"
+x-maintenance-intent: ["(latest)"]

src/jsont_pointer.ml

···
 (*---------------------------------------------------------------------------
-   Copyright (c) 2024 The jsont programmers. All rights reserved.
-   SPDX-License-Identifier: ISC
-  ---------------------------------------------------------------------------*)
+  Copyright (c) 2025 Anil Madhavapeddy <[e-mail]>. All rights reserved.
+  SPDX-License-Identifier: ISC
+ ---------------------------------------------------------------------------*)
 
 (* Token escaping/unescaping per RFC 6901 Section 3-4 *)
 module Token = struct
···
 
 let of_string_result s =
   try Ok (of_string s)
-  with Jsont.Error (_, _, _) as e ->
-    Error (Jsont.Error.to_string (match e with Jsont.Error e -> e | _ -> assert false))
+  with Jsont.Error e -> Error (Jsont.Error.to_string e)
 
 (* URI fragment percent-decoding *)
 let hex_value c =
···
 
 let of_uri_fragment_result s =
   try Ok (of_uri_fragment s)
-  with Jsont.Error (_, _, _) as e ->
-    Error (Jsont.Error.to_string (match e with Jsont.Error e -> e | _ -> assert false))
+  with Jsont.Error e -> Error (Jsont.Error.to_string e)
 
 (* Serialization *)
 
···
   | Segment.End, Segment.End -> 0
 
 let equal p1 p2 =
-  List.length p1 = List.length p2 &&
-  List.for_all2 segment_equal p1 p2
+  List.equal segment_equal p1 p2
 
 let compare p1 p2 =
-  let rec loop l1 l2 = match l1, l2 with
-    | [], [] -> 0
-    | [], _ -> -1
-    | _, [] -> 1
-    | h1 :: t1, h2 :: t2 ->
-      let c = segment_compare h1 h2 in
-      if c <> 0 then c else loop t1 t2
-  in
-  loop p1 p2
+  List.compare segment_compare p1 p2
 
 (* Path conversion *)
 
···
 (* Mutation helpers *)
 
 let set_member name value (obj : Jsont.object') : Jsont.object' =
-  let found = ref false in
-  let result = List.map (fun ((n, m), v) ->
-    if String.equal n name then begin
-      found := true;
-      ((n, m), value)
-    end else
-      ((n, m), v)
-  ) obj in
-  if !found then result
-  else obj @ [((name, Jsont.Meta.none), value)]
+  let rec loop found acc = function
+    | [] ->
+      if found then List.rev acc
+      else List.rev_append acc [((name, Jsont.Meta.none), value)]
+    | ((n, m), _) :: rest when String.equal n name ->
+      loop true (((n, m), value) :: acc) rest
+    | mem :: rest ->
+      loop found (mem :: acc) rest
+  in
+  loop false [] obj
 
 let remove_member name (obj : Jsont.object') : Jsont.object' =
   List.filter (fun ((n, _), _) -> not (String.equal n name)) obj
 
 let insert_at n value lst =
   let rec loop i acc = function
-    | [] when i = n -> List.rev (value :: acc)
-    | [] -> List.rev acc (* shouldn't happen if n is valid *)
-    | h :: t when i = n -> List.rev_append (value :: acc) (h :: t)
+    | rest when i = n -> List.rev_append acc (value :: rest)
+    | [] -> List.rev acc
     | h :: t -> loop (i + 1) (h :: acc) t
   in
   loop 0 [] lst
 
 let remove_at n lst =
-  let rec loop i acc = function
-    | [] -> List.rev acc
-    | _ :: t when i = n -> List.rev_append acc t
-    | h :: t -> loop (i + 1) (h :: acc) t
-  in
-  loop 0 [] lst
+  List.filteri (fun i _ -> i <> n) lst
 
 let replace_at n value lst =
   List.mapi (fun i v -> if i = n then value else v) lst
 
+(* Common navigation for mutation operations *)
+
+let navigate_to_child token json ~on_object ~on_array ~on_other =
+  match json with
+  | Jsont.Object (members, meta) -> on_object members meta
+  | Jsont.Array (elements, meta) ->
+    (match Token.is_valid_array_index token with
+     | Some n -> on_array elements meta n
+     | None ->
+       Jsont.Error.msgf (Jsont.Json.meta json)
+         "JSON Pointer: invalid array index '%s'" token)
+  | _ -> on_other ()
+
+let error_member_not_found json token =
+  Jsont.Error.msgf (Jsont.Json.meta json) "JSON Pointer: member '%s' not found" token
+
+let error_index_out_of_bounds json n =
+  Jsont.Error.msgf (Jsont.Json.meta json) "JSON Pointer: index %d out of bounds" n
+
+let error_cannot_navigate json =
+  Jsont.Error.msgf (Jsont.Json.meta json)
+    "JSON Pointer: cannot navigate through %s" (json_sort_string json)
+
 (* Mutation: set *)
 
 let rec eval_set p value json =
···
   | [] -> value
   | [Segment.End] ->
     (match json with
-     | Jsont.Array (elements, meta) ->
-       Jsont.Array (elements @ [value], meta)
+     | Jsont.Array (elements, meta) -> Jsont.Array (elements @ [value], meta)
      | _ ->
        Jsont.Error.msgf (Jsont.Json.meta json)
          "JSON Pointer: '-' can only be used on arrays, got %s"
···
     Jsont.Error.msgf (Jsont.Json.meta json)
       "JSON Pointer: '-' (end marker) refers to nonexistent array element"
   | [Segment.Token token] ->
-    (match json with
-     | Jsont.Object (members, meta) ->
-       if Option.is_some (get_member token members) then
-         Jsont.Object (set_member token value members, meta)
-       else
-         Jsont.Error.msgf (Jsont.Json.meta json)
-           "JSON Pointer: member '%s' not found for set" token
-     | Jsont.Array (elements, meta) ->
-       (match Token.is_valid_array_index token with
-        | Some n when n >= 0 && n < List.length elements ->
+    navigate_to_child token json
+      ~on_object:(fun members meta ->
+        if Option.is_some (get_member token members) then
+          Jsont.Object (set_member token value members, meta)
+        else
+          Jsont.Error.msgf (Jsont.Json.meta json)
+            "JSON Pointer: member '%s' not found for set" token)
+      ~on_array:(fun elements meta n ->
+        if n < List.length elements then
           Jsont.Array (replace_at n value elements, meta)
-        | Some n ->
-          Jsont.Error.msgf (Jsont.Json.meta json)
-            "JSON Pointer: index %d out of bounds for set" n
-        | None ->
+        else
           Jsont.Error.msgf (Jsont.Json.meta json)
-            "JSON Pointer: invalid array index '%s'" token)
-     | _ ->
-       Jsont.Error.msgf (Jsont.Json.meta json)
-         "JSON Pointer: cannot set in %s" (json_sort_string json))
+            "JSON Pointer: index %d out of bounds for set" n)
+      ~on_other:(fun () ->
+        Jsont.Error.msgf (Jsont.Json.meta json)
+          "JSON Pointer: cannot set in %s" (json_sort_string json))
   | Segment.Token token :: rest ->
-    (match json with
-     | Jsont.Object (members, meta) ->
-       (match get_member token members with
+    navigate_to_child token json
+      ~on_object:(fun members meta ->
+        match get_member token members with
         | Some (_, child) ->
           Jsont.Object (set_member token (eval_set rest value child) members, meta)
-        | None ->
-          Jsont.Error.msgf (Jsont.Json.meta json)
-            "JSON Pointer: member '%s' not found" token)
-     | Jsont.Array (elements, meta) ->
-       (match Token.is_valid_array_index token with
-        | Some n ->
-          (match get_nth n elements with
-           | Some child ->
-             Jsont.Array (replace_at n (eval_set rest value child) elements, meta)
-           | None ->
-             Jsont.Error.msgf (Jsont.Json.meta json)
-               "JSON Pointer: index %d out of bounds" n)
-        | None ->
-          Jsont.Error.msgf (Jsont.Json.meta json)
-            "JSON Pointer: invalid array index '%s'" token)
-     | _ ->
-       Jsont.Error.msgf (Jsont.Json.meta json)
-         "JSON Pointer: cannot navigate through %s" (json_sort_string json))
+        | None -> error_member_not_found json token)
+      ~on_array:(fun elements meta n ->
+        match get_nth n elements with
+        | Some child ->
+          Jsont.Array (replace_at n (eval_set rest value child) elements, meta)
+        | None -> error_index_out_of_bounds json n)
+      ~on_other:(fun () -> error_cannot_navigate json)
 
 let set p json ~value = eval_set p value json
 
···
   | [] -> value
   | [Segment.End] ->
     (match json with
-     | Jsont.Array (elements, meta) ->
-       Jsont.Array (elements @ [value], meta)
+     | Jsont.Array (elements, meta) -> Jsont.Array (elements @ [value], meta)
      | _ ->
        Jsont.Error.msgf (Jsont.Json.meta json)
          "JSON Pointer: '-' can only be used on arrays, got %s"
···
     Jsont.Error.msgf (Jsont.Json.meta json)
       "JSON Pointer: '-' in non-final position"
   | [Segment.Token token] ->
-    (match json with
-     | Jsont.Object (members, meta) ->
-       (* For objects, add/replace member *)
-       Jsont.Object (set_member token value members, meta)
-     | Jsont.Array (elements, meta) ->
-       (* For arrays, insert at index *)
-       (match Token.is_valid_array_index token with
-        | Some n ->
-          let len = List.length elements in
-          if n >= 0 && n <= len then
-            Jsont.Array (insert_at n value elements, meta)
-          else
-            Jsont.Error.msgf (Jsont.Json.meta json)
-              "JSON Pointer: index %d out of bounds for add (array has %d elements)"
-              n len
-        | None ->
+    navigate_to_child token json
+      ~on_object:(fun members meta ->
+        Jsont.Object (set_member token value members, meta))
+      ~on_array:(fun elements meta n ->
+        let len = List.length elements in
+        if n <= len then
+          Jsont.Array (insert_at n value elements, meta)
+        else
           Jsont.Error.msgf (Jsont.Json.meta json)
-            "JSON Pointer: invalid array index '%s'" token)
-     | _ ->
-       Jsont.Error.msgf (Jsont.Json.meta json)
-         "JSON Pointer: cannot add to %s" (json_sort_string json))
+            "JSON Pointer: index %d out of bounds for add (array has %d elements)"
+            n len)
+      ~on_other:(fun () ->
+        Jsont.Error.msgf (Jsont.Json.meta json)
+          "JSON Pointer: cannot add to %s" (json_sort_string json))
   | Segment.Token token :: rest ->
-    (match json with
-     | Jsont.Object (members, meta) ->
-       (match get_member token members with
+    navigate_to_child token json
+      ~on_object:(fun members meta ->
+        match get_member token members with
         | Some (_, child) ->
           Jsont.Object (set_member token (eval_add rest value child) members, meta)
-        | None ->
-          Jsont.Error.msgf (Jsont.Json.meta json)
-            "JSON Pointer: member '%s' not found" token)
-     | Jsont.Array (elements, meta) ->
-       (match Token.is_valid_array_index token with
-        | Some n ->
-          (match get_nth n elements with
-           | Some child ->
-             Jsont.Array (replace_at n (eval_add rest value child) elements, meta)
-           | None ->
-             Jsont.Error.msgf (Jsont.Json.meta json)
-               "JSON Pointer: index %d out of bounds" n)
-        | None ->
-          Jsont.Error.msgf (Jsont.Json.meta json)
-            "JSON Pointer: invalid array index '%s'" token)
-     | _ ->
-       Jsont.Error.msgf (Jsont.Json.meta json)
-         "JSON Pointer: cannot navigate through %s" (json_sort_string json))
+        | None -> error_member_not_found json token)
+      ~on_array:(fun elements meta n ->
+        match get_nth n elements with
+        | Some child ->
+          Jsont.Array (replace_at n (eval_add rest value child) elements, meta)
+        | None -> error_index_out_of_bounds json n)
+      ~on_other:(fun () -> error_cannot_navigate json)
 
 let add p json ~value = eval_add p value json
 
···
 let rec eval_remove p json =
   match p with
   | [] ->
-    Jsont.Error.msgf Jsont.Meta.none
-      "JSON Pointer: cannot remove root document"
+    Jsont.Error.msgf Jsont.Meta.none "JSON Pointer: cannot remove root document"
   | [Segment.End] ->
     Jsont.Error.msgf (Jsont.Json.meta json)
       "JSON Pointer: '-' refers to nonexistent element"
···
     Jsont.Error.msgf (Jsont.Json.meta json)
       "JSON Pointer: '-' in non-final position"
   | [Segment.Token token] ->
-    (match json with
-     | Jsont.Object (members, meta) ->
-       if Option.is_some (get_member token members) then
-         Jsont.Object (remove_member token members, meta)
-       else
-         Jsont.Error.msgf (Jsont.Json.meta json)
-           "JSON Pointer: member '%s' not found for remove" token
-     | Jsont.Array (elements, meta) ->
-       (match Token.is_valid_array_index token with
-        | Some n when n >= 0 && n < List.length elements ->
+    navigate_to_child token json
+      ~on_object:(fun members meta ->
+        if Option.is_some (get_member token members) then
+          Jsont.Object (remove_member token members, meta)
+        else
+          Jsont.Error.msgf (Jsont.Json.meta json)
+            "JSON Pointer: member '%s' not found for remove" token)
+      ~on_array:(fun elements meta n ->
+        if n < List.length elements then
           Jsont.Array (remove_at n elements, meta)
-        | Some n ->
+        else
           Jsont.Error.msgf (Jsont.Json.meta json)
-            "JSON Pointer: index %d out of bounds for remove" n
-        | None ->
-          Jsont.Error.msgf (Jsont.Json.meta json)
-            "JSON Pointer: invalid array index '%s'" token)
-     | _ ->
-       Jsont.Error.msgf (Jsont.Json.meta json)
-         "JSON Pointer: cannot remove from %s" (json_sort_string json))
+            "JSON Pointer: index %d out of bounds for remove" n)
+      ~on_other:(fun () ->
+        Jsont.Error.msgf (Jsont.Json.meta json)
+          "JSON Pointer: cannot remove from %s" (json_sort_string json))
   | Segment.Token token :: rest ->
-    (match json with
-     | Jsont.Object (members, meta) ->
-       (match get_member token members with
+    navigate_to_child token json
+      ~on_object:(fun members meta ->
+        match get_member token members with
         | Some (_, child) ->
           Jsont.Object (set_member token (eval_remove rest child) members, meta)
-        | None ->
-          Jsont.Error.msgf (Jsont.Json.meta json)
-            "JSON Pointer: member '%s' not found" token)
-     | Jsont.Array (elements, meta) ->
-       (match Token.is_valid_array_index token with
-        | Some n ->
-          (match get_nth n elements with
-           | Some child ->
-             Jsont.Array (replace_at n (eval_remove rest child) elements, meta)
-           | None ->
-             Jsont.Error.msgf (Jsont.Json.meta json)
-               "JSON Pointer: index %d out of bounds" n)
-        | None ->
-          Jsont.Error.msgf (Jsont.Json.meta json)
-            "JSON Pointer: invalid array index '%s'" token)
-     | _ ->
-       Jsont.Error.msgf (Jsont.Json.meta json)
-         "JSON Pointer: cannot navigate through %s" (json_sort_string json))
+        | None -> error_member_not_found json token)
+      ~on_array:(fun elements meta n ->
+        match get_nth n elements with
+        | Some child ->
+          Jsont.Array (replace_at n (eval_remove rest child) elements, meta)
+        | None -> error_index_out_of_bounds json n)
+      ~on_other:(fun () -> error_cannot_navigate json)
 
 let remove p json = eval_remove p json
 
···
 
 (* Mutation: move *)
 
-let is_prefix_of p1 p2 =
-  let rec loop l1 l2 = match l1, l2 with
-    | [], _ -> true
-    | _, [] -> false
-    | h1 :: t1, h2 :: t2 ->
-      segment_equal h1 h2 && loop t1 t2
-  in
-  loop p1 p2
+let rec is_prefix_of p1 p2 =
+  match p1, p2 with
+  | [], _ -> true
+  | _, [] -> false
+  | h1 :: t1, h2 :: t2 -> segment_equal h1 h2 && is_prefix_of t1 t2
 
 let move ~from ~path json =
   (* Check for cycle: path cannot be a proper prefix of from *)
···
 (* Mutation: test *)
 
 let test p json ~expected =
-  match find p json with
-  | None -> false
-  | Some value -> Jsont.Json.equal value expected
+  Option.fold ~none:false ~some:(Jsont.Json.equal expected) (find p json)
 
 (* Jsont codec *)
 

src/jsont_pointer.mli

···
 (*---------------------------------------------------------------------------
-   Copyright (c) 2024 The jsont programmers. All rights reserved.
-   SPDX-License-Identifier: ISC
-  ---------------------------------------------------------------------------*)
+  Copyright (c) 2025 Anil Madhavapeddy <[e-mail]>. All rights reserved.
+  SPDX-License-Identifier: ISC
+ ---------------------------------------------------------------------------*)
 
 (** RFC 6901 JSON Pointer implementation for jsont.