add ocb support, again
This commit is contained in:
parent
c4f0b30854
commit
6da727943e
@ -21,6 +21,8 @@
|
||||
(>= 0.2))
|
||||
(crunch
|
||||
(>= 3.2.0))
|
||||
(ocb
|
||||
(>= 0.1))
|
||||
(bisect_ppx
|
||||
(and
|
||||
:with-test
|
||||
|
||||
@ -9,6 +9,7 @@ depends: [
|
||||
"dune" {>= "2.8" & >= "2.8"}
|
||||
"bos" {>= "0.2"}
|
||||
"crunch" {>= "3.2.0"}
|
||||
"ocb" {>= "0.1"}
|
||||
"bisect_ppx" {with-test & >= "2.6" & dev}
|
||||
"odoc" {with-doc}
|
||||
]
|
||||
|
||||
4
src/dune
4
src/dune
@ -10,7 +10,7 @@
|
||||
utils
|
||||
raw
|
||||
html)
|
||||
(libraries bos fpath re cmdliner))
|
||||
(libraries bos fpath re cmdliner ocb))
|
||||
|
||||
(executable
|
||||
(public_name orel)
|
||||
@ -20,7 +20,7 @@
|
||||
(executable
|
||||
(name orel_opam_repo)
|
||||
(modules orel_opam_repo)
|
||||
(libraries bos directories fpath orel))
|
||||
(libraries bos directories fpath orel ocb))
|
||||
|
||||
(rule
|
||||
(target assets.ml)
|
||||
|
||||
180
src/html.ml
180
src/html.ml
@ -8,19 +8,46 @@ let style file =
|
||||
| Some css -> Format.fprintf fmt {|%s|} css;
|
||||
close_out out
|
||||
|
||||
let make_ocb_badge_for path (score, max_score) =
|
||||
let file = Filename.basename path ^ ".svg" in
|
||||
|
||||
let target_file = Fpath.( (v "_orel_view") // (v "badges") // (v file)) in
|
||||
|
||||
let out = open_out (Fpath.to_string target_file) in
|
||||
let fmt = Format.formatter_of_out_channel out in
|
||||
|
||||
let fscore = Format.sprintf "%d / %d" score max_score in
|
||||
|
||||
let percent = 100 * score / max_score in
|
||||
|
||||
let rgb = Format.sprintf "%x%x%x" (255-percent) (155+percent) 85 in
|
||||
|
||||
let open Ocb in
|
||||
Gen.mk fmt ~label:"Orel" ~scale:1.5 ~color:(Color.Custom rgb) ~style:Style.Flat ~label_color:Color.Black ~status:fscore ();
|
||||
|
||||
close_out out
|
||||
|
||||
let get_score results =
|
||||
List.fold_left
|
||||
(fun (acc_score, acc_max_score) r ->
|
||||
match r with
|
||||
| Ok (_msg, max_score) ->
|
||||
(acc_score + max_score, acc_max_score + max_score)
|
||||
| Error (_msg, score, max_score) ->
|
||||
(acc_score + score, acc_max_score + max_score) )
|
||||
(0, 0) results
|
||||
|
||||
let result_to_html fmt results =
|
||||
let score, max_score =
|
||||
List.fold_left
|
||||
(fun (acc_score, acc_max_score) r ->
|
||||
match r with
|
||||
| Ok (msg, max_score) ->
|
||||
Utils.log fmt "<li>%s (%d/%d)</li>" msg max_score max_score;
|
||||
(acc_score + max_score, acc_max_score + max_score)
|
||||
| Error (msg, score, max_score) ->
|
||||
Format.fprintf fmt "<li>%s (%d/%d)</li>" msg score max_score;
|
||||
(acc_score + score, acc_max_score + max_score) )
|
||||
(0, 0) results
|
||||
in
|
||||
List.iter
|
||||
(fun r ->
|
||||
match r with
|
||||
| Ok (msg, max_score) ->
|
||||
Utils.log fmt "<li>%s (%d/%d)</li>" msg max_score max_score
|
||||
| Error (msg, score, max_score) ->
|
||||
Format.fprintf fmt "<li>%s (%d/%d)</li>" msg score max_score
|
||||
)
|
||||
results;
|
||||
let score, max_score = get_score results in
|
||||
Format.fprintf fmt "<br/><h2>Final score: %d / %d</h2><br />" score max_score
|
||||
|
||||
let head title = Format.sprintf {|
|
||||
@ -60,7 +87,7 @@ let header title =
|
||||
</header>
|
||||
|} (head title)
|
||||
|
||||
let output fmt result =
|
||||
let output fmt result package =
|
||||
Format.fprintf fmt
|
||||
{|%s
|
||||
<br />
|
||||
@ -69,9 +96,15 @@ let output fmt result =
|
||||
<br />
|
||||
<main>
|
||||
<div class="container">
|
||||
<h1> Orel results </h1>
|
||||
<h1> Orel results for %s</h1>
|
||||
<br />
|
||||
<br />
|
||||
<img src="badges/%s.svg">
|
||||
<br />
|
||||
Use this in your website:
|
||||
<code>
|
||||
[](https://orel.ocamlpro.com/%s.html)
|
||||
</code>
|
||||
<hr class="featurette-divider" />
|
||||
<br />
|
||||
<br />
|
||||
@ -88,9 +121,13 @@ let output fmt result =
|
||||
</html>
|
||||
|}
|
||||
(header "Orel results")
|
||||
package
|
||||
package
|
||||
package
|
||||
package
|
||||
result_to_html result
|
||||
|
||||
(** [view_summary fmt view_files] prints HTML into formatter [fmt]. [view_files] is a list of type [(file:string * score:string)] where file is a [.html] file found in directory _orel_view and [score] the final score given by orel. *)
|
||||
(** [view_summary fmt view_files] prints HTML into formatter [fmt]. [view_files] is a list of type [(file:string * score:string)] where file is [.html] file found in directory _orel_view and [score] the final score given by orel. *)
|
||||
let view_summary fmt view_files =
|
||||
Format.fprintf fmt
|
||||
{|%s
|
||||
@ -128,16 +165,20 @@ let view_summary fmt view_files =
|
||||
(** [view source_dirs] takes a list of source directories and creates a directory name [_orel_view] in which *)
|
||||
let view source_dirs =
|
||||
let orel_view_dir = "_orel_view" in
|
||||
let badges = "badges" in
|
||||
|
||||
(* check existence of [_orel_view] directory *)
|
||||
match Bos.OS.Dir.exists (Fpath.v orel_view_dir) with
|
||||
| Error e -> (match e with
|
||||
| `Msg m -> Format.eprintf "%s@." m);
|
||||
Utils.error "`Bos.OS.Dir.exists _orel_view` returned Error. (orel_opam_repo.ml)."
|
||||
(* stop view construction if [_orel_view] directory already exists *)
|
||||
| Ok true -> Utils.error "_orel_view already exists, can't delete your directory."
|
||||
(* else create [_orel_view] directory and proceed *)
|
||||
| Ok false ->
|
||||
begin
|
||||
match Bos.OS.Dir.exists (Fpath.v orel_view_dir) with
|
||||
| Error e -> (match e with
|
||||
| `Msg m -> Format.eprintf "%s@." m);
|
||||
Utils.error "`Bos.OS.Dir.exists _orel_view` returned Error. (orel_opam_repo.ml)."
|
||||
(* stop view construction if [_orel_view] directory already exists *)
|
||||
| Ok true -> Utils.error "_orel_view already exists, can't delete your directory."
|
||||
(* else create [_orel_view] directory and proceed *)
|
||||
| Ok false -> ()
|
||||
end;
|
||||
begin
|
||||
match Bos.OS.Dir.create (Fpath.v orel_view_dir) with
|
||||
| Error e -> (match e with
|
||||
| `Msg m -> Format.eprintf "%s@." m);
|
||||
@ -148,51 +189,62 @@ let view source_dirs =
|
||||
* [file] is the name of a given HTML file for a given package
|
||||
* [score] its score based on orel's checks
|
||||
* *)
|
||||
| Ok _b ->
|
||||
style "style.css";
|
||||
style "bootstrap.min.css";
|
||||
style "logo_ocp_icon.svg";
|
||||
style "logo_ocamlpro.png";
|
||||
let view_files =
|
||||
List.map
|
||||
(fun path ->
|
||||
(* name the file *)
|
||||
let file = Filename.basename path ^ ".html" in
|
||||
Format.printf "linting package %s... " (Filename.chop_extension file);
|
||||
Format.pp_print_flush Format.std_formatter ();
|
||||
| Ok _b -> ()
|
||||
end;
|
||||
begin
|
||||
match Bos.OS.Dir.create Fpath.(append (v orel_view_dir) (v badges)) with
|
||||
| Error e -> (match e with
|
||||
| `Msg m -> Format.eprintf "%s@." m);
|
||||
Utils.error "can't create _orel_view/badges dir."
|
||||
| Ok _b -> ()
|
||||
end;
|
||||
style "style.css";
|
||||
style "bootstrap.min.css";
|
||||
style "logo_ocp_icon.svg";
|
||||
style "logo_ocamlpro.png";
|
||||
let view_files =
|
||||
List.map
|
||||
(fun path ->
|
||||
(* name the file *)
|
||||
let file = Filename.basename path ^ ".html" in
|
||||
let package_name = (Filename.chop_extension file) in
|
||||
Format.printf "linting package %s... " package_name ;
|
||||
Format.pp_print_flush Format.std_formatter ();
|
||||
|
||||
(* prepend the path to it *)
|
||||
let target_file = Fpath.(append (Fpath.v orel_view_dir)) (Fpath.v file) in
|
||||
(* prepend the path to it *)
|
||||
let target_file = Fpath.(append (Fpath.v orel_view_dir)) (Fpath.v file) in
|
||||
|
||||
(* collect orel's results *)
|
||||
let results = Check.check_local (Fpath.v path) in
|
||||
(* collect orel's results *)
|
||||
let results = Check.check_local (Fpath.v path) in
|
||||
let score = get_score results in
|
||||
|
||||
(* open file, write to corresponding formatter and close *)
|
||||
let out = open_out (Fpath.to_string target_file) in
|
||||
let fmt = Format.formatter_of_out_channel out in
|
||||
output fmt results;
|
||||
close_out out;
|
||||
Format.printf "done@.";
|
||||
(* open file, write to corresponding formatter and close *)
|
||||
let out = open_out (Fpath.to_string target_file) in
|
||||
let fmt = Format.formatter_of_out_channel out in
|
||||
output fmt results package_name;
|
||||
close_out out;
|
||||
make_ocb_badge_for path score;
|
||||
Format.printf "done@.";
|
||||
|
||||
(* collect score *)
|
||||
let score, max_score =
|
||||
List.fold_left
|
||||
(fun (acc_score, acc_max_score) r ->
|
||||
match r with
|
||||
| Ok (_msg, max_score) -> (acc_score + max_score, acc_max_score + max_score)
|
||||
| Error (_msg, score, max_score) -> (acc_score + score, acc_max_score + max_score)
|
||||
) (0, 0) results
|
||||
in
|
||||
(* collect score *)
|
||||
let score, max_score =
|
||||
List.fold_left
|
||||
(fun (acc_score, acc_max_score) r ->
|
||||
match r with
|
||||
| Ok (_msg, max_score) -> (acc_score + max_score, acc_max_score + max_score)
|
||||
| Error (_msg, score, max_score) -> (acc_score + score, acc_max_score + max_score)
|
||||
) (0, 0) results
|
||||
in
|
||||
|
||||
file, Format.sprintf "%d / %d" score max_score)
|
||||
source_dirs
|
||||
in
|
||||
file, Format.sprintf "%d / %d" score max_score)
|
||||
source_dirs
|
||||
in
|
||||
|
||||
(* writes summary of all view files in a index.html file under [_orel_view/]*)
|
||||
let index_file = Fpath.(append (Fpath.v orel_view_dir)) (Fpath.v "index.html") in
|
||||
(* writes summary of all view files in a index.html file under [_orel_view/]*)
|
||||
let index_file = Fpath.(append (Fpath.v orel_view_dir)) (Fpath.v "index.html") in
|
||||
|
||||
(* open index.html, write to corresponding formatter and close *)
|
||||
let out = open_out (Fpath.to_string index_file) in
|
||||
let fmt = Format.formatter_of_out_channel out in
|
||||
view_summary fmt view_files;
|
||||
close_out out;
|
||||
(* open index.html, write to corresponding formatter and close *)
|
||||
let out = open_out (Fpath.to_string index_file) in
|
||||
let fmt = Format.formatter_of_out_channel out in
|
||||
view_summary fmt view_files;
|
||||
close_out out;
|
||||
|
||||
@ -28,7 +28,7 @@ let check verbose repo html =
|
||||
|
||||
Utils.set_verbose verbose;
|
||||
if html then
|
||||
Html.output Format.std_formatter results
|
||||
Html.output Format.std_formatter results repo
|
||||
else
|
||||
Raw.output Format.std_formatter results
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user