From 05bfe465a5cf36fd29e681b19768d6d5004a20d9 Mon Sep 17 00:00:00 2001 From: Thibaut Mattio Date: Sun, 7 May 2023 11:19:48 +0200 Subject: [PATCH] [WIP] Upgrade Omd to 2.0.0~alpha3 --- dune-project | 2 +- ocaml-lsp-server.opam | 2 +- ocaml-lsp-server/src/doc_to_md.ml | 178 +++++++++++++++++------------- 3 files changed, 103 insertions(+), 79 deletions(-) diff --git a/dune-project b/dune-project index 8420d9c41..bf9d28607 100644 --- a/dune-project +++ b/dune-project @@ -59,7 +59,7 @@ possible and does not make any assumptions about IO. (ppx_expect (and (>= v0.15.0) :with-test)) (ocamlformat (and :with-test (= 0.24.1))) (ocamlc-loc (and (>= 3.5.0) (< 3.7.0))) - (omd (and (>= 1.3.2) (< 2.0.0~alpha1))) + (omd (>= 2.0.0~alpha3)) (octavius (>= 1.2.2)) (uutf (>= 1.0.2)) (pp (>= 1.1.2)) diff --git a/ocaml-lsp-server.opam b/ocaml-lsp-server.opam index 8ef8542f2..e803509e8 100644 --- a/ocaml-lsp-server.opam +++ b/ocaml-lsp-server.opam @@ -35,7 +35,7 @@ depends: [ "ppx_expect" {>= "v0.15.0" & with-test} "ocamlformat" {with-test & = "0.24.1"} "ocamlc-loc" {>= "3.5.0" & < "3.7.0"} - "omd" {>= "1.3.2" & < "2.0.0~alpha1"} + "omd" {>= "2.0.0~alpha3"} "octavius" {>= "1.2.2"} "uutf" {>= "1.0.2"} "pp" {>= "1.1.2"} diff --git a/ocaml-lsp-server/src/doc_to_md.ml b/ocaml-lsp-server/src/doc_to_md.ml index 421636a34..1d8b12aaa 100644 --- a/ocaml-lsp-server/src/doc_to_md.ml +++ b/ocaml-lsp-server/src/doc_to_md.ml @@ -1,15 +1,9 @@ open Import module Oct = Octavius +open Omd +open Omd.Ctor -let ocaml = "ocaml" - -let to_inline_code code = Omd.Code (ocaml, code) - -let to_code_block code = Omd.Code_block (ocaml, code) - -let space = Omd.Text " " - -let new_line = Omd.NL +let space = Omd.Ctor.txt " " (* [put_in_between elem lst] inserts [elem] between all elements of [lst] *) let put_in_between elem lst = @@ -20,86 +14,117 @@ let put_in_between elem lst = in List.rev (loop [] lst) -let heading_level level heading : Omd.element = +let heading_level level heading = match level with - | 0 -> H1 heading - | 1 -> H2 heading - | 2 -> H3 heading - | 3 -> H4 heading - | 4 -> H5 heading - | _ -> H6 heading - -let style_markdown (kind : Oct.Types.style_kind) md : Omd.element list = - match kind with - | SK_bold -> [ Bold md ] - | SK_italic | SK_emphasize -> [ Emph md ] - | SK_center | SK_left | SK_right | SK_superscript | SK_subscript | SK_custom _ - -> - (* TODO: implement SK_{center, left, right, superscript, subscript, custom} - using html blocks *) - md - -let rec text_to_markdown doc = List.concat_map ~f:text_element_to_markdown doc - -and text_element_to_markdown (doc_elem : Oct.Types.text_element) = - match doc_elem with - | Raw text -> [ Omd.Text text ] - | Code code -> [ to_inline_code code ] - | PreCode code -> [ to_code_block code ] - | Verbatim text -> [ Raw text ] - | Style (kind, text) -> style_markdown kind @@ text_to_markdown text - | List l -> [ Ul (text_elements_to_markdown l) ] - | Enum l -> [ Ol (text_elements_to_markdown l) ] - | Newline -> [ new_line; new_line ] - | Title (i, _, content) -> - (* TODO: along with cross-references support, add support for labels *) - let heading = text_to_markdown content in - [ heading_level i heading ] - | Ref (RK_link, url, descr) -> + | 0 -> h 1 heading + | 1 -> h 2 heading + | 2 -> h 3 heading + | 3 -> h 4 heading + | 4 -> h 5 heading + | _ -> h 6 heading + +let inline_with_style ?style ?(attrs = []) s = + match style with + | None -> s + | Some Oct.Types.SK_bold -> Strong (attrs, s) + | Some Oct.Types.(SK_italic | SK_emphasize) -> Emph (attrs, s) + | Some + Oct.Types.( + ( SK_center + | SK_left + | SK_right + | SK_superscript + | SK_subscript + | SK_custom _ )) -> s + +let rec fold_text_inline ?style elements acc = + match elements with + | Oct.Types.Raw text :: rest -> + fold_text_inline rest (inline_with_style ?style (txt text) :: acc) + | Oct.Types.Code cd :: rest -> + fold_text_inline rest (inline_with_style ?style (code cd) :: acc) + | Oct.Types.Verbatim text :: rest -> + fold_text_inline rest (inline_with_style ?style (txt text) :: acc) + | Oct.Types.Style (style, text) :: rest -> + let inner, _blocks = fold_text_inline ~style text [] in + fold_text_inline rest (inner @ acc) + | Oct.Types.Newline :: rest -> fold_text_inline rest [ nl; nl ] + | Oct.Types.Ref (RK_link, url, descr) :: rest -> let descr = - Option.map descr ~f:text_to_markdown |> Option.value ~default:[] + (* ISSUE: links should accept a list of inline elements *) + match + Option.map descr ~f:(fun x -> + let inner, _blocks = fold_text_inline ?style x [] in + inner) + with + | Some (el :: _rest) -> el + | Some [] | None -> txt "" + in + let link = + Link ([], { label = descr; destination = url; title = Some "" }) in - let empty_title = "" in - [ Url (url, descr, empty_title) ] - | Ref (_ref_kind, reference, descr) -> + fold_text_inline rest (inline_with_style ?style link :: acc) + | Oct.Types.Ref (_ref_kind, reference, descr) :: rest -> (* TODO: add support for cross-references *) - Option.map ~f:text_to_markdown descr - |> Option.value ~default:[ to_inline_code reference ] - | Special_ref _ - | Target (_, _) (* TODO: add support for markdown-specific blocks *) -> [] + let x = + Option.map + ~f:(fun x -> + let inner, _blocks = fold_text_inline ?style x [] in + inner) + descr + |> Option.value ~default:[ inline_with_style ?style (code reference) ] + in + fold_text_inline rest (x @ acc) + | _rest -> (List.rev acc, elements) + +let rec fold_text elements acc = + match elements with + | Oct.Types.(Raw _ | Code _ | Verbatim _ | Style _ | Newline | Ref _) :: _rest + -> + let inlines, rest = fold_text_inline elements [] in + fold_text rest (p inlines :: acc) + | Oct.Types.Title (i, _, content) :: rest -> + (* TODO: along with cross-references support, add support for labels *) + let heading, _blocks = fold_text_inline content [] in + fold_text rest (h (i + 1) heading :: acc) + | Oct.Types.PreCode code :: rest -> fold_text rest (code_bl code :: acc) + | Oct.Types.List l :: rest -> + fold_text rest (ul (text_elements_to_markdown l) :: acc) + | Oct.Types.Enum l :: rest -> + fold_text rest (ol (text_elements_to_markdown l) :: acc) + | Oct.Types.Special_ref _ :: rest | Oct.Types.Target (_, _) :: rest -> + (* TODO: add support for markdown-specific blocks *) fold_text rest acc + | [] -> acc + +and text_to_markdown doc = fold_text doc [] and text_elements_to_markdown lst = List.map ~f:text_to_markdown lst let rec tags_to_markdown (tags : Oct.Types.tag list) = - List.map ~f:tag_to_markdown tags - |> put_in_between [ new_line; new_line ] - |> List.concat + List.map ~f:tag_to_markdown tags |> put_in_between [ nl; nl ] |> List.concat -and tag_to_markdown tag : Omd.element list = - let format_tag tag = Omd.Bold [ Emph [ Text tag ] ] in - let plain_tag_to_md tag descr = [ format_tag tag; space; Text descr ] in +and tag_to_markdown tag = + let format_tag tag = Strong ([], Emph ([], txt tag)) in + let plain_tag_to_md tag descr = [ format_tag tag; space; txt descr ] in let tag_with_text_to_md tag text = - format_tag tag :: space :: text_to_markdown text - in - let marked_tag_to_md tag mark = - [ format_tag tag; space; to_inline_code mark ] + let inlines, _blocks = fold_text_inline text [] in + format_tag tag :: space :: inlines in + let marked_tag_to_md tag mark = [ format_tag tag; space; code mark ] in let marked_tag_with_text_to_md tag mark text = - format_tag tag :: space :: to_inline_code mark :: space - :: text_to_markdown text + let inlines, _blocks = fold_text_inline text [] in + format_tag tag :: space :: code mark :: space :: inlines in let see_tag_to_md (see_ref, comment) = let content = match (see_ref, comment) with | Oct.Types.See_url url, text -> - let empty_hover_title = "" in - let link_title = [ Omd.Text "link" ] in - Omd.Url (url, link_title, empty_hover_title) - :: space :: text_to_markdown text + let inlines, _blocks = fold_text_inline text [] in + a ~url ~title:"link" "" :: space :: inlines | See_file name, text | See_doc name, text -> - let no_prog_lang = "" in (* TODO: add support to reference files and documents *) - Code (no_prog_lang, name) :: space :: text_to_markdown text + let inlines, _blocks = fold_text_inline text [] in + code name :: space :: inlines in format_tag "@see" :: space :: content in @@ -122,17 +147,16 @@ and tag_to_markdown tag : Omd.element list = | Raised_exception (exn, text) -> marked_tag_with_text_to_md "@raise" exn text | See (r, s) -> see_tag_to_md (r, s) | Custom (name, text) -> - [ Omd.Emph [ Text ("@" ^ name) ]; space ] @ text_to_markdown text - | Inline -> [ Emph [ Text "@inline" ] ] + let inlines, _blocks = fold_text_inline text [] in + [ Emph ([], txt ("@" ^ name)); space ] @ inlines + | Inline -> [ Emph ([], txt "@inline") ] let comment_to_markdown (doc, tags) = let text = text_to_markdown doc in let tags = tags_to_markdown tags in match tags with | [] -> text - | non_empty_tags -> - let separation = Omd.[ NL; Hr ] in - text @ separation @ non_empty_tags + | non_empty_tags -> text @ [ hr ] @ [ p non_empty_tags ] type t = | Raw of string @@ -144,7 +168,7 @@ let translate doc : t = let msg = Oct.Errors.message e.error in Log.log ~section:"debug" (fun () -> Log.msg "invalid doc comments" [ ("msg", `String msg) ]); - Raw (Omd.to_markdown [ Raw doc ]) + Raw (Omd.of_string doc) | Ok doc -> let doc = comment_to_markdown doc in - Markdown (Omd.to_markdown doc) + Markdown (Omd.to_string doc)