Merge pull request #28 from mbarbin/rm-arg

Replace vcs-arg by a few helpers

.vscode/settings.json

@@ -1,8 +1,15 @@
 {
     "cSpell.words": [
+        "chdir",
+        "ENOENT",
         "janestreet",
+        "mkdirs",
         "odoc",
         "opam",
+        "pathspec",
+        "rmtree",
+        "Stdenv",
+        "subdir",
         "worktree",
         "worktrees"
     ]

CHANGES.md

@@ -1,3 +1,22 @@
+## 0.0.9 (unreleased)
+
+### Added
+
+- Add `Vcs.find_enclosing_repo_root` helper (#28, @mbarbin).
+- Add `Vcs.read_dir` helper (#28, @mbarbin).
+
+### Changed
+
+- Moved `ocaml-vcs more-tests` commands at top-level (#28, @mbarbin).
+
+### Deprecated
+
+### Fixed
+
+### Removed
+
+- Removed package `vcs-arg` and inline what's needed directly in `vcs-command` (#28, @mbarbin).
+
 ## 0.0.8 (2024-09-30)
 
 ### Changed

doc/docs/explanation/exploratory_tests.md

@@ -24,15 +24,17 @@ SYNOPSIS
 
 
        We expect a 1:1 mapping between the function exposed in the [Vcs.S]
-       and the sub commands exposed here, plus additional functionality in
-       [more-tests].
+       and the sub commands exposed here, plus additional ones.
 
 
 
 COMMANDS
        add [OPTION]… file
            add a file to the index
 
+       branch-revision [OPTION]… [BRANCH]
+           revision of a branch
+
        commit [--message=MSG] [--quiet] [OPTION]…
            commit a file
 
@@ -42,16 +44,23 @@ COMMANDS
        current-revision [OPTION]…
            revision of HEAD
 
+       find-enclosing-repo-root [--from=path/to/dir] [--store=VAL]
+       [OPTION]…
+           find enclosing repo root
+
+       gca [OPTION]… [REV]…
+           print greatest common ancestors of revisions
+
        git [OPTION]… [ARG]…
            run the git cli
 
        graph [OPTION]…
            compute graph of current repo
 
-       init [--quiet] [OPTION]… file
+       init [--quiet] [OPTION]… path/to/root
            initialize a new repository
 
-       load-file [OPTION]… file
+       load-file [OPTION]… path/to/file
            print a file from the filesystem (aka cat)
 
        log [OPTION]…
@@ -60,28 +69,28 @@ COMMANDS
        ls-files [--below=PATH] [OPTION]…
            list file
 
-       more-tests COMMAND …
-           more tests combining vcs functions
-
-       name-status [OPTION]… rev rev
+       name-status [OPTION]… BASE TIP
            show a summary of the diff between 2 revs
 
-       num-status [OPTION]… rev rev
+       num-status [OPTION]… BASE TIP
            show a summary of the number of lines of diff between 2 revs
 
+       read-dir [OPTION]… path/to/dir
+           print the list of files in a directory
+
        refs [OPTION]…
            show the refs of current repo
 
        rename-current-branch [OPTION]… branch
            move/rename a branch to a new name
 
-       save-file [OPTION]… file
+       save-file [OPTION]… FILE
            save stdin to a file from the filesystem (aka tee)
 
        set-user-config [--user.email=EMAIL] [--user.name=USER] [OPTION]…
            set the user config
 
-       show-file-at-rev [--rev=REV] [OPTION]… file
+       show-file-at-rev [--rev=REV] [OPTION]… FILE
            show the contents of file at a given revision
 
 COMMON OPTIONS

dune-project

@@ -64,59 +64,6 @@
   (provider
    (>= 0.0.8))))
 
-(package
- (name vcs-arg)
- (synopsis "[Command.Arg] helpers for the Vcs library")
- (depends
-  (ocaml
-   (>= 5.2))
-  (base
-   (and
-    (>= v0.17)
-    (< v0.18)))
-  (cmdlang
-   (>= 0.0.5))
-  (eio
-   (>= 1.0))
-  (fpath
-   (>= 0.7.3))
-  (fpath-sexp0
-   (>= 0.2.0))
-  (ppx_compare
-   (and
-    (>= v0.17)
-    (< v0.18)))
-  (ppx_enumerate
-   (and
-    (>= v0.17)
-    (< v0.18)))
-  (ppx_hash
-   (and
-    (>= v0.17)
-    (< v0.18)))
-  (ppx_here
-   (and
-    (>= v0.17)
-    (< v0.18)))
-  (ppx_let
-   (and
-    (>= v0.17)
-    (< v0.18)))
-  (ppx_sexp_conv
-   (and
-    (>= v0.17)
-    (< v0.18)))
-  (ppx_sexp_value
-   (and
-    (>= v0.17)
-    (< v0.18)))
-  (ppxlib
-   (>= 0.33))
-  (vcs
-   (= :version))
-  (vcs-git-eio
-   (= :version))))
-
 (package
  (name vcs-command)
  (synopsis "A command line tool for the Vcs library")
@@ -175,8 +122,6 @@
    (>= 0.33))
   (vcs
    (= :version))
-  (vcs-arg
-   (= :version))
   (vcs-git-eio
    (= :version))))
 
@@ -444,8 +389,6 @@
     (< v0.18)))
   (vcs
    (= :version))
-  (vcs-arg
-   (= :version))
   (vcs-command
    (= :version))
   (vcs-git-blocking

headache.sh

@@ -5,8 +5,6 @@ dirs=(
     "example"
     "lib/vcs/src"
     "lib/vcs/test"
-    "lib/vcs_arg/src"
-    "lib/vcs_arg/test"
     "lib/vcs_command/src"
     "lib/vcs_command/test"
     "lib/vcs_git_blocking/src"

lib/vcs/src/non_raising.ml

@@ -31,6 +31,15 @@ module Make (M : M) :
   ;;
 
   let init vcs ~path = try_with (fun () -> Vcs0.init vcs ~path)
+
+  let find_enclosing_repo_root vcs ~from ~store =
+    try_with (fun () -> Vcs0.find_enclosing_repo_root vcs ~from ~store)
+  ;;
+
+  let find_enclosing_git_repo_root vcs ~from =
+    try_with (fun () -> Vcs0.find_enclosing_git_repo_root vcs ~from)
+  ;;
+
   let add vcs ~repo_root ~path = try_with (fun () -> Vcs0.add vcs ~repo_root ~path)
 
   let commit vcs ~repo_root ~commit_message =
@@ -51,6 +60,8 @@ module Make (M : M) :
     try_with (fun () -> Vcs0.save_file ?perms vcs ~path ~file_contents)
   ;;
 
+  let read_dir vcs ~dir = try_with (fun () -> Vcs0.read_dir vcs ~dir)
+
   let rename_current_branch vcs ~repo_root ~to_ =
     try_with (fun () -> Vcs0.rename_current_branch vcs ~repo_root ~to_)
   ;;

lib/vcs/src/trait_file_system.mli

@@ -29,12 +29,23 @@
 module type S = sig
   type t
 
+  (** Returns the contents of the file at the given path or an error if the file
+      does not exist or is not readable. *)
   val load_file : t -> path:Absolute_path.t -> File_contents.t Or_error.t
 
+  (** [save_file] is expected to truncate the file if it already exists. Errors
+      are reserved for other cases, such as trying to write to an non existing
+      directory, not having write permissions, etc. *)
   val save_file
     :  ?perms:int (** defaults to [0o666]. *)
     -> t
     -> path:Absolute_path.t
     -> file_contents:File_contents.t
     -> unit Or_error.t
+
+  (** Returns the entries contained in the given directory, ordered increasingly
+      according to [String.compare]. This must error out if [dir] is not a
+      directory, or if we don't have access to it. The unix entries "." and
+      ".." shall not be included in the result. *)
+  val read_dir : t -> dir:Absolute_path.t -> Fpart.t list Or_error.t
 end

lib/vcs/src/vcs.mli

@@ -84,10 +84,44 @@ module Repo_name = Repo_name
 module Repo_root = Repo_root
 module Url = Url
 
-(** Initialize a git repository at the given path. This errors out if a
+(** Initialize a Git repository at the given path. This errors out if a
     repository is already initialized there. *)
 val init : [> Trait.init ] t -> path:Absolute_path.t -> Repo_root.t
 
+(** [find_enclosing_repo_root vcs ~from:dir ~store] walks up the path from
+    the given directory [dir] and stops when at the root of a repository. If no
+    repo root has been found when reaching the root path ["/"], the function
+    returns [None].
+
+    The way we determine whether we are at the root of a repo is by looking for
+    the presence of one of the store entries in the directory (e.g. [".git"]).
+
+    When present, we do not check that the store is itself a directory, so that
+    this function is able to correctly infer and return the root of Git repos
+    where [".git"] is not a directory (e.g. Git worktrees).
+
+    You may supply several stores if you want to stop at the first store that is
+    encountered, if you do not know in what kind of repo you are. For example,
+    [[".git"; ".hg"]]. The store that was matched is returned as part of the
+    result.
+
+    If you know you are in a Git repository you may want to use the wrapper
+    {!val:find_enclosing_git_repo_root} instead. *)
+val find_enclosing_repo_root
+  :  [> Trait.file_system ] t
+  -> from:Absolute_path.t
+  -> store:Fpart.t list
+  -> ([ `Store of Fpart.t ] * Repo_root.t) option
+
+(** [find_enclosing_git_repo_root vcs ~from:dir] is a convenient wrapper around
+    {!val:find_enclosing_repo_root} for Git repositories. This is looking for
+    the right most directory containing a [".git"] entry, starting from [dir]
+    and walking up. *)
+val find_enclosing_git_repo_root
+  :  [> Trait.file_system ] t
+  -> from:Absolute_path.t
+  -> Repo_root.t option
+
 (** {1 Revisions} *)
 
 module Rev = Rev
@@ -134,13 +168,19 @@ val show_file_at_rev
 
 val load_file : [> Trait.file_system ] t -> path:Absolute_path.t -> File_contents.t
 
+(** Create a new file, or truncate an existing one. *)
 val save_file
   :  ?perms:int (** defaults to [0o666]. *)
   -> [> Trait.file_system ] t
   -> path:Absolute_path.t
   -> file_contents:File_contents.t
   -> unit
 
+(** Returns the entries of the supplied directory, ordered increasingly
+    according to [String.compare]. The result does not include the unix entries
+    ".", "..". *)
+val read_dir : [> Trait.file_system ] t -> dir:Absolute_path.t -> Fpart.t list
+
 (** {1 Branches & Tags} *)
 
 module Branch_name = Branch_name
@@ -200,7 +240,7 @@ module User_name = User_name
 
 (** During tests in the GitHub environment we end up having issues if we do not
     set the user name and email. Also, we rather not do it globally. If this
-    is never called, the current user config is used as usual by git processes
+    is never called, the current user config is used as usual by Git processes
     invocations. *)
 
 val set_user_name

lib/vcs/src/vcs0.ml

@@ -42,6 +42,12 @@ let save_file ?perms (Provider.T { t; handler }) ~path ~file_contents =
          (lazy [%sexp "Vcs.save_file", { perms : int option; path : Absolute_path.t }])
 ;;
 
+let read_dir (Provider.T { t; handler }) ~dir =
+  let module M = (val Provider.Handler.lookup handler ~trait:Trait.File_system) in
+  M.read_dir t ~dir
+  |> of_result ~step:(lazy [%sexp "Vcs.read_dir", { dir : Absolute_path.t }])
+;;
+
 let add (Provider.T { t; handler }) ~repo_root ~path =
   let module M = (val Provider.Handler.lookup handler ~trait:Trait.Add) in
   M.add t ~repo_root ~path
@@ -54,6 +60,31 @@ let init (Provider.T { t; handler }) ~path =
   M.init t ~path |> of_result ~step:(lazy [%sexp "Vcs.init", { path : Absolute_path.t }])
 ;;
 
+let find_enclosing_repo_root t ~from ~store =
+  let rec visit dir =
+    let entries = read_dir t ~dir in
+    match List.find entries ~f:(fun entry -> List.mem store entry ~equal:Fpart.equal) with
+    | Some entry ->
+      let dir =
+        Fpath.rem_empty_seg (dir :> Fpath.t)
+        |> Absolute_path.of_fpath
+        |> Option.value ~default:dir
+      in
+      Some (`Store entry, Repo_root.of_absolute_path dir)
+    | None ->
+      (match Absolute_path.parent dir with
+       | None -> None
+       | Some parent_dir -> visit parent_dir)
+  in
+  visit from
+;;
+
+let find_enclosing_git_repo_root t ~from =
+  match find_enclosing_repo_root t ~from ~store:[ Fpart.dot_git ] with
+  | None -> None
+  | Some (_, repo_root) -> Some repo_root
+;;
+
 let current_branch (Provider.T { t; handler }) ~repo_root =
   let module M = (val Provider.Handler.lookup handler ~trait:Trait.Rev_parse) in
   M.current_branch t ~repo_root