Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file dream_html.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647(* Copyright 2023 Yawar Amin
This file is part of dream-html.
dream-html is free software: you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation, either version 3 of the License, or (at your option) any
later version.
dream-html 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 General Public License for more
details.
You should have received a copy of the GNU General Public License along with
dream-html. If not, see <https://www.gnu.org/licenses/>. *)typeattr=string*stringtypetag={name:string;attrs:attrlist;children:nodelistoption}andnode=|Tagoftag|Txtofstring|Commentofstringtype'ato_attr='a->attrtype'astring_attr=('a,unit,string,attr)format4->'atypestd_tag=attrlist->nodelist->nodetypevoid_tag=attrlist->nodetype'atext_tag=attrlist->('a,unit,string,node)format4->'aletwrite_attrp=function|"",_->()|name,""->p" ";pname|name,value->p" ";pname;p{|="|};pvalue;p{|"|}(* Loosely based on https://www.w3.org/TR/DOM-Parsing/ *)letrecwrite_tagp=function|Tag{name="";children=Somechildren;_}->List.iter(write_tagp)children|Tag{name;attrs;children=None}->p"<";pname;List.iter(write_attrp)attrs;p">"|Tag({name;children=Somechildren;_}asnon_void)->ifname="html"thenp"<!DOCTYPE html>\n";write_tagp(Tag{non_voidwithchildren=None});List.iter(write_tagp)children;p"</";pname;p">\n"|Txtstr->pstr|Commentstr->p"<!-- ";pstr;p" -->\n"letto_stringnode=letbuf=Buffer.create256inwrite_tag(Buffer.add_stringbuf)node;Buffer.contentsbufletppppfnode=node|>to_string|>Format.pp_print_stringppfletrespond?status?code?headersnode=Dream.html?status?code?headers@@to_stringnodeletset_bodyrespnode=Dream.set_bodyresp(to_stringnode);Dream.set_headerresp"Content-Type""text/html"letwritestreamnode=Dream.writestream(to_stringnode)lettxt_escapebuffer=function|'&'->Buffer.add_stringbuffer"&"|'<'->Buffer.add_stringbuffer"<"|'>'->Buffer.add_stringbuffer">"|c->Buffer.add_charbufferclettxt_escaperaws=ifrawthenselseletbuffer=Buffer.create(String.lengths*2)inString.iter(txt_escapebuffer)s;Buffer.contentsbufferletattr_escapebuffer=function|'"'->Buffer.add_stringbuffer"""|c->Buffer.add_charbuffercletattr_escaperaws=ifrawthenselseletbuffer=Buffer.create(String.lengths*2)inString.iter(attr_escapebuffer)s;Buffer.contentsbufferletattrname=name,""letstring_attrname?(raw=false)fmt=Printf.ksprintf(funs->name,attr_escaperaws)fmtleturi_attrnamefmt=Printf.ksprintf(funs->name,s|>Uri.of_string|>Uri.to_string)fmtletbool_attrnamevalue=name,string_of_boolvalueletfloat_attrnamevalue=name,Printf.sprintf"%f"valueletint_attrnamevalue=name,string_of_intvalueletstd_tagnameattrschildren=Tag{name;attrs;children=Somechildren}letvoid_tagnameattrs=Tag{name;attrs;children=None}lettext_tagname?(raw=false)attrsfmt=Printf.ksprintf(funs->Tag{name;attrs;children=Some[Txt(txt_escaperaws)]})fmtlettxt?(raw=false)fmt=Printf.ksprintf(funs->Txt(txt_escaperaws))fmtletcsrf_tagreq=req|>Dream.csrf_tag|>txt~raw:true"%s"letcommentstr=Comment(Dream.html_escapestr)let(+@)nodeattr=matchnodewith|Tagt->Tag{twithattrs=attr::t.attrs}|_->invalid_arg"cannot add attribute to non-tag node"let(-@)nodeattr=matchnodewith|Tagt->Tag{twithattrs=List.filter(fun(k,_)->k<>attr)t.attrs}|_->invalid_arg"cannot remove attribute from non-tag node"let(.@[])nodeattr=matchnodewith|Tag{attrs;_}->List.assocattrattrs|_->invalid_arg"cannot get value of attribute from non-tag node"letis_null=function|Tag{name="";_}->true|_->falseletis_null_(name,_)=name=""moduleHTML=struct(* Attributes *)typemethod_=[`GET|`POST]typeenctype=[`urlencoded|`formdata|`text_plain]letenctype_string=function|`urlencoded->"application/x-www-form-urlencoded"|`formdata->"multipart/form-data"|`text_plain->"text/plain"letnull_=string_attr""""letacceptfmt=string_attr"accept"fmtletaccept_charsetfmt=string_attr"accept-charset"fmtletaccesskeyfmt=string_attr"accesskey"fmtletactionfmt=uri_attr"action"fmtletalignfmt=string_attr"align"fmtletallowfmt=string_attr"allow"fmtletaltfmt=string_attr"alt"fmtletasync=attr"async"letautocapitalizevalue=("autocapitalize",matchvaluewith|`off->"off"|`none->"none"|`on->"on"|`sentences->"sentences"|`words->"words"|`characters->"characters")letautocompletevalue=("autocomplete",matchvaluewith|`off->"off"|`on->"on"|`name->"name"|`honorific_prefix->"honorific-prefix"|`given_name->"given-name"|`additional_name->"additional-name"|`honorific_suffix->"honorific-suffix"|`nickname->"nickname"|`email->"email"|`username->"username"|`new_password->"new-password"|`current_password->"current-password"|`one_time_code->"one-time-code"|`organization_title->"organization-title"|`organization->"organization"|`street_address->"street-address"|`address_line1->"address-line1"|`address_line2->"address-line2"|`address_line3->"address-line3"|`address_level4->"address-level4"|`address_level3->"address-level3"|`address_level2->"address-level2"|`address_level1->"address-level1"|`country->"country"|`country_name->"country-name"|`postal_code->"postal-code"|`cc_name->"cc-name"|`cc_given_name->"cc-given-name"|`cc_additional_name->"cc-additional-name"|`cc_family_name->"cc-family-name"|`cc_number->"cc-number"|`cc_exp->"cc-exp"|`cc_exp_month->"cc-exp-month"|`cc_exp_year->"cc-exp-year"|`cc_csc->"cc-csc"|`cc_type->"cc-type"|`transaction_currency->"transaction-currency"|`transaction_amount->"transaction-amount"|`language->"language"|`bday->"bday"|`bday_day->"bday-day"|`bday_month->"bday-month"|`bday_year->"bday-year"|`sex->"sex"|`tel->"tel"|`tel_country_code->"tel-country-code"|`tel_national->"tel-national"|`tel_area_code->"tel-area-code"|`tel_local->"tel-local"|`tel_extension->"tel-extension"|`impp->"impp"|`url->"url"|`photo->"photo")letautofocus=attr"autofocus"letautoplay=attr"autoplay"letbufferedfmt=string_attr"buffered"fmtletcapturefmt=string_attr"capture"fmtletcharsetfmt=string_attr"charset"fmtletchecked=attr"checked"letcite_fmt=uri_attr"cite"fmtletclass_fmt=string_attr"class"fmtletcolorfmt=string_attr"color"fmtletcols=int_attr"cols"letcolspan=int_attr"colspan"letcontentfmt=string_attr"content"fmtletcontenteditable=bool_attr"contenteditable"letcontextmenufmt=string_attr"contextmenu"fmtletcontrols=attr"controls"letcoordsfmt=string_attr"coords"fmtletcrossoriginvalue=("crossorigin",matchvaluewith|`anonymous->"anonymous"|`use_credentials->"use-credentials")letdata_fmt=uri_attr"data"fmtletdatetimefmt=string_attr"datetime"fmtletdecodingvalue=("decoding",matchvaluewith|`sync->"sync"|`async->"async"|`auto->"auto")letdefault=attr"default"letdefer=attr"defer"letdirvalue=("dir",matchvaluewith|`ltr->"ltr"|`rtl->"rtl"|`auto->"auto")letdirnamefmt=string_attr"dirname"fmtletdisabled=attr"disabled"letdownloadfmt=string_attr"download"fmtletdraggable=attr"draggable"letenctypevalue="enctype",enctype_stringvalueletfetchpriorityvalue=("fetchpriority",matchvaluewith|`high->"high"|`low->"low"|`auto->"auto")letfor_fmt=string_attr"for"fmtletform_fmt=string_attr"form"fmtletformactionfmt=string_attr"formaction"fmtletformenctypevalue="formenctype",enctype_stringvalueletformmethodvalue="formmethod",Dream.method_to_stringvalueletformnovalidate=attr"formnovalidate"letformtargetfmt=string_attr"formtarget"fmtletheadersfmt=string_attr"headers"fmtletheightfmt=string_attr"height"fmtlethiddenvalue=("hidden",matchvaluewith|`hidden->"hidden"|`until_found->"until-found")lethigh=float_attr"high"lethreffmt=uri_attr"href"fmtlethreflangfmt=string_attr"hreflang"fmtlethttp_equivvalue=("http-equiv",matchvaluewith|`content_security_policy->"content-security-policy"|`content_type->"content-type"|`default_style->"default-style"|`x_ua_compatible->"x-ua-compatible"|`refresh->"refresh")letidfmt=string_attr"id"fmtletintegrityfmt=string_attr"integrity"fmtletinputmodevalue=("inputmode",matchvaluewith|`none->"none"|`text->"text"|`decimal->"decimal"|`numeric->"numeric"|`tel->"tel"|`search->"search"|`email->"email"|`url->"url")letismap=attr"ismap"letitempropfmt=string_attr"itemprop"fmtletkindvalue=("kind",matchvaluewith|`subtitles->"subtitles"|`captions->"captions"|`descriptions->"descriptions"|`chapters->"chapters"|`metadata->"metadata")letlabel_fmt=string_attr"label"fmtletlangfmt=string_attr"lang"fmtletlistfmt=string_attr"list"fmtletloop=attr"loop"letlow=float_attr"low"letmaxfmt=string_attr"max"fmtletmaxlength=int_attr"maxlength"letmediafmt=string_attr"media"fmtletmethod_value="method",Dream.method_to_stringvalueletminfmt=string_attr"min"fmtletminlength=int_attr"minlength"letmultiple=attr"multiple"letmuted=attr"muted"letnamefmt=string_attr"name"fmtletnovalidate=attr"novalidate"letonblurfmt=string_attr"onblur"~raw:truefmtletonclickfmt=string_attr"onclick"~raw:truefmtletopen_=attr"open"letoptimum=float_attr"optimum"letpatternfmt=string_attr"pattern"fmtletpingfmt=string_attr"ping"fmtletplaceholderfmt=string_attr"placeholder"fmtletplaysinline=attr"playsinline"letposterfmt=uri_attr"poster"fmtletpreloadvalue=("preload",matchvaluewith|`none->"none"|`metadata->"metadata"|`auto->"auto")letreadonly=attr"readonly"letreferrerpolicyvalue=("referrerpolicy",matchvaluewith|`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")letrelfmt=string_attr"rel"fmtletrequired=attr"required"letreversed=attr"reversed"letrolefmt=string_attr"role"fmtletrows=int_attr"rows"letrowspan=int_attr"rowspan"letsandboxfmt=string_attr"sandbox"fmtletscopefmt=string_attr"scope"fmtletselected=attr"selected"letshapefmt=string_attr"shape"fmtletsizefmt=string_attr"size"fmtletsizesfmt=string_attr"sizes"fmtletslot_fmt=string_attr"slot"fmtletspan_=int_attr"span"letspellcheck=bool_attr"spellcheck"letsrcfmt=uri_attr"src"fmtletsrcdocfmt=string_attr"srcdoc"fmtletsrclangfmt=string_attr"srclang"fmtletsrcsetfmt=string_attr"srcset"fmtletstart=int_attr"start"letstepfmt=string_attr"step"fmtletstyle_fmt=string_attr~raw:true"style"fmtlettabindex=int_attr"tabindex"lettargetfmt=string_attr"target"fmtlettitle_fmt=string_attr"title"fmtlettranslatevalue=("translate",matchvaluewith|`yes->"yes"|`no->"no")lettype_fmt=string_attr"type"fmtletusemapfmt=string_attr"usemap"fmtletvaluefmt=string_attr"value"fmtletwidthfmt=string_attr"width"fmtletwrapvalue=("wrap",matchvaluewith|`hard->"hard"|`soft->"soft")(* Tags *)letnull=std_tag""[]leta=std_tag"a"letaddress=std_tag"address"letabbr=std_tag"abbr"letarea=void_tag"area"letarticle=std_tag"article"letaside=std_tag"aside"letaudio=std_tag"audio"letb=std_tag"b"letbase=void_tag"base"letbdi=std_tag"bdi"letbdo=std_tag"bdo"letblockquote=std_tag"blockquote"letbr=void_tag"br"letbody=std_tag"body"letbutton=std_tag"button"letcanvas=std_tag"canvas"letcaption=std_tag"caption"letcite=std_tag"cite"letcode=std_tag"code"letcol=void_tag"col"letcolgroup=std_tag"colgroup"letdata=std_tag"data"letdatalist=std_tag"datalist"letdd=std_tag"dd"letdel=std_tag"del"letdetails=std_tag"details"letdfn=std_tag"dfn"letdialog=std_tag"dialog"letdiv=std_tag"div"letdl=std_tag"dl"letdt=std_tag"dt"letem=std_tag"em"letembed=void_tag"embed"letfieldset=std_tag"fieldset"letfigcaption=std_tag"figcaption"letfigure=std_tag"figure"letfooter=std_tag"footer"letform=std_tag"form"leth1=std_tag"h1"leth2=std_tag"h2"leth3=std_tag"h3"leth4=std_tag"h4"leth5=std_tag"h5"leth6=std_tag"h6"lethead=std_tag"head"letheader=std_tag"header"lethgroup=std_tag"hgroup"lethr=void_tag"hr"lethtml=std_tag"html"leti=std_tag"i"letiframe=std_tag"iframe"letimg=void_tag"img"letinput=void_tag"input"letins=std_tag"ins"letkbd=std_tag"kbd"letlabel=std_tag"label"letlegend=std_tag"legend"letli=std_tag"li"letlink=void_tag"link"letmain=std_tag"main"letmap=std_tag"map"letmark=std_tag"mark"letmenu=std_tag"menu"letmeta=void_tag"meta"letmeter=std_tag"meter"letnav=std_tag"nav"letnoscript=std_tag"noscript"letobject_=std_tag"object"letol=std_tag"ol"letoptgroup=std_tag"optgroup"letoptionattrsfmt=text_tag"option"attrsfmtletoutput=std_tag"output"letp=std_tag"p"letpicture=std_tag"picture"letpre=std_tag"pre"letprogress=std_tag"progress"letq=std_tag"q"letrp=std_tag"rp"letrt=std_tag"rt"letruby=std_tag"ruby"lets=std_tag"s"letsamp=std_tag"samp"letscriptattrsfmt=text_tag"script"~raw:trueattrsfmtletsection=std_tag"section"letselect=std_tag"select"letslot=std_tag"slot"letsmall=std_tag"small"letsource=void_tag"source"letspan=std_tag"span"letstrong=std_tag"strong"letstyleattrsfmt=text_tag"style"~raw:trueattrsfmtletsub=std_tag"sub"letsup=std_tag"sup"letsummary=std_tag"summary"lettable=std_tag"table"lettbody=std_tag"tbody"lettd=std_tag"td"lettemplate=std_tag"template"lettextareaattrsfmt=text_tag"textarea"attrsfmtlettfoot=std_tag"tfoot"letth=std_tag"th"letthead=std_tag"thead"lettime=std_tag"time"lettitleattrsfmt=text_tag"title"attrsfmtlettr=std_tag"tr"lettrack=void_tag"track"letu=std_tag"u"letul=std_tag"ul"letvar=std_tag"var"letvideo=std_tag"video"letwbr=void_tag"wbr"endmoduleSVG=struct(* Attributes *)letdfmt=string_attr"d"fmtletfillfmt=string_attr"fill"fmtletstrokefmt=string_attr"stroke"fmtletstroke_linecapvalue=("stroke-linecap",matchvaluewith|`butt->"butt"|`round->"round"|`square->"square")letstroke_linejoinvalue=("stroke-linejoin",matchvaluewith|`arcs->"arcs"|`bevel->"bevel"|`miter->"miter"|`miter_clip->"miter-clip"|`round->"round")letstroke_widthfmt=string_attr"stroke-width"fmtletviewbox~min_x~min_y~width~height="viewbox",Printf.sprintf"%d %d %d %d"min_xmin_ywidthheightletxmlns=string_attr"xmlns""http://www.w3.org/2000/svg"(* Tags *)letpath=std_tag"path"letsvg=std_tag"svg"endmoduleHx=structlet__fmt=string_attr~raw:true"_"fmt(* This is a boolean because it can be selectively switched off in some parts
of the page. *)letboost=bool_attr"data-hx-boost"letconfirmfmt=string_attr"data-hx-confirm"fmtletdeletefmt=uri_attr"data-hx-delete"fmtletdisable=attr"data-hx-disable"letdisinheritfmt=string_attr"data-hx-disinherit"fmtletencoding_formdata="data-hx-encoding","multipart/form-data"letextfmt=string_attr"data-hx-ext"fmtletgetfmt=uri_attr"data-hx-get"fmtletheadersfmt=string_attr"data-hx-headers"fmtlethistory_false=bool_attr"data-hx-history"falselethistory_elt=attr"data-hx-history-elt"letinclude_fmt=string_attr"data-hx-include"fmtletindicatorfmt=string_attr~raw:true"data-hx-indicator"fmtletonfmt=string_attr"data-hx-on"~raw:truefmtletparamsfmt=string_attr"data-hx-params"fmtletpatchfmt=uri_attr"data-hx-patch"fmtletpostfmt=uri_attr"data-hx-post"fmtletpreload=attr"preload"letpreserve=attr"data-hx-preserve"letpromptfmt=string_attr"data-hx-prompt"fmtletpush_urlfmt=uri_attr"data-hx-push-url"fmtletputfmt=uri_attr"data-hx-put"fmtletreplace_urlfmt=string_attr"data-hx-replace-url"fmtletrequestfmt=string_attr"data-hx-request"fmtletselectfmt=string_attr~raw:true"data-hx-select"fmtletselect_oobfmt=string_attr~raw:true"data-hx-select-oob"fmtletsse_connectfmt=string_attr"data-sse-connect"fmtletsse_swapfmt=string_attr"data-sse-swap"fmtletswapfmt=string_attr~raw:true"data-hx-swap"fmtletswap_oobfmt=string_attr~raw:true"data-hx-swap-oob"fmtletsyncfmt=string_attr"data-hx-sync"fmtlettargetfmt=string_attr~raw:true"data-hx-target"fmtlettriggerfmt=string_attr"data-hx-trigger"~raw:truefmtletvalidate=attr"data-hx-validate"letvalsfmt=string_attr"data-hx-vals"fmtletws_connectfmt=string_attr"data-ws-connect"fmtletws_send=attr"data-ws-send"end