From e2a3c98b409a7dedcb375b42117bd290f168e3b1 Mon Sep 17 00:00:00 2001 From: Drup Date: Sat, 9 Aug 2014 17:10:50 +0200 Subject: [PATCH 1/2] Allow to output wrapped eliom elements. --- src/MarkdownHTML.ml | 53 +++++++++++++++++++++++++++++++------------- src/MarkdownHTML.mli | 53 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 90 insertions(+), 16 deletions(-) create mode 100644 src/MarkdownHTML.mli diff --git a/src/MarkdownHTML.ml b/src/MarkdownHTML.ml index 7169c85..81d1138 100644 --- a/src/MarkdownHTML.ml +++ b/src/MarkdownHTML.ml @@ -1,53 +1,74 @@ (* Copyright (C) 2009 Mauricio Fernandez *) -module Make_html5 (Html5 : Html5_sigs.T with type 'a Xml.wrap = 'a and type 'a wrap = 'a and type 'a list_wrap = 'a list) = struct +module Make_wrapped_html5 + (W : Xml_wrap.T) + (Html5 : Html5_sigs.T + with type +'a Xml.wrap = 'a W.t + and type +'a wrap = 'a W.t + and type +'a Xml.list_wrap = 'a W.tlist + and type +'a list_wrap = 'a W.tlist) += struct open Markdown open Html5 +let pcdata_w x = W.return @@ pcdata @@ W.return x +let wrap_list f l = + List.fold_right + (fun x l -> W.(cons (return @@ f x) l)) + l (W.nil ()) + let rec elm_to_html ~render_pre ~render_link ~render_img elm = let self = elm_to_html ~render_pre ~render_link ~render_img in - let item l = li (List.map self l) + let item l = li (wrap_list self l) in match elm with Normal text -> p (par_text_to_html ~render_link ~render_img text) | Pre (s, kind) -> begin match kind with Some k -> render_pre ~kind:k s - | None -> pre [pcdata s] + | None -> pre W.(singleton @@ pcdata_w s) end | Heading (l, text) -> let f = match l with 1 -> h1 | 2 -> h2 | 3 -> h3 | 4 -> h4 | 5 -> h5 | _ -> h6 in f (par_text_to_html render_link render_img text) - | Quote ps -> blockquote (List.map self ps) + | Quote ps -> blockquote @@ wrap_list self ps | Ulist (fst, others) -> - ul (List.map item (fst :: others)) + ul (wrap_list item (fst :: others)) | Olist (fst, others) -> - let item l = li (List.map self l) in - ol (List.map item (fst :: others)) + ol (wrap_list item (fst :: others)) and par_text_to_html ~render_link ~render_img = - List.map (text_to_html ~render_link ~render_img) + wrap_list (text_to_html ~render_link ~render_img) and text_to_html ~render_link ~render_img = function - Text s -> pcdata s - | Emph s -> em [pcdata s] - | Bold s -> b [pcdata s] - | Struck l -> del (List.map (text_to_html ~render_link ~render_img) l) - | Code s -> code [pcdata s] + Text s -> pcdata @@ W.return s + | Emph s -> em @@ W.singleton @@ pcdata_w s + | Bold s -> b @@ W.singleton @@ pcdata_w s + | Struck l -> del (wrap_list (text_to_html ~render_link ~render_img) l) + | Code s -> code @@ W.singleton @@ pcdata_w s | Anchor id -> (* would like to do a ~a:[XHTML.M_01_00.a_name_01_00 id] [] but that'd require switching to M_01_00 everywhere, so cheap hack *) - b ~a:[a_id id] [] + b ~a:[a_id @@ W.return id] (W.nil ()) | Link href -> begin match href.href_target with s when String.length s >= 1 && s.[0] = '#' -> - a ~a:[a_href (uri_of_string s)] [pcdata href.href_desc] + a ~a:[a_href (W.return @@ uri_of_string s)] + @@ W.singleton @@ pcdata_w href.href_desc | _ -> render_link href end | Image href -> render_img href let to_html ~render_pre ~render_link ~render_img l = - List.map (elm_to_html ~render_pre ~render_link ~render_img) l + W.map (elm_to_html ~render_pre ~render_link ~render_img) l end + +module Make_html5 + (Html5 : Html5_sigs.T + with type +'a Xml.wrap = 'a + and type +'a wrap = 'a + and type +'a Xml.list_wrap = 'a list + and type +'a list_wrap = 'a list) + = Make_wrapped_html5 (Xml_wrap.NoWrap) (Html5) diff --git a/src/MarkdownHTML.mli b/src/MarkdownHTML.mli new file mode 100644 index 0000000..e476cb7 --- /dev/null +++ b/src/MarkdownHTML.mli @@ -0,0 +1,53 @@ +open Markdown + +module Make_wrapped_html5 + (W : Xml_wrap.T) + (Html5 : Html5_sigs.T + with type +'a Xml.wrap = 'a W.t + and type +'a wrap = 'a W.t + and type +'a Xml.list_wrap = 'a W.tlist + and type +'a list_wrap = 'a W.tlist) + : sig + + val elm_to_html : + render_pre:(kind:string -> + string -> + ([< Html5_types.li_content_fun + > `Blockquote `H1 `H2 `H3 `H4 `H5 `H6 `Ol `P `Pre `Ul ] + as 'a) + Html5.elt) -> + render_link:(href -> Html5_types.phrasing Html5.elt) -> + render_img:(img_ref -> Html5_types.phrasing Html5.elt) -> + paragraph -> 'a Html5.elt + + val par_text_to_html : + render_link:(href -> Html5_types.phrasing Html5.elt) -> + render_img:(img_ref -> Html5_types.phrasing Html5.elt) -> + par_text -> Html5_types.phrasing Html5.elt Html5.list_wrap + + val text_to_html : + render_link:(href -> Html5_types.phrasing Html5.elt) -> + render_img:(img_ref -> Html5_types.phrasing Html5.elt) -> + text -> Html5_types.phrasing Html5.elt + + val to_html : + render_pre:(kind:string -> + string -> + ([< Html5_types.li_content_fun + > `Blockquote `H1 `H2 `H3 `H4 `H5 `H6 `Ol `P `Pre `Ul ] + as 'a) + Html5.elt) -> + render_link:(href -> Html5_types.phrasing Html5.elt) -> + render_img:(img_ref -> Html5_types.phrasing Html5.elt) -> + paragraph Html5.list_wrap -> 'a Html5.elt Html5.list_wrap + +end + + +module Make_html5 + (Html5 : Html5_sigs.T + with type +'a Xml.wrap = 'a + and type +'a wrap = 'a + and type +'a Xml.list_wrap = 'a list + and type +'a list_wrap = 'a list) + : module type of Make_wrapped_html5 (Xml_wrap.NoWrap) (Html5) From aab07fa115e2a72e78db09bfc7e50f8228ac678f Mon Sep 17 00:00:00 2001 From: Drup Date: Fri, 10 Oct 2014 20:00:52 +0200 Subject: [PATCH 2/2] Use simplifications in tyxml to clean up the additional functors. --- src/MarkdownHTML.ml | 18 ++---------------- src/MarkdownHTML.mli | 18 +----------------- 2 files changed, 3 insertions(+), 33 deletions(-) diff --git a/src/MarkdownHTML.ml b/src/MarkdownHTML.ml index 81d1138..5cc12da 100644 --- a/src/MarkdownHTML.ml +++ b/src/MarkdownHTML.ml @@ -1,16 +1,10 @@ (* Copyright (C) 2009 Mauricio Fernandez *) -module Make_wrapped_html5 - (W : Xml_wrap.T) - (Html5 : Html5_sigs.T - with type +'a Xml.wrap = 'a W.t - and type +'a wrap = 'a W.t - and type +'a Xml.list_wrap = 'a W.tlist - and type +'a list_wrap = 'a W.tlist) -= struct +module Make_html5 (Html5 : Html5_sigs.T) = struct open Markdown open Html5 +module W = Xml.W let pcdata_w x = W.return @@ pcdata @@ W.return x let wrap_list f l = @@ -64,11 +58,3 @@ let to_html ~render_pre ~render_link ~render_img l = W.map (elm_to_html ~render_pre ~render_link ~render_img) l end - -module Make_html5 - (Html5 : Html5_sigs.T - with type +'a Xml.wrap = 'a - and type +'a wrap = 'a - and type +'a Xml.list_wrap = 'a list - and type +'a list_wrap = 'a list) - = Make_wrapped_html5 (Xml_wrap.NoWrap) (Html5) diff --git a/src/MarkdownHTML.mli b/src/MarkdownHTML.mli index e476cb7..c71a646 100644 --- a/src/MarkdownHTML.mli +++ b/src/MarkdownHTML.mli @@ -1,13 +1,6 @@ open Markdown -module Make_wrapped_html5 - (W : Xml_wrap.T) - (Html5 : Html5_sigs.T - with type +'a Xml.wrap = 'a W.t - and type +'a wrap = 'a W.t - and type +'a Xml.list_wrap = 'a W.tlist - and type +'a list_wrap = 'a W.tlist) - : sig +module Make_html5 (Html5 : Html5_sigs.T) : sig val elm_to_html : render_pre:(kind:string -> @@ -42,12 +35,3 @@ module Make_wrapped_html5 paragraph Html5.list_wrap -> 'a Html5.elt Html5.list_wrap end - - -module Make_html5 - (Html5 : Html5_sigs.T - with type +'a Xml.wrap = 'a - and type +'a wrap = 'a - and type +'a Xml.list_wrap = 'a list - and type +'a list_wrap = 'a list) - : module type of Make_wrapped_html5 (Xml_wrap.NoWrap) (Html5)