From ca0f6430038cea5b66f445fca1948f3fc4dfcf4e Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Tue, 11 Dec 2018 10:26:40 +0000 Subject: [PATCH] Improve opam metadata in dune We add metadata that can be used to used to partially specify opam files. Common fields such as depends, conflicts, authors, are all handled. Dune will now automatically suggest corrections to the existing opam files based on this metadata in the dune files Co-authored-by: Jon Ludlam Signed-off-by: Anil Madhavapeddy Signed-off-by: Rudi Grinberg --- CHANGES.md | 4 + doc/index.rst | 1 + doc/opam.rst | 103 ++++ dune-project | 38 +- dune.opam | 1 - .../hello_world/hello_world.opam | 2 +- .../with-configure-step/myproject.opam | 2 +- src/blang.ml | 59 +++ src/blang.mli | 6 +- src/dune_file.ml | 37 -- src/dune_project.ml | 476 ++++++++++++++---- src/dune_project.mli | 58 ++- src/gen_rules.ml | 3 +- src/opam_create.boot.ml | 1 + src/opam_create.ml | 76 +++ src/opam_create.mli | 3 + src/opam_file.ml | 83 +++ src/opam_file.mli | 53 ++ src/scope.ml | 8 +- src/stdune/dyn.ml | 2 + src/stdune/dyn.mli | 2 + src/syntax.ml | 4 + src/syntax.mli | 10 +- test/blackbox-tests/dune.inc | 10 + .../bad-opam-file/dune-project | 32 ++ .../dune-project-meta/bad-opam-file/foo.opam | 1 + .../test-cases/dune-project-meta/run.t | 61 +++ .../test-fields/cohttp-async.opam | 0 .../dune-project-meta/test-fields/cohttp.opam | 0 .../test-fields/dune-project | 32 ++ .../test-cases/github568/lib1.opam | 2 +- vendor/boot/opamPrinter.ml | 2 + .../opam-file-format/src/opamBaseParser.mly | 2 +- vendor/opam-file-format/src/opamLexer.mll | 25 +- vendor/opam-file-format/src/opamParser.ml | 35 +- vendor/opam-file-format/src/opamParser.mli | 24 +- .../opam-file-format/src/opamParserTypes.mli | 2 +- vendor/opam-file-format/src/opamPrinter.ml | 124 +++++ vendor/opam-file-format/src/opamPrinter.mli | 28 +- vendor/update-opam-file-format.sh | 4 +- 40 files changed, 1235 insertions(+), 181 deletions(-) create mode 100644 doc/opam.rst create mode 100644 src/opam_create.boot.ml create mode 100644 src/opam_create.ml create mode 100644 src/opam_create.mli create mode 100644 test/blackbox-tests/test-cases/dune-project-meta/bad-opam-file/dune-project create mode 100644 test/blackbox-tests/test-cases/dune-project-meta/bad-opam-file/foo.opam create mode 100644 test/blackbox-tests/test-cases/dune-project-meta/run.t create mode 100644 test/blackbox-tests/test-cases/dune-project-meta/test-fields/cohttp-async.opam create mode 100644 test/blackbox-tests/test-cases/dune-project-meta/test-fields/cohttp.opam create mode 100644 test/blackbox-tests/test-cases/dune-project-meta/test-fields/dune-project create mode 100644 vendor/boot/opamPrinter.ml diff --git a/CHANGES.md b/CHANGES.md index a322404144e..9cb1fcd4e9a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -25,6 +25,10 @@ unreleased to produce targets that are present in the source tree. This has been a warning for long enough (#2068, @diml) +- Add more opam metadata and use it to generate corrections to the .opam files + in the source. This allows the user to partially specify opam metadata in the + the dune-project file. (#2017, @avsm, @jonludlam) + 1.9.1 (11/04/2019) ------------------ diff --git a/doc/index.rst b/doc/index.rst index 8cb0e32880d..52a40faeb02 100644 --- a/doc/index.rst +++ b/doc/index.rst @@ -22,6 +22,7 @@ Welcome to dune's documentation! configurator menhir jsoo + opam variants formatting coq diff --git a/doc/opam.rst b/doc/opam.rst new file mode 100644 index 00000000000..c1c3edabaeb --- /dev/null +++ b/doc/opam.rst @@ -0,0 +1,103 @@ +**** +opam +**** + +opam_ is the official package manager for OCaml, and dune offers some +integration with it. + +Generating opam files +===================== + +Dune is able to use metadata specified in the ``dune-project`` file to cross +reference it with the information in the user written ``.opam`` file. To enable +this integration, a user needs to add an ``(opam ..)`` field to the dune-project +file. + +The fields that dune uses for this purpose are: + +- ``(license )`` - Specified the license of the project + +- ``(authors )`` - A list of authors + +- ``(source )`` - where the source is specified two ways: + ``(github )`` or ``(uri )`` + +To enable dune suggesting corrections to the opam stanza, the user must specify +an ``(opam )`` with the fields: + +- ``(tags )`` - Specify the list of tags for all packages +- ``(depends )`` - The list of dependencies shared by all opam packages + in this dune project +- ``(conflicts )`` - The list of conflicts shared by all opam + packages in this dune project +- ``(package )`` - the list of packages in this project and their + individual metadata. + +The list of dependencies ```` is modeled after opam's own +language: The syntax is as a list of the following elements: + +.. code:: + op := '=' | '<' | '>' | '<>' | '>=' | '<=' + + stage := :with_test | :build | :dev + + constr := ( ) + + logop := or | and + + dep := (name ) + | (name ) + | (name ( ( | )*)) + + dep-specification = dep+ + +The `(package )` field contains the fields: + +- ``(name )`` is the name of the package + +- ``(synopsis )`` is a short package description + +- ``(description )`` is a longer package description + +- ``(depends )`` are package specific dependencies + +- ``(conflicts = 4.06.0)) + (cohttp (>= 1.0.0))) + (package + (name cohttp) + (synopsis "An OCaml library for HTTP clients and servers") + (description "A longer description") + (depends + (alcotest :with-test) + (dune (and :build (> 1.5))) + (foo (and :dev (> 1.5) (< 2.0))) + (uri (>= 1.9.0)) + (uri (< 2.0.0)) + (fieldslib (> v0.12)) + (fieldslib (< v0.13)))) + (package + (name cohttp-async) + (synopsis "HTTP client and server for the Async library") + (description "A _really_ long description") + (depends + (cohttp (>= 1.0.2)) + (conduit-async (>= 1.0.3)) + (async (>= v0.10.0)) + (async (< v0.12))))) + +.. _opam: https://opam.ocaml.org/ diff --git a/dune-project b/dune-project index 728fd8a37eb..8004f78da1a 100644 --- a/dune-project +++ b/dune-project @@ -1,4 +1,38 @@ -(lang dune 1.8) +(lang dune 1.10) (name dune) -(implicit_transitive_deps false) \ No newline at end of file +(implicit_transitive_deps false) + +(license MIT) +(authors "Jane Street Group, LLC ") +(source (github ocaml/dune)) + +(opam + (package + (name dune) + (depends + (ocaml (>= 4.02)) + base-unix + base-threads) + (conflicts + (jbuilder (<> "transition")) + (odoc (< 1.3.0))) + (synopsis "Fast, portable and opinionated build system") + (description " +dune is a build system that was designed to simplify the release of +Jane Street packages. It reads metadata from \"dune\" files following a +very simple s-expression syntax. + +dune is fast, it has very low-overhead and support parallel builds on +all platforms. It has no system dependencies, all you need to build +dune and packages using dune is OCaml. You don't need or make or bash +as long as the packages themselves don't use bash explicitly. + +dune supports multi-package development by simply dropping multiple +repositories into the same directory. + +It also supports multi-context builds, such as building against +several opam roots/switches simultaneously. This helps maintaining +packages across several versions of OCaml and gives cross-compilation +for free. +"))) \ No newline at end of file diff --git a/dune.opam b/dune.opam index f7d9d45aee5..6543755df12 100644 --- a/dune.opam +++ b/dune.opam @@ -21,7 +21,6 @@ conflicts: [ "jbuilder" {!= "transition"} "odoc" {< "1.3.0"} ] - synopsis: "Fast, portable and opinionated build system" description: """ dune is a build system that was designed to simplify the release of diff --git a/example/sample-projects/hello_world/hello_world.opam b/example/sample-projects/hello_world/hello_world.opam index e41b3113508..e01384176bc 100644 --- a/example/sample-projects/hello_world/hello_world.opam +++ b/example/sample-projects/hello_world/hello_world.opam @@ -8,4 +8,4 @@ dev-repo: "git+https://github.com/SpongeBob/hello_world.git" license: "Apache-2.0" build: [ ["dune" "build" "-p" name "-j" jobs] -] +] \ No newline at end of file diff --git a/example/sample-projects/with-configure-step/myproject.opam b/example/sample-projects/with-configure-step/myproject.opam index 87b0c72a65c..e9806ca7fc8 100644 --- a/example/sample-projects/with-configure-step/myproject.opam +++ b/example/sample-projects/with-configure-step/myproject.opam @@ -8,4 +8,4 @@ dev-repo: "git+https://github.com/SpongeBob/myproject.git" license: "Apache-2.0" build: [ ["dune" "build" "-p" name "-j" jobs] -] +] \ No newline at end of file diff --git a/src/blang.ml b/src/blang.ml index 88f42a181eb..93f80782ffa 100644 --- a/src/blang.ml +++ b/src/blang.ml @@ -15,6 +15,16 @@ module Op = struct | (Neq | Lt | Lte) , Lt | (Neq | Gt | Gte) , Gt -> true | _, _ -> false + + let to_dyn = + let open Dyn.Encoder in + function + | Eq -> string "Eq" + | Gt -> string "Gt" + | Gte -> string "Gte" + | Lte -> string "Lte" + | Lt -> string "Lt" + | Neq -> string "Neq" end type t = @@ -43,3 +53,52 @@ let rec eval t ~dir ~f = let x = String_with_vars.expand x ~mode:Many ~dir ~f and y = String_with_vars.expand y ~mode:Many ~dir ~f in Op.eval op (Value.L.compare_vals ~dir x y) + +let rec to_dyn = + let open Dyn.Encoder in + function + | Const b -> constr "Const" [bool b] + | Expr e -> constr "Expr" [via_sexp String_with_vars.to_sexp e] + | And t -> constr "And" (List.map ~f:to_dyn t) + | Or t -> constr "Or" (List.map ~f:to_dyn t) + | Compare (o, s1, s2) -> + constr "Compare" + [ Op.to_dyn o + ; via_sexp String_with_vars.to_sexp s1 + ; via_sexp String_with_vars.to_sexp s2 + ] + +let ops = + [ "=", Op.Eq + ; ">=", Gte + ; "<=", Lt + ; ">", Gt + ; "<", Lt + ; "<>", Neq + ] + +let decode = + let open Stanza.Decoder in + let ops = + List.map ops ~f:(fun (name, op) -> + ( name + , (let+ x = String_with_vars.decode + and+ y = String_with_vars.decode + in + Compare (op, x, y)))) + in + let decode = + fix begin fun t -> + if_list + ~then_:( + [ "or", repeat t >>| (fun x -> Or x) + ; "and", repeat t >>| (fun x -> And x) + ] @ ops + |> sum) + ~else_:(String_with_vars.decode >>| fun v -> Expr v) + end + in + let+ () = Syntax.since Stanza.syntax (1, 1) + and+ decode = decode + in + decode diff --git a/src/blang.mli b/src/blang.mli index 39bfddafc26..4c2ee29c0f4 100644 --- a/src/blang.mli +++ b/src/blang.mli @@ -22,5 +22,9 @@ val true_ : t val eval : t -> dir:Path.t - -> f:Value.t list option String_with_vars.expander + -> f:Value.t list option String_with_vars.expander -> bool + +val to_dyn : t -> Dyn.t + +val decode : t Stanza.Decoder.t diff --git a/src/dune_file.ml b/src/dune_file.ml index 8d925b79e93..67bc992492e 100644 --- a/src/dune_file.ml +++ b/src/dune_file.ml @@ -319,43 +319,6 @@ module Preprocess = struct ])) end -module Blang = struct - include Blang - - let ops = - [ "=", Op.Eq - ; ">=", Gte - ; "<=", Lt - ; ">", Gt - ; "<", Lt - ; "<>", Neq - ] - - let decode = - let ops = - List.map ops ~f:(fun (name, op) -> - ( name - , (let+ x = String_with_vars.decode - and+ y = String_with_vars.decode - in - Compare (op, x, y)))) - in - let decode = - fix begin fun t -> - if_list - ~then_:( - [ "or", repeat t >>| (fun x -> Or x) - ; "and", repeat t >>| (fun x -> And x) - ] @ ops - |> sum) - ~else_:(String_with_vars.decode >>| fun v -> Expr v) - end - in - let+ () = Syntax.since Stanza.syntax (1, 1) - and+ decode = decode - in - decode -end let enabled_if = field "enabled_if" ~default:Blang.true_ diff --git a/src/dune_project.ml b/src/dune_project.ml index 8704d1d1992..31d0908585a 100644 --- a/src/dune_project.ml +++ b/src/dune_project.ml @@ -13,14 +13,13 @@ module Name : sig | Named of string | Anonymous of Path.t - val pp : t Fmt.t + val to_dyn : t -> Dyn.t val compare : t -> t -> Ordering.t val to_string_hum : t -> string val decode : t Dune_lang.Decoder.t - val to_sexp : t Sexp.Encoder.t val to_encoded_string : t -> string val of_encoded_string : string -> t @@ -55,23 +54,16 @@ end = struct let anonymous_root = Anonymous Path.root - let pp fmt = function - | Named n -> - Format.fprintf fmt "Named %S" n - | Anonymous p -> - Format.fprintf fmt "Anonymous %s" (Path.to_string_maybe_quoted p) + let to_dyn = + let open Dyn.Encoder in + function + | Named n -> constr "Named" [string n] + | Anonymous p -> constr "Anonymous" [Path.to_dyn p] let to_string_hum = function | Named s -> s | Anonymous p -> sprintf "" (Path.to_string_maybe_quoted p) - let to_sexp = function - | Named s -> Sexp.Encoder.string s - | Anonymous p -> - List [ Atom "anonymous" - ; Path.to_sexp p - ] - let validate name = let len = String.length name in len > 0 && @@ -139,26 +131,289 @@ module Project_file = struct ; project_name : Name.t } - let pp fmt { file ; exists; project_name } = - Fmt.record fmt - [ "file", Fmt.const Path.Source.pp file - ; "exists", Fmt.const Format.pp_print_bool exists - ; "project_name", (fun fmt () -> Name.pp fmt project_name) + let to_dyn { file; exists; project_name } = + let open Dyn.Encoder in + record + [ "file", Path.Source.to_dyn file + ; "exists", bool exists + ; "project_name", Name.to_dyn project_name ] +end + +module Source_kind = struct + type t = + | Github of string * string + | Url of string + + let to_dyn = + let open Dyn.Encoder in + function + | Github (user,repo) -> + constr "Github" [string user; string repo] + | Url url -> + constr "Url" [string url] - let to_sexp { file; exists; project_name } = - Sexp.Encoder.( + let pp fmt = function + | Github (user,repo) -> + Format.fprintf fmt "git+https://github.com/%s/%s.git" user repo + | Url u -> Format.pp_print_string fmt u + + let decode = + let open Stanza.Decoder in + sum + ["github", plain_string (fun ~loc s -> + match String.split ~on:'/' s with + | [user; repo] -> Github (user,repo) + | _ -> + of_sexp_errorf loc "GitHub repository must be of form user/repo") + ; "uri", string >>| fun s -> Url s + ] +end + +module Opam = struct + + module Dependency = struct + module Op = struct + type t = + | Eq + | Gte + | Lte + | Gt + | Lt + | Neq + + let map = + [ "=", Eq + ; ">=", Gte + ; "<=", Lte + ; ">", Gt + ; "<", Lt + ; "<>", Neq + ] + + let to_dyn = + let open Dyn.Encoder in + function + | Eq -> string "Eq" + | Gt -> string "Gt" + | Gte -> string "Gte" + | Lte -> string "Lte" + | Lt -> string "Lt" + | Neq -> string "Neq" + + let to_relop : t -> OpamParserTypes.relop = function + | Eq -> `Eq + | Gte -> `Geq + | Lte -> `Leq + | Gt -> `Gt + | Lt -> `Lt + | Neq -> `Neq + end + + module Constraint = struct + module Var = struct + type t = + | QVar of string + | Var of string + + let decode = + let open Stanza.Decoder in + let+ s = string in + if String.is_prefix s ~prefix:":" then + Var (String.drop s 1) + else + QVar s + + let to_opam : t -> OpamParserTypes.value = + let nopos = Opam_file.nopos in + function + | QVar x -> String (nopos, x) + | Var x -> Ident (nopos, x) + end + + type t = + | Bvar of Var.t + | Uop of Op.t * Var.t + | And of t list + | Or of t list + + let decode = + let open Stanza.Decoder in + let ops = + List.map Op.map ~f:(fun (name, op) -> + name, (let+ x = Var.decode in Uop (op, x))) + in + let ops = + ("!=", let+ loc = loc in of_sexp_error loc "Use <> instead of !=") + :: ops + in + fix begin fun t -> + let logops = + [ "and", (let+ x = repeat t in And x) + ; "or", (let+ x = repeat t in Or x) + ] + in + peek_exn >>= function + | Atom (_loc, A s) when String.is_prefix s ~prefix:":" -> + let+ () = junk in + Bvar (Var (String.drop s 1)) + | _ -> + sum (ops @ logops) + end + + let rec to_dyn = + let open Dyn.Encoder in + function + | Bvar (QVar v) -> constr "Bvar" [Dyn.String v] + | Bvar (Var v) -> constr "Bvar" [Dyn.String (":" ^ v)] + | Uop (b, QVar v) -> constr "Uop" [Op.to_dyn b; Dyn.String v] + | Uop (b, Var v) -> constr "Uop" [Op.to_dyn b; Dyn.String (":" ^ v)] + | And t -> constr "And" (List.map ~f:to_dyn t) + | Or t -> constr "Or" (List.map ~f:to_dyn t) + end + + type t = + { name : Package.Name.t + ; constraint_ : Constraint.t option + } + + let decode = + let open Stanza.Decoder in + let constrained = + let+ name = Package.Name.decode + and+ expr = Constraint.decode + in + { name + ; constraint_ = Some expr + } + in + if_list + ~then_:(enter constrained) + ~else_:( + let+ name = Package.Name.decode in + { name + ; constraint_ = None + }) + + let rec opam_constraint : Constraint.t -> OpamParserTypes.value = + let nopos = Opam_file.nopos in + function + | Bvar v -> Constraint.Var.to_opam v + | Uop (op, v) -> + Prefix_relop (nopos, Op.to_relop op, Constraint.Var.to_opam v) + | And [c] -> opam_constraint c + | And (c :: cs) -> + Logop (nopos, `And, opam_constraint c, opam_constraint (And cs)) + | Or [c] -> opam_constraint c + | Or (c :: cs) -> + Logop (nopos, `Or, opam_constraint c, opam_constraint (And cs)) + | And [] + | Or [] -> Exn.code_error "opam_constraint" [] + + let opam_depend : t -> OpamParserTypes.value = + let nopos = Opam_file.nopos in + fun { name; constraint_ } -> + let constraint_ = Option.map ~f:opam_constraint constraint_ in + let pkg : OpamParserTypes.value = + String (nopos, Package.Name.to_string name) in + match constraint_ with + | None -> pkg + | Some c -> Option (nopos, pkg, [c]) + + let to_dyn { name; constraint_ } = + let open Dyn.Encoder in record - [ "file", Path.Source.to_sexp file - ; "exists", bool exists - ; "project_name", Name.to_sexp project_name - ]) + [ "name", Package.Name.to_dyn name + ; "constr", Dyn.Option (Option.map ~f:Constraint.to_dyn constraint_) + ] + end + + module Package = struct + module Name = Package.Name + + type t = + { name : Package.Name.t + ; synopsis : string + ; description : string + ; depends : Dependency.t list + ; conflicts: Dependency.t list + } + + let decode = + let open Stanza.Decoder in + Syntax.since Stanza.syntax (1, 7) >>> + fields ( + let+ name = field "name" Package.Name.decode + and+ synopsis = field "synopsis" string + and+ description = field "description" string + and+ depends = + field ~default:[] "depends" (repeat Dependency.decode) + and+ conflicts = + field ~default:[] "conflicts" (repeat Dependency.decode) + in + { name + ; synopsis + ; description + ; depends + ; conflicts + }) + + let to_dyn { name; synopsis; depends; conflicts; description } = + let open Dyn.Encoder in + record + [ "name", Package.Name.to_dyn name + ; "synopsis", string synopsis + ; "description", string description + ; "depends", list Dependency.to_dyn depends + ; "conflicts", list Dependency.to_dyn conflicts + ] + end + + type t = + { tags : string list + ; depends : Dependency.t list + ; conflicts : Dependency.t list + ; packages : Package.t list + } + + let to_dyn { tags; depends ; packages ; conflicts } = + let open Dyn.Encoder in + record + [ "tags", list string tags + ; "depends", list Dependency.to_dyn depends + ; "conflicts", list Dependency.to_dyn conflicts + ; "packages", list Package.to_dyn packages + ] + + let decode = + let open Stanza.Decoder in + Syntax.since Stanza.syntax (1, 9) >>> + fields ( + let+ tags = field ~default:[] "tags" (repeat string) + and+ depends = + field ~default:[] "depends" (repeat Dependency.decode) + and+ conflicts = + field ~default:[] "conflicts" (repeat Dependency.decode) + and+ packages = multi_field "package" Package.decode in + { tags + ; depends + ; conflicts + ; packages + } + ) + + let find t name = + List.find t.packages ~f:(fun p -> Package.Name.equal p.name name) end type t = { name : Name.t ; root : Path.Source.t ; version : string option + ; source : Source_kind.t option + ; license : string option + ; authors : string list + ; opam : Opam.t option ; packages : Package.t Package.Name.Map.t ; stanza_parser : Stanza.t list Dune_lang.Decoder.t ; project_file : Project_file.t @@ -174,6 +429,10 @@ let hash = Hashtbl.hash let packages t = t.packages let version t = t.version +let source t = t.source +let license t = t.license +let authors t = t.authors +let opam t = t.opam let name t = t.name let root t = t.root let stanza_parser t = t.stanza_parser @@ -181,24 +440,29 @@ let file t = t.project_file.file let implicit_transitive_deps t = t.implicit_transitive_deps let allow_approx_merlin t = t.allow_approx_merlin -let pp fmt { name ; root ; version ; project_file ; parsing_context = _ - ; extension_args = _; stanza_parser = _ ; packages - ; implicit_transitive_deps ; dune_version - ; allow_approx_merlin } = - Fmt.record fmt - [ "name", Fmt.const Name.pp name - ; "root", Fmt.const Path.Source.pp root - ; "version", Fmt.const (Fmt.optional Format.pp_print_string) version - ; "project_file", Fmt.const Project_file.pp project_file +let to_dyn + { name ; root ; version ; source; license; authors + ; opam; project_file ; parsing_context = _ + ; extension_args = _; stanza_parser = _ ; packages + ; implicit_transitive_deps ; dune_version + ; allow_approx_merlin } = + let open Dyn.Encoder in + record + [ "name", Name.to_dyn name + ; "root", via_sexp Path.Source.to_sexp root + ; "version", (option string) version + ; "source", (option Source_kind.to_dyn) source + ; "license", (option string) license + ; "authors", (list string) authors + ; "opam", (option Opam.to_dyn) opam + ; "project_file", Project_file.to_dyn project_file ; "packages", - Fmt.const - (Fmt.ocaml_list (Fmt.tuple Package.Name.pp Package.pp)) + (list (pair Package.Name.to_dyn Package.to_dyn)) (Package.Name.Map.to_list packages) ; "implicit_transitive_deps", - Fmt.const Format.pp_print_bool implicit_transitive_deps - ; "dune_version", Fmt.const Syntax.Version.pp dune_version - ; "allow_approx_merlin" - , Fmt.const Format.pp_print_bool allow_approx_merlin + bool implicit_transitive_deps + ; "dune_version", Syntax.Version.to_dyn dune_version + ; "allow_approx_merlin", bool allow_approx_merlin ] let find_extension_args t key = @@ -294,7 +558,7 @@ module Extension = struct ; version : Syntax.Version.t ; loc : Loc.t ; parse_args : (Univ_map.t * Stanza.Parser.t list) Dune_lang.Decoder.t -> - Univ_map.t * Stanza.Parser.t list + Univ_map.t * Stanza.Parser.t list } let extensions = Hashtbl.create 32 @@ -354,7 +618,7 @@ module Extension = struct let result_stanzas = List.map stanzas ~f:(fun (name, p) -> (name, - return () >>= fun () -> + let* () = return () in if not !dune_project_edited then begin dune_project_edited := true; ignore ( @@ -385,66 +649,71 @@ let interpret_lang_and_extensions ~(lang : Lang.Instance.t) match String.Map.of_list (List.map explicit_extensions ~f:(fun (e : Extension.instance) -> - (Syntax.name (Extension.syntax e.extension), e.loc))) + (Syntax.name (Extension.syntax e.extension), e.loc))) with | Error (name, _, loc) -> - Errors.fail loc "Extension %S specified for the second time." name + Errors.fail loc "Extension %S specified for the second time." name | Ok map -> - let implicit_extensions = - Extension.automatic ~project_file - ~f:(fun name -> not (String.Map.mem map name)) - in - let extensions = - List.map ~f:(fun e -> (e, true)) explicit_extensions @ - List.map ~f:(fun e -> (e, false)) implicit_extensions - in - let acc = Univ_map.singleton (Syntax.key lang.syntax) lang.version in - let parsing_context = - List.fold_left extensions ~init:acc - ~f:(fun acc ((ext : Extension.instance), _) -> - Univ_map.add acc (Syntax.key (Extension.syntax ext.extension)) - ext.version) - in - let extension_args, extension_stanzas = - List.fold_left - extensions - ~init:(Univ_map.empty, []) - ~f:(fun (args_acc, stanzas_acc) - ((instance : Extension.instance), is_explicit) -> - let extension = instance.extension in - let Extension.Extension e = extension in - let args = - let+ (arg, stanzas) = - Dune_lang.Decoder.set_many parsing_context e.stanzas - in - let new_args_acc = - if is_explicit then - Univ_map.add args_acc e.key arg - else - args_acc - in - (new_args_acc, stanzas) - in - let (new_args_acc, stanzas) = instance.parse_args args in - (new_args_acc, stanzas::stanzas_acc)) - in - let stanzas = List.concat (lang.data :: extension_stanzas) in - let stanza_parser = - Dune_lang.Decoder.(set_many parsing_context (sum stanzas)) - in - (parsing_context, stanza_parser, extension_args) + let implicit_extensions = + Extension.automatic ~project_file + ~f:(fun name -> not (String.Map.mem map name)) + in + let extensions = + List.map ~f:(fun e -> (e, true)) explicit_extensions @ + List.map ~f:(fun e -> (e, false)) implicit_extensions + in + let acc = Univ_map.singleton (Syntax.key lang.syntax) lang.version in + let parsing_context = + List.fold_left extensions ~init:acc + ~f:(fun acc ((ext : Extension.instance), _) -> + Univ_map.add acc (Syntax.key (Extension.syntax ext.extension)) + ext.version) + in + let extension_args, extension_stanzas = + List.fold_left + extensions + ~init:(Univ_map.empty, []) + ~f:(fun (args_acc, stanzas_acc) + ((instance : Extension.instance), is_explicit) -> + let extension = instance.extension in + let Extension.Extension e = extension in + let args = + let+ (arg, stanzas) = + Dune_lang.Decoder.set_many parsing_context e.stanzas + in + let new_args_acc = + if is_explicit then + Univ_map.add args_acc e.key arg + else + args_acc + in + (new_args_acc, stanzas) + in + let (new_args_acc, stanzas) = instance.parse_args args in + (new_args_acc, stanzas::stanzas_acc)) + in + let stanzas = List.concat (lang.data :: extension_stanzas) in + let stanza_parser = + Dune_lang.Decoder.(set_many parsing_context (sum stanzas)) + in + (parsing_context, stanza_parser, extension_args) let key = Univ_map.Key.create ~name:"dune-project" - (fun { name; root; version; project_file + (fun { name; root; version; project_file; source + ; license; authors; opam ; stanza_parser = _; packages = _ ; extension_args = _ ; parsing_context ; implicit_transitive_deps ; dune_version ; allow_approx_merlin } -> Sexp.Encoder.record - [ "name", Name.to_sexp name + [ "name", Dyn.to_sexp (Name.to_dyn name) ; "root", Path.Source.to_sexp root + ; "license", Sexp.Encoder.(option string) license + ; "authors", Sexp.Encoder.(list string) authors + ; "source", Dyn.to_sexp (Dyn.Encoder.(option Source_kind.to_dyn) source) ; "version", Sexp.Encoder.(option string) version - ; "project_file", Project_file.to_sexp project_file + ; "opam", Dyn.to_sexp (Dyn.Encoder.(option Opam.to_dyn) opam) + ; "project_file", Dyn.to_sexp (Project_file.to_dyn project_file) ; "parsing_context", Univ_map.to_sexp parsing_context ; "implicit_transitive_deps", Sexp.Encoder.bool implicit_transitive_deps ; "dune_version", Syntax.Version.to_sexp dune_version @@ -478,8 +747,12 @@ let anonymous = lazy ( { name = name ; packages = Package.Name.Map.empty ; root = Path.Source.root + ; source = None + ; license = None + ; authors = [] ; version = None ; implicit_transitive_deps = false + ; opam = None ; stanza_parser ; project_file ; extension_args @@ -509,15 +782,22 @@ let default_name ~dir ~packages = name let name_field ~dir ~packages = - let+ name = field_o "name" Name.decode in - match name with - | Some x -> x - | None -> default_name ~dir ~packages + let+ name = field_o "name" Name.decode in + match name with + | Some x -> x + | None -> default_name ~dir ~packages let parse ~dir ~lang ~packages ~file = fields (let+ name = name_field ~dir:(Path.source dir) ~packages and+ version = field_o "version" string + and+ source = field_o "source" (Syntax.since Stanza.syntax (1, 7) + >>> Source_kind.decode) + and+ opam = field_o "opam" Opam.decode + and+ authors = field ~default:[] "authors" + (Syntax.since Stanza.syntax (1, 9) >>> repeat string) + and+ license = field_o "license" + (Syntax.since Stanza.syntax (1, 9) >>> string) and+ explicit_extensions = multi_field "using" (let+ loc = loc @@ -553,7 +833,11 @@ let parse ~dir ~lang ~packages ~file = { name ; root = dir ; version + ; source + ; license + ; authors ; packages + ; opam ; stanza_parser ; project_file ; extension_args @@ -583,6 +867,10 @@ let make_jbuilder_project ~dir packages = { name ; root = dir ; version = None + ; source = None + ; license = None + ; authors = [] + ; opam = None ; packages ; stanza_parser ; project_file diff --git a/src/dune_project.mli b/src/dune_project.mli index eca8d339869..a37db27acde 100644 --- a/src/dune_project.mli +++ b/src/dune_project.mli @@ -18,13 +18,13 @@ module Name : sig | Named of string | Anonymous of Path.t + val to_dyn : t -> Dyn.t + val compare : t -> t -> Ordering.t (** Convert to a string that is suitable for human readable messages *) val to_string_hum : t -> string - val to_sexp : t Sexp.Encoder.t - (** Convert to/from an encoded string that is suitable to use in filenames *) val to_encoded_string : t -> string val of_encoded_string : string -> t @@ -36,14 +36,66 @@ end module Project_file : sig type t + val to_dyn : t -> Dyn.t +end + +module Source_kind : sig + type t = + | Github of string * string + | Url of string + + val pp : t Fmt.t + + val to_dyn : t -> Dyn.t end +module Opam : sig + + module Dependency : sig + type t + + val opam_depend : t -> OpamParserTypes.value + + val to_dyn : t -> Dyn.t + end + + module Package : sig + type t = private + { name: Package.Name.t + ; synopsis: string + ; description: string + ; depends: Dependency.t list + ; conflicts: Dependency.t list + } + val to_dyn : t -> Dyn.t + end + + type t = private + { tags : string list + ; depends: Dependency.t list + ; conflicts: Dependency.t list + ; packages: Package.t list + } + + type package_name + + val to_dyn : t -> Dyn.t + + val find : t -> package_name -> Package.t option +end with type package_name := Package.Name.t + type t +val to_dyn : t -> Dyn.t + val packages : t -> Package.t Package.Name.Map.t val version : t -> string option val name : t -> Name.t val root : t -> Path.Source.t +val source: t -> Source_kind.t option +val opam : t -> Opam.t option +val license : t -> string option +val authors : t -> string list val stanza_parser : t -> Stanza.t list Dune_lang.Decoder.t val allow_approx_merlin : t -> bool @@ -133,5 +185,3 @@ val set_parsing_context : t -> 'a Dune_lang.Decoder.t -> 'a Dune_lang.Decoder.t val implicit_transitive_deps : t -> bool val dune_version : t -> Syntax.Version.t - -val pp : t Fmt.t diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 1ff8bcdb515..c896755b1f8 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -219,6 +219,7 @@ module Gen(P : sig val sctx : Super_context.t end) = struct let gen_rules ~dir components : Build_system.extra_sub_directories_to_keep = Install_rules.init_meta sctx ~dir; + Opam_create.add_rules sctx ~dir; (match components with | ".js" :: rest -> Js_of_ocaml_rules.setup_separate_compilation_rules sctx rest @@ -346,5 +347,5 @@ let gen ~contexts Build_system.set_rule_generators (String.Map.map map ~f:(fun (module M : Gen) -> M.gen_rules)); String.Map.iter map ~f:(fun (module M : Gen) -> M.init ()); - String.Map.map map ~f:(fun (module M : Gen) -> M.sctx) + String.Map.map map ~f:(fun (module M : Gen) -> M.sctx); diff --git a/src/opam_create.boot.ml b/src/opam_create.boot.ml new file mode 100644 index 00000000000..2131b435de7 --- /dev/null +++ b/src/opam_create.boot.ml @@ -0,0 +1 @@ +let add_rules _sctx ~dir:_ = () diff --git a/src/opam_create.ml b/src/opam_create.ml new file mode 100644 index 00000000000..e4395748742 --- /dev/null +++ b/src/opam_create.ml @@ -0,0 +1,76 @@ +open Stdune + +let correct_specific + ((opam : Dune_project.Opam.t) + , { Dune_project.Opam.Package.synopsis + ; description + ; depends + ; conflicts + ; name = _ + }) = + let open Opam_file.Mutator in + set_string "synopsis" synopsis >>> + set_string "description" description >>> + list (depends @ opam.depends) + (set_list "depends" Dune_project.Opam.Dependency.opam_depend) >>> + list (conflicts @ opam.conflicts) + (set_list "conflicts" Dune_project.Opam.Dependency.opam_depend) + +let correct project package_name = + let open Opam_file.Mutator in + opt ( + let open Option.O in + let* opam = Dune_project.opam project in + let+ pkg = Dune_project.Opam.find opam package_name in + (opam, pkg)) + correct_specific >>> + opt (Dune_project.license project) (set_string "license") >>> + list (Dune_project.authors project) (set_list "authors" mkstring) >>> + opt (Dune_project.version project) (set_string "version") >>> + opt (Option.map ~f:(Format.asprintf "%a" Dune_project.Source_kind.pp) + (Dune_project.source project)) (set_string "dev-repo") >>> + set_string "opam-version" "2.0" >>> + fixup + +let add_rules sctx ~dir ~project = + let open Build.O in + Local_package.defined_in sctx ~dir + |> List.iter ~f:(fun pkg -> + let opam_path = Local_package.opam_file pkg in + let expected_path = Path.extend_basename opam_path ~suffix:".expected" in + let expected_rule = + Build.contents opam_path >>^ (fun contents -> + let opamfile = Opam_file.of_string ~path:opam_path contents in + let package_name = Local_package.name pkg in + let corrected = + Opam_file.Mutator.apply (correct project package_name) opamfile in + OpamPrinter.Preserved.items contents opamfile.file_contents + corrected.file_contents) >>> + Build.write_file_dyn expected_path + in + let diff_rule = + Build.paths [expected_path; opam_path] + >>^ fun () -> + Action.Diff { Action.Diff. + file1 = opam_path + ; file2 = expected_path + ; optional = false + ; mode = Text + } + in + let dir = Local_package.build_dir pkg in + Super_context.add_rule sctx ~dir expected_rule; + let aliases = + [ Alias.install ~dir + ; Alias.runtest ~dir ] in + List.iter ~f:(fun alias -> + Super_context.add_alias_action sctx alias + ~dir ~loc:None ~stamp:("opam_diff", opam_path) diff_rule) + aliases) + +let add_rules sctx ~dir = + let scope = Super_context.find_scope_by_dir sctx dir in + let project = Scope.project scope in + Option.iter + (Dune_project.opam project) + ~f:(fun _ -> add_rules sctx ~dir ~project) diff --git a/src/opam_create.mli b/src/opam_create.mli new file mode 100644 index 00000000000..13f97718cc3 --- /dev/null +++ b/src/opam_create.mli @@ -0,0 +1,3 @@ +open Stdune + +val add_rules : Super_context.t -> dir:Path.t -> unit diff --git a/src/opam_file.ml b/src/opam_file.ml index ad91d57b6f2..2c953afdaf1 100644 --- a/src/opam_file.ml +++ b/src/opam_file.ml @@ -13,6 +13,16 @@ let parse (lb : Lexing.lexbuf) = | Parsing.Parse_error -> Errors.fail_lex lb "Parse error" +let of_string ~path s = + let lb = Lexing.from_string s in + lb.lex_curr_p <- + { pos_fname = Path.to_string path + ; pos_lnum = 1 + ; pos_bol = 0 + ; pos_cnum = 0 + }; + parse lb + let load fn = Io.with_lexbuf_from_file fn ~f:parse @@ -67,3 +77,76 @@ let absolutify_positions ~file_contents t = { file_contents = List.map t.file_contents ~f:map_item ; file_name = t.file_name } + +let nopos : OpamParserTypes.pos = ("",0,0) (* Null position *) + +module Mutator = struct + open OpamParserTypes + + type t = opamfile_item list -> opamfile_item list + + let (>>>) : t -> t -> t = fun x y z -> y (x z) + + let fixup : t = List.map ~f:(function + | Variable (x,y,String (pos,z)) -> + let fixed = + if String.length z > 0 && z.[0] = '\n' + then String.sub z ~pos:1 ~len:(String.length z - 1) + else z + in + Variable (x,y,String (pos,fixed)) + | y -> y) + + let _remove_var : string -> t = + fun str -> List.filter ~f:(function + | Variable (_, v, _) when v=str -> false + | _ -> true) + + let add_var : string -> OpamParserTypes.value -> t = fun var value l -> + (Variable (nopos, var, value))::l + + let remap x f = + List.filter_map ~f:(function + | Variable (_, v, y) when v = x -> begin + match f (Some y) with + | Some y' -> Some (Variable (nopos, v, y')) + | None -> None + end + | z -> Some z) + + let binding_present x = + List.exists ~f:(function + | Variable (_, v, _) when v = x -> true + | _ -> false) + + let _map_var x f zs = + if binding_present x zs + then remap x f zs + else begin + match f None with + | Some y -> (Variable (nopos, x, y))::zs + | None -> zs + end + + let set_var x y zs = + if binding_present x zs + then remap x (fun _ -> Some y) zs + else add_var x y zs + + let mkstring x = String (nopos, x) + let mklist f xs = List (nopos, List.map ~f xs) + + let set_string x y = set_var x (mkstring y) + + let set_list x conv l = set_var x (mklist conv l) + let id x = x + + let opt opt f : t = match opt with | None -> id | Some x -> f x + let list l f : t = match l with [] -> id | xs -> f xs + + let apply t opamfile = + { + opamfile with + file_contents = t opamfile.file_contents + } +end diff --git a/src/opam_file.mli b/src/opam_file.mli index 7846a299ddd..a506bfcb771 100644 --- a/src/opam_file.mli +++ b/src/opam_file.mli @@ -16,6 +16,59 @@ val get_field : t -> string -> value option (** Parse the contents of an opam file *) val parse : Lexing.lexbuf -> t +val of_string : path:Path.t -> string -> t + (** Replace all [pos] value by a triplet [(fname, line, absolute_offset)] *) val absolutify_positions : file_contents:string -> opamfile -> opamfile + +val nopos : OpamParserTypes.pos + +module Mutator : sig + open OpamParserTypes + + type t + + val (>>>) : t -> t -> t + + val mkstring : string -> value + + val mklist : ('a -> value) -> 'a list -> value + + val set_var : string -> value -> t + + (** [fixup] is a mutator that strips leading '\n's from variables. + Without this we accumulate newlines in long strings *) + val fixup : t + + (** Identity mutator *) + val id : t + + (** [set_string v s] is a mutator that sets the opam variable [v] to the + string [s]. If [v] is already bound in the opamfile the value is updated. + If [v] is not present in the opam file it is inserted at the top of the + file *) + val set_string : string -> string -> t + + (** [set_list v conv l] is a mutator that sets the opam variable [v] to the + list [l] after applying the convertor [conv] to the elements of [l]. If + [v] is already bound in the opamfile the value is updated. If [v] is not + present in the opam + file it is inserted at the top of the file. *) + val set_list : string -> ('a -> value) -> 'a list -> t + + (** [opt v f] returns an identity transformer if [v] is None and if it is + [Some x] applies [f] to [x] to return a transformer. Useful for + constructing a mutator that is only applied if an optional value has been + given. *) + val opt : 'a option -> ('a -> t) -> t + + (** [list v f] returns an identity transformer if [v] is the empty list, and + if not returns a transformer with the semantics of {v:set_list} *) + val list : 'a list -> ('a list -> t) -> t + + (** [apply t] returns a function that applies the transformation [t] to an + {{val:OpamParserTypes.opamfile}opamfile} *) + val apply : t -> OpamParserTypes.opamfile -> OpamParserTypes.opamfile +end + diff --git a/src/scope.ml b/src/scope.ml index 9f632dc1435..4ed4e6e8e6a 100644 --- a/src/scope.ml +++ b/src/scope.ml @@ -46,11 +46,12 @@ module DB = struct match Dune_project.Name.Map.find t.by_name name with | Some x -> x | None -> + let dune_project_sexp p = Dyn.to_sexp (Dune_project.Name.to_dyn p) in Exn.code_error "Scope.DB.find_by_name" - [ "name" , Dune_project.Name.to_sexp name + [ "name" , dune_project_sexp name ; "context", Sexp.Encoder.string t.context ; "names", - Sexp.Encoder.(list Dune_project.Name.to_sexp) + Sexp.Encoder.(list dune_project_sexp) (Dune_project.Name.Map.keys t.by_name) ] @@ -111,8 +112,9 @@ module DB = struct | Ok x -> x | Error (_name, project1, project2) -> let to_sexp (project : Dune_project.t) = - Sexp.Encoder.(pair Dune_project.Name.to_sexp Path.Source.to_sexp) + Dyn.Encoder.(pair Dune_project.Name.to_dyn Path.Source.to_dyn) (Dune_project.name project, Dune_project.root project) + |> Dyn.to_sexp in Exn.code_error "Scope.DB.create got two projects with the same name" [ "project1", to_sexp project1 diff --git a/src/stdune/dyn.ml b/src/stdune/dyn.ml index 8d53e00dbee..cca102f65f4 100644 --- a/src/stdune/dyn.ml +++ b/src/stdune/dyn.ml @@ -126,3 +126,5 @@ module Encoder = struct end let opaque = String "" + +type dyn = t diff --git a/src/stdune/dyn.mli b/src/stdune/dyn.mli index d9c00beead9..6084167e3bb 100644 --- a/src/stdune/dyn.mli +++ b/src/stdune/dyn.mli @@ -48,3 +48,5 @@ val pp : Format.formatter -> t -> unit val opaque : t val to_sexp : t Sexp.Encoder.t + +type dyn = t diff --git a/src/syntax.ml b/src/syntax.ml index ec6d9a1a67a..32079ec4346 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -23,6 +23,10 @@ module Version = struct let to_sexp t = Sexp.Atom (to_string t) + let to_dyn t = + let open Dyn.Encoder in + pair int int t + let hash = Hashtbl.hash let encode t = Dune_lang.Encoder.string (to_string t) diff --git a/src/syntax.mli b/src/syntax.mli index f215f8cdfc3..a1c7b803439 100644 --- a/src/syntax.mli +++ b/src/syntax.mli @@ -12,16 +12,18 @@ module Version : sig include Dune_lang.Conv with type t := t + val pp : t Fmt.t + + val to_sexp : t Sexp.Encoder.t + + val to_dyn : t Dyn.Encoder.t + val hash : t -> int val equal : t -> t -> bool - val to_sexp : t Sexp.Encoder.t - val to_string : t -> string - val pp : t Fmt.t - (** Whether the parser can read the data or not *) val can_read : parser_version:t -> data_version:t -> bool diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index f0395a01d9d..8c95ec34c8e 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -239,6 +239,14 @@ test-cases/dune-project-edition (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name dune-project-meta) + (deps (package dune) (source_tree test-cases/dune-project-meta)) + (action + (chdir + test-cases/dune-project-meta + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name dup-fields) (deps (package dune) (source_tree test-cases/dup-fields)) @@ -1426,6 +1434,7 @@ (alias dune-package) (alias dune-ppx-driver-system) (alias dune-project-edition) + (alias dune-project-meta) (alias dup-fields) (alias duplicate-c-cxx) (alias duplicate-c-cxx-obj) @@ -1595,6 +1604,7 @@ (alias dune-jbuild-var-case) (alias dune-package) (alias dune-project-edition) + (alias dune-project-meta) (alias dup-fields) (alias duplicate-c-cxx) (alias duplicate-c-cxx-obj) diff --git a/test/blackbox-tests/test-cases/dune-project-meta/bad-opam-file/dune-project b/test/blackbox-tests/test-cases/dune-project-meta/bad-opam-file/dune-project new file mode 100644 index 00000000000..d2fe6674a54 --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-project-meta/bad-opam-file/dune-project @@ -0,0 +1,32 @@ +(lang dune 1.10) +(name cohttp) +(source (github mirage/ocaml-cohttp)) +(license ISC) +(authors "Anil Madhavapeddy" "Rudi Grinberg") + +(opam + (tags org:mirage org:dune) + (depends + (ocaml (>= 4.06.0)) + (cohttp (>= 1.0.0))) + (package + (name cohttp) + (synopsis "An OCaml library for HTTP clients and servers") + (description "A longer description") + (depends + (alcotest :with-test) + (dune (and :build (> 1.5))) + (foo (and :dev (> 1.5) (< 2.0))) + (uri (>= 1.9.0)) + (uri (< 2.0.0)) + (fieldslib (> v0.12)) + (fieldslib (< v0.13)))) + (package + (name cohttp-async) + (synopsis "HTTP client and server for the Async library") + (description "A _really_ long description") + (depends + (cohttp (>= 1.0.2)) + (conduit-async (>= 1.0.3)) + (async (>= v0.10.0)) + (async (< v0.12))))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/dune-project-meta/bad-opam-file/foo.opam b/test/blackbox-tests/test-cases/dune-project-meta/bad-opam-file/foo.opam new file mode 100644 index 00000000000..c6381ff2d4c --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-project-meta/bad-opam-file/foo.opam @@ -0,0 +1 @@ +cannot parse me diff --git a/test/blackbox-tests/test-cases/dune-project-meta/run.t b/test/blackbox-tests/test-cases/dune-project-meta/run.t new file mode 100644 index 00000000000..726ea443b5e --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-project-meta/run.t @@ -0,0 +1,61 @@ +Test the various new fields inside the dune-project file. + +The `dune build` should work. + + $ dune build @install --root test-fields --auto-promote + Entering directory 'test-fields' + File "cohttp-async.opam", line 1, characters 0-0: + Files _build/default/cohttp-async.opam and _build/default/cohttp-async.opam.expected differ. + File "cohttp.opam", line 1, characters 0-0: + Files _build/default/cohttp.opam and _build/default/cohttp.opam.expected differ. + Promoting _build/default/cohttp-async.opam.expected to cohttp-async.opam. + Promoting _build/default/cohttp.opam.expected to cohttp.opam. + [1] + $ cat test-fields/cohttp.opam + opam-version: "2.0" + dev-repo: "git+https://github.com/mirage/ocaml-cohttp.git" + authors: ["Anil Madhavapeddy" "Rudi Grinberg"] + license: "ISC" + depends: [ + "alcotest" {with-test} + "dune" {build & > "1.5"} + "foo" {dev & > "1.5" & < "2.0"} + "uri" {>= "1.9.0"} + "uri" {< "2.0.0"} + "fieldslib" {> "v0.12"} + "fieldslib" {< "v0.13"} + "ocaml" {>= "4.06.0"} + "cohttp" {>= "1.0.0"} + ] + description: "A longer description" + synopsis: "An OCaml library for HTTP clients and servers" + $ cat test-fields/cohttp-async.opam + opam-version: "2.0" + dev-repo: "git+https://github.com/mirage/ocaml-cohttp.git" + authors: ["Anil Madhavapeddy" "Rudi Grinberg"] + license: "ISC" + depends: [ + "cohttp" {>= "1.0.2"} + "conduit-async" {>= "1.0.3"} + "async" {>= "v0.10.0"} + "async" {< "v0.12"} + "ocaml" {>= "4.06.0"} + "cohttp" {>= "1.0.0"} + ] + description: "A _really_ long description" + synopsis: "HTTP client and server for the Async library" + + +Fatal error with invalid opam file: + $ dune build @install --root bad-opam-file --auto-promote + Entering directory 'bad-opam-file' + File "foo.opam", line 1, characters 0-0: + Warning: Unable to read opam file. This package's version field willbe ignored. + Reason: File "foo.opam", line 1, characters 7-12: + Parse error + + File "_build/default/foo.opam", line 1, characters 7-12: + 1 | cannot parse me + ^^^^^ + Error: Parse error + [1] diff --git a/test/blackbox-tests/test-cases/dune-project-meta/test-fields/cohttp-async.opam b/test/blackbox-tests/test-cases/dune-project-meta/test-fields/cohttp-async.opam new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/dune-project-meta/test-fields/cohttp.opam b/test/blackbox-tests/test-cases/dune-project-meta/test-fields/cohttp.opam new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/dune-project-meta/test-fields/dune-project b/test/blackbox-tests/test-cases/dune-project-meta/test-fields/dune-project new file mode 100644 index 00000000000..b6ca7adbfa9 --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-project-meta/test-fields/dune-project @@ -0,0 +1,32 @@ +(lang dune 1.10) +(name cohttp) +(source (github mirage/ocaml-cohttp)) +(license ISC) +(authors "Anil Madhavapeddy" "Rudi Grinberg") + +(opam + (tags org:mirage org:dune) + (depends + (ocaml (>= 4.06.0)) + (cohttp (>= 1.0.0))) + (package + (name cohttp) + (synopsis "An OCaml library for HTTP clients and servers") + (description "A longer description") + (depends + (alcotest :with-test) + (dune (and :build (> 1.5))) + (foo (and :dev (> 1.5) (< 2.0))) + (uri (>= 1.9.0)) + (uri (< 2.0.0)) + (fieldslib (> v0.12)) + (fieldslib (< v0.13)))) + (package + (name cohttp-async) + (synopsis "HTTP client and server for the Async library") + (description "A _really_ long description") + (depends + (cohttp (>= 1.0.2)) + (conduit-async (>= 1.0.3)) + (async (>= v0.10.0)) + (async (< v0.12))))) diff --git a/test/blackbox-tests/test-cases/github568/lib1.opam b/test/blackbox-tests/test-cases/github568/lib1.opam index bafcac0b55f..0041f24ec3f 100644 --- a/test/blackbox-tests/test-cases/github568/lib1.opam +++ b/test/blackbox-tests/test-cases/github568/lib1.opam @@ -3,4 +3,4 @@ name: "lib1" build: [ ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] -] +] \ No newline at end of file diff --git a/vendor/boot/opamPrinter.ml b/vendor/boot/opamPrinter.ml new file mode 100644 index 00000000000..68fa14c47e7 --- /dev/null +++ b/vendor/boot/opamPrinter.ml @@ -0,0 +1,2 @@ +let opamfile _ = "" + diff --git a/vendor/opam-file-format/src/opamBaseParser.mly b/vendor/opam-file-format/src/opamBaseParser.mly index afe686abe94..7264edbded5 100644 --- a/vendor/opam-file-format/src/opamBaseParser.mly +++ b/vendor/opam-file-format/src/opamBaseParser.mly @@ -39,8 +39,8 @@ let get_pos n = %left COLON %left ATOM -%left AND %left OR +%left AND %nonassoc ENVOP %nonassoc PFXOP %left LBRACE RBRACE diff --git a/vendor/opam-file-format/src/opamLexer.mll b/vendor/opam-file-format/src/opamLexer.mll index fa24491a06a..ece6d7ec8aa 100644 --- a/vendor/opam-file-format/src/opamLexer.mll +++ b/vendor/opam-file-format/src/opamLexer.mll @@ -27,6 +27,7 @@ let relop = function | ">" -> `Gt | "<=" -> `Leq | "<" -> `Lt + | "~" -> `Geq | x -> error "%S is not a valid comparison operator" x let logop = function @@ -36,6 +37,7 @@ let logop = function let pfxop = function | "!" -> `Not + | "?" -> `Defined | x -> error "%S is not a valid prefix operator" x let env_update_op = function @@ -78,7 +80,9 @@ let buffer_rule r lb = Buffer.contents b } -let space = [' ' '\t' '\r'] +let eol = '\r'? '\n' + +let space = [' ' '\t'] let alpha = ['a'-'z' 'A'-'Z'] let digit = ['0'-'9'] @@ -87,15 +91,15 @@ let ichar = alpha | digit | ['_' '-'] let id = ichar* alpha ichar* let ident = (id | '_') ('+' (id | '_'))* (':' id)? -let relop = ('!'? '=' | [ '<' '>' ] '='?) -let pfxop = '!' +let relop = ('!'? '=' | [ '<' '>' ] '='? | '~') +let pfxop = '!' | '?' let envop_char = [ '+' ':' ] let envop = (envop_char '=' | '=' envop_char '='?) let int = ('-'? ['0'-'9' '_']+) rule token = parse | space { token lexbuf } -| '\n' { newline lexbuf; token lexbuf } +| eol { newline lexbuf; token lexbuf } | ":" { COLON } | "{" { LBRACE } | "}" { RBRACE } @@ -106,7 +110,8 @@ rule token = parse | '\"' { STRING (buffer_rule string lexbuf) } | "\"\"\"" { STRING (buffer_rule string_triple lexbuf) } | "(*" { comment 1 lexbuf; token lexbuf } -| "#" { comment_line lexbuf; token lexbuf } +| '#' [^'\n']* + { token lexbuf } | "true" { BOOL true } | "false"{ BOOL false } | int { INT (int_of_string (Lexing.lexeme lexbuf)) } @@ -122,7 +127,7 @@ rule token = parse and string b = parse | '\"' { () } -| '\n' { newline lexbuf ; +| eol { newline lexbuf ; Buffer.add_char b '\n' ; string b lexbuf } | '\\' { (match escape lexbuf with | Some c -> Buffer.add_char b c @@ -133,7 +138,7 @@ and string b = parse and string_triple b = parse | "\"\"\"" { () } -| '\n' { newline lexbuf ; +| eol { newline lexbuf ; Buffer.add_char b '\n' ; string_triple b lexbuf } | '\\' { (match escape lexbuf with | Some c -> Buffer.add_char b c @@ -143,7 +148,7 @@ and string_triple b = parse | eof { error "unterminated string" } and escape = parse -| '\n' space * +| eol space * { newline lexbuf; None } | ['\\' '\"' ''' 'n' 'r' 't' 'b' ' '] as c { Some (char_for_backslash c) } @@ -159,7 +164,3 @@ and comment n = parse | eof { error "unterminated comment" } | '\n' { newline lexbuf; comment n lexbuf } | _ { comment n lexbuf } - -and comment_line = parse -| [^'\n']* '\n' { newline lexbuf } -| [^'\n'] { () } diff --git a/vendor/opam-file-format/src/opamParser.ml b/vendor/opam-file-format/src/opamParser.ml index ea05ebc691e..6c89d894746 100644 --- a/vendor/opam-file-format/src/opamParser.ml +++ b/vendor/opam-file-format/src/opamParser.ml @@ -8,21 +8,38 @@ (* *) (**************************************************************************) -let main = OpamBaseParser.main - -let string str filename = +(** Generic glue functions *) +let parse_from_string parse_fun str filename = let lexbuf = Lexing.from_string str in lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = filename }; - OpamBaseParser.main OpamLexer.token lexbuf filename + parse_fun OpamLexer.token lexbuf -let channel ic filename = +let parse_from_channel parse_fun ic filename = let lexbuf = Lexing.from_channel ic in lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = filename }; - OpamBaseParser.main OpamLexer.token lexbuf filename + parse_fun OpamLexer.token lexbuf -let file filename = - let ic = open_in filename in - try channel ic filename +let parse_from_file parse_fun filename = + let ic = open_in_bin filename in + try + let r = parse_from_channel parse_fun ic filename in + close_in ic; + r with e -> close_in ic; raise e + +(** raw parser entry points *) +let main = OpamBaseParser.main +let value = OpamBaseParser.value + +(** file parsers *) +let main' filename lexer lexbuf = main lexer lexbuf filename +let string str filename = parse_from_string (main' filename) str filename +let channel ic filename = parse_from_channel (main' filename) ic filename +let file filename = parse_from_file (main' filename) filename + +(** value parsers *) +let value_from_string = parse_from_string value +let value_from_channel = parse_from_channel value +let value_from_file = parse_from_file value diff --git a/vendor/opam-file-format/src/opamParser.mli b/vendor/opam-file-format/src/opamParser.mli index 95204cf5042..1a5f97bb189 100644 --- a/vendor/opam-file-format/src/opamParser.mli +++ b/vendor/opam-file-format/src/opamParser.mli @@ -10,13 +10,31 @@ open OpamParserTypes -(** Raw OpamBaseParser main entry point *) +(** Raw OpamBaseParser entry points; + + Providing a custom [lexbuf] argument allows you, for example, to + set the initial lexing position. For the first argument, you may + use the {!OpamLexer.token} lexing function: + +{[ + let lexbuf = Lexing.from_string input in + lexbuf.Lexing.lex_curr_p <- current_position; + OpamParser.value OpamLexer.token lexbuf +]} +*) val main: (Lexing.lexbuf -> OpamBaseParser.token) -> Lexing.lexbuf -> file_name -> opamfile +val value: + (Lexing.lexbuf -> OpamBaseParser.token) -> + Lexing.lexbuf -> value +(** file parsers *) val string: string -> file_name -> opamfile - val channel: in_channel -> file_name -> opamfile - val file: file_name -> opamfile + +(** value parsers *) +val value_from_string: string -> file_name -> value +val value_from_channel: in_channel -> file_name -> value +val value_from_file: file_name -> value diff --git a/vendor/opam-file-format/src/opamParserTypes.mli b/vendor/opam-file-format/src/opamParserTypes.mli index 02b8a5cfd2a..0bc183acd70 100644 --- a/vendor/opam-file-format/src/opamParserTypes.mli +++ b/vendor/opam-file-format/src/opamParserTypes.mli @@ -11,7 +11,7 @@ type relop = [ `Eq | `Neq | `Geq | `Gt | `Leq | `Lt ] type logop = [ `And | `Or ] -type pfxop = [ `Not ] +type pfxop = [ `Not | `Defined ] type file_name = string diff --git a/vendor/opam-file-format/src/opamPrinter.ml b/vendor/opam-file-format/src/opamPrinter.ml index 9619896effa..2eb8d4f1274 100644 --- a/vendor/opam-file-format/src/opamPrinter.ml +++ b/vendor/opam-file-format/src/opamPrinter.ml @@ -18,6 +18,7 @@ let relop = function | `Gt -> ">" | `Leq -> "<=" | `Lt -> "<" + | `Sem -> "~" let logop = function | `And -> "&" @@ -25,6 +26,7 @@ let logop = function let pfxop = function | `Not -> "!" + | `Defined -> "?" let env_update_op = function | Eq -> "=" @@ -136,6 +138,41 @@ let items l = let opamfile f = items f.file_contents +let rec value_equals v1 v2 = match v1, v2 with + | Bool (_, b1), Bool (_, b2) -> b1 = b2 + | Int (_, i1), Int (_, i2) -> i1 = i2 + | String (_, s1), String (_, s2) -> s1 = s2 + | Relop (_, r1, va1, vb1), Relop (_, r2, va2, vb2) -> + r1 = r2 && value_equals va1 va2 && value_equals vb1 vb2 + | Prefix_relop (_, r1, v1), Prefix_relop (_, r2, v2) -> + r1 = r2 && value_equals v1 v2 + | Logop (_, l1, va1, vb1), Logop (_, l2, va2, vb2) -> + l1 = l2 && value_equals va1 va2 && value_equals vb1 vb2 + | Pfxop (_, p1, v1), Pfxop (_, p2, v2) -> + p1 = p2 && value_equals v1 v2 + | Ident (_, s1), Ident (_, s2) -> + s1 = s2 + | List (_, vl1), List (_, vl2) -> + (try List.for_all2 value_equals vl1 vl2 with Invalid_argument _ -> false) + | Group (_, vl1), Group (_, vl2) -> + (try List.for_all2 value_equals vl1 vl2 with Invalid_argument _ -> false) + | Option (_, v1, vl1), Option (_, v2, vl2) -> + value_equals v1 v2 && + (try List.for_all2 value_equals vl1 vl2 with Invalid_argument _ -> false) + | Env_binding (_, v1, op1, vx1), Env_binding (_, v2, op2, vx2) -> + op1 = op2 && value_equals v1 v2 && value_equals vx1 vx2 + | _ -> false + +let rec opamfile_item_equals i1 i2 = match i1, i2 with + | Variable (_, n1, v1), Variable (_, n2, v2) -> + n1 = n2 && value_equals v1 v2 + | Section (_, s1), Section (_, s2) -> + s1.section_kind = s2.section_kind && + s1.section_name = s2.section_name && + (try List.for_all2 opamfile_item_equals s1.section_items s2.section_items + with Invalid_argument _ -> false) + | _ -> false + module Normalise = struct (** OPAM normalised file format, for signatures: - each top-level field on a single line @@ -212,3 +249,90 @@ module Normalise = struct let opamfile f = items f.file_contents end + +module Preserved = struct + let items txt orig f = + let pos_index = + let lines_index = + let rec aux acc s = + let until = + try Some (String.index_from s (List.hd acc) '\n') + with Not_found -> None + in + match until with + | Some until -> aux (until+1 :: acc) s + | None -> Array.of_list (List.rev acc) + in + aux [0] txt + in + fun (_file, li, col) -> lines_index.(li - 1) + col + in + let get_substring start_pos rest = + let start = pos_index start_pos in + let stop = match rest with + | (Section (pos,_) | Variable (pos,_,_)) :: _ -> pos_index pos + | [] -> String.length txt + in + if stop < start then raise Exit + else String.sub txt start (stop - start) + in + let list_take f l = + let rec aux acc = function + | [] -> None, List.rev acc + | x::r -> + if f x then Some x, List.rev_append acc r + else aux (x::acc) r + in + aux [] l + in + let is_variable name = function + | Variable (_, name1, _v1) -> name = name1 + | _ -> false + in + let is_section kind name = function + | Section (_, {section_kind; section_name; _}) -> + kind = section_kind && name = section_name + | _ -> false + in + let rec aux acc f = function + | Variable (pos, name, v) :: r -> + (match list_take (is_variable name) f with + | Some (Variable (_, _, v1)), f when value_equals v v1 -> + aux (get_substring pos r :: acc) f r + | Some item, f -> + aux ((items [item] ^ "\n") :: acc) f r + | None, f -> + aux acc f r) + | Section (pos, {section_kind; section_name; _}) as sec :: r -> + (match list_take (is_section section_kind section_name) f with + | Some s, f when opamfile_item_equals sec s -> + aux (get_substring pos r :: acc) f r + | Some item, f -> + aux ((items [item] ^ "\n") :: acc) f r + | None, f -> aux acc f r) + | [] -> + let remaining = match f with + | [] -> [] + | f -> [items f ^ "\n"] + in + List.rev_append acc remaining + in + let header = [get_substring ("",1,0) orig] in + String.concat "" (aux header f orig) + + let opamfile ?format_from f = + let orig_file = match format_from with + | Some name -> name + | None -> f.file_name + in + let txt = + let b = Buffer.create 4096 in + let ic = open_in orig_file in + try while true do Buffer.add_channel b ic 4096 done; assert false with + | End_of_file -> close_in ic; Buffer.contents b + | e -> close_in ic; raise e + in + let orig = OpamParser.string txt orig_file in + items txt orig.file_contents f.file_contents + +end diff --git a/vendor/opam-file-format/src/opamPrinter.mli b/vendor/opam-file-format/src/opamPrinter.mli index 4376c35ab37..c05fd3f0a33 100644 --- a/vendor/opam-file-format/src/opamPrinter.mli +++ b/vendor/opam-file-format/src/opamPrinter.mli @@ -13,11 +13,11 @@ open OpamParserTypes -val relop: relop -> string +val relop: [< relop ] -> string -val logop: logop -> string +val logop: [< logop ] -> string -val pfxop: pfxop -> string +val pfxop: [< pfxop ] -> string val env_update_op: env_update_op -> string @@ -42,3 +42,25 @@ module Normalise : sig val opamfile : opamfile -> string end +(** {2 Format-preserving reprinter} *) + +module Preserved : sig + (** [items str orig_its its] converts [its] to string, while attempting to + preserve the layout and comments of the original [str] for unmodified + elements. The function assumes that [str] parses to the items + [orig_its]. *) + val items: string -> opamfile_item list -> opamfile_item list -> string + + (** [opamfile f] converts [f] to string, respecting the layout and comments in + the corresponding on-disk file for unmodified items. [format_from] can be + specified instead of using the filename specified in [f]. *) + val opamfile: ?format_from:file_name -> opamfile -> string +end + +(** {2 Random utility functions} *) + +(** Compares structurally, without considering file positions *) +val value_equals: value -> value -> bool + +(** Compares structurally, without considering file positions *) +val opamfile_item_equals: opamfile_item -> opamfile_item -> bool diff --git a/vendor/update-opam-file-format.sh b/vendor/update-opam-file-format.sh index b5208491622..f6d4bb0cb66 100755 --- a/vendor/update-opam-file-format.sh +++ b/vendor/update-opam-file-format.sh @@ -1,6 +1,6 @@ #!/bin/bash -version=2.0.0~beta +version=2.0.0 set -e -o pipefail @@ -16,5 +16,5 @@ SRC=$TMP/opam-file-format.$version cp -v $SRC/src/*.{ml,mli,mll,mly} opam-file-format/src -git checkout opam-file-format/src/jbuild +git checkout opam-file-format/src/dune git add -A .