Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Make the Ppx_tyxml api a bit friendlier. #151

Merged
merged 1 commit into from
May 7, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
22 changes: 13 additions & 9 deletions ppx/ppx_tyxml.ml
Original file line number Diff line number Diff line change
Expand Up @@ -237,12 +237,7 @@ let replace_attribute ~loc (attr,value) =

Each token is equipped with a starting (but no ending) position.
*)
let ast_to_stream expr =
let expressions =
match expr.pexp_desc with
| Pexp_apply (f, arguments) -> f::(List.map snd arguments)
| _ -> [expr]
in
let ast_to_stream expressions =

let strings =
expressions |> List.map @@ fun expr ->
Expand Down Expand Up @@ -380,6 +375,12 @@ let dispatch_ext {txt ; loc} =
Some (Ppx_common.Svg, get_modname ~loc len l)
| _ -> None

let application_to_list expr =
match expr.pexp_desc with
| Pexp_apply (f, arguments) -> f::(List.map snd arguments)
| _ -> [expr]


open Ast_mapper
open Ast_helper

Expand All @@ -390,7 +391,8 @@ let markup_cases ~lang ~modname cases =
let f ({pc_rhs} as case) =
let loc = pc_rhs.pexp_loc in
let pc_rhs =
markup_to_expr_with_implementation lang modname loc pc_rhs
markup_to_expr_with_implementation lang modname loc @@
application_to_list pc_rhs
in {case with pc_rhs}
in
List.map f cases
Expand All @@ -405,7 +407,8 @@ let rec markup_function ~lang ~modname e =
let cases = markup_cases ~lang ~modname cases in
{e with pexp_desc = Pexp_function cases}
| _ ->
markup_to_expr_with_implementation lang modname loc e
markup_to_expr_with_implementation lang modname loc @@
application_to_list e

let markup_bindings ~lang ~modname l =
let f ({pvb_expr} as b) =
Expand All @@ -424,7 +427,8 @@ let rec expr mapper e =
let bindings = markup_bindings ~lang ~modname bindings in
{e with pexp_desc = Pexp_let (recflag, bindings, expr mapper next)}
| _ ->
markup_to_expr_with_implementation lang modname e.pexp_loc e
markup_to_expr_with_implementation lang modname e.pexp_loc @@
application_to_list e
end
| Some _, _ -> error ext
| None, _ -> default_mapper.expr mapper e
Expand Down
2 changes: 1 addition & 1 deletion ppx/ppx_tyxml.mli
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@

val markup_to_expr :
Ppx_common.lang ->
Location.t -> Parsetree.expression -> Parsetree.expression
Location.t -> Parsetree.expression list -> Parsetree.expression
(** Given the payload of a [%html ...] or [%svg ...] expression,
converts it to a TyXML expression representing the markup
contained therein. *)
Expand Down