diff --git a/_oasis b/_oasis index c82c056e4..9885c9cbf 100644 --- a/_oasis +++ b/_oasis @@ -203,6 +203,20 @@ Test basic_website TestTools: basic_website Run$: flag(tests) +Executable basic_website_ppx + Install: false + Build$: flag(tests) && flag(tests) + Path: examples/basic_website_ppx + MainIs: site_html.ml + BuildDepends: tyxml + CompiledObject: best + +Test basic_website_ppx + WorkingDirectory: examples/basic_website_ppx + Command: $basic_website_ppx + TestTools: basic_website_ppx + Run$: flag(tests) && flag(tests) + Executable mini_website Install: false Build$: flag(tests) diff --git a/_tags b/_tags index 068d8b58e..5f2c73ce0 100644 --- a/_tags +++ b/_tags @@ -15,4 +15,4 @@ true: keep_locs # Tests use the tyxml ppx : ppx_tyxml -: ppx_tyxml +: ppx_tyxml diff --git a/examples/basic_website_ppx/.merlin b/examples/basic_website_ppx/.merlin new file mode 100644 index 000000000..d6152e662 --- /dev/null +++ b/examples/basic_website_ppx/.merlin @@ -0,0 +1 @@ +PKG tyxml.ppx \ No newline at end of file diff --git a/examples/basic_website_ppx/Makefile b/examples/basic_website_ppx/Makefile new file mode 100644 index 000000000..c84af8cad --- /dev/null +++ b/examples/basic_website_ppx/Makefile @@ -0,0 +1,8 @@ +site_gen := make_site + +all: + ocamlfind ocamlc site_html.ml -package tyxml.ppx -short-paths -linkpkg -o ${site_gen} + ./${site_gen} + +clean: + rm -f *.cmo *.cmt *.cmi ${site_gen} index.html diff --git a/examples/basic_website_ppx/Readme.md b/examples/basic_website_ppx/Readme.md new file mode 100644 index 000000000..1826eaef7 --- /dev/null +++ b/examples/basic_website_ppx/Readme.md @@ -0,0 +1,13 @@ +This is a very simple website in pure tyxml using the ppx syntax extension. +To generate the website, compile `site_html.ml` and then execute. This can be done with `make`. + +Content of this directory: +- `site_html.ml`: Generates the Html. +- `Makefile`: Simple rules to create the website. Uses ocamlbuild +- `main.js` and `home.css` : auxiliary files for the website. +- `.merlin`: An appropriate merlin file. +- Readme.md : You are reading it + +This website is distributed under the [unlicense][], feel free to use it! + +[unlicense]: http://unlicense.org/ diff --git a/examples/basic_website_ppx/home.css b/examples/basic_website_ppx/home.css new file mode 100644 index 000000000..16ba856e5 --- /dev/null +++ b/examples/basic_website_ppx/home.css @@ -0,0 +1,11 @@ +#links_bar li { + margin:1em; + padding:0.4em; + font-size:large; + display:inline; + cursor:pointer; + border:none; + border-radius:0px; + transition:.2s linear; + text-align:center; +} diff --git a/examples/basic_website_ppx/main.js b/examples/basic_website_ppx/main.js new file mode 100644 index 000000000..166b288bb --- /dev/null +++ b/examples/basic_website_ppx/main.js @@ -0,0 +1,6 @@ +"use strict"; + + +var handle = document.getElementById("payload"); + +console.log(handle); diff --git a/examples/basic_website_ppx/site_html.ml b/examples/basic_website_ppx/site_html.ml new file mode 100644 index 000000000..572db2bfb --- /dev/null +++ b/examples/basic_website_ppx/site_html.ml @@ -0,0 +1,69 @@ +open Tyxml + +let this_title = Html.pcdata "Your Cool Web Page" + +let image_box = [%html + "
" +] + +let links_box = [%html {| + +|}] + +let common_footer = [%html {| + +|}] + +let home_content = [%html + "

Hello Coder

" +] + +let main_payload = [%html + "
"[home_content]"
" +] + +let common_nav = Html.nav [links_box] + +let content_box = [%html + "
"[ + common_nav; + main_payload; + common_footer; + ]"
" +] + +let main_script = [%html + "" +] + +let home_page_doc = [%html + {| + + |}this_title{| + + + |} [ image_box; content_box; main_script ] {| + +|}] + +(** The set of pages in your website. *) +let pages = [("index.html", home_page_doc)] + +(** Small code to emit all the pages. *) +let emit_page (name, page) = + Printf.printf "Generating: %s\n" name ; + let file_handle = open_out name in + let fmt = Format.formatter_of_out_channel file_handle in + Html.pp () fmt page; + close_out file_handle + +let () = List.iter emit_page pages diff --git a/examples/mini_website_ppx/minihtml.ml b/examples/mini_website_ppx/minihtml.ml index 6bcd0a01f..a963f3ed2 100644 --- a/examples/mini_website_ppx/minihtml.ml +++ b/examples/mini_website_ppx/minihtml.ml @@ -11,7 +11,13 @@ let mycontent = [%html {| let mytitle = Html.pcdata "A Fabulous Web Page" let mypage = [%html - ""mytitle""mycontent""] + {| + + |}mytitle{| + + "mycontent" + + |}] let () = let file = open_out "index.html" in diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index efc2fef2e..1894a4e08 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -704,8 +704,10 @@ module type T = sig val dl : ([< | dl_attrib], [< | dl_content_fun], [> | dl]) star val ol : ([< | ol_attrib], [< | ol_content_fun], [> | ol]) star + [@@reflect.element "ol"] val ul : ([< | ul_attrib], [< | ul_content_fun], [> | ul]) star + [@@reflect.element "ul"] val dd : ([< | dd_attrib], [< | dd_content_fun], [> | dd]) star diff --git a/ppx/ppx_element_content.ml b/ppx/ppx_element_content.ml index 4969c4f48..52ae66dbc 100644 --- a/ppx/ppx_element_content.ml +++ b/ppx/ppx_element_content.ml @@ -42,17 +42,27 @@ let to_pcdata = function end | _ -> None +(** Test if the expression is a pcdata containing only whitespaces. *) +let is_whitespace = function + | Pc.Val e -> begin + match to_pcdata e with + | Some s when String.trim s = "" -> true + | _ -> false + end + | _ -> true + (* Given a list of parse trees representing children of an element, filters out all children that consist of applications of [pcdata] to strings containing only whitespace. *) -let filter_whitespace children = - children |> List.filter (function - | Pc.Val e -> begin - match to_pcdata e with - | Some s when String.trim s = "" -> false - | _ -> true - end - | _ -> true) +let filter_whitespace = List.filter (fun e -> not @@ is_whitespace e) + +let filter_surrounding_whitespace children = + let rec aux = function + | [] -> [] + | h :: t when is_whitespace h -> aux t + | l -> List.rev l + in + aux @@ aux children (* Given a parse tree and a string [name], checks whether the parse tree is an application of a function with name [name]. *) @@ -93,7 +103,16 @@ let star ~lang ~loc ~name:_ children = (* Special-cased. *) +let ul ~lang ~loc ~name children = + let children = filter_whitespace children in + star ~lang ~loc ~name children + +let ol ~lang ~loc ~name children = + let children = filter_whitespace children in + star ~lang ~loc ~name children + let head ~lang ~loc ~name children = + let children = filter_whitespace children in let title, others = partition (html "title") children in match title with diff --git a/ppx/ppx_element_content.mli b/ppx/ppx_element_content.mli index dab27470a..4cc87490d 100644 --- a/ppx/ppx_element_content.mli +++ b/ppx/ppx_element_content.mli @@ -77,3 +77,13 @@ val fieldset : assembler val datalist : assembler val details : assembler val menu : assembler +val ul : assembler +val ol : assembler + +(** {1 Misc utilities} *) + +(** Remove pcdata containing only whitespace that are at the beginning or the end + of the list. *) +val filter_surrounding_whitespace : + Parsetree.expression Ppx_common.value list -> + Parsetree.expression Ppx_common.value list diff --git a/ppx/ppx_tyxml.ml b/ppx/ppx_tyxml.ml index 3d006ba01..68fe6bc8c 100644 --- a/ppx/ppx_tyxml.ml +++ b/ppx/ppx_tyxml.ml @@ -270,7 +270,12 @@ let markup_to_expr lang loc expr = assemble lang children in - match assemble lang [] with + let l = + Ppx_element_content.filter_surrounding_whitespace @@ + assemble lang [] + in + + match l with | [ Val x | Antiquot x ] -> x | l -> Ppx_common.list_wrap_value lang loc l diff --git a/test/test_ppx.ml b/test/test_ppx.ml index 83c621c2a..22c575fd3 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -61,6 +61,33 @@ let basics = "ppx basics", tyxml_tests Html.[ [[%html "foo "]], [html (head (title (pcdata "foo")) []) (body [])] ; + "whitespace around html element", + [[%html " foo "]], + [html (head (title (pcdata "foo")) []) (body [])] ; + + "whitespace around element", + [[%html "

"]], + [p []] ; + + "whitespace in element", + [[%html "

"]], + [p [pcdata " "]] ; + + "whitespace around lists", + [%html "

"], + [p [] ; span []] ; + + "whitespace around pcdata", + [%html " bar

foo "], + [pcdata " bar" ; p [] ; pcdata "foo " ] ; + + "whitespace in ul", + [[%html "
  • foo
  • bar
"]], + [ul [li [pcdata "foo"] ; li [pcdata "bar"]]] ; + + "whitespace in ol", + [[%html "
  1. foo
  2. bar
"]], + [ol [li [pcdata "foo"] ; li [pcdata "bar"]]] ; ]