Add (with-stdout-to ...)
This commit is contained in:
parent
24ac055511
commit
ecc3462912
|
@ -798,6 +798,7 @@ The following constructions are available:
|
|||
- =(run <prog> <args>)= to execute a program
|
||||
- =(chdir <dir> <DSL>)= to change the current directory
|
||||
- =(setenv <var> <value> <DSL>)= to set an environment variable
|
||||
- =(with-stdout-to <file> <DSL>)= to redirect the output to a file
|
||||
* Usage
|
||||
|
||||
TODO
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
type t =
|
||||
{ prog : Path.t
|
||||
; args : string list
|
||||
; dir : Path.t
|
||||
; env : string array
|
||||
{ prog : Path.t
|
||||
; args : string list
|
||||
; dir : Path.t
|
||||
; env : string array
|
||||
; stdout_to : Path.t option
|
||||
; touches : Path.t list
|
||||
}
|
||||
|
|
|
@ -173,8 +173,12 @@ let action ~targets =
|
|||
dyn_paths (arr (fun a -> [a.Action.prog]))
|
||||
>>>
|
||||
prim ~targets
|
||||
(fun { Action. prog; args; env; dir } ->
|
||||
Future.run ~dir:(Path.to_string dir) ~env (Path.reach ~from:dir prog) args)
|
||||
(fun { Action. prog; args; env; dir; stdout_to; touches } ->
|
||||
List.iter touches ~f:(fun fn ->
|
||||
close_out (open_out_bin (Path.to_string fn)));
|
||||
let stdout_to = Option.map stdout_to ~f:(Path.reach ~from:dir) in
|
||||
Future.run ~dir:(Path.to_string dir) ~env ?stdout_to (Path.reach ~from:dir prog)
|
||||
args)
|
||||
|
||||
let echo fn =
|
||||
create_file ~target:fn (fun data ->
|
||||
|
|
|
@ -127,12 +127,14 @@ module User_action = struct
|
|||
| Run of 'a * 'a list
|
||||
| Chdir of 'a * 'a t
|
||||
| Setenv of 'a * 'a * 'a t
|
||||
| With_stdout_to of 'a * 'a t
|
||||
|
||||
let rec t a sexp =
|
||||
match sexp with
|
||||
| List (Atom "run" :: prog :: args) -> Run (a prog, List.map args ~f:a)
|
||||
| List [ Atom "chdir"; dir; arg ] -> Chdir (a dir, t a arg)
|
||||
| List [ Atom "setenv"; var; value; arg ] -> Setenv (a var, a value, t a arg)
|
||||
| List [ Atom "with-stdout-to"; file; arg ] -> With_stdout_to (a file, t a arg)
|
||||
| _ ->
|
||||
of_sexp_error sexp "\
|
||||
invalid action, expected one of:
|
||||
|
@ -140,6 +142,7 @@ invalid action, expected one of:
|
|||
(run <prog> <args>)
|
||||
(chdir <dir> <action>)
|
||||
(setenv <var> <value> <action>)
|
||||
(with-stdout-to <file> <action>)
|
||||
"
|
||||
|
||||
let rec map t ~f =
|
||||
|
@ -147,33 +150,45 @@ invalid action, expected one of:
|
|||
| Run (prog, args) -> Run (f prog, List.map args ~f)
|
||||
| Chdir (fn, t) -> Chdir (f fn, map t ~f)
|
||||
| Setenv (var, value, t) -> Setenv (f var, f value, map t ~f)
|
||||
| With_stdout_to (fn, t) -> With_stdout_to (f fn, map t ~f)
|
||||
|
||||
let rec fold t ~init:acc ~f =
|
||||
match t with
|
||||
| Run (prog, args) -> List.fold_left args ~init:(f acc prog) ~f
|
||||
| Chdir (fn, t) -> fold t ~init:(f acc fn) ~f
|
||||
| Setenv (var, value, t) -> fold t ~init:(f (f acc var) value) ~f
|
||||
| With_stdout_to (fn, t) -> fold t ~init:(f acc fn) ~f
|
||||
|
||||
let to_action ~dir ~env (t : string t) =
|
||||
let rec loop vars dir = function
|
||||
let rec loop vars dir stdouts = function
|
||||
| Chdir (fn, t) ->
|
||||
loop vars (Path.relative dir fn) t
|
||||
loop vars (Path.relative dir fn) stdouts t
|
||||
| Setenv (var, value, t) ->
|
||||
loop (String_map.add vars ~key:var ~data:value) dir t
|
||||
loop (String_map.add vars ~key:var ~data:value) dir stdouts t
|
||||
| With_stdout_to (fn, t) ->
|
||||
loop vars dir (Path.relative dir fn :: stdouts) t
|
||||
| Run (prog, args) ->
|
||||
let stdout_to, touches =
|
||||
match stdouts with
|
||||
| [] -> None, []
|
||||
| p :: rest -> (Some p, rest)
|
||||
in
|
||||
{ Action.
|
||||
prog = Path.relative dir prog
|
||||
; args = args
|
||||
; dir
|
||||
; env = Context.extend_env ~vars ~env
|
||||
; stdout_to
|
||||
; touches
|
||||
}
|
||||
in
|
||||
loop String_map.empty dir t
|
||||
loop String_map.empty dir [] t
|
||||
|
||||
let rec sexp_of_t f = function
|
||||
| Run (a, xs) -> List (Atom "run" :: f a :: List.map xs ~f)
|
||||
| Chdir (a, r) -> List [Atom "chdir" ; f a ; sexp_of_t f r]
|
||||
| Setenv (k, v, r) -> List [Atom "setenv" ; f k ; f v ; sexp_of_t f r]
|
||||
| With_stdout_to (fn, r) -> List [Atom "with-stdout-to"; f fn; sexp_of_t f r]
|
||||
end
|
||||
|
||||
module T = struct
|
||||
|
@ -213,6 +228,8 @@ invalid action, expected one of:
|
|||
; args = ["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd]
|
||||
; env
|
||||
; dir
|
||||
; stdout_to = None
|
||||
; touches = []
|
||||
}
|
||||
end
|
||||
|
||||
|
|
Loading…
Reference in New Issue