1 (** Markdown documentation format. 2 3 Parses ATX headings, fenced code blocks, unordered and ordered lists, and 4 paragraphs. Inline markup is passed through as plain text. *) 5 6 (* {1 Line classifiers} *) 7 8 let trim_end_hashes text = 9 let text = String.trim text in 10 let rec last_non_hash index = 11 if index < 0 || text.[index] <> '#' then index else last_non_hash (index - 1) 12 in 13 let last = last_non_hash (String.length text - 1) in 14 String.sub text 0 (last + 1) |> String.trim 15 16 let heading line = 17 let length = String.length line in 18 let rec count_hashes index = 19 if index < length && line.[index] = '#' then count_hashes (index + 1) 20 else index 21 in 22 let level = count_hashes 0 in 23 if level = 0 || level > 6 || level >= length || line.[level] <> ' ' then None 24 else 25 Some 26 ( level, 27 String.sub line (level + 1) (length - level - 1) |> trim_end_hashes ) 28 29 let unordered_item = Format.unordered_item 30 let ordered_item = Format.ordered_item 31 32 let fence line = 33 let line = String.trim line in 34 if String.length line < 3 then None 35 else 36 let marker = String.sub line 0 3 in 37 if marker <> "```" && marker <> "~~~" then None 38 else 39 let language = 40 String.sub line 3 (String.length line - 3) 41 |> String.trim |> Format.first_word 42 in 43 Some (marker, language) 44 45 (* {1 Block parsing} *) 46 47 let is_boundary_common = Format.is_boundary_common 48 49 let parse_blocks lines = 50 let is_boundary line = 51 is_boundary_common line 52 || Option.is_some (heading line) 53 || Option.is_some (fence line) 54 in 55 let rec take_paragraph collected = function 56 | line :: _ as rest when is_boundary line -> (List.rev collected, rest) 57 | line :: rest -> take_paragraph (String.trim line :: collected) rest 58 | [] -> (List.rev collected, []) 59 in 60 let rec take_unordered collected = function 61 | line :: rest -> ( 62 match unordered_item line with 63 | Some first_line -> 64 let continuations, rest = Format.take_continuations rest in 65 let item = String.concat " " (first_line :: continuations) in 66 take_unordered (item :: collected) rest 67 | None -> (List.rev collected, line :: rest)) 68 | [] -> (List.rev collected, []) 69 in 70 let rec take_ordered collected = function 71 | line :: rest -> ( 72 match ordered_item line with 73 | Some first_line -> 74 let continuations, rest = Format.take_continuations rest in 75 let item = String.concat " " (first_line :: continuations) in 76 take_ordered (item :: collected) rest 77 | None -> (List.rev collected, line :: rest)) 78 | [] -> (List.rev collected, []) 79 in 80 let open Format in 81 let rec loop blocks = function 82 | [] -> List.rev blocks 83 | line :: rest when String.trim line = "" -> loop blocks rest 84 | line :: rest -> ( 85 match heading line with 86 | Some (level, text) -> loop (Heading (level, text) :: blocks) rest 87 | None -> ( 88 match fence line with 89 | Some (marker, language) -> 90 let lines, rest = 91 Format.take_until 92 (fun candidate -> 93 String.starts_with ~prefix:marker (String.trim candidate)) 94 [] rest 95 in 96 loop 97 (Code_block (language, String.concat "\n" lines) :: blocks) 98 rest 99 | None -> ( 100 match unordered_item line with 101 | Some _ -> 102 let items, rest = take_unordered [] (line :: rest) in 103 loop (Unordered_list items :: blocks) rest 104 | None -> ( 105 match ordered_item line with 106 | Some _ -> 107 let items, rest = take_ordered [] (line :: rest) in 108 loop (Ordered_list items :: blocks) rest 109 | None -> 110 let paragraph, rest = 111 take_paragraph [] (line :: rest) 112 in 113 loop 114 (Paragraph (String.concat " " paragraph) :: blocks) 115 rest)))) 116 in 117 loop [] lines 118 119 (* {1 Format definition} *) 120 121 let format : Format.format = 122 { 123 name = "markdown"; 124 css_class = "readme-document readme-markdown"; 125 parse = 126 (fun content -> 127 let lines = String.split_on_char '\n' content in 128 { Format.title = None; metadata = []; blocks = parse_blocks lines }); 129 inline = (fun text -> [ Ui.text text ]); 130 } 131