Incomplete expression in ppx extension

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"