Adapt the behavior of dune subst for dune projects

CHANGES.md

@@ -114,6 +114,8 @@ next
 
 - Remove `path-no-dep:file` (#948, @emillon)
 
+- Adapt the behavior of `dune subst` for dune projects (#960, @diml)
+
 1.0+beta20 (10/04/2018)
 -----------------------
 

bin/main.ml

@@ -1334,7 +1334,7 @@ let subst =
     ; `Pre {|  \$ git describe --always --dirty|}
     ; `P {|$(b,dune subst) substitutes the variables that topkg substitutes with
            the defatult configuration:|}
-    ; var "NAME" "the name of the package"
+    ; var "NAME" "the name of the project (from the dune-project file)"
     ; var "VERSION" "output of $(b,git describe --always --dirty)"
     ; var "VERSION_NUM" "same as $(b,%%VERSION%%) but with a potential leading \
                          'v' or 'V' dropped"
@@ -1346,30 +1346,43 @@ let subst =
     ; opam "doc"
     ; opam "license"
     ; opam "repo"
-    ; `P {|It is not possible to customize this list. If you wish to do so you need to
-           configure topkg instead and use it to perform the substitution.|}
-    ; `P {|Note that the expansion of $(b,%%NAME%%) is guessed using the following
-           heuristic: if all the $(b,<package>.opam) files in the current directory are
-           prefixed by the shortest package name, this prefix is used. Otherwise you must
-           specify a name with the $(b,-n) command line option.|}
     ; `P {|In order to call $(b,dune subst) when your package is pinned, add this line
            to the $(b,build:) field of your opam file:|}
     ; `Pre {|  [dune "subst"] {pinned}|}
+    ; `P {|Note that this command is meant to be called only from opam files and
+           behaves a bit differently from other dune commands. In particular it
+           doesn't try to detect the root and must be called from the root of
+           the project.|}
     ; `Blocks help_secs
     ]
   in
-  let go common name =
-    set_common common ~targets:[];
-    Scheduler.go ~common (Watermarks.subst ?name ())
+  let term =
+    match Which_program.t with
+    | Jbuilder ->
+      let go common name =
+        set_common common ~targets:[];
+        Scheduler.go ~common (Watermarks.subst ?name ())
+      in
+      Term.(const go
+            $ common
+            $ Arg.(value
+                   & opt (some string) None
+                   & info ["n"; "name"] ~docv:"NAME"
+                       ~doc:"Use this project name instead of detecting it."))
+    | Dune ->
+      let go () =
+        let config : Config.t =
+          { display     = Quiet
+          ; concurrency = Fixed 1
+          }
+        in
+        Path.set_root (Path.External.cwd ());
+        Dune.Scheduler.go ~config (Watermarks.subst ())
+      in
+      Term.(const go $ const ())
   in
-  ( Term.(const go
-          $ common
-          $ Arg.(value
-                 & opt (some string) None
-                 & info ["n"; "name"] ~docv:"NAME"
-                     ~doc:"Use this package name instead of detecting it.")
-         )
-  , Term.info "subst" ~doc ~man)
+  (term,
+   Term.info "subst" ~doc ~man)
 
 let utop =
   let doc = "Load library in utop" in

doc/usage.rst

@@ -462,30 +462,32 @@ must be prefixed by the shortest one.
 Watermarking
 ============
 
-One of the feature topkg provides is watermarking; it replaces various strings
-of the form ``%%ID%%`` in all files of your project before creating a release
-tarball or when the package is pinned by the user using opam.
+One of the feature dune-release provides is watermarking; it replaces
+various strings of the form ``%%ID%%`` in all files of your project
+before creating a release tarball or when the package is pinned by the
+user using opam.
 
 This is especially interesting for the ``VERSION`` watermark, which gets
 replaced by the version obtained from the vcs. For instance if you are using
-git, topkg invokes this command to find out the version:
+git, dune-release invokes this command to find out the version:
 
 .. code:: bash
 
     $ git describe --always --dirty
     1.0+beta9-79-g29e9b37
 
-Projects using dune usually only need topkg for creating and publishing
-releases. However they might still want to substitute the watermarks when the
-package is pinned by the user. To help with this, dune provides the ``subst``
-sub-command.
+Projects using dune usually only need dune-release for creating and
+publishing releases. However they might still want to substitute the
+watermarks when the package is pinned by the user. To help with this,
+dune provides the ``subst`` sub-command.
 
 dune subst
 ==========
 
-``dune subst`` performs the same substitution ``topkg`` does with the default
-configuration. i.e. calling ``dune subst`` at the root of your project will
-rewrite in place all the files in your project.
+``dune subst`` performs the same substitution ``dune-release`` does
+with the default configuration. i.e. calling ``dune subst`` at the
+root of your project will rewrite in place all the files in your
+project.
 
 More precisely, it replaces all the following watermarks in source files:
 
@@ -503,18 +505,15 @@ More precisely, it replaces all the following watermarks in source files:
 - ``PKG_LICENSE``, contents of the ``license`` field from the opam file
 - ``PKG_REPO``, contents of the ``repo`` field from the opam file
 
-Note that if your project contains several packages, ``NAME`` will be replaced
-by the shorted package name as long as it is a prefix of all the package names.
-If your package names don't follow this rule, you need to specify the name
-explicitly via the ``-n`` flag:
-
-.. code:: bash
-
-    $ dune subst -n myproject
+The name of the project is obtained by reading the ``dune-project``
+file in the directory where ``dune subst`` is called. The
+``dune-project`` file must exist and contain a valid ``(name ...)``
+field.
 
-Finally, note that dune doesn't allow you to customize the list of substituted
-watermarks. If you which to do so, you need to configure topkg and use it
-instead of ``dune subst``.
+Note that ``dune subst`` is meant to be called from the opam file and
+in particular behaves a bit different to other ``dune`` commands. In
+particular it doesn't try to detect the root of the workspace and must
+be called from the root of the project.
 
 Custom Build Directory
 ======================

src/dune_project.ml

@@ -386,6 +386,13 @@ let make_jbuilder_project ~dir packages =
   ; project_file = { file = Path.relative dir filename; exists = false }
   }
 
+let read_name file =
+  load file ~f:(fun _lang ->
+    fields
+      (field_o "name" string >>= fun name ->
+       junk_everything >>= fun () ->
+       return name))
+
 let load ~dir ~files =
   let packages =
     String.Set.fold files ~init:[] ~f:(fun fn acc ->
@@ -399,7 +406,8 @@ let load ~dir ~files =
         in
         let name = Package.Name.of_string pkg in
         (name,
-         { Package. name
+         { Package.
+           name
          ; path = dir
          ; version_from_opam_file
          }) :: acc

src/dune_project.mli

@@ -70,6 +70,9 @@ end
     is the set of files in this directory. *)
 val load : dir:Path.t -> files:String.Set.t -> t option
 
+(** Read the [name] file from a dune-project file *)
+val read_name : Path.t -> string option
+
 (** "dune-project" *)
 val filename : string
 

src/main.ml

@@ -199,7 +199,12 @@ let bootstrap () =
   let main () =
     let anon s = raise (Arg.Bad (Printf.sprintf "don't know what to do with %s\n" s)) in
     let subst () =
-      Scheduler.go (Watermarks.subst () ~name:"dune");
+      let config : Config.t =
+        { display     = Quiet
+        ; concurrency = Fixed 1
+        }
+      in
+      Scheduler.go ~config (Watermarks.subst ());
       exit 0
     in
     let display = ref None in

src/stdune/sexp.ml

@@ -245,6 +245,11 @@ module Of_sexp = struct
 
   let junk = next ignore
 
+  let junk_everything : type k. (unit, k) parser = fun ctx state ->
+    match ctx with
+    | Values _ -> ((), [])
+    | Fields _ -> ((), { state with unparsed = Name_map.empty })
+
   let plain_string f =
     next (function
       | Atom (loc, A s) | Quoted_string (loc, s) -> f ~loc s

src/stdune/sexp.mli

@@ -163,6 +163,9 @@ module Of_sexp : sig
   (** Consume and ignore the next element of the input *)
   val junk : unit t
 
+  (** Ignore all the rest of the input *)
+  val junk_everything : (unit, _) parser
+
   (** [plain_string f] expects the next element of the input to be a
       plain string, i.e. either an atom or a quoted string, but not a
       template nor a list. *)

src/watermarks.ml

@@ -19,7 +19,7 @@ let is_a_source_file fn =
   | _ -> true
 
 let make_watermark_map ~name ~version ~commit =
-  let opam_file = Opam_file.load (Path.of_string (name ^ ".opam")) in
+  let opam_file = Opam_file.load (Path.in_source (name ^ ".opam")) in
   let version_num =
     if String.is_prefix version ~prefix:"v" then
       String.sub version ~pos:1 ~len:(String.length version - 1)
@@ -164,6 +164,9 @@ let subst_file path ~map =
   | None -> ()
   | Some s -> Io.write_file path s
 
+let read_project_name () =
+  Dune_project.read_name (Path.in_source Dune_project.filename)
+
 let get_name ~files ?name () =
   let package_names =
     List.filter_map files ~f:(fun fn ->
@@ -174,28 +177,53 @@ let get_name ~files ?name () =
       else
         None)
   in
-  if package_names = [] then die "@{<error>Error@}: no <package>.opam files found.";
-  match name with
-  | Some name ->
-    if not (List.mem name ~set:package_names) then
-      die "@{<error>Error@}: file %s.opam doesn't exist." name;
-    name
-  | None ->
-    let shortest =
-      match package_names with
-      | [] -> assert false
-      | first :: rest ->
-        List.fold_left rest ~init:first ~f:(fun acc s ->
-          if String.length s < String.length acc then
-            s
+  if package_names = [] then
+    die "@{<error>Error@}: no <package>.opam files found.";
+  let name =
+    match Which_program.t with
+    | Dune -> begin
+        assert (Option.is_none name);
+        if not (List.mem ~set:files Dune_project.filename) then
+          die "@{<error>Error@}: There is no dune-project file in the current \
+               directory, please add one with a (name <name>) field in it.\n\
+               Hint: dune subst must be executed from the root of the project.";
+        match read_project_name () with
+        | None ->
+          die "@{<error>Error@}: The project name is not defined, please add \
+               a (name <name>) field to your dune-project file."
+        | Some name -> name
+      end
+    | Jbuilder ->
+      match name with
+      | Some name -> name
+      | None ->
+        match
+          if List.mem ~set:files Dune_project.filename then
+            read_project_name ()
           else
-            acc)
-    in
-    if List.for_all package_names ~f:(String.is_prefix ~prefix:shortest) then
-      shortest
-    else
-      die "@{<error>Error@}: cannot determine name automatically.\n\
-           You must pass a [--name] command line argument."
+            None
+        with
+        | Some name -> name
+        | None ->
+          let shortest =
+            match package_names with
+            | [] -> assert false
+            | first :: rest ->
+              List.fold_left rest ~init:first ~f:(fun acc s ->
+                if String.length s < String.length acc then
+                  s
+                else
+                  acc)
+          in
+          if List.for_all package_names ~f:(String.is_prefix ~prefix:shortest) then
+            shortest
+          else
+            die "@{<error>Error@}: cannot determine name automatically.\n\
+                 You must pass a [--name] command line argument."
+  in
+  if not (List.mem name ~set:package_names) then
+    die "@{<error>Error@}: file %s.opam doesn't exist." name;
+  name
 
 let subst_git ?name () =
   let rev = "HEAD" in
@@ -224,7 +252,7 @@ let subst_git ?name () =
   let watermarks = make_watermark_map ~name ~version ~commit in
   List.iter files ~f:(fun fn ->
     if is_a_source_file fn then
-      subst_file (Path.of_string fn) ~map:watermarks);
+      subst_file (Path.in_source fn) ~map:watermarks);
   Fiber.return ()
 
 let subst ?name () =

test/blackbox-tests/dune.inc

@@ -571,6 +571,14 @@
    test-cases/select
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name subst)
+ (deps (package dune) (source_tree test-cases/subst))
+ (action
+  (chdir
+   test-cases/subst
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name syntax-versioning)
  (deps (package dune) (source_tree test-cases/syntax-versioning))
@@ -688,6 +696,7 @@
   (alias scope-bug)
   (alias scope-ppx-bug)
   (alias select)
+  (alias subst)
   (alias syntax-versioning)
   (alias tests-stanza)
   (alias use-meta)
@@ -756,6 +765,7 @@
   (alias scope-bug)
   (alias scope-ppx-bug)
   (alias select)
+  (alias subst)
   (alias syntax-versioning)
   (alias tests-stanza)
   (alias use-meta)

test/blackbox-tests/test-cases/subst/dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.0)
+(name foo)

test/blackbox-tests/test-cases/subst/file.ml

@@ -0,0 +1,3 @@
+let name = "%%NAME%%"
+let authors = "%%PKG_AUTHORS%%"
+let version = "%%VERSION%%"

test/blackbox-tests/test-cases/subst/foo.opam

@@ -0,0 +1 @@
+authors: [ "John Doe <john@doe.com>" ]

test/blackbox-tests/test-cases/subst/run.t

@@ -0,0 +1,13 @@
+  $ git init &> /dev/null
+  $ git add . &> /dev/null
+  $ git commit -am _ &> /dev/null
+  $ git tag -a 1.0 -m 1.0
+  $ dune subst
+  $ cat file.ml
+  let name = "foo"
+  let authors = "John Doe <john@doe.com>"
+  let version = "1.0"
+
+To avoid the issue exposed in ../action-modifying-a-dependency:
+
+  $ git reset --hard &> /dev/null