diff --git a/CHANGES.md b/CHANGES.md index a322404144e2..9cb1fcd4e9a3 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 8cb0e32880db..52a40faeb024 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 000000000000..c1c3edabaeb3 --- /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 728fd8a37eb9..8004f78da1a8 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 f7d9d45aee5f..6543755df12e 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 e41b3113508b..e01384176bc7 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 87b0c72a65c1..e9806ca7fc82 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 88f42a181ebf..93f80782ffa8 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 39bfddafc261..4c2ee29c0f44 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 4c01772e6931..2e03ba646b8a 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 8704d1d1992a..31d0908585a7 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 eca8d3398692..a37db27acde3 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 1ff8bcdb5151..c896755b1f85 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 000000000000..2131b435de76 --- /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 000000000000..e43957487426 --- /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 000000000000..13f97718cc36 --- /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 ad91d57b6f2c..2c953afdaf1f 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 7846a299ddd0..a506bfcb771c 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 9f632dc1435f..4ed4e6e8e6a5 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 8d53e00dbeea..cca102f65f4e 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 d9c00beead97..6084167e3bb2 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 ec6d9a1a67a2..32079ec4346d 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 f215f8cdfc3b..a1c7b8034390 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 f0395a01d9da..8c95ec34c8eb 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 000000000000..d2fe6674a54a --- /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 000000000000..c6381ff2d4c5 --- /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 000000000000..726ea443b5e9 --- /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 000000000000..e69de29bb2d1 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 000000000000..e69de29bb2d1 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 000000000000..b6ca7adbfa96 --- /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 bafcac0b55fd..0041f24ec3f5 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 000000000000..68fa14c47e74 --- /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 afe686abe940..7264edbded5e 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 fa24491a06a1..ece6d7ec8aa7 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 ea05ebc691ef..6c89d894746d 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 95204cf50422..1a5f97bb1894 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 02b8a5cfd2a2..0bc183acd70c 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 9619896effaf..2eb8d4f12748 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 4376c35ab37f..c05fd3f0a33f 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 b52084916221..f6d4bb0cb663 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 .