Merge branch '20220202_refactoring_views'

Reviewed-on: https://git.robur.io/robur/builder-web/pulls/72

.ocp-indent

@@ -0,0 +1,130 @@
+# -*- conf -*-
+# This is an example configuration file for ocp-indent
+#
+# Copy to the root of your project with name ".ocp-indent", customise, and
+# transparently get consistent indentation on all your ocaml source files.
+
+# Starting the configuration file with a preset ensures you won't fallback to
+# definitions from "~/.ocp/ocp-indent.conf".
+# These are `normal`, `apprentice` and `JaneStreet` and set different defaults.
+normal
+
+#
+#    INDENTATION VALUES
+#
+
+# Number of spaces used in all base cases, for example:
+#    let foo =
+#    ^^bar
+base = 2
+
+# Indent for type definitions:
+#    type t =
+#    ^^int
+type = 2
+
+# Indent after `let in` (unless followed by another `let`):
+#    let foo = () in
+#    ^^bar
+in = 0
+
+# Indent after `match/try with` or `function`:
+#    match foo with
+#    ^^| _ -> bar
+with = 0
+
+# Indent for clauses inside a pattern-match (after the arrow):
+#    match foo with
+#    | _ ->
+#    ^^^^bar
+# the default is 2, which aligns the pattern and the expression
+match_clause = 2 
+
+# Indentation for items inside extension nodes:
+#    [%% id.id
+#    ^^^^contents ]
+#    [@@id
+#    ^^^^foo
+#    ]
+ppx_stritem_ext = 2
+
+# When nesting expressions on the same line, their indentation are in
+# some cases stacked, so that it remains correct if you close them one
+# at a line. This may lead to large indents in complex code though, so
+# this parameter can be used to set a maximum value. Note that it only
+# affects indentation after function arrows and opening parens at end
+# of line.
+#
+# for example (left: `none`; right: `4`)
+#    let f = g (h (i (fun x ->     #    let f = g (h (i (fun x ->
+#          x)                      #        x)
+#        )                         #      )
+#      )                           #    )
+max_indent = 4
+
+
+#
+#    INDENTATION TOGGLES
+#
+
+# Wether the `with` parameter should be applied even when in a sub-block.
+# Can be `always`, `never` or `auto`.
+# if `always`, there are no exceptions
+# if `auto`, the `with` parameter is superseded when seen fit (most of the time,
+#            but not after `begin match` for example)
+# if `never`, `with` is only applied if the match block starts a line.
+#
+# For example, the following is not indented if set to `always`:
+#    let f = function
+#    ^^| Foo -> bar
+strict_with = never
+
+# Controls indentation after the `else` keyword. `always` indents after the
+# `else` keyword normally, like after `then`.
+# If set to `never', the `else` keyword won't indent when followed by a newline.
+# `auto` indents after `else` unless in a few "unclosable" cases (`let in`,
+# `match`...).
+#
+# For example, with `strict_else=never`:
+#    if cond then
+#      foo
+#    else
+#    bar;
+#    baz
+# `never` is discouraged if you may encounter code like this example,
+# because it hides the scoping error (`baz` is always executed)
+strict_else = always
+
+# Ocp-indent will normally try to preserve your in-comment indentation, as long
+# as it respects the left-margin or starts with `(*\n`. Setting this to `true`
+# forces alignment within comments.
+strict_comments = false
+
+# Toggles preference of column-alignment over line indentation for most
+# of the common operators and after mid-line opening parentheses.
+#
+# for example (left: `false'; right: `true')
+#    let f x = x            #    let f x = x
+#      + y                  #              + y
+align_ops = true
+
+# Function parameters are normally indented one level from the line containing
+# the function. This option can be used to have them align relative to the
+# column of the function body instead.
+# if set to `always`, always align below the function
+# if `auto`, only do that when seen fit (mainly, after arrows)
+# if `never`, no alignment whatsoever
+#
+# for example (left: `never`; right: `always or `auto)
+#    match foo with         #    match foo with
+#    | _ -> some_fun        #    | _ -> some_fun
+#      ^^parameter          #           ^^parameter
+align_params = auto
+
+
+#
+#    SYNTAX EXTENSIONS
+#
+
+# You can also add syntax extensions (as per the --syntax command-line option):
+# syntax = mll lwt

lib/builder_web.ml

@@ -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 =
@@ -138,7 +138,9 @@ let add_routes datadir =
     |> if_error "Error getting job"
       ~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e))
     >>= fun (readme, builds) ->
-    Views.Job.make ~failed:false job_name platform readme builds |> string_of_html |> Dream.html |> Lwt_result.ok
+    builds
+    |> Views.Job.make ~failed:false ~job_name ~platform ~readme 
+    |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 
   let job_with_failed req =
@@ -150,7 +152,9 @@ let add_routes datadir =
     |> if_error "Error getting job"
       ~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e))
     >>= fun (readme, builds) ->
-    Views.Job.make ~failed:true job_name platform readme builds |> string_of_html |> Dream.html |> Lwt_result.ok
+    builds
+    |> Views.Job.make ~failed:true ~job_name ~platform ~readme
+    |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 
   let redirect_latest req =
@@ -279,7 +283,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
@@ -446,8 +450,13 @@ let add_routes datadir =
     in
     let switch_left = OpamFile.SwitchExport.read_from_string switch_left
     and switch_right = OpamFile.SwitchExport.read_from_string switch_right in
-    Opamdiff.compare switch_left switch_right
-    |> Views.compare_builds job_left job_right build_left build_right env_diff pkg_diff
+    let opam_diff = Opamdiff.compare switch_left switch_right in
+    Views.compare_builds
+      ~job_left ~job_right
+      ~build_left ~build_right
+      ~env_diff
+      ~pkg_diff
+      ~opam_diff
     |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 
@@ -493,7 +502,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);

lib/utils.ml

@@ -44,3 +44,83 @@ let compare_pkgs p1 p2 =
     String_map.empty (Astring.String.cuts ~sep:"\n" p)
   in
   diff_map (parse_pkgs p1) (parse_pkgs p2)
+
+module Omd = struct
+
+  let make_safe 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 html_of_string markdown =
+    markdown
+    |> Omd.of_string 
+    |> make_safe 
+    |> Omd.to_html 
+
+end

test/markdown_to_html.ml

@@ -1,4 +1,4 @@
-let markdown_to_html = Builder_web__Views.markdown_to_html
+let markdown_to_html = Builder_web__Utils.Omd.html_of_string
 
 let test_simple () =
   let markdown = {|# Hello world|} in