robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Views++: Factored Job.Build to Job_build + Renamed Builder to Builds to avoid collision with lib

Browse source
This commit is contained in:
rand00 2022-02-02 23:03:16 +01:00
parent f40a081198
commit c17802d84f
2 changed files with 206 additions and 279 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
lib/builder_web.ml
View file

@ -100,7 +100,7 @@ let dream_svg ?status ?code ?headers body =
let add_routes datadir =
let datadir_global = Dream.new_global ~name:"datadir" (fun () -> datadir) in
let builder req =
let builds req =
Dream.sql req Model.jobs_with_section_synopsis
|> if_error "Error getting jobs"
~log:(fun e -> Log.warn (fun m -> m "Error getting jobs: %a" pp_error e))
@ -126,7 +126,7 @@ let add_routes datadir =
|> if_error "Error getting jobs"
~log:(fun e -> Log.warn (fun m -> m "Error getting jobs: %a" pp_error e))
>>= fun jobs ->
Views.builder jobs |> string_of_html |> Dream.html |> Lwt_result.ok
Views.Builds.make jobs |> string_of_html |> Dream.html |> Lwt_result.ok
in
let job req =
@ -279,7 +279,7 @@ let add_routes datadir =
|> if_error "Error getting job build"
~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e))
>>= fun (build, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest, next, previous) ->
Views.Job.Build.make
Views.Job_build.make
~name:job_name
~build
~artifacts
@ -493,7 +493,7 @@ let add_routes datadir =
let w f req = or_error_response (f req) in
Dream.router [
Dream.get "/" (w builder);
Dream.get "/" (w builds);
Dream.get "/job/:job/" (w job);
Dream.get "/job/:job/failed/" (w job_with_failed);
Dream.get "/job/:job/build/latest/**" (w redirect_latest);

87
lib/views.ml
View file

@ -155,9 +155,9 @@ let artifact ?(basename=false) job_name build { Builder_db.filepath; localpath =
txtf " (%a)" Fmt.byte_size size;
]
module Builds = struct
let builder section_job_map =
let make section_job_map =
layout ~title:"Reproducible OPAM builds"
([ h1 [txt "Reproducible OPAM builds"];
p [ txt "This website offers binary MirageOS unikernels and supplementary OS packages." ];
@ -227,80 +227,7 @@ let builder section_job_map =
txt "."
]])
let safe_omd omd =
let rec safe_block = function
| Omd.Paragraph (attr, inline) ->
safe_inline inline
|> Option.map (fun inline -> Omd.Paragraph (attr, inline))
| Omd.List (attr, typ, spacing, blocks) ->
let blocks = List.filter_map (fun b ->
let b = List.filter_map safe_block b in
if b = [] then None else Some b)
blocks
in
if blocks = [] then None else
Some (Omd.List (attr, typ, spacing, blocks))
| Omd.Blockquote (attr, blocks) ->
let blocks = List.filter_map safe_block blocks in
if blocks = [] then None else
Some (Omd.Blockquote (attr, blocks))
| Omd.Heading (attr, level, inline) ->
safe_inline inline
|> Option.map (fun inline -> Omd.Heading (attr, level, inline))
| Omd.Html_block _ -> None
| Omd.Definition_list (attr, def_elts) ->
let def_elts = List.filter_map safe_def_elts def_elts in
if def_elts = [] then None else
Some (Omd.Definition_list (attr, def_elts))
| Omd.Code_block _
| Omd.Thematic_break _ as v -> Some v
and safe_def_elts { term ; defs } =
let defs = List.filter_map safe_inline defs in
safe_inline term
|> Option.map (fun term -> { Omd.term ; defs })
and safe_inline = function
| Concat (attr, inline) ->
Some (Concat (attr, List.filter_map safe_inline inline))
| Emph (attr, inline) ->
safe_inline inline
|> Option.map (fun inline -> Omd.Emph (attr, inline))
| Strong (attr, inline) ->
safe_inline inline
|> Option.map (fun inline -> Omd.Strong (attr, inline))
| Link (attr, link) ->
begin match safe_link link with
| `No_label | `Relative -> safe_inline link.Omd.label
| `Link l -> Some (Omd.Link (attr, l))
end
| Image (attr, link) ->
begin match safe_link link with
| `No_label | `Relative -> None
| `Link l -> Some (Omd.Image (attr, l))
end
| Html _ -> None
| Text _
| Code _
| Hard_break _
| Soft_break _ as v -> Some v
and safe_link ({ label ; destination ; _ } as l) =
let absolute_link =
String.(length destination >= 2 && equal (sub destination 0 2) "//") ||
String.(length destination >= 7 && equal (sub destination 0 7) "http://") ||
String.(length destination >= 8 && equal (sub destination 0 8) "https://")
in
if absolute_link then
match safe_inline label with
| None -> `No_label
| Some label -> `Link { l with label }
else
`Relative
in
List.filter_map safe_block omd
let markdown_to_html data =
let omd = Omd.of_string data in
let omd = safe_omd omd in
Omd.to_html omd
module Job = struct
@ -313,7 +240,7 @@ module Job = struct
[
h2 ~a:[a_id "readme"] [txt "README"];
a ~a:[a_href "#builds"] [txt "Skip to builds"];
Unsafe.data (markdown_to_html data)
Unsafe.data (Utils.Omd.html_of_string data)
])) @
[
h2 ~a:[a_id "builds"] [txt "Builds"];
@ -340,14 +267,16 @@ module Job = struct
p [ txt "Including failed builds " ; a ~a:[a_href "failed/"] [txt "here"] ; txt "." ]
])
end
module Job_build = struct
let contains_debug_bin artifacts =
let check f =
Fpath.has_ext "debug" f.Builder_db.filepath
in
List.exists check artifacts
module Build = struct
let make_build_info
~name
~delta
@ -530,8 +459,6 @@ module Job = struct
end
end
let key_values xs =
List.concat_map (fun (k, v) -> [ txtf "%s %s" k v ; br () ]) xs