Add support for reading files from actions

- ${read:<filename>}        -> expand to the contents of the file
- ${read-lines:<filename>}  -> expand to the list of lines in the file
- ${read-strings:<filename> -> expand to the list of lines in the file,
  unescaped using OCaml escaping rules

Generalize ${!...} form
This commit is contained in:
Jeremie Dimino 2017-05-30 15:40:06 +01:00
parent 5167dd2f16
commit 4e7cb253e1
7 changed files with 217 additions and 122 deletions

View File

@ -3,71 +3,99 @@ open Sexp.Of_sexp
module Env_var_map = Context.Env_var_map
type split_or_concat = Split | Concat
module Var_expansion = struct
module Concat_or_split = struct
type t =
| Concat (* default *)
| Split (* ${!...} *)
end
type var_expansion =
| Not_found
| Path of Path.t
| Paths of Path.t list * split_or_concat
| Str of string
open Concat_or_split
let expand_str ~dir ~f template =
String_with_vars.expand template ~f:(fun var ->
match f var with
| Not_found -> None
| Path path -> Some (Path.reach ~from:dir path)
| Paths (l, _) -> Some (List.map l ~f:(Path.reach ~from:dir) |> String.concat ~sep:" ")
| Str s -> Some s)
type t =
| Paths of Path.t list * Concat_or_split.t
| Strings of string list * Concat_or_split.t
let expand_str_split ~dir ~f template =
match String_with_vars.just_a_var template with
| None -> [expand_str ~dir ~f template]
| Some var ->
match f var with
| Not_found -> [expand_str ~dir ~f template]
| Path path -> [Path.reach ~from:dir path]
| Str s -> [s]
| Paths (l, Concat) ->
[List.map l ~f:(Path.reach ~from:dir) |> String.concat ~sep:" "]
| Paths (l, Split) -> List.map l ~f:(Path.reach ~from:dir)
let concat = function
| [s] -> s
| l -> String.concat ~sep:" " l
let expand_path ~dir ~f template =
match String_with_vars.just_a_var template with
| None -> expand_str ~dir ~f template |> Path.relative dir
| Some v ->
match f v with
| Not_found -> expand_str ~dir ~f template |> Path.relative dir
| Path p
| Paths ([p], _) -> p
| Str s -> Path.relative dir s
| Paths (l, _) ->
List.map l ~f:(Path.reach ~from:dir)
|> String.concat ~sep:" "
|> Path.relative dir
let string_of_path ~dir p = Path.reach ~from:dir p
let path_of_string ~dir s = Path.relative dir s
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 -> Utils.program_not_found ~context:ctx.name s
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 (p :: args, Split) -> (p, List.map args ~f:(Path.reach ~from:dir))
| Paths (l, _) ->
(List.map l ~f:(Path.reach ~from:dir)
|> String.concat ~sep:" "
|> resolve,
[])
let to_strings ~dir = function
| Strings (l, Split ) -> l
| Strings (l, Concat) -> [concat l]
| Paths (l, Split ) -> List.map l ~f:(string_of_path ~dir)
| Paths (l, Concat) -> [concat (List.map l ~f:(string_of_path ~dir))]
let to_string ~dir = function
| Strings (_, Split) | Paths (_, Split) -> assert false
| Strings (l, Concat) -> concat l
| Paths (l, Concat) -> concat (List.map l ~f:(string_of_path ~dir))
let to_path ~dir = function
| Strings (_, Split) | Paths (_, Split) -> assert false
| Strings (l, Concat) -> path_of_string ~dir (concat l)
| Paths ([p], Concat) -> p
| Paths (l, Concat) ->
path_of_string ~dir (concat (List.map l ~f:(string_of_path ~dir)))
end
module Expand = struct
module V = Var_expansion
module SW = String_with_vars
let string ~dir ~f template =
SW.expand template ~f:(fun var ->
match f var with
| None -> None
| Some e -> Some (V.to_string ~dir e))
let expand ~generic ~special ~dir ~f template =
match SW.just_a_var template with
| None -> generic ~dir (string ~dir ~f template)
| Some var ->
match f var with
| None -> generic ~dir (SW.to_string template)
| Some e -> special ~dir e
let strings ~dir ~f template =
expand ~dir ~f template
~generic:(fun ~dir:_ x -> [x])
~special:V.to_strings
let path ~dir ~f template =
expand ~dir ~f template
~generic:V.path_of_string
~special:V.to_path
let prog_and_args 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 -> Utils.program_not_found ~context:ctx.name s
in
expand ~dir ~f template
~generic:(fun ~dir:_ s -> (resolve s, []))
~special:(fun ~dir exp ->
match exp with
| Paths ([p], _) -> (p , [])
| Strings ([s], _) -> (resolve s, [])
| Paths ([], _) | Strings ([], _) -> (resolve "", [])
| Paths (l, Concat) ->
(V.path_of_string ~dir (V.concat (List.map l ~f:(V.string_of_path ~dir))),
[])
| Strings (l, Concat) ->
(resolve (V.concat l), l)
| Paths (p :: l, Split) ->
(p, List.map l ~f:(V.string_of_path ~dir))
| Strings (s :: l, Split) ->
(resolve s, l))
end
module Outputs = struct
include Action_intf.Outputs
@ -213,38 +241,38 @@ module Unexpanded = struct
let rec expand ctx dir t ~f : action =
match t with
| Run (prog, args) ->
let prog, more_args = expand_prog ctx ~dir ~f prog in
let prog, more_args = Expand.prog_and_args ctx ~dir ~f prog in
Run (prog,
more_args @ List.concat_map args ~f:(expand_str_split ~dir ~f))
more_args @ List.concat_map args ~f:(Expand.strings ~dir ~f))
| Chdir (fn, t) ->
let fn = expand_path ~dir ~f fn in
let fn = Expand.path ~dir ~f fn in
Chdir (fn, expand ctx fn t ~f)
| Setenv (var, value, t) ->
Setenv (expand_str ~dir ~f var, expand_str ~dir ~f value,
Setenv (Expand.string ~dir ~f var, Expand.string ~dir ~f value,
expand ctx dir t ~f)
| Redirect (outputs, fn, t) ->
Redirect (outputs, expand_path ~dir ~f fn, expand ctx dir t ~f)
Redirect (outputs, Expand.path ~dir ~f fn, expand ctx dir t ~f)
| Ignore (outputs, t) ->
Ignore (outputs, expand ctx 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)
| Cat x -> Cat (expand_path ~dir ~f x)
| Create_file x -> Create_file (expand_path ~dir ~f x)
| Echo x -> Echo (Expand.string ~dir ~f x)
| Cat x -> Cat (Expand.path ~dir ~f x)
| Create_file x -> Create_file (Expand.path ~dir ~f x)
| Copy (x, y) ->
Copy (expand_path ~dir ~f x, expand_path ~dir ~f y)
Copy (Expand.path ~dir ~f x, Expand.path ~dir ~f y)
| Symlink (x, y) ->
Symlink (expand_path ~dir ~f x, expand_path ~dir ~f y)
Symlink (Expand.path ~dir ~f x, Expand.path ~dir ~f y)
| Copy_and_add_line_directive (x, y) ->
Copy_and_add_line_directive (expand_path ~dir ~f x, expand_path ~dir ~f y)
| System x -> System (expand_str ~dir ~f x)
| Bash x -> Bash (expand_str ~dir ~f x)
| Update_file (x, y) -> Update_file (expand_path ~dir ~f x, expand_str ~dir ~f y)
Copy_and_add_line_directive (Expand.path ~dir ~f x, Expand.path ~dir ~f y)
| System x -> System (Expand.string ~dir ~f x)
| Bash x -> Bash (Expand.string ~dir ~f x)
| Update_file (x, y) -> Update_file (Expand.path ~dir ~f x, Expand.string ~dir ~f y)
| Rename (x, y) ->
Rename (expand_path ~dir ~f x, expand_path ~dir ~f y)
Rename (Expand.path ~dir ~f x, Expand.path ~dir ~f y)
| Remove_tree x ->
Remove_tree (expand_path ~dir ~f x)
Remove_tree (Expand.path ~dir ~f x)
| Mkdir x ->
Mkdir (expand_path ~dir ~f x)
Mkdir (Expand.path ~dir ~f x)
end
let fold_one_step t ~init:acc ~f =

View File

@ -1,12 +1,16 @@
open! Import
type split_or_concat = Split | Concat
module Var_expansion : sig
module Concat_or_split : sig
type t =
| Concat (* default *)
| Split (* ${!...} *)
end
type var_expansion =
| Not_found
| Path of Path.t
| Paths of Path.t list * split_or_concat
| Str of string
type t =
| Paths of Path.t list * Concat_or_split.t
| Strings of string list * Concat_or_split.t
end
module Outputs : module type of struct include Action_intf.Outputs end
@ -45,7 +49,7 @@ module Unexpanded : sig
val t : t Sexp.Of_sexp.t
val sexp_of_t : t Sexp.To_sexp.t
val fold_vars : t -> init:'a -> f:('a -> Loc.t -> string -> 'a) -> 'a
val expand : Context.t -> Path.t -> t -> f:(string -> var_expansion) -> action
val expand : Context.t -> Path.t -> t -> f:(string -> Var_expansion.t option) -> action
end with type action := t
val exec : targets:Path.Set.t -> ?context:Context.t -> t -> unit Future.t

View File

@ -140,6 +140,11 @@ let dyn_paths t = Dyn_paths t
let contents p = Contents p
let lines_of p = Lines_of p
let strings p =
lines_of p
>>^ fun l ->
List.map l ~f:Scanf.unescaped
let read_sexp p =
contents p
>>^ fun s ->

View File

@ -45,6 +45,9 @@ val dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
val contents : Path.t -> ('a, string) t
val lines_of : Path.t -> ('a, string list) t
(** Read lines from a file, unescaping each line using the OCaml conventions *)
val strings : Path.t -> ('a, string list) t
(** Load an S-expression from a file *)
val read_sexp : Path.t -> (unit, Sexp.Ast.t) t

View File

@ -92,14 +92,26 @@ let fold t ~init ~f =
let vars t = fold t ~init:String_set.empty ~f:(fun acc _ x -> String_set.add x acc)
let string_of_var syntax v =
match syntax with
| Parens -> sprintf "$(%s)" v
| Braces -> sprintf "${%s}" v
let expand t ~f =
List.map t.items ~f:(function
| Text s -> s
| Var (syntax, v) ->
match f v with
| Some x -> x
| None ->
match syntax with
| Parens -> sprintf "$(%s)" v
| Braces -> sprintf "${%s}" v)
| None -> string_of_var syntax v)
|> String.concat ~sep:""
let to_string t =
match t.items with
(* [to_string is only called from action.ml, always on [t]s of this form *)
| [Var (syntax, v)] -> string_of_var syntax v
| items ->
List.map items ~f:(function
| Text s -> s
| Var (syntax, v) -> string_of_var syntax v)
|> String.concat ~sep:""

View File

@ -12,6 +12,7 @@ val sexp_of_t : t -> Sexp.t
val loc : t -> Loc.t
val of_string : loc:Loc.t -> string -> t
val to_string : t -> string
val raw : loc:Loc.t -> string -> t
val just_a_var : t -> string option

View File

@ -447,18 +447,27 @@ module Pkg_version = struct
Build.vpath spec
end
let parse_bang var : Action.Var_expansion.Concat_or_split.t * string =
let len = String.length var in
if len > 0 && var.[0] = '!' then
(Split, String.sub var ~pos:1 ~len:(len - 1))
else
(Concat, var)
module Do_action = struct
open Build.O
module U = Action.Unexpanded
let run t action ~dir =
let action =
Action.Unexpanded.expand t.context dir action ~f:(function
| "ROOT" -> Path t.context.build_dir
Action.Unexpanded.expand t.context dir action ~f:(fun var ->
let cos, var = parse_bang var in
match var with
| "ROOT" -> Some (Paths ([t.context.build_dir], cos))
| var ->
match expand_var_no_root t var with
| Some s -> Str s
| None -> Not_found)
| Some s -> Some (Strings ([s], cos))
| None -> None)
in
let { Action.Infer.Outcome.deps; targets } = Action.Infer.infer action in
Build.path_set deps
@ -472,15 +481,15 @@ module Action = struct
type resolved_forms =
{ (* Mapping from ${...} forms to their resolutions *)
artifacts : Action.var_expansion String_map.t
artifacts : Action.Var_expansion.t String_map.t
; (* Failed resolutions *)
failures : fail list
; (* All "name" for ${lib:name:...}/${lib-available:name} forms *)
lib_deps : Build.lib_deps
; vdeps : (unit, Action.var_expansion) Build.t String_map.t
; vdeps : (unit, Action.Var_expansion.t) Build.t String_map.t
}
let add_artifact ?lib_dep acc ~var result =
let add_artifact ?lib_dep acc ~key result =
let lib_deps =
match lib_dep with
| None -> acc.lib_deps
@ -489,7 +498,7 @@ module Action = struct
match result with
| Ok path ->
{ acc with
artifacts = String_map.add acc.artifacts ~key:var ~data:path
artifacts = String_map.add acc.artifacts ~key ~data:path
; lib_deps
}
| Error fail ->
@ -498,8 +507,11 @@ module Action = struct
; lib_deps
}
let ok_path x = Ok (Action.Var_expansion.Paths ([x], Concat))
let ok_string x = Ok (Action.Var_expansion.Strings ([x], Concat))
let map_result = function
| Ok x -> Ok (Action.Path x)
| Ok x -> ok_path x
| Error _ as e -> e
let extract_artifacts sctx ~dir ~dep_kind ~package_context t =
@ -510,59 +522,89 @@ module Action = struct
; vdeps = String_map.empty
}
in
U.fold_vars t ~init ~f:(fun acc loc var ->
U.fold_vars t ~init ~f:(fun acc loc key ->
let module A = Artifacts in
let open Action.Var_expansion in
let cos, var = parse_bang key in
match String.lsplit2 var ~on:':' with
| Some ("exe" , s) -> add_artifact acc ~var (Ok (Path (Path.relative dir s)))
| Some ("path" , s) -> add_artifact acc ~var (Ok (Path (Path.relative dir s)))
| Some ("exe" , s) -> add_artifact acc ~key (ok_path (Path.relative dir s))
| Some ("path" , s) -> add_artifact acc ~key (ok_path (Path.relative dir s))
| Some ("bin" , s) ->
add_artifact acc ~var (A.binary (artifacts sctx) s |> map_result)
add_artifact acc ~key (A.binary (artifacts sctx) s |> map_result)
| Some ("lib" , s)
| Some ("libexec" , s) ->
let lib_dep, res = A.file_of_lib (artifacts sctx) ~from:dir s in
add_artifact acc ~var ~lib_dep:(lib_dep, dep_kind) (map_result res)
add_artifact acc ~key ~lib_dep:(lib_dep, dep_kind) (map_result res)
| Some ("lib-available", lib) ->
add_artifact acc ~var ~lib_dep:(lib, Optional)
(Ok (Str (string_of_bool (Libs.lib_is_available sctx ~from:dir lib))))
add_artifact acc ~key ~lib_dep:(lib, Optional)
(ok_string (string_of_bool (Libs.lib_is_available sctx ~from:dir lib)))
(* CR-someday jdimino: allow this only for (jbuild_version jane_street) *)
| Some ("findlib" , s) ->
let lib_dep, res =
A.file_of_lib (artifacts sctx) ~from:dir s ~use_provides:true
in
add_artifact acc ~var ~lib_dep:(lib_dep, Required) (map_result res)
add_artifact acc ~key ~lib_dep:(lib_dep, Required) (map_result res)
| Some ("version", s) -> begin
match Pkgs.resolve package_context s with
| Ok p ->
let x =
Pkg_version.read sctx p >>^ function
| None -> Action.Str ""
| Some s -> Str s
| None -> Strings ([""], Concat)
| Some s -> Strings ([s], Concat)
in
{ acc with vdeps = String_map.add acc.vdeps ~key:var ~data:x }
{ acc with vdeps = String_map.add acc.vdeps ~key ~data:x }
| Error s ->
{ acc with failures = { fail = fun () -> Loc.fail loc "%s" s } :: acc.failures }
end
| Some ("read", s) -> begin
let path = Path.relative dir s in
let data =
Build.contents path
>>^ fun s -> Strings ([s], cos)
in
{acc with vdeps = String_map.add acc.vdeps ~key ~data }
end
| Some ("read-lines", s) -> begin
let path = Path.relative dir s in
let data =
Build.lines_of path
>>^ fun l -> Strings (l, cos)
in
{acc with vdeps = String_map.add acc.vdeps ~key ~data }
end
| Some ("read-strings", s) -> begin
let path = Path.relative dir s in
let data =
Build.strings path
>>^ fun l -> Strings (l, cos)
in
{acc with vdeps = String_map.add acc.vdeps ~key ~data }
end
| _ -> acc)
let expand_var =
fun sctx ~artifacts ~targets ~deps var_name ->
let open Action.Var_expansion in
let cos, var_name = parse_bang var_name in
match String_map.find var_name artifacts with
| Some exp -> exp
| Some _ as opt -> opt
| None ->
match var_name with
| "@" -> Action.Paths (targets, Concat)
| "!@" -> Action.Paths (targets, Split)
| "@" -> Some (Paths (targets, cos))
| "<" ->
(match deps with
| [] -> Str "" (* CR-someday jdimino: this should be an error *)
| dep :: _ -> Path dep)
| "^" -> Paths (deps, Concat)
| "!^" -> Paths (deps, Split)
| "ROOT" -> Path sctx.context.build_dir
Some
(match deps with
| [] ->
(* CR-someday jdimino: this should be an error *)
Strings ([""], cos)
| dep :: _ ->
Paths ([dep], cos))
| "^" -> Some (Paths (deps, cos))
| "ROOT" -> Some (Paths ([sctx.context.build_dir], cos))
| var ->
match expand_var_no_root sctx var with
| Some s -> Str s
| None -> Not_found
| Some s -> Some (Strings ([s], cos))
| None -> None
let run sctx t ~dir ~dep_kind ~targets ~package_context
: (Path.t list, Action.t) Build.t =
@ -574,9 +616,9 @@ module Action = struct
(String_map.fold forms.artifacts ~init:Path.Set.empty
~f:(fun ~key:_ ~data:exp acc ->
match exp with
| Action.Path p -> Path.Set.add p acc
| Paths (ps, _) -> Path.Set.union acc (Path.Set.of_list ps)
| Not_found | Str _ -> acc))
| Action.Var_expansion.Paths (ps, _) ->
Path.Set.union acc (Path.Set.of_list ps)
| Strings _ -> acc))
>>>
Build.arr (fun paths -> ((), paths))
>>>