Improve find_enclosing_repo_root

lib/vcs/src/vcs.mli

@@ -102,16 +102,16 @@ val init : [> Trait.init ] t -> path:Absolute_path.t -> Repo_root.t
 
     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.
+    [[".git", `Git; ".hg", `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:Fsegment.t list
-  -> ([ `Store of Fsegment.t ] * Repo_root.t) option
+  -> store:(Fsegment.t * 'store) list
+  -> ('store * 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

lib/vcs/src/vcs0.ml

@@ -64,15 +64,17 @@ 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:Fsegment.equal)
+      List.find_map entries ~f:(fun entry ->
+        List.find_map store ~f:(fun (seg, store) ->
+          Option.some_if (Fsegment.equal seg entry) store))
     with
-    | Some entry ->
+    | Some store ->
       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)
+      Some (store, Repo_root.of_absolute_path dir)
     | None ->
       (match Absolute_path.parent dir with
        | None -> None
@@ -82,9 +84,9 @@ let find_enclosing_repo_root t ~from ~store =
 ;;
 
 let find_enclosing_git_repo_root t ~from =
-  match find_enclosing_repo_root t ~from ~store:[ Fsegment.dot_git ] with
+  match find_enclosing_repo_root t ~from ~store:[ Fsegment.dot_git, `Git ] with
   | None -> None
-  | Some (_, repo_root) -> Some repo_root
+  | Some (`Git, repo_root) -> Some repo_root
 ;;
 
 let current_branch (Provider.T { t; handler }) ~repo_root =

lib/vcs/src/vcs_interface.mli

@@ -64,8 +64,8 @@ module type S = sig
   val find_enclosing_repo_root
     :  [> Trait.file_system ] t
     -> from:Absolute_path.t
-    -> store:Fsegment.t list
-    -> ([ `Store of Fsegment.t ] * Repo_root.t) option result
+    -> store:(Fsegment.t * 'store) list
+    -> ('store * Repo_root.t) option result
 
   val add
     :  [> Trait.add ] t

lib/vcs_command/src/vcs_command.ml

@@ -34,8 +34,8 @@ module Initialized = struct
 end
 
 let find_enclosing_repo_root vcs ~from =
-  match Vcs.find_enclosing_repo_root vcs ~from ~store:[ Fsegment.dot_git ] with
-  | Some (`Store _, repo_root) -> repo_root
+  match Vcs.find_enclosing_repo_root vcs ~from ~store:[ Fsegment.dot_git, `Git ] with
+  | Some (`Git, repo_root) -> repo_root
   | None ->
     Vcs.raise_s
       "Failed to locate enclosing repo root from directory"
@@ -142,6 +142,7 @@ let find_enclosing_repo_root_cmd =
        | None -> cwd
        | Some from -> Absolute_path.relativize ~root:cwd from
      in
+     let store = List.map store ~f:(fun store -> store, `Store store) in
      match Vcs.find_enclosing_repo_root vcs ~from ~store with
      | None -> ()
      | Some (`Store store, repo_root) ->

test/expect/find_enclosing_repo_root.ml

@@ -74,23 +74,21 @@ let%expect_test "find_enclosing_repo_root" =
        Vcs.find_enclosing_repo_root
          vcs
          ~from:subdir
-         ~store:[ Fsegment.dot_git; Fsegment.dot_hg ]
+         ~store:[ Fsegment.dot_git, `Git; Fsegment.dot_hg, `Hg ]
      with
-     | None -> assert false
-     | Some (`Store store, repo_root2) ->
-       require_equal [%here] (module Fsegment) store Fsegment.dot_git;
+     | None | Some (`Hg, _) -> assert false
+     | Some (`Git, repo_root2) ->
        require_equal [%here] (module Vcs.Repo_root) repo_root repo_root2;
        [%expect {||}]);
     (* 2. Non-raising [find_enclosing_repo_root]. *)
     (match
        Vcs.Result.find_enclosing_repo_root
          vcs
          ~from:subdir
-         ~store:[ Fsegment.dot_git; Fsegment.dot_hg ]
+         ~store:[ Fsegment.dot_git, `Git; Fsegment.dot_hg, `Hg ]
      with
-     | Error _ | Ok None -> assert false
-     | Ok (Some (`Store store, repo_root2)) ->
-       require_equal [%here] (module Fsegment) store Fsegment.dot_git;
+     | Error _ | Ok None | Ok (Some (`Hg, _)) -> assert false
+     | Ok (Some (`Git, repo_root2)) ->
        require_equal [%here] (module Vcs.Repo_root) repo_root repo_root2;
        [%expect {||}]);
     (* 3. Raising [find_enclosing_git_repo_root]. *)
@@ -109,10 +107,11 @@ let%expect_test "find_enclosing_repo_root" =
       ~create:(`Or_truncate 0o666)
       Eio.Path.(Eio.Stdenv.fs env / Absolute_path.to_string stop_at / ".hg")
       "";
-    match Vcs.find_enclosing_repo_root vcs ~from:subdir ~store:[ Fsegment.dot_hg ] with
+    match
+      Vcs.find_enclosing_repo_root vcs ~from:subdir ~store:[ Fsegment.dot_hg, `Hg ]
+    with
     | None -> assert false
-    | Some (`Store store, repo_root2) ->
-      require_equal [%here] (module Fsegment) store Fsegment.dot_hg;
+    | Some (`Hg, repo_root2) ->
       require_equal
         [%here]
         (module Vcs.Repo_root)