Fix expansion of user actions
This commit is contained in:
parent
a07a9a84ec
commit
a26b787456
|
@ -29,6 +29,29 @@ let expand_path ~dir ~f template =
|
||||||
|> String.concat ~sep:" "
|
|> String.concat ~sep:" "
|
||||||
|> Path.relative dir
|
|> Path.relative dir
|
||||||
|
|
||||||
|
let expand_prog ctx ~dir ~f template =
|
||||||
|
let resolve s =
|
||||||
|
if String.contains s '/' then
|
||||||
|
Path.relative dir s
|
||||||
|
else
|
||||||
|
match Context.which ctx s with
|
||||||
|
| Some p -> p
|
||||||
|
| None ->
|
||||||
|
die "@{<error>Error@}: Program %s not found in PATH (context: %s)" s ctx.name
|
||||||
|
in
|
||||||
|
match String_with_vars.just_a_var template with
|
||||||
|
| None -> resolve (expand_str ~dir ~f template)
|
||||||
|
| Some v ->
|
||||||
|
match f v with
|
||||||
|
| Not_found -> resolve (expand_str ~dir ~f template)
|
||||||
|
| Path p
|
||||||
|
| Paths [p] -> p
|
||||||
|
| Str s -> resolve s
|
||||||
|
| Paths l ->
|
||||||
|
List.map l ~f:(Path.reach ~from:dir)
|
||||||
|
|> String.concat ~sep:" "
|
||||||
|
|> resolve
|
||||||
|
|
||||||
module Mini_shexp = struct
|
module Mini_shexp = struct
|
||||||
module Ast = struct
|
module Ast = struct
|
||||||
type ('a, 'path) t =
|
type ('a, 'path) t =
|
||||||
|
@ -126,20 +149,20 @@ module Mini_shexp = struct
|
||||||
Ast.fold t ~init ~f:(fun acc pat ->
|
Ast.fold t ~init ~f:(fun acc pat ->
|
||||||
String_with_vars.fold ~init:acc pat ~f)
|
String_with_vars.fold ~init:acc pat ~f)
|
||||||
|
|
||||||
let rec expand dir t ~f : (string, Path.t) Ast.t =
|
let rec expand ctx dir t ~f : (string, Path.t) Ast.t =
|
||||||
match t with
|
match t with
|
||||||
| Run (prog, args) ->
|
| Run (prog, args) ->
|
||||||
Run (expand_path ~dir ~f prog,
|
Run (expand_prog ctx ~dir ~f prog,
|
||||||
List.map args ~f:(fun arg -> expand_str ~dir ~f arg))
|
List.map args ~f:(fun arg -> expand_str ~dir ~f arg))
|
||||||
| Chdir (fn, t) ->
|
| Chdir (fn, t) ->
|
||||||
let fn = expand_path ~dir ~f fn in
|
let fn = expand_path ~dir ~f fn in
|
||||||
Chdir (fn, expand fn t ~f)
|
Chdir (fn, expand ctx fn t ~f)
|
||||||
| Setenv (var, value, t) ->
|
| Setenv (var, value, t) ->
|
||||||
Setenv (expand_str ~dir ~f var, expand_str ~dir ~f value,
|
Setenv (expand_str ~dir ~f var, expand_str ~dir ~f value,
|
||||||
expand dir t ~f)
|
expand ctx dir t ~f)
|
||||||
| With_stdout_to (fn, t) ->
|
| With_stdout_to (fn, t) ->
|
||||||
With_stdout_to (expand_path ~dir ~f fn, expand dir t ~f)
|
With_stdout_to (expand_path ~dir ~f fn, expand ctx dir t ~f)
|
||||||
| Progn l -> Progn (List.map l ~f:(fun t -> expand dir t ~f))
|
| Progn l -> Progn (List.map l ~f:(fun t -> expand ctx dir t ~f))
|
||||||
| Echo x -> Echo (expand_str ~dir ~f x)
|
| Echo x -> Echo (expand_str ~dir ~f x)
|
||||||
| Cat x -> Cat (expand_path ~dir ~f x)
|
| Cat x -> Cat (expand_path ~dir ~f x)
|
||||||
| Create_file x -> Create_file (expand_path ~dir ~f x)
|
| Create_file x -> Create_file (expand_path ~dir ~f x)
|
||||||
|
|
|
@ -37,7 +37,7 @@ module Mini_shexp : sig
|
||||||
val t : t Sexp.Of_sexp.t
|
val t : t Sexp.Of_sexp.t
|
||||||
val sexp_of_t : t Sexp.To_sexp.t
|
val sexp_of_t : t Sexp.To_sexp.t
|
||||||
val fold_vars : t -> init:'a -> f:('a -> string -> 'a) -> 'a
|
val fold_vars : t -> init:'a -> f:('a -> string -> 'a) -> 'a
|
||||||
val expand : Path.t -> t -> f:(string -> var_expansion) -> desc
|
val expand : Context.t -> Path.t -> t -> f:(string -> var_expansion) -> desc
|
||||||
end with type desc := t
|
end with type desc := t
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -34,7 +34,7 @@ module Repr = struct
|
||||||
| Vpath : 'a Vspec.t -> (unit, 'a) t
|
| Vpath : 'a Vspec.t -> (unit, 'a) t
|
||||||
| Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
|
| Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
|
||||||
| Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
|
| Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
|
||||||
| Fail : fail -> ('a, 'a) t
|
| Fail : fail -> (_, _) t
|
||||||
end
|
end
|
||||||
include Repr
|
include Repr
|
||||||
let repr t = t
|
let repr t = t
|
||||||
|
|
|
@ -47,7 +47,7 @@ val lines_of : Path.t -> ('a, string list) t
|
||||||
|
|
||||||
(** Always fail when executed. We pass a function rather than an exception to get a proper
|
(** Always fail when executed. We pass a function rather than an exception to get a proper
|
||||||
backtrace *)
|
backtrace *)
|
||||||
val fail : fail -> ('a, 'a) t
|
val fail : fail -> (_, _) t
|
||||||
|
|
||||||
module Prog_spec : sig
|
module Prog_spec : sig
|
||||||
type 'a t =
|
type 'a t =
|
||||||
|
@ -116,7 +116,7 @@ module Repr : sig
|
||||||
| Vpath : 'a Vspec.t -> (unit, 'a) t
|
| Vpath : 'a Vspec.t -> (unit, 'a) t
|
||||||
| Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
|
| Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
|
||||||
| Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
|
| Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
|
||||||
| Fail : fail -> ('a, 'a) t
|
| Fail : fail -> (_, _) t
|
||||||
end
|
end
|
||||||
|
|
||||||
val repr : ('a, 'b) t -> ('a, 'b) Repr.t
|
val repr : ('a, 'b) t -> ('a, 'b) Repr.t
|
||||||
|
|
|
@ -1483,18 +1483,24 @@ module Gen(P : Params) = struct
|
||||||
~f:(Path.relative dir))
|
~f:(Path.relative dir))
|
||||||
in
|
in
|
||||||
let forms = extract_artifacts ~dir t in
|
let forms = extract_artifacts ~dir t in
|
||||||
let t =
|
let build =
|
||||||
U.expand dir t
|
match
|
||||||
~f:(expand_var ~artifacts:forms.artifacts ~targets ~deps)
|
U.expand ctx dir t
|
||||||
|
~f:(expand_var ~artifacts:forms.artifacts ~targets ~deps)
|
||||||
|
with
|
||||||
|
| t ->
|
||||||
|
Build.paths (String_map.values forms.artifacts)
|
||||||
|
>>>
|
||||||
|
Build.action t ~dir ~targets
|
||||||
|
| exception e ->
|
||||||
|
Build.fail { fail = fun () -> raise e }
|
||||||
in
|
in
|
||||||
let build =
|
let build =
|
||||||
Build.record_lib_deps ~dir ~kind:dep_kind
|
Build.record_lib_deps ~dir ~kind:dep_kind
|
||||||
(String_set.elements forms.lib_deps
|
(String_set.elements forms.lib_deps
|
||||||
|> List.map ~f:(fun s -> Lib_dep.Direct s))
|
|> List.map ~f:(fun s -> Lib_dep.Direct s))
|
||||||
>>>
|
>>>
|
||||||
Build.paths (String_map.values forms.artifacts)
|
build
|
||||||
>>>
|
|
||||||
Build.action t ~dir ~targets
|
|
||||||
in
|
in
|
||||||
match forms.failures with
|
match forms.failures with
|
||||||
| [] -> build
|
| [] -> build
|
||||||
|
|
Loading…
Reference in New Issue