Implement meta data caching

Also print builds by their start time instead of UUID

bin/builder_web_app.ml

@@ -1,6 +1,6 @@
 open Opium
 
-let t = { Builder_web.dir = Fpath.v "sample" }
+let t = Builder_web.init (Fpath.v "sample")
 
 let app =
   App.empty

lib/builder_web.ml

@@ -4,9 +4,9 @@ module Log = (val Logs.src_log src : Logs.LOG)
 open Opium
 open Rresult.R.Infix
 
-type t = Model.t = {
+type t = Model.t
-  dir : Fpath.t
+
-}
+let init = Model.init
 
 let safe_seg path =
   if Fpath.is_seg path && not (Fpath.is_rel_seg path)
@@ -21,7 +21,8 @@ let routes (t : Model.t) =
       Response.of_plain_text ~status:`Internal_server_error
         "Error getting jobs" |> Lwt.return
     | Ok jobs ->
-      Views.builder jobs |> Response.of_html |> Lwt.return
+      List.sort (fun j1 j2 -> Fpath.compare j1.Model.path j2.Model.path) jobs
+      |> Views.builder |> Response.of_html |> Lwt.return
   in
 
   let job req =
@@ -29,7 +30,9 @@ let routes (t : Model.t) =
     match safe_seg job >>= fun job ->
       Model.job t job with
     | Ok job ->
-      Views.job job |> Response.of_html |> Lwt.return
+      let name = Model.job_name job
+      and runs = job.Model.runs in
+      Views.job name runs |> Response.of_html |> Lwt.return
     | Error (`Msg e) ->
       Log.warn (fun m -> m "Error getting job: %s" e);
       Response.of_plain_text ~status:`Internal_server_error

lib/model.ml

@@ -3,37 +3,73 @@ module Log = (val Logs.src_log  src : Logs.LOG)
 
 open Rresult.R.Infix
 
-type t = {
+module RunMap = Map.Make(struct
-  dir : Fpath.t;
+    type t = Fpath.t * Fpath.t
-}
+    let compare (j1,r1) (j2,r2) =
+      let jcmp = Fpath.compare j1 j2 in
+      if jcmp <> 0
+      then jcmp
+      else Fpath.compare r1 r2
+  end)
 
-type job = {
+type job_run_meta = {
-  path : Fpath.t;
-  runs : Fpath.t list;
-}
-
-let job_name { path; _ } = Fpath.to_string path
-
-type job_run_info = {
   job_info : Builder.job;
   uuid : Uuidm.t;
-  out : (int * string) list;
   start : Ptime.t;
   finish : Ptime.t;
   result : Builder.execution_result;
+}
+
+type job_run_info = {
+  meta : job_run_meta;
+  out : (int * string) list;
   data : (Fpath.t * string) list
 }
 
+type t = {
+  dir : Fpath.t;
+  mutable cache : job_run_meta RunMap.t
+}
+
+let init dir = { dir; cache = RunMap.empty; }
+
+type job = {
+  path : Fpath.t;
+  runs : job_run_meta list;
+}
+
+let job_name { path; _ } = Fpath.to_string path
+
 let read_full t path run =
   let f = Fpath.(t.dir // path // run / "full") in
   Bos.OS.File.read f >>= fun s ->
   Builder.Asn.exec_of_cs (Cstruct.of_string s)
   >>| fun (job_info, uuid, out, start, finish, result, data) ->
-  { job_info; uuid; out; start; finish; result; data }
+  { meta = { job_info; uuid; start; finish; result };
+    out; data }
+
+let read_full_meta t path run =
+  match RunMap.find_opt (path, run) t.cache with
+  | Some meta -> Ok meta
+  | None ->
+    read_full t path run >>| fun { meta; out = _; data = _ }  ->
+    t.cache <- RunMap.add (path, run) meta t.cache;
+    meta
 
 let job t job =
-  Bos.OS.Dir.contents ~rel:true Fpath.(t.dir // job) >>= fun job_runs ->
+  let path = Fpath.(t.dir // job) in
-  Ok { path = job; runs = job_runs }
+  Bos.OS.Dir.contents ~rel:true path >>= fun runs ->
+  let runs =
+    List.filter_map (fun run ->
+        match read_full_meta t job run with
+        | Error (`Msg e) ->
+          Log.warn (fun m -> m "error reading job run file %a: %s"
+                       Fpath.pp Fpath.(path // run) e);
+          None
+        | Ok meta -> Some meta)
+      runs
+  in
+  Ok { path = job; runs }
 
 let jobs t =
   Bos.OS.Dir.contents ~rel:true t.dir >>|
@@ -42,6 +78,6 @@ let jobs t =
       match job t f with
       | Ok job -> Some job
       | Error (`Msg e) ->
-        Log.warn (fun m -> m "Error reading job run dir %a: %s" Fpath.pp
+        Log.warn (fun m -> m "error reading job run dir %a: %s" Fpath.pp
                      Fpath.(t.dir // f) e);
         None)

lib/model.mli

@@ -1,22 +1,25 @@
-type t = {
+type t
-  dir : Fpath.t
+
+type job_run_meta = {
+  job_info : Builder.job;
+  uuid : Uuidm.t;
+  start : Ptime.t;
+  finish : Ptime.t;
+  result : Builder.execution_result;
+}
+
+type job_run_info = {
+  meta : job_run_meta;
+  out : (int * string) list;
+  data : (Fpath.t * string) list
 }
 
 type job = {
   path : Fpath.t;
-  runs : Fpath.t list;
+  runs : job_run_meta list;
 }
 
-
+val init : Fpath.t -> t
-type job_run_info = {
-  job_info : Builder.job;
-  uuid : Uuidm.t;
-  out : (int * string) list;
-  start : Ptime.t;
-  finish : Ptime.t;
-  result : Builder.execution_result;
-  data : (Fpath.t * string) list
-}
 
 val job_name : job -> string
 

lib/views.ml

@@ -23,25 +23,28 @@ let builder jobs =
           jobs);
     ]
 
-let job job =
+let job name runs =
-  let name = Model.job_name job in
   layout ~title:(Printf.sprintf "Job %s" name)
     [ h1 [txtf "Job %s" name];
       p [
         txtf "Currently %d job runs."
-          (List.length job.Model.runs)
+          (List.length runs)
       ];
-      ul (List.map (fun (run : Fpath.t) ->
+      ul (List.map (fun run ->
           li [
-            a ~a:[a_href Fpath.(to_string (v "run" // run) ^ "/")]
+            a ~a:[a_href Fpath.(to_string (v "run" / Uuidm.to_string run.Model.uuid) ^ "/")]
-              [txtf "%a" Fpath.pp run];
+              [txtf "%a" (Ptime.pp_human ()) run.Model.start];
           ])
-          job.Model.runs);
+          runs);
 
     ]
 
-let job_run { Model.job_info = { Builder.name; _ };
+let job_run
-              uuid; result; out; _ } =
+    { Model.meta = {
+          Model.job_info = { Builder.name; _ };
+          uuid; result; _ };
+      out; _ }
+  =
   layout ~title:(Printf.sprintf "Job run %s (%s)" name (Uuidm.to_string uuid))
     [ h1 [txtf "Job build %s (%a)" name Uuidm.pp uuid];
       p [txtf "Status: %a" Builder.pp_execution_result result];