Skip to content

Commit

Permalink
refactor(engine): split actions
Browse files Browse the repository at this point in the history 
Split the type for actions executed by dune from the type of actions
used by the dune language. This refactoring allows us to remove some
impossible cases from the dune language definition.

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

ps-id: 68576DAB-5E08-4D43-97FB-BA9E08A802A0
  • Loading branch information
@rgrinberg
rgrinberg committed May 31, 2022
1 parent 07015ba commit d301c91
Show file tree
Hide file tree
Showing 10 changed files with 345 additions and 274 deletions.
7 changes: 0 additions & 7 deletions src/dune_engine/action.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,9 +33,6 @@ module Prog = struct

type t = (Path.t, Not_found.t) result

let decode : t Dune_lang.Decoder.t =
Dune_lang.Decoder.map Dpath.decode ~f:Result.ok

let encode = function
| Ok s -> Dpath.encode s
| Error (e : Not_found.t) -> Dune_lang.Encoder.string e.program
Expand All @@ -59,11 +56,7 @@ module rec Ast : Ast = Ast
module String_with_sexp = struct
type t = string

let decode = Dune_lang.Decoder.string

let encode = Dune_lang.Encoder.string

let is_dev_null s = Path.equal (Path.of_string s) Config.dev_null
end

include Action_ast.Make (Prog) (Dpath) (Dpath.Build) (String_with_sexp) (Ast)
Expand Down
6 changes: 6 additions & 0 deletions src/dune_engine/action.mli
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,9 @@
(** Actions as defined an executed by the build system.
These executions correpsond to primitives that the build system knows how to
execute. These usually, but not necessarily correspond to actions written by
the user in [Action_dune_lang.t] *)

open! Import

include module type of Action_types
Expand Down
178 changes: 7 additions & 171 deletions src/dune_engine/action_ast.ml
View file
Original file line number Diff line number Diff line change
@@ -1,19 +1,18 @@
open Import
open Dune_lang.Decoder
open Action_types
module Stanza = Dune_lang.Stanza

module type Target_intf = sig
include Dune_lang.Conv.S
module type Encoder = sig
type t

val is_dev_null : t -> bool
val encode : t -> Dune_lang.t
end

module Make
(Program : Dune_lang.Conv.S)
(Path : Dune_lang.Conv.S)
(Target : Target_intf)
(String : Dune_lang.Conv.S)
(Program : Encoder)
(Path : Encoder)
(Target : Encoder)
(String : Encoder)
(Ast : Action_intf.Ast
with type program := Program.t
with type path := Path.t
Expand All @@ -22,169 +21,6 @@ module Make
struct
include Ast

let translate_to_ignore fn output action =
if Target.is_dev_null fn then Ignore (output, action)
else Redirect_out (output, fn, Normal, action)

let two_or_more decode =
let open Dune_lang.Decoder in
let+ n1 = decode
and+ n2 = decode
and+ rest = repeat decode in
n1 :: n2 :: rest

let decode =
let path = Path.decode in
let string = String.decode in
let target = Target.decode in
Dune_lang.Decoder.fix (fun t ->
sum
[ ( "run"
, let+ prog = Program.decode
and+ args = repeat String.decode in
Run (prog, args) )
; ( "with-accepted-exit-codes"
, let open Dune_lang in
Syntax.since Stanza.syntax (2, 0)
>>> let+ codes = Predicate_lang.decode_one Dune_lang.Decoder.int
and+ version = Syntax.get_exn Stanza.syntax
and+ loc, t = located t in
let nesting_support_version = (2, 2) in
let nesting_support =
Syntax.Version.Infix.(version >= nesting_support_version)
in
let rec is_ok = function
| Run _ | Bash _ | System _ -> true
| Chdir (_, t)
| Setenv (_, _, t)
| Ignore (_, t)
| Redirect_in (_, _, t)
| Redirect_out (_, _, _, t)
| No_infer t ->
if nesting_support then is_ok t
else
Syntax.Error.since loc Stanza.syntax
nesting_support_version
~what:
"nesting modifiers under 'with-accepted-exit-codes'"
| _ -> false
in
let quote = List.map ~f:(Printf.sprintf "\"%s\"") in
match (is_ok t, nesting_support) with
| true, _ -> With_accepted_exit_codes (codes, t)
| false, true ->
User_error.raise ~loc
[ Pp.textf
"Only %s can be nested under \
\"with-accepted-exit-codes\""
(Stdune.String.enumerate_and
(quote
[ "run"
; "bash"
; "system"
; "chdir"
; "setenv"
; "ignore-<outputs>"
; "with-stdin-from"
; "with-<outputs>-to"
; "no-infer"
]))
]
| false, false ->
User_error.raise ~loc
[ Pp.textf
"with-accepted-exit-codes can only be used with %s"
(Stdune.String.enumerate_or
(quote [ "run"; "bash"; "system" ]))
] )
; ( "dynamic-run"
, Dune_lang.Syntax.since Action_plugin.syntax (0, 1)
>>> let+ prog = Program.decode
and+ args = repeat String.decode in
Dynamic_run (prog, args) )
; ( "chdir"
, let+ dn = path
and+ t = t in
Chdir (dn, t) )
; ( "setenv"
, let+ k = string
and+ v = string
and+ t = t in
Setenv (k, v, t) )
; ( "with-stdout-to"
, let+ fn = target
and+ t = t in
translate_to_ignore fn Stdout t )
; ( "with-stderr-to"
, let+ fn = target
and+ t = t in
translate_to_ignore fn Stderr t )
; ( "with-outputs-to"
, let+ fn = target
and+ t = t in
translate_to_ignore fn Outputs t )
; ( "with-stdin-from"
, Dune_lang.Syntax.since Stanza.syntax (2, 0)
>>> let+ fn = path
and+ t = t in
Redirect_in (Stdin, fn, t) )
; ("ignore-stdout", t >>| fun t -> Ignore (Stdout, t))
; ("ignore-stderr", t >>| fun t -> Ignore (Stderr, t))
; ("ignore-outputs", t >>| fun t -> Ignore (Outputs, t))
; ("progn", repeat t >>| fun l -> Progn l)
; ( "echo"
, let+ x = string
and+ xs = repeat string in
Echo (x :: xs) )
; ("cat", path >>| fun x -> Cat x)
; ( "copy"
, let+ src = path
and+ dst = target in
Copy (src, dst) )
; ( "copy#"
, let+ src = path
and+ dst = target in
Copy_and_add_line_directive (src, dst) )
; ( "copy-and-add-line-directive"
, let+ src = path
and+ dst = target in
Copy_and_add_line_directive (src, dst) )
; ("system", string >>| fun cmd -> System cmd)
; ("bash", string >>| fun cmd -> Bash cmd)
; ( "write-file"
, let+ fn = target
and+ s = string in
Write_file (fn, Normal, s) )
; ( "diff"
, let+ diff = Diff.decode path target ~optional:false in
Diff diff )
; ( "diff?"
, let+ diff = Diff.decode path target ~optional:true in
Diff diff )
; ( "cmp"
, let+ diff = Diff.decode_binary path target in
Diff diff )
; ( "no-infer"
, Dune_lang.Syntax.since Stanza.syntax (2, 6) >>> t >>| fun t ->
No_infer t )
; ( "pipe-stdout"
, Dune_lang.Syntax.since Stanza.syntax (2, 7)
>>> let+ ts = two_or_more t in
Pipe (Stdout, ts) )
; ( "pipe-stderr"
, Dune_lang.Syntax.since Stanza.syntax (2, 7)
>>> let+ ts = two_or_more t in
Pipe (Stderr, ts) )
; ( "pipe-outputs"
, Dune_lang.Syntax.since Stanza.syntax (2, 7)
>>> let+ ts = two_or_more t in
Pipe (Outputs, ts) )
; ( "cram"
, Dune_lang.Syntax.since Stanza.syntax (2, 7)
>>> let+ script = path in
Cram script )
])

let rec encode =
let open Dune_lang in
let program = Program.encode in
Expand Down
18 changes: 8 additions & 10 deletions src/dune_engine/action_ast.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,27 +3,25 @@
More documentation is available in the [Action] and [Action_intf] modules.
This module is separate to break dependency cycles *)

module type Target_intf = sig
include Dune_lang.Conv.S
module type Encoder = sig
type t

(** Needed to simplify redirections to /dev/null. In particular, this means
that no /dev/null target is inferred *)
val is_dev_null : t -> bool
val encode : t -> Dune_lang.t
end

module Make
(Program : Dune_lang.Conv.S)
(Path : Dune_lang.Conv.S)
(Target : Target_intf)
(String : Dune_lang.Conv.S)
(Program : Encoder)
(Path : Encoder)
(Target : Encoder)
(String : Encoder)
(Ast : Action_intf.Ast
with type program := Program.t
and type path := Path.t
and type target := Target.t
and type string := String.t) : sig
include module type of Ast with type t = Ast.t

include Dune_lang.Conv.S with type t := t
include Encoder with type t := t

include
Action_intf.Helpers
Expand Down
Loading

0 comments on commit d301c91

Please sign in to comment.