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.

Sign up for GitHub

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

Type safe templating (with mustache) #128

Open
wants to merge 8 commits into
base: master
Choose a base branch
from
Open

Type safe templating (with mustache) #128

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
cbaf192
Cleanup in ppx build.
Drup Apr 13, 2018
af435ae
Mass rename.
Drup Apr 13, 2018
674195c
Keep renaming.
Drup Apr 13, 2018
a92cf8d
Add conditional simplification for markup_to_expr.
Drup Apr 18, 2016
15d6029
Add mustache templates.
Drup Apr 17, 2016
3a1918d
Add a test.
Drup Apr 18, 2016
715dca5
Use locations reported by the new mustache parser.
Drup Feb 25, 2017
f0dc427
WIP.
Drup Apr 13, 2018
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
93 changes: 46 additions & 47 deletions ppx/ppx_attribute_value.ml → ppx/attribute_value.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,14 +20,13 @@
[@@@ocaml.warning "-3"]

open Ast_helper
module Pc = Ppx_common

type 'a gparser =
?separated_by:string -> ?default:string -> Location.t -> string -> 'a ->
Parsetree.expression option

type parser = string gparser
type vparser = string Pc.value gparser
type vparser = string Common.value gparser

(* Handle expr *)

Expand Down Expand Up @@ -72,7 +71,7 @@ let list
delimiter separated_by element_parser ?separated_by:_ ?default:_ loc name s =

exp_list delimiter separated_by element_parser loc name s
|> Ppx_common.list loc
|> Common.list loc
|> fun e -> Some e

let spaces = list (Re_str.regexp " +") "space"
Expand All @@ -91,8 +90,8 @@ let wrap (parser : parser) implementation =
expr @@
fun ?separated_by:_ ?default:_ loc name s ->
match parser loc name s with
| None -> Ppx_common.error loc "wrap applied to presence; nothing to wrap"
| Some e -> Some (Ppx_common.wrap implementation loc e)
| None -> Common.error loc "wrap applied to presence; nothing to wrap"
| Some e -> Some (Common.wrap implementation loc e)

let nowrap (parser : parser) _ =
expr @@
Expand All @@ -116,7 +115,7 @@ let must_be_a
| None -> singular_description
in

Ppx_common.error loc "Value of %s must be %s" name description
Common.error loc "Value of %s must be %s" name description



Expand All @@ -134,12 +133,12 @@ let group_matched index s =
with Not_found -> false

let int_exp loc s =
try Some (Ppx_common.int loc (int_of_string s))
try Some (Common.int loc (int_of_string s))
with Failure _ -> None

let float_exp loc s =
try
Some (Ppx_common.float loc @@ float_of_string s)
Some (Common.float loc @@ float_of_string s)
with Failure _ ->
None

Expand All @@ -154,22 +153,22 @@ let char ?separated_by:_ ?default:_ loc name s =
let open Markup.Encoding in

let report _ error =
Ppx_common.error loc "%s in attribute %s"
Common.error loc "%s in attribute %s"
(Markup.Error.to_string error |> String.capitalize) name
in
let decoded = string s |> decode ~report utf_8 in

let c =
match next decoded with
| None -> Ppx_common.error loc "No character in attribute %s" name
| None -> Common.error loc "No character in attribute %s" name
| Some i when i <= 255 -> Char.chr i
| Some _ ->
Ppx_common.error loc "Character out of range in attribute %s" name
Common.error loc "Character out of range in attribute %s" name
in

begin match next decoded with
| None -> ()
| Some _ -> Ppx_common.error loc "Multiple characters in attribute %s" name
| Some _ -> Common.error loc "Multiple characters in attribute %s" name
end;

Some (with_default_loc loc @@ fun () -> Ast_convenience.char c)
Expand All @@ -179,7 +178,7 @@ let onoff ?separated_by:_ ?default:_ loc name s =
| "" | "on" -> true
| "off" -> false
| _ ->
Ppx_common.error loc {|Value of %s must be "on", "" or "off"|} name
Common.error loc {|Value of %s must be "on", "" or "off"|} name
in
Some (bool_exp loc b)

Expand All @@ -188,15 +187,15 @@ let bool ?separated_by:_ ?default:_ loc name s =
| "" | "true" -> true
| "false" -> false
| _ ->
Ppx_common.error loc {|Value of %s must be "true", "" or "false"|} name
Common.error loc {|Value of %s must be "true", "" or "false"|} name
in
Some (bool_exp loc b)

let unit ?separated_by:_ ?default:_ loc name s =
if s = "" || s = name then
Some (Ast_convenience.(with_default_loc loc unit))
else
Ppx_common.error loc
Common.error loc
{|Value of %s must be %s or "".|}
name name

Expand All @@ -218,8 +217,8 @@ let points ?separated_by:_ ?default:_ loc name s =
let expressions = spaces_or_commas_ float loc name s in

let rec pair acc = function
| [] -> List.rev acc |> Ppx_common.list loc
| [_] -> Ppx_common.error loc "Unpaired coordinate in %s" name
| [] -> List.rev acc |> Common.list loc
| [_] -> Common.error loc "Unpaired coordinate in %s" name
| ex::ey::rest -> pair (([%expr [%e ex], [%e ey]] [@metaloc loc])::acc) rest
in

Expand All @@ -230,7 +229,7 @@ let number_pair ?separated_by:_ ?default:_ loc name s =
begin match spaces_or_commas_ float loc name s with
| [orderx] -> [%expr [%e orderx], None]
| [orderx; ordery] -> [%expr [%e orderx], Some [%e ordery]]
| _ -> Ppx_common.error loc "%s requires one or two numbers" name
| _ -> Common.error loc "%s requires one or two numbers" name
end [@metaloc loc]
in

Expand All @@ -241,29 +240,29 @@ let fourfloats ?separated_by:_ ?default:_ loc name s =
| [min_x; min_y; width; height] ->
Some [%expr ([%e min_x], [%e min_y], [%e width], [%e height])]
[@metaloc loc]
| _ -> Ppx_common.error loc "Value of %s must be four numbers" name
| _ -> Common.error loc "Value of %s must be four numbers" name

(* These are always in a list; hence the error message. *)
let icon_size =
let regexp = Re_str.regexp "\\([0-9]+\\)[xX]\\([0-9]+\\)" in

fun ?separated_by:_ ?default:_ loc name s ->
if not @@ does_match regexp s then
Ppx_common.error loc "Value of %s must be a %s, or %s"
Common.error loc "Value of %s must be a %s, or %s"
name "space-separated list of icon sizes, such as 16x16" "any";

let width, height =
try
int_of_string (Re_str.matched_group 1 s),
int_of_string (Re_str.matched_group 2 s)
with Invalid_argument _ ->
Ppx_common.error loc "Icon dimension out of range in %s" name
Common.error loc "Icon dimension out of range in %s" name
in

Some
[%expr
[%e Ppx_common.int loc width],
[%e Ppx_common.int loc height]] [@metaloc loc]
[%e Common.int loc width],
[%e Common.int loc height]] [@metaloc loc]



Expand All @@ -284,7 +283,7 @@ let svg_quantity =
let n =
match float_exp loc (Re_str.matched_group 1 s) with
| Some n -> n
| None -> Ppx_common.error loc "Number out of range in %s" name
| None -> Common.error loc "Number out of range in %s" name
in

let unit_string = Re_str.matched_group 4 s in
Expand All @@ -307,7 +306,7 @@ let svg_length =
| "pt" -> [%expr `Pt]
| "px" -> [%expr `Px]
| "%" -> [%expr `Percent]
| s -> Ppx_common.error loc "Invalid length unit %s in %s" s name
| s -> Common.error loc "Invalid length unit %s in %s" s name
end [@metaloc loc]
in

Expand All @@ -322,7 +321,7 @@ let angle_ =
| "deg" -> [%expr `Deg]
| "rad" -> [%expr `Rad]
| "grad" -> [%expr `Grad]
| s -> Ppx_common.error loc "Invalid angle unit %s in %s" s name
| s -> Common.error loc "Invalid angle unit %s in %s" s name
end [@metaloc loc]
in

Expand All @@ -333,7 +332,7 @@ let angle ?separated_by ?default loc name s =

let offset =
let bad_form name loc =
Ppx_common.error loc "Value of %s must be a number or percentage" name in
Common.error loc "Value of %s must be a number or percentage" name in

let regexp = Re_str.regexp "\\([-+0-9eE.]+\\)\\(%\\)?" in

Expand All @@ -356,7 +355,7 @@ let transform =

fun ?separated_by:_ ?default:_ loc name s ->
if not @@ does_match regexp s then
Ppx_common.error loc "Value of %s must be an SVG transform" name;
Common.error loc "Value of %s must be an SVG transform" name;

let kind = Re_str.matched_group 1 s in
let values = Re_str.matched_group 2 s in
Expand All @@ -368,22 +367,22 @@ let transform =
| [a; b; c; d; e; f] ->
[%expr `Matrix ([%e a], [%e b], [%e c], [%e d], [%e e], [%e f])]
| _ ->
Ppx_common.error loc "%s: matrix requires six numbers" name
Common.error loc "%s: matrix requires six numbers" name
end

| "translate" ->
begin match spaces_or_commas_ float loc "translate" values with
| [tx; ty] -> [%expr `Translate ([%e tx], Some [%e ty])]
| [tx] -> [%expr `Translate ([%e tx], None)]
| _ ->
Ppx_common.error loc "%s: translate requires one or two numbers" name
Common.error loc "%s: translate requires one or two numbers" name
end

| "scale" ->
begin match spaces_or_commas_ float loc "scale" values with
| [sx; sy] -> [%expr `Scale ([%e sx], Some [%e sy])]
| [sx] -> [%expr `Scale ([%e sx], None)]
| _ -> Ppx_common.error loc "%s: scale requires one or two numbers" name
| _ -> Common.error loc "%s: scale requires one or two numbers" name
end

| "rotate" ->
Expand All @@ -395,18 +394,18 @@ let transform =
[%expr `Rotate
([%e angle_ loc "rotate" a], Some ([%e cx], [%e cy]))]
| _ ->
Ppx_common.error loc "%s: rotate center requires two numbers" name
Common.error loc "%s: rotate center requires two numbers" name
end
| _ ->
Ppx_common.error loc
Common.error loc
"%s: rotate requires an angle and an optional center" name
end

| "skewX" -> [%expr `SkewX [%e angle_ loc "skewX" values]]

| "skewY" -> [%expr `SkewY [%e angle_ loc "skewY" values]]

| s -> Ppx_common.error loc "%s: %s is not a valid transform type" name s
| s -> Common.error loc "%s: %s is not a valid transform type" name s
end [@metaloc loc]
in

Expand All @@ -433,7 +432,7 @@ let variant ?separated_by:_ ?default:_ loc _ s =
let total_variant (unary, nullary) ?separated_by:_ ?default:_ loc _name s =
let variand = variand s in
if List.mem variand nullary then Some (Exp.variant ~loc variand None)
else Some (Exp.variant ~loc unary (Some (Ppx_common.string loc s)))
else Some (Exp.variant ~loc unary (Some (Common.string loc s)))



Expand All @@ -456,20 +455,20 @@ let paint_without_icc loc _name s =
in

match icc_color_start with
| None -> [%expr `Color ([%e Ppx_common.string loc s], None)]
| None -> [%expr `Color ([%e Common.string loc s], None)]
| Some i ->
let icc_color = Re_str.matched_group 1 s in
let color = String.sub s 0 i in
[%expr `Color
([%e Ppx_common.string loc color],
Some [%e Ppx_common.string loc icc_color])]
([%e Common.string loc color],
Some [%e Common.string loc icc_color])]
end [@metaloc loc]

let paint ?separated_by:_ ?default:_ loc name s =
if not @@ Re_str.string_match (Re_str.regexp "url(\\([^)]+\\))") s 0 then
Some (paint_without_icc loc name s)
else
let iri = Re_str.matched_group 1 s |> Ppx_common.string loc in
let iri = Re_str.matched_group 1 s |> Common.string loc in
let remainder_start = Re_str.group_end 0 in
let remainder_length = String.length s - remainder_start in
let remainder =
Expand All @@ -491,13 +490,13 @@ let srcset_element =
let e =
begin match Re_str.bounded_split space s 2 with
| [url] ->
[%expr `Url [%e Ppx_common.string loc url]]
[%expr `Url [%e Common.string loc url]]

| [url; descriptor] ->
let bad_descriptor () =
Ppx_common.error loc "Bad width or density descriptor in %s" name in
Common.error loc "Bad width or density descriptor in %s" name in

let url = Ppx_common.string loc url in
let url = Common.string loc url in
let suffix_index = String.length descriptor - 1 in

let is_width =
Expand All @@ -513,7 +512,7 @@ let srcset_element =
match int_exp loc (String.sub descriptor 0 suffix_index) with
| Some n -> n
| None ->
Ppx_common.error loc "Bad number for width in %s" name
Common.error loc "Bad number for width in %s" name
in

[%expr `Url_width ([%e url], [%e n])]
Expand All @@ -523,12 +522,12 @@ let srcset_element =
match float_exp loc (String.sub descriptor 0 suffix_index) with
| Some n -> n
| None ->
Ppx_common.error loc "Bad number for pixel density in %s" name
Common.error loc "Bad number for pixel density in %s" name
in

[%expr `Url_pixel ([%e url], [%e n])]

| _ -> Ppx_common.error loc "Missing URL in %s" name
| _ -> Common.error loc "Missing URL in %s" name
end [@metaloc loc]
in

Expand All @@ -537,7 +536,7 @@ let srcset_element =
let number_or_datetime ?separated_by:_ ?default:_ loc _ s =
match int_exp loc s with
| Some n -> Some [%expr `Number [%e n]]
| None -> Some [%expr `Datetime [%e Pc.string loc s]]
| None -> Some [%expr `Datetime [%e Common.string loc s]]
[@metaloc loc]


Expand All @@ -552,6 +551,6 @@ let in2 = in_

let xmlns ?separated_by:_ ?default:_ loc name s =
if s <> Markup.Ns.html then
Ppx_common.error loc "%s: namespace must be %s" name Markup.Ns.html;
Common.error loc "%s: namespace must be %s" name Markup.Ns.html;

Some [%expr `W3_org_1999_xhtml] [@metaloc loc]
6 changes: 3 additions & 3 deletions ppx/ppx_attribute_value.mli → ppx/attribute_value.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ type 'a gparser =
?separated_by:string -> ?default:string -> Location.t -> string -> 'a ->
Parsetree.expression option
type parser = string gparser
type vparser = string Ppx_common.value gparser
type vparser = string Common.value gparser
(** Attribute value parsers are assigned to each attribute depending on the type
of the attribute's argument, though some attributes have special parsers
based on their name, or on a [[@@reflect]] annotation. A parser is a
Expand Down Expand Up @@ -76,11 +76,11 @@ val spaces_or_commas : parser -> parser
(** {3 Top combinators}
Exported parsers should always use one of those combinators last. *)

val wrap : parser -> Ppx_common.lang -> vparser
val wrap : parser -> Common.lang -> vparser
(** [wrap parser module_ _ _ s] applies [parser _ _ s] to get a parse tree for
[e], then evaluates to the parse tree for [module_.Xml.W.return e]. *)

val nowrap : parser -> Ppx_common.lang -> vparser
val nowrap : parser -> Common.lang -> vparser
(** [nowrap parser _ _ _ s] evaluates to [parser _ _ s]. The purpose of this
combinator is to provide a signature similar to [wrap] in situations where
wrapping is not wanted. *)
Expand Down
Loading