From 03c97fbb020324d66acb64ac907b2facff4c013c Mon Sep 17 00:00:00 2001
From: Maxime Levillain <maxime.levillain@functori.com>
Date: Tue, 15 Oct 2024 14:09:28 +0200
Subject: [PATCH] add possiblity of trailing '/' in url

---
 src/common/path.ml    | 13 +++++++++----
 src/ppx/ppx_common.ml | 21 ++++++++++++---------
 2 files changed, 21 insertions(+), 13 deletions(-)

diff --git a/src/common/path.ml b/src/common/path.ml
index 49aec25..f7f182a 100644
--- a/src/common/path.ml
+++ b/src/common/path.ml
@@ -12,12 +12,13 @@ type (_, _) t =
   | Root : ('r, 'r) t
   | Static : ('r, 'key) t * string -> ('r, 'key) t
   | Dynamic : ('r, 'key) t * 'a Arg.t -> ('r, 'key * 'a) t
+  | Trailing : ('r, 'key) t -> ('r, 'key) t
 
 let root = Root
 
 let add_suffix path name = Static (path, name)
-
 let add_arg path arg = Dynamic (path, arg)
+let add_trailing path = Trailing path
 
 let (//) = add_suffix
 let (/:) = add_arg
@@ -26,13 +27,15 @@ let to_list ?(root=[]) ?(wrap=(fun s -> "{" ^ s ^ "}")) path =
   let rec aux : type r a. (r, a) t -> string list = function
     | Root -> root
     | Static (path, name) -> name :: aux path
-    | Dynamic (path, arg) -> wrap arg.Arg.description.Arg.name :: aux path in
+    | Dynamic (path, arg) -> wrap arg.Arg.description.Arg.name :: aux path
+    | Trailing path -> "" :: aux path
+  in
   List.rev @@ aux path
 
 let args path =
   let rec aux : type r a. (r, a) t -> Arg.descr list = function
     | Root -> []
-    | Static (path, _) -> aux path
+    | Static (path, _) | Trailing path -> aux path
     | Dynamic (path, arg) -> (Arg.descr arg) :: aux path in
   List.rev @@ aux path
 
@@ -45,7 +48,8 @@ let forge path args =
     fun path args acc -> match path, args with
       | Root, _ -> acc
       | Static (path, name), args -> aux path args (name :: acc)
-      | Dynamic (path, arg), (args, x) -> aux path args (arg.Arg.construct x :: acc) in
+      | Dynamic (path, arg), (args, x) -> aux path args (arg.Arg.construct x :: acc)
+      | Trailing path, _ -> aux path args ("" :: acc) in
   aux path args []
 
 let rec get_root : type r a. (r, a) t -> a -> r =
@@ -54,3 +58,4 @@ let rec get_root : type r a. (r, a) t -> a -> r =
   | Root, _ -> a
   | Static (p, _), _ -> get_root p a
   | Dynamic (p, _), (a, _) -> get_root p a
+  | Trailing p, _ -> get_root p a
diff --git a/src/ppx/ppx_common.ml b/src/ppx/ppx_common.ml
index 0e3d2d8..f80b231 100644
--- a/src/ppx/ppx_common.ml
+++ b/src/ppx/ppx_common.ml
@@ -115,16 +115,19 @@ let parse_arg ~loc s = match String.index_opt s ':' with
       Location.raise_errorf ~loc "argument type not understood: %S" typ
 
 let parse_path ~loc s =
-  let path ~loc s = pexp_ident ~loc {txt=Longident.parse ("EzAPI.Path." ^ s); loc} in
   let l = String.split_on_char '/' s in
-  let l = List.filter (fun s -> s <> "") l in
-  List.fold_left (fun (acc, n) s ->
-      match String.get s 0 with
-      | '{' ->
-        let e = parse_arg ~loc String.(sub s 1 (length s - 2)) in
-        eapply ~loc (path ~loc "add_arg") [ acc; e ], n+1
-      | _ -> eapply ~loc (path ~loc "add_suffix") [ acc; estring ~loc s ], n
-    ) (path ~loc "root", 0) l
+  let npath = List.length l in
+  let acc, n, _ = List.fold_left (fun (acc, n, i) s ->
+      if s = "" && i <> npath-1 then (acc, n, i+1)
+      else if s = "" then [%expr EzAPI.Path.add_trailing [%e acc]], n, i+1
+      else match String.get s 0 with
+        | '{' ->
+          let e = parse_arg ~loc String.(sub s 1 (length s - 2)) in
+          [%expr EzAPI.Path.add_arg [%e acc] [%e e]], n+1, i+1
+        | _ ->
+          [%expr EzAPI.Path.add_suffix [%e acc] [%e estring ~loc s]], n, i+1
+    ) ([%expr EzAPI.Path.root], 0, 0) l in
+  acc, n
 
 let string_literal = function
   | Ppxlib.Pconst_string (s, _, _) -> Some s