Skip to content

Commit

Permalink
add possiblity of trailing '/' in url
Browse files Browse the repository at this point in the history
  • Loading branch information
maxtori committed Oct 15, 2024
1 parent 28db88b commit 03c97fb
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 13 deletions.
13 changes: 9 additions & 4 deletions src/common/path.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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

Expand All @@ -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 =
Expand All @@ -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
21 changes: 12 additions & 9 deletions src/ppx/ppx_common.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit 03c97fb

Please sign in to comment.