diff --git a/CHANGES.md b/CHANGES.md index 558ffb36..21df2d87 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -93,6 +93,8 @@ next - Make `dev` the default build profile (#920, @diml) +- Version `dune-workspace` and `~/.config/dune/config` files (#..., @diml) + 1.0+beta20 (10/04/2018) ----------------------- diff --git a/bin/main.ml b/bin/main.ml index ce149c07..8b6c3ca9 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -579,8 +579,10 @@ let installed_libraries = let env = Main.setup_env ~capture_outputs:common.capture_outputs in Scheduler.go ~log:(Log.create common) ~common (Context.create - (Default { targets = [Native] - ; profile = Config.default_build_profile }) + (Default { loc = Loc.of_pos __POS__ + ; targets = [Native] + ; profile = Config.default_build_profile + }) ~env >>= fun ctxs -> let ctx = List.hd ctxs in @@ -1424,8 +1426,11 @@ module Help = struct Unix systems and $(b,Local Settings/dune/config) in the User home directory on Windows. However, it is possible to specify an alternative configuration file with the $(b,--config-file) option.|} - ; `P {|This file must be written in S-expression syntax and be composed of - a list of stanzas. The following sections describe the stanzas available.|} + ; `P {|The first line of the file must be of the form (lang dune X.Y) \ + where X.Y is the version of the dune language used in the file.|} + ; `P {|The rest of the file must be written in S-expression syntax and be \ + composed of a list of stanzas. The following sections describe \ + the stanzas available.|} ; `S "DISPLAY MODES" ; `P {|Syntax: $(b,\(display MODE\))|} ; `P {|This stanza controls how Dune reports what it is doing to the user. diff --git a/doc/advanced-topics.rst b/doc/advanced-topics.rst index d29d975f..0094deb5 100644 --- a/doc/advanced-topics.rst +++ b/doc/advanced-topics.rst @@ -112,16 +112,16 @@ building executables needed by the other contexts. With such a setup, calling ``jbuilder build @install`` will build all the packages three times. -Note that instead of writing a ``jbuild-workspace`` file, you can also -use the ``-x`` command line option. Passing ``-x foo`` to ``jbuilder`` -without having a ``jbuild-workspace`` file is the same as writing the -following ``jbuild-workspace`` file: +Note that instead of writing a ``dune-workspace`` file, you can also +use the ``-x`` command line option. Passing ``-x foo`` to ``dune`` +without having a ``dune-workspace`` file is the same as writing the +following ``dune-workspace`` file: .. code:: scheme (context (default (targets (foo)))) -If you have a ``jbuild-workspace`` and pass a ``-x foo`` option, +If you have a ``dune-workspace`` and pass a ``-x foo`` option, ``foo`` will be added as target of all context stanzas. How does it work? diff --git a/doc/terminology.rst b/doc/terminology.rst index 0afb5801..7cac56d7 100644 --- a/doc/terminology.rst +++ b/doc/terminology.rst @@ -38,7 +38,7 @@ Terminology specific configuration from the user, there is always a ``default`` build context, which corresponds to the environment in which Jbuilder is executed. Build contexts can be specified by writing a - :ref:`jbuild-workspace` file + :ref:`dune-workspace` file - **build context root**: the root of a build context named ``foo`` is ``/_build/`` diff --git a/doc/usage.rst b/doc/usage.rst index 4a5a9a9e..c12ba0ac 100644 --- a/doc/usage.rst +++ b/doc/usage.rst @@ -9,71 +9,51 @@ This section describe usage of Jbuilder from the shell. Finding the root ================ -.. _jbuild-workspace: +.. _dune-workspace: -jbuild-workspace ----------------- +dune-workspace +-------------- The root of the current workspace is determined by looking up a -``jbuild-workspace`` or ``dune-project`` file in the current directory +``dune-workspace`` or ``dune-project`` file in the current directory and parent directories. -``jbuilder`` prints out the root when starting if it is not the -current directory: +``dune`` prints out the root when starting if it is not the current +directory: .. code:: bash - $ jbuilder runtest - Entering directory '/home/jdimino/code/jbuilder' + $ dune runtest + Entering directory '/home/jdimino/code/dune' ... More precisely, it will choose the outermost ancestor directory containing a -``jbuild-workspace`` file as root. For instance if you are in +``dune-workspace`` file as root. For instance if you are in ``/home/me/code/myproject/src``, then jbuilder will look for all these files in order: -- ``/jbuild-workspace`` -- ``/home/jbuild-workspace`` -- ``/home/me/jbuild-workspace`` -- ``/home/me/code/jbuild-workspace`` -- ``/home/me/code/myproject/jbuild-workspace`` -- ``/home/me/code/myproject/src/jbuild-workspace`` +- ``/dune-workspace`` +- ``/home/dune-workspace`` +- ``/home/me/dune-workspace`` +- ``/home/me/code/dune-workspace`` +- ``/home/me/code/myproject/dune-workspace`` +- ``/home/me/code/myproject/src/dune-workspace`` The first entry to match in this list will determine the root. In practice this means that if you nest your workspaces, Jbuilder will always use the outermost one. -In addition to determining the root, ``jbuilder`` will read this file as to -setup the configuration of the workspace unless the ``--workspace`` command line -option is used. See the section `Workspace configuration`_ for the syntax of -this file. - -jbuild-workspace\* ------------------- - -The following is deprecated and no longer works with ``dune``. - -In addition to the previous rule, if no ``jbuild-workspace`` file is found, -``jbuilder`` will look for any file whose name starts with ``jbuild-workspace`` -in ancestor directories. For instance ``jbuild-workspace.dev``. If such a file -is found, it will mark the root of the workspace. ``jbuilder`` will however not -read its contents. - -The rationale for this rule is that it is good practice to have a -``jbuild-workspace.dev`` file at the root of your project. - -For quick experiments, simply do this to mark the root: - -.. code:: bash - - $ touch jbuild-workspace.here +In addition to determining the root, ``dune`` will read this file as +to setup the configuration of the workspace unless the ``--workspace`` +command line option is used. See the section `Workspace +configuration`_ for the syntax of this file. Current directory ----------------- -If none of the two previous rules appies, i.e. no ancestor directories -have a file whose name starts with ``jbuild-workspace``, then the -current directory will be used as root. +If the previous rule doesn't apply, i.e. no ancestor directory has a +file named ``dune-workspace``, then the current directory will be used +as root. Forcing the root (for scripts) ------------------------------ @@ -319,47 +299,49 @@ Workspace configuration ======================= By default, a workspace has only one build context named ``default`` -which correspond to the environment in which ``jbuilder`` is run. You -can define more contexts by writing a ``jbuild-workspace`` file. +which correspond to the environment in which ``dune`` is run. You can +define more contexts by writing a ``dune-workspace`` file. -You can point ``jbuilder`` to an explicit ``jbuild-workspace`` file with +You can point ``dune`` to an explicit ``dune-workspace`` file with the ``--workspace`` option. For instance it is good practice to write a -``jbuild-workspace.dev`` in your project with all the version of OCaml +``dune-workspace.dev`` in your project with all the version of OCaml your projects support. This way developers can tests that the code builds with all version of OCaml by simply running: .. code:: bash - $ jbuilder build --workspace jbuild-workspace.dev @install @runtest + $ dune build --workspace dune-workspace.dev @install @runtest -jbuild-workspace ----------------- +dune-workspace +-------------- -The ``jbuild-workspace`` file uses the S-expression syntax. This is what -a typical ``jbuild-workspace`` file looks like: +The ``dune-workspace`` file uses the S-expression syntax. This is what +a typical ``dune-workspace`` file looks like: .. code:: scheme + (lang dune 1.0) (context (opam (switch 4.02.3))) (context (opam (switch 4.03.0))) (context (opam (switch 4.04.0))) The rest of this section describe the stanzas available. -Note that an empty ``jbuild-workspace`` file is interpreted the same +Note that an empty ``dune-workspace`` file is interpreted the same as one containing exactly: .. code:: scheme + (lang dune 1.0) (context default) -This allows you to use an empty ``jbuild-workspace`` file to mark +This allows you to use an empty ``dune-workspace`` file to mark the root of your project. profile ~~~~~~~ -The build profile can be selected in the ``jbuild-workspace`` file by +The build profile can be selected in the ``dune-workspace`` file by write a ``(profile ...)`` stanza. For instance: .. code:: scheme @@ -404,22 +386,13 @@ for more information. Merlin reads compilation artifacts and it can only read the compilation artifacts of a single context. Usually, you should use the artifacts from the ``default`` context, and if you have the -``(context default)`` stanza in your ``jbuild-workspace`` file, that +``(context default)`` stanza in your ``dune-workspace`` file, that is the one Jbuilder will use. For rare cases where this is not what you want, you can force Jbuilder to use a different build contexts for merlin by adding the field ``(merlin)`` to this context. -Note that the following syntax is still accepted but is deprecated: - -.. code:: scheme - - (context ((switch ) - )) - -it is interpreted the same as ``(context (opam (switch ...) ...))``. - Building JavaScript with js_of_ocaml ==================================== diff --git a/dune-workspace.dev b/dune-workspace.dev index 90cfb5c4..1c68f94c 100644 --- a/dune-workspace.dev +++ b/dune-workspace.dev @@ -1,3 +1,5 @@ +(lang dune 1.0) + ;; This file is used by `make all-supported-ocaml-versions` (context (opam (switch 4.02.3))) (context (opam (switch 4.03.0))) diff --git a/src/config.ml b/src/config.ml index 28d4d45e..bfe88e2d 100644 --- a/src/config.ml +++ b/src/config.ml @@ -29,7 +29,11 @@ let default_build_profile = | Dune -> "dev" | Jbuilder -> "release" -open Sexp.Of_sexp +open Stanza.Of_sexp + +(* the configuration file use the same version numbers as dune-project + files for simplicity *) +let syntax = Stanza.syntax module Display = struct type t = @@ -106,21 +110,35 @@ let default = } let t = - record - (field "display" Display.t ~default:default.display - >>= fun display -> - field "jobs" Concurrency.t ~default:default.concurrency - >>= fun concurrency -> - return { display - ; concurrency - }) + field "display" Display.t ~default:default.display + >>= fun display -> + field "jobs" Concurrency.t ~default:default.concurrency + >>= fun concurrency -> + return { display + ; concurrency + } + +let t = fields t let user_config_file = Path.relative (Path.of_filename_relative_to_initial_cwd Xdg.config_dir) "dune/config" +include Versioned_file.Make(struct type t = unit end) +let () = Lang.register syntax () + let load_config_file p = - (Sexp.Of_sexp.parse t Univ_map.empty) (Io.Sexp.load p ~mode:Many_as_one) + match Which_program.t with + | Dune -> load p ~f:(fun _lang -> t) + | Jbuilder -> + Io.with_lexbuf_from_file p ~f:(fun lb -> + match Dune_lexer.maybe_first_line lb with + | None -> + parse (enter t) + (Univ_map.singleton (Syntax.key syntax) (0, 0)) + (Io.Sexp.load p ~mode:Many_as_one ~lexer:Sexp.Lexer.jbuild_token) + | Some first_line -> + parse_contents lb first_line ~f:(fun _lang -> t)) let load_user_config_file () = if Path.exists user_config_file then diff --git a/src/context.ml b/src/context.ml index 3aa557ae..677c3685 100644 --- a/src/context.ml +++ b/src/context.ml @@ -453,7 +453,7 @@ let create_for_opam ?root ~env ~targets ~profile ~switch ~name let create ?merlin ~env def = match (def : Workspace.Context.t) with - | Default { targets; profile } -> default ~env ~profile ~targets ?merlin () + | Default { targets; profile; _ } -> default ~env ~profile ~targets ?merlin () | Opam { name; switch; root; targets; profile; _ } -> create_for_opam ?root ~env ~profile ~switch ~name ?merlin ~targets () diff --git a/src/dune_lexer.mli b/src/dune_lexer.mli index 7b3c5eaf..2067c6c7 100644 --- a/src/dune_lexer.mli +++ b/src/dune_lexer.mli @@ -12,3 +12,5 @@ val first_line : Lexing.lexbuf -> first_line (** Parse the first line of a versioned file but do not fail if it doesn't start with [(lang ...)]. *) val maybe_first_line : Lexing.lexbuf -> first_line option + +val eof_reached : Lexing.lexbuf -> bool diff --git a/src/dune_lexer.mll b/src/dune_lexer.mll index b7ac50b8..603c9407 100644 --- a/src/dune_lexer.mll +++ b/src/dune_lexer.mll @@ -61,6 +61,10 @@ and to_eol = parse { () } +and eof_reached = parse + | eof { true } + | "" { false } + { let first_line lb = match maybe_first_line lb with diff --git a/src/dune_project.ml b/src/dune_project.ml index 6badd128..857f7035 100644 --- a/src/dune_project.ml +++ b/src/dune_project.ml @@ -141,51 +141,9 @@ type t = ; project_file : Project_file.t } -module Lang = struct - type t = - { syntax : Syntax.t - ; stanzas : Stanza.Parser.t list - } - - type instance = - { lang : t - ; version : Syntax.Version.t - } - - let langs = Hashtbl.create 32 - - let register syntax stanzas = - let name = Syntax.name syntax in - if Hashtbl.mem langs name then - Exn.code_error "Dune_project.Lang.register: already registered" - [ "name", Sexp.To_sexp.string name ]; - Hashtbl.add langs name { syntax; stanzas } - - let parse first_line = - let { Dune_lexer. - lang = (name_loc, name) - ; version = (ver_loc, ver) - } = first_line - in - let ver = - Sexp.Of_sexp.parse Syntax.Version.t Univ_map.empty - (Atom (ver_loc, Sexp.Atom.of_string ver)) in - match Hashtbl.find langs name with - | None -> - Loc.fail name_loc "Unknown language %S.%s" name - (hint name (Hashtbl.keys langs)) - | Some t -> - Syntax.check_supported t.syntax (ver_loc, ver); - { lang = t - ; version = ver - } - - let get_exn name = - let lang = Option.value_exn (Hashtbl.find langs name) in - { lang - ; version = Syntax.greatest_supported_version lang.syntax - } -end +include Versioned_file.Make(struct + type t = Stanza.Parser.t list + end) module Project_file_edit = struct open Project_file @@ -296,8 +254,8 @@ module Extension = struct acc) end -let make_parsing_context ~(lang : Lang.instance) ~extensions = - let acc = Univ_map.singleton (Syntax.key lang.lang.syntax) lang.version in +let make_parsing_context ~(lang : Lang.Instance.t) ~extensions = + let acc = Univ_map.singleton (Syntax.key lang.syntax) lang.version in List.fold_left extensions ~init:acc ~f:(fun acc (ext : Extension.instance) -> Univ_map.add acc (Syntax.key ext.extension.syntax) ext.version) @@ -338,7 +296,7 @@ let anonymous = lazy ( ; root = get_local_path Path.root ; version = None ; stanza_parser = - Sexp.Of_sexp.(set_many parsing_context (sum lang.lang.stanzas)) + Sexp.Of_sexp.(set_many parsing_context (sum lang.data)) ; project_file = { file = Path.relative Path.root filename; exists = false } }) @@ -367,7 +325,7 @@ let name ~dir ~packages = | None -> return (default_name ~dir ~packages) let parse ~dir ~lang ~packages ~file = - record + fields (name ~dir ~packages >>= fun name -> field_o "version" string >>= fun version -> multi_field "using" @@ -396,7 +354,7 @@ let parse ~dir ~lang ~packages ~file = let parsing_context = make_parsing_context ~lang ~extensions in let stanzas = List.concat - (lang.lang.stanzas :: + (lang.data :: List.map extensions ~f:(fun (ext : Extension.instance) -> ext.parse_args (Sexp.Of_sexp.set_many parsing_context ext.extension.stanzas))) @@ -412,12 +370,8 @@ let parse ~dir ~lang ~packages ~file = }) let load_dune_project ~dir packages = - let fname = Path.relative dir filename in - Io.with_lexbuf_from_file fname ~f:(fun lb -> - let lang = Lang.parse (Dune_lexer.first_line lb) in - let sexp = Sexp.Parser.parse lb ~mode:Many_as_one in - Sexp.Of_sexp.parse (parse ~dir ~lang ~packages ~file:fname) - Univ_map.empty sexp) + let file = Path.relative dir filename in + load file ~f:(fun lang -> parse ~dir ~lang ~packages ~file) let make_jbuilder_project ~dir packages = let lang = Lang.get_exn "dune" in @@ -428,7 +382,7 @@ let make_jbuilder_project ~dir packages = ; version = None ; packages ; stanza_parser = - Sexp.Of_sexp.(set_many parsing_context (sum lang.lang.stanzas)) + Sexp.Of_sexp.(set_many parsing_context (sum lang.data)) ; project_file = { file = Path.relative dir filename; exists = false } } diff --git a/src/main.ml b/src/main.ml index cb9c35a8..8c526b70 100644 --- a/src/main.ml +++ b/src/main.ml @@ -58,29 +58,17 @@ let setup ?(log=Log.no_log) | None -> match workspace_file with | Some p -> + if not (Path.exists p) then + die "@{Error@}: workspace file %s does not exist" + (Path.to_string_maybe_quoted p); Workspace.load ?x ?profile p - | _ -> + | None -> match let p = Path.of_string Workspace.filename in - if Path.exists p then - Some p - else - None + Option.some_if (Path.exists p) p with | Some p -> Workspace.load ?x ?profile p - | None -> - { merlin_context = Some "default" - ; contexts = [Default - { targets = [ - match x with - | None -> Native - | Some x -> Named x - ] - ; profile = - Option.value profile - ~default:Config.default_build_profile - }] - } + | None -> Workspace.default ?x ?profile () in Fiber.parallel_map workspace.contexts ~f:(fun ctx_def -> @@ -262,14 +250,7 @@ let bootstrap () = Scheduler.go ~log ~config (set_concurrency config >>= fun () -> - setup ~log ~workspace:{ merlin_context = Some "default" - ; contexts = [Default { targets = [Native] - ; profile = - Option.value !profile - ~default:"dev" - } - ] - } + setup ~log ~workspace:(Workspace.default ?profile:!profile ()) ?profile:!profile ~extra_ignored_subtrees:ignored_during_bootstrap () diff --git a/src/super_context.ml b/src/super_context.ml index 05fd103a..181de7b5 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -309,6 +309,7 @@ let create ; "ext_lib" , string context.ext_lib ; "ext_dll" , string context.ext_dll ; "ext_exe" , string context.ext_exe + ; "build_profile" , string context.profile ] in let vars = diff --git a/src/syntax.ml b/src/syntax.ml index b4c7c6c5..dae362fa 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -74,9 +74,12 @@ let check_supported t (loc, ver) = (String.concat ~sep:"\n" (List.map (Supported_versions.supported_ranges t.supported_versions) ~f:(fun (a, b) -> - sprintf "- %s to %s" - (Version.to_string a) - (Version.to_string b)))) + if a = b then + sprintf "- %s" (Version.to_string a) + else + sprintf "- %s to %s" + (Version.to_string a) + (Version.to_string b)))) let greatest_supported_version t = Supported_versions.greatest_supported_version t.supported_versions diff --git a/src/versioned_file.ml b/src/versioned_file.ml new file mode 100644 index 00000000..03e18087 --- /dev/null +++ b/src/versioned_file.ml @@ -0,0 +1,88 @@ +open Import + +module type S = sig + type data + + module Lang : sig + val register : Syntax.t -> data -> unit + module Instance : sig + type t = + { syntax : Syntax.t + ; data : data + ; version : Syntax.Version.t + } + end + val get_exn : string -> Instance.t + end + val load : Path.t -> f:(Lang.Instance.t -> 'a Sexp.Of_sexp.t) -> 'a + val parse_contents + : Lexing.lexbuf + -> Dune_lexer.first_line + -> f:(Lang.Instance.t -> 'a Sexp.Of_sexp.t) + -> 'a +end + +module Make(Data : sig type t end) = struct + module Lang = struct + type t = + { syntax : Syntax.t + ; data : Data.t + } + + module Instance = struct + type t = + { syntax : Syntax.t + ; data : Data.t + ; version : Syntax.Version.t + } + end + + let langs = Hashtbl.create 32 + + let register syntax data = + let name = Syntax.name syntax in + if Hashtbl.mem langs name then + Exn.code_error "Versioned_file.Lang.register: already registered" + [ "name", Sexp.To_sexp.string name ]; + Hashtbl.add langs name { syntax; data } + + let parse first_line : Instance.t = + let { Dune_lexer. + lang = (name_loc, name) + ; version = (ver_loc, ver) + } = first_line + in + let ver = + Sexp.Of_sexp.parse Syntax.Version.t Univ_map.empty + (Atom (ver_loc, Sexp.Atom.of_string ver)) in + match Hashtbl.find langs name with + | None -> + Loc.fail name_loc "Unknown language %S.%s" name + (hint name (Hashtbl.keys langs)) + | Some t -> + Syntax.check_supported t.syntax (ver_loc, ver); + { syntax = t.syntax + ; data = t.data + ; version = ver + } + + let get_exn name : Instance.t = + let t = Option.value_exn (Hashtbl.find langs name) in + { syntax = t.syntax + ; data = t.data + ; version = Syntax.greatest_supported_version t.syntax + } + end + + let parse_contents lb first_line ~f = + let lang = Lang.parse first_line in + let sexp = Sexp.Parser.parse lb ~mode:Many_as_one in + let parsing_context = + Univ_map.singleton (Syntax.key lang.syntax) lang.version + in + Sexp.Of_sexp.parse (Sexp.Of_sexp.enter (f lang)) parsing_context sexp + + let load fn ~f = + Io.with_lexbuf_from_file fn ~f:(fun lb -> + parse_contents lb (Dune_lexer.first_line lb) ~f) +end diff --git a/src/versioned_file.mli b/src/versioned_file.mli new file mode 100644 index 00000000..6d8833c6 --- /dev/null +++ b/src/versioned_file.mli @@ -0,0 +1,44 @@ +(** Implementation of versioned files *) + +open Stdune + +module type S = sig + type data + + module Lang : sig + + (** [register id data] registers a new language. Users will select + this language by writing: + + {[ (lang ) ]} + + as the first line of the versioned file. *) + val register : Syntax.t -> data -> unit + + module Instance : sig + type t = + { syntax : Syntax.t + ; data : data + ; version : Syntax.Version.t + } + end + + (** Return the latest version of a language. *) + val get_exn : string -> Instance.t + end + + (** [load fn ~f] loads a versioned file. It parses the first line, + looks up the language, checks that the version is supported and + parses the rest of the file with [f]. *) + val load : Path.t -> f:(Lang.Instance.t -> 'a Sexp.Of_sexp.t) -> 'a + + (** Parse the contents of a versioned file after the first line has + been read. *) + val parse_contents + : Lexing.lexbuf + -> Dune_lexer.first_line + -> f:(Lang.Instance.t -> 'a Sexp.Of_sexp.t) + -> 'a +end + +module Make(Data : sig type t end) : S with type data := Data.t diff --git a/src/workspace.ml b/src/workspace.ml index bcfad9ba..65999fa1 100644 --- a/src/workspace.ml +++ b/src/workspace.ml @@ -1,5 +1,9 @@ open Import -open Sexp.Of_sexp +open Stanza.Of_sexp + +(* workspace files use the same version numbers as dune-project files + for simplicity *) +let syntax = Stanza.syntax module Context = struct module Target = struct @@ -11,11 +15,35 @@ module Context = struct map string ~f:(function | "native" -> Native | s -> Named s) + + let add ts x = + match x with + | None -> ts + | Some t -> + if List.mem t ~set:ts then + ts + else + ts @ [t] + end + + module Name = struct + let t = + plain_string (fun ~loc name -> + if name = "" || + String.is_prefix name ~prefix:"." || + name = "log" || + name = "install" || + String.contains name '/' || + String.contains name '\\' then + of_sexp_errorf loc + "%S is not allowed as a build context name" name; + name) end module Opam = struct type t = - { name : string + { loc : Loc.t + ; name : string ; profile : string ; switch : string ; root : string option @@ -23,58 +51,69 @@ module Context = struct ; targets : Target.t list } - let t ~profile = + let t ~profile ~x = field "switch" string >>= fun switch -> - field "name" string ~default:switch >>= fun name -> + field "name" Name.t ~default:switch >>= fun name -> field "targets" (list Target.t) ~default:[Target.Native] >>= fun targets -> field_o "root" string >>= fun root -> field_b "merlin" >>= fun merlin -> field "profile" string ~default:profile >>= fun profile -> - return { switch + loc >>= fun loc -> + return { loc + ; switch ; name ; root ; merlin - ; targets + ; targets = Target.add targets x ; profile } end module Default = struct type t = - { profile : string + { loc : Loc.t + ; profile : string ; targets : Target.t list } - let t ~profile = + let t ~profile ~x = field "targets" (list Target.t) ~default:[Target.Native] >>= fun targets -> field "profile" string ~default:profile >>= fun profile -> - return { targets; profile } + loc + >>= fun loc -> + return { loc + ; targets = Target.add targets x + ; profile + } end type t = Default of Default.t | Opam of Opam.t - let t ~profile = - Sexp.Of_sexp.( - peek_exn >>= function - | Atom _ | Quoted_string _ -> - enum [ "default", - Default { targets = [Native] - ; profile - } - ] - | List (_, List _ :: _) -> - record (Opam.t ~profile) >>| fun x -> Opam x - | _ -> - sum - [ "default", - (fields (Default.t ~profile) >>| fun x -> - Default x) - ; "opam", - (fields (Opam.t ~profile) >>| fun x -> - Opam x) - ]) + let loc = function + | Default x -> x.loc + | Opam x -> x.loc + + let t ~profile ~x = + sum + [ "default", + (fields (Default.t ~profile ~x) >>| fun x -> + Default x) + ; "opam", + (fields (Opam.t ~profile ~x) >>| fun x -> + Opam x) + ] + + let t ~profile ~x = + Syntax.get_exn syntax >>= function + | (0, _) -> + (* jbuild-workspace files *) + (peek_exn >>= function + | List (_, List _ :: _) -> + Sexp.Of_sexp.record (Opam.t ~profile ~x) >>| fun x -> Opam x + | _ -> t ~profile ~x) + | _ -> t ~profile ~x let name = function | Default _ -> "default" @@ -89,6 +128,14 @@ module Context = struct n :: List.filter_map (targets t) ~f:(function | Native -> None | Named s -> Some (n ^ "." ^ s)) + + let default ?x ?profile () = + Default + { loc = Loc.of_pos __POS__ + ; targets = [Option.value x ~default:Target.Native] + ; profile = Option.value profile + ~default:Config.default_build_profile + } end type t = @@ -96,75 +143,32 @@ type t = ; contexts : Context.t list } -type item = Context of Sexp.Ast.t | Profile of Loc.t * string +include Versioned_file.Make(struct type t = unit end) +let () = Lang.register syntax () -let item_of_sexp = - sum - [ "context", (raw >>|fun x -> Context x) - ; "profile", - (loc >>= fun loc -> - string >>= fun x -> - return (Profile (loc, x))) - ] - -let t ?x ?profile:cmdline_profile sexps = +let t ?x ?profile:cmdline_profile () = + field "profile" string ~default:Config.default_build_profile + >>= fun profile -> + let profile = Option.value cmdline_profile ~default:profile in + multi_field "context" (Context.t ~profile ~x) + >>= fun contexts -> let defined_names = ref String.Set.empty in - let profiles, contexts = - List.partition_map sexps ~f:(fun sexp -> - match Sexp.Of_sexp.parse item_of_sexp Univ_map.empty sexp with - | Profile (loc, p) -> Left (loc, p) - | Context c -> Right c) - in - let profile = - match profiles, cmdline_profile with - | _ :: (loc, _) :: _, _ -> - Loc.fail loc "profile defined too many times" - | _, Some p -> p - | [], None -> Config.default_build_profile - | [(_, p)], None -> p - in let { merlin_context; contexts } = let init = { merlin_context = None ; contexts = [] } in - List.fold_left contexts ~init ~f:(fun t sexp -> - let ctx = Sexp.Of_sexp.parse (Context.t ~profile) Univ_map.empty sexp in - let ctx = - match x with - | None -> ctx - | Some s -> - let target = Context.Target.Named s in - let add_target target targets = - if List.mem target ~set:targets then - targets - else - targets @ [target] - in - match ctx with - | Default d -> - Default { d with targets = add_target target d.targets } - | Opam o -> - Opam { o with targets = add_target target o.targets } - in + List.fold_left contexts ~init ~f:(fun t ctx -> let name = Context.name ctx in - if name = "" || - String.is_prefix name ~prefix:"." || - name = "log" || - name = "install" || - String.contains name '/' || - String.contains name '\\' then - of_sexp_errorf (Sexp.Ast.loc sexp) - "%S is not allowed as a build context name" name; if String.Set.mem !defined_names name then - of_sexp_errorf (Sexp.Ast.loc sexp) + Loc.fail (Context.loc ctx) "second definition of build context %S" name; defined_names := String.Set.union !defined_names (String.Set.of_list (Context.all_names ctx)); match ctx, t.merlin_context with | Opam { merlin = true; _ }, Some _ -> - of_sexp_errorf (Sexp.Ast.loc sexp) + Loc.fail (Context.loc ctx) "you can only have one context for merlin" | Opam { merlin = true; _ }, None -> { merlin_context = Some name; contexts = ctx :: t.contexts } @@ -173,7 +177,7 @@ let t ?x ?profile:cmdline_profile sexps = in let contexts = match contexts with - | [] -> [Context.Default { targets = [Native]; profile }] + | [] -> [Context.default ?x ~profile ()] | _ -> contexts in let merlin_context = @@ -186,11 +190,40 @@ let t ?x ?profile:cmdline_profile sexps = else None in - { merlin_context - ; contexts = List.rev contexts + return + { merlin_context + ; contexts = List.rev contexts + } + +let t ?x ?profile () = fields (t ?x ?profile ()) + +let default ?x ?profile () = + { merlin_context = Some "default" + ; contexts = [Context.default ?x ?profile ()] } -let load ?x ?profile p = t ?x ?profile (Io.Sexp.load p ~mode:Many) +let load ?x ?profile p = + let x = Option.map x ~f:(fun s -> Context.Target.Named s) in + match Which_program.t with + | Dune -> + Io.with_lexbuf_from_file p ~f:(fun lb -> + if Dune_lexer.eof_reached lb then + default ?x ?profile () + else + let first_line = Dune_lexer.first_line lb in + parse_contents lb first_line ~f:(fun _lang -> t ?x ?profile ())) + | Jbuilder -> + let sexp = + Io.Sexp.load p ~mode:Many_as_one ~lexer:Sexp.Lexer.jbuild_token + in + parse + (enter (t ?x ?profile ())) + (Univ_map.singleton (Syntax.key syntax) (0, 0)) + sexp + +let default ?x ?profile () = + let x = Option.map x ~f:(fun s -> Context.Target.Named s) in + default ?x ?profile () let filename = match Which_program.t with diff --git a/src/workspace.mli b/src/workspace.mli index a45c3908..19c04bdc 100644 --- a/src/workspace.mli +++ b/src/workspace.mli @@ -10,7 +10,8 @@ module Context : sig end module Opam : sig type t = - { name : string + { loc : Loc.t + ; name : string ; profile : string ; switch : string ; root : string option @@ -21,7 +22,8 @@ module Context : sig module Default : sig type t = - { profile : string + { loc : Loc.t + ; profile : string ; targets : Target.t list } end @@ -40,3 +42,6 @@ val load : ?x:string -> ?profile:string -> Path.t -> t (** Default name of workspace files *) val filename : string + +(** Default configuration *) +val default : ?x:string -> ?profile:string -> unit -> t diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 3ab73034..28390f9e 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -579,6 +579,14 @@ test-cases/windows-diff (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name workspaces) + (deps (package dune) (source_tree test-cases/workspaces)) + (action + (chdir + test-cases/workspaces + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name runtest) (deps @@ -648,7 +656,8 @@ (alias syntax-versioning) (alias use-meta) (alias utop) - (alias windows-diff))) + (alias windows-diff) + (alias workspaces))) (alias (name runtest-no-deps) @@ -710,7 +719,8 @@ (alias select) (alias syntax-versioning) (alias use-meta) - (alias windows-diff))) + (alias windows-diff) + (alias workspaces))) (alias (name runtest-disabled) (deps (alias reason))) diff --git a/test/blackbox-tests/test-cases/workspaces/custom-profile/dune b/test/blackbox-tests/test-cases/workspaces/custom-profile/dune new file mode 100644 index 00000000..1517a8a5 --- /dev/null +++ b/test/blackbox-tests/test-cases/workspaces/custom-profile/dune @@ -0,0 +1,3 @@ +(alias + (name runtest) + (action (echo "build profile: %{build_profile}"))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/workspaces/custom-profile/dune-project b/test/blackbox-tests/test-cases/workspaces/custom-profile/dune-project new file mode 100644 index 00000000..b2559fa0 --- /dev/null +++ b/test/blackbox-tests/test-cases/workspaces/custom-profile/dune-project @@ -0,0 +1 @@ +(lang dune 1.0) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/workspaces/custom-profile/dune-workspace b/test/blackbox-tests/test-cases/workspaces/custom-profile/dune-workspace new file mode 100644 index 00000000..84bdee13 --- /dev/null +++ b/test/blackbox-tests/test-cases/workspaces/custom-profile/dune-workspace @@ -0,0 +1,3 @@ +(lang dune 1.0) + +(context (default (profile foobar))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/workspaces/custom-workspace/dune-workspace.dev b/test/blackbox-tests/test-cases/workspaces/custom-workspace/dune-workspace.dev new file mode 100644 index 00000000..a27d9ccd --- /dev/null +++ b/test/blackbox-tests/test-cases/workspaces/custom-workspace/dune-workspace.dev @@ -0,0 +1,3 @@ +(lang dune 1.0) + +(context (does-not-exist)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/workspaces/dune-no-version/dune-workspace b/test/blackbox-tests/test-cases/workspaces/dune-no-version/dune-workspace new file mode 100644 index 00000000..b4454ea8 --- /dev/null +++ b/test/blackbox-tests/test-cases/workspaces/dune-no-version/dune-workspace @@ -0,0 +1 @@ +(context (default)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/workspaces/jbuilder-default-name/jbuild-workspace b/test/blackbox-tests/test-cases/workspaces/jbuilder-default-name/jbuild-workspace new file mode 100644 index 00000000..4554f70b --- /dev/null +++ b/test/blackbox-tests/test-cases/workspaces/jbuilder-default-name/jbuild-workspace @@ -0,0 +1 @@ +(context (does-not-exist)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/workspaces/opam/dune-workspace b/test/blackbox-tests/test-cases/workspaces/opam/dune-workspace new file mode 100644 index 00000000..a0ae01c8 --- /dev/null +++ b/test/blackbox-tests/test-cases/workspaces/opam/dune-workspace @@ -0,0 +1,8 @@ +(lang dune 1.0) + +(context + (opam + (switch foo-switch) + (name foo-name) + (profile foo-profile) + (merlin false))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/workspaces/run.t b/test/blackbox-tests/test-cases/workspaces/run.t new file mode 100644 index 00000000..5ca2dd04 --- /dev/null +++ b/test/blackbox-tests/test-cases/workspaces/run.t @@ -0,0 +1,50 @@ +jbuild still discovers workspaces as usual + + $ jbuilder build --root jbuilder-default-name + File "jbuild-workspace", line 1, characters 10-24: + Error: Unknown constructor does-not-exist + [1] + +and dune ignores this file: + + $ dune build --root jbuilder-default-name + Entering directory 'jbuilder-default-name' + +dune uses a versioned file. If the version is missing, then we get an error. + + $ dune build --root dune-no-version + File "dune-workspace", line 1, characters 0-19: + Error: Invalid first line, expected: (lang ) + [1] + +analogously, jbuilder will ignore it + + $ jbuilder build --root dune-no-version + Entering directory 'dune-no-version' + +specifying the workspace file is possible: + + $ dune build --root custom-workspace --workspace custom-workspace/dune-workspace.dev + Error: workspace file custom-workspace/dune-workspace.dev does not exist + [1] + +Workspaces let you set custom profiles + + $ dune runtest --root custom-profile + Entering directory 'custom-profile' + build profile: foobar + +A workspace context can ve defined using an opam switch. This test is disabled +because we don't really have a way to mock an opam switch. + +# $ dune build --root opam --display quiet 2>&1 + +Workspaces also allow you to set "target" for cross compilation. This feature is +a bit hard to test since it requires mocking more than one context. But we can +see how we can set a "native" target. Which is the default. + + $ dune exec ./foo.exe --root targets-native + Info: creating file dune-project with this contents: (lang dune 1.0) + Entering directory 'targets-native' + Entering directory 'targets-native' + message from targets-native test diff --git a/test/blackbox-tests/test-cases/workspaces/targets-native/dune b/test/blackbox-tests/test-cases/workspaces/targets-native/dune new file mode 100644 index 00000000..285ef0c0 --- /dev/null +++ b/test/blackbox-tests/test-cases/workspaces/targets-native/dune @@ -0,0 +1,2 @@ + +(executable (name foo)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/workspaces/targets-native/dune-workspace b/test/blackbox-tests/test-cases/workspaces/targets-native/dune-workspace new file mode 100644 index 00000000..1cab60b7 --- /dev/null +++ b/test/blackbox-tests/test-cases/workspaces/targets-native/dune-workspace @@ -0,0 +1,3 @@ +(lang dune 1.0) + +(context (default (targets native))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/workspaces/targets-native/foo.ml b/test/blackbox-tests/test-cases/workspaces/targets-native/foo.ml new file mode 100644 index 00000000..8ade8dc3 --- /dev/null +++ b/test/blackbox-tests/test-cases/workspaces/targets-native/foo.ml @@ -0,0 +1 @@ +print_endline "message from targets-native test";;