diff --git a/omd_tyxml/dune b/omd_tyxml/dune new file mode 100644 index 00000000..e44b8630 --- /dev/null +++ b/omd_tyxml/dune @@ -0,0 +1,3 @@ +(library + (name omd_tyxml) + (libraries omd tyxml)) diff --git a/omd_tyxml/omd_tyxml.ml b/omd_tyxml/omd_tyxml.ml new file mode 100644 index 00000000..99f5b652 --- /dev/null +++ b/omd_tyxml/omd_tyxml.ml @@ -0,0 +1,59 @@ +(* module Html_importer = Xml_stream.signal *) +open Tyxml + + +(* let rec of_inline (inline : Omd.Inline.t) = + * match inline with + * | Concat ls -> List.concat_map of_inline ls + * | Text t -> [Html.txt t] + * | Emph e -> [of_emph e] + * | Code _ -> raise (Failure "TODO of_inline Code") + * | Hard_break -> raise (Failure "TODO of_inline Hard_break") + * | Soft_break -> raise (Failure "TODO of_inline Soft_break") + * | Link _ -> raise (Failure "TODO of_inline Link") + * | Ref _ -> raise (Failure "TODO of_inline Ref") + * | Html raw -> [Tyxml.Html.Unsafe.data raw] + * | Tag _ -> raise (Failure "TODO of_inline tag") + * + * and of_emph (emph : Omd.Inline.emph) = + * match emph.kind with + * | Omd.Normal -> Html.em (of_inline emph.content) + * | Omd.Strong -> Html.strong (of_inline emph.content) + * + * let of_block (block : Omd.Block.t) = + * match block with + * | Paragraph inline -> Html.p (of_inline inline) + * | List _ -> raise (Failure "TODO of_block") + * | Blockquote _ -> raise (Failure "TODO of_block") + * | Thematic_break -> raise (Failure "TODO of_block") + * | Heading _ -> raise (Failure "TODO of_block") + * | Code_block _ -> raise (Failure "TODO of_block") + * | Html_block _ -> raise (Failure "TODO of_block") + * | Link_def _ -> raise (Failure "TODO of_block") + * | Def_list _ -> raise (Failure "TODO of_block") + * | Tag_block _ -> raise (Failure "TODO of_block") *) + +let rec of_omd_html (h : Omd.Html.t) = + match h with + | Omd.Html.Element (eltype, tag, attrs, child) -> of_element eltype tag attrs child + | Omd.Html.Text _ -> (??) + | Omd.Html.Raw _ -> (??) + | Omd.Html.Null -> (??) + | Omd.Html.Concat (_, _) -> (??) + +and of_element = + fun element_type tag attrs child -> + match element_type with + | Inline -> of_inline tag attrs child + | Block -> of_block tag attrs child + + +let of_omd ?(title="") : Omd.t -> Tyxml.Html.doc = + fun omd -> + let omd_html = Omd.Html.of_doc omd in + let title' = title in + let body' = of_omd_html omd_html in + let open Html in + html + (head (title (txt title')) []) + (body body')