matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge pull request #932 from diml/version-other-files 

Version `dune-workspace` and `~/.config/dune/config` files
This commit is contained in:
Rudi Grinberg 2018-07-01 15:25:09 +07:00 committed by GitHub
parent d6c35e01df 60c97ab365
commit a877fc00df
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
30 changed files with 463 additions and 262 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CHANGES.md
View File

@ -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
View File

@ -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.

10
doc/advanced-topics.rst
View File

@ -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?

2
doc/terminology.rst
View File

@ -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
View File

@ -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
====================================

2
dune-workspace.dev
View File

@ -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)))

38
src/config.ml
View File

@ -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

2
src/context.ml
View File

@ -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 ()

2
src/dune_lexer.mli
View File

@ -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

4
src/dune_lexer.mll
View File

@ -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

68
src/dune_project.ml
View File

@ -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
View File

@ -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
()

1
src/super_context.ml
View File

@ -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 =

9
src/syntax.ml
View File

@ -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

88
src/versioned_file.ml Normal file
View File

@ -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

44
src/versioned_file.mli Normal file
View File

@ -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
View File

@ -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

9
src/workspace.mli
View File

@ -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

14
test/blackbox-tests/dune.inc
View File

@ -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)))

3
test/blackbox-tests/test-cases/workspaces/custom-profile/dune Normal file
View File

@ -0,0 +1,3 @@
(alias
(name runtest)
(action (echo "build profile: %{build_profile}")))

1
test/blackbox-tests/test-cases/workspaces/custom-profile/dune-project Normal file
View File

@ -0,0 +1 @@
(lang dune 1.0)

3
test/blackbox-tests/test-cases/workspaces/custom-profile/dune-workspace Normal file
View File

@ -0,0 +1,3 @@
(lang dune 1.0)
(context (default (profile foobar)))

3
test/blackbox-tests/test-cases/workspaces/custom-workspace/dune-workspace.dev Normal file
View File

@ -0,0 +1,3 @@
(lang dune 1.0)
(context (does-not-exist))

1
test/blackbox-tests/test-cases/workspaces/dune-no-version/dune-workspace Normal file
View File

@ -0,0 +1 @@
(context (default))

1
test/blackbox-tests/test-cases/workspaces/jbuilder-default-name/jbuild-workspace Normal file
View File

@ -0,0 +1 @@
(context (does-not-exist))

8
test/blackbox-tests/test-cases/workspaces/opam/dune-workspace Normal file
View File

@ -0,0 +1,8 @@
(lang dune 1.0)
(context
(opam
(switch foo-switch)
(name foo-name)
(profile foo-profile)
(merlin false)))

50
test/blackbox-tests/test-cases/workspaces/run.t Normal file
View File

@ -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

2
test/blackbox-tests/test-cases/workspaces/targets-native/dune Normal file
View File

@ -0,0 +1,2 @@
(executable (name foo))

3
test/blackbox-tests/test-cases/workspaces/targets-native/dune-workspace Normal file
View File

@ -0,0 +1,3 @@
(lang dune 1.0)
(context (default (targets native)))

1
test/blackbox-tests/test-cases/workspaces/targets-native/foo.ml Normal file
View File

@ -0,0 +1 @@
print_endline "message from targets-native test";;