Make "dune subst" add a version field to dune-project

CHANGES.md

@@ -62,6 +62,9 @@ unreleased
 
 - Fix generation of the `-pp` flag in .merlin (#2142, @rgrinberg)
 
+- Make `dune subst` add a `(version ...)` field to the `dune-project`
+  file (#2148, @diml)
+
 1.9.3 (06/05/2019)
 ------------------
 

src/dune_project.ml

@@ -733,14 +733,6 @@ let make_jbuilder_project ~dir opam_packages =
   ; generate_opam_files = false
   }
 
-let read_name file =
-  load file ~f:(fun _lang ->
-    fields
-      (let+ name = field_o "name" (located string)
-       and+ () = junk_everything
-       in
-       name))
-
 let load ~dir ~files =
   let opam_packages =
     String.Set.fold files ~init:[] ~f:(fun fn acc ->

src/dune_project.mli

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

src/watermarks.ml

@@ -163,10 +163,99 @@ 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)
+(* Minimal API for dune-project files that makes as little assumption
+   about the contents as possible and keeps enough info for editing
+   the file. *)
+module Dune_project = struct
+  type 'a simple_field =
+    { loc : Loc.t
+    ; loc_of_arg : Loc.t
+    ; arg : 'a
+    }
 
-let get_name ~files ?name () =
+  type t =
+    { contents : string
+    ; name : string simple_field option
+    ; version : string simple_field option
+    }
+
+  let file = Path.in_source Dune_project.filename
+
+  let load file =
+    let s = Io.read_file file in
+    let lb = Lexing.from_string s in
+    lb.lex_curr_p <-
+      { pos_fname = Path.to_string file
+      ; pos_lnum  = 1
+      ; pos_bol   = 0
+      ; pos_cnum  = 0
+      };
+    let sexp = Dune_lang.Parser.parse lb ~mode:Many_as_one in
+    let parser =
+      let open Dune_lang.Decoder in
+      let simple_field name arg =
+        let+ loc, x = located (field_o name (located arg)) in
+        match x with
+        | Some (loc_of_arg, arg) -> Some { loc; loc_of_arg; arg }
+        | None -> None
+      in
+      enter
+        (fields
+           (let+ name = simple_field "name" string
+            and+ version = simple_field "version" string
+            and+ () = junk_everything
+            in
+            { contents = s; name; version }))
+    in
+    Dune_lang.Decoder.parse parser Univ_map.empty sexp
+
+  let subst t ~map ~version =
+    let s =
+      let replace_text start_ofs stop_ofs repl =
+        sprintf "%s%s%s"
+          (String.sub t.contents ~pos:0 ~len:start_ofs)
+          repl
+          (String.sub t.contents ~pos:stop_ofs
+             ~len:(String.length t.contents - stop_ofs))
+      in
+      match t.version with
+      | Some v ->
+        (* There is a [version] field, overwrite its argument *)
+        replace_text v.loc_of_arg.start.pos_cnum v.loc_of_arg.stop.pos_cnum
+          (Dune_lang.to_string (Dune_lang.atom_or_quoted_string version)
+             ~syntax:Dune)
+      | None ->
+        let version_field =
+          Dune_lang.to_string ~syntax:Dune
+            (List [ Dune_lang.atom "version"
+                  ; Dune_lang.atom_or_quoted_string version
+                  ])
+          ^ "\n"
+        in
+        let ofs = ref (
+          match t.name with
+          | Some { loc; _ } ->
+            (* There is no [version] field but there is a [name] one,
+               add the version after it *)
+            loc.stop.pos_cnum
+          | None ->
+            (* If all else fails, add the [version] field after the
+               first line of the file *)
+            0)
+        in
+        let len = String.length t.contents in
+        while !ofs < len && t.contents.[!ofs] <> '\n' do incr ofs done;
+        if !ofs < len && t.contents.[!ofs] = '\n' then begin
+          incr ofs;
+          replace_text !ofs !ofs version_field
+        end else
+          replace_text !ofs !ofs ("\n" ^ version_field)
+    in
+    let s = Option.value (subst_string s ~map file) ~default:s in
+    if s <> t.contents then Io.write_file file s
+end
+
+let get_name ~files ~(dune_project : Dune_project.t option) ?name () =
   let package_names =
     List.filter_map files ~f:(fun fn ->
       match Path.parent fn with
@@ -178,35 +267,29 @@ let get_name ~files ?name () =
       end
       | _ -> None)
   in
-  let dune_project_file = Path.in_source Dune_project.filename in
   if package_names = [] then
     die "@{<error>Error@}: no <package>.opam files found.";
   let (loc, name) =
     match Wp.t with
     | Dune -> begin
         assert (Option.is_none name);
-        if not (List.mem ~set:files dune_project_file) then
+        match dune_project with
+        | None ->
           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 ->
+               Hint: dune subst must be executed from the root of the project."
+        | Some { name = None; _ } ->
           die "@{<error>Error@}: The project name is not defined, please add \
                a (name <name>) field to your dune-project file."
-        | Some name -> name
+        | Some { name = Some n; _ } -> (n.loc_of_arg, n.arg)
       end
     | Jbuilder ->
       match name with
       | Some name -> (Loc.none, name)
       | None ->
-        match
-          if List.mem ~set:files dune_project_file then
-            read_project_name ()
-          else
-            None
-        with
-        | Some name -> name
-        | None ->
+        match dune_project with
+        | Some { name = Some n; _ } -> (n.loc_of_arg, n.arg)
+        | _ ->
           let name =
             let prefix = String.longest_prefix package_names in
             if prefix = "" then
@@ -246,10 +329,17 @@ let subst ?name vcs =
            (fun () -> Vcs.commit_id vcs))
       (fun () -> Vcs.files vcs)
   in
-  let name = get_name ~files ?name () in
+  let dune_project =
+    if List.exists files ~f:(Path.equal Dune_project.file) then
+      Some (Dune_project.load Dune_project.file)
+    else
+      None
+  in
+  let name = get_name ~files ~dune_project ?name () in
   let watermarks = make_watermark_map ~name ~version ~commit in
+  Option.iter dune_project ~f:(Dune_project.subst ~map:watermarks ~version);
   List.iter files ~f:(fun path ->
-    if is_a_source_file path then
+    if is_a_source_file path && not (Path.equal path Dune_project.file) then
       subst_file path ~map:watermarks)
 
 let subst ?name () =

test/blackbox-tests/test-cases/dune-project-meta/run.t

@@ -133,8 +133,8 @@ The following behavior is wrong, the version should be set in stone
 after running `dune subst`:
 
   $ grep ^version version/foo.opam
-  [1]
+  version: "1.0"
 
   $ grep ^version version/_build/default/META.foo
-  [1]
+  version = "1.0"
 

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

@@ -8,3 +8,7 @@
   let name = "foo"
   let authors = "John Doe <[email protected]>"
   let version = "1.0"
+  $ cat dune-project
+  (lang dune 1.0)
+  (name foo)
+  (version 1.0)