refactor and add a cache

src/dune

 (executable
  (public_name osh)
  (modules content osh template)
- (libraries dream ezcurl ocb omd yojson))
+ (libraries dream ezcurl ocb omd lambdasoup yojson))
 
 (rule
  (targets template.ml)

src/osh.ml

-let render ~title ~content =
-  Template.render_unsafe ~title ~content:(Dream.html_escape content)
+let get_title content =
+  let open Soup in
+  try
+    let soup = content |> parse in
+    soup $ "h1" |> R.leaf_text
+  with
+  | Failure _e -> "Osh by OCamlPro"
+
+let render_unsafe ?title content =
+  let title =
+    match title with
+    | None -> get_title content
+    | Some title -> title
+  in
+  Dream.html @@ Template.render_unsafe ~content ~title
 
 let asset_loader _root path _request =
   match Content.read ("assets/" ^ path) with
@@ -15,9 +28,7 @@ let page path =
     request. *)
 let mk_badge ~label ~color ~style ~label_color ~status ~scale request =
   let q field = Dream.query field request in
-  Dream.respond
-    ~headers:[ ("Content-Type", "image/svg+xml") ]
-    (let open Ocb in
+  let open Ocb in
   let module Option = Stdlib.Option in
   let label = Option.value (q "label") ~default:label in
   let color =
@@ -42,27 +53,26 @@ let mk_badge ~label ~color ~style ~label_color ~status ~scale request =
     end
   in
   Format.asprintf "%a"
-      (Gen.mk ~label ~color ~style ~label_color ~status ~icon:None
-         ~icon_width:0. ~scale )
-      ())
+    (Gen.mk ~label ~color ~style ~label_color ~status ~icon:None ~icon_width:0.
+       ~scale )
+    ()
 
-let () =
-  Dream.run ~interface:"0.0.0.0"
-  @@ Dream.logger
-  @@ Dream.router
-       [ Dream.get "/assets/**" (Dream.static ~loader:asset_loader "")
-       ; Dream.get "/" (fun _request ->
+let home_page _request =
   match page "index" with
   | None -> Dream.empty `Not_Found
-             | Some content ->
-               Dream.html
-                 (Template.render_unsafe ~title:"Osh by OCamlPro" ~content) )
-       ; Dream.get "/badge" (fun request ->
+  | Some content -> render_unsafe content
+
+let badge request =
   let open Ocb in
+  let badge =
     mk_badge ~label:"Label" ~color:Color.Blue ~style:Style.Flat
-               ~label_color:Color.Black ~status:"Status" ~scale:1. request )
-       ; Dream.get "/badge/github/workflow/status/:user/:repo/:workflow"
-           (fun request ->
+      ~label_color:Color.Black ~status:"Status" ~scale:1. request
+  in
+  Dream.respond ~headers:[ ("Content-Type", "image/svg+xml") ] badge
+
+let badge_github_workflow_status =
+  let tbl = Hashtbl.create 512 in
+  fun request ->
     let url =
       Format.sprintf
         "https://api.github.com/repos/%s/%s/actions/workflows/%s/runs"
@@ -70,10 +80,21 @@ let () =
         (Dream.param "repo" request)
         (Dream.param "workflow" request)
     in
+    let badge, invalid =
+      match Hashtbl.find_opt tbl url with
+      | Some (badge, timestamp) ->
+        let curr_timestamp = Unix.time () in
+        let invalid = curr_timestamp -. timestamp > 60. *. 10. in
+        (badge, invalid)
+      | None -> ("", true)
+    in
+    let badge =
+      if not invalid then
+        Ok badge
+      else
         match Ezcurl.get ~url () with
         | Error (_code, msg) ->
-               Dream.respond
-                 (Format.sprintf "Failed to query the API: curl error: %s" msg)
+          Error (Format.sprintf "Failed to query the API: curl error: %s" msg)
         | Ok response -> (
           let open Yojson.Basic in
           let response = from_string response.Ezcurl.body in
@@ -89,7 +110,7 @@ let () =
               response
           in
           match latest_run with
-               | None -> Dream.respond "Invalid JSON answer"
+          | None -> Error "Invalid JSON answer"
           | Some x ->
             let s = x |> Util.member "conclusion" |> Util.to_string in
             let open Ocb in
@@ -103,7 +124,26 @@ let () =
               | "timed_out" -> ("Timed out", Color.Red)
               | unknown -> (unknown, Color.Grey)
             in
+            let badge =
               mk_badge ~label:"Build" ~color ~style:Style.Flat
-                   ~label_color:Color.Black ~status ~scale:1. request ) )
+                ~label_color:Color.Black ~status ~scale:1. request
+            in
+            Hashtbl.add tbl url (badge, Unix.time ());
+            Ok badge )
+    in
+    match badge with
+    | Ok badge ->
+      Dream.respond ~headers:[ ("Content-Type", "image/svg+xml") ] badge
+    | Error e -> Dream.respond e
+
+let () =
+  Dream.run ~interface:"0.0.0.0"
+  @@ Dream.logger
+  @@ Dream.router
+       [ Dream.get "/assets/**" (Dream.static ~loader:asset_loader "")
+       ; Dream.get "/" home_page
+       ; Dream.get "/badge" badge
+       ; Dream.get "/badge/github/workflow/status/:user/:repo/:workflow"
+           badge_github_workflow_status
        ]
   @@ Dream.not_found