struct
open Meta_result
let to_html ~configuration code =
let remove_comments s =
String.sub_exn s ~index:3 ~length:(String.length s - 6)
in
let open Higlo in
let parsed = parse ~lang:"ocaml" code in
let flush_tokens revtoklist =
if List.for_all revtoklist
~f:(function Text t when String.strip t = "" -> true | _ -> false)
then ""
else
let html =
Xtmpl_xml.to_string
(List.rev_map ~f:Higlo.token_to_xml revtoklist) in
"<pre>" ^ html ^ "</pre>"
in
let rec loop acc_tokens acc_html acc_toc tokens =
match tokens with
| [] ->
(List.rev acc_toc |> String.concat ~sep:"\n"
|> Markdown.to_toc ~configuration)
>>= fun toc ->
return (List.rev (flush_tokens acc_tokens :: acc_html)
|> String.concat ~sep:"\n", toc)
| one :: more ->
begin match one with
| Bcomment com
| Lcomment com when String.sub com ~index:0 ~length:3 = Some "(*M" ->
let html_code = flush_tokens acc_tokens in
let comment_content = remove_comments com in
Markdown.to_html ~configuration comment_content
>>= fun html_comment ->
loop [] (html_comment :: html_code :: acc_html)
(comment_content :: acc_toc) more
| tok ->
loop (tok :: acc_tokens) acc_html acc_toc more
end
in
loop [] [] [] parsed
end