Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Page
Library
Module
Module type
Parameter
Class
Class type
Source
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 ? 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