From 437211f74f8fd9c11fb17cd0d1cd7a06819157d9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Thu, 25 Jan 2018 19:07:46 +0000 Subject: [PATCH] Expose the promote mode (#437) --- CHANGES.md | 12 ++++++++ bin/main.ml | 66 ++++++++++++++++++++++++++-------------- doc/jbuild.rst | 61 +++++++++++++++++++++++++++++++++---- src/jbuild.ml | 74 +++++++++++++++++++++++++++++++++++++-------- src/jbuild_load.ml | 31 ++++++++++++++----- src/jbuild_load.mli | 6 +++- src/main.ml | 3 +- src/main.mli | 1 + 8 files changed, 202 insertions(+), 52 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 3c0f4f85ecf..a7d08d7408d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -70,6 +70,18 @@ - Use /Fo instead of -o when invoking the Microsoft C compiler to eliminate deprecation warning when compiling C++ sources (#354) +- Add a mode field to `rule` stanzas: + + `(mode standard)` is the default + + `(mode fallback)` replaces `(fallback)` + + `(mode promote)` means that targets are copied to the source tree + after the rule has completed + + `(mode promote-until-clean)` is the same as `(mode promote)` except + that `jbuilder clean` deletes the files copied to the source tree. + (#437) + +- Add a flag `--ignore-promoted-rules` to make jbuilder ignore rules + with `(mode promote)`. `-p` implies `--ignore-promoted-rules` (#437) + - Display a warning for invalid lines in jbuild-ignore (#389) 1.0+beta16 (05/11/2017) diff --git a/bin/main.ml b/bin/main.ml index b8c529da191..3e5ef9953de 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -10,23 +10,24 @@ let (>>=) = Future.(>>=) let (>>|) = Future.(>>|) type common = - { concurrency : int - ; debug_dep_path : bool - ; debug_findlib : bool - ; debug_backtraces : bool - ; dev_mode : bool - ; verbose : bool - ; workspace_file : string option - ; root : string - ; target_prefix : string - ; only_packages : String_set.t option - ; capture_outputs : bool - ; x : string option - ; diff_command : string option - ; auto_promote : bool - ; force : bool + { concurrency : int + ; debug_dep_path : bool + ; debug_findlib : bool + ; debug_backtraces : bool + ; dev_mode : bool + ; verbose : bool + ; workspace_file : string option + ; root : string + ; target_prefix : string + ; only_packages : String_set.t option + ; capture_outputs : bool + ; x : string option + ; diff_command : string option + ; auto_promote : bool + ; force : bool + ; ignore_promoted_rules : bool ; (* Original arguments for the external-lib-deps hint *) - orig_args : string list + orig_args : string list } let prefix_target common s = common.target_prefix ^ s @@ -82,6 +83,7 @@ module Main = struct ?only_packages:common.only_packages ?filter_out_optional_stanzas_with_missing_deps ?x:common.x + ~ignore_promoted_rules:common.ignore_promoted_rules () end @@ -176,7 +178,10 @@ let common = diff_command auto_promote force - (root, only_packages, orig) + (root, + only_packages, + ignore_promoted_rules, + orig) x = let root, to_cwd = @@ -205,6 +210,7 @@ let common = ; diff_command ; auto_promote ; force + ; ignore_promoted_rules ; only_packages = Option.map only_packages ~f:(fun s -> String_set.of_list (String.split s ~on:',')) @@ -309,6 +315,12 @@ let common = ~doc:"Force actions associated to aliases to be re-executed even if their dependencies haven't changed.") in + let ignore_promoted_rules = + Arg.(value + & flag + & info ["ignore-promoted-rules"] ~docs + ~doc:"Ignore rules with (mode promote)") + in let for_release = "for-release-of-packages" in let frop = Arg.(value @@ -320,32 +332,40 @@ let common = packages as well as getting reproducible builds.|}) in let root_and_only_packages = - let merge root only_packages release = + let merge root only_packages ignore_promoted_rules release = let fail opt = `Error (true, sprintf "Cannot use -p/--%s and %s simultaneously" for_release opt) in - match release, root, only_packages with - | Some _, Some _, _ -> fail "--root" - | Some _, _, Some _ -> fail "--only-packages" - | Some pkgs, None, None -> + match release, root, only_packages, ignore_promoted_rules with + | Some _, Some _, _, _ -> fail "--root" + | Some _, _, Some _, _ -> fail "--only-packages" + | Some _, _, _, true -> fail "--ignore-promoted-rules" + | Some pkgs, None, None, false -> `Ok (Some ".", Some pkgs, + true, ["-p"; pkgs] ) - | None, _, _ -> + | None, _, _, _ -> `Ok (root, only_packages, + ignore_promoted_rules, List.concat [ dump_opt "--root" root ; dump_opt "--only-packages" only_packages + ; if ignore_promoted_rules then + ["--ignore-promoted-rules"] + else + [] ]) in Term.(ret (const merge $ root $ only_packages + $ ignore_promoted_rules $ frop)) in let x = diff --git a/doc/jbuild.rst b/doc/jbuild.rst index c6984bda209..1b3b161a870 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -294,12 +294,10 @@ See the `User actions`_ section for more details. - ``(deps ())`` to specify the dependencies of the rule. See the `Dependency specification`_ section for more details. -- ``(fallback)`` to specify that this is a fallback rule. A fallback - rule means that if the targets are already present in the source - tree, jbuilder will ignore the rule. It is an error if only a subset - of the targets are present in the tree. The common use of fallback - rules is to generate default configuration files that may be - generated by a configure script. +- ``(mode )`` to specify how to handle the targets, see `mode`_ + for details + +- ``(fallback)`` is deprecated and is the same as ``(mode fallback)`` - ``(locks ())`` specify that the action must be run while holding the following locks. See the `Locks`_ section for more details. @@ -308,6 +306,41 @@ Note that contrary to makefiles or other build systems, user rules currently don't support patterns, such as a rule to produce ``%.y`` from ``%.x`` for any given ``%``. This might be supported in the future. +modes +~~~~~ + +By default, the target of a rule must not exist in the source tree and +Jbuilder will error out when this is the case. + +However, it is possible to change this behavior using the ``mode`` +field. The following modes are available: + +- ``standard``, this is the standard mode + +- ``fallback``, in this mode, when the targets are already present in + the source tree, jbuilder will ignore the rule. It is an error if + only a subset of the targets are present in the tree. The common use + of fallback rules is to generate default configuration files that + may be generated by a configure script. + +- ``promote``, in this mode, the files in the source tree will be + ignored. Once the rule has been executed, the targets will be copied + back to the source tree + +- ``promote-until-clean`` is the same as ``promote`` except than + ``jbuilder clean`` will remove the promoted files from the source + tree + + +There are two use cases for promote rules. The first one is when the +generated code is easier to review than the generator, so it's easier +to commit the generated code and review it. The second is to cut down +dependencies during releases: by passing ``--ignore-promoted-rules`` +to jbuilder, rules will ``(mode promote)`` will be ignored and the +source files will be used instead. The +``-p/--for-release-of-packages`` flag implies +``--ignore-promote-rules``. + inferred rules ~~~~~~~~~~~~~~ @@ -359,6 +392,14 @@ ocamllex (deps (.mll)) (action (chdir ${ROOT} (run ${bin:ocamllex} -q -o ${<}))))) +To use a different rule mode, use the long form: + +.. code:: scheme + + (ocamllex + ((modules ()) + (mode ))) + ocamlyacc --------- @@ -371,6 +412,14 @@ ocamlyacc (deps (.mly)) (action (chdir ${ROOT} (run ${bin:ocamlyacc} ${<}))))) +To use a different rule mode, use the long form: + +.. code:: scheme + + (ocamlyacc + ((modules ()) + (mode ))) + menhir ------ diff --git a/src/jbuild.ml b/src/jbuild.ml index fe96abc6a8d..fab86743986 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -738,6 +738,16 @@ module Rule = struct | Promote_but_delete_on_clean | Not_a_rule_stanza | Ignore_source_files + + let t = + enum + [ "standard" , Standard + ; "fallback" , Fallback + ; "promote" , Promote + ; "promote-unil-clean", Promote_but_delete_on_clean + ] + + let field = field "mode" t ~default:Standard end type t = @@ -765,19 +775,51 @@ module Rule = struct field "deps" (list Dep_conf.t) ~default:[] >>= fun deps -> field "action" Action.Unexpanded.t >>= fun action -> field "locks" (list String_with_vars.t) ~default:[] >>= fun locks -> - field_b "fallback" >>= fun fallback -> + map_validate + (field_b "fallback" >>= fun fallback -> + field_o "mode" Mode.t >>= fun mode -> + return (fallback, mode)) + ~f:(function + | true, Some _ -> + Error "Cannot use both (fallback) and (mode ...) at the same time.\n\ + (fallback) is the same as (mode fallback), \ + please use the latter in new code." + | false, Some mode -> Ok mode + | true, None -> Ok Fallback + | false, None -> Ok Standard) + >>= fun mode -> return { targets = Static targets ; deps ; action - ; mode = if fallback then Fallback else Standard + ; mode ; locks ; loc = Loc.none }) sexp - let ocamllex_v1 loc names = + type lex_or_yacc = + { modules : string list + ; mode : Mode.t + } + + let ocamllex_v1 sexp = + match sexp with + | List (_, List (_, _) :: _) -> + record + (field "modules" (list string) >>= fun modules -> + Mode.field >>= fun mode -> + return { modules; mode }) + sexp + | _ -> + { modules = list string sexp + ; mode = Standard + } + + let ocamlyacc_v1 = ocamllex_v1 + + let ocamllex_to_rule loc { modules; mode } = let module S = String_with_vars in - List.map names ~f:(fun name -> + List.map modules ~f:(fun name -> let src = name ^ ".mll" in let dst = name ^ ".ml" in { targets = Static [dst] @@ -791,14 +833,14 @@ module Rule = struct ; S.virt_var __POS__ "@" ; S.virt_var __POS__"<" ])) - ; mode = Not_a_rule_stanza + ; mode ; locks = [] ; loc }) - let ocamlyacc_v1 loc names = + let ocamlyacc_to_rule loc { modules; mode } = let module S = String_with_vars in - List.map names ~f:(fun name -> + List.map modules ~f:(fun name -> let src = name ^ ".mly" in { targets = Static [name ^ ".ml"; name ^ ".mli"] ; deps = [File (S.virt_text __POS__ src)] @@ -807,7 +849,7 @@ module Rule = struct (S.virt_var __POS__ "ROOT", Run (S.virt_text __POS__ "ocamlyacc", [S.virt_var __POS__ "<"])) - ; mode = Not_a_rule_stanza + ; mode ; locks = [] ; loc }) @@ -818,6 +860,7 @@ module Menhir = struct { merge_into : string option ; flags : String_with_vars.t list ; modules : string list + ; mode : Rule.Mode.t } let v1 = @@ -825,10 +868,12 @@ module Menhir = struct (field_o "merge_into" string >>= fun merge_into -> field "flags" (list String_with_vars.t) ~default:[] >>= fun flags -> field "modules" (list string) >>= fun modules -> + Rule.Mode.field >>= fun mode -> return { merge_into ; flags ; modules + ; mode } ) @@ -847,7 +892,7 @@ module Menhir = struct (S.virt_var __POS__ "ROOT", Run (S.virt_text __POS__ "menhir", t.flags @ [S.virt_var __POS__ "<"])) - ; mode = Not_a_rule_stanza + ; mode = t.mode ; locks = [] ; loc }) @@ -867,7 +912,7 @@ module Menhir = struct ; t.flags ; [ S.virt_var __POS__ "^" ] ])) - ; mode = Not_a_rule_stanza + ; mode = t.mode ; locks = [] ; loc }] @@ -962,9 +1007,12 @@ module Stanzas = struct ; cstr "executable" (Executables.v1_single pkgs @> nil) execs ; cstr "executables" (Executables.v1_multi pkgs @> nil) execs ; cstr_loc "rule" (Rule.v1 @> nil) (fun loc x -> [Rule { x with loc }]) - ; cstr_loc "ocamllex" (list string @> nil) (fun loc x -> rules (Rule.ocamllex_v1 loc x)) - ; cstr_loc "ocamlyacc" (list string @> nil) (fun loc x -> rules (Rule.ocamlyacc_v1 loc x)) - ; cstr_loc "menhir" (Menhir.v1 @> nil) (fun loc x -> rules (Menhir.v1_to_rule loc x)) + ; cstr_loc "ocamllex" (Rule.ocamllex_v1 @> nil) + (fun loc x -> rules (Rule.ocamllex_to_rule loc x)) + ; cstr_loc "ocamlyacc" (Rule.ocamlyacc_v1 @> nil) + (fun loc x -> rules (Rule.ocamlyacc_to_rule loc x)) + ; cstr_loc "menhir" (Menhir.v1 @> nil) + (fun loc x -> rules (Menhir.v1_to_rule loc x)) ; cstr "install" (Install_conf.v1 pkgs @> nil) (fun x -> [Install x]) ; cstr "alias" (Alias_conf.v1 pkgs @> nil) (fun x -> [Alias x]) ; cstr "copy_files" (Copy_files.v1 @> nil) diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index a2de2f62f7f..0d77bb2d4e1 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -1,6 +1,14 @@ open Import open Jbuild +let filter_stanzas ~ignore_promoted_rules stanzas = + if ignore_promoted_rules then + List.filter stanzas ~f:(function + | Stanza.Rule { mode = Promote; _ } -> false + | _ -> true) + else + stanzas + module Jbuilds = struct type script = { dir : Path.t @@ -11,7 +19,10 @@ module Jbuilds = struct | Literal of (Path.t * Scope.t * Stanza.t list) | Script of script - type t = one list + type t = + { jbuilds : one list + ; ignore_promoted_rules : bool + } let generated_jbuilds_dir = Path.(relative root) "_build/.jbuilds" @@ -89,7 +100,7 @@ end plugin plugin_contents); extract_requires ~fname:plugin plugin_contents - let eval jbuilds ~(context : Context.t) = + let eval { jbuilds; ignore_promoted_rules } ~(context : Context.t) = let open Future in List.map jbuilds ~f:(function | Literal x -> return x @@ -146,7 +157,9 @@ end Did you forgot to call [Jbuild_plugin.V*.send]?" (Path.to_string file); let sexps = Sexp.load ~fname:(Path.to_string generated_jbuild) ~mode:Many in - return (dir, scope, Stanzas.parse scope sexps ~file:generated_jbuild)) + return (dir, scope, + Stanzas.parse scope sexps ~file:generated_jbuild + |> filter_stanzas ~ignore_promoted_rules)) |> Future.all end @@ -157,15 +170,17 @@ type conf = ; scopes : Scope.t list } -let load ~dir ~scope = +let load ~dir ~scope ~ignore_promoted_rules = let file = Path.relative dir "jbuild" in match Sexp.load_many_or_ocaml_script (Path.to_string file) with | Sexps sexps -> - Jbuilds.Literal (dir, scope, Stanzas.parse scope sexps ~file) + Jbuilds.Literal (dir, scope, + Stanzas.parse scope sexps ~file + |> filter_stanzas ~ignore_promoted_rules) | Ocaml_script -> Script { dir; scope } -let load ?extra_ignored_subtrees () = +let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () = let ftree = File_tree.load Path.root ?extra_ignored_subtrees in let packages = File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[] ~f:(fun dir pkgs -> @@ -221,7 +236,7 @@ let load ?extra_ignored_subtrees () = let scope = Path.Map.find_default path scopes ~default:scope in let jbuilds = if String_set.mem "jbuild" files then - let jbuild = load ~dir:path ~scope in + let jbuild = load ~dir:path ~scope ~ignore_promoted_rules in jbuild :: jbuilds else jbuilds @@ -233,7 +248,7 @@ let load ?extra_ignored_subtrees () = in let jbuilds = walk (File_tree.root ftree) [] Scope.empty in { file_tree = ftree - ; jbuilds + ; jbuilds = { jbuilds; ignore_promoted_rules } ; packages ; scopes = Path.Map.values scopes } diff --git a/src/jbuild_load.mli b/src/jbuild_load.mli index d88915ffc94..f4376f08aec 100644 --- a/src/jbuild_load.mli +++ b/src/jbuild_load.mli @@ -14,4 +14,8 @@ type conf = ; scopes : Scope.t list } -val load : ?extra_ignored_subtrees:Path.Set.t -> unit -> conf +val load + : ?extra_ignored_subtrees:Path.Set.t + -> ?ignore_promoted_rules:bool + -> unit + -> conf diff --git a/src/main.ml b/src/main.ml index 8fe97d1b91c..693257b5cd8 100644 --- a/src/main.ml +++ b/src/main.ml @@ -22,8 +22,9 @@ let setup ?(log=Log.no_log) ?only_packages ?extra_ignored_subtrees ?x + ?ignore_promoted_rules () = - let conf = Jbuild_load.load ?extra_ignored_subtrees () in + let conf = Jbuild_load.load ?extra_ignored_subtrees ?ignore_promoted_rules () in Option.iter only_packages ~f:(fun set -> String_set.iter set ~f:(fun pkg -> if not (String_map.mem pkg conf.packages) then diff --git a/src/main.mli b/src/main.mli index 5e6c9c7c997..5c38fb36a2b 100644 --- a/src/main.mli +++ b/src/main.mli @@ -22,6 +22,7 @@ val setup -> ?workspace_file:string -> ?only_packages:String_set.t -> ?x:string + -> ?ignore_promoted_rules:bool -> unit -> setup Future.t val external_lib_deps