Source file `github_repo.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
open Bos_setup

type t = { owner : string; repo : string }

let equal t t' =
  let { owner; repo } = t in
  let { owner = owner'; repo = repo' } = t' in
  String.equal owner owner' && String.equal repo repo'

let pp fmt { owner; repo } =
  Format.fprintf fmt "@[<hov 2>{ owner = %S;@ repo = %S }@]" owner repo

let drop_git_ext repo =
  let affix = ".git" in
  if String.is_suffix ~affix repo then
    let len = String.length repo - String.length affix in
    StringLabels.sub ~pos:0 ~len repo
  else repo

let from_uri uri =
  let uri = Uri_helpers.parse uri in
  match uri with
  | Some
      {
        scheme = Some ("git+https" | "https") | None;
        domain = [ "com"; "github" ];
        path = [ owner; repo ];
      }
  | Some
      {
        scheme = Some "https" | None;
        domain = [ "io"; "github"; owner ];
        path = repo :: _;
      }
  | Some
      {
        scheme = Some ("git+ssh" | "ssh") | None;
        domain = [ "com"; "git@github" ];
        path = [ owner; repo ];
      } ->
      let repo = drop_git_ext repo in
      Some { owner; repo }
  | _ -> None

let fpath_of_list l =
  let rec aux acc l =
    match l with [] | [ "" ] -> acc | hd :: tl -> aux Fpath.(acc / hd) tl
  in
  match l with [] | [ "" ] -> Fpath.v "." | hd :: tl -> aux (Fpath.v hd) tl

let from_gh_pages uri =
  let uri = Uri_helpers.parse uri in
  match uri with
  | Some
      {
        scheme = Some "https" | None;
        domain = [ "io"; "github"; owner ];
        path = repo :: rest;
      } ->
      Some ({ owner; repo }, fpath_of_list rest)
  | _ -> None

let https_uri { owner; repo } =
  Printf.sprintf "https://github.com/%s/%s" owner repo

let ssh_uri { owner; repo } =
  Printf.sprintf "git@github.com:%s/%s.git" owner repo