Add Html.link

lib/html.ml

@@ -88,6 +88,46 @@ type link = {
 let html_of_link l : t =
   <:xml<<a href=$str:l.href$>$str:l.text$</a>&>>
 
+let link ?hreflang ?rel ?target ?ty ?title text l =
+  let attrs = [(("", "href"), Uri.to_string l)] in
+  let attrs = match hreflang with
+    | Some h -> (("", "hreflang"), h) :: attrs
+    | None -> attrs in
+  let attrs = match rel with
+    | Some rel ->
+       let rel = match rel with
+         | `alternate  -> "alternate"
+         | `author     -> "author"
+         | `bookmark   -> "bookmark"
+         | `help       -> "help"
+         | `license    -> "license"
+         | `next       -> "next"
+         | `nofollow   -> "nofollow"
+         | `noreferrer -> "noreferrer"
+         | `prefetch   -> "prefetch"
+         | `prev       -> "prev"
+         | `search     -> "search"
+         | `tag        -> "tag" in
+       (("", "rel"), rel) :: attrs
+    | None -> attrs in
+  let attrs = match target with
+    | Some t ->
+       let target = match t with
+         | `blank  -> "_blank"
+         | `parent -> "_parent"
+         | `self   -> "_self"
+         | `top    -> "_top"
+         | `Frame n -> n in
+       (("", "target"), target) :: attrs
+    | None -> attrs in
+  let attrs = match ty with
+    | Some t -> (("", "type"), t) :: attrs
+    | None -> attrs in
+  let attrs = match title with
+    | Some t -> (("", "title"), t) :: attrs
+    | None -> attrs in
+  [ `El((("", "a"), attrs), [`Data text]) ]
+
 (* color tweaks for lists *)
 let interleave classes l =
   let i = ref 0 in

lib/html.mli

@@ -64,10 +64,31 @@ val output_doc :
 type link = {
   text : string;
   href: string;
+  (** The URI of the link.  You must take care of properly
+      percent-encode the URI. *)
 }
 
 val html_of_link : link -> t
 
+val link : ?hreflang: string ->
+           ?rel: [ `alternate | `author | `bookmark | `help | `license
+                 | `next | `nofollow | `noreferrer | `prefetch
+                 | `prev | `search | `tag ] ->
+           ?target: [ `blank | `parent | `self | `top | `Frame of string ] ->
+           ?ty: string ->
+           ?title: string ->
+           string -> Uri.t -> t
+(** [link text href] generate a link from the data [text] to [href].
+
+    @param title specifies extra information about the element that is
+                 usually as a tooltip text when the mouse moves over
+                 the element.  Default: [None].
+    @pram target Specifies where to open the linked document.
+    @param rel Specifies the relationship between the current document
+               and the linked document.  Default: [None].
+    @param hreflang the language of the linked document.  Default: [None].
+    @param ty Specifies the media type of the linked document.  *)
+
 val interleave : string array -> t list -> t list
 
 val html_of_string : string -> t