Source file non_raising.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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
(*******************************************************************************)
(*  Volgo - a Versatile OCaml Library for Git Operations                       *)
(*  Copyright (C) 2024-2025 Mathieu Barbin <mathieu.barbin@gmail.com>          *)
(*                                                                             *)
(*  This file is part of Volgo.                                                *)
(*                                                                             *)
(*  Volgo 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.                              *)
(*                                                                             *)
(*  Volgo 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.       *)
(*******************************************************************************)

open! Import

module type M = Error_intf.S
module type S = Vcs_intf.S

module Make (M : M) :
  S with type 'a t := 'a Vcs0.t and type 'a result := ('a, M.t) Result.t = struct
  let try_with f =
    match f () with
    | r -> Ok r
    | exception Err.E err -> Error (M.of_err err)
  ;;

  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 =
    try_with (fun () -> Vcs0.commit vcs ~repo_root ~commit_message)
  ;;

  let ls_files vcs ~repo_root ~below =
    try_with (fun () -> Vcs0.ls_files vcs ~repo_root ~below)
  ;;

  let show_file_at_rev vcs ~repo_root ~rev ~path =
    try_with (fun () -> Vcs0.show_file_at_rev vcs ~repo_root ~rev ~path)
  ;;

  let load_file vcs ~path = try_with (fun () -> Vcs0.load_file vcs ~path)

  let save_file ?perms vcs ~path ~file_contents =
    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_)
  ;;

  let name_status vcs ~repo_root ~changed =
    try_with (fun () -> Vcs0.name_status vcs ~repo_root ~changed)
  ;;

  let num_status vcs ~repo_root ~changed =
    try_with (fun () -> Vcs0.num_status vcs ~repo_root ~changed)
  ;;

  let log vcs ~repo_root = try_with (fun () -> Vcs0.log vcs ~repo_root)
  let refs vcs ~repo_root = try_with (fun () -> Vcs0.refs vcs ~repo_root)
  let graph vcs ~repo_root = try_with (fun () -> Vcs0.graph vcs ~repo_root)

  let current_branch vcs ~repo_root =
    try_with (fun () -> Vcs0.current_branch vcs ~repo_root)
  ;;

  let current_revision vcs ~repo_root =
    try_with (fun () -> Vcs0.current_revision vcs ~repo_root)
  ;;

  let set_user_name vcs ~repo_root ~user_name =
    try_with (fun () -> Vcs0.set_user_name vcs ~repo_root ~user_name)
  ;;

  let set_user_email vcs ~repo_root ~user_email =
    try_with (fun () -> Vcs0.set_user_email vcs ~repo_root ~user_email)
  ;;

  let git ?env ?run_in_subdir vcs ~repo_root ~args ~f =
    match
      Vcs0.Private.git ?env ?run_in_subdir vcs ~repo_root ~args ~f:(fun output ->
        f output |> Result.map_error ~f:M.to_err)
    with
    | Ok t -> Ok t
    | Error err ->
      Error
        (M.of_err
           (Err.add_context
              err
              [ Err.sexp
                  (Vcs0.Private.make_git_err_step ?env ?run_in_subdir ~repo_root ~args ())
              ]))
  ;;

  let hg ?env ?run_in_subdir vcs ~repo_root ~args ~f =
    match
      Vcs0.Private.hg ?env ?run_in_subdir vcs ~repo_root ~args ~f:(fun output ->
        f output |> Result.map_error ~f:M.to_err)
    with
    | Ok t -> Ok t
    | Error err ->
      Error
        (M.of_err
           (Err.add_context
              err
              [ Err.sexp
                  (Vcs0.Private.make_hg_err_step ?env ?run_in_subdir ~repo_root ~args ())
              ]))
  ;;
end