Source file cmd__tools__enclosing_repo_info.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
(********************************************************************************)
(*  crs - A tool for managing inline review comments embedded in source code    *)
(*  Copyright (C) 2024-2026 Mathieu Barbin <mathieu.barbin@gmail.com>           *)
(*                                                                              *)
(*  This file is part of crs.                                                   *)
(*                                                                              *)
(*  crs is free software; you can redistribute it and/or modify it under the    *)
(*  terms of the GNU Lesser General Public License as published by the Free     *)
(*  Software Foundation either version 3 of the License, or any later version,  *)
(*  with the LGPL-3.0 Linking Exception.                                        *)
(*                                                                              *)
(*  crs is distributed in the hope that it will be useful, but WITHOUT ANY      *)
(*  WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS   *)
(*  FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and     *)
(*  the file `NOTICE.md` at the root of this repository for more details.       *)
(*                                                                              *)
(*  You should have received a copy of the GNU Lesser General Public License    *)
(*  and the LGPL-3.0 Linking Exception along with this library. If not, see     *)
(*  <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.        *)
(********************************************************************************)

let main =
  Command.make
    ~summary:"A util to get info about the enclosing repo."
    ~readme:(fun () ->
      "This debug command locates the root of the repository containing the current \
       working directory.\n\n\
       It then displays a json-expression containing several fields related to that \
       repository and the current path.\n\n\
       - $(b,repo_root) : The root of the enclosing repo (absolute path).\n\n\
       - $(b,path_in_repo) : The path of the current directory related to the repo root \
       (relative path).\n\n\
       - $(b,vcs_kind) : The kind of version control for the enclosing repository \
       (Git|Hg).\n\n\
       This command is meant for debug and quick tests only. Its output is unstable and \
       may change without semver updates. In particular it should not be relied on in \
       scripts.")
    (let open Command.Std in
     let+ () = Arg.return () in
     let cwd = Unix.getcwd () |> Absolute_path.v in
     let { Enclosing_repo.vcs_kind; repo_root; vcs = _ } =
       Common_helpers.find_enclosing_repo ~from:cwd
     in
     let path_in_repo =
       Common_helpers.relativize ~repo_root ~cwd ~path:(Relative_path.empty :> Fpath.t)
     in
     (* Even though we say that this command shall not be used by scripts, it is
        actually used internally by the emacs-mode provided by this repo. We
        control both code and release them in sync, however breaking upgrades
        shall be done with care. At the moment, the emacs code relies on the
        presence of [json-string] fields [repo_root] and [path_in_repo]. *)
     print_endline
       (Json.to_string
          (`Assoc
              [ "repo_root", `String (repo_root |> Vcs.Repo_root.to_string)
              ; "path_in_repo", `String (path_in_repo |> Vcs.Path_in_repo.to_string)
              ; "vcs_kind", `String (vcs_kind |> Enclosing_repo.Vcs_kind.to_string)
              ]));
     ())
;;