From fc7edcde99d8f87c5f3be49111d91387325e25a9 Mon Sep 17 00:00:00 2001 From: Keryan Didier Date: Fri, 5 Feb 2021 11:35:24 +0100 Subject: [PATCH] new operator '~' for semantic versioning (#2976) --- src/client/opamArg.ml | 3 ++- src/format/opamFile.ml | 33 ++++++++++++++++-------- src/format/opamFilter.ml | 9 +++++++ src/format/opamFormat.ml | 53 +++++++++++++++++++++++++++++++------- src/format/opamFormat.mli | 6 +++-- src/format/opamFormula.ml | 5 +++- src/format/opamFormula.mli | 2 +- src/format/opamPackage.ml | 28 ++++++++++++++++++++ src/format/opamPackage.mli | 4 +++ src/format/opamTypes.mli | 3 ++- src/state/opamFileTools.ml | 4 +-- 11 files changed, 122 insertions(+), 28 deletions(-) diff --git a/src/client/opamArg.ml b/src/client/opamArg.ml index 3309049d124..1eed471c1f7 100644 --- a/src/client/opamArg.ml +++ b/src/client/opamArg.ml @@ -811,7 +811,8 @@ let atom_or_dir = let dep_formula = let module OpamParser = OpamParser.FullPos in let module OpamPrinter = OpamPrinter.FullPos in - let pp = OpamFormat.V.(package_formula `Conj (constraints version)) in + let pp = OpamFormat.V.(package_formula `Conj + (constraints version OpamPackage.Version.next)) in let parse str = try let v = OpamParser.value_from_string str "" in diff --git a/src/format/opamFile.ml b/src/format/opamFile.ml index bd082f5687d..2bad66facd6 100644 --- a/src/format/opamFile.ml +++ b/src/format/opamFile.ml @@ -1427,10 +1427,12 @@ module ConfigSyntax = struct (Pp.V.map_list ~depth:1 Pp.V.arg); "default-compiler", Pp.ppacc with_default_compiler default_compiler - (Pp.V.package_formula `Disj Pp.V.(constraints Pp.V.version)); + (Pp.V.package_formula `Disj + Pp.V.(constraints Pp.V.version OpamPackage.Version.next)); "default-invariant", Pp.ppacc with_default_invariant default_invariant - (Pp.V.package_formula `Conj Pp.V.(constraints Pp.V.version)); + (Pp.V.package_formula `Conj Pp.V.(constraints Pp.V.version + OpamPackage.Version.next)); "depext", Pp.ppacc with_depext depext Pp.V.bool; @@ -1612,10 +1614,12 @@ module InitConfigSyntax = struct (fun (name, (url, ta)) -> (name, Some url, ta))); "default-compiler", Pp.ppacc with_default_compiler default_compiler - (Pp.V.package_formula `Disj Pp.V.(constraints Pp.V.version)); + (Pp.V.package_formula `Disj + Pp.V.(constraints Pp.V.version OpamPackage.Version.next)); "default-invariant", Pp.ppacc with_default_invariant default_invariant - (Pp.V.package_formula `Disj Pp.V.(constraints Pp.V.version)); + (Pp.V.package_formula `Disj Pp.V.(constraints Pp.V.version + OpamPackage.Version.next)); "jobs", Pp.ppacc_opt (with_jobs @* OpamStd.Option.some) jobs Pp.V.pos_int; @@ -1843,7 +1847,8 @@ module Switch_configSyntax = struct (Pp.V.map_list ~depth:2 Pp.V.env_binding); "invariant", Pp.ppacc_opt (fun inv t -> {t with invariant = Some inv }) (fun t -> t.invariant) - (Pp.V.package_formula `Conj Pp.V.(constraints version)); + (Pp.V.package_formula `Conj + Pp.V.(constraints version OpamPackage.Version.next)); "depext-bypass", Pp.ppacc (fun depext_bypass t -> { t with depext_bypass}) (fun t -> t.depext_bypass) @@ -2812,12 +2817,15 @@ module OPAMSyntax = struct (Pp.V.map_list ~depth:1 Pp.V.string); "depends", no_cleanup Pp.ppacc with_depends depends - (Pp.V.package_formula `Conj Pp.V.(filtered_constraints ext_version)); + (Pp.V.package_formula `Conj + Pp.V.(filtered_constraints ext_version (fun f -> FNext f))); "depopts", with_cleanup cleanup_depopts Pp.ppacc with_depopts depopts - (Pp.V.package_formula `Disj Pp.V.(filtered_constraints ext_version)); + (Pp.V.package_formula `Disj + Pp.V.(filtered_constraints ext_version (fun f -> FNext f))); "conflicts", with_cleanup cleanup_conflicts Pp.ppacc with_conflicts conflicts - (Pp.V.package_formula `Disj Pp.V.(filtered_constraints ext_version)); + (Pp.V.package_formula `Disj + Pp.V.(filtered_constraints ext_version (fun f -> FNext f))); "conflict-class", no_cleanup Pp.ppacc with_conflict_class conflict_class (Pp.V.map_list ~depth:1 Pp.V.pkgname); "available", no_cleanup Pp.ppacc with_available available @@ -2849,7 +2857,8 @@ module OPAMSyntax = struct (Pp.V.map_list ~depth:1 @@ Pp.V.map_options_2 (Pp.V.ident -| Pp.of_module "variable" (module OpamVariable)) - (Pp.V.package_formula_items `Conj Pp.V.(filtered_constraints ext_version)) + (Pp.V.package_formula_items `Conj + Pp.V.(filtered_constraints ext_version (fun f -> FNext f))) (Pp.singleton -| Pp.V.string)); "messages", no_cleanup Pp.ppacc with_messages messages @@ -2910,7 +2919,8 @@ module OPAMSyntax = struct "ocaml-version", no_cleanup Pp.ppacc_opt with_ocaml_version OpamStd.Option.none (Pp.V.list_depth 1 -| Pp.V.list -| - Pp.V.constraints Pp.V.compiler_version); + Pp.V.constraints Pp.V.compiler_version + (fun _ -> raise (Failure "unexpected '~' in compiler constraints"))); "os", no_cleanup Pp.ppacc_opt with_os OpamStd.Option.none Pp.V.os_constraint; "descr", no_cleanup Pp.ppacc_opt with_descr OpamStd.Option.none @@ -3745,7 +3755,8 @@ module CompSyntax = struct (Pp.V.map_list ~depth:1 Pp.V.command); "packages", Pp.ppacc with_packages packages - (Pp.V.package_formula `Conj (Pp.V.constraints Pp.V.version)); + (Pp.V.package_formula `Conj + (Pp.V.constraints Pp.V.version OpamPackage.Version.next)); "env", Pp.ppacc with_env env (Pp.V.map_list ~depth:2 Pp.V.env_binding); "preinstalled", Pp.ppacc_opt with_preinstalled diff --git a/src/format/opamFilter.ml b/src/format/opamFilter.ml index 7d3601e55cd..9ae6664bb23 100644 --- a/src/format/opamFilter.ml +++ b/src/format/opamFilter.ml @@ -41,6 +41,8 @@ let to_string t = (match converter with | Some (it,ifu) -> "?"^it^":"^ifu | None -> "") + | FNext f -> + Printf.sprintf "#next(%s)" (aux f) | FOp(e,s,f) -> paren ~cond:(context <> `Or && context <> `And) (Printf.sprintf "%s %s %s" @@ -71,6 +73,7 @@ let rec map_up f = function | FOp (l, op, r) -> f (FOp (map_up f l, op, map_up f r)) | FAnd (l, r) -> f (FAnd (map_up f l, map_up f r)) | FOr (l, r) -> f (FOr (map_up f l, map_up f r)) + | FNext x -> f (FNext (map_up f x)) | FNot x -> f (FNot (map_up f x)) | FUndef x -> f (FUndef (map_up f x)) | (FBool _ | FString _ | FIdent _ | FDefined _) as flt -> f flt @@ -349,6 +352,12 @@ let rec reduce_aux ?no_undef_expand ~default_str env = | FBool b -> FBool b | FString s -> FString s | FIdent i -> resolve_ident ?no_undef_expand env i + | FNext f -> + (match reduce f with + | FUndef x -> FUndef (FNext x) + | f -> FString (OpamPackage.Version.(value_string f + |> of_string |> next + |> to_string))) | FOp (e,relop,f) -> (match reduce e, reduce f with | FUndef x, FUndef y -> FUndef (FOp (x, relop, y)) diff --git a/src/format/opamFormat.ml b/src/format/opamFormat.ml index aa89b793677..5538f1aaa99 100644 --- a/src/format/opamFormat.ml +++ b/src/format/opamFormat.ml @@ -306,7 +306,13 @@ module V = struct | Int i -> FString (string_of_int i) | Ident _ -> FIdent (parse ~pos:v.pos filter_ident v) | Group g -> parse_filter ~pos:v.pos g.pelem - | Relop (op,e,f) -> FOp (aux e, op.pelem, aux f) + | Relop (op,e,f) -> + (match op.pelem with + | `Sem -> (* rewrite `Sem case *) + FAnd (FOp (aux e, `Geq, aux f), + FOp (aux e, `Lt, FNext (aux f))) + | `Eq | `Neq | `Gt | `Geq | `Lt | `Leq as op -> + FOp (aux e, op, aux f)) | Pfxop ({ pelem = `Not; _}, e) -> FNot (aux e) | Pfxop ({ pelem = `Defined; _}, e) -> FDefined (aux e) | Logop ({ pelem = `And; _}, e, f)-> FAnd (aux e, aux f) @@ -331,9 +337,15 @@ module V = struct | FString s -> print string s | FIdent fid -> print filter_ident fid | FBool b -> print bool b + | FAnd (FOp (f1, `Geq, v1), FOp(f2, `Lt, FNext v2)) + when f1 = f2 && v1 = v2 -> + (* match rewrote `Sem *) + group_if ~cond:(context <> `Or && context <> `And) @@ nullify_pos @@ + Relop (nullify_pos `Sem, aux ~context:`Relop f1, aux ~context:`Relop v1) | FOp (e,s,f) -> + let s :> relop_kind with_pos = nullify_pos s in group_if ~cond:(context <> `Or && context <> `And) @@ nullify_pos @@ - Relop (nullify_pos s, aux ~context:`Relop e, aux ~context:`Relop f) + Relop (s, aux ~context:`Relop e, aux ~context:`Relop f) | FOr (e,f) -> group_if ~cond:(context <> `Or) @@ nullify_pos @@ Logop (nullify_pos `Or, aux ~context:`Or e, aux ~context:`Or f) @@ -346,7 +358,7 @@ module V = struct | FDefined f -> group_if ~cond:(context = `Relop) @@ nullify_pos @@ Pfxop (nullify_pos `Defined, aux ~context:`Defined f) - | FUndef _ -> assert false + | FUndef _ | FNext _ -> assert false in match f with | FBool true -> [] @@ -358,10 +370,16 @@ module V = struct let command = map_option (map_list arg) (opt filter) - let constraints version = + let constraints version next = let rec parse_constraints ~pos:_ l = let rec aux v = match v.pelem with - | Prefix_relop (op, v) -> Atom (op.pelem, parse version ~pos:v.pos v) + | Prefix_relop (op, v) -> + let ver = parse version ~pos:v.pos v in + (match op.pelem with + | `Sem -> (* rewrite `Sem case *) + And (Atom (`Geq, ver), Atom (`Lt, next ver)) + | `Eq | `Neq | `Gt | `Geq | `Lt | `Leq as op -> + Atom (op, ver)) | Logop ({ pelem = `And; _}, l, r) -> And (aux l, aux r) | Logop ({ pelem = `Or; _}, l, r) -> Or (aux l, aux r) | Pfxop ({ pelem = `Not; _}, v) -> @@ -381,9 +399,14 @@ module V = struct in match cs with | Empty -> assert false + | And (Atom (`Geq, v1), Atom (`Lt, v2)) + when next v1 = v2 -> + (* match rewrote `Sem *) + group_if @@ nullify_pos @@ + Prefix_relop (nullify_pos `Sem, print version v1) | Atom (r, v) -> group_if @@ nullify_pos @@ - Prefix_relop (nullify_pos r, print version v) + Prefix_relop ((nullify_pos r :> relop_kind with_pos), print version v) | And (x, y) -> group_if @@ nullify_pos @@ Logop (nullify_pos `And, aux ~in_and:true x, aux ~in_and:true y) @@ -400,11 +423,17 @@ module V = struct pp ~name:(version.ppname ^ "-constraints") parse_constraints print_constraints - let filtered_constraints version = + let filtered_constraints version next = let rec parse_cs ~pos:_ items = let rec aux_parse v = match v.pelem with | Prefix_relop (op, v) -> - Atom (Constraint (op.pelem, parse version ~pos:v.pos v)) + let ver = parse version ~pos:v.pos v in + (match op.pelem with + | `Sem -> (* rewrite `Sem case *) + And (Atom (Constraint (`Geq, ver)), + Atom (Constraint (`Lt, next ver))) + | `Eq | `Neq | `Gt | `Geq | `Lt | `Leq as op -> + Atom (Constraint (op, ver))) | Logop ({ pelem = `And; _}, a, b) -> OpamFormula.ands [aux_parse a; aux_parse b] | Logop ({ pelem = `Or; _}, a, b) -> @@ -429,6 +458,12 @@ module V = struct in match cs with | Empty -> assert false + | And (Atom (Constraint (`Geq, v1)), + Atom (Constraint (`Lt, v2))) + when (next v1) = v2 -> + (* match rewrote `Sem *) + group_if @@ nullify_pos @@ + Prefix_relop (nullify_pos `Sem, print version v1) | And (x, y) -> group_if @@ nullify_pos @@ Logop (nullify_pos `And, aux ~in_and:true x, aux ~in_and:true y) @@ -438,7 +473,7 @@ module V = struct | Block g -> nullify_pos @@ Group (nullify_pos @@ print_cs g) | Atom (Constraint (op,v)) -> group_if @@ nullify_pos @@ - Prefix_relop (nullify_pos op, print version v) + Prefix_relop ((nullify_pos op :> relop_kind with_pos), print version v) | Atom (Filter flt) -> (match filter.print flt with | f1::fr -> diff --git a/src/format/opamFormat.mli b/src/format/opamFormat.mli index aa55a928473..7ad74025384 100644 --- a/src/format/opamFormat.mli +++ b/src/format/opamFormat.mli @@ -134,12 +134,14 @@ module V : sig (** Simple dependency constraints *) val constraints : - (value, 'a) t -> - (value list, (OpamFormula.relop * 'a) OpamFormula.formula) t + (value, 'version) t -> + ('version -> 'version) -> + (value list, (OpamFormula.relop * 'version) OpamFormula.formula) t (** Dependency constraints mixed with filters *) val filtered_constraints : (value, 'version) t -> + ('version -> 'version) -> (value list, 'version filter_or_constraint OpamFormula.formula) t (** Package versions *) diff --git a/src/format/opamFormula.ml b/src/format/opamFormula.ml index 4eeb480713f..2844ae1cd05 100644 --- a/src/format/opamFormula.ml +++ b/src/format/opamFormula.ml @@ -63,7 +63,10 @@ let atom_of_string str = let sversion = Re.Group.get sub 3 in let name = OpamPackage.Name.of_string sname in let sop = if sop = "." then "=" else sop in - let op = OpamLexer.FullPos.relop sop in + let op = match OpamLexer.FullPos.relop sop with + | `Eq | `Neq | `Gt | `Geq | `Lt | `Leq as sop -> sop + | `Sem -> raise (Failure "unexpected '~' in atomic constraint") + in let version = OpamPackage.Version.of_string sversion in name, Some (op, version) with Not_found | Failure _ | OpamLexer.Error _ -> diff --git a/src/format/opamFormula.mli b/src/format/opamFormula.mli index 7eadd514eef..e706f4d24d0 100644 --- a/src/format/opamFormula.mli +++ b/src/format/opamFormula.mli @@ -13,7 +13,7 @@ functions *) (** binary operations (compatible with the Dose type for Cudf operators!) *) -type relop = OpamParserTypes.FullPos.relop_kind (* = [ `Eq | `Neq | `Geq | `Gt | `Leq | `Lt ] *) +type relop = [ `Eq | `Neq | `Geq | `Gt | `Leq | `Lt ] (** Version constraints for OPAM *) type version_constraint = relop * OpamPackage.Version.t diff --git a/src/format/opamPackage.ml b/src/format/opamPackage.ml index 582b25e99ca..92a5ad8f8e4 100644 --- a/src/format/opamPackage.ml +++ b/src/format/opamPackage.ml @@ -38,6 +38,34 @@ module Version = struct let equal v1 v2 = compare v1 v2 = 0 + let next v = + let re = Re.(compile @@ seq [ start; + group @@ rep @@ diff any (alt [ digit; char '~' ]); + group @@ opt @@ seq [ + rep1 @@ digit; + rep @@ seq [ + char '.'; + rep1 @@ digit ]] + ]) + in + let res = Re.exec re v in + let pfx = Re.Group.get res 1 in + let num = Re.Group.get res 2 in + let nums = String.split_on_char '.' num in + let incr_compat_num nums = + let aux = function + | [] -> ["1"] + | [n] -> [int_of_string n |> (+)1 |> string_of_int ] + | n0::n1::ns -> + let nn0,nn1 = int_of_string n0, int_of_string n1 in + if not (nn1=0 && ns=[]) + then (string_of_int (nn1+1))::ns + else (string_of_int (nn0+1))::n1::ns + in List.rev nums |> aux |> List.rev + in + let next = incr_compat_num nums |> String.concat "." in + pfx^next + let to_json x = `String (to_string x) let of_json = function diff --git a/src/format/opamPackage.mli b/src/format/opamPackage.mli index bb1d765398d..b85d3169cbb 100644 --- a/src/format/opamPackage.mli +++ b/src/format/opamPackage.mli @@ -24,6 +24,10 @@ module Version: sig (** Are two package versions equal? *) val equal: t -> t -> bool + + (** Next version from semantic versioning perspective (#2976) *) + val next: t -> t + end (** Names *) diff --git a/src/format/opamTypes.mli b/src/format/opamTypes.mli index 0665d243f15..613507401ff 100644 --- a/src/format/opamTypes.mli +++ b/src/format/opamTypes.mli @@ -178,7 +178,7 @@ type repository = { (** {2 Variable-based filters} *) -type relop = OpamParserTypes.FullPos.relop_kind +type relop = OpamFormula.relop type filter = | FBool of bool @@ -186,6 +186,7 @@ type filter = | FIdent of (name option list * variable * (string * string) option) (** packages (or None for self-ref through "_"), variable name, string converter (val_if_true, val_if_false_or_undef) *) + | FNext of filter | FOp of filter * relop * filter | FAnd of filter * filter | FOr of filter * filter diff --git a/src/state/opamFileTools.ml b/src/state/opamFileTools.ml index e2b64c4e593..0f65aa125b0 100644 --- a/src/state/opamFileTools.ml +++ b/src/state/opamFileTools.ml @@ -820,7 +820,7 @@ let t_lint ?check_extra_files ?(check_upstream=false) ?(all=false) t = | FOp (fl,_,fr) -> (aux acc true fl) @ aux acc true fr | FAnd (fl, fr) | FOr (fl, fr) -> (aux acc false fl) @ aux acc false fr - | FNot f | FDefined f | FUndef f -> aux acc false f + | FNot f | FNext f | FDefined f | FUndef f -> aux acc false f in aux [] false in @@ -1188,7 +1188,7 @@ let read_repo_opam ~repo_name ~repo_root dir = let dep_formula_to_string f = let pp = - OpamFormat.V.(package_formula `Conj (constraints version)) + OpamFormat.V.(package_formula `Conj (constraints version OpamPackage.Version.next)) in OpamPrinter.FullPos.value (OpamPp.print pp f)