[OCaml] Org mode parser.
chore fix dune-project, update ocamlformat, apply formatting
- Remove hardcoded version (VCS tags drive it on release) - Remove bug_reports (no tracker yet) - Fix menhir dep indentation - Update .ocamlformat to 0.29.0 (matches installed version) - Run dune fmt across all .ml files
Changed files
.ocamlformat
@@ -1,2 +1,2 @@
1
Removed:
version = 0.26.2
1
Added:
version = 0.29.0
2
2
profile = default
dune-project
@@ -1,9 +1,7 @@
1
Removed:
(lang dune 3.0)
1
Added:
(lang dune 3.24)
2
2
3
3
(name org)
4
4
5
Removed:
(version 0.1.0)
6
Removed:
7
5
(generate_opam_files true)
8
6
9
7
(using menhir 2.1)
@@ -11,13 +9,11 @@
11
9
(package
12
10
(name org)
13
11
(synopsis "OCaml Org Mode parser library")
14
Removed:
(description
15
Removed:
"A compact, high-quality OCaml library for parsing Org Mode documents into a semantic, strongly typed abstract syntax tree.")
16
Removed:
(license ISC)
17
Removed:
(authors "blendux")
18
Removed:
(maintainers "blendux")
19
Removed:
(homepage "https://github.com/blendux/ocaml-org")
20
Removed:
(bug_reports "https://github.com/blendux/ocaml-org/issues")
12
Added:
(description "A compact OCaml library for parsing Org Mode documents.")
13
Added:
(license GPL-3.0-only)
14
Added:
(authors "Marius PETER")
15
Added:
(maintainers "Marius PETER")
16
Added:
(homepage "https://git.mlnp.fr/ocaml-org")
21
17
(depends
22
18
(ocaml
23
19
(>= 5.0))
lib/ast.ml
@@ -11,7 +11,6 @@
11
11
12
12
(** {1 Timestamps} *)
13
13
14
Removed:
(** A date with optional time. *)
15
14
type date = {
16
15
year : int;
17
16
month : int;
@@ -20,6 +19,7 @@
20
19
hour : int option;
21
20
minute : int option;
22
21
}
22
Added:
(** A date with optional time. *)
23
23
24
24
(** Repeater or delay mark. *)
25
25
type repeater_mark =
@@ -54,10 +54,7 @@
54
54
55
55
(** {1 Properties} *)
56
56
57
Removed:
type property = {
58
Removed:
prop_name : string;
59
Removed:
prop_value : string option;
60
Removed:
}
57
Added:
type property = { prop_name : string; prop_value : string option }
61
58
62
59
(** {1 Affiliated keywords} *)
63
60
@@ -82,29 +79,19 @@
82
79
| Timestamp of timestamp (** A timestamp *)
83
80
| Line_break (** Explicit line break \\\\ *)
84
81
82
Added:
and link = { target : link_target; description : inline list option }
85
83
(** A link with optional description. *)
86
Removed:
and link = {
87
Removed:
target : link_target;
88
Removed:
description : inline list option;
89
Removed:
}
90
84
91
85
(** {1 Lists} *)
92
86
93
87
type list_kind = Ordered | Unordered | Descriptive
94
Removed:
95
88
type checkbox = Checked | Unchecked | Partial
96
89
97
90
(** {1 Tables} *)
98
91
99
92
type table_cell = inline list
100
Removed:
101
Removed:
type table_row =
102
Removed:
| Table_row_standard of table_cell list
103
Removed:
| Table_row_rule
104
Removed:
105
Removed:
type table = {
106
Removed:
rows : table_row list;
107
Removed:
}
93
Added:
type table_row = Table_row_standard of table_cell list | Table_row_rule
94
Added:
type table = { rows : table_row list }
108
95
109
96
(** {1 Blocks} *)
110
97
@@ -118,10 +105,7 @@
118
105
119
106
(** {1 Keywords} *)
120
107
121
Removed:
type keyword = {
122
Removed:
kw_key : string;
123
Removed:
kw_value : string;
124
Removed:
}
108
Added:
type keyword = { kw_key : string; kw_value : string }
125
109
126
110
(** {1 Elements} *)
127
111
@@ -147,13 +131,35 @@
147
131
148
132
and block =
149
133
| Src_block of src_block
150
Removed:
| Example_block of { ex_value : string; ex_switches : string option; ex_affiliated : affiliated list }
151
Removed:
| Export_block of { exp_backend : string; exp_value : string; exp_affiliated : affiliated list }
134
Added:
| Example_block of {
135
Added:
ex_value : string;
136
Added:
ex_switches : string option;
137
Added:
ex_affiliated : affiliated list;
138
Added:
}
139
Added:
| Export_block of {
140
Added:
exp_backend : string;
141
Added:
exp_value : string;
142
Added:
exp_affiliated : affiliated list;
143
Added:
}
152
144
| Comment_block of { cb_value : string; cb_affiliated : affiliated list }
153
Removed:
| Quote_block of { qt_contents : element list; qt_affiliated : affiliated list }
154
Removed:
| Center_block of { cn_contents : element list; cn_affiliated : affiliated list }
155
Removed:
| Verse_block of { vs_contents : inline list; vs_affiliated : affiliated list }
156
Removed:
| Custom_block of { cst_name : string; cst_params : string option; cst_contents : element list; cst_affiliated : affiliated list }
145
Added:
| Quote_block of {
146
Added:
qt_contents : element list;
147
Added:
qt_affiliated : affiliated list;
148
Added:
}
149
Added:
| Center_block of {
150
Added:
cn_contents : element list;
151
Added:
cn_affiliated : affiliated list;
152
Added:
}
153
Added:
| Verse_block of {
154
Added:
vs_contents : inline list;
155
Added:
vs_affiliated : affiliated list;
156
Added:
}
157
Added:
| Custom_block of {
158
Added:
cst_name : string;
159
Added:
cst_params : string option;
160
Added:
cst_contents : element list;
161
Added:
cst_affiliated : affiliated list;
162
Added:
}
157
163
158
164
(** {1 Headings} *)
159
165
@@ -172,11 +178,8 @@
172
178
173
179
(** {1 Directives} *)
174
180
181
Added:
type directive = { dir_key : string; dir_value : string }
175
182
(** File-level directives like #+TITLE, #+AUTHOR, etc. *)
176
Removed:
type directive = {
177
Removed:
dir_key : string;
178
Removed:
dir_value : string;
179
Removed:
}
180
183
181
184
(** {1 Document} *)
182
185
lib/ast.mli
@@ -1,9 +1,9 @@
1
1
(** Public semantic AST types for Org Mode documents.
2
2
3
Removed:
This module defines the strongly-typed abstract syntax tree
4
Removed:
produced by parsing an Org Mode document. The types are designed
5
Removed:
to be semantic: they represent the meaning of Org constructs
6
Removed:
rather than their exact surface syntax.
3
Added:
This module defines the strongly-typed abstract syntax tree produced by
4
Added:
parsing an Org Mode document. The types are designed to be semantic: they
5
Added:
represent the meaning of Org constructs rather than their exact surface
6
Added:
syntax.
7
7
8
8
The AST is read-only and uses closed variants for known constructs. *)
9
9
@@ -27,13 +27,7 @@
27
27
minute : int option;
28
28
}
29
29
30
Removed:
type repeater_mark =
31
Removed:
| Plus
32
Removed:
| Double_plus
33
Removed:
| Dot_plus
34
Removed:
| Minus
35
Removed:
| Double_minus
36
Removed:
30
Added:
type repeater_mark = Plus | Double_plus | Dot_plus | Minus | Double_minus
37
31
type duration_unit = Hour | Day | Week | Month | Year
38
32
39
33
type repeater_or_delay = {
@@ -58,10 +52,7 @@
58
52
59
53
(** {1 Properties} *)
60
54
61
Removed:
type property = {
62
Removed:
prop_name : string;
63
Removed:
prop_value : string option;
64
Removed:
}
55
Added:
type property = { prop_name : string; prop_value : string option }
65
56
66
57
(** {1 Affiliated keywords} *)
67
58
@@ -85,28 +76,18 @@
85
76
| Timestamp of timestamp
86
77
| Line_break
87
78
88
Removed:
and link = {
89
Removed:
target : link_target;
90
Removed:
description : inline list option;
91
Removed:
}
79
Added:
and link = { target : link_target; description : inline list option }
92
80
93
81
(** {1 Lists} *)
94
82
95
83
type list_kind = Ordered | Unordered | Descriptive
96
Removed:
97
84
type checkbox = Checked | Unchecked | Partial
98
85
99
86
(** {1 Tables} *)
100
87
101
88
type table_cell = inline list
102
Removed:
103
Removed:
type table_row =
104
Removed:
| Table_row_standard of table_cell list
105
Removed:
| Table_row_rule
106
Removed:
107
Removed:
type table = {
108
Removed:
rows : table_row list;
109
Removed:
}
89
Added:
type table_row = Table_row_standard of table_cell list | Table_row_rule
90
Added:
type table = { rows : table_row list }
110
91
111
92
(** {1 Blocks} *)
112
93
@@ -120,10 +101,7 @@
120
101
121
102
(** {1 Keywords} *)
122
103
123
Removed:
type keyword = {
124
Removed:
kw_key : string;
125
Removed:
kw_value : string;
126
Removed:
}
104
Added:
type keyword = { kw_key : string; kw_value : string }
127
105
128
106
(** {1 Elements} *)
129
107
@@ -148,13 +126,35 @@
148
126
149
127
and block =
150
128
| Src_block of src_block
151
Removed:
| Example_block of { ex_value : string; ex_switches : string option; ex_affiliated : affiliated list }
152
Removed:
| Export_block of { exp_backend : string; exp_value : string; exp_affiliated : affiliated list }
129
Added:
| Example_block of {
130
Added:
ex_value : string;
131
Added:
ex_switches : string option;
132
Added:
ex_affiliated : affiliated list;
133
Added:
}
134
Added:
| Export_block of {
135
Added:
exp_backend : string;
136
Added:
exp_value : string;
137
Added:
exp_affiliated : affiliated list;
138
Added:
}
153
139
| Comment_block of { cb_value : string; cb_affiliated : affiliated list }
154
Removed:
| Quote_block of { qt_contents : element list; qt_affiliated : affiliated list }
155
Removed:
| Center_block of { cn_contents : element list; cn_affiliated : affiliated list }
156
Removed:
| Verse_block of { vs_contents : inline list; vs_affiliated : affiliated list }
157
Removed:
| Custom_block of { cst_name : string; cst_params : string option; cst_contents : element list; cst_affiliated : affiliated list }
140
Added:
| Quote_block of {
141
Added:
qt_contents : element list;
142
Added:
qt_affiliated : affiliated list;
143
Added:
}
144
Added:
| Center_block of {
145
Added:
cn_contents : element list;
146
Added:
cn_affiliated : affiliated list;
147
Added:
}
148
Added:
| Verse_block of {
149
Added:
vs_contents : inline list;
150
Added:
vs_affiliated : affiliated list;
151
Added:
}
152
Added:
| Custom_block of {
153
Added:
cst_name : string;
154
Added:
cst_params : string option;
155
Added:
cst_contents : element list;
156
Added:
cst_affiliated : affiliated list;
157
Added:
}
158
158
159
159
(** {1 Headings} *)
160
160
@@ -173,10 +173,7 @@
173
173
174
174
(** {1 Directives} *)
175
175
176
Removed:
type directive = {
177
Removed:
dir_key : string;
178
Removed:
dir_value : string;
179
Removed:
}
176
Added:
type directive = { dir_key : string; dir_value : string }
180
177
181
178
(** {1 Document} *)
182
179
lib/config.ml
@@ -1,21 +1,18 @@
1
1
(** Document configuration from pre-scan.
2
2
3
Removed:
This module holds document-level settings extracted from
4
Removed:
file-local declarations such as #+TODO lines. These affect
5
Removed:
how the structural lexer and normalization interpret the document. *)
3
Added:
This module holds document-level settings extracted from file-local
4
Added:
declarations such as #+TODO lines. These affect how the structural lexer and
5
Added:
normalization interpret the document. *)
6
6
7
Added:
type todo_sequence = { active : string list; done_ : string list }
7
8
(** A TODO keyword sequence: active keywords followed by done keywords. *)
8
Removed:
type todo_sequence = {
9
Removed:
active : string list;
10
Removed:
done_ : string list;
11
Removed:
}
12
9
13
Removed:
(** Document configuration. *)
14
10
type t = {
15
11
todo_sequences : todo_sequence list;
16
Removed:
(** All TODO keyword sequences declared in the file.
17
Removed:
Default: one sequence with active=["TODO"] done_=["DONE"]. *)
12
Added:
(** All TODO keyword sequences declared in the file. Default: one sequence
13
Added:
with active=["TODO"] done_=["DONE"]. *)
18
14
}
15
Added:
(** Document configuration. *)
19
16
20
17
(** The default configuration when no #+TODO declarations are present. *)
21
18
let default =
@@ -23,9 +20,7 @@
23
20
24
21
(** Return all TODO keywords (both active and done) from the config. *)
25
22
let all_todo_keywords config =
26
Removed:
List.concat_map
27
Removed:
(fun seq -> seq.active @ seq.done_)
28
Removed:
config.todo_sequences
23
Added:
List.concat_map (fun seq -> seq.active @ seq.done_) config.todo_sequences
29
24
30
25
(** Check if a word is a known TODO keyword. *)
31
26
let is_todo_keyword config word =
lib/inline_lexer.ml
@@ -1,11 +1,11 @@
1
1
(** Handwritten inline lexer.
2
2
3
Removed:
Tokenizes bounded text (heading titles, paragraph bodies, etc.)
4
Removed:
into tokens suitable for the inline Menhir grammar.
3
Added:
Tokenizes bounded text (heading titles, paragraph bodies, etc.) into tokens
4
Added:
suitable for the inline Menhir grammar.
5
5
6
Removed:
Key design: emphasis delimiters are only emitted as OPEN/CLOSE tokens
7
Removed:
when they form valid matched pairs. Unmatched delimiters become TEXT.
8
Removed:
This eliminates ambiguity in the Menhir grammar. *)
6
Added:
Key design: emphasis delimiters are only emitted as OPEN/CLOSE tokens when
7
Added:
they form valid matched pairs. Unmatched delimiters become TEXT. This
8
Added:
eliminates ambiguity in the Menhir grammar. *)
9
9
10
10
(** Inline tokens. *)
11
11
type token =
@@ -39,21 +39,21 @@
39
39
(** POST characters that allow an emphasis marker to close. *)
40
40
let is_post ch =
41
41
match ch with
42
Removed:
| ' ' | '\t' | '-' | '.' | ',' | ';' | ':' | '!' | '?'
43
Removed:
| ')' | '}' | '\'' | '"' | '\n' | '[' -> true
42
Added:
| ' ' | '\t' | '-' | '.' | ',' | ';' | ':' | '!' | '?' | ')' | '}' | '\''
43
Added:
| '"' | '\n' | '[' ->
44
Added:
true
44
45
| _ -> false
45
46
46
47
(** Common link protocols for plain link detection. *)
47
Removed:
let link_protocols = ["https://"; "http://"; "ftp://"; "file://"; "mailto:"]
48
Added:
let link_protocols = [ "https://"; "http://"; "ftp://"; "file://"; "mailto:" ]
48
49
49
50
(** Check if a string starts with a prefix at position [pos]. *)
50
51
let starts_with_at s pos prefix =
51
52
let plen = String.length prefix in
52
Removed:
if pos + plen > String.length s then false
53
Removed:
else String.sub s pos plen = prefix
53
Added:
if pos + plen > String.length s then false else String.sub s pos plen = prefix
54
54
55
Removed:
(** Pre-scan for matched emphasis pairs in the input.
56
Removed:
Returns a set of positions where open/close markers are valid. *)
55
Added:
(** Pre-scan for matched emphasis pairs in the input. Returns a set of positions
56
Added:
where open/close markers are valid. *)
57
57
let find_emphasis_pairs input delim =
58
58
let len = String.length input in
59
59
let opens = ref [] in
@@ -63,12 +63,16 @@
63
63
if input.[!i] = delim then begin
64
64
(* Check if this could be an opener *)
65
65
let pre_ok = !i = 0 || is_pre input.[!i - 1] in
66
Removed:
let next_not_space = !i + 1 < len &&
67
Removed:
(match input.[!i + 1] with ' ' | '\t' | '\n' -> false | _ -> true) in
66
Added:
let next_not_space =
67
Added:
!i + 1 < len
68
Added:
&& match input.[!i + 1] with ' ' | '\t' | '\n' -> false | _ -> true
69
Added:
in
68
70
(* Check if this could be a closer *)
69
71
let post_ok = !i + 1 >= len || is_post input.[!i + 1] in
70
Removed:
let prev_not_space = !i > 0 &&
71
Removed:
(match input.[!i - 1] with ' ' | '\t' | '\n' -> false | _ -> true) in
72
Added:
let prev_not_space =
73
Added:
!i > 0
74
Added:
&& match input.[!i - 1] with ' ' | '\t' | '\n' -> false | _ -> true
75
Added:
in
72
76
if prev_not_space && post_ok && !opens <> [] then begin
73
77
(* This is a closer — match with most recent opener *)
74
78
let open_pos = List.hd !opens in
@@ -85,7 +89,6 @@
85
89
done;
86
90
pairs
87
91
88
Removed:
(** Lexer state. *)
89
92
type state = {
90
93
input : string;
91
94
len : int;
@@ -95,9 +98,13 @@
95
98
under_pairs : (int, [ `Open | `Close ]) Hashtbl.t;
96
99
plus_pairs : (int, [ `Open | `Close ]) Hashtbl.t;
97
100
}
101
Added:
(** Lexer state. *)
98
102
99
103
let create input =
100
Removed:
{ input; len = String.length input; pos = 0;
104
Added:
{
105
Added:
input;
106
Added:
len = String.length input;
107
Added:
pos = 0;
101
108
star_pairs = find_emphasis_pairs input '*';
102
109
slash_pairs = find_emphasis_pairs input '/';
103
110
under_pairs = find_emphasis_pairs input '_';
@@ -131,7 +138,8 @@
131
138
else begin
132
139
let next_pos = st.pos + 1 in
133
140
if next_pos >= st.len then None
134
Removed:
else if not (st.input.[next_pos] >= '0' && st.input.[next_pos] <= '9') then None
141
Added:
else if not (st.input.[next_pos] >= '0' && st.input.[next_pos] <= '9') then
142
Added:
None
135
143
else begin
136
144
let rec find_close i =
137
145
if i >= st.len then None
@@ -142,23 +150,31 @@
142
150
match find_close next_pos with
143
151
| None -> None
144
152
| Some end_pos ->
145
Removed:
let ts = String.sub st.input st.pos (end_pos - st.pos + 1) in
146
Removed:
(* Check for range *)
147
Removed:
let after = end_pos + 1 in
148
Removed:
if after + 2 < st.len && st.input.[after] = '-' && st.input.[after + 1] = '-' then begin
149
Removed:
let range_start = after + 2 in
150
Removed:
if range_start < st.len && st.input.[range_start] = c then
151
Removed:
let next2 = range_start + 1 in
152
Removed:
if next2 < st.len && st.input.[next2] >= '0' && st.input.[next2] <= '9' then
153
Removed:
match find_close next2 with
154
Removed:
| Some end2 ->
155
Removed:
let full = String.sub st.input st.pos (end2 - st.pos + 1) in
156
Removed:
Some (full, end2 + 1)
157
Removed:
| None -> Some (ts, after)
153
Added:
let ts = String.sub st.input st.pos (end_pos - st.pos + 1) in
154
Added:
(* Check for range *)
155
Added:
let after = end_pos + 1 in
156
Added:
if
157
Added:
after + 2 < st.len
158
Added:
&& st.input.[after] = '-'
159
Added:
&& st.input.[after + 1] = '-'
160
Added:
then begin
161
Added:
let range_start = after + 2 in
162
Added:
if range_start < st.len && st.input.[range_start] = c then
163
Added:
let next2 = range_start + 1 in
164
Added:
if
165
Added:
next2 < st.len
166
Added:
&& st.input.[next2] >= '0'
167
Added:
&& st.input.[next2] <= '9'
168
Added:
then
169
Added:
match find_close next2 with
170
Added:
| Some end2 ->
171
Added:
let full = String.sub st.input st.pos (end2 - st.pos + 1) in
172
Added:
Some (full, end2 + 1)
173
Added:
| None -> Some (ts, after)
174
Added:
else Some (ts, after)
158
175
else Some (ts, after)
176
Added:
end
159
177
else Some (ts, after)
160
Removed:
end
161
Removed:
else Some (ts, after)
162
178
end
163
179
end
164
180
@@ -185,34 +201,45 @@
185
201
let rec try_protocols = function
186
202
| [] -> None
187
203
| proto :: rest ->
188
Removed:
if starts_with_at st.input st.pos proto then begin
189
Removed:
let plen = String.length proto in
190
Removed:
let rec find_end i =
191
Removed:
if i >= st.len then i
192
Removed:
else match st.input.[i] with
193
Removed:
| ' ' | '\t' | '\n' | '>' | '<' | ']' -> i
194
Removed:
| _ -> find_end (i + 1)
195
Removed:
in
196
Removed:
let end_pos = find_end (st.pos + plen) in
197
Removed:
let end_pos = ref end_pos in
198
Removed:
while !end_pos > st.pos + plen &&
199
Removed:
(match st.input.[!end_pos - 1] with '.' | ',' | ';' | ':' | '!' | '?' | ')' -> true | _ -> false) do
200
Removed:
decr end_pos
201
Removed:
done;
202
Removed:
if !end_pos > st.pos + plen then
203
Removed:
Some (String.sub st.input st.pos (!end_pos - st.pos), !end_pos)
204
Removed:
else None
205
Removed:
end
206
Removed:
else try_protocols rest
204
Added:
if starts_with_at st.input st.pos proto then begin
205
Added:
let plen = String.length proto in
206
Added:
let rec find_end i =
207
Added:
if i >= st.len then i
208
Added:
else
209
Added:
match st.input.[i] with
210
Added:
| ' ' | '\t' | '\n' | '>' | '<' | ']' -> i
211
Added:
| _ -> find_end (i + 1)
212
Added:
in
213
Added:
let end_pos = find_end (st.pos + plen) in
214
Added:
let end_pos = ref end_pos in
215
Added:
while
216
Added:
!end_pos > st.pos + plen
217
Added:
&&
218
Added:
match st.input.[!end_pos - 1] with
219
Added:
| '.' | ',' | ';' | ':' | '!' | '?' | ')' -> true
220
Added:
| _ -> false
221
Added:
do
222
Added:
decr end_pos
223
Added:
done;
224
Added:
if !end_pos > st.pos + plen then
225
Added:
Some (String.sub st.input st.pos (!end_pos - st.pos), !end_pos)
226
Added:
else None
227
Added:
end
228
Added:
else try_protocols rest
207
229
in
208
230
try_protocols link_protocols
209
231
210
232
(** Try to match a line break: \\\\ at end of line *)
211
233
let try_line_break st =
212
Removed:
if st.pos + 1 < st.len && st.input.[st.pos] = '\\' && st.input.[st.pos + 1] = '\\' then begin
234
Added:
if
235
Added:
st.pos + 1 < st.len
236
Added:
&& st.input.[st.pos] = '\\'
237
Added:
&& st.input.[st.pos + 1] = '\\'
238
Added:
then begin
213
239
let rec skip_space i =
214
240
if i >= st.len then Some i
215
Removed:
else match st.input.[i] with
241
Added:
else
242
Added:
match st.input.[i] with
216
243
| ' ' | '\t' -> skip_space (i + 1)
217
244
| '\n' -> Some (i + 1)
218
245
| _ -> None
@@ -228,112 +255,151 @@
228
255
let c = st.input.[st.pos] in
229
256
(* Try line break *)
230
257
match try_line_break st with
231
Removed:
| Some new_pos -> st.pos <- new_pos; LINE_BREAK
258
Added:
| Some new_pos ->
259
Added:
st.pos <- new_pos;
260
Added:
LINE_BREAK
232
261
| None ->
233
Removed:
(* Try verbatim/code *)
234
Removed:
if c = '~' then
235
Removed:
match try_verbatim_code st '~' with
236
Removed:
| Some (content, new_pos) -> st.pos <- new_pos; TILDE content
237
Removed:
| None -> st.pos <- st.pos + 1; TEXT "~"
238
Removed:
else if c = '=' then
239
Removed:
match try_verbatim_code st '=' with
240
Removed:
| Some (content, new_pos) -> st.pos <- new_pos; EQUALS content
241
Removed:
| None -> st.pos <- st.pos + 1; TEXT "="
242
Removed:
else
243
Removed:
(* Try link brackets *)
244
Removed:
if c = '[' && st.pos + 1 < st.len && st.input.[st.pos + 1] = '[' then begin
245
Removed:
st.pos <- st.pos + 2; LINK_OPEN
246
Removed:
end
247
Removed:
else if c = ']' && st.pos + 1 < st.len && st.input.[st.pos + 1] = ']' then begin
248
Removed:
st.pos <- st.pos + 2; LINK_CLOSE
249
Removed:
end
250
Removed:
else if c = ']' && st.pos + 1 < st.len && st.input.[st.pos + 1] = '[' then begin
251
Removed:
st.pos <- st.pos + 2; LINK_SEP
252
Removed:
end
253
Removed:
else
254
Removed:
(* Try timestamp *)
255
Removed:
if c = '<' || (c = '[' && st.pos + 1 < st.len && st.input.[st.pos + 1] >= '0' && st.input.[st.pos + 1] <= '9') then begin
256
Removed:
match try_timestamp st with
257
Removed:
| Some (ts, new_pos) -> st.pos <- new_pos; TIMESTAMP ts
258
Removed:
| None ->
259
Removed:
if c = '<' then
260
Removed:
match try_angle_link st with
261
Removed:
| Some (content, new_pos) -> st.pos <- new_pos; ANGLE_LINK content
262
Removed:
| None -> st.pos <- st.pos + 1; TEXT "<"
263
Removed:
else begin
264
Removed:
st.pos <- st.pos + 1; TEXT "["
262
Added:
(* Try verbatim/code *)
263
Added:
if c = '~' then (
264
Added:
match try_verbatim_code st '~' with
265
Added:
| Some (content, new_pos) ->
266
Added:
st.pos <- new_pos;
267
Added:
TILDE content
268
Added:
| None ->
269
Added:
st.pos <- st.pos + 1;
270
Added:
TEXT "~")
271
Added:
else if c = '=' then (
272
Added:
match try_verbatim_code st '=' with
273
Added:
| Some (content, new_pos) ->
274
Added:
st.pos <- new_pos;
275
Added:
EQUALS content
276
Added:
| None ->
277
Added:
st.pos <- st.pos + 1;
278
Added:
TEXT "=")
279
Added:
else if
280
Added:
(* Try link brackets *)
281
Added:
c = '[' && st.pos + 1 < st.len && st.input.[st.pos + 1] = '['
282
Added:
then begin
283
Added:
st.pos <- st.pos + 2;
284
Added:
LINK_OPEN
265
285
end
266
Removed:
end
267
Removed:
else
268
Removed:
(* Try plain link *)
269
Removed:
begin match try_plain_link st with
270
Removed:
| Some (link, new_pos) -> st.pos <- new_pos; PLAIN_LINK link
271
Removed:
| None ->
272
Removed:
(* Try emphasis markers — only emit OPEN/CLOSE if pre-scan found a pair *)
273
Removed:
if c = '*' then begin
274
Removed:
let tok =
275
Removed:
match Hashtbl.find_opt st.star_pairs st.pos with
276
Removed:
| Some `Open -> STAR_OPEN
277
Removed:
| Some `Close -> STAR_CLOSE
278
Removed:
| None -> TEXT "*"
279
Removed:
in
280
Removed:
st.pos <- st.pos + 1; tok
281
Removed:
end
282
Removed:
else if c = '/' then begin
283
Removed:
let tok =
284
Removed:
match Hashtbl.find_opt st.slash_pairs st.pos with
285
Removed:
| Some `Open -> SLASH_OPEN
286
Removed:
| Some `Close -> SLASH_CLOSE
287
Removed:
| None -> TEXT "/"
288
Removed:
in
289
Removed:
st.pos <- st.pos + 1; tok
290
Removed:
end
291
Removed:
else if c = '_' then begin
292
Removed:
let tok =
293
Removed:
match Hashtbl.find_opt st.under_pairs st.pos with
294
Removed:
| Some `Open -> UNDER_OPEN
295
Removed:
| Some `Close -> UNDER_CLOSE
296
Removed:
| None -> TEXT "_"
297
Removed:
in
298
Removed:
st.pos <- st.pos + 1; tok
299
Removed:
end
300
Removed:
else if c = '+' then begin
301
Removed:
let tok =
302
Removed:
match Hashtbl.find_opt st.plus_pairs st.pos with
303
Removed:
| Some `Open -> PLUS_OPEN
304
Removed:
| Some `Close -> PLUS_CLOSE
305
Removed:
| None -> TEXT "+"
306
Removed:
in
307
Removed:
st.pos <- st.pos + 1; tok
308
Removed:
end
309
Removed:
else if c = '\n' then begin
310
Removed:
st.pos <- st.pos + 1; NEWLINE
311
Removed:
end
312
Removed:
else begin
313
Removed:
(* Accumulate plain text *)
314
Removed:
let start = st.pos in
315
Removed:
let rec scan i =
316
Removed:
if i >= st.len then i
317
Removed:
else match st.input.[i] with
318
Removed:
| '*' | '/' | '_' | '+' | '~' | '=' | '[' | ']' | '<' | '\n' | '\\' -> i
319
Removed:
| _ ->
320
Removed:
if List.exists (fun proto -> starts_with_at st.input i proto) link_protocols
321
Removed:
then i
322
Removed:
else scan (i + 1)
323
Removed:
in
324
Removed:
let end_pos = scan (start + 1) in
325
Removed:
st.pos <- end_pos;
326
Removed:
TEXT (String.sub st.input start (end_pos - start))
327
Removed:
end
328
Removed:
end
286
Added:
else if c = ']' && st.pos + 1 < st.len && st.input.[st.pos + 1] = ']'
287
Added:
then begin
288
Added:
st.pos <- st.pos + 2;
289
Added:
LINK_CLOSE
290
Added:
end
291
Added:
else if c = ']' && st.pos + 1 < st.len && st.input.[st.pos + 1] = '['
292
Added:
then begin
293
Added:
st.pos <- st.pos + 2;
294
Added:
LINK_SEP
295
Added:
end
296
Added:
else if
297
Added:
(* Try timestamp *)
298
Added:
c = '<'
299
Added:
|| c = '['
300
Added:
&& st.pos + 1 < st.len
301
Added:
&& st.input.[st.pos + 1] >= '0'
302
Added:
&& st.input.[st.pos + 1] <= '9'
303
Added:
then
304
Added:
begin match try_timestamp st with
305
Added:
| Some (ts, new_pos) ->
306
Added:
st.pos <- new_pos;
307
Added:
TIMESTAMP ts
308
Added:
| None ->
309
Added:
if c = '<' then (
310
Added:
match try_angle_link st with
311
Added:
| Some (content, new_pos) ->
312
Added:
st.pos <- new_pos;
313
Added:
ANGLE_LINK content
314
Added:
| None ->
315
Added:
st.pos <- st.pos + 1;
316
Added:
TEXT "<")
317
Added:
else begin
318
Added:
st.pos <- st.pos + 1;
319
Added:
TEXT "["
320
Added:
end
321
Added:
end
322
Added:
else
323
Added:
(* Try plain link *)
324
Added:
begin match try_plain_link st with
325
Added:
| Some (link, new_pos) ->
326
Added:
st.pos <- new_pos;
327
Added:
PLAIN_LINK link
328
Added:
| None ->
329
Added:
(* Try emphasis markers — only emit OPEN/CLOSE if pre-scan found a pair *)
330
Added:
if c = '*' then begin
331
Added:
let tok =
332
Added:
match Hashtbl.find_opt st.star_pairs st.pos with
333
Added:
| Some `Open -> STAR_OPEN
334
Added:
| Some `Close -> STAR_CLOSE
335
Added:
| None -> TEXT "*"
336
Added:
in
337
Added:
st.pos <- st.pos + 1;
338
Added:
tok
339
Added:
end
340
Added:
else if c = '/' then begin
341
Added:
let tok =
342
Added:
match Hashtbl.find_opt st.slash_pairs st.pos with
343
Added:
| Some `Open -> SLASH_OPEN
344
Added:
| Some `Close -> SLASH_CLOSE
345
Added:
| None -> TEXT "/"
346
Added:
in
347
Added:
st.pos <- st.pos + 1;
348
Added:
tok
349
Added:
end
350
Added:
else if c = '_' then begin
351
Added:
let tok =
352
Added:
match Hashtbl.find_opt st.under_pairs st.pos with
353
Added:
| Some `Open -> UNDER_OPEN
354
Added:
| Some `Close -> UNDER_CLOSE
355
Added:
| None -> TEXT "_"
356
Added:
in
357
Added:
st.pos <- st.pos + 1;
358
Added:
tok
359
Added:
end
360
Added:
else if c = '+' then begin
361
Added:
let tok =
362
Added:
match Hashtbl.find_opt st.plus_pairs st.pos with
363
Added:
| Some `Open -> PLUS_OPEN
364
Added:
| Some `Close -> PLUS_CLOSE
365
Added:
| None -> TEXT "+"
366
Added:
in
367
Added:
st.pos <- st.pos + 1;
368
Added:
tok
369
Added:
end
370
Added:
else if c = '\n' then begin
371
Added:
st.pos <- st.pos + 1;
372
Added:
NEWLINE
373
Added:
end
374
Added:
else begin
375
Added:
(* Accumulate plain text *)
376
Added:
let start = st.pos in
377
Added:
let rec scan i =
378
Added:
if i >= st.len then i
379
Added:
else
380
Added:
match st.input.[i] with
381
Added:
| '*' | '/' | '_' | '+' | '~' | '=' | '[' | ']' | '<' | '\n'
382
Added:
| '\\' ->
383
Added:
i
384
Added:
| _ ->
385
Added:
if
386
Added:
List.exists
387
Added:
(fun proto -> starts_with_at st.input i proto)
388
Added:
link_protocols
389
Added:
then i
390
Added:
else scan (i + 1)
391
Added:
in
392
Added:
let end_pos = scan (start + 1) in
393
Added:
st.pos <- end_pos;
394
Added:
TEXT (String.sub st.input start (end_pos - start))
395
Added:
end
396
Added:
end
329
397
330
398
(** Tokenize an entire string into a list of tokens. *)
331
399
let tokenize input =
332
400
let st = create input in
333
401
let rec loop acc =
334
402
let tok = next_token st in
335
Removed:
match tok with
336
Removed:
| EOF -> List.rev (EOF :: acc)
337
Removed:
| _ -> loop (tok :: acc)
403
Added:
match tok with EOF -> List.rev (EOF :: acc) | _ -> loop (tok :: acc)
338
404
in
339
405
loop []
lib/lexer.ml
@@ -1,15 +1,13 @@
1
1
(** Handwritten structural line lexer.
2
2
3
Removed:
Classifies physical lines into high-level structural tokens
4
Removed:
that the Menhir grammar will consume. The lexer is context-aware:
5
Removed:
it knows the TODO keywords from the pre-scan to assist heading
6
Removed:
classification (though heading title parsing is deferred to
7
Removed:
normalization).
3
Added:
Classifies physical lines into high-level structural tokens that the Menhir
4
Added:
grammar will consume. The lexer is context-aware: it knows the TODO keywords
5
Added:
from the pre-scan to assist heading classification (though heading title
6
Added:
parsing is deferred to normalization).
8
7
9
Removed:
The lexer operates line-by-line. Each call to [next_token]
10
Removed:
returns the classification of the next line. *)
8
Added:
The lexer operates line-by-line. Each call to [next_token] returns the
9
Added:
classification of the next line. *)
11
10
12
Removed:
(** A raw list item token payload. *)
13
11
type list_item_data = {
14
12
lid_indent : int;
15
13
lid_bullet : string; (** The bullet text including trailing space *)
@@ -17,13 +15,15 @@
17
15
lid_checkbox : string option; (** "[ ]", "[X]", "[-]" *)
18
16
lid_rest : string; (** Remainder of line after bullet/checkbox *)
19
17
}
18
Added:
(** A raw list item token payload. *)
20
19
21
20
(** Structural tokens produced by the lexer. *)
22
21
type token =
23
22
| Blank
24
23
| Heading of int * string (** level, rest of line *)
25
24
| Keyword of string * string (** key (uppercase), value *)
26
Removed:
| Affiliated_keyword of string * string option * string (** name, optional, value *)
25
Added:
| Affiliated_keyword of string * string option * string
26
Added:
(** name, optional, value *)
27
27
| Begin_block of string * string option (** name (lowercase), params *)
28
28
| End_block of string (** name (lowercase) *)
29
29
| Drawer_begin of string (** name *)
@@ -38,13 +38,13 @@
38
38
| Text_line of string (** anything else *)
39
39
| Eof
40
40
41
Removed:
(** Lexer state. *)
42
41
type state = {
43
42
lines : string array;
44
43
mutable line_idx : int;
45
44
mutable line_number : int; (** 1-based line number *)
46
45
config : Config.t;
47
46
}
47
Added:
(** Lexer state. *)
48
48
49
49
(** Create a new lexer state from input text. *)
50
50
let create ~config input =
@@ -94,27 +94,27 @@
94
94
else
95
95
let c1 = Char.lowercase_ascii s.[pos + i] in
96
96
let c2 = Char.lowercase_ascii prefix.[i] in
97
Removed:
if c1 <> c2 then false
98
Removed:
else loop (i + 1)
97
Added:
if c1 <> c2 then false else loop (i + 1)
99
98
in
100
99
loop 0
101
100
102
101
let rstrip = String_util.rstrip
103
102
104
103
(** Affiliated keyword names per Org spec defaults. *)
105
Removed:
let affiliated_keywords = [ "CAPTION"; "DATA"; "HEADER"; "HEADERS"; "NAME"; "PLOT"; "RESULTS" ]
104
Added:
let affiliated_keywords =
105
Added:
[ "CAPTION"; "DATA"; "HEADER"; "HEADERS"; "NAME"; "PLOT"; "RESULTS" ]
106
106
107
107
let attr_prefix = "ATTR_"
108
108
109
Removed:
(** Check if a keyword key is an affiliated keyword.
110
Removed:
Affiliated keywords: CAPTION, DATA, HEADER, HEADERS, NAME, PLOT, RESULTS, ATTR_* *)
109
Added:
(** Check if a keyword key is an affiliated keyword. Affiliated keywords:
110
Added:
CAPTION, DATA, HEADER, HEADERS, NAME, PLOT, RESULTS, ATTR_* *)
111
111
let is_affiliated_key key =
112
112
let ukey = String.uppercase_ascii key in
113
113
List.mem ukey affiliated_keywords
114
114
|| (String.length ukey > 5 && String.sub ukey 0 5 = attr_prefix)
115
115
116
Removed:
(** Try to classify a line as a keyword: #+KEY: VALUE
117
Removed:
Returns Some (key, value) or None. *)
116
Added:
(** Try to classify a line as a keyword: #+KEY: VALUE Returns Some (key, value)
117
Added:
or None. *)
118
118
let try_keyword line start =
119
119
let len = String.length line in
120
120
if start + 1 >= len || line.[start] <> '#' || line.[start + 1] <> '+' then
@@ -125,26 +125,27 @@
125
125
let rec find_colon i =
126
126
if i >= len then None
127
127
else if line.[i] = ':' then Some i
128
Removed:
else if line.[i] = ' ' || line.[i] = '\t' then None (* space before colon = not keyword *)
128
Added:
else if line.[i] = ' ' || line.[i] = '\t' then
129
Added:
None (* space before colon = not keyword *)
129
130
else find_colon (i + 1)
130
131
in
131
132
match find_colon rest_start with
132
133
| None -> None
133
134
| Some colon_pos ->
134
Removed:
let key = String.sub line rest_start (colon_pos - rest_start) in
135
Removed:
let value =
136
Removed:
if colon_pos + 1 < len then
137
Removed:
let v = String.sub line (colon_pos + 1) (len - colon_pos - 1) in
138
Removed:
(* Strip leading space from value *)
139
Removed:
if String.length v > 0 && v.[0] = ' ' then
140
Removed:
String.sub v 1 (String.length v - 1)
141
Removed:
else v
142
Removed:
else ""
143
Removed:
in
144
Removed:
Some (key, rstrip value)
135
Added:
let key = String.sub line rest_start (colon_pos - rest_start) in
136
Added:
let value =
137
Added:
if colon_pos + 1 < len then
138
Added:
let v = String.sub line (colon_pos + 1) (len - colon_pos - 1) in
139
Added:
(* Strip leading space from value *)
140
Added:
if String.length v > 0 && v.[0] = ' ' then
141
Added:
String.sub v 1 (String.length v - 1)
142
Added:
else v
143
Added:
else ""
144
Added:
in
145
Added:
Some (key, rstrip value)
145
146
146
Removed:
(** Try to parse a #+begin_NAME line.
147
Removed:
Returns Some (name_lowercase, params_option) or None. *)
147
Added:
(** Try to parse a #+begin_NAME line. Returns Some (name_lowercase,
148
Added:
params_option) or None. *)
148
149
let try_begin_block line start =
149
150
let len = String.length line in
150
151
if not (starts_at_ci line start "#+begin_") then None
@@ -157,15 +158,20 @@
157
158
else find_end (i + 1)
158
159
in
159
160
let name_end = find_end name_start in
160
Removed:
if name_end = name_start then None (* empty name *)
161
Added:
if name_end = name_start then None (* empty name *)
161
162
else
162
Removed:
let name = String.lowercase_ascii (String.sub line name_start (name_end - name_start)) in
163
Added:
let name =
164
Added:
String.lowercase_ascii
165
Added:
(String.sub line name_start (name_end - name_start))
166
Added:
in
163
167
let params =
164
168
if name_end < len then
165
169
let p = rstrip (String.sub line name_end (len - name_end)) in
166
Removed:
let p = if String.length p > 0 && p.[0] = ' ' then
167
Removed:
String.sub p 1 (String.length p - 1)
168
Removed:
else p in
170
Added:
let p =
171
Added:
if String.length p > 0 && p.[0] = ' ' then
172
Added:
String.sub p 1 (String.length p - 1)
173
Added:
else p
174
Added:
in
169
175
if String.length p > 0 then Some p else None
170
176
else None
171
177
in
@@ -185,7 +191,9 @@
185
191
let name_end = find_end name_start in
186
192
if name_end = name_start then None
187
193
else
188
Removed:
Some (String.lowercase_ascii (String.sub line name_start (name_end - name_start)))
194
Added:
Some
195
Added:
(String.lowercase_ascii
196
Added:
(String.sub line name_start (name_end - name_start)))
189
197
190
198
(** Try to parse a drawer begin line: :NAME: *)
191
199
let try_drawer_begin line start =
@@ -198,27 +206,28 @@
198
206
else if line.[i] = ':' then
199
207
(* Check rest is blank *)
200
208
let rest = rstrip (String.sub line (i + 1) (len - i - 1)) in
201
Removed:
if String.length rest = 0 then Some i
202
Removed:
else None
203
Removed:
else if (line.[i] >= 'a' && line.[i] <= 'z')
204
Removed:
|| (line.[i] >= 'A' && line.[i] <= 'Z')
205
Removed:
|| (line.[i] >= '0' && line.[i] <= '9')
206
Removed:
|| line.[i] = '-' || line.[i] = '_' then
207
Removed:
find_end (i + 1)
209
Added:
if String.length rest = 0 then Some i else None
210
Added:
else if
211
Added:
(line.[i] >= 'a' && line.[i] <= 'z')
212
Added:
|| (line.[i] >= 'A' && line.[i] <= 'Z')
213
Added:
|| (line.[i] >= '0' && line.[i] <= '9')
214
Added:
|| line.[i] = '-'
215
Added:
|| line.[i] = '_'
216
Added:
then find_end (i + 1)
208
217
else None
209
218
in
210
219
match find_end (start + 1) with
211
220
| None -> None
212
221
| Some end_pos ->
213
Removed:
let name = String.sub line (start + 1) (end_pos - start - 1) in
214
Removed:
if String.length name = 0 then None
215
Removed:
else Some name
222
Added:
let name = String.sub line (start + 1) (end_pos - start - 1) in
223
Added:
if String.length name = 0 then None else Some name
216
224
217
225
(** Check if a line is :end: (drawer end). *)
218
226
let is_drawer_end line start =
219
227
starts_at_ci line start ":end:"
220
Removed:
&& (let rest = String.sub line (start + 5) (String.length line - start - 5) in
221
Removed:
is_blank_line rest)
228
Added:
&&
229
Added:
let rest = String.sub line (start + 5) (String.length line - start - 5) in
230
Added:
is_blank_line rest
222
231
223
232
(** Check if a line is a property: :NAME: VALUE or :NAME+: VALUE *)
224
233
let try_property line start =
@@ -228,33 +237,40 @@
228
237
let rec find_colon i =
229
238
if i >= len then None
230
239
else if line.[i] = ':' then Some i
231
Removed:
else if (line.[i] >= 'a' && line.[i] <= 'z')
232
Removed:
|| (line.[i] >= 'A' && line.[i] <= 'Z')
233
Removed:
|| (line.[i] >= '0' && line.[i] <= '9')
234
Removed:
|| line.[i] = '-' || line.[i] = '_' || line.[i] = '+' then
235
Removed:
find_colon (i + 1)
240
Added:
else if
241
Added:
(line.[i] >= 'a' && line.[i] <= 'z')
242
Added:
|| (line.[i] >= 'A' && line.[i] <= 'Z')
243
Added:
|| (line.[i] >= '0' && line.[i] <= '9')
244
Added:
|| line.[i] = '-'
245
Added:
|| line.[i] = '_'
246
Added:
|| line.[i] = '+'
247
Added:
then find_colon (i + 1)
236
248
else None
237
249
in
238
250
match find_colon (start + 1) with
239
251
| None -> None
240
252
| Some colon_pos ->
241
Removed:
let name = String.sub line (start + 1) (colon_pos - start - 1) in
242
Removed:
if String.length name = 0 then None
243
Removed:
else
244
Removed:
let value_start = colon_pos + 1 in
245
Removed:
let value =
246
Removed:
if value_start < len then
247
Removed:
let v = rstrip (String.sub line value_start (len - value_start)) in
248
Removed:
let v = if String.length v > 0 && v.[0] = ' ' then
249
Removed:
String.sub v 1 (String.length v - 1) else v in
250
Removed:
if String.length v > 0 then Some v else None
251
Removed:
else None
252
Removed:
in
253
Removed:
Some (name, value)
253
Added:
let name = String.sub line (start + 1) (colon_pos - start - 1) in
254
Added:
if String.length name = 0 then None
255
Added:
else
256
Added:
let value_start = colon_pos + 1 in
257
Added:
let value =
258
Added:
if value_start < len then
259
Added:
let v =
260
Added:
rstrip (String.sub line value_start (len - value_start))
261
Added:
in
262
Added:
let v =
263
Added:
if String.length v > 0 && v.[0] = ' ' then
264
Added:
String.sub v 1 (String.length v - 1)
265
Added:
else v
266
Added:
in
267
Added:
if String.length v > 0 then Some v else None
268
Added:
else None
269
Added:
in
270
Added:
Some (name, value)
254
271
255
Removed:
(** Try to classify a line as a list item.
256
Removed:
List items start with: - item, + item, * item (not at column 0),
257
Removed:
1. item, 1) item, a. item, a) item *)
272
Added:
(** Try to classify a line as a list item. List items start with: - item, +
273
Added:
item, * item (not at column 0), 1. item, 1) item, a. item, a) item *)
258
274
let try_list_item line =
259
275
let len = String.length line in
260
276
let indent = leading_indent line in
@@ -270,7 +286,8 @@
270
286
pos := !pos + 2;
271
287
Some (String.make 1 c ^ " ")
272
288
end
273
Removed:
else if c = '*' && indent > 0 && !pos + 1 < len && line.[!pos + 1] = ' ' then begin
289
Added:
else if c = '*' && indent > 0 && !pos + 1 < len && line.[!pos + 1] = ' '
290
Added:
then begin
274
291
(* * at column >0 is a list bullet; at column 0 it's a heading *)
275
292
pos := !pos + 2;
276
293
Some "* "
@@ -281,15 +298,25 @@
281
298
let rec scan_digits i =
282
299
if i >= len then None
283
300
else if line.[i] >= '0' && line.[i] <= '9' then scan_digits (i + 1)
284
Removed:
else if (i > start) && (line.[i] = '.' || line.[i] = ')')
285
Removed:
&& i + 1 < len && line.[i + 1] = ' ' then begin
301
Added:
else if
302
Added:
i > start
303
Added:
&& (line.[i] = '.' || line.[i] = ')')
304
Added:
&& i + 1 < len
305
Added:
&& line.[i + 1] = ' '
306
Added:
then begin
286
307
let bullet_text = String.sub line start (i - start + 1) ^ " " in
287
308
pos := i + 2;
288
309
Some bullet_text
289
310
end
290
Removed:
else if (i = start) && (line.[i] >= 'a' && line.[i] <= 'z' || line.[i] >= 'A' && line.[i] <= 'Z')
291
Removed:
&& i + 1 < len && (line.[i + 1] = '.' || line.[i + 1] = ')')
292
Removed:
&& i + 2 < len && line.[i + 2] = ' ' then begin
311
Added:
else if
312
Added:
i = start
313
Added:
&& ((line.[i] >= 'a' && line.[i] <= 'z')
314
Added:
|| (line.[i] >= 'A' && line.[i] <= 'Z'))
315
Added:
&& i + 1 < len
316
Added:
&& (line.[i + 1] = '.' || line.[i + 1] = ')')
317
Added:
&& i + 2 < len
318
Added:
&& line.[i + 2] = ' '
319
Added:
then begin
293
320
let bullet_text = String.sub line start 2 ^ " " in
294
321
pos := i + 3;
295
322
Some bullet_text
@@ -302,46 +329,54 @@
302
329
match bullet_result with
303
330
| None -> None
304
331
| Some bullet ->
305
Removed:
(* Check for counter set: [@N] *)
306
Removed:
let counter_set =
307
Removed:
if !pos + 2 < len && line.[!pos] = '[' && line.[!pos + 1] = '@' then begin
308
Removed:
let start = !pos + 2 in
309
Removed:
let rec find_bracket i =
310
Removed:
if i >= len then None
311
Removed:
else if line.[i] = ']' then
312
Removed:
let num_str = String.sub line start (i - start) in
313
Removed:
(try
314
Removed:
pos := i + 1;
315
Removed:
if !pos < len && line.[!pos] = ' ' then incr pos;
316
Removed:
Some (int_of_string num_str)
317
Removed:
with Failure _ -> None)
318
Removed:
else find_bracket (i + 1)
319
Removed:
in
320
Removed:
find_bracket start
321
Removed:
end
322
Removed:
else None
323
Removed:
in
324
Removed:
(* Check for checkbox: [ ], [X], [-] *)
325
Removed:
let checkbox =
326
Removed:
if !pos + 2 < len && line.[!pos] = '['
327
Removed:
&& (line.[!pos + 1] = ' ' || line.[!pos + 1] = 'X' || line.[!pos + 1] = 'x'
332
Added:
(* Check for counter set: [@N] *)
333
Added:
let counter_set =
334
Added:
if !pos + 2 < len && line.[!pos] = '[' && line.[!pos + 1] = '@' then begin
335
Added:
let start = !pos + 2 in
336
Added:
let rec find_bracket i =
337
Added:
if i >= len then None
338
Added:
else if line.[i] = ']' then
339
Added:
let num_str = String.sub line start (i - start) in
340
Added:
try
341
Added:
pos := i + 1;
342
Added:
if !pos < len && line.[!pos] = ' ' then incr pos;
343
Added:
Some (int_of_string num_str)
344
Added:
with Failure _ -> None
345
Added:
else find_bracket (i + 1)
346
Added:
in
347
Added:
find_bracket start
348
Added:
end
349
Added:
else None
350
Added:
in
351
Added:
(* Check for checkbox: [ ], [X], [-] *)
352
Added:
let checkbox =
353
Added:
if
354
Added:
!pos + 2 < len
355
Added:
&& line.[!pos] = '['
356
Added:
&& (line.[!pos + 1] = ' '
357
Added:
|| line.[!pos + 1] = 'X'
358
Added:
|| line.[!pos + 1] = 'x'
328
359
|| line.[!pos + 1] = '-')
329
Removed:
&& line.[!pos + 2] = ']' then begin
330
Removed:
let cb = String.sub line !pos 3 in
331
Removed:
pos := !pos + 3;
332
Removed:
if !pos < len && line.[!pos] = ' ' then incr pos;
333
Removed:
Some cb
334
Removed:
end
335
Removed:
else None
336
Removed:
in
337
Removed:
let rest = if !pos < len then String.sub line !pos (len - !pos) else "" in
338
Removed:
Some {
339
Removed:
lid_indent = indent;
340
Removed:
lid_bullet = bullet;
341
Removed:
lid_counter_set = counter_set;
342
Removed:
lid_checkbox = checkbox;
343
Removed:
lid_rest = rstrip rest;
344
Removed:
}
360
Added:
&& line.[!pos + 2] = ']'
361
Added:
then begin
362
Added:
let cb = String.sub line !pos 3 in
363
Added:
pos := !pos + 3;
364
Added:
if !pos < len && line.[!pos] = ' ' then incr pos;
365
Added:
Some cb
366
Added:
end
367
Added:
else None
368
Added:
in
369
Added:
let rest =
370
Added:
if !pos < len then String.sub line !pos (len - !pos) else ""
371
Added:
in
372
Added:
Some
373
Added:
{
374
Added:
lid_indent = indent;
375
Added:
lid_bullet = bullet;
376
Added:
lid_counter_set = counter_set;
377
Added:
lid_checkbox = checkbox;
378
Added:
lid_rest = rstrip rest;
379
Added:
}
345
380
346
381
(** Check if a line is a horizontal rule: 5+ hyphens, nothing else. *)
347
382
let is_horizontal_rule line start =
@@ -357,15 +392,15 @@
357
392
in
358
393
count start >= 5
359
394
360
Removed:
(** Check if a line is a planning line (starts with DEADLINE:, SCHEDULED:, or CLOSED:). *)
395
Added:
(** Check if a line is a planning line (starts with DEADLINE:, SCHEDULED:, or
396
Added:
CLOSED:). *)
361
397
let is_planning_line line start =
362
Removed:
starts_at line start "DEADLINE:" ||
363
Removed:
starts_at line start "SCHEDULED:" ||
364
Removed:
starts_at line start "CLOSED:"
398
Added:
starts_at line start "DEADLINE:"
399
Added:
|| starts_at line start "SCHEDULED:"
400
Added:
|| starts_at line start "CLOSED:"
365
401
366
402
(** Check if a line is a table row (starts with |). *)
367
Removed:
let is_table_row line start =
368
Removed:
start < String.length line && line.[start] = '|'
403
Added:
let is_table_row line start = start < String.length line && line.[start] = '|'
369
404
370
405
(** Check if a line is a comment: # followed by space or end of line. *)
371
406
let try_comment_line line start =
@@ -374,8 +409,8 @@
374
409
else if start + 1 >= len then Some ""
375
410
else if line.[start + 1] = ' ' then
376
411
Some (rstrip (String.sub line (start + 2) (len - start - 2)))
377
Removed:
else if line.[start + 1] = '+' then None (* keyword, not comment *)
378
Removed:
else None (* # followed by non-space non-+ is not a comment *)
412
Added:
else if line.[start + 1] = '+' then None (* keyword, not comment *)
413
Added:
else None (* # followed by non-space non-+ is not a comment *)
379
414
380
415
(** Check if a line is fixed-width: ": " or ":" at end of line. *)
381
416
let try_fixed_width line start =
@@ -386,20 +421,19 @@
386
421
Some (rstrip (String.sub line (start + 2) (len - start - 2)))
387
422
else None
388
423
389
Removed:
(** Check if a line is a heading: starts with one or more * followed by space. *)
424
Added:
(** Check if a line is a heading: starts with one or more * followed by space.
425
Added:
*)
390
426
let try_heading line =
391
427
let len = String.length line in
392
428
if len = 0 || line.[0] <> '*' then None
393
429
else
394
430
let rec count_stars i =
395
Removed:
if i >= len then i
396
Removed:
else if line.[i] = '*' then count_stars (i + 1)
397
Removed:
else i
431
Added:
if i >= len then i else if line.[i] = '*' then count_stars (i + 1) else i
398
432
in
399
433
let stars = count_stars 0 in
400
434
if stars >= len then
401
435
(* Line is all stars with no space — it's a heading with empty title *)
402
Removed:
None (* Actually per spec, space after stars is mandatory *)
436
Added:
None (* Actually per spec, space after stars is mandatory *)
403
437
else if line.[stars] = ' ' then
404
438
let rest = String.sub line (stars + 1) (len - stars - 1) in
405
439
Some (stars, rstrip rest)
@@ -413,82 +447,85 @@
413
447
let indent = leading_indent line in
414
448
let start = indent in
415
449
(* Headings must be at column 0 *)
416
Removed:
if indent = 0 then begin
417
Removed:
match try_heading line with
450
Added:
if indent = 0 then
451
Added:
begin match try_heading line with
418
452
| Some (level, rest) -> Heading (level, rest)
419
Removed:
| None ->
420
Removed:
(* Try keyword/block *)
421
Removed:
match try_begin_block line start with
422
Removed:
| Some (name, params) -> Begin_block (name, params)
423
Removed:
| None ->
424
Removed:
match try_end_block line start with
425
Removed:
| Some name -> End_block name
426
Removed:
| None ->
427
Removed:
match try_keyword line start with
428
Removed:
| Some (key, value) ->
429
Removed:
if is_affiliated_key key then
430
Removed:
(* Check for optional value: #+KEY[OPTVAL]: VALUE *)
431
Removed:
Affiliated_keyword (String.uppercase_ascii key, None, value)
432
Removed:
else
433
Removed:
Keyword (String.uppercase_ascii key, value)
434
Removed:
| None ->
435
Removed:
if is_drawer_end line start then Drawer_end
436
Removed:
else
437
Removed:
match try_drawer_begin line start with
438
Removed:
| Some name -> Drawer_begin name
439
Removed:
| None ->
440
Removed:
match try_property line start with
441
Removed:
| Some (name, value) -> Property (name, value)
442
Removed:
| None ->
443
Removed:
if is_horizontal_rule line start then Horizontal_rule
444
Removed:
else if is_planning_line line start then Planning line
445
Removed:
else if is_table_row line start then Table_row line
446
Removed:
else
447
Removed:
match try_comment_line line start with
448
Removed:
| Some content -> Comment_line content
449
Removed:
| None ->
450
Removed:
match try_fixed_width line start with
451
Removed:
| Some content -> Fixed_width content
452
Removed:
| None ->
453
Removed:
match try_list_item line with
454
Removed:
| Some data -> List_item data
455
Removed:
| None -> Text_line line
456
Removed:
end
457
Removed:
else begin
453
Added:
| None -> (
454
Added:
(* Try keyword/block *)
455
Added:
match try_begin_block line start with
456
Added:
| Some (name, params) -> Begin_block (name, params)
457
Added:
| None -> (
458
Added:
match try_end_block line start with
459
Added:
| Some name -> End_block name
460
Added:
| None -> (
461
Added:
match try_keyword line start with
462
Added:
| Some (key, value) ->
463
Added:
if is_affiliated_key key then
464
Added:
(* Check for optional value: #+KEY[OPTVAL]: VALUE *)
465
Added:
Affiliated_keyword
466
Added:
(String.uppercase_ascii key, None, value)
467
Added:
else Keyword (String.uppercase_ascii key, value)
468
Added:
| None -> (
469
Added:
if is_drawer_end line start then Drawer_end
470
Added:
else
471
Added:
match try_drawer_begin line start with
472
Added:
| Some name -> Drawer_begin name
473
Added:
| None -> (
474
Added:
match try_property line start with
475
Added:
| Some (name, value) -> Property (name, value)
476
Added:
| None -> (
477
Added:
if is_horizontal_rule line start then
478
Added:
Horizontal_rule
479
Added:
else if is_planning_line line start then
480
Added:
Planning line
481
Added:
else if is_table_row line start then
482
Added:
Table_row line
483
Added:
else
484
Added:
match try_comment_line line start with
485
Added:
| Some content -> Comment_line content
486
Added:
| None -> (
487
Added:
match try_fixed_width line start with
488
Added:
| Some content -> Fixed_width content
489
Added:
| None -> (
490
Added:
match try_list_item line with
491
Added:
| Some data -> List_item data
492
Added:
| None -> Text_line line))))))))
493
Added:
end
494
Added:
else
458
495
(* Indented lines *)
459
Removed:
if is_planning_line line start then Planning line
496
Added:
begin if is_planning_line line start then Planning line
460
497
else if is_table_row line start then Table_row line
461
498
else if is_drawer_end line start then Drawer_end
462
499
else
463
500
match try_drawer_begin line start with
464
501
| Some name -> Drawer_begin name
465
Removed:
| None ->
466
Removed:
match try_begin_block line start with
467
Removed:
| Some (name, params) -> Begin_block (name, params)
468
Removed:
| None ->
469
Removed:
match try_end_block line start with
470
Removed:
| Some name -> End_block name
471
Removed:
| None ->
472
Removed:
match try_keyword line start with
473
Removed:
| Some (key, value) ->
474
Removed:
if is_affiliated_key key then
475
Removed:
Affiliated_keyword (String.uppercase_ascii key, None, value)
476
Removed:
else
477
Removed:
Keyword (String.uppercase_ascii key, value)
478
Removed:
| None ->
479
Removed:
match try_property line start with
480
Removed:
| Some (name, value) -> Property (name, value)
481
Removed:
| None ->
482
Removed:
match try_comment_line line start with
483
Removed:
| Some content -> Comment_line content
484
Removed:
| None ->
485
Removed:
match try_fixed_width line start with
486
Removed:
| Some content -> Fixed_width content
487
Removed:
| None ->
488
Removed:
match try_list_item line with
489
Removed:
| Some data -> List_item data
490
Removed:
| None -> Text_line line
491
Removed:
end
502
Added:
| None -> (
503
Added:
match try_begin_block line start with
504
Added:
| Some (name, params) -> Begin_block (name, params)
505
Added:
| None -> (
506
Added:
match try_end_block line start with
507
Added:
| Some name -> End_block name
508
Added:
| None -> (
509
Added:
match try_keyword line start with
510
Added:
| Some (key, value) ->
511
Added:
if is_affiliated_key key then
512
Added:
Affiliated_keyword
513
Added:
(String.uppercase_ascii key, None, value)
514
Added:
else Keyword (String.uppercase_ascii key, value)
515
Added:
| None -> (
516
Added:
match try_property line start with
517
Added:
| Some (name, value) -> Property (name, value)
518
Added:
| None -> (
519
Added:
match try_comment_line line start with
520
Added:
| Some content -> Comment_line content
521
Added:
| None -> (
522
Added:
match try_fixed_width line start with
523
Added:
| Some content -> Fixed_width content
524
Added:
| None -> (
525
Added:
match try_list_item line with
526
Added:
| Some data -> List_item data
527
Added:
| None -> Text_line line)))))))
528
Added:
end
492
529
493
530
(** Get the next token from the lexer. *)
494
531
let next_token st =
@@ -500,8 +537,8 @@
500
537
classify_line st line
501
538
end
502
539
503
Removed:
(** Tokenize the entire input into a list of (token, line_number) pairs.
504
Removed:
Useful for testing and for feeding Menhir. *)
540
Added:
(** Tokenize the entire input into a list of (token, line_number) pairs. Useful
541
Added:
for testing and for feeding Menhir. *)
505
542
let tokenize ~config input =
506
543
let st = create ~config input in
507
544
let rec loop acc =
lib/normalize.ml
@@ -1,7 +1,7 @@
1
1
(** Raw_ast to Ast normalization.
2
2
3
Removed:
Transforms the flat [Raw_ast.document] produced by the structural
4
Removed:
parser into the semantic [Ast.document] tree. This includes:
3
Added:
Transforms the flat [Raw_ast.document] produced by the structural parser
4
Added:
into the semantic [Ast.document] tree. This includes:
5
5
- building heading hierarchy from flat headings
6
6
- parsing heading titles for TODO/priority/tags/COMMENT
7
7
- inline parsing of text fields
@@ -31,8 +31,8 @@
31
31
(* Heading title parsing *)
32
32
(* ------------------------------------------------------------------ *)
33
33
34
Removed:
(** Parse tags from the end of a heading title.
35
Removed:
Tags look like :tag1:tag2: at the end of the line. *)
34
Added:
(** Parse tags from the end of a heading title. Tags look like :tag1:tag2: at
35
Added:
the end of the line. *)
36
36
let extract_tags title =
37
37
let title = trim title in
38
38
let len = String.length title in
@@ -48,63 +48,61 @@
48
48
in
49
49
match find_tag_start (len - 2) with
50
50
| None ->
51
Removed:
(* Check if the whole title is a tag string *)
52
Removed:
if title.[0] = ':' then
53
Removed:
let tag_str = String.sub title 1 (len - 2) in
51
Added:
(* Check if the whole title is a tag string *)
52
Added:
if title.[0] = ':' then
53
Added:
let tag_str = String.sub title 1 (len - 2) in
54
Added:
let tags = String.split_on_char ':' tag_str in
55
Added:
if List.for_all (fun t -> String.length t > 0) tags then ("", tags)
56
Added:
else (title, [])
57
Added:
else (title, [])
58
Added:
| Some tag_start ->
59
Added:
let tag_str = String.sub title (tag_start + 1) (len - tag_start - 2) in
54
60
let tags = String.split_on_char ':' tag_str in
55
61
if List.for_all (fun t -> String.length t > 0) tags then
56
Removed:
("", tags)
62
Added:
let title_part = trim (String.sub title 0 tag_start) in
63
Added:
(title_part, tags)
57
64
else (title, [])
58
Removed:
else (title, [])
59
Removed:
| Some tag_start ->
60
Removed:
let tag_str = String.sub title (tag_start + 1) (len - tag_start - 2) in
61
Removed:
let tags = String.split_on_char ':' tag_str in
62
Removed:
if List.for_all (fun t -> String.length t > 0) tags then
63
Removed:
let title_part = trim (String.sub title 0 tag_start) in
64
Removed:
(title_part, tags)
65
Removed:
else (title, [])
66
65
end
67
66
68
Removed:
(** Parse priority from the beginning of a heading title.
69
Removed:
Priority looks like [#A] at the start. *)
67
Added:
(** Parse priority from the beginning of a heading title. Priority looks like
68
Added:
[#A] at the start. *)
70
69
let extract_priority title =
71
70
let title = trim title in
72
Removed:
if String.length title >= 4
73
Removed:
&& title.[0] = '['
74
Removed:
&& title.[1] = '#'
75
Removed:
&& title.[3] = ']'
76
Removed:
&& (title.[2] >= 'A' && title.[2] <= 'Z') then
71
Added:
if
72
Added:
String.length title >= 4
73
Added:
&& title.[0] = '['
74
Added:
&& title.[1] = '#'
75
Added:
&& title.[3] = ']'
76
Added:
&& title.[2] >= 'A'
77
Added:
&& title.[2] <= 'Z'
78
Added:
then
77
79
let rest = trim (String.sub title 4 (String.length title - 4)) in
78
80
(Some title.[2], rest)
79
Removed:
else
80
Removed:
(None, title)
81
Added:
else (None, title)
81
82
82
Removed:
(** Parse a heading raw title string into its components.
83
Removed:
Order: TODO [#PRIORITY] COMMENT title :tags: *)
83
Added:
(** Parse a heading raw title string into its components. Order: TODO
84
Added:
[#PRIORITY] COMMENT title :tags: *)
84
85
let parse_heading_title config raw_title =
85
86
let raw_title = trim raw_title in
86
87
(* Extract tags from end first *)
87
Removed:
let (title_no_tags, tags) = extract_tags raw_title in
88
Added:
let title_no_tags, tags = extract_tags raw_title in
88
89
(* Extract TODO keyword from front *)
89
Removed:
let (todo, rest) =
90
Removed:
let (first_word, remainder) = split_first_word title_no_tags in
90
Added:
let todo, rest =
91
Added:
let first_word, remainder = split_first_word title_no_tags in
91
92
if first_word <> "" && Config.is_todo_keyword config first_word then
92
93
(Some first_word, remainder)
93
Removed:
else
94
Removed:
(None, title_no_tags)
94
Added:
else (None, title_no_tags)
95
95
in
96
96
(* Extract priority *)
97
Removed:
let (priority, rest2) = extract_priority rest in
97
Added:
let priority, rest2 = extract_priority rest in
98
98
(* Extract COMMENT marker *)
99
Removed:
let (commented, rest3) =
100
Removed:
let (first_word, remainder) = split_first_word rest2 in
101
Removed:
if first_word = "COMMENT" then (true, remainder)
102
Removed:
else (false, rest2)
99
Added:
let commented, rest3 =
100
Added:
let first_word, remainder = split_first_word rest2 in
101
Added:
if first_word = "COMMENT" then (true, remainder) else (false, rest2)
103
102
in
104
103
(* Parse remaining text as inline content *)
105
104
let title_inline =
106
Removed:
if trim rest3 = "" then []
107
Removed:
else Parse_bridge.parse_inline (trim rest3)
105
Added:
if trim rest3 = "" then [] else Parse_bridge.parse_inline (trim rest3)
108
106
in
109
107
(todo, priority, commented, title_inline, tags)
110
108
@@ -122,22 +120,22 @@
122
120
(* Descriptive list tag extraction *)
123
121
(* ------------------------------------------------------------------ *)
124
122
125
Removed:
(** Extract a descriptive list tag from the first body line.
126
Removed:
A descriptive list item has "TAG :: rest" in its text. *)
123
Added:
(** Extract a descriptive list tag from the first body line. A descriptive list
124
Added:
item has "TAG :: rest" in its text. *)
127
125
let extract_list_tag text =
128
126
match String.index_opt text ':' with
129
127
| None -> (None, text)
130
128
| Some i ->
131
Removed:
if i + 1 < String.length text && text.[i + 1] = ':' then
132
Removed:
let tag = trim (String.sub text 0 i) in
133
Removed:
let rest_start = i + 2 in
134
Removed:
let rest =
135
Removed:
if rest_start < String.length text then
136
Removed:
trim (String.sub text rest_start (String.length text - rest_start))
137
Removed:
else ""
138
Removed:
in
139
Removed:
(Some tag, rest)
140
Removed:
else (None, text)
129
Added:
if i + 1 < String.length text && text.[i + 1] = ':' then
130
Added:
let tag = trim (String.sub text 0 i) in
131
Added:
let rest_start = i + 2 in
132
Added:
let rest =
133
Added:
if rest_start < String.length text then
134
Added:
trim (String.sub text rest_start (String.length text - rest_start))
135
Added:
else ""
136
Added:
in
137
Added:
(Some tag, rest)
138
Added:
else (None, text)
141
139
142
140
(* ------------------------------------------------------------------ *)
143
141
(* List nesting *)
@@ -148,89 +146,93 @@
148
146
match items with
149
147
| [] -> Ast.Unordered
150
148
| first :: _ ->
151
Removed:
let bullet = trim first.Raw_ast.rli_bullet in
152
Removed:
if first.Raw_ast.rli_tag <> None then Ast.Descriptive
153
Removed:
else begin
154
Removed:
(* Check if bullet indicates an ordered list *)
155
Removed:
let len = String.length bullet in
156
Removed:
if len >= 2 then
157
Removed:
let last = bullet.[len - 1] in
158
Removed:
if last = '.' || last = ')' then
159
Removed:
(* Check if prefix is digits or alpha *)
160
Removed:
let prefix = String.sub bullet 0 (len - 1) in
161
Removed:
let is_ordered =
162
Removed:
String.length prefix > 0 &&
163
Removed:
(let c = prefix.[0] in
164
Removed:
(c >= '0' && c <= '9') || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'))
165
Removed:
in
166
Removed:
if is_ordered then Ast.Ordered else Ast.Unordered
149
Added:
let bullet = trim first.Raw_ast.rli_bullet in
150
Added:
if first.Raw_ast.rli_tag <> None then Ast.Descriptive
151
Added:
else begin
152
Added:
(* Check if bullet indicates an ordered list *)
153
Added:
let len = String.length bullet in
154
Added:
if len >= 2 then
155
Added:
let last = bullet.[len - 1] in
156
Added:
if last = '.' || last = ')' then
157
Added:
(* Check if prefix is digits or alpha *)
158
Added:
let prefix = String.sub bullet 0 (len - 1) in
159
Added:
let is_ordered =
160
Added:
String.length prefix > 0
161
Added:
&&
162
Added:
let c = prefix.[0] in
163
Added:
(c >= '0' && c <= '9')
164
Added:
|| (c >= 'a' && c <= 'z')
165
Added:
|| (c >= 'A' && c <= 'Z')
166
Added:
in
167
Added:
if is_ordered then Ast.Ordered else Ast.Unordered
168
Added:
else Ast.Unordered
167
169
else Ast.Unordered
168
Removed:
else Ast.Unordered
169
Removed:
end
170
Added:
end
170
171
171
172
(** Check if a raw list item text contains a descriptive tag (::). *)
172
173
let item_has_tag (item : Raw_ast.raw_list_item) =
173
Removed:
item.Raw_ast.rli_tag <> None ||
174
Removed:
(match item.Raw_ast.rli_body_lines with
175
Removed:
| first :: _ ->
176
Removed:
(match String.index_opt first ':' with
174
Added:
item.Raw_ast.rli_tag <> None
175
Added:
||
176
Added:
match item.Raw_ast.rli_body_lines with
177
Added:
| first :: _ -> (
178
Added:
match String.index_opt first ':' with
177
179
| Some i -> i + 1 < String.length first && first.[i + 1] = ':'
178
180
| None -> false)
179
Removed:
| [] -> false)
181
Added:
| [] -> false
180
182
181
183
(** Determine list kind considering descriptive tag detection. *)
182
184
let determine_list_kind_with_tags (items : Raw_ast.raw_list_item list) =
183
185
match items with
184
186
| [] -> Ast.Unordered
185
187
| first :: _ ->
186
Removed:
if item_has_tag first then Ast.Descriptive
187
Removed:
else determine_list_kind items
188
Added:
if item_has_tag first then Ast.Descriptive else determine_list_kind items
188
189
189
Removed:
(** Nest flat list items by indentation into a tree.
190
Removed:
Items with greater indentation than the first item at this level
191
Removed:
become sub-items of the preceding item. *)
192
Removed:
let rec nest_list_items (items : Raw_ast.raw_list_item list) : Ast.list_item list =
190
Added:
(** Nest flat list items by indentation into a tree. Items with greater
191
Added:
indentation than the first item at this level become sub-items of the
192
Added:
preceding item. *)
193
Added:
let rec nest_list_items (items : Raw_ast.raw_list_item list) :
194
Added:
Ast.list_item list =
193
195
match items with
194
196
| [] -> []
195
197
| first :: _ ->
196
Removed:
let base_indent = first.Raw_ast.rli_indent in
197
Removed:
let rec group acc current_item remaining =
198
Removed:
match remaining with
199
Removed:
| [] ->
200
Removed:
let finished = finish_item current_item [] in
201
Removed:
List.rev (finished :: acc)
202
Removed:
| next :: _ when next.Raw_ast.rli_indent > base_indent ->
203
Removed:
(* Collect all deeper items as sub-items of current_item *)
204
Removed:
let (sub_items, remaining') = collect_sub_items base_indent remaining in
205
Removed:
let finished = finish_item current_item sub_items in
206
Removed:
(match remaining' with
207
Removed:
| [] -> List.rev (finished :: acc)
208
Removed:
| next_top :: rest_top ->
209
Removed:
group (finished :: acc) next_top rest_top)
210
Removed:
| next :: rest ->
211
Removed:
(* Same level: finish current, start new *)
212
Removed:
let finished = finish_item current_item [] in
213
Removed:
group (finished :: acc) next rest
214
Removed:
in
215
Removed:
group [] first (List.tl items)
198
Added:
let base_indent = first.Raw_ast.rli_indent in
199
Added:
let rec group acc current_item remaining =
200
Added:
match remaining with
201
Added:
| [] ->
202
Added:
let finished = finish_item current_item [] in
203
Added:
List.rev (finished :: acc)
204
Added:
| next :: _ when next.Raw_ast.rli_indent > base_indent -> (
205
Added:
(* Collect all deeper items as sub-items of current_item *)
206
Added:
let sub_items, remaining' =
207
Added:
collect_sub_items base_indent remaining
208
Added:
in
209
Added:
let finished = finish_item current_item sub_items in
210
Added:
match remaining' with
211
Added:
| [] -> List.rev (finished :: acc)
212
Added:
| next_top :: rest_top -> group (finished :: acc) next_top rest_top)
213
Added:
| next :: rest ->
214
Added:
(* Same level: finish current, start new *)
215
Added:
let finished = finish_item current_item [] in
216
Added:
group (finished :: acc) next rest
217
Added:
in
218
Added:
group [] first (List.tl items)
216
219
217
220
and collect_sub_items base_indent items =
218
221
let rec collect acc = function
219
222
| [] -> (List.rev acc, [])
220
223
| item :: rest ->
221
Removed:
if item.Raw_ast.rli_indent > base_indent then
222
Removed:
collect (item :: acc) rest
223
Removed:
else
224
Removed:
(List.rev acc, item :: rest)
224
Added:
if item.Raw_ast.rli_indent > base_indent then collect (item :: acc) rest
225
Added:
else (List.rev acc, item :: rest)
225
226
in
226
227
collect [] items
227
228
228
Removed:
and finish_item (raw : Raw_ast.raw_list_item) (sub_items : Raw_ast.raw_list_item list) : Ast.list_item =
229
Added:
and finish_item (raw : Raw_ast.raw_list_item)
230
Added:
(sub_items : Raw_ast.raw_list_item list) : Ast.list_item =
229
231
let checkbox = parse_checkbox raw.Raw_ast.rli_checkbox in
230
232
(* Join body lines *)
231
233
let body_text = String.concat " " raw.Raw_ast.rli_body_lines in
232
234
(* Check for descriptive tag *)
233
Removed:
let (tag_opt, content_text) =
235
Added:
let tag_opt, content_text =
234
236
match raw.Raw_ast.rli_tag with
235
237
| Some t -> (Some t, body_text)
236
238
| None -> extract_list_tag body_text
@@ -240,17 +242,18 @@
240
242
let contents =
241
243
let text_elements =
242
244
if trim content_text = "" then []
243
Removed:
else [Ast.Paragraph (Parse_bridge.parse_inline content_text, [])]
245
Added:
else [ Ast.Paragraph (Parse_bridge.parse_inline content_text, []) ]
244
246
in
245
247
let sub_list_elements =
246
248
if sub_items = [] then []
247
249
else
248
250
let kind = determine_list_kind_with_tags sub_items in
249
Removed:
[Ast.Plain_list (kind, nest_list_items sub_items)]
251
Added:
[ Ast.Plain_list (kind, nest_list_items sub_items) ]
250
252
in
251
253
text_elements @ sub_list_elements
252
254
in
253
Removed:
{ Ast.li_bullet = raw.Raw_ast.rli_bullet;
255
Added:
{
256
Added:
Ast.li_bullet = raw.Raw_ast.rli_bullet;
254
257
li_counter_set = raw.Raw_ast.rli_counter_set;
255
258
li_checkbox = checkbox;
256
259
li_tag = tag_inline;
@@ -261,8 +264,8 @@
261
264
(* Table normalization *)
262
265
(* ------------------------------------------------------------------ *)
263
266
264
Removed:
(** Parse a table row string into cells.
265
Removed:
Row format: "| cell1 | cell2 | cell3 |" *)
267
Added:
(** Parse a table row string into cells. Row format: "| cell1 | cell2 | cell3 |"
268
Added:
*)
266
269
let parse_table_row_cells row_str =
267
270
(* Strip leading and trailing | *)
268
271
let s = trim row_str in
@@ -283,7 +286,7 @@
283
286
match row with
284
287
| Raw_ast.Raw_table_rule -> Ast.Table_row_rule
285
288
| Raw_ast.Raw_table_standard s ->
286
Removed:
Ast.Table_row_standard (parse_table_row_cells s)
289
Added:
Ast.Table_row_standard (parse_table_row_cells s)
287
290
288
291
let normalize_table (rows : Raw_ast.raw_table_row list) : Ast.table =
289
292
{ Ast.rows = List.map normalize_table_row rows }
@@ -292,172 +295,210 @@
292
295
(* Block classification *)
293
296
(* ------------------------------------------------------------------ *)
294
297
295
Removed:
(** Parse src block params: first word is language, rest is switches/arguments. *)
298
Added:
(** Parse src block params: first word is language, rest is switches/arguments.
299
Added:
*)
296
300
let parse_src_params params_opt =
297
301
match params_opt with
298
302
| None -> (None, None, None)
299
303
| Some params ->
300
Removed:
let params = trim params in
301
Removed:
if params = "" then (None, None, None)
302
Removed:
else
303
Removed:
let (lang, rest) = split_first_word params in
304
Removed:
let language = if lang = "" then None else Some lang in
305
Removed:
let arguments = if trim rest = "" then None else Some (trim rest) in
306
Removed:
(language, None, arguments)
304
Added:
let params = trim params in
305
Added:
if params = "" then (None, None, None)
306
Added:
else
307
Added:
let lang, rest = split_first_word params in
308
Added:
let language = if lang = "" then None else Some lang in
309
Added:
let arguments = if trim rest = "" then None else Some (trim rest) in
310
Added:
(language, None, arguments)
307
311
308
312
(** Normalize a block body that contains recursive elements. *)
309
Removed:
let rec normalize_recursive_body (elements : Raw_ast.raw_element list) config : Ast.element list =
313
Added:
let rec normalize_recursive_body (elements : Raw_ast.raw_element list) config :
314
Added:
Ast.element list =
310
315
normalize_elements config elements
311
316
312
317
(** Classify a raw block into the appropriate Ast.block variant. *)
313
Removed:
and classify_block (raw : Raw_ast.raw_block) config (affiliated : Ast.affiliated list) : Ast.block =
318
Added:
and classify_block (raw : Raw_ast.raw_block) config
319
Added:
(affiliated : Ast.affiliated list) : Ast.block =
314
320
let name = string_lowercase raw.rb_name in
315
321
match name with
316
322
| "src" ->
317
Removed:
let body_str = match raw.rb_body with
318
Removed:
| Raw_ast.Opaque_body s -> s
319
Removed:
| Raw_ast.Recursive_body _ -> ""
320
Removed:
in
321
Removed:
let (language, switches, arguments) = parse_src_params raw.rb_params in
322
Removed:
Ast.Src_block { src_language = language; src_switches = switches;
323
Removed:
src_arguments = arguments; src_value = body_str;
324
Removed:
src_affiliated = affiliated }
323
Added:
let body_str =
324
Added:
match raw.rb_body with
325
Added:
| Raw_ast.Opaque_body s -> s
326
Added:
| Raw_ast.Recursive_body _ -> ""
327
Added:
in
328
Added:
let language, switches, arguments = parse_src_params raw.rb_params in
329
Added:
Ast.Src_block
330
Added:
{
331
Added:
src_language = language;
332
Added:
src_switches = switches;
333
Added:
src_arguments = arguments;
334
Added:
src_value = body_str;
335
Added:
src_affiliated = affiliated;
336
Added:
}
325
337
| "example" ->
326
Removed:
let body_str = match raw.rb_body with
327
Removed:
| Raw_ast.Opaque_body s -> s
328
Removed:
| Raw_ast.Recursive_body _ -> ""
329
Removed:
in
330
Removed:
Ast.Example_block { ex_value = body_str; ex_switches = raw.rb_params;
331
Removed:
ex_affiliated = affiliated }
338
Added:
let body_str =
339
Added:
match raw.rb_body with
340
Added:
| Raw_ast.Opaque_body s -> s
341
Added:
| Raw_ast.Recursive_body _ -> ""
342
Added:
in
343
Added:
Ast.Example_block
344
Added:
{
345
Added:
ex_value = body_str;
346
Added:
ex_switches = raw.rb_params;
347
Added:
ex_affiliated = affiliated;
348
Added:
}
332
349
| "export" ->
333
Removed:
let body_str = match raw.rb_body with
334
Removed:
| Raw_ast.Opaque_body s -> s
335
Removed:
| Raw_ast.Recursive_body _ -> ""
336
Removed:
in
337
Removed:
let backend = match raw.rb_params with
338
Removed:
| None -> ""
339
Removed:
| Some p -> fst (split_first_word p)
340
Removed:
in
341
Removed:
Ast.Export_block { exp_backend = backend; exp_value = body_str;
342
Removed:
exp_affiliated = affiliated }
350
Added:
let body_str =
351
Added:
match raw.rb_body with
352
Added:
| Raw_ast.Opaque_body s -> s
353
Added:
| Raw_ast.Recursive_body _ -> ""
354
Added:
in
355
Added:
let backend =
356
Added:
match raw.rb_params with
357
Added:
| None -> ""
358
Added:
| Some p -> fst (split_first_word p)
359
Added:
in
360
Added:
Ast.Export_block
361
Added:
{
362
Added:
exp_backend = backend;
363
Added:
exp_value = body_str;
364
Added:
exp_affiliated = affiliated;
365
Added:
}
343
366
| "comment" ->
344
Removed:
let body_str = match raw.rb_body with
345
Removed:
| Raw_ast.Opaque_body s -> s
346
Removed:
| Raw_ast.Recursive_body _ -> ""
347
Removed:
in
348
Removed:
Ast.Comment_block { cb_value = body_str; cb_affiliated = affiliated }
367
Added:
let body_str =
368
Added:
match raw.rb_body with
369
Added:
| Raw_ast.Opaque_body s -> s
370
Added:
| Raw_ast.Recursive_body _ -> ""
371
Added:
in
372
Added:
Ast.Comment_block { cb_value = body_str; cb_affiliated = affiliated }
349
373
| "quote" ->
350
Removed:
let contents = match raw.rb_body with
351
Removed:
| Raw_ast.Recursive_body elems -> normalize_recursive_body elems config
352
Removed:
| Raw_ast.Opaque_body s ->
353
Removed:
if trim s = "" then []
354
Removed:
else [Ast.Paragraph (Parse_bridge.parse_inline s, [])]
355
Removed:
in
356
Removed:
Ast.Quote_block { qt_contents = contents; qt_affiliated = affiliated }
374
Added:
let contents =
375
Added:
match raw.rb_body with
376
Added:
| Raw_ast.Recursive_body elems -> normalize_recursive_body elems config
377
Added:
| Raw_ast.Opaque_body s ->
378
Added:
if trim s = "" then []
379
Added:
else [ Ast.Paragraph (Parse_bridge.parse_inline s, []) ]
380
Added:
in
381
Added:
Ast.Quote_block { qt_contents = contents; qt_affiliated = affiliated }
357
382
| "center" ->
358
Removed:
let contents = match raw.rb_body with
359
Removed:
| Raw_ast.Recursive_body elems -> normalize_recursive_body elems config
360
Removed:
| Raw_ast.Opaque_body s ->
361
Removed:
if trim s = "" then []
362
Removed:
else [Ast.Paragraph (Parse_bridge.parse_inline s, [])]
363
Removed:
in
364
Removed:
Ast.Center_block { cn_contents = contents; cn_affiliated = affiliated }
383
Added:
let contents =
384
Added:
match raw.rb_body with
385
Added:
| Raw_ast.Recursive_body elems -> normalize_recursive_body elems config
386
Added:
| Raw_ast.Opaque_body s ->
387
Added:
if trim s = "" then []
388
Added:
else [ Ast.Paragraph (Parse_bridge.parse_inline s, []) ]
389
Added:
in
390
Added:
Ast.Center_block { cn_contents = contents; cn_affiliated = affiliated }
365
391
| "verse" ->
366
Removed:
let inline = match raw.rb_body with
367
Removed:
| Raw_ast.Opaque_body s -> Parse_bridge.parse_inline s
368
Removed:
| Raw_ast.Recursive_body _ -> []
369
Removed:
in
370
Removed:
Ast.Verse_block { vs_contents = inline; vs_affiliated = affiliated }
392
Added:
let inline =
393
Added:
match raw.rb_body with
394
Added:
| Raw_ast.Opaque_body s -> Parse_bridge.parse_inline s
395
Added:
| Raw_ast.Recursive_body _ -> []
396
Added:
in
397
Added:
Ast.Verse_block { vs_contents = inline; vs_affiliated = affiliated }
371
398
| _ ->
372
Removed:
let contents = match raw.rb_body with
373
Removed:
| Raw_ast.Recursive_body elems -> normalize_recursive_body elems config
374
Removed:
| Raw_ast.Opaque_body s ->
375
Removed:
if trim s = "" then []
376
Removed:
else [Ast.Paragraph (Parse_bridge.parse_inline s, [])]
377
Removed:
in
378
Removed:
Ast.Custom_block { cst_name = raw.rb_name; cst_params = raw.rb_params;
379
Removed:
cst_contents = contents; cst_affiliated = affiliated }
399
Added:
let contents =
400
Added:
match raw.rb_body with
401
Added:
| Raw_ast.Recursive_body elems -> normalize_recursive_body elems config
402
Added:
| Raw_ast.Opaque_body s ->
403
Added:
if trim s = "" then []
404
Added:
else [ Ast.Paragraph (Parse_bridge.parse_inline s, []) ]
405
Added:
in
406
Added:
Ast.Custom_block
407
Added:
{
408
Added:
cst_name = raw.rb_name;
409
Added:
cst_params = raw.rb_params;
410
Added:
cst_contents = contents;
411
Added:
cst_affiliated = affiliated;
412
Added:
}
380
413
381
414
(* ------------------------------------------------------------------ *)
382
415
(* Element normalization with affiliated keyword attachment *)
383
416
(* ------------------------------------------------------------------ *)
384
417
385
Removed:
(** Normalize a list of raw elements into Ast elements.
386
Removed:
Handles affiliated keyword collection and attachment. *)
387
Removed:
and normalize_elements config (raw_elements : Raw_ast.raw_element list) : Ast.element list =
418
Added:
(** Normalize a list of raw elements into Ast elements. Handles affiliated
419
Added:
keyword collection and attachment. *)
420
Added:
and normalize_elements config (raw_elements : Raw_ast.raw_element list) :
421
Added:
Ast.element list =
388
422
let rec process acc affiliated = function
389
423
| [] ->
390
Removed:
(* Any trailing affiliated keywords become plain keywords *)
391
Removed:
let trailing = List.rev_map (fun (aff : Ast.affiliated) ->
392
Removed:
Ast.Keyword { kw_key = aff.aff_name; kw_value = aff.aff_value }
393
Removed:
) affiliated in
394
Removed:
List.rev (trailing @ acc)
424
Added:
(* Any trailing affiliated keywords become plain keywords *)
425
Added:
let trailing =
426
Added:
List.rev_map
427
Added:
(fun (aff : Ast.affiliated) ->
428
Added:
Ast.Keyword { kw_key = aff.aff_name; kw_value = aff.aff_value })
429
Added:
affiliated
430
Added:
in
431
Added:
List.rev (trailing @ acc)
395
432
| Raw_ast.Raw_paragraph [] :: rest ->
396
Removed:
(* Blank paragraph: skip it but flush any pending affiliated as keywords *)
397
Removed:
if affiliated <> [] then begin
398
Removed:
let kws = List.rev_map (fun (aff : Ast.affiliated) ->
399
Removed:
Ast.Keyword { kw_key = aff.aff_name; kw_value = aff.aff_value }
400
Removed:
) affiliated in
401
Removed:
process (kws @ acc) [] rest
402
Removed:
end else
403
Removed:
process acc [] rest
433
Added:
(* Blank paragraph: skip it but flush any pending affiliated as keywords *)
434
Added:
if affiliated <> [] then begin
435
Added:
let kws =
436
Added:
List.rev_map
437
Added:
(fun (aff : Ast.affiliated) ->
438
Added:
Ast.Keyword { kw_key = aff.aff_name; kw_value = aff.aff_value })
439
Added:
affiliated
440
Added:
in
441
Added:
process (kws @ acc) [] rest
442
Added:
end
443
Added:
else process acc [] rest
404
444
| Raw_ast.Raw_affiliated (name, opt, value) :: rest ->
405
Removed:
let aff = { Ast.aff_name = name; aff_optional = opt; aff_value = value } in
406
Removed:
process acc (aff :: affiliated) rest
407
Removed:
| elem :: rest ->
408
Removed:
let normalized = normalize_single_element config elem (List.rev affiliated) in
409
Removed:
(match normalized with
410
Removed:
| Some e -> process (e :: acc) [] rest
411
Removed:
| None -> process acc [] rest)
445
Added:
let aff =
446
Added:
{ Ast.aff_name = name; aff_optional = opt; aff_value = value }
447
Added:
in
448
Added:
process acc (aff :: affiliated) rest
449
Added:
| elem :: rest -> (
450
Added:
let normalized =
451
Added:
normalize_single_element config elem (List.rev affiliated)
452
Added:
in
453
Added:
match normalized with
454
Added:
| Some e -> process (e :: acc) [] rest
455
Added:
| None -> process acc [] rest)
412
456
in
413
457
process [] [] raw_elements
414
458
415
459
(** Normalize a single raw element into an Ast element. *)
416
Removed:
and normalize_single_element config (elem : Raw_ast.raw_element) (affiliated : Ast.affiliated list) : Ast.element option =
460
Added:
and normalize_single_element config (elem : Raw_ast.raw_element)
461
Added:
(affiliated : Ast.affiliated list) : Ast.element option =
417
462
match elem with
418
463
| Raw_ast.Raw_paragraph [] -> None
419
464
| Raw_ast.Raw_paragraph lines ->
420
Removed:
let text = String.concat " " lines in
421
Removed:
let inline = Parse_bridge.parse_inline text in
422
Removed:
Some (Ast.Paragraph (inline, affiliated))
465
Added:
let text = String.concat " " lines in
466
Added:
let inline = Parse_bridge.parse_inline text in
467
Added:
Some (Ast.Paragraph (inline, affiliated))
423
468
| Raw_ast.Raw_list_items items ->
424
Removed:
let kind = determine_list_kind_with_tags items in
425
Removed:
let nested = nest_list_items items in
426
Removed:
Some (Ast.Plain_list (kind, nested))
427
Removed:
| Raw_ast.Raw_table rows ->
428
Removed:
Some (Ast.Table (normalize_table rows))
469
Added:
let kind = determine_list_kind_with_tags items in
470
Added:
let nested = nest_list_items items in
471
Added:
Some (Ast.Plain_list (kind, nested))
472
Added:
| Raw_ast.Raw_table rows -> Some (Ast.Table (normalize_table rows))
429
473
| Raw_ast.Raw_block raw_block ->
430
Removed:
Some (Ast.Block (classify_block raw_block config affiliated))
474
Added:
Some (Ast.Block (classify_block raw_block config affiliated))
431
475
| Raw_ast.Raw_drawer drawer ->
432
Removed:
let contents = normalize_elements config drawer.rd_contents in
433
Removed:
Some (Ast.Drawer (drawer.rd_name, contents))
476
Added:
let contents = normalize_elements config drawer.rd_contents in
477
Added:
Some (Ast.Drawer (drawer.rd_name, contents))
434
478
| Raw_ast.Raw_keyword (key, value) ->
435
Removed:
Some (Ast.Keyword { kw_key = key; kw_value = value })
479
Added:
Some (Ast.Keyword { kw_key = key; kw_value = value })
436
480
| Raw_ast.Raw_affiliated (name, _opt, value) ->
437
Removed:
(* Standalone affiliated keyword not attached to anything → keyword *)
438
Removed:
Some (Ast.Keyword { kw_key = name; kw_value = value })
439
Removed:
| Raw_ast.Raw_comment lines ->
440
Removed:
Some (Ast.Comment lines)
441
Removed:
| Raw_ast.Raw_fixed_width lines ->
442
Removed:
Some (Ast.Fixed_width lines)
443
Removed:
| Raw_ast.Raw_horizontal_rule ->
444
Removed:
Some Ast.Horizontal_rule
481
Added:
(* Standalone affiliated keyword not attached to anything → keyword *)
482
Added:
Some (Ast.Keyword { kw_key = name; kw_value = value })
483
Added:
| Raw_ast.Raw_comment lines -> Some (Ast.Comment lines)
484
Added:
| Raw_ast.Raw_fixed_width lines -> Some (Ast.Fixed_width lines)
485
Added:
| Raw_ast.Raw_horizontal_rule -> Some Ast.Horizontal_rule
445
486
| Raw_ast.Raw_planning _ ->
446
Removed:
(* Planning outside heading context becomes a paragraph *)
447
Removed:
None
487
Added:
(* Planning outside heading context becomes a paragraph *)
488
Added:
None
448
489
| Raw_ast.Raw_property_drawer _ ->
449
Removed:
(* Property drawer outside heading context: ignore *)
450
Removed:
None
490
Added:
(* Property drawer outside heading context: ignore *)
491
Added:
None
451
492
| Raw_ast.Raw_heading _ ->
452
Removed:
(* Should not appear in element lists *)
453
Removed:
None
493
Added:
(* Should not appear in element lists *)
494
Added:
None
454
495
455
496
(* ------------------------------------------------------------------ *)
456
497
(* Planning and property extraction from heading body *)
457
498
(* ------------------------------------------------------------------ *)
458
499
459
Removed:
(** Extract a timestamp from a raw planning entry.
460
Removed:
Uses the inline parser which handles timestamps. *)
500
Added:
(** Extract a timestamp from a raw planning entry. Uses the inline parser which
501
Added:
handles timestamps. *)
461
502
let extract_timestamp ts_str =
462
503
let inlines = Parse_bridge.parse_inline ts_str in
463
504
let rec find_ts = function
@@ -468,47 +509,64 @@
468
509
find_ts inlines
469
510
470
511
(** Extract planning information from a list of raw_planning entries. *)
471
Removed:
let extract_planning (entries : Raw_ast.raw_planning list) : Ast.planning option =
512
Added:
let extract_planning (entries : Raw_ast.raw_planning list) : Ast.planning option
513
Added:
=
472
514
match entries with
473
515
| [] -> None
474
516
| _ ->
475
Removed:
let planning =
476
Removed:
List.fold_left (fun acc (entry : Raw_ast.raw_planning) ->
477
Removed:
match entry.rpl_keyword with
478
Removed:
| "DEADLINE" -> { acc with Ast.deadline = extract_timestamp entry.rpl_timestamp }
479
Removed:
| "SCHEDULED" -> { acc with Ast.scheduled = extract_timestamp entry.rpl_timestamp }
480
Removed:
| "CLOSED" -> { acc with Ast.closed = extract_timestamp entry.rpl_timestamp }
481
Removed:
| _ -> acc
482
Removed:
) { Ast.deadline = None; scheduled = None; closed = None } entries
483
Removed:
in
484
Removed:
if planning.deadline = None && planning.scheduled = None && planning.closed = None then None
485
Removed:
else Some planning
517
Added:
let planning =
518
Added:
List.fold_left
519
Added:
(fun acc (entry : Raw_ast.raw_planning) ->
520
Added:
match entry.rpl_keyword with
521
Added:
| "DEADLINE" ->
522
Added:
{
523
Added:
acc with
524
Added:
Ast.deadline = extract_timestamp entry.rpl_timestamp;
525
Added:
}
526
Added:
| "SCHEDULED" ->
527
Added:
{
528
Added:
acc with
529
Added:
Ast.scheduled = extract_timestamp entry.rpl_timestamp;
530
Added:
}
531
Added:
| "CLOSED" ->
532
Added:
{ acc with Ast.closed = extract_timestamp entry.rpl_timestamp }
533
Added:
| _ -> acc)
534
Added:
{ Ast.deadline = None; scheduled = None; closed = None }
535
Added:
entries
536
Added:
in
537
Added:
if
538
Added:
planning.deadline = None && planning.scheduled = None
539
Added:
&& planning.closed = None
540
Added:
then None
541
Added:
else Some planning
486
542
487
Removed:
(** Extract properties from drawer contents.
488
Removed:
In a PROPERTIES drawer, each entry was parsed as Raw_keyword(name, value). *)
489
Removed:
let extract_properties (elements : Raw_ast.raw_element list) : Ast.property list =
490
Removed:
List.filter_map (fun elem ->
491
Removed:
match elem with
492
Removed:
| Raw_ast.Raw_keyword (name, value) ->
493
Removed:
let prop_value = if trim value = "" then None else Some value in
494
Removed:
Some { Ast.prop_name = name; prop_value }
495
Removed:
| Raw_ast.Raw_paragraph [] -> None
496
Removed:
| _ -> None
497
Removed:
) elements
543
Added:
(** Extract properties from drawer contents. In a PROPERTIES drawer, each entry
544
Added:
was parsed as Raw_keyword(name, value). *)
545
Added:
let extract_properties (elements : Raw_ast.raw_element list) : Ast.property list
546
Added:
=
547
Added:
List.filter_map
548
Added:
(fun elem ->
549
Added:
match elem with
550
Added:
| Raw_ast.Raw_keyword (name, value) ->
551
Added:
let prop_value = if trim value = "" then None else Some value in
552
Added:
Some { Ast.prop_name = name; prop_value }
553
Added:
| Raw_ast.Raw_paragraph [] -> None
554
Added:
| _ -> None)
555
Added:
elements
498
556
499
Removed:
(** Process heading body to extract planning, properties, and remaining elements. *)
557
Added:
(** Process heading body to extract planning, properties, and remaining
558
Added:
elements. *)
500
559
let process_heading_body config (body : Raw_ast.raw_element list) =
501
Removed:
let (planning, rest1) =
560
Added:
let planning, rest1 =
502
561
match body with
503
Removed:
| Raw_ast.Raw_planning entries :: rest ->
504
Removed:
(extract_planning entries, rest)
562
Added:
| Raw_ast.Raw_planning entries :: rest -> (extract_planning entries, rest)
505
563
| _ -> (None, body)
506
564
in
507
Removed:
let (properties, rest2) =
565
Added:
let properties, rest2 =
508
566
match rest1 with
509
567
| Raw_ast.Raw_drawer { rd_name; rd_contents } :: rest
510
568
when string_lowercase rd_name = "properties" ->
511
Removed:
(extract_properties rd_contents, rest)
569
Added:
(extract_properties rd_contents, rest)
512
570
| _ -> ([], rest1)
513
571
in
514
572
let elements = normalize_elements config rest2 in
@@ -518,45 +576,48 @@
518
576
(* Heading hierarchy *)
519
577
(* ------------------------------------------------------------------ *)
520
578
521
Removed:
(** Build heading hierarchy from a flat list of raw headings.
522
Removed:
Each heading's children are subsequent headings with a greater level,
523
Removed:
until a heading of equal or lesser level is encountered. *)
524
Removed:
let build_heading_tree config (raw_headings : Raw_ast.raw_heading list) : Ast.heading list =
579
Added:
(** Build heading hierarchy from a flat list of raw headings. Each heading's
580
Added:
children are subsequent headings with a greater level, until a heading of
581
Added:
equal or lesser level is encountered. *)
582
Added:
let build_heading_tree config (raw_headings : Raw_ast.raw_heading list) :
583
Added:
Ast.heading list =
525
584
let rec process_headings headings =
526
585
match headings with
527
586
| [] -> []
528
587
| raw :: rest ->
529
Removed:
let (children_raw, siblings_raw) = collect_children raw.Raw_ast.rh_level rest in
530
Removed:
let (todo, priority, commented, title, tags) =
531
Removed:
parse_heading_title config raw.Raw_ast.rh_raw_title
532
Removed:
in
533
Removed:
let (planning, properties, contents) =
534
Removed:
process_heading_body config raw.Raw_ast.rh_body
535
Removed:
in
536
Removed:
let children = process_headings children_raw in
537
Removed:
let heading = {
538
Removed:
Ast.level = raw.Raw_ast.rh_level;
539
Removed:
todo;
540
Removed:
priority;
541
Removed:
commented;
542
Removed:
title;
543
Removed:
tags;
544
Removed:
planning;
545
Removed:
properties;
546
Removed:
contents;
547
Removed:
children;
548
Removed:
} in
549
Removed:
heading :: process_headings siblings_raw
550
Removed:
588
Added:
let children_raw, siblings_raw =
589
Added:
collect_children raw.Raw_ast.rh_level rest
590
Added:
in
591
Added:
let todo, priority, commented, title, tags =
592
Added:
parse_heading_title config raw.Raw_ast.rh_raw_title
593
Added:
in
594
Added:
let planning, properties, contents =
595
Added:
process_heading_body config raw.Raw_ast.rh_body
596
Added:
in
597
Added:
let children = process_headings children_raw in
598
Added:
let heading =
599
Added:
{
600
Added:
Ast.level = raw.Raw_ast.rh_level;
601
Added:
todo;
602
Added:
priority;
603
Added:
commented;
604
Added:
title;
605
Added:
tags;
606
Added:
planning;
607
Added:
properties;
608
Added:
contents;
609
Added:
children;
610
Added:
}
611
Added:
in
612
Added:
heading :: process_headings siblings_raw
551
613
and collect_children parent_level headings =
552
614
(* Collect all headings that are deeper than parent_level *)
553
615
let rec collect children remaining =
554
616
match remaining with
555
617
| [] -> (List.rev children, [])
556
618
| h :: _ when h.Raw_ast.rh_level <= parent_level ->
557
Removed:
(List.rev children, remaining)
558
Removed:
| h :: rest ->
559
Removed:
collect (h :: children) rest
619
Added:
(List.rev children, remaining)
620
Added:
| h :: rest -> collect (h :: children) rest
560
621
in
561
622
collect [] headings
562
623
in
@@ -567,33 +628,47 @@
567
628
(* ------------------------------------------------------------------ *)
568
629
569
630
(** Known directive keywords that should be extracted from the preamble. *)
570
Removed:
let directive_keywords = [
571
Removed:
"TITLE"; "AUTHOR"; "DATE"; "EMAIL"; "LANGUAGE";
572
Removed:
"DESCRIPTION"; "OPTIONS"; "STARTUP"; "FILETAGS";
573
Removed:
"CATEGORY"; "PROPERTY"; "ARCHIVE"; "COLUMNS";
574
Removed:
"LINK"; "PRIORITIES"; "TAGS"; "EXPORT_FILE_NAME";
575
Removed:
]
631
Added:
let directive_keywords =
632
Added:
[
633
Added:
"TITLE";
634
Added:
"AUTHOR";
635
Added:
"DATE";
636
Added:
"EMAIL";
637
Added:
"LANGUAGE";
638
Added:
"DESCRIPTION";
639
Added:
"OPTIONS";
640
Added:
"STARTUP";
641
Added:
"FILETAGS";
642
Added:
"CATEGORY";
643
Added:
"PROPERTY";
644
Added:
"ARCHIVE";
645
Added:
"COLUMNS";
646
Added:
"LINK";
647
Added:
"PRIORITIES";
648
Added:
"TAGS";
649
Added:
"EXPORT_FILE_NAME";
650
Added:
]
576
651
577
652
(** Check if a keyword should be treated as a directive. *)
578
653
let is_directive_keyword key =
579
654
List.mem (String.uppercase_ascii key) directive_keywords
580
655
581
Removed:
(** Extract directives from the leading keywords of the preamble.
582
Removed:
Directives are keywords that appear before any non-keyword/non-blank
583
Removed:
element in the preamble. *)
656
Added:
(** Extract directives from the leading keywords of the preamble. Directives are
657
Added:
keywords that appear before any non-keyword/non-blank element in the
658
Added:
preamble. *)
584
659
let extract_directives (raw_elements : Raw_ast.raw_element list) :
585
Removed:
Ast.directive list * Raw_ast.raw_element list =
660
Added:
Ast.directive list * Raw_ast.raw_element list =
586
661
let rec collect_leading directives remaining =
587
662
match remaining with
588
663
| Raw_ast.Raw_keyword (key, value) :: rest when is_directive_keyword key ->
589
Removed:
let dir = { Ast.dir_key = key; dir_value = value } in
590
Removed:
collect_leading (dir :: directives) rest
664
Added:
let dir = { Ast.dir_key = key; dir_value = value } in
665
Added:
collect_leading (dir :: directives) rest
591
666
| Raw_ast.Raw_paragraph [] :: rest ->
592
Removed:
(* Skip blank paragraphs while collecting directives *)
593
Removed:
collect_leading directives rest
667
Added:
(* Skip blank paragraphs while collecting directives *)
668
Added:
collect_leading directives rest
594
669
| Raw_ast.Raw_affiliated _ :: rest ->
595
Removed:
(* Skip affiliated keywords in directive zone *)
596
Removed:
collect_leading directives rest
670
Added:
(* Skip affiliated keywords in directive zone *)
671
Added:
collect_leading directives rest
597
672
| _ -> (List.rev directives, remaining)
598
673
in
599
674
collect_leading [] raw_elements
@@ -604,7 +679,7 @@
604
679
605
680
let normalize (config : Config.t) (raw : Raw_ast.document) : Ast.document =
606
681
(* Extract directives from preamble *)
607
Removed:
let (directives, remaining_preamble) = extract_directives raw.rd_preamble in
682
Added:
let directives, remaining_preamble = extract_directives raw.rd_preamble in
608
683
(* Normalize remaining preamble elements *)
609
684
let preamble = normalize_elements config remaining_preamble in
610
685
(* Build heading hierarchy *)
lib/org.ml
@@ -1,14 +1,12 @@
1
1
(** Org — OCaml Org Mode parser library.
2
2
3
Removed:
This is the top-level module for the [org] library. It re-exports
4
Removed:
the public API and sub-modules, providing a convenient namespace
5
Removed:
for consumers:
3
Added:
This is the top-level module for the [org] library. It re-exports the public
4
Added:
API and sub-modules, providing a convenient namespace for consumers:
6
5
7
6
{[
8
Removed:
let doc = Org.parse input
9
Removed:
let headings = doc.Org.Ast.headings
10
Removed:
]}
11
Removed:
*)
7
Added:
let doc = Org.parse input
8
Added:
let headings = doc.Org.Ast.headings
9
Added:
]} *)
12
10
13
11
(** {1 Public sub-modules} *)
14
12
@@ -17,39 +15,38 @@
17
15
18
16
(** {1 Internal sub-modules}
19
17
20
Removed:
These are exposed for testing and advanced use. They are not
21
Removed:
part of the stable public API and may change without notice. *)
18
Added:
These are exposed for testing and advanced use. They are not part of the
19
Added:
stable public API and may change without notice. *)
22
20
23
21
(**/**)
22
Added:
24
23
module Private = struct
25
24
module Lexer = Lexer
26
25
module Parse_bridge = Parse_bridge
27
26
module Raw_ast = Raw_ast
28
27
module Prescan = Prescan
29
28
end
29
Added:
30
30
(**/**)
31
Added:
31
32
(** {1 Parsing entry points} *)
32
33
33
34
let version = "0.1.0"
34
35
35
36
(** Parse an Org Mode document string into a semantic AST.
36
37
37
Removed:
This is the primary entry point. It:
38
Removed:
1. Pre-scans for file-local declarations (#+TODO etc.)
39
Removed:
2. Lexes the input into structural tokens
40
Removed:
3. Parses tokens into a raw document tree (Menhir)
41
Removed:
4. Normalizes the raw tree into the semantic AST
38
Added:
This is the primary entry point. It: 1. Pre-scans for file-local
39
Added:
declarations (#+TODO etc.) 2. Lexes the input into structural tokens 3.
40
Added:
Parses tokens into a raw document tree (Menhir) 4. Normalizes the raw tree
41
Added:
into the semantic AST
42
42
43
Removed:
Malformed input degrades gracefully — the parser always
44
Removed:
produces a best-effort document without raising exceptions
45
Removed:
for syntax errors.
43
Added:
Malformed input degrades gracefully — the parser always produces a
44
Added:
best-effort document without raising exceptions for syntax errors.
46
45
47
Removed:
@param config Optional document configuration. When omitted,
48
Removed:
the input is pre-scanned for #+TODO declarations automatically. *)
46
Added:
@param config
47
Added:
Optional document configuration. When omitted, the input is pre-scanned
48
Added:
for #+TODO declarations automatically. *)
49
49
let parse ?config input =
50
Removed:
let config = match config with
51
Removed:
| Some c -> c
52
Removed:
| None -> Prescan.scan input
53
Removed:
in
50
Added:
let config = match config with Some c -> c | None -> Prescan.scan input in
54
51
let raw = Parse_bridge.parse ~config input in
55
52
Normalize.normalize config raw
lib/parse_bridge.ml
@@ -1,7 +1,7 @@
1
1
(** Bridge between the structural lexer and the Menhir parser.
2
2
3
Removed:
Converts [Lexer.token] values into [Parser.token] values
4
Removed:
and provides the entry point for structural parsing. *)
3
Added:
Converts [Lexer.token] values into [Parser.token] values and provides the
4
Added:
entry point for structural parsing. *)
5
5
6
6
(** Convert a lexer token to a Menhir parser token. *)
7
7
let convert_token (tok : Lexer.token) : Parser.token =
@@ -9,7 +9,8 @@
9
9
| Lexer.Blank -> Parser.BLANK
10
10
| Lexer.Heading (level, rest) -> Parser.HEADING (level, rest)
11
11
| Lexer.Keyword (key, value) -> Parser.KEYWORD (key, value)
12
Removed:
| Lexer.Affiliated_keyword (name, opt, value) -> Parser.AFFILIATED_KEYWORD (name, opt, value)
12
Added:
| Lexer.Affiliated_keyword (name, opt, value) ->
13
Added:
Parser.AFFILIATED_KEYWORD (name, opt, value)
13
14
| Lexer.Begin_block (name, params) -> Parser.BEGIN_BLOCK (name, params)
14
15
| Lexer.End_block name -> Parser.END_BLOCK name
15
16
| Lexer.Drawer_begin name -> Parser.DRAWER_BEGIN name
@@ -25,15 +26,11 @@
25
26
| Lexer.Eof -> Parser.EOF
26
27
27
28
(** A dummy lexbuf position for Menhir (we track positions ourselves). *)
28
Removed:
let dummy_pos = {
29
Removed:
Lexing.pos_fname = "";
30
Removed:
pos_lnum = 0;
31
Removed:
pos_bol = 0;
32
Removed:
pos_cnum = 0;
33
Removed:
}
29
Added:
let dummy_pos =
30
Added:
{ Lexing.pos_fname = ""; pos_lnum = 0; pos_bol = 0; pos_cnum = 0 }
34
31
35
Removed:
(** Parse input text into a Raw_ast.document using the structural
36
Removed:
lexer and Menhir parser. *)
32
Added:
(** Parse input text into a Raw_ast.document using the structural lexer and
33
Added:
Menhir parser. *)
37
34
let parse ~config input =
38
35
let lexer_state = Lexer.create ~config input in
39
36
let dummy_lexbuf = Lexing.from_string "" in
@@ -83,8 +80,7 @@
83
80
let tok = Inline_lexer.next_token st in
84
81
convert_inline_token tok
85
82
in
86
Removed:
try
87
Removed:
Inline_parser.inline_content token_fun dummy_lexbuf
83
Added:
try Inline_parser.inline_content token_fun dummy_lexbuf
88
84
with Inline_parser.Error ->
89
85
(* Fallback: if inline parsing fails, return plain text *)
90
Removed:
[Ast.Plain input]
86
Added:
[ Ast.Plain input ]
lib/prescan.ml
@@ -1,61 +1,61 @@
1
1
(** Pre-scan phase for file-local declarations.
2
2
3
Removed:
Scans the entire input for syntax-affecting keywords like
4
Removed:
#+TODO, #+SEQ_TODO, and #+TYP_TODO before the main parse.
5
Removed:
These declarations may appear anywhere in the file and affect
6
Removed:
how headings are interpreted. *)
3
Added:
Scans the entire input for syntax-affecting keywords like #+TODO,
4
Added:
#+SEQ_TODO, and #+TYP_TODO before the main parse. These declarations may
5
Added:
appear anywhere in the file and affect how headings are interpreted. *)
7
6
8
7
let lstrip = String_util.lstrip
9
8
let strip = String_util.strip
10
9
11
Removed:
(** Parse a TODO keyword line value into a todo_sequence.
12
Removed:
Format: "KEYWORD1 KEYWORD2 | DONE1 DONE2"
13
Removed:
If no | is present, all keywords are active and there are no done keywords. *)
10
Added:
(** Parse a TODO keyword line value into a todo_sequence. Format: "KEYWORD1
11
Added:
KEYWORD2 | DONE1 DONE2" If no | is present, all keywords are active and
12
Added:
there are no done keywords. *)
14
13
let parse_todo_value value =
15
14
let value = strip value in
16
15
if String.length value = 0 then None
17
16
else
18
Removed:
let words = String.split_on_char ' ' value |> List.filter (fun s -> s <> "") in
17
Added:
let words =
18
Added:
String.split_on_char ' ' value |> List.filter (fun s -> s <> "")
19
Added:
in
19
20
let rec split_at_bar acc = function
20
21
| [] -> (List.rev acc, [])
21
22
| "|" :: rest -> (List.rev acc, rest)
22
23
| w :: rest -> split_at_bar (w :: acc) rest
23
24
in
24
Removed:
let (active, done_) = split_at_bar [] words in
25
Removed:
if active = [] && done_ = [] then None
26
Removed:
else Some { Config.active; done_ }
25
Added:
let active, done_ = split_at_bar [] words in
26
Added:
if active = [] && done_ = [] then None else Some { Config.active; done_ }
27
27
28
28
(** Extract the value part after #+KEY: from a line. *)
29
29
let extract_keyword_value line =
30
30
(* Line format: #+KEY: VALUE *)
31
31
let line = lstrip line in
32
Removed:
if String.length line < 2 || line.[0] <> '#' || line.[1] <> '+' then
33
Removed:
None
32
Added:
if String.length line < 2 || line.[0] <> '#' || line.[1] <> '+' then None
34
33
else
35
34
let rest = String.sub line 2 (String.length line - 2) in
36
35
match String.index_opt rest ':' with
37
36
| None -> None
38
37
| Some colon_pos ->
39
Removed:
let key = String.uppercase_ascii (String.sub rest 0 colon_pos) in
40
Removed:
let value =
41
Removed:
if colon_pos + 1 < String.length rest then
42
Removed:
String.sub rest (colon_pos + 1) (String.length rest - colon_pos - 1)
43
Removed:
else ""
44
Removed:
in
45
Removed:
Some (key, strip value)
38
Added:
let key = String.uppercase_ascii (String.sub rest 0 colon_pos) in
39
Added:
let value =
40
Added:
if colon_pos + 1 < String.length rest then
41
Added:
String.sub rest (colon_pos + 1) (String.length rest - colon_pos - 1)
42
Added:
else ""
43
Added:
in
44
Added:
Some (key, strip value)
46
45
47
Removed:
(** Scan the input for TODO keyword declarations.
48
Removed:
Returns a [Config.t] with all discovered TODO sequences. *)
46
Added:
(** Scan the input for TODO keyword declarations. Returns a [Config.t] with all
47
Added:
discovered TODO sequences. *)
49
48
let scan input =
50
49
let lines = String.split_on_char '\n' input in
51
50
let sequences =
52
Removed:
List.filter_map (fun line ->
53
Removed:
match extract_keyword_value line with
54
Removed:
| Some (key, value)
55
Removed:
when key = "TODO" || key = "SEQ_TODO" || key = "TYP_TODO" ->
56
Removed:
parse_todo_value value
57
Removed:
| _ -> None
58
Removed:
) lines
51
Added:
List.filter_map
52
Added:
(fun line ->
53
Added:
match extract_keyword_value line with
54
Added:
| Some (key, value)
55
Added:
when key = "TODO" || key = "SEQ_TODO" || key = "TYP_TODO" ->
56
Added:
parse_todo_value value
57
Added:
| _ -> None)
58
Added:
lines
59
59
in
60
60
match sequences with
61
61
| [] -> Config.default
lib/raw_ast.ml
@@ -1,12 +1,10 @@
1
1
(** Private raw parse tree types.
2
2
3
Removed:
These types represent the output of the structural Menhir parser
4
Removed:
before normalization. They are flat (no heading hierarchy), store
5
Removed:
inline content as raw strings, and preserve the parsing order.
6
Removed:
The normalization phase converts these into the public [Ast] types. *)
3
Added:
These types represent the output of the structural Menhir parser before
4
Added:
normalization. They are flat (no heading hierarchy), store inline content as
5
Added:
raw strings, and preserve the parsing order. The normalization phase
6
Added:
converts these into the public [Ast] types. *)
7
7
8
Removed:
(** A raw list item as classified by the lexer.
9
Removed:
Indentation is preserved for later nesting. *)
10
8
type raw_list_item = {
11
9
rli_indent : int;
12
10
rli_bullet : string;
@@ -15,26 +13,25 @@
15
13
rli_tag : string option; (** Descriptive list tag text (raw) *)
16
14
rli_body_lines : string list; (** Continuation lines *)
17
15
}
16
Added:
(** A raw list item as classified by the lexer. Indentation is preserved for
17
Added:
later nesting. *)
18
18
19
Added:
type raw_property = { rp_name : string; rp_value : string option }
19
20
(** A raw property drawer entry. *)
20
Removed:
type raw_property = {
21
Removed:
rp_name : string;
22
Removed:
rp_value : string option;
23
Removed:
}
24
21
25
Removed:
(** A raw planning line. *)
26
22
type raw_planning = {
27
23
rpl_keyword : string; (** DEADLINE, SCHEDULED, or CLOSED *)
28
24
rpl_timestamp : string; (** Raw timestamp text *)
29
25
}
26
Added:
(** A raw planning line. *)
30
27
31
28
(** A raw table row. *)
32
29
type raw_table_row =
33
30
| Raw_table_standard of string (** | cell | cell | ... *)
34
31
| Raw_table_rule (** |---+---| *)
35
32
36
Removed:
(** A block body. Opaque blocks store raw text;
37
Removed:
recursive blocks store nested raw elements. *)
33
Added:
(** A block body. Opaque blocks store raw text; recursive blocks store nested
34
Added:
raw elements. *)
38
35
type raw_block_body =
39
36
| Opaque_body of string (** Source, example, export, comment *)
40
37
| Recursive_body of raw_element list (** Quote, center, verse, custom *)
@@ -48,35 +45,35 @@
48
45
| Raw_block of raw_block
49
46
| Raw_drawer of raw_drawer
50
47
| Raw_keyword of string * string (** key, value *)
51
Removed:
| Raw_affiliated of string * string option * string (** name, optional, value *)
48
Added:
| Raw_affiliated of string * string option * string
49
Added:
(** name, optional, value *)
52
50
| Raw_comment of string list (** Consecutive comment lines *)
53
51
| Raw_fixed_width of string list (** Consecutive fixed-width lines *)
54
52
| Raw_horizontal_rule
55
53
| Raw_planning of raw_planning list (** Planning line entries *)
56
54
| Raw_property_drawer of raw_property list (** Property drawer *)
57
55
58
Removed:
(** A raw block. *)
59
56
and raw_block = {
60
57
rb_name : string; (** Block type name (src, quote, etc.) *)
61
58
rb_params : string option; (** Parameters after #+begin_NAME *)
62
59
rb_body : raw_block_body;
63
60
}
61
Added:
(** A raw block. *)
64
62
63
Added:
and raw_drawer = { rd_name : string; rd_contents : raw_element list }
65
64
(** A raw drawer. *)
66
Removed:
and raw_drawer = {
67
Removed:
rd_name : string;
68
Removed:
rd_contents : raw_element list;
69
Removed:
}
70
65
71
Removed:
(** A raw heading (flat — no hierarchy yet). *)
72
66
and raw_heading = {
73
67
rh_level : int;
74
Removed:
rh_raw_title : string; (** Everything after stars, to be parsed for TODO/priority/tags/inline *)
75
Removed:
rh_body : raw_element list; (** Elements until next heading of same or higher level *)
68
Added:
rh_raw_title : string;
69
Added:
(** Everything after stars, to be parsed for TODO/priority/tags/inline *)
70
Added:
rh_body : raw_element list;
71
Added:
(** Elements until next heading of same or higher level *)
76
72
}
73
Added:
(** A raw heading (flat — no hierarchy yet). *)
77
74
78
Removed:
(** A raw document produced by the structural parser. *)
79
75
type document = {
80
76
rd_preamble : raw_element list;
81
77
rd_headings : raw_heading list;
82
78
}
79
Added:
(** A raw document produced by the structural parser. *)
lib/string_util.ml
@@ -1,7 +1,7 @@
1
1
(** Shared string utility functions.
2
2
3
Removed:
Centralizes whitespace handling to avoid duplication
4
Removed:
across prescan, lexer, and normalization modules. *)
3
Added:
Centralizes whitespace handling to avoid duplication across prescan, lexer,
4
Added:
and normalization modules. *)
5
5
6
6
(** Strip leading whitespace (spaces and tabs). *)
7
7
let lstrip s =
org.opam
@@ -1,14 +1,11 @@
1
1
# This file is generated by dune, edit dune-project instead
2
2
opam-version: "2.0"
3
Removed:
version: "0.1.0"
4
3
synopsis: "OCaml Org Mode parser library"
5
Removed:
description:
6
Removed:
"A compact, high-quality OCaml library for parsing Org Mode documents into a semantic, strongly typed abstract syntax tree."
7
Removed:
maintainer: ["blendux"]
8
Removed:
authors: ["blendux"]
9
Removed:
license: "ISC"
10
Removed:
homepage: "https://github.com/blendux/ocaml-org"
11
Removed:
bug-reports: "https://github.com/blendux/ocaml-org/issues"
4
Added:
description: "A compact OCaml library for parsing Org Mode documents."
5
Added:
maintainer: ["Marius PETER"]
6
Added:
authors: ["Marius PETER"]
7
Added:
license: "GPL-3.0-only"
8
Added:
homepage: "https://git.mlnp.fr/ocaml-org"
12
9
depends: [
13
10
"dune" {>= "3.0"}
14
11
"ocaml" {>= "5.0"}
test/test_main.ml
@@ -1,5 +1,4 @@
1
Removed:
let test_version () =
2
Removed:
Alcotest.(check string) "version" "0.1.0" Org.version
1
Added:
let test_version () = Alcotest.(check string) "version" "0.1.0" Org.version
3
2
4
3
(* Prescan tests *)
5
4
@@ -12,42 +11,50 @@
12
11
let input = "#+TODO: NEXT WAITING | DONE CANCELLED\n" in
13
12
let config = Org.Private.Prescan.scan input in
14
13
let kws = Org.Config.all_todo_keywords config in
15
Removed:
Alcotest.(check (list string)) "custom keywords"
16
Removed:
[ "NEXT"; "WAITING"; "DONE"; "CANCELLED" ] kws
14
Added:
Alcotest.(check (list string))
15
Added:
"custom keywords"
16
Added:
[ "NEXT"; "WAITING"; "DONE"; "CANCELLED" ]
17
Added:
kws
17
18
18
19
let test_prescan_multiple_sequences () =
19
Removed:
let input =
20
Removed:
"#+TODO: TODO | DONE\n\
21
Removed:
#+TODO: OPEN | CLOSED\n"
22
Removed:
in
20
Added:
let input = "#+TODO: TODO | DONE\n#+TODO: OPEN | CLOSED\n" in
23
21
let config = Org.Private.Prescan.scan input in
24
22
let kws = Org.Config.all_todo_keywords config in
25
Removed:
Alcotest.(check (list string)) "multiple sequences"
26
Removed:
[ "TODO"; "DONE"; "OPEN"; "CLOSED" ] kws
23
Added:
Alcotest.(check (list string))
24
Added:
"multiple sequences"
25
Added:
[ "TODO"; "DONE"; "OPEN"; "CLOSED" ]
26
Added:
kws
27
27
28
28
let test_prescan_seq_todo () =
29
29
let input = "#+SEQ_TODO: NEXT ACTIVE | DONE\n" in
30
30
let config = Org.Private.Prescan.scan input in
31
Removed:
Alcotest.(check bool) "NEXT is todo" true
31
Added:
Alcotest.(check bool)
32
Added:
"NEXT is todo" true
32
33
(Org.Config.is_todo_keyword config "NEXT");
33
Removed:
Alcotest.(check bool) "DONE is todo" true
34
Added:
Alcotest.(check bool)
35
Added:
"DONE is todo" true
34
36
(Org.Config.is_todo_keyword config "DONE");
35
Removed:
Alcotest.(check bool) "UNKNOWN is not todo" false
37
Added:
Alcotest.(check bool)
38
Added:
"UNKNOWN is not todo" false
36
39
(Org.Config.is_todo_keyword config "UNKNOWN")
37
40
38
41
let test_prescan_case_insensitive_key () =
39
42
let input = "#+todo: BUG FIX | RESOLVED\n" in
40
43
let config = Org.Private.Prescan.scan input in
41
44
let kws = Org.Config.all_todo_keywords config in
42
Removed:
Alcotest.(check (list string)) "case insensitive key"
43
Removed:
[ "BUG"; "FIX"; "RESOLVED" ] kws
45
Added:
Alcotest.(check (list string))
46
Added:
"case insensitive key"
47
Added:
[ "BUG"; "FIX"; "RESOLVED" ]
48
Added:
kws
44
49
45
50
let test_prescan_no_bar () =
46
51
let input = "#+TODO: TODO DOING DONE\n" in
47
52
let config = Org.Private.Prescan.scan input in
48
53
let seqs = config.todo_sequences in
49
54
let seq = List.hd seqs in
50
Removed:
Alcotest.(check (list string)) "all active" [ "TODO"; "DOING"; "DONE" ]
55
Added:
Alcotest.(check (list string))
56
Added:
"all active"
57
Added:
[ "TODO"; "DOING"; "DONE" ]
51
58
seq.active;
52
59
Alcotest.(check (list string)) "no done" [] seq.done_
53
60
@@ -55,22 +62,25 @@
55
62
module L = Org.Private.Lexer
56
63
57
64
let config = Org.Config.default
58
Removed:
59
Removed:
let lex input =
60
Removed:
L.tokenize ~config input |> List.map fst
65
Added:
let lex input = L.tokenize ~config input |> List.map fst
61
66
62
67
let tok_to_string = function
63
68
| L.Blank -> "Blank"
64
69
| L.Heading (n, s) -> Printf.sprintf "Heading(%d, %S)" n s
65
70
| L.Keyword (k, v) -> Printf.sprintf "Keyword(%S, %S)" k v
66
71
| L.Affiliated_keyword (n, _, v) -> Printf.sprintf "Affiliated(%S, %S)" n v
67
Removed:
| L.Begin_block (n, p) -> Printf.sprintf "Begin_block(%S, %s)" n (match p with Some s -> Printf.sprintf "%S" s | None -> "None")
72
Added:
| L.Begin_block (n, p) ->
73
Added:
Printf.sprintf "Begin_block(%S, %s)" n
74
Added:
(match p with Some s -> Printf.sprintf "%S" s | None -> "None")
68
75
| L.End_block n -> Printf.sprintf "End_block(%S)" n
69
76
| L.Drawer_begin n -> Printf.sprintf "Drawer_begin(%S)" n
70
77
| L.Drawer_end -> "Drawer_end"
71
Removed:
| L.Property (n, v) -> Printf.sprintf "Property(%S, %s)" n (match v with Some s -> Printf.sprintf "%S" s | None -> "None")
78
Added:
| L.Property (n, v) ->
79
Added:
Printf.sprintf "Property(%S, %s)" n
80
Added:
(match v with Some s -> Printf.sprintf "%S" s | None -> "None")
72
81
| L.Planning _ -> "Planning"
73
Removed:
| L.List_item d -> Printf.sprintf "List_item(indent=%d, bullet=%S)" d.lid_indent d.lid_bullet
82
Added:
| L.List_item d ->
83
Added:
Printf.sprintf "List_item(indent=%d, bullet=%S)" d.lid_indent d.lid_bullet
74
84
| L.Table_row _ -> "Table_row"
75
85
| L.Fixed_width s -> Printf.sprintf "Fixed_width(%S)" s
76
86
| L.Comment_line s -> Printf.sprintf "Comment_line(%S)" s
@@ -120,15 +130,18 @@
120
130
121
131
let test_lex_list_unordered () =
122
132
let toks = lex "- item one" in
123
Removed:
check_tok "unordered list" "List_item(indent=0, bullet=\"- \")" (List.nth toks 0)
133
Added:
check_tok "unordered list" "List_item(indent=0, bullet=\"- \")"
134
Added:
(List.nth toks 0)
124
135
125
136
let test_lex_list_ordered () =
126
137
let toks = lex "1. first item" in
127
Removed:
check_tok "ordered list" "List_item(indent=0, bullet=\"1. \")" (List.nth toks 0)
138
Added:
check_tok "ordered list" "List_item(indent=0, bullet=\"1. \")"
139
Added:
(List.nth toks 0)
128
140
129
141
let test_lex_list_indented () =
130
142
let toks = lex " - nested" in
131
Removed:
check_tok "indented list" "List_item(indent=2, bullet=\"- \")" (List.nth toks 0)
143
Added:
check_tok "indented list" "List_item(indent=2, bullet=\"- \")"
144
Added:
(List.nth toks 0)
132
145
133
146
let test_lex_table () =
134
147
let toks = lex "| a | b | c |" in
@@ -182,105 +195,132 @@
182
195
let doc = parse input in
183
196
Alcotest.(check int) "one heading" 1 (List.length doc.R.rd_headings);
184
197
let h = List.hd doc.R.rd_headings in
185
Removed:
let has_paragraph = List.exists (function R.Raw_paragraph ls -> List.length ls > 0 | _ -> false) h.R.rh_body in
198
Added:
let has_paragraph =
199
Added:
List.exists
200
Added:
(function R.Raw_paragraph ls -> List.length ls > 0 | _ -> false)
201
Added:
h.R.rh_body
202
Added:
in
186
203
Alcotest.(check bool) "has paragraph body" true has_paragraph
187
204
188
205
let test_parse_preamble () =
189
206
let input = "Some preamble text\n\n* Heading" in
190
207
let doc = parse input in
191
Removed:
let non_blank = List.filter (function R.Raw_paragraph [] -> false | _ -> true) doc.R.rd_preamble in
208
Added:
let non_blank =
209
Added:
List.filter
210
Added:
(function R.Raw_paragraph [] -> false | _ -> true)
211
Added:
doc.R.rd_preamble
212
Added:
in
192
213
Alcotest.(check bool) "has preamble" true (List.length non_blank > 0);
193
214
Alcotest.(check int) "one heading" 1 (List.length doc.R.rd_headings)
194
215
195
216
let test_parse_keyword () =
196
217
let input = "#+TITLE: My Doc\n* Heading" in
197
218
let doc = parse input in
198
Removed:
let has_kw = List.exists (function R.Raw_keyword ("TITLE", _) -> true | _ -> false) doc.R.rd_preamble in
219
Added:
let has_kw =
220
Added:
List.exists
221
Added:
(function R.Raw_keyword ("TITLE", _) -> true | _ -> false)
222
Added:
doc.R.rd_preamble
223
Added:
in
199
224
Alcotest.(check bool) "has title keyword" true has_kw
200
225
201
226
let test_parse_block () =
202
227
let input = "#+begin_src ocaml\nlet x = 42\n#+end_src" in
203
228
let doc = parse input in
204
Removed:
let has_block = List.exists (function R.Raw_block _ -> true | _ -> false) doc.R.rd_preamble in
229
Added:
let has_block =
230
Added:
List.exists
231
Added:
(function R.Raw_block _ -> true | _ -> false)
232
Added:
doc.R.rd_preamble
233
Added:
in
205
234
Alcotest.(check bool) "has block" true has_block
206
235
207
236
let test_parse_list () =
208
237
let input = "- item one\n- item two" in
209
238
let doc = parse input in
210
Removed:
let has_list = List.exists (function R.Raw_list_items _ -> true | _ -> false) doc.R.rd_preamble in
239
Added:
let has_list =
240
Added:
List.exists
241
Added:
(function R.Raw_list_items _ -> true | _ -> false)
242
Added:
doc.R.rd_preamble
243
Added:
in
211
244
Alcotest.(check bool) "has list" true has_list
212
245
213
246
(* Inline parser tests *)
214
247
let test_inline_plain () =
215
248
let result = parse_inline "hello world" in
216
249
match result with
217
Removed:
| [A.Plain s] -> Alcotest.(check string) "plain" "hello world" s
250
Added:
| [ A.Plain s ] -> Alcotest.(check string) "plain" "hello world" s
218
251
| _ -> Alcotest.fail "expected single Plain"
219
252
220
253
let test_inline_bold () =
221
254
let result = parse_inline "*bold*" in
222
255
match result with
223
Removed:
| [A.Bold [A.Plain s]] -> Alcotest.(check string) "bold content" "bold" s
256
Added:
| [ A.Bold [ A.Plain s ] ] -> Alcotest.(check string) "bold content" "bold" s
224
257
| _ -> Alcotest.fail "expected Bold"
225
258
226
259
let test_inline_italic () =
227
260
let result = parse_inline "/italic/" in
228
261
match result with
229
Removed:
| [A.Italic [A.Plain s]] -> Alcotest.(check string) "italic content" "italic" s
262
Added:
| [ A.Italic [ A.Plain s ] ] ->
263
Added:
Alcotest.(check string) "italic content" "italic" s
230
264
| _ -> Alcotest.fail "expected Italic"
231
265
232
266
let test_inline_code () =
233
267
let result = parse_inline "~code~" in
234
268
match result with
235
Removed:
| [A.Code s] -> Alcotest.(check string) "code content" "code" s
269
Added:
| [ A.Code s ] -> Alcotest.(check string) "code content" "code" s
236
270
| _ -> Alcotest.fail "expected Code"
237
271
238
272
let test_inline_verbatim () =
239
273
let result = parse_inline "=verb=" in
240
274
match result with
241
Removed:
| [A.Verbatim s] -> Alcotest.(check string) "verbatim content" "verb" s
275
Added:
| [ A.Verbatim s ] -> Alcotest.(check string) "verbatim content" "verb" s
242
276
| _ -> Alcotest.fail "expected Verbatim"
243
277
244
278
let test_inline_link () =
245
279
let result = parse_inline "[[https://org.org][Org]]" in
246
280
match result with
247
Removed:
| [A.Link lnk] ->
248
Removed:
(match lnk.target with
249
Removed:
| A.Url u -> Alcotest.(check string) "url" "https://org.org" u
250
Removed:
| _ -> Alcotest.fail "expected Url target");
251
Removed:
(match lnk.description with
252
Removed:
| Some [A.Plain d] -> Alcotest.(check string) "desc" "Org" d
253
Removed:
| _ -> Alcotest.fail "expected description")
281
Added:
| [ A.Link lnk ] -> (
282
Added:
(match lnk.target with
283
Added:
| A.Url u -> Alcotest.(check string) "url" "https://org.org" u
284
Added:
| _ -> Alcotest.fail "expected Url target");
285
Added:
match lnk.description with
286
Added:
| Some [ A.Plain d ] -> Alcotest.(check string) "desc" "Org" d
287
Added:
| _ -> Alcotest.fail "expected description")
254
288
| _ -> Alcotest.fail "expected Link"
255
289
256
290
let test_inline_link_no_desc () =
257
291
let result = parse_inline "[[file:readme.org]]" in
258
292
match result with
259
Removed:
| [A.Link lnk] ->
260
Removed:
(match lnk.target with
261
Removed:
| A.File f -> Alcotest.(check string) "file" "readme.org" f
262
Removed:
| _ -> Alcotest.fail "expected File target");
263
Removed:
Alcotest.(check bool) "no description" true (lnk.description = None)
293
Added:
| [ A.Link lnk ] ->
294
Added:
(match lnk.target with
295
Added:
| A.File f -> Alcotest.(check string) "file" "readme.org" f
296
Added:
| _ -> Alcotest.fail "expected File target");
297
Added:
Alcotest.(check bool) "no description" true (lnk.description = None)
264
298
| _ -> Alcotest.fail "expected Link"
265
299
266
300
let test_inline_timestamp () =
267
301
let result = parse_inline "<2024-01-15 Mon>" in
268
302
match result with
269
Removed:
| [A.Timestamp (A.Active (d, _))] ->
270
Removed:
Alcotest.(check int) "year" 2024 d.year;
271
Removed:
Alcotest.(check int) "month" 1 d.month;
272
Removed:
Alcotest.(check int) "day" 15 d.day
303
Added:
| [ A.Timestamp (A.Active (d, _)) ] ->
304
Added:
Alcotest.(check int) "year" 2024 d.year;
305
Added:
Alcotest.(check int) "month" 1 d.month;
306
Added:
Alcotest.(check int) "day" 15 d.day
273
307
| _ -> Alcotest.fail "expected active timestamp"
274
308
275
309
let test_inline_plain_link () =
276
310
let result = parse_inline "see https://example.com for info" in
277
Removed:
let has_link = List.exists (function A.Link _ -> true | _ -> false) result in
311
Added:
let has_link =
312
Added:
List.exists (function A.Link _ -> true | _ -> false) result
313
Added:
in
278
314
Alcotest.(check bool) "has plain link" true has_link
279
315
280
316
let test_inline_mixed () =
281
317
let result = parse_inline "Hello *bold* and ~code~" in
282
Removed:
let has_bold = List.exists (function A.Bold _ -> true | _ -> false) result in
283
Removed:
let has_code = List.exists (function A.Code _ -> true | _ -> false) result in
318
Added:
let has_bold =
319
Added:
List.exists (function A.Bold _ -> true | _ -> false) result
320
Added:
in
321
Added:
let has_code =
322
Added:
List.exists (function A.Code _ -> true | _ -> false) result
323
Added:
in
284
324
Alcotest.(check bool) "has bold" true has_bold;
285
325
Alcotest.(check bool) "has code" true has_code
286
326
@@ -288,7 +328,8 @@
288
328
(* Integration tests *)
289
329
(* ================================================================== *)
290
330
291
Removed:
let full_fixture = {|#+TITLE: Integration Test Document
331
Added:
let full_fixture =
332
Added:
{|#+TITLE: Integration Test Document
292
333
#+AUTHOR: Test Author
293
334
#+TODO: TODO NEXT WAITING | DONE CANCELLED
294
335
@@ -408,17 +449,17 @@
408
449
Alcotest.(check bool) "has directives" true (List.length dirs >= 2);
409
450
let title_dir = List.find_opt (fun d -> d.A.dir_key = "TITLE") dirs in
410
451
Alcotest.(check bool) "has TITLE" true (Option.is_some title_dir);
411
Removed:
Alcotest.(check string) "TITLE value" "Integration Test Document"
412
Removed:
(Option.get title_dir).A.dir_value;
452
Added:
Alcotest.(check string)
453
Added:
"TITLE value" "Integration Test Document" (Option.get title_dir).A.dir_value;
413
454
let author_dir = List.find_opt (fun d -> d.A.dir_key = "AUTHOR") dirs in
414
455
Alcotest.(check bool) "has AUTHOR" true (Option.is_some author_dir);
415
Removed:
Alcotest.(check string) "AUTHOR value" "Test Author"
416
Removed:
(Option.get author_dir).A.dir_value;
456
Added:
Alcotest.(check string)
457
Added:
"AUTHOR value" "Test Author" (Option.get author_dir).A.dir_value;
417
458
(* Preamble *)
418
Removed:
Alcotest.(check bool) "has preamble" true
419
Removed:
(List.length full_doc.A.preamble > 0);
459
Added:
Alcotest.(check bool) "has preamble" true (List.length full_doc.A.preamble > 0);
420
460
(* Top-level headings *)
421
Removed:
Alcotest.(check int) "6 top-level headings" 6
461
Added:
Alcotest.(check int)
462
Added:
"6 top-level headings" 6
422
463
(List.length full_doc.A.headings)
423
464
424
465
let test_integration_headings () =
@@ -426,39 +467,45 @@
426
467
(* First heading: TODO, priority, tags *)
427
468
Alcotest.(check (option string)) "h1 todo" (Some "TODO") h1.A.todo;
428
469
Alcotest.(check (option char)) "h1 priority" (Some 'A') h1.A.priority;
429
Removed:
Alcotest.(check (list string)) "h1 tags" ["project"; "important"] h1.A.tags;
470
Added:
Alcotest.(check (list string)) "h1 tags" [ "project"; "important" ] h1.A.tags;
430
471
Alcotest.(check int) "h1 level" 1 h1.A.level;
431
472
(* Planning *)
432
473
Alcotest.(check bool) "h1 has planning" true (Option.is_some h1.A.planning);
433
474
let planning = Option.get h1.A.planning in
434
Removed:
Alcotest.(check bool) "h1 has scheduled" true
475
Added:
Alcotest.(check bool)
476
Added:
"h1 has scheduled" true
435
477
(Option.is_some planning.A.scheduled);
436
478
(* Properties *)
437
Removed:
Alcotest.(check bool) "h1 has properties" true
479
Added:
Alcotest.(check bool)
480
Added:
"h1 has properties" true
438
481
(List.length h1.A.properties >= 2);
439
Removed:
let custom_id = List.find_opt
440
Removed:
(fun p -> p.A.prop_name = "CUSTOM_ID") h1.A.properties in
482
Added:
let custom_id =
483
Added:
List.find_opt (fun p -> p.A.prop_name = "CUSTOM_ID") h1.A.properties
484
Added:
in
441
485
Alcotest.(check bool) "has CUSTOM_ID" true (Option.is_some custom_id);
442
Removed:
Alcotest.(check (option string)) "CUSTOM_ID value" (Some "first-heading")
443
Removed:
(Option.get custom_id).A.prop_value;
444
Removed:
let effort = List.find_opt
445
Removed:
(fun p -> p.A.prop_name = "EFFORT") h1.A.properties in
486
Added:
Alcotest.(check (option string))
487
Added:
"CUSTOM_ID value" (Some "first-heading") (Option.get custom_id).A.prop_value;
488
Added:
let effort =
489
Added:
List.find_opt (fun p -> p.A.prop_name = "EFFORT") h1.A.properties
490
Added:
in
446
491
Alcotest.(check bool) "has EFFORT" true (Option.is_some effort);
447
Removed:
Alcotest.(check (option string)) "EFFORT value" (Some "2h")
448
Removed:
(Option.get effort).A.prop_value;
492
Added:
Alcotest.(check (option string))
493
Added:
"EFFORT value" (Some "2h") (Option.get effort).A.prop_value;
449
494
(* Children of first heading *)
450
495
Alcotest.(check int) "h1 has 2 children" 2 (List.length h1.A.children);
451
496
let child1 = List.nth h1.A.children 0 in
452
497
Alcotest.(check (option string)) "child1 todo" (Some "DONE") child1.A.todo;
453
498
(* DONE sub-heading has CLOSED planning *)
454
Removed:
Alcotest.(check bool) "child1 has planning" true
499
Added:
Alcotest.(check bool)
500
Added:
"child1 has planning" true
455
501
(Option.is_some child1.A.planning);
456
502
let child1_planning = Option.get child1.A.planning in
457
Removed:
Alcotest.(check bool) "child1 has closed" true
503
Added:
Alcotest.(check bool)
504
Added:
"child1 has closed" true
458
505
(Option.is_some child1_planning.A.closed);
459
506
let child2 = List.nth h1.A.children 1 in
460
507
Alcotest.(check (option string)) "child2 todo" (Some "NEXT") child2.A.todo;
461
Removed:
Alcotest.(check (list string)) "child2 tags" ["review"] child2.A.tags;
508
Added:
Alcotest.(check (list string)) "child2 tags" [ "review" ] child2.A.tags;
462
509
(* Deep heading is a child of child2 *)
463
510
Alcotest.(check int) "child2 has 1 child" 1 (List.length child2.A.children);
464
511
let deep = List.nth child2.A.children 0 in
@@ -473,122 +520,181 @@
473
520
let h3 = List.nth full_doc.A.headings 2 in
474
521
(* h3 children: Unordered list, Ordered list, Descriptive list,
475
522
Source block, Quote block, Example block *)
476
Removed:
Alcotest.(check bool) "Lists and Blocks has children" true
523
Added:
Alcotest.(check bool)
524
Added:
"Lists and Blocks has children" true
477
525
(List.length h3.A.children >= 6);
478
526
(* Unordered list *)
479
527
let ul_heading = List.nth h3.A.children 0 in
480
528
let ul_elems = ul_heading.A.contents in
481
Removed:
let has_unordered = List.exists (function
482
Removed:
| A.Plain_list (A.Unordered, items) -> List.length items >= 3
483
Removed:
| _ -> false) ul_elems in
529
Added:
let has_unordered =
530
Added:
List.exists
531
Added:
(function
532
Added:
| A.Plain_list (A.Unordered, items) -> List.length items >= 3
533
Added:
| _ -> false)
534
Added:
ul_elems
535
Added:
in
484
536
Alcotest.(check bool) "has unordered list" true has_unordered;
485
537
(* Ordered list *)
486
538
let ol_heading = List.nth h3.A.children 1 in
487
539
let ol_elems = ol_heading.A.contents in
488
Removed:
let has_ordered = List.exists (function
489
Removed:
| A.Plain_list (A.Ordered, items) -> List.length items >= 3
490
Removed:
| _ -> false) ol_elems in
540
Added:
let has_ordered =
541
Added:
List.exists
542
Added:
(function
543
Added:
| A.Plain_list (A.Ordered, items) -> List.length items >= 3 | _ -> false)
544
Added:
ol_elems
545
Added:
in
491
546
Alcotest.(check bool) "has ordered list" true has_ordered;
492
547
(* Descriptive list *)
493
548
let dl_heading = List.nth h3.A.children 2 in
494
549
let dl_elems = dl_heading.A.contents in
495
Removed:
let has_descriptive = List.exists (function
496
Removed:
| A.Plain_list (A.Descriptive, items) -> List.length items >= 2
497
Removed:
| _ -> false) dl_elems in
550
Added:
let has_descriptive =
551
Added:
List.exists
552
Added:
(function
553
Added:
| A.Plain_list (A.Descriptive, items) -> List.length items >= 2
554
Added:
| _ -> false)
555
Added:
dl_elems
556
Added:
in
498
557
Alcotest.(check bool) "has descriptive list" true has_descriptive;
499
558
(* Source block *)
500
559
let src_heading = List.nth h3.A.children 3 in
501
560
let src_elems = src_heading.A.contents in
502
Removed:
let has_src = List.exists (function
503
Removed:
| A.Block (A.Src_block sb) ->
504
Removed:
sb.A.src_language = Some "ocaml" &&
505
Removed:
String.length sb.A.src_value > 0
506
Removed:
| _ -> false) src_elems in
561
Added:
let has_src =
562
Added:
List.exists
563
Added:
(function
564
Added:
| A.Block (A.Src_block sb) ->
565
Added:
sb.A.src_language = Some "ocaml" && String.length sb.A.src_value > 0
566
Added:
| _ -> false)
567
Added:
src_elems
568
Added:
in
507
569
Alcotest.(check bool) "has src block with ocaml" true has_src;
508
570
(* Quote block *)
509
571
let qt_heading = List.nth h3.A.children 4 in
510
572
let qt_elems = qt_heading.A.contents in
511
Removed:
let has_quote = List.exists (function
512
Removed:
| A.Block (A.Quote_block _) -> true
513
Removed:
| _ -> false) qt_elems in
573
Added:
let has_quote =
574
Added:
List.exists
575
Added:
(function A.Block (A.Quote_block _) -> true | _ -> false)
576
Added:
qt_elems
577
Added:
in
514
578
Alcotest.(check bool) "has quote block" true has_quote;
515
579
(* Example block *)
516
580
let ex_heading = List.nth h3.A.children 5 in
517
581
let ex_elems = ex_heading.A.contents in
518
Removed:
let has_example = List.exists (function
519
Removed:
| A.Block (A.Example_block _) -> true
520
Removed:
| _ -> false) ex_elems in
582
Added:
let has_example =
583
Added:
List.exists
584
Added:
(function A.Block (A.Example_block _) -> true | _ -> false)
585
Added:
ex_elems
586
Added:
in
521
587
Alcotest.(check bool) "has example block" true has_example;
522
588
(* Tables heading is at index 3 *)
523
589
let h4 = List.nth full_doc.A.headings 3 in
524
590
let table_elems = h4.A.contents in
525
Removed:
let has_table = List.exists (function
526
Removed:
| A.Table t ->
527
Removed:
let has_standard = List.exists (function
528
Removed:
| A.Table_row_standard _ -> true | _ -> false) t.A.rows in
529
Removed:
let has_rule = List.exists (function
530
Removed:
| A.Table_row_rule -> true | _ -> false) t.A.rows in
531
Removed:
has_standard && has_rule
532
Removed:
| _ -> false) table_elems in
591
Added:
let has_table =
592
Added:
List.exists
593
Added:
(function
594
Added:
| A.Table t ->
595
Added:
let has_standard =
596
Added:
List.exists
597
Added:
(function A.Table_row_standard _ -> true | _ -> false)
598
Added:
t.A.rows
599
Added:
in
600
Added:
let has_rule =
601
Added:
List.exists
602
Added:
(function A.Table_row_rule -> true | _ -> false)
603
Added:
t.A.rows
604
Added:
in
605
Added:
has_standard && has_rule
606
Added:
| _ -> false)
607
Added:
table_elems
608
Added:
in
533
609
Alcotest.(check bool) "has table with rows and rules" true has_table;
534
610
(* Miscellaneous heading is at index 4 *)
535
611
let h5 = List.nth full_doc.A.headings 4 in
536
612
let misc_elems = h5.A.contents in
537
Removed:
let has_fixed_width = List.exists (function
538
Removed:
| A.Fixed_width lines -> List.length lines >= 2
539
Removed:
| _ -> false) misc_elems in
613
Added:
let has_fixed_width =
614
Added:
List.exists
615
Added:
(function A.Fixed_width lines -> List.length lines >= 2 | _ -> false)
616
Added:
misc_elems
617
Added:
in
540
618
Alcotest.(check bool) "has fixed-width" true has_fixed_width;
541
Removed:
let has_comment = List.exists (function
542
Removed:
| A.Comment lines -> List.length lines >= 2
543
Removed:
| _ -> false) misc_elems in
619
Added:
let has_comment =
620
Added:
List.exists
621
Added:
(function A.Comment lines -> List.length lines >= 2 | _ -> false)
622
Added:
misc_elems
623
Added:
in
544
624
Alcotest.(check bool) "has comment" true has_comment;
545
Removed:
let has_hrule = List.exists (function
546
Removed:
| A.Horizontal_rule -> true
547
Removed:
| _ -> false) misc_elems in
625
Added:
let has_hrule =
626
Added:
List.exists (function A.Horizontal_rule -> true | _ -> false) misc_elems
627
Added:
in
548
628
Alcotest.(check bool) "has horizontal rule" true has_hrule;
549
Removed:
let has_drawer = List.exists (function
550
Removed:
| A.Drawer ("NOTES", _) -> true
551
Removed:
| _ -> false) misc_elems in
629
Added:
let has_drawer =
630
Added:
List.exists
631
Added:
(function A.Drawer ("NOTES", _) -> true | _ -> false)
632
Added:
misc_elems
633
Added:
in
552
634
Alcotest.(check bool) "has drawer" true has_drawer
553
635
554
636
let test_integration_inline () =
555
637
(* Preamble paragraph should have inline markup *)
556
Removed:
let preamble_para = List.find_opt (function
557
Removed:
| A.Paragraph _ -> true | _ -> false) full_doc.A.preamble in
558
Removed:
Alcotest.(check bool) "preamble has paragraph" true
638
Added:
let preamble_para =
639
Added:
List.find_opt
640
Added:
(function A.Paragraph _ -> true | _ -> false)
641
Added:
full_doc.A.preamble
642
Added:
in
643
Added:
Alcotest.(check bool)
644
Added:
"preamble has paragraph" true
559
645
(Option.is_some preamble_para);
560
Removed:
let inlines = match preamble_para with
561
Removed:
| Some (A.Paragraph (il, _)) -> il
562
Removed:
| _ -> [] in
563
Removed:
let has_bold = List.exists (function A.Bold _ -> true | _ -> false) inlines in
564
Removed:
let has_italic = List.exists (function A.Italic _ -> true | _ -> false) inlines in
565
Removed:
let has_code = List.exists (function A.Code _ -> true | _ -> false) inlines in
646
Added:
let inlines =
647
Added:
match preamble_para with Some (A.Paragraph (il, _)) -> il | _ -> []
648
Added:
in
649
Added:
let has_bold =
650
Added:
List.exists (function A.Bold _ -> true | _ -> false) inlines
651
Added:
in
652
Added:
let has_italic =
653
Added:
List.exists (function A.Italic _ -> true | _ -> false) inlines
654
Added:
in
655
Added:
let has_code =
656
Added:
List.exists (function A.Code _ -> true | _ -> false) inlines
657
Added:
in
566
658
Alcotest.(check bool) "preamble has bold" true has_bold;
567
659
Alcotest.(check bool) "preamble has italic" true has_italic;
568
660
Alcotest.(check bool) "preamble has code" true has_code;
569
661
(* Second preamble paragraph should have a plain link *)
570
Removed:
let preamble_paras = List.filter (function
571
Removed:
| A.Paragraph _ -> true | _ -> false) full_doc.A.preamble in
572
Removed:
Alcotest.(check bool) "preamble has 2+ paragraphs" true
662
Added:
let preamble_paras =
663
Added:
List.filter
664
Added:
(function A.Paragraph _ -> true | _ -> false)
665
Added:
full_doc.A.preamble
666
Added:
in
667
Added:
Alcotest.(check bool)
668
Added:
"preamble has 2+ paragraphs" true
573
669
(List.length preamble_paras >= 2);
574
Removed:
let para2_inlines = match List.nth preamble_paras 1 with
575
Removed:
| A.Paragraph (il, _) -> il
576
Removed:
| _ -> [] in
577
Removed:
let has_link = List.exists (function A.Link _ -> true | _ -> false)
578
Removed:
para2_inlines in
670
Added:
let para2_inlines =
671
Added:
match List.nth preamble_paras 1 with A.Paragraph (il, _) -> il | _ -> []
672
Added:
in
673
Added:
let has_link =
674
Added:
List.exists (function A.Link _ -> true | _ -> false) para2_inlines
675
Added:
in
579
676
Alcotest.(check bool) "preamble para2 has link" true has_link;
580
677
(* Timestamps heading (index 5) *)
581
678
let h6 = List.nth full_doc.A.headings 5 in
582
679
let ts_elems = h6.A.contents in
583
Removed:
let all_inlines = List.concat_map (function
584
Removed:
| A.Paragraph (il, _) -> il
585
Removed:
| _ -> []) ts_elems in
586
Removed:
let has_active_ts = List.exists (function
587
Removed:
| A.Timestamp (A.Active _) -> true | _ -> false) all_inlines in
588
Removed:
let has_inactive_ts = List.exists (function
589
Removed:
| A.Timestamp (A.Inactive _) -> true | _ -> false) all_inlines in
590
Removed:
let has_range = List.exists (function
591
Removed:
| A.Timestamp (A.Active_range _) -> true | _ -> false) all_inlines in
680
Added:
let all_inlines =
681
Added:
List.concat_map (function A.Paragraph (il, _) -> il | _ -> []) ts_elems
682
Added:
in
683
Added:
let has_active_ts =
684
Added:
List.exists
685
Added:
(function A.Timestamp (A.Active _) -> true | _ -> false)
686
Added:
all_inlines
687
Added:
in
688
Added:
let has_inactive_ts =
689
Added:
List.exists
690
Added:
(function A.Timestamp (A.Inactive _) -> true | _ -> false)
691
Added:
all_inlines
692
Added:
in
693
Added:
let has_range =
694
Added:
List.exists
695
Added:
(function A.Timestamp (A.Active_range _) -> true | _ -> false)
696
Added:
all_inlines
697
Added:
in
592
698
Alcotest.(check bool) "has active timestamp" true has_active_ts;
593
699
Alcotest.(check bool) "has inactive timestamp" true has_inactive_ts;
594
700
Alcotest.(check bool) "has timestamp range" true has_range
@@ -634,7 +740,8 @@
634
740
[
635
741
Alcotest.test_case "empty document" `Quick test_parse_empty;
636
742
Alcotest.test_case "single heading" `Quick test_parse_single_heading;
637
Removed:
Alcotest.test_case "heading with body" `Quick test_parse_heading_with_body;
743
Added:
Alcotest.test_case "heading with body" `Quick
744
Added:
test_parse_heading_with_body;
638
745
Alcotest.test_case "preamble" `Quick test_parse_preamble;
639
746
Alcotest.test_case "keyword" `Quick test_parse_keyword;
640
747
Alcotest.test_case "block" `Quick test_parse_block;