Improve the syntax of ppx rewriters and flags (#910)

- old syntax: (pps (ppx1 -arg1 ppx2 (-foo x)))
- new syntax: (pps ppx1 -arg ppx2 -- -foo x)

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>

CHANGES.md

@@ -84,6 +84,10 @@ next
 - Present the `menhir` stanza as an extension with its own version
   (#901, @diml)
 
+- Improve the syntax of flags in `(pps ...)`. Now instead of `(pps
+  (ppx1 -arg1 ppx2 (-foo x)))` one should write `(pps ppx1 -arg ppx2
+  -- -foo x)` which looks nicer (#..., @diml)
+
 1.0+beta20 (10/04/2018)
 -----------------------
 

doc/jbuild.rst

@@ -975,7 +975,7 @@ Jbuilder accepts three kinds of preprocessing:
 - ``no_preprocessing``, meaning that files are given as it to the compiler, this
   is the default
 - ``(action <action>)`` to preprocess files using the given action
-- ``(pps (<ppx-rewriters-and-flags>))`` to preprocess files using the given list
+- ``(pps <ppx-rewriters-and-flags>)`` to preprocess files using the given list
   of ppx rewriters
 
 Note that in any cases, files are preprocessed only once. Jbuilder doesn't use
@@ -1006,14 +1006,15 @@ The equivalent of a ``-pp <command>`` option passed to the OCaml compiler is
 Preprocessing with ppx rewriters
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
-``<ppx-rewriters-and-flags>`` is expected to be a list where each element is
-either a command line flag if starting with a ``-`` or the name of a library.
-Additionally, any sub-list will be treated as a list of command line arguments.
-So for instance from the following ``preprocess`` field:
+``<ppx-rewriters-and-flags>`` is expected to be a sequence where each
+element is either a command line flag if starting with a ``-`` or the
+name of a library.  If you want to pass command line flags that do not
+start with a ``-``, you can separate library names from flags using
+``--``. So for instance from the following ``preprocess`` field:
 
    .. code:: scheme
 
-       (preprocess (pps (ppx1 -foo ppx2 (-bar 42))))
+       (preprocess (pps ppx1 -foo ppx2 -- -bar 42))
 
 The list of libraries will be ``ppx1`` and ``ppx2`` and the command line
 arguments will be: ``-foo -bar 42``.

src/jbuild.ml

@@ -181,29 +181,53 @@ end = struct
   let compare = String.compare
 end
 
-module Pp_or_flags = struct
-  type t =
-    | PP of Loc.t * Pp.t
-    | Flags of string list
+module Pps_and_flags = struct
+  module Jbuild_syntax = struct
+    let of_string ~loc s =
+      if String.is_prefix s ~prefix:"-" then
+        Right [s]
+      else
+        Left (loc, Pp.of_string s)
 
-  let of_string ~loc s =
-    if String.is_prefix s ~prefix:"-" then
-      Flags [s]
-    else
-      PP (loc, Pp.of_string s)
+    let item =
+      peek raw >>= function
+      | Atom _ | Quoted_string _ -> plain_string of_string
+      | List _ -> list string >>| fun l -> Right l
+
+    let split l =
+      let pps, flags =
+        List.partition_map l ~f:(fun x -> x)
+      in
+      (pps, List.concat flags)
+
+    let t = list item >>| split
+  end
+
+  module Dune_syntax = struct
+    let rec parse acc_pps acc_flags =
+      eos >>= function
+      | true ->
+        return (List.rev acc_pps, List.rev acc_flags)
+      | false ->
+        plain_string (fun ~loc s -> (loc, s)) >>= fun (loc, s) ->
+        match s with
+        | "--" ->
+          repeat string >>= fun flags ->
+          return (List.rev acc_pps, List.rev_append acc_flags flags)
+        | s when String.is_prefix s ~prefix:"-" ->
+          parse acc_pps (s :: acc_flags)
+        | _ ->
+          parse ((loc, Pp.of_string s) :: acc_pps) acc_flags
+
+    let t = parse [] []
+  end
 
   let t =
-    peek raw >>= function
-    | Atom _ | Quoted_string _ -> plain_string of_string
-    | List _ -> list string >>| fun l -> Flags l
-
-  let split l =
-    let pps, flags =
-      List.partition_map l ~f:(function
-        | PP (loc, pp) -> Left (loc, pp)
-        | Flags s      -> Right s)
-    in
-    (pps, List.concat flags)
+    Syntax.get_exn Stanza.syntax >>= fun ver ->
+    if ver < (1, 0) then
+      Jbuild_syntax.t
+    else
+      Dune_syntax.t
 end
 
 module Dep_conf = struct
@@ -277,8 +301,7 @@ module Preprocess = struct
          Action (loc, x))
       ; "pps",
         (loc >>= fun loc ->
-         list Pp_or_flags.t >>| fun l ->
-         let pps, flags = Pp_or_flags.split l in
+         Pps_and_flags.t >>| fun (pps, flags) ->
          Pps { loc; pps; flags })
       ]
 

test/blackbox-tests/test-cases/dune-ppx-driver-system/dune

@@ -3,21 +3,21 @@
  ((name foo1)
   (public_name foo.1)
   (modules (foo1))
-  (preprocess (pps ()))))
+  (preprocess (pps))))
 
 ; Too many drivers
 (library
  ((name foo2)
   (public_name foo.2)
   (modules (foo2))
-  (preprocess (pps (ppx1 ppx2)))))
+  (preprocess (pps ppx1 ppx2))))
 
 ; Incompatible with Dune
 (library
  ((name foo3)
   (public_name foo.3)
   (modules (foo3))
-  (preprocess (pps (ppx_other)))))
+  (preprocess (pps ppx_other))))
 
 (rule (with-stdout-to foo1.ml (echo "")))
 (rule (with-stdout-to foo2.ml (echo "")))
@@ -54,3 +54,15 @@
   (public_name foo.ppx-other)
   (modules ())
   (kind ppx_rewriter)))
+
+(library
+ ((name driver_print_args)
+  (modules ())
+  (ppx.driver ((main "(fun () -> Array.iter print_endline Sys.argv)")))))
+
+(rule (with-stdout-to test_ppx_args.ml (echo "")))
+
+(library
+ ((name test_ppx_args)
+  (modules (test_ppx_args))
+  (preprocess (pps -arg1 driver_print_args -arg2 -- -foo bar))))

test/blackbox-tests/test-cases/dune-ppx-driver-system/run.t

@@ -1,14 +1,14 @@
 No ppx driver found
 
   $ dune build foo1.cma
-  File "dune", line 6, characters 14-22:
+  File "dune", line 6, characters 14-19:
   Error: You must specify at least one ppx rewriter.
   [1]
 
 Too many drivers
 
   $ dune build foo2.cma
-  File "dune", line 13, characters 14-31:
+  File "dune", line 13, characters 14-29:
   Error: Too many incompatible ppx drivers were found: foo.driver2 and
   foo.driver1.
   [1]
@@ -16,7 +16,7 @@ Too many drivers
 Not compatible with Dune
 
   $ dune build foo3.cma
-  File "dune", line 20, characters 14-31:
+  File "dune", line 20, characters 14-29:
   Error: No ppx driver were found. It seems that ppx_other is not compatible
   with Dune. Examples of ppx rewriters that are compatible with Dune are ones
   using ocaml-migrate-parsetree, ppxlib or ppx_driver.
@@ -37,3 +37,22 @@ Same, but with error pointing to .ppx
   Examples of ppx rewriters that are compatible with Dune are ones using
   ocaml-migrate-parsetree, ppxlib or ppx_driver.
   [1]
+
+Test the argument syntax
+
+  $ dune build test_ppx_args.cma
+           ppx test_ppx_args.pp.ml
+  .ppx/driver_print_args@foo/ppx.exe
+  -arg1
+  -arg2
+  -foo
+  bar
+  --cookie
+  library-name="test_ppx_args"
+  -o
+  test_ppx_args.pp.ml
+  --impl
+  test_ppx_args.ml
+  Error: Rule failed to generate the following targets:
+  - test_ppx_args.pp.ml
+  [1]

test/blackbox-tests/test-cases/js_of_ocaml/bin/dune

@@ -4,5 +4,5 @@
   (js_of_ocaml (
     (flags (:standard))
     (javascript_files (runtime.js))))
-  (preprocess (pps (js_of_ocaml-ppx)))
+  (preprocess (pps js_of_ocaml-ppx))
   ))

test/blackbox-tests/test-cases/js_of_ocaml/lib/dune

@@ -4,5 +4,5 @@
   (js_of_ocaml ((flags (--pretty))
                 (javascript_files (runtime.js))))
   (c_names (stubs))
-  (preprocess (pps (js_of_ocaml-ppx)))
+  (preprocess (pps js_of_ocaml-ppx))
   ))

test/blackbox-tests/test-cases/merlin-tests/lib/dune

@@ -2,9 +2,9 @@
  ((name foo)
   (libraries (bytes unix findlib))
   (modules ())
-  (preprocess (pps (fooppx)))))
+  (preprocess (pps fooppx))))
 
 (library
  ((name bar)
   (modules ())
-  (preprocess (pps (fooppx)))))
+  (preprocess (pps fooppx))))

test/blackbox-tests/test-cases/meta-gen/dune

@@ -39,7 +39,7 @@
   (public_name foobar.ppd)
   (synopsis "pp'd with a rewriter")
   (libraries (foobar))
-  (preprocess (pps (foobar_rewriter)))))
+  (preprocess (pps foobar_rewriter))))
 
 (alias
  ((name runtest)