@ -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 >
[ ! [ orel results ] ( https : // orel . ocamlpro . com / badges /% s . svg ) ] ( 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 () ;
(* 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
(* 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@. " ;
(* 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
(* 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 ;
| 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
(* 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 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
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
(* 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 ;
