From bb3e241580833ec1011ad1e925cfd9d1aeca8c89 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 24 Apr 2018 15:41:00 +0100 Subject: [PATCH] Preliminary support for dune-project files --- bin/main.ml | 7 ++- doc/jbuild.rst | 4 +- doc/project-layout-specification.rst | 38 +++++++++++++-- doc/usage.rst | 5 +- src/dune_project.ml | 69 ++++++++++++++++++++++++++++ src/dune_project.mli | 10 ++++ src/jbuild_load.ml | 25 ++++++++++ 7 files changed, 148 insertions(+), 10 deletions(-) create mode 100644 src/dune_project.ml create mode 100644 src/dune_project.mli diff --git a/bin/main.ml b/bin/main.ml index 0a640cbfc698..954b9e13ee06 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -142,9 +142,12 @@ module Make(M : sig val which : which end) = struct let files = Sys.readdir dir |> Array.to_list |> String.Set.of_list in if String.Set.mem files "jbuild-workspace" then cont counter ~candidates:((0, dir, to_cwd) :: candidates) dir ~to_cwd - else if String.Set.exists files ~f:(fun fn -> - String.is_prefix fn ~prefix:"jbuild-workspace") then + else if M.which = Jbuilder && + String.Set.exists files ~f:(fun fn -> + String.is_prefix fn ~prefix:"jbuild-workspace") then cont counter ~candidates:((1, dir, to_cwd) :: candidates) dir ~to_cwd + else if String.Set.mem files "dune-project" then + cont counter ~candidates:((2, dir, to_cwd) :: candidates) dir ~to_cwd else cont counter ~candidates dir ~to_cwd and cont counter ~candidates ~to_cwd dir = diff --git a/doc/jbuild.rst b/doc/jbuild.rst index fc376ec55bc7..7026ff10e3ab 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -31,8 +31,8 @@ The following sections describe the available stanzas and their meaning. jbuild_version -------------- -``(jbuild_version 1)`` specifies that we are using the version 1 of -the Jbuilder metadata format in this ``jbuild`` file. +Deprecated. This stanza is no longer used and will be removed in the +future. library ------- diff --git a/doc/project-layout-specification.rst b/doc/project-layout-specification.rst index 44305a30d48b..20b71efb3b00 100644 --- a/doc/project-layout-specification.rst +++ b/doc/project-layout-specification.rst @@ -2,9 +2,10 @@ Project Layout and Metadata Specification ***************************************** -A typical jbuilder project will have one or more ``.opam`` file -at toplevel as well as ``jbuild`` files wherever interesting things are: -libraries, executables, tests, documents to install, etc... +A typical jbuilder project will have a ```dune-project`` and one or +more ``.opam`` file at toplevel as well as ``jbuild`` files +wherever interesting things are: libraries, executables, tests, +documents to install, etc... It is recommended to organize your project so that you have exactly one library per directory. You can have several executables in the same @@ -83,10 +84,10 @@ Examples this_is_an_atom_123'&^%! ; this is a comment "another atom in an OCaml-string \"string in a string\" \123" - + ; empty list follows below () - + ; a more complex example ( ( @@ -103,6 +104,33 @@ Examples .. _opam-files: +dune-project files +================== + +These files are used to mark the root of projects as well as define +project-wide parameters. These files are required to have a ``lang`` +which controls the names and contents of all configuration files read +by Dune. The ``lang`` stanza looks like: + +.. code:: scheme + + (lang dune 0.1) + +The 0.1 version of the language is exactly the same as the Jbuilder +language. So to convert a Jbuilder project to Dune, simply write this +file at the root of your project. + +Additionally, they can contains the following stanzas. + +name +---- + +Sets the name of the project: + +.. code:: scheme + + (name ) + .opam files ==================== diff --git a/doc/usage.rst b/doc/usage.rst index 20059b74fde0..d253f94bc6a1 100644 --- a/doc/usage.rst +++ b/doc/usage.rst @@ -15,7 +15,8 @@ jbuild-workspace ---------------- The root of the current workspace is determined by looking up a -``jbuild-workspace`` file in the current directory and parent directories. +``jbuild-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: @@ -50,6 +51,8 @@ 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 diff --git a/src/dune_project.ml b/src/dune_project.ml new file mode 100644 index 000000000000..3d68083d71e9 --- /dev/null +++ b/src/dune_project.ml @@ -0,0 +1,69 @@ +open Import +open Sexp.Of_sexp + +type t = + { name : string + } + +let filename = "dune-project" + +type lang = + | Dune_0_1 + +let lang = + let version ver = + match string ver with + | "0.1" -> Dune_0_1 + | _ -> + of_sexp_error ver "unsupported version of the dune language" + in + let name = + enum + [ ("dune", ()) ] + in + sum + [ cstr "lang" (name @> version @> nil) (fun () v -> v) ] + +module Acc = struct + type t = + { name : string option + } + + let init = + { name = None } +end + +let load ~dir = + let fname = Path.to_string (Path.relative dir filename) in + let sexps = Sexp.load ~fname ~mode:Many in + let langs, sexps = + List.partition_map sexps ~f:(function + | List (loc, Atom (_, A "lang") :: _) as sexp -> + Left (lang sexp, loc) + | sexp -> Right sexp) + in + let _lang = + match langs with + | [] -> + Loc.fail (Loc.in_file fname) + "language not specified, you need to add (lang dune 0.1)" + | [(v, _)] -> v + | _ :: (_, loc) :: _ -> + Loc.fail loc "language specified too many times" + in + let acc = + List.fold_left sexps ~init:Acc.init ~f:(fun (acc : Acc.t) sexp -> + sum + [ cstr "lang" nil acc + ; cstr_loc "name" (string @> nil) (fun loc name -> + match acc.name with + | None -> { Acc.name = Some name } + | Some _ -> Loc.fail loc "name specified too many times") + ] + sexp) + in + { name = + match acc.name with + | Some s -> s + | None -> "_" ^ String.concat ~sep:"_" (Path.explode_exn dir) + } diff --git a/src/dune_project.mli b/src/dune_project.mli new file mode 100644 index 000000000000..9a6e7a59468f --- /dev/null +++ b/src/dune_project.mli @@ -0,0 +1,10 @@ +(** dune-project files *) + +type t = + { name : string + } + +val load : dir:Path.t -> t + +(** "dune-project" *) +val filename : string diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index f1ef80cac3c9..23d4828fa6e3 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -222,6 +222,31 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () = |> Path.Map.of_list_multi |> Path.Map.map ~f:Scope_info.make in + + let projects = + File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[] + ~f:(fun dir acc -> + let path = File_tree.Dir.path dir in + let files = File_tree.Dir.files dir in + if String.Set.mem files Dune_project.filename then begin + (path, Dune_project.load ~dir:path) :: acc + end else + acc) + |> Path.Map.of_list_exn + in + let scopes = + Path.Map.merge scopes projects ~f:(fun path scope project -> + match scope, project with + | None, None -> assert false + | Some _, None -> scope + | None, Some { name } -> + Some { name = Some name + ; packages = Package.Name.Map.empty + ; root = path + } + | Some scope, Some { name } -> Some { scope with name = Some name }) + in + let scopes = if Path.Map.mem scopes Path.root then scopes