Merge pull request #3 from mbarbin/fpart

Rename Fpart, reduce deps and add tests

CHANGES.md

@@ -1,3 +1,10 @@
+## 0.2.0 (2024-09-04)
+
+### Changed
+
+- Rename `File_name` into `Fpart`.
+- Remove need for ppx preprocessing.
+
 ## 0.1.0 (2024-09-03)
 
 ### Added

dune-project

@@ -21,43 +21,18 @@
  (depends
   (ocaml
    (>= 5.2))
-  (ocamlformat
-   (and
-    :with-dev-setup
-    (= 0.26.2)))
   (base
    (and
     (>= v0.17)
     (< v0.18)))
-  (bisect_ppx
-   (and
-    :with-dev-setup
-    (>= 2.8.3)))
   (fpath
    (>= 0.7.3))
   (fpath-sexp0
    (= :version))
-  (ppx_compare
-   (and
-    (>= v0.17)
-    (< v0.18)))
   (ppx_hash
    (and
     (>= v0.17)
     (< v0.18)))
-  (ppx_js_style
-   (and
-    :with-dev-setup
-    (>= v0.17)
-    (< v0.18)))
-  (ppx_sexp_conv
-   (and
-    (>= v0.17)
-    (< v0.18)))
-  (ppx_sexp_value
-   (and
-    (>= v0.17)
-    (< v0.18)))
   (ppxlib
    (>= 0.33))))
 
@@ -68,31 +43,8 @@
  (depends
   (ocaml
    (>= 5.2))
-  (ocamlformat
-   (and
-    :with-dev-setup
-    (= 0.26.2)))
-  (bisect_ppx
-   (and
-    :with-dev-setup
-    (>= 2.8.3)))
   (fpath
    (>= 0.7.3))
-  (ppx_js_style
-   (and
-    :with-dev-setup
-    (>= v0.17)
-    (< v0.18)))
-  (ppx_sexp_conv
-   (and
-    (>= v0.17)
-    (< v0.18)))
-  (ppx_sexp_value
-   (and
-    (>= v0.17)
-    (< v0.18)))
-  (ppxlib
-   (>= 0.33))
   (sexplib0
    (and
     (>= v0.17)

fpath-base.opam

@@ -10,16 +10,10 @@ bug-reports: "https://github.com/mbarbin/fpath-base/issues"
 depends: [
   "dune" {>= "3.16"}
   "ocaml" {>= "5.2"}
-  "ocamlformat" {with-dev-setup & = "0.26.2"}
   "base" {>= "v0.17" & < "v0.18"}
-  "bisect_ppx" {with-dev-setup & >= "2.8.3"}
   "fpath" {>= "0.7.3"}
   "fpath-sexp0" {= version}
-  "ppx_compare" {>= "v0.17" & < "v0.18"}
   "ppx_hash" {>= "v0.17" & < "v0.18"}
-  "ppx_js_style" {with-dev-setup & >= "v0.17" & < "v0.18"}
-  "ppx_sexp_conv" {>= "v0.17" & < "v0.18"}
-  "ppx_sexp_value" {>= "v0.17" & < "v0.18"}
   "ppxlib" {>= "0.33"}
   "odoc" {with-doc}
 ]

fpath-sexp0.opam

@@ -11,13 +11,7 @@ bug-reports: "https://github.com/mbarbin/fpath-base/issues"
 depends: [
   "dune" {>= "3.16"}
   "ocaml" {>= "5.2"}
-  "ocamlformat" {with-dev-setup & = "0.26.2"}
-  "bisect_ppx" {with-dev-setup & >= "2.8.3"}
   "fpath" {>= "0.7.3"}
-  "ppx_js_style" {with-dev-setup & >= "v0.17" & < "v0.18"}
-  "ppx_sexp_conv" {>= "v0.17" & < "v0.18"}
-  "ppx_sexp_value" {>= "v0.17" & < "v0.18"}
-  "ppxlib" {>= "0.33"}
   "sexplib0" {>= "v0.17" & < "v0.18"}
   "odoc" {with-doc}
 ]

lib/fpath_base/src/dune

@@ -8,9 +8,4 @@
  (lint
   (pps ppx_js_style -check-doc-comments))
  (preprocess
-  (pps
-   -unused-code-warnings=force
-   ppx_compare
-   ppx_hash
-   ppx_sexp_conv
-   ppx_sexp_value)))
+  (pps -unused-code-warnings=force ppx_hash)))

lib/fpath_base/src/fpath_base.ml

@@ -25,8 +25,8 @@ module Relative_path = struct
   let hash_fold_t state t = String.hash_fold_t state (T.to_string t)
 end
 
-module File_name = struct
-  module T = Fpath_sexp0.File_name
+module Fpart = struct
+  module T = Fpath_sexp0.Fpart
   include T
   include Comparable.Make (T)
 

lib/fpath_base/src/fpath_base.mli

@@ -19,9 +19,9 @@ module Relative_path : sig
   include Comparable.S with type t := t
 end
 
-module File_name : sig
-  type t = Fpath_sexp0.File_name.t [@@deriving hash]
+module Fpart : sig
+  type t = Fpath_sexp0.Fpart.t [@@deriving hash]
 
-  include module type of Fpath_sexp0.File_name with type t := t
+  include module type of Fpath_sexp0.Fpart with type t := t
   include Comparable.S with type t := t
 end

lib/fpath_base/test/test__absolute_path.ml

@@ -88,11 +88,11 @@ let%expect_test "append" =
 
 let%expect_test "extend" =
   let abs = Absolute_path.v in
-  let file str = str |> File_name.v in
+  let file str = str |> Fpart.v in
   let test a b = print_s [%sexp (Absolute_path.extend a b : Absolute_path.t)] in
-  require_does_raise [%here] (fun () : File_name.t -> file "a/b");
-  [%expect {| (Invalid_argument "a/b: invalid file name") |}];
-  require_does_not_raise [%here] (fun () -> ignore (file ".." : File_name.t));
+  require_does_raise [%here] (fun () : Fpart.t -> file "a/b");
+  [%expect {| (Invalid_argument "a/b: invalid file part") |}];
+  require_does_not_raise [%here] (fun () -> ignore (file ".." : Fpart.t));
   [%expect {||}];
   test (abs "/") (file "a");
   [%expect {| /a |}];
@@ -288,3 +288,35 @@ let%expect_test "relativize" =
   [%expect {| /foo/bar |}];
   ()
 ;;
+
+let%expect_test "hashtbl" =
+  let t = Hashtbl.create (module Absolute_path) in
+  Hashtbl.set t ~key:(Absolute_path.v "/tmp/my-file") ~data:42;
+  print_s [%sexp (t : int Hashtbl.M(Absolute_path).t)];
+  [%expect {| ((/tmp/my-file 42)) |}]
+;;
+
+module Pair = struct
+  [@@@coverage off]
+
+  type t =
+    { a : Absolute_path.t
+    ; b : Absolute_path.t
+    }
+  [@@deriving compare, hash, sexp_of]
+end
+
+let%expect_test "hash-fold-t" =
+  let t = Hashtbl.create (module Pair) in
+  Hashtbl.set
+    t
+    ~key:{ a = Absolute_path.v "/tmp/a"; b = Absolute_path.v "/tmp/a" }
+    ~data:42;
+  print_s [%sexp (t : int Hashtbl.M(Pair).t)];
+  [%expect {|
+    ((
+      ((a /tmp/a)
+       (b /tmp/a))
+      42))
+    |}]
+;;

lib/fpath_base/test/test__fpart.ml

@@ -0,0 +1,61 @@
+let%expect_test "of_string" =
+  let test str =
+    print_s [%sexp (Fpart.of_string str : (Fpart.t, [ `Msg of string ]) Result.t)]
+  in
+  test "";
+  [%expect {| (Error (Msg ": invalid file part")) |}];
+  test "a";
+  [%expect {| (Ok a) |}];
+  test ".a";
+  [%expect {| (Ok .a) |}];
+  test "..";
+  [%expect {| (Ok ..) |}];
+  test "/";
+  [%expect {| (Error (Msg "/: invalid file part")) |}];
+  test "a/b";
+  [%expect {| (Error (Msg "a/b: invalid file part")) |}];
+  test "a\000b";
+  [%expect {| (Error (Msg "a\000b: invalid file part")) |}];
+  ()
+;;
+
+let%expect_test "hard coded" =
+  List.iter
+    ~f:(fun (name, t) -> print_endline (Printf.sprintf "%10s: " name ^ Fpart.to_string t))
+    Fpart.[ "dot", dot; "dot_dot", dot_dot; "dot_git", dot_git; "dot_hg", dot_hg ];
+  [%expect {|
+        dot: .
+    dot_dot: ..
+    dot_git: .git
+     dot_hg: .hg |}];
+  ()
+;;
+
+let%expect_test "hashtbl" =
+  let t = Hashtbl.create (module Fpart) in
+  Hashtbl.set t ~key:(Fpart.v "my-file") ~data:42;
+  print_s [%sexp (t : int Hashtbl.M(Fpart).t)];
+  [%expect {| ((my-file 42)) |}]
+;;
+
+module Pair = struct
+  [@@@coverage off]
+
+  type t =
+    { a : Fpart.t
+    ; b : Fpart.t
+    }
+  [@@deriving compare, hash, sexp_of]
+end
+
+let%expect_test "hash-fold-t" =
+  let t = Hashtbl.create (module Pair) in
+  Hashtbl.set t ~key:{ a = Fpart.v "a"; b = Fpart.v "b" } ~data:42;
+  print_s [%sexp (t : int Hashtbl.M(Pair).t)];
+  [%expect {|
+    ((
+      ((a a)
+       (b b))
+      42))
+    |}]
+;;

lib/fpath_base/test/test__relative_path.ml

@@ -105,11 +105,11 @@ let%expect_test "append" =
 
 let%expect_test "extend" =
   let rel = Relative_path.v in
-  let file str = str |> File_name.v in
+  let file str = str |> Fpart.v in
   let test a b = print_s [%sexp (Relative_path.extend a b : Relative_path.t)] in
-  require_does_raise [%here] (fun () : File_name.t -> file "a/b");
-  [%expect {| (Invalid_argument "a/b: invalid file name") |}];
-  require_does_not_raise [%here] (fun () -> ignore (file ".." : File_name.t));
+  require_does_raise [%here] (fun () : Fpart.t -> file "a/b");
+  [%expect {| (Invalid_argument "a/b: invalid file part") |}];
+  require_does_not_raise [%here] (fun () -> ignore (file ".." : Fpart.t));
   [%expect {| |}];
   test Relative_path.empty (file "a");
   [%expect {| a |}];
@@ -155,7 +155,7 @@ let%expect_test "parent" =
 
 let%expect_test "of_list" =
   let test files =
-    let result = Relative_path.of_list (List.map files ~f:File_name.v) in
+    let result = Relative_path.of_list (List.map files ~f:Fpart.v) in
     print_s [%sexp (result : Relative_path.t)]
   in
   test [];
@@ -291,3 +291,35 @@ let%expect_test "to_dir_path" =
   [%expect {| ./ |}];
   ()
 ;;
+
+let%expect_test "hashtbl" =
+  let t = Hashtbl.create (module Relative_path) in
+  Hashtbl.set t ~key:(Relative_path.v "path/to/my-file") ~data:42;
+  print_s [%sexp (t : int Hashtbl.M(Relative_path).t)];
+  [%expect {| ((path/to/my-file 42)) |}]
+;;
+
+module Pair = struct
+  [@@@coverage off]
+
+  type t =
+    { a : Relative_path.t
+    ; b : Relative_path.t
+    }
+  [@@deriving compare, hash, sexp_of]
+end
+
+let%expect_test "hash-fold-t" =
+  let t = Hashtbl.create (module Pair) in
+  Hashtbl.set
+    t
+    ~key:{ a = Relative_path.v "path/to/a"; b = Relative_path.v "path/to/b" }
+    ~data:42;
+  print_s [%sexp (t : int Hashtbl.M(Pair).t)];
+  [%expect {|
+    ((
+      ((a path/to/a)
+       (b path/to/b))
+      42))
+    |}]
+;;

lib/fpath_sexp0/src/dune

@@ -7,5 +7,4 @@
   (backend bisect_ppx))
  (lint
   (pps ppx_js_style -check-doc-comments))
- (preprocess
-  (pps -unused-code-warnings=force ppx_sexp_conv ppx_sexp_value)))
+ (preprocess no_preprocessing))

lib/fpath_sexp0/src/file_name.ml → lib/fpath_sexp0/src/fpart.ml

@@ -12,7 +12,7 @@ let invariant t =
 let to_string t = t
 
 let of_string s =
-  if invariant s then Ok s else Error (`Msg (Printf.sprintf "%s: invalid file name" s))
+  if invariant s then Ok s else Error (`Msg (Printf.sprintf "%s: invalid file part" s))
 ;;
 
 let v t =