Incomplete expression in ppx extension - ocaml

Question

I want to try to write my own ppx to allow named arguments in formatting strings:
From Format.printf [%fmt "!(abc) !(qsd)"] to Format.printf "%s %s" abc qsd
When dumping with ppx_tools I want to go from:
{pexp_desc =
Pexp_apply
({pexp_desc = Pexp_ident {txt = Ldot (Lident "Format", "printf")};
pexp_loc_stack = []},
[(Nolabel,
{pexp_desc =
Pexp_extension
({txt = "fmt"},
PStr
[{pstr_desc =
Pstr_eval
({pexp_desc =
Pexp_constant (Pconst_string ("!(abc) !(qsd)", ...));
pexp_loc_stack = []},
...)}]);
pexp_loc_stack = []})]);
pexp_loc_stack = []}
To
{pexp_desc =
Pexp_apply
({pexp_desc = Pexp_ident {txt = Ldot (Lident "Format", "printf")};
pexp_loc_stack = []},
[(Nolabel,
{pexp_desc = Pexp_constant (Pconst_string ("%s %s", ...));
pexp_loc_stack = []});
(Nolabel,
{pexp_desc = Pexp_ident {txt = Lident "abc"}; pexp_loc_stack = []});
(Nolabel,
{pexp_desc = Pexp_ident {txt = Lident "qsd"}; pexp_loc_stack = []})]);
pexp_loc_stack = []}
The ppx extension starts inside a function application so I would just want to specify that what I'm about to create are applications arguments but so far I've not been able to do so:
I get the formatting string (in my example it would be "%s %s") and the arguments to it (e.g. abc and qsd) and try to produce "%s %s" abc qsd but if I use Ast_build.Default.elist fmt args I get ["%s %s"; abc; qsd] and with eapply I get ("%s %s" abc qsd) (almost there but the parenthesis make it wrong).
let expand ~ctxt fmt =
let loc = Expansion_context.Extension.extension_point_loc ctxt in
let fmt, args = parse loc fmt in
Ast_builder.Default.eapply ~loc (* <- Here is where I don't know what to do *)
(Ast_builder.Default.estring ~loc fmt)
(List.map (Ast_builder.Default.evar ~loc) args)
Since it's heavily recommended to use ppxlib to do this kind of things, is there an easy way to achieve what I want? I tried looking for some documentation for it but it's still a work in progress and the few examples I could find transform an expression in another expression while I'm transforming an expression (a string) in an incomplete one.
FULL CODE:
open Ppxlib
(* A format string is a normal string with the special construct !(...) *)
let parse loc string =
let length = String.length string in
let buffer = Buffer.create length in
let rec parse args index =
if index = length then (Buffer.contents buffer, args)
else
match String.unsafe_get string index with
| '!' as c ->
if index = length - 1 || String.unsafe_get string (index + 1) <> '('
then (
(* Simple ! not starting a named argument *)
Buffer.add_char buffer c;
parse args (index + 1))
else
(* We saw !( and need to parse the rest as a named argument *)
let index, var = parse_named_arg (index + 2) in
Buffer.add_string buffer "%s";
parse (var :: args) index
| c ->
Buffer.add_char buffer c;
parse args (index + 1)
and parse_named_arg index =
let var = Buffer.create 8 in
let rec parse_var index =
if index = length then
Location.raise_errorf ~loc
"Reached end of formatting string with !(...) construct not ended"
else
match String.unsafe_get string index with
| ')' -> (index + 1, Buffer.contents var)
| c ->
Buffer.add_char var c;
parse_var (index + 1)
in
parse_var index
in
parse [] 0
let expand ~ctxt fmt =
let loc = Expansion_context.Extension.extension_point_loc ctxt in
let fmt, args = parse loc fmt in
Ast_builder.Default.eapply ~loc
(Ast_builder.Default.estring ~loc fmt)
(List.map (Ast_builder.Default.evar ~loc) args)
let my_extension =
Extension.V3.declare "fmt" Extension.Context.expression
Ast_pattern.(single_expr_payload (estring __))
expand
let rule = Ppxlib.Context_free.Rule.extension my_extension
let () = Driver.register_transformation ~rules:[ rule ] "ppx_fmt_string"