1 (** Mld (ocamldoc) documentation format. 2 3 Parses section headings, code blocks, and paragraphs. Inline markup handles 4 bold, italic, emphasis, and code spans. *) 5 6 (* {1 Line classifiers} *) 7 8 let heading line = 9 let trimmed = String.trim line in 10 let len = String.length trimmed in 11 if len < 4 || trimmed.[0] <> '{' then None 12 else 13 match trimmed.[1] with 14 | '0' .. '6' when len > 3 && trimmed.[2] = ' ' -> 15 let level = Char.code trimmed.[1] - Char.code '0' in 16 let text_start = 3 in 17 let text_end = if trimmed.[len - 1] = '}' then len - 1 else len in 18 let text = 19 String.sub trimmed text_start (text_end - text_start) |> String.trim 20 in 21 Some (max 1 level, text) 22 | _ -> None 23 24 let code_block_open line = 25 let trimmed = String.trim line in 26 if String.starts_with ~prefix:"{[" trimmed then 27 let rest = String.sub trimmed 2 (String.length trimmed - 2) in 28 if 29 String.length rest > 0 30 && rest.[String.length rest - 1] = ']' 31 && String.length rest > 1 32 && rest.[String.length rest - 2] = '}' 33 then 34 (* Single-line code block: {[code]} on one line *) 35 None 36 else Some rest 37 else None 38 39 let code_block_single line = 40 let trimmed = String.trim line in 41 let len = String.length trimmed in 42 if 43 len >= 4 44 && String.starts_with ~prefix:"{[" trimmed 45 && trimmed.[len - 2] = ']' 46 && trimmed.[len - 1] = '}' 47 then Some (String.sub trimmed 2 (len - 4)) 48 else None 49 50 let is_code_block_close line = 51 let trimmed = String.trim line in 52 String.length trimmed >= 2 53 && trimmed.[String.length trimmed - 2] = ']' 54 && trimmed.[String.length trimmed - 1] = '}' 55 56 (* {1 Block parsing} *) 57 58 let parse_blocks lines = 59 let is_boundary line = 60 String.trim line = "" 61 || Option.is_some (heading line) 62 || Option.is_some (code_block_open line) 63 || Option.is_some (code_block_single line) 64 in 65 let rec take_paragraph collected = function 66 | line :: _ as rest when is_boundary line -> (List.rev collected, rest) 67 | line :: rest -> take_paragraph (String.trim line :: collected) rest 68 | [] -> (List.rev collected, []) 69 in 70 let open Format in 71 let rec loop blocks = function 72 | [] -> List.rev blocks 73 | line :: rest when String.trim line = "" -> loop blocks rest 74 | line :: rest -> ( 75 match heading line with 76 | Some (level, text) -> loop (Heading (level, text) :: blocks) rest 77 | None -> ( 78 match code_block_single line with 79 | Some code -> loop (Code_block (None, code) :: blocks) rest 80 | None -> ( 81 match code_block_open line with 82 | Some first_line -> 83 let code_lines, rest = 84 Format.take_until is_code_block_close [] rest 85 in 86 let all_lines = 87 if first_line = "" then code_lines 88 else first_line :: code_lines 89 in 90 let code = String.concat "\n" all_lines in 91 loop (Code_block (None, code) :: blocks) rest 92 | None -> 93 let paragraph, rest = take_paragraph [] (line :: rest) in 94 loop 95 (Paragraph (String.concat " " paragraph) :: blocks) 96 rest))) 97 in 98 loop [] lines 99 100 (* {1 Inline markup} *) 101 102 let inline text = 103 let len = String.length text in 104 let buf = Buffer.create 64 in 105 let nodes = ref [] in 106 let flush () = 107 if Buffer.length buf > 0 then ( 108 nodes := Ui.text (Buffer.contents buf) :: !nodes; 109 Buffer.clear buf) 110 in 111 let rec loop i = 112 if i >= len then flush () 113 else 114 match text.[i] with 115 | '{' when i + 1 < len -> ( 116 match text.[i + 1] with 117 | ('b' | 'i' | 'e') when i + 2 < len && text.[i + 2] = ' ' -> 118 flush (); 119 let close = find_brace_close (i + 3) 1 in 120 let content = String.sub text (i + 3) (close - i - 3) in 121 nodes := 122 Ui.inline ~class_:"readme-emphasis" [ Ui.text content ] 123 :: !nodes; 124 loop (close + 1) 125 | '[' -> 126 flush (); 127 let close = find_code_close (i + 2) in 128 let content = String.sub text (i + 2) (close - i - 2) in 129 nodes := Ui.code_inline ~class_:"readme-code" content :: !nodes; 130 loop (close + 2) 131 | _ -> 132 Buffer.add_char buf '{'; 133 loop (i + 1)) 134 | c -> 135 Buffer.add_char buf c; 136 loop (i + 1) 137 and find_brace_close start depth = 138 if start >= len then len 139 else if text.[start] = '}' then 140 if depth <= 1 then start else find_brace_close (start + 1) (depth - 1) 141 else if text.[start] = '{' then find_brace_close (start + 1) (depth + 1) 142 else find_brace_close (start + 1) depth 143 and find_code_close start = 144 if start + 1 >= len then len 145 else if text.[start] = ']' && text.[start + 1] = '}' then start 146 else find_code_close (start + 1) 147 in 148 loop 0; 149 List.rev !nodes 150 151 (* {1 Format definition} *) 152 153 let format : Format.format = 154 { 155 name = "mld"; 156 css_class = "readme-document readme-mld"; 157 parse = 158 (fun content -> 159 let lines = String.split_on_char '\n' content in 160 { Format.title = None; metadata = []; blocks = parse_blocks lines }); 161 inline; 162 } 163