Skip to content

Commit

Permalink
Merge pull request #151 from ocsigen/ppx_api
Browse files Browse the repository at this point in the history
Make the Ppx_tyxml api a bit friendlier.
  • Loading branch information
Drup committed May 7, 2016
2 parents 15c7278 + 4c524a0 commit 9d72bbc
Show file tree
Hide file tree
Showing 2 changed files with 14 additions and 10 deletions.
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

0 comments on commit 9d72bbc

Please sign in to comment.