From e8147638919d542c295c4bac3223972291f4bdd0 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Tue, 3 Sep 2024 14:39:25 +0200 Subject: [PATCH] Introduce fpath-sexp0 - split package dependencies --- .github/workflows/ci.yml | 2 +- CHANGES.md | 11 +- Makefile | 2 +- dune-project | 60 ++++- fpath-base-tests.opam | 6 +- fpath-base.opam | 9 +- fpath-sexp0.opam | 38 ++++ {src => lib/fpath_base/src}/dune | 5 +- lib/fpath_base/src/fpath_base.ml | 35 +++ lib/fpath_base/src/fpath_base.mli | 27 +++ {test => lib/fpath_base/test}/dune | 0 .../fpath_base/test}/test__absolute_path.ml | 205 +++++------------- .../fpath_base/test}/test__absolute_path.mli | 0 .../fpath_base/test}/test__file_name.ml | 12 +- .../fpath_base/test}/test__file_name.mli | 0 {test => lib/fpath_base/test}/test__fpath.ml | 192 ++++++++-------- {test => lib/fpath_base/test}/test__fpath.mli | 0 .../fpath_base/test}/test__relative_path.ml | 171 ++++----------- .../fpath_base/test}/test__relative_path.mli | 0 lib/fpath_sexp0/src/dune | 11 + lib/fpath_sexp0/src/file_name.ml | 27 +++ {src => lib/fpath_sexp0/src}/file_name.mli | 8 +- lib/fpath_sexp0/src/fpath0.ml | 5 + lib/fpath_sexp0/src/fpath0.mli | 6 + .../fpath_sexp0/src/fpath_sexp0.ml | 0 .../fpath_sexp0/src/fpath_sexp0.mli | 0 lib/fpath_sexp0/src/path.ml | 118 ++++++++++ {src => lib/fpath_sexp0/src}/path.mli | 36 +-- lib/fpath_sexp0/test/dune | 36 +++ src/file_name.ml | 20 -- src/fpath0.ml | 11 - src/fpath0.mli | 12 - src/path.ml | 123 ----------- 33 files changed, 581 insertions(+), 607 deletions(-) create mode 100644 fpath-sexp0.opam rename {src => lib/fpath_base/src}/dune (83%) create mode 100644 lib/fpath_base/src/fpath_base.ml create mode 100644 lib/fpath_base/src/fpath_base.mli rename {test => lib/fpath_base/test}/dune (100%) rename {test => lib/fpath_base/test}/test__absolute_path.ml (61%) rename {test => lib/fpath_base/test}/test__absolute_path.mli (100%) rename {test => lib/fpath_base/test}/test__file_name.ml (58%) rename {test => lib/fpath_base/test}/test__file_name.mli (100%) rename {test => lib/fpath_base/test}/test__fpath.ml (50%) rename {test => lib/fpath_base/test}/test__fpath.mli (100%) rename {test => lib/fpath_base/test}/test__relative_path.ml (66%) rename {test => lib/fpath_base/test}/test__relative_path.mli (100%) create mode 100644 lib/fpath_sexp0/src/dune create mode 100644 lib/fpath_sexp0/src/file_name.ml rename {src => lib/fpath_sexp0/src}/file_name.mli (83%) create mode 100644 lib/fpath_sexp0/src/fpath0.ml create mode 100644 lib/fpath_sexp0/src/fpath0.mli rename src/fpath_base.ml => lib/fpath_sexp0/src/fpath_sexp0.ml (100%) rename src/fpath_base.mli => lib/fpath_sexp0/src/fpath_sexp0.mli (100%) create mode 100644 lib/fpath_sexp0/src/path.ml rename {src => lib/fpath_sexp0/src}/path.mli (67%) create mode 100644 lib/fpath_sexp0/test/dune delete mode 100644 src/file_name.ml delete mode 100644 src/fpath0.ml delete mode 100644 src/fpath0.mli delete mode 100644 src/path.ml diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index be4407d..48c10a8 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -31,7 +31,7 @@ jobs: # janestreet-bleeding-external: https://github.com/janestreet/opam-repository.git#external-packages - name: Install dependencies - run: opam install . --deps-only --with-doc --with-test + run: opam install . --deps-only --with-doc --with-test --with-dev-setup - name: Build run: opam exec -- dune build @all @lint diff --git a/CHANGES.md b/CHANGES.md index 0fd3348..666814a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,17 +1,14 @@ -## 0.0.11 (unreleased) +## 0.1.0 (2024-09-03) ### Added +- Added minimal library depending on `sexplib0` only. + ### Changed +- Rewrite `Fpath_base` on top of `Fpath_sexp0`. - Remove vendor, use `expect_test_helpers_core.expect_test_helpers_base`. -### Deprecated - -### Fixed - -### Removed - ## 0.0.10 (2024-07-26) ### Added diff --git a/Makefile b/Makefile index 55239e3..f37bffd 100644 --- a/Makefile +++ b/Makefile @@ -20,7 +20,7 @@ lint: .PHONY: deps deps: - opam install . --deps-only --with-doc --with-test + opam install . --deps-only --with-doc --with-test --with-dev-setup .PHONY: doc doc: diff --git a/dune-project b/dune-project index 6015c0c..d2a31d5 100644 --- a/dune-project +++ b/dune-project @@ -21,39 +21,66 @@ (depends (ocaml (>= 5.2)) + (ocamlformat + (and + :with-dev-setup + (= 0.26.2))) (base (and (>= v0.17) (< v0.18))) (bisect_ppx (and - :dev + :with-dev-setup (>= 2.8.3))) (fpath (>= 0.7.3)) + (fpath-sexp0 + (= :version)) (ppx_compare (and (>= v0.17) (< v0.18))) - (ppx_enumerate + (ppx_hash (and (>= v0.17) (< v0.18))) - (ppx_hash + (ppx_js_style (and + :with-dev-setup (>= v0.17) (< v0.18))) - (ppx_here + (ppx_sexp_conv (and (>= v0.17) (< v0.18))) - (ppx_js_style + (ppx_sexp_value (and - :dev (>= v0.17) (< v0.18))) - (ppx_let + (ppxlib + (>= 0.33)))) + +(package + (name fpath-sexp0) + (synopsis + "Adding sexp converters to Fpath as well as Abs and Rel path modules") + (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 @@ -65,7 +92,11 @@ (>= v0.17) (< v0.18))) (ppxlib - (>= 0.33)))) + (>= 0.33)) + (sexplib0 + (and + (>= v0.17) + (< v0.18))))) (package (name fpath-base-tests) @@ -73,6 +104,10 @@ (depends (ocaml (>= 5.2)) + (ocamlformat + (and + :with-dev-setup + (= 0.26.2))) (base (and (>= v0.17) @@ -83,7 +118,7 @@ (< v0.18))) (bisect_ppx (and - :dev + :with-dev-setup (>= 2.8.3))) (expect_test_helpers_core (and @@ -93,6 +128,8 @@ (>= 0.7.3)) (fpath-base (= :version)) + (fpath-sexp0 + (= :version)) (ppx_compare (and (>= v0.17) @@ -115,7 +152,7 @@ (< v0.18))) (ppx_js_style (and - :dev + :with-dev-setup (>= v0.17) (< v0.18))) (ppx_let @@ -133,8 +170,7 @@ (ppxlib (>= 0.33)) (re - (and - (>= 1.8.0))) + (>= 1.8.0)) (sexp_pretty (and (>= v0.17) diff --git a/fpath-base-tests.opam b/fpath-base-tests.opam index 99a13c6..86d5428 100644 --- a/fpath-base-tests.opam +++ b/fpath-base-tests.opam @@ -10,18 +10,20 @@ 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"} "base_quickcheck" {>= "v0.17" & < "v0.18"} - "bisect_ppx" {dev & >= "2.8.3"} + "bisect_ppx" {with-dev-setup & >= "2.8.3"} "expect_test_helpers_core" {>= "v0.17" & < "v0.18"} "fpath" {>= "0.7.3"} "fpath-base" {= version} + "fpath-sexp0" {= version} "ppx_compare" {>= "v0.17" & < "v0.18"} "ppx_enumerate" {>= "v0.17" & < "v0.18"} "ppx_expect" {>= "v0.17" & < "v0.18"} "ppx_hash" {>= "v0.17" & < "v0.18"} "ppx_here" {>= "v0.17" & < "v0.18"} - "ppx_js_style" {dev & >= "v0.17" & < "v0.18"} + "ppx_js_style" {with-dev-setup & >= "v0.17" & < "v0.18"} "ppx_let" {>= "v0.17" & < "v0.18"} "ppx_sexp_conv" {>= "v0.17" & < "v0.18"} "ppx_sexp_value" {>= "v0.17" & < "v0.18"} diff --git a/fpath-base.opam b/fpath-base.opam index 2457aa5..7a8376a 100644 --- a/fpath-base.opam +++ b/fpath-base.opam @@ -10,15 +10,14 @@ 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" {dev & >= "2.8.3"} + "bisect_ppx" {with-dev-setup & >= "2.8.3"} "fpath" {>= "0.7.3"} + "fpath-sexp0" {= version} "ppx_compare" {>= "v0.17" & < "v0.18"} - "ppx_enumerate" {>= "v0.17" & < "v0.18"} "ppx_hash" {>= "v0.17" & < "v0.18"} - "ppx_here" {>= "v0.17" & < "v0.18"} - "ppx_js_style" {dev & >= "v0.17" & < "v0.18"} - "ppx_let" {>= "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"} diff --git a/fpath-sexp0.opam b/fpath-sexp0.opam new file mode 100644 index 0000000..868947f --- /dev/null +++ b/fpath-sexp0.opam @@ -0,0 +1,38 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: + "Adding sexp converters to Fpath as well as Abs and Rel path modules" +maintainer: ["Mathieu Barbin"] +authors: ["Mathieu Barbin"] +license: "MIT" +homepage: "https://github.com/mbarbin/fpath-base" +doc: "https://mbarbin.github.io/fpath-base/" +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} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/mbarbin/fpath-base.git" diff --git a/src/dune b/lib/fpath_base/src/dune similarity index 83% rename from src/dune rename to lib/fpath_base/src/dune index 48704e8..9525c67 100644 --- a/src/dune +++ b/lib/fpath_base/src/dune @@ -2,7 +2,7 @@ (name fpath_base) (public_name fpath-base) (flags :standard -w +a-4-40-41-42-44-45-48-66 -warn-error +a -open Base) - (libraries base fpath) + (libraries base fpath fpath_sexp0) (instrumentation (backend bisect_ppx)) (lint @@ -11,9 +11,6 @@ (pps -unused-code-warnings=force ppx_compare - ppx_enumerate ppx_hash - ppx_here - ppx_let ppx_sexp_conv ppx_sexp_value))) diff --git a/lib/fpath_base/src/fpath_base.ml b/lib/fpath_base/src/fpath_base.ml new file mode 100644 index 0000000..676024a --- /dev/null +++ b/lib/fpath_base/src/fpath_base.ml @@ -0,0 +1,35 @@ +module Fpath = struct + module T = Fpath_sexp0.Fpath + include T + include Comparable.Make (T) + + let hash t = String.hash (T.to_string t) + let hash_fold_t state t = String.hash_fold_t state (T.to_string t) +end + +module Absolute_path = struct + module T = Fpath_sexp0.Absolute_path + include T + include Comparable.Make (T) + + let hash t = String.hash (T.to_string t) + let hash_fold_t state t = String.hash_fold_t state (T.to_string t) +end + +module Relative_path = struct + module T = Fpath_sexp0.Relative_path + include T + include Comparable.Make (T) + + let hash t = String.hash (T.to_string t) + 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 + include T + include Comparable.Make (T) + + let hash t = String.hash (T.to_string t) + let hash_fold_t state t = String.hash_fold_t state (T.to_string t) +end diff --git a/lib/fpath_base/src/fpath_base.mli b/lib/fpath_base/src/fpath_base.mli new file mode 100644 index 0000000..3b4f3ef --- /dev/null +++ b/lib/fpath_base/src/fpath_base.mli @@ -0,0 +1,27 @@ +module Fpath : sig + type t = Fpath_sexp0.Fpath.t [@@deriving hash] + + include module type of Fpath_sexp0.Fpath with type t := t + include Comparable.S with type t := t +end + +module Absolute_path : sig + type t = Fpath_sexp0.Absolute_path.t [@@deriving hash] + + include module type of Fpath_sexp0.Absolute_path with type t := t + include Comparable.S with type t := t +end + +module Relative_path : sig + type t = Fpath_sexp0.Relative_path.t [@@deriving hash] + + include module type of Fpath_sexp0.Relative_path with type t := t + include Comparable.S with type t := t +end + +module File_name : sig + type t = Fpath_sexp0.File_name.t [@@deriving hash] + + include module type of Fpath_sexp0.File_name with type t := t + include Comparable.S with type t := t +end diff --git a/test/dune b/lib/fpath_base/test/dune similarity index 100% rename from test/dune rename to lib/fpath_base/test/dune diff --git a/test/test__absolute_path.ml b/lib/fpath_base/test/test__absolute_path.ml similarity index 61% rename from test/test__absolute_path.ml rename to lib/fpath_base/test/test__absolute_path.ml index 690e8aa..29e1760 100644 --- a/test/test__absolute_path.ml +++ b/lib/fpath_base/test/test__absolute_path.ml @@ -1,13 +1,15 @@ let%expect_test "of_string" = let test str = - print_s [%sexp (Absolute_path.of_string str : Absolute_path.t Or_error.t)] + print_s + [%sexp + (Absolute_path.of_string str : (Absolute_path.t, [ `Msg of string ]) Result.t)] in test ""; - [%expect {| (Error (Absolute_path.of_string "\"\": invalid path")) |}]; + [%expect {| (Error (Msg "\"\": invalid path")) |}]; test "/"; [%expect {| (Ok /) |}]; test "a"; - [%expect {| (Error ("Absolute_path.of_fpath: not an absolute path" a)) |}]; + [%expect {| (Error (Msg "\"a\": not an absolute path")) |}]; test "/a/b/../.."; [%expect {| (Ok /) |}]; () @@ -15,15 +17,15 @@ let%expect_test "of_string" = let%expect_test "v" = require_does_raise [%here] (fun () -> Absolute_path.v ""); - [%expect {| (Absolute_path.of_string "\"\": invalid path") |}]; + [%expect {| (Invalid_argument "\"\": invalid path") |}]; () ;; let%expect_test "of_fpath" = let test_fpath f = let t = Absolute_path.of_fpath f in - if Result.is_error t then print_s [%sexp (t : Absolute_path.t Or_error.t)]; - Or_error.iter t ~f:(fun t -> + if Option.is_none t then print_s [%sexp "not an absolute path"]; + Option.iter t ~f:(fun t -> print_endline (Absolute_path.to_string t); let f' = Absolute_path.to_fpath t in if Fpath.equal f f' @@ -49,7 +51,7 @@ let%expect_test "of_fpath" = (f /.) (f' /))) |}]; test_fpath (Fpath.v "a/relative/path"); - [%expect {| (Error ("Absolute_path.of_fpath: not an absolute path" a/relative/path)) |}]; + [%expect {| "not an absolute path" |}]; require_does_raise [%here] (fun () -> Fpath.v ""); [%expect {| (Invalid_argument "\"\": invalid path") |}]; () @@ -89,7 +91,7 @@ let%expect_test "extend" = let file str = str |> File_name.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 {| ("File_name.of_string: invalid file name" a/b) |}]; + [%expect {| (Invalid_argument "a/b: invalid file name") |}]; require_does_not_raise [%here] (fun () -> ignore (file ".." : File_name.t)); [%expect {||}]; test (abs "/") (file "a"); @@ -137,68 +139,43 @@ let%expect_test "parent" = let%expect_test "chop_prefix" = let abs = Absolute_path.v in let test prefix path = - let result = Absolute_path.chop_prefix ~prefix path in - print_s [%sexp (result : Relative_path.t Or_error.t)] + let result = Absolute_path.chop_prefix path ~prefix in + print_s [%sexp (result : Relative_path.t option)] in test (abs "/foo") (abs "/foo/bar"); - [%expect {| (Ok bar) |}]; + [%expect {| (bar) |}]; test (abs "/foo/") (abs "/foo/bar"); - [%expect {| (Ok bar) |}]; + [%expect {| (bar) |}]; test (abs "/foo") (abs "/foo/bar/"); - [%expect {| (Ok bar/) |}]; + [%expect {| (bar/) |}]; test (abs "/foo/") (abs "/foo/bar/"); - [%expect {| (Ok bar/) |}]; + [%expect {| (bar/) |}]; test (abs "/foo/") (abs "/foo/"); - [%expect {| (Ok ./) |}]; + [%expect {| (./) |}]; test (abs "/foo") (abs "/foo/"); - [%expect {| (Ok ./) |}]; + [%expect {| (./) |}]; test (abs "/foo") (abs "/foo"); - [%expect {| (Ok ./) |}]; + [%expect {| (./) |}]; test (abs "/foo/") (abs "/foo"); - [%expect - {| - (Error ( - "Absolute_path.chop_prefix: not a prefix" ( - (prefix /foo/) - (t /foo)))) |}]; + [%expect {| () |}]; test (abs "/foo") (abs "/foo/bar/baz"); - [%expect {| (Ok bar/baz) |}]; + [%expect {| (bar/baz) |}]; test (abs "/foo") (abs "/bar/baz"); - [%expect - {| - (Error ( - "Absolute_path.chop_prefix: not a prefix" ( - (prefix /foo) - (t /bar/baz)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar") (abs "/foo"); - [%expect - {| - (Error ( - "Absolute_path.chop_prefix: not a prefix" ( - (prefix /foo/bar) - (t /foo)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar") (abs "/foo/bar/baz"); - [%expect {| (Ok baz) |}]; + [%expect {| (baz) |}]; test (abs "/foo/bar") (abs "/foo/bar/baz/qux"); - [%expect {| (Ok baz/qux) |}]; + [%expect {| (baz/qux) |}]; (* Paths are normalized before the function call. *) test (abs "/foo/bar") (abs "/foo/bar/../baz"); - [%expect - {| - (Error ( - "Absolute_path.chop_prefix: not a prefix" ( - (prefix /foo/bar) - (t /foo/baz)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar") (abs "/foo/sna/../bar/baz"); - [%expect {|(Ok baz) |}]; + [%expect {| (baz) |}]; (* Beware of string prefix vs path prefix *) test (abs "/foo/bar") (abs "/foo/bar-baz"); - [%expect - {| - (Error ( - "Absolute_path.chop_prefix: not a prefix" ( - (prefix /foo/bar) - (t /foo/bar-baz)))) |}]; + [%expect {| () |}]; () ;; @@ -207,133 +184,53 @@ let%expect_test "chop_suffix" = let rel = Relative_path.v in let test path suffix = let result = Absolute_path.chop_suffix path ~suffix in - print_s [%sexp (result : Absolute_path.t Or_error.t)] + print_s [%sexp (result : Absolute_path.t option)] in test (abs "/foo/bar") (rel "bar"); - [%expect {| (Ok /foo) |}]; + [%expect {| (/foo) |}]; test (abs "/foo/bar") (rel "bar/"); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /foo/bar) - (suffix bar/)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar/") (rel "bar"); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /foo/bar/) - (suffix bar)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar/") (rel "bar/"); - [%expect {| (Ok /foo) |}]; + [%expect {| (/foo) |}]; test (abs "/foo/bar") (rel "."); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /foo/bar) - (suffix ./)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar/") (rel "."); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /foo/bar/) - (suffix ./)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar/.") (rel "."); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /foo/bar/) - (suffix ./)))) |}]; + [%expect {| () |}]; test (abs "/bar") (rel "foo/bar"); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /bar) - (suffix foo/bar)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar") (rel "foo/bar"); - [%expect {| (Ok /) |}]; + [%expect {| (/) |}]; test (abs "/foo/bar") (rel "bar/"); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /foo/bar) - (suffix bar/)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar/") (rel "bar"); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /foo/bar/) - (suffix bar)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar/") (rel "bar/"); - [%expect {| (Ok /foo) |}]; + [%expect {| (/foo) |}]; test (abs "/foo/bar") (rel "baz"); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /foo/bar) - (suffix baz)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar/baz") (rel "bar/baz"); - [%expect {| (Ok /foo) |}]; + [%expect {| (/foo) |}]; test (abs "/foo/bar/baz") (rel "baz/qux"); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /foo/bar/baz) - (suffix baz/qux)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar/baz") (rel "."); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /foo/bar/baz) - (suffix ./)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar/baz/") (rel "."); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /foo/bar/baz/) - (suffix ./)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar/baz") (rel "./"); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /foo/bar/baz) - (suffix ./)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar/baz/") (rel "./"); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /foo/bar/baz/) - (suffix ./)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar/baz") (rel ".."); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /foo/bar/baz) - (suffix ../)))) |}]; + [%expect {| () |}]; test (abs "/foo/bar/baz") (rel "foo/../baz"); - [%expect {| (Ok /foo/bar) |}]; + [%expect {| (/foo/bar) |}]; (* Beware of string suffix vs path suffix *) test (abs "/foo/bar-baz") (rel "-baz"); - [%expect - {| - (Error ( - "Absolute_path.chop_suffix: not a suffix" ( - (t /foo/bar-baz) - (suffix -baz)))) |}]; + [%expect {| () |}]; () ;; diff --git a/test/test__absolute_path.mli b/lib/fpath_base/test/test__absolute_path.mli similarity index 100% rename from test/test__absolute_path.mli rename to lib/fpath_base/test/test__absolute_path.mli diff --git a/test/test__file_name.ml b/lib/fpath_base/test/test__file_name.ml similarity index 58% rename from test/test__file_name.ml rename to lib/fpath_base/test/test__file_name.ml index f6625b8..eca8dd6 100644 --- a/test/test__file_name.ml +++ b/lib/fpath_base/test/test__file_name.ml @@ -1,7 +1,9 @@ let%expect_test "of_string" = - let test str = print_s [%sexp (File_name.of_string str : File_name.t Or_error.t)] in + let test str = + print_s [%sexp (File_name.of_string str : (File_name.t, [ `Msg of string ]) Result.t)] + in test ""; - [%expect {| (Error ("File_name.of_string: invalid file name" "")) |}]; + [%expect {| (Error (Msg ": invalid file name")) |}]; test "a"; [%expect {| (Ok a) |}]; test ".a"; @@ -9,11 +11,11 @@ let%expect_test "of_string" = test ".."; [%expect {| (Ok ..) |}]; test "/"; - [%expect {| (Error ("File_name.of_string: invalid file name" /)) |}]; + [%expect {| (Error (Msg "/: invalid file name")) |}]; test "a/b"; - [%expect {| (Error ("File_name.of_string: invalid file name" a/b)) |}]; + [%expect {| (Error (Msg "a/b: invalid file name")) |}]; test "a\000b"; - [%expect {| (Error ("File_name.of_string: invalid file name" "a\000b")) |}]; + [%expect {| (Error (Msg "a\000b: invalid file name")) |}]; () ;; diff --git a/test/test__file_name.mli b/lib/fpath_base/test/test__file_name.mli similarity index 100% rename from test/test__file_name.mli rename to lib/fpath_base/test/test__file_name.mli diff --git a/test/test__fpath.ml b/lib/fpath_base/test/test__fpath.ml similarity index 50% rename from test/test__fpath.ml rename to lib/fpath_base/test/test__fpath.ml index 8444114..d915049 100644 --- a/test/test__fpath.ml +++ b/lib/fpath_base/test/test__fpath.ml @@ -116,15 +116,6 @@ let%expect_test "classify" = () ;; -module Hide_error = struct - type 'a t = 'a Or_error.t - - let sexp_of_t sexp_of_a : _ t -> Sexp.t = function - | Ok a -> [%sexp Ok (a : a)] - | Error _ -> [%sexp Error "_"] - ;; -end - let%expect_test "chop_prefix and chop_suffix" = List.iter ~f:(fun (a, b) -> @@ -143,7 +134,7 @@ let%expect_test "chop_prefix and chop_suffix" = (a : Absolute_path.t) , (b : Absolute_path.t) , "==> chop_prefix" - , (Absolute_path.chop_prefix ~prefix:a b : Relative_path.t Hide_error.t)] + , (Absolute_path.chop_prefix b ~prefix:a : Relative_path.t option)] | `Relative _, `Absolute _ -> assert false | `Absolute a, `Relative b -> print_s @@ -151,14 +142,14 @@ let%expect_test "chop_prefix and chop_suffix" = (a : Absolute_path.t) , (b : Relative_path.t) , "==> chop_suffix" - , (Absolute_path.chop_suffix a ~suffix:b : Absolute_path.t Hide_error.t)] + , (Absolute_path.chop_suffix a ~suffix:b : Absolute_path.t option)] | `Relative a, `Relative b -> print_s [%sexp (a : Relative_path.t) , (b : Relative_path.t) , "==> chop_prefix" - , (Relative_path.chop_prefix ~prefix:a b : Relative_path.t Hide_error.t)])) + , (Relative_path.chop_prefix b ~prefix:a : Relative_path.t option)])) [ "/", "." ; "/", "a" ; "/a", "a" @@ -184,93 +175,94 @@ let%expect_test "chop_prefix and chop_suffix" = ]; [%expect {| - (/ ./ "==> chop_suffix" (Error _)) - (/ ./ "==> chop_suffix" (Error _)) - (/ ./ "==> chop_suffix" (Error _)) - (/ ./ "==> chop_suffix" (Error _)) - (/ a "==> chop_suffix" (Error _)) - (/ a "==> chop_suffix" (Error _)) - (/ a/ "==> chop_suffix" (Error _)) - (/ a/ "==> chop_suffix" (Error _)) - (/a a "==> chop_suffix" (Ok /)) - (/a/ a "==> chop_suffix" (Error _)) - (/a a/ "==> chop_suffix" (Error _)) - (/a/ a/ "==> chop_suffix" (Ok /)) - (/a b "==> chop_suffix" (Error _)) - (/a/ b "==> chop_suffix" (Error _)) - (/a b/ "==> chop_suffix" (Error _)) - (/a/ b/ "==> chop_suffix" (Error _)) - (/a/b b "==> chop_suffix" (Ok /a)) - (/a/b/ b "==> chop_suffix" (Error _)) - (/a/b b/ "==> chop_suffix" (Error _)) - (/a/b/ b/ "==> chop_suffix" (Ok /a)) - (/a/b a/b "==> chop_suffix" (Ok /)) - (/a/b/ a/b "==> chop_suffix" (Error _)) - (/a/b a/b/ "==> chop_suffix" (Error _)) - (/a/b/ a/b/ "==> chop_suffix" (Ok /)) - (/ / "==> chop_prefix" (Ok ./)) - (/ / "==> chop_prefix" (Ok ./)) - (/ / "==> chop_prefix" (Ok ./)) - (/ / "==> chop_prefix" (Ok ./)) - (/ /a "==> chop_prefix" (Ok a)) - (/ /a "==> chop_prefix" (Ok a)) - (/ /a/ "==> chop_prefix" (Ok a/)) - (/ /a/ "==> chop_prefix" (Ok a/)) - (/a / "==> chop_prefix" (Error _)) - (/a/ / "==> chop_prefix" (Error _)) - (/a / "==> chop_prefix" (Error _)) - (/a/ / "==> chop_prefix" (Error _)) - (/a/b /a/b/c "==> chop_prefix" (Ok c)) - (/a/b/ /a/b/c "==> chop_prefix" (Ok c)) - (/a/b /a/b/c/ "==> chop_prefix" (Ok c/)) - (/a/b/ /a/b/c/ "==> chop_prefix" (Ok c/)) - (/a/b /a/bc "==> chop_prefix" (Error _)) - (/a/b/ /a/bc "==> chop_prefix" (Error _)) - (/a/b /a/bc/ "==> chop_prefix" (Error _)) - (/a/b/ /a/bc/ "==> chop_prefix" (Error _)) - (/a/b /a/b/c/d "==> chop_prefix" (Ok c/d)) - (/a/b/ /a/b/c/d "==> chop_prefix" (Ok c/d)) - (/a/b /a/b/c/d/ "==> chop_prefix" (Ok c/d/)) - (/a/b/ /a/b/c/d/ "==> chop_prefix" (Ok c/d/)) - (/a/b/c /a/b/c "==> chop_prefix" (Ok ./)) - (/a/b/c/ /a/b/c "==> chop_prefix" (Error _)) - (/a/b/c /a/b/c/ "==> chop_prefix" (Ok ./)) - (/a/b/c/ /a/b/c/ "==> chop_prefix" (Ok ./)) - (/a/b/c /a/b "==> chop_prefix" (Error _)) - (/a/b/c/ /a/b "==> chop_prefix" (Error _)) - (/a/b/c /a/b/ "==> chop_prefix" (Error _)) - (/a/b/c/ /a/b/ "==> chop_prefix" (Error _)) - (./ ./ "==> chop_prefix" (Ok ./)) - (./ ./ "==> chop_prefix" (Ok ./)) - (./ ./ "==> chop_prefix" (Ok ./)) - (./ ./ "==> chop_prefix" (Ok ./)) - (./ a "==> chop_prefix" (Error _)) - (./ a "==> chop_prefix" (Error _)) - (./ a/ "==> chop_prefix" (Error _)) - (./ a/ "==> chop_prefix" (Error _)) - (a ./ "==> chop_prefix" (Error _)) - (a/ ./ "==> chop_prefix" (Error _)) - (a ./ "==> chop_prefix" (Error _)) - (a/ ./ "==> chop_prefix" (Error _)) - (a/b a/b/c "==> chop_prefix" (Ok c)) - (a/b/ a/b/c "==> chop_prefix" (Ok c)) - (a/b a/b/c/ "==> chop_prefix" (Ok c/)) - (a/b/ a/b/c/ "==> chop_prefix" (Ok c/)) - (a/b a/bc "==> chop_prefix" (Error _)) - (a/b/ a/bc "==> chop_prefix" (Error _)) - (a/b a/bc/ "==> chop_prefix" (Error _)) - (a/b/ a/bc/ "==> chop_prefix" (Error _)) - (a/b a/b/c/d "==> chop_prefix" (Ok c/d)) - (a/b/ a/b/c/d "==> chop_prefix" (Ok c/d)) - (a/b a/b/c/d/ "==> chop_prefix" (Ok c/d/)) - (a/b/ a/b/c/d/ "==> chop_prefix" (Ok c/d/)) - (a/b/c a/b/c "==> chop_prefix" (Ok ./)) - (a/b/c/ a/b/c "==> chop_prefix" (Error _)) - (a/b/c a/b/c/ "==> chop_prefix" (Ok ./)) - (a/b/c/ a/b/c/ "==> chop_prefix" (Ok ./)) - (a/b/c a/b "==> chop_prefix" (Error _)) - (a/b/c/ a/b "==> chop_prefix" (Error _)) - (a/b/c a/b/ "==> chop_prefix" (Error _)) - (a/b/c/ a/b/ "==> chop_prefix" (Error _)) |}]; + (/ ./ "==> chop_suffix" ()) + (/ ./ "==> chop_suffix" ()) + (/ ./ "==> chop_suffix" ()) + (/ ./ "==> chop_suffix" ()) + (/ a "==> chop_suffix" ()) + (/ a "==> chop_suffix" ()) + (/ a/ "==> chop_suffix" ()) + (/ a/ "==> chop_suffix" ()) + (/a a "==> chop_suffix" (/)) + (/a/ a "==> chop_suffix" ()) + (/a a/ "==> chop_suffix" ()) + (/a/ a/ "==> chop_suffix" (/)) + (/a b "==> chop_suffix" ()) + (/a/ b "==> chop_suffix" ()) + (/a b/ "==> chop_suffix" ()) + (/a/ b/ "==> chop_suffix" ()) + (/a/b b "==> chop_suffix" (/a)) + (/a/b/ b "==> chop_suffix" ()) + (/a/b b/ "==> chop_suffix" ()) + (/a/b/ b/ "==> chop_suffix" (/a)) + (/a/b a/b "==> chop_suffix" (/)) + (/a/b/ a/b "==> chop_suffix" ()) + (/a/b a/b/ "==> chop_suffix" ()) + (/a/b/ a/b/ "==> chop_suffix" (/)) + (/ / "==> chop_prefix" (./)) + (/ / "==> chop_prefix" (./)) + (/ / "==> chop_prefix" (./)) + (/ / "==> chop_prefix" (./)) + (/ /a "==> chop_prefix" (a)) + (/ /a "==> chop_prefix" (a)) + (/ /a/ "==> chop_prefix" (a/)) + (/ /a/ "==> chop_prefix" (a/)) + (/a / "==> chop_prefix" ()) + (/a/ / "==> chop_prefix" ()) + (/a / "==> chop_prefix" ()) + (/a/ / "==> chop_prefix" ()) + (/a/b /a/b/c "==> chop_prefix" (c)) + (/a/b/ /a/b/c "==> chop_prefix" (c)) + (/a/b /a/b/c/ "==> chop_prefix" (c/)) + (/a/b/ /a/b/c/ "==> chop_prefix" (c/)) + (/a/b /a/bc "==> chop_prefix" ()) + (/a/b/ /a/bc "==> chop_prefix" ()) + (/a/b /a/bc/ "==> chop_prefix" ()) + (/a/b/ /a/bc/ "==> chop_prefix" ()) + (/a/b /a/b/c/d "==> chop_prefix" (c/d)) + (/a/b/ /a/b/c/d "==> chop_prefix" (c/d)) + (/a/b /a/b/c/d/ "==> chop_prefix" (c/d/)) + (/a/b/ /a/b/c/d/ "==> chop_prefix" (c/d/)) + (/a/b/c /a/b/c "==> chop_prefix" (./)) + (/a/b/c/ /a/b/c "==> chop_prefix" ()) + (/a/b/c /a/b/c/ "==> chop_prefix" (./)) + (/a/b/c/ /a/b/c/ "==> chop_prefix" (./)) + (/a/b/c /a/b "==> chop_prefix" ()) + (/a/b/c/ /a/b "==> chop_prefix" ()) + (/a/b/c /a/b/ "==> chop_prefix" ()) + (/a/b/c/ /a/b/ "==> chop_prefix" ()) + (./ ./ "==> chop_prefix" (./)) + (./ ./ "==> chop_prefix" (./)) + (./ ./ "==> chop_prefix" (./)) + (./ ./ "==> chop_prefix" (./)) + (./ a "==> chop_prefix" ()) + (./ a "==> chop_prefix" ()) + (./ a/ "==> chop_prefix" ()) + (./ a/ "==> chop_prefix" ()) + (a ./ "==> chop_prefix" ()) + (a/ ./ "==> chop_prefix" ()) + (a ./ "==> chop_prefix" ()) + (a/ ./ "==> chop_prefix" ()) + (a/b a/b/c "==> chop_prefix" (c)) + (a/b/ a/b/c "==> chop_prefix" (c)) + (a/b a/b/c/ "==> chop_prefix" (c/)) + (a/b/ a/b/c/ "==> chop_prefix" (c/)) + (a/b a/bc "==> chop_prefix" ()) + (a/b/ a/bc "==> chop_prefix" ()) + (a/b a/bc/ "==> chop_prefix" ()) + (a/b/ a/bc/ "==> chop_prefix" ()) + (a/b a/b/c/d "==> chop_prefix" (c/d)) + (a/b/ a/b/c/d "==> chop_prefix" (c/d)) + (a/b a/b/c/d/ "==> chop_prefix" (c/d/)) + (a/b/ a/b/c/d/ "==> chop_prefix" (c/d/)) + (a/b/c a/b/c "==> chop_prefix" (./)) + (a/b/c/ a/b/c "==> chop_prefix" ()) + (a/b/c a/b/c/ "==> chop_prefix" (./)) + (a/b/c/ a/b/c/ "==> chop_prefix" (./)) + (a/b/c a/b "==> chop_prefix" ()) + (a/b/c/ a/b "==> chop_prefix" ()) + (a/b/c a/b/ "==> chop_prefix" ()) + (a/b/c/ a/b/ "==> chop_prefix" ()) + |}]; () ;; diff --git a/test/test__fpath.mli b/lib/fpath_base/test/test__fpath.mli similarity index 100% rename from test/test__fpath.mli rename to lib/fpath_base/test/test__fpath.mli diff --git a/test/test__relative_path.ml b/lib/fpath_base/test/test__relative_path.ml similarity index 66% rename from test/test__relative_path.ml rename to lib/fpath_base/test/test__relative_path.ml index 1c138b1..3fe5d5b 100644 --- a/test/test__relative_path.ml +++ b/lib/fpath_base/test/test__relative_path.ml @@ -1,13 +1,15 @@ let%expect_test "of_string" = let test str = - print_s [%sexp (Relative_path.of_string str : Relative_path.t Or_error.t)] + print_s + [%sexp + (Relative_path.of_string str : (Relative_path.t, [ `Msg of string ]) Result.t)] in test ""; - [%expect {| (Error (Relative_path.of_string "\"\": invalid path")) |}]; + [%expect {| (Error (Msg "\"\": invalid path")) |}]; test "."; [%expect {| (Ok ./) |}]; test "/a"; - [%expect {| (Error ("Relative_path.of_fpath: not a relative path" /a)) |}]; + [%expect {| (Error (Msg "\"/a\": not a relative path")) |}]; test "a/b/../.."; [%expect {| (Ok ./) |}]; () @@ -15,15 +17,15 @@ let%expect_test "of_string" = let%expect_test "v" = require_does_raise [%here] (fun () -> Relative_path.v ""); - [%expect {| (Relative_path.of_string "\"\": invalid path") |}]; + [%expect {| (Invalid_argument "\"\": invalid path") |}]; () ;; let%expect_test "of_fpath" = let test_fpath f = let t = Relative_path.of_fpath f in - if Result.is_error t then print_s [%sexp (t : Relative_path.t Or_error.t)]; - Or_error.iter t ~f:(fun t -> + if Option.is_none t then print_s [%sexp "not a relative path"]; + Option.iter t ~f:(fun t -> print_endline (Relative_path.to_string t); let f' = Relative_path.to_fpath t in if Fpath.equal f f' @@ -49,9 +51,7 @@ let%expect_test "of_fpath" = ./ ("does roundtrip" ((f ./))) |}]; test_fpath (Fpath.v "/an/absolute/path"); - [%expect - {| - (Error ("Relative_path.of_fpath: not a relative path" /an/absolute/path)) |}]; + [%expect {| "not a relative path" |}]; () ;; @@ -108,7 +108,7 @@ let%expect_test "extend" = let file str = str |> File_name.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 {| ("File_name.of_string: invalid file name" a/b) |}]; + [%expect {| (Invalid_argument "a/b: invalid file name") |}]; require_does_not_raise [%here] (fun () -> ignore (file ".." : File_name.t)); [%expect {| |}]; test Relative_path.empty (file "a"); @@ -180,69 +180,39 @@ let%expect_test "of_list" = let%expect_test "chop_prefix" = let rel = Relative_path.v in let test prefix path = - let result = Relative_path.chop_prefix ~prefix path in - print_s [%sexp (result : Relative_path.t Or_error.t)] + let result = Relative_path.chop_prefix path ~prefix in + print_s [%sexp (result : Relative_path.t option)] in test (rel "foo") (rel "foo/bar"); - [%expect {| (Ok bar) |}]; + [%expect {| (bar) |}]; test (rel "foo") (rel "foo/bar/"); - [%expect {| (Ok bar/) |}]; + [%expect {| (bar/) |}]; test (rel "foo/") (rel "foo/bar"); - [%expect {| (Ok bar) |}]; + [%expect {| (bar) |}]; test (rel "foo/") (rel "foo/bar/"); - [%expect {| (Ok bar/) |}]; + [%expect {| (bar/) |}]; test (rel "foo/") (rel "foo"); - [%expect - {| - (Error ( - "Relative_path.chop_prefix: not a prefix" ( - (prefix foo/) - (t foo)))) |}]; + [%expect {| () |}]; test (rel "foo") (rel "foo/bar/baz"); - [%expect {| (Ok bar/baz) |}]; + [%expect {| (bar/baz) |}]; test (rel "foo") (rel "bar/baz"); - [%expect - {| - (Error ( - "Relative_path.chop_prefix: not a prefix" ( - (prefix foo) - (t bar/baz)))) |}]; + [%expect {| () |}]; test (rel "foo/bar") (rel "foo"); - [%expect - {| - (Error ( - "Relative_path.chop_prefix: not a prefix" ( - (prefix foo/bar) - (t foo)))) |}]; + [%expect {| () |}]; test (rel "foo/bar") (rel "foo"); - [%expect - {| - (Error ( - "Relative_path.chop_prefix: not a prefix" ( - (prefix foo/bar) - (t foo)))) |}]; + [%expect {| () |}]; test (rel "foo/bar") (rel "foo/bar/baz"); - [%expect {| (Ok baz) |}]; + [%expect {| (baz) |}]; test (rel "foo/bar") (rel "foo/bar/baz/qux"); - [%expect {| (Ok baz/qux) |}]; + [%expect {| (baz/qux) |}]; (* Paths are normalized before the function call. *) test (rel "foo/bar") (rel "foo/bar/../baz"); - [%expect - {| - (Error ( - "Relative_path.chop_prefix: not a prefix" ( - (prefix foo/bar) - (t foo/baz)))) |}]; + [%expect {| () |}]; test (rel "foo/bar") (rel "foo/sna/../bar/baz"); - [%expect {|(Ok baz) |}]; + [%expect {| (baz) |}]; (* Beware of string prefix vs path prefix *) test (rel "foo/bar") (rel "foo/bar-baz"); - [%expect - {| - (Error ( - "Relative_path.chop_prefix: not a prefix" ( - (prefix foo/bar) - (t foo/bar-baz)))) |}]; + [%expect {| () |}]; () ;; @@ -250,96 +220,41 @@ let%expect_test "chop_suffix" = let rel = Relative_path.v in let test path suffix = let result = Relative_path.chop_suffix path ~suffix in - print_s [%sexp (result : Relative_path.t Or_error.t)] + print_s [%sexp (result : Relative_path.t option)] in test (rel "foo/bar") (rel "bar"); - [%expect {| (Ok foo) |}]; + [%expect {| (foo) |}]; test (rel "foo/bar") (rel "bar/"); - [%expect - {| - (Error ( - "Relative_path.chop_suffix: not a suffix" ( - (t foo/bar) - (suffix bar/)))) |}]; + [%expect {| () |}]; test (rel "foo/bar/") (rel "bar"); - [%expect - {| - (Error ( - "Relative_path.chop_suffix: not a suffix" ( - (t foo/bar/) - (suffix bar)))) |}]; + [%expect {| () |}]; test (rel "foo/bar/") (rel "bar/"); - [%expect {| (Ok foo) |}]; + [%expect {| (foo) |}]; test (rel "foo/bar") Relative_path.empty; - [%expect - {| - (Error ( - "Relative_path.chop_suffix: not a suffix" ( - (t foo/bar) - (suffix ./)))) |}]; + [%expect {| () |}]; test (rel "foo/bar/") Relative_path.empty; - [%expect - {| - (Error ( - "Relative_path.chop_suffix: not a suffix" ( - (t foo/bar/) - (suffix ./)))) |}]; + [%expect {| () |}]; test (rel "foo/bar/.") Relative_path.empty; - [%expect - {| - (Error ( - "Relative_path.chop_suffix: not a suffix" ( - (t foo/bar/) - (suffix ./)))) |}]; + [%expect {| () |}]; test (rel "bar") (rel "foo/bar"); - [%expect - {| - (Error ( - "Relative_path.chop_suffix: not a suffix" ( - (t bar) - (suffix foo/bar)))) |}]; + [%expect {| () |}]; test (rel "foo/bar") (rel "foo/bar"); - [%expect {| (Ok ./) |}]; + [%expect {| (./) |}]; test (rel "foo/bar") (rel "baz"); - [%expect - {| - (Error ( - "Relative_path.chop_suffix: not a suffix" ( - (t foo/bar) - (suffix baz)))) |}]; + [%expect {| () |}]; test (rel "foo/bar/baz") (rel "bar/baz"); - [%expect {| (Ok foo) |}]; + [%expect {| (foo) |}]; test (rel "foo/bar/baz") (rel "baz/qux"); - [%expect - {| - (Error ( - "Relative_path.chop_suffix: not a suffix" ( - (t foo/bar/baz) - (suffix baz/qux)))) |}]; + [%expect {| () |}]; test (rel "foo/bar/baz") Relative_path.empty; - [%expect - {| - (Error ( - "Relative_path.chop_suffix: not a suffix" ( - (t foo/bar/baz) - (suffix ./)))) |}]; + [%expect {| () |}]; test (rel "foo/bar/baz") (rel ".."); - [%expect - {| - (Error ( - "Relative_path.chop_suffix: not a suffix" ( - (t foo/bar/baz) - (suffix ../)))) |}]; + [%expect {| () |}]; test (rel "foo/bar/baz") (rel "foo/../baz"); - [%expect {| (Ok foo/bar) |}]; + [%expect {| (foo/bar) |}]; (* Beware of string suffix vs path suffix *) test (rel "foo/bar-baz") (rel "-baz"); - [%expect - {| - (Error ( - "Relative_path.chop_suffix: not a suffix" ( - (t foo/bar-baz) - (suffix -baz)))) |}]; + [%expect {| () |}]; () ;; diff --git a/test/test__relative_path.mli b/lib/fpath_base/test/test__relative_path.mli similarity index 100% rename from test/test__relative_path.mli rename to lib/fpath_base/test/test__relative_path.mli diff --git a/lib/fpath_sexp0/src/dune b/lib/fpath_sexp0/src/dune new file mode 100644 index 0000000..2b44b13 --- /dev/null +++ b/lib/fpath_sexp0/src/dune @@ -0,0 +1,11 @@ +(library + (name fpath_sexp0) + (public_name fpath-sexp0) + (flags :standard -w +a-4-40-41-42-44-45-48-66 -warn-error +a) + (libraries fpath sexplib0) + (instrumentation + (backend bisect_ppx)) + (lint + (pps ppx_js_style -check-doc-comments)) + (preprocess + (pps -unused-code-warnings=force ppx_sexp_conv ppx_sexp_value))) diff --git a/lib/fpath_sexp0/src/file_name.ml b/lib/fpath_sexp0/src/file_name.ml new file mode 100644 index 0000000..c451952 --- /dev/null +++ b/lib/fpath_sexp0/src/file_name.ml @@ -0,0 +1,27 @@ +type t = string + +let compare = String.compare +let equal = String.equal +let sexp_of_t t = Sexplib0.Sexp.Atom t + +let invariant t = + String.length t > 0 + && String.for_all (fun c -> not (Char.equal c '/' || Char.equal c '\000')) 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)) +;; + +let v t = + match of_string t with + | Ok t -> t + | Error (`Msg s) -> invalid_arg s +;; + +let dot = v "." +let dot_dot = v ".." +let dot_git = v ".git" +let dot_hg = v ".hg" diff --git a/src/file_name.mli b/lib/fpath_sexp0/src/file_name.mli similarity index 83% rename from src/file_name.mli rename to lib/fpath_sexp0/src/file_name.mli index 0316433..5e7fa3d 100644 --- a/src/file_name.mli +++ b/lib/fpath_sexp0/src/file_name.mli @@ -12,11 +12,11 @@ This module provides functions to convert between strings and file_names, validate file_names, and some common file_names. *) -type t [@@deriving compare, equal, hash, sexp_of] +type t [@@deriving sexp_of] -include Comparable.S with type t := t - -val of_string : string -> t Or_error.t +val compare : t -> t -> int +val equal : t -> t -> bool +val of_string : string -> (t, [ `Msg of string ]) Result.t val to_string : t -> string val v : string -> t diff --git a/lib/fpath_sexp0/src/fpath0.ml b/lib/fpath_sexp0/src/fpath0.ml new file mode 100644 index 0000000..80dfb95 --- /dev/null +++ b/lib/fpath_sexp0/src/fpath0.ml @@ -0,0 +1,5 @@ +type t = Fpath.t + +let sexp_of_t t = Sexplib0.Sexp.Atom (Fpath.to_string t) +let compare = Fpath.compare +let equal = Fpath.equal diff --git a/lib/fpath_sexp0/src/fpath0.mli b/lib/fpath_sexp0/src/fpath0.mli new file mode 100644 index 0000000..6a009f3 --- /dev/null +++ b/lib/fpath_sexp0/src/fpath0.mli @@ -0,0 +1,6 @@ +(** Adding to sexp serialization to [Fpath]. *) + +type t = Fpath.t [@@deriving sexp_of] + +val compare : t -> t -> int +val equal : t -> t -> bool diff --git a/src/fpath_base.ml b/lib/fpath_sexp0/src/fpath_sexp0.ml similarity index 100% rename from src/fpath_base.ml rename to lib/fpath_sexp0/src/fpath_sexp0.ml diff --git a/src/fpath_base.mli b/lib/fpath_sexp0/src/fpath_sexp0.mli similarity index 100% rename from src/fpath_base.mli rename to lib/fpath_sexp0/src/fpath_sexp0.mli diff --git a/lib/fpath_sexp0/src/path.ml b/lib/fpath_sexp0/src/path.ml new file mode 100644 index 0000000..d9e106b --- /dev/null +++ b/lib/fpath_sexp0/src/path.ml @@ -0,0 +1,118 @@ +type absolute_path = Fpath.t +type relative_path = Fpath.t + +let append a r = Fpath.(a // r) |> Fpath.normalize +let extend t f = Fpath.(t / File_name.to_string f) |> Fpath.normalize + +let parent t = + let t' = Fpath.normalize t |> Fpath.parent in + if Fpath.equal t t' then None else Some t' +;; + +let chop_prefix t ~prefix = + match Fpath.rem_prefix prefix t with + | Some t -> Some t + | None -> if Fpath.equal prefix t then Some Fpath.(v "./") else None +;; + +let chop_suffix ~empty t ~suffix = + let rec aux t suffix = + match t, suffix with + | _, [] -> Some t + | [], _ :: _ -> None + | hd :: t, hd2 :: suffix -> if String.equal hd hd2 then aux t suffix else None + in + match aux (Fpath.segs t |> List.rev) (Fpath.segs suffix |> List.rev) with + | Some ([] | [ "" ]) -> Some empty + | Some (_ :: _ as segs) -> + let result = String.concat Fpath.dir_sep (List.rev segs) in + Some (Fpath.v result) + | None -> None +;; + +module Absolute_path = struct + include Fpath0 + + let to_fpath t = t + let to_string = Fpath.to_string + + let of_fpath f = + let f = Fpath.normalize f in + if Fpath.is_abs f then Some f else None + ;; + + let of_string str = + match Fpath.of_string str with + | Error (`Msg _) as error -> error + | Ok f -> + (match of_fpath f with + | Some t -> Ok t + | None -> + Error (`Msg (Printf.sprintf "%S: not an absolute path" (f |> Fpath.to_string)))) + ;; + + let v str = + match str |> of_string with + | Ok t -> t + | Error (`Msg m) -> invalid_arg m + ;; + + let root = Fpath.v Fpath.dir_sep + let append = append + let extend = extend + let parent = parent + let chop_prefix t ~prefix = chop_prefix t ~prefix + let chop_suffix t ~suffix = chop_suffix ~empty:root t ~suffix + let is_dir_path = Fpath.is_dir_path + let to_dir_path = Fpath.to_dir_path + + let relativize ~root f = + let f = Fpath.normalize f in + if Fpath.is_abs f then f else append root f + ;; +end + +module Relative_path = struct + include Fpath0 + + let to_fpath t = t + let to_string = Fpath.to_string + + let of_fpath f = + let f = Fpath.normalize f in + if Fpath.is_rel f then Some f else None + ;; + + let of_string str = + match Fpath.of_string str with + | Error (`Msg _) as error -> error + | Ok f -> + (match of_fpath f with + | None -> + Error (`Msg (Printf.sprintf "%S: not a relative path" (f |> Fpath.to_string))) + | Some t -> Ok t) + ;; + + let v str = + match str |> of_string with + | Ok t -> t + | Error (`Msg m) -> invalid_arg m + ;; + + let empty = Fpath.v "./" + let append = append + let extend = extend + let parent = parent + let of_list files = List.fold_left extend empty files + let chop_prefix t ~prefix = chop_prefix t ~prefix + let chop_suffix t ~suffix = chop_suffix ~empty t ~suffix + let is_dir_path = Fpath.is_dir_path + let to_dir_path = Fpath.to_dir_path +end + +module Export = struct + let classify f = + let f = Fpath.normalize f in + if Fpath.is_abs f then `Absolute f else `Relative f + ;; +end diff --git a/src/path.mli b/lib/fpath_sexp0/src/path.mli similarity index 67% rename from src/path.mli rename to lib/fpath_sexp0/src/path.mli index f6bfe39..c6dc148 100644 --- a/src/path.mli +++ b/lib/fpath_sexp0/src/path.mli @@ -6,21 +6,21 @@ type absolute_path = private Fpath.t type relative_path = private Fpath.t module Absolute_path : sig - type t = absolute_path [@@deriving compare, equal, hash, sexp_of] - - include Comparable.S with type t := t + type t = absolute_path [@@deriving sexp_of] + val compare : t -> t -> int + val equal : t -> t -> bool val to_fpath : t -> Fpath.t val to_string : t -> string (** [of_fpath p] returns a normalized of [p] classified as an absolute path. - Returns an error if [p] is not an absolute path. *) - val of_fpath : Fpath.t -> t Or_error.t + Returns [None] if [p] is not an absolute path. *) + val of_fpath : Fpath.t -> t option (** This is a convenient wrapper to compose {!Fpath.of_string} and {!of_fpath}. *) - val of_string : string -> t Or_error.t + val of_string : string -> (t, [ `Msg of string ]) Result.t - (** [v str] is [of_string str |> Or_error.ok_exn]. *) + (** [v str] returns a [t] or raises [Invalid_argument]. *) val v : string -> t (** The root path ["/"]. *) @@ -29,8 +29,8 @@ module Absolute_path : sig val append : t -> relative_path -> t val extend : t -> File_name.t -> t val parent : t -> t option - val chop_prefix : prefix:t -> t -> relative_path Or_error.t - val chop_suffix : t -> suffix:relative_path -> t Or_error.t + val chop_prefix : t -> prefix:t -> relative_path option + val chop_suffix : t -> suffix:relative_path -> t option val is_dir_path : t -> bool val to_dir_path : t -> t @@ -41,23 +41,23 @@ module Absolute_path : sig end module Relative_path : sig - type t = relative_path [@@deriving compare, equal, hash, sexp_of] - - include Comparable.S with type t := t + type t = relative_path [@@deriving sexp_of] + val compare : t -> t -> int + val equal : t -> t -> bool val to_fpath : t -> Fpath.t val to_string : t -> string (** [of_fpath p] returns a normalized of [p] classified as a relative path. - Returns an error if [p] is not a relative path. Note, in particular that + Returns [None] if [p] is not a relative path. Note, in particular that due to normalization, ["."] immediately becomes ["./"] (the empty relative path). *) - val of_fpath : Fpath.t -> t Or_error.t + val of_fpath : Fpath.t -> t option (** This is a convenient wrapper to compose {!Fpath.of_string} and {!of_fpath}. *) - val of_string : string -> t Or_error.t + val of_string : string -> (t, [ `Msg of string ]) Result.t - (** [v str] is [of_string str |> Or_error.ok_exn]. *) + (** [v str] returns a [t] or raises [Invalid_argument]. *) val v : string -> t (** The empty relative path ["./"]. *) @@ -67,8 +67,8 @@ module Relative_path : sig val extend : t -> File_name.t -> t val parent : t -> t option val of_list : File_name.t list -> t - val chop_prefix : prefix:t -> t -> t Or_error.t - val chop_suffix : t -> suffix:t -> t Or_error.t + val chop_prefix : t -> prefix:t -> t option + val chop_suffix : t -> suffix:t -> t option val is_dir_path : t -> bool val to_dir_path : t -> t end diff --git a/lib/fpath_sexp0/test/dune b/lib/fpath_sexp0/test/dune new file mode 100644 index 0000000..49add26 --- /dev/null +++ b/lib/fpath_sexp0/test/dune @@ -0,0 +1,36 @@ +(library + (name fpath_sexp0_test) + (public_name fpath-base-tests.fpath_sexp0_test) + (flags + :standard + -w + +a-4-40-41-42-44-45-48-66 + -warn-error + +a + -open + Base + -open + Expect_test_helpers_base + -open + Fpath_sexp0) + (libraries + base + expect_test_helpers_core.expect_test_helpers_base + fpath + fpath_sexp0) + (inline_tests) + (instrumentation + (backend bisect_ppx)) + (lint + (pps ppx_js_style -check-doc-comments)) + (preprocess + (pps + -unused-code-warnings=force + ppx_compare + ppx_enumerate + ppx_expect + ppx_hash + ppx_here + ppx_let + ppx_sexp_conv + ppx_sexp_value))) diff --git a/src/file_name.ml b/src/file_name.ml deleted file mode 100644 index b9b6262..0000000 --- a/src/file_name.ml +++ /dev/null @@ -1,20 +0,0 @@ -include String - -let invariant t = - (not (String.is_empty t)) - && String.for_all t ~f:(fun c -> not (Char.equal c '/' || Char.equal c '\000')) -;; - -let to_string t = t - -let of_string s = - if invariant s - then Ok s - else Or_error.error_s [%sexp "File_name.of_string: invalid file name", (s : string)] -;; - -let v t = of_string t |> Or_error.ok_exn -let dot = v "." -let dot_dot = v ".." -let dot_git = v ".git" -let dot_hg = v ".hg" diff --git a/src/fpath0.ml b/src/fpath0.ml deleted file mode 100644 index 6ac67c9..0000000 --- a/src/fpath0.ml +++ /dev/null @@ -1,11 +0,0 @@ -module T = struct - type t = Fpath.t - - let compare = Fpath.compare - let sexp_of_t t = Sexp.Atom (Fpath.to_string t) - let hash_fold_t state t = String.hash_fold_t state (Fpath.to_string t) - let hash t = Hash.of_fold hash_fold_t t -end - -include T -include Comparable.Make (T) diff --git a/src/fpath0.mli b/src/fpath0.mli deleted file mode 100644 index e331b00..0000000 --- a/src/fpath0.mli +++ /dev/null @@ -1,12 +0,0 @@ -(** Adding a few functions to {!module:Fpath} to use alongside Base. - - - sexp serializer - - enough for compatibility with Base style containers, such as: - - {[ - let create_fpath_table () = Hashtbl.create (module Fpath) - ]} *) - -type t = Fpath.t [@@deriving compare, equal, hash, sexp_of] - -include Comparable.S with type t := t diff --git a/src/path.ml b/src/path.ml deleted file mode 100644 index 48842ef..0000000 --- a/src/path.ml +++ /dev/null @@ -1,123 +0,0 @@ -type absolute_path = Fpath.t -type relative_path = Fpath.t - -let append a r = Fpath.(a // r) |> Fpath.normalize -let extend t f = Fpath.(t / File_name.to_string f) |> Fpath.normalize - -let parent t = - let t' = Fpath.normalize t |> Fpath.parent in - if Fpath.equal t t' then None else Some t' -;; - -let chop_prefix ~module_name ~prefix t = - match Fpath.rem_prefix prefix t with - | Some t -> Ok t - | None -> - if Fpath.equal prefix t - then Ok Fpath.(v "./") - else - Or_error.error_s - [%sexp - (Printf.sprintf "%s.chop_prefix: not a prefix" module_name : string) - , { prefix : Fpath0.t; t : Fpath0.t }] -;; - -let chop_suffix ~module_name ~empty t ~suffix = - let rec aux t suffix = - match t, suffix with - | _, [] -> Ok t - | [], _ :: _ -> Error () - | hd :: t, hd2 :: suffix -> if String.equal hd hd2 then aux t suffix else Error () - in - match aux (Fpath.segs t |> List.rev) (Fpath.segs suffix |> List.rev) with - | Ok ([] | [ "" ]) -> Ok empty - | Ok (_ :: _ as segs) -> - let result = String.concat ~sep:Fpath.dir_sep (List.rev segs) in - Ok (Fpath.v result) - | Error () -> - Or_error.error_s - [%sexp - (Printf.sprintf "%s.chop_suffix: not a suffix" module_name : string) - , { t : Fpath0.t; suffix : Fpath0.t }] -;; - -module Absolute_path = struct - include Fpath0 - - let to_fpath t = t - let to_string = Fpath.to_string - - let of_fpath f = - let f = Fpath.normalize f in - if Fpath.is_abs f - then Ok f - else - Or_error.error_s - [%sexp "Absolute_path.of_fpath: not an absolute path", (f : Fpath0.t)] - ;; - - let of_string str = - match Fpath.of_string str with - | Error (`Msg m) -> Or_error.error_s [%sexp "Absolute_path.of_string", (m : string)] - | Ok f -> of_fpath f - ;; - - let v str = str |> of_string |> Or_error.ok_exn - let root = Fpath.v Fpath.dir_sep - let append = append - let extend = extend - let parent = parent - let chop_prefix ~prefix t = chop_prefix ~module_name:"Absolute_path" ~prefix t - - let chop_suffix t ~suffix = - chop_suffix ~module_name:"Absolute_path" ~empty:root t ~suffix - ;; - - let is_dir_path = Fpath.is_dir_path - let to_dir_path = Fpath.to_dir_path - - let relativize ~root f = - let f = Fpath.normalize f in - if Fpath.is_abs f then f else append root f - ;; -end - -module Relative_path = struct - include Fpath0 - - let to_fpath t = t - let to_string = Fpath.to_string - - let of_fpath f = - let f = Fpath.normalize f in - if Fpath.is_rel f - then Ok f - else - Or_error.error_s - [%sexp "Relative_path.of_fpath: not a relative path", (f : Fpath0.t)] - ;; - - let of_string str = - match Fpath.of_string str with - | Error (`Msg m) -> Or_error.error_s [%sexp "Relative_path.of_string", (m : string)] - | Ok f -> of_fpath f - ;; - - let v str = str |> of_string |> Or_error.ok_exn - let empty = Fpath.v "./" - let append = append - let extend = extend - let parent = parent - let of_list files = List.fold files ~init:empty ~f:extend - let chop_prefix ~prefix t = chop_prefix ~module_name:"Relative_path" ~prefix t - let chop_suffix t ~suffix = chop_suffix ~module_name:"Relative_path" ~empty t ~suffix - let is_dir_path = Fpath.is_dir_path - let to_dir_path = Fpath.to_dir_path -end - -module Export = struct - let classify f = - let f = Fpath.normalize f in - if Fpath.is_abs f then `Absolute f else `Relative f - ;; -end