Merge pull request #932 from diml/version-other-files
Version `dune-workspace` and `~/.config/dune/config` files
This commit is contained in:
commit
a877fc00df
|
@ -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)
|
||||
-----------------------
|
||||
|
||||
|
|
13
bin/main.ml
13
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.
|
||||
|
|
|
@ -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?
|
||||
|
|
|
@ -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
|
||||
``<root>/_build/<foo>``
|
||||
|
|
101
doc/usage.rst
101
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 <opam-switch-name>)
|
||||
<optional-fields>))
|
||||
|
||||
it is interpreted the same as ``(context (opam (switch ...) ...))``.
|
||||
|
||||
Building JavaScript with js_of_ocaml
|
||||
====================================
|
||||
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ()
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 }
|
||||
}
|
||||
|
||||
|
|
33
src/main.ml
33
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>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
|
||||
()
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
|
@ -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 <name> <version>) ]}
|
||||
|
||||
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
|
207
src/workspace.ml
207
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)))
|
||||
|
||||
|
|
|
@ -0,0 +1,3 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(action (echo "build profile: %{build_profile}")))
|
|
@ -0,0 +1 @@
|
|||
(lang dune 1.0)
|
|
@ -0,0 +1,3 @@
|
|||
(lang dune 1.0)
|
||||
|
||||
(context (default (profile foobar)))
|
|
@ -0,0 +1,3 @@
|
|||
(lang dune 1.0)
|
||||
|
||||
(context (does-not-exist))
|
|
@ -0,0 +1 @@
|
|||
(context (default))
|
|
@ -0,0 +1 @@
|
|||
(context (does-not-exist))
|
|
@ -0,0 +1,8 @@
|
|||
(lang dune 1.0)
|
||||
|
||||
(context
|
||||
(opam
|
||||
(switch foo-switch)
|
||||
(name foo-name)
|
||||
(profile foo-profile)
|
||||
(merlin false)))
|
|
@ -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 <lang> <version>)
|
||||
[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
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
(executable (name foo))
|
|
@ -0,0 +1,3 @@
|
|||
(lang dune 1.0)
|
||||
|
||||
(context (default (targets native)))
|
|
@ -0,0 +1 @@
|
|||
print_endline "message from targets-native test";;
|
Loading…
Reference in New Issue