Switch to (dir target), adjust tests

Signed-off-by: Andrey Mokhov <[email protected]>

Author: snowleopard

bin/print_rules.ml

@@ -54,22 +54,25 @@ let print_rule_sexp ppf (rule : Dune_engine.Reflection.Rule.t) =
     Action.for_shell action |> Action.For_shell.encode
   in
   let paths ps = Dune_lang.Encoder.list Dpath.encode (Path.Set.to_list ps) in
-  let file_targets, dir_targets =
-    Dune_engine.Targets.map rule.targets ~f:(fun ~files ~dirs -> (files, dirs))
-  in
-  let targets =
-    Path.Build.Set.union file_targets
-      (Path.Build.Set.map dir_targets ~f:(fun target ->
-           Path.Build.relative target "*"))
+  let file_targets =
+    Dune_engine.Targets.map rule.targets ~f:(fun ~files ~dirs ->
+        if not (Path.Build.Set.is_empty dirs) then
+          User_error.raise
+            [ Pp.text
+                "Printing rules with directory targets is currently not \
+                 supported"
+            ];
+
+        files)
   in
   let sexp =
     Dune_lang.Encoder.record
       (List.concat
          [ [ ("deps", Dep.Set.encode rule.deps)
            ; ( "targets"
              , paths
-                 (Path.Build.Set.to_list targets |> Path.set_of_build_paths_list)
-             )
+                 (Path.Build.Set.to_list file_targets
+                 |> Path.set_of_build_paths_list) )
            ]
          ; (match rule.context with
            | None -> []

src/dune_engine/string_with_vars.ml

@@ -312,14 +312,6 @@ let text_only t =
   | [ Text s ] -> Some s
   | _ -> None
 
-let last_text_part t =
-  List.filter_map t.parts ~f:(function
-    | Text s -> Some s
-    | Error _
-    | Pform _ ->
-      None)
-  |> List.last
-
 let has_pforms t = Option.is_none (text_only t)
 
 let encode t =

src/dune_engine/string_with_vars.mli

@@ -54,9 +54,6 @@ val has_pforms : t -> bool
 (** If [t] contains no variable, returns the contents of [t]. *)
 val text_only : t -> string option
 
-(** The last text part of [t], if any. *)
-val last_text_part : t -> string option
-
 module Mode : sig
   (** How many values expansion of a template must produce.
 

src/dune_rules/action_unexpanded.ml

@@ -516,11 +516,8 @@ let expand t ~loc ~deps:deps_written_by_user ~targets_dir
   let deps_builder, expander =
     Dep_conf_eval.named ~expander deps_written_by_user
   in
-  let untagged_targets_written_by_user =
-    Targets_spec.untag targets_written_by_user
-  in
   let expander =
-    match (untagged_targets_written_by_user : _ Targets_spec.t) with
+    match (targets_written_by_user : _ Targets_spec.t) with
     | Infer -> expander
     | Static { targets; multiplicity } ->
       Expander.add_bindings_full expander
@@ -532,11 +529,13 @@ let expand t ~loc ~deps:deps_written_by_user ~targets_dir
                 | Multiple -> Targets))
              (Expander.Deps.Without
                 (Memo.Build.return
-                   (Value.L.paths (List.map targets ~f:Path.build)))))
+                   (Value.L.paths
+                      (List.map targets
+                         ~f:(fun (target, (_ : Targets_spec.Kind.t)) ->
+                           Path.build target))))))
   in
   let expander =
-    Expander.set_expanding_what expander
-      (User_action untagged_targets_written_by_user)
+    Expander.set_expanding_what expander (User_action targets_written_by_user)
   in
   let+! { Action_builder.With_targets.build; targets } =
     Action_expander.run (expand t) ~expander
@@ -546,17 +545,17 @@ let expand t ~loc ~deps:deps_written_by_user ~targets_dir
     | Infer -> targets
     | Static { targets = targets_written_by_user; multiplicity = _ } ->
       let files, dirs =
-        List.partition_map targets_written_by_user ~f:(fun (path, tag) ->
+        List.partition_map targets_written_by_user ~f:(fun (path, kind) ->
             if Path.Build.(parent_exn path <> targets_dir) then
               User_error.raise ~loc
                 [ Pp.text
                     "This action has targets in a different directory than the \
                      current one, this is not allowed by dune at the moment:"
                 ; Targets.pp targets
                 ];
-            match tag with
-            | None -> Left path
-            | Star -> Right path)
+            match kind with
+            | File -> Left path
+            | Directory -> Right path)
       in
       let files = Path.Build.Set.of_list files in
       let dirs = Path.Build.Set.of_list dirs in

src/dune_rules/action_unexpanded.mli

@@ -31,7 +31,7 @@ val expand :
   -> loc:Loc.t
   -> deps:Dep_conf.t Bindings.t
   -> targets_dir:Path.Build.t
-  -> targets:(Path.Build.t * Targets_spec.Tag.t) Targets_spec.t
+  -> targets:Path.Build.t Targets_spec.t
   -> expander:Expander.t
   -> Action.t Action_builder.With_targets.t Memo.Build.t
 

src/dune_rules/dune_file.ml

@@ -1639,14 +1639,14 @@ module Rule = struct
       field "deps" (Bindings.decode Dep_conf.decode) ~default:Bindings.empty
     in
     let* project = Dune_project.get_exn () in
-    let disallow_directory_targets =
-      Option.is_none
+    let allow_directory_targets =
+      Option.is_some
         (Dune_project.find_extension_args project directory_targets_extension)
     in
     String_with_vars.add_user_vars_to_decoding_env (Bindings.var_names deps)
       (let+ loc = loc
        and+ action = field "action" (located Action_dune_lang.decode)
-       and+ targets = Targets_spec.field
+       and+ targets = Targets_spec.field ~allow_directory_targets
        and+ locks = field "locks" (repeat String_with_vars.decode) ~default:[]
        and+ () =
          let+ fallback =
@@ -1672,13 +1672,6 @@ module Rule = struct
          field_o "alias"
            (Dune_lang.Syntax.since Stanza.syntax (2, 0) >>> Alias.Name.decode)
        in
-       if
-         disallow_directory_targets && Targets_spec.has_target_directory targets
-       then
-         User_error.raise ~loc
-           [ Pp.text
-               "Directory targets require the 'directory-targets' extension"
-           ];
        { targets; deps; action; mode; locks; loc; enabled_if; alias; package })
 
   let decode =
@@ -1726,7 +1719,9 @@ module Rule = struct
                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 ]; multiplicity = Multiple }
+              { targets = [ (S.make_text loc dst, File) ]
+              ; multiplicity = Multiple
+              }
         ; deps = Bindings.singleton (Dep_conf.File (S.virt_text __POS__ src))
         ; action =
             ( loc
@@ -1754,7 +1749,8 @@ module Rule = struct
         { targets =
             Static
               { targets =
-                  List.map ~f:(S.make_text loc) [ name ^ ".ml"; name ^ ".mli" ]
+                  List.map [ name ^ ".ml"; name ^ ".mli" ] ~f:(fun target ->
+                      (S.make_text loc target, Targets_spec.Kind.File))
               ; multiplicity = Multiple
               }
         ; deps = Bindings.singleton (Dep_conf.File (S.virt_text __POS__ src))

src/dune_rules/simple_rules.ml

@@ -28,17 +28,12 @@ let check_filename =
       User_error.raise ~loc:error_loc
         [ Pp.text "'.' and '..' are not valid filenames" ]
     | String s ->
-      let s, tag =
-        match String.drop_suffix s ~suffix:"/*" with
-        | None -> (s, Targets_spec.Tag.None)
-        | Some s -> (s, Star)
-      in
       if Filename.dirname s <> Filename.current_dir_name then
         not_in_dir ~error_loc s;
-      (Path.Build.relative ~error_loc dir s, tag)
+      Path.Build.relative ~error_loc dir s
     | Path p -> (
       match Option.equal Path.equal (Path.parent p) (Some (Path.build dir)) with
-      | true -> (Path.as_in_build_dir_exn p, Targets_spec.Tag.None)
+      | true -> Path.as_in_build_dir_exn p
       | false -> not_in_dir ~error_loc (Path.to_string p))
     | Dir p -> not_in_dir ~error_loc (Path.to_string p)
 
@@ -81,14 +76,15 @@ let user_rule sctx ?extra_bindings ~dir ~expander (rule : Rule.t) =
       | Infer -> Memo.Build.return Targets_spec.Infer
       | Static { targets; multiplicity } ->
         let+ targets =
-          Memo.Build.List.concat_map targets ~f:(fun target ->
+          Memo.Build.List.concat_map targets ~f:(fun (target, kind) ->
               let error_loc = String_with_vars.loc target in
               (match multiplicity with
               | One ->
                 let+ x = Expander.No_deps.expand expander ~mode:Single target in
                 [ x ]
               | Multiple -> Expander.No_deps.expand expander ~mode:Many target)
-              >>| List.map ~f:(check_filename ~dir ~error_loc))
+              >>| List.map ~f:(fun value ->
+                      (check_filename ~dir ~error_loc value, kind)))
         in
         Targets_spec.Static { multiplicity; targets }
     in

src/dune_rules/targets_spec.ml

@@ -25,15 +25,15 @@ end
 
 (* CR-someday amokhov: Add more interesting tags, for example, to allow the user
    to specify file patterns like "*.ml" for directory targets. *)
-module Tag = struct
+module Kind = struct
   type t =
-    | None
-    | Star
+    | File
+    | Directory
 end
 
 module Static = struct
   type 'path t =
-    { targets : 'path list
+    { targets : ('path * Kind.t) list
     ; multiplicity : Multiplicity.t
     }
 end
@@ -42,39 +42,44 @@ type 'a t =
   | Static of 'a Static.t
   | Infer
 
-let decode_static =
+let decode_target ~allow_directory_targets =
+  let open Dune_lang.Decoder in
+  let file =
+    let+ file = String_with_vars.decode in
+    (file, Kind.File)
+  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)
+  in
+  file <|> dir
+
+let decode_static ~allow_directory_targets =
   let open Dune_lang.Decoder in
   let+ syntax_version = Dune_lang.Syntax.get_exn Stanza.syntax
-  and+ targets = repeat String_with_vars.decode in
+  and+ targets = repeat (decode_target ~allow_directory_targets) in
   if syntax_version < (1, 3) then
-    List.iter targets ~f:(fun target ->
+    List.iter targets ~f:(fun (target, (_ : Kind.t)) ->
         if String_with_vars.has_pforms target then
           Dune_lang.Syntax.Error.since
             (String_with_vars.loc target)
             Stanza.syntax (1, 3) ~what:"Using variables in the targets field");
   Static { targets; multiplicity = Multiple }
 
-let decode_one_static =
+let decode_one_static ~allow_directory_targets =
   let open Dune_lang.Decoder in
   let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 11)
-  and+ target = String_with_vars.decode in
+  and+ target = decode_target ~allow_directory_targets in
   Static { targets = [ target ]; multiplicity = One }
 
-let field =
+let field ~allow_directory_targets =
   let open Dune_lang.Decoder in
   fields_mutually_exclusive ~default:Infer
-    [ ("targets", decode_static); ("target", decode_one_static) ]
-
-let has_target_directory = function
-  | Infer -> false
-  | Static { targets; _ } ->
-    List.exists targets ~f:(fun target ->
-        match String_with_vars.last_text_part target with
-        | None -> false
-        | Some part -> Option.is_some (String.drop_suffix ~suffix:"/*" part))
-
-let untag = function
-  | Infer -> Infer
-  | Static { targets; multiplicity } ->
-    let targets = List.map targets ~f:fst in
-    Static { targets; multiplicity }
+    [ ("targets", decode_static ~allow_directory_targets)
+    ; ("target", decode_one_static ~allow_directory_targets)
+    ]

src/dune_rules/targets_spec.mli

@@ -11,32 +11,27 @@ module Multiplicity : sig
   val check_variable_matches_field : loc:Loc.t -> field:t -> variable:t -> unit
 end
 
-(** Tags are used to distinguish file and directory targets. Specifically, a
-    directory target is specified by adding "/*" at the end. *)
-module Tag : sig
+module Kind : sig
   type t =
-    | None
-    | Star  (** Ends with "/*", i.e. "output/*" *)
+    | File
+    | Directory
 end
 
 module Static : sig
   type 'path t =
-    { targets : 'path list  (** Here ['path] may be tagged with [Tag.t]. *)
+    { targets : ('path * Kind.t) list
     ; multiplicity : Multiplicity.t
     }
 end
 
-(** Static targets are listed by the user while [Infer] denotes that dune must
-    discover all the targets. In the [Static] case, dune still implicitly adds
+(** Static targets are listed by the user while [Infer] denotes that Dune must
+    discover all the targets. In the [Static] case, Dune still implicitly adds
     the list of inferred targets. *)
 type 'a t =
   | Static of 'a Static.t
   | Infer
 
 (** [target] or [targets] field with the correct multiplicity. *)
-val field : String_with_vars.t t Dune_lang.Decoder.fields_parser
-
-(** Contains a directory target. *)
-val has_target_directory : String_with_vars.t t -> bool
-
-val untag : ('a * Tag.t) t -> 'a t
+val field :
+     allow_directory_targets:bool
+  -> String_with_vars.t t Dune_lang.Decoder.fields_parser