Named targets feature

src/dune_lang/targets_spec.ml

@@ -33,16 +33,23 @@ module Kind = struct
 end
 
 module Static = struct
-  type 'path t =
-    { targets : ('path * Kind.t) list
-    ; multiplicity : Multiplicity.t
-    }
+  (* Change to take the full pair as path *)
+  type ('path, 'kind) named = {
+    name : string option;
+    path : 'path * 'kind;  (* Now takes the tuple *)
+  }
+
+  type 'path t = {
+    targets : ('path, Kind.t) named list;  (* This now matches *)
+    multiplicity : Multiplicity.t;
+  }
 end
 
 type 'a t =
   | Static of 'a Static.t
   | Infer
 
+(* Move decode_target before decode_named_target *)
 let decode_target ~allow_directory_targets =
   let open Dune_sexp.Decoder in
   let file =
@@ -61,28 +68,71 @@ let decode_target ~allow_directory_targets =
   file <|> dir
 ;;
 
-let decode_static ~allow_directory_targets =
+let decode_named_target ~allow_directory_targets =
   let open Dune_sexp.Decoder in
-  let+ syntax_version = Dune_sexp.Syntax.get_exn Stanza.syntax
-  and+ targets = repeat (decode_target ~allow_directory_targets) in
-  if syntax_version < (1, 3)
-  then
-    List.iter targets ~f:(fun (target, (_ : Kind.t)) ->
-      if String_with_vars.has_pforms target
-      then
-        Dune_sexp.Syntax.Error.since
-          (String_with_vars.loc target)
-          Stanza.syntax
-          (1, 3)
-          ~what:"Using variables in the targets field");
-  Static { targets; multiplicity = Multiple }
+  let named =
+    enter (
+      let* loc = loc in
+      let* sexp_opt = peek in
+      match sexp_opt with
+      | Some (sexp : Dune_sexp.Ast.t) ->
+        (match sexp with
+        | Atom (loc, atom) when String.is_prefix (Dune_sexp.Atom.to_string atom) ~prefix:":" ->
+          let* () = junk in
+          let+ target = decode_target ~allow_directory_targets in
+          let atom_str = Dune_sexp.Atom.to_string atom in
+          let name = 
+            match String.drop_prefix atom_str ~prefix:":" with
+            | Some name -> name
+            | None -> 
+                User_error.raise ~loc [ Pp.text "Expected ':' prefix but couldn't extract name" ]
+          in
+          { Static.name = Some name;
+            path = target;  (* target is already the (path, kind) tuple *)
+          }
+        | _ ->
+          let+ target = decode_target ~allow_directory_targets in
+          { Static.name = None;
+            path = target;  (* target is already the (path, kind) tuple *)
+          })
+      | None ->
+        let+ () = return () in
+        User_error.raise ~loc [ Pp.text "Expected an S-expression but got nothing" ]
+    )
+  in
+  named
+
+  let decode_static ~allow_directory_targets =
+    let open Dune_sexp.Decoder in
+    let+ syntax_version = Dune_sexp.Syntax.get_exn Stanza.syntax
+    and+ targets = repeat (decode_named_target ~allow_directory_targets) in
+    (* Check for variables in targets if using older syntax *)
+    if syntax_version < (1, 3) then
+      List.iter targets ~f:(fun target ->
+        let path = fst target.Static.path in  (* Extract just the path from the tuple *)
+        if String_with_vars.has_pforms path then
+          Dune_sexp.Syntax.Error.since
+            (String_with_vars.loc path)
+            Stanza.syntax
+            (1, 3)
+            ~what:"Using variables in the targets field");
+
+    (* Check for duplicate names *)
+    let names = List.filter_map targets ~f:(fun t -> t.Static.name) in
+    if List.length names <> String.Set.cardinal (String.Set.of_list names) then
+      User_error.raise ~loc:(Loc.of_pos __POS__) [ Pp.text "Duplicate target names found" ];
+
+    Static { targets; multiplicity = Multiple }
 ;;
 
 let decode_one_static ~allow_directory_targets =
   let open Dune_sexp.Decoder in
   let+ () = Dune_sexp.Syntax.since Stanza.syntax (1, 11)
-  and+ target = decode_target ~allow_directory_targets in
-  Static { targets = [ target ]; multiplicity = One }
+  and+ target = decode_named_target ~allow_directory_targets in
+  Static { 
+    targets = [ target ];  (* Directly use the target from decode_named_target *)
+    multiplicity = One 
+  }
 ;;
 
 let field ~allow_directory_targets =
@@ -92,4 +142,4 @@ let field ~allow_directory_targets =
     [ "target", decode_one_static ~allow_directory_targets
     ; "targets", decode_static ~allow_directory_targets
     ]
-;;
+;;

src/dune_lang/targets_spec.mli

@@ -17,10 +17,15 @@ module Kind : sig
 end
 
 module Static : sig
-  type 'path t =
-    { targets : ('path * Kind.t) list
-    ; multiplicity : Multiplicity.t
-    }
+  type ('path, 'kind) named = {
+    name : string option;
+    path : 'path * 'kind;  (* Now takes the tuple *)
+  }
+
+  type 'path t = {
+    targets : ('path, Kind.t) named list;  (* This now matches *)
+    multiplicity : Multiplicity.t;
+  }
 end
 
 (** [Static] targets are listed by the user while [Infer] denotes that Dune must

src/dune_pkg/fetch.ml

@@ -125,8 +125,10 @@ let label = "dune-fetch"
 
 let unpack_tarball ~target ~archive =
   Tar.extract ~archive ~target
-  >>| Result.map_error ~f:(fun () ->
-    Pp.textf "unable to extract %S" (Path.to_string archive))
+  >>| Result.map_error ~f:(fun err ->
+    let stderr_output = Format.asprintf "%a" Error.pp err in
+    Pp.textf "unable to extract %S\nDetails: %s" (Path.to_string archive) stderr_output
+  )
 ;;
 
 let check_checksum checksum path =

src/dune_rules/action_unexpanded.ml

@@ -640,8 +640,9 @@ let expand
                (Expander.Deps.Without
                   (Memo.return
                      (Value.L.paths
-                        (List.map targets ~f:(fun (target, (_ : Targets_spec.Kind.t)) ->
-                           Path.build target))))))
+                     (List.map targets ~f:(fun named_target ->
+                      let { Targets_spec.Static.path = (path_value, _kind); _ } = named_target in
+                      Path.build path_value))))))
     in
     Expander.set_expanding_what expander (User_action targets_written_by_user)
   in
@@ -653,7 +654,8 @@ let expand
     | Infer -> targets
     | Static { targets = targets_written_by_user; multiplicity = _ } ->
       let files, dirs =
-        List.partition_map targets_written_by_user ~f:(fun (path, kind) ->
+      List.partition_map targets_written_by_user ~f:(fun named_target ->
+        let { Targets_spec.Static.path = (path, kind); _ } = named_target in
           validate_target_dir ~targets_dir ~loc targets path;
           match kind with
           | File -> Left path

src/dune_rules/dir_status.ml

@@ -109,12 +109,13 @@ let directory_targets_of_rule ~dir { Rule_conf.targets; loc = rule_loc; enabled_
     Memo.return Path.Build.Map.empty
   | Static { targets; _ } ->
     let directory_targets =
-      List.fold_left targets ~init:Path.Build.Map.empty ~f:(fun acc (target, kind) ->
+      List.fold_left targets ~init:Path.Build.Map.empty ~f:(fun acc named_target ->
+        let { Targets_spec.Static.path = (string_with_vars, kind); _ } = named_target in
         match (kind : Targets_spec.Kind.t) with
         | File -> acc
         | Directory ->
-          let loc = String_with_vars.loc target in
-          (match String_with_vars.text_only target with
+          let loc = String_with_vars.loc string_with_vars in  (* Changed target to string_with_vars *)
+          (match String_with_vars.text_only string_with_vars with  (* Changed target to string_with_vars *)
            | None ->
              User_error.raise
                ~loc

src/dune_rules/simple_rules.ml

@@ -88,17 +88,25 @@ let user_rule sctx ?extra_bindings ~dir ~expander (rule : Rule_conf.t) =
       match rule.targets with
       | Infer -> Memo.return Targets_spec.Infer
       | Static { targets; multiplicity } ->
-        let+ targets =
-          Memo.List.concat_map targets ~f:(fun (target, kind) ->
+        let+ paths_with_kinds =
+          Memo.List.concat_map targets ~f:(fun named_target ->
+            let (string_with_vars, kind) = named_target.Targets_spec.Static.path in
             (match multiplicity with
              | One ->
-               Expander.No_deps.expand expander ~mode:Single target >>| List.singleton
-             | Multiple -> Expander.No_deps.expand expander ~mode:Many target)
+               Expander.No_deps.expand expander ~mode:Single string_with_vars >>| List.singleton
+             | Multiple -> 
+               Expander.No_deps.expand expander ~mode:Many string_with_vars)
             >>|
-            let error_loc = String_with_vars.loc target in
+            let error_loc = String_with_vars.loc string_with_vars in
             List.map ~f:(fun value -> check_filename ~kind ~dir ~error_loc value, kind))
         in
-        Targets_spec.Static { multiplicity; targets }
+        Targets_spec.Static {
+          multiplicity;
+          targets = List.map paths_with_kinds ~f:(fun (path, kind) ->
+            { Targets_spec.Static.name = None;  (* Preserve original name if needed *)
+              path = (path, kind);
+            }
+        )}
     in
     let expander =
       match extra_bindings with

src/dune_rules/stanzas/rule_conf.ml

@@ -6,21 +6,45 @@ module Mode = struct
   include Rule_mode_decoder
 end
 
-type t =
-  { targets : String_with_vars.t Targets_spec.t
-  ; deps : Dep_conf.t Bindings.t
-  ; action : Loc.t * Dune_lang.Action.t
-  ; mode : Rule.Mode.t
-  ; locks : Locks.t
-  ; loc : Loc.t
-  ; enabled_if : Blang.t
-  ; aliases : Alias.Name.t list
-  ; package : Package.t option
-  }
+module Targets_bindings = struct
+  type t = String_with_vars.t Bindings.t
+
+  let decode : t Dune_lang.Decoder.t =
+    let+ bindings = Bindings.decode String_with_vars.decode in
+    let names = Bindings.var_names bindings in
+    let unique_names = String.Set.of_list names in
+    if List.length names <> String.Set.cardinal unique_names then
+      User_error.raise ~loc:(Loc.of_pos __POS__)
+        [Pp.text "Duplicate target names found"];
+    bindings
+
+
+    let to_targets (bindings : t) : String_with_vars.t Targets_spec.t =
+      let targets = Bindings.to_list bindings in
+      Targets_spec.Static {
+        targets = List.map targets ~f:(fun path ->
+          { Targets_spec.Static.name = None;
+            path = (path, Targets_spec.Kind.File);
+          });
+        multiplicity = Multiple
+      }
+  end
+
+
+type t = {
+  targets : String_with_vars.t Targets_spec.t;
+  deps : Dep_conf.t Bindings.t;
+  action : Loc.t * Dune_lang.Action.t;
+  mode : Rule.Mode.t;
+  locks : Locks.t;
+  loc : Loc.t;
+  enabled_if : Blang.t;
+  aliases : Alias.Name.t list;
+  package : Package.t option;
+}
 
 include Stanza.Make (struct
     type nonrec t = t
-
     include Poly
   end)
 
@@ -92,30 +116,31 @@ let directory_targets_extension =
   Dune_project.Extension.register syntax (Dune_lang.Decoder.return ((), [])) Dyn.unit
 ;;
 
+
 let long_form =
   let* deps = field "deps" (Bindings.decode Dep_conf.decode) ~default:Bindings.empty in
   let* project = Dune_project.get_exn () in
-  let allow_directory_targets =
+  let _allow_directory_targets =
     Dune_project.is_extension_set project directory_targets_extension
   in
   String_with_vars.add_user_vars_to_decoding_env
     (Bindings.var_names deps)
-    (let+ loc = loc
-     and+ action_o = field_o "action" (located Dune_lang.Action.decode_dune_file)
-     and+ targets = Targets_spec.field ~allow_directory_targets
-     and+ locks = Locks.field ()
-     and+ () =
+    (let* targets = 
+       field "targets" ~default:(Targets_spec.Infer)
+         (Targets_bindings.decode >>| Targets_bindings.to_targets)
+     in
+     let* () =
        let+ fallback =
          field_b
            ~check:
              (Dune_lang.Syntax.renamed_in Stanza.syntax (1, 0) ~to_:"(mode fallback)")
            "fallback"
        in
-       (* The "fallback" field was only allowed in jbuild file, which we don't
-          support anymore. So this cannot be [true]. We just keep the parser
-          to provide a nice error message for people switching from jbuilder
-          to dune. *)
        assert (not fallback)
+     in
+     let+ loc = loc
+     and+ action_o = field_o "action" (located Dune_lang.Action.decode_dune_file)
+     and+ locks = Locks.field ()
      and+ mode = Mode.field
      and+ enabled_if = Enabled_if.decode ~allowed_vars:Any ~since:(Some (1, 4)) ()
      and+ package =
@@ -198,28 +223,33 @@ let ocamllex_to_rule loc { modules; mode; enabled_if } =
     let src = name ^ ".mll" in
     let dst = name ^ ".ml" in
     { targets =
-        (* CR-someday aalekseyev: want to use [multiplicity = One] here, but
-           can't because this is might get parsed with old dune syntax where
-           [multiplicity = One] is not supported. *)
-        Static { targets = [ S.make_text loc dst, File ]; multiplicity = Multiple }
-    ; deps = Bindings.singleton (Dep_conf.File (S.virt_text __POS__ src))
-    ; action =
-        ( loc
-        , Chdir
-            ( S.virt_pform __POS__ (Var Workspace_root)
-            , Dune_lang.Action.run
+        Static {
+          targets = [
+            {
+              Targets_spec.Static.name = None;
+              path = (S.make_text loc dst, Targets_spec.Kind.File);
+            }
+          ];
+          multiplicity = Multiple
+        };
+      deps = Bindings.singleton (Dep_conf.File (S.virt_text __POS__ src));
+      action =
+        ( loc,
+          Chdir
+            ( S.virt_pform __POS__ (Var Workspace_root),
+              Dune_lang.Action.run
                 (S.virt_text __POS__ "ocamllex")
-                [ S.virt_text __POS__ "-q"
-                ; S.virt_text __POS__ "-o"
-                ; S.virt_pform __POS__ (Var Targets)
-                ; S.virt_pform __POS__ (Var Deps)
-                ] ) )
-    ; mode
-    ; locks = []
-    ; loc
-    ; enabled_if
-    ; aliases = []
-    ; package = None
+                [ S.virt_text __POS__ "-q";
+                  S.virt_text __POS__ "-o";
+                  S.virt_pform __POS__ (Var Targets);
+                  S.virt_pform __POS__ (Var Deps);
+                ] ) );
+      mode;
+      locks = [];
+      loc;
+      enabled_if;
+      aliases = [];
+      package = None;
     })
 ;;
 
@@ -230,9 +260,13 @@ let ocamlyacc_to_rule loc { modules; mode; enabled_if } =
     { targets =
         Static
           { targets =
-              List.map
-                [ name ^ ".ml"; name ^ ".mli" ]
-                ~f:(fun target -> S.make_text loc target, Targets_spec.Kind.File)
+          List.map
+          [ name ^ ".ml"; name ^ ".mli" ]
+          ~f:(fun target -> 
+            { Targets_spec.Static.name = None;
+              path = (S.make_text loc target, Targets_spec.Kind.File);
+            }
+          )
           ; multiplicity = Multiple
           }
     ; deps = Bindings.singleton (Dep_conf.File (S.virt_text __POS__ src))