1 (** Org mode documentation format. 2 3 Parses Org headings, #+BEGIN_SRC blocks, metadata directives, unordered, 4 ordered, and definition lists, and paragraphs. Inline markup handles 5 =verbatim=, ~code~, and [[link][desc]] syntax. *) 6 7 (* {1 Inline markup} *) 8 9 let org_inline text = 10 let len = String.length text in 11 let buf = Buffer.create 64 in 12 let nodes = ref [] in 13 let flush () = 14 if Buffer.length buf > 0 then ( 15 nodes := Ui.text (Buffer.contents buf) :: !nodes; 16 Buffer.clear buf) 17 in 18 let rec loop i = 19 if i >= len then flush () 20 else 21 match text.[i] with 22 | '[' when i + 1 < len && text.[i + 1] = '[' -> 23 flush (); 24 parse_link (i + 2) 25 | ('=' | '~') as marker -> ( 26 let close = find_close marker (i + 1) in 27 match close with 28 | Some end_pos -> 29 flush (); 30 let content = String.sub text (i + 1) (end_pos - i - 1) in 31 let node = 32 match marker with 33 | '~' -> Ui.code_inline ~class_:"readme-code" content 34 | _ -> Ui.inline ~class_:"readme-verbatim" [ Ui.text content ] 35 in 36 nodes := node :: !nodes; 37 loop (end_pos + 1) 38 | None -> 39 Buffer.add_char buf text.[i]; 40 loop (i + 1)) 41 | c -> 42 Buffer.add_char buf c; 43 loop (i + 1) 44 and find_close marker start = 45 let rec search j = 46 if j >= len then None 47 else if text.[j] = marker then Some j 48 else if text.[j] = '\n' then None 49 else search (j + 1) 50 in 51 if start >= len then None else search start 52 and parse_link start = 53 let rec find_end j _depth = 54 if j >= len then None 55 else if j + 1 < len && text.[j] = ']' && text.[j + 1] = ']' then Some j 56 else find_end (j + 1) 0 57 in 58 match find_end start 0 with 59 | None -> 60 Buffer.add_string buf "[["; 61 loop start 62 | Some close_pos -> 63 let inner = String.sub text start (close_pos - start) in 64 let href, desc = 65 match String.index_opt inner ']' with 66 | Some bracket_pos 67 when bracket_pos + 1 < String.length inner 68 && inner.[bracket_pos + 1] = '[' -> 69 let href = String.sub inner 0 bracket_pos in 70 let desc = 71 String.sub inner (bracket_pos + 2) 72 (String.length inner - bracket_pos - 2) 73 in 74 (href, desc) 75 | _ -> (inner, inner) 76 in 77 let node = Ui.link ~class_:"readme-link" ~href [ Ui.text desc ] in 78 nodes := node :: !nodes; 79 loop (close_pos + 2) 80 in 81 loop 0; 82 List.rev !nodes 83 84 (* {1 Line classifiers} *) 85 86 let heading line = 87 let length = String.length line in 88 let rec count_stars index = 89 if index < length && line.[index] = '*' then count_stars (index + 1) 90 else index 91 in 92 let level = count_stars 0 in 93 if level = 0 || level >= length || line.[level] <> ' ' then None 94 else 95 Some 96 ( min 6 level, 97 String.sub line (level + 1) (length - level - 1) |> String.trim ) 98 99 let unordered_item = Format.unordered_item 100 let ordered_item = Format.ordered_item 101 102 let definition_item line = 103 let trimmed = String.trim line in 104 let tlen = String.length trimmed in 105 if tlen < 2 || trimmed.[0] <> '-' || trimmed.[1] <> ' ' then None 106 else 107 let rest = String.sub trimmed 2 (tlen - 2) in 108 let rec find_sep i = 109 if i + 3 >= String.length rest then None 110 else if 111 rest.[i] = ' ' 112 && rest.[i + 1] = ':' 113 && rest.[i + 2] = ':' 114 && rest.[i + 3] = ' ' 115 then 116 let term = String.sub rest 0 i |> String.trim in 117 let desc = 118 String.sub rest (i + 4) (String.length rest - i - 4) |> String.trim 119 in 120 Some (term, desc) 121 else find_sep (i + 1) 122 in 123 find_sep 0 124 125 let src_begin line = 126 let prefix = "#+begin_src" in 127 let lower = String.lowercase_ascii (String.trim line) in 128 if not (String.starts_with ~prefix lower) then None 129 else 130 let language = 131 String.sub lower (String.length prefix) 132 (String.length lower - String.length prefix) 133 |> String.trim |> Format.first_word 134 in 135 Some language 136 137 let is_src_end line = 138 String.trim line |> String.lowercase_ascii 139 |> String.starts_with ~prefix:"#+end_src" 140 141 let is_example_begin line = 142 String.trim line |> String.lowercase_ascii 143 |> String.starts_with ~prefix:"#+begin_example" 144 145 let is_example_end line = 146 String.trim line |> String.lowercase_ascii 147 |> String.starts_with ~prefix:"#+end_example" 148 149 (* {1 Block parsing} *) 150 151 let is_boundary_common line = 152 Format.is_boundary_common line || Option.is_some (definition_item line) 153 154 let parse_blocks lines = 155 let is_boundary line = 156 is_boundary_common line 157 || Option.is_some (heading line) 158 || Option.is_some (src_begin line) 159 || is_example_begin line 160 in 161 let rec take_paragraph collected = function 162 | line :: _ as rest when is_boundary line -> (List.rev collected, rest) 163 | line :: rest -> take_paragraph (String.trim line :: collected) rest 164 | [] -> (List.rev collected, []) 165 in 166 let rec take_unordered collected = function 167 | line :: rest -> ( 168 match unordered_item line with 169 | Some first_line -> 170 let continuations, rest = Format.take_continuations rest in 171 let item = String.concat " " (first_line :: continuations) in 172 take_unordered (item :: collected) rest 173 | None -> (List.rev collected, line :: rest)) 174 | [] -> (List.rev collected, []) 175 in 176 let rec take_ordered collected = function 177 | line :: rest -> ( 178 match ordered_item line with 179 | Some first_line -> 180 let continuations, rest = Format.take_continuations rest in 181 let item = String.concat " " (first_line :: continuations) in 182 take_ordered (item :: collected) rest 183 | None -> (List.rev collected, line :: rest)) 184 | [] -> (List.rev collected, []) 185 in 186 let rec take_definitions collected = function 187 | line :: rest -> ( 188 match definition_item line with 189 | Some (term, first_desc) -> 190 let continuations, rest = Format.take_continuations rest in 191 let desc = String.concat " " (first_desc :: continuations) in 192 take_definitions ((term, desc) :: collected) rest 193 | None -> (List.rev collected, line :: rest)) 194 | [] -> (List.rev collected, []) 195 in 196 let open Format in 197 let rec loop blocks = function 198 | [] -> List.rev blocks 199 | line :: rest when String.trim line = "" -> loop blocks rest 200 | line :: rest -> ( 201 match heading line with 202 | Some (level, text) -> loop (Heading (level, text) :: blocks) rest 203 | None -> ( 204 match src_begin line with 205 | Some language -> 206 let lines, rest = Format.take_until is_src_end [] rest in 207 loop 208 (Code_block (language, String.concat "\n" lines) :: blocks) 209 rest 210 | None when is_example_begin line -> 211 let lines, rest = Format.take_until is_example_end [] rest in 212 loop 213 (Code_block (None, String.concat "\n" lines) :: blocks) 214 rest 215 | None -> ( 216 match definition_item line with 217 | Some _ -> 218 let items, rest = take_definitions [] (line :: rest) in 219 loop (Definition_list items :: blocks) rest 220 | None -> ( 221 match unordered_item line with 222 | Some _ -> 223 let items, rest = take_unordered [] (line :: rest) in 224 loop (Unordered_list items :: blocks) rest 225 | None -> ( 226 match ordered_item line with 227 | Some _ -> 228 let items, rest = take_ordered [] (line :: rest) in 229 loop (Ordered_list items :: blocks) rest 230 | None -> 231 let paragraph, rest = 232 take_paragraph [] (line :: rest) 233 in 234 loop 235 (Paragraph (String.concat " " paragraph) :: blocks) 236 rest))))) 237 in 238 loop [] lines 239 240 (* {1 Org metadata} *) 241 242 let metadata_line line = 243 let prefix = "#+" in 244 let line = String.trim line in 245 if not (String.starts_with ~prefix line) then None 246 else 247 match String.index_opt line ':' with 248 | None -> None 249 | Some colon -> 250 let key = String.sub line 2 (colon - 2) |> String.lowercase_ascii in 251 let value = 252 String.sub line (colon + 1) (String.length line - colon - 1) 253 |> String.trim 254 in 255 if List.mem key [ "title"; "author"; "date"; "email"; "language" ] then 256 Some (key, value) 257 else None 258 259 let split_metadata lines = 260 List.fold_left 261 (fun (metadata, body) line -> 262 match metadata_line line with 263 | None -> (metadata, line :: body) 264 | Some entry -> (entry :: metadata, body)) 265 ([], []) lines 266 |> fun (metadata, body) -> (List.rev metadata, List.rev body) 267 268 (* {1 Format definition} *) 269 270 let format : Format.format = 271 { 272 name = "org"; 273 css_class = "readme-document readme-org"; 274 parse = 275 (fun content -> 276 let lines = String.split_on_char '\n' content in 277 let metadata, lines = split_metadata lines in 278 let title = 279 List.find_opt (fun (key, _) -> key = "title") metadata 280 |> Option.map snd 281 in 282 let metadata_entries = 283 List.filter (fun (key, _) -> key <> "title") metadata 284 in 285 { 286 Format.title; 287 metadata = metadata_entries; 288 blocks = parse_blocks lines; 289 }); 290 inline = org_inline; 291 } 292