fix: Prevent docs link for packages without docs (#1927)

* fix: Prevent docs link for packages without docs

* Update no documentation notice

* remove ^M from the end of line

* Prefer let bindings over Infix operators

* prevent docs link on the search box autocomplete for packages without docs

* feat: cache documentation status response inside the state record

* feat: increase version number to force state regeneration

* feat: update calling points

* feat: use a map based on name and version.

I think I need to throw the *kind* somewhere in there, but idk how.
(TODO)

* feat: remove duplocation by extracting to new functions

* fix: remove unnecessary Map

* feat: make documentation_status part of the frontend package

* feat: a new config value to control the time documentation status is cached

* feat: refresh doc_status cache after ttl time

* minor changes, info.ml version no update, record type for cache entry

src/ocamlorg_frontend/package.ml

@@ -23,6 +23,7 @@ type package = {
          documentation_status : documentation_status; readme_filename : string
          option; changes_filename : string option; license_filename : string
          option;*)
+  documentation_status : documentation_status;
 }
 
 let specific_version package =

src/ocamlorg_frontend/pages/packages_autocomplete_fragment.eml

@@ -27,7 +27,7 @@ let input_attributes ~target_sel ~indicator_sel =
 let render
 ~search
 ~total
-(packages : Package.package list)
+(packages : Package.package  list)
 =
 <div class="mb-2">
   <% if total = 0 then ( %>
@@ -54,15 +54,20 @@ let render
       >
         <%s! Search.highlight_search_terms ~class_:"bg-legacy-search-term-highlight text-gray-800 font-normal" ~search package.name %>
       </a>
-      <a
-        id="package-autocomplete-<%s string_of_int i %>-1"
-        :aria-selected="row == <%s string_of_int i %> && col == 1"
-        href="<%s Url.Package.documentation package.name %>"
-        :class=' row == <%s string_of_int i %> && col == 1 ? "bg-legacy-search-keyboard-cursor text-white": ""'
-        class="flex text-sm justify-self-end px-2 py-2 leading-6 font-normal hover:text-white hover:bg-search-result-background-blue rounded-md">
-        <%s! Icons.documentation "h-5 w-5" %>
-        DOCS
-      </a>
+      <% (match package.documentation_status with | Package.Success -> %>
+        <a
+          id="package-autocomplete-<%s string_of_int i %>-1"
+          :aria-selected="row == <%s string_of_int i %> && col == 1"
+          href="<%s Url.Package.documentation package.name %>"
+          :class=' row == <%s string_of_int i %> && col == 1 ? "bg-legacy-search-keyboard-cursor text-white": ""'
+          class="flex text-smi w-20 justify-self-end px-2 py-2 leading-6
+          font-normal hover:text-white hover:bg-legacy-search-result-background-blue rounded-md">
+          <%s! Icons.documentation "h-5 w-5" %>
+          DOCS
+        </a>
+      <% | _ -> %>
+        <p class="w-20"></p>
+      <% ); %>
     </li>
   <% ); %>
   </ol>

src/ocamlorg_frontend/pages/packages_search.eml

@@ -56,13 +56,19 @@ let render ~total ~search ~page ~number_of_pages (packages : Package.package lis
                 <%s package.name %>
               </a>
               <div class="flex gap-4 justify-end items-center">
-              <a
-                href="<%s Url.Package.documentation package.name %>"
-                class="text-primary dark:text-dark-primary flex gap-1 text-sm items-center"
-              >
-                <%s! Icons.documentation "h-5 w-5" %>
-                Documentation
-              </a>
+                <% (match package.documentation_status with | Package.Success -> %>
+                  <a
+                    href="<%s Url.Package.documentation package.name %>"
+                    class="text-primary dark:text-dark-primary flex gap-1 text-sm items-center"
+                  >
+                    <%s! Icons.documentation "h-5 w-5" %>
+                    Documentation
+                  </a>
+                <% | _ -> %>
+                  <p class="text-content dark:text-dark-content text-sm">
+                    No documentation
+                  </p>
+                <% ); %>
               </div>
             </div>
 

src/ocamlorg_package/lib/config.ml

@@ -7,6 +7,9 @@ let documentation_url =
   Sys.getenv_opt "OCAMLORG_DOC_URL"
   |> Option.value ~default:"https://docs-data.ocaml.org/live/"
 
+let documentation_status_cache_ttl =
+  env_with_default "OCAMLORG_DOC_STATUS_CACHE_TTL" "3600" |> float_of_string
+
 let default_cache_dir =
   match Sys.os_type with
   | "Unix" -> Fpath.(v (Sys.getenv "HOME") / ".cache" / "ocamlorg")

src/ocamlorg_package/lib/config.mli

@@ -2,5 +2,6 @@
 
 val opam_polling : int
 val documentation_url : string
+val documentation_status_cache_ttl : float
 val opam_repository_path : Fpath.t
 val package_state_path : Fpath.t

src/ocamlorg_package/lib/ocamlorg_package.ml

@@ -12,11 +12,17 @@ let version t = t.version
 let info t = t.info
 let create ~name ~version info = { name; version; info }
 
+type documentation_status_cache_entry = {
+  documentation_status : Documentation_status.t option;
+  time : float;
+}
+
 type state = {
   version : string;
   mutable opam_repository_commit : string option;
   mutable packages : Info.t Version.Map.t Name.Map.t;
   mutable stats : Statistics.t option;
+  mutable doc_status : documentation_status_cache_entry Version.Map.t Name.Map.t;
 }
 
 let mockup_state (pkgs : t list) =
@@ -35,6 +41,7 @@ let mockup_state (pkgs : t list) =
     packages;
     opam_repository_commit = None;
     stats = None;
+    doc_status = Name.Map.empty;
   }
 
 let read_versions package_name versions =
@@ -97,6 +104,7 @@ let try_load_state () =
       version = Info.version;
       packages = Name.Map.empty;
       stats = None;
+      doc_status = Name.Map.empty;
     }
 
 let save_state t =
@@ -382,28 +390,52 @@ let search_index ~kind t =
 
 module Documentation_status = Documentation_status
 
-let documentation_status ~kind t : Documentation_status.t option Lwt.t =
+let documentation_status ~kind state t : Documentation_status.t option Lwt.t =
   let open Lwt.Syntax in
   let package_url =
     package_url ~kind (Name.to_string t.name) (Version.to_string t.version)
   in
   let url = package_url ^ "status.json" in
-  let* content = http_get url in
-  let status =
-    match content with
-    | Ok s ->
-        Some (s |> Yojson.Safe.from_string |> Documentation_status.of_yojson)
-    | _ -> None
+
+  let get_and_cache () =
+    let+ content = http_get url in
+    let status =
+      match content with
+      | Ok s ->
+          Some (s |> Yojson.Safe.from_string |> Documentation_status.of_yojson)
+      | _ -> None
+    in
+    let status_entry =
+      { documentation_status = status; time = Unix.gettimeofday () }
+    in
+    state.doc_status <-
+      Name.Map.update t.name
+        (Version.Map.add t.version status_entry)
+        (Version.Map.singleton t.version status_entry)
+        state.doc_status;
+    status
+  in
+
+  let has_cache_expired time =
+    Unix.gettimeofday () -. time > Config.documentation_status_cache_ttl
   in
-  Lwt.return status
+
+  match
+    Name.Map.find_opt t.name state.doc_status
+    |> Option.map (Version.Map.find_opt t.version)
+    |> Option.value ~default:None
+  with
+  | None -> get_and_cache ()
+  | Some { time; _ } when has_cache_expired time -> get_and_cache ()
+  | Some { documentation_status; _ } -> Lwt.return documentation_status
 
 let doc_exists t name version =
   let package = get t name version in
   let open Lwt.Syntax in
   match package with
   | None -> Lwt.return None
   | Some package -> (
-      let* doc_stat = documentation_status ~kind:`Package package in
+      let* doc_stat = documentation_status ~kind:`Package t package in
       match doc_stat with
       | Some { failed = false; _ } -> Lwt.return (Some version)
       | _ -> Lwt.return None)

src/ocamlorg_package/lib/ocamlorg_package.mli

@@ -122,6 +122,7 @@ end
 
 val documentation_status :
   kind:[< `Package | `Universe of string ] ->
+  state ->
   t ->
   Documentation_status.t option Lwt.t
 (** Get the build status of the documentation of a package *)

src/ocamlorg_web/lib/handler.ml

@@ -453,7 +453,7 @@ type package_kind = Package | Universe
 
 module Package_helper = struct
   let package_info_to_frontend_package ~name ~version ?(on_latest_url = false)
-      ~latest_version ~versions info =
+      ?documentation_status ~latest_version ~versions info =
     let rev_deps =
       List.map
         (fun (name, _, _versions) -> Ocamlorg_package.Name.to_string name)
@@ -491,6 +491,8 @@ module Package_helper = struct
             (fun url ->
               (url.Ocamlorg_package.Info.uri, url.Ocamlorg_package.Info.checksum))
             info.Ocamlorg_package.Info.url;
+        documentation_status =
+          Option.value ~default:Unknown documentation_status;
       }
 
   (** Query all the versions of a package. *)
@@ -503,8 +505,8 @@ module Package_helper = struct
                publication = v.publication;
              })
 
-  let frontend_package ?on_latest_url state (package : Ocamlorg_package.t) :
-      Ocamlorg_frontend.Package.package =
+  let frontend_package ?on_latest_url ?documentation_status state
+      (package : Ocamlorg_package.t) : Ocamlorg_frontend.Package.package =
     let name = Ocamlorg_package.name package
     and version = Ocamlorg_package.version package
     and info = Ocamlorg_package.info package in
@@ -515,7 +517,7 @@ module Package_helper = struct
         (Ocamlorg_package.get_latest state name)
     in
     package_info_to_frontend_package ~name ~version ?on_latest_url
-      ~latest_version ~versions info
+      ?documentation_status ~latest_version ~versions info
 
   let of_name_version t name version =
     let package =
@@ -528,10 +530,10 @@ module Package_helper = struct
            ( package,
              frontend_package t package ~on_latest_url:(version = "latest") ))
 
-  let package_sidebar_data ~kind package =
+  let package_sidebar_data ~kind t package =
     let open Lwt.Syntax in
     let* package_documentation_status =
-      Ocamlorg_package.documentation_status ~kind package
+      Ocamlorg_package.documentation_status ~kind t package
     in
     let readme_filename =
       Option.fold ~none:None
@@ -641,6 +643,28 @@ let is_author_match name pattern =
   | Some { name; email; github_username; _ } ->
       match_opt (Some name) || match_opt email || match_opt github_username
 
+let documentation_status_of_package t (pkg : Ocamlorg_package.t) =
+  let open Lwt.Syntax in
+  let* package_documentation_status =
+    Ocamlorg_package.documentation_status ~kind:`Package t pkg
+  in
+  Lwt.return
+    (match package_documentation_status with
+    | Some { failed = false; _ } -> Ocamlorg_frontend.Package.Success
+    | Some { failed = true; _ } -> Failure
+    | None -> Unknown)
+
+let prepare_search_result_packages t packages =
+  let open Lwt.Syntax in
+  let* results =
+    Lwt_list.map_p
+      (fun pkg ->
+        let+ documentation_status = documentation_status_of_package t pkg in
+        Package_helper.frontend_package ~documentation_status t pkg)
+      packages
+  in
+  Lwt.return results
+
 let packages_search t req =
   let packages =
     match Dream.query req "q" with
@@ -655,7 +679,10 @@ let packages_search t req =
     Dream.from_percent_encoded
       (match Dream.query req "q" with Some search -> search | None -> "")
   in
-  let results = List.map (Package_helper.frontend_package t) current_items in
+
+  let open Lwt.Syntax in
+  let* results = prepare_search_result_packages t current_items in
+
   Dream.html
     (Ocamlorg_frontend.packages_search ~total ~search ~page ~number_of_pages
        results)
@@ -667,12 +694,17 @@ let packages_autocomplete_fragment t req =
         Ocamlorg_package.search ~is_author_match ~sort_by_popularity:true t
           search
       in
-      let results = List.map (Package_helper.frontend_package t) packages in
-      let top_5 = results |> List.take 5 in
+
+      let open Lwt.Syntax in
+      let* top_5 =
+        packages |> List.take 5 |> prepare_search_result_packages t
+      in
+
       let search = Dream.from_percent_encoded search in
+
       Dream.html
         (Ocamlorg_frontend.packages_autocomplete_fragment ~search
-           ~total:(List.length results) top_5)
+           ~total:(List.length packages) top_5)
   | _ -> Dream.html ""
 
 let package_overview t kind req =
@@ -687,7 +719,7 @@ let package_overview t kind req =
     | Package -> `Package
     | Universe -> `Universe (Dream.param req "hash")
   in
-  let* sidebar_data = Package_helper.package_sidebar_data ~kind package in
+  let* sidebar_data = Package_helper.package_sidebar_data ~kind t package in
 
   let* maybe_search_index = Ocamlorg_package.search_index ~kind package in
   let search_index_digest =
@@ -966,7 +998,7 @@ let package_file t kind req =
     | Universe -> `Universe (Dream.param req "hash")
   in
   let path = (Dream.path [@ocaml.warning "-3"]) req |> String.concat "/" in
-  let* sidebar_data = Package_helper.package_sidebar_data ~kind package in
+  let* sidebar_data = Package_helper.package_sidebar_data ~kind t package in
   let* maybe_search_index = Ocamlorg_package.search_index ~kind package in
   let search_index_digest =
     Option.map