Add endpoint that returns the latest stable release

bin/main.ml

@@ -41,7 +41,7 @@ module Sync = struct
       Metadata.Bundle.create_daily ~commit ~tag Metadata.Target.defaults
     in
     let bundle_key =
-      match daily_bundle.tag with
+      match Metadata.Bundle.tag daily_bundle with
       | Some tag -> tag
       | None -> Metadata.Bundle.get_date_string_from daily_bundle
     in
@@ -110,39 +110,17 @@ module Sync = struct
   let cmd = Cmd.v info term
 end
 
-let find_latest_stable bundles =
-  bundles
-  |> List.filter_map (fun (b : Metadata.Bundle.t) ->
-    match b.tag with
-    | None -> None
-    | Some tag ->
-      (match Scanf.sscanf_opt tag "%d.%d.%d" (fun x y z -> x, y, z) with
-       | None -> None
-       | Some tup -> Some (tup, b)))
-  |> List.sort (fun ((maj, min, patch), _) ((maj', min', patch'), _) ->
-    (* reverse sort, biggest first *)
-    match Int.compare maj' maj with
-    | 0 ->
-      (match Int.compare min' min with
-       | 0 -> Int.compare patch' patch
-       | otherwise -> otherwise)
-    | otherwise -> otherwise)
-  |> function
-  | [] -> None
-  | (_, bundle) :: _ -> Some bundle
-;;
-
 module Http = struct
   let serve dev (module Config : Config.Configuration) port =
     let title = "Dune Nightly" in
     let base_url = Config.Server.url in
     let bundles = Metadata.import_from_json Config.Path.metadata in
     let latest_release =
-      match find_latest_stable bundles with
+      match Metadata.Bundle.newest_tagged bundles with
       | None -> "<RELEASE>"
       | Some bundle ->
         (* guaranteed to exist at this point *)
-        Option.get bundle.tag
+        bundle |> Metadata.Bundle.tag |> Option.get
     in
     let routes =
       let main_page = Web.generate_main_page ~title ~base_url ~latest_release bundles in

bin/server.ml

@@ -1,3 +1,7 @@
+type release =
+  | Latest
+  | Specific of string
+
 let cache_middleware ~dev next_handler request =
   let open Lwt.Infix in
   if (not dev) && Dream.target request |> String.starts_with ~prefix:"/static"
@@ -16,31 +20,46 @@ let reload_script_middleware ~dev inner_handler request =
 let matching_bundle ~base_url bundles ~target ~tag request =
   let module Bundle = Sandworm.Metadata.Bundle in
   let bundle =
-    List.find_opt
-      (fun candidate -> Bundle.matches_criteria ~tag ~target candidate)
-      bundles
+    match tag with
+    | Some Latest -> Bundle.newest_tagged bundles
+    | Some (Specific version) ->
+      List.find_opt
+        (fun candidate -> Bundle.matches_criteria ~tag:(Some version) ~target candidate)
+        bundles
+    | None as tag ->
+      List.find_opt
+        (fun candidate -> Bundle.matches_criteria ~tag ~target candidate)
+        bundles
   in
   match bundle with
   | None -> Dream.respond ~status:`Not_Found "No such release"
   | Some bundle ->
     Dream.redirect request (Bundle.to_download_url ~base_url ~target bundle)
 ;;
 
-let latest_route_from_targets ~base_url bundles request =
+let with_valid_target request f =
   let module Target = Sandworm.Metadata.Target in
   let target = Dream.param request "target" in
   match Target.of_string target with
   | None -> Dream.respond ~status:`Not_Found "Invalid target"
-  | Some target -> matching_bundle bundles ~base_url ~target ~tag:None request
+  | Some target -> f target
+;;
+
+let latest_route_from_targets ~base_url bundles request =
+  with_valid_target request
+  @@ fun target -> matching_bundle bundles ~base_url ~target ~tag:None request
 ;;
 
 let stable_release ~base_url bundles request =
-  let module Target = Sandworm.Metadata.Target in
-  let release = Dream.param request "release" in
-  let target = Dream.param request "target" in
-  match Target.of_string target with
-  | None -> Dream.respond ~status:`Not_Found "Invalid target"
-  | Some target -> matching_bundle bundles ~base_url ~target ~tag:(Some release) request
+  let tag = Some (Specific (Dream.param request "release")) in
+  with_valid_target request
+  @@ fun target -> matching_bundle bundles ~base_url ~target ~tag request
+;;
+
+let latest_stable_release ~base_url bundles request =
+  let tag = Some Latest in
+  with_valid_target request
+  @@ fun target -> matching_bundle bundles ~base_url ~target ~tag request
 ;;
 
 let error_template _error _debug_info suggested_response =
@@ -77,6 +96,7 @@ let serve ~dev ~base_url routes port bundles =
           ; Dream.get "/install" (fun request -> Dream.redirect request "/static/install")
           ; Dream.get "/static/**" @@ Dream.static "static"
           ; Dream.get "/latest/:target" (latest_route_from_targets ~base_url bundles)
+          ; Dream.get "/stable/latest/:target" (latest_stable_release ~base_url bundles)
           ; Dream.get "/stable/:release/:target" (stable_release ~base_url bundles)
           ])
 ;;

lib/main.mlx

@@ -51,10 +51,16 @@ let getting_started ~install_url ~latest_release:version () =
 
     <h4>
       <span class_="mr-2.5"><Icons.terminal /></span>
-      "Copy & Install (stable)"
+      "Copy & Install (current stable)"
     </h4>
     <Curl script=(Info.curl_with_sh_stable ~url:install_url ~version) />
 
+    <h4>
+      <span class_="mr-2.5"><Icons.terminal /></span>
+      "Copy & Install (latest stable)"
+    </h4>
+    <Curl script=(Info.curl_with_sh_stable ~url:install_url ~version:"latest") />
+
     <h3 class_="mt-10 mb-2.5">"Getting Started"</h3>
     <p>"You can create and run your first hello-world program using Dune like this"</p>
     <h4 class_="mt-2.5">
@@ -260,7 +266,8 @@ let manual_installation ~base_url ~builds () =
     </p>
     <ul class_="flex flex-row gap-2.5 justify-around flex-wrap items-center align-center mb-5">
       (let bundle: Metadata.Bundle.t = builds |> List.hd in
-      bundle.targets
+      bundle
+       |> Metadata.Bundle.targets
        |> List.map (installation_target ~base_url ~bundle)
        |> JSX.list)
     </ul>
@@ -305,7 +312,7 @@ let release_information ~base_url ~bundle ~target () =
     <td class_="py-2.5 pl-2.5 border">"Archive"</td>
     <td class_="py-2.5 pl-2.5 border">(JSX.string os)</td>
     <td class_="py-2.5 pl-2.5 border">(JSX.string arch)</td>
-    <td class_="py-2.5 pl-2.5 border">(String.sub bundle.commit 0 6 |> JSX.string)</td>
+    <td class_="py-2.5 pl-2.5 border">(String.sub (Metadata.Bundle.commit bundle) 0 6 |> JSX.string)</td>
     <td class_="py-2.5 pl-2.5 border">
       <div class_="group w-full flex flex-raw gap-2.5 items-center">
         <Icons.eye class_=" stroke-block-p group-hover:stroke-primary-light" />
@@ -331,7 +338,7 @@ let build_history ~base_url ~builds () =
       |> List.map (fun (bundle: Bundle.t) ->
           let date = Bundle.get_date_string_from ~prefix:"nightly-" bundle in
           let summary = Format.sprintf "dune %s" date in
-          let files = bundle.targets |> List.map (fun (target: Target.t) -> (<release_information base_url bundle target />)) in
+          let files = bundle |> Metadata.Bundle.targets |> List.map (fun (target: Target.t) -> (<release_information base_url bundle target />)) in
           (<Details summary container_class="w-full overflow-scroll">
              <table class_="w-full pb-4 border-collapse border">
                 <thead class_="font-normal border">

lib/metadata.ml

@@ -25,7 +25,7 @@ module Target = struct
   ;;
 
   let to_description = function
-    | Aarch64_apple_darwin -> "macOS 11 or later for Apple Sillicon processors"
+    | Aarch64_apple_darwin -> "macOS 11 or later for Apple silicon processors"
     | X86_64_apple_darwin -> "macOS 11 or later for Intel processors"
     | X86_64_unknown_linux_musl -> "Linux for Intel 64-bit processors"
   ;;
@@ -73,6 +73,10 @@ module Bundle = struct
     { date; targets; commit; tag; has_certificate = true }
   ;;
 
+  let targets { targets; _ } = targets
+  let commit { commit; _ } = commit
+  let tag { tag; _ } = tag
+
   let create_daily targets =
     let date = Unix.time () |> Ptime.of_float_s |> Option.get |> Ptime.to_date in
     create ~date targets
@@ -90,6 +94,65 @@ module Bundle = struct
     | Some t -> List.mem target t.targets
   ;;
 
+  module Version = struct
+    module Compare = struct
+      module Syntax = struct
+        let ( let+ ) comparison_result continue =
+          match comparison_result with
+          | 0 -> continue ()
+          | non_equal -> non_equal
+        ;;
+      end
+    end
+
+    let parse tag = Scanf.sscanf_opt tag "%d.%d.%d" (fun x y z -> x, y, z)
+
+    let compare (maj, min, patch) (maj', min', patch') =
+      let open Compare.Syntax in
+      let+ () = Int.compare maj maj' in
+      let+ () = Int.compare min min' in
+      Int.compare patch patch'
+    ;;
+  end
+
+  module Option = struct
+    include Option
+
+    module Syntax = struct
+      let ( let+ ) v f = map f v
+      let ( let* ) = bind
+    end
+  end
+
+  let bundle_with_tag bundle =
+    let open Option.Syntax in
+    let* tag = bundle.tag in
+    let+ tag = Version.parse tag in
+    tag, bundle
+  ;;
+
+  let max_bundle_by_version previous candidate =
+    match previous with
+    | None -> Some candidate
+    | Some previous ->
+      let previous_version, _ = previous in
+      let candidate_version, _ = candidate in
+      if Version.compare previous_version candidate_version < 0
+      then Some candidate
+      else Some previous
+  ;;
+
+  let newest_tagged bundles =
+    bundles
+    |> List.fold_left
+         (fun acc bundle ->
+            match bundle_with_tag bundle with
+            | None -> acc
+            | Some bundle_with_tag -> max_bundle_by_version acc bundle_with_tag)
+         None
+    |> Option.map snd
+  ;;
+
   let get_date_string_from ?prefix t =
     let y, m, d = t.date in
     let date = Format.sprintf "%d-%02d-%02d" y m d in

lib/metadata.mli

@@ -0,0 +1,40 @@
+module Target : sig
+  type t
+
+  val to_human_readable_string : t -> string
+  val to_description : t -> string
+  val to_triple : t -> string * string * string
+  val of_string : string -> t option
+  val defaults : t list
+end
+
+module Bundle : sig
+  type t
+
+  val targets : t -> Target.t list
+  val commit : t -> string
+  val tag : t -> string option
+  val to_download_file : Target.t -> string
+  val to_download_url : base_url:string -> target:Target.t -> t -> string
+  val to_certificate_url : base_url:string -> target:Target.t -> t -> string
+  val get_date_string_from : ?prefix:string -> t -> string
+
+  (* creates a bundle with the current date *)
+  val create_daily : Target.t list -> commit:string -> tag:string option -> t
+
+  (* returns [true] if the bundle matches the query *)
+  val matches_criteria : tag:string option -> target:Target.t -> t -> bool
+
+  (* returns the bundle with the highest version number *)
+  val newest_tagged : t list -> t option
+end
+
+(* [import_from_json filename] reads the file and parses it into a list of [Bundle.t] *)
+val import_from_json : string -> Bundle.t list
+
+(* [export_to_json filename bundles] takes bundles and writes them to the specified
+   file name. *)
+val export_to_json : string -> Bundle.t list -> unit
+
+(* Inserts a new bundle into the list unless there is already an equivalent one. *)
+val insert_unique : Bundle.t -> Bundle.t list -> Bundle.t list