From 4c524a066a22ed8a5be024bd5fa6487359215c4e Mon Sep 17 00:00:00 2001 From: Drup Date: Mon, 18 Apr 2016 01:32:11 +0200 Subject: [PATCH] Make the Ppx_tyxml api a bit friendlier. --- ppx/ppx_tyxml.ml | 22 +++++++++++++--------- ppx/ppx_tyxml.mli | 2 +- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/ppx/ppx_tyxml.ml b/ppx/ppx_tyxml.ml index da9d65868..e7d27debe 100644 --- a/ppx/ppx_tyxml.ml +++ b/ppx/ppx_tyxml.ml @@ -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 -> @@ -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 @@ -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 @@ -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) = @@ -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 diff --git a/ppx/ppx_tyxml.mli b/ppx/ppx_tyxml.mli index 150e7e775..dced44352 100644 --- a/ppx/ppx_tyxml.mli +++ b/ppx/ppx_tyxml.mli @@ -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. *)