Allow to pass more information to ppx rewriters

CHANGES.md

@@ -28,6 +28,10 @@ unreleased
 - Allow %{...} variables in pps flags (#2076, @mlasson review by @diml and
   @aalekseyev).
 
+- Add a 'cookies' option to ppx_rewriter/deriver flags in library stanzas
+  (#2106, @mlasson @diml). This allow to specify cookie requests from
+  variables expanded at each invocation of the preprocessor. 
+
 - Add more opam metadata and use it to generate `.opam` files. In particular, a
   `package` field has been added to specify package specific information.
   (#2017, #2091, @avsm, @jonludlam, @rgrinberg)

doc/dune-files.rst

@@ -140,7 +140,12 @@ to use the :ref:`include_subdirs` stanza.
   available choices are ``ppx_rewriter`` and ``ppx_deriver`` and must be set
   when the library is intended to be used as a ppx rewriter or a ``[@@deriving
   ...]`` plugin. The reason why ``ppx_rewriter`` and ``ppx_deriver`` are split
-  is historical and hopefully we won't need two options soon
+  is historical and hopefully we won't need two options soon. Both ppx kinds
+  support an optional field ``(cookies <cookies>)`` where ``<cookies>`` is a
+  list of pairs ``(<name> <value>)`` with ``<name>`` being the cookie name and
+  ``<value>`` is a string that supports `Variables expansion`_ evaluated
+  by each invocation of the preprocessor (note: libraries that share
+  cookies with the same name should agree on their expanded value)
 
 - ``(ppx_runtime_libraries (<library-names>))`` is for when the library is a ppx
   rewriter or a ``[@@deriving ...]`` plugin and has runtime dependencies. You

src/gen_meta.ml

@@ -75,7 +75,7 @@ let gen_lib pub_name lib ~version =
   let preds =
     match Lib.kind lib with
     | Normal -> []
-    | Ppx_rewriter | Ppx_deriver -> [Pos "ppx_driver"]
+    | Ppx_rewriter _ | Ppx_deriver _ -> [Pos "ppx_driver"]
   in
   let lib_deps    = Lib.Meta.requires lib in
   let ppx_rt_deps = Lib.Meta.ppx_runtime_deps lib in
@@ -95,7 +95,7 @@ let gen_lib pub_name lib ~version =
         ]
     ; (match Lib.kind lib with
        | Normal -> []
-       | Ppx_rewriter | Ppx_deriver ->
+       | Ppx_rewriter _ | Ppx_deriver _ ->
          (* Deprecated ppx method support *)
          let no_ppx_driver = Neg "ppx_driver" and no_custom_ppx = Neg "custom_ppx" in
          List.concat
@@ -107,10 +107,10 @@ let gen_lib pub_name lib ~version =
              ]
            ; match Lib.kind lib with
            | Normal -> assert false
-           | Ppx_rewriter ->
+           | Ppx_rewriter _ ->
              [ rule "ppx" [no_ppx_driver; no_custom_ppx]
                  Set "./ppx.exe --as-ppx" ]
-           | Ppx_deriver ->
+           | Ppx_deriver _ ->
              [ rule "requires" [no_ppx_driver; no_custom_ppx] Add
                  "ppx_deriving"
              ; rule "ppxopt" [no_ppx_driver; no_custom_ppx] Set

src/install_rules.ml

@@ -152,8 +152,8 @@ let init_meta sctx ~dir =
 
 let lib_ppxs sctx ~(lib : Dune_file.Library.t) ~scope ~dir_kind =
   match lib.kind with
-  | Normal | Ppx_deriver -> []
-  | Ppx_rewriter ->
+  | Normal | Ppx_deriver _ -> []
+  | Ppx_rewriter _ ->
     let name = Dune_file.Library.best_name lib in
     match (dir_kind : Dune_lang.File_syntax.t) with
     | Dune ->

src/lib_kind.ml

@@ -1,19 +1,73 @@
+module Ppx_args = struct
+  module Cookie = struct
+    type t =
+      { name : string
+      ; value : String_with_vars.t
+      }
+
+    let decode =
+      let open Stanza.Decoder in
+      let* () = Syntax.since Stanza.syntax (1, 10) in
+      enter
+        (
+          let+ name = plain_string
+            (fun ~loc str ->
+              if String.contains str '=' then
+                Errors.fail loc "Character '=' is not allowed in cookie names"
+              else
+                str
+            )
+          and+ value = String_with_vars.decode in
+          { name; value }
+        )
+
+    let encode { name; value } =
+      let open Dune_lang in
+      List
+        [ Encoder.string name
+        ; String_with_vars.encode value
+        ]
+  end
+
+  type t =
+    { cookies : Cookie.t list
+    }
+
+  let decode =
+    let open Stanza.Decoder in
+    let args =
+      let+ cookies = field "cookies" (list Cookie.decode) ~default:[] in
+      {cookies}
+    in
+    fields args
+
+  let encode { cookies } =
+    let open Dune_lang.Encoder in
+    record_fields
+      [ field_l "cookies" Cookie.encode cookies ]
+end
+
 type t =
   | Normal
-  | Ppx_deriver
-  | Ppx_rewriter
+  | Ppx_deriver of Ppx_args.t
+  | Ppx_rewriter of Ppx_args.t
 
 let decode =
   let open Dune_lang.Decoder in
-  enum
-    [ "normal"       , Normal
-    ; "ppx_deriver"  , Ppx_deriver
-    ; "ppx_rewriter" , Ppx_rewriter
+  sum
+    [ "normal"       , return Normal
+    ; "ppx_deriver"  , (let+ args = Ppx_args.decode in Ppx_deriver args)
+    ; "ppx_rewriter" , (let+ args = Ppx_args.decode in Ppx_rewriter args)
     ]
 
 let encode t =
-  Dune_lang.Encoder.string (
+  match
     match t with
-    | Normal -> "normal"
-    | Ppx_deriver -> "ppx_deriver"
-    | Ppx_rewriter -> "ppx_rewriter")
+    | Normal -> Dune_lang.atom "normal"
+    | Ppx_deriver x ->
+      List (Dune_lang.atom "ppx_deriver" :: Ppx_args.encode x)
+    | Ppx_rewriter x ->
+      List (Dune_lang.atom "ppx_rewriter" :: Ppx_args.encode x)
+  with
+  | List [x] -> x
+  | x -> x

src/lib_kind.mli

@@ -1,6 +1,19 @@
+module Ppx_args : sig
+  module Cookie : sig
+    type t =
+      { name : string
+      ; value : String_with_vars.t
+      }
+  end
+
+  type t =
+    { cookies : Cookie.t list
+    }
+end
+
 type t =
   | Normal
-  | Ppx_deriver
-  | Ppx_rewriter
+  | Ppx_deriver of Ppx_args.t
+  | Ppx_rewriter of Ppx_args.t
 
 include Dune_lang.Conv with type t := t

src/lib_rules.ml

@@ -77,7 +77,7 @@ module Gen (P : sig val sctx : Super_context.t end) = struct
            ; Dyn (fun (_, _, _, library_flags) -> As library_flags)
            ; As (match lib.kind with
                | Normal -> []
-               | Ppx_deriver | Ppx_rewriter -> ["-linkall"])
+               | Ppx_deriver _ | Ppx_rewriter _ -> ["-linkall"])
            ; Dyn (fun (cm_files, _, _, _) -> Deps cm_files)
            ; Hidden_targets
                (match mode with

src/merlin.ml

@@ -126,15 +126,12 @@ let pp_flags sctx ~expander ~dir_kind { preprocess; libname; _ } =
   match Dune_file.Preprocess.remove_future_syntax preprocess
           (Super_context.context sctx).version
   with
-  | Pps { loc = _; pps; flags; staged = _ } -> begin
-    match Preprocessing.get_ppx_driver sctx ~scope ~dir_kind pps with
+  | Pps { loc; pps; flags; staged = _ } -> begin
+    match Preprocessing.get_ppx_driver sctx ~loc ~expander ~lib_name:libname ~flags ~scope ~dir_kind pps with
     | Error _ -> None
-    | Ok exe ->
-      let flags = List.map ~f:(Expander.expand_str expander) flags in
+    | Ok (exe, flags) ->
       (Path.to_absolute_filename exe
-       :: "--as-ppx"
-       :: Preprocessing.cookie_library_name libname
-       @ flags)
+       :: "--as-ppx" :: flags)
       |> List.map ~f:quote_for_merlin
       |> String.concat ~sep:" "
       |> Filename.quote