Validate maintenance_intent

doc/changes/11308.md

@@ -0,0 +1 @@
+- Validate opam `maintenance_intent` (#11308, @art-w)

src/dune_config_file/dune_config_file.ml

@@ -28,7 +28,8 @@ module Dune_config = struct
       fields
         (let+ authors = field_o "authors" (repeat string)
          and+ maintainers = field_o "maintainers" (repeat string)
-         and+ maintenance_intent = field_o "maintenance_intent" (repeat string)
+         and+ maintenance_intent =
+           field_o "maintenance_intent" Dune_lang.Package_info.decode_maintenance_intent
          and+ license = field_o "license" (repeat string) in
          { authors; maintainers; maintenance_intent; license })
     ;;

src/dune_lang/package_info.ml

@@ -109,6 +109,84 @@ let encode_fields
     ]
 ;;
 
+let maintenance_intent_list = [ "any"; "latest"; "none" ]
+
+let rec pp_or_list () = function
+  | [] -> ""
+  | [ x ] -> x
+  | [ x; y ] -> sprintf "%S or %S" x y
+  | x :: xs -> sprintf "%S, %a" x pp_or_list xs
+;;
+
+let valid_maintenance_intent =
+  let open Decoder in
+  map_validate (located string) ~f:(fun (loc, str) ->
+    let rec parse_part i =
+      if i >= String.length str
+      then if i > 0 then Error "version ends with a dot" else Error "empty version"
+      else (
+        match str.[i] with
+        | '(' -> parse_token (i + 1) (i + 1)
+        | '.' -> Error "unexpected dot"
+        | _ -> inside_part (i + 1))
+    and inside_part i =
+      if i >= String.length str
+      then Ok ()
+      else (
+        match str.[i] with
+        | '.' -> parse_part (i + 1)
+        | '(' | ')' -> Error "unexpected parenthesis"
+        | _ -> inside_part (i + 1))
+    and parse_token start i =
+      if i >= String.length str
+      then Error "unclosed parenthesis"
+      else (
+        match str.[i] with
+        | ')' ->
+          let token = String.sub str ~pos:start ~len:(i - start) in
+          if List.mem ~equal:String.equal maintenance_intent_list token
+          then after_token (i + 1)
+          else
+            Error
+              (sprintf
+                 "unknown intent %S, expected %a"
+                 token
+                 pp_or_list
+                 maintenance_intent_list)
+        | '-' ->
+          let token = String.sub str ~pos:start ~len:(i - start) in
+          if String.equal token "latest"
+          then parse_num (i + 1) (i + 1)
+          else Error (sprintf "substraction only allowed for \"latest\", not %S" token)
+        | _ -> parse_token start (i + 1))
+    and parse_num start i =
+      if i >= String.length str
+      then Error "unclosed parenthesis"
+      else (
+        match str.[i] with
+        | ')' when i > start -> after_token (i + 1)
+        | '0' when i > start -> parse_num start (i + 1)
+        | '0' -> parse_num (i + 1) (i + 1)
+        | '1' .. '9' -> parse_num start (i + 1)
+        | _ -> Error "invalid substraction")
+    and after_token i =
+      if i >= String.length str
+      then Ok ()
+      else (
+        match str.[i] with
+        | '.' -> parse_part (i + 1)
+        | _ -> Error "missing dot after intent")
+    in
+    match parse_part 0 with
+    | Ok () -> Ok str
+    | Error msg -> Error (User_error.make ~loc [ Pp.text msg ]))
+;;
+
+let decode_maintenance_intent =
+  let open Decoder in
+  Syntax.since Stanza.syntax (3, 18) >>> repeat valid_maintenance_intent
+;;
+
 let decode ?since () =
   let open Decoder in
   let v default = Option.value since ~default in
@@ -132,9 +210,7 @@ let decode ?since () =
     field_o "bug_reports" (Syntax.since Stanza.syntax (v (1, 10)) >>> string)
   and+ maintainers =
     field_o "maintainers" (Syntax.since Stanza.syntax (v (1, 10)) >>> repeat string)
-  and+ maintenance_intent =
-    field_o "maintenance_intent" (Syntax.since Stanza.syntax (v (3, 18)) >>> repeat string)
-  in
+  and+ maintenance_intent = field_o "maintenance_intent" decode_maintenance_intent in
   { source
   ; authors
   ; license

src/dune_lang/package_info.mli

@@ -25,6 +25,7 @@ val decode
   -> unit
   -> t Dune_sexp.Decoder.fields_parser
 
+val decode_maintenance_intent : string list Dune_sexp.Decoder.t
 val superpose : t -> t -> t
 
 val create

test/blackbox-tests/test-cases/opam-maintenance-intent.t

@@ -0,0 +1,243 @@
+The `x-opam-maintenance` field allows a list of strings matching version
+numbers, possibly using the special keywords (latest), (any) and (none):
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (generate_opam_files true)
+  > (package (name foo) (allow_empty))
+  > (maintenance_intent
+  >   "1.2.3"
+  >   "(latest)"
+  >   "(latest-1234567890)"
+  >   "(latest-1).(none)"
+  >   "(any).(latest).(none)"
+  >   "1.(any).2.(none)"
+  >   "3.14.(latest)")
+  > EOF
+  $ cat dune-project
+  (lang dune 3.18)
+  (generate_opam_files true)
+  (package (name foo) (allow_empty))
+  (maintenance_intent
+    "1.2.3"
+    "(latest)"
+    "(latest-1234567890)"
+    "(latest-1).(none)"
+    "(any).(latest).(none)"
+    "1.(any).2.(none)"
+    "3.14.(latest)")
+  $ dune build foo.opam
+  $ cat foo.opam
+  # This file is generated by dune, edit dune-project instead
+  opam-version: "2.0"
+  depends: [
+    "dune" {>= "3.18"}
+    "odoc" {with-doc}
+  ]
+  build: [
+    ["dune" "subst"] {dev}
+    [
+      "dune"
+      "build"
+      "-p"
+      name
+      "-j"
+      jobs
+      "@install"
+      "@runtest" {with-test}
+      "@doc" {with-doc}
+    ]
+  ]
+  x-maintenance-intent: [
+    "1.2.3"
+    "(latest)"
+    "(latest-1234567890)"
+    "(latest-1).(none)"
+    "(any).(latest).(none)"
+    "1.(any).2.(none)"
+    "3.14.(latest)"
+  ]
+
+The following are all invalid maintenance intents:
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-22:
+  2 | (maintenance_intent "")
+                          ^^
+  Error: empty version
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-29:
+  2 | (maintenance_intent "(latest")
+                          ^^^^^^^^^
+  Error: unclosed parenthesis
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent ").1")
+  > EOF
+  $ dune build
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent ".1")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-24:
+  2 | (maintenance_intent ".1")
+                          ^^^^
+  Error: unexpected dot
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "1.2.")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-26:
+  2 | (maintenance_intent "1.2.")
+                          ^^^^^^
+  Error: version ends with a dot
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "1.2(latest).3")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-35:
+  2 | (maintenance_intent "1.2(latest).3")
+                          ^^^^^^^^^^^^^^^
+  Error: unexpected parenthesis
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(none-3)")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-30:
+  2 | (maintenance_intent "(none-3)")
+                          ^^^^^^^^^^
+  Error: substraction only allowed for "latest", not "none"
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(any-3)")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-29:
+  2 | (maintenance_intent "(any-3)")
+                          ^^^^^^^^^
+  Error: substraction only allowed for "latest", not "any"
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest)1")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-31:
+  2 | (maintenance_intent "(latest)1")
+                          ^^^^^^^^^^^
+  Error: missing dot after intent
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest-)")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-31:
+  2 | (maintenance_intent "(latest-)")
+                          ^^^^^^^^^^^
+  Error: invalid substraction
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest-0)")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-32:
+  2 | (maintenance_intent "(latest-0)")
+                          ^^^^^^^^^^^^
+  Error: invalid substraction
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest-00)")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-33:
+  2 | (maintenance_intent "(latest-00)")
+                          ^^^^^^^^^^^^^
+  Error: invalid substraction
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest--1)")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-33:
+  2 | (maintenance_intent "(latest--1)")
+                          ^^^^^^^^^^^^^
+  Error: invalid substraction
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest-a)")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-32:
+  2 | (maintenance_intent "(latest-a)")
+                          ^^^^^^^^^^^^
+  Error: invalid substraction
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(latest-1")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-31:
+  2 | (maintenance_intent "(latest-1")
+                          ^^^^^^^^^^^
+  Error: unclosed parenthesis
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "(lates)")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 20-29:
+  2 | (maintenance_intent "(lates)")
+                          ^^^^^^^^^
+  Error: unknown intent "lates", expected "any", "latest" or "none"
+  [1]
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.18)
+  > (maintenance_intent "1.2" "(latest)" "err)" "3.4")
+  > EOF
+  $ dune build
+  File "dune-project", line 2, characters 37-43:
+  2 | (maintenance_intent "1.2" "(latest)" "err)" "3.4")
+                                           ^^^^^^
+  Error: unexpected parenthesis
+  [1]