├── .gitignore ├── .ocamlformat ├── .travis.yml ├── CHANGES.md ├── LICENSE.md ├── Makefile ├── README.md ├── cow.opam ├── dune-project ├── src ├── atom.ml ├── atom.mli ├── cow.ml ├── cow.mli ├── dune ├── html.ml ├── html.mli ├── json.ml ├── json.mli ├── markdown.ml ├── markdown.mli ├── xhtml.ml ├── xhtml.mli ├── xml.ml └── xml.mli └── test ├── basic.ml ├── dune └── render.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | _opam 3 | *~ 4 | \.\#* 5 | \#*# 6 | *.install 7 | .merlin 8 | basic.html 9 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version = 0.26.1 2 | profile = conventional 3 | break-infix = fit-or-vertical 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-docker.sh 3 | script: bash -ex .travis-docker.sh 4 | services: 5 | - docker 6 | env: 7 | global: 8 | - PINS="cow:." 9 | - DISTRO="debian-stable" 10 | matrix: 11 | - PACKAGE="cow" OCAML_VERSION="4.05" 12 | - PACKAGE="cow" OCAML_VERSION="4.06" 13 | - PACKAGE="cow" OCAML_VERSION="4.07" 14 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ### v2.5.0 (10-03-2019) 2 | 3 | * Add integrity and crossorigin attributes (#108, @tbrk) 4 | * Dune packaging fixes and updates (#109, #112, @craife, @samoht) 5 | 6 | ### v2.4.0 (10-03-2019) 7 | 8 | * Port to dune fully (#105 @emillon) 9 | * Upgrade opam metadata to 2.0 (@avsm) 10 | 11 | ### 2.3.0 (29-04-2018) 12 | 13 | * Port to jbuilder/dune (@samoht, #102) 14 | * Fix atom feeds (@hannesm, #101) 15 | * Improve the functions generating HTML tags with no content (@Chris00, #100) 16 | * Improve documentation (@Chris00, #99) 17 | * Add a "ty" (type) argument to `Html.link` (@Chris00, #99) 18 | * Update `Html.script` to take a Uri.t for "src" (@Chris00, #99) 19 | * `Html.a`: make ~href optional (also used for anchors) (@Chris00, #99) 20 | * Add the optional argument ?attrs to `Html.a` (@Chris00, #99) 21 | * Use and for table construction (when appropriate) (@Chris00, #99) 22 | 23 | ### 2.2.0 (15-09-2017) 24 | 25 | * Port to use module aliases, so there are now `Cow_xml` `Cow_html` 26 | `Cow_xhtml` `Cow_markdown` `Cow_json` and `Cow_atom` modules, 27 | with aliases to the old scheme under the `Cow` module (e.g. `Cow.Xml`). 28 | Existing code should continue to work, but the whole compilation unit 29 | is no longer linked in if just a single method of output is used. 30 | This bumps the minimum OCaml version to 4.02.3 due to the use of 31 | module-level aliases. 32 | * Switch build system to use `topkg` instead of `oasis`, and adhere 33 | to the `opkg` layout format. 34 | 35 | ### 2.1.0 (21-05-2016) 36 | 37 | * Add description lists (dl/dt/dd) 38 | * Add ~licls/~dtcls/~ddcls to Html.ul/ol/dl. Setting classes of child 39 | elements in lists is sometimes useful. 40 | * Add some missing HTML5 combinators. 41 | 42 | ### 2.0.1 (03-05-2016) 43 | 44 | * Turn off warnings-as-errors, which fixes build under 4.03 45 | * Add OCaml test cases for OCaml 4.03. 46 | 47 | ### 2.0.0: (13-05-2016) 48 | 49 | * Remove camlp4 syntax extension support 50 | * Expose more and clean-up Html combinators 51 | 52 | ### 1.4.1 (unreleased) 53 | 54 | * Fix XML and HTML labeled argument assignment antiquotation syntax bug (#86) 55 | * Fix CSS space-less antiquotation syntax bug 56 | 57 | ### 1.4.0 (27-09-2015) 58 | 59 | * Improve compatability with Type_conv >= 113.00 by renaming some of the 60 | syntax parser modules to be less generically named. 61 | * Add ocamldoc generation and improve the `Html.Create` library 62 | (from @chrismamo1 in #82). 63 | 64 | ### 1.3.0 (02-08-2015) 65 | 66 | * Add `Css.of_string`, `Css.set_prop`, `Css.get_prop`, `Css.polygradient`. 67 | `Css.gradient` (#74, by @chrismamo1) 68 | * Add optional arguments to `Css.top_rounded`, `Css.rounded`, `Css.box_shadow` 69 | and `Css.text_shadow` (#74, by @chrismamo1) 70 | * Add `Html.concat`, `Html.append`, `Html.Create.ul` and `Html.Create.ol` 71 | (#74, by @chrismamo1) 72 | 73 | ### 1.2.2 (30-07-2015) 74 | 75 | * Fix int32 conversion to float in JSON syntax (#76, by Antoine Luciani) 76 | * Fix a regression introduced in 1.2.0 in `make test` (#72 by @dsheets) 77 | * Modernize `.travis.yml` to use `ocaml-travisci-skeleton` (by @dsheets) 78 | * Remove direct dependency on re (#71, by @rgrinberg) 79 | * Add a `.merlin` file (#70, by @rgrinberg) 80 | 81 | ### 1.2.1 (05-04-2015) 82 | 83 | * Fix compatibility of the `json` syntax extension with `ezjsonm` version 0.4 84 | (#68) 85 | 86 | ### 1.2.0 (06-02-2015) 87 | 88 | * When serializing HTML, only self-close void elements. 89 | * New `Html.doctype` value of the HTML5 DOCTYPE. 90 | * New `Html.output` and `Html.output_doc` functions for generic polyglot output. 91 | * Atom support is now deprecated in favor of Syndic 92 | * New `Html.img` constructor for easy creation of tags 93 | * New `Html.a` constructor for easy creation of tags 94 | * Deprecate function `Html.html_of_link` and type `Html.link` 95 | 96 | ### 1.1.0 (20-12-2014) 97 | 98 | * Add OPAM 1.2 compatible description file (#53). 99 | * Fix compatibility with `ezjsonm` version 0.4+ (#55). 100 | 101 | ### 1.0.0 (26-08-2014) 102 | 103 | * Fix OCaml 4.02 compatibility by not exposing a `Location` module 104 | in syntax extensions to avoid a namespace clash. We now rename them 105 | to `Xml_location` and `Css_location` and pack those instead. 106 | * Fix BSD compatibility using `$(MAKE)` instead of `make` (since the 107 | GNU make binary is actually `gmake` on Free/Net/OpenBSD). 108 | * Reduce the verbosity of the build by default. 109 | * Travis: Add OCaml 4.02 and OPAM 1.2.0 tests 110 | 111 | ### 0.10.1 (10-08-2014) 112 | 113 | * Fix Xml.of_string "" invalid argument bug 114 | 115 | ### 0.10.0 (26-03-2014) 116 | 117 | * Remove JSON parsing in favour of using `jsonm` instead. 118 | * Stop testing OCaml 3.12.1 (although it may continue to work). 119 | 120 | ### 0.9.1 (20-12-2013) 121 | 122 | * Fix parsing of empty attributes in XML/HTML/XHTML. 123 | 124 | ### 0.9.0 (20-12-2013) 125 | 126 | * Remove all the Markdown variants except `Omd`, which now claims the 127 | `Cow.Markdown` module name. 128 | * Clarify the repository license as ISC. 129 | * Run some modules through `ocp-indent`. 130 | 131 | ### 0.8.1 (15-12-2013) 132 | 133 | * Fix META file to include `omd`. 134 | * Improve ocamldoc in CSS module and document quotations in README. 135 | * Add `merlin` editor file. 136 | 137 | ### 0.8.0 (12-12-2013) 138 | 139 | * Add Travis continuous integration scripts. 140 | * Add `Omd_markdown` module based on the `omd` library. 141 | * Note: The `Markdown` and `Markdown_github` modules are now deprecated and will 142 | be removed before 1.0. 143 | 144 | ### 0.7.0 (25-09-2013) 145 | 146 | * Add an OPAM script that installs the right dependencies. 147 | * Make native dynlink optional if not supported by the toolchain. 148 | * Add support for `` in Atom feeds. 149 | 150 | ### 0.6.2 (30-08-2013) 151 | 152 | * Fix code highlighting of integer literals with underscores. 153 | * Fix XML parsing and printing for fragments and full documents. 154 | * Fix handling of whitespaces in antiquotation attributes. 155 | 156 | ### 0.6.1 (03-07-2013) 157 | 158 | * Tweak CSS syntax highlighting of OCaml code to fit Anil's superior colour 159 | taste. 160 | * Add a `Code.ocaml_fragment` to get just the syntax highlighted bits without 161 | the wrapper tags. 162 | * Expose a `decl` option to make the `Xml.to_string` declaration prefix optional. 163 | * Do not output a `" 3 | authors: [ 4 | "Anil Madhavapeddy" 5 | "Thomas Gazagnaire" 6 | "David Sheets" 7 | "Rudi Grinberg" 8 | "Timothy Bourke" 9 | ] 10 | license: "ISC" 11 | tags: [ 12 | "org:mirage" "org:xapi-project" "www" "html" "xml" "css" "json" "markdown" 13 | ] 14 | homepage: "https://github.com/mirage/ocaml-cow/" 15 | doc: "https://mirage.github.io/ocaml-cow/" 16 | bug-reports: "https://github.com/mirage/ocaml-cow/issues" 17 | depends: [ 18 | "ocaml" {>= "4.03.0"} 19 | "dune" {>= "3.1.0"} 20 | "uri" {>= "1.3.9"} 21 | "xmlm" {>= "1.1.1"} 22 | "omd" {>= "0.8.2"} 23 | "ezjsonm" {>= "0.4.0"} 24 | "alcotest" {with-test & >= "0.8.0"} 25 | ] 26 | build: [ 27 | ["dune" "subst"] {pinned} 28 | ["dune" "build" "-p" name "-j" jobs] 29 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 30 | ] 31 | dev-repo: "git+https://github.com/mirage/ocaml-cow.git" 32 | synopsis: "Caml on the Web" 33 | description: """ 34 | Writing web-applications requires a lot of skills: HTML, XML, JSON and 35 | Markdown, to name but a few! This library provides OCaml combinators 36 | for these web formats. 37 | """ 38 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.1) 2 | (name cow) 3 | -------------------------------------------------------------------------------- /src/atom.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2010 Anil Madhavapeddy 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | * 16 | *) 17 | 18 | (* Atom Syndication format output. Bare minimum for a reader to use, feel 19 | free to extend from the full spec at: 20 | http://www.atomenabled.org/developers/syndication/atom-format-spec.php 21 | *) 22 | type author = { name : string; uri : string option; email : string option } 23 | 24 | let stringo = function None -> None | Some s -> Some (Xml.string s) 25 | 26 | let xml_of_author a = 27 | Xml.( 28 | tag "name" (string a.name) 29 | ++ tago "uri" (stringo a.uri) 30 | ++ tago "email" (stringo a.email)) 31 | 32 | type date = int * int * int * int * int (* year, month, day, hour, minute *) 33 | 34 | let xml_of_date (year, month, day, hour, min) = 35 | let str = 36 | Printf.sprintf "%.4d-%.2d-%.2dT%.2d:%.2d:00Z" year month day hour min 37 | in 38 | Xml.string str 39 | 40 | type link = { rel : [ `self | `alternate ]; href : Uri.t; typ : string option } 41 | 42 | let mk_link ?(rel = `self) ?typ href = { rel; typ; href } 43 | let data body : Xml.t = [ `Data body ] 44 | let empty : Xml.t = [] 45 | 46 | let xml_of_link l = 47 | let attrs = 48 | [ 49 | ("rel", match l.rel with `self -> "self" | `alternate -> "alternate"); 50 | ("href", Uri.to_string l.href); 51 | ] 52 | @ match l.typ with None -> [] | Some t -> [ ("type", t) ] 53 | in 54 | Xml.tag "link" ~attrs empty 55 | 56 | type meta = { 57 | id : string; 58 | title : string; 59 | subtitle : string option; 60 | author : author option; 61 | rights : string option; 62 | updated : date; 63 | links : link list; 64 | } 65 | 66 | let xml_of_meta m = 67 | let open Xml in 68 | let body = 69 | [ 70 | tag "id" (data m.id); 71 | tag "title" (data m.title); 72 | (match m.subtitle with 73 | | None -> empty 74 | | Some s -> tag "subtitle" (data s)); 75 | (match m.author with 76 | | None -> empty 77 | | Some a -> tag "author" (xml_of_author a)); 78 | (match m.rights with None -> empty | Some r -> tag "rights" (data r)); 79 | tag "updated" (xml_of_date m.updated); 80 | ] 81 | in 82 | List.concat (body @ List.map xml_of_link m.links) 83 | 84 | type content = Xml.t 85 | 86 | let xml_of_content base c = 87 | let div = 88 | Xml.tag "content" 89 | ~attrs:[ ("type", "xhtml") ] 90 | (Xml.tag "div" ~attrs:[ ("xmlns", "http://www.w3.org/1999/xhtml") ] c) 91 | in 92 | match base with 93 | | None -> div 94 | | Some base -> ( 95 | match div with 96 | | [ `El ((("", "content"), [ (("", "type"), "xhtml") ]), childs) ] -> 97 | [ 98 | `El 99 | ( ( ("", "content"), 100 | [ (("", "type"), "xhtml"); (("", "xml:base"), base) ] ), 101 | childs ); 102 | ] 103 | | _ -> assert false) 104 | 105 | type summary = string option 106 | 107 | let xml_of_summary = function 108 | | None -> Xml.empty 109 | | Some str -> Xml.(tag "summary" (string str)) 110 | 111 | type entry = { 112 | entry : meta; 113 | summary : summary; 114 | content : content; 115 | base : string option; 116 | } 117 | 118 | let xml_of_entry e = 119 | Xml.( 120 | tag "entry" 121 | (xml_of_meta e.entry 122 | ++ xml_of_summary e.summary 123 | ++ xml_of_content e.base e.content)) 124 | 125 | let contributors entries = 126 | List.fold_left 127 | (fun accu e -> 128 | match e.entry.author with 129 | | None -> accu 130 | | Some a -> if List.mem a accu then accu else a :: accu) 131 | [] entries 132 | 133 | let xml_of_contributor c = Xml.tag "contributor" (xml_of_author c) 134 | 135 | type feed = { feed : meta; entries : entry list } 136 | 137 | let xml_of_feed ?self f = 138 | let self = 139 | match self with 140 | | None -> Xml.empty 141 | | Some s -> Xml.tag "link" ~attrs:[ ("rel", "self"); ("href", s) ] Xml.empty 142 | in 143 | Xml.( 144 | tag "feed" 145 | ~attrs:[ ("xmlns", "http://www.w3.org/2005/Atom") ] 146 | (self 147 | ++ xml_of_meta f.feed 148 | ++ list (List.map xml_of_contributor (contributors f.entries)) 149 | ++ list (List.map xml_of_entry f.entries))) 150 | 151 | let compare (yr1, mn1, da1, _, _) (yr2, mn2, da2, _, _) = 152 | match yr1 - yr2 with 153 | | 0 -> ( match mn1 - mn2 with 0 -> da1 - da2 | n -> n) 154 | | n -> n 155 | -------------------------------------------------------------------------------- /src/atom.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2010 Anil Madhavapeddy 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | * 16 | *) 17 | 18 | (** The Atom Syndication format. See RFC4287 for the full specification. 19 | @deprecated Please use the [Syndic] package instead. *) 20 | 21 | type author = { name : string; uri : string option; email : string option } 22 | 23 | type date = int * int * int * int * int 24 | (** year, month, date, hour, minute *) 25 | 26 | val compare : date -> date -> int 27 | 28 | type link = { rel : [ `self | `alternate ]; href : Uri.t; typ : string option } 29 | (** An Atom URI. There are lots of rules on which combinations of links 30 | are permitted in one feed. See RFC4287 Sec 4.1.1 for the gory details. 31 | *) 32 | 33 | val mk_link : ?rel:[ `self | `alternate ] -> ?typ:string -> Uri.t -> link 34 | (** [mk_link ~rel ~typ uri] builds a {!link}. [rel] defaults to [`self], 35 | and [typ] represents the optional MIME type (e.g. [text/html]). 36 | The [uri] should usually be a fully qualified URI. *) 37 | 38 | type meta = { 39 | id : string; 40 | title : string; 41 | subtitle : string option; 42 | author : author option; 43 | rights : string option; 44 | updated : date; 45 | links : link list; 46 | } 47 | 48 | type summary = string option 49 | 50 | (** A single entry in the Atom feed. The [base] represents the base 51 | href for the contents of the feed, in case it has relative links. *) 52 | 53 | type entry = { 54 | entry : meta; 55 | summary : summary; 56 | content : Xml.t; 57 | base : string option; 58 | } 59 | 60 | type feed = { feed : meta; entries : entry list } 61 | 62 | val xml_of_feed : ?self:string -> feed -> Xml.t 63 | -------------------------------------------------------------------------------- /src/cow.ml: -------------------------------------------------------------------------------- 1 | module Xml = Xml 2 | module Json = Json 3 | module Markdown = Markdown 4 | module Html = Html 5 | module Xhtml = Xhtml 6 | module Atom = Atom 7 | -------------------------------------------------------------------------------- /src/cow.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2016 Anil Madhavapeddy 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | (** Camel on the Web (CoW) library. 18 | 19 | This library includes module aliases for various useful Web formats 20 | such as XML, XHTML, JSON, Markdown and Atom. In many cases, you can 21 | also use the constitutent libraries directly. *) 22 | 23 | module Xml = Xml 24 | module Json = Json 25 | module Markdown = Markdown 26 | module Html = Html 27 | module Xhtml = Xhtml 28 | module Atom = Atom 29 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name cow) 3 | (libraries uri omd ezjsonm xmlm)) 4 | -------------------------------------------------------------------------------- /src/html.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2010 Thomas Gazagnaire 3 | * Copyright (c) 2013 Anil Madhavapeddy 4 | * Copyright (c) 2015 David Sheets 5 | * 6 | * Permission to use, copy, modify, and distribute this software for any 7 | * purpose with or without fee is hereby granted, provided that the above 8 | * copyright notice and this permission notice appear in all copies. 9 | * 10 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 11 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 12 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 13 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 14 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 15 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 16 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 17 | *) 18 | 19 | let ( @@ ) f x = f x 20 | let ( |> ) x f = f x 21 | 22 | type t = Xml.t 23 | 24 | let void_elements = 25 | [ 26 | "img"; 27 | "input"; 28 | "link"; 29 | "meta"; 30 | "br"; 31 | "hr"; 32 | "source"; 33 | "wbr"; 34 | "param"; 35 | "embed"; 36 | "base"; 37 | "area"; 38 | "col"; 39 | "track"; 40 | "keygen"; 41 | ] 42 | 43 | type node = ?cls:string -> ?id:string -> ?attrs:(string * string) list -> t -> t 44 | 45 | let tag name ?cls ?id ?(attrs = []) t = 46 | let attrs = match id with None -> attrs | Some i -> ("id", i) :: attrs in 47 | let attrs = 48 | match cls with None -> attrs | Some c -> ("class", c) :: attrs 49 | in 50 | Xml.tag name ~attrs t 51 | 52 | let empty : t = [] 53 | let div = tag "div" 54 | let span = tag "span" 55 | 56 | let add_oattr name attr attrs = 57 | match attr with None -> attrs | Some i -> (name, i) :: attrs 58 | 59 | let add_uattr name attr attrs = 60 | match attr with None -> attrs | Some i -> (name, Uri.to_string i) :: attrs 61 | 62 | let add_iattr name attr attrs = 63 | match attr with None -> attrs | Some i -> (name, string_of_int i) :: attrs 64 | 65 | let add_battr name attr attrs = if attr then (name, name) :: attrs else attrs 66 | 67 | let input ?cls ?id ?(attrs = []) ?ty v = 68 | let attrs = ("value", v) :: add_oattr "type" ty attrs in 69 | tag "input" ?cls ?id ~attrs empty 70 | 71 | let br = tag "br" empty 72 | let hr = tag "hr" empty 73 | 74 | let source ?media ?ty uri = 75 | let attrs = add_oattr "media" media [] |> add_oattr "type" ty in 76 | tag "source" empty ~attrs:(("src", Uri.to_string uri) :: attrs) 77 | 78 | let wbr = tag "wbr" empty 79 | let param ~name v = tag "param" empty ~attrs:[ ("name", name); ("value", v) ] 80 | 81 | let embed ?width ?height ?ty ?(attrs = []) uri = 82 | let attrs = 83 | attrs 84 | |> add_iattr "width" width 85 | |> add_iattr "height" height 86 | |> add_oattr "type" ty 87 | in 88 | tag "embed" empty ~attrs:(("src", Uri.to_string uri) :: attrs) 89 | 90 | let col ?cls ?style ?(attrs = []) n = 91 | let attrs = ("span", string_of_int n) :: attrs in 92 | tag "col" empty ?cls ~attrs:(add_oattr "style" style attrs) 93 | 94 | let track ?(default = false) ?label kind uri = 95 | let attrs = add_battr "default" default [] |> add_oattr "label" label in 96 | let attrs = 97 | match kind with 98 | | `Captions -> ("kind", "captions") :: attrs 99 | | `Chapters -> ("kind", "chapters") :: attrs 100 | | `Descriptions -> ("kind", "descriptions") :: attrs 101 | | `Metadata -> ("kind", "metadata") :: attrs 102 | | `Subtitles lang -> ("kind", "subtitles") :: ("srclang", lang) :: attrs 103 | in 104 | let attrs = ("src", Uri.to_string uri) :: attrs in 105 | tag "track" empty ~attrs 106 | 107 | let keygen ?(autofocus = false) ?(disabled = false) ?form ?(challenge = true) 108 | ?(keytype = `RSA) name = 109 | let attrs = 110 | add_battr "autofocus" autofocus [] 111 | |> add_battr "disabled" disabled 112 | |> add_oattr "form" form 113 | |> add_battr "challenge" challenge 114 | in 115 | let attrs = 116 | match keytype with 117 | | `RSA -> ("keytype", "rsa") :: attrs 118 | | `DSA -> ("keytype", "dsa") :: attrs 119 | | `EC -> ("keytype", "ec") :: attrs 120 | in 121 | tag "keygen" empty ~attrs:(("name", name) :: attrs) 122 | 123 | let html = tag "html" 124 | let footer = tag "footer" 125 | let header = tag "header" 126 | let head = tag "head" 127 | let title = tag "title" 128 | let body = tag "body" 129 | let nav = tag "nav" 130 | let tr = tag "tr" 131 | let th = tag "th" 132 | let td = tag "td" 133 | let article = tag "article" 134 | let section = tag "section" 135 | let address = tag "address" 136 | let list = List.concat 137 | let some = function None -> empty | Some x -> x 138 | let i = tag "i" 139 | let p = tag "p" 140 | let tt = tag "tt" 141 | let aside = tag "aside" 142 | let pre = tag "pre" 143 | let main = tag "main" 144 | 145 | type cors = [ `anonymous | `use_credentials ] 146 | 147 | let string_of_cors c = 148 | match c with 149 | | `anonymous -> "anonymous" 150 | | `use_credentials -> "use-credentials" 151 | 152 | let add_ocrossorigin co attrs = 153 | match co with 154 | | Some s -> ("crossorigin", string_of_cors s) :: attrs 155 | | None -> attrs 156 | 157 | let link ?cls ?id ?(attrs = []) ?title ?media ?ty ?rel ?integrity ?crossorigin 158 | href = 159 | let attrs = 160 | add_oattr "media" media attrs 161 | |> add_oattr "title" title 162 | |> add_oattr "rel" rel 163 | |> add_oattr "type" ty 164 | |> add_oattr "integrity" integrity 165 | |> add_ocrossorigin crossorigin 166 | in 167 | tag "link" empty ?cls ?id ~attrs:(("href", Uri.to_string href) :: attrs) 168 | 169 | let base ?cls ?id ?(attrs = []) ?target href = 170 | tag "base" empty ?cls ?id 171 | ~attrs:(("href", Uri.to_string href) :: add_oattr "target" target attrs) 172 | 173 | let meta ?cls ?id ?name ?content ?charset attrs = 174 | tag "meta" empty ?cls ?id 175 | ~attrs: 176 | (add_oattr "name" name 177 | (add_oattr "content" content (add_oattr "charset" charset attrs))) 178 | 179 | let blockquote ?cls ?id ?(attrs = []) ?cite x = 180 | tag "blockquote" ?cls ?id ~attrs:(add_uattr "cite" cite attrs) x 181 | 182 | let figure ?cls ?id ?(attrs = []) ?figcaption x = 183 | let x = 184 | match figcaption with None -> x | Some i -> tag "figcaption" Xml.(i ++ x) 185 | in 186 | tag "figure" ?cls ?id ~attrs x 187 | 188 | let em = tag "em" 189 | let strong = tag "strong" 190 | let s = tag "s" 191 | let cite = tag "cite" 192 | let code = tag "code" 193 | let var = tag "var" 194 | let samp = tag "samp" 195 | let kbd = tag "kbd" 196 | let sub = tag "sub" 197 | let sup = tag "sup" 198 | let b = tag "b" 199 | let u = tag "u" 200 | let mark = tag "mark" 201 | let bdi = tag "bdi" 202 | let bdo = tag "bdo" 203 | 204 | let q ?cls ?id ?(attrs = []) ?cite x = 205 | let attrs = 206 | match cite with 207 | | None -> attrs 208 | | Some i -> ("cite", Uri.to_string i) :: attrs 209 | in 210 | tag "q" ?cls ?id ~attrs x 211 | 212 | let dfn ?cls ?id ?(attrs = []) ?title x = 213 | tag "dfn" ?cls ?id ~attrs:(add_oattr "title" title attrs) x 214 | 215 | let abbr ?cls ?id ?(attrs = []) ?title x = 216 | tag "abbr" ?cls ?id ~attrs:(add_oattr "title" title attrs) x 217 | 218 | let data ?cls ?id ?(attrs = []) ~value x = 219 | tag "data" ?cls ?id ~attrs:(("value", value) :: attrs) x 220 | 221 | let time ?cls ?id ?(attrs = []) ?datetime x = 222 | tag "time" ?cls ?id ~attrs:(add_oattr "datetime" datetime attrs) x 223 | 224 | let ruby = tag "ruby" 225 | let rb = tag "rb" 226 | let rt = tag "rt" 227 | let rtc = tag "rtc" 228 | let rp = tag "rp" 229 | 230 | let ins ?cls ?id ?(attrs = []) ?cite ?datetime x = 231 | tag "ins" ?cls ?id 232 | ~attrs:(add_oattr "datetime" datetime (add_uattr "cite" cite attrs)) 233 | x 234 | 235 | let del ?cls ?id ?(attrs = []) ?cite ?datetime x = 236 | tag "del" ?cls ?id 237 | ~attrs:(add_oattr "datetime" datetime (add_uattr "cite" cite attrs)) 238 | x 239 | 240 | let nil = empty 241 | let concat = list 242 | let li ?cls ?id ?attrs x = tag ?cls ?id ?attrs "li" x 243 | let dt ?cls ?id ?attrs x = tag ?cls ?id ?attrs "dt" x 244 | let dd ?cls ?id ?attrs x = tag ?cls ?id ?attrs "dd" x 245 | 246 | let ul ?(add_li = true) ?cls ?id ?attrs ?licls ls = 247 | let ls = if add_li then List.map (fun x -> li ?cls:licls x) ls else ls in 248 | tag ?cls ?id ?attrs "ul" (list ls) 249 | 250 | let ol ?(add_li = false) ?cls ?id ?attrs ?licls ls = 251 | let ls = if add_li then List.map (fun x -> li ?cls:licls x) ls else ls in 252 | tag ?cls ?id ?attrs "ol" (list ls) 253 | 254 | let dl ?(add_dtdd = true) ?cls ?id ?attrs ?dtcls ?ddcls lss = 255 | let lss = 256 | if add_dtdd then 257 | List.map (fun (t, d) -> list [ dt ?cls:dtcls t; dd ?cls:ddcls d ]) lss 258 | else List.map (fun (t, d) -> list [ t; d ]) lss 259 | in 260 | tag ?cls ?id ?attrs "dl" (list lss) 261 | 262 | let h1 = tag "h1" 263 | let h2 = tag "h2" 264 | let h3 = tag "h3" 265 | let h4 = tag "h4" 266 | let h5 = tag "h5" 267 | let h6 = tag "h6" 268 | let small = tag "small" 269 | let doctype = "" 270 | 271 | let rec generate_signals signals = function 272 | | `Data s -> `Data s :: signals 273 | | `El (tag, children) -> ( 274 | let signals = `El_start tag :: signals in 275 | let signals = List.fold_left generate_signals signals children in 276 | match signals with 277 | | `El_start ((_, tag), _) :: _ when List.mem tag void_elements -> 278 | `El_end :: signals 279 | | [] | (`Data _ | `Dtd _ | `El_end) :: _ -> `El_end :: signals 280 | | `El_start _ :: _ -> `El_end :: `Data "" :: signals) 281 | 282 | let output ?(nl = false) ?(indent = None) ?(ns_prefix = fun _ -> None) dest t = 283 | let append tree = 284 | let signals = generate_signals [] tree in 285 | let out = Xml.make_output ~decl:false ~nl ~indent ~ns_prefix dest in 286 | Xml.output out (`Dtd None); 287 | List.(iter (Xml.output out) (rev signals)) 288 | in 289 | List.iter append t 290 | 291 | let output_doc ?(nl = false) ?(indent = None) ?(ns_prefix = fun _ -> None) dest 292 | t = 293 | (* This could build an Xmlm.output and use `Dtd to set the DOCTYPE. *) 294 | let doctype = doctype ^ "\n" in 295 | (match dest with 296 | | `Buffer buf -> Buffer.add_string buf doctype 297 | | `Channel oc -> output_string oc doctype 298 | | `Fun f -> 299 | let len = String.length doctype in 300 | for i = 0 to len - 1 do 301 | f (int_of_char doctype.[i]) 302 | done); 303 | output ~nl ~indent ~ns_prefix dest t 304 | 305 | let to_string t = 306 | let buf = Buffer.create 4096 in 307 | output_doc (`Buffer buf) t; 308 | Buffer.contents buf 309 | 310 | let of_string ?enc str = Xml.of_string ~entity:Xhtml.entity ?enc str 311 | 312 | type rel = 313 | [ `alternate 314 | | `author 315 | | `bookmark 316 | | `help 317 | | `license 318 | | `next 319 | | `nofollow 320 | | `noreferrer 321 | | `prefetch 322 | | `prev 323 | | `search 324 | | `tag ] 325 | 326 | let string_of_rel = function 327 | | `alternate -> "alternate" 328 | | `author -> "author" 329 | | `bookmark -> "bookmark" 330 | | `help -> "help" 331 | | `license -> "license" 332 | | `next -> "next" 333 | | `nofollow -> "nofollow" 334 | | `noreferrer -> "noreferrer" 335 | | `prefetch -> "prefetch" 336 | | `prev -> "prev" 337 | | `search -> "search" 338 | | `tag -> "tag" 339 | 340 | type target = [ `blank | `parent | `self | `top | `Frame of string ] 341 | 342 | let string_of_target = function 343 | | `blank -> "_blank" 344 | | `parent -> "_parent" 345 | | `self -> "_self" 346 | | `top -> "_top" 347 | | `Frame n -> n 348 | 349 | let a ?cls ?(attrs = []) ?hreflang ?rel ?target ?ty ?title ?href html = 350 | let attrs = add_uattr "href" href attrs in 351 | let attrs = List.map (fun (n, v) -> (("", n), v)) attrs in 352 | let attrs = 353 | match hreflang with 354 | | Some h -> (("", "hreflang"), h) :: attrs 355 | | None -> attrs 356 | in 357 | let attrs = 358 | match rel with 359 | | Some rel -> (("", "rel"), string_of_rel rel) :: attrs 360 | | None -> attrs 361 | in 362 | let attrs = 363 | match target with 364 | | Some t -> (("", "target"), string_of_target t) :: attrs 365 | | None -> attrs 366 | in 367 | let attrs = 368 | match ty with Some t -> (("", "type"), t) :: attrs | None -> attrs 369 | in 370 | let attrs = 371 | match title with Some t -> (("", "title"), t) :: attrs | None -> attrs 372 | in 373 | let attrs = 374 | match cls with Some c -> (("", "class"), c) :: attrs | None -> attrs 375 | in 376 | [ `El ((("", "a"), attrs), html) ] 377 | 378 | let img ?alt ?width ?height ?ismap ?title ?cls ?crossorigin ?(attrs = []) src = 379 | let attrs = List.map (fun (n, v) -> (("", n), v)) attrs in 380 | let attrs = (("", "src"), Uri.to_string src) :: attrs in 381 | let attrs = 382 | match alt with Some t -> (("", "alt"), t) :: attrs | None -> attrs 383 | in 384 | let attrs = 385 | match width with 386 | | Some w -> (("", "width"), string_of_int w) :: attrs 387 | | None -> attrs 388 | in 389 | let attrs = 390 | match height with 391 | | Some h -> (("", "height"), string_of_int h) :: attrs 392 | | None -> attrs 393 | in 394 | let attrs = 395 | match title with Some t -> (("", "title"), t) :: attrs | None -> attrs 396 | in 397 | let attrs = 398 | match cls with Some c -> (("", "class"), c) :: attrs | None -> attrs 399 | in 400 | let attrs = 401 | match crossorigin with 402 | | Some c -> (("", "crossorigin"), string_of_cors c) :: attrs 403 | | None -> attrs 404 | in 405 | match ismap with 406 | | Some u -> 407 | a ~href:u ~target:`self 408 | [ `El ((("", "img"), (("", "ismap"), "") :: attrs), []) ] 409 | | None -> [ `El ((("", "img"), attrs), []) ] 410 | 411 | let anchor name = tag "a" ~attrs:[ ("name", name) ] empty 412 | 413 | let style ?media ?(scoped = false) css = 414 | let attrs = add_oattr "media" media [] |> add_battr "scoped" scoped in 415 | tag "style" (Xml.string css) ~attrs 416 | 417 | (* color tweaks for lists *) 418 | let interleave classes l = 419 | let i = ref 0 in 420 | let n = Array.length classes in 421 | let get () = 422 | let res = classes.(!i mod n) in 423 | incr i; 424 | res 425 | in 426 | List.map (Xml.tag "div" ~attrs:[ ("class", get ()) ]) l 427 | 428 | let html_of_string s = Xml.string s 429 | let string = html_of_string 430 | let html_of_int i = Xml.int i 431 | let int = html_of_int 432 | let html_of_float f = Xml.float f 433 | let float = html_of_float 434 | 435 | type table = t array array 436 | 437 | let html_of_table ?(headings = false) t = 438 | let hd = 439 | if Array.length t > 0 && headings then 440 | let l = Array.to_list t.(0) in 441 | Some (tr (list @@ List.map (fun x -> th x) l)) 442 | else None 443 | in 444 | let tl = 445 | if Array.length t > 1 && headings then 446 | List.map Array.to_list (List.tl (Array.to_list t)) 447 | else List.map Array.to_list (Array.to_list t) 448 | in 449 | let tl = List.map (fun l -> tr (list @@ List.map (fun x -> td x) l)) tl in 450 | Xml.(tag "table" (some hd ++ list tl)) 451 | 452 | let append (_to : t) (el : t) = _to @ el 453 | let ( ++ ) = append 454 | 455 | module Create = struct 456 | module Tags = struct 457 | type html_list = [ `Ol of t list | `Ul of t list ] 458 | type color = Rgba of char * char * char * char | Rgb of char * char * char 459 | 460 | let color_of_string ?(fmt = `Hex) s = 461 | let s = String.lowercase_ascii s in 462 | let coi = char_of_int in 463 | let rval = 464 | match fmt with 465 | | `Hex -> 466 | let fmt' = format_of_string "#%x" in 467 | let x = Scanf.sscanf s fmt' (fun x -> x) in 468 | let r, g, b = 469 | ((x land 0xff0000) lsr 16, (x land 0xff00) lsr 8, x land 0xff) 470 | in 471 | Rgb (coi r, coi g, coi b) 472 | | `Rgb -> 473 | let fmt' = format_of_string "rgb(%d,%d,%d)" in 474 | let r, g, b = Scanf.sscanf s fmt' (fun a b c -> (a, b, c)) in 475 | Rgb (coi r, coi g, coi b) 476 | in 477 | rval 478 | 479 | type table_flags = 480 | | Headings_fst_col 481 | | Headings_fst_row 482 | | Sideways 483 | | Heading_color of color 484 | | Bg_color of color 485 | 486 | type 'a table = 487 | [ `Tr of 'a table list | `Td of 'a * int * int | `Th of 'a * int * int ] 488 | end 489 | 490 | open Tags 491 | 492 | type t = Xml.t 493 | 494 | let stylesheet css = 495 | Xml.tag "style" ~attrs:[ ("type", "text/css") ] (string css) 496 | 497 | let thead t = Xml.tag "thead" t 498 | let tbody t = Xml.tag "tbody" t 499 | 500 | let table ?(flags = [ Headings_fst_row ]) = 501 | let h_fst_col = ref false in 502 | let h_fst_row = ref false in 503 | let hdg_c = ref (color_of_string "#eDeDeD") in 504 | let bg_c = ref (color_of_string "#fFfFfF") in 505 | let side = ref false in 506 | let () = 507 | List.iter 508 | (fun tag -> 509 | match tag with 510 | | Headings_fst_col -> h_fst_col := true 511 | | Headings_fst_row -> h_fst_row := true 512 | | Heading_color c -> hdg_c := c 513 | | Bg_color c -> bg_c := c 514 | | Sideways -> 515 | side := true; 516 | ()) 517 | flags 518 | in 519 | let aux ~row tbl = 520 | let rows = List.map row tbl in 521 | let rows = 522 | if !side then 523 | List.mapi (fun i _ -> List.map (fun el -> List.nth el i) rows) 524 | @@ List.hd rows 525 | else rows 526 | in 527 | let cellify rows = List.map (fun r -> List.map (fun x -> td x) r) rows in 528 | let tr1 row = tr (List.flatten row) in 529 | let tr rows = List.concat (List.map tr1 rows) in 530 | let rows = 531 | match (!h_fst_row, !h_fst_col) with 532 | | false, false -> tbody (tr (cellify rows)) 533 | | true, false -> 534 | let hrow = List.hd rows |> List.map (fun x -> th x) in 535 | let rest = cellify (List.tl rows) in 536 | thead (tr1 hrow) @ tbody (tr rest) 537 | | false, true -> 538 | List.map 539 | (fun r -> 540 | let h = List.hd r in 541 | let rest = List.map (fun x -> td x) (List.tl r) in 542 | th h :: rest) 543 | rows 544 | |> tr 545 | | true, true -> 546 | let hrow = List.hd rows |> List.map (fun x -> th x) in 547 | let rest = 548 | List.tl rows 549 | |> List.map (fun r -> 550 | let hcell = List.hd r in 551 | let rest = List.flatten @@ cellify [ List.tl r ] in 552 | th hcell :: rest) 553 | in 554 | thead (tr1 hrow) @ tbody (tr rest) 555 | in 556 | Xml.tag "table" rows 557 | in 558 | aux 559 | end 560 | 561 | let script ?src ?ty ?charset ?integrity ?crossorigin body = 562 | let attrs = 563 | add_uattr "src" src [] 564 | |> add_oattr "type" ty 565 | |> add_oattr "charset" charset 566 | |> add_oattr "integrity" integrity 567 | |> add_ocrossorigin crossorigin 568 | in 569 | tag "script" ~attrs body 570 | -------------------------------------------------------------------------------- /src/html.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2010 Thomas Gazagnaire 3 | * Copyright (c) 2015 David Sheets 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** (X)HTML library *) 19 | 20 | type t = Xml.t 21 | (** A sequence of (X)HTML trees. *) 22 | 23 | val doctype : string 24 | (** @see The 25 | (X)HTML5 DOCTYPE. *) 26 | 27 | val to_string : t -> string 28 | (** [to_string html] is a valid (X)HTML5 polyglot string corresponding 29 | to the [html] structure. *) 30 | 31 | val of_string : ?enc:Xml.encoding -> string -> t 32 | (** [of_string ?enc html_str] is the tree representation of [html_str] 33 | as decoded by [enc]. For more information about the default 34 | encoding, see {!Xmlm.inenc}. 35 | 36 | Note that this function converts all 37 | {{:https://en.wikipedia.org/wiki/List_of_XML_and_HTML_character_entity_references} 38 | standard entities} into their corresponding UTF-8 symbol. *) 39 | 40 | val output : 41 | ?nl:bool -> 42 | ?indent:int option -> 43 | ?ns_prefix:(string -> string option) -> 44 | Xmlm.dest -> 45 | t -> 46 | unit 47 | (** Outputs valid (X)HTML5 polyglot text from a {!t}. Only non-void 48 | element handling is implemented so far. For more information 49 | about the parameters, see {!Xmlm.make_output}. 50 | 51 | @see Polyglot Markup *) 52 | 53 | val output_doc : 54 | ?nl:bool -> 55 | ?indent:int option -> 56 | ?ns_prefix:(string -> string option) -> 57 | Xmlm.dest -> 58 | t -> 59 | unit 60 | (** Outputs a valid (X)HTML5 polyglot document from a {!t}. Only 61 | non-void element handling and HTML5 DOCTYPE is implemented so far. 62 | For more information about the parameters, see 63 | {!Xmlm.make_output}. 64 | 65 | @see Polyglot Markup *) 66 | 67 | (** {2 HTML library} *) 68 | 69 | type rel = 70 | [ `alternate 71 | | `author 72 | | `bookmark 73 | | `help 74 | | `license 75 | | `next 76 | | `nofollow 77 | | `noreferrer 78 | | `prefetch 79 | | `prev 80 | | `search 81 | | `tag ] 82 | 83 | type target = [ `blank | `parent | `self | `top | `Frame of string ] 84 | 85 | val a : 86 | ?cls:string -> 87 | ?attrs:(string * string) list -> 88 | ?hreflang:string -> 89 | ?rel:rel -> 90 | ?target:target -> 91 | ?ty:string -> 92 | ?title:string -> 93 | ?href:Uri.t -> 94 | t -> 95 | t 96 | (** [a href html] generate a link from [html] to [href]. 97 | 98 | @param title specifies extra information about the element that is 99 | usually as a tooltip text when the mouse moves over the element. 100 | Default: [None]. 101 | 102 | @param target Specifies where to open the linked document. 103 | 104 | @param rel Specifies the relationship between the current document 105 | and the linked document. Default: [None]. 106 | 107 | @param hreflang the language of the linked document. Default: 108 | [None]. 109 | 110 | @param ty Specifies the media type of the linked document. *) 111 | 112 | type cors = [ `anonymous | `use_credentials ] 113 | (** Cross Origin Resource Sharing (CORS) 114 | 115 | @see The crossorigin attribute 116 | *) 117 | 118 | val img : 119 | ?alt:string -> 120 | ?width:int -> 121 | ?height:int -> 122 | ?ismap:Uri.t -> 123 | ?title:string -> 124 | ?cls:string -> 125 | ?crossorigin:cors -> 126 | ?attrs:(string * string) list -> 127 | Uri.t -> 128 | t 129 | 130 | val interleave : string array -> t list -> t list 131 | 132 | val html_of_string : string -> t 133 | (** @deprecated use {!string} *) 134 | 135 | val string : string -> t 136 | 137 | val html_of_int : int -> t 138 | (** @deprecated use {!int} *) 139 | 140 | val int : int -> t 141 | 142 | val html_of_float : float -> t 143 | (** @deprecated use {!float} *) 144 | 145 | val float : float -> t 146 | 147 | type table = t array array 148 | 149 | val html_of_table : ?headings:bool -> table -> t 150 | 151 | val nil : t 152 | (** @deprecated use {!empty} *) 153 | 154 | val empty : t 155 | 156 | val concat : t list -> t 157 | (** @deprecated use {!list} *) 158 | 159 | val list : t list -> t 160 | val some : t option -> t 161 | 162 | val append : t -> t -> t 163 | (** [append par ch] appends ch to par *) 164 | 165 | val ( ++ ) : t -> t -> t 166 | 167 | module Create : sig 168 | module Tags : sig 169 | type html_list = [ `Ol of t list | `Ul of t list ] 170 | type color = Rgba of char * char * char * char | Rgb of char * char * char 171 | 172 | type table_flags = 173 | | Headings_fst_col 174 | | Headings_fst_row 175 | | Sideways 176 | | Heading_color of color 177 | | Bg_color of color 178 | 179 | type 'a table = 180 | [ `Tr of 'a table list | `Td of 'a * int * int | `Th of 'a * int * int ] 181 | end 182 | 183 | type t = Xml.t 184 | 185 | val stylesheet : string -> t 186 | (** [stylesheet style] converts a COW CSS type to a valid HTML stylesheet *) 187 | 188 | val table : ?flags:Tags.table_flags list -> row:('a -> t list) -> 'a list -> t 189 | (** [table ~flags:f ~row:r tbl] produces an HTML table formatted according to 190 | [f] where each row is generated by passing a member of [tbl] to [r]. 191 | 192 | @param flags a list of type [Html.Flags.table_flags] specifying how 193 | the generated table is to be structured. 194 | 195 | @param row a function to transform a single row of the input table (a 196 | single element of the list, that is) into a list of elements, each of 197 | which will occupy a cell in a row of the table. 198 | 199 | [tbl:] a list of (probably) tuples representing a table. 200 | 201 | See the following example: 202 | {[ 203 | let row = (fun (name,email) -> [ <:html<$str:name$>>; <:html<$str:email$>>]) in 204 | let data = 205 | \[ "Name","Email Address"; 206 | "John Christopher McAlpine","christophermcalpine\@gmail.com"; 207 | "Somebody McElthein","johnqpublic\@something.something"; 208 | "John Doe","johndoe\@johndoe.com"; \] in 209 | let table = Html.Create ~flags:[Headings_fst_row] ~row data 210 | ]} 211 | which produces the HTML table 212 | {%html: 213 | 214 | 215 | 216 | 217 | 218 | 219 | 220 | 221 | 222 | 223 | 224 | 225 | 226 | 227 |

Name	Email Address
John Christopher McAlpine	christophermcalpine\@gmail.com
Somebody McElthein	johnqpublic\@something.something
John Doe	johndoe\@johndoe.com

228 | %} 229 | *) 230 | end 231 | 232 | (** {1 HTML nodes} *) 233 | 234 | type node = ?cls:string -> ?id:string -> ?attrs:(string * string) list -> t -> t 235 | (** The type for nodes. *) 236 | 237 | val tag : string -> node 238 | (** [tag name t] returns [t] where [] can have 239 | attributes "class" (if [cls] is given), "id" (if [id] is given) 240 | and other attributes specified by [attrs]. You are encouraged not 241 | to use [tag] but prefer the specialized versions below whenever 242 | possible. *) 243 | 244 | val div : node 245 | (** [div ~cls:"cl" t] is [

]. *) 246 | 247 | val span : node 248 | (** [div ~cls:"cl" t] is [

]. *) 249 | 250 | val input : 251 | ?cls:string -> 252 | ?id:string -> 253 | ?attrs:(string * string) list -> 254 | ?ty:string -> 255 | string -> 256 | t 257 | (** [input v] returns a button with value "v". 258 | @param ty the type of the input. Default: ["button"]. *) 259 | 260 | val br : t 261 | val hr : t 262 | 263 | val wbr : t 264 | (** A "Word Break Opportunity" node. *) 265 | 266 | val param : name:string -> string -> t 267 | (** [param name value] return a [] node to be used in [