Actions printed by "jbuilder rules" are now using relative paths
This seems more natural
This commit is contained in:
parent
1588ce90f2
commit
f949588742
|
@ -842,6 +842,9 @@ let rules =
|
||||||
| _ -> resolve_targets_exn ~log common setup targets |> request_of_targets setup
|
| _ -> resolve_targets_exn ~log common setup targets |> request_of_targets setup
|
||||||
in
|
in
|
||||||
Build_system.build_rules setup.build_system ~request ~recursive >>= fun rules ->
|
Build_system.build_rules setup.build_system ~request ~recursive >>= fun rules ->
|
||||||
|
let sexp_of_action action =
|
||||||
|
Action.for_shell action |> Action.For_shell.sexp_of_t
|
||||||
|
in
|
||||||
let print oc =
|
let print oc =
|
||||||
let ppf = Format.formatter_of_out_channel oc in
|
let ppf = Format.formatter_of_out_channel oc in
|
||||||
Sexp.prepare_formatter ppf;
|
Sexp.prepare_formatter ppf;
|
||||||
|
@ -855,7 +858,7 @@ let rules =
|
||||||
(fun ppf ->
|
(fun ppf ->
|
||||||
Path.Set.iter rule.deps ~f:(fun dep ->
|
Path.Set.iter rule.deps ~f:(fun dep ->
|
||||||
Format.fprintf ppf "@ %s" (Path.to_string dep)))
|
Format.fprintf ppf "@ %s" (Path.to_string dep)))
|
||||||
Sexp.pp_split_strings (Action.sexp_of_t rule.action))
|
Sexp.pp_split_strings (sexp_of_action rule.action))
|
||||||
end else begin
|
end else begin
|
||||||
List.iter rules ~f:(fun (rule : Build_system.Rule.t) ->
|
List.iter rules ~f:(fun (rule : Build_system.Rule.t) ->
|
||||||
let sexp =
|
let sexp =
|
||||||
|
@ -867,7 +870,7 @@ let rules =
|
||||||
; (match rule.context with
|
; (match rule.context with
|
||||||
| None -> []
|
| None -> []
|
||||||
| Some c -> ["context", Atom c.name])
|
| Some c -> ["context", Atom c.name])
|
||||||
; [ "action" , Action.sexp_of_t rule.action ]
|
; [ "action" , sexp_of_action rule.action ]
|
||||||
])
|
])
|
||||||
in
|
in
|
||||||
Format.fprintf ppf "%a@," Sexp.pp_split_strings sexp)
|
Format.fprintf ppf "%a@," Sexp.pp_split_strings sexp)
|
||||||
|
|
|
@ -131,35 +131,35 @@ module Make_mapper
|
||||||
(Src : Action_intf.Ast)
|
(Src : Action_intf.Ast)
|
||||||
(Dst : Action_intf.Ast)
|
(Dst : Action_intf.Ast)
|
||||||
= struct
|
= struct
|
||||||
let rec map (t : Src.t) ~f_program ~f_string ~f_path : Dst.t =
|
let rec map (t : Src.t) ~dir ~f_program ~f_string ~f_path : Dst.t =
|
||||||
match t with
|
match t with
|
||||||
| Run (prog, args) ->
|
| Run (prog, args) ->
|
||||||
Run (f_program prog, List.map args ~f:f_string)
|
Run (f_program ~dir prog, List.map args ~f:(f_string ~dir))
|
||||||
| Chdir (fn, t) ->
|
| Chdir (fn, t) ->
|
||||||
Chdir (f_path fn, map t ~f_program ~f_string ~f_path)
|
Chdir (f_path ~dir fn, map t ~dir:fn ~f_program ~f_string ~f_path)
|
||||||
| Setenv (var, value, t) ->
|
| Setenv (var, value, t) ->
|
||||||
Setenv (f_string var, f_string value, map t ~f_program ~f_string ~f_path)
|
Setenv (f_string ~dir var, f_string ~dir value, map t ~dir ~f_program ~f_string ~f_path)
|
||||||
| Redirect (outputs, fn, t) ->
|
| Redirect (outputs, fn, t) ->
|
||||||
Redirect (outputs, f_path fn, map t ~f_program ~f_string ~f_path)
|
Redirect (outputs, f_path ~dir fn, map t ~dir ~f_program ~f_string ~f_path)
|
||||||
| Ignore (outputs, t) ->
|
| Ignore (outputs, t) ->
|
||||||
Ignore (outputs, map t ~f_program ~f_string ~f_path)
|
Ignore (outputs, map t ~dir ~f_program ~f_string ~f_path)
|
||||||
| Progn l -> Progn (List.map l ~f:(fun t -> map t ~f_program ~f_string ~f_path))
|
| Progn l -> Progn (List.map l ~f:(fun t -> map t ~dir ~f_program ~f_string ~f_path))
|
||||||
| Echo x -> Echo (f_string x)
|
| Echo x -> Echo (f_string ~dir x)
|
||||||
| Cat x -> Cat (f_path x)
|
| Cat x -> Cat (f_path ~dir x)
|
||||||
| Copy (x, y) -> Copy (f_path x, f_path y)
|
| Copy (x, y) -> Copy (f_path ~dir x, f_path ~dir y)
|
||||||
| Symlink (x, y) ->
|
| Symlink (x, y) ->
|
||||||
Symlink (f_path x, f_path y)
|
Symlink (f_path ~dir x, f_path ~dir y)
|
||||||
| Copy_and_add_line_directive (x, y) ->
|
| Copy_and_add_line_directive (x, y) ->
|
||||||
Copy_and_add_line_directive (f_path x, f_path y)
|
Copy_and_add_line_directive (f_path ~dir x, f_path ~dir y)
|
||||||
| System x -> System (f_string x)
|
| System x -> System (f_string ~dir x)
|
||||||
| Bash x -> Bash (f_string x)
|
| Bash x -> Bash (f_string ~dir x)
|
||||||
| Write_file (x, y) -> Write_file (f_path x, f_string y)
|
| Write_file (x, y) -> Write_file (f_path ~dir x, f_string ~dir y)
|
||||||
| Rename (x, y) -> Rename (f_path x, f_path y)
|
| Rename (x, y) -> Rename (f_path ~dir x, f_path ~dir y)
|
||||||
| Remove_tree x -> Remove_tree (f_path x)
|
| Remove_tree x -> Remove_tree (f_path ~dir x)
|
||||||
| Mkdir x -> Mkdir (f_path x)
|
| Mkdir x -> Mkdir (f_path ~dir x)
|
||||||
| Digest_files x -> Digest_files (List.map x ~f:f_path)
|
| Digest_files x -> Digest_files (List.map x ~f:(f_path ~dir))
|
||||||
| Diff { optional; file1; file2 } ->
|
| Diff { optional; file1; file2 } ->
|
||||||
Diff { optional; file1 = f_path file1; file2 = f_path file2 }
|
Diff { optional; file1 = f_path ~dir file1; file2 = f_path ~dir file2 }
|
||||||
end
|
end
|
||||||
|
|
||||||
module Prog = struct
|
module Prog = struct
|
||||||
|
@ -189,16 +189,44 @@ module type Ast = Action_intf.Ast
|
||||||
with type string = String.t
|
with type string = String.t
|
||||||
module rec Ast : Ast = Ast
|
module rec Ast : Ast = Ast
|
||||||
|
|
||||||
|
module String_with_sexp = struct
|
||||||
|
type t = string
|
||||||
|
let t = Sexp.Of_sexp.string
|
||||||
|
let sexp_of_t = Sexp.To_sexp.string
|
||||||
|
end
|
||||||
|
|
||||||
include Make_ast
|
include Make_ast
|
||||||
(Prog)
|
(Prog)
|
||||||
(Path)
|
(Path)
|
||||||
(struct
|
(String_with_sexp)
|
||||||
type t = string
|
|
||||||
let t = Sexp.Of_sexp.string
|
|
||||||
let sexp_of_t = Sexp.To_sexp.string
|
|
||||||
end)
|
|
||||||
(Ast)
|
(Ast)
|
||||||
|
|
||||||
|
module For_shell = struct
|
||||||
|
module type Ast = Action_intf.Ast
|
||||||
|
with type program = string
|
||||||
|
with type path = string
|
||||||
|
with type string = string
|
||||||
|
module rec Ast : Ast = Ast
|
||||||
|
|
||||||
|
include Make_ast
|
||||||
|
(String_with_sexp)
|
||||||
|
(String_with_sexp)
|
||||||
|
(String_with_sexp)
|
||||||
|
(Ast)
|
||||||
|
end
|
||||||
|
|
||||||
|
module Relativise = Make_mapper(Ast)(For_shell.Ast)
|
||||||
|
|
||||||
|
let for_shell t =
|
||||||
|
Relativise.map t
|
||||||
|
~dir:Path.root
|
||||||
|
~f_string:(fun ~dir:_ x -> x)
|
||||||
|
~f_path:(fun ~dir x -> Path.reach x ~from:dir)
|
||||||
|
~f_program:(fun ~dir x ->
|
||||||
|
match x with
|
||||||
|
| Ok p -> Path.reach p ~from:dir
|
||||||
|
| Error e -> e.program)
|
||||||
|
|
||||||
module Unresolved = struct
|
module Unresolved = struct
|
||||||
module Program = struct
|
module Program = struct
|
||||||
type t =
|
type t =
|
||||||
|
@ -222,8 +250,11 @@ module Unresolved = struct
|
||||||
include Make_mapper(Uast)(Ast)
|
include Make_mapper(Uast)(Ast)
|
||||||
|
|
||||||
let resolve t ~f =
|
let resolve t ~f =
|
||||||
map t ~f_path:(fun x -> x) ~f_string:(fun x -> x)
|
map t
|
||||||
~f_program:(function
|
~dir:Path.root
|
||||||
|
~f_path:(fun ~dir:_ x -> x)
|
||||||
|
~f_string:(fun ~dir:_ x -> x)
|
||||||
|
~f_program:(fun ~dir:_ -> function
|
||||||
| This p -> Ok p
|
| This p -> Ok p
|
||||||
| Search s -> Ok (f s))
|
| Search s -> Ok (f s))
|
||||||
end
|
end
|
||||||
|
@ -864,10 +895,11 @@ let sandbox t ~sandboxed ~deps ~targets =
|
||||||
Some (Ast.Symlink (path, sandboxed path))
|
Some (Ast.Symlink (path, sandboxed path))
|
||||||
else
|
else
|
||||||
None))
|
None))
|
||||||
; map t ~f_string:(fun x -> x) ~f_path:sandboxed
|
; map t
|
||||||
~f_program:(function
|
~dir:Path.root
|
||||||
| Ok p -> Ok (sandboxed p)
|
~f_string:(fun ~dir:_ x -> x)
|
||||||
| Error _ as e -> e)
|
~f_path:(fun ~dir:_ p -> sandboxed p)
|
||||||
|
~f_program:(fun ~dir:_ x -> Result.map x ~f:sandboxed)
|
||||||
; Progn (List.filter_map targets ~f:(fun path ->
|
; Progn (List.filter_map targets ~f:(fun path ->
|
||||||
if Path.is_local path then
|
if Path.is_local path then
|
||||||
Some (Ast.Rename (sandboxed path, path))
|
Some (Ast.Rename (sandboxed path, path))
|
||||||
|
|
|
@ -42,7 +42,18 @@ include Action_intf.Helpers
|
||||||
with type t := t
|
with type t := t
|
||||||
|
|
||||||
val t : t Sexp.Of_sexp.t
|
val t : t Sexp.Of_sexp.t
|
||||||
val sexp_of_t : t Sexp.To_sexp.t
|
|
||||||
|
module For_shell : sig
|
||||||
|
include Action_intf.Ast
|
||||||
|
with type program := string
|
||||||
|
with type path := string
|
||||||
|
with type string := string
|
||||||
|
|
||||||
|
val sexp_of_t : t Sexp.To_sexp.t
|
||||||
|
end
|
||||||
|
|
||||||
|
(** Convert the action to a format suitable for printing *)
|
||||||
|
val for_shell : t -> For_shell.t
|
||||||
|
|
||||||
(** Return the list of directories the action chdirs to *)
|
(** Return the list of directories the action chdirs to *)
|
||||||
val chdirs : t -> Path.Set.t
|
val chdirs : t -> Path.Set.t
|
||||||
|
|
Loading…
Reference in New Issue