Skip to content

Fix handling of figcaption. #219

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

Merged
Drup merged 1 commit into from
Oct 4, 2018
Merged

Fix handling of figcaption. #219

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
43 changes: 27 additions & 16 deletions ppx/element_content.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -127,23 +127,34 @@ let head ~lang ~loc ~name children =
"%s element must have exactly one title child element" name

let figure ~lang ~loc ~name children =
begin match children with
| [] -> star ~lang ~loc ~name children
| first::others ->
if is_element_with_name (html "figcaption") first then
let caption, children =
let rec is_first_figcaption = function
| [] -> is_last_figcaption (List.rev children)
| h :: t ->
if is_whitespace h then is_first_figcaption t
else if is_element_with_name (html "figcaption") h then
`Top h,t
else is_last_figcaption (List.rev children)
and is_last_figcaption = function
| [] -> `No, children
| h :: t ->
if is_whitespace h then is_last_figcaption t
else if is_element_with_name (html "figcaption") h then
`Bottom h, (List.rev t)
else `No, children
in
is_first_figcaption children
in
begin match caption with
| `No -> star ~lang ~loc ~name children
| `Top elt ->
(Common.Label.labelled "figcaption",
[%expr `Top [%e Common.wrap_value lang loc elt]])::
(star ~lang ~loc ~name children)
| `Bottom elt ->
(Common.Label.labelled "figcaption",
[%expr `Top [%e Common.wrap_value lang loc first]])::
(star ~lang ~loc ~name others)
else
let children_reversed = List.rev children in
let last = List.hd children_reversed in
if is_element_with_name (html "figcaption") last then
let others = List.rev (List.tl children_reversed) in
(Common.Label.labelled "figcaption",
[%expr `Bottom [%e Common.wrap_value lang loc last]])::
(star ~lang ~loc ~name others)
else
star ~lang ~loc ~name children
[%expr `Bottom [%e Common.wrap_value lang loc elt]])::
(star ~lang ~loc ~name children)
end [@metaloc loc]

let object_ ~lang ~loc ~name children =
Expand Down
10 changes: 10 additions & 0 deletions test/test_ppx.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -145,6 +145,16 @@ let basics = "ppx basics", HtmlTests.make Html.[
[[%html {|<div><p>a</p><!-- b --><hr/></div>|}]],
[div [p [pcdata "a"]; tot (Xml.comment " b "); hr ()]] ;

"figcaption first",
[[%html {|<figure> <figcaption> hello </figcaption> <img src="foo.jpg" alt="a" /> </figure>|}]],
[figure ~figcaption:(`Top (figcaption [pcdata " hello "]))
[pcdata " "; img ~src:"foo.jpg" ~alt:"a" () ; pcdata " " ]];

"figcaption last",
[[%html {|<figure> <img src="foo.jpg" alt="a" /> <figcaption> hello </figcaption> </figure>|}]],
[figure ~figcaption:(`Bottom (figcaption [pcdata " hello "]))
[pcdata " "; img ~src:"foo.jpg" ~alt:"a" () ; pcdata " " ]];

]

let attribs = "ppx attribs", HtmlTests.make Html.[
Expand Down