From 582a2ca37cd91f4508b742118790d5b4d002d4cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Sun, 20 Oct 2019 00:00:27 +0200 Subject: [PATCH] Allow to set per-package information MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune/dune_project.ml | 120 +++----------------------------- src/dune/dune_project.mli | 24 +------ src/dune/opam_create.ml | 26 ++++--- src/dune/package.ml | 139 ++++++++++++++++++++++++++++++++++++++ src/dune/package.mli | 36 ++++++++++ 5 files changed, 200 insertions(+), 145 deletions(-) diff --git a/src/dune/dune_project.ml b/src/dune/dune_project.ml index 0e9cfc28d5e..ba138f728b1 100644 --- a/src/dune/dune_project.ml +++ b/src/dune/dune_project.ml @@ -139,37 +139,6 @@ module Project_file = struct ] 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 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 Dune_lang.Decoder in - sum - [ ( "github" - , plain_string (fun ~loc s -> - match String.split ~on:'/' s with - | [ user; repo ] -> Github (user, repo) - | _ -> - User_error.raise ~loc - [ Pp.textf "GitHub repository must be of form user/repo" ]) - ) - ; ("uri", string >>| fun s -> Url s) - ] -end - module File_key = struct type t = string @@ -188,13 +157,7 @@ type t = { name : Name.t ; root : Path.Source.t ; version : string option - ; source : Source_kind.t option - ; license : string option - ; authors : string list - ; homepage : string option - ; bug_reports : string option - ; documentation : string option - ; maintainers : string list + ; info : Package.Info.t ; packages : Package.t Package.Name.Map.t ; stanza_parser : Stanza.t list Dune_lang.Decoder.t ; project_file : Project_file.t @@ -219,19 +182,7 @@ let packages t = t.packages let version t = t.version -let source t = t.source - -let license t = t.license - -let homepage t = t.homepage - -let documentation t = t.documentation - -let bug_reports t = t.bug_reports - -let maintainers t = t.maintainers - -let authors t = t.authors +let info t = t.info let name t = t.name @@ -257,15 +208,9 @@ let to_dyn { name ; root ; version - ; source - ; license - ; authors - ; homepage - ; documentation + ; info ; project_file ; parsing_context = _ - ; bug_reports - ; maintainers ; extension_args = _ ; stanza_parser = _ ; packages @@ -284,13 +229,7 @@ let to_dyn [ ("name", Name.to_dyn name) ; ("root", Path.Source.to_dyn root) ; ("version", (option string) version) - ; ("source", (option Source_kind.to_dyn) source) - ; ("license", (option string) license) - ; ("homepage", (option string) homepage) - ; ("documentation", (option string) documentation) - ; ("bug_reports", (option string) bug_reports) - ; ("maintainers", (list string) maintainers) - ; ("authors", (list string) authors) + ; ("info", Package.Info.to_dyn info) ; ("project_file", Project_file.to_dyn project_file) ; ( "packages" , (list (pair Package.Name.to_dyn Package.to_dyn)) @@ -618,13 +557,7 @@ let infer ~dir packages = { name ; packages ; root - ; source = None - ; license = None - ; homepage = None - ; bug_reports = None - ; documentation = None - ; maintainers = [] - ; authors = [] + ; info = Package.Info.empty ; version = None ; implicit_transitive_deps ; wrapped_executables @@ -647,28 +580,8 @@ let parse ~dir ~lang ~opam_packages ~file = fields (let+ name = field_o "name" Name.decode and+ version = field_o "version" string - and+ source = - field_o "source" - (Dune_lang.Syntax.since Stanza.syntax (1, 7) >>> Source_kind.decode) + and+ info = Package.Info.decode () and+ packages = multi_field "package" (Package.decode ~dir) - and+ authors = - field ~default:[] "authors" - (Dune_lang.Syntax.since Stanza.syntax (1, 9) >>> repeat string) - and+ license = - field_o "license" - (Dune_lang.Syntax.since Stanza.syntax (1, 9) >>> string) - and+ homepage = - field_o "homepage" - (Dune_lang.Syntax.since Stanza.syntax (1, 10) >>> string) - and+ documentation = - field_o "documentation" - (Dune_lang.Syntax.since Stanza.syntax (1, 10) >>> string) - and+ bug_reports = - field_o "bug_reports" - (Dune_lang.Syntax.since Stanza.syntax (1, 10) >>> string) - and+ maintainers = - field "maintainers" ~default:[] - (Dune_lang.Syntax.since Stanza.syntax (1, 10) >>> repeat string) and+ explicit_extensions = multi_field "using" (let+ loc = loc @@ -699,18 +612,6 @@ let parse ~dir ~lang ~opam_packages ~file = field_o_b "explicit_js_mode" ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 11)) and+ format_config = Format_config.field in - let homepage = - match (homepage, source) with - | None, Some (Github (user, repo)) -> - Some (sprintf "https://github.com/%s/%s" user repo) - | s, _ -> s - in - let bug_reports = - match (bug_reports, source) with - | None, Some (Github (user, repo)) -> - Some (sprintf "https://github.com/%s/%s/issues" user repo) - | s, _ -> s - in let packages = if List.is_empty packages then Package.Name.Map.map opam_packages ~f:(fun (_loc, p) -> Lazy.force p) @@ -820,13 +721,7 @@ let parse ~dir ~lang ~opam_packages ~file = ; file_key ; root ; version - ; source - ; license - ; authors - ; homepage - ; documentation - ; bug_reports - ; maintainers + ; info ; packages ; stanza_parser ; project_file @@ -886,6 +781,7 @@ let load ~dir ~files ~infer_from_opam_files = ; conflicts = [] ; depends = [] ; depopts = [] + ; info = Package.Info.empty ; synopsis = None ; description = None ; kind = Opam diff --git a/src/dune/dune_project.mli b/src/dune/dune_project.mli index 46775317c67..79311286c41 100644 --- a/src/dune/dune_project.mli +++ b/src/dune/dune_project.mli @@ -41,16 +41,6 @@ module Project_file : sig 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 - type t module File_key : sig @@ -77,19 +67,7 @@ val name : t -> Name.t val root : t -> Path.Source.t -val source : t -> Source_kind.t option - -val license : t -> string option - -val maintainers : t -> string list - -val bug_reports : t -> string option - -val documentation : t -> string option - -val homepage : t -> string option - -val authors : t -> string list +val info : t -> Package.Info.t val stanza_parser : t -> Stanza.t list Dune_lang.Decoder.t diff --git a/src/dune/opam_create.ml b/src/dune/opam_create.ml index 5830e01d765..1b94fa4a746 100644 --- a/src/dune/opam_create.ml +++ b/src/dune/opam_create.ml @@ -41,6 +41,7 @@ let package_fields ; depends ; conflicts ; depopts + ; info = _ ; name = _ ; path = _ ; version = _ @@ -104,28 +105,33 @@ let opam_fields project (package : Package.t) = in let package_fields = package_fields package ~project in let open Opam_file.Create in + let info = + Package.Info.superpose (Dune_project.info project) package.Package.info + in let optional_fields = - [ ("bug-reports", Dune_project.bug_reports project) - ; ("homepage", Dune_project.homepage project) - ; ("doc", Dune_project.documentation project) - ; ("license", Dune_project.license project) + [ ("bug-reports", info.Package.Info.bug_reports) + ; ("homepage", info.Package.Info.homepage) + ; ("doc", info.Package.Info.documentation) + ; ("license", info.Package.Info.license) ; ("version", Dune_project.version project) ; ( "dev-repo" , Option.map - ~f:(Format.asprintf "%a" Dune_project.Source_kind.pp) - (Dune_project.source project) ) + ~f:(Format.asprintf "%a" Package.Source_kind.pp) + info.Package.Info.source ) ] |> List.filter_map ~f:(fun (k, v) -> Option.map v ~f:(fun v -> (k, string v))) in let list_fields = - [ ("maintainer", Dune_project.maintainers project) - ; ("authors", Dune_project.authors project) + [ ("maintainer", info.Package.Info.maintainers) + ; ("authors", info.Package.Info.authors) ] |> List.filter_map ~f:(fun (k, v) -> match v with - | [] -> None - | _ :: _ -> Some (k, string_list v)) + | None + | Some [] -> + None + | Some (_ :: _ as v) -> Some (k, string_list v)) in let fields = [ ("opam-version", string "2.0"); ("build", default_build_command project) ] diff --git a/src/dune/package.ml b/src/dune/package.ml index ff3d15e4a82..eeb4bb63ebe 100644 --- a/src/dune/package.ml +++ b/src/dune/package.ml @@ -234,6 +234,140 @@ module Kind = struct | Opam -> constr "Opam" [] 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 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 Dune_lang.Decoder in + sum + [ ( "github" + , plain_string (fun ~loc s -> + match String.split ~on:'/' s with + | [ user; repo ] -> Github (user, repo) + | _ -> + User_error.raise ~loc + [ Pp.textf "GitHub repository must be of form user/repo" ]) + ) + ; ("uri", string >>| fun s -> Url s) + ] +end + +module Info = struct + type t = + { source : Source_kind.t option + ; license : string option + ; authors : string list option + ; homepage : string option + ; bug_reports : string option + ; documentation : string option + ; maintainers : string list option + } + + let empty = + { source = None + ; license = None + ; authors = None + ; homepage = None + ; bug_reports = None + ; documentation = None + ; maintainers = None + } + + let to_dyn + { source + ; license + ; authors + ; homepage + ; bug_reports + ; documentation + ; maintainers + } = + let open Dyn.Encoder in + record + [ ("source", (option Source_kind.to_dyn) source) + ; ("license", (option string) license) + ; ("homepage", (option string) homepage) + ; ("documentation", (option string) documentation) + ; ("bug_reports", (option string) bug_reports) + ; ("maintainers", option (list string) maintainers) + ; ("authors", option (list string) authors) + ] + + let decode ?since () = + let open Dune_lang.Decoder in + let v default = Option.value since ~default in + let+ source = + field_o "source" + (Dune_lang.Syntax.since Stanza.syntax (v (1, 7)) >>> Source_kind.decode) + and+ authors = + field_o "authors" + (Dune_lang.Syntax.since Stanza.syntax (v (1, 9)) >>> repeat string) + and+ license = + field_o "license" + (Dune_lang.Syntax.since Stanza.syntax (v (1, 9)) >>> string) + and+ homepage = + field_o "homepage" + (Dune_lang.Syntax.since Stanza.syntax (v (1, 10)) >>> string) + and+ documentation = + field_o "documentation" + (Dune_lang.Syntax.since Stanza.syntax (v (1, 10)) >>> string) + and+ bug_reports = + field_o "bug_reports" + (Dune_lang.Syntax.since Stanza.syntax (v (1, 10)) >>> string) + and+ maintainers = + field_o "maintainers" + (Dune_lang.Syntax.since Stanza.syntax (v (1, 10)) >>> repeat string) + in + let homepage = + match (homepage, source) with + | None, Some (Github (user, repo)) -> + Some (sprintf "https://github.com/%s/%s" user repo) + | s, _ -> s + in + let bug_reports = + match (bug_reports, source) with + | None, Some (Github (user, repo)) -> + Some (sprintf "https://github.com/%s/%s/issues" user repo) + | s, _ -> s + in + { source + ; authors + ; license + ; homepage + ; documentation + ; bug_reports + ; maintainers + } + + let superpose t1 t2 = + let f o1 o2 = + match o2 with + | Some _ as x -> x + | None -> o1 + in + { source = f t1.source t2.source + ; authors = f t1.authors t2.authors + ; license = f t1.license t2.license + ; homepage = f t1.homepage t2.homepage + ; documentation = f t1.documentation t2.documentation + ; bug_reports = f t1.bug_reports t2.bug_reports + ; maintainers = f t1.maintainers t2.maintainers + } +end + type t = { name : Name.t ; loc : Loc.t @@ -242,6 +376,7 @@ type t = ; depends : Dependency.t list ; conflicts : Dependency.t list ; depopts : Dependency.t list + ; info : Info.t ; path : Path.Source.t ; version : string option ; kind : Kind.t @@ -264,6 +399,7 @@ let decode ~dir = and+ depends = field ~default:[] "depends" (repeat Dependency.decode) and+ conflicts = field ~default:[] "conflicts" (repeat Dependency.decode) and+ depopts = field ~default:[] "depopts" (repeat Dependency.decode) + and+ info = Info.decode ~since:(2, 0) () and+ tags = field "tags" (enter (repeat string)) ~default:[] and+ deprecated_package_names = field ~default:[] "deprecated_package_names" @@ -291,6 +427,7 @@ let decode ~dir = ; depends ; conflicts ; depopts + ; info ; path = dir ; version = None ; kind = Dune false @@ -307,6 +444,7 @@ let to_dyn ; depends ; conflicts ; depopts + ; info ; kind ; tags ; loc = _ @@ -321,6 +459,7 @@ let to_dyn ; ("depends", list Dependency.to_dyn depends) ; ("conflicts", list Dependency.to_dyn conflicts) ; ("depopts", list Dependency.to_dyn depopts) + ; ("info", Info.to_dyn info) ; ("kind", Kind.to_dyn kind) ; ("tags", list string tags) ; ("version", option string version) diff --git a/src/dune/package.mli b/src/dune/package.mli index e54a74595bd..2778274fc38 100644 --- a/src/dune/package.mli +++ b/src/dune/package.mli @@ -69,6 +69,41 @@ module Kind : sig | Opam end +module Source_kind : sig + type t = + | Github of string * string + | Url of string + + val to_dyn : t Dyn.Encoder.t + + val pp : Format.formatter -> t -> unit + + val decode : t Dune_lang.Decoder.t +end + +module Info : sig + type t = + { source : Source_kind.t option + ; license : string option + ; authors : string list option + ; homepage : string option + ; bug_reports : string option + ; documentation : string option + ; maintainers : string list option + } + + val empty : t + + val to_dyn : t Dyn.Encoder.t + + val decode : + ?since:Dune_lang.Syntax.Version.t + -> unit + -> t Dune_lang.Decoder.fields_parser + + val superpose : t -> t -> t +end + type t = { name : Name.t ; loc : Loc.t @@ -77,6 +112,7 @@ type t = ; depends : Dependency.t list ; conflicts : Dependency.t list ; depopts : Dependency.t list + ; info : Info.t ; path : Path.Source.t ; version : string option ; kind : Kind.t