pax_global_header 0000666 0000000 0000000 00000000064 14040247726 0014520 g ustar 00root root 0000000 0000000 52 comment=ef431a4bceaefb2d9248e79092e6c1a1a9420095
tyxml-4.5.0/ 0000775 0000000 0000000 00000000000 14040247726 0012703 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/.github/ 0000775 0000000 0000000 00000000000 14040247726 0014243 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/.github/workflows/ 0000775 0000000 0000000 00000000000 14040247726 0016300 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/.github/workflows/workflow.yml 0000664 0000000 0000000 00000001773 14040247726 0020705 0 ustar 00root root 0000000 0000000 name: Main workflow
on:
pull_request:
push:
schedule:
# Prime the caches every Monday
- cron: 0 1 * * MON
jobs:
build:
strategy:
fail-fast: false
matrix:
os:
- ubuntu-latest
ocaml-compiler:
- 4.04.x
- 4.05.x
- 4.06.x
- 4.07.x
- 4.08.x
- 4.09.x
- 4.10.x
include:
- os: macos-latest
ocaml-compiler: 4.10.x
- os: windows-latest
ocaml-compiler: 4.10.x
runs-on: ${{ matrix.os }}
steps:
- name: Checkout code
uses: actions/checkout@v2
- name: Use OCaml ${{ matrix.ocaml-compiler }}
uses: avsm/setup-ocaml@v2
with:
ocaml-compiler: ${{ matrix.ocaml-compiler }}
dune-cache: ${{ matrix.os == 'ubuntu-latest' }}
opam-depext-flags: --with-test
- run: opam install . --deps-only --with-test
- run: opam exec -- make build
- run: opam exec -- make test
tyxml-4.5.0/.gitignore 0000664 0000000 0000000 00000000276 14040247726 0014700 0 ustar 00root root 0000000 0000000 _build/
_opam/
.vscode/
**/*.mlpack
**/*.mllib
**/*.odocl
**/*.docdir
lib/META
setup.data
setup.log
**/*~
setup.exe
setup-dev.exe
*.byte
*.native
_tests
.merlin
*.install
docs/api/
_wikidoc
tyxml-4.5.0/.jenkins.sh 0000664 0000000 0000000 00000000614 14040247726 0014757 0 ustar 00root root 0000000 0000000 export ALCOTEST_SHOW_ERRORS=true
opam pin add --no-action tyxml .
opam pin add --no-action tyxml-ppx .
opam install -t --deps-only tyxml
opam install -t --verbose tyxml
opam install -t --verbose tyxml-ppx
do_build_doc () {
make wikidoc
cp -Rf doc/manual-wiki/*.wiki ${MANUAL_SRC_DIR}
cp -Rf _build/tyxml-api.wikidocdir/*.wiki ${API_DIR}
}
do_remove () {
opam remove --verbose tyxml
}
tyxml-4.5.0/.ocp-indent 0000664 0000000 0000000 00000000051 14040247726 0014740 0 ustar 00root root 0000000 0000000 normal
with=0
syntax=lwt mll
max_indent=2 tyxml-4.5.0/CHANGES.md 0000664 0000000 0000000 00000022466 14040247726 0014307 0 ustar 00root root 0000000 0000000 # 4.5.0
* Move all the PPXs to ppxlib
(#271, Initial code by Sonja @pitag-ha Heinze)
* Add the `translate` attribute
(#281 by Javier @jchavarri Chávarri)
* Update allowed `inputmode`s
(#279 by Joel @joelburget Burget)
* Add the `picture` element
(#263 by Stéphane @slegrand45 Legrand)
# 4.4.0
* Add support for Reason's JSX syntax with a new `tyxml-jsx` package
(#254 by Joris Giovannangeli and Gabriel Radanne
with help from Ulrik Strid and Louis Roché)
* Modernize the handling of toplevel printers for utop.
(Gabriel Radanne)
## Elements and attributes
* Add `allowfullscreen`, `allowpaymentrequest`, `referrerpolicy` attributes
(#242 by Thibault Suzanne)
* Allow `crossorigin` attribute for script element
(#243 by Thibault Suzanne)
* Greatly improved support of whitespaces in the PPX
(#225 by Jules Aguillon)
* Add preliminary support for ARIA attributes
(#253 by Stéphane Legrand and Gabriel Radanne)
* Add `template` element
(#239 Stéphane Legrand)
* Several bug fixes for types and PPX
# 4.3.0
* Dunify
This also removes all the deprecated libraries (`tyxml.syntax`, `tyxml.parser`)
and removes the ocamlfind library `tyxml.ppx` in favor of `tyxml-ppx`.
(#197 by Drup, Rudi Grinberg and Anton Bachin)
* Add simplistic indentation for the Format-based printer (#187 by Drup)
* Allow the ppx to be used for more exotic tyxml instances, such
as reactive elements (#200 by Drup)
* Add `Html.of_seq` and `Svg.of_seq`, which allow to easily import
HTML parsed with markup in TyXML (#221 by Drup)
## Elements and attributes
* Add Html.txt and Svg.txt as an alias for `pcdata` (#222 by Drup)
* Add noopener link types (#198 by Jérôme Vouillon)
* Slightly relax dt content type (#193 by Anton Bachin)
* Add touch events (#211 by Malthe Borch)
* Fix handling of figcaption in the PPX (#219 by Drup)
# 4.2.0
* Compatibility with OCaml 4.6.0.
* The ppx should now be compatible with driver-based workflows. In particular, jbuilder.
* Future breakage:
* The two camlp4-based packages (tyxml.syntax and tyxml.parser) are now deprecated and will be removed in the next major version.
* Introduction of the tyxml-ppx ocamlfind package. Usage of the tyxml.ppx package is discouraged, and it will be removed in the next major version.
* Various fixes in the Html_sigs.T module (contribution by Fabian Pijcke):
* Fixed the map element function signature.
* The elements functions now (almost) all make use of the types defined in Html_types, rather than redefining them.
* Html_sigs.T.fieldset now takes [< legend] elt wrap as optional argument rather than legend elt wrap.
* Add basic support for `aria-*` attributes (contribution by Armaël Guéneau)
(see https://www.w3.org/TR/wai-aria-1.1/#states_and_properties)
* Add support for the `role` attribute (contribution by Armaël Guéneau)
(see https://www.w3.org/TR/role-attribute/)
* Add support for the `minlength` form attribute (contribution by Armaël Guéneau)
(See https://www.w3.org/TR/html5/forms.html#attr-input-minlength)
# 4.1.0
* Uses uutf 1.0 (contribution by Daniel Bunzli)
# 4.0.1
* Fix handling of comments in the ppx.
* Fix printing of utf8 in attributes.
* Properly flush ppx errors. This bug was causing some blank error messages.
* Fix handling of whitespaces in `
more content
"]
val my_paragraphs : [> Html_types.p ] Html.elt list
>>
Note here that since ##p## expects a list of children (it's a <> element), the antiquotation must be of type list, hence the use of ##[##, ##]##.
It is also possible to use antiquotations for attributes.
<"]
val my_div : [> Html_types.div ] Html.elt
>>
==@@id="let"@@ Let notation
It is also possible to use the ppx with the ##let## notation:
<some content|} ;;
val content : [> Html_types.div ] Html.elt
>>
All the capabilities provided by the ppx are still available with this form. Additionally, the modifiers ##and## or ##rec## are available. It is also possible to create functions:
<some content" ;;
val make_content : string -> [> Html_types.div ] Html.elt
>>
==@@id="notes"@@ Notes
=== Locations ===
Due to the code transformations done by the ppx, proper locations are difficult to provide.
Please report examples of badly located code on [[https://github.com/ocsigen/tyxml/issues|the bug tracker]].
=== Composability ===
Due to various reasons, some ##HTML## can not be composed properly using the ppx. For example, this will result in an error:
<The title"]
let my_head = [%html ""my_title""]
>>
You can, however, inline the title element inside the head element:
<"my_title""]
>>
tyxml-4.5.0/dune-project 0000664 0000000 0000000 00000004302 14040247726 0015224 0 ustar 00root root 0000000 0000000 (lang dune 2.0)
(name tyxml)
(license "LGPL-2.1 with OCaml linking exception")
(authors "The ocsigen team")
(maintainers "dev@ocsigen.org")
(source (github ocsigen/tyxml))
(bug_reports "https://github.com/ocsigen/tyxml/issues")
(homepage "https://github.com/ocsigen/tyxml")
(documentation "https://ocsigen.org/tyxml/latest/manual/intro")
(generate_opam_files true)
(package
(name tyxml-jsx)
(synopsis "JSX syntax to write TyXML documents")
(description
"\| ```reason
"\| open Tyxml;
"\| let to_reason = \"Reason!\"
"\| ```
"\|
"\| The TyXML JSX allow to write TyXML documents with reason's JSX syntax.
"\| It works with textual trees, virtual DOM trees, or any TyXML module.
)
(depends
(ocaml
(>= 4.04))
(tyxml :version)
(tyxml-syntax :version)
(alcotest :with-test)
(reason :with-test)
ppxlib))
(package
(name tyxml-ppx)
(synopsis "PPX to write TyXML documents with the HTML syntax")
(description
"\| ```ocaml
"\| open Tyxml
"\| let%html to_ocaml = \"OCaml!\"
"\| ```
"\|
"\| The TyXML PPX allow to write TyXML documents using the traditional HTML syntax.
"\| It works with textual trees, virtual DOM trees, or any TyXML module.
)
(depends
(ocaml
(>= 4.04))
(tyxml :version)
(tyxml-syntax :version)
(alcotest :with-test)
(markup
(>= 0.7.2))
ppxlib))
(package
(name tyxml-syntax)
(synopsis "Common layer for the JSX and PPX syntaxes for Tyxml")
(depends
(ocaml
(>= 4.02))
(alcotest :with-test)
ppxlib
(re
(>= 1.5.0))
(uutf
(>= 1.0.0))))
(package
(name tyxml)
(synopsis "A library for building correct HTML and SVG documents")
(description
"TyXML provides a set of convenient combinators that uses the OCaml type system to ensure the validity of the generated documents. TyXML can be used with any representation of HTML and SVG: the textual one, provided directly by this package, or DOM trees (`js_of_ocaml-tyxml`) virtual DOM (`virtual-dom`) and reactive or replicated trees (`eliom`). You can also create your own representation and use it to instantiate a new set of combinators.")
(depends
(ocaml
(>= 4.02))
(alcotest :with-test)
(re
(>= 1.5.0))
seq
(uutf
(>= 1.0.0))))
tyxml-4.5.0/examples/ 0000775 0000000 0000000 00000000000 14040247726 0014521 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/examples/.gitignore 0000664 0000000 0000000 00000000006 14040247726 0016505 0 ustar 00root root 0000000 0000000 *.html tyxml-4.5.0/examples/UNLICENSE.md 0000664 0000000 0000000 00000002271 14040247726 0016372 0 ustar 00root root 0000000 0000000 This is free and unencumbered software released into the public domain.
Anyone is free to copy, modify, publish, use, compile, sell, or
distribute this software, either in source code form or as a compiled
binary, for any purpose, commercial or non-commercial, and by any
means.
In jurisdictions that recognize copyright laws, the author or authors
of this software dedicate any and all copyright interest in the
software to the public domain. We make this dedication for the benefit
of the public at large and to the detriment of our heirs and
successors. We intend this dedication to be an overt act of
relinquishment in perpetuity of all present and future rights to this
software under copyright law.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.
For more information, please refer to http://unlicense.org/
tyxml-4.5.0/examples/basic_website/ 0000775 0000000 0000000 00000000000 14040247726 0017324 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/examples/basic_website/Makefile 0000664 0000000 0000000 00000000266 14040247726 0020770 0 ustar 00root root 0000000 0000000 site_gen := make_site
all:
ocamlfind ocamlc site_html.ml -package tyxml -short-paths -linkpkg -o ${site_gen}
./${site_gen}
clean:
rm -f *.cmo *.cmt *.cmi ${site_gen} index.html
tyxml-4.5.0/examples/basic_website/Readme.md 0000664 0000000 0000000 00000001010 14040247726 0021033 0 ustar 00root root 0000000 0000000 This is a very simple website in pure tyxml. 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/
tyxml-4.5.0/examples/basic_website/dune 0000664 0000000 0000000 00000000223 14040247726 0020177 0 ustar 00root root 0000000 0000000 (executable
(name site_html)
(libraries tyxml)
)
(rule
(targets index.html)
(deps site_html.exe)
(action (run %{exe:site_html.exe})
))
tyxml-4.5.0/examples/basic_website/home.css 0000664 0000000 0000000 00000000314 14040247726 0020764 0 ustar 00root root 0000000 0000000 #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;
}
tyxml-4.5.0/examples/basic_website/main.js 0000664 0000000 0000000 00000000127 14040247726 0020606 0 ustar 00root root 0000000 0000000 "use strict";
var handle = document.getElementById("payload");
console.log(handle);
tyxml-4.5.0/examples/basic_website/site_html.ml 0000664 0000000 0000000 00000003051 14040247726 0021645 0 ustar 00root root 0000000 0000000 open Tyxml.Html
let this_title = title (txt "Your Cool Web Page")
let image_box =
div ~a:[a_id "image_box"]
[]
let links_box =
ul ~a:[a_class ["links_bar"]; a_id "links_bar"]
[li ~a:[a_id "home_click"]
[txt "My Musings"];
li ~a:[a_id "about_click"]
[txt "About Me"];
li ~a:[a_id "blog_posts_click"]
[txt "Blog"];
li ~a:[a_id "hackathons_click"]
[txt "Hackathons"]]
let common_footer =
footer ~a:[a_id "footer_box"]
[p [txt "This site was made with ";
a ~a:[a_href "http://ocaml.org"] [txt "OCaml"];
txt " and ";
a ~a:[a_href "https://www.gnu.org/software/emacs/"] [txt "emacs"]]]
let home_content =
div
[h2
[txt "Hello Coder"]]
let main_payload =
div ~a:[a_id "payload"]
[home_content]
let common_nav =
nav [links_box]
let content_box =
div ~a:[a_id "content_box"]
[common_nav;
main_payload;
common_footer]
let main_script =
script ~a:[a_src (Xml.uri_of_string "main.js")] (txt "")
let home_page_doc =
html (head this_title
[link ~rel:[`Stylesheet] ~href:"home.css" ();])
(body [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
Format.fprintf fmt "%a@." (pp ~indent:true ()) page;
close_out file_handle
let () = List.iter emit_page pages
tyxml-4.5.0/examples/basic_website_jsx/ 0000775 0000000 0000000 00000000000 14040247726 0020210 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/examples/basic_website_jsx/Readme.md 0000664 0000000 0000000 00000000745 14040247726 0021735 0 ustar 00root root 0000000 0000000 This is a very simple website in pure tyxml using the jsx syntax extension.
To generate the website, compile `site_html.re` and then execute. This can be done with `make`.
Content of this directory:
- `site_html.re`: Generates the Html.
- `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/
tyxml-4.5.0/examples/basic_website_jsx/dune 0000664 0000000 0000000 00000000261 14040247726 0021065 0 ustar 00root root 0000000 0000000 (executable
(name site_html)
(libraries tyxml)
(preprocess (pps tyxml-jsx)
))
(rule
(targets index.html)
(deps site_html.exe)
(action (run %{exe:site_html.exe})
))
tyxml-4.5.0/examples/basic_website_jsx/home.css 0000664 0000000 0000000 00000000314 14040247726 0021650 0 ustar 00root root 0000000 0000000 #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;
}
tyxml-4.5.0/examples/basic_website_jsx/home_page.re 0000664 0000000 0000000 00000000377 14040247726 0022473 0 ustar 00root root 0000000 0000000 open Tyxml;
let createElement = (~title: string, ~children: list('a), ()): Html.doc => {
{Html.txt(title)}
...children
};
tyxml-4.5.0/examples/basic_website_jsx/main.js 0000664 0000000 0000000 00000000127 14040247726 0021472 0 ustar 00root root 0000000 0000000 "use strict";
var handle = document.getElementById("payload");
console.log(handle);
tyxml-4.5.0/examples/basic_website_jsx/site_html.re 0000664 0000000 0000000 00000002605 14040247726 0022533 0 ustar 00root root 0000000 0000000 open Tyxml;
let this_title = "Your Cool Web Page";
let image_box = ;
let links_box =
"My Musings"
"About Me"
"Blog"
"Hackathons"
;
let common_footer =
;
let home_content =
"Hello Coder"
;
let main_payload =
home_content
;
let common_nav = Html.nav([links_box]);
let content_box =
common_nav main_payload common_footer
;
let main_script = ;
let home_page_doc =
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);
let fmt = Format.formatter_of_out_channel(file_handle);
Format.fprintf(fmt, "%a@.", Html.pp(~indent=true, ()), page);
close_out(file_handle);
};
let () = List.iter(emit_page, pages);
tyxml-4.5.0/examples/basic_website_ppx/ 0000775 0000000 0000000 00000000000 14040247726 0020213 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/examples/basic_website_ppx/Makefile 0000664 0000000 0000000 00000000272 14040247726 0021654 0 ustar 00root root 0000000 0000000 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
tyxml-4.5.0/examples/basic_website_ppx/Readme.md 0000664 0000000 0000000 00000001047 14040247726 0021734 0 ustar 00root root 0000000 0000000 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/
tyxml-4.5.0/examples/basic_website_ppx/dune 0000664 0000000 0000000 00000000262 14040247726 0021071 0 ustar 00root root 0000000 0000000 (executable
(name site_html)
(libraries tyxml)
(preprocess (pps tyxml-ppx)
))
(rule
(targets index.html)
(deps site_html.exe)
(action (run %{exe:site_html.exe})
))
tyxml-4.5.0/examples/basic_website_ppx/home.css 0000664 0000000 0000000 00000000314 14040247726 0021653 0 ustar 00root root 0000000 0000000 #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;
}
tyxml-4.5.0/examples/basic_website_ppx/main.js 0000664 0000000 0000000 00000000127 14040247726 0021475 0 ustar 00root root 0000000 0000000 "use strict";
var handle = document.getElementById("payload");
console.log(handle);
tyxml-4.5.0/examples/basic_website_ppx/site_html.ml 0000664 0000000 0000000 00000003026 14040247726 0022536 0 ustar 00root root 0000000 0000000 open Tyxml
let this_title = Html.txt "Your Cool Web Page"
let image_box = [%html
""
]
let links_box = [%html {|
My Musings
About Me
Blog
Hackathons
|}]
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
Format.fprintf fmt "%a@." (Html.pp ~indent:true ()) page;
close_out file_handle
let () = List.iter emit_page pages
tyxml-4.5.0/examples/dune 0000664 0000000 0000000 00000000533 14040247726 0015400 0 ustar 00root root 0000000 0000000 (alias
(name runtest)
(deps
mini_website/index.html
basic_website/index.html
)
(package tyxml)
)
(alias
(name runtest)
(deps
mini_website_ppx/index.html
basic_website_ppx/index.html
)
(package tyxml-ppx)
)
(alias
(name runtest)
(deps
mini_website_jsx/index.html
basic_website_jsx/index.html
)
(package tyxml-jsx)
)
tyxml-4.5.0/examples/mini_website/ 0000775 0000000 0000000 00000000000 14040247726 0017177 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/examples/mini_website/Makefile 0000664 0000000 0000000 00000000264 14040247726 0020641 0 ustar 00root root 0000000 0000000 site_gen := minihtml
all:
ocamlfind ocamlc minihtml.ml -short-paths -package tyxml -linkpkg -o ${site_gen}
./${site_gen}
clean:
rm -f *.cmo *.cmt *.cmi ${site_gen} index.html
tyxml-4.5.0/examples/mini_website/Readme.md 0000664 0000000 0000000 00000000666 14040247726 0020726 0 ustar 00root root 0000000 0000000 This is the minimal website in pure tyxml. To generate the website, compile `minihtml.ml` and then execute. This can be done with `make`.
Content of this directory:
- `minihtml.ml`: Generates the Html.
- `Makefile`: Simple rules to create 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/
tyxml-4.5.0/examples/mini_website/dune 0000664 0000000 0000000 00000000216 14040247726 0020054 0 ustar 00root root 0000000 0000000 (executable
(name minihtml)
(libraries tyxml)
)
(rule
(targets index.html)
(deps minihtml.exe)
(action (run %{exe:minihtml.exe}))
)
tyxml-4.5.0/examples/mini_website/minihtml.ml 0000664 0000000 0000000 00000000661 14040247726 0021355 0 ustar 00root root 0000000 0000000 open Tyxml.Html
let mycontent =
div ~a:[a_class ["content"]] [
h1 [txt "A fabulous title"] ;
txt "This is a fabulous content." ;
]
let mytitle = title (txt "A Fabulous Web Page")
let mypage =
html
(head mytitle [])
(body [mycontent])
let () =
let file = open_out "index.html" in
let fmt = Format.formatter_of_out_channel file in
Format.fprintf fmt "%a@." (pp ~indent:true ()) mypage;
close_out file
tyxml-4.5.0/examples/mini_website_jsx/ 0000775 0000000 0000000 00000000000 14040247726 0020063 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/examples/mini_website_jsx/Readme.md 0000664 0000000 0000000 00000000643 14040247726 0021605 0 ustar 00root root 0000000 0000000 This is the minimal website in pure tyxml using the jsx syntax extension.
To generate the website, compile `minihtml.re` and then execute. This can be done with `make`.
Content of this directory:
- `minihtml.re`: Generates the Html.
- `.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/
tyxml-4.5.0/examples/mini_website_jsx/dune 0000664 0000000 0000000 00000000256 14040247726 0020744 0 ustar 00root root 0000000 0000000 (executable
(name minihtml)
(libraries tyxml)
(preprocess (pps tyxml-jsx))
)
(rule
(targets index.html)
(deps minihtml.exe)
(action (run %{exe:minihtml.exe}))
)
tyxml-4.5.0/examples/mini_website_jsx/minihtml.re 0000664 0000000 0000000 00000000736 14040247726 0022242 0 ustar 00root root 0000000 0000000 open Tyxml;
let mycontent =
"A fabulous title"
"This is a fabulous content."
;
let mytitle = Html.txt("A Fabulous Web Page");
let mypage =
mytitle
mycontent
;
let () = {
let file = open_out("index.html");
let fmt = Format.formatter_of_out_channel(file);
Format.fprintf(fmt, "%a@.", Html.pp(~indent=true, ()), mypage);
close_out(file);
};
tyxml-4.5.0/examples/mini_website_ppx/ 0000775 0000000 0000000 00000000000 14040247726 0020066 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/examples/mini_website_ppx/Makefile 0000664 0000000 0000000 00000000270 14040247726 0021525 0 ustar 00root root 0000000 0000000 site_gen := minihtml
all:
ocamlfind ocamlc minihtml.ml -short-paths -package tyxml.ppx -linkpkg -o ${site_gen}
./${site_gen}
clean:
rm -f *.cmo *.cmt *.cmi ${site_gen} index.html
tyxml-4.5.0/examples/mini_website_ppx/Readme.md 0000664 0000000 0000000 00000000725 14040247726 0021611 0 ustar 00root root 0000000 0000000 This is the minimal website in pure tyxml using the ppx syntax extension.
To generate the website, compile `minihtml.ml` and then execute. This can be done with `make`.
Content of this directory:
- `minihtml.ml`: Generates the Html.
- `Makefile`: Simple rules to create 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/
tyxml-4.5.0/examples/mini_website_ppx/dune 0000664 0000000 0000000 00000000256 14040247726 0020747 0 ustar 00root root 0000000 0000000 (executable
(name minihtml)
(libraries tyxml)
(preprocess (pps tyxml-ppx))
)
(rule
(targets index.html)
(deps minihtml.exe)
(action (run %{exe:minihtml.exe}))
)
tyxml-4.5.0/examples/mini_website_ppx/minihtml.ml 0000664 0000000 0000000 00000000763 14040247726 0022247 0 ustar 00root root 0000000 0000000 open Tyxml
let%html mycontent = {|
A fabulous title
This is a fabulous content.
|}
let mytitle = Html.txt "A Fabulous Web Page"
let%html mypage =
{|
|}mytitle{|
|}[mycontent]{|
|}
let () =
let file = open_out "index.html" in
let fmt = Format.formatter_of_out_channel file in
Format.fprintf fmt "%a@." (Html.pp ~indent:true ()) mypage;
close_out file
tyxml-4.5.0/implem/ 0000775 0000000 0000000 00000000000 14040247726 0014166 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/implem/dune 0000664 0000000 0000000 00000000207 14040247726 0015043 0 ustar 00root root 0000000 0000000 (library
(name tyxml)
(public_name tyxml)
(wrapped false)
(libraries tyxml_f re uutf)
(flags (:standard
-safe-string))
)
tyxml-4.5.0/implem/tyxml.ml 0000664 0000000 0000000 00000001404 14040247726 0015674 0 ustar 00root root 0000000 0000000 (** Typed implementation for HTML, SVG and XML
This is the natural implementation of the TyXML combinators
based on an XML data-structure.
{%
Other implementations are available, see <> for details. %}
*)
(** Typesafe constructors and printers for HTML documents.
@see W3C Recommendation *)
module Html = Tyxml_html
(** Typesafe constructors and printers for Svg documents.
@see W3C Recommendation *)
module Svg = Tyxml_svg
(** Basic functions for construction and manipulation of XML tree. *)
module Xml = Tyxml_xml
(** Deprecated alias for {!Html}.
@deprecated "Use Html" *)
module Html5 = Tyxml_html
[@@ocaml.deprecated "Use Tyxml.Html"]
tyxml-4.5.0/implem/tyxml_html.ml 0000664 0000000 0000000 00000002117 14040247726 0016722 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2011 Pierre Chambart, Grégoire Henry
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
module M = Html_f.Make(Tyxml_xml)(Tyxml_svg)
module P = Xml_print.Make_typed_fmt(Tyxml_xml)(M)
module Make_printer = Xml_print.Make_typed(Tyxml_xml)(M)
[@@ocaml.warning "-3"]
include M
include P
let _pp = pp ()
let _pp_elt = pp_elt ()
tyxml-4.5.0/implem/tyxml_html.mli 0000664 0000000 0000000 00000004212 14040247726 0017071 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2011 Pierre Chambart, Grégoire Henry
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** Typesafe constructors and printers for Html documents.
@see W3C Recommendation *)
(** Concrete implementation of Html typesafe constructors.
See {!module-type:Html_sigs.T}.
*)
include Html_sigs.Make(Tyxml_xml)(Tyxml_svg).T
with module Xml.W = Xml_wrap.NoWrap
(** {2 Printers} *)
(** [pp ()] is a {!Format} printer for Html documents.
It can be used in combination with ["%a"]. For example, to get a string:
{[let s = Format.asprintf "%a" (Tyxml.Html.pp ()) my_html]}
*)
val pp:
?encode:(string -> string) -> ?indent:bool -> ?advert:string -> unit ->
Format.formatter -> doc -> unit
(** [pp_elt ()] is a {!Format} printer for Html elements. *)
val pp_elt :
?encode:(string -> string) -> ?indent:bool -> unit ->
Format.formatter -> 'a elt -> unit
(** Parametrized stream printer for Html documents.
@deprecated Use {!pp} instead.
*)
module Make_printer(O : Xml_sigs.Output) :
Xml_sigs.Typed_printer with type out := O.out
and type 'a elt := 'a elt
and type doc := doc
[@@ocaml.deprecated "Use Html.pp instead."]
(**/*)
(** Toplevel printers *)
val _pp : Format.formatter -> doc -> unit
[@@ocaml.toplevel_printer]
val _pp_elt : Format.formatter -> _ elt -> unit
[@@ocaml.toplevel_printer]
tyxml-4.5.0/implem/tyxml_svg.ml 0000664 0000000 0000000 00000002104 14040247726 0016551 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2011 Pierre Chambart, Grégoire Henry
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
module M = Svg_f.Make(Tyxml_xml)
module P = Xml_print.Make_typed_fmt(Tyxml_xml)(M)
module Make_printer = Xml_print.Make_typed(Tyxml_xml)(M)
[@@ocaml.warning "-3"]
include M
include P
let _pp = pp ()
let _pp_elt = pp_elt ()
tyxml-4.5.0/implem/tyxml_svg.mli 0000664 0000000 0000000 00000004162 14040247726 0016730 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2011 Pierre Chambart, Grégoire Henry
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** Typesafe constructors and printers for Svg documents.
@see W3C Recommendation *)
(** Concrete implementation of Svg typesafe constructors.
See {!module-type:Svg_sigs.T}.
*)
include Svg_sigs.Make(Tyxml_xml).T
with module Xml.W = Xml_wrap.NoWrap
(** {2 Printers} *)
(** [pp ()] is a {!Format} printer for Svg documents.
It can be used in combination with ["%a"]. For example, to get a string:
{[let s = Format.asprintf "%a" (Tyxml.Svg.pp ()) my_svg]}
*)
val pp:
?encode:(string -> string) -> ?indent:bool -> ?advert:string -> unit ->
Format.formatter -> doc -> unit
(** [pp_elt ()] is a {!Format} printer for Svg elements. *)
val pp_elt :
?encode:(string -> string) -> ?indent:bool -> unit ->
Format.formatter -> 'a elt -> unit
(** Parametrized stream printer for Svg documents.
@deprecated Use {!pp} instead.
*)
module Make_printer(O : Xml_sigs.Output) :
Xml_sigs.Typed_printer with type out := O.out
and type 'a elt := 'a elt
and type doc := doc
[@@ocaml.deprecated "Use Svg.pp instead."]
(**/*)
(** Toplevel printers *)
val _pp : Format.formatter -> doc -> unit
[@@ocaml.toplevel_printer]
val _pp_elt : Format.formatter -> _ elt -> unit
[@@ocaml.toplevel_printer]
tyxml-4.5.0/implem/tyxml_xml.ml 0000664 0000000 0000000 00000006741 14040247726 0016565 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2004 Thorsten Ohl
* Copyright (C) 2007 Gabriel Kerneis
* Copyright (C) 2010 Cecile Herbelin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
module M = struct
module W = Xml_wrap.NoWrap
type 'a wrap = 'a
type 'a list_wrap = 'a list
type uri = string
let uri_of_string s = s
let string_of_uri s = s
type separator = Space | Comma
(** Attributes *)
type aname = string
type acontent =
| AFloat of float
| AInt of int
| AStr of string
| AStrL of separator * string list
type attrib = aname * acontent
type event_handler = string
type mouse_event_handler = string
type keyboard_event_handler = string
type touch_event_handler = string
let acontent (_, a) = a
let aname (name, _) = name
let float_attrib name value = name, AFloat value
let int_attrib name value = name, AInt value
let string_attrib name value = name, AStr value
let space_sep_attrib name values = name, AStrL (Space, values)
let comma_sep_attrib name values = name, AStrL (Comma, values)
let event_handler_attrib name value = name, AStr value
let mouse_event_handler_attrib name value = name, AStr value
let keyboard_event_handler_attrib name value = name, AStr value
let touch_event_handler_attrib name value = name, AStr value
let uri_attrib name value = name, AStr value
let uris_attrib name values = name, AStrL (Space, values)
(** Element *)
type ename = string
type econtent =
| Empty
| Comment of string
| EncodedPCDATA of string
| PCDATA of string
| Entity of string
| Leaf of ename * attrib list
| Node of ename * attrib list * econtent list
type elt = econtent
let content elt = elt
let empty () = Empty
let comment c = Comment c
let pcdata d = PCDATA d
let encodedpcdata d = EncodedPCDATA d
let entity e = Entity e
(* For security reasons, we do not allow "]]>" inside CDATA
(as this string is to be considered as the end of the cdata)
*)
let re_end_cdata = Re.(compile @@ str "]]>")
let encoded_cdata s1 s2 s =
encodedpcdata
(Printf.sprintf "\n%s\n%s\n%s\n"
s1
(Re.replace_string ~all:true re_end_cdata ~by:"" s)
s2 )
let cdata = encoded_cdata ""
let cdata_script = encoded_cdata "//"
let cdata_style = encoded_cdata "/* */"
let leaf ?(a=[]) name = Leaf (name, a)
let node ?(a=[]) name children = Node (name, a, children)
end
include M
include Xml_print.Make_simple(M)(struct let emptytags = [] end)
[@@ocaml.warning "-3"]
include Xml_iter.Make(M)
include Xml_print.Make_fmt(M)(struct let emptytags = [] end)
include Xml_stream.Import(M)
let print fmt x = print_list ~output:(Format.pp_print_string fmt) [x]
tyxml-4.5.0/implem/tyxml_xml.mli 0000664 0000000 0000000 00000006537 14040247726 0016741 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2004 Thorsten Ohl
* Copyright (C) 2007 Gabriel Kerneis
* Copyright (C) 2010 Cecile Herbelin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** Basic functions for construction and manipulation of XML tree. *)
include Xml_sigs.Iterable
with type uri = string
and type event_handler = string
and type mouse_event_handler = string
and type keyboard_event_handler = string
and type touch_event_handler = string
include Xml_sigs.Pp
with type elt := elt
(** {2 Import/Export} *)
val of_seq : Xml_stream.signal Seq.t -> elt list
(** {2 Iterators} *)
val amap : (ename -> attrib list -> attrib list) -> elt -> elt
(** Recursively edit attributes for the element and all its children. *)
val amap1 : (ename -> attrib list -> attrib list) -> elt -> elt
(** Edit attributes only for one element. *)
(** The following can safely be exported by higher level libraries,
because removing an attribute from a element is always legal. *)
val rm_attrib : (aname -> bool) -> attrib list -> attrib list
val rm_attrib_from_list : (aname -> bool) -> (string -> bool) -> attrib list -> attrib list
val map_int_attrib :
(aname -> bool) -> (int -> int) -> attrib list -> attrib list
val map_string_attrib :
(aname -> bool) -> (string -> string) -> attrib list -> attrib list
val map_string_attrib_in_list :
(aname -> bool) -> (string -> string) -> attrib list -> attrib list
(** Exporting the following by higher level libraries would drive
a hole through a type system, because they allow to add {e any}
attribute to {e any} element. *)
val add_int_attrib : aname -> int -> attrib list -> attrib list
val add_string_attrib : aname -> string -> attrib list -> attrib list
val add_comma_sep_attrib : aname -> string -> attrib list -> attrib list
val add_space_sep_attrib : aname -> string -> attrib list -> attrib list
val fold : (unit -> 'a) -> (string -> 'a) -> (string -> 'a) -> (string -> 'a) ->
(string -> 'a) -> (ename -> attrib list -> 'a) ->
(ename -> attrib list -> 'a list -> 'a) ->
elt -> 'a
val all_entities : elt -> string list
val translate :
(ename -> attrib list -> elt) ->
(ename -> attrib list -> elt list -> elt) ->
('state -> ename -> attrib list -> elt list) ->
('state -> ename -> attrib list -> elt list -> elt list) ->
(ename -> attrib list -> 'state -> 'state) -> 'state -> elt -> elt
(** {2 Deprecated printers} *)
val print_list:
output:(string -> unit) -> ?encode:(string -> string) -> elt list -> unit
[@@ocaml.deprecated "Use Xml.pp instead."]
val print : Format.formatter -> elt -> unit
[@@ocaml.deprecated "Use Xml.pp instead."]
tyxml-4.5.0/jsx/ 0000775 0000000 0000000 00000000000 14040247726 0013507 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/jsx/dune 0000664 0000000 0000000 00000000362 14040247726 0014366 0 ustar 00root root 0000000 0000000 (library
(name tyxml_jsx)
(public_name tyxml-jsx)
(libraries tyxml-syntax
ppxlib
)
(kind ppx_rewriter)
(preprocess (pps ppxlib.metaquot))
(flags (:standard
-safe-string
-open Ppxlib
-w "-9"
))
)
tyxml-4.5.0/jsx/tyxml_jsx.ml 0000664 0000000 0000000 00000016730 14040247726 0016111 0 ustar 00root root 0000000 0000000 open Ppxlib.Parsetree
open Ppxlib.Asttypes
open Tyxml_syntax
let is_jsx e =
let f = function
| { attr_name = {txt = "JSX"}} -> true
| _ -> false
in
List.exists f e.pexp_attributes
(* When dropping support for 4.02, this module can simply be deleted. *)
module String = struct
include String
let lowercase_ascii = String.lowercase [@ocaml.warning "-3"]
end
module Char = struct
include Char
let lowercase_ascii = Char.lowercase [@ocaml.warning "-3"]
end
let lowercase_lead s =
String.mapi (fun i c -> if i = 0 then Char.lowercase_ascii c else c) s
let to_kebab_case name =
let length = String.length name in
if length > 5 then
let first = String.sub name 0 4 in
match first with
| "aria"
| "data" ->
first ^ "-" ^ lowercase_lead (String.sub name 4 (length - 4))
| _ -> name
else
name
let make_attr_name name =
let name =
match name with
| "className" -> "class"
| "htmlFor" -> "for"
| "class_" -> "class"
| "for_" -> "for"
| "type_" -> "type"
| "to_" -> "to"
| "open_" -> "open"
| "begin_" -> "begin"
| "end_" -> "end"
| "in_" -> "in"
| "method_" -> "method"
| name -> to_kebab_case name
in
name
open Common
let rec filter_map f = function
| [] -> []
| a :: q ->
match f a with
| None -> filter_map f q
| Some a -> a :: filter_map f q
(** Children *)
let make_txt ~loc ~lang s =
let txt = Common.make ~loc lang "txt" in
let arg = Common.wrap lang loc @@ Common.string loc s in
Ppxlib.Ast_helper.Exp.apply ~loc txt [Nolabel, arg]
let element_mapper transform_expr e =
match e with
(* Convert string constant into Html.txt "constant" for convenience *)
| { pexp_desc = Pexp_constant (Pconst_string (str, loc, _)); _ } ->
make_txt ~loc ~lang:Html str
| _ ->
transform_expr e
let extract_element_list transform_expr elements =
let rec map acc e =
match e with
| [%expr []] -> List.rev acc
| [%expr [%e? child] :: [%e? rest]] ->
let child = Common.value (element_mapper transform_expr child) in
map (child :: acc) rest
| e ->
List.rev (Common.antiquot (element_mapper transform_expr e) :: acc)
in
map [] elements
let extract_children transform_expr args =
match
List.find
(function Labelled "children", _ -> true | _ -> false)
args
with
| _, children -> extract_element_list transform_expr children
| exception Not_found -> []
(** Attributes *)
type attr = {
a_name: Common.name;
a_value : string value;
a_loc: Location.t;
}
let rec extract_attr_value ~lang a_name a_value =
let a_name = make_attr_name a_name in
match a_value with
| { pexp_desc = Pexp_constant (Pconst_string (attr_value, _, _)); _ } ->
((lang, a_name), Common.value attr_value)
| e ->
((lang, a_name), Common.antiquot e)
and extract_attr ~lang = function
(* Ignore last unit argument as tyxml api is pure *)
| Nolabel, [%expr ()] -> None
| Labelled "children", _ -> None
| Labelled name, value ->
Some (extract_attr_value ~lang name value)
| Nolabel, e ->
error e.pexp_loc "Unexpected unlabeled jsx attribute"
| Optional name, e ->
error e.pexp_loc "Unexpected optional jsx attribute %s" name
let classify_name ~loc hint_lang lid =
let annotated_lang, name = match lid with
| Longident.Ldot (Ldot (Lident s, name), "createElement")
when String.lowercase_ascii s = "html"
-> Some Html, lowercase_lead name
| Longident.Ldot (Lident s, name)
when String.lowercase_ascii s = "html"
-> Some Html, lowercase_lead name
| Ldot (Ldot (Lident s, name), "createElement")
when String.lowercase_ascii s = "svg"
-> Some Svg, lowercase_lead name
| Longident.Ldot (Lident s, name)
when String.lowercase_ascii s = "svg"
-> Some Svg, lowercase_lead name
| Lident name ->
hint_lang, name
| _ ->
Common.error loc "Invalid Tyxml tag %s"
(String.concat "." (Longident.flatten_exn lid))
in
let parent_lang, elt =
match Element.find_assembler (Html, name),
Element.find_assembler (Svg, name),
annotated_lang
with
| _, Some ("svg", _), Some l -> l, (Svg, name)
| _, Some ("svg", _), None -> Svg, (Svg, name)
| Some _, None, _ -> Html, (Html, name)
| None, Some _, _ -> Svg, (Svg, name)
| Some _, Some _, Some lang -> lang, (lang, name)
| Some _, Some _, None ->
(* In case of doubt, use Html *)
Html, (Html, name)
| None, None, _ ->
Common.error loc "Unknown namespace for the element %s" name
in
parent_lang, elt
let is_homemade_component lid = match lid with
| Longident.Ldot (( Lident s | Ldot (_, s)), "createElement") ->
String.lowercase_ascii s <> "svg"
&& String.lowercase_ascii s <> "Html"
&& let c = s.[0] in 'A' <= c && c <= 'Z'
| _ -> false
let mk_component ~lang ~loc f attrs children =
let children = match children with
| [] -> []
| l -> [Labelled "children", Common.list_wrap_value lang loc l]
in
let mk_attr ((_ns, name), v) =
Labelled name, match v with
| Common.Val s -> Common.string loc s
| Common.Antiquot e -> e
in
let attrs = List.map mk_attr attrs in
let args = attrs @ children @ [Nolabel,[%expr ()]] in
Ppxlib.Ast_helper.Exp.apply ~loc f args
let traverse = object(self)
inherit [Common.lang option] Ppxlib.Ast_traverse.map_with_context as super
val mutable enabled = true
method! structure_item hint_lang stri = match stri.pstr_desc with
| Pstr_attribute
{ attr_name = { txt = ("tyxml.jsx" | "tyxml.jsx.enable") as s } ;
attr_payload ; attr_loc ;
}
->
begin match attr_payload with
| PStr [%str true] -> enabled <- true
| PStr [%str false] -> enabled <- false
| _ ->
Common.error
attr_loc
"Unexpected payload for %s. A boolean is expected." s
end ;
stri
| _ -> super#structure_item hint_lang stri
method! expression hint_lang e =
if not (is_jsx e) || not enabled then super#expression hint_lang e
else
let loc = e.pexp_loc in
match e with
(* matches <> ... >; *)
| [%expr []]
| [%expr [%e? _] :: [%e? _]] ->
let l = extract_element_list (self#expression hint_lang) e in
Common.list_wrap_value Common.Html loc l
(* matches child1 child2 ; *)
| {pexp_desc = Pexp_apply
({ pexp_desc = Pexp_ident { txt }; _ } as f_expr, args )}
when is_homemade_component txt
->
let lang = match hint_lang with
| Some l -> l | None -> Common.Html
in
let attributes = filter_map (extract_attr ~lang) args in
let children = extract_children (self#expression hint_lang) args in
let e =
mk_component ~loc ~lang f_expr attributes children
in
e
(* matches
child1 child2
; *)
| {pexp_desc = Pexp_apply
({ pexp_desc = Pexp_ident { txt }; _ }, args )}
->
let parent_lang, name = classify_name ~loc hint_lang txt in
let lang = fst name in
let attributes = filter_map (extract_attr ~lang) args in
let children =
extract_children (self#expression @@ Some lang) args
in
let e = Element.parse ~loc
~parent_lang
~name
~attributes
children
in
e
| _ -> super#expression hint_lang e
end
let () =
Ppxlib.Driver.register_transformation
~impl:(traverse#structure None)
"tyxml-jsx"
tyxml-4.5.0/lib/ 0000775 0000000 0000000 00000000000 14040247726 0013451 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/lib/dune 0000664 0000000 0000000 00000000454 14040247726 0014332 0 ustar 00root root 0000000 0000000 (library
(name tyxml_f)
(public_name tyxml.functor)
(wrapped false)
(modules_without_implementation
Xml_sigs Html_sigs Svg_sigs Html_types Svg_types)
(synopsis "Statically correct HTML and SVG documents (Functor version)")
(libraries uutf re seq)
(flags (:standard
-safe-string))
)
tyxml-4.5.0/lib/html_f.ml 0000664 0000000 0000000 00000066307 14040247726 0015270 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2004 by Thorsten Ohl
* Copyright (C) 2007 by Vincent Balat, Gabriel Kerneis
* Copyright (C) 2010 by Cecile Herbelin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
module Make_with_wrapped_functions
(Xml : Xml_sigs.T)
(C : Html_sigs.Wrapped_functions with module Xml = Xml)
(Svg : Svg_sigs.T with module Xml := Xml) =
struct
module Xml = Xml
module W = Xml.W
module Info = struct
let content_type = "text/html"
let alternative_content_types = ["application/xhtml+xml";"application/xml";"text/xml"]
let version = "HTML5-draft"
let standard = "http://www.w3.org/TR/html5/"
let namespace = "http://www.w3.org/1999/xhtml"
let doctype =
Xml_print.compose_doctype "html" []
let emptytags =
[ "area"; "base"; "br"; "col"; "command"; "embed"; "hr"; "img";
"input"; "keygen"; "link"; "meta"; "param"; "source"; "wbr" ]
end
type 'a wrap = 'a W.t
type 'a list_wrap = 'a W.tlist
type uri = Xml.uri
let string_of_uri = Xml.string_of_uri
let uri_of_string = Xml.uri_of_string
type image_candidate =
[ `Url of uri
| `Url_width of uri * Html_types.number
| `Url_pixel of uri * Html_types.float_number ]
type 'a attrib = Xml.attrib
let to_xmlattribs x = x
let to_attrib x = x
(* VB *)
let float_attrib = Xml.float_attrib
let int_attrib = Xml.int_attrib
let string_attrib = Xml.string_attrib
let uri_attrib a s = Xml.uri_attrib a s
let space_sep_attrib = Xml.space_sep_attrib
let comma_sep_attrib = Xml.comma_sep_attrib
let user_attrib f name v = Xml.string_attrib name (W.fmap f v)
let bool_attrib = user_attrib C.string_of_bool
let constant_attrib a () =
string_attrib a (W.return a)
let linktypes_attrib name x =
user_attrib C.string_of_linktypes name x
let mediadesc_attrib name x =
user_attrib C.string_of_mediadesc name x
let srcset_attrib name x =
user_attrib C.string_of_srcset name x
(* Core: *)
let a_class = space_sep_attrib "class"
let a_id = string_attrib "id"
let a_user_data name = string_attrib ("data-" ^ name)
let a_title = string_attrib "title"
(* I18N: *)
let a_xml_lang = string_attrib "xml:lang"
let a_lang = string_attrib "lang"
(* Style: *)
let a_style = string_attrib "style"
let a_property = string_attrib "property"
(* Events: *)
let a_onabort = Xml.event_handler_attrib "onabort"
let a_onafterprint = Xml.event_handler_attrib "onafterprint"
let a_onbeforeprint = Xml.event_handler_attrib "onbeforeprint"
let a_onbeforeunload = Xml.event_handler_attrib "onbeforeunload"
let a_onblur = Xml.event_handler_attrib "onblur"
let a_oncanplay = Xml.event_handler_attrib "oncanplay"
let a_oncanplaythrough = Xml.event_handler_attrib "oncanplaythrough"
let a_onchange = Xml.event_handler_attrib "onchange"
let a_ondurationchange = Xml.event_handler_attrib "ondurationchange"
let a_onemptied = Xml.event_handler_attrib "onemptied"
let a_onended = Xml.event_handler_attrib "onended"
let a_onerror = Xml.event_handler_attrib "onerror"
let a_onfocus = Xml.event_handler_attrib "onfocus"
let a_onformchange = Xml.event_handler_attrib "onformchange"
let a_onforminput = Xml.event_handler_attrib "onforminput"
let a_onhashchange = Xml.event_handler_attrib "onhashchange"
let a_oninput = Xml.event_handler_attrib "oninput"
let a_oninvalid = Xml.event_handler_attrib "oninvalid"
let a_onoffline = Xml.event_handler_attrib "onoffline"
let a_ononline = Xml.event_handler_attrib "ononline"
let a_onpause = Xml.event_handler_attrib "onpause"
let a_onplay = Xml.event_handler_attrib "onplay"
let a_onplaying = Xml.event_handler_attrib "onplaying"
let a_onpagehide = Xml.event_handler_attrib "onpagehide"
let a_onpageshow = Xml.event_handler_attrib "onpageshow"
let a_onpopstate = Xml.event_handler_attrib "onpopstate"
let a_onprogress = Xml.event_handler_attrib "onprogress"
let a_onratechange = Xml.event_handler_attrib "onratechange"
let a_onreadystatechange = Xml.event_handler_attrib "onreadystatechange"
let a_onredo = Xml.event_handler_attrib "onredo"
let a_onresize = Xml.event_handler_attrib "onresize"
let a_onscroll = Xml.event_handler_attrib "onscroll"
let a_onseeked = Xml.event_handler_attrib "onseeked"
let a_onseeking = Xml.event_handler_attrib "onseeking"
let a_onselect = Xml.event_handler_attrib "onselect"
let a_onshow = Xml.event_handler_attrib "onshow"
let a_onstalled = Xml.event_handler_attrib "onstalled"
let a_onstorage = Xml.event_handler_attrib "onstorage"
let a_onsubmit = Xml.event_handler_attrib "onsubmit"
let a_onsuspend = Xml.event_handler_attrib "onsuspend"
let a_ontimeupdate = Xml.event_handler_attrib "ontimeupdate"
let a_onundo = Xml.event_handler_attrib "onundo"
let a_onunload = Xml.event_handler_attrib "onunload"
let a_onvolumechange = Xml.event_handler_attrib "onvolumechange"
let a_onwaiting = Xml.event_handler_attrib "onwaiting"
let a_onload = Xml.event_handler_attrib "onload"
let a_onloadeddata = Xml.event_handler_attrib "onloadeddata"
let a_onloadedmetadata = Xml.event_handler_attrib "onloadedmetadata"
let a_onloadstart = Xml.event_handler_attrib "onloadstart"
let a_onmessage = Xml.event_handler_attrib "onmessage"
let a_onmousewheel = Xml.event_handler_attrib "onmousewheel"
(** Javascript mouse events *)
let a_onclick = Xml.mouse_event_handler_attrib "onclick"
let a_oncontextmenu = Xml.mouse_event_handler_attrib "oncontextmenu"
let a_ondblclick = Xml.mouse_event_handler_attrib "ondblclick"
let a_ondrag = Xml.mouse_event_handler_attrib "ondrag"
let a_ondragend = Xml.mouse_event_handler_attrib "ondragend"
let a_ondragenter = Xml.mouse_event_handler_attrib "ondragenter"
let a_ondragleave = Xml.mouse_event_handler_attrib "ondragleave"
let a_ondragover = Xml.mouse_event_handler_attrib "ondragover"
let a_ondragstart = Xml.mouse_event_handler_attrib "ondragstart"
let a_ondrop = Xml.mouse_event_handler_attrib "ondrop"
let a_onmousedown = Xml.mouse_event_handler_attrib "onmousedown"
let a_onmouseup = Xml.mouse_event_handler_attrib "onmouseup"
let a_onmouseover = Xml.mouse_event_handler_attrib "onmouseover"
let a_onmousemove = Xml.mouse_event_handler_attrib "onmousemove"
let a_onmouseout = Xml.mouse_event_handler_attrib "onmouseout"
(** Javascript touch events *)
let a_ontouchstart = Xml.touch_event_handler_attrib "ontouchstart"
let a_ontouchend = Xml.touch_event_handler_attrib "ontouchend"
let a_ontouchmove = Xml.touch_event_handler_attrib "ontouchmove"
let a_ontouchcancel = Xml.touch_event_handler_attrib "ontouchcancel"
(** Javascript keyboard events *)
let a_onkeypress = Xml.keyboard_event_handler_attrib "onkeypress"
let a_onkeydown = Xml.keyboard_event_handler_attrib "onkeydown"
let a_onkeyup = Xml.keyboard_event_handler_attrib "onkeyup"
(* Other Attributes *)
let a_version = string_attrib "version"
let a_xmlns x =
user_attrib C.string_of_big_variant "xmlns" x
let a_manifest = uri_attrib "manifest"
let a_cite = uri_attrib "cite"
let a_xml_space x =
user_attrib C.string_of_big_variant "xml:space" x
let a_accesskey c =
user_attrib C.string_of_character "accesskey" c
let a_charset = string_attrib "charset"
let a_accept_charset = space_sep_attrib "accept-charset"
let a_accept = comma_sep_attrib "accept"
let a_href = uri_attrib "href"
let a_hreflang = string_attrib "hreflang"
let a_download file =
user_attrib (C.unoption_string) "download" file
let a_rel = linktypes_attrib "rel"
let a_tabindex = int_attrib "tabindex"
let a_mime_type = string_attrib "type"
let a_alt = string_attrib "alt"
let a_height p = int_attrib "height" p
let a_src = uri_attrib "src"
let a_width p = int_attrib "width" p
let a_label_for = string_attrib "for"
let a_for = a_label_for
let a_output_for = space_sep_attrib "for"
let a_for_list = a_output_for
let a_selected =
constant_attrib "selected"
let a_text_value = string_attrib "value"
let a_int_value = int_attrib "value"
let a_value = string_attrib "value"
let a_float_value = float_attrib "value"
let a_action = uri_attrib "action"
let a_method x =
user_attrib C.string_of_big_variant "method" x
let a_formmethod = a_method
let a_enctype = string_attrib "enctype"
let a_checked =
constant_attrib "checked"
let a_disabled =
constant_attrib "disabled"
let a_readonly =
constant_attrib "readonly"
let a_maxlength = int_attrib "maxlength"
let a_minlength = int_attrib "minlength"
let a_name = string_attrib "name"
let a_allowfullscreen =
constant_attrib "allowfullscreen"
let a_allowpaymentrequest =
constant_attrib "allowpaymentrequest"
let a_referrerpolicy x =
user_attrib C.string_of_referrerpolicy "referrerpolicy" x
let a_autocomplete x =
user_attrib C.onoff_of_bool "autocomplete" x
let a_async =
constant_attrib "async"
let a_autofocus =
constant_attrib "autofocus"
let a_autoplay =
constant_attrib "autoplay"
let a_muted =
constant_attrib "muted"
let a_crossorigin x =
user_attrib C.string_of_big_variant "crossorigin" x
let a_integrity = string_attrib "integrity"
let a_mediagroup = string_attrib "mediagroup"
let a_challenge = string_attrib "challenge"
let a_contenteditable ce =
bool_attrib "contenteditable" ce
let a_contextmenu = string_attrib "contextmenu"
let a_controls =
constant_attrib "controls"
let a_dir x =
user_attrib C.string_of_big_variant "dir" x
let a_draggable d =
bool_attrib "draggable" d
let a_form = string_attrib "form"
let a_formaction = uri_attrib "formaction"
let a_formenctype = string_attrib "formenctype"
let a_formnovalidate =
constant_attrib "formnovalidate"
let a_formtarget = string_attrib "formtarget"
let a_hidden =
constant_attrib "hidden"
let a_high = float_attrib "high"
let a_icon = uri_attrib "icon"
let a_ismap =
constant_attrib "ismap"
let a_keytype = string_attrib "keytype"
let a_list = string_attrib "list"
let a_loop =
constant_attrib "loop"
let a_low = float_attrib "low"
let a_max = float_attrib "max"
let a_input_max = user_attrib C.string_of_number_or_datetime "max"
let a_min = float_attrib "min"
let a_input_min = user_attrib C.string_of_number_or_datetime "min"
let a_inputmode x =
user_attrib C.string_of_big_variant "inputmode" x
let a_novalidate =
constant_attrib "novalidate"
let a_open =
constant_attrib "open"
let a_optimum = float_attrib "optimum"
let a_pattern = string_attrib "pattern"
let a_placeholder = string_attrib "placeholder"
let a_poster = uri_attrib "poster"
let a_preload x =
user_attrib C.string_of_big_variant "preload" x
let a_pubdate =
constant_attrib "pubdate"
let a_radiogroup = string_attrib "radiogroup"
let a_required =
constant_attrib "required"
let a_reversed =
constant_attrib "reserved"
let a_sandbox x =
user_attrib C.string_of_sandbox "sandbox" x
let a_spellcheck sc =
bool_attrib "spellcheck" sc
let a_scoped =
constant_attrib "scoped"
let a_seamless =
constant_attrib "seamless"
let a_sizes sizes =
user_attrib C.string_of_sizes "sizes" sizes
let a_span = int_attrib "span"
(*let a_srcdoc*)
let a_srclang = string_attrib "xml:lang"
let a_srcset = srcset_attrib "srcset"
let a_img_sizes = comma_sep_attrib "sizes"
let a_start = int_attrib "start"
let a_step step =
user_attrib C.string_of_step "step" step
let a_translate x =
user_attrib C.string_of_big_variant "translate" x
let a_wrap x =
user_attrib C.string_of_big_variant "wrap" x
let a_size = int_attrib "size"
let a_input_type it =
user_attrib C.string_of_input_type "type" it
let a_menu_type x =
user_attrib C.string_of_big_variant "type" x
let a_command_type x =
user_attrib C.string_of_big_variant "type" x
let a_button_type bt =
user_attrib C.string_of_input_type "type" bt
let a_multiple =
constant_attrib "multiple"
let a_cols = int_attrib "cols"
let a_rows = int_attrib "rows"
let a_summary = string_attrib "summary"
let a_align x =
user_attrib C.string_of_big_variant "align" x
let a_axis = string_attrib "axis"
let a_colspan = int_attrib "colspan"
let a_headers = space_sep_attrib "headers"
let a_rowspan = int_attrib "rowspan"
let a_scope x =
user_attrib C.string_of_big_variant "scope" x
let a_border = int_attrib "border"
let a_rules x =
user_attrib C.string_of_big_variant "rules" x
let a_char c =
user_attrib C.string_of_character "char" c
let a_data = uri_attrib "data"
let a_codetype = string_attrib "codetype"
let a_frameborder x =
user_attrib C.string_of_big_variant "frameborder" x
let a_marginheight = int_attrib "marginheight"
let a_marginwidth = int_attrib "marginwidth"
let a_scrolling x =
user_attrib C.string_of_big_variant "scrolling" x
let a_target = string_attrib "target"
let a_content = string_attrib "content"
let a_http_equiv = string_attrib "http-equiv"
let a_media = mediadesc_attrib "media"
(* ARIA *)
let a_role = space_sep_attrib "role"
let a_aria name = space_sep_attrib ("aria-" ^ name)
type 'a elt = Xml.elt
type ('a, 'b) nullary = ?a: (('a attrib) list) -> unit -> 'b elt
type ('a, 'b, 'c) unary = ?a: (('a attrib) list) -> 'b elt wrap -> 'c elt
type ('a, 'b, 'c) star =
?a: (('a attrib) list) -> ('b elt) list_wrap -> 'c elt
let terminal tag ?a () = Xml.leaf ?a tag
let unary tag ?a elt =
Xml.node ?a tag (W.singleton elt)
let star tag ?a elts = Xml.node ?a tag elts
let plus tag ?a elt elts =
Xml.node ?a tag (W.cons elt elts)
let option_cons opt elts =
match opt with
| None -> elts
| Some x -> W.cons x elts
let body = star "body"
let head = plus "head"
let title = unary "title"
let html ?a head body =
let content = W.cons head (W.singleton body) in
Xml.node ?a "html" content
let footer = star "footer"
let header = star "header"
let section = star "section"
let nav = star "nav"
let txt s = Xml.pcdata s
let pcdata = txt
let entity = Xml.entity
let space () = entity "nbsp"
let cdata = Xml.cdata
let cdata_script = Xml.cdata_script
let cdata_style = Xml.cdata_style
let h1 = star "h1"
let h2 = star "h2"
let h3 = star "h3"
let h4 = star "h4"
let h5 = star "h5"
let h6 = star "h6"
let hgroup = star "hgroup"
let address = star "address"
let blockquote = star "blockquote"
let div = star "div"
let p = star "p"
let pre = star "pre"
let abbr = star "abbr"
let br = terminal "br"
let cite = star "cite"
let code = star "code"
let dfn = star "dfn"
let em = star "em"
let kbd = star "kbd"
let q = star "q"
let samp = star "samp"
let span = star "span"
let strong = star "strong"
let time = star "time"
let var = star "var"
let a = star "a"
let dl = star "dl"
let ol = star "ol"
let ul = star "ul"
let dd = star "dd"
let dt = star "dt"
let li = star "li"
let hr = terminal "hr"
let b = star "b"
let i = star "i"
let u = star "u"
let small = star "small"
let sub = star "sub"
let sup = star "sup"
let mark = star "mark"
let rp = star "rp"
let rt = star "rt"
let ruby = star "ruby"
let wbr = terminal "wbr"
(* VB *)
type shape = [ | `Rect | `Circle | `Poly | `Default ]
let bdo ~dir ?(a = []) elts = Xml.node ~a: ((a_dir dir) :: a) "bdo" elts
let a_datetime = string_attrib "datetime"
let a_shape x =
user_attrib C.string_of_big_variant "shape" x
let a_coords coords =
user_attrib C.string_of_numbers "coords" coords
let a_usemap = string_attrib "usemap"
let a_defer =
constant_attrib "defer"
let a_label = string_attrib "label"
let area ~alt ?(a = []) () = Xml.leaf ~a: ((a_alt alt) :: a) "area"
let map = star "map"
let del = star "del"
let ins = star "ins"
let script = unary "script"
let noscript = star "noscript"
let template = star "template"
let article = star "article"
let aside = star "aside"
let main = star "main"
let video_audio name ?src ?srcs ?(a = []) elts =
let a =
match src with
| None -> a
| Some uri -> (a_src uri) :: a
in
match srcs with
| None -> Xml.node name ~a elts
| Some srcs -> Xml.node name ~a (W.append srcs elts)
let audio = video_audio "audio"
let video = video_audio "video"
let canvas = star "canvas"
let command ~label ?(a = []) () =
Xml.leaf ~a: ((a_label label) :: a) "command"
let menu ?children ?a () =
let children = match children with
| None -> W.nil ()
| Some (`Lis l)
| Some (`Flows l) -> l in
Xml.node ?a "menu" children
let embed = terminal "embed"
let source = terminal "source"
let meter = star "meter"
let output_elt = star "output"
let form = star "form"
let svg ?(a = []) children =
Svg.toelt (Svg.svg ~a children)
let input = terminal "input"
let keygen = terminal "keygen"
let label = star "label"
let option = unary "option"
let select = star "select"
let textarea = unary "textarea"
let button = star "button"
let datalist ?children ?a () =
let children = match children with
| None -> W.nil ()
| Some (`Options x | `Phras x) -> x in
Xml.node ?a "datalist" children
let progress = star "progress"
let legend = star "legend"
let details summary ?a children =
plus "details" ?a summary children
let summary = star "summary"
let fieldset ?legend ?a elts =
Xml.node ?a "fieldset" (option_cons legend elts)
let optgroup ~label ?(a = []) elts =
Xml.node ~a: ((a_label label) :: a) "optgroup" elts
let figcaption = star "figcaption"
let figure ?figcaption ?a elts =
let content = match figcaption with
| None -> elts
| Some (`Top c) -> W.cons c elts
| Some (`Bottom c) -> W.append elts (W.singleton c)
in
Xml.node ?a "figure" content
let caption = star "caption"
let tablex ?caption ?columns ?thead ?tfoot ?a elts =
let content = option_cons thead (option_cons tfoot elts) in
let content = match columns with
| None -> content
| Some columns -> W.append columns content in
let content = option_cons caption content in
Xml.node ?a "table" content
let table = tablex
let td = star "td"
let th = star "th"
let tr = star "tr"
let colgroup = star "colgroup"
let col = terminal "col"
let thead = star "thead"
let tbody = star "tbody"
let tfoot = star "tfoot"
let iframe = star "iframe"
let object_ ?params ?(a = []) elts =
let elts = match params with
| None -> elts
| Some e -> W.append e elts in
Xml.node ~a "object" elts
let param = terminal "param"
let img ~src ~alt ?(a = []) () =
let a = (a_src src) :: (a_alt alt) :: a in
Xml.leaf ~a "img"
let picture ~img ?a elts =
let content = W.cons img elts in
Xml.node ?a "picture" content
let meta = terminal "meta"
let style ?(a = []) elts = Xml.node ~a "style" elts
let link ~rel ~href ?(a = []) () =
Xml.leaf ~a: ((a_rel rel) :: (a_href href) :: a) "link"
let base = terminal "base"
(******************************************************************)
(* Conversion from and to Xml module *)
let tot x = x
let totl x = x
let toelt x = x
let toeltl x = x
type doc = [ `Html ] elt
let doc_toelt x = x
module I = Xml_stream.Import(Xml)
let of_seq s = totl @@ I.of_seq s
module Unsafe = struct
let data s = Xml.encodedpcdata s
let leaf tag ?a () = Xml.leaf ?a tag
let node tag ?a elts = Xml.node ?a tag elts
let coerce_elt x = x
let float_attrib = Xml.float_attrib
let int_attrib = Xml.int_attrib
let string_attrib = Xml.string_attrib
let uri_attrib a s = Xml.uri_attrib a s
let space_sep_attrib = Xml.space_sep_attrib
let comma_sep_attrib = Xml.comma_sep_attrib
end
end
module Wrapped_functions
(Xml : Xml_sigs.T with type ('a,'b) W.ft = 'a -> 'b) =
struct
module Xml = Xml
let string_of_sandbox_token = function
| `Allow_forms -> "allow-forms"
| `Allow_pointer_lock -> "allow-pointer-lock"
| `Allow_popups -> "allow-popups"
| `Allow_top_navigation -> "allow-top-navigation"
| `Allow_same_origin -> "allow-same-origin"
| `Allow_script -> "allow-script"
let string_of_linktype = function
| `Alternate -> "alternate"
| `Archives -> "archives"
| `Author -> "author"
| `Bookmark -> "bookmark"
| `Canonical -> "canonical"
| `External -> "external"
| `First -> "first"
| `Help -> "help"
| `Icon -> "icon"
| `Index -> "index"
| `Last -> "last"
| `License -> "license"
| `Next -> "next"
| `Nofollow -> "nofollow"
| `Noreferrer -> "noreferrer"
| `Noopener -> "noopener"
| `Pingback -> "pingback"
| `Prefetch -> "prefetch"
| `Prev -> "prev"
| `Search -> "search"
| `Stylesheet -> "stylesheet"
| `Sidebar -> "sidebar"
| `Tag -> "tag"
| `Up -> "up"
| `Other s -> s
let string_of_mediadesc_token =
function
| `All -> "all"
| `Aural -> "aural"
| `Braille -> "braille"
| `Embossed -> "embossed"
| `Handheld -> "handheld"
| `Print -> "print"
| `Projection -> "projection"
| `Screen -> "screen"
| `Speech -> "speech"
| `Tty -> "tty"
| `Tv -> "tv"
| `Raw_mediadesc s -> s
let string_of_referrerpolicy = function
| `Empty -> ""
| `No_referrer -> "no-referrer"
| `No_referrer_when_downgrade -> "no-referrer-when-downgrade"
| `Origin -> "origin"
| `Origin_when_cross_origin -> "origin-when-cross-origin"
| `Same_origin -> "same-origin"
| `Strict_origin -> "strict-origin"
| `Strict_origin_when_cross_origin -> "strict-origin-when-cross-origin"
| `Unsafe_url -> "unsafe-url"
let string_of_big_variant = function
| `Anonymous -> "anonymous"
| `Async -> "async"
| `Autofocus -> "autofocus"
| `Autoplay -> "autoplay"
| `Checked -> "checked"
| `Defer -> "defer"
| `Disabled -> "disabled"
| `Muted -> "muted"
| `ReadOnly -> "readonly"
| `Rect -> "rect"
| `Selected -> "selected"
| `Use_credentials -> "use-credentials"
| `W3_org_1999_xhtml -> "http://www.w3.org/1999/xhtml"
| `All -> "all"
| `Preserve -> "preserve"
| `Default -> "default"
| `Controls -> "controls"
| `Ltr -> "ltr"
| `Rtl -> "rtl"
| `Get -> "GET"
| `Post -> "POST"
| `Formnovalidate -> "formnovalidate"
| `Hidden -> "hidden"
| `Ismap -> "ismap"
| `Loop -> "loop"
| `Novalidate -> "novalidate"
| `Open -> "open"
| `None -> "none"
| `Metadata -> "metadata"
| `Audio -> "audio"
| `Pubdate -> "pubdate"
| `Required -> "required"
| `Reversed -> "reserved"
| `Scoped -> "scoped"
| `Seamless -> "seamless"
| `Any -> "any"
| `Soft -> "soft"
| `Hard -> "hard"
| `Context -> "context"
| `Toolbar -> "toolbar"
| `Command -> "command"
| `Checkbox -> "checkbox"
| `Radio -> "radio"
| `Multiple -> "multiple"
| `Left -> "left"
| `Right -> "right"
| `Justify -> "justify"
| `Char -> "char"
| `Row -> "row"
| `Col -> "col"
| `Rowgroup -> "rowgroup"
| `Colgroup -> "colgroup"
| `Groups -> "groups"
| `Rows -> "rows"
| `Cols -> "cols"
| `Zero -> "0"
| `One -> "1"
| `Yes -> "yes"
| `No -> "no"
| `Auto -> "auto"
| `Circle -> "circle"
| `Poly -> "poly"
| `Alternate -> "alternate"
| `Archives -> "archives"
| `Author -> "author"
| `Bookmark -> "bookmark"
| `External -> "external"
| `First -> "first"
| `Help -> "help"
| `Icon -> "icon"
| `Index -> "index"
| `Last -> "last"
| `License -> "license"
| `Next -> "next"
| `Nofollow -> "nofollow"
| `Noreferrer -> "noreferrer"
| `Pingback -> "pingback"
| `Prefetch -> "prefetch"
| `Prev -> "prev"
| `Search -> "search"
| `Stylesheet -> "stylesheet"
| `Sidebar -> "sidebar"
| `Tag -> "tag"
| `Up -> "up"
| `Verbatim -> "verbatim"
| `Latin -> "latin"
| `Latin_name -> "latin-name"
| `Latin_prose -> "latin-prose"
| `Full_width_latin -> "full-width-latin"
| `Kana -> "kana"
| `Katakana -> "katakana"
| `Numeric -> "numeric"
| `Tel -> "tel"
| `Email -> "email"
| `Url -> "url"
| `Text -> "text"
| `Decimal -> "decimal"
| `Other s -> s
let string_of_input_type = function
| `Button -> "button"
| `Checkbox -> "checkbox"
| `Color -> "color"
| `Date -> "date"
| `Datetime -> "datetime"
| `Datetime_local -> "datetime-local"
| `Email -> "email"
| `File -> "file"
| `Hidden -> "hidden"
| `Image -> "image"
| `Month -> "month"
| `Number -> "number"
| `Password -> "password"
| `Radio -> "radio"
| `Range -> "range"
| `Readonly -> "readonly"
| `Reset -> "reset"
| `Search -> "search"
| `Submit -> "submit"
| `Tel -> "tel"
| `Text -> "text"
| `Time -> "time"
| `Url -> "url"
| `Week -> "week"
let string_of_number_or_datetime = function
| `Number n -> string_of_int n
| `Datetime t -> t
let string_of_character = String.make 1
let string_of_number = string_of_int
let string_of_bool = string_of_bool
let onoff_of_bool = function
| false -> "off"
| true -> "on"
let unoption_string = function
| Some x -> x
| None -> ""
let string_of_step = function
| Some x -> Xml_print.string_of_number x
| None -> "any"
let string_of_sizes = function
| Some l ->
String.concat " "
(List.map (fun (x, y) -> Printf.sprintf "%dx%d" x y) l)
| None ->
"any"
let string_of_sandbox l =
String.concat " " (List.map string_of_sandbox_token l)
let string_of_numbers l =
String.concat "," (List.map string_of_number l)
let string_of_mediadesc l =
String.concat ", " (List.map string_of_mediadesc_token l)
let string_of_linktypes l =
String.concat " " (List.map string_of_linktype l)
type image_candidate =
[ `Url of Xml.uri
| `Url_width of Xml.uri * Html_types.number
| `Url_pixel of Xml.uri * Html_types.float_number ]
let string_of_srcset (l : [< image_candidate] list) =
let f = function
| `Url url -> Xml.string_of_uri url
| `Url_width (url, v) ->
Printf.sprintf "%s %sw" (Xml.string_of_uri url) (string_of_number v)
| `Url_pixel (url, v) ->
Printf.sprintf "%s %sx" (Xml.string_of_uri url) (Xml_print.string_of_number v)
in
String.concat ", " (List.map f l)
end
module Make
(Xml : Xml_sigs.T with type ('a, 'b) W.ft = 'a -> 'b)
(Svg : Svg_sigs.T with module Xml := Xml) =
Make_with_wrapped_functions(Xml)(Wrapped_functions(Xml))(Svg)
tyxml-4.5.0/lib/html_f.mli 0000664 0000000 0000000 00000004237 14040247726 0015433 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2004 by Thorsten Ohl
* Copyright (C) 2007 by Vincent Balat, Gabriel Kerneis
* Copyright (C) 2010 by Cecile Herbelin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** Typesafe constructors for HTML documents (Functorial interface)
{% See <>. %}
*)
(** Create a new implementation of [HTML], using the given underlying [Xml]
and [Svg] implementation. Will output a module of type {!Html_sigs.T} with
the various type equalities.
If your [Xml] implementation uses a special function wrapping, use
{!Make_with_wrapped_functions}.
*)
module Make
(Xml : Xml_sigs.T with type ('a, 'b) W.ft = 'a -> 'b)
(Svg : Svg_sigs.T with module Xml := Xml)
: Html_sigs.Make(Xml)(Svg).T
with type +'a elt = Xml.elt
and type +'a attrib = Xml.attrib
(** The standard set of wrapped functions, when [W.ft] is the regular function. *)
module Wrapped_functions
(Xml: Xml_sigs.T with type ('a, 'b) W.ft = 'a -> 'b)
: Html_sigs.Wrapped_functions with module Xml = Xml
(** Similar to {!Make} but with a custom set of wrapped functions. *)
module Make_with_wrapped_functions
(Xml : Xml_sigs.T)
(C : Html_sigs.Wrapped_functions with module Xml = Xml)
(Svg : Svg_sigs.T with module Xml := Xml)
: Html_sigs.Make(Xml)(Svg).T
with type +'a elt = Xml.elt
and type +'a attrib = Xml.attrib
tyxml-4.5.0/lib/html_sigs.mli 0000664 0000000 0000000 00000124535 14040247726 0016157 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2011 Pierre Chambart, Grégoire Henry
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** HTML signatures for the functorial interface. *)
(** Signature of typesafe constructors for HTML documents. *)
module type T = sig
open Html_types
(** HTML elements.
Element constructors are in section {{!elements}elements}. Most elements constructors
are either {{!nullary}nullary}, {{!unary}unary} or {{!star}star},
depending on the number of children they accept.
Children are usually given as a list of elements.
{{!txt}txt} is used for text.
[div [a [txt "Foo"]]]
is equivalent to
[
]
The type variable ['a] is used to track the element's type. This
allows the OCaml typechecker to check HTML validity.
For example, [div []] is of type [[> `Div] elt].
The {{!span}span} function only accepts children of type
{!Html_types.span_content}.
Since [`Div] is not part of it. [span [div []]] will not typecheck.
Note that the concrete implementation of this type can vary.
See {!Xml} for details.
*)
type +'a elt
(** A complete HTML document. *)
type doc = html elt
(** HTML attributes
Attribute constructors are in section {{!attributes}attributes} and their name starts
with [a_]. Attributes are given to elements with the [~a] optional argument.
[a ~a:[a_href "ocsigen.org"] [txt "link!"]]
is equivalent to
[link!]
Similarly to {{!elt}elt}, attributes use the OCaml type system to enforce
HTML validity.
For example {!a_href} returns a value of type [[> `Href] attrib].
The {{!div}div} function only accepts attributes of type
{!Html_types.div_attrib}.
Since [`Href] is not part of it,
[div ~a:[a_href "ocsigen.org"] []] will not typecheck.
In some cases, attributes have to be disambiguated.
The [max] attribute has two version,
{!a_max} and {!a_input_max}, depending on the
element.
Such disambiguated attribute will contain the name of the associated element.
*)
type +'a attrib
(** Underlying XML data-structure
The type variables in {!elt} and {!attrib} are know as {i phantom types}.
The implementation, defined here, is actually monomorphic.
In particular, tyxml doesn't impose any overhead over the underlying
representation. The {!tot} and {!toelt} functions allows to convert
between the typed and the untyped representation without any cost.
Note that some implementation may not be iterable or printable, such as the
Dom representation exposed by js_of_ocaml.
*)
module Xml : Xml_sigs.T
(** [wrap] is a container for elements and values.
In most cases, ['a wrap = 'a]. For [R] modules (in eliom or js_of_ocaml),
It will be {!React.S.t}.
*)
type 'a wrap = 'a Xml.W.t
(** [list_wrap] is a container for list of elements.
In most cases, ['a list_wrap = 'a list]. For [R] modules (in eliom or js_of_ocaml),
It will be {!ReactiveData.RList.t}.
*)
type 'a list_wrap = 'a Xml.W.tlist
(** A nullary element is an element that doesn't have any children. *)
type ('a, 'b) nullary = ?a:('a attrib list) -> unit -> 'b elt
(** A unary element is an element that have exactly one children. *)
type ('a, 'b, 'c) unary = ?a:('a attrib list) -> 'b elt wrap -> 'c elt
(** A star element is an element that has any number of children, including zero. *)
type ('a, 'b, 'c) star =
?a:('a attrib list) -> 'b elt list_wrap -> 'c elt
(** Associated SVG module, for the {!svg} combinator. *)
module Svg : Svg_sigs.T with module Xml := Xml
(** Various information about HTML, such as the doctype, ... *)
module Info : Xml_sigs.Info
(** {3 Uri} *)
type uri = Xml.uri
val string_of_uri : (uri, string) Xml.W.ft
val uri_of_string : (string, uri) Xml.W.ft
(** {2:attributes Attributes} *)
val a_class : nmtokens wrap -> [> | `Class] attrib
(** This attribute assigns a class name or set of class names to an
element. Any number of elements may be assigned the same class
name or names. *)
val a_user_data : nmtoken -> text wrap -> [> | `User_data] attrib
(** May be used to specify custom attributes.
The example given by the W3C is as follows :
{v
Beyond The Sea
v}
It should be used for preprocessing ends only. *)
val a_id : text wrap -> [> | `Id] attrib
(** This attribute assigns a name to an element. This name must be
unique in a document. The text should be without any space. *)
val a_title : text wrap -> [> | `Title] attrib
(** This attribute offers advisory information about the element for
which it is set.
Values of the title attribute may be rendered by user agents in a
variety of ways. For instance, visual browsers frequently display
the title as a {i tool tip} (a short message that appears when the
pointing device pauses over an object). Audio user agents may
speak the title information in a similar context.
The title attribute has an additional role when used with the [link]
element to designate an external style sheet. Please consult the
section on links and style sheets for details. *)
(** {3 I18N} *)
val a_xml_lang : languagecode wrap -> [> | `XML_lang] attrib
val a_lang : languagecode wrap -> [> | `Lang] attrib
(** {3 Events}
{4 Javascript events} *)
val a_onabort : Xml.event_handler -> [> | `OnAbort] attrib
val a_onafterprint : Xml.event_handler -> [> | `OnAfterPrint] attrib
val a_onbeforeprint : Xml.event_handler -> [> | `OnBeforePrint] attrib
val a_onbeforeunload : Xml.event_handler -> [> | `OnBeforeUnload] attrib
val a_onblur : Xml.event_handler -> [> | `OnBlur] attrib
val a_oncanplay : Xml.event_handler -> [> | `OnCanPlay] attrib
val a_oncanplaythrough : Xml.event_handler -> [> | `OnCanPlayThrough] attrib
val a_onchange : Xml.event_handler -> [> | `OnChange] attrib
val a_ondurationchange : Xml.event_handler -> [> | `OnDurationChange] attrib
val a_onemptied : Xml.event_handler -> [> | `OnEmptied] attrib
val a_onended : Xml.event_handler -> [> | `OnEnded] attrib
val a_onerror : Xml.event_handler -> [> | `OnError] attrib
val a_onfocus : Xml.event_handler -> [> | `OnFocus] attrib
val a_onformchange : Xml.event_handler -> [> | `OnFormChange] attrib
val a_onforminput : Xml.event_handler -> [> | `OnFormInput] attrib
val a_onhashchange : Xml.event_handler -> [> | `OnHashChange] attrib
val a_oninput : Xml.event_handler -> [> | `OnInput] attrib
val a_oninvalid : Xml.event_handler -> [> | `OnInvalid] attrib
val a_onmousewheel : Xml.event_handler -> [> | `OnMouseWheel] attrib
val a_onoffline : Xml.event_handler -> [> | `OnOffLine] attrib
val a_ononline : Xml.event_handler -> [> | `OnOnLine] attrib
val a_onpause : Xml.event_handler -> [> | `OnPause] attrib
val a_onplay : Xml.event_handler -> [> | `OnPlay] attrib
val a_onplaying : Xml.event_handler -> [> | `OnPlaying] attrib
val a_onpagehide : Xml.event_handler -> [> | `OnPageHide] attrib
val a_onpageshow : Xml.event_handler -> [> | `OnPageShow] attrib
val a_onpopstate : Xml.event_handler -> [> | `OnPopState] attrib
val a_onprogress : Xml.event_handler -> [> | `OnProgress] attrib
val a_onratechange : Xml.event_handler -> [> | `OnRateChange] attrib
val a_onreadystatechange : Xml.event_handler -> [> | `OnReadyStateChange] attrib
val a_onredo : Xml.event_handler -> [> | `OnRedo] attrib
val a_onresize : Xml.event_handler -> [> | `OnResize] attrib
val a_onscroll : Xml.event_handler -> [> | `OnScroll] attrib
val a_onseeked : Xml.event_handler -> [> | `OnSeeked] attrib
val a_onseeking : Xml.event_handler -> [> | `OnSeeking] attrib
val a_onselect : Xml.event_handler -> [> | `OnSelect] attrib
val a_onshow : Xml.event_handler -> [> | `OnShow] attrib
val a_onstalled : Xml.event_handler -> [> | `OnStalled] attrib
val a_onstorage : Xml.event_handler -> [> | `OnStorage] attrib
val a_onsubmit : Xml.event_handler -> [> | `OnSubmit] attrib
val a_onsuspend : Xml.event_handler -> [> | `OnSuspend] attrib
val a_ontimeupdate : Xml.event_handler -> [> | `OnTimeUpdate] attrib
val a_onundo : Xml.event_handler -> [> | `OnUndo] attrib
val a_onunload : Xml.event_handler -> [> | `OnUnload] attrib
val a_onvolumechange : Xml.event_handler -> [> | `OnVolumeChange] attrib
val a_onwaiting : Xml.event_handler -> [> | `OnWaiting] attrib
val a_onload : Xml.event_handler -> [> | `OnLoad] attrib
val a_onloadeddata : Xml.event_handler -> [> | `OnLoadedData] attrib
val a_onloadedmetadata : Xml.event_handler -> [> | `OnLoadedMetaData] attrib
val a_onloadstart : Xml.event_handler -> [> | `OnLoadStart] attrib
val a_onmessage : Xml.event_handler -> [> | `OnMessage] attrib
(** {4 Mouse events} *)
val a_onclick : Xml.mouse_event_handler -> [> | `OnClick] attrib
val a_oncontextmenu : Xml.mouse_event_handler -> [> | `OnContextMenu] attrib
val a_ondblclick : Xml.mouse_event_handler -> [> | `OnDblClick] attrib
val a_ondrag : Xml.mouse_event_handler -> [> | `OnDrag] attrib
val a_ondragend : Xml.mouse_event_handler -> [> | `OnDragEnd] attrib
val a_ondragenter : Xml.mouse_event_handler -> [> | `OnDragEnter] attrib
val a_ondragleave : Xml.mouse_event_handler -> [> | `OnDragLeave] attrib
val a_ondragover : Xml.mouse_event_handler -> [> | `OnDragOver] attrib
val a_ondragstart : Xml.mouse_event_handler -> [> | `OnDragStart] attrib
val a_ondrop : Xml.mouse_event_handler -> [> | `OnDrop] attrib
val a_onmousedown : Xml.mouse_event_handler -> [> | `OnMouseDown] attrib
val a_onmouseup : Xml.mouse_event_handler -> [> | `OnMouseUp] attrib
val a_onmouseover : Xml.mouse_event_handler -> [> | `OnMouseOver] attrib
val a_onmousemove : Xml.mouse_event_handler -> [> | `OnMouseMove] attrib
val a_onmouseout : Xml.mouse_event_handler -> [> | `OnMouseOut] attrib
(** {4 Touch events} *)
val a_ontouchstart : Xml.touch_event_handler -> [> | `OnTouchStart] attrib
val a_ontouchend : Xml.touch_event_handler -> [> | `OnTouchEnd] attrib
val a_ontouchmove : Xml.touch_event_handler -> [> | `OnTouchMove] attrib
val a_ontouchcancel : Xml.touch_event_handler -> [> | `OnTouchCancel] attrib
(** {4 Keyboard events} *)
val a_onkeypress : Xml.keyboard_event_handler -> [> | `OnKeyPress] attrib
val a_onkeydown : Xml.keyboard_event_handler -> [> | `OnKeyDown] attrib
val a_onkeyup : Xml.keyboard_event_handler -> [> | `OnKeyUp] attrib
(** {3 Other attributes} *)
val a_allowfullscreen : unit -> [> | `Allowfullscreen] attrib
val a_allowpaymentrequest : unit -> [> | `Allowpaymentrequest] attrib
val a_autocomplete : (bool[@onoff]) wrap -> [> | `Autocomplete] attrib
val a_async : unit -> [> | `Async] attrib
val a_autofocus : unit -> [> | `Autofocus] attrib
val a_autoplay : unit -> [> | `Autoplay] attrib
val a_muted : unit -> [> | `Muted] attrib
val a_crossorigin :
[< | `Anonymous | `Use_credentials ] wrap -> [> | `Crossorigin ] attrib
val a_integrity :
string wrap -> [> | `Integrity ] attrib
val a_mediagroup : string wrap -> [> | `Mediagroup ] attrib
val a_challenge : text wrap -> [> | `Challenge] attrib
val a_contenteditable : bool wrap -> [> | `Contenteditable] attrib
val a_contextmenu : idref wrap -> [> | `Contextmenu] attrib
val a_controls : unit -> [> | `Controls] attrib
val a_dir : [< | `Rtl | `Ltr] wrap -> [> | `Dir] attrib
val a_draggable : bool wrap -> [> | `Draggable] attrib
val a_form : idref wrap -> [> | `Form] attrib
val a_formaction : Xml.uri wrap -> [> | `Formaction] attrib
val a_formenctype : contenttype wrap -> [> | `Formenctype] attrib
val a_formnovalidate : unit -> [> | `Formnovalidate] attrib
val a_formtarget : text wrap -> [> | `Formtarget] attrib
val a_hidden : unit -> [> | `Hidden] attrib
val a_high : float_number wrap -> [> | `High] attrib
val a_icon : Xml.uri wrap -> [> | `Icon] attrib
val a_ismap : unit -> [> | `Ismap] attrib
val a_keytype : text wrap -> [> | `Keytype] attrib
val a_list : idref wrap -> [> | `List] attrib
val a_loop : unit -> [> | `Loop] attrib
val a_low : float_number wrap -> [> | `High] attrib
val a_max : float_number wrap -> [> | `Max] attrib
val a_input_max : number_or_datetime wrap -> [> | `Input_Max] attrib
[@@reflect.attribute "max" ["input"]]
val a_min : float_number wrap -> [> | `Min] attrib
val a_input_min : number_or_datetime wrap -> [> | `Input_Min] attrib
[@@reflect.attribute "min" ["input"]]
val a_inputmode :
[< `None | `Text | `Decimal | `Numeric | `Tel | `Search | `Email | `Url ] wrap ->
[> `Inputmode] attrib
(** @see inputmode documentation. *)
val a_novalidate : unit -> [> | `Novalidate] attrib
val a_open : unit -> [> | `Open] attrib
val a_optimum : float_number wrap -> [> | `Optimum] attrib
val a_pattern : text wrap -> [> | `Pattern] attrib
val a_placeholder : text wrap -> [> | `Placeholder] attrib
val a_poster : Xml.uri wrap -> [> | `Poster] attrib
val a_preload : [< | `None | `Metadata | `Audio] wrap -> [> | `Preload] attrib
val a_pubdate : unit -> [> | `Pubdate] attrib
val a_radiogroup : text wrap -> [> | `Radiogroup] attrib
val a_referrerpolicy : referrerpolicy wrap -> [> `Referrerpolicy] attrib
(** @see
*)
val a_required : unit -> [> | `Required] attrib
val a_reversed : unit -> [> | `Reversed] attrib
val a_sandbox : [< | sandbox_token ] list wrap -> [> | `Sandbox] attrib
val a_spellcheck : bool wrap -> [> | `Spellcheck] attrib
val a_scoped : unit -> [> | `Scoped] attrib
val a_seamless : unit -> [> | `Seamless] attrib
val a_sizes : (number * number) list option wrap -> [> | `Sizes] attrib
val a_span : number wrap -> [> | `Span] attrib
(** @deprecated Use {!a_xml_lang} instead. *)
val a_srclang : nmtoken wrap -> [> | `XML_lang] attrib
[@@ocaml.deprecated "Use a_xml_lang instead."]
type image_candidate =
[ `Url of uri
| `Url_width of uri * number
| `Url_pixel of uri * float_number ]
val a_srcset : image_candidate list wrap -> [> | `Srcset] attrib
val a_img_sizes : text list wrap -> [> | `Img_sizes] attrib
[@@reflect.attribute "sizes" ["img"]]
val a_start : number wrap -> [> | `Start] attrib
val a_step : float_number option wrap -> [> | `Step] attrib
val a_translate : [< | `Yes | `No] wrap -> [> | `Translate] attrib
(** @see [translate] global attribute documentation. *)
val a_wrap : [< | `Soft | `Hard] wrap -> [> | `Wrap] attrib
val a_version : cdata wrap -> [> | `Version] attrib
val a_xmlns : [< | `W3_org_1999_xhtml] wrap -> [> | `XMLns] attrib
val a_manifest : Xml.uri wrap -> [> | `Manifest] attrib
val a_cite : Xml.uri wrap -> [> | `Cite] attrib
val a_xml_space : [< | `Default | `Preserve] wrap -> [> | `XML_space] attrib
val a_accesskey : character wrap -> [> | `Accesskey] attrib
(** This attribute assigns an access key to an element. An access key
is a single character from the document character
set. NB: authors should consider the input method of the
expected reader when specifying an accesskey. *)
val a_charset : charset wrap -> [> | `Charset] attrib
(** This attribute specifies the character encoding of the resource
designated by the link. Please consult the section on character
encodings for more details. *)
val a_accept_charset : charsets wrap -> [> | `Accept_charset] attrib
val a_accept : contenttypes wrap -> [> | `Accept] attrib
val a_href : Xml.uri wrap -> [> | `Href] attrib
(** This attribute specifies the location of a Web resource, thus
defining a link between the current element (the source anchor)
and the destination anchor defined by this attribute. *)
val a_hreflang : languagecode wrap -> [> | `Hreflang] attrib
(** This attribute specifies the base language of the resource
designated by href and may only be used when href is specified. *)
val a_download : string option wrap -> [> | `Download] attrib
val a_rel : linktypes wrap -> [> | `Rel] attrib
(** This attribute describes the relationship from the current
document to the anchor specified by the href attribute. The
value of this attribute is a space-separated list of link
types. *)
(** This attribute is used to describe a reverse link from the
anchor specified by the href attribute to the current
document. The value of this attribute is a space-separated
list of link types. *)
val a_tabindex : number wrap -> [> | `Tabindex] attrib
(** This attribute specifies the position of the current
element in the tabbing order for the current document. This
value must be a number between 0 and 32767. User agents
should ignore leading zeros. *)
val a_mime_type : contenttype wrap -> [> | `Mime_type] attrib
[@@reflect.attribute "type" ["object"; "embed"; "area"; "link"; "source"]]
(** This attribute gives an advisory hint as to the content type
of the content available at the link target address. It
allows user agents to opt to use a fallback mechanism rather
than fetch the content if they are advised that they will
get content in a content type they do not support.Authors
who use this attribute take responsibility to manage the
risk that it may become inconsistent with the content
available at the link target address. *)
val a_datetime : cdata wrap -> [> | `Datetime] attrib
val a_action : Xml.uri wrap -> [> | `Action] attrib
(** This attribute specifies a form processing agent. User agent
behavior for a value other than an HTTP URI is undefined. *)
val a_checked : unit -> [> | `Checked] attrib
(** When the [type] attribute has the value ["radio"] or
["checkbox"], this boolean attribute specifies that the
button is on. User agents must ignore this attribute for
other control types. *)
val a_cols : number wrap -> [> | `Cols] attrib
(** This attribute specifies the visible width in average
character widths. Users should be able to enter longer lines
than this, so user agents should provide some means to
scroll through the contents of the control when the contents
extend beyond the visible area. User agents may wrap visible
text lines to keep long lines visible without the need for
scrolling. *)
val a_enctype : contenttype wrap -> [> | `Enctype] attrib
val a_label_for : idref wrap -> [> | `Label_for] attrib
[@@reflect.attribute "for" ["label"]]
val a_for : idref wrap -> [> | `Label_for] attrib
[@@ocaml.deprecated "Use a_label_for"]
(** @deprecated Use a_label_for *)
val a_output_for : idrefs wrap -> [> | `Output_for] attrib
[@@reflect.attribute "for" ["output"]]
val a_for_list : idrefs wrap -> [> | `Output_for] attrib
[@@ocaml.deprecated "Use a_output_for"]
(** @deprecated Use a_output_for *)
val a_maxlength : number wrap -> [> | `Maxlength] attrib
val a_minlength : number wrap -> [> | `Minlength] attrib
val a_method :
[< | `Get | `Post] wrap -> [> | `Method] attrib
val a_formmethod :
[< | `Get | `Post] wrap -> [> | `Method] attrib
[@@ocaml.deprecated "Use a_method"]
(** @deprecated Use a_method *)
val a_multiple : unit -> [> | `Multiple] attrib
val a_name : text wrap -> [> | `Name] attrib
(** This attribute assigns the control name. *)
val a_rows : number wrap -> [> | `Rows] attrib
(** This attribute specifies the number of visible text
lines. Users should be able to enter more lines than this,
so user agents should provide some means to scroll through
the contents of the control when the contents extend beyond
the visible area. *)
val a_selected : unit -> [> | `Selected] attrib
(** When set, this boolean attribute specifies that
this option is pre-selected. *)
val a_size : number wrap -> [> | `Size] attrib
val a_src : Xml.uri wrap -> [> | `Src] attrib
val a_input_type : [<
| `Url
| `Tel
| `Text
| `Time
| `Search
| `Password
| `Checkbox
| `Range
| `Radio
| `Submit
| `Reset
| `Number
| `Hidden
| `Month
| `Week
| `File
| `Email
| `Image
| `Datetime_local
| `Datetime
| `Date
| `Color
| `Button] wrap -> [> | `Input_Type] attrib
[@@reflect.attribute "type" ["input"]]
val a_text_value : text wrap -> [> | `Text_Value] attrib
[@@reflect.attribute "value" ["param"; "button"; "option"]]
(** This attribute specifies the initial value of the
control. If this attribute is not set, the initial value is
set to the contents of the [option] element. *)
val a_int_value : number wrap -> [> | `Int_Value] attrib
[@@reflect.attribute "value" ["li"]]
val a_value : cdata wrap -> [> | `Value] attrib
val a_float_value : float_number wrap -> [> | `Float_Value] attrib
[@@reflect.attribute "value" ["progress"; "meter"]]
val a_disabled : unit -> [> | `Disabled] attrib
val a_readonly : unit -> [> | `ReadOnly] attrib
val a_button_type :
[< | `Button | `Submit | `Reset] wrap -> [> | `Button_Type] attrib
[@@reflect.attribute "type" ["button"]]
val a_command_type :
[< | `Command | `Checkbox | `Radio] wrap -> [> | `Command_Type] attrib
[@@reflect.attribute "type" ["command"]]
val a_menu_type : [< | `Context | `Toolbar] wrap -> [> | `Menu_Type] attrib
[@@reflect.attribute "type" ["menu"]]
val a_label : text wrap -> [> | `Label] attrib
val a_align :
[< | `Left | `Right | `Justify | `Char] wrap -> [> | `Align] attrib
[@@ocaml.deprecated "Use CSS text-align"]
(** @deprecated Use CSS text-align *)
val a_axis : cdata wrap -> [> | `Axis] attrib
[@@ocaml.deprecated "Not supported in HTML5"]
(** @deprecated Not supported in HTML5 *)
val a_colspan : number wrap -> [> | `Colspan] attrib
val a_headers : idrefs wrap -> [> | `Headers] attrib
val a_rowspan : number wrap -> [> | `Rowspan] attrib
val a_scope :
[< | `Row | `Col | `Rowgroup | `Colgroup] wrap -> [> | `Scope] attrib
[@@ocaml.deprecated "Not supported in HTML5"]
(** @deprecated Not supported in HTML5 *)
val a_summary : text wrap -> [> | `Summary] attrib
[@@ocaml.deprecated "Move content elsewhere or to a
child"]
(** @deprecated Move content elsewhere or to a
child *)
val a_border : pixels wrap -> [> | `Border] attrib
[@@ocaml.deprecated "Use CSS border and/or border-width"]
(** @deprecated Use CSS border and/or border-width *)
val a_rules :
[< | `None | `Groups | `Rows | `Cols | `All] wrap -> [> | `Rules] attrib
[@@ocaml.deprecated "Use CSS border"]
(** @deprecated Use CSS border *)
val a_char : character wrap -> [> | `Char] attrib
[@@ocaml.deprecated "The char attribute is not supported in HTML5"]
(** @deprecated The char attribute is not supported in HTML5 *)
val a_alt : text wrap -> [> | `Alt] attrib
val a_height : number wrap -> [> | `Height] attrib
val a_width : number wrap -> [> | `Width] attrib
type shape = [ | `Rect | `Circle | `Poly | `Default ]
val a_shape : shape wrap -> [> | `Shape] attrib
val a_coords : numbers wrap -> [> | `Coords] attrib
val a_usemap : idref wrap -> [> | `Usemap] attrib
val a_data : Xml.uri wrap -> [> | `Data] attrib
val a_codetype : contenttype wrap -> [> | `Codetype] attrib
[@@ocaml.deprecated "Not supported in HTML5"]
(** @deprecated Not supported in HTML5 *)
val a_frameborder : [< | `Zero | `One] wrap -> [> | `Frameborder] attrib
[@@ocaml.deprecated "Use CSS border"]
(** @deprecated Use CSS border *)
val a_marginheight : pixels wrap -> [> | `Marginheight] attrib
[@@ocaml.deprecated "Use CSS margin"]
(** @deprecated Use CSS *)
val a_marginwidth : pixels wrap -> [> | `Marginwidth] attrib
[@@ocaml.deprecated "Use CSS margin"]
(** @deprecated Use CSS *)
val a_scrolling : [< | `Yes | `No | `Auto] wrap -> [> | `Scrolling] attrib
val a_target : frametarget wrap -> [> | `Target] attrib
val a_content : text wrap -> [> | `Content] attrib
val a_http_equiv : text wrap -> [> | `Http_equiv] attrib
val a_defer : unit -> [> | `Defer] attrib
val a_media : mediadesc wrap -> [> | `Media] attrib
val a_style : string wrap -> [> | `Style_Attr] attrib
val a_property : string wrap -> [> | `Property] attrib
(** {3 ARIA support} *)
(** {{: https://www.w3.org/TR/wai-aria-1.1/} WAI-ARIA} is a specification
written by the W3C, defining a set of additional HTML attributes that can
be applied to elements to provide additional semantics and improve
accessibility wherever it is lacking.
See for example a {{:
https://developer.mozilla.org/en-US/docs/Learn/Accessibility/WAI-ARIA_basics}
WAI-ARIA tutorial}.
*)
val a_role : string list wrap -> [> | `Role] attrib
(** @see Role attribute specification
@see List of WAI-ARIA roles
*)
val a_aria : string -> string list wrap -> [> | `Aria] attrib
(** Basic support for WAI-ARIA attributes: [a_aria "foo"] corresponds to an
"aria-foo" attribute.
@see List of WAI-ARIA attributes
*)
(** {2:elements Elements} *)
val txt : string wrap -> [> | txt] elt
val html :
?a: ((html_attrib attrib) list) ->
[< | head] elt wrap -> [< | body] elt wrap -> [> | html] elt
[@@reflect.filter_whitespace]
[@@reflect.element "html"]
val head :
?a: ((head_attrib attrib) list) ->
[< | title] elt wrap -> (head_content_fun elt) list_wrap -> [> | head] elt
[@@reflect.filter_whitespace]
[@@reflect.element "head"]
val base : ([< | base_attrib], [> | base]) nullary
val title : (title_attrib, [< | title_content_fun], [> | title]) unary
val body : ([< | body_attrib], [< | body_content_fun], [> | body]) star
val svg : ?a : [< svg_attrib ] Svg.attrib list -> [< svg_content ] Svg.elt list_wrap -> [> svg ] elt
(** {3 Section} *)
val footer :
([< | footer_attrib], [< | footer_content_fun], [> | footer]) star
val header :
([< | header_attrib], [< | header_content_fun], [> | header]) star
val section :
([< | section_attrib], [< | section_content_fun], [> | section]) star
val nav : ([< | nav_attrib], [< | nav_content_fun], [> | nav]) star
val h1 : ([< | h1_attrib], [< | h1_content_fun], [> | h1]) star
val h2 : ([< | h2_attrib], [< | h2_content_fun], [> | h2]) star
val h3 : ([< | h3_attrib], [< | h3_content_fun], [> | h3]) star
val h4 : ([< | h4_attrib], [< | h4_content_fun], [> | h4]) star
val h5 : ([< | h5_attrib], [< | h5_content_fun], [> | h5]) star
val h6 : ([< | h6_attrib], [< | h6_content_fun], [> | h6]) star
val hgroup :
([< | hgroup_attrib], [< | hgroup_content_fun], [> | hgroup]) star
val address :
([< | address_attrib], [< | address_content_fun], [> | address]) star
val article :
([< | article_attrib], [< | article_content_fun], [> | article]) star
val aside :
([< | aside_attrib], [< | aside_content_fun], [> | aside]) star
val main :
([< | main_attrib], [< | main_content_fun], [> | main]) star
(** {3 Grouping content} *)
val p : ([< | p_attrib], [< | p_content_fun], [> | p]) star
val pre : ([< | pre_attrib], [< | pre_content_fun], [> | pre]) star
val blockquote :
([< | blockquote_attrib], [< | blockquote_content_fun], [> | blockquote])
star
val div : ([< | div_attrib], [< | div_content_fun], [> | div]) star
val dl : ([< | dl_attrib], [< | dl_content_fun], [> | dl]) star
val ol : ([< | ol_attrib], [< | ol_content_fun], [> | ol]) star
[@@reflect.filter_whitespace]
val ul : ([< | ul_attrib], [< | ul_content_fun], [> | ul]) star
[@@reflect.filter_whitespace]
val dd : ([< | dd_attrib], [< | dd_content_fun], [> | dd]) star
val dt : ([< | dt_attrib], [< | dt_content_fun], [> | dt]) star
val li : ([< | li_attrib], [< | li_content_fun], [> | li]) star
val figcaption :
([< | figcaption_attrib], [< | figcaption_content_fun], [> | figcaption]) star
val figure :
?figcaption: ([`Top of [< | figcaption ] elt wrap | `Bottom of [< | figcaption ] elt wrap ]) ->
([< | figure_attrib], [< | figure_content_fun], [> | figure]) star
[@@reflect.element "figure"]
val hr : ([< | hr_attrib], [> | hr]) nullary
(** {3 Semantic} *)
val b : ([< | b_attrib], [< | b_content_fun], [> | b]) star
val i : ([< | i_attrib], [< | i_content_fun], [> | i]) star
val u : ([< | u_attrib], [< | u_content_fun], [> | u]) star
val small :
([< | small_attrib], [< | small_content_fun], [> | small]) star
val sub : ([< | sub_attrib], [< | sub_content_fun], [> | sub]) star
val sup : ([< | sup_attrib], [< | sup_content_fun], [> | sup]) star
val mark : ([< | mark_attrib], [< | mark_content_fun], [> | mark]) star
val wbr : ([< | wbr_attrib], [> | wbr]) nullary
val bdo :
dir: [< | `Ltr | `Rtl] wrap ->
([< | bdo_attrib], [< | bdo_content_fun], [> | bdo]) star
val abbr : ([< | abbr_attrib], [< | abbr_content_fun], [> | abbr]) star
val br : ([< | br_attrib], [> | br]) nullary
val cite : ([< | cite_attrib], [< | cite_content_fun], [> | cite]) star
val code : ([< | code_attrib], [< | code_content_fun], [> | code]) star
val dfn : ([< | dfn_attrib], [< | dfn_content_fun], [> | dfn]) star
val em : ([< | em_attrib], [< | em_content_fun], [> | em]) star
val kbd : ([< | kbd_attrib], [< | kbd_content_fun], [> | kbd]) star
val q : ([< | q_attrib], [< | q_content_fun], [> | q]) star
val samp : ([< | samp_attrib], [< | samp_content_fun], [> | samp]) star
val span : ([< | span_attrib], [< | span_content_fun], [> | span]) star
val strong :
([< | strong_attrib], [< | strong_content_fun], [> | strong]) star
val time : ([< | time_attrib], [< | time_content_fun], [> | time]) star
val var : ([< | var_attrib], [< | var_content_fun], [> | var]) star
(** {3 Hypertext} *)
val a : ([< | a_attrib], 'a, [> | 'a a]) star
(** {3 Edit} *)
val del : ([< | del_attrib], 'a, [> | 'a del]) star
val ins : ([< | ins_attrib], 'a, [> | 'a ins]) star
(** {3 Embedded} *)
val img :
src: Xml.uri wrap ->
alt: text wrap ->
([< img_attrib], [> img]) nullary
val picture : img:([< | img] elt wrap) -> ([< | picture_attrib], [< | picture_content_fun], [> | picture]) star
[@@reflect.filter_whitespace]
[@@reflect.element "picture"]
(** @see
Picture element documentation on MDN *)
val iframe :
([< | iframe_attrib], [< | iframe_content_fun], [> | iframe]) star
val object_ :
?params: (([< | param] elt) list_wrap ) ->
([< | object__attrib], 'a, [> | `Object of 'a]) star
[@@reflect.element "object_" "object"]
val param : ([< | param_attrib], [> | param]) nullary
val embed : ([< | embed_attrib], [> | embed]) nullary
val audio :
?src:Xml.uri wrap ->
?srcs:(([< | source] elt) list_wrap) ->
([< | audio_attrib], 'a, [> 'a audio ]) star
[@@reflect.element "audio_video"]
val video :
?src:Xml.uri wrap ->
?srcs: (([< | source] elt) list_wrap) ->
([< | video_attrib], 'a, [> 'a video]) star
[@@reflect.element "audio_video"]
val canvas : ([< | canvas_attrib], 'a, [> | 'a canvas]) star
val source : ([< | source_attrib], [> | source]) nullary
val area :
alt: text wrap ->
([<
| common
| `Alt
| `Coords
| `Shape
| `Target
| `Rel
| `Media
| `Hreflang
| `Mime_type
], [> | area]) nullary
val map : ([< | map_attrib], 'a, [> | 'a map]) star
(** {3 Tables Data} *)
val caption :
([< | caption_attrib], [< | caption_content_fun], [> | caption]) star
val table :
?caption: [< | caption] elt wrap ->
?columns: [< | colgroup] elt list_wrap ->
?thead: [< | thead] elt wrap ->
?tfoot: [< | tfoot] elt wrap ->
([< | table_attrib], [< | table_content_fun], [> | table]) star
[@@reflect.filter_whitespace]
[@@reflect.element "table"]
val tablex :
?caption: [< | caption] elt wrap ->
?columns: [< | colgroup] elt list_wrap ->
?thead: [< | thead] elt wrap ->
?tfoot: [< | tfoot] elt wrap ->
([< | tablex_attrib], [< | tablex_content_fun], [> | tablex]) star
[@@reflect.filter_whitespace]
[@@reflect.element "table" "table"]
val colgroup :
([< | colgroup_attrib], [< | colgroup_content_fun], [> | colgroup]) star
[@@reflect.filter_whitespace]
val col : ([< | col_attrib], [> | col]) nullary
val thead :
([< | thead_attrib], [< | thead_content_fun], [> | thead]) star
[@@reflect.filter_whitespace]
val tbody :
([< | tbody_attrib], [< | tbody_content_fun], [> | tbody]) star
[@@reflect.filter_whitespace]
val tfoot :
([< | tfoot_attrib], [< | tfoot_content_fun], [> | tfoot]) star
[@@reflect.filter_whitespace]
val td : ([< | td_attrib], [< | td_content_fun], [> | td]) star
val th : ([< | th_attrib], [< | th_content_fun], [> | th]) star
val tr : ([< | tr_attrib], [< | tr_content_fun], [> | tr]) star
[@@reflect.filter_whitespace]
(** {3 Forms} *)
val form : ([< | form_attrib], [< | form_content_fun], [> | form]) star
val fieldset :
?legend: [< | legend ] elt wrap ->
([< | fieldset_attrib], [< | fieldset_content_fun], [> | fieldset]) star
[@@reflect.element "fieldset"]
val legend :
([< | legend_attrib], [< | legend_content_fun], [> | legend]) star
(** Label authorizes only one control inside them
that should be labelled with a [for] attribute
(although it is not necessary). Such constraints are not currently
enforced by the type-system *)
val label :
([< | label_attrib], [< | label_content_fun], [> | label]) star
val input : ([< | input_attrib], [> | input]) nullary
val button :
([< | button_attrib], [< | button_content_fun], [> | button]) star
val select :
([< | select_attrib], [< | select_content_fun], [> | select]) star
[@@reflect.filter_whitespace]
val datalist :
?children:(
[<
| `Options of ([< | selectoption] elt) list_wrap
| `Phras of ([< | phrasing] elt) list_wrap
]) ->
([< | datalist_attrib], [> | datalist]) nullary
[@@reflect.filter_whitespace]
[@@reflect.element "datalist"]
val optgroup :
label: text wrap ->
([< | optgroup_attrib], [< | optgroup_content_fun], [> | optgroup]) star
val option :
([< | option_attrib], [< | option_content_fun], [> | selectoption]) unary
val textarea :
([< | textarea_attrib], [< | textarea_content_fun], [> | textarea]) unary
val keygen : ([< | keygen_attrib], [> | keygen]) nullary
val progress :
([< | progress_attrib], [< | progress_content_fun], [> | progress]) star
val meter :
([< | meter_attrib], [< | meter_content_fun], [> | meter]) star
val output_elt :
([< | output_elt_attrib], [< | output_elt_content_fun], [> | output_elt]) star
[@@reflect.element "star" "output"]
(** {3 Data} *)
(** [entity "foo"] is the HTML entity [&foo;]. Both numerical and named form are allowed.
@see A tutorial on HTML entities.
@see The list of HTML entities.
*)
val entity : string -> [> | txt] elt
val space : unit -> [> | txt] elt
val cdata : string -> [> | txt] elt
val cdata_script : string -> [> | txt] elt
val cdata_style : string -> [> | txt] elt
(** {3 Interactive} *)
val details :
[< | summary] elt wrap ->
([< | details_attrib], [< | details_content_fun], [> | details]) star
[@@reflect.element "details"]
val summary :
([< | summary_attrib], [< | summary_content_fun], [> | summary]) star
val command :
label: text wrap ->
([< | command_attrib], [> | command]) nullary
val menu :
?children:(
[<
| `Lis of ([< | `Li of [< | common]] elt) list_wrap
| `Flows of ([< | flow5] elt) list_wrap
]) ->
([< | menu_attrib], [> | menu]) nullary
[@@reflect.element "menu"]
(** {3 Scripting} *)
val script :
([< | script_attrib], [< | script_content_fun], [> | script]) unary
[@@reflect.element "script"]
val noscript :
([< | noscript_attrib], [< | noscript_content_fun], [> | noscript]) star
val template :
([< | template_attrib], [< | template_content_fun], [> | template]) star
(** @see
Template element documentation on MDN *)
val meta : ([< | meta_attrib], [> | meta]) nullary
(** {3 Style Sheets} *)
val style :
([< | style_attrib], [< | style_content_fun], [> | style]) star
val link :
rel: linktypes wrap ->
href: Xml.uri wrap ->
([< | link_attrib], [> | link]) nullary
(** {3 Ruby} *)
val rt : ([< | rt_attrib], [< | rt_content_fun], [> | rt]) star
val rp : ([< | rp_attrib], [< | rp_content_fun], [> | rp]) star
val ruby : ([< | ruby_attrib], [< | ruby_content_fun], [> | ruby]) star
(** {3 Deprecated} *)
val pcdata : string wrap -> [> | pcdata] elt
[@@ocaml.deprecated "Use txt instead"]
(** @deprecated Use txt instead *)
(** {2 Conversion with untyped representation}
WARNING: These functions do not ensure HTML or SVG validity! You should
always explicitly given an appropriate type to the output.
*)
(** [import signal] converts the given XML signal into Tyxml elements.
It can be used with HTML and SVG parsing libraries, such as Markup.
@raise Xml_stream.Malformed_stream if the stream is malformed.
*)
val of_seq : Xml_stream.signal Seq.t -> 'a elt list_wrap
val tot : Xml.elt -> 'a elt
val totl : Xml.elt list_wrap -> 'a elt list_wrap
val toelt : 'a elt -> Xml.elt
val toeltl : 'a elt list_wrap -> Xml.elt list_wrap
val doc_toelt : doc -> Xml.elt
val to_xmlattribs : 'a attrib list -> Xml.attrib list
val to_attrib : Xml.attrib -> 'a attrib
(** Unsafe features.
Using this module can break
HTML validity and may introduce security problems like
code injection.
Use it with care.
*)
module Unsafe : sig
(** Insert raw text without any encoding *)
val data : string wrap -> 'a elt
(** Insert an XML node that is not implemented in this module.
If it is a standard HTML node which is missing,
please report to the Ocsigen team.
*)
val node : string -> ?a:'a attrib list -> 'b elt list_wrap -> 'c elt
(** Insert an XML node without children
that is not implemented in this module.
If it is a standard HTML node which is missing,
please report to the Ocsigen team.
*)
val leaf : string -> ?a:'a attrib list -> unit -> 'b elt
(** Remove phantom type annotation on an element,
to make it usable everywhere.
*)
val coerce_elt : 'a elt -> 'b elt
(** Insert an attribute that is not implemented in this module.
If it is a standard HTML attribute which is missing,
please report to the Ocsigen team.
*)
val string_attrib : string -> string wrap -> 'a attrib
(** Same, for float attribute *)
val float_attrib : string -> float wrap -> 'a attrib
(** Same, for int attribute *)
val int_attrib : string -> int wrap -> 'a attrib
(** Same, for URI attribute *)
val uri_attrib : string -> uri wrap -> 'a attrib
(** Same, for a space separated list of values *)
val space_sep_attrib : string -> string list wrap -> 'a attrib
(** Same, for a comma separated list of values *)
val comma_sep_attrib : string -> string list wrap -> 'a attrib
end
end
(** Equivalent to {!T}, but without wrapping. *)
module type NoWrap = T with module Xml.W = Xml_wrap.NoWrap
(** {2 Signature functors}
{% See <>. %} *)
(** Signature functor for {!Html_f.Make}. *)
module Make
(Xml : Xml_sigs.T)
(Svg : Svg_sigs.T with module Xml := Xml) :
sig
(** See {!module-type:Html_sigs.T}. *)
module type T = T
with type 'a Xml.W.t = 'a Xml.W.t
and type 'a Xml.W.tlist = 'a Xml.W.tlist
and type ('a,'b) Xml.W.ft = ('a,'b) Xml.W.ft
and type Xml.uri = Xml.uri
and type Xml.event_handler = Xml.event_handler
and type Xml.mouse_event_handler = Xml.mouse_event_handler
and type Xml.keyboard_event_handler = Xml.keyboard_event_handler
and type Xml.touch_event_handler = Xml.touch_event_handler
and type Xml.attrib = Xml.attrib
and type Xml.elt = Xml.elt
and module Svg := Svg
end
(** Wrapped functions, to be used with {!Html_f.Make_with_wrapped_functions}. *)
module type Wrapped_functions = sig
module Xml : Xml_sigs.T
val string_of_big_variant :
([< Html_types.big_variant], string) Xml.W.ft
val string_of_bool : (bool, string) Xml.W.ft
val onoff_of_bool : (bool, string) Xml.W.ft
val string_of_character : (Html_types.character, string) Xml.W.ft
val string_of_input_type :
([< Html_types.input_type], string) Xml.W.ft
val string_of_number_or_datetime :
([< Html_types.number_or_datetime], string) Xml.W.ft
val string_of_linktypes :
([< Html_types.linktype] list, string) Xml.W.ft
val string_of_mediadesc :
([< Html_types.mediadesc_token] list, string) Xml.W.ft
val string_of_referrerpolicy :
([< Html_types.referrerpolicy], string) Xml.W.ft
val string_of_numbers : (Html_types.numbers, string) Xml.W.ft
val string_of_sandbox :
([< Html_types.sandbox_token] list, string) Xml.W.ft
val string_of_sizes :
((Html_types.number * Html_types.number) list option, string) Xml.W.ft
type image_candidate =
[ `Url of Xml.uri
| `Url_width of Xml.uri * Html_types.number
| `Url_pixel of Xml.uri * Html_types.float_number ]
val string_of_srcset :
([< image_candidate] list, string) Xml.W.ft
val string_of_step : (float option, string) Xml.W.ft
val unoption_string : (string option, string) Xml.W.ft
end
tyxml-4.5.0/lib/html_types.mli 0000664 0000000 0000000 00000163262 14040247726 0016356 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2010 by Simon Castellan
* Copyright (C) 2010 by Cecile Herbelin
* Copyright (C) 2010 by Vincent Balat
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(* _fun prefix are the types that must be used
in Html_sigs. They are more restrictive as
some param are already taken as separate argument,
to ensure better compatibility.
SC *)
(** HTML types with variants, goes with {!Html_sigs.T}.
@see information concerning HTML at W3C.
*)
(** {1 Attribute types.} *)
type cdata = string
(** Character data *)
type id = string
(** A document-unique identifier *)
type idref = string
(** A reference to a document-unique identifier *)
type idrefs = idref list
(** A space-separated list of references to document-unique identifiers *)
type name = string
(** A name with the same character constraints as ID above *)
type nmtoken = string
(** A name composed of only name tokens as defined in XML 1.0
@see XML 1.0 *)
type nmtokens = nmtoken list
(** One or more white space separated NMTOKEN values *)
(** {2 Data Types} *)
type character = char
(** A single character from ISO 10646. *)
type charset = string
(** A character encoding, as per RFC2045 (MIME).
@see RFC2045 *)
type charsets = charset list
(** A space-separated list of character encodings, as per RFC2045 (MIME).
@see RFC2045 *)
type contenttype = string
(** A media type, as per RFC2045 (MIME).
@see RFC2045 *)
type contenttypes = contenttype list
(** A comma-separated list of media types, as per RFC2045 (MIME).
@see RFC2045 *)
type number = int
(* space-separated *)
type numbers = number list
type coords = string list
(** Comma- separated list of coordinates to use in defining areas. *)
type datetime = string
(** Date and time information. *)
type number_or_datetime = [ | `Number of number | `Datetime of datetime ]
(** Either a number or date and time information. *)
type fpi = string
(** A character string representing an SGML Formal Public Identifier. *)
type frametarget = string
(** Frame name used as destination for results of certain actions. *)
type languagecode = string
(** A language code, as per RFC5646/BCP47.
@see RFC5646 *)
type linktype =
[
| `Alternate
| `Archives
| `Author
| `Bookmark
| `Canonical
| `External
| `First
| `Help
| `Icon
| `Index
| `Last
| `License
| `Next
| `Nofollow
| `Noreferrer
| `Noopener
| `Pingback
| `Prefetch
| `Prev
| `Search
| `Stylesheet
| `Sidebar
| `Tag
| `Up
| `Other of string ] [@@reflect.total_variant]
type linktypes = linktype list
(** Authors may use the following recognized link types, listed here with
their conventional interpretations. A LinkTypes value refers to a
space-separated list of link types. White space characters are not
permitted within link types. These link types are case-insensitive, i.e.,
["Alternate"] has the same meaning as ["alternate"].
User agents, search engines, etc. may interpret these link types in a
variety of ways. For example, user agents may provide access to linked
documents through a navigation bar.
{ul
{- [`Alternate]:
Gives alternate representations of the current document.}
{- [`Archives]:
Provides a link to a collection of records, documents, or other materials of historical interest.}
{- [`Author]:
Gives a link to the current document's author.}
{- [`Bookmark]:
Gives the permalink for the nearest ancestor section.}
{- [`Canonical]:
Gives the preferred location for accessing the current document.}
{- [`External]:
Indicates that the referenced document is not part of the same site as the current document.}
{- [`First]:
Indicates that the current document is a part of a series, and that the first document in the series is the referenced document.}
{- [`Help]:
Provides a link to context-sensitive help.}
{- [`Icon]:
Imports an icon to represent the current document.}
{- [`Index]:
Gives a link to the document that provides a table of contents or index listing the current document.}
{- [`Last]:
Indicates that the current document is a part of a series, and that the last document in the series is the referenced document.}
{- [`Licence]:
Indicates that the main content of the current document is covered by the copyright license described by the referenced document.}
{- [`Next]:
Indicates that the current document is a part of a series, and that the next document in the series is the referenced document.}
{- [`Nofollow]:
Indicates that the current document's original author or publisher does not endorse the referenced document.}
{- [`Noreferrer]:
Requires that the user agent not send an HTTP Referer (sic) header if the user follows the hyperlink.}
{- [`Noopener]:
Instructs the browser to open the link without granting the new browsing context access to the document that opened it.}
{- [`Pingback]:
Gives the address of the pingback server that handles pingbacks to the current document.}
{- [`Prefetch]:
Specifies that the target resource should be preemptively cached.}
{- [`Prev]:
Indicates that the current document is a part of a series, and that the previous document in the series is the referenced document.}
{- [`Search]:
Gives a link to a resource that can be used to search through the current document and its related pages.}
{- [`Stylesheet]:
Imports a stylesheet.}
{- [`Sidebar]:
Specifies that the referenced document, if retrieved, is intended to be shown in the browser's sidebar (if it has one).}
{- [`Tag]:
Gives a tag (identified by the given address) that applies to the current document.}
{- [`Up]:
Provides a link to a document giving the context for the current document.}
} *)
type mediadesc_token =
[ `All
| `Aural
| `Braille
| `Embossed
| `Handheld
| `Print
| `Projection
| `Screen
| `Speech
| `Tty
| `Tv
| `Raw_mediadesc of string ] [@@reflect.total_variant]
type mediadesc = mediadesc_token list
(** The MediaDesc attribute is a comma-separated list of media descriptors.
The following is a list of recognized media descriptors:
{ul
{- [`Screen]:
For non-paged computer screens.}
{- [`TTY]:
For media using a fixed-pitch character grid (like teletypes, terminals, or devices with limited display capabilities).}
{- [`TV]:
For TV-type devices (low resolution, limited scrollability).}
{- [`Projection]:
For projectors.}
{- [`Handheld]:
For handheld devices (small screen, limited bandwidth).}
{- [`Print]:
For paged and for documents viewed on screen in print preview mode.}
{- [`Braille]:
For braille tactile feedback devices.}
{- [`Aural]:
For speech synthesizers.}
{- [`All]:
For speech synthesizers.}
{- [`Raw_mediadesc]:
For more complex (untyped) media descriptors.}}
*)
type float_number = float
type pixels = int
(** The value is an integer that represents the number of pixels of
the canvas (screen, paper). Thus, the value ["50"] means fifty
pixels. For normative information about the definition of a pixel,
please consult CSS2.
@see CSS2 *)
type script_ = string
(** Script data can be the content of the ["script"] element and the
value of intrinsic event attributes. User agents must not evaluate
script data as HTML markup but instead must pass it on as data to a
script engine.
The case-sensitivity of script data depends on the scripting
language.
Please note that script data that is element content may not
contain character references, but script data that is the value of
an attribute may contain them. *)
type text = string
(** Arbitrary textual data, likely meant to be human-readable. *)
(** {2 Core} *)
type i18n = [ | `XML_lang | `Lang ]
type core =
[
| `Accesskey
| `Class
| `Contenteditable
| `Contextmenu
| `Dir
| `Draggable
| `Hidden
| `Id
| i18n
| `Spellcheck
| `Style_Attr
| `Tabindex
| `Translate
| `Title
| `User_data
| `XMLns
]
(** {2 Events} *)
(** Javascript events *)
type events =
[
| `OnAbort
| `OnBlur
| `OnCanPlay
| `OnCanPlayThrough
| `OnChange
| `OnClick
| `OnContextMenu
| `OnDblClick
| `OnDrag
| `OnDragEnd
| `OnDragEnter
| `OnDragLeave
| `OnDragOver
| `OnDragStart
| `OnDrop
| `OnDurationChange
| `OnEmptied
| `OnEnded
| `OnError
| `OnFocus
| `OnFormChange
| `OnFormInput
| `OnInput
| `OnInvalid
| `OnMouseDown
| `OnMouseUp
| `OnMouseOver
| `OnMouseMove
| `OnMouseOut
| `OnMouseWheel
| `OnPause
| `OnPlay
| `OnPlaying
| `OnProgress
| `OnRateChange
| `OnReadyStateChange
| `OnScroll
| `OnSeeked
| `OnSeeking
| `OnSelect
| `OnShow
| `OnStalled
| `OnSubmit
| `OnSuspend
| `OnTimeUpdate
| `OnTouchStart
| `OnTouchEnd
| `OnTouchMove
| `OnTouchCancel
| `OnVolumeChange
| `OnWaiting
| `OnKeyPress
| `OnKeyDown
| `OnKeyUp
| `OnLoad
| `OnLoadedData
| `OnLoadedMetaData
| `OnLoadStart
]
(** {2 ARIA} *)
type aria =
[
| `Role
| `Aria
]
(** Common attributes *)
type common = [ | core | i18n | events | aria ]
(** {1 Categories of HTML elements}
These category are mainly subdivised in
- interactive,
- phrasing,
- flow5,
these categories may overlap *)
type heading = [ | `H1 | `H2 | `H3 | `H4 | `H5 | `H6 | `Hgroup ]
type sectioning = [ | `Section | `Nav | `Aside | `Article ]
type resetable = [ | `Textarea | `Select | `Output | `Keygen | `Input ]
type submitable = [ | `Textarea | `Select | `Keygen | `Input | `Button ]
type labelable = [ | resetable | `Progress | `Meter | `Button ]
type labelable_without_interactive = [ `Progress | `Meter]
type formatblock =
[
| heading
| sectioning
| `Pre
| `P
| `Header
| `Footer
| `Div
| `Blockquote
| `Address
]
type sectionningroot =
[ | `Td | `Figure | `Fieldset | `Details | `Body | `Blockquote
]
type listed = [ | resetable | submitable | `Fieldset ]
type formassociated = [ | listed | `Progress | `Meter | `Label ]
type subressource_integrity = [ | `Crossorigin | `Integrity ]
(** @see *)
(** Transparent elements.
Such elements have a part of they children in their data
and behaves like them. We could do something like [a: 'a elt list -> 'a elt]
but the information about the node name would be forgotten and would allow
things like that : [p [a [a []]]].
This system allow to build non-conforming terms such as [a [a []]] but when passed
to a standard element (such as [p]), it will yield an error.
Exception to that : if you embdedd the element in another transparent (of an
another kind) : [p [noscript (a [a []])]] will be correctly typed.
*)
type (+'interactive, +'noscript, +'regular, +'media) transparent =
[
| `A of 'interactive
| `Noscript of 'noscript
| `Canvas of 'regular
| `Map of 'regular
| `Ins of 'regular
| `Del of 'regular
| `Object of 'regular
| `Object_interactive of 'regular
| `Audio_interactive of 'media
| `Video_interactive of 'media
| `Audio of 'media
| `Video of 'media
]
(* _interactive variants are not used for now *)
type (+'noscript, +'regular, +'media) transparent_without_interactive =
[
| `Noscript of 'noscript
| `Ins of 'regular
| `Del of 'regular
| `Object of 'regular
| `Canvas of 'regular
| `Map of 'regular
| `Audio of 'media
| `Video of 'media
]
type (+'interactive, +'regular, +'media) transparent_without_noscript =
[
| `A of 'interactive
| `Ins of 'regular
| `Del of 'regular
| `Canvas of 'regular
| `Map of 'regular
| `Object of 'regular
| `Object_interactive of 'regular
| `Video of 'media
| `Audio of 'media
| `Video_interactive of 'media
| `Audio_interactive of 'media
]
type (+'interactive, +'noscript, +'regular) transparent_without_media =
[
| `A of 'interactive
| `Noscript of 'noscript
| `Ins of 'regular
| `Del of 'regular
| `Map of 'regular
| `Canvas of 'regular
| `Object of 'regular
| `Object_interactive of 'regular
]
(** Metadata without title *)
type metadata_without_title =
[
| `Template
| `Style
| `Script
| `Noscript of [ | `Meta | `Link | `Style ]
| `Meta
| `Link
| `Command
| `Base
]
(** Metadata contents. Used specially in *)
type metadata = [ | metadata_without_title | `Title ]
(** Interactive contents : contents that require user-interaction
(Forms, link, etc.) *)
(** Core element types are element types without transparent. *)
type core_interactive =
[
| `Textarea
| `Select
| `Menu
| `Label
| `Keygen
| `Input
| `Img_interactive
| `Iframe
| `Embed
| `Details
| `Button
]
type interactive =
[
core_interactive | (interactive, interactive, interactive) transparent_without_interactive
]
(** Phrasing contents is inline contents : bold text, span, and so on. *)
type core_phrasing =
[
| labelable
| submitable
| `Wbr
| `Var
| `U
| `Svg
| `Time
| `Template
| `Sup
| `Sub
| `Strong
| `Span
| `Small
| `Script
| `Samp
| `Ruby
| `Q
| `Mark
| `Label
| `Kbd
| `Iframe
| `I
| `Embed
| `Em
| `Dfn
| `Datalist
| `Command
| `Code
| `Cite
| `Br
| `Bdo
| `B
| `Abbr
| `Img | `Img_interactive
| `Picture
| `PCDATA
]
type core_phrasing_without_noscript =
[
| labelable
| submitable
| `Wbr
| `Var
| `U
| `Time
| `Template
| `Sup
| `Sub
| `Svg
| `Strong
| `Span
| `Small
| `Script
| `Samp
| `Ruby
| `Q
| `Mark
| `Label
| `Kbd
| `Iframe
| `I
| `Embed
| `Em
| `Dfn
| `Datalist
| `Command
| `Code
| `Cite
| `Br
| `Bdo
| `Img | `Img_interactive
| `Picture
| `B
| `Abbr
| `PCDATA
]
type core_phrasing_without_interactive =
[
| labelable_without_interactive
| `Wbr
| `Var
| `U
| `Time
| `Template
| `Sup
| `Sub
| `Strong
| `Span
| `Small
| `Script
| `Svg
| `Samp
| `Ruby
| `Q
| `Mark
| `Kbd
| `Img
| `Picture
| `I
| `Em
| `Dfn
| `Datalist
| `Command
| `Code
| `Cite
| `Br
| `Bdo
| `B
| `Abbr
| `PCDATA
]
type core_phrasing_without_media =
[
| labelable
| submitable
| `Wbr
| `Var
| `U
| `Time
| `Template
| `Svg
| `Sup
| `Sub
| `Strong
| `Span
| `Small
| `Script
| `Samp
| `Ruby
| `Q
| `Mark
| `Label
| `Kbd
| `Img | `Img_interactive
| `Picture
| `Iframe
| `I
| `Embed
| `Em
| `Dfn
| `Datalist
| `Command
| `Code
| `Cite
| `Br
| `Bdo
| `B
| `Abbr
| `PCDATA
]
type phrasing_without_noscript =
(phrasing_without_interactive,
phrasing,
phrasing_without_media) transparent_without_noscript
and phrasing_without_media =
[
| core_phrasing_without_media
| (phrasing_without_interactive, phrasing_without_noscript, phrasing)
transparent_without_media
]
and phrasing_without_interactive =
[
| core_phrasing_without_interactive
| (phrasing_without_noscript, phrasing, phrasing_without_media)
transparent_without_interactive
]
and phrasing =
[
| (phrasing_without_interactive, phrasing_without_noscript, phrasing,
phrasing_without_media) transparent
| core_phrasing
]
type (+'a, +'b) between_phrasing_and_phrasing_without_interactive =
( [< core_phrasing
| ([< phrasing_without_interactive] as 'b,
phrasing_without_noscript,
phrasing,
phrasing_without_media) transparent
> `Abbr `B `Bdo `Br `Canvas `Cite `Code `Command
`Datalist `Del `Dfn `Em `I `Img `Picture `Ins `Kbd `Map `Mark `Meter
`Noscript `Object `PCDATA `Progress `Q `Ruby `Samp `Script
`Small `Span `Strong `Sub `Sup `Svg `Template `Time `U `Var `Wbr ] as 'a)
(** Phrasing without the interactive markups *)
type phrasing_without_dfn =
[
| labelable
| submitable
| `Wbr
| `Var
| `U
| `Time
| `Template
| `Sup
| `Sub
| `Strong
| `Span
| `Small
| `Script
| `Samp
| `Ruby
| `Q
| `Mark
| `Label
| `Img | `Img_interactive
| `Picture
| `Kbd
| `I
| `Em
| `Datalist
| `Command
| `Code
| `Cite
| `Br
| `Bdo
| `B
| `Abbr
| `PCDATA
| (phrasing_without_interactive, phrasing_without_noscript,
phrasing_without_dfn, phrasing_without_media) transparent
]
type phrasing_without_label =
[
| labelable
| submitable
| `Wbr
| `Var
| `U
| `Time
| `Template
| `Sup
| `Sub
| `Strong
| `Span
| `Img | `Img_interactive
| `Picture
| `Small
| `Script
| `Samp
| `Ruby
| `Q
| `Mark
| `Kbd
| `I
| `Em
| `Dfn
| `Datalist
| `Command
| `Code
| `Cite
| `Br
| `Bdo
| `B
| `Abbr
| `PCDATA
| (phrasing_without_interactive, phrasing_without_noscript,
phrasing_without_label, phrasing_without_media) transparent
]
type phrasing_without_progress =
[
| resetable
| submitable
| `Wbr
| `Var
| `U
| `Time
| `Template
| `Sup
| `Sub
| `Strong
| `Span
| `Small
| `Script
| `Samp
| `Img | `Img_interactive
| `Picture
| `Ruby
| `Q
| `Meter
| `Mark
| `Label
| `Kbd
| `I
| `Em
| `Dfn
| `Datalist
| `Command
| `Code
| `Cite
| `Button
| `Br
| `Bdo
| `B
| `Abbr
| `PCDATA
| (phrasing_without_interactive, phrasing_without_noscript,
phrasing_without_progress, phrasing_without_media) transparent
]
type phrasing_without_time =
[
| labelable
| submitable
| `Wbr
| `Var
| `U
| `Template
| `Sup
| `Sub
| `Strong
| `Img | `Img_interactive
| `Picture
| `Span
| `Small
| `Script
| `Samp
| `Ruby
| `Q
| `Mark
| `Label
| `Kbd
| `I
| `Em
| `Dfn
| `Datalist
| `Command
| `Code
| `Cite
| `Br
| `Bdo
| `B
| `Abbr
| `PCDATA
| (phrasing_without_interactive, phrasing_without_noscript,
phrasing_without_time, phrasing_without_media) transparent
]
type phrasing_without_meter =
[
| submitable
| resetable
| `Progress
| `Button
| `Wbr
| `Var
| `U
| `Time
| `Template
| `Sup
| `Img | `Img_interactive
| `Picture
| `Sub
| `Strong
| `Span
| `Small
| `Script
| `Samp
| `Ruby
| `Q
| `Mark
| `Label
| `Kbd
| `I
| `Em
| `Dfn
| `Datalist
| `Command
| `Code
| `Cite
| `Br
| `Bdo
| `B
| `Abbr
| `PCDATA
| (phrasing_without_interactive, phrasing_without_noscript,
phrasing_without_meter, phrasing_without_media) transparent
]
type core_flow5 =
[
| core_phrasing
| formassociated
| formatblock
| `Ul
| `Table
| `Style
| `Ol
| `Menu
| `Hr
| `Form
| `Figure
| `Dl
| `Details
| `Main
]
type core_flow5_without_interactive =
[
| core_phrasing_without_interactive
| formassociated
| formatblock
| `Ul
| `Table
| `Style
| `Ol
| `Menu
| `Hr
| `Form
| `Figure
| `Dl
| `Main
]
type core_flow5_without_noscript =
[
| core_phrasing_without_noscript
| formassociated
| formatblock
| `Ul
| `Table
| `Style
| `Ol
| `Menu
| `Hr
| `Form
| `Figure
| `Dl
| `Details
| `Main
]
type core_flow5_without_media =
[
| core_phrasing_without_media
| formassociated
| formatblock
| `Ul
| `Table
| `Style
| `Ol
| `Menu
| `Hr
| `Form
| `Figure
| `Dl
| `Details
| `Main
]
type flow5_without_interactive =
[
core_flow5_without_interactive
| (flow5_without_noscript, flow5, flow5_without_media)
transparent_without_interactive
]
and flow5_without_noscript =
[ | core_flow5_without_noscript
| (flow5_without_interactive,
flow5,
flow5_without_media) transparent_without_noscript
]
and flow5_without_media =
[ core_flow5_without_media
| (flow5_without_interactive,
flow5_without_noscript,
flow5) transparent_without_media ]
and flow5 =
[
| core_flow5
| (flow5_without_interactive, flow5_without_noscript, flow5,
flow5_without_media) transparent
]
type flow5_without_table =
[
| core_phrasing
| formassociated
| formatblock
| `Ul
| `Style
| `Ol
| `Menu
| `Hr
| `Form
| `Figure
| `Dl
| `Details
| `Main
| (flow5_without_interactive, flow5_without_noscript, flow5,
flow5_without_media) transparent
]
type flow5_without_interactive_header_footer =
[
| heading
| sectioning
| `Pre
| `P
| `Div
| `Blockquote
| `Address
| core_phrasing_without_interactive
| formassociated
| `Ul
| `Table
| `Style
| `Ol
| `Menu
| `Hr
| `Form
| `Figure
| `Dl
| `Main
| (flow5_without_noscript, flow5, flow5_without_media)
transparent_without_interactive
]
type flow5_without_header_footer =
[
| heading
| sectioning
| `Pre
| `P
| `Div
| `Blockquote
| `Address
| core_phrasing
| formassociated
| `Ul
| `Table
| `Style
| `Ol
| `Menu
| `Hr
| `Form
| `Figure
| `Dl
| `Details
| `Main
| (flow5_without_interactive_header_footer,
flow5_without_noscript, flow5,
flow5_without_media) transparent
]
type +'a between_flow5_and_flow5_without_interactive_header_footer =
[< flow5 > `Abbr `Address `Article `Aside `Audio `B `Bdo `Blockquote `Br
`Button `Canvas `Cite `Code `Command `Datalist `Del `Dfn `Div `Dl `Em
`Fieldset `Figure `Form `H1 `H2 `H3 `H4 `H5 `H6 `Hgroup `Hr `I `Img `Picture
`Input `Ins `Kbd `Keygen `Label `Map`Mark `Menu `Meter `Nav `Noscript
`Object `Ol `Output `P `PCDATA `Pre `Progress `Q `Ruby `Samp `Script
`Section `Select `Small `Span `Strong `Style `Sub `Sup `Svg `Table
`Template `Textarea `Time `U `Ul `Var `Video `Wbr] as 'a
type (+'a, +'b) between_flow5_and_flow5_without_header_footer =
[< core_flow5
| ([< flow5_without_interactive ] as 'b,
flow5_without_noscript, 'a,
flow5_without_media)
transparent
> `A `Abbr `Address `Article `Aside `Audio `Audio_interactive `B
`Bdo `Blockquote `Br `Button `Canvas `Cite `Code `Command
`Datalist `Del `Details `Dfn `Div `Dl `Em `Embed `Fieldset
`Figure `Form `H1 `H2 `H3 `H4 `H5 `H6 `Hgroup `Hr `I `Iframe
`Img `Img_interactive `Picture `Input `Ins `Kbd `Keygen `Label `Map
`Mark `Menu `Meter `Nav `Noscript `Object `Object_interactive
`Ol `Output `P `PCDATA `Pre `Progress `Q `Ruby `Samp `Script
`Section `Select `Small `Span `Strong `Style `Sub `Sup `Svg
`Table `Template `Textarea `Time `U `Ul `Var `Video `Video_interactive
`Wbr ] as 'a
type flow5_without_form =
[
| core_phrasing
| formassociated
| formatblock
| `Ul
| `Table
| `Style
| `Ol
| `Menu
| `Hr
| `Figure
| `Dl
| `Details
| `Main
| (flow5_without_interactive, flow5_without_noscript, flow5,
flow5_without_media) transparent
]
type flow5_without_sectioning_heading_header_footer_address =
[
| core_phrasing
| formassociated
| `Pre
| `P
| `Div
| `Blockquote
| `Ul
| `Table
| `Style
| `Ol
| `Menu
| `Hr
| `Form
| `Figure
| `Dl
| `Details
| `Main
| (flow5_without_interactive, flow5_without_noscript, flow5,
flow5_without_media) transparent
]
type flow5_without_sectioning_heading_header_footer =
[
| flow5_without_sectioning_heading_header_footer_address
| `Address
]
(*
Type for HTML for elements
*)
type pcdata = [ | `PCDATA ]
type txt = [ | `PCDATA ]
type notag
type no_attribute_allowed
type noattrib = [ `No_attribute_allowed of no_attribute_allowed ]
type html = [ | `Html ]
type html_content_fun = [ | `Head | `Body ]
type html_content = html_content_fun
type html_attrib = [ | common | `Manifest ]
type head = [ | `Head ]
type head_content = [ | metadata ]
type head_content_fun = [ | metadata_without_title ]
type head_attrib = [ | common ]
type body = [ | `Body ]
type body_attrib =
[
| common
| `OnAfterPrint
| `OnBeforePrint
| `OneBeforeUnload
| `OnHashChange
| `OnMessage
| `OnOffLine
| `OnOnLine
| `OnPageHide
| `OnPageShow
| `OnPopState
| `OnRedo
| `OnResize
| `OnStorage
| `OnUndo
| `OnUnload
]
type body_content = flow5
type body_content_fun = flow5
type svg = [ `Svg ]
type svg_content = Svg_types.svg_content
type svg_attrib = Svg_types.svg_attr
(* NAME: base, KIND: nullary, TYPE: [= common | `Href | `Target], [= `Base ], ARG: notag, ATTRIB: OUT: [= `Base ] *)
type base = [ | `Base ]
type base_content = notag
type base_content_fun = notag
type base_attrib = [ | common | `Href | `Target ]
type title = [ | `Title ]
type title_content = [ | `PCDATA ]
type title_content_fun = [ | `PCDATA ]
type title_attrib = noattrib
(* NAME: footer, KIND: star, TYPE: [= common ], [= flow5_without_header_footer ], [=`Footer], ARG: [= flow5_without_header_footer ], ATTRIB: OUT: [=`Footer] *)
type footer = [ | `Footer ]
type footer_content = [ | flow5_without_header_footer ]
type footer_content_fun = [ | flow5_without_header_footer ]
type footer_attrib = [ | common ]
(* NAME: header, KIND: star, TYPE: [= common ], [= flow5_without_header_footer ], [=`Header], ARG: [= flow5_without_header_footer ], ATTRIB: OUT: [=`Header] *)
type header = [ | `Header ]
type header_content = [ | flow5_without_header_footer ]
type header_content_fun = [ | flow5_without_header_footer ]
type header_attrib = [ | common ]
(* NAME: section, KIND: star, TYPE: [= common ], [= flow5 ], [=`Section], ARG: [= flow5 ], ATTRIB: OUT: [=`Section] *)
type section = [ | `Section ]
type section_content = [ | flow5 ]
type section_content_fun = [ | flow5 ]
type section_attrib = [ | common ]
(* NAME: nav, KIND: star, TYPE: [= common ], [= flow5 ], [=`Nav], ARG: [= flow5 ], ATTRIB: OUT: [=`Nav] *)
type nav = [ | `Nav ]
type nav_content = [ | flow5 ]
type nav_content_fun = [ | flow5 ]
type nav_attrib = [ | common ]
(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H1], ARG: [= phrasing ], ATTRIB: OUT: [=`H1] *)
type h1 = [ | `H1 ]
type h1_content = [ | phrasing ]
type h1_content_fun = [ | phrasing ]
type h1_attrib = [ | common ]
(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H2], ARG: [= phrasing ], ATTRIB: OUT: [=`H2] *)
type h2 = [ | `H2 ]
type h2_content = [ | phrasing ]
type h2_content_fun = [ | phrasing ]
type h2_attrib = [ | common ]
(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H3], ARG: [= phrasing ], ATTRIB: OUT: [=`H3] *)
type h3 = [ | `H3 ]
type h3_content = [ | phrasing ]
type h3_content_fun = [ | phrasing ]
type h3_attrib = [ | common ]
(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H4], ARG: [= phrasing ], ATTRIB: OUT: [=`H4] *)
type h4 = [ | `H4 ]
type h4_content = [ | phrasing ]
type h4_content_fun = [ | phrasing ]
type h4_attrib = [ | common ]
(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H5], ARG: [= phrasing ], ATTRIB: OUT: [=`H5] *)
type h5 = [ | `H5 ]
type h5_content = [ | phrasing ]
type h5_content_fun = [ | phrasing ]
type h5_attrib = [ | common ]
(* NAME: h, KIND: star, TYPE: [= common ], [= phrasing ], [=`H6], ARG: [= phrasing ], ATTRIB: OUT: [=`H6] *)
type h6 = [ | `H6 ]
type h6_content = [ | phrasing ]
type h6_content_fun = [ | phrasing ]
type h6_attrib = [ | common ]
(* NAME: hgroup, KIND: plus, TYPE: [= common ], [= `H1 | `H2 | `H3 | `H4 | `H5 | `H6 ], [=`Hgroup], ARG: [= `H1 | `H2 | `H3 | `H4 | `H5 | `H6 ], ATTRIB: OUT: [=`Hgroup] *)
type hgroup = [ | `Hgroup ]
type hgroup_content = [ | `H1 | `H2 | `H3 | `H4 | `H5 | `H6 ]
type hgroup_content_fun = [ | `H1 | `H2 | `H3 | `H4 | `H5 | `H6 ]
type hgroup_attrib = [ | common ]
(* NAME: address, KIND: star, TYPE: [= common ], [= flow5_without_sectioning_heading_header_footer_address ], [=`Address], ARG: [= flow5_without_sectioning_heading_header_footer_address ], ATTRIB: OUT: [=`Address] *)
type address = [ | `Address ]
type address_content =
[ | flow5_without_sectioning_heading_header_footer_address
]
type address_content_fun =
[ | flow5_without_sectioning_heading_header_footer_address
]
type address_attrib = [ | common ]
(* NAME: article, KIND: star, TYPE: [= common ], [= flow5 ], [=`Article], ARG: [= flow5 ], ATTRIB: OUT: [=`Article] *)
type article = [ | `Article ]
type article_content = [ | flow5 ]
type article_content_fun = [ | flow5 ]
type article_attrib = [ | common ]
(* NAME: aside, KIND: star, TYPE: [= common ], [= flow5 ], [=`Aside], ARG: [= flow5 ], ATTRIB: OUT: [=`Aside] *)
type aside = [ | `Aside ]
type aside_content = [ | flow5 ]
type aside_content_fun = [ | flow5 ]
type aside_attrib = [ | common ]
(* NAME: main, KIND: star, TYPE: [= common ], [= flow5 ], [=`Main], ARG: [= flow5 ], ATTRIB: OUT: [=`Main] *)
type main = [ | `Main ]
type main_content = [ | flow5 ]
type main_content_fun = [ | flow5 ]
type main_attrib = [ | common ]
(* NAME: p, KIND: star, TYPE: [= common ], [=phrasing ], [=`P], ARG: [=phrasing ], ATTRIB: OUT: [=`P] *)
type p = [ | `P ]
type p_content = [ | phrasing ]
type p_content_fun = [ | phrasing ]
type p_attrib = [ | common ]
(* NAME: pre, KIND: star, TYPE: [= common ],[= phrasing ], [=`Pre], ARG: [= phrasing ], ATTRIB: OUT: [=`Pre] *)
type pre = [ | `Pre ]
type pre_content = [ | phrasing ]
type pre_content_fun = [ | phrasing ]
type pre_attrib = [ | common ]
(* NAME: blockquote, KIND: star, TYPE: [= common | `Cite ],[= flow5 ], [=`Blockquote], ARG: [= flow5 ], ATTRIB: OUT: [=`Blockquote] *)
type blockquote = [ | `Blockquote ]
type blockquote_content = [ | flow5 ]
type blockquote_content_fun = [ | flow5 ]
type blockquote_attrib = [ | common | `Cite ]
(* NAME: div, KIND: star, TYPE: [= common ], [= flow5 ], [=`Div], ARG: [= flow5 ], ATTRIB: OUT: [=`Div] *)
type div = [ | `Div ]
type div_content = [ | flow5 ]
type div_content_fun = [ | flow5 ]
type div_attrib = [ | common ]
(* NAME: ol, KIND: star, TYPE: [= common | `Reserved |`Start ], [= `Li of [= common | `Int_Value ]], [=`Ol], ARG: [= `Li of [= common | `Int_Value ]], ATTRIB: OUT: [=`Ol] *)
type ol = [ | `Ol ]
type ol_content = [ | `Li of [ | common | `Int_Value ] ]
type ol_content_fun = [ | `Li of [ | common | `Int_Value ] ]
type ol_attrib = [ | common | `Reversed | `Start ]
(* NAME: li, KIND: star, TYPE: [= common | `Int_Value] as 'a, [=flow5 ], [=`Li of 'a], ARG: [=flow5 ], ATTRIB: OUT: [=`Li of 'a] *)
type li_content = [ | flow5 ]
type li_content_fun = [ | flow5 ]
type li_attrib = [ | common | `Int_Value ]
type li = [ | `Li of li_attrib ]
(* NAME: ul, KIND: star, TYPE: [= common ], [= `Li of [= common] ], [=`Ul], ARG: [= `Li of [= common] ], ATTRIB: OUT: [=`Ul] *)
type ul = [ | `Ul ]
type ul_content = [ | `Li of [ | li_attrib ] ]
type ul_content_fun = [ | `Li of [ | li_attrib ] ]
type ul_attrib = [ | common ]
(* NAME: dd, KIND: star, TYPE: [= common ], [= flow5 ], [=`Dd], ARG: [= flow5 ], ATTRIB: OUT: [=`Dd] *)
type dd = [ | `Dd ]
type dd_content = [ | flow5 ]
type dd_content_fun = [ | flow5 ]
type dd_attrib = [ | common ]
(* NAME: dt, KIND: star, TYPE: [= common ], [= phrasing], [=`Dt], ARG: [= phrasing], ATTRIB: OUT: [=`Dt] *)
type dt = [ | `Dt ]
type dt_content = [ | flow5_without_sectioning_heading_header_footer ]
type dt_content_fun = [ | flow5_without_sectioning_heading_header_footer ]
type dt_attrib = [ | common ]
type dl = [ | `Dl ]
type dl_content = [ | `Dt | `Dd ]
type dl_content_fun = [ | `Dt | `Dd ]
type dl_attrib = [ | common ]
(* NAME: figcaption, KIND: star, TYPE: [= common ], [= flow5], [=`Figcaption], ARG: [= flow5], ATTRIB: OUT: [=`Figcaption] *)
type figcaption = [ | `Figcaption ]
type figcaption_content = [ | flow5 ]
type figcaption_content_fun = [ | flow5 ]
type figcaption_attrib = [ | common ]
(* figure *)
type figure = [ | `Figure ]
type figure_content = [ | flow5 ]
type figure_content_fun = [ | flow5 ]
type figure_attrib = [ | common ]
(* Rp, Rt and ruby *)
type rp = [ | `Rp ]
type rp_content = [ | phrasing ]
type rp_content_fun = [ | phrasing ]
type rp_attrib = [ | common ]
type rt = [ | `Rt ]
type rt_content = [ | phrasing ]
type rt_content_fun = [ | phrasing ]
type rt_attrib = [ | common ]
type ruby = [ | `Ruby ]
type ruby_content = [ | phrasing | rp | rt ]
type ruby_content_fun = [ | phrasing | rp | rt ]
type ruby_attrib = [ | common ]
(* NAME: hr, KIND: nullary, TYPE: [= common ], [=`Hr], ARG: notag, ATTRIB: OUT: [=`Hr] *)
type hr = [ | `Hr ]
type hr_content = notag
type hr_content_fun = notag
type hr_attrib = [ | common ]
(* NAME: b, KIND: star, TYPE: [= common ], [= phrasing ], [=`B], ARG: [= phrasing ], ATTRIB: OUT: [=`B] *)
type b = [ | `B ]
type b_content = [ | phrasing ]
type b_content_fun = [ | phrasing ]
type b_attrib = [ | common ]
(* NAME: i, KIND: star, TYPE: [= common ], [= phrasing ], [=`I], ARG: [= phrasing ], ATTRIB: OUT: [=`I] *)
type i = [ | `I ]
type i_content = [ | phrasing ]
type i_content_fun = [ | phrasing ]
type i_attrib = [ | common ]
(* NAME: u, KIND: star, TYPE: [= common ], [= phrasing ], [=`U], ARG: [= phrasing ], ATTRIB: OUT: [=`U] *)
type u = [ | `U ]
type u_content = [ | phrasing ]
type u_content_fun = [ | phrasing ]
type u_attrib = [ | common ]
(* NAME: small, KIND: star, TYPE: [= common ], [= phrasing ], [=`Small], ARG: [= phrasing ], ATTRIB: OUT: [=`Small] *)
type small = [ | `Small ]
type small_content = [ | phrasing ]
type small_content_fun = [ | phrasing ]
type small_attrib = [ | common ]
(* NAME: sub, KIND: star, TYPE: [= common ], [= phrasing ], [=`Sub], ARG: [= phrasing ], ATTRIB: OUT: [=`Sub] *)
type sub = [ | `Sub ]
type sub_content = [ | phrasing ]
type sub_content_fun = [ | phrasing ]
type sub_attrib = [ | common ]
(* NAME: sup, KIND: star, TYPE: [= common ], [= phrasing ], [=`Sup], ARG: [= phrasing ], ATTRIB: OUT: [=`Sup] *)
type sup = [ | `Sup ]
type sup_content = [ | phrasing ]
type sup_content_fun = [ | phrasing ]
type sup_attrib = [ | common ]
(* NAME: mark, KIND: star, TYPE: [= common ],[= phrasing ],[= `Mark ], ARG: [= phrasing ], ATTRIB: OUT: [= `Mark ] *)
type mark = [ | `Mark ]
type mark_content = [ | phrasing ]
type mark_content_fun = [ | phrasing ]
type mark_attrib = [ | common ]
(* NAME: wbr, KIND: nullary, TYPE: [= common ],[= `Wbr ], ARG: notag, ATTRIB: OUT: [= `Wbr ] *)
type wbr = [ | `Wbr ]
type wbr_content = notag
type wbr_content_fun = notag
type wbr_attrib = [ | common ]
(* NAME: bdo, KIND: star, TYPE: [= common ],[= phrasing ],[= `Bdo ], ARG: [= phrasing ], ATTRIB: OUT: [= `Bdo ] *)
type bdo = [ | `Bdo ]
type bdo_content = [ | phrasing ]
type bdo_content_fun = [ | phrasing ]
type bdo_attrib = [ | common ]
(* NAME: abbr, KIND: star, TYPE: [= common ], [=phrasing ], [=`Abbr], ARG: [=phrasing ], ATTRIB: OUT: [=`Abbr] *)
type abbr = [ | `Abbr ]
type abbr_content = [ | phrasing ]
type abbr_content_fun = [ | phrasing ]
type abbr_attrib = [ | common ]
(* NAME: br, KIND: nullary, TYPE: [= common ], [=`Br], ARG: notag, ATTRIB: OUT: [=`Br] *)
type br = [ | `Br ]
type br_content = notag
type br_content_fun = notag
type br_attrib = [ | common ]
(* NAME: cite, KIND: star, TYPE: [= common ], [= phrasing ], [=`Cite], ARG: [= phrasing ], ATTRIB: OUT: [=`Cite] *)
type cite = [ | `Cite ]
type cite_content = [ | phrasing ]
type cite_content_fun = [ | phrasing ]
type cite_attrib = [ | common ]
(* NAME: code, KIND: star, TYPE: [= common ], [= phrasing ], [=`Code], ARG: [= phrasing ], ATTRIB: OUT: [=`Code] *)
type code = [ | `Code ]
type code_content = [ | phrasing ]
type code_content_fun = [ | phrasing ]
type code_attrib = [ | common ]
(* NAME: dfn, KIND: star, TYPE: [= common ], [= phrasing_without_dfn ], [=`Dfn], ARG: [= phrasing_without_dfn ], ATTRIB: OUT: [=`Dfn] *)
type dfn = [ | `Dfn ]
type dfn_content = [ | phrasing_without_dfn ]
type dfn_content_fun = [ | phrasing_without_dfn ]
type dfn_attrib = [ | common ]
(* NAME: em, KIND: star, TYPE: [= common ], [= phrasing ], [=`Em], ARG: [= phrasing ], ATTRIB: OUT: [=`Em] *)
type em = [ | `Em ]
type em_content = [ | phrasing ]
type em_content_fun = [ | phrasing ]
type em_attrib = [ | common ]
(* NAME: kbd, KIND: star, TYPE: [= common ], [= phrasing ], [=`Kbd], ARG: [= phrasing ], ATTRIB: OUT: [=`Kbd] *)
type kbd = [ | `Kbd ]
type kbd_content = [ | phrasing ]
type kbd_content_fun = [ | phrasing ]
type kbd_attrib = [ | common ]
(* NAME: q, KIND: star, TYPE: [= common | `Cite ], [= phrasing ], [=`Q], ARG: [= phrasing ], ATTRIB: OUT: [=`Q] *)
type q = [ | `Q ]
type q_content = [ | phrasing ]
type q_content_fun = [ | phrasing ]
type q_attrib = [ | common | `Cite ]
(* NAME: samp, KIND: star, TYPE: [= common ], [= phrasing ], [=`Samp], ARG: [= phrasing ], ATTRIB: OUT: [=`Samp] *)
type samp = [ | `Samp ]
type samp_content = [ | phrasing ]
type samp_content_fun = [ | phrasing ]
type samp_attrib = [ | common ]
(* NAME: span, KIND: star, TYPE: [= common ], [= phrasing ], [=`Span], ARG: [= phrasing ], ATTRIB: OUT: [=`Span] *)
type span = [ | `Span ]
type span_content = [ | phrasing ]
type span_content_fun = [ | phrasing ]
type span_attrib = [ | common ]
(* NAME: strong, KIND: star, TYPE: [= common ], [= phrasing ], [=`Strong], ARG: [= phrasing ], ATTRIB: OUT: [=`Strong] *)
type strong = [ | `Strong ]
type strong_content = [ | phrasing ]
type strong_content_fun = [ | phrasing ]
type strong_attrib = [ | common ]
(* NAME: time, KIND: star, TYPE: [= common |`Datetime |`Pubdate], [= phrasing_without_time ], [=`Time], ARG: [= phrasing_without_time ], ATTRIB: OUT: [=`Time] *)
type time = [ | `Time ]
type time_content = [ | phrasing_without_time ]
type time_content_fun = [ | phrasing_without_time ]
type time_attrib = [ | common | `Datetime | `Pubdate ]
(* NAME: var, KIND: star, TYPE: [= common ], [= phrasing ], [=`Var], ARG: [= phrasing ], ATTRIB: OUT: [=`Var] *)
type var = [ | `Var ]
type var_content = [ | phrasing ]
type var_content_fun = [ | phrasing ]
type var_attrib = [ | common ]
(* NAME: a, KIND: star, TYPE: [= common | `Href | `Hreflang | `Media | `Rel | `Target | `Mime_type ], 'a, [= `A of 'a ], ARG: 'a, ATTRIB: OUT: [= `A of 'a ] *)
type a_content = flow5_without_interactive
type a_content_fun = flow5_without_interactive
type 'a a = [ | `A of 'a ]
type a_ = [ `A of a_content ] (* should not be used as it may break *)
type a_attrib =
[ | common | `Href | `Hreflang | `Media | `Rel | `Target | `Mime_type
| `Download
]
(* NAME: del, KIND: star, TYPE: [= common | `Cite | `Datetime ], 'a,[=`Del of 'a], ARG: 'a, ATTRIB: OUT: [=`Del of 'a] *)
type 'a del = [ | `Del of 'a ]
type del_content = flow5
type del_ = del_content del
type del_content_fun = flow5
type del_attrib = [ | common | `Cite | `Datetime ]
(* NAME: ins, KIND: star, TYPE: [= common | `Cite | `Datetime ],'a ,[=`Ins of 'a], ARG: 'a , ATTRIB: OUT: [=`Ins of 'a] *)
type 'a ins = [ | `Ins of 'a ]
type ins_content = flow5
type ins_ = ins_content ins
type ins_content_fun = flow5
type ins_attrib = [ | common | `Cite | `Datetime ]
(* NAME: iframe, KIND: ndbox, TYPE: *| `Srcdoc*, ARG: , ATTRIB: OUT: *)
type iframe = [ | `Iframe ]
type iframe_content = [ | `PCDATA ]
type iframe_content_fun = [ | `PCDATA ]
type iframe_attrib =
[
| common
| `Allowfullscreen
| `Allowpaymentrequest
| `Src
| (*| `Srcdoc*)
`Name
| `Sandbox
| `Seamless
| `Width
| `Height
| `Referrerpolicy
]
type object__content = [ | flow5 | `Param ]
type object__content_fun = flow5
type 'a object_ = [ | `Object of 'a | `Object_interactive of 'a]
type object__ = object__content object_
type object__attrib =
[
| common
| `Data
| `Form
| `Mime_type
| `Height
| `Width
| `Name
| `Usemap
]
(* NAME: param, KIND: nullary, TYPE: [= common | `Name | `Text_Value ],[= `Param ], ARG: notag, ATTRIB: OUT: [= `Param ] *)
type param = [ | `Param ]
type param_content = notag
type param_content_fun = notag
type param_attrib = [ | common | `Name | `Text_Value ]
(* NAME: embed, KIND: nullary, TYPE: [= common | `Src | `Height | `Mime_type | `Width], [=`Embed], ARG: notag, ATTRIB: OUT: [=`Embed] *)
type embed = [ | `Embed ]
type embed_content = notag
type embed_content_fun = notag
type embed_attrib = [ | common | `Src | `Height | `Mime_type | `Width ]
type img = [ `Img ]
type img_interactive = [ `Img | `Img_interactive ]
type img_content = notag
type img_content_fun = notag
type img_attrib = [ | common | `Height | `Ismap | `Width | `Srcset | `Img_sizes]
(* Attributes used by audio and video. *)
type media_attrib =
[ | `Crossorigin
| `Preload
| `Autoplay
| `Mediagroup
| `Loop
| `Muted
| `Controls
]
type 'a audio = [ | `Audio of 'a ]
type 'a audio_interactive = [ | `Audio of 'a | `Audio_interactive of 'a ]
type audio_content = flow5_without_media
type audio_ = audio_content audio
type audio_content_fun = flow5_without_media
type audio_attrib =
[ | common
| media_attrib
]
type 'a video = [ | `Video of 'a ]
type 'a video_interactive = [ | `Video of 'a | `Video_interactive of 'a ]
type video_content = flow5_without_media
type video_ = video_content video
type video_content_fun = flow5_without_media
type video_attrib =
[ | common
| media_attrib
| `Poster
| `Width
| `Height
]
(* NAME: canvas, KIND: star, TYPE: [= common |`Width |`Height],'a, [=`Canvas of 'a], ARG: 'a, ATTRIB: OUT: [=`Canvas of 'a] *)
type 'a canvas = [ | `Canvas of 'a ]
type canvas_content = flow5
type canvas_ = canvas_content canvas
type canvas_content_fun = flow5
type canvas_attrib = [ | common | `Width | `Height ]
(* NAME: source, KIND: nullary, TYPE: [= common |`Src |`Mime_type |`Media ], [=`Source], ARG: notag, ATTRIB: OUT: [=`Source] *)
type source = [ | `Source ]
type source_content = notag
type source_content_fun = notag
type source_attrib = [ | common | `Src | `Mime_type | `Media ]
(* NAME: area, KIND: nullary, TYPE: [= common | `Alt | `Coords | `Shape| `Target | `Rel | `Media| `Hreflang | `Mime_type],[=`Area], ARG: notag, ATTRIB: OUT: [=`Area] *)
type area = [ | `Area ]
type area_content = notag
type area_content_fun = notag
type area_attrib =
[
| common
| `Alt
| `Coords
| `Shape
| `Target
| `Rel
| `Media
| `Hreflang
| `Mime_type
| `Download
]
(* NAME: map, KIND: plus, TYPE: [=common | `Name ],'a, [=`Map of 'a], ARG: 'a, ATTRIB: OUT: [=`Map of 'a] *)
type 'a map = [ | `Map of 'a ]
type map_content = flow5
type map_ = map_content map
type map_content_fun = flow5
type map_attrib = [ | common | `Name ]
(* NAME: caption, KIND: star, TYPE: [= common ], [= flow5_without_table], [=`Caption], ARG: [= flow5_without_table], ATTRIB: OUT: [=`Caption] *)
type caption = [ | `Caption ]
type caption_content = [ | flow5_without_table ]
type caption_content_fun = [ | flow5_without_table ]
type caption_attrib = [ | common ]
(* NAME: table, KIND: plus, TYPE: [= common | `Summary ], [= `Tr ], [=`Table], ARG: [= `Tr ], ATTRIB: OUT: [=`Table] *)
type table = [ | `Table ]
type table_content = [ | `Tr ]
type table_content_fun = [ | `Tr ]
type table_attrib = [ | common | `Summary ]
(* NAME: tablex, KIND: star, TYPE: [= common | `Summary ], [= `Tbody ], [=`Table], ARG: [= `Tbody ], ATTRIB: OUT: [=`Table] *)
type tablex = [ | `Table ]
type tablex_content = [ | `Tbody ]
type tablex_content_fun = [ | `Tbody ]
type tablex_attrib = [ | common | `Summary ]
(* NAME: colgroup, KIND: star, TYPE: [= common | `Span ],[= `Col ], [=`Colgroup], ARG: [= `Col ], ATTRIB: OUT: [=`Colgroup] *)
type colgroup = [ | `Colgroup ]
type colgroup_content = [ | `Col ]
type colgroup_content_fun = [ | `Col ]
type colgroup_attrib = [ | common | `Span ]
(* NAME: col, KIND: nullary, TYPE: [= common | `Span], [=`Col], ARG: notag, ATTRIB: OUT: [=`Col] *)
type col = [ | `Col ]
type col_content = notag
type col_content_fun = notag
type col_attrib = [ | common | `Span ]
(* NAME: thead, KIND: star, TYPE: [= common],[= `Tr ], [=`Thead], ARG: [= `Tr ], ATTRIB: OUT: [=`Thead] *)
type thead = [ | `Thead ]
type thead_content = [ | `Tr ]
type thead_content_fun = [ | `Tr ]
type thead_attrib = [ | common ]
(* NAME: tbody, KIND: star, TYPE: [= common],[= `Tr ], [=`Tbody], ARG: [= `Tr ], ATTRIB: OUT: [=`Tbody] *)
type tbody = [ | `Tbody ]
type tbody_content = [ | `Tr ]
type tbody_content_fun = [ | `Tr ]
type tbody_attrib = [ | common ]
(* NAME: tfoot, KIND: star, TYPE: [= common],[= `Tr ], [=`Tfoot], ARG: [= `Tr ], ATTRIB: OUT: [=`Tfoot] *)
type tfoot = [ | `Tfoot ]
type tfoot_content = [ | `Tr ]
type tfoot_content_fun = [ | `Tr ]
type tfoot_attrib = [ | common ]
(* NAME: td, KIND: star, TYPE: [= common | `Colspan | `Headers | `Rowspan ], [= flow5 ], [=`Td], ARG: [= flow5 ], ATTRIB: OUT: [=`Td] *)
type td = [ | `Td ]
type td_content = [ | flow5 ]
type td_content_fun = [ | flow5 ]
type td_attrib = [ | common | `Colspan | `Headers | `Rowspan ]
(* NAME: th, KIND: star, TYPE: [= common | `Colspan | `Headers | `Rowspan | `Scope], [= flow5], [=`Th], ARG: [= flow5], ATTRIB: OUT: [=`Th] *)
type th = [ | `Th ]
type th_content = [ | flow5 ]
type th_content_fun = [ | flow5 ]
type th_attrib = [ | common | `Colspan | `Headers | `Rowspan | `Scope ]
(* NAME: tr, KIND: star, TYPE: [= common ],[= `Td | `Th ], [=`Tr], ARG: [= `Td | `Th ], ATTRIB: OUT: [=`Tr] *)
type tr = [ | `Tr ]
type tr_content = [ | `Td | `Th ]
type tr_content_fun = [ | `Td | `Th ]
type tr_attrib = [ | common ]
(* NAME: form, KIND: plus, TYPE: [= common |`Accept_charset | `Action | `Enctype | `Method | `Name | `Target | `Autocomplete | `Novalidate ], [= flow5_without_form ], [=`Form], ARG: [= flow5_without_form ], ATTRIB: OUT: [=`Form] *)
type form = [ | `Form ]
type form_content = [ | flow5_without_form ]
type form_content_fun = [ | flow5_without_form ]
type form_attrib =
[
| common
| `Accept_charset
| `Action
| `Enctype
| `Method
| `Name
| `Target
| `Autocomplete
| `Novalidate
]
(* NAME: fieldset, KIND: star, TYPE: [= common | `Disabled | `Form | `Name], [= flow5 ], [=`Fieldset], ARG: [= flow5 ], ATTRIB: OUT: [=`Fieldset] *)
type fieldset = [ | `Fieldset ]
type fieldset_content = [ | flow5 ]
type fieldset_content_fun = [ | flow5 ]
type fieldset_attrib = [ | common | `Disabled | `Form | `Name ]
(* NAME: legend, KIND: star, TYPE: [= common ],[= phrasing], [=`Legend], ARG: [= phrasing], ATTRIB: OUT: [=`Legend] *)
type legend = [ | `Legend ]
type legend_content = [ | phrasing ]
type legend_content_fun = [ | phrasing ]
type legend_attrib = [ | common ]
(* NAME: label, KIND: star, TYPE: [= common | `Label_for | `Form ],[= phrasing_without_label], [=`Label], ARG: [= phrasing_without_label], ATTRIB: OUT: [=`Label] *)
type label = [ | `Label ]
type label_content = [ | phrasing_without_label ]
type label_content_fun = [ | phrasing_without_label ]
type label_attrib = [ | common | `Label_for | `Form ]
(* NAME: input, KIND: nullary, TYPE: [= input_attr ], [=`Input], ARG: notag, ATTRIB: OUT: [=`Input] *)
type input = [ | `Input ]
type input_content = notag
type input_content_fun = notag
type input_attrib =
[
| common
| `Accept
| `Alt
| `Autocomplete
| `Autofocus
| `Checked
| `Disabled
| `Form
| `Formation
| `Formenctype
| `Method
| `Formnovalidate
| `Formtarget
| `Height
| `List
| `Input_Max
| `Maxlength
| `Minlength
| `Input_Min
| `Multiple
| `Name
| `Pattern
| `Placeholder
| `ReadOnly
| `Required
| `Size
| `Src
| `Step
| `Input_Type
| `Value
| `Width
| `Inputmode
]
type textarea = [ | `Textarea ]
type textarea_attrib =
[
| common
| `Autofocus
| `Disabled
| `Form
| `Maxlength
| `Minlength
| `Name
| `Placeholder
| `ReadOnly
| `Required
| `Wrap
| `Rows
| `Cols
]
type textarea_content = [ | `PCDATA ]
type textarea_content_fun = textarea_content
(* NAME: button, KIND: star, TYPE: [= button_attr ], [= phrasing_without_interactive ], [=`Button], ARG: [= phrasing_without_interactive ], ATTRIB: OUT: [=`Button] *)
type button = [ | `Button ]
type button_content = [ | phrasing_without_interactive ]
type button_content_fun = [ | phrasing_without_interactive ]
type button_attrib =
[
| common
| `Autofocus
| `Disabled
| `Form
| `Formaction
| `Formenctype
| `Method
| `Formnovalidate
| `Formtarget
| `Name
| `Text_Value
| `Button_Type
]
(* NAME: select, KIND: star, TYPE: [= common |`Autofocus | `Multiple | `Name | `Size | `Form | `Disabled ], [ `Optgroup | `Option ],[=`Select], ARG: [ `Optgroup | `Option ], ATTRIB: OUT: [=`Select] *)
type select = [ | `Select ]
type select_content = [ | `Optgroup | `Option ]
type select_content_fun = [ | `Optgroup | `Option ]
type select_attrib =
[ | common | `Autofocus | `Multiple | `Name | `Size | `Form | `Disabled | `Required
]
(* NAME: datalist, KIND: nullary, TYPE: [= common ], [=`Datalist], ARG: notag, ATTRIB: OUT: [=`Datalist] *)
type datalist = [ | `Datalist ]
type datalist_content = notag
type datalist_content_fun = notag
type datalist_attrib = [ | common ]
(* NAME: optgroup, KIND: star, TYPE: [= common | `Disabled | `Label ], [= `Option ], [=`Optgroup], ARG: [= `Option ], ATTRIB: OUT: [=`Optgroup] *)
type optgroup = [ | `Optgroup ]
type optgroup_content = [ | `Option ]
type optgroup_content_fun = [ | `Option ]
type optgroup_attrib = [ | common | `Disabled | `Label ]
type option_attrib =
[ | common | `Selected | `Text_Value | `Disabled | `Label | `Value ]
type selectoption = [ | `Option ]
type option_content_fun = [ | `PCDATA ]
type option_content = [ | `PCDATA ]
(* NAME: keygen, KIND: nullary, TYPE: [= common | `Autofcus | `Challenge | `Disabled | `Form | `Keytype | `Name ], [=`Keygen], ARG: notag, ATTRIB: OUT: [=`Keygen] *)
type keygen = [ | `Keygen ]
type keygen_content = notag
type keygen_content_fun = notag
type keygen_attrib =
[ | common | `Autofcus | `Challenge | `Disabled | `Form | `Keytype | `Name
]
(* NAME: progress, KIND: star, TYPE: [= common | `Float_Value |`Max| `Form ],[= phrasing_without_progress], [=`Progress], ARG: [= phrasing_without_progress], ATTRIB: OUT: [=`Progress] *)
type progress = [ | `Progress ]
type progress_content = [ | phrasing_without_progress ]
type progress_content_fun = [ | phrasing_without_progress ]
type progress_attrib = [ | common | `Float_Value | `Max | `Form ]
(* NAME: meter, KIND: star, TYPE: [= common |`Float_Value |`Min |`Max |`Low |`High |`Optimum |`Form],[= phrasing_without_meter ],[=`Meter], ARG: [= phrasing_without_meter ], ATTRIB: OUT: [=`Meter] *)
type meter = [ | `Meter ]
type meter_content = [ | phrasing_without_meter ]
type meter_content_fun = [ | phrasing_without_meter ]
type meter_attrib =
[ | common | `Float_Value | `Min | `Max | `Low | `High | `Optimum | `Form
]
(* NAME: output_elt, KIND: star, TYPE: [= common |`Form |`Output_for |`Name],[= phrasing ],[=`Output], ARG: [= phrasing ], ATTRIB: OUT: [=`Output] *)
type output_elt = [ | `Output ]
type output_elt_content = [ | phrasing ]
type output_elt_content_fun = [ | phrasing ]
type output_elt_attrib = [ | common | `Form | `Output_for | `Name ]
(* NAME: details, KIND: star, TYPE: [= common | `Open ], [= flow5] elt, [= `Details], ARG: [= flow5] elt, ATTRIB: OUT: [= `Details] *)
type details = [ | `Details ]
type details_content = [ | flow5 ]
type details_content_fun = [ | flow5 ]
type details_attrib = [ | common | `Open ]
(* NAME: summary, KIND: star, TYPE: [= common ],[= phrasing ], [=`Summary], ARG: [= phrasing ], ATTRIB: OUT: [=`Summary] *)
type summary = [ | `Summary ]
type summary_content = [ | phrasing ]
type summary_content_fun = [ | phrasing ]
type summary_attrib = [ | common ]
(* NAME: command, KIND: nullary, TYPE: [= common |`Icon |`Disabled |`Checked|`Radiogroup |`Command_Type], [=`Command], ARG: notag, ATTRIB: OUT: [=`Command] *)
type command = [ | `Command ]
type command_content = notag
type command_content_fun = notag
type command_attrib =
[ | common | `Icon | `Disabled | `Checked | `Radiogroup | `Command_Type
]
(* NAME: menu, KIND: nullary, TYPE: [= common |`Label |`Menu_Type ],[=`Menu], ARG: notag, ATTRIB: OUT: [=`Menu] *)
type menu = [ | `Menu ]
type menu_content = notag
type menu_content_fun = notag
type menu_attrib = [ | common | `Label | `Menu_Type ]
(* NAME: noscript, KIND: plus, TYPE: [= common ], 'a, [=`Noscript of 'a], ARG: 'a, ATTRIB: OUT: [=`Noscript of 'a] *)
type noscript = [ | `Noscript of flow5_without_noscript ]
type noscript_content = flow5_without_noscript
type noscript_content_fun = flow5_without_noscript
type noscript_attrib = [ | common ]
(* NAME: meta, KIND: nullary, TYPE: [= common | `Http_equiv | `Name | `Content | `Charset ], [=`Meta], ARG: notag, ATTRIB: OUT: [=`Meta] *)
type meta = [ | `Meta ]
type meta_content = notag
type meta_content_fun = notag
type meta_attrib = [ | common | `Http_equiv | `Name | `Content | `Charset | `Property ]
(* NAME: style, KIND: star, TYPE: [= common | `Media | `Mime_type | `Scoped ], [= `PCDATA ], [=`Style], ARG: [= `PCDATA ], ATTRIB: OUT: [=`Style] *)
type style = [ | `Style ]
type style_content = [ | `PCDATA ]
type style_content_fun = [ | `PCDATA ]
type style_attrib = [ | common | `Media | `Mime_type | `Scoped ]
type script = [ | `Script ]
type script_attrib =
[ | common | subressource_integrity
| `Async | `Charset | `Src | `Defer | `Mime_type
]
type script_content = [ | `PCDATA ]
type script_content_fun = [ | `PCDATA ]
(* NAME: template, KIND: star, TYPE: [= common ], [= flow5 ], [=`Template], ARG: [= flow5 ], ATTRIB: OUT: [=`Template] *)
type template = [ | `Template ]
type template_attrib = [ | common ]
type template_content = [ | flow5 ]
type template_content_fun = [ | flow5 ]
(* NAME: link, KIND: nullary, TYPE: [= common | `Hreflang | `Media | `Rel | `Href | `Sizes | `Mime_type ], [=`Link], ARG: notag, ATTRIB: OUT: [=`Link] *)
type link = [ | `Link ]
type link_content = notag
type link_content_fun = notag
type link_attrib =
[ | common | subressource_integrity
| `Hreflang | `Media | `Rel | `Href | `Sizes | `Mime_type
]
type picture = [ | `Picture ]
type picture_content = [ | source | script | template ]
type picture_content_fun = [ | source | script | template ]
type picture_attrib = [ | common ]
type referrerpolicy = [
| `Empty
| `No_referrer
| `No_referrer_when_downgrade
| `Origin
| `Origin_when_cross_origin
| `Same_origin
| `Strict_origin
| `Strict_origin_when_cross_origin
| `Unsafe_url
]
type big_variant =
[ `W3_org_1999_xhtml
| `Default
| `Preserve
| `Selected
| `Get
| `Post
| `Checked
| `Disabled
| `ReadOnly
| `Async
| `Autofocus
| `Autoplay
| `Muted
| `Anonymous
| `Use_credentials
| `Controls
| `Ltr
| `Rtl
| `Formnovalidate
| `Hidden
| `Ismap
| `Loop
| `Novalidate
| `Open
| `Audio
| `Metadata
| `None
| `Pubdate
| `Required
| `Reversed
| `Scoped
| `Seamless
| `Hard
| `Soft
| `Multiple
| `Checkbox
| `Command
| `Radio
| `Context
| `Toolbar
| `Char
| `Justify
| `Left
| `Right
| `Col
| `Colgroup
| `Row
| `Rowgroup
| `All
| `Cols
| `Groups
| `None
| `Rows
| `Rect
| `Circle
| `Poly
| `Default
| `One
| `Zero
| `Auto
| `No
| `Yes
| `Defer
| `Verbatim
| `Latin
| `Latin_name
| `Latin_prose
| `Full_width_latin
| `Kana
| `Katakana
| `Numeric
| `Tel
| `Email
| `Url
| `Text
| `Decimal
| `Search
]
type sandbox_token =
[ `Allow_forms
| `Allow_pointer_lock
| `Allow_popups
| `Allow_top_navigation
| `Allow_same_origin
| `Allow_script ]
type input_type =
[ `Button
| `Checkbox
| `Color
| `Date
| `Datetime
| `Datetime_local
| `Email
| `File
| `Hidden
| `Image
| `Month
| `Number
| `Password
| `Radio
| `Range
| `Reset
| `Search
| `Submit
| `Tel
| `Text
| `Time
| `Url
| `Week ]
tyxml-4.5.0/lib/svg_f.ml 0000664 0000000 0000000 00000073225 14040247726 0015120 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2010 by Simon Castellan
* Copyright (C) 2010 by Cecile Herbelin
* Copyright (C) 2010 by Vincent Balat
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** Type instantiations for SVG *)
(** This module defines basic data types for data, attributes
and element occurring in SVG documents.
It is based on the specification available at http://www.w3.org/TR/SVG/.
This module is experimental, it may lack of some attributes,
and the interface is very low level and do not take deeply into account
the needs of SVG elements. *)
open Svg_types
open Unit
let string_of_iri x = Printf.sprintf "url(%s)" x
module Unit = struct
(* let rel x = (x, None) *)
(* let deg x = (x, Some `Deg) *)
(* let grad x = (x, Some `Grad) *)
(* let rad x = (x, Some `Rad) *)
(* let ms x = (x, Some `Ms) *)
(* let s x = (x, Some `S) *)
(* let em x = (x, Some `Em) *)
(* let ex x = (x, Some `Ex) *)
(* let px x = (x, Some `Px) *)
(* let in_ x = (x, Some `In) *)
(* let cm x = (x, Some `Cm) *)
(* let mm x = (x, Some `Mm) *)
(* let pt x = (x, Some `Pt) *)
(* let pc x = (x, Some `Pc) *)
(* let percent x = (x, Some `Percent) *)
(* let hz x = (x, Some `Hz) *)
(* let khz x = (x, Some `KHz) *)
let to_string f (n, unit) = Printf.sprintf "%g%s" n begin
match unit with
| Some unit -> f unit
| None -> ""
end
let angle_names = function `Deg -> "deg" | `Grad -> "grad" | `Rad -> "rad"
let string_of_angle a = to_string angle_names a
(* let time_names = function `Ms -> "ms" | `S -> "s" *)
(* let string_of_time a = to_string time_names a *)
let length_names = function
| `Em -> "em" | `Ex -> "ex" | `Px -> "px" | `In -> "in" | `Cm -> "cm"
| `Mm -> "mm" | `Pt -> "pt" | `Pc -> "pc" | `Percent -> "%"
let string_of_length (a: length) = to_string length_names a
(* let freq_names = function `Hz -> "Hz" | `KHz -> "kHz" *)
(* let string_of_freq a = to_string freq_names a *)
end
open Unit
let opt_concat ?(sep=" ") s f = function
| Some x -> s ^ sep ^ (f x)
| None -> s
let list ?(sep=" ") f l = String.concat sep (List.map f l)
let string_of_color s = s
(* For now just string, we may want something better in the future. *)
let string_of_icccolor s = s
let string_of_paint_whitout_icc = function
| `None -> "none"
| `CurrentColor -> "currentColor"
| `Color (c, icc) -> opt_concat (string_of_color c) string_of_icccolor icc
let string_of_paint = function
| `Icc (iri, None) -> string_of_iri iri
| `Icc (iri, Some b) ->
(string_of_iri iri) ^" "^ (string_of_paint_whitout_icc b)
| #paint_whitout_icc as c -> string_of_paint_whitout_icc c
module Make_with_wrapped_functions
(Xml : Xml_sigs.T)
(C : Svg_sigs.Wrapped_functions with module Xml = Xml) =
struct
module Xml = Xml
module W = Xml.W
module Info = struct
let content_type = "image/svg+xml"
let alternative_content_types = []
let emptytags = []
let version = "SVG 1.1"
let standard = "http://www.w3.org/TR/svg11/"
let namespace = "http://www.w3.org/2000/svg"
let doctype =
Xml_print.compose_doctype"svg"
["-//W3C//DTD SVG 1.1//EN";
"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"]
end
type uri = Xml.uri
let string_of_uri = Xml.string_of_uri
let uri_of_string = Xml.uri_of_string
(* Mandatory XML stuff. *)
type 'a attrib = Xml.attrib
type +'a elt = Xml.elt
type 'a wrap = 'a W.t
type 'a list_wrap = 'a W.tlist
type ('a, 'b) nullary = ?a: (('a attrib) list) -> unit -> 'b elt
type ('a, 'b, 'c) unary = ?a: (('a attrib) list) -> 'b elt wrap -> 'c elt
type ('a, 'b, 'c) star =
?a: (('a attrib) list) -> ('b elt) list_wrap -> 'c elt
let tot x = x
let totl x = x
let toelt x = x
let toeltl x = x
let to_attrib x = x
let nullary tag ?a () =
Xml.node ?a tag (W.nil ())
let unary tag ?a elt =
Xml.node ?a tag (W.singleton elt)
let star tag ?a elts = Xml.node ?a tag elts
type altglyphdef_content =
[ `Ref of (glyphref elt) list
| `Item of (altglyphitem elt) list
]
let to_xmlattribs x = x
let float_attrib = Xml.float_attrib
let string_attrib = Xml.string_attrib
(* wrap C module functions *)
let string_of_coord = C.string_of_length
let string_of_length = C.string_of_length
let string_of_lengths = C.string_of_lengths
(* Custom XML attributes *)
let user_attrib f name v =
Xml.string_attrib name (W.fmap f v)
let number_attrib = float_attrib
(* for now string_attrib, we may want something better in the
future. *)
let color_attrib = Xml.string_attrib
(* SVG attributes *)
let metadata ?a children = Xml.node ?a "metadata" children
let foreignObject ?a children = Xml.node ?a "foreignObject" children
let txt s = Xml.pcdata s
let pcdata = txt
(* generated *)
let a_version = string_attrib "version"
let a_baseProfile = string_attrib "baseProfile"
let a_x = user_attrib string_of_coord "x"
let a_y = user_attrib string_of_coord "y"
let a_width = user_attrib string_of_length "width"
let a_height = user_attrib string_of_length "height"
let a_preserveAspectRatio =
string_attrib "preserveAspectRatio"
let a_contentScriptType =
string_attrib "contentScriptType"
let a_contentStyleType = string_attrib "contentStyleType"
let a_zoomAndPan x =
user_attrib C.string_of_big_variant "zoomAndSpan" x
let a_href = string_attrib "href"
let a_xlink_href = string_attrib "xlink:href"
let a_requiredFeatures =
Xml.space_sep_attrib "requiredFeatures"
let a_requiredExtensions =
Xml.space_sep_attrib "requiredExtension"
let a_systemLanguage =
Xml.comma_sep_attrib "systemLanguage"
let a_externalRessourcesRequired =
user_attrib C.string_of_bool "externalRessourcesRequired"
let a_id = string_attrib "id"
let a_user_data name = string_attrib ("data-" ^ name)
let a_xml_base = string_attrib "xml:base"
let a_xml_lang = string_attrib "xml:lang"
let a_xml_space x =
user_attrib C.string_of_big_variant "xml:space" x
let a_type = string_attrib "type"
let a_media = Xml.comma_sep_attrib "media"
let a_xlink_title = string_attrib "xlink:title"
let a_class = Xml.space_sep_attrib "class"
let a_style = string_attrib "style"
let a_transform = user_attrib C.string_of_transforms "transform"
let a_viewBox = user_attrib C.string_of_fourfloats "viewBox"
let a_d = string_attrib "d"
let a_pathLength = number_attrib "pathLength"
let a_rx = user_attrib string_of_length "rx"
let a_ry = user_attrib string_of_length "ry"
let a_cx = user_attrib string_of_length "cx"
let a_cy = user_attrib string_of_length "cy"
let a_r = user_attrib string_of_length "r"
let a_x1 = user_attrib string_of_coord "x1"
let a_y1 = user_attrib string_of_coord "y1"
let a_x2 = user_attrib string_of_coord "x2"
let a_y2 = user_attrib string_of_coord "y2"
let a_points = user_attrib C.string_of_coords "points"
let a_x_list = user_attrib string_of_lengths "x"
let a_y_list = user_attrib string_of_lengths "y"
let a_dx = user_attrib C.string_of_number "dx"
let a_dy = user_attrib C.string_of_number "dy"
let a_dx_list = user_attrib string_of_lengths "dx"
let a_dy_list = user_attrib string_of_lengths "dy"
let a_lengthAdjust x =
user_attrib C.string_of_big_variant "lengthAdjust" x
let a_textLength = user_attrib string_of_length "textLength"
let a_text_anchor x =
user_attrib C.string_of_big_variant "text-anchor" x
let a_text_decoration x =
user_attrib C.string_of_big_variant "text-decoration" x
let a_text_rendering x =
user_attrib C.string_of_big_variant "text-rendering" x
let a_rotate = user_attrib C.string_of_numbers "rotate"
let a_startOffset = user_attrib string_of_length "startOffset"
let a_method x =
user_attrib C.string_of_big_variant "method" x
let a_spacing x =
user_attrib C.string_of_big_variant "spacing" x
let a_glyphRef = string_attrib "glyphRef"
let a_format = string_attrib "format"
let a_markerUnits x =
user_attrib C.string_of_big_variant "markerUnits" x
let a_refX = user_attrib string_of_coord "refX"
let a_refY = user_attrib string_of_coord "refY"
let a_markerWidth = user_attrib string_of_length "markerWidth"
let a_markerHeight = user_attrib string_of_length "markerHeight"
let a_orient x =
user_attrib C.string_of_orient "orient" x
let a_local = string_attrib "local"
let a_rendering_intent x =
user_attrib C.string_of_big_variant "rendering-intent" x
let a_gradientUnits x =
user_attrib C.string_of_big_variant "gradientUnits" x
let a_gradientTransform =
user_attrib C.string_of_transforms "gradientTransform"
let a_spreadMethod x =
user_attrib C.string_of_big_variant "spreadMethod" x
let a_fx = user_attrib string_of_coord "fx"
let a_fy = user_attrib string_of_coord "fy"
let a_offset x =
user_attrib C.string_of_offset "offset" x
let a_patternUnits x =
user_attrib C.string_of_big_variant "patternUnits" x
let a_patternContentUnits x =
user_attrib C.string_of_big_variant "patternContentUnits" x
let a_patternTransform x =
user_attrib C.string_of_transforms "patternTransform" x
let a_clipPathUnits x =
user_attrib C.string_of_big_variant "clipPathUnits" x
let a_maskUnits x =
user_attrib C.string_of_big_variant "maskUnits" x
let a_maskContentUnits x =
user_attrib C.string_of_big_variant "maskContentUnits" x
let a_primitiveUnits x =
user_attrib C.string_of_big_variant "primitiveUnits" x
let a_filterRes =
user_attrib C.string_of_number_optional_number "filterResUnits"
let a_result = string_attrib "result"
let a_in x =
user_attrib C.string_of_in_value "in" x
let a_in2 x =
user_attrib C.string_of_in_value "in2" x
let a_azimuth = number_attrib "azimuth"
let a_elevation = number_attrib "elevation"
let a_pointsAtX = number_attrib "pointsAtX"
let a_pointsAtY = number_attrib "pointsAtY"
let a_pointsAtZ = number_attrib "pointsAtZ"
let a_specularExponent = number_attrib "specularExponent"
let a_specularConstant = number_attrib "specularConstant"
let a_limitingConeAngle = number_attrib "limitingConeAngle"
let a_mode x =
user_attrib C.string_of_big_variant "mode" x
let a_feColorMatrix_type x =
user_attrib C.string_of_big_variant "type" x
let a_values = user_attrib C.string_of_numbers "values"
let a_transfer_type x =
user_attrib C.string_of_big_variant "type" x
let a_tableValues = user_attrib C.string_of_numbers "tableValues"
let a_intercept = user_attrib C.string_of_number "intercept"
let a_amplitude = user_attrib C.string_of_number "amplitude"
let a_exponent = user_attrib C.string_of_number "exponent"
let a_transfer_offset = user_attrib C.string_of_number "offset"
let a_feComposite_operator x =
user_attrib C.string_of_big_variant "operator" x
let a_k1 = user_attrib C.string_of_number "k1"
let a_k2 = user_attrib C.string_of_number "k2"
let a_k3 = user_attrib C.string_of_number "k3"
let a_k4 = user_attrib C.string_of_number "k4"
let a_order = user_attrib C.string_of_number_optional_number "order"
let a_kernelMatrix = user_attrib C.string_of_numbers "kernelMatrix"
let a_divisor = user_attrib C.string_of_number "divisor"
let a_bias = user_attrib C.string_of_number "bias"
let a_kernelUnitLength =
user_attrib C.string_of_number_optional_number "kernelUnitLength"
let a_targetX = user_attrib C.string_of_int "targetX"
let a_targetY = user_attrib C.string_of_int "targetY"
let a_edgeMode x =
user_attrib C.string_of_big_variant "targetY" x
let a_preserveAlpha = user_attrib C.string_of_bool "preserveAlpha"
let a_surfaceScale = user_attrib C.string_of_number "surfaceScale"
let a_diffuseConstant =
user_attrib C.string_of_number "diffuseConstant"
let a_scale = user_attrib C.string_of_number "scale"
let a_xChannelSelector x =
user_attrib C.string_of_big_variant "xChannelSelector" x
let a_yChannelSelector x =
user_attrib C.string_of_big_variant "yChannelSelector" x
let a_stdDeviation =
user_attrib C.string_of_number_optional_number "stdDeviation"
let a_feMorphology_operator x =
user_attrib C.string_of_big_variant "operator" x
let a_radius = user_attrib C.string_of_number_optional_number "radius"
let a_baseFrenquency =
user_attrib C.string_of_number_optional_number "baseFrequency"
let a_numOctaves = user_attrib C.string_of_int "numOctaves"
let a_seed = user_attrib C.string_of_number "seed"
let a_stitchTiles x =
user_attrib C.string_of_big_variant "stitchTiles" x
let a_feTurbulence_type x =
user_attrib C.string_of_big_variant "type" x
let a_xlink_show x =
user_attrib C.string_of_big_variant "xlink:show" x
let a_xlink_actuate x =
user_attrib C.string_of_big_variant "xlink:actuate" x
let a_target = string_attrib "xlink:target"
let a_viewTarget = string_attrib "viewTarget"
let a_attributeName = string_attrib "attributeName"
let a_attributeType x =
user_attrib C.string_of_big_variant "attributeType" x
let a_begin = string_attrib "begin"
let a_dur = string_attrib "dur"
let a_min = string_attrib "min"
let a_max = string_attrib "max"
let a_restart x =
user_attrib C.string_of_big_variant "restart" x
let a_repeatCount = string_attrib "repeatCount"
let a_repeatDur = string_attrib "repeatDur"
let a_fill = user_attrib C.string_of_paint "fill"
let a_animation_fill x =
user_attrib C.string_of_big_variant "fill" x
let a_calcMode x =
user_attrib C.string_of_big_variant "calcMode" x
let a_animation_values = Xml.comma_sep_attrib "values"
let a_keyTimes = Xml.comma_sep_attrib "keyTimes"
let a_keySplines = Xml.comma_sep_attrib "keySplines"
let a_from = string_attrib "from"
let a_to = string_attrib "to"
let a_by = string_attrib "by"
let a_additive x =
user_attrib C.string_of_big_variant "additive" x
let a_accumulate x =
user_attrib C.string_of_big_variant "accumulate" x
let a_keyPoints = user_attrib C.string_of_numbers_semicolon "keyPoints"
let a_path = string_attrib "path"
let a_animateTransform_type =
user_attrib C.string_of_big_variant "type"
let a_horiz_origin_x = user_attrib C.string_of_number "horiz-origin-x"
let a_horiz_origin_y = user_attrib C.string_of_number "horiz-origin-y"
let a_horiz_adv_x = user_attrib C.string_of_number "horiz-adv-x"
let a_vert_origin_x = user_attrib C.string_of_number "vert-origin-x"
let a_vert_origin_y = user_attrib C.string_of_number "vert-origin-y"
let a_vert_adv_y = user_attrib C.string_of_number "vert-adv-y"
let a_unicode = string_attrib "unicode"
let a_glyph_name = string_attrib "glyphname"
let a_orientation x =
user_attrib C.string_of_big_variant "orientation" x
let a_arabic_form x =
user_attrib C.string_of_big_variant "arabic-form" x
let a_lang = string_attrib "lang"
let a_u1 = string_attrib "u1"
let a_u2 = string_attrib "u2"
let a_g1 = string_attrib "g1"
let a_g2 = string_attrib "g2"
let a_k = string_attrib "k"
let a_font_family = string_attrib "font-family"
let a_font_style = string_attrib "font-style"
let a_font_variant = string_attrib "font-variant"
let a_font_weight = string_attrib "font-weight"
let a_font_stretch = string_attrib "font-stretch"
let a_font_size = string_attrib "font-size"
let a_unicode_range = string_attrib "unicode-range"
let a_units_per_em = string_attrib "units-per-em"
let a_stemv = user_attrib C.string_of_number "stemv"
let a_stemh = user_attrib C.string_of_number "stemh"
let a_slope = user_attrib C.string_of_number "slope"
let a_cap_height = user_attrib C.string_of_number "cap-height"
let a_x_height = user_attrib C.string_of_number "x-height"
let a_accent_height = user_attrib C.string_of_number "accent-height"
let a_ascent = user_attrib C.string_of_number "ascent"
let a_widths = string_attrib "widths"
let a_bbox = string_attrib "bbox"
let a_ideographic = user_attrib C.string_of_number "ideographic"
let a_alphabetic = user_attrib C.string_of_number "alphabetic"
let a_mathematical = user_attrib C.string_of_number "mathematical"
let a_hanging = user_attrib C.string_of_number "hanging"
let a_videographic = user_attrib C.string_of_number "v-ideographic"
let a_v_alphabetic = user_attrib C.string_of_number "v-alphabetic"
let a_v_mathematical = user_attrib C.string_of_number "v-mathematical"
let a_v_hanging = user_attrib C.string_of_number "v-hanging"
let a_underline_position =
user_attrib C.string_of_number "underline-position"
let a_underline_thickness =
user_attrib C.string_of_number "underline-thickness"
let a_strikethrough_position =
user_attrib C.string_of_number "strikethrough-position"
let a_strikethrough_thickness =
user_attrib C.string_of_number "strikethrough-thickness"
let a_overline_position = user_attrib C.string_of_number "overline-position"
let a_overline_thickness =
user_attrib C.string_of_number "overline-thickness"
let a_string = string_attrib "string"
let a_name = string_attrib "name"
let a_alignment_baseline x =
user_attrib C.string_of_alignment_baseline "alignment-baseline" x
let a_dominant_baseline x =
user_attrib C.string_of_dominant_baseline "dominant-baseline" x
(** Javascript events *)
let a_onabort = Xml.event_handler_attrib "onabort"
let a_onactivate = Xml.event_handler_attrib "onactivate"
let a_onbegin = Xml.event_handler_attrib "onbegin"
let a_onend = Xml.event_handler_attrib "onend"
let a_onerror = Xml.event_handler_attrib "onerror"
let a_onfocusin = Xml.event_handler_attrib "onfocusin"
let a_onfocusout = Xml.event_handler_attrib "onfocusout"
let a_onload = Xml.event_handler_attrib "onload"
let a_onrepeat = Xml.event_handler_attrib "onrepeat"
let a_onresize = Xml.event_handler_attrib "onresize"
let a_onscroll = Xml.event_handler_attrib "onscroll"
let a_onunload = Xml.event_handler_attrib "onunload"
let a_onzoom = Xml.event_handler_attrib "onzoom"
(** Javascript mouse events *)
let a_onclick = Xml.mouse_event_handler_attrib "onclick"
let a_onmousedown = Xml.mouse_event_handler_attrib "onmousedown"
let a_onmouseup = Xml.mouse_event_handler_attrib "onmouseup"
let a_onmouseover = Xml.mouse_event_handler_attrib "onmouseover"
let a_onmouseout = Xml.mouse_event_handler_attrib "onmouseout"
let a_onmousemove = Xml.mouse_event_handler_attrib "onmousemove"
(** Javascript touch events *)
let a_ontouchstart = Xml.touch_event_handler_attrib "ontouchstart"
let a_ontouchend = Xml.touch_event_handler_attrib "ontouchend"
let a_ontouchmove = Xml.touch_event_handler_attrib "ontouchmove"
let a_ontouchcancel = Xml.touch_event_handler_attrib "ontouchcancel"
let a_stop_color = color_attrib "stop-color"
let a_stop_opacity = user_attrib C.string_of_number "stop-opacity"
let a_stroke = user_attrib C.string_of_paint "stroke"
let a_stroke_width = user_attrib C.string_of_length "stroke-width"
let a_stroke_linecap x =
user_attrib C.string_of_big_variant "stroke-linecap" x
let a_stroke_linejoin x =
user_attrib C.string_of_big_variant "stroke-linejoin" x
let a_stroke_miterlimit =
user_attrib C.string_of_number "stroke-miterlimit"
let a_stroke_dasharray x =
user_attrib C.string_of_strokedasharray "stroke-dasharray" x
let a_stroke_dashoffset =
user_attrib C.string_of_length "stroke-dashoffset"
let a_stroke_opacity =
user_attrib C.string_of_number "stroke-opacity"
(* xlink namespace given a nickname since some attributes mandated by
the svg standard such as xlink:href live in that namespace, and we
refer to them as "xlink:whatever" (see a_xlink_href or a_xlinkshow)
*)
let svg ?(a = []) children =
let attribs =
string_attrib "xmlns" (W.return "http://www.w3.org/2000/svg")
:: string_attrib "xmlns:xlink" (W.return "http://www.w3.org/1999/xlink")
:: to_xmlattribs a
in
star ~a:(attribs) "svg" children
(* also generated *)
let g = star "g"
let defs = star "defs"
let desc = unary "desc"
let title = unary "title"
let symbol = star "symbol"
let use = star "use"
let image = star "image"
let switch = star "switch"
let style = unary "style"
let path = star "path"
let rect = star "rect"
let circle = star "circle"
let ellipse = star "ellipse"
let line = star "line"
let polyline = star "polyline"
let polygon = star "polygon"
let text = star "text"
let tspan = star "tspan"
let tref = star "tref"
let textPath = star "textPath"
let altGlyph = unary "altGlyph"
let altGlyphDef = unary "altGlyphDef"
let altGlyphItem = star "altGlyphItem"
let glyphRef = nullary "glyphRef"
let marker = star "marker"
let color_profile = star "color-profile"
let linearGradient = star "linearGradient"
let radialGradient = star "radialGradient"
let stop = star "stop"
let pattern = star "pattern"
let clipPath = star "clipPath"
let filter = star "filter"
let feDistantLight = star "feDistantLight"
let fePointLight = star "fePointLight"
let feSpotLight = star "feSpotLight"
let feBlend = star "feBlend"
let feColorMatrix = star "feColorMatrix"
let feComponentTransfer = star "feComponentTransfer"
let feFuncA = star "feFuncA"
let feFuncG = star "feFuncG"
let feFuncB = star "feFuncB"
let feFuncR = star "feFuncR"
let feComposite = star "feComposite"
let feConvolveMatrix = star "feConvolveMatrix"
let feDiffuseLighting = star "feDiffuseLighting"
let feDisplacementMap = star "feDisplacementMap"
let feFlood = star "feFlood"
let feGaussianBlur = star "feGaussianBlur"
let feImage = star "feImage"
let feMerge = star "feMerge"
let feMorphology = star "feMorphology"
let feOffset = star "feOffset"
let feSpecularLighting = star "feSpecularLighting"
let feTile = star "feTile"
let feTurbulence = star "feTurbulence"
let cursor = star "cursor"
let a = star "a"
let view = star "view"
let script = unary "script"
let animation = star "animate"
let set = star "set"
let animateMotion = star "animateMotion"
let mpath = star "mpath"
let animateColor = star "animateColor"
let animateTransform = star "animateTransform"
let font = star "font"
let glyph = star "glyph"
let missing_glyph = star "missing-glyph"
let hkern = nullary "hkern"
let vkern = nullary "vkern"
let font_face = nullary "font-face"
let font_face_src = star "font-face-src"
let font_face_uri = star "font-face-uri"
let font_face_format = nullary "font-face-uri"
let font_face_name = nullary "font-face-name"
type doc = [ `Svg ] elt
let doc_toelt x = x
module I = Xml_stream.Import(Xml)
let of_seq s = totl @@ I.of_seq s
module Unsafe = struct
let data s = Xml.encodedpcdata s
let leaf tag ?a () = Xml.leaf ?a tag
let node tag ?a elts = Xml.node ?a tag elts
let coerce_elt x = x
let float_attrib = Xml.float_attrib
let int_attrib = Xml.int_attrib
let string_attrib = Xml.string_attrib
let uri_attrib a s = Xml.uri_attrib a s
let space_sep_attrib = Xml.space_sep_attrib
let comma_sep_attrib = Xml.comma_sep_attrib
end
end
module Wrapped_functions
(Xml : Xml_sigs.T with type ('a,'b) W.ft = 'a -> 'b) =
struct
module Xml = Xml
let string_of_alignment_baseline = function
| `Auto -> "auto"
| `Baseline -> "baseline"
| `Before_edge -> "before-edge"
| `Text_before_edge -> "text-before-edge"
| `Middle -> "middle"
| `Central -> "central"
| `After_edge -> "after-edge"
| `Text_after_edge -> "text-after-edge"
| `Ideographic -> "ideographic"
| `Alphabetic -> "alphabetic"
| `Hanging-> "hanging"
| `Mathematical -> "mathematical"
| `Inherit -> "inherit"
let string_of_big_variant = function
| `A -> "a"
| `Absolute_colorimetric -> "absolute_colorimetric"
| `Align -> ""
| `Always -> "always"
| `Atop -> "atop"
| `Arithmetic -> "arithmetic"
| `Auto -> "auto"
| `B -> "b"
| `Bever -> "bevel"
| `Blink -> "blink"
| `Butt -> "butt"
| `CSS -> "CSS"
| `Darken -> "darken"
| `Default -> "default"
| `Dilate -> "dilate"
| `Disable -> "disable"
| `Discrete -> "discrete"
| `Duplicate -> "duplicate"
| `End -> "end"
| `Erode -> "erode"
| `Exact -> "exact"
| `FractalNoise -> "fractalNoise"
| `Freeze -> "freeze"
| `HueRotate -> "hueRotate"
| `G -> "g"
| `Gamma -> "gamma"
| `GeometricPrecision -> "geometricPrecision"
| `H -> "h"
| `Identity -> "identity"
| `In -> "in"
| `Inherit -> "inherit"
| `Initial -> "initial"
| `Isolated -> "isolated"
| `Lighten -> "lighten"
| `Line_through -> "line-through"
| `Linear -> "linear"
| `LuminanceToAlpha -> "luminanceToAlpha"
| `Magnify -> "magnify"
| `Matrix -> "matrix"
| `Medial -> "medial"
| `Middle -> "middle"
| `Miter -> "miter"
| `Multiply -> "multiply"
| `Never -> "never"
| `New -> "new"
| `None -> "none"
| `Normal -> "normal"
| `NoStitch -> "noStitch"
| `ObjectBoundingBox -> "objectBoundingBox"
| `OnLoad -> "onLoad"
| `OnRequest -> "onRequest"
| `OptimizeLegibility -> "optimizeLegibility"
| `OptimizeSpeed -> "optimizeSpeed"
| `Other -> "other"
| `Out -> "out"
| `Over -> "over"
| `Overline -> "overline"
| `Paced -> "paced"
| `Pad -> "pad"
| `Perceptual -> "perceptual"
| `Preserve -> "preserve"
| `R -> "r"
| `Reflect -> "reflect"
| `Remove -> "remove"
| `Repeat -> "repeat"
| `Replace -> "replace"
| `Relative_colorimetric -> "relative_colorimetric"
| `Rotate -> "rotate"
| `Round -> "round"
| `Saturate -> "saturate"
| `Saturation -> "saturation"
| `Scale -> "scale"
| `Screen -> "screen"
| `SkewX -> "skewX"
| `SkewY -> "skewY"
| `Spacing -> "spacing"
| `SpacingAndGlyphs -> "spacingAndGlyphs"
| `Spline -> "spline"
| `Square -> "square"
| `Start -> "start"
| `Stitch -> "stitch"
| `Stretch -> "stretch"
| `StrokeWidth -> "stroke-width"
| `Sum -> "sum"
| `Table -> "table"
| `Terminal -> "terminal"
| `Translate -> "translate"
| `Turbulence -> "turbulence"
| `Underline -> "underline"
| `UserSpaceOnUse -> "userSpaceOnUse"
| `V -> "v"
| `WhenNotActive -> "whenNotActive"
| `Wrap -> "wrap"
| `XML -> "XML"
| `Xor -> "xor"
let string_of_bool = string_of_bool
let string_of_coords =
list (fun (a, b) -> Printf.sprintf "%g, %g" a b)
let string_of_dominant_baseline = function
| `Auto -> "auto"
| `Use_script -> "usescript"
| `No_change -> "nochange"
| `Reset_size -> "resetsize"
| `Ideographic -> "ideographic"
| `Alphabetic -> "alphabetic"
| `Hanging -> "hanging"
| `Mathematical -> "mathematical"
| `Central -> "central"
| `Middle -> "middle"
| `Text_after_edge -> "textafteredge"
| `Text_before_edge -> "textbeforeedge"
| `Inherit -> "inherit"
let string_of_in_value = function
| `SourceGraphic -> "sourceGraphic"
| `SourceAlpha -> "sourceAlpha"
| `BackgroundImage -> "backgroundImage"
| `BackgroundAlpha -> "backgroundAlpha"
| `FillPaint -> "fillPaint"
| `StrokePaint -> "strokePaint"
| `Ref _svg -> _svg
let string_of_int = string_of_int
let string_of_length = Unit.string_of_length
let string_of_lengths = list string_of_length
let string_of_number = Xml_print.string_of_number
let string_of_percentage x = (string_of_number x) ^ "%"
let string_of_fourfloats (a, b, c, d) =
Printf.sprintf "%s %s %s %s"
(string_of_number a) (string_of_number b) (string_of_number c) (string_of_number d)
let string_of_number_optional_number = function
| x, Some y -> Printf.sprintf "%g, %g" x y
| x, None -> Printf.sprintf "%g" x
let string_of_numbers = list string_of_number
let string_of_numbers_semicolon = list ~sep:"; " string_of_number
let string_of_offset = function
| `Number x -> string_of_number x
| `Percentage x -> string_of_percentage x
let string_of_orient = function
| None -> "auto"
| Some __svg -> string_of_angle __svg
let string_of_paint = string_of_paint
let string_of_strokedasharray = function
| [] -> "none"
| l -> list string_of_length l
let string_of_transform = function
| `Matrix (a, b, c, d, e, f) ->
Printf.sprintf "matrix(%g %g %g %g %g %g)" a b c d e f
| `Translate x ->
Printf.sprintf "translate(%s)"
(string_of_number_optional_number x)
| `Scale x ->
Printf.sprintf "scale(%s)" (string_of_number_optional_number x)
| `Rotate ((angle, x)) ->
Printf.sprintf "rotate(%s %s)" (string_of_angle angle)
(match x with
| Some ((x, y)) -> Printf.sprintf "%g %g" x y
| None -> "")
| `SkewX angle ->
Printf.sprintf "skewX(%s)" (string_of_angle angle)
| `SkewY angle ->
Printf.sprintf "skewY(%s)" (string_of_angle angle)
let string_of_transforms l =
String.concat " " (List.map string_of_transform l)
end
module Make
(Xml : Xml_sigs.T with type ('a, 'b) W.ft = ('a -> 'b)) =
Make_with_wrapped_functions(Xml)(Wrapped_functions(Xml))
tyxml-4.5.0/lib/svg_f.mli 0000664 0000000 0000000 00000006721 14040247726 0015266 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2011 Pierre Chambart, Grégoire Henry
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** Typesafe constructors for SVG documents (Functorial interface)
This module is experimental, it may lack of some attributes,
and the interface is very low level and do not take deeply into account
the needs of SVG elements.
{% See <>. %}
*)
(*
open Svg_types
module Unit : sig
open Unit
val rel: float -> 'a quantity
(** Do not specify the unit *)
val deg : float -> angle
val grad : float -> angle
val rad : float -> angle
val s : float -> time
val ms : float -> time
val em : float -> length
val ex : float -> length
val px : float -> length
val in_ : float -> length
val cm : float -> length
val mm : float -> length
val pt : float -> length
val pc : float -> length
val hz : float -> frequency
val khz : float -> frequency
val string_of_angle : angle -> string
val string_of_time : time -> string
val string_of_length : length -> string
val string_of_freq : frequency -> string
end
open Unit
val string_of_number : number -> string
val string_of_number_optional_number : number_optional_number -> string
val string_of_percentage : percentage -> string
val string_of_strings : strings -> string
val string_of_spacestrings : spacestrings -> string
val string_of_commastrings : commastrings -> string
val string_of_fourfloats : fourfloats -> string
val string_of_numbers : numbers -> string
val string_of_numbers_semicolon : numbers_semicolon -> string
val string_of_lengths : lengths -> string
val string_of_coord : coord -> string
val string_of_coords : coords -> string
val string_of_transform : transform -> string
val string_of_transforms : transforms -> string
*)
(** Create a new implementation of [Svg], using the given underlying [Xml]
implementation. Will output a module of type {!Svg_sigs.T} with
the various type equalities.
If your [Xml] implementation uses a special function wrapping, use
{!Make_with_wrapped_functions}.
*)
module Make(Xml : Xml_sigs.T with type ('a, 'b) W.ft = ('a -> 'b))
: Svg_sigs.Make(Xml).T
with type +'a elt = Xml.elt
and type +'a attrib = Xml.attrib
(** The standard set of wrapped functions, when [W.ft] is the regular function. *)
module Wrapped_functions
(Xml: Xml_sigs.T with type ('a, 'b) W.ft = 'a -> 'b)
: Svg_sigs.Wrapped_functions with module Xml = Xml
(** Similar to {!Make} but with a custom set of wrapped functions. *)
module Make_with_wrapped_functions
(Xml : Xml_sigs.T)
(C : Svg_sigs.Wrapped_functions with module Xml = Xml)
: Svg_sigs.Make(Xml).T
with type +'a elt = Xml.elt
and type +'a attrib = Xml.attrib
tyxml-4.5.0/lib/svg_sigs.mli 0000664 0000000 0000000 00000110273 14040247726 0016004 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2011 Pierre Chambart, Grégoire Henry
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** SVG signatures for the functorial interface. *)
(** Signature of typesafe constructors for SVG documents. *)
module type T = sig
(** SVG elements.
Element constructors are in section {!elements}. Most elements constructors
are either {{!nullary}nullary}, {{!unary}unary} or {{!star}star},
depending on the number of children they accept.
Children are usually given as a list of elements.
{{!txt}txt} is used for text.
The type variable ['a] is used to track the element's type. This
allows the OCaml typechecker to check SVG validity.
Note that the concrete implementation of this type can vary.
See {!Xml} for details.
*)
type +'a elt
(** A complete SVG document. *)
type doc = [ `Svg ] elt
(** SVG attributes
Attribute constructors are in section {!attributes} and their name starts
with [a_]. Attributes are given to elements with the [~a] optional argument.
Similarly to {{!elt}elt}, attributes use the OCaml type system to enforce
Html validity.
In some cases, attributes have to be disambiguated.
The [max] attribute has two version,
{!a_fill} and {!a_animation_fill},
depending on the element.
Such disambiguated attribute will contain the name of the associated element.
*)
type +'a attrib
(** Underlying XML data-structure
The type variables in {!elt} and {!attrib} are know as {i phantom types}.
The implementation, defined here, is actually monomorphic.
In particular, tyxml doesn't impose any overhead over the underlying
representation. The {!tot} and {!toelt} functions allows to convert
between the typed and the untyped representation without any cost.
Note that some implementation may not be iterable or printable, such as the
Dom representation exposed by js_of_ocaml.
*)
module Xml : Xml_sigs.T
(** [wrap] is a container for elements and values.
In most cases, ['a wrap = 'a]. For [R] modules (in eliom or js_of_ocaml),
It will be {!React.S.t}.
*)
type 'a wrap = 'a Xml.W.t
(** [list_wrap] is a containre for list of elements.
In most cases, ['a list_wrap = 'a list]. For [R] modules (in eliom or js_of_ocaml),
It will be {!ReactiveData.RList.t}.
*)
type 'a list_wrap = 'a Xml.W.tlist
(** A nullary element is an element that doesn't have any children. *)
type ('a, 'b) nullary = ?a: (('a attrib) list) -> unit -> 'b elt
(** A unary element is an element that have exactly one children. *)
type ('a, 'b, 'c) unary = ?a: (('a attrib) list) -> 'b elt wrap -> 'c elt
(** A star element is an element that has any number of children, including zero. *)
type ('a, 'b, 'c) star =
?a: (('a attrib) list) -> ('b elt) list_wrap -> 'c elt
(** Various information about SVG, such as the doctype, ... *)
module Info : Xml_sigs.Info
(** {3 Uri} *)
type uri = Xml.uri
val string_of_uri : (uri, string) Xml.W.ft
val uri_of_string : (string, uri) Xml.W.ft
open Svg_types
(** {2:attributes Attributes } *)
val a_version : string wrap -> [> | `Version ] attrib
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val a_baseProfile : string wrap -> [> | `BaseProfile ] attrib
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val a_x : coord wrap -> [> | `X ] attrib
val a_y : coord wrap -> [> | `Y ] attrib
val a_width : Unit.length wrap -> [> | `Width ] attrib
val a_height : Unit.length wrap -> [> | `Height ] attrib
val a_preserveAspectRatio : string wrap -> [> | `PreserveAspectRatio ] attrib
val a_contentScriptType : string wrap -> [> | `ContentScriptType ] attrib
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val a_contentStyleType : string wrap -> [> | `ContentStyleType ] attrib
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val a_zoomAndPan : [< | `Disable | `Magnify ] wrap -> [> | `ZoomAndSpan ] attrib
val a_href : iri wrap -> [> | `Xlink_href ] attrib
val a_xlink_href : iri wrap -> [> | `Xlink_href ] attrib
[@@ocaml.deprecated "Use a_href"]
(** @deprecated Use a_href *)
val a_requiredFeatures : spacestrings wrap -> [> | `RequiredFeatures ] attrib
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val a_requiredExtensions :
spacestrings wrap -> [> | `RequiredExtension ] attrib
val a_systemLanguage : commastrings wrap -> [> | `SystemLanguage ] attrib
val a_externalRessourcesRequired :
bool wrap -> [> | `ExternalRessourcesRequired ] attrib
val a_id : string wrap -> [> | `Id ] attrib
val a_user_data : string -> string wrap -> [> | `User_data] attrib
val a_xml_base : iri wrap -> [> | `Xml_Base ] attrib
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val a_xml_lang : iri wrap -> [> | `Xml_Lang ] attrib
val a_xml_space : [< `Default | `Preserve ] wrap -> [> | `Xml_Space ] attrib
[@@ocaml.deprecated "Use CSS white-space"]
(** @deprecated Use CSS white-space *)
val a_type : string wrap -> [> | `Type ] attrib
val a_media : commastrings wrap -> [> | `Media ] attrib
val a_xlink_title : string wrap -> [> | `Title ] attrib
[@@ocaml.deprecated "Use a child title element"]
(** @deprecated Use a child title element *)
val a_class : spacestrings wrap -> [> | `Class ] attrib
val a_style : string wrap -> [> | `Style ] attrib
val a_transform : transforms wrap -> [> | `Transform ] attrib
val a_viewBox : fourfloats wrap -> [> | `ViewBox ] attrib
val a_d : string wrap -> [> | `D ] attrib
val a_pathLength : float wrap -> [> | `PathLength ] attrib
(* XXX: better language support *)
val a_rx : Unit.length wrap -> [> | `Rx ] attrib
val a_ry : Unit.length wrap -> [> | `Ry ] attrib
val a_cx : Unit.length wrap -> [> | `Cx ] attrib
val a_cy : Unit.length wrap -> [> | `Cy ] attrib
val a_r : Unit.length wrap -> [> | `R ] attrib
val a_x1 : coord wrap -> [> | `X1 ] attrib
val a_y1 : coord wrap -> [> | `Y1 ] attrib
val a_x2 : coord wrap -> [> | `X2 ] attrib
val a_y2 : coord wrap -> [> | `Y2 ] attrib
val a_points : coords wrap -> [> | `Points ] attrib
val a_x_list : lengths wrap -> [> | `X_list ] attrib
[@@reflect.attribute "x" ["text"; "tspan"; "tref"; "altGlyph"]]
val a_y_list : lengths wrap -> [> | `Y_list ] attrib
[@@reflect.attribute "y" ["text"; "tspan"; "tref"; "altGlyph"]]
val a_dx : number wrap -> [> | `Dx ] attrib
val a_dy : number wrap -> [> | `Dy ] attrib
val a_dx_list : lengths wrap -> [> | `Dx_list ] attrib
[@@reflect.attribute "dx" ["text"; "tspan"; "tref"; "altGlyph"]]
val a_dy_list : lengths wrap -> [> | `Dy_list ] attrib
[@@reflect.attribute "dy" ["text"; "tspan"; "tref"; "altGlyph"]]
val a_lengthAdjust :
[< `Spacing | `SpacingAndGlyphs ] wrap -> [> | `LengthAdjust ] attrib
val a_textLength : Unit.length wrap -> [> | `TextLength ] attrib
val a_text_anchor : [< `Start | `Middle | `End | `Inherit ] wrap -> [> | `Text_Anchor ] attrib
val a_text_decoration : [< `None | `Underline | `Overline | `Line_through | `Blink | `Inherit ] wrap -> [> | `Text_Decoration ] attrib
val a_text_rendering : [< `Auto | `OptimizeSpeed | `OptimizeLegibility | `GeometricPrecision | `Inherit ] wrap -> [> | `Text_Rendering ] attrib
val a_rotate : numbers wrap -> [> | `Rotate ] attrib
val a_startOffset : Unit.length wrap -> [> | `StartOffset ] attrib
val a_method : [< `Align | `Stretch ] wrap -> [> | `Method ] attrib
val a_spacing : [< `Auto | `Exact ] wrap -> [> | `Spacing ] attrib
val a_glyphRef : string wrap -> [> | `GlyphRef ] attrib
val a_format : string wrap -> [> | `Format ] attrib
val a_markerUnits :
[< `StrokeWidth | `UserSpaceOnUse ] wrap -> [> | `MarkerUnits ] attrib
val a_refX : coord wrap -> [> | `RefX ] attrib
val a_refY : coord wrap -> [> | `RefY ] attrib
val a_markerWidth : Unit.length wrap -> [> | `MarkerWidth ] attrib
val a_markerHeight : Unit.length wrap -> [> | `MarkerHeight ] attrib
val a_orient : Unit.angle option wrap -> [> | `Orient ] attrib
val a_local : string wrap -> [> | `Local ] attrib
val a_rendering_intent :
[<
| `Auto
| `Perceptual
| `Relative_colorimetric
| `Saturation
| `Absolute_colorimetric ] wrap -> [> | `Rendering_Indent ] attrib
val a_gradientUnits :
[< `UserSpaceOnUse | `ObjectBoundingBox ] wrap ->
[ | `GradientUnits ] attrib
val a_gradientTransform : transforms wrap -> [> | `Gradient_Transform ] attrib
val a_spreadMethod :
[< `Pad | `Reflect | `Repeat ] wrap -> [> | `SpreadMethod ] attrib
val a_fx : coord wrap -> [> | `Fx ] attrib
val a_fy : coord wrap -> [> | `Fy ] attrib
val a_offset :
[< `Number of number | `Percentage of percentage ] wrap ->
[> | `Offset ] attrib
val a_patternUnits :
[< `UserSpaceOnUse | `ObjectBoundingBox ] wrap ->
[> | `PatternUnits ] attrib
val a_patternContentUnits :
[< `UserSpaceOnUse | `ObjectBoundingBox ] wrap ->
[> | `PatternContentUnits ] attrib
val a_patternTransform : transforms wrap -> [> | `PatternTransform ] attrib
val a_clipPathUnits :
[< `UserSpaceOnUse | `ObjectBoundingBox ] wrap ->
[> | `ClipPathUnits ] attrib
val a_maskUnits :
[< | `UserSpaceOnUse | `ObjectBoundingBox ] wrap -> [> | `MaskUnits ] attrib
val a_maskContentUnits :
[< | `UserSpaceOnUse | `ObjectBoundingBox ] wrap ->
[> | `MaskContentUnits ] attrib
val a_primitiveUnits :
[< | `UserSpaceOnUse | `ObjectBoundingBox ] wrap ->
[> | `PrimitiveUnits ] attrib
val a_filterRes : number_optional_number wrap -> [> | `FilterResUnits ] attrib
val a_result : string wrap -> [> | `Result ] attrib
val a_in :
[<
| `SourceGraphic
| `SourceAlpha
| `BackgroundImage
| `BackgroundAlpha
| `FillPaint
| `StrokePaint
| `Ref of string ] wrap -> [> | `In ] attrib
val a_in2 :
[<
| `SourceGraphic
| `SourceAlpha
| `BackgroundImage
| `BackgroundAlpha
| `FillPaint
| `StrokePaint
| `Ref of string ] wrap -> [> | `In2 ] attrib
val a_azimuth : float wrap -> [> | `Azimuth ] attrib
val a_elevation : float wrap -> [> | `Elevation ] attrib
val a_pointsAtX : float wrap -> [> | `PointsAtX ] attrib
val a_pointsAtY : float wrap -> [> | `PointsAtY ] attrib
val a_pointsAtZ : float wrap -> [> | `PointsAtZ ] attrib
val a_specularExponent : float wrap -> [> | `SpecularExponent ] attrib
val a_specularConstant : float wrap -> [> | `SpecularConstant ] attrib
val a_limitingConeAngle : float wrap -> [> | `LimitingConeAngle ] attrib
val a_mode :
[< | `Normal | `Multiply | `Screen | `Darken | `Lighten ] wrap ->
[> | `Mode ] attrib
val a_feColorMatrix_type :
[< | `Matrix | `Saturate | `HueRotate | `LuminanceToAlpha ] wrap ->
[> | `Typefecolor ] attrib
[@@reflect.attribute "type" ["feColorMatrix"]]
val a_values : numbers wrap -> [> | `Values ] attrib
val a_transfer_type :
[< | `Identity | `Table | `Discrete | `Linear | `Gamma ] wrap ->
[> | `Type_transfert ] attrib
[@@reflect.attribute "type" ["feFuncR"; "feFuncG"; "feFuncB"; "feFuncA"]]
val a_tableValues : numbers wrap -> [> | `TableValues ] attrib
val a_intercept : number wrap -> [> | `Intercept ] attrib
val a_amplitude : number wrap -> [> | `Amplitude ] attrib
val a_exponent : number wrap -> [> | `Exponent ] attrib
val a_transfer_offset : number wrap -> [> | `Offset_transfer ] attrib
[@@reflect.attribute "offset" ["feFuncR"; "feFuncG"; "feFuncB"; "feFuncA"]]
val a_feComposite_operator :
[< | `Over | `In | `Out | `Atop | `Xor | `Arithmetic ] wrap ->
[> | `OperatorComposite ] attrib
[@@reflect.attribute "operator" ["feComposite"]]
val a_k1 : number wrap -> [> | `K1 ] attrib
val a_k2 : number wrap -> [> | `K2 ] attrib
val a_k3 : number wrap -> [> | `K3 ] attrib
val a_k4 : number wrap -> [> | `K4 ] attrib
val a_order : number_optional_number wrap -> [> | `Order ] attrib
val a_kernelMatrix : numbers wrap -> [> | `KernelMatrix ] attrib
val a_divisor : number wrap -> [> | `Divisor ] attrib
val a_bias : number wrap -> [> | `Bias ] attrib
val a_kernelUnitLength :
number_optional_number wrap -> [> | `KernelUnitLength ] attrib
val a_targetX : int wrap -> [> | `TargetX ] attrib
val a_targetY : int wrap -> [> | `TargetY ] attrib
val a_edgeMode :
[< | `Duplicate | `Wrap | `None ] wrap -> [> | `TargetY ] attrib
val a_preserveAlpha : bool wrap -> [> | `TargetY ] attrib
val a_surfaceScale : number wrap -> [> | `SurfaceScale ] attrib
val a_diffuseConstant : number wrap -> [> | `DiffuseConstant ] attrib
val a_scale : number wrap -> [> | `Scale ] attrib
val a_xChannelSelector :
[< | `R | `G | `B | `A ] wrap -> [> | `XChannelSelector ] attrib
val a_yChannelSelector :
[< | `R | `G | `B | `A ] wrap -> [> | `YChannelSelector ] attrib
val a_stdDeviation : number_optional_number wrap -> [> | `StdDeviation ] attrib
val a_feMorphology_operator :
[< | `Erode | `Dilate ] wrap -> [> | `OperatorMorphology ] attrib
[@@reflect.attribute "operator" ["feMorphology"]]
val a_radius : number_optional_number wrap -> [> | `Radius ] attrib
val a_baseFrenquency :
number_optional_number wrap -> [> | `BaseFrequency ] attrib
val a_numOctaves : int wrap -> [> | `NumOctaves ] attrib
val a_seed : number wrap -> [> | `Seed ] attrib
val a_stitchTiles :
[< | `Stitch | `NoStitch ] wrap -> [> | `StitchTiles ] attrib
val a_feTurbulence_type :
[< | `FractalNoise | `Turbulence ] wrap -> [> | `TypeStitch ] attrib
[@@reflect.attribute "type" ["feTurbulence"]]
val a_xlink_show : [< | `New | `Replace ] wrap -> [> | `Xlink_show ] attrib
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val a_xlink_actuate :
[< | `OnRequest | `OnLoad | `Other | `None ] wrap
-> [> | `Xlink_actuate ] attrib
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val a_target : string wrap -> [> | `Xlink_target ] attrib
val a_viewTarget : string wrap -> [> | `ViewTarget ] attrib
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val a_attributeName : string wrap -> [> | `AttributeName ] attrib
val a_attributeType :
[< | `CSS | `XML | `Auto ] wrap -> [> | `AttributeType ] attrib
val a_begin : string wrap -> [> | `Begin ] attrib
val a_dur : string wrap -> [> | `Dur ] attrib
val a_min : string wrap -> [> | `Min ] attrib
val a_max : string wrap -> [> | `Max ] attrib
val a_restart :
[< | `Always | `WhenNotActive | `Never ] wrap -> [> | `Restart ] attrib
val a_repeatCount : string wrap -> [> | `RepeatCount ] attrib
val a_repeatDur : string wrap -> [> | `RepeatDur ] attrib
val a_fill : paint wrap -> [> | `Fill ] attrib
val a_animation_fill : [< | `Freeze | `Remove ] wrap -> [> | `Fill_Animation ] attrib
[@@reflect.attribute "fill" ["animation"]]
val a_calcMode :
[< | `Discrete | `Linear | `Paced | `Spline ] wrap -> [> | `CalcMode ] attrib
val a_animation_values : strings wrap -> [> | `Valuesanim ] attrib
[@@reflect.attribute "values" ["animation"]]
val a_keyTimes : strings wrap -> [> | `KeyTimes ] attrib
val a_keySplines : strings wrap -> [> | `KeySplines ] attrib
val a_from : string wrap -> [> | `From ] attrib
val a_to : string wrap -> [> | `To ] attrib
val a_by : string wrap -> [> | `By ] attrib
val a_additive : [< | `Replace | `Sum ] wrap -> [> | `Additive ] attrib
val a_accumulate : [< | `None | `Sum ] wrap -> [> | `Accumulate ] attrib
val a_keyPoints : numbers_semicolon wrap -> [> | `KeyPoints ] attrib
val a_path : string wrap -> [> | `Path ] attrib
val a_animateTransform_type :
[ | `Translate | `Scale | `Rotate | `SkewX | `SkewY ] wrap ->
[ | `Typeanimatetransform ] attrib
[@@reflect.attribute "type" ["animateTransform"]]
val a_horiz_origin_x : number wrap -> [> | `HorizOriginX ] attrib
val a_horiz_origin_y : number wrap -> [> | `HorizOriginY ] attrib
val a_horiz_adv_x : number wrap -> [> | `HorizAdvX ] attrib
val a_vert_origin_x : number wrap -> [> | `VertOriginX ] attrib
val a_vert_origin_y : number wrap -> [> | `VertOriginY ] attrib
val a_vert_adv_y : number wrap -> [> | `VertAdvY ] attrib
val a_unicode : string wrap -> [> | `Unicode ] attrib
val a_glyph_name : string wrap -> [> | `glyphname ] attrib
val a_orientation : [< | `H | `V ] wrap -> [> | `Orientation ] attrib
val a_arabic_form :
[< | `Initial | `Medial | `Terminal | `Isolated ] wrap ->
[> | `Arabicform ] attrib
val a_lang : string wrap -> [> | `Lang ] attrib
val a_u1 : string wrap -> [> | `U1 ] attrib
val a_u2 : string wrap -> [> | `U2 ] attrib
val a_g1 : string wrap -> [> | `G1 ] attrib
val a_g2 : string wrap -> [> | `G2 ] attrib
val a_k : string wrap -> [> | `K ] attrib
val a_font_family : string wrap -> [> | `Font_Family ] attrib
val a_font_style : string wrap -> [> | `Font_Style ] attrib
val a_font_variant : string wrap -> [> | `Font_Variant ] attrib
val a_font_weight : string wrap -> [> | `Font_Weight ] attrib
val a_font_stretch : string wrap -> [> | `Font_Stretch ] attrib
val a_font_size : string wrap -> [> | `Font_Size ] attrib
val a_unicode_range : string wrap -> [> | `UnicodeRange ] attrib
val a_units_per_em : string wrap -> [> | `UnitsPerEm ] attrib
val a_stemv : number wrap -> [> | `Stemv ] attrib
val a_stemh : number wrap -> [> | `Stemh ] attrib
val a_slope : number wrap -> [> | `Slope ] attrib
val a_cap_height : number wrap -> [> | `CapHeight ] attrib
val a_x_height : number wrap -> [> | `XHeight ] attrib
val a_accent_height : number wrap -> [> | `AccentHeight ] attrib
val a_ascent : number wrap -> [> | `Ascent ] attrib
val a_widths : string wrap -> [> | `Widths ] attrib
val a_bbox : string wrap -> [> | `Bbox ] attrib
val a_ideographic : number wrap -> [> | `Ideographic ] attrib
val a_alphabetic : number wrap -> [> | `Alphabetic ] attrib
val a_mathematical : number wrap -> [> | `Mathematical ] attrib
val a_hanging : number wrap -> [> | `Hanging ] attrib
val a_videographic : number wrap -> [> | `VIdeographic ] attrib
val a_v_alphabetic : number wrap -> [> | `VAlphabetic ] attrib
val a_v_mathematical : number wrap -> [> | `VMathematical ] attrib
val a_v_hanging : number wrap -> [> | `VHanging ] attrib
val a_underline_position : number wrap -> [> | `UnderlinePosition ] attrib
val a_underline_thickness : number wrap -> [> | `UnderlineThickness ] attrib
val a_strikethrough_position :
number wrap -> [> | `StrikethroughPosition ] attrib
val a_strikethrough_thickness :
number wrap -> [> | `StrikethroughThickness ] attrib
val a_overline_position : number wrap -> [> | `OverlinePosition ] attrib
val a_overline_thickness : number wrap -> [> | `OverlineThickness ] attrib
val a_string : string wrap -> [> | `String ] attrib
val a_name : string wrap -> [> | `Name ] attrib
val a_alignment_baseline :
[< | `Auto | `Baseline | `Before_edge | `Text_before_edge | `Middle
| `Central | `After_edge | `Text_after_edge | `Ideographic
| `Alphabetic | `Hanging | `Mathematical | `Inherit ] wrap ->
[> | `Alignment_Baseline ] attrib
val a_dominant_baseline :
[< | `Auto | `Use_script | `No_change | `Reset_size | `Ideographic
| `Alphabetic | `Hanging | `Mathematical | `Central | `Middle
| `Text_after_edge | `Text_before_edge | `Inherit ] wrap ->
[> | `Dominant_Baseline ] attrib
val a_stop_color : color wrap -> [> | `Stop_Color ] attrib
val a_stop_opacity : number wrap -> [> | `Stop_Opacity ] attrib
val a_stroke : paint wrap -> [> | `Stroke ] attrib
val a_stroke_width : Unit.length wrap -> [> | `Stroke_Width ] attrib
val a_stroke_linecap :
[< `Butt | `Round | `Square ] wrap -> [> | `Stroke_Linecap ] attrib
val a_stroke_linejoin :
[< `Miter | `Round | `Bever ] wrap -> [> `Stroke_Linejoin ] attrib
val a_stroke_miterlimit : float wrap -> [> `Stroke_Miterlimit ] attrib
val a_stroke_dasharray :
Unit.length list wrap -> [> `Stroke_Dasharray ] attrib
val a_stroke_dashoffset : Unit.length wrap -> [> `Stroke_Dashoffset ] attrib
val a_stroke_opacity : float wrap -> [> `Stroke_Opacity ] attrib
(** {2 Events}
{3 Javascript events} *)
val a_onabort : Xml.event_handler -> [> | `OnAbort ] attrib
val a_onactivate : Xml.event_handler -> [> | `OnActivate ] attrib
val a_onbegin : Xml.event_handler -> [> | `OnBegin ] attrib
val a_onend : Xml.event_handler -> [> | `OnEnd ] attrib
val a_onerror : Xml.event_handler -> [> | `OnError ] attrib
val a_onfocusin : Xml.event_handler -> [> | `OnFocusIn ] attrib
val a_onfocusout : Xml.event_handler -> [> | `OnFocusOut ] attrib
val a_onload : Xml.event_handler -> [> | `OnLoad ] attrib
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val a_onrepeat : Xml.event_handler -> [> | `OnRepeat ] attrib
val a_onresize : Xml.event_handler -> [> | `OnResize ] attrib
val a_onscroll : Xml.event_handler -> [> | `OnScroll ] attrib
val a_onunload : Xml.event_handler -> [> | `OnUnload ] attrib
val a_onzoom : Xml.event_handler -> [> | `OnZoom ] attrib
(** {3 Javascript mouse events} *)
val a_onclick : Xml.mouse_event_handler -> [> | `OnClick ] attrib
val a_onmousedown : Xml.mouse_event_handler -> [> | `OnMouseDown ] attrib
val a_onmouseup : Xml.mouse_event_handler -> [> | `OnMouseUp ] attrib
val a_onmouseover : Xml.mouse_event_handler -> [> | `OnMouseOver ] attrib
val a_onmouseout : Xml.mouse_event_handler -> [> | `OnMouseOut ] attrib
val a_onmousemove : Xml.mouse_event_handler -> [> | `OnMouseMove ] attrib
(** {3 Javascript touch events} *)
val a_ontouchstart : Xml.touch_event_handler -> [> | `OnTouchStart] attrib
val a_ontouchend : Xml.touch_event_handler -> [> | `OnTouchEnd] attrib
val a_ontouchmove : Xml.touch_event_handler -> [> | `OnTouchMove] attrib
val a_ontouchcancel : Xml.touch_event_handler -> [> | `OnTouchCancel] attrib
(** {2:elements Elements} *)
val txt : string wrap -> [> | txt] elt
val svg : ([< | svg_attr], [< | svg_content], [> | svg]) star
val g : ([< | g_attr], [< | g_content], [> | g]) star
val defs : ([< | defs_attr], [< | defs_content], [> | defs]) star
val desc : ([< | desc_attr], [< | desc_content], [> | desc]) unary
val title : ([< | title_attr], [< | title_content], [> | title]) unary
val symbol : ([< | symbol_attr], [< | symbol_content], [> | symbol]) star
val use : ([< | use_attr], [< | use_content], [> | use]) star
val image : ([< | image_attr], [< | image_content], [> | image]) star
val switch : ([< | switch_attr], [< | switch_content], [> | switch]) star
val style : ([< | style_attr], [< | style_content], [> | style]) unary
val path : ([< | path_attr], [< | path_content], [> | path]) star
val rect : ([< | rect_attr], [< | rect_content], [> | rect]) star
val circle : ([< | circle_attr], [< | circle_content], [> | circle]) star
val ellipse :
([< | ellipse_attr], [< | ellipse_content], [> | ellipse]) star
val line : ([< | line_attr], [< | line_content], [> | line]) star
val polyline :
([< | polyline_attr], [< | polyline_content], [> | polyline]) star
val polygon :
([< | polygon_attr], [< | polygon_content], [> | polygon]) star
val text : ([< | text_attr], [< | text_content], [> | text]) star
val tspan : ([< | tspan_attr], [< | tspan_content], [> | tspan]) star
val tref : ([< | tref_attr], [< | tref_content], [> | tref]) star
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val textPath :
([< | textpath_attr], [< | textpath_content], [> | textpath]) star
val altGlyph :
([< | altglyph_attr], [< | altglyph_content], [> | altglyph]) unary
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
type altglyphdef_content =
[ | `Ref of (glyphref elt) list | `Item of (altglyphitem elt) list
]
val altGlyphDef :
([< | altglyphdef_attr], [< | altglyphdef_content], [> | altglyphdef])
unary
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val altGlyphItem :
([< | altglyphitem_attr], [< | altglyphitem_content], [> | altglyphitem
]) star
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val glyphRef : ([< | glyphref_attr], [> | glyphref]) nullary
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val marker : ([< | marker_attr], [< | marker_content], [> | marker]) star
val color_profile :
([< | colorprofile_attr], [< | colorprofile_content], [> | colorprofile
]) star
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val linearGradient :
([< | lineargradient_attr], [< | lineargradient_content],
[> | lineargradient]) star
val radialGradient :
([< | radialgradient_attr], [< | radialgradient_content],
[> | radialgradient]) star
val stop :
([< | stop_attr], [< | stop_content], [> | stop ]) star
val pattern :
([< | pattern_attr], [< | pattern_content], [> | pattern]) star
val clipPath :
([< | clippath_attr], [< | clippath_content], [> | clippath]) star
val filter : ([< | filter_attr], [< | filter_content], [> | filter]) star
val feDistantLight :
([< | fedistantlight_attr], [< | fedistantlight_content],
[> | fedistantlight]) star
val fePointLight :
([< | fepointlight_attr], [< | fepointlight_content], [> | fepointlight
]) star
val feSpotLight :
([< | fespotlight_attr], [< | fespotlight_content], [> | fespotlight])
star
val feBlend :
([< | feblend_attr], [< | feblend_content], [> | feblend]) star
val feColorMatrix :
([< | fecolormatrix_attr], [< | fecolormatrix_content],
[> | fecolormatrix]) star
val feComponentTransfer :
([< | fecomponenttransfer_attr], [< | fecomponenttransfer_content],
[> | fecomponenttransfer]) star
val feFuncA :
([< | fefunca_attr], [< | fefunca_content], [> | fefunca]) star
val feFuncG :
([< | fefuncg_attr], [< | fefuncg_content], [> | fefuncg]) star
val feFuncB :
([< | fefuncb_attr], [< | fefuncb_content], [> | fefuncb]) star
val feFuncR :
([< | fefuncr_attr], [< | fefuncr_content], [> | fefuncr]) star
val feComposite :
([< | fecomposite_attr], [< | fecomposite_content], [> | fecomposite])
star
val feConvolveMatrix :
([< | feconvolvematrix_attr], [< | feconvolvematrix_content],
[> | feconvolvematrix]) star
val feDiffuseLighting :
([< | fediffuselighting_attr], [< | fediffuselighting_content],
[> | fediffuselighting]) star
val feDisplacementMap :
([< | fedisplacementmap_attr], [< | fedisplacementmap_content],
[> | fedisplacementmap]) star
val feFlood :
([< | feflood_attr], [< | feflood_content], [> | feflood]) star
val feGaussianBlur :
([< | fegaussianblur_attr], [< | fegaussianblur_content],
[> | fegaussianblur]) star
val feImage :
([< | feimage_attr], [< | feimage_content], [> | feimage]) star
val feMerge :
([< | femerge_attr], [< | femerge_content], [> | femerge]) star
val feMorphology :
([< | femorphology_attr], [< | femorphology_content], [> | femorphology
]) star
val feOffset :
([< | feoffset_attr], [< | feoffset_content], [> | feoffset]) star
val feSpecularLighting :
([< | fespecularlighting_attr], [< | fespecularlighting_content],
[> | fespecularlighting]) star
val feTile : ([< | fetile_attr], [< | fetile_content], [> | fetile]) star
val feTurbulence :
([< | feturbulence_attr], [< | feturbulence_content], [> | feturbulence
]) star
val cursor : ([< | cursor_attr], [< | cursor_content], [> | cursor]) star
val a : ([< | a_attr], [< | a_content], [> | a]) star
val view : ([< | view_attr], [< | view_content], [> | view]) star
val script :
([< | script_attr], [< | script_content], [> | script]) unary
val animation :
([< | animation_attr], [< | animation_content], [> | animation]) star
val set : ([< | set_attr], [< | set_content], [> | set]) star
val animateMotion :
([< | animatemotion_attr], [< | animatemotion_content],
[> | animatemotion]) star
val mpath : ([< | mpath_attr], [< | mpath_content], [> | mpath]) star
val animateColor :
([< | animatecolor_attr], [< | animatecolor_content], [> | animatecolor
]) star
val animateTransform :
([< | animatetransform_attr], [< | animatetransform_content],
[> | animatetransform]) star
val font : ([< | font_attr], [< | font_content], [> | font]) star
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val glyph : ([< | glyph_attr], [< | glyph_content], [> | glyph]) star
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val missing_glyph :
([< | missingglyph_attr], [< | missingglyph_content], [> | missingglyph
]) star
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val hkern : ([< | hkern_attr], [> | hkern]) nullary
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val vkern : ([< | vkern_attr], [> | vkern]) nullary
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val font_face : ([< | font_face_attr], [> | font_face]) nullary
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val font_face_src :
([< | font_face_src_attr], [< | font_face_src_content], [> | font_face_src])
star
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val font_face_uri :
([< | font_face_uri_attr], [< | font_face_uri_content], [> | font_face_uri])
star
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val font_face_format :
([< | font_face_format_attr], [> | font_face_format]) nullary
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val font_face_name : ([< | font_face_name_attr], [> | font_face_name]) nullary
[@@ocaml.deprecated "Removed in SVG2"]
(** @deprecated Removed in SVG2 *)
val metadata :
?a: ((metadata_attr attrib) list) -> Xml.elt list_wrap -> [> | metadata] elt
val foreignObject :
?a: ((foreignobject_attr attrib) list) ->
Xml.elt list_wrap -> [> | foreignobject] elt
(** {3 Deprecated} *)
val pcdata : string wrap -> [> txt] elt
[@@ocaml.deprecated "Use txt instead"]
(** @deprecated Use txt instead *)
(** {2 Conversion with untyped representation}
WARNING: These functions do not ensure HTML or SVG validity! You should
always explicitly given an appropriate type to the output.
*)
(** [import signal] converts the given XML signal into Tyxml elements.
It can be used with HTML and SVG parsing libraries, such as Markup.
@raise Xml_stream.Malformed_stream if the stream is malformed.
*)
val of_seq : Xml_stream.signal Seq.t -> 'a elt list_wrap
val tot : Xml.elt -> 'a elt
val totl : Xml.elt list_wrap -> ('a elt) list_wrap
val toelt : 'a elt -> Xml.elt
val toeltl : ('a elt) list_wrap -> Xml.elt list_wrap
val doc_toelt : doc -> Xml.elt
val to_xmlattribs : ('a attrib) list -> Xml.attrib list
val to_attrib : Xml.attrib -> 'a attrib
(** Unsafe features.
Using this module can break
SVG validity and may introduce security problems like
code injection.
Use it with care.
*)
module Unsafe : sig
(** Insert raw text without any encoding *)
val data : string wrap -> 'a elt
(** Insert an XML node that is not implemented in this module.
If it is a standard SVG node which is missing,
please report to the Ocsigen team.
*)
val node : string -> ?a:'a attrib list -> 'b elt list_wrap -> 'c elt
(** Insert an XML node without children
that is not implemented in this module.
If it is a standard SVG node which is missing,
please report to the Ocsigen team.
*)
val leaf : string -> ?a:'a attrib list -> unit -> 'b elt
(** Remove phantom type annotation on an element,
to make it usable everywhere.
*)
val coerce_elt : 'a elt -> 'b elt
(** Insert an attribute that is not implemented in this module.
If it is a standard SVG attribute which is missing,
please report to the Ocsigen team.
*)
val string_attrib : string -> string wrap -> 'a attrib
(** Same, for float attribute *)
val float_attrib : string -> float wrap -> 'a attrib
(** Same, for int attribute *)
val int_attrib : string -> int wrap -> 'a attrib
(** Same, for URI attribute *)
val uri_attrib : string -> uri wrap -> 'a attrib
(** Same, for a space separated list of values *)
val space_sep_attrib : string -> string list wrap -> 'a attrib
(** Same, for a comma separated list of values *)
val comma_sep_attrib : string -> string list wrap -> 'a attrib
end
end
(** Equivalent to {!T}, but without wrapping. *)
module type NoWrap = T with module Xml.W = Xml_wrap.NoWrap
(** {2 Signature functors}
See {% <> %}. *)
(** Signature functor for {!Svg_f.Make}. *)
module Make (Xml : Xml_sigs.T) : sig
(** See {!module-type:Svg_sigs.T}. *)
module type T = T
with type 'a Xml.W.t = 'a Xml.W.t
and type 'a Xml.W.tlist = 'a Xml.W.tlist
and type ('a,'b) Xml.W.ft = ('a,'b) Xml.W.ft
and type Xml.uri = Xml.uri
and type Xml.event_handler = Xml.event_handler
and type Xml.mouse_event_handler = Xml.mouse_event_handler
and type Xml.keyboard_event_handler = Xml.keyboard_event_handler
and type Xml.touch_event_handler = Xml.touch_event_handler
and type Xml.attrib = Xml.attrib
and type Xml.elt = Xml.elt
end
(** Wrapped functions, to be used with {!Svg_f.Make_with_wrapped_functions}. *)
module type Wrapped_functions = sig
module Xml : Xml_sigs.T
val string_of_alignment_baseline :
([< Svg_types.alignment_baseline], string) Xml.W.ft
val string_of_bool : (bool, string) Xml.W.ft
val string_of_big_variant : ([< Svg_types.big_variant], string) Xml.W.ft
val string_of_coords : (Svg_types.coords, string) Xml.W.ft
val string_of_dominant_baseline :
([< Svg_types.dominant_baseline], string) Xml.W.ft
val string_of_fourfloats : (float * float * float * float, string) Xml.W.ft
val string_of_in_value : ([< Svg_types.in_value], string) Xml.W.ft
val string_of_int : (int, string) Xml.W.ft
val string_of_length : (Svg_types.Unit.length, string) Xml.W.ft
val string_of_lengths : (Svg_types.lengths, string) Xml.W.ft
val string_of_number : (float, string) Xml.W.ft
val string_of_number_optional_number :
(float * float option, string) Xml.W.ft
val string_of_numbers : (float list, string) Xml.W.ft
val string_of_numbers_semicolon : (float list, string) Xml.W.ft
val string_of_offset : ([< Svg_types.offset], string) Xml.W.ft
val string_of_orient : (Svg_types.Unit.angle option, string) Xml.W.ft
val string_of_paint : ([< Svg_types.paint], string) Xml.W.ft
val string_of_strokedasharray : (Svg_types.lengths, string) Xml.W.ft
val string_of_transform : (Svg_types.transform, string) Xml.W.ft
val string_of_transforms : (Svg_types.transforms, string) Xml.W.ft
end
tyxml-4.5.0/lib/svg_types.mli 0000664 0000000 0000000 00000106602 14040247726 0016204 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2010 by Simon Castellan
* Copyright (C) 2010 by Cecile Herbelin
* Copyright (C) 2010 by Vincent Balat
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** SVG types with variants, goes with {!Svg_sigs.T}. *)
(** This module defines basic data types for data, attributes
and element occurring in SVG documents.
It is based on the specification available at http://www.w3.org/TR/SVG/.
This module is experimental, it may lack of some attributes,
and the interface is very low level and do not take deeply into account
the needs of SVG elements. *)
(* Some attribute and elements are tagged with XXX: they
may be improved and do not match completely the SVG spec *)
(** {1 Categories of elements and attributes} *)
(** This part defines the categories of elements and attributes *)
(** {2 Elements} *)
type animation_element =
[ | `AnimateColor | `AnimateMotion | `AnimateTransform | `Animate | `Set ]
type descriptive_element = [ | `Desc | `Metadata | `Title ]
type basic_shape_element =
[ | `Circle | `Ellipse | `Line | `Polygon | `Polyline | `Rect ]
type container_element =
[
| `A
| `Defs
| `Glyph
| `G
| `Marker
| `Mask
| `Missing_glyph
| `Pattern
| `Svg
| `Switch
| `Symbol
]
type filter_primitive_element =
[
| `FeBlend
| `FeColorMatrix
| `FeComponentTransfer
| `FeComposite
| `FeConvolveMatrix
| `FeDiffuseLighting
| `FeDisplacementMap
| `FeFlood
| `FeGaussianBlur
| `FeImage
| `FeMerge
| `FeMorphology
| `FeOffset
| `FeSpecularLighting
| `FeTile
| `FeTurbulence
]
type light_source_element =
[
| `FeDistantLight
| `FePointLight
| `FeSpotLight
]
type shape_element = [ | `Circle | `Ellipse | `Line | `Path | `Polyline | `Polygon | `Rect]
type structural_element = [ | `Defs | `G | `Svg | `Symbol | `Use ]
type text_content_element =
[ | `AltGlyph | `TextPath | `Text | `Tref | `Tspan ]
type text_content_child_element =
[ | `AltGlyph | `TextPath | `Tref | `Tspan ]
type gradient_element = [ | `Lineargradient | `Radialgradient ]
type graphics_element =
[
| `Circle
| `Ellipse
| `Image
| `Line
| `Path
| `Polygon
| `Polyline
| `Rect
| `Text
| `Use
]
type graphics_ref_element = [ | `Image | `Use ]
(** {2 Attributes } *)
type conditional_processing_attr =
[ | `RequiredExtensions | `RequiredFeatures | `SystemLanguage ]
type core_attr = [ | `Id | `Xml_base | `Xml_lang | `Xml_space | `User_data ]
type transfer_attr =
[
| `Type_transfert
| `TableValues
| `Slope
| `Intercept
| `Amplitude
| `Exponent
| `Offset_transfer
]
type document_event_attr =
[ | `OnAbort | `OnError | `OnResize | `OnScroll | `OnUnload | `OnZoom ]
type filter_primitive_attr = [ | `Height | `Result | `Width | `X | `Y ]
type animation_event_attr = [ | `OnBegin | `OnEnd | `OnRepeat | `OnLoad ]
type animation_attr_target_attr = [ | `AttributeType | `AttributeName ]
type animation_timing_attr =
[
| `Begin
| `Dur
| `End
| `Min
| `Max
| `Restart
| `RepeatCount
| `RepeatDur
| `Fill_Animation
]
type animation_value_attr =
[ | `CalcMode | `Valuesanim | `KeyTimes | `KeySplines | `From | `To | `By
]
type animation_addition_attr = [ | `Additive | `Accumulate ]
type presentation_attr =
[
| `Alignment_Baseline
| `Baseline_Shift
| `Clip
| `Clip_Path
| `Clip_Rule
| `Color
| `Color_Interpolation
| `Color_interpolation_filters
| `Color_profile
| `Color_rendering
| `Cursor
| `Direction
| `Display
| `Dominant_Baseline
| `Enable_background
| `Fill
| `Fill_opacity
| `Fill_rule
| `Filter
| `Flood_Color
| `Flood_Opacity
| `Font_Family
| `Font_Size
| `Font_Size_Adjust
| `Font_Stretch
| `Font_Style
| `Font_Variant
| `Font_Weight
| `Glyph_Orientation_Horizontal
| `Glyph_Orientation_Vertical
| `Image_Rendering
| `Kerning
| `Letter_Spacing
| `Lighting_Color
| `Marker_End
| `Marker_Mid
| `Marker_Start
| `Mask
| `Opacity
| `Overflow
| `Pointer_Events
| `Shape_Rendering
| `Stop_Color
| `Stop_Opacity
| `Stroke
| `Stroke_Dasharray
| `Stroke_Dashoffset
| `Stroke_Linecap
| `Stroke_Linejoin
| `Stroke_Miterlimit
| `Stroke_Opacity
| `Stroke_Width
| `Text_Anchor
| `Text_Decoration
| `Text_Rendering
| `Unicode_Bidi
| `Visibility
| `Word_Spacing
| `Writing_Mode
]
type graphical_event_attr =
[
| `OnActivate
| `OnClick
| `OnFocusIn
| `OnFocusOut
| `OnLoad
| `OnMouseDown
| `OnMouseMove
| `OnMouseOut
| `OnMouseOver
| `OnMouseUp
]
type xlink_attr =
[
| `Xlink_href
| `Xlink_type
| `Xlink_role
| `Xlink_arcrole
| `Xlink_title
| `Xlink_show
| `Xlink_actuate
]
(** {2 Generic data types} *)
type iri = string
(** An IRI reference is an Internationalized Resource Identifier with
an optional fragment identifier, as defined in Internationalized
Resource Identifiers [RFC3987]. An IRI reference serves as a reference
to a resource or (with a fragment identifier) to a secondary
resource. See References and the ‘defs’ element.. *)
(** {2 Units} *)
(** SVG defines several units to measure time, length, angles. *)
module Unit : sig
type 'a quantity = (float * 'a option)
type angle = [ `Deg | `Grad | `Rad ] quantity
type length = [ `Em | `Ex | `Px | `In | `Cm | `Mm | `Pt | `Pc | `Percent ] quantity
type time = [ `S | `Ms ] quantity
type frequency = [ `Hz | `KHz ] quantity
end
open Unit
type coord = length
type number = float
type number_optional_number = (number * (number option))
type percentage = float
type strings = string list
type color = string
type icccolor = string
type paint_whitout_icc =
[ `None | `CurrentColor
| `Color of (color * icccolor option)
]
type paint =
[ paint_whitout_icc
| `Icc of (iri * paint_whitout_icc option) ]
(* Transformation *)
type transform =
[ `Matrix of (float * float * float * float * float * float)
| `Translate of (float * (float option))
| `Scale of (float * (float option))
| `Rotate of (angle * ((float * float) option))
| `SkewX of angle
| `SkewY of angle ]
type spacestrings = string list
type commastrings = string list
type transforms = transform list
type fourfloats = (float * float * float * float)
type lengths = length list
type numbers = float list
type numbers_semicolon = float list
type coords = (float * float) list
type rotate = float list
type pcdata = [ `PCDATA ]
type txt = [ | `PCDATA ]
(** {1 Element} *)
(*-ELEMENTS-*)
type svg = [ | `Svg ]
(* star *)
type svg_content =
[
| animation_element
| descriptive_element
| shape_element
| structural_element
| gradient_element
| `A
| `AltGlyphDef
| `ClipPath
| `Color_Profile
| `Cursor
| `Filter
| `Font
| `Font_Face
| `ForeignObject
| `Image
| `Marker
| `Mask
| `Pattern
| `Script
| `Style
| `Switch
| `Text
| `View
]
type svg_attr =
[
| conditional_processing_attr
| core_attr
| document_event_attr
| graphical_event_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `X
| `Y
| `Width
| `Height
| `ViewBox
| `PreserveAspectRatio
| `ZoomAndPlan
| `Version
| `BaseProfile
| `ContentScriptType
| `ContentStyleType
| `X
| `Y
]
type g = [ | `G ]
(* star *)
type g_content =
[
| animation_element
| descriptive_element
| shape_element
| structural_element
| gradient_element
| `A
| `AltGlyphDef
| `ClipPath
| `Color_Profile
| `Cursor
| `Filter
| `Font
| `Font_Face
| `ForeignObject
| `Image
| `Marker
| `Mask
| `Pattern
| `Script
| `Style
| `Switch
| `Text
| `View
]
type g_attr =
[
| conditional_processing_attr
| core_attr
| graphical_event_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Transform
]
type defs = [ | `Defs ]
(* star *)
type defs_content =
[
| animation_element
| descriptive_element
| shape_element
| structural_element
| gradient_element
| `A
| `AltGlyphDef
| `ClipPath
| `Color_Profile
| `Cursor
| `Filter
| `Font
| `Font_Face
| `ForeignObject
| `Image
| `Marker
| `Mask
| `Pattern
| `Script
| `Style
| `Switch
| `Text
| `View
]
type defs_attr =
[
| conditional_processing_attr
| core_attr
| graphical_event_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Transform
]
type desc = [ | `Desc ]
(* unary *)
type desc_content = [ | `PCDATA ]
type desc_attr = [ | core_attr | `Class | `Style ]
type title = [ | `Title ]
(* unary *)
type title_content = [ | `PCDATA ]
type title_attr = desc_attr
type symbol = [ | `Symbol ]
(* star *)
type symbol_content =
[
| animation_element
| descriptive_element
| structural_element
| gradient_element
| `A
| `AltGlyphDef
| `ClipPath
| `Color_Profile
| `Cursor
| `Filter
| `Font
| `Font_Face
| `ForeignObject
| `Image
| `Marker
| `Mask
| `Pattern
| `Script
| `Style
| `Switch
| `Text
| `View
]
type symbol_attr =
[
| `Class
| `Style
| `ExternalResourcesRequired
| `PreserveAspectRatio
| `ViewBox
]
type use = [ | `Use ]
(* star *)
type use_content = [ | animation_element | descriptive_element ]
type use_attr =
[
| core_attr
| conditional_processing_attr
| graphical_event_attr
| presentation_attr
| xlink_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Transform
| `X
| `Y
| `Width
| `Height
| `Xlink_href
]
type image = [ | `Image ]
(* star *)
type image_content = [ | animation_element | descriptive_element ]
type image_attr =
[
| core_attr
| conditional_processing_attr
| graphical_event_attr
| xlink_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `PreserveAspectRatio
| `Transform
| `X
| `Y
| `Width
| `Height
| `Xlink_href
]
type switch = [ | `Switch ]
(* star *)
type switch_content =
[
| animation_element
| descriptive_element
| shape_element
| `A
| `ForeignObject
| `G
| `Image
| `Svg
| `Switch
| `Text
| `Use
]
type switch_attr =
[
| conditional_processing_attr
| core_attr
| graphical_event_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Transform
]
type style = [ | `Style ]
(* unary *)
type style_content = [ | `PCDATA ]
type style_attr = [ | core_attr | `Title | `Media | `Type ]
type path = [ | `Path ]
(* star *)
type path_content = [ | animation_element | descriptive_element ]
type path_attr =
[
| conditional_processing_attr
| core_attr
| graphical_event_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Transform
| `D
| `PathLength
]
type rect = [ | `Rect ]
(* star *)
type rect_content = [ | animation_element | descriptive_element ]
type rect_attr =
[
| conditional_processing_attr
| core_attr
| graphical_event_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Transform
| `X
| `Y
| `Width
| `Height
| `Rx
| `Ry
]
type circle = [ | `Circle ]
(* star *)
type circle_content = [ | animation_element | descriptive_element ]
type circle_attr =
[
| conditional_processing_attr
| core_attr
| graphical_event_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Transform
| `R
| `Cx
| `Cy
]
type ellipse = [ | `Ellipse ]
(* star *)
type ellipse_content = [ | animation_element | descriptive_element ]
type ellipse_attr =
[
| conditional_processing_attr
| core_attr
| graphical_event_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Transform
| `Rx
| `Ry
| `Cx
| `Cy
]
type line = [ | `Line ]
(* star *)
type line_content = [ | animation_element | descriptive_element ]
type line_attr =
[
| conditional_processing_attr
| core_attr
| graphical_event_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Transform
| `X1
| `Y1
| `X2
| `Y2
]
type polyline = [ | `Polyline ]
(* star *)
type polyline_content = [ | animation_element | descriptive_element ]
type polyline_attr =
[
| conditional_processing_attr
| core_attr
| graphical_event_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Transform
| `Points
]
type polygon = [ | `Polygon ]
(* star *)
type polygon_content = [ | animation_element | descriptive_element ]
type polygon_attr =
[
| conditional_processing_attr
| core_attr
| graphical_event_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Transform
| `Points
]
type text = [ | `Text ]
(* star *)
type text_content =
[
| animation_element
| descriptive_element
| text_content_child_element
| `PCDATA
| `A
]
type text_attr =
[
| conditional_processing_attr
| core_attr
| graphical_event_attr
| presentation_attr
| `Class
| `Transform
| `LengthAdjust
| `X_list
| `Y_list
| `Dx_list
| `Dy_list
| `Rotate
| `TextLength
]
type tspan = [ | `Tspan ]
(* star *)
type tspan_content =
[
| descriptive_element
| core_attr
| `PCDATA
| `A
| `AltGlyph
| `Animate
| `AnimateColor
| `Set
| `Tref
| `Tspan
]
type tspan_attr =
[
| core_attr
| conditional_processing_attr
| graphical_event_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `X_list
| `Y_list
| `Dx_list
| `Dy_list
| `Rotate
| `TextLength
| `LengthAdjust
]
type tref = [ | `Tref ]
(* star *)
type tref_content =
[ | descriptive_element | `Animate | `AnimateColor | `Set
]
type tref_attr =
[
| conditional_processing_attr
| core_attr
| graphical_event_attr
| presentation_attr
| xlink_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Xlink_href
]
type textpath = [ | `TextPath ]
(* star *)
type textpath_content =
[
| descriptive_element
| `PCDATA
| `A
| `AltGlyph
| `Animate
| `AnimateColor
| `Set
| `Tref
| `Tspan
]
type textpath_attr =
[
| conditional_processing_attr
| core_attr
| graphical_event_attr
| presentation_attr
| xlink_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Xlink_href
| `StartOffset
| `Method
| `Spacing
]
type altglyph = [ | `AltGlyph ]
(* unary *)
type altglyph_content = [ | `PCDATA ]
type altglyph_attr =
[
| conditional_processing_attr
| core_attr
| graphical_event_attr
| presentation_attr
| xlink_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `X_list
| `Y_list
| `Dx_list
| `Dy_list
| `GlyphRef
| `Format
| `Rotate
| `Xlink_href
]
type altglyphdef = [ | `AltGlyphDef ]
(* unary *)
type altglyphdef_attr = [ | core_attr ]
type altglyphitem = [ | `AltGlyphItem ]
type altglyphitem_content = [ | `glyphRef ]
type altglyphitem_attr = [ | core_attr ]
type glyphref = [ | `GlyphRef ]
(* nullary *)
type glyphref_attr =
[
| core_attr
| presentation_attr
| xlink_attr
| `Class
| `Style
| `X
| `Y
| `Dx
| `Dy
| `GlyphRef
| `Format
| `Xlink_href
]
type marker = [ | `Marker ]
(* star *)
type marker_content =
[
| animation_element
| descriptive_element
| shape_element
| structural_element
| gradient_element
| `A
| `AltGlyphDef
| `ClipPath
| `Color_Profile
| `Cursor
| `Filter
| `Font
| `Font_Face
| `ForeignObject
| `Image
| `Marker
| `Mask
| `Pattern
| `Script
| `Style
| `Switch
| `Text
| `View
]
type marker_attr =
[
| core_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `ViewBox
| `PreserveAspectRatio
| `RefX
| `RefY
| `MarkerUnits
| `MarkerWidth
| `MarkerHeight
| `Orient
]
type colorprofile = [ | `ColorProfile ]
(* star *)
type colorprofile_content = [ | descriptive_element ]
type colorprofile_attr =
[
| core_attr
| xlink_attr
| `Local
| `Name
| `Rendering_Intent
| `Xlink_href
]
type lineargradient = [ | `Lineargradient ]
(* star *)
type lineargradient_content =
[ | descriptive_element | `Animate | `AnimateTransform | `Set | `Stop
]
type lineargradient_attr =
[
| core_attr
| presentation_attr
| xlink_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `X1
| `Y1
| `X2
| `Y2
| `GradientUnits
| `GradientTransform
| `SpreadMethod
| `Xlink_href
]
type radialgradient = [ | `Radialgradient ]
(* star *)
type radialgradient_content =
[ | descriptive_element | `Animate | `AnimateTransform | `Set | `Stop
]
type radialgradient_attr =
[
| core_attr
| presentation_attr
| xlink_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Cx
| `Cy
| `R
| `Fx
| `Fy
| `GradientUnits
| `GradientTransform
| `SpreadMethod
| `Xlink_href
]
type stop = [ | `Stop ]
(* star *)
type stop_content = [ | `Animate | `Animate_Color | `Set ]
type stop_attr =
[ | core_attr | presentation_attr | `Class | `Style | `Offset
]
type pattern = [ | `Pattern ]
(* star *)
type pattern_content =
[
| animation_element
| descriptive_element
| shape_element
| structural_element
| gradient_element
| `A
| `AltGlyphDef
| `ClipPath
| `Color_Profile
| `Cursor
| `Filter
| `Font
| `Font_Face
| `ForeignObject
| `Image
| `Marker
| `Mask
| `Pattern
| `Script
| `Style
| `Switch
| `Text
| `View
]
type pattern_attr =
[
| conditional_processing_attr
| core_attr
| presentation_attr
| xlink_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `ViewBox
| `PreserveAspectRatio
| `X
| `Y
| `Width
| `Height
| `PatternUnits
| `PatternContentUnits
| `PatternTransform
| `Xlink_href
]
type clippath = [ | `ClipPath ]
(* star *)
type clippath_attr =
[
| conditional_processing_attr
| core_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Transform
| `ClipPathUnits
]
type clippath_content =
[ | descriptive_element | animation_element | shape_element | `Text | `Use
]
type mask = [ | `Mask ]
type mask_content =
[
| animation_element
| descriptive_element
| shape_element
| structural_element
| gradient_element
| `A
| `AltGlyphDef
| `ClipPath
| `Color_Profile
| `Cursor
| `Filter
| `Font
| `Font_Face
| `ForeignObject
| `Image
| `Marker
| `Mask
| `Pattern
| `Script
| `Style
| `Switch
| `Text
| `View
]
type mask_attr =
[
| conditional_processing_attr
| core_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `X
| `Y
| `Width
| `Height
| `MaskUnits
| `MaskContentUnits
]
type filter = [ | `Filter ]
(* star *)
type filter_content =
[ | descriptive_element | filter_primitive_element | `Animate | `Set
]
type filter_attr =
[
| core_attr
| presentation_attr
| xlink_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `X
| `Y
| `Width
| `Height
| `FilterRes
| `FilterUnits
| `PrimitiveUnits
| `Xlink_href
]
type fedistantlight = [ | `FeDistantLight ]
(* star *)
type fedistantlight_content = [ | `Animate | `Set ]
type fedistantlight_attr = [ | core_attr | `Azimuth | `Elevation ]
type fepointlight = [ | `FePointLight ]
(* star *)
type fepointlight_content = [ | `Animate | `Set ]
type fepointlight_attr = [ | core_attr | `X | `Y | `Z ]
type fespotlight = [ | `FeSpotLight ]
(* star *)
type fespotlight_content = [ | `Animate | `Set ]
type fespotlight_attr =
[
| core_attr
| `X
| `Y
| `Z
| `PointsAtX
| `PointsAtY
| `PointsAtZ
| `SpecularExponent
| `LimitingConeAngle
]
type feblend = [ | `FeBlend ]
(* star *)
type feblend_content = [ | `Animate | `Set ]
type feblend_attr =
[
| core_attr
| presentation_attr
| filter_primitive_attr
| `Class
| `Style
| `In
| `In2
| `Mode
]
type fecolormatrix = [ | `FeColorMatrix ]
(* star *)
type fecolormatrix_content = [ | `Animate | `Set ]
type fecolormatrix_attr =
[
| core_attr
| presentation_attr
| filter_primitive_attr
| `Class
| `Style
| `Typefecolor
| `Values
| `In
]
type fecomponenttransfer = [ | `FeComponentTransfer ]
(* star *)
type fecomponenttransfer_content =
[ | `FeFuncA | `FeFuncB | `FeFuncG | `FeFuncR
]
type fecomponenttransfer_attr =
[
| core_attr
| presentation_attr
| filter_primitive_attr
| `Class
| `Style
| `In
]
type fefunca = [ | `FeFuncA ]
(* star *)
type fefunca_content = [ | `Animate | `Set ]
type fefunca_attr = [ | core_attr | transfer_attr ]
type fefuncg = [ | `FeFuncA ]
(* star *)
type fefuncg_content = [ | `Animate | `Set ]
type fefuncg_attr = [ | core_attr | transfer_attr ]
type fefuncb = [ | `FeFuncA ]
(* star *)
type fefuncb_content = [ | `Animate | `Set ]
type fefuncb_attr = [ | core_attr | transfer_attr ]
type fefuncr = [ | `FeFuncA ]
(* star *)
type fefuncr_content = [ | `Animate | `Set ]
type fefuncr_attr = [ | core_attr | transfer_attr ]
type fecomposite = [ | `FeComposite ]
(* star *)
type fecomposite_content = [ | `Animate | `Set ]
type fecomposite_attr =
[
| core_attr
| presentation_attr
| filter_primitive_attr
| `Class
| `Style
| `In
| `In2
| `OperatorComposite
| `K1
| `K2
| `K3
| `K4
]
type feconvolvematrix = [ | `FeConvolveMatrix ]
(* star *)
type feconvolvematrix_content = [ | `Animate | `Set ]
type feconvolvematrix_attr =
[
| core_attr
| presentation_attr
| filter_primitive_attr
| `Class
| `Style
| `In
| `Order
| `KernelMatrix
| `Divisor
| `Bias
| `TargetX
| `TargetY
| `EdgeMode
| `KernelUnitLength
| `PreserveAlpha
]
type fediffuselighting = [ | `FeDiffuseLighting ]
(* star *)
type fediffuselighting_content =
[ | descriptive_element | light_source_element
]
(* XXX *)
type fediffuselighting_attr =
[
| core_attr
| filter_primitive_attr
| presentation_attr
| `Class
| `Style
| `In
| `SurfaceScale
| `DiffuseConstant
| `KernelUnitLength
]
type fedisplacementmap = [ | `FeDisplacementMap ]
(* star *)
type fedisplacementmap_content = [ | `Animate | `Set ]
type fedisplacementmap_attr =
[
| core_attr
| filter_primitive_attr
| presentation_attr
| `Class
| `Style
| `In
| `In2
| `Scale
| `XChannelSelector
| `YChannelSelector
]
type feflood = [ | `FeFlood ]
(* star *)
type feflood_content = [ | `Animate | `AnimateColor | `Set ]
type feflood_attr =
[ | core_attr | presentation_attr | filter_primitive_attr | `Class | `Style
]
type fegaussianblur = [ | `FeGaussianBlur ]
(* star *)
type fegaussianblur_content = [ | `Animate | `AnimateColor | `Set ]
type fegaussianblur_attr =
[
| core_attr
| presentation_attr
| filter_primitive_attr
| `Class
| `Style
| `In
| `StdDeviation
]
type feimage = [ | `FeImage ]
(* star *)
type feimage_content = [ | `Animate | `AnimateColor | `Set ]
type feimage_attr =
[
| core_attr
| presentation_attr
| filter_primitive_attr
| xlink_attr
| `Xlink_href
| `Class
| `Style
| `ExternalResourcesRequired
| `PreserveAspectRadio
]
type femerge = [ | `FeMerge ]
(* star *)
type femerge_content = [ | `FeMergeNode ]
type femerge_attr =
[ | core_attr | presentation_attr | filter_primitive_attr | `Class | `Style
]
type femorphology = [ | `FeMorphology ]
(* star *)
type femorphology_content = [ | `Animate | `Set ]
type femorphology_attr =
[
| core_attr
| presentation_attr
| filter_primitive_attr
| `OperatorMorphology
| `Class
| `Style
| `In
| `Radius
]
type feoffset = [ | `FeOffset ]
(* star *)
type feoffset_content = [ | `Animate | `Set ]
type feoffset_attr =
[
| core_attr
| presentation_attr
| filter_primitive_attr
| `Class
| `Style
| `Dx
| `Dy
| `In
]
type fespecularlighting = [ | `FeSpecularLighting ]
(* star *)
type fespecularlighting_content =
[ | descriptive_element | light_source_element
]
(* XXX *)
type fespecularlighting_attr =
[
| core_attr
| presentation_attr
| filter_primitive_attr
| `Class
| `Style
| `In
| `SurfaceScale
| `SpecularConstant
| `SpecularExponent
| `KernelUnitLength
]
type fetile = [ | `FeTile ]
(* star *)
type fetile_content = [ | `Animate | `Set ]
type fetile_attr =
[
| core_attr
| presentation_attr
| filter_primitive_attr
| `Class
| `Style
| `In
]
type feturbulence = [ | `FeTurbulence ]
(* star *)
type feturbulence_content = [ | `Animate | `Set ]
type feturbulence_attr =
[
| core_attr
| presentation_attr
| filter_primitive_attr
| `Class
| `Style
| `BaseFrequency
| `NumOctaves
| `Seed
| `StitchTiles
| `TypeStitch
]
type cursor = [ | `Cursor ]
(* star *)
type cursor_content = descriptive_element
type cursor_attr =
[
| core_attr
| conditional_processing_attr
| xlink_attr
| `X
| `Y
| `ExternalResourcesRequired
| `Xlink_href
]
type a = [ | `A ]
(* star *)
type a_content =
[
| animation_element
| descriptive_element
| shape_element
| structural_element
| gradient_element
| `A
| `AltGlyphDef
| `ClipPath
| `Color_Profile
| `Cursor
| `Filter
| `Font
| `Font_Face
| `ForeignObject
| `Image
| `Marker
| `Mask
| `Pattern
| `Script
| `Style
| `Switch
| `Text
| `View
]
type a_attr =
[
| core_attr
| conditional_processing_attr
| xlink_attr
| graphical_event_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Transform
| `Xlink_href
| `Xlink_show
| `Xlink_actuate
| `Target
]
type view = [ | `View ]
(* star *)
type view_content = descriptive_element
type view_attr =
[
| core_attr
| `ExternalResourcesRequired
| `ViewBox
| `PreserveAspectRatio
| `ZoomAndPan
| `ViewTarget
]
type script = [ | `Script ]
(* unary *)
type script_content = [ | `PCDATA ]
type script_attr =
[
| core_attr
| xlink_attr
| `ExternalResourcesRequired
| `Type
| `Xlink_href
]
type animation = [ | `Animation ]
(* star *)
type animation_content = descriptive_element
type animation_attr =
[
| conditional_processing_attr
| core_attr
| animation_event_attr
| xlink_attr
| animation_attr_target_attr
| animation_timing_attr
| animation_value_attr
| animation_addition_attr
| `ExternalResourcesRequired
]
type set = [ | `Set ]
(* star *)
type set_content = descriptive_element
type set_attr =
[
| core_attr
| conditional_processing_attr
| xlink_attr
| animation_event_attr
| animation_attr_target_attr
| animation_timing_attr
| `To
| `ExternalResourcesRequired
]
type animatemotion = [ | `AnimateMotion ]
(* star *)
type animatemotion_content = [ | descriptive_element | `Mpath ]
(* XXX *)
type animatemotion_attr =
[
| conditional_processing_attr
| core_attr
| animation_event_attr
| xlink_attr
| animation_timing_attr
| animation_value_attr
| animation_addition_attr
| `ExternalResourcesRequired
| `Path
| `KeyPoints
| `Rotate
| `Origin
]
(* XXX: rotate *)
type mpath = [ | `Mpath ]
(* star *)
type mpath_content = descriptive_element
type mpath_attr =
[ | core_attr | xlink_attr | `ExternalResourcesRequired | `Xlink_href
]
type animatecolor = [ | `AnimateColor ]
(* star *)
type animatecolor_content = descriptive_element
type animatecolor_attr =
[
| conditional_processing_attr
| core_attr
| animation_event_attr
| xlink_attr
| animation_attr_target_attr
| animation_timing_attr
| animation_value_attr
| animation_addition_attr
| `ExternalResourcesRequired
]
type animatetransform = [ | `AnimateTransform ]
(* star *)
type animatetransform_content = descriptive_element
type animatetransform_attr =
[
| conditional_processing_attr
| core_attr
| animation_event_attr
| xlink_attr
| animation_attr_target_attr
| animation_timing_attr
| animation_value_attr
| animation_addition_attr
| `ExternalResourcesRequired
| `Typeanimatetransform
]
type font = [ | `Font ]
(* star *)
type font_attr =
[
| core_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `HorizOriginX
| `HorizOriginY
| `HorizAdvX
| `VertOriginX
| `VertOriginY
| `VertAdvY
]
type font_content =
[
| descriptive_element
| `Font_Face
| `Glyph
| `Hkern
| `MissingGlyph
| `Vkern
]
type glyph = [ | `Glyph ]
(* star *)
type glyph_content =
[
| animation_element
| descriptive_element
| shape_element
| structural_element
| gradient_element
| `A
| `AltGlyphDef
| `ClipPath
| `Color_Profile
| `Cursor
| `Filter
| `Font
| `Font_Face
| `ForeignObject
| `Image
| `Marker
| `Mask
| `Pattern
| `Script
| `Style
| `Switch
| `Text
| `View
]
type glyph_attr =
[
| core_attr
| presentation_attr
| `Class
| `Style
| `D
| `HorizAdvX
| `VertOriginX
| `VertOriginY
| `VertAdvY
| `Unicode
| `GlyphName
| `Orientation
| `ArabicForm
| `Lang
]
type missingglyph = [ | `MissingGlyph ]
(* star *)
type missingglyph_content =
[
| animation_element
| descriptive_element
| shape_element
| structural_element
| gradient_element
| `A
| `AltGlyphDef
| `ClipPath
| `Color_Profile
| `Cursor
| `Filter
| `Font
| `Font_Face
| `ForeignObject
| `Image
| `Marker
| `Mask
| `Pattern
| `Script
| `Style
| `Switch
| `Text
| `View
]
type missingglyph_attr =
[
| core_attr
| presentation_attr
| `Class
| `Style
| `D
| `HorizAdvX
| `VertOriginX
| `VertOriginY
| `VertAdvY
]
type hkern = [ | `Hkern ]
(* nullary *)
type hkern_attr = [ | core_attr | `U1 | `G1 | `U2 | `G2 | `K ]
type vkern = [ | `Vkern ]
(* nullary *)
type vkern_attr = [ | core_attr | `U1 | `G1 | `U2 | `G2 | `K ]
type font_face = [ | `Font_Face ]
(* nullary *)
type font_face_content = [ | descriptive_element | `Font_Face_Src ]
type font_face_attr =
[
| core_attr
| `Font_Family
| `Font_Style
| `Font_Variant
| `Font_Weight
| `Font_Stretch
| `Font_Size
| `UnicodeRange
| `UnitsPerEm
| `Panose1
| `Stemv
| `Stemh
| `Slope
| `CapHeight
| `XHeight
| `AccentHeight
| `Ascent
| `Descent
| `Widths
| `Bbox
| `Ideographic
| `Alphabetic
| `Mathematical
| `Hanging
| `VIdeographic
| `VAlphabetic
| `VMathematical
| `VHanging
| `UnderlinePosition
| `UnderlineThickness
| `StrikethroughPosition
| `StrikethroughThickness
| `OverlinePosition
| `OverlineThickness
]
(* star *)
type font_face_src = [ | `Font_Face_Src ]
type font_face_src_content = [ | `Font_Face_Name | `Font_Face_Uri ]
type font_face_src_attr = core_attr
(* star *)
type font_face_uri = [ | `Font_Face_Uri ]
type font_face_uri_content = [ | `Font_Face_Format ]
type font_face_uri_attr = [ | core_attr | xlink_attr | `Xlink_href ]
(* nullary *)
type font_face_format = [ | `Font_Face_Format ]
type font_face_format_attr = [ | core_attr | `String ]
(* nullary *)
type font_face_name = [ | `Font_Face_Name ]
type font_face_name_attr = [ | core_attr | `Name ]
type metadata = [ | `Metadata ]
type metadata_attr = [ | core_attr ]
type foreignobject = [ | `ForeignObject ]
type foreignobject_attr =
[
| core_attr
| conditional_processing_attr
| graphical_event_attr
| presentation_attr
| `Class
| `Style
| `ExternalResourcesRequired
| `Transform
| `X
| `Y
| `Width
| `Height
]
type alignment_baseline =
[ `After_edge
| `Alphabetic
| `Auto
| `Baseline
| `Before_edge
| `Central
| `Hanging
| `Ideographic
| `Inherit
| `Mathematical
| `Middle
| `Text_after_edge
| `Text_before_edge ]
type dominant_baseline =
[ `Auto
| `Use_script
| `No_change
| `Reset_size
| `Ideographic
| `Alphabetic
| `Hanging
| `Mathematical
| `Central
| `Middle
| `Text_after_edge
| `Text_before_edge
| `Inherit
]
type in_value =
[ `SourceGraphic
| `SourceAlpha
| `BackgroundImage
| `BackgroundAlpha
| `FillPaint
| `StrokePaint
| `Ref of string ] [@@reflect.total_variant]
type offset =
[ `Number of number
| `Percentage of percentage ]
type big_variant =
[ `A
| `Absolute_colorimetric
| `Align
| `Always
| `Atop
| `Arithmetic
| `Auto
| `B
| `Bever
| `Blink
| `Butt
| `CSS
| `Darken
| `Default
| `Dilate
| `Disable
| `Discrete
| `Duplicate
| `End
| `Erode
| `Exact
| `FractalNoise
| `Freeze
| `HueRotate
| `G
| `Gamma
| `GeometricPrecision
| `H
| `Identity
| `In
| `Inherit
| `Initial
| `Isolated
| `Lighten
| `Line_through
| `Linear
| `LuminanceToAlpha
| `Magnify
| `Matrix
| `Medial
| `Middle
| `Miter
| `Multiply
| `Never
| `New
| `None
| `Normal
| `NoStitch
| `ObjectBoundingBox
| `OnLoad
| `OnRequest
| `OptimizeLegibility
| `OptimizeSpeed
| `Other
| `Out
| `Over
| `Overline
| `Paced
| `Pad
| `Perceptual
| `Preserve
| `R
| `Reflect
| `Remove
| `Repeat
| `Replace
| `Relative_colorimetric
| `Rotate
| `Round
| `Saturate
| `Saturation
| `Scale
| `Screen
| `SkewX
| `SkewY
| `Spacing
| `SpacingAndGlyphs
| `Spline
| `Square
| `Start
| `Stitch
| `Stretch
| `StrokeWidth
| `Sum
| `Table
| `Terminal
| `Translate
| `Turbulence
| `Underline
| `UserSpaceOnUse
| `V
| `WhenNotActive
| `Wrap
| `XML
| `Xor
]
tyxml-4.5.0/lib/xml_iter.ml 0000664 0000000 0000000 00000014031 14040247726 0015625 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2004 Thorsten Ohl
* Copyright (C) 2011 Pierre Chambart, Grégoire Henry
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
module Make(Xml : Xml_sigs.Iterable) = struct
open Xml
(** Iterators *)
let amap1 f n =
match content n with
| Empty | Comment _ | PCDATA _ | EncodedPCDATA _ | Entity _ -> n
| Leaf (name, attribs) -> leaf ~a:(f name attribs) name
| Node (name, attribs, elts) -> node ~a:(f name attribs) name elts
let rec amap f n =
match content n with
| Empty | Comment _ | PCDATA _ | EncodedPCDATA _ | Entity _ -> n
| Leaf (name, attribs) -> leaf ~a:(f name attribs) name
| Node (name, attribs, elts) ->
node ~a:(f name attribs) name (List.map (amap f) elts)
let rec add_float_attrib name value = function
| [] -> [float_attrib name value]
| head :: tail when aname head = name ->
float_attrib name value :: tail
| head :: tail -> head :: add_float_attrib name value tail
let map_float_attrib is_attrib f l =
let aux head = match acontent head with
| AFloat value when is_attrib (aname head) -> float_attrib (aname head) (f value)
| _ -> head in
List.map aux l
let rec add_int_attrib name value = function
| [] -> [int_attrib name value]
| head :: tail when aname head = name ->
int_attrib name value :: tail
| head :: tail -> head :: add_int_attrib name value tail
let rec rm_attrib is_attrib = function
| [] -> []
| head :: tail when is_attrib (aname head) -> rm_attrib is_attrib tail
| head :: tail -> head :: rm_attrib is_attrib tail
let map_int_attrib is_attrib f l =
let aux head = match acontent head with
| AInt value when is_attrib (aname head) -> int_attrib (aname head) (f value)
| _ -> head in
List.map aux l
let rec add_string_attrib name value = function
| [] -> [string_attrib name value]
| head :: tail when aname head = name ->
string_attrib name value :: tail
| head :: tail -> head :: add_string_attrib name value tail
let map_string_attrib is_attrib f l =
let aux head = match acontent head with
| AStr value when is_attrib (aname head) -> string_attrib (aname head) (f value)
| _ -> head in
List.map aux l
let rec add_space_sep_attrib name value = function
| [] -> [space_sep_attrib name [value]]
| head :: tail ->
match acontent head with
| AStrL (Space, values') when aname head = name ->
space_sep_attrib name (value :: values') :: tail
| _ when aname head = name ->
space_sep_attrib name [value] :: tail
| _ -> head :: add_space_sep_attrib name value tail
let rec add_comma_sep_attrib name value = function
| [] -> [comma_sep_attrib name [value]]
| head :: tail ->
match acontent head with
| AStrL (Comma, values') when aname head = name ->
comma_sep_attrib name (value :: values') :: tail
| _ when aname head = name ->
comma_sep_attrib name [value] :: tail
| _ -> head :: add_comma_sep_attrib name value tail
let rec rm_attrib_from_list is_attrib is_value = function
| [] -> []
| head :: tail ->
match acontent head with
| AStrL (sep, values) when is_attrib (aname head) ->
begin match List.filter (fun v -> not (is_value v)) values with
| [] -> tail
| values' ->
match sep with
| Space -> space_sep_attrib (aname head) values' :: tail
| Comma -> comma_sep_attrib (aname head) values' :: tail
end
| _ -> head :: rm_attrib_from_list is_attrib is_value tail
let map_string_attrib_in_list is_attrib f l =
let aux head = match acontent head with
| AStrL (sep, values) when is_attrib (aname head) ->
begin match sep with
| Comma -> comma_sep_attrib (aname head) (List.map f values)
| Space -> space_sep_attrib (aname head) (List.map f values)
end
| _ -> head in
List.map aux l
let rec fold of_empty of_comment of_txt of_encodedpcdata of_entity
of_leaf of_node n =
match content n with
| Empty -> of_empty ()
| Comment s -> of_comment s
| PCDATA s -> of_txt s
| EncodedPCDATA s -> of_encodedpcdata s
| Entity s -> of_entity s
| Leaf (name, attribs) -> of_leaf name attribs
| Node (name, attribs, elts) ->
of_node name attribs
(List.map (fold of_empty of_comment of_txt of_encodedpcdata of_entity of_leaf of_node) elts)
let all_entities elt =
let f _ = [] in
fold f f f f f
(fun _ename _attribs -> []) (fun _ename _attribs elts -> List.flatten elts)
elt
let flatmap f l = List.concat (List.map f l)
let translate root_leaf root_node sub_leaf sub_node update_state state n =
let rec translate' state n =
match content n with
| (Empty | Comment _ | PCDATA _ | EncodedPCDATA _ | Entity _) -> [n]
| Leaf (name, attribs) ->
sub_leaf state name attribs
| Node (name, attribs, elts) ->
sub_node state name attribs
(flatmap (translate' (update_state name attribs state)) elts)
in
match content n with
| (Empty | Comment _ | PCDATA _ | EncodedPCDATA _ | Entity _) -> n
| Leaf (name, attribs) ->
root_leaf name attribs
| Node (name, attribs, elts) ->
root_node name attribs (flatmap (translate' state) elts)
end
tyxml-4.5.0/lib/xml_iter.mli 0000664 0000000 0000000 00000005773 14040247726 0016013 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2004 Thorsten Ohl
* Copyright (C) 2011 Pierre Chambart, Grégoire Henry
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** Basic iterators over XML tree (functorial interface). *)
module Make(Xml : Xml_sigs.Iterable) : sig
open Xml
val amap : (ename -> attrib list -> attrib list) -> elt -> elt
(** Recursively edit attributes for the element and all its children. *)
val amap1 : (ename -> attrib list -> attrib list) -> elt -> elt
(** Edit attributes only for one element. *)
(** The following can safely be exported by higher level libraries,
because removing an attribute from a element is always legal. *)
val rm_attrib : (aname -> bool) -> attrib list -> attrib list
val rm_attrib_from_list : (aname -> bool) -> (string -> bool) -> attrib list -> attrib list
val map_int_attrib :
(aname -> bool) -> (int -> int) -> attrib list -> attrib list
val map_float_attrib :
(aname -> bool) -> (float -> float) -> attrib list -> attrib list
val map_string_attrib :
(aname -> bool) -> (string -> string) -> attrib list -> attrib list
val map_string_attrib_in_list :
(aname -> bool) -> (string -> string) -> attrib list -> attrib list
(** Exporting the following by higher level libraries would drive
a hole through a type system, because they allow to add {e any}
attribute to {e any} element. *)
val add_int_attrib : aname -> int -> attrib list -> attrib list
val add_float_attrib : aname -> float -> attrib list -> attrib list
val add_string_attrib : aname -> string -> attrib list -> attrib list
val add_comma_sep_attrib : aname -> string -> attrib list -> attrib list
val add_space_sep_attrib : aname -> string -> attrib list -> attrib list
val fold : (unit -> 'a) -> (string -> 'a) -> (string -> 'a) -> (string -> 'a) ->
(string -> 'a) -> (ename -> attrib list -> 'a) ->
(ename -> attrib list -> 'a list -> 'a) ->
elt -> 'a
val all_entities : elt -> string list
val translate :
(ename -> attrib list -> elt) ->
(ename -> attrib list -> elt list -> elt) ->
('state -> ename -> attrib list -> elt list) ->
('state -> ename -> attrib list -> elt list -> elt list) ->
(ename -> attrib list -> 'state -> 'state) -> 'state -> elt -> elt
end
tyxml-4.5.0/lib/xml_print.ml 0000664 0000000 0000000 00000035261 14040247726 0016026 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2008 Vincent Balat, Mauricio Fernandez
* Copyright (C) 2011 Pierre Chambart, Grégoire Henry
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
let is_control c =
let cc = Char.code c in
(cc <= 8 || cc = 11 || cc = 12 || (14 <= cc && cc <= 31) || cc = 127)
let add_unsafe_char b = function
| '<' -> Buffer.add_string b "<"
| '>' -> Buffer.add_string b ">"
| '"' -> Buffer.add_string b """
| '&' -> Buffer.add_string b "&"
| c when is_control c ->
Buffer.add_string b "" ;
Buffer.add_string b (string_of_int (Char.code c)) ;
Buffer.add_string b ";"
| c -> Buffer.add_char b c
let encode_unsafe_char s =
let b = Buffer.create (String.length s) in
String.iter (add_unsafe_char b) s;
Buffer.contents b
let encode_unsafe_char_and_at s =
let b = Buffer.create (String.length s) in
let f = function
| '@' -> Buffer.add_string b "@"
| c -> add_unsafe_char b c
in
String.iter f s;
Buffer.contents b
let compose_decl ?(version = "1.0") ?(encoding = "UTF-8") () =
Format.sprintf
{|\n|}
version encoding
let compose_doctype dt args =
let pp_args fmt = function
| [] -> ()
| l ->
Format.fprintf fmt " PUBLIC %a"
(Format.pp_print_list ~pp_sep:Format.pp_print_space
(fun fmt -> Format.fprintf fmt "\"%s\""))
l
in
Format.asprintf
""
dt
pp_args args
let re_end_comment = Re.(compile @@ alt [
seq [ bos ; str ">" ] ;
seq [ bos ; str "->" ] ;
str "-->" ;
str "--!>" ;
])
let escape_comment s =
let f g = match Re.Group.get g 0 with
| ">" -> ">"
| "->" -> "->"
| "-->" -> "-->"
| "--!>" -> "--!>"
| s -> s
in
Re.replace ~all:true re_end_comment ~f s
(* copied form js_of_ocaml: compiler/javascript.ml *)
let pp_number fmt v =
if v = infinity
then Format.pp_print_string fmt "Infinity"
else if v = neg_infinity
then Format.pp_print_string fmt "-Infinity"
else if v <> v
then Format.pp_print_string fmt "NaN"
else
let vint = int_of_float v in
(* compiler 1000 into 1e3 *)
if float_of_int vint = v
then
let rec div n i =
if n <> 0 && n mod 10 = 0
then div (n/10) (succ i)
else
if i > 2
then Format.fprintf fmt "%de%d" n i
else Format.pp_print_int fmt vint in
div vint 0
else
let s1 = Printf.sprintf "%.12g" v in
if v = float_of_string s1
then Format.pp_print_string fmt s1
else
let s2 = Printf.sprintf "%.15g" v in
if v = float_of_string s2
then Format.pp_print_string fmt s2
else Format.fprintf fmt "%.18g" v
let string_of_number v =
Format.asprintf "%a" pp_number v
module Utf8 = struct
type utf8 = string
let normalize src =
let warn = ref false in
let buffer = Buffer.create (String.length src) in
Uutf.String.fold_utf_8
(fun _ _ d ->
match d with
| `Uchar code -> Uutf.Buffer.add_utf_8 buffer code
| `Malformed _ ->
Uutf.Buffer.add_utf_8 buffer Uutf.u_rep;
warn:=true)
() src;
(Buffer.contents buffer, !warn)
let normalization_needed src =
let rec loop src i l =
i < l &&
match src.[i] with
(* Characters that need to be encoded in HTML *)
| '\034' | '\038' | '\060' |'\062' ->
true
(* ASCII characters *)
| '\009' | '\010' | '\013' | '\032'..'\126' ->
loop src (i + 1) l
| _ ->
true
in
loop src 0 (String.length src)
let normalize_html src =
if normalization_needed src then begin
let warn = ref false in
let buffer = Buffer.create (String.length src) in
Uutf.String.fold_utf_8
(fun _ _ d ->
match d with
| `Uchar u ->
begin match Uchar.to_int u with
| 34 ->
Buffer.add_string buffer """
| 38 ->
Buffer.add_string buffer "&"
| 60 ->
Buffer.add_string buffer "<"
| 62 ->
Buffer.add_string buffer ">"
| code ->
let u =
(* Illegal characters in html
http://en.wikipedia.org/wiki/Character_encodings_in_HTML
http://www.w3.org/TR/html5/syntax.html *)
if (* A. control C0 *)
(code <= 31 && code <> 9 && code <> 10 && code <> 13)
(* B. DEL + control C1
- invalid in html
- discouraged in xml;
except 0x85 see http://www.w3.org/TR/newline
but let's discard it anyway *)
|| (code >= 127 && code <= 159)
(* C. UTF-16 surrogate halves : already discarded
by uutf || (code >= 0xD800 && code <= 0xDFFF) *)
(* D. BOM related *)
|| code land 0xFFFF = 0xFFFE
|| code land 0xFFFF = 0xFFFF
then (warn:=true; Uutf.u_rep)
else u
in
Uutf.Buffer.add_utf_8 buffer u
end
| `Malformed _ ->
Uutf.Buffer.add_utf_8 buffer Uutf.u_rep;
warn:=true)
() src;
(Buffer.contents buffer, !warn)
end else
(src, false)
end
module type TagList = sig val emptytags : string list end
(** Format based printers *)
let pp_noop _fmt _ = ()
module Make_fmt
(Xml : Xml_sigs.Iterable)
(I : TagList) =
struct
open Xml
let open_box indent fmt = if indent then Format.pp_open_box fmt 0 else ()
let close_box indent fmt = if indent then Format.pp_close_box fmt () else ()
let sp indent fmt =
if indent then Format.pp_print_space fmt () else Format.pp_print_string fmt " "
let cut indent fmt =
if indent then Format.pp_print_cut fmt () else ()
module S = Set.Make(String)
let is_emptytag = match I.emptytags with
| [] -> fun _ -> false
| l ->
let set = List.fold_left (fun s x -> S.add x s) S.empty l in
fun x -> S.mem x set
let pp_encode encode indent fmt s =
let s = encode s in
if indent then
Format.fprintf fmt "@[%a@]" Format.pp_print_text s
else
Format.pp_print_string fmt s
let pp_sep indent = function
| Space -> fun fmt () -> sp indent fmt
| Comma -> fun fmt () -> Format.fprintf fmt ",%t" (sp indent)
let pp_attrib_value encode indent fmt a = match acontent a with
| AFloat f -> Format.fprintf fmt "\"%a\"" pp_number f
| AInt i -> Format.fprintf fmt "\"%d\"" i
| AStr s -> Format.fprintf fmt "\"%s\"" (encode s)
| AStrL (sep, slist) ->
Format.fprintf fmt "\"%a\""
(Format.pp_print_list ~pp_sep:(pp_sep indent sep)
(pp_encode encode indent)) slist
let pp_attrib encode indent fmt a =
Format.fprintf fmt
"%t%s=%a" (sp indent) (aname a) (pp_attrib_value encode indent) a
let pp_attribs encode indent =
Format.pp_print_list ~pp_sep:pp_noop (pp_attrib encode indent)
let pp_tag_and_attribs encode indent fmt (tag, attrs) =
open_box indent fmt ;
Format.fprintf fmt "%s%a%t" tag (pp_attribs encode indent) attrs (cut indent);
close_box indent fmt
let pp_closedtag encode indent fmt tag attrs =
if is_emptytag tag then
Format.fprintf fmt "<%a/>" (pp_tag_and_attribs encode indent) (tag, attrs)
else begin
open_box indent fmt ;
Format.fprintf fmt "<%a>%t%s>"
(pp_tag_and_attribs encode indent) (tag, attrs)
(cut indent)
tag ;
close_box indent fmt
end
let rec pp_tag encode indent fmt tag attrs children =
match children with
| [] -> pp_closedtag encode indent fmt tag attrs
| _ ->
open_box indent fmt ;
Format.fprintf fmt "<%t%a>%t%a%t%t%s>"
(open_box indent)
(pp_tag_and_attribs encode indent) (tag, attrs)
(cut indent)
(pp_elts encode indent) children
(close_box indent)
(cut indent)
tag ;
close_box indent fmt
and pp_elt encode indent fmt elt = match content elt with
| Comment texte ->
Format.fprintf fmt "" (escape_comment texte)
| Entity e ->
Format.fprintf fmt "&%s;" e
| PCDATA texte ->
pp_encode encode indent fmt texte
| EncodedPCDATA texte ->
Format.pp_print_string fmt texte
| Node (name, xh_attrs, xh_taglist) ->
pp_tag encode indent fmt name xh_attrs xh_taglist
| Leaf (name, xh_attrs) ->
pp_closedtag encode indent fmt name xh_attrs
| Empty -> ()
and pp_elts encode indent =
Format.pp_print_list
~pp_sep:(fun fmt () -> cut indent fmt)
(pp_elt encode indent)
let pp ?(encode=encode_unsafe_char) ?(indent=false) () =
pp_elt encode indent
end
module Make_typed_fmt
(Xml : Xml_sigs.Iterable)
(Typed_xml : Xml_sigs.Typed_xml with module Xml := Xml) =
struct
module P = Make_fmt(Xml)(Typed_xml.Info)
(* Add an xmlns tag on the html element if it's not already present *)
let prepare_document doc =
let doc = Typed_xml.doc_toelt doc in
match Xml.content doc with
| Xml.Node (n, a, c) ->
let a =
if List.exists (fun a -> Xml.aname a = "xmlns") a
then a
else Xml.string_attrib "xmlns" Typed_xml.Info.namespace :: a
in
Xml.node ~a n c
| _ -> doc
let pp_elt ?(encode=encode_unsafe_char) ?(indent=false) () fmt foret =
P.pp_elt encode indent fmt (Typed_xml.toelt foret)
let pp ?(encode = encode_unsafe_char) ?(indent=false) ?advert () fmt doc =
Format.pp_open_vbox fmt 0 ;
Format.fprintf fmt "%s@," Typed_xml.Info.doctype ;
begin match advert with
| Some s -> Format.fprintf fmt "@," s
| None -> ()
end ;
P.pp_elt encode indent fmt (prepare_document doc) ;
Format.pp_close_box fmt ();
end
module Make
(Xml : Xml_sigs.Iterable)
(I : TagList)
(O : Xml_sigs.Output) =
struct
let (++) = O.concat
open Xml
let separator_to_string = function
| Space -> " "
| Comma -> ", "
let attrib_value_to_string encode a = match acontent a with
| AFloat f -> Printf.sprintf "\"%s\"" (string_of_number f)
| AInt i -> Printf.sprintf "\"%d\"" i
| AStr s -> Printf.sprintf "\"%s\"" (encode s)
| AStrL (sep, slist) ->
Printf.sprintf "\"%s\""
(encode (String.concat (separator_to_string sep) slist))
let attrib_to_string encode a =
Printf.sprintf "%s=%s" (aname a) (attrib_value_to_string encode a)
let rec xh_print_attrs encode attrs = match attrs with
| [] -> O.empty
| attr::queue ->
O.put (" "^ attrib_to_string encode attr)
++ xh_print_attrs encode queue
and xh_print_closedtag encode tag attrs =
if I.emptytags = [] || List.mem tag I.emptytags
then
(O.put ("<"^tag)
++ xh_print_attrs encode attrs
++ O.put " />")
else
(O.put ("<"^tag)
++ xh_print_attrs encode attrs
++ O.put (">"^tag^">"))
and xh_print_tag encode tag attrs taglist =
if taglist = []
then xh_print_closedtag encode tag attrs
else
(O.put ("<"^tag)
++ xh_print_attrs encode attrs
++ O.put ">"
++ xh_print_taglist encode taglist
++ O.put (""^tag^">"))
and print_nodes encode name xh_attrs xh_taglist queue =
xh_print_tag encode name xh_attrs xh_taglist
++ xh_print_taglist encode queue
and xh_print_taglist encode taglist =
match taglist with
| [] -> O.empty
| elt :: queue -> match content elt with
| Comment texte ->
O.put ("")
++ xh_print_taglist encode queue
| Entity e ->
O.put ("&"^e^";") (* no encoding *)
++ xh_print_taglist encode queue
| PCDATA texte ->
O.put (encode texte)
++ xh_print_taglist encode queue
| EncodedPCDATA texte ->
O.put texte
++ xh_print_taglist encode queue
| Node (name, xh_attrs, xh_taglist) ->
print_nodes encode name xh_attrs xh_taglist queue
| Leaf (name, xh_attrs) ->
print_nodes encode name xh_attrs [] queue
| Empty ->
xh_print_taglist encode queue
let print_list ?(encode = encode_unsafe_char) foret =
O.make (xh_print_taglist encode foret)
end
module Make_typed
(Xml : Xml_sigs.Iterable)
(Typed_xml : Xml_sigs.Typed_xml with module Xml := Xml)
(O : Xml_sigs.Output) =
struct
module P = Make(Xml)(Typed_xml.Info)(O)
let (++) = O.concat
let print_list ?(encode = encode_unsafe_char) foret =
O.make (P.xh_print_taglist encode (List.map Typed_xml.toelt foret))
let print ?(encode = encode_unsafe_char) ?(advert = "") doc =
let doc = Typed_xml.doc_toelt doc in
let doc = match Xml.content doc with
| Xml.Node (n, a, c) ->
let a =
if List.exists (fun a -> Xml.aname a = "xmlns") a
then a
else Xml.string_attrib "xmlns" Typed_xml.Info.namespace :: a
in
Xml.node ~a n c
| _ -> doc in
O.make
(O.put Typed_xml.Info.doctype
++ O.put (if advert <> "" then ("\n") else "\n")
++ P.xh_print_taglist encode [doc])
end
module Simple_output(M : sig val put: string -> unit end) = struct
type out = unit
type m = unit -> unit
let empty () = ()
let concat f1 f2 () = f1 (); f2 ()
let put s () = M.put s
let make f = f ()
end
module Make_simple
(Xml : Xml_sigs.Iterable)
(I : TagList) =
struct
let print_list ~output =
let module M = Make(Xml)(I)(Simple_output(struct let put = output end)) in
M.print_list
end
module Make_typed_simple
(Xml : Xml_sigs.Iterable)
(Typed_xml : Xml_sigs.Typed_xml with module Xml := Xml) =
struct
let print_list ~output =
let module M =
Make_typed(Xml)(Typed_xml)(Simple_output(struct let put = output end)) in
M.print_list
let print ~output =
let module M =
Make_typed(Xml)(Typed_xml)(Simple_output(struct let put = output end)) in
M.print
end
tyxml-4.5.0/lib/xml_print.mli 0000664 0000000 0000000 00000012162 14040247726 0016172 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2008 Vincent Balat, Mauricio Fernandez
* Copyright (C) 2011 Pierre Chambart, Grégoire Henry
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** Printing utilities.
This module contains various encoding functions that can be used
with {!Tyxml.Html.pp} and {!Tyxml.Svg.pp}.
It also contains functors to create printers for your own XML data structure.
*)
(** {2 Encoding functions} *)
val encode_unsafe_char : string -> string
(** The encoder maps strings to HTML and {e must} encode the unsafe characters
['<'], ['>'], ['"'], ['&'] and the control characters 0-8, 11-12, 14-31, 127
to HTML entities. [encode_unsafe_char] is the default for [?encode] in [output]
and [pretty_print] below. Other implementations are provided by the module
[Netencoding] in the
{{:http://www.ocaml-programming.de/programming/ocamlnet.html}OcamlNet}
library, e.g.:
{[
let encode = Netencoding.Html.encode ~in_enc:`Enc_iso88591 ~out_enc:`Enc_usascii ()
]}
Where national characters are replaced by HTML entities.
The user is of course free to write her own implementation.
@see OcamlNet *)
val encode_unsafe_char_and_at : string -> string
(** In addition, encode ["@"] as ["@"] in the hope that this will fool
simple minded email address harvesters. *)
(** Utf8 normalizer and encoder for HTML.
Given a [pp] function produced by one of the functors in {!Xml_print}, this modules is used as following:
{[
let encode x = fst (Xml_print.Utf8.normalize_html x) in
Format.printf "%a" (Html.pp ~encode ()) document
]} *)
module Utf8 : sig
type utf8 = string
(** [normalize str] take a possibly invalid utf-8 string
and return a valid utf-8 string
where invalid bytes have been replaced by
the replacement character [U+FFFD].
The returned boolean is true if invalid bytes were found *)
val normalize : string -> utf8 * bool
(** Same as [normalize] plus some extra work :
It encode '<' , '>' , '"' , '&' characters with
corresponding entities and replaced invalid html
character by [U+FFFD] *)
val normalize_html : string -> utf8 * bool
end
(** {2 Utilities} *)
val compose_decl : ?version:string -> ?encoding:string -> unit -> string
(** [encoding] is the name of the character encoding, e.g. ["US-ASCII"] or ["UTF-8"] *)
val compose_doctype : string -> string list -> string
val string_of_number : float -> string
(** Convert a float to a string using a compact representation compatible with the Javascript norm. *)
val pp_number : Format.formatter -> float -> unit
(** See {!string_of_number}. *)
(** {2 Formatter functors} *)
(** Printers for typed XML modules such as the one produced by {!Svg_f} and {!Html_f}. *)
module Make_typed_fmt
(Xml : Xml_sigs.Iterable)
(Typed_xml : Xml_sigs.Typed_xml with module Xml := Xml)
: Xml_sigs.Typed_pp
with type 'a elt := 'a Typed_xml.elt
and type doc := Typed_xml.doc
(** List of tags that can be printed as empty tags: []. *)
module type TagList = sig val emptytags : string list end
(** Printers for raw XML modules. *)
module Make_fmt
(Xml : Xml_sigs.Iterable)
(I : TagList)
: Xml_sigs.Pp with type elt := Xml.elt
(** {2 Deprecated functors}
Use {!Make_fmt} and {!Make_typed_fmt} instead.
*)
module Make
(Xml : Xml_sigs.Iterable)
(I : TagList)
(O : Xml_sigs.Output)
: Xml_sigs.Printer with type out := O.out and type xml_elt := Xml.elt
[@@ocaml.deprecated "Use Xml_print.Make_fmt instead."]
module Make_typed
(Xml : Xml_sigs.Iterable)
(Typed_xml : Xml_sigs.Typed_xml with module Xml := Xml)
(O : Xml_sigs.Output)
: Xml_sigs.Typed_printer with type out := O.out
and type 'a elt := 'a Typed_xml.elt
and type doc := Typed_xml.doc
[@@ocaml.deprecated "Use Xml_print.Make_typed_fmt instead."]
module Make_simple
(Xml : Xml_sigs.Iterable)
(I : TagList)
: Xml_sigs.Simple_printer with type xml_elt := Xml.elt
[@@ocaml.deprecated "Use Xml_print.Make_fmt instead."]
module Make_typed_simple
(Xml : Xml_sigs.Iterable)
(Typed_xml : Xml_sigs.Typed_xml with module Xml := Xml)
: Xml_sigs.Typed_simple_printer with type 'a elt := 'a Typed_xml.elt
and type doc := Typed_xml.doc
[@@ocaml.deprecated "Use Xml_print.Make_typed_fmt instead."]
tyxml-4.5.0/lib/xml_sigs.mli 0000664 0000000 0000000 00000012745 14040247726 0016012 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2004 Thorsten Ohl
* Copyright (C) 2011 Pierre Chambart, Grégoire Henry
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** XML Signatures. *)
module type T = sig
module W : Xml_wrap.T
type 'a wrap = 'a W.t
type 'a list_wrap = 'a W.tlist
type uri
val string_of_uri : (uri, string) W.ft
val uri_of_string : (string, uri) W.ft
type aname = string
type event_handler
type mouse_event_handler
type keyboard_event_handler
type touch_event_handler
type attrib
val float_attrib : aname -> float wrap -> attrib
val int_attrib : aname -> int wrap -> attrib
val string_attrib : aname -> string wrap -> attrib
val space_sep_attrib : aname -> string list wrap -> attrib
val comma_sep_attrib : aname -> string list wrap -> attrib
val event_handler_attrib : aname -> event_handler -> attrib
val mouse_event_handler_attrib : aname -> mouse_event_handler -> attrib
val keyboard_event_handler_attrib : aname -> keyboard_event_handler -> attrib
val touch_event_handler_attrib : aname -> touch_event_handler -> attrib
val uri_attrib : aname -> uri wrap -> attrib
val uris_attrib : aname -> uri list wrap -> attrib
type elt
type ename = string
val empty : unit -> elt
val comment : string -> elt
val pcdata : string wrap -> elt
val encodedpcdata : string wrap -> elt
val entity : string -> elt
val leaf : ?a:(attrib list) -> ename -> elt
val node : ?a:(attrib list) -> ename -> elt list_wrap -> elt
val cdata : string -> elt
val cdata_script : string -> elt
val cdata_style : string -> elt
end
module type NoWrap = T with module W = Xml_wrap.NoWrap
module type Iterable = sig
include NoWrap
type separator = Space | Comma
val aname : attrib -> aname
type acontent = private
| AFloat of float
| AInt of int
| AStr of string
| AStrL of separator * string list
val acontent : attrib -> acontent
type econtent = private
| Empty
| Comment of string
| EncodedPCDATA of string
| PCDATA of string
| Entity of string
| Leaf of ename * attrib list
| Node of ename * attrib list * elt list
val content : elt -> econtent
end
module type Info = sig
val content_type: string
val alternative_content_types: string list
val version: string
val standard: string
val namespace: string
val doctype: string
val emptytags: string list
end
module type Output = sig
type out
type m
val empty: m
val concat: m -> m -> m
val put: string -> m
val make: m -> out
end
module type Typed_xml = sig
module Xml : NoWrap
module Info : Info
type 'a elt
type doc
val toelt : 'a elt -> Xml.elt
val doc_toelt : doc -> Xml.elt
end
module type Printer = sig
type xml_elt
type out
val print_list: ?encode:(string -> string) -> xml_elt list -> out
end
module type Simple_printer = sig
type xml_elt
val print_list:
output:(string -> unit) ->
?encode:(string -> string) ->
xml_elt list -> unit
end
module type Typed_printer = sig
type 'a elt
type doc
type out
val print_list: ?encode:(string -> string) -> 'a elt list -> out
val print: ?encode:(string -> string) -> ?advert:string-> doc -> out
end
module type Typed_simple_printer = sig
type 'a elt
type doc
val print_list:
output:(string -> unit) ->
?encode:(string -> string) ->
'a elt list -> unit
val print:
output:(string -> unit) ->
?encode:(string -> string) -> ?advert:string->
doc -> unit
end
module type Pp = sig
type elt
(** [pp ()] is a {!Format} printer for untyped XML.
It can be used in combination with ["%a"]. For example, to get a string:
{[let s = Format.asprintf "%a" (pp ()) my_xml]}
A custom encoding function can be provided with the [~encode] argument.
Various implementations of [encode] are available in {!Xml_print}.
*)
val pp:
?encode:(string -> string) -> ?indent:bool -> unit ->
Format.formatter -> elt -> unit
end
module type Typed_pp = sig
type 'a elt
type doc
(** [pp_elt ()] is a {!Format} printer for individual elements.
A custom encoding function can be provided with the [~encode] argument.
Various implementations of [encode] are available in {!Xml_print}.
*)
val pp_elt :
?encode:(string -> string) -> ?indent:bool -> unit ->
Format.formatter -> 'a elt -> unit
(** [pp ()] is a {!Format} printer for complete documents.
It can be used in combination with ["%a"]. For example, to get a string:
{[let s = Format.asprintf "%a" (pp ()) my_document]}
A custom encoding function can be provided with the [~encode] argument.
Various implementations of [encode] are available in {!Xml_print}.
*)
val pp:
?encode:(string -> string) -> ?indent:bool -> ?advert:string -> unit ->
Format.formatter -> doc -> unit
end
tyxml-4.5.0/lib/xml_stream.ml 0000664 0000000 0000000 00000004006 14040247726 0016156 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2018 Gabriel Radanne
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
type name = string * string
(** Input *)
type signal = [
| `Comment of string
| `End_element
| `Start_element of name * (name * string) list
| `Text of string list
]
exception Malformed_stream
module Import
(Xml : Xml_sigs.T)
= struct
let of_list l =
List.fold_right
(fun a b -> Xml.W.(cons (return a) b))
l (Xml.W.nil ())
let mk_attribs attrs =
(* TODO: This is not very structured *)
let f ((_,name), v) = Xml.string_attrib name (Xml.W.return v) in
List.map f attrs
let rec mk children (seq : signal Seq.t) = match seq () with
| Cons (`Comment s, q) ->
mk (Xml.comment s :: children) q
| Cons (`Text s, q) ->
mk (List.map (fun x -> Xml.pcdata @@ Xml.W.return x) s @ children) q
| Cons (`Start_element ((_, name), attrs), q) ->
let a = mk_attribs attrs in
let sub_children, rest = mk [] q in
mk (Xml.node ~a name sub_children :: children) rest
| Cons (`End_element, rest) ->
of_list (List.rev children), rest
| Nil ->
of_list (List.rev children), Seq.empty
let of_seq seq =
let l, rest = mk [] seq in
match rest () with
| Seq.Nil -> l
| _ -> raise Malformed_stream
end
tyxml-4.5.0/lib/xml_stream.mli 0000664 0000000 0000000 00000002253 14040247726 0016331 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2018 Gabriel Radanne
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** Streaming IO to/from XML trees *)
type name = string * string
(** {2 Input} *)
type signal = [
| `Comment of string
| `End_element
| `Start_element of name * (name * string) list
| `Text of string list
]
exception Malformed_stream
module Import (Xml : Xml_sigs.T) : sig
val of_seq : signal Seq.t -> Xml.elt Xml.list_wrap
end
tyxml-4.5.0/lib/xml_wrap.ml 0000664 0000000 0000000 00000003125 14040247726 0015635 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2013 Gabriel Radanne
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
module type T = sig
type 'a t
val return : 'a -> 'a t
type (-'a, 'b) ft
val fmap : ('a, 'b) ft -> 'a t -> 'b t
type 'a tlist
val nil : unit -> 'a tlist
val singleton : 'a t -> 'a tlist
val cons : 'a t -> 'a tlist -> 'a tlist
val append : 'a tlist -> 'a tlist -> 'a tlist
val map : ('a, 'b) ft -> 'a tlist -> 'b tlist
end
module type NoWrap =
T with type 'a t = 'a
and type 'a tlist = 'a list
and type (-'a, 'b) ft = 'a -> 'b
module NoWrap = struct
type 'a t = 'a
type 'a tlist = 'a list
type (-'a, 'b) ft = 'a -> 'b
external return : 'a -> 'a = "%identity"
let fmap f : 'a t -> 'b t = f
let nil () = []
let singleton x = [x]
let cons x xs = x::xs
let append x y= x@y
let map = List.map
end
tyxml-4.5.0/lib/xml_wrap.mli 0000664 0000000 0000000 00000002515 14040247726 0016010 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2013 Gabriel Radanne
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
module type T = sig
type 'a t
val return : 'a -> 'a t
type (-'a, 'b) ft
val fmap : ('a, 'b) ft -> 'a t -> 'b t
type 'a tlist
val nil : unit -> 'a tlist
val singleton : 'a t -> 'a tlist
val cons : 'a t -> 'a tlist -> 'a tlist
val append : 'a tlist -> 'a tlist -> 'a tlist
val map : ('a, 'b) ft -> 'a tlist -> 'b tlist
end
module type NoWrap =
T with type 'a t = 'a
and type 'a tlist = 'a list
and type (-'a, 'b) ft = 'a -> 'b
module NoWrap : NoWrap
tyxml-4.5.0/ppx/ 0000775 0000000 0000000 00000000000 14040247726 0013512 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/ppx/dune 0000664 0000000 0000000 00000000414 14040247726 0014367 0 ustar 00root root 0000000 0000000 (library
(name tyxml_ppx)
(public_name tyxml-ppx.internal)
(libraries re.str
markup
tyxml-syntax
ppxlib
)
(preprocess (pps ppxlib.metaquot))
(flags (:standard
-safe-string
-open Ppxlib
-w "-9"
))
)
tyxml-4.5.0/ppx/register/ 0000775 0000000 0000000 00000000000 14040247726 0015336 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/ppx/register/dune 0000664 0000000 0000000 00000000173 14040247726 0016215 0 ustar 00root root 0000000 0000000 (library
(name tyxml_ppx_register)
(public_name tyxml-ppx)
(libraries tyxml-ppx.internal ppxlib)
(kind ppx_rewriter)
)
tyxml-4.5.0/ppx/register/tyxml_ppx_register.ml 0000664 0000000 0000000 00000001237 14040247726 0021643 0 ustar 00root root 0000000 0000000 open Ppxlib
let str_item_expansion name lang =
Extension.declare_with_path_arg
name
Extension.Context.structure_item
Ast_pattern.(pstr ((pstr_value __ __) ^:: nil))
(Tyxml_ppx.expand_str_item ~lang)
let expr_expansion name lang =
Extension.declare_with_path_arg
name
Extension.Context.expression
Ast_pattern.(pstr ((pstr_eval __ __) ^:: nil))
(Tyxml_ppx.expand_expr ~lang)
let () =
let extensions = [
expr_expansion "tyxml.html" Html;
expr_expansion "tyxml.svg" Svg;
str_item_expansion "tyxml.html" Html;
str_item_expansion "tyxml.svg" Svg;
]
in
Ppxlib.Driver.register_transformation ~extensions "tyxml"
tyxml-4.5.0/ppx/tyxml_ppx.ml 0000664 0000000 0000000 00000030761 14040247726 0016117 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
open Tyxml_syntax
(* When dropping support for 4.02, this module can simply be deleted. *)
module String = struct
include String
let capitalize_ascii = String.capitalize [@ocaml.warning "-3"]
end
open Ppxlib.Asttypes
open Ppxlib.Parsetree
type lang = Common.lang = Html | Svg
let lang_of_ns loc ns =
if ns = Markup.Ns.html || ns = "" then Common.Html
else if ns = Markup.Ns.svg then Common.Svg
else Common.error loc "Unknown namespace %s" ns
module Loc = struct
(** 0-width locations do not show in the toplevel. We expand them to
one-width.
*)
let one_width ?(ghost=false) pos =
{ Location.loc_ghost = ghost ;
loc_start = pos ;
loc_end = {pos with pos_cnum = pos.pos_cnum + 1}
}
(** Given a list of input strings for Markup.ml, evaluates to a function that
converts Markup.ml locations of characters within these strings to their
OCaml locations. *)
let make_location_map located_strings =
(* [source] is a byte stream created from the string list, which calls
[!starting_a_string] each time it moves on to a new string in the
list. *)
let starting_a_string = ref (fun _ -> ()) in
let source =
let strings = ref located_strings in
let offset = ref 0 in
let rec next_byte () = match !strings with
| [] -> None
| (s, loc)::rest ->
if !offset = 0 then !starting_a_string loc;
if !offset < String.length s then begin
offset := !offset + 1;
Some (s.[!offset - 1])
end
else begin
offset := 0;
strings := rest;
next_byte ()
end
in
Markup.fn next_byte
in
(* Use Markup.ml to assign locations to characters in [source], and note
the Markup.ml and OCaml locations of the start of each string. *)
let location_map =
let preprocessed_input_stream, get_markupml_location =
source
|> Markup.Encoding.decode Markup.Encoding.utf_8
|> Markup.preprocess_input_stream
in
let location_map = ref [] in
starting_a_string := begin fun ocaml_position ->
location_map :=
(get_markupml_location (), ocaml_position)::!location_map
end;
Markup.drain preprocessed_input_stream;
List.rev !location_map
in
(* The function proper which translates Markup.ml locations into OCaml
locations. *)
fun given_markup_location ->
(* [bounded_maximum None location_map] evaluates to the greatest Markup.ml
location (and its paired OCaml location) in [location_map] that is less
than or equal to [given_markup_location]. [best] is [Some] of the
greatest candidate found so far, or [None] on the first iteration. *)
let rec bounded_maximum best = function
| [] -> best
| ((noted_markup_location, _) as loc)::rest ->
if Markup.compare_locations
noted_markup_location given_markup_location > 0 then best
else bounded_maximum (Some loc) rest
in
let preceding_markup_location, preceding_ocaml_position =
match bounded_maximum None location_map with
| Some loc -> loc
| None -> assert false
in
let line, column = given_markup_location in
let line', column' = preceding_markup_location in
let ocaml_position =
let open Lexing in
if line = line' then
{preceding_ocaml_position with
pos_cnum = preceding_ocaml_position.pos_cnum + column - column'}
else
{preceding_ocaml_position with
pos_lnum = preceding_ocaml_position.pos_lnum + line - line';
pos_bol = 0;
pos_cnum = column - 1}
in
one_width ocaml_position
end
(** Antiquotations
We replace antiquotations expressions by a dummy token "(tyxmlX)".
We store a table token to expression to retrieve them after parsing.
*)
module Antiquot = struct
let fmt_id = Printf.sprintf "(tyxml%i)"
let regex_id = Re.(seq [ str "(tyxml" ; rep digit ; char ')' ])
let re_id = Re.compile regex_id
let make_id =
let r = ref 0 in
fun () -> incr r ; fmt_id !r
module H = Hashtbl.Make(struct
type t = string
let hash = Hashtbl.hash
let equal (x:string) y = x = y
end)
let tbl = H.create 17
let create expr =
let s = make_id () in
H.add tbl s expr ;
s
let get loc s =
if H.mem tbl s then H.find tbl s
else
Common.error loc
"Internal error: This expression placeholder is not registered"
let contains loc s = match Re.exec_opt re_id s with
| None -> `No
| Some g ->
let (i,j) = Re.Group.offset g 0 in
let is_whole = i = 0 && j = String.length s in
if is_whole
then `Whole (get loc s)
else `Yes (get loc @@ Re.Group.get g 0)
let assert_no_antiquot ~loc kind (_namespace,s) =
match contains loc s with
| `No -> ()
| `Yes e | `Whole e ->
Common.error e.pexp_loc
"OCaml expressions are not accepted as %s names" kind
end
(** Building block to rebuild the output with expressions intertwined. *)
(** Walk the text list to replace placeholders by OCaml expressions when
appropriate. Use {!make_txt} on the rest. *)
let make_text ~loc ~lang ss =
let buf = Buffer.create 17 in
let push_txt buf l =
let s = Buffer.contents buf in
Buffer.clear buf ;
if s = "" then l else Common.value (Common.txt ~loc ~lang s) :: l
in
let rec aux ~loc res = function
| [] -> push_txt buf res
| `Text s :: t ->
Buffer.add_string buf s ;
aux ~loc res t
| `Delim g :: t ->
let e = Antiquot.get loc @@ Re.Group.get g 0 in
aux ~loc (Common.antiquot e :: push_txt buf res) t
in
aux ~loc [] @@ Re.split_full Antiquot.re_id @@ String.concat "" ss
let replace_attribute ~loc ((ns,attr_name),value) =
let attr = (lang_of_ns loc ns, attr_name) in
Antiquot.assert_no_antiquot ~loc "attribute" attr ;
match Antiquot.contains loc value with
| `No -> (attr, Common.value value)
| `Whole e -> (attr, Common.antiquot e)
| `Yes _ ->
Common.error loc
"Mixing literals and OCaml expressions is not supported in attribute values"
(** Processing *)
(** Takes the ast and transforms it into a Markup.ml char stream.
The payload [expr] is either a single token, or an application (that is, a list).
A token is either a string or an antiquotation. Antiquotations are replaced
by placeholder strings (see {!Antiquot}).
Each token is equipped with a starting (but no ending) position.
*)
let ast_to_stream expressions =
let strings =
expressions |> List.map @@ fun expr ->
match expr.pexp_desc with
| Pexp_constant (Pconst_string (s, loc, _)) ->
(s, loc.loc_start)
| _ ->
(Antiquot.create expr, expr.pexp_loc.loc_start)
in
let source =
let items = ref strings in
let offset = ref 0 in
let rec next_byte () = match !items with
| [] -> None
| (s, _)::rest ->
if !offset < String.length s then begin
offset := !offset + 1;
Some (s.[!offset - 1])
end
else begin
offset := 0;
items := rest;
next_byte ()
end
in
Markup.fn next_byte
in
source, Loc.make_location_map strings
let context_of_lang = function
| Common.Svg -> Some (`Fragment "svg")
| Html -> None
(** Given the payload of a [%html ...] or [%svg ...] expression,
converts it to a TyXML expression representing the markup
contained therein. *)
let markup_to_expr lang loc expr =
let context = context_of_lang lang in
let input_stream, adjust_location = ast_to_stream expr in
let report loc error =
match error with
| `Bad_content _ -> ()
| _ ->
let loc = adjust_location loc in
let message =
Markup.Error.to_string error |> String.capitalize_ascii
in
Common.error loc "%s" message
in
let parser =
Markup.parse_html
?context
~encoding:Markup.Encoding.utf_8
~report
input_stream
in
let signals = Markup.signals parser in
let get_loc () = adjust_location @@ Markup.location parser in
let rec assemble lang children =
match Markup.next signals with
| None | Some `End_element -> List.rev children
| Some (`Text ss) ->
let loc = get_loc () in
let node = make_text ~loc ~lang ss in
assemble lang (node @ children)
| Some (`Start_element ((ns, elt_name), attributes)) ->
let newlang = lang_of_ns loc ns in
let name = (newlang, elt_name) in
let loc = get_loc () in
let sub_children = assemble newlang [] in
Antiquot.assert_no_antiquot ~loc "element" name ;
let attributes = List.map (replace_attribute ~loc) attributes in
let node =
Element.parse
~parent_lang:lang ~loc ~name ~attributes sub_children
in
assemble lang (Common.Val node :: children)
| Some (`Comment s) ->
let loc = get_loc () in
let node = Common.value @@ Element.comment ~loc ~lang s in
assemble lang (node :: children)
| Some (`Xml _ | `Doctype _ | `PI _) ->
assemble lang children
in
let l =
Element_content.filter_surrounding_whitespace @@
assemble lang []
in
match l with
| [ Val x | Antiquot x ] -> x
| l -> Common.list_wrap_value lang loc l
let markup_to_expr_with_implementation lang modname loc expr =
match modname with
| Some modname ->
let current_modname = Common.implementation lang in
Common.set_implementation lang modname ;
let res = markup_to_expr lang loc expr in
Common.set_implementation lang current_modname ;
res
| _ ->
markup_to_expr lang loc expr
let is_capitalized s =
if String.length s < 0 then false
else match s.[0] with
| 'A'..'Z' -> true
| _ -> false
(** Extract and verify the modname in the annotation [%html.Bar.Baz .. ]. *)
let get_modname = function
| None -> None
| Some {txt = longident ; loc} ->
let l = Longident.flatten_exn longident in
let s = String.concat "." l in
if l = [] then None
else if not (List.for_all is_capitalized l) then
Common.error loc "This identifier is not a module name"
else Some s
let application_to_list expr =
match expr.pexp_desc with
| Pexp_apply (f, arguments) -> f::(List.map snd arguments)
| _ -> [expr]
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 @@
application_to_list pc_rhs
in {case with pc_rhs}
in
List.map f cases
let rec markup_function ~lang ~modname e =
let loc = e.pexp_loc in
match e.pexp_desc with
| Pexp_fun (label,def,pat,content) ->
let content = markup_function ~lang ~modname content in
{e with pexp_desc = Pexp_fun (label,def,pat,content)}
| Pexp_function cases ->
let cases = markup_cases ~lang ~modname cases in
{e with pexp_desc = Pexp_function cases}
| _ ->
markup_to_expr_with_implementation lang modname loc @@
application_to_list e
let markup_bindings ~lang ~modname l =
let f ({pvb_expr} as b) =
let pvb_expr = markup_function ~lang ~modname pvb_expr in
{b with pvb_expr}
in
List.map f l
let expand_expr ~lang ~loc:_ ~path:_ ~arg e _ =
let modname = get_modname arg in
match e.pexp_desc with
| Pexp_let (recflag, bindings, next) ->
let bindings = markup_bindings ~lang ~modname bindings in
{e with pexp_desc = Pexp_let (recflag, bindings, next)}
| _ ->
markup_to_expr_with_implementation lang modname e.pexp_loc @@
application_to_list e
let expand_str_item ~lang ~loc:_ ~path:_ ~arg recflag value_bindings =
let bindings =
markup_bindings ~lang ~modname:(get_modname arg) value_bindings
in
Ppxlib.Ast_helper.Str.value recflag bindings
tyxml-4.5.0/ppx/tyxml_ppx.mli 0000664 0000000 0000000 00000003276 14040247726 0016271 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin, Gabriel Radanne
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** TyXML ppx library.
This is the documentation for the internal ppx library.
{% Documentation for the ppx itself is available
<>. %}
*)
type lang = Html | Svg
val markup_to_expr :
lang ->
Location.t -> Ppxlib.expression list -> Ppxlib.expression
(** Given the payload of a [%html ...] or [%svg ...] expression,
converts it to a TyXML expression representing the markup
contained therein. *)
val expand_expr :
lang:lang ->
loc: Ppxlib.Location.t ->
path: string ->
arg: Ppxlib.Longident.t Asttypes.loc option ->
Ppxlib.expression ->
Ppxlib.attribute list ->
Ppxlib.expression
val expand_str_item :
lang:lang ->
loc: Ppxlib.Location.t ->
path: string ->
arg: Ppxlib.Longident.t Asttypes.loc option ->
Ppxlib.rec_flag ->
Ppxlib.value_binding list ->
Ppxlib.structure_item
tyxml-4.5.0/syntax/ 0000775 0000000 0000000 00000000000 14040247726 0014231 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/syntax/attribute_value.ml 0000664 0000000 0000000 00000040625 14040247726 0017771 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
[@@@ocaml.warning "-3"]
open Ppxlib.Ast_helper
type 'a gparser =
?separated_by:string -> ?default:string -> Location.t -> string -> 'a ->
expression option
type parser = string gparser
type vparser = string Common.value gparser
(* Handle expr *)
let expr (parser : parser) : vparser =
fun ?separated_by ?default loc name v ->
match v with
| Antiquot e -> Some e
| Val s -> parser ?separated_by ?default loc name s
(* Options. *)
let option none (parser : parser) ?separated_by:_ ?default:_ loc name s =
if s = none then Some [%expr None] [@metaloc loc]
else
match parser ~default:none loc name s with
| None -> None
| Some e -> Some [%expr Some [%e e]] [@metaloc loc]
(* Lists. *)
let filter_map f l =
l
|> List.fold_left (fun acc v ->
match f v with
| None -> acc
| Some v' -> v'::acc)
[]
|> List.rev
(* Splits the given string on the given delimiter (a regular expression), then
applies [element_parser] to each resulting component. Each such application
resulting in [Some expr] is included in the resulting expression list. *)
let exp_list delimiter separated_by (element_parser : parser) loc name s =
Re_str.split delimiter s
|> filter_map (element_parser ~separated_by loc name)
(* Behaves as _expr_list, but wraps the resulting expression list as a list
expression. *)
let list
delimiter separated_by element_parser ?separated_by:_ ?default:_ loc name s =
exp_list delimiter separated_by element_parser loc name s
|> Common.list loc
|> fun e -> Some e
let spaces = list (Re_str.regexp " +") "space"
let commas = list (Re_str.regexp " *, *") "comma"
let semicolons = list (Re_str.regexp " *; *") "semicolon"
let spaces_or_commas_regexp = Re_str.regexp "\\( *, *\\)\\| +"
let spaces_or_commas_ = exp_list spaces_or_commas_regexp "space- or comma"
let spaces_or_commas = list spaces_or_commas_regexp "space- or comma"
(* Wrapping. *)
let wrap (parser : parser) implementation =
expr @@
fun ?separated_by:_ ?default:_ loc name s ->
match parser loc name s with
| None -> Common.error loc "wrap applied to presence; nothing to wrap"
| Some e -> Some (Common.wrap implementation loc e)
let nowrap (parser : parser) _ =
expr @@
fun ?separated_by:_ ?default:_ loc name s ->
parser loc name s
(* Error reporting for values in lists and options. *)
let must_be_a
singular_description plural_description separated_by default loc name =
let description =
match separated_by with
| Some separated_by ->
Printf.sprintf "a %s-separated list of %s" separated_by plural_description
| None ->
match default with
| Some default -> Printf.sprintf "%s or %s" singular_description default
| None -> singular_description
in
Common.error loc "Value of %s must be %s" name description
(* General helpers. *)
(* Checks that the given string matches the given regular expression exactly,
i.e. the match begins at position 0 and ends at the end of the string. *)
let does_match regexp s =
Re_str.string_match regexp s 0 && Re_str.match_end () = String.length s
(* Checks that the group with the given index was matched in the given
string. *)
let group_matched index s =
try Re_str.matched_group index s |> ignore; true
with Not_found -> false
let int_exp loc s =
try Some (Common.int loc (int_of_string s))
with Failure _ -> None
let float_exp loc s =
try
Some (Common.float loc @@ float_of_string s)
with Failure _ ->
None
let bool_exp loc b =
let s = if b then "true" else "false" in
Exp.construct ~loc ({ txt = (Longident.Lident s); loc }) None
(* Numeric. *)
let char ?separated_by:_ ?default:_ loc name s =
let encoding = `UTF_8 in (* OCaml source files are always in utf8 *)
let decoder = Uutf.decoder ~encoding (`String s) in
let c =
match Uutf.decode decoder with
| `End -> Common.error loc "No character in attribute %s" name
| `Uchar i when Uchar.is_char i -> Uchar.to_char i
| `Uchar _ ->
Common.error loc "Character out of range in attribute %s" name
| `Await -> assert false
| `Malformed s ->
Common.error loc "Malformed character %s in attribute %s" s name
in
begin match Uutf.decode decoder with
| `End -> ()
| _ -> Common.error loc "Multiple characters in attribute %s" name
end;
Some (Ast_builder.Default.echar ~loc c)
let onoff ?separated_by:_ ?default:_ loc name s =
let b = match s with
| "" | "on" -> true
| "off" -> false
| _ ->
Common.error loc {|Value of %s must be "on", "" or "off"|} name
in
Some (bool_exp loc b)
let bool ?separated_by:_ ?default:_ loc name s =
let b = match s with
| "" | "true" -> true
| "false" -> false
| _ ->
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_builder.Default.eunit ~loc)
else
Common.error loc
{|Value of %s must be %s or "".|}
name name
let int ?separated_by ?default loc name s =
match int_exp loc s with
| Some _ as e -> e
| None ->
must_be_a "a whole number" "whole numbers" separated_by default loc name
let float ?separated_by ?default loc name s =
match float_exp loc s with
| Some _ as e -> e
| None ->
must_be_a
"a number (decimal fraction)" "numbers (decimal fractions)"
separated_by default loc name
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 |> 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
Some (pair [] expressions)
let number_pair ?separated_by:_ ?default:_ loc name s =
let e =
begin match spaces_or_commas_ float loc name s with
| [orderx] -> [%expr [%e orderx], None]
| [orderx; ordery] -> [%expr [%e orderx], Some [%e ordery]]
| _ -> Common.error loc "%s requires one or two numbers" name
end [@metaloc loc]
in
Some e
let fourfloats ?separated_by:_ ?default:_ loc name s =
match spaces_or_commas_ float loc name s with
| [min_x; min_y; width; height] ->
Some [%expr ([%e min_x], [%e min_y], [%e width], [%e height])]
[@metaloc loc]
| _ -> 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
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 _ ->
Common.error loc "Icon dimension out of range in %s" name
in
Some
[%expr
[%e Common.int loc width],
[%e Common.int loc height]] [@metaloc loc]
(* Dimensional. *)
let svg_quantity =
let integer = "[+-]?[0-9]+" in
let integer_scientific = Printf.sprintf "%s\\([Ee]%s\\)?" integer integer in
let fraction = Printf.sprintf "[+-]?[0-9]*\\.[0-9]+\\([Ee]%s\\)?" integer in
let number = Printf.sprintf "%s\\|%s" integer_scientific fraction in
let quantity = Printf.sprintf "\\(%s\\)\\([^0-9]*\\)$" number in
let regexp = Re_str.regexp quantity in
fun kind_singular kind_plural parse_unit ?separated_by ?default loc name s ->
if not @@ does_match regexp s then
must_be_a kind_singular kind_plural separated_by default loc name;
let n =
match float_exp loc (Re_str.matched_group 1 s) with
| Some n -> n
| None -> Common.error loc "Number out of range in %s" name
in
let unit_string = Re_str.matched_group 4 s in
let unit =
(if unit_string = "" then [%expr None]
else [%expr Some [%e parse_unit loc name unit_string]]) [@metaloc loc]
in
[%expr [%e n], [%e unit]] [@metaloc loc]
let svg_length =
let parse_unit loc name unit =
begin match unit with
| "cm" -> [%expr `Cm]
| "em" -> [%expr `Em]
| "ex" -> [%expr `Ex]
| "in" -> [%expr `In]
| "mm" -> [%expr `Mm]
| "pc" -> [%expr `Pc]
| "pt" -> [%expr `Pt]
| "px" -> [%expr `Px]
| "%" -> [%expr `Percent]
| s -> Common.error loc "Invalid length unit %s in %s" s name
end [@metaloc loc]
in
fun ?separated_by ?default loc name s ->
Some
(svg_quantity "an SVG length" "SVG lengths" parse_unit
?separated_by ?default loc name s)
let angle_ =
let parse_unit loc name unit =
begin match unit with
| "deg" -> [%expr `Deg]
| "rad" -> [%expr `Rad]
| "grad" -> [%expr `Grad]
| s -> Common.error loc "Invalid angle unit %s in %s" s name
end [@metaloc loc]
in
svg_quantity "an SVG angle" "SVG angles" parse_unit
let angle ?separated_by ?default loc name s =
Some (angle_ ?separated_by ?default loc name s)
let offset =
let bad_form name loc =
Common.error loc "Value of %s must be a number or percentage" name in
let regexp = Re_str.regexp "\\([-+0-9eE.]+\\)\\(%\\)?" in
fun ?separated_by:_ ?default:_ loc name s ->
if not @@ does_match regexp s then bad_form name loc;
begin
let n =
match float_exp loc (Re_str.matched_group 1 s) with
| Some n -> n
| None -> bad_form name loc
in
if group_matched 2 s then Some [%expr `Percentage [%e n]]
else Some [%expr `Number [%e n]]
end [@metaloc loc]
let transform =
let regexp = Re_str.regexp "\\([^(]+\\)(\\([^)]*\\))" in
fun ?separated_by:_ ?default:_ loc name s ->
if not @@ does_match regexp s then
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
let e =
begin match kind with
| "matrix" ->
begin match spaces_or_commas_ float loc "matrix" values with
| [a; b; c; d; e; f] ->
[%expr `Matrix ([%e a], [%e b], [%e c], [%e d], [%e e], [%e f])]
| _ ->
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)]
| _ ->
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)]
| _ -> Common.error loc "%s: scale requires one or two numbers" name
end
| "rotate" ->
begin match Re_str.bounded_split spaces_or_commas_regexp values 2 with
| [a] -> [%expr `Rotate ([%e angle_ loc "rotate" a], None)]
| [a; axis] ->
begin match spaces_or_commas_ float loc "rotate axis" axis with
| [cx; cy] ->
[%expr `Rotate
([%e angle_ loc "rotate" a], Some ([%e cx], [%e cy]))]
| _ ->
Common.error loc "%s: rotate center requires two numbers" name
end
| _ ->
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 -> Common.error loc "%s: %s is not a valid transform type" name s
end [@metaloc loc]
in
Some e
(* String-like. *)
let string ?separated_by:_ ?default:_ loc _ s =
Some (Ast_builder.Default.estring ~loc s)
let variand s =
let without_backtick s =
let length = String.length s in
String.sub s 1 (length - 1)
in
s |> Name_convention.polyvar |> without_backtick
let variant ?separated_by:_ ?default:_ loc _ s =
Some (Exp.variant ~loc (variand s) None)
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 (Common.string loc s)))
let variant_or_empty empty ?separated_by:_ ?default:_ loc _ s =
let variand = variand s in
let variand = if variand = "" then empty else variand in
Some (Exp.variant ~loc variand None)
(* Miscellaneous. *)
let presence ?separated_by:_ ?default:_ _ _ _ = None
let paint_without_icc loc _name s =
begin match s with
| "none" ->
[%expr `None]
| "currentColor" ->
[%expr `CurrentColor]
| _ ->
let icc_color_start =
try Some (Re_str.search_forward (Re_str.regexp "icc-color(\\([^)]*\\))") s 0)
with Not_found -> None
in
match icc_color_start with
| 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 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 |> Common.string loc in
let remainder_start = Re_str.group_end 0 in
let remainder_length = String.length s - remainder_start in
let remainder =
String.sub s remainder_start remainder_length |> String.trim in
begin
if remainder = "" then
Some [%expr `Icc ([%e iri], None)]
else
Some
[%expr
`Icc ([%e iri], Some [%e paint_without_icc loc name remainder])]
end [@metaloc loc]
let srcset_element =
let space = Re_str.regexp " +" in
fun ?separated_by:_ ?default:_ loc name s ->
let e =
begin match Re_str.bounded_split space s 2 with
| [url] ->
[%expr `Url [%e Common.string loc url]]
| [url; descriptor] ->
let bad_descriptor () =
Common.error loc "Bad width or density descriptor in %s" name in
let url = Common.string loc url in
let suffix_index = String.length descriptor - 1 in
let is_width =
match descriptor.[suffix_index] with
| 'w' -> true
| 'x' -> false
| _ -> bad_descriptor ()
| exception Invalid_argument _ -> bad_descriptor ()
in
if is_width then
let n =
match int_exp loc (String.sub descriptor 0 suffix_index) with
| Some n -> n
| None ->
Common.error loc "Bad number for width in %s" name
in
[%expr `Url_width ([%e url], [%e n])]
else
let n =
match float_exp loc (String.sub descriptor 0 suffix_index) with
| Some n -> n
| None ->
Common.error loc "Bad number for pixel density in %s" name
in
[%expr `Url_pixel ([%e url], [%e n])]
| _ -> Common.error loc "Missing URL in %s" name
end [@metaloc loc]
in
Some e
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 Common.string loc s]]
[@metaloc loc]
(* Special-cased. *)
let sandbox = spaces variant
let in_ = total_variant Svg_types_reflected.in_value
let in2 = in_
let xmlns ?separated_by:_ ?default:_ loc name s =
if s <> "http://www.w3.org/1999/xhtml" then
Common.error loc "%s: namespace must be http://www.w3.org/1999/xhtml" name;
Some [%expr `W3_org_1999_xhtml] [@metaloc loc]
tyxml-4.5.0/syntax/attribute_value.mli 0000664 0000000 0000000 00000016542 14040247726 0020143 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** Attribute value parsers and parser combinators. *)
type 'a gparser =
?separated_by:string -> ?default:string -> Location.t -> string -> 'a ->
expression option
type parser = string 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
function [p] such that [p loc name value] either:
- converts the string [value] into [Some] of a parse tree representing that
value, for use with attributes that take an argument, or
- evaluates to [None], for use with attributes that take no argument (for
instance, [a_selected]).
For example, [int loc name "3"] converts ["3"] into the parse tree
[{pexp_desc = Pexp_constant (Const_int 3); ...}].
The parse tree is assigned the location [loc]. This {e should} be the
location of the start of the value string, but, presently, the location of
the element containing the value string is used.
[name] is the name of the attribute. This is used only for error reporting.
[~separated_by] and [~default] are used internally by combinators to modify
the error message (for example, to make nouns plural if an error occurs in a
list). *)
(** {2 Combinators} *)
val option : string -> parser -> parser
(** [option none parser _ _ s] behaves as follows:
- if [s] = [none], evaluates to a parse tree for [None].
- otherwise, if [parser _ _ s] evaluates to a parse tree for [e], [option]
evaluates to a parse tree for [Some e]. *)
val spaces : parser -> parser
(** [spaces parser _ _ s] splits [s] on spaces, then applies [parser] to each
component. The resulting parse trees for [e, e', ...] are combined into a
parse tree of [[e; e'; ...]]. *)
val commas : parser -> parser
(** Similar to [spaces], but splits on commas. *)
val semicolons : parser -> parser
(** Similar to [spaces], but splits on semicolons. *)
val spaces_or_commas : parser -> parser
(** Similar to [spaces], but splits on both spaces and commas. *)
(** {3 Top combinators}
Exported parsers should always use one of those combinators last. *)
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 -> 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. *)
(** {2 Numeric} *)
val char : parser
(** [char _ _ s], where [s] is a string containing a single UTF-8 character [c],
produces a parse tree for [c] of type [char]. Note that this means the range
is restricted to the first 256 code points. *)
val bool : parser
(** [bool _ _ s] produces a parse tree for the boolean [true]
if [s = "true"] or [""] and [false] if [s = "false"]. *)
val onoff : parser
(** [onoff _ _ s] produces a parse tree for the boolean [true]
if [s = "on"] or [""] and [false] if [s = "off"]. *)
val unit : parser
(** [unit _ name s] produces a parse tree for [()]. It fails if [name <> s]. *)
val int : parser
(** [int _ _ s] produces a parse tree for [int_of_string s]. *)
val float : parser
(** [float _ _ s] produces a parse tree for [float_of_string s]. This is a
slight superset of HTML and SVG decimal fraction number syntax. *)
val points : parser
(** Similar to [spaces_or_commas float], but pairs consecutive numbers. *)
val number_pair : parser
(** [number_pair _ _ s] produces a parse tree for
- [n, None] if [s] = [(string_of_float n)], or
- [m, Some n'] if [s] is a space- or comma-separated list of representations
of two floats. *)
val fourfloats : parser
(** Acts as [spaces_or_commas float], but expects the list to have exactly four
elements. *)
val icon_size : parser
(** [icon_size _ _ s] produces a parse tree for the pair [(width, height)] when
[s] has the form [(string_of_int width) ^ x ^ (string_of_int height)] and
[x] is either ["x"] or ["X"]. *)
(** {2 Dimensional} *)
val svg_length : parser
(** [svg_length _ _ s] produces a parse tree for a value of type
[Svg_types.Unit.(length quantity)]. [s] is expected to have form
[(string_of_float n) ^ unit] for some number [n] and a valid SVG length
unit, or no unit. *)
val angle : parser
(** Similar to [svg_length], but for SVG angles. *)
val offset : parser
(** [offset _ _ s] produces a parse tree for
- [`Number n] if [s] = [string_of_float n], or
- [`Percentage n] if [s] has form [(string_of_float n) ^ "%"]. *)
val transform : parser
(** Parses an SVG transform attribute value.
@see
*)
(* {2 String-like} *)
val string : parser
(** [string _ _ s] produces a parse tree for [s]. This is intended for ordinary
attributes containing text that requires no further parsing. *)
val variant : parser
(** [variant _ _ s] produces a parse tree for the variand
[Tyxml_name.polyvar s]. This is intended for attributes whose argument type
is a polymorphic variant, none of whose constructors take arguments. *)
val total_variant : (string * string list) -> parser
(** [total_variant] is used for parsing arguments whose type is a variant with
the following pattern:
{[
| `A | `B | `C | `EverythingElse of string
]}
It behaves like [variant] for strings matching the no-argument constructors.
Any other string [s] is mapped to the parse trees for
[`EverythingElse s]. *)
val variant_or_empty : string -> parser
(** [variant_or_empty empty] is used for parsing arguments whose type
is a variant, possibly the empty string. It behaves like [variant]
for every string but the empty one, which will be parsed as if it
was the [empty] parameter. *)
(* {2 Miscellaneous} *)
val presence : parser
(** [presence _ _ _] evaluates to [None]. It is used as a "parser" for
attributes that do not take arguments. *)
val paint : parser
(* Parses SVG paint values. See
{:{https://www.w3.org/TR/SVG/painting.html#SpecifyingPaint} Specifying
paint}. *)
val srcset_element : parser
(** Used for [a_srcset]. *)
val number_or_datetime : parser
(** Used for [a_input_min] and [a_input_max]. *)
(* {2 Special-cased}
These parsers are named after the attribute for which they are used. *)
val sandbox : parser
val in_ : parser
val in2 : parser
val xmlns : parser
tyxml-4.5.0/syntax/attributes.ml 0000664 0000000 0000000 00000013037 14040247726 0016755 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
let parse loc (language, element_name) attributes =
let (module Reflected) =
Namespace.get language in
(* For prefix ["prefix"] and attribute names ["prefix-foo"], evaluates to
[Some "foo"], otherwise evaluates to [None].
Used to parse user-data attributes (prefixed by "data-") and ARIA
attributes (prefixed by "aria-").
*)
let parse_prefixed prefix name =
let length = String.length prefix in
let is_prefixed =
try String.sub name 0 length = prefix
with Invalid_argument _ -> false
in
if not is_prefixed then None
else Some (String.sub name length (String.length name - length))
in
(* Applied to each attribute. Accumulates individually labeled attributes,
such as img/src, in "labeled," and attributes passed in ~a in "regular." *)
let parse_attribute (labeled, regular) ((_, local_name), value) =
(* Convert the markup name of the attribute to a TyXML name without regard
to renamed attributes such as "a_input_max." Renaming will be accounted
for later. *)
let tyxml_name = Name_convention.attrib local_name in
let test_labeled (e, a, _) = e = element_name && a = local_name in
let test_blacklisted (a, _, _) = a = tyxml_name in
let test_renamed (_, a, es) = a = local_name && List.mem element_name es in
let unknown () =
Common.error loc "Unknown attribute in %s element: %s"
(Common.lang language) local_name
in
(* Check whether this attribute is individually labeled. Parse its argument
and accumulate the attribute if so. *)
match Common.find test_labeled Reflected.labeled_attributes with
| Some (_, label, parser) ->
let e =
match parser language loc local_name value with
| None ->
Common.error loc
"Internal error: labeled attribute %s without an argument" label
| Some e -> e
in
(Labelled label, e)::labeled, regular
| None ->
(* The attribute is not individually labeled, so it is passed in ~a.
First, check if the default TyXML name of this attribute collides with
the TyXML name of a renamed attribute. For example, if the language is
HTML, and this attribute has markup name "input-max" (which is
invalid), then its default TyXML name will be "a_input_max", which is a
*valid* value in TyXML. We want to avoid mapping "input-max" to
"a_input_max", because "input-max" is invalid, and because
"a_input_max" maps to "max" instead. *)
if List.exists test_blacklisted Reflected.renamed_attributes then
unknown ()
else
let parse_prefixed_attribute tag tyxml_name =
let parser =
try List.assoc tyxml_name Reflected.attribute_parsers
with Not_found ->
Common.error loc "Internal error: no parser for %s" tyxml_name
in
let identifier = Common.make ~loc language tyxml_name in
let tag = Common.string loc tag in
let e =
match parser language loc local_name value with
| Some e' -> [%expr [%e identifier] [%e tag] [%e e']] [@metaloc loc]
| None ->
Common.error loc "Internal error: no expression for %s"
tyxml_name
in
labeled, e::regular
in
(* Check if this is a "data-foo" or "aria-foo" attribute. Parse the
attribute value, and accumulate it in the list of attributes passed
in ~a. *)
match parse_prefixed "data-" local_name,
parse_prefixed "aria-" local_name
with
| Some tag, _ -> parse_prefixed_attribute tag "a_user_data"
| _, Some tag -> parse_prefixed_attribute tag "a_aria"
| None, None ->
let tyxml_name =
match Common.find test_renamed Reflected.renamed_attributes with
| Some (name, _, _) -> name
| None -> tyxml_name
in
let parser =
try List.assoc tyxml_name Reflected.attribute_parsers
with Not_found -> unknown ()
in
let identifier = Common.make ~loc language tyxml_name in
let e =
match parser language loc local_name value with
| None -> identifier
| Some e' -> [%expr [%e identifier] [%e e']] [@metaloc loc]
in
labeled, e::regular
in
let labeled, regular =
List.fold_left parse_attribute ([], []) attributes in
(* If there are any attributes to pass in ~a, assemble them into a parse tree
for a list, and prefix that with the ~a label. *)
if regular = [] then List.rev labeled
else
let regular =
Labelled "a",
Common.list loc (List.rev regular)
in
List.rev (regular::labeled)
tyxml-4.5.0/syntax/attributes.mli 0000664 0000000 0000000 00000002745 14040247726 0017132 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** Attribute parsing. *)
val parse :
Location.t -> Common.name -> (Common.name * string Common.value) list ->
(Ppxlib.arg_label * Ppxlib.expression) list
(** [parse loc element_name attributes] evaluates to a list of labeled parse
trees, each representing an attribute argument to the element function for
[element_name]. For example, if called on the HTML element
[], this function will evaluate to
parse trees for the arguments:
{[
~src:(return "foo") ~alt:(return "bar") ~a:[id (return "some-image")]
]}
This satisfies the attribute arguments in the signature of
[Html_sigs.T.img]. *)
tyxml-4.5.0/syntax/common.ml 0000664 0000000 0000000 00000007662 14040247726 0016066 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
open Ppxlib.Ast_helper
open Ppxlib.Parsetree
(** Lang utilities *)
type lang = Html | Svg
type name = lang * string
let html_implementation = ref "Html"
let svg_implementation = ref "Svg"
let implemenentation_ref = function
| Html -> html_implementation
| Svg -> svg_implementation
let set_implementation lang s =
(implemenentation_ref lang) := s
let implementation lang =
!(implemenentation_ref lang)
let lang = function
| Html -> "HTML"
| Svg -> "SVG"
let make_lid ~loc i s =
{ txt =
(Longident.parse @@ implementation i ^ "." ^ s);
loc }
let make ~loc i s =
Exp.ident ~loc @@ make_lid ~loc i s
(** Generic *)
let find f l =
try Some (List.find f l)
with Not_found -> None
let error loc ppf =
(* Originally written by @Drup in 24d87befcc505a9e3a1b081849b12560ce38028f. *)
(* We use a custom implementation because the type of Location.raise_errorf
changed in 4.03 *)
let buf = Buffer.create 17 in
let fmt = Format.formatter_of_buffer buf in
Format.kfprintf
(fun _ ->
Format.pp_print_flush fmt ();
Location.raise_errorf ~loc "%s@." (Buffer.contents buf))
fmt
ppf
(** Ast manipulation *)
let int loc = Ast_builder.Default.eint ~loc
let float loc fl = Ast_builder.Default.efloat ~loc @@ string_of_float fl
let string loc = Ast_builder.Default.estring ~loc
let add_constraints ~list lang e =
let loc = {e.pexp_loc with loc_ghost = true} in
let elt = make_lid ~loc lang "elt" in
let wrap =
if list then make_lid ~loc lang "list_wrap"
else make_lid ~loc lang "wrap"
in
let ty =
Typ.(constr ~loc wrap [ constr ~loc elt [any ~loc ()]])
in
Exp.constraint_ ~loc e ty
type 'a value =
| Val of 'a
| Antiquot of expression
let value x = Val x
let antiquot e = Antiquot e
let map_value f = function
| Val x -> Val (f x)
| Antiquot x -> Antiquot x
let list_gen cons append nil l =
let f acc = function
| Val x -> cons acc x
| Antiquot e -> append acc e
in
(l |> List.rev |> List.fold_left f nil)
let list loc l =
let nil = [%expr []][@metaloc loc] in
let cons acc x = [%expr [%e x]::[%e acc]][@metaloc loc] in
let append acc x = [%expr [%e x]@[%e acc]][@metaloc loc] in
list_gen cons append nil @@ List.map (fun x -> Val x) l
let list_wrap_value lang loc =
let (!!) = make ~loc lang in
let nil =
[%expr
[%e !!"Xml.W.nil"]
()] [@metaloc loc]
in
let cons acc x =
[%expr [%e !!"Xml.W.cons"]
([%e !!"Xml.W.return"] [%e x])
[%e acc]
][@metaloc loc]
in
let append acc x =
[%expr
[%e !!"Xml.W.append"]
[%e add_constraints ~list:true lang x] [%e acc]
][@metaloc loc]
in
list_gen cons append nil
let list_wrap lang loc l =
list_wrap_value lang loc @@ List.map (fun x -> Val x) l
let wrap implementation loc e =
[%expr
[%e make ~loc implementation "Xml.W.return"]
[%e e]] [@metaloc loc]
let wrap_value lang loc = function
| Val x -> wrap lang loc x
| Antiquot e -> add_constraints ~list:false lang e
let txt ~loc ~lang s =
let txt = make ~loc lang "txt" in
let arg = wrap lang loc @@ string loc s in
Ast_helper.Exp.apply ~loc txt [Nolabel, arg]
tyxml-4.5.0/syntax/common.mli 0000664 0000000 0000000 00000004263 14040247726 0016231 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
val find : ('a -> bool) -> 'a list -> 'a option
(** Similar to [List.find], but evaluates to an option instead of raising
[Not_found]. *)
(** Markup language *)
type lang = Html | Svg
val lang : lang -> string
val implementation : lang -> string
val set_implementation : lang -> string -> unit
type name = lang * string
val make_lid :
loc:Location.t -> lang -> string -> Longident.t Location.loc
val make :
loc:Location.t -> lang -> string -> expression
(** Expression helpers. *)
val int : Location.t -> int -> expression
val float : Location.t -> float -> expression
val string : Location.t -> string -> expression
val list : Location.t -> expression list -> expression
val list_wrap : lang -> Location.t -> expression list -> expression
val wrap :
lang -> Location.t -> expression -> expression
(** [wrap implementation loc e] creates a parse tree for
[implementation.Xml.W.return e]. *)
type 'a value =
| Val of 'a
| Antiquot of expression
val map_value : ('a -> 'b) -> 'a value -> 'b value
val value : 'a -> 'a value
val antiquot : expression -> _ value
val wrap_value :
lang -> Location.t -> expression value -> expression
val list_wrap_value :
lang -> Location.t -> expression value list -> expression
val error : Location.t -> ('b, Format.formatter, unit, 'a) format4 -> 'b
val txt :
loc:Location.t -> lang:lang -> string -> expression
tyxml-4.5.0/syntax/dune 0000664 0000000 0000000 00000001430 14040247726 0015105 0 ustar 00root root 0000000 0000000 (rule
(targets html_sigs_reflected.ml)
(deps reflect/reflect.exe ../lib/html_sigs.mli)
(action (run %{deps} %{targets})))
(rule
(targets svg_sigs_reflected.ml)
(deps reflect/reflect.exe ../lib/svg_sigs.mli)
(action (run %{deps} %{targets})))
(rule
(targets html_types_reflected.ml)
(deps reflect/reflect.exe ../lib/html_types.mli)
(action (run %{deps} %{targets})))
(rule
(targets svg_types_reflected.ml)
(deps reflect/reflect.exe ../lib/svg_types.mli)
(action (run %{deps} %{targets})))
(library
(name tyxml_syntax)
(public_name tyxml-syntax)
(libraries uutf re.str
ppxlib
)
(preprocess (pps ppxlib.metaquot))
(modules_without_implementation sigs_reflected)
(flags (:standard
-safe-string
-open Ppxlib
-w "-9"
))
)
tyxml-4.5.0/syntax/element.ml 0000664 0000000 0000000 00000004233 14040247726 0016216 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
let find_assembler (lang, name) =
let (module Reflected) = Namespace.get lang in
let name =
try List.assoc name Reflected.renamed_elements
with Not_found -> Name_convention.ident name
in
try Some (name, List.assoc name Reflected.element_assemblers)
with Not_found -> None
let parse
~loc ~parent_lang
~name:((lang, name) as element_name) ~attributes children =
let attributes = Attributes.parse loc element_name attributes in
let (module Reflected) = Namespace.get lang in
let lang = match parent_lang, lang with
| Common.Html, Svg -> Common.Html
| Html, Html | Svg, Svg -> lang
| Svg, Html ->
Common.error loc
"Nesting of Html element inside svg element is not supported"
in
let name, assembler = match find_assembler element_name with
| Some e -> e
| None -> Common.error loc "Unknown %s element %s" (Common.lang lang) name
in
let element_function = Common.make ~loc lang name in
let children = assembler ~lang ~loc ~name children in
Ast_helper.Exp.apply ~loc element_function (attributes @ children)
let comment ~loc ~lang s =
let tot = Common.make ~loc lang "tot" in
let comment = Common.make ~loc lang "Xml.comment" in
let s = Common.string loc s in
(* Using metaquot here avoids fiddling with labels. *)
[%expr [%e tot] ([%e comment] [%e s])][@metaloc loc]
tyxml-4.5.0/syntax/element.mli 0000664 0000000 0000000 00000003027 14040247726 0016367 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** Element parsing. *)
val parse :
loc:Location.t ->
parent_lang:Common.lang ->
name:Common.name ->
attributes:(Common.name * string Common.value) list ->
Ppxlib.expression Common.value list ->
Ppxlib.expression
(** [parse ~loc ~parent_lang ~name ~attributes children]
evaluates to a parse tree for applying the TyXML function corresponding
to element [name] to suitable arguments representing [attributes] and
[children].
*)
val comment :
loc:Location.t ->
lang:Common.lang ->
string ->
Ppxlib.expression
(** [comment ~loc ~ns s] evaluates to a parse tree that represents an XML comment. *)
val find_assembler :
Common.name ->
(string * Element_content.assembler) option
tyxml-4.5.0/syntax/element_content.ml 0000664 0000000 0000000 00000020522 14040247726 0017747 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
open Asttypes
open Parsetree
type assembler =
lang:Common.lang ->
loc:Location.t ->
name:string ->
expression Common.value list ->
(arg_label * expression) list
(* Helpers. *)
(* Given a parse tree [e], if [e] represents [_.txt s], where [s] is a string
constant, evaluates to [Some s]. Otherwise, evaluates to [None]. *)
let to_txt = function
| [%expr[%e? {pexp_desc = Pexp_ident f; _}]
( [%e? {pexp_desc = Pexp_ident f2; _}] [%e? arg])] -> begin
match Longident.last_exn f.txt, Longident.last_exn f2.txt, arg.pexp_desc with
| "txt", "return", Pexp_constant (Pconst_string (s, _, _)) -> Some s
| _ -> None
end
| _ -> None
(** Test if the expression is a txt containing only whitespaces. *)
let is_whitespace = function
| Common.Val e -> begin
match to_txt e with
| Some s when String.trim s = "" -> true
| _ -> false
end
| _ -> false
(* Given a list of parse trees representing children of an element, filters out
all children that consist of applications of [txt] to strings containing
only whitespace. *)
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
(** Improve an assembler by first applying [filter_whitespace] on children
Used by the [[@@reflect.filter_whitespace]] annotation *)
let comp_filter_whitespace assembler ~lang ~loc ~name children =
assembler ~lang ~loc ~name (filter_whitespace children)
(* Given a parse tree and a string [name], checks whether the parse tree is an
application of a function with name [name]. *)
let is_element_with_name name = function
| Common.Val {pexp_desc = Pexp_apply ({pexp_desc = Pexp_ident {txt}}, _)}
when txt = name -> true
| _ -> false
(* Partitions a list of elements according to [is_element_with_name name]. *)
let partition name children =
List.partition (is_element_with_name name) children
(* Given the name [n] of a function in [Html_sigs.T], evaluates to
["Html." ^ n]. *)
let html local_name =
Longident.Ldot (Lident Common.(implementation Html), local_name)
(* Generic. *)
let nullary ~lang:_ ~loc ~name children =
if children <> [] then
Common.error loc "%s should have no content" name;
[Nolabel, [%expr ()] [@metaloc loc]]
let unary ~lang ~loc ~name children =
match children with
| [child] ->
let child = Common.wrap_value lang loc child in
[Nolabel, child]
| _ -> Common.error loc "%s should have exactly one child" name
let star ~lang ~loc ~name:_ children =
[Nolabel, Common.list_wrap_value lang loc children]
(* Special-cased. *)
let head ~lang ~loc ~name children =
let title, others = partition (html "title") children in
match title with
| [title] ->
(Nolabel, Common.wrap_value lang loc title) :: star ~lang ~loc ~name others
| _ ->
Common.error loc
"%s element must have exactly one title child element" name
let figure ~lang ~loc ~name children =
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 ->
(Labelled "figcaption",
[%expr `Top [%e Common.wrap_value lang loc elt]])::
(star ~lang ~loc ~name children)
| `Bottom elt ->
(Labelled "figcaption",
[%expr `Bottom [%e Common.wrap_value lang loc elt]])::
(star ~lang ~loc ~name children)
end [@metaloc loc]
let object_ ~lang ~loc ~name children =
let params, others = partition (html "param") children in
if params <> [] then
(Labelled "params", Common.list_wrap_value lang loc params) ::
star ~lang ~loc ~name others
else
star ~lang ~loc ~name others
let audio_video ~lang ~loc ~name children =
let sources, others = partition (html "source") children in
if sources <> [] then
(Labelled "srcs", Common.list_wrap_value lang loc sources) ::
star ~lang ~loc ~name others
else
star ~lang ~loc ~name others
let table ~lang ~loc ~name children =
let caption, others = partition (html "caption") children in
let columns, others = partition (html "colgroup") others in
let thead, others = partition (html "thead") others in
let tfoot, others = partition (html "tfoot") others in
let one label = function
| [] -> []
| [child] -> [Labelled label, Common.wrap_value lang loc child]
| _ -> Common.error loc "%s cannot have more than one %s" name label
in
let columns =
if columns = [] then []
else [Labelled "columns", Common.list_wrap_value lang loc columns]
in
(one "caption" caption) @
columns @
(one "thead" thead) @
(one "tfoot" tfoot) @
(star ~lang ~loc ~name others)
let fieldset ~lang ~loc ~name children =
let legend, others = partition (html "legend") children in
match legend with
| [] -> star ~lang ~loc ~name others
| [legend] ->
(Labelled "legend", Common.wrap_value lang loc legend)::
(star ~lang ~loc ~name others)
| _ -> Common.error loc "%s cannot have more than one legend" name
let datalist ~lang ~loc ~name children =
let options, others = partition (html "option") children in
let children =
begin match others with
| [] ->
Labelled "children",
[%expr `Options [%e Common.list_wrap_value lang loc options]]
| _ ->
Labelled "children",
[%expr `Phras [%e Common.list_wrap_value lang loc children]]
end [@metaloc loc]
in
children::(nullary ~lang ~loc ~name [])
let script ~lang ~loc ~name children =
match children with
| [] ->
let child = Common.txt ~loc ~lang "" in
[Nolabel, child]
| [child] ->
let child = Common.wrap_value lang loc child in
[Nolabel, child]
| _ -> Common.error loc "%s can have at most one child" name
let details ~lang ~loc ~name children =
let summary, others = partition (html "summary") children in
match summary with
| [summary] ->
(Nolabel, Common.wrap_value lang loc summary)::
(star ~lang ~loc ~name others)
| _ -> Common.error loc "%s must have exactly one summary child" name
let menu ~lang ~loc ~name children =
let children =
Labelled "child",
[%expr `Flows [%e Common.list_wrap_value lang loc children]]
[@metaloc loc]
in
children::(nullary ~lang ~loc ~name [])
let picture ~lang ~loc ~name children =
let img, others = partition (html "img") children in
match img with
| [] -> star ~lang ~loc ~name others
| [img] ->
(Labelled "img", Common.wrap_value lang loc img)::
(star ~lang ~loc ~name others)
| _ -> Common.error loc "%s cannot have more than one img" name
let html ~lang ~loc ~name children =
let head, others = partition (html "head") children in
let body, others = partition (html "body") others in
match head, body, others with
| [head], [body], [] ->
[Nolabel, Common.wrap_value lang loc head;
Nolabel, Common.wrap_value lang loc body]
| _ ->
Common.error loc
"%s element must have exactly head and body child elements" name
tyxml-4.5.0/syntax/element_content.mli 0000664 0000000 0000000 00000005671 14040247726 0020130 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** Element child argument assemblers. These are almost parsers, except they
only tell how to pass already-parsed children to element functions. *)
type assembler =
lang:Common.lang ->
loc:Location.t ->
name:string ->
expression Common.value list ->
(arg_label * expression) list
(** Assemblers satisfy: [assembler ~lang ~loc ~name children] evaluates
to a list of optionally-labeled parse trees for passing [children] to the
the element function for element [name]. For example, for a table element
{[
A
B
]}
The assembler [table], when called with the parsed children, will evaluate
to parse trees representing
{[
~thead:(* the thead element *) [(* the tbody element *)]
]}
This satisfies the child arguments in the signature of
[Html_sigs.T.tablex]. The [~table] label is represented by the string
["table"], and the unlabeled list argument is paired with the empty string.
The argument [implementation] is the name of the module providing the
run-time implementation of the element function that will be applied to the
children. It is either [Html] or [Svg], and is based on the element's
namespace. It is used for wrapping child elements, and for scoping child
[txt] elements.
The [name] argument is used for error reporting. *)
(** {2 Generic} *)
val nullary : assembler
val unary : assembler
val star : assembler
(** {2 Special-cased} *)
val html : assembler
val head : assembler
val figure : assembler
val object_ : assembler
val audio_video : assembler
val table : assembler
val fieldset : assembler
val datalist : assembler
val details : assembler
val menu : assembler
val picture : assembler
val script : assembler
(** {1 Misc utilities} *)
(** Remove txt node containing only whitespace that are at the beginning or the end
of the list. *)
val filter_surrounding_whitespace :
expression Common.value list ->
expression Common.value list
(** Improve an assembler by removing txt nodes containing only whitespace *)
val comp_filter_whitespace : assembler -> assembler
tyxml-4.5.0/syntax/name_convention.ml 0000664 0000000 0000000 00000002113 14040247726 0017742 0 ustar 00root root 0000000 0000000
(* Elements and attributes are technically utf8, but ascii is enough for now.
see
*)
(* When dropping support for 4.02, this module can simply be deleted. *)
module Char = struct
include Char
let lowercase_ascii = Char.lowercase [@ocaml.warning "-3"]
let uppercase_ascii = Char.uppercase [@ocaml.warning "-3"]
end
(* In the ocaml parser:
let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9']
*)
let is_identchar = function
| 'A'..'Z'
| 'a'..'z'
| '_'
| '\''
| '0'..'9' -> true
| _ -> false
let to_ocaml_bytes s =
let f c = if is_identchar c then c else '_' in
Bytes.init (String.length s) (fun i -> f s.[i])
let to_ocaml s =
Bytes.to_string (to_ocaml_bytes s)
let ident s =
let s = to_ocaml_bytes s in
let s = Bytes.mapi (fun i c ->
if i = 0 then Char.lowercase_ascii c else c)
s in
Bytes.to_string s
let attrib s =
"a_" ^ to_ocaml s
let polyvar s =
let s = to_ocaml_bytes s in
let s = Bytes.mapi (fun i c ->
if i = 0 then Char.uppercase_ascii c else c)
s in
"`" ^ Bytes.to_string s
tyxml-4.5.0/syntax/name_convention.mli 0000664 0000000 0000000 00000001357 14040247726 0020124 0 ustar 00root root 0000000 0000000 (** Gives the tyxml names for HTML elements and attributes. *)
(** The transformations are the following:
- Valid letters in OCaml identifiers are kept.
- Everything else is turn into an underscore '_'.
*)
val to_ocaml : string -> string
(** Turn the given element name into a valid identifier.
Follow the [to_ocaml] convention and lowercase the first letter. *)
val ident : string -> string
(** Turn the given attribute name into a valid identifier.
Follow the [to_ocaml] convention and add ["a_"] at the beginning. *)
val attrib : string -> string
(** Turn the given name into a valid Polymorphic variant name.
Follow the [to_ocaml] convention, uppercase the first letter and add ["`"]. *)
val polyvar : string -> string
tyxml-4.5.0/syntax/namespace.ml 0000664 0000000 0000000 00000001735 14040247726 0016525 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
let get : Common.lang -> (module Sigs_reflected.S) = function
| Html -> (module Html_sigs_reflected)
| Svg -> (module Svg_sigs_reflected)
tyxml-4.5.0/syntax/namespace.mli 0000664 0000000 0000000 00000002031 14040247726 0016664 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** Namespace-specific values. *)
val get : Common.lang -> (module Sigs_reflected.S)
(** Returns the preprocessing-time module
containing reflection information associated to the given language. *)
tyxml-4.5.0/syntax/reflect/ 0000775 0000000 0000000 00000000000 14040247726 0015655 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/syntax/reflect/dune 0000664 0000000 0000000 00000000252 14040247726 0016532 0 ustar 00root root 0000000 0000000 (executable
(name reflect)
(libraries ppxlib)
(preprocess (pps ppxlib.metaquot))
(flags (:standard
-safe-string
-open Ppxlib
-w "-9"
))
)
tyxml-4.5.0/syntax/reflect/reflect.ml 0000664 0000000 0000000 00000042217 14040247726 0017641 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(* Runs on [html_sigs.mli], [svg_sigs.mli], and [html_types.mli]. Certain type
and value declarations are read for type information, which is stored in
corresponding [_reflected] files - for example, [html_sigs.mli] results in
[html_sigs_reflected.ml]. See comments by functions below and in
[sigs_reflected.mli] for details. *)
open Ppxlib.Ast_helper
let find_attr s l =
let f attr = attr.attr_name.txt = s in
try Some (List.find f l)
with Not_found -> None
let is_attribute s = String.length s >= 2 && String.sub s 0 2 = "a_"
let strip_a s =
if String.length s < 2 || String.sub s 0 2 <> "a_" then s
else String.sub s 2 (String.length s - 2)
(** Utilities for types of functions. *)
module FunTyp = struct
(* Extract the tuple (arguments, return) of a function type. *)
let get t =
let rec scan acc = function
| {ptyp_desc = Ptyp_arrow (lab, t, t')} -> scan ((lab,t)::acc) t'
| ret -> (List.rev acc, ret)
in
scan [] t
let arguments t = fst @@ get t
let result t = snd @@ get t
exception Found
(** Check if a type contains the "elt" constructor, somewhere. *)
let contains_elt t =
let iterate = object
inherit Ast_traverse.iter as super
method! core_type = function
| [%type: [%t? _] elt] -> raise Found
| ty -> super#core_type ty
end in
try iterate#core_type t ; false
with Found -> true
(** Extract the type inside [wrap]. *)
let unwrap = function
(* Optional argument are [_ wrap *predef*.option], In 4.02 *)
| {ptyp_desc = Ptyp_constr (lid, [[%type: [%t? _] wrap] as t])}
when Longident.last_exn lid.txt = "option" ->
Some t
| [%type: [%t? _] wrap] as t -> Some t
| _ -> None
(** Extract the type of for html/svg attributes. *)
let extract_attribute_argument (lab, t) =
if contains_elt t then None
else match lab, unwrap t with
| Nolabel, _ | _, None -> None
| (Labelled lab | Optional lab), Some t -> Some (lab, t)
let rec no_constructor_arguments = function
| [] -> true
| {prf_desc = Rinherit _}::_
| {prf_desc = Rtag (_, _, _::_)}::_ -> false
| {prf_desc = Rtag (_, _, [])}::more -> no_constructor_arguments more
(* Given the name of a TyXML attribute function and a list of its argument
types, selects the attribute value parser (in module [Attribute_value])
that should be used for that attribute. *)
let rec to_attribute_parser lang name ~loc = function
| [] -> [%expr nowrap presence]
| [[%type: [%t? ty] wrap]] ->
[%expr wrap [%e to_attribute_parser lang name [ty] ~loc]]
| [[%type: character]] -> [%expr char]
| [[%type: bool] as ty]
when (List.exists (fun ty -> ty.attr_name.txt = "onoff") ty.ptyp_attributes) -> [%expr onoff]
| [[%type: bool]] -> [%expr bool]
| [[%type: unit]] -> [%expr nowrap unit]
| [[%type: number]] when lang = `Html -> [%expr int]
| [[%type: pixels]]
| [[%type: int]] -> [%expr int]
| [[%type: numbers]] when lang = `Html -> [%expr commas int]
| [[%type: number]] when lang = `Svg -> [%expr float]
| [[%type: float_number]] | [[%type: float]] -> [%expr float]
| [[%type: float_number option]] ->
[%expr option "any" float]
| [[%type: numbers_semicolon]] ->
[%expr semicolons float]
| [[%type: numbers]] when lang = `Svg ->
[%expr spaces_or_commas float]
| [[%type: fourfloats]] ->
[%expr fourfloats]
| [[%type: number_optional_number]] ->
[%expr number_pair]
| [[%type: coords]] ->
[%expr points]
| [[%type: (number * number) list option]] ->
[%expr option "any" (spaces icon_size)]
| [[%type: coord]] | [[%type: Unit.length]] ->
[%expr svg_length]
| [[%type: Unit.length list]] ->
[%expr spaces_or_commas svg_length]
| [[%type: Unit.angle option]] ->
[%expr option "auto" angle]
| [[%type: string]]
| [[%type: text]]
| [[%type: nmtoken]]
| [[%type: idref]]
| [[%type: Xml.uri]]
| [[%type: contenttype]]
| [[%type: languagecode]]
| [[%type: cdata]]
| [[%type: charset]]
| [[%type: frametarget]]
| [[%type: iri]]
| [[%type: color]] -> [%expr string]
| [[%type: nmtoken]; [%type: text wrap]] -> [%expr wrap string]
| [[%type: string]; [%type: string wrap]] -> [%expr wrap string]
| [[%type: string]; [%type: string list wrap]] -> [%expr wrap (spaces string)]
| [[%type: Xml.event_handler]]
| [[%type: Xml.mouse_event_handler]]
| [[%type: Xml.keyboard_event_handler]]
| [[%type: Xml.touch_event_handler]] ->
[%expr nowrap string]
| [[%type: string option]] ->
[%expr (option "" string)]
| [{ptyp_desc = Ptyp_variant (_::_::_ as constructors, _, _)}]
when no_constructor_arguments constructors ->
[%expr variant]
| [[%type: shape]] ->
[%expr variant]
| [[%type: nmtokens]]
| [[%type: idrefs]]
| [[%type: charsets]]
| [[%type: spacestrings]]
| [[%type: strings]]
| [[%type: string list]] ->
[%expr spaces string]
| [[%type: commastrings]]
| [[%type: text list]]
| [[%type: contenttypes]] ->
[%expr commas string]
| [[%type: linktypes]] ->
[%expr spaces (total_variant Html_types_reflected.linktype)]
| [[%type: referrerpolicy]] ->
[%expr variant_or_empty "Empty"]
| [[%type: mediadesc]] ->
[%expr commas (total_variant Html_types_reflected.mediadesc_token)]
| [[%type: lengths]] ->
[%expr spaces_or_commas svg_length]
| [[%type: transforms]] ->
[%expr spaces_or_commas transform]
| [[%type: paint]] ->
[%expr paint]
| [[%type: number_or_datetime]] ->
[%expr number_or_datetime]
| [[%type: image_candidate list]] ->
[%expr commas srcset_element]
| _ ->
let name = strip_a name in
let name = if name = "in" then "in_" else name in
Ast_builder.Default.evar ~loc name
end
(* Given a list of attributes from a val declaration whose name begins with a_,
checks if the declaration has a [@@reflect.attribute] annotation. If so, the
declaration's name does not directly correspond to markup attribute name
(e.g. "a_input_max" does not directly correspond to "max"). The annotation is
parsed to get the markup name and the element types in which the translation
from markup name to TyXML name should be performed. *)
let get_str = function
| {pexp_desc=Pexp_constant (Pconst_string (s, _, _)); _} -> Some s
| _ -> None
let ocaml_attributes_to_renamed_attribute name attributes =
let maybe_attribute = find_attr "reflect.attribute" attributes in
match maybe_attribute with
| None -> []
| Some {attr_loc = loc; attr_payload = payload} ->
let error () =
Location.raise_errorf ~loc
"Payload of [@@reflect.attribute] must be a string and a string list"
in
match payload with
| PStr [%str
[%e? const]
[%e? element_names]] ->
begin match get_str const with
| None -> error ()
| Some real_name ->
let element_names =
let error loc =
Location.raise_errorf ~loc
"List in [@@reflect.attribute] must contain strings"
in
let rec traverse acc = function
| [%expr [%e? e]::[%e? tail]] ->
begin match get_str e with
| Some element_name -> traverse (element_name::acc) tail
| None -> error e.pexp_loc
end
| [%expr []] -> acc
| {pexp_loc} -> error pexp_loc
in
traverse [] element_names
in
[name, real_name, element_names]
end
| _ -> error ()
(* Given a val declaration, determines whether it is for an element. If so,
evaluates to the element's child assembler (from module
[Element_content]), list of attributes passed as labeled arguments, and
markup name, if different from its TyXML name (for example, [object_] is
[object] in markup).
A val declaration is for an element if it either has a [@@reflect.element]
attribute, or its result type is [_ nullary], [_ unary], or [_ star].
Also understands the [@@reflect.filter_whitespace] attribute. *)
let val_item_to_element_info lang value_description =
let name = value_description.pval_name.txt in
let maybe_attribute =
find_attr "reflect.element" value_description.pval_attributes
in
let maybe_assembler, real_name =
match maybe_attribute with
| Some { attr_loc = loc ; attr_payload = payload} ->
let assembler, real_name = match payload with
| PStr [%str [%e? assembler] [%e? name]] ->
get_str assembler, get_str name
| PStr [%str [%e? assembler]] ->
get_str assembler, None
| _ -> None, None
in
begin match assembler with
| Some _ -> (assembler, real_name)
| None ->
Location.raise_errorf ~loc
"Payload of [@@reflect.element] must be one or two strings"
end
| None ->
let result_type = FunTyp.result value_description.pval_type in
let assembler = match result_type with
| [%type: ([%t? _], [%t ? _]) nullary] -> Some "nullary"
| [%type: ([%t? _], [%t ? _], [%t ? _]) unary] -> Some "unary"
| [%type: ([%t? _], [%t ? _], [%t ? _]) star] -> Some "star"
| _ -> None
in assembler, None
in
match maybe_assembler with
| None -> None
| Some assembler ->
(* We gather all the labeled arguments that are attributes. *)
let arguments = FunTyp.arguments value_description.pval_type in
let labeled_attributes =
let aux x acc = match FunTyp.extract_attribute_argument x with
| None -> acc
| Some (label, ty) ->
let parser = FunTyp.to_attribute_parser lang label [ty] ~loc:ty.ptyp_loc in
(name, label, parser) :: acc
in
List.fold_right aux arguments []
in
let rename =
match real_name with
| None -> []
| Some real_name -> [real_name, name]
in
let assembler = [ assembler ] in
let assembler =
match
find_attr "reflect.filter_whitespace" value_description.pval_attributes
with
| Some _ -> "comp_filter_whitespace" :: assembler
| None -> assembler
in
Some (assembler, labeled_attributes, rename)
let attribute_parsers = ref []
let labeled_attributes = ref []
let renamed_attributes = ref []
let element_assemblers = ref []
let renamed_elements = ref []
let reflected_variants = ref []
class reflector lang = object
inherit Ast_traverse.iter as super
(* Walks over signature items, looking for elements and attributes. Calls the
functions immediately above, and accumulates their results in the above
references. This function is relevant for [html_sigs.mli] and
[svg_sigs.mli]. *)
method! signature_item item =
begin match item.psig_desc with
| Psig_value {pval_name = {txt = name}; pval_type = type_; pval_attributes; pval_loc = loc}
when is_attribute name ->
(* Attribute declaration. *)
let argument_types = List.map snd @@ FunTyp.arguments type_ in
let attribute_parser_mapping =
name, FunTyp.to_attribute_parser lang name argument_types ~loc in
attribute_parsers := attribute_parser_mapping::!attribute_parsers;
let renaming = ocaml_attributes_to_renamed_attribute name pval_attributes in
renamed_attributes := renaming @ !renamed_attributes
| Psig_value v ->
(* Non-attribute, but potentially an element declaration. *)
begin match val_item_to_element_info lang v with
| None -> ()
| Some (assembler, labeled_attributes', rename) ->
element_assemblers := (v.pval_name.txt, assembler)::!element_assemblers;
labeled_attributes := labeled_attributes' @ !labeled_attributes;
renamed_elements := rename @ !renamed_elements
end
| _ -> ()
end;
super#signature_item item
(* Walks over type declarations (which will be in signature items). For each
that is marked with [@@reflect.total_variant], expects it to be a polymorphic
variant. Splits the constructors into those that have no arguments, and one
constructor that has one string argument. This constructor information is
accumulated in [reflected_variants]. This function is relevant for
[html_types.mli]. *)
method! type_declaration declaration =
let is_reflect attr = attr.attr_name.txt = "reflect.total_variant" in
if List.exists is_reflect declaration.ptype_attributes then begin
let name = declaration.ptype_name.txt in
match declaration.ptype_manifest with
| Some {ptyp_desc = Ptyp_variant (rows, _, _); ptyp_loc} ->
let rows =
rows |> List.map (function
| {prf_desc = Rtag (label, _, types)} -> label, types
| {prf_desc = Rinherit {ptyp_loc}} ->
Location.raise_errorf ~loc:ptyp_loc
"Inclusion is not supported by [@@reflect.total_variant]")
in
let nullary, unary =
List.partition (fun (_, types) -> types = []) rows in
let unary =
match unary with
| [name, [[%type: string]]] -> name.txt
| _ ->
Location.raise_errorf ~loc:ptyp_loc
"Expected exactly one non-nullary constructor `C of string"
in
let nullary = List.map (fun ({txt},_) -> txt) nullary in
reflected_variants := (name, (unary, nullary))::!reflected_variants
| _ ->
Location.raise_errorf ~loc:declaration.ptype_loc
"[@@reflect.total_variant] expects a polymorphic variant type"
end;
super#type_declaration declaration
end
(** Small set of combinators to help {!make_module}. *)
module Combi = struct
module Builder = Ast_builder.Make(struct let loc = Location.none end)
let list f l = Builder.elist @@ List.map f l
let tuple2 f1 f2 (x1, x2) = Builder.pexp_tuple [f1 x1; f2 x2]
let tuple3 f1 f2 f3 (x1, x2, x3) = Builder.pexp_tuple [f1 x1; f2 x2; f3 x3]
let str = Builder.estring
let id = Builder.evar
let expr x = x
let let_ p f (x,e) = Str.value Nonrecursive [Vb.mk (p x) (f e)]
let rec compose_ids =
function
| [ i ] -> id i
| i :: tl -> Builder.eapply (id i) [compose_ids tl]
| [] -> assert false
end
(** Create a module based on the various things collected while reading the file. *)
let emit_module () =
let loc = Location.none in
begin if !attribute_parsers <> [] then [%str
open Attribute_value
let attribute_parsers =
[%e Combi.(list @@ tuple2 str expr) !attribute_parsers ]
let renamed_attributes =
[%e Combi.(list @@ tuple3 str str (list str)) !renamed_attributes ]
let labeled_attributes =
[%e Combi.(list @@ tuple3 str str expr) !labeled_attributes ]
open Element_content
let element_assemblers =
[%e Combi.(list @@ tuple2 str compose_ids) !element_assemblers ]
let renamed_elements =
[%e Combi.(list @@ tuple2 str str) !renamed_elements ]
] else []
end @
List.map
Combi.(let_ (Ast_builder.Default.pvar ~loc) (tuple2 str (list str)))
!reflected_variants
(* Crude I/O tools to read a signature and output a structure.
The executable will take as first argument the name of the signature
and as second argument the name of the structure.
*)
let read_sig filename =
let handle =
try open_in filename
with Sys_error msg -> prerr_endline msg; exit 1
in
let buf = Lexing.from_channel handle in
buf.lex_curr_p <- {
pos_fname = filename;
pos_lnum = 1;
pos_bol = 0;
pos_cnum = 0;
};
let ast = Parse.interface buf in
close_in handle ;
ast
let write_struct filename ast =
let handle =
try open_out filename
with Sys_error msg -> prerr_endline msg; exit 1
in
let fmt = Format.formatter_of_out_channel handle in
Format.fprintf fmt "%a@." Pprintast.structure ast ;
close_out handle
let () =
if Array.length Sys.argv < 3 then begin
Printf.eprintf "Usage: %s IN OUT\n" Sys.argv.(0);
exit 2
end;
let in_file = Sys.argv.(1) in
let out_file = Sys.argv.(2) in
Ast_helper.default_loc := Location.in_file in_file ;
let lang =
let basename = Filename.basename in_file in
let svg_prefix = "svg_" in
if String.length basename >= String.length svg_prefix
&& String.sub basename 0 (String.length svg_prefix) = svg_prefix
then `Svg
else `Html
in
let reflected_struct sig_ =
let iterate = new reflector lang in
iterate#signature sig_ ;
emit_module ()
in
try
read_sig in_file
|> reflected_struct
|> write_struct out_file
with exn ->
Location.report_exception Format.err_formatter exn;
exit 2
tyxml-4.5.0/syntax/sigs_reflected.mli 0000664 0000000 0000000 00000003217 14040247726 0017721 0 ustar 00root root 0000000 0000000 (* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2016 Anton Bachin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1301, USA.
*)
(** Signature of [Html_sigs_reflected] and [Svg_sigs_reflected] (but not
[Html_types_reflected]). *)
module type S =
sig
val attribute_parsers :
(string * (Common.lang -> Attribute_value.vparser)) list
(** Pairs [tyxml_attribute_name, wrapped_attribute_value_parser]. *)
val renamed_attributes : (string * string * string list) list
(** Triples [tyxml_attribute_name, markup_name, in_element_types]. *)
val labeled_attributes :
(string * string * (Common.lang -> Attribute_value.vparser)) list
(** Triples [tyxml_element_name, label, wrapped_attribute_value_parser]. *)
val element_assemblers : (string * Element_content.assembler) list
(** Pairs [tyxml_element_name, child_argument_assembler]. *)
val renamed_elements : (string * string) list
(** Pairs [markup_element_name, tyxml_name]. *)
end
tyxml-4.5.0/test/ 0000775 0000000 0000000 00000000000 14040247726 0013662 5 ustar 00root root 0000000 0000000 tyxml-4.5.0/test/dune 0000664 0000000 0000000 00000002252 14040247726 0014541 0 ustar 00root root 0000000 0000000 ;; Normal tests
(library
(name tyxml_test)
(libraries tyxml alcotest)
(modules tyxml_test)
)
(tests
(names test_html test_svg)
(modules test_html test_svg)
(libraries tyxml alcotest tyxml_test)
(package tyxml)
)
(test
(name test_ppx)
(modules test_ppx)
(libraries tyxml alcotest tyxml_test)
(preprocess (pps tyxml-ppx))
(package tyxml-ppx)
)
(test
(name test_jsx)
(modules test_jsx)
(libraries tyxml alcotest tyxml_test)
(preprocess (pps tyxml-jsx))
(package tyxml-jsx)
)
;; Toplevel ppx tests
;; WIP this test is temporarily disable, waiting for proper support for
;; toplevel tests in dune.
; (executable
; (name ppx)
; (libraries tyxml-ppx ppxlib)
; (modules ppx)
; )
; (rule
; (targets html_fail.result)
; (deps ppx.exe html_fail.ml)
; (action (system "TERM= %{ocaml} -I ../implem/.tyxml.objs/ -noinit -noprompt -ppx './%{exe:ppx.exe} --as-ppx' < html_fail.ml 2>&1 | tail -n +3 > %{targets}"))
; )
; (alias
; (name runtest)
; (deps html_fail.result html_fail.expected)
; (action (diff html_fail.expected html_fail.result))
; (package tyxml-ppx)
; )
;; Emitbig
(test
(name emitbig)
(libraries tyxml unix)
(modules emitbig)
(package tyxml)
)
tyxml-4.5.0/test/emitbig.ml 0000664 0000000 0000000 00000001763 14040247726 0015643 0 ustar 00root root 0000000 0000000 (* This is an absurd website to stress the printer.
It creates fibonacci(22) nested divs.
*)
open Tyxml
let rec unfold n =
let l =
if n = 1 then []
else if n = 2 then []
else[
unfold (n-1) ;
unfold (n-2) ;
]
in
Html.(div ~a:[a_class ["fibo" ^ string_of_int n]] l)
let emit_page_pp indent page =
let file_handle = open_out "fibo.html" in
let fmt = Format.formatter_of_out_channel file_handle in
Format.fprintf fmt "%a@." (Html.pp ~indent ()) page;
close_out file_handle
let run_n ~n f x =
let r = ref 0. in
for _ = 1 to n do
let t = Unix.gettimeofday () in
f x ;
let tpp = Unix.gettimeofday () -. t in
r := !r +. tpp ;
done ;
!r /. float n
let () =
let p = Html.(
html (head (title (txt "fibo")) []) (body [unfold 22])
) in
let n = 10 in
let time_pp = run_n ~n (emit_page_pp false) p in
let time_indent_pp = run_n ~n (emit_page_pp true) p in
Format.printf
"Noindent: %f@.Indent: %f"
time_pp
time_indent_pp
tyxml-4.5.0/test/html_fail.expected 0000664 0000000 0000000 00000005035 14040247726 0017347 0 ustar 00root root 0000000 0000000 Characters 6-14:
div [a [a []]] ;;
^^^^^^^^
Error: This expression has type
([> 'b Html_types.a ] as 'a) Tyxml.Html.elt = 'a Tyxml_html.elt
but an expression was expected of type
([< Html_types.div_content_fun ] as 'd) Tyxml.Html.elt =
'd Tyxml_html.elt
Type 'a = [> `A of 'b ] is not compatible with type
'd =
[< `A of Html_types.flow5_without_interactive
| `Abbr
| `Address
| `Article
| `Aside
| `Audio of Html_types.flow5_without_media
| `Audio_interactive of Html_types.flow5_without_media
| `B
| `Bdo
| `Blockquote
| `Br
| `Button
| `Canvas of Html_types.flow5
| `Cite
| `Code
| `Command
| `Datalist
| `Del of Html_types.flow5
| `Details
| `Dfn
| `Div
| `Dl
| `Em
| `Embed
| `Fieldset
| `Figure
| `Footer
| `Form
| `H1
| `H2
| `H3
| `H4
| `H5
| `H6
| `Header
| `Hgroup
| `Hr
| `I
| `Iframe
| `Img
| `Img_interactive
| `Input
| `Ins of Html_types.flow5
| `Kbd
| `Keygen
| `Label
| `Main
| `Map of Html_types.flow5
| `Mark
| `Menu
| `Meter
| `Nav
| `Noscript of Html_types.flow5_without_noscript
| `Object of Html_types.flow5
| `Object_interactive of Html_types.flow5
| `Ol
| `Output
| `P
| `PCDATA
| `Pre
| `Progress
| `Q
| `Ruby
| `Samp
| `Script
| `Section
| `Select
| `Small
| `Span
| `Strong
| `Style
| `Sub
| `Sup
| `Svg
| `Table
| `Textarea
| `Time
| `U
| `Ul
| `Var
| `Video of Html_types.flow5_without_media
| `Video_interactive of Html_types.flow5_without_media
| `Wbr ]
Type 'b = [> `A of 'c ] is not compatible with type
Html_types.flow5_without_interactive
Types for tag `A are incompatible
tyxml-4.5.0/test/html_fail.ml 0000664 0000000 0000000 00000000046 14040247726 0016153 0 ustar 00root root 0000000 0000000 open Tyxml.Html ;;
div [a [a []]] ;;
tyxml-4.5.0/test/ppx.ml 0000664 0000000 0000000 00000000035 14040247726 0015021 0 ustar 00root root 0000000 0000000 Ppxlib.Driver.standalone ();
tyxml-4.5.0/test/test_html.ml 0000664 0000000 0000000 00000004423 14040247726 0016222 0 ustar 00root root 0000000 0000000 open Tyxml_test
let html_elements = "html elements", tyxml_tests Html.[
"div",
div [a []],
"