Source file `commit_id.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
[@@@ocaml.warning "-3"]

type t = {
  repo : string;  (* Remote repository from which to pull. *)
  gref : string;  (* Ref to pull, e.g. "master" or "pull/12/head". *)
  hash : string;  (* Hash that [gref] is expected to have. *)
} [@@deriving yojson]

[@@@ocaml.warning "+3"]

let ensure_no_spaces x =
  if String.contains x ' ' then
    Fmt.failwith "Spaces are not allowed here (in %S)" x

let v ~repo ~gref ~hash =
  ensure_no_spaces repo;
  ensure_no_spaces gref;
  ensure_no_spaces hash;
  { repo; gref; hash }

let pp f {repo; gref; hash} =
  Fmt.pf f "%s#%s (%s)" repo gref hash

let is_local t =
  if Astring.String.is_prefix ~affix:"file:" t.repo then true
  else match String.index_opt t.repo ':',
             String.index_opt t.repo '/' with
  | Some i, Some j -> i < j     (* http://... is remote; /http:foo is local *)
  | None, _ -> true             (* All remote URLs have colons *)
  | Some _, None -> false       (* foo:bar is remote *)

let equal = (=)
let compare = compare
let digest {repo; gref; hash} = Fmt.str "%s %s %s" repo gref hash

let repo t = t.repo
let gref t = t.gref
let hash t = t.hash

(* git-clone doesn't like the "refs/heads" prefix. *)
let strip_heads gref =
  let prefix = "refs/heads/" in
  let open Astring in
  if String.is_prefix ~affix:prefix gref then
    String.with_index_range ~first:(String.length prefix) gref
  else
    gref

let pp_user_clone f id =
  let short_hash = Astring.String.with_range ~len:8 id.hash in
  if Astring.String.(is_prefix ~affix:"refs/pull/" id.gref
                     || is_prefix ~affix:"refs/merge-requests/" id.gref) then (
    (* GitHub and GitLab don't recognise pull requests in clones, but they do in fetches. *)
    Fmt.pf f "git clone --recursive %S && cd %S && git fetch origin %S && git reset --hard %s"
      id.repo
      (Filename.basename id.repo |> Filename.remove_extension)
      (strip_heads id.gref)
      short_hash
  ) else (
    Fmt.pf f "git clone --recursive %S -b %S && cd %S && git reset --hard %s"
      id.repo
      (strip_heads id.gref)
      (Filename.basename id.repo |> Filename.remove_extension)
      short_hash
  )