package dune-release

  1. Overview
  2. Docs

Source file lint.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
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
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
open Bos_setup

type t = [ `Std_files | `Opam ]

let lint_files pkg =
  Pkg.readmes pkg >>= fun readmes ->
  Pkg.licenses pkg >>= fun licenses ->
  Pkg.change_logs pkg >>= fun changelogs ->
  Pkg.opam pkg >>| fun opam ->
  readmes
  @ licenses
  @ changelogs
  @ [opam]

let report_status status f =
  Logs.app (fun l -> f (fun ?header ?tags fmt -> l ?header ?tags ("%a " ^^ fmt) Text.Pp.status status))

let lint_std_files ~dry_run pkg =
  let lint_exists file errs =
    let report exists =
      let status, errs = if exists then `Ok, errs else `Fail, errs + 1 in
      report_status status (fun m -> m "@[File %a@ is@ present.@]" Text.Pp.path file);
      errs
    in
    (Sos.file_exists ~dry_run file >>= fun exists -> Ok (report exists))
    |> Logs.on_error_msg ~use:(fun () -> errs + 1)
  in
  begin
    lint_files pkg >>= fun files ->
    let files = Fpath.Set.of_list files in
    Ok (Fpath.Set.fold lint_exists files 0)
  end
  |> Logs.on_error_msg ~use:(fun () -> 1)

let lint_file_with_cmd ~dry_run ~file_kind ~cmd ~handle_exit file errs =
  let run_linter cmd file ~exists =
    if not (exists || dry_run) then
      Ok (`Fail (strf "%a: No such file" Fpath.pp file))
    else
    Sos.run_out ~dry_run ~err:OS.Cmd.err_run_out Cmd.(cmd % p file)
      ~default:(Sos.out "") OS.Cmd.out_string
    >>| fun (out, status) -> handle_exit (snd status) out
  in
  begin
    OS.File.exists file
    >>= fun exists -> run_linter cmd file ~exists
    >>| function
    | `Ok ->
        Logs.app (fun m -> m "%a @[lint@ %s %a.@]" Text.Pp.status `Ok file_kind Text.Pp.path file);
        errs
    | `Fail msgs ->
        Logs.app
          (fun m -> m "%a @[<v>@[lint@ %s %a:@]@,@[%a messages:@]@,%a@]"
              Text.Pp.status `Fail file_kind Text.Pp.path file Cmd.pp cmd Fmt.lines msgs);
        errs + 1
  end
  |> Logs.on_error_msg ~use:(fun () -> errs + 1)

let lint_res ~msgf = function
  | Ok _ ->
      report_status `Ok msgf;
      0
  | Error _ as err ->
      report_status `Fail msgf;
      Logs.on_error_msg ~use:(fun () -> 1) err

let pp_field = Fmt.(styled `Bold string)

let lint_opam_doc pkg =
  lint_res
    ~msgf:(fun l -> l "opam field %a can be parsed by dune-release" pp_field "doc")
    (Pkg.doc_user_repo_and_path pkg)

let lint_opam_home_and_dev pkg =
  lint_res
    ~msgf:
      (fun l ->
         l "opam fields %a and %a can be parsed by dune-release"
           pp_field
           "homepage"
           pp_field
           "dev-repo")
    (Pkg.distrib_user_and_repo pkg)

let lint_opam_github_fields pkg =
  lint_opam_doc pkg
  + lint_opam_home_and_dev pkg

let opam_lint_cmd ~opam_file_version ~opam_tool_version =
  let lint_older_format =
    match opam_file_version, opam_tool_version with
    | Some "1.2", `v2 -> true
    | _ -> false
  in
  Cmd.(Opam.cmd % "lint" %% (on lint_older_format (v "--warn=-21-32-48")))

(* We first run opam lint with -s and if there's something beyond 5
   we rerun it without it for the error messages. It's ugly since 5
   will still but opam lint's cli is broken. *)
let handle_opam_lint_exit ~dry_run ~verbose_lint_cmd ~opam_file status output =
  match status, output with
  | `Exited 0, ("" | "5") -> `Ok
  | _ ->
      let default = Sos.out "" in
      let err = OS.Cmd.err_run_out in
      let cmd = Cmd.(verbose_lint_cmd % p opam_file) in
      let verbose_lint_output = Sos.run_out ~dry_run ~err ~default cmd OS.Cmd.out_string in
      match verbose_lint_output with
      | Ok (out, _)
      | Error (`Msg out) -> `Fail out

let check_has_description ~opam_file pkg =
  Pkg.opam_field_hd pkg "description" >>= function
  | None -> R.error_msgf "%a does not have a 'description' field." Fpath.pp opam_file
  | Some _ -> Ok ()

let lint_descr ~opam_file pkg =
  lint_res
    ~msgf:(fun l -> l "opam field %a is present" pp_field "description")
    (check_has_description ~opam_file pkg)

let opam_lint ~dry_run ~opam_file_version ~opam_tool_version opam_file =
  let base_lint_cmd = opam_lint_cmd ~opam_file_version ~opam_tool_version in
  let short_lint_cmd = Cmd.(base_lint_cmd % "-s") in
  let verbose_lint_cmd = base_lint_cmd in
  lint_file_with_cmd
    ~dry_run
    ~file_kind:"opam file"
    ~cmd:short_lint_cmd
    ~handle_exit:(handle_opam_lint_exit ~dry_run ~verbose_lint_cmd ~opam_file)
    opam_file
    0

let extra_opam_lint ~opam_file_version ~opam_file pkg =
  let is_2_0_format = match opam_file_version with Some "2.0" -> true | _ -> false in
  let descr_err = if is_2_0_format then lint_descr ~opam_file pkg else 0 in
  let github_field_errs = lint_opam_github_fields pkg in
  descr_err + github_field_errs

let lint_opam ~dry_run pkg =
  let opam_tool_version = Lazy.force Opam.version in
  Pkg.opam_field_hd pkg "opam-version" >>= fun opam_file_version ->
  match opam_file_version, opam_tool_version with
  | Some "2.0", `v1_2_2 ->
      Logs.app
        (fun l ->
           l "Skipping opam lint as `opam-version` field is \"2.0\" while `opam --version` is 1.2.2");
      Ok 0
  | _ ->
      Pkg.opam pkg >>= fun opam_file ->
      let opam_lint_errors = opam_lint ~dry_run ~opam_file_version ~opam_tool_version opam_file in
      let extra_errors = extra_opam_lint ~opam_file_version ~opam_file pkg in
      Ok (opam_lint_errors + extra_errors)

let lint_opam ~dry_run pkg =
  Logs.on_error_msg ~use:(fun () -> 1) (lint_opam ~dry_run pkg)

let t_to_fun =
  [`Std_files, lint_std_files;
   `Opam, lint_opam ]

let all = List.map fst t_to_fun

let apply_lint ~dry_run t pkg =
  let f = List.assoc t t_to_fun in
  f ~dry_run pkg

let lint_pkg ~dry_run ~dir pkg todo =
  let lint pkg =
    let do_lint acc t =
      let errs = apply_lint t ~dry_run pkg in
      acc + errs
    in
    let total_errs = List.fold_left do_lint 0 todo in
    match total_errs with
    | 0 ->
        Logs.app
          (fun m -> m "%a lint %a %a" Text.Pp.status `Ok Text.Pp.path dir (Fmt.styled_unit `Green "success") ());
        0
    | n ->
        Logs.app
          (fun m -> m "%a lint %a %a: %d errors."
              Text.Pp.status `Fail
              Text.Pp.path dir
              (Fmt.styled_unit `Red "failure") ()
              n);
        1
  in
  Sos.with_dir ~dry_run dir lint pkg
OCaml

Innovation. Community. Security.