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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
open OpamFilename.Op
open OpamProcess.Job.Op
module VCS = struct
let name = `hg
let mark_prefix = "opam-mark"
let exists repo_root =
OpamFilename.exists_dir (repo_root / ".hg")
let hg repo_root =
let dir = OpamFilename.Dir.to_string repo_root in
fun ?verbose ?env ?stdout args ->
OpamSystem.make_command ~dir ?verbose ?env ?stdout "hg" args
let init repo_root _repo_url =
OpamFilename.mkdir repo_root;
hg repo_root [ "init" ] @@> fun r ->
OpamSystem.raise_on_process_error r;
Done ()
let mark_from_url url =
match url.OpamUrl.hash with
| None -> mark_prefix
| Some fragment -> mark_prefix ^ "-" ^ fragment
let fetch ?full_fetch:_ ?cache_dir:_ ?subpath:_ repo_root repo_url =
let src = OpamUrl.base_url repo_url in
let rev = OpamStd.Option.default "default" repo_url.OpamUrl.hash in
let mark = mark_from_url repo_url in
hg repo_root [ "pull"; "--rev"; rev; src ] @@> fun r ->
OpamSystem.raise_on_process_error r;
hg repo_root [ "bookmark"; "--force"; "--rev"; rev; mark ] @@> fun r ->
OpamSystem.raise_on_process_error r;
Done ()
let revision repo_root =
hg repo_root [ "identify"; "--id" ] @@> fun r ->
OpamSystem.raise_on_process_error r;
match r.OpamProcess.r_stdout with
| [] -> Done None
| full::_ ->
Done (Some full)
let clean repo_root =
hg repo_root ["revert"; "--all"; "--no-backup"]
@@> fun r ->
OpamSystem.raise_on_process_error r;
Done ()
let reset_tree repo_root repo_url =
let mark = mark_from_url repo_url in
hg repo_root [ "update"; "--clean"; "--rev"; mark ] @@> fun r ->
OpamSystem.raise_on_process_error r;
Done ()
let patch_applied = reset_tree
let diff repo_root repo_url =
let patch_file = OpamSystem.temp_file ~auto_clean:false "hg-diff" in
let finalise () = OpamSystem.remove_file patch_file in
OpamProcess.Job.catch (fun e -> finalise (); raise e) @@ fun () ->
let mark = mark_from_url repo_url in
hg repo_root ~stdout:patch_file [ "diff"; "--text"; "--subrepos"; "--reverse";
"--rev"; mark ] @@> fun r ->
if OpamProcess.is_failure r then
(finalise ();
OpamSystem.internal_error "Hg error: '%s' not found." mark)
else if OpamSystem.file_is_empty patch_file then
(finalise (); Done None)
else
Done (Some (OpamFilename.of_string patch_file))
let is_up_to_date ?subpath:_ repo_root repo_url =
let mark = mark_from_url repo_url in
hg repo_root [ "status"; "--subrepos"; "--rev"; mark ] @@> fun r ->
OpamSystem.raise_on_process_error r;
Done (r.OpamProcess.r_stdout = [])
let versioned_files repo_root =
hg repo_root [ "locate" ] @@> fun r ->
OpamSystem.raise_on_process_error r;
Done r.OpamProcess.r_stdout
let vc_dir repo_root = OpamFilename.Op.(repo_root / ".hg")
let current_branch repo_root =
hg repo_root [ "identify"; "--bookmarks" ] @@> fun r ->
OpamSystem.raise_on_process_error r;
match r.OpamProcess.r_stdout with
| [] -> Done None
| marks::_ ->
let marks = OpamStd.String.split marks ' ' in
let marks =
List.filter (OpamStd.String.starts_with ~prefix:mark_prefix) marks
in
match marks with
| mark::_ -> Done (Some mark)
| [] ->
hg repo_root [ "identify"; "--branch" ] @@> fun r ->
OpamSystem.raise_on_process_error r;
match r.OpamProcess.r_stdout with
| branch::_ when branch <> "default" -> Done (Some branch)
| _ -> Done None
let is_dirty ?subpath:_ repo_root =
hg repo_root [ "status"; "--subrepos" ] @@> fun r ->
OpamSystem.raise_on_process_error r;
Done (r.OpamProcess.r_stdout = [])
let modified_files repo_root =
hg repo_root [ "status"; "--subrepos" ] @@> fun r ->
OpamSystem.raise_on_process_error r;
let files =
OpamStd.List.filter_map (fun line ->
match OpamStd.String.split line ' ' with
| ("A" | "M")::file::[] -> Some file
| _ -> None) r.OpamProcess.r_stdout
in
Done files
let get_remote_url ?hash repo_root =
hg repo_root [ "paths"; "default" ]
@@> function
| { OpamProcess.r_code = 0; _ } as r ->
(match r.r_stdout with
| [url] ->
(let url = OpamUrl.parse ~backend:`hg url in
if OpamUrl.local_dir url <> None then Done None else
let check_remote hash =
hg repo_root [ "id"; "-r"; hash; "default" ]
@@> fun r ->
if OpamProcess.is_success r then
Done (Some { url with hash = Some hash })
else Done (Some { url with hash = None})
in
match hash with
| None ->
(hg repo_root ["branch"] @@> function
| { OpamProcess.r_code = 0; OpamProcess.r_stdout = [hash]; _ } ->
check_remote hash
| { OpamProcess.r_code = 0; _ }
| { OpamProcess.r_code = 1; _ } -> Done (Some url)
| r -> OpamSystem.process_error r)
| Some hash -> check_remote hash)
| _ -> Done None)
| { OpamProcess.r_code = 1; _ } -> Done None
| r -> OpamSystem.process_error r
end
module B = OpamVCS.Make(VCS)