refactor: do not assume every syntax extension has a defined version (#…

…9710) If an extension is deleted, it will not have a minimum or maximum functional version. Signed-off-by: Rudi Grinberg <[email protected]>
ocaml · Jan 11, 2024 · 142fba4 · 142fba4
1 parent e515c29
commit 142fba4
Show file tree

Hide file tree

Showing 11 changed files with 82 additions and 45 deletions.
diff --git a/bin/describe/describe_format.ml b/bin/describe/describe_format.ml
@@ -23,7 +23,7 @@ let print_as_sexp dyn =
     |> Dune_lang.Ast.add_loc ~loc:Loc.none
     |> Dune_lang.Cst.concrete
   in
-  let version = Dune_lang.Syntax.greatest_supported_version Stanza.syntax in
+  let version = Dune_lang.Syntax.greatest_supported_version_exn Stanza.syntax in
   Pp.to_fmt Stdlib.Format.std_formatter (Dune_lang.Format.pp_top_sexps ~version [ cst ])
 ;;
 

diff --git a/bin/dune_init.ml b/bin/dune_init.ml
@@ -142,7 +142,9 @@ module File = struct
 
   let write_dune_file (dune_file : dune) =
     let path = Path.relative dune_file.path dune_file.name in
-    let version = Dune_lang.Syntax.greatest_supported_version Dune_lang.Stanza.syntax in
+    let version =
+      Dune_lang.Syntax.greatest_supported_version_exn Dune_lang.Stanza.syntax
+    in
     Io.with_file_out
       ~binary:true
       (* Why do we pass [~binary:true] but not anywhere else when formatting? *)

diff --git a/bin/format_dune_file.ml b/bin/format_dune_file.ml
@@ -45,7 +45,9 @@ let term =
   and+ version =
     let docv = "VERSION" in
     let doc = "Which version of Dune language to use." in
-    let default = Dune_lang.Syntax.greatest_supported_version Dune_lang.Stanza.syntax in
+    let default =
+      Dune_lang.Syntax.greatest_supported_version_exn Dune_lang.Stanza.syntax
+    in
     Arg.(value & opt version default & info [ "dune-version" ] ~docv ~doc)
   in
   let input = Option.map ~f:Arg.Path.path path_opt in

diff --git a/bin/internal.ml b/bin/internal.ml
@@ -5,7 +5,7 @@ let latest_lang_version =
     (Cmd.info "latest-lang-version")
     (let+ () = Term.const () in
      print_endline
-       (Dune_lang.Syntax.greatest_supported_version Stanza.syntax
+       (Dune_lang.Syntax.greatest_supported_version_exn Stanza.syntax
         |> Dune_lang.Syntax.Version.to_string))
 ;;
 

diff --git a/bin/printenv.ml b/bin/printenv.ml
@@ -50,7 +50,7 @@ let pp ppf ~fields sexps =
     in
     if do_print
     then (
-      let version = Dune_lang.Syntax.greatest_supported_version Stanza.syntax in
+      let version = Dune_lang.Syntax.greatest_supported_version_exn Stanza.syntax in
       Dune_lang.Ast.add_loc sexp ~loc:Loc.none
       |> Dune_lang.Cst.concrete
       |> List.singleton

diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml
@@ -304,7 +304,7 @@ let create_latest_version
            ; "dependency of", Package_name.to_dyn dependant_package.info.name
            ] ))
      |> Code_error.raise "Invalid package table");
-  let version = Syntax.greatest_supported_version Dune_lang.Pkg.syntax in
+  let version = Syntax.greatest_supported_version_exn Dune_lang.Pkg.syntax in
   let dependency_hash =
     Local_package.(
       For_solver.list_non_local_dependency_set local_packages |> Dependency_set.hash)

diff --git a/src/dune_rules/dune_project.ml b/src/dune_rules/dune_project.ml
@@ -248,7 +248,7 @@ include Dune_lang.Versioned_file.Make (struct
   end)
 
 let default_dune_language_version =
-  ref (Dune_lang.Syntax.greatest_supported_version Stanza.syntax)
+  ref (Dune_lang.Syntax.greatest_supported_version_exn Stanza.syntax)
 ;;
 
 let get_dune_lang () =
@@ -404,17 +404,21 @@ let interpret_lang_and_extensions ~(lang : Lang.Instance.t) ~explicit_extensions
         | Not_selected (Packed e) ->
           let stanzas =
             let open Dune_lang.Decoder in
-            let _arg, stanzas =
-              let parsing_context =
-                (* Temporarily mark the extension as active so that we can
-                   call the parser and extract the list of stanza names this
-                   extension registers *)
-                Univ_map.set
-                  parsing_context
-                  (Dune_lang.Syntax.key e.syntax)
-                  (Active (Dune_lang.Syntax.greatest_supported_version e.syntax))
-              in
-              parse (enter e.stanzas) parsing_context (List (Loc.of_pos __POS__, []))
+            let stanzas =
+              match Dune_lang.Syntax.greatest_supported_version e.syntax with
+              | None -> []
+              | Some greatest_supported_version ->
+                let parsing_context =
+                  (* Temporarily mark the extension as active so that we can
+                     call the parser and extract the list of stanza names this
+                     extension registers *)
+                  Univ_map.set
+                    parsing_context
+                    (Dune_lang.Syntax.key e.syntax)
+                    (Active greatest_supported_version)
+                in
+                parse (enter e.stanzas) parsing_context (List (Loc.of_pos __POS__, []))
+                |> snd
             in
             List.map stanzas ~f:(fun (name, _) ->
               ( name

diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml
@@ -701,7 +701,7 @@ end = struct
 
   let gen_dune_package sctx (pkg : Package.t) =
     let ctx = Super_context.context sctx in
-    let dune_version = Dune_lang.Syntax.greatest_supported_version Stanza.syntax in
+    let dune_version = Dune_lang.Syntax.greatest_supported_version_exn Stanza.syntax in
     let* lib_entries = Scope.DB.lib_entries_of_package ctx (Package.name pkg) in
     let action =
       let dune_package_file = Package_paths.dune_package_file ctx pkg in

diff --git a/src/dune_sexp/syntax.ml b/src/dune_sexp/syntax.ml
@@ -69,7 +69,7 @@ module Supported_versions : sig
     -> dune_lang_ver:Version.t
     -> Version.t option
 
-  val minimum_versions : t -> Version.t * Version.t
+  val minimum_versions : t -> (Version.t * Version.t) option
 
   val status
     :  t
@@ -188,8 +188,9 @@ end = struct
   ;;
 
   let minimum_versions t =
-    let major, major_map = Option.value_exn (Int.Map.min_binding t.version_map) in
-    let minor, lang = Option.value_exn (Int.Map.min_binding major_map) in
+    let open Option.O in
+    let* major, major_map = Int.Map.min_binding t.version_map in
+    let+ minor, lang = Int.Map.min_binding major_map in
     (major, minor), lang
   ;;
 
@@ -323,19 +324,23 @@ module Error = struct
          ]
        else (
          match greatest_supported_version with
+         | Some _ -> []
          | None ->
-           let min_lang_version, min_dune_version =
-             Supported_versions.minimum_versions t.supported_versions
+           let first_version_message =
+             match Supported_versions.minimum_versions t.supported_versions with
+             | None -> ""
+             | Some (min_lang_version, min_dune_version) ->
+               sprintf
+                 " The first version of this plugin is %s and was introduced in dune %s."
+                 (Version.to_string min_lang_version)
+                 (Version.to_string min_dune_version)
            in
            [ Pp.textf
                "Note however that the currently selected version of dune (%s) does not \
-                support this plugin. The first version of this plugin is %s and was \
-                introduced in dune %s."
+                support this plugin.%s"
                (Version.to_string dune_lang_ver)
-               (Version.to_string min_lang_version)
-               (Version.to_string min_dune_version)
-           ]
-         | Some _ -> []))
+               first_version_message
+           ]))
   ;;
 end
 
@@ -372,28 +377,40 @@ let check_supported ~dune_lang_ver t (loc, ver) =
   | `Supported -> ()
   | `Deleted_in deleted_in ->
     let min_ext_ver, min_dune_lang_ver =
-      Supported_versions.minimum_versions t.supported_versions
+      match Supported_versions.minimum_versions t.supported_versions with
+      | None -> None, None
+      | Some (x, y) -> Some x, Some y
+    in
+    let please_port_message =
+      match min_ext_ver with
+      | None -> ""
+      | Some min_ext_ver ->
+        sprintf
+          " Please port this project to a newer version of the extension, such as %s."
+          (Version.to_string min_ext_ver)
     in
     let hints =
-      if dune_lang_ver >= min_dune_lang_ver
-      then []
-      else
-        [ Pp.textf
-            "You will also need to upgrade to (lang dune %s)."
-            (Version.to_string min_dune_lang_ver)
-        ]
+      match min_dune_lang_ver with
+      | None -> []
+      | Some min_dune_lang_ver ->
+        if dune_lang_ver >= min_dune_lang_ver
+        then []
+        else
+          [ Pp.textf
+              "You will also need to upgrade to (lang dune %s)."
+              (Version.to_string min_dune_lang_ver)
+          ]
     in
     User_error.raise
       ~loc
+      ~hints
       [ Pp.textf
-          "Version %s of the %s extension has been deleted in Dune %s. Please port this \
-           project to a newer version of the extension, such as %s."
+          "Version %s of the %s extension has been deleted in Dune %s.%s"
           (Version.to_string ver)
           t.name
           (Version.to_string deleted_in)
-          (Version.to_string min_ext_ver)
+          please_port_message
       ]
-      ~hints
   | `Unsupported_in_project (supported_ranges, min_lang_ver) ->
     let dune_ver_text v =
       Printf.sprintf "version %s of the dune language" (Version.to_string v)
@@ -428,7 +445,16 @@ let check_supported ~dune_lang_ver t (loc, ver) =
 ;;
 
 let greatest_supported_version t =
-  Option.value_exn (Supported_versions.greatest_supported_version t.supported_versions)
+  Supported_versions.greatest_supported_version t.supported_versions
+;;
+
+let greatest_supported_version_exn t =
+  match greatest_supported_version t with
+  | Some s -> s
+  | None ->
+    Code_error.raise
+      "no supported versions for extesnion"
+      [ "supported_versions", Supported_versions.to_dyn t.supported_versions ]
 ;;
 
 let key t = t.key

diff --git a/src/dune_sexp/syntax.mli b/src/dune_sexp/syntax.mli
@@ -74,7 +74,10 @@ val name : t -> string
 (** Check that the given version is supported and raise otherwise. *)
 val check_supported : dune_lang_ver:Version.t -> t -> Loc.t * Version.t -> unit
 
-val greatest_supported_version : t -> Version.t
+val greatest_supported_version : t -> Version.t option
+
+(** [greatest_supported_version_exn t] assumes *)
+val greatest_supported_version_exn : t -> Version.t
 
 (** {1 S-expression parsing} *)
 

diff --git a/src/dune_sexp/versioned_file.ml b/src/dune_sexp/versioned_file.ml
@@ -81,7 +81,7 @@ struct
       let t = Table.find_exn langs name in
       { syntax = t.syntax
       ; data = t.data
-      ; version = Syntax.greatest_supported_version t.syntax
+      ; version = Syntax.greatest_supported_version_exn t.syntax
       }
     ;;
   end