named targets

Signed-off-by: Anthony Onah <[email protected]>

Author: create2000

src/dune_lang/action.ml

@@ -1,6 +1,11 @@
 open Stdune
 open Dune_sexp
 open Dune_util.Action
+open Pform.Macro
+
+module Named_targets = struct
+  type t = (string * String_with_vars.t) list
+end
 
 module Action_plugin = struct
   let syntax =
@@ -12,6 +17,55 @@ module Action_plugin = struct
   ;;
 end
 
+module Pform = struct
+  module Var = struct
+    type t =
+      | Values
+      | Loc
+      | C_flags
+      | Cxx_flags
+      | Cpp_flags
+      | Target of string  (* New variant for named targets *)
+      | Ocaml
+      | Ocamlc
+      | Ocamlopt
+      | Ocamldep
+      | Ocamlmklib
+      | Dev_null
+      | Null
+      | Ext_obj
+      | Ext_asm
+      | Ext_lib
+      | Ext_dll
+      | Ext_exe
+      | Ext_plugin
+      | Profile
+      | Context_name
+      | Os_type
+      | Architecture
+      | System
+      | Model
+      | Ignoring_promoted_rules
+      | Project_root
+      | Workspace_root
+      | Build_context
+      | First_dep
+      | Input_file
+      | Library_name
+      | Partition
+      | Impl_files
+      | Intf_files
+      | Test
+      | Corrected_suffix
+      | Inline_tests
+      | Toolchain
+
+    let compare = compare
+  end
+  type t =
+    | Var of Var.t
+end
+
 module Diff = struct
   include Diff
 
@@ -178,14 +232,63 @@ type t =
   | When of Slang.blang * t
   | Format_dune_file of String_with_vars.t * String_with_vars.t
 
+type expansion_context = {
+  dir : Path.t;
+  (* ... other fields ... *)
+  named_targets : Named_targets.t;
+}
 let is_dev_null t = String_with_vars.is_pform t (Var Dev_null)
 
 let translate_to_ignore fn output action =
   if is_dev_null fn
   then Ignore (output, action)
   else Redirect_out (output, fn, Normal, action)
 ;;
+let expand_target_var ~loc ~named_targets name =
+  match List.assoc_opt name named_targets with
+  | Some target -> 
+    (match String_with_vars.text_only target with
+     | Some text -> text
+     | None ->
+       User_error.raise ~loc [
+         Pp.textf "Named target '%s' contains variables and cannot be expanded here" name
+       ])
+  | None ->
+    User_error.raise ~loc [
+      Pp.textf "Undefined named target: %s" name;
+      Pp.text "Available named targets:";
+      Pp.enumerate named_targets ~f:(fun (name, _) -> Pp.text name)
+    ]
+  ;;
+let expand_str ~context sw =
+  let module S = String_with_vars in
+
+  match S.text_only sw with
+  | Some s -> s
+  | None ->
+    let expand_var = function
+      | Pform.Var var ->
+        if String.equal (Pform.Var.to_string var) "target" then
+          (match context.named_targets with
+          | (name, target) :: _ -> S.to_string target
+          | [] -> "%{target}")
+        else
+          S.to_string (S.make_var (S.loc sw) (Pform.Var var))
+    in
+    S.expand sw ~f:expand_var
+    ;;  
 
+let create_action targets action =
+  let named_targets = 
+    List.filter_map targets ~f:(fun (target, _, name) ->
+      Option.map name ~f:(fun n -> (n, target)))
+  in
+  { action with 
+    expansion_context = { 
+      dir = Path.root;
+      named_targets 
+    } 
+  }
 let two_or_more decode =
   let open Decoder in
   let+ n1 = decode
@@ -255,6 +358,19 @@ let decode_with_accepted_exit_codes =
             ]
 ;;
 
+let decode_rule =
+  let open Decoder in
+  let* targets = 
+    repeat (
+      let* target = String_with_vars.decode in
+      let* name = optional string in
+      return (target, (), name)
+    )
+  in
+  let* action = decode_dune_file in
+  return (create_action targets action)
+;;
+
 let sw = String_with_vars.decode
 
 let cstrs_dune_file t =

src/dune_lang/targets_spec.ml

@@ -1,5 +1,8 @@
 open Stdune
 
+
+module Hashtbl = Stdlib.Hashtbl
+
 module Multiplicity = struct
   type t =
     | One
@@ -33,43 +36,53 @@ module Kind = struct
 end
 
 module Static = struct
-  type 'path t =
-    { targets : ('path * Kind.t) list
-    ; multiplicity : Multiplicity.t
-    }
+  type 'path t = {
+  targets : ('path * Kind.t * string option) list;
+  multiplicity : Multiplicity.t;
+}
+
 end
 
 type 'a t =
   | Static of 'a Static.t
   | Infer
 
+  let named_targets : (string, String_with_vars.t) Hashtbl.t = Hashtbl.create 16
 let decode_target ~allow_directory_targets =
   let open Dune_sexp.Decoder in
-  let file =
-    let+ file = String_with_vars.decode in
-    file, Kind.File
+  let base_target =
+    let file = 
+      let+ file = String_with_vars.decode in
+      (file, Kind.File, None)
+    in
+    let dir =
+      let+ dir = sum ~force_parens:true [ "dir", String_with_vars.decode ] in
+      if not allow_directory_targets then
+        User_error.raise ~loc:(String_with_vars.loc dir)
+          [ Pp.text "Directory targets require extension" ];
+      (dir, Kind.Directory, None)
+    in
+    file <|> dir
   in
-  let dir =
-    let+ dir = sum ~force_parens:true [ "dir", String_with_vars.decode ] in
-    if not allow_directory_targets
-    then
-      User_error.raise
-        ~loc:(String_with_vars.loc dir)
-        [ Pp.text "Directory targets require the 'directory-targets' extension" ];
-    dir, Kind.Directory
+    
+  let named_target =
+    let+ name, (target, kind, _) = 
+      sum ~force_parens:true [ "named", pair string base_target ] in
+    Hashtbl.add named_targets name target;
+    (target, kind, Some name)
   in
-  file <|> dir
+  
+  named_target <|> base_target
 ;;
 
+(* src/dune_lang/targets_spec.ml *)
 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_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
+  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
@@ -78,13 +91,15 @@ let decode_static ~allow_directory_targets =
   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 }
 ;;
 
+
 let field ~allow_directory_targets =
   let open Dune_sexp.Decoder in
   fields_mutually_exclusive
@@ -93,3 +108,6 @@ let field ~allow_directory_targets =
     ; "targets", decode_static ~allow_directory_targets
     ]
 ;;
+
+let get_target_by_name name =
+  Hashtbl.find_opt named_targets name

src/dune_lang/targets_spec.mli

@@ -18,8 +18,8 @@ end
 
 module Static : sig
   type 'path t =
-    { targets : ('path * Kind.t) list
-    ; multiplicity : Multiplicity.t
+    { targets : ('path * Kind.t * string option) list;
+     multiplicity : Multiplicity.t
     }
 end
 
@@ -34,3 +34,5 @@ type 'a t =
 val field
   :  allow_directory_targets:bool
   -> String_with_vars.t t Dune_sexp.Decoder.fields_parser
+  
+val get_target_by_name : string -> String_with_vars.t option

test/blackbox-tests/test-cases/dune

@@ -174,3 +174,7 @@
  (applies_to hidden-deps-unsupported)
  (enabled_if
   (< %{ocaml_version} 5.2.0)))
+
+(rule
+ (alias named-targets)
+ (action (run %{bin:bash} ./named-targets.t)))

test/blackbox-tests/test-cases/named-targets.t

@@ -0,0 +1,35 @@
+#!/usr/bin/env bash
+set -euo pipefail
+
+# Setup test environment
+WORKDIR=$(mktemp -d)
+trap 'rm -rf "$WORKDIR"' EXIT
+cd "$WORKDIR"
+
+# Create test files
+cat > dune-project <<'EOF'
+(lang dune 3.0)
+EOF
+
+cat > dune <<'EOF'
+(rule
+ (targets output.txt secondary.log)
+ (action
+  (progn
+   (write-file output.txt "Primary content")
+   (write-file secondary.log "Log content"))))
+
+(rule
+ (alias runtest)
+ (action
+  (progn
+   (diff output.txt output.expected)
+   (diff secondary.log secondary.expected))))
+EOF
+
+# Create expected files - MUST match exactly what's generated
+printf "Primary content" > output.expected
+printf "Log content" > secondary.expected
+
+# Run the test
+dune build @runtest

test/dune

@@ -3,6 +3,8 @@
 ;; $ ./_build/default/bin/main.exe build @test/fail-with-background-jobs-running
 ;;
 
+(include_subdirs no)  ; Disable automatic inclusion
+
 (rule
  (alias sleep5)
  (action
@@ -157,3 +159,7 @@
  (action
   (run ./incr.exe y %{targets}))
  (locks m))
+
+(rule
+ (alias runtest)
+ (action (diff output.txt output.expected)))