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

Version `dune-workspace` and `~/.config/dune/config` files

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

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]
+         (Default { loc = Loc.of_pos __POS__
-                  ; profile = Config.default_build_profile })
+                  ; 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
+    ; `P {|The first line of the file must be of the form (lang dune X.Y) \
-           a list of stanzas. The following sections describe the stanzas available.|}
+           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.

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
+Note that instead of writing a ``dune-workspace`` file, you can also
-use the ``-x`` command line option. Passing ``-x foo`` to ``jbuilder``
+use the ``-x`` command line option. Passing ``-x foo`` to ``dune``
-without having a ``jbuild-workspace`` file is the same as writing the
+without having a ``dune-workspace`` file is the same as writing the
-following ``jbuild-workspace`` file:
+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?

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
    ``<root>/_build/<foo>``

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
+``dune`` prints out the root when starting if it is not the current
-current directory:
+directory:
 
 .. code:: bash
 
-    $ jbuilder runtest
+    $ dune runtest
-    Entering directory '/home/jdimino/code/jbuilder'
+    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``
+-  ``/dune-workspace``
--  ``/home/jbuild-workspace``
+-  ``/home/dune-workspace``
--  ``/home/me/jbuild-workspace``
+-  ``/home/me/dune-workspace``
--  ``/home/me/code/jbuild-workspace``
+-  ``/home/me/code/dune-workspace``
--  ``/home/me/code/myproject/jbuild-workspace``
+-  ``/home/me/code/myproject/dune-workspace``
--  ``/home/me/code/myproject/src/jbuild-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
+In addition to determining the root, ``dune`` will read this file as
-setup the configuration of the workspace unless the ``--workspace`` command line
+to setup the configuration of the workspace unless the ``--workspace``
-option is used. See the section `Workspace configuration`_ for the syntax of
+command line option is used. See the section `Workspace
-this file.
+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
 
 Current directory
 -----------------
 
-If none of the two previous rules appies, i.e. no ancestor directories
+If the previous rule doesn't apply, i.e. no ancestor directory has a
-have a file whose name starts with ``jbuild-workspace``, then the
+file named ``dune-workspace``, then the current directory will be used
-current directory will be used as root.
+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
+which correspond to the environment in which ``dune`` is run. You can
-can define more contexts by writing a ``jbuild-workspace`` file.
+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
+The ``dune-workspace`` file uses the S-expression syntax. This is what
-a typical ``jbuild-workspace`` file looks like:
+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
 ====================================
 

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

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
-    (field "display" Display.t ~default:default.display
+  >>= fun display ->
-     >>= fun display ->
+  field "jobs" Concurrency.t ~default:default.concurrency
-     field "jobs" Concurrency.t ~default:default.concurrency
+  >>= fun concurrency ->
-     >>= fun concurrency ->
+  return { display
-     return { display
+         ; concurrency
-            ; 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

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

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

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

src/dune_project.ml

@@ -141,51 +141,9 @@ type t =
   ; project_file  : Project_file.t
   }
 
-module Lang = struct
+include Versioned_file.Make(struct
-  type t =
+    type t = Stanza.Parser.t list
-    { syntax  : Syntax.t
+  end)
-    ; 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
 
 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 make_parsing_context ~(lang : Lang.Instance.t) ~extensions =
-  let acc = Univ_map.singleton (Syntax.key lang.lang.syntax) lang.version in
+  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
+  let file = Path.relative dir filename in
-  Io.with_lexbuf_from_file fname ~f:(fun lb ->
+  load file ~f:(fun lang -> parse ~dir ~lang ~packages ~file)
-    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 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 }
   }
 

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
+          Option.some_if (Path.exists p) p
-            Some p
-          else
-            None
         with
         | Some p -> Workspace.load ?x ?profile p
-        | None ->
+        | None -> Workspace.default ?x ?profile ()
-          { 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
-                          }]
-          }
   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"
+       setup ~log ~workspace:(Workspace.default ?profile:!profile ())
-                             ; contexts = [Default { targets = [Native]
-                                                   ; profile =
-                                                       Option.value !profile
-                                                         ~default:"dev"
-                                                   }
-                                          ]
-                             }
          ?profile:!profile
          ~extra_ignored_subtrees:ignored_during_bootstrap
          ()

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 =

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"
+              if a = b then
-                (Version.to_string a)
+                sprintf "- %s" (Version.to_string a)
-                (Version.to_string b))))
+              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

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

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

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 =
+  let loc = function
-    Sexp.Of_sexp.(
+    | Default x -> x.loc
-      peek_exn >>= function
+    | Opam    x -> x.loc
-      | Atom _ | Quoted_string _ ->
+
-        enum [ "default",
+  let t ~profile ~x =
-               Default { targets = [Native]
+    sum
-                       ; profile
+      [ "default",
-                       }
+        (fields (Default.t ~profile ~x) >>| fun x ->
-             ]
+         Default x)
-      | List (_, List _ :: _) ->
+      ; "opam",
-        record (Opam.t ~profile) >>| fun x -> Opam x
+        (fields (Opam.t ~profile ~x) >>| fun x ->
-      | _ ->
+         Opam x)
-        sum
+      ]
-          [ "default",
+
-            (fields (Default.t ~profile) >>| fun x ->
+  let t ~profile ~x =
-             Default x)
+    Syntax.get_exn syntax >>= function
-          ; "opam",
+    | (0, _) ->
-            (fields (Opam.t ~profile) >>| fun x ->
+      (* jbuild-workspace files *)
-             Opam x)
+      (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 =
+let t ?x ?profile:cmdline_profile () =
-  sum
+  field "profile" string ~default:Config.default_build_profile
-    [ "context", (raw >>|fun x -> Context x)
+  >>= fun profile ->
-    ; "profile",
+  let profile = Option.value cmdline_profile ~default:profile in
-      (loc >>= fun loc ->
+  multi_field "context" (Context.t ~profile ~x)
-       string >>= fun x ->
+  >>= fun contexts ->
-       return (Profile (loc, x)))
-    ]
-
-let t ?x ?profile:cmdline_profile sexps =
   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 ->
+    List.fold_left contexts ~init ~f:(fun t ctx ->
-      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
       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
+  return
-  ; contexts = List.rev contexts
+    { 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

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

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

test/blackbox-tests/test-cases/workspaces/custom-profile/dune

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

test/blackbox-tests/test-cases/workspaces/custom-profile/dune-project

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

test/blackbox-tests/test-cases/workspaces/custom-profile/dune-workspace

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

test/blackbox-tests/test-cases/workspaces/custom-workspace/dune-workspace.dev

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

test/blackbox-tests/test-cases/workspaces/dune-no-version/dune-workspace

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

test/blackbox-tests/test-cases/workspaces/jbuilder-default-name/jbuild-workspace

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

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

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

test/blackbox-tests/test-cases/workspaces/targets-native/dune

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

test/blackbox-tests/test-cases/workspaces/targets-native/dune-workspace

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

test/blackbox-tests/test-cases/workspaces/targets-native/foo.ml

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