1 (* Inline Menhir grammar for Org Mode inline objects. 2 Parses inline tokens into Ast.inline list. 3 4 Key design: the inline lexer pre-scans for matched emphasis pairs 5 and only emits OPEN/CLOSE tokens for valid pairs. Unmatched 6 delimiters become TEXT tokens from the lexer. This eliminates 7 ambiguity in the grammar. *) 8 9 %{ 10 open Ast 11 12 let merge_plain items = 13 let rec loop acc = function 14 | [] -> List.rev acc 15 | Plain s1 :: Plain s2 :: rest -> 16 loop acc (Plain (s1 ^ s2) :: rest) 17 | item :: rest -> loop (item :: acc) rest 18 in 19 loop [] items 20 21 let parse_link_target s = 22 if String.length s >= 8 && String.sub s 0 8 = "https://" then Url s 23 else if String.length s >= 7 && String.sub s 0 7 = "http://" then Url s 24 else if String.length s >= 6 && String.sub s 0 6 = "ftp://" then Url s 25 else if String.length s >= 5 && String.sub s 0 5 = "file:" then 26 File (String.sub s 5 (String.length s - 5)) 27 else 28 match String.index_opt s ':' with 29 | Some i when i > 0 -> 30 let proto = String.sub s 0 i in 31 let path = String.sub s (i + 1) (String.length s - i - 1) in 32 Protocol (proto, path) 33 | _ -> Internal s 34 35 let rec parse_timestamp_string s = 36 let len = String.length s in 37 if len < 12 then None 38 else 39 let is_active = s.[0] = '<' in 40 (* Check for range *) 41 let range_sep = if is_active then ">--<" else "]--[" in 42 let range_idx = 43 let slen = String.length range_sep in 44 let rec find i = 45 if i + slen > len then None 46 else if String.sub s i slen = range_sep then Some i 47 else find (i + 1) 48 in 49 find 0 50 in 51 match range_idx with 52 | Some idx -> 53 let ts1 = String.sub s 0 (idx + 1) in 54 let ts2 = String.sub s (idx + String.length range_sep - 1) 55 (len - idx - String.length range_sep + 1) in 56 (match parse_single_date ts1, parse_single_date ts2 with 57 | Some d1, Some d2 -> 58 if is_active then Some (Active_range (d1, d2)) 59 else Some (Inactive_range (d1, d2)) 60 | _ -> None) 61 | None -> 62 match parse_single_date s with 63 | Some date -> 64 if is_active then Some (Active (date, None)) 65 else Some (Inactive (date, None)) 66 | None -> None 67 68 and parse_single_date s = 69 let len = String.length s in 70 if len < 12 then None 71 else 72 let inner = String.sub s 1 (len - 2) in 73 let parts = String.split_on_char ' ' inner |> List.filter (fun p -> p <> "") in 74 match parts with 75 | date_part :: rest -> 76 let date_parts = String.split_on_char '-' date_part in 77 (match date_parts with 78 | [y; m; d] -> 79 (try 80 let year = int_of_string y in 81 let month = int_of_string m in 82 let day = int_of_string d in 83 let dayname = ref None in 84 let hour = ref None in 85 let minute = ref None in 86 List.iter (fun part -> 87 if String.length part = 5 && part.[2] = ':' then begin 88 (try 89 hour := Some (int_of_string (String.sub part 0 2)); 90 minute := Some (int_of_string (String.sub part 3 2)) 91 with Failure _ -> ()) 92 end 93 else if String.length part >= 2 then 94 dayname := Some part 95 ) rest; 96 Some { year; month; day; dayname = !dayname; hour = !hour; minute = !minute } 97 with Failure _ -> None) 98 | _ -> None) 99 | [] -> None 100 %} 101 102 %token <string> TEXT 103 %token STAR_OPEN STAR_CLOSE 104 %token SLASH_OPEN SLASH_CLOSE 105 %token UNDER_OPEN UNDER_CLOSE 106 %token PLUS_OPEN PLUS_CLOSE 107 %token <string> TILDE 108 %token <string> EQUALS 109 %token LINK_OPEN LINK_CLOSE LINK_SEP 110 %token <string> TIMESTAMP 111 %token <string> ANGLE_LINK 112 %token <string> PLAIN_LINK 113 %token LINE_BREAK 114 %token NEWLINE 115 %token EOF 116 117 %start <Ast.inline list> inline_content 118 119 %% 120 121 inline_content: 122 | items = list(inline_item) EOF 123 { merge_plain items } 124 ; 125 126 inline_item: 127 | t = TEXT 128 { Plain t } 129 | STAR_OPEN contents = list(inline_item) STAR_CLOSE 130 { Bold (merge_plain contents) } 131 | SLASH_OPEN contents = list(inline_item) SLASH_CLOSE 132 { Italic (merge_plain contents) } 133 | UNDER_OPEN contents = list(inline_item) UNDER_CLOSE 134 { Underline (merge_plain contents) } 135 | PLUS_OPEN contents = list(inline_item) PLUS_CLOSE 136 { Strikethrough (merge_plain contents) } 137 | c = TILDE 138 { Code c } 139 | v = EQUALS 140 { Verbatim v } 141 | LINK_OPEN target = link_path LINK_CLOSE 142 { Link { target = parse_link_target target; description = None } } 143 | LINK_OPEN target = link_path LINK_SEP desc = list(inline_item) LINK_CLOSE 144 { Link { target = parse_link_target target; description = Some (merge_plain desc) } } 145 | link = ANGLE_LINK 146 { Link { target = parse_link_target link; description = None } } 147 | link = PLAIN_LINK 148 { Link { target = parse_link_target link; description = None } } 149 | ts = TIMESTAMP 150 { match parse_timestamp_string ts with 151 | Some t -> Timestamp t 152 | None -> Plain ts } 153 | LINE_BREAK 154 { Line_break } 155 | NEWLINE 156 { Plain " " } 157 ; 158 159 link_path: 160 | parts = nonempty_list(link_path_part) 161 { String.concat "" parts } 162 ; 163 164 link_path_part: 165 | t = TEXT { t } 166 | STAR_OPEN { "*" } 167 | STAR_CLOSE { "*" } 168 | SLASH_OPEN { "/" } 169 | SLASH_CLOSE { "/" } 170 | UNDER_OPEN { "_" } 171 | UNDER_CLOSE { "_" } 172 | PLUS_OPEN { "+" } 173 | PLUS_CLOSE { "+" } 174 | c = TILDE { "~" ^ c ^ "~" } 175 | v = EQUALS { "=" ^ v ^ "=" } 176 | link = PLAIN_LINK { link } 177 | link = ANGLE_LINK { "<" ^ link ^ ">" } 178 | ts = TIMESTAMP { ts } 179 | NEWLINE { " " } 180 | LINE_BREAK { "\\\\" } 181 ; 182