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
167
168
169
170
171
172
173
open! Import
let parse_ref_kind_exn str : Vcs.Ref_kind.t =
match
Vcs.Private.try_with (fun () ->
let str =
match String.chop_prefix str ~prefix:"refs/" with
| Some str -> str
| None ->
raise (Err.E (Err.create [ Pp.text "Expected ref to start with ['refs/']." ]))
in
match String.lsplit2 str ~on:'/' with
| None -> Vcs.Ref_kind.Other { name = str }
| Some (kind, name) ->
(match kind with
| "heads" -> Local_branch { branch_name = Vcs.Branch_name.v name }
| "remotes" ->
Remote_branch { remote_branch_name = Vcs.Remote_branch_name.v name }
| "tags" -> Tag { tag_name = Vcs.Tag_name.v name }
| _ -> Other { name = str }))
with
| Ok t -> t
| Error err ->
raise
(Err.E
(Err.add_context
err
[ Err.sexp
(Sexp.List
[ Sexp.Atom "Volgo_git_backend.Refs.parse_ref_kind_exn"
; sexp_field (module String) "ref_kind" str
])
]))
;;
module Dereferenced = struct
module T = struct
[@@@coverage off]
type t =
{ rev : Vcs.Rev.t
; ref_kind : Vcs.Ref_kind.t
; dereferenced : bool
}
[@@deriving_inline sexp_of]
let sexp_of_t =
(fun { rev = rev__002_
; ref_kind = ref_kind__004_
; dereferenced = dereferenced__006_
} ->
let bnds__001_ = ([] : _ Stdlib.List.t) in
let bnds__001_ =
let arg__007_ = sexp_of_bool dereferenced__006_ in
(Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "dereferenced"; arg__007_ ]
:: bnds__001_
: _ Stdlib.List.t)
in
let bnds__001_ =
let arg__005_ = Vcs.Ref_kind.sexp_of_t ref_kind__004_ in
(Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "ref_kind"; arg__005_ ] :: bnds__001_
: _ Stdlib.List.t)
in
let bnds__001_ =
let arg__003_ = Vcs.Rev.sexp_of_t rev__002_ in
(Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "rev"; arg__003_ ] :: bnds__001_
: _ Stdlib.List.t)
in
Sexplib0.Sexp.List bnds__001_
: t -> Sexplib0.Sexp.t)
;;
[@@@deriving.end]
let equal =
(fun a__001_ b__002_ ->
if a__001_ == b__002_
then true
else
Vcs.Rev.equal a__001_.rev b__002_.rev
&& Vcs.Ref_kind.equal a__001_.ref_kind b__002_.ref_kind
&& equal_bool a__001_.dereferenced b__002_.dereferenced
: t -> t -> bool)
;;
end
include T
let parse_exn ~line:str =
match
Vcs.Private.try_with (fun () ->
match String.lsplit2 str ~on:' ' with
| None -> raise (Err.E (Err.create [ Pp.text "Invalid ref line." ]))
| Some (rev, ref_) ->
(match String.chop_suffix ref_ ~suffix:"^{}" with
| Some ref_ ->
{ rev = Vcs.Rev.v rev
; ref_kind = parse_ref_kind_exn ref_
; dereferenced = true
}
| None ->
{ rev = Vcs.Rev.v rev
; ref_kind = parse_ref_kind_exn ref_
; dereferenced = false
}))
with
| Ok t -> t
| Error err ->
raise
(Err.E
(Err.add_context
err
[ Err.sexp
(Sexp.List
[ Sexp.Atom "Volgo_git_backend.Refs.Dereferenced.parse_exn"
; sexp_field (module String) "line" str
])
]))
;;
end
module Ref_kind_table = Vcs.Private.Ref_kind_table
let parse_lines_exn ~lines =
let lines = List.map lines ~f:(fun line -> Dereferenced.parse_exn ~line) in
let dereferenced_refs =
let refs = Ref_kind_table.create (List.length lines) in
List.iter lines ~f:(fun (line : Dereferenced.t) ->
if line.dereferenced then Ref_kind_table.add refs ~key:line.ref_kind ~data:());
refs
in
List.filter_map lines ~f:(fun { Dereferenced.rev; ref_kind; dereferenced } ->
if Ref_kind_table.mem dereferenced_refs ref_kind && not dereferenced
then None
else Some { Vcs.Refs.Line.rev; ref_kind })
;;
module Make (Runtime : Runtime.S) = struct
type t = Runtime.t
let get_refs_lines t ~repo_root =
Runtime.git
t
~cwd:(repo_root |> Vcs.Repo_root.to_absolute_path)
~args:[ "show-ref"; "--dereference" ]
~f:(fun output ->
let open Result.Monad_syntax in
let* output = Vcs.Git.Result.exit0_and_stdout output in
Vcs.Private.try_with (fun () ->
parse_lines_exn ~lines:(String.split_lines output)))
;;
end