[OCaml] Org mode parser.
feat initial implementation of ocaml-org parser library
Implement a complete Org Mode parser that transforms Org documents into a strongly-typed semantic AST covering the 80% most-used Org features. Architecture: - Handwritten structural lexer (line-oriented, context-aware) - Menhir structural grammar (tokens → raw document tree) - Handwritten inline lexer (pre-scans matched emphasis pairs) - Menhir inline grammar (tokens → semantic inline objects) - Normalization phase (raw tree → semantic AST) - Pre-scan phase (file-local TODO declarations) - Lightweight diagnostic reporting Supported structural syntax: - Document preamble, heading hierarchy - TODO states, priorities, tags, planning, property drawers - Paragraphs, unordered/ordered/descriptive lists - Source/example/export/comment/quote/center/verse/custom blocks - Tables, drawers, keywords, affiliated keywords - Comments, fixed-width, horizontal rules Supported inline syntax: - Bold, italic, underline, strikethrough, code, verbatim - Regular links, angle links, plain links - Active/inactive timestamps, timestamp ranges - Explicit line breaks Test suite: 47 tests (prescan, lexer, structural parser, inline parser, end-to-end integration).
Changed files
- .gitignore
- .kiro/steering/git.md
- .kiro/steering/main.md
- .ocamlformat
- dune-project
- lib/ast.ml
- lib/ast.mli
- lib/config.ml
- lib/diagnostic.ml
- lib/dune
- lib/inline_lexer.ml
- lib/inline_parser.mly
- lib/lexer.ml
- lib/normalize.ml
- lib/org.ml
- lib/parse_bridge.ml
- lib/parser.mly
- lib/prescan.ml
- lib/raw_ast.ml
- ocaml-org.opam
- test/dune
- test/fixtures/.gitkeep
- test/fixtures/full.org
- test/test_main.ml
.gitignore
@@ -0,0 +1,3 @@
1
Added:
_build/
2
Added:
_opam/
3
Added:
.agent-shell/
.kiro/steering/git.md
@@ -0,0 +1,140 @@
1
Added:
---
2
Added:
3
Added:
## inclusion: always
4
Added:
5
Added:
# Git Conventions
6
Added:
7
Added:
This project uses Git for version control. Follow these conventions
8
Added:
for all commits and branches.
9
Added:
10
Added:
## Conventional Commits
11
Added:
12
Added:
All commit messages must follow the Conventional Commits
13
Added:
specification (https://www.conventionalcommits.org/).
14
Added:
15
Added:
### Format
16
Added:
17
Added:
```
18
Added:
<type>[optional scope]: <description>
19
Added:
20
Added:
[optional body]
21
Added:
22
Added:
[optional footer(s)]
23
Added:
```
24
Added:
25
Added:
### Types
26
Added:
27
Added:
| Type | Purpose |
28
Added:
|------------|---------------------------------------------------------|
29
Added:
| `feat` | A new feature or capability |
30
Added:
| `fix` | A bug fix |
31
Added:
| `refactor` | Code change that neither fixes a bug nor adds a feature |
32
Added:
| `test` | Adding or updating tests |
33
Added:
| `docs` | Documentation changes |
34
Added:
| `chore` | Build process, tooling, or auxiliary changes |
35
Added:
| `ci` | CI/CD configuration changes |
36
Added:
| `perf` | Performance improvement |
37
Added:
| `style` | Code style changes (formatting, whitespace) |
38
Added:
39
Added:
### Scopes
40
Added:
41
Added:
Use a scope to indicate the area affected. Common scopes for this
42
Added:
project:
43
Added:
44
Added:
* `lexer` — lexer recognition changes
45
Added:
* `parser` — Menhir grammar changes
46
Added:
* `ast` — AST type definitions
47
Added:
* `normalize` — normalization phase
48
Added:
* `inline` — inline parsing
49
Added:
* `prescan` — pre-scan configuration discovery
50
Added:
* `diagnostic` — diagnostic reporting
51
Added:
* `test` — test infrastructure (not individual test additions)
52
Added:
53
Added:
Omit the scope when the change is cross-cutting or does not fit a
54
Added:
single module.
55
Added:
56
Added:
### Rules
57
Added:
58
Added:
* Use the imperative mood in the description: "add heading parser",
59
Added:
not "added heading parser".
60
Added:
* Keep the first line under 72 characters.
61
Added:
* Do not end the description with a period.
62
Added:
* Use the body to explain *what* and *why*, not *how*.
63
Added:
* Use `BREAKING CHANGE:` in the footer when a change breaks the
64
Added:
public API.
65
Added:
* A `!` after the type/scope indicates a breaking change:
66
Added:
`feat(ast)!: restructure heading representation`.
67
Added:
68
Added:
### Examples
69
Added:
70
Added:
```
71
Added:
feat(lexer): add keyword line classification
72
Added:
73
Added:
Recognize lines matching #+KEY: VALUE as Keyword tokens.
74
Added:
```
75
Added:
76
Added:
```
77
Added:
fix(normalize): attach affiliated keywords across blank lines
78
Added:
79
Added:
Previously affiliated keywords separated by a blank line from their
80
Added:
target element were left as standalone nodes. Now they correctly
81
Added:
remain unattached per the Org spec.
82
Added:
```
83
Added:
84
Added:
```
85
Added:
test: add malformed block recovery fixtures
86
Added:
```
87
Added:
88
Added:
```
89
Added:
refactor(parser): extract list item grouping into helper function
90
Added:
```
91
Added:
92
Added:
## Conventional Branches
93
Added:
94
Added:
### Branch naming format
95
Added:
96
Added:
```
97
Added:
<type>/<short-description>
98
Added:
```
99
Added:
100
Added:
Use kebab-case for the description. Keep it concise but descriptive.
101
Added:
102
Added:
### Branch types
103
Added:
104
Added:
| Prefix | Purpose |
105
Added:
|-------------|----------------------------------------------------|
106
Added:
| `feat/` | Feature development |
107
Added:
| `fix/` | Bug fixes |
108
Added:
| `refactor/` | Refactoring without behavior change |
109
Added:
| `test/` | Test additions or infrastructure |
110
Added:
| `docs/` | Documentation work |
111
Added:
| `chore/` | Tooling, build, or maintenance |
112
Added:
113
Added:
### Rules
114
Added:
115
Added:
* Branch from `master` unless working on a dependent feature.
116
Added:
* One logical change per branch.
117
Added:
* Do not reuse branch names after merging.
118
Added:
* Delete branches after they are merged.
119
Added:
120
Added:
### Examples
121
Added:
122
Added:
```
123
Added:
feat/heading-parser
124
Added:
fix/list-indentation-edge-case
125
Added:
refactor/inline-lexer-modes
126
Added:
test/block-recovery-fixtures
127
Added:
docs/update-support-matrix
128
Added:
chore/upgrade-menhir
129
Added:
```
130
Added:
131
Added:
## General Git practices
132
Added:
133
Added:
* Keep commits atomic: one logical change per commit.
134
Added:
* Do not mix formatting changes with behavioral changes in the same
135
Added:
commit.
136
Added:
* Prefer rebase workflows to keep linear history on `master`.
137
Added:
* Squash fixup commits before merging to `master`.
138
Added:
* Do not commit generated files (build artifacts, `.merlin`, etc.).
139
Added:
* Do not commit editor-specific files unless shared tooling requires
140
Added:
them.
.kiro/steering/main.md
@@ -0,0 +1,970 @@
1
Added:
---
2
Added:
3
Added:
## inclusion: always
4
Added:
5
Added:
# OCaml Org Mode Parser
6
Added:
7
Added:
## Project mission
8
Added:
9
Added:
Build a compact, high-quality OCaml library whose primary
10
Added:
responsibility is parsing Org Mode documents into a semantic, strongly
11
Added:
typed abstract syntax tree.
12
Added:
13
Added:
The library is intended to serve as infrastructure for downstream
14
Added:
consumers such as:
15
Added:
16
Added:
* HTML renderers;
17
Added:
* document-analysis tools;
18
Added:
* Patoline input support;
19
Added:
* formatters and printers maintained in separate libraries.
20
Added:
21
Added:
Keep the parser focused. Do not turn it into an Org execution
22
Added:
environment, editor engine, document renderer, or general
23
Added:
document-processing framework.
24
Added:
25
Added:
## Source of truth
26
Added:
27
Added:
The current official Org Mode syntax specification is the normative
28
Added:
reference for syntax and parsing behavior.
29
Added:
30
Added:
<https://orgmode.org/worg/org-syntax.html>
31
Added:
32
Added:
When the specification is ambiguous:
33
Added:
34
Added:
1. prefer the documented behavior of Org Mode;
35
Added:
2. prefer semantic usefulness over preservation of surface spelling;
36
Added:
3. prefer permissive recovery over rejecting the document;
37
Added:
4. document any deliberate simplification;
38
Added:
5. add a fixture that demonstrates the chosen behavior.
39
Added:
40
Added:
The target is practical coverage of approximately 80% of commonly used
41
Added:
Org syntax, not exact compatibility with every behavior of Emacs Org
42
Added:
Mode or `org-element`.
43
Added:
44
Added:
Do not claim exact Org compatibility unless it has been demonstrated
45
Added:
by tests.
46
Added:
47
Added:
## Core product principles
48
Added:
49
Added:
### One primary responsibility
50
Added:
51
Added:
The library parses Org syntax.
52
Added:
53
Added:
It must not:
54
Added:
55
Added:
* render HTML, LaTeX, Patoline, Markdown, or other output formats;
56
Added:
* evaluate Babel source blocks;
57
Added:
* execute inline source code;
58
Added:
* resolve or fetch external links;
59
Added:
* expand macros;
60
Added:
* evaluate table formulas;
61
Added:
* mutate or rewrite Org documents;
62
Added:
* provide editor-specific incremental parsing;
63
Added:
* depend on an Emacs process;
64
Added:
* reproduce the full Org runtime environment.
65
Added:
66
Added:
Downstream libraries may interpret or render the AST.
67
Added:
68
Added:
### Semantic AST
69
Added:
70
Added:
Prioritize semantic meaning over exact source representation.
71
Added:
72
Added:
The parser does not need to be lossless. It may normalize
73
Added:
insignificant syntax such as:
74
Added:
75
Added:
* redundant blank lines;
76
Added:
* line endings;
77
Added:
* ordinary physical newlines within paragraphs;
78
Added:
* equivalent keyword capitalization where Org treats it as
79
Added:
insignificant.
80
Added:
81
Added:
Preserve text exactly where whitespace is semantically meaningful,
82
Added:
including:
83
Added:
84
Added:
* source block bodies;
85
Added:
* example block bodies;
86
Added:
* export block bodies;
87
Added:
* comment block bodies;
88
Added:
* code objects;
89
Added:
* verbatim objects;
90
Added:
* fixed-width content.
91
Added:
92
Added:
The AST is initially read-only. Do not design around arbitrary AST
93
Added:
editing or byte-for-byte serialization.
94
Added:
95
Added:
### Small public API
96
Added:
97
Added:
Keep the public API narrow and stable.
98
Added:
99
Added:
The initial public entry point should be conceptually equivalent to:
100
Added:
101
Added:
```ocaml
102
Added:
val parse : string -> Ast.document
103
Added:
```
104
Added:
105
Added:
A diagnostic API may also be provided:
106
Added:
107
Added:
```ocaml
108
Added:
val parse_with_diagnostics :
109
Added:
string -> Ast.document * Diagnostic.t list
110
Added:
```
111
Added:
112
Added:
Do not expose lexer tokens, raw parser nodes, parser stacks, mutable
113
Added:
cursors, or normalization internals unless a demonstrated use case
114
Added:
requires it.
115
Added:
116
Added:
### Strongly typed representation
117
Added:
118
Added:
Use closed OCaml variants and records for known Org constructs.
119
Added:
120
Added:
Prefer:
121
Added:
122
Added:
```ocaml
123
Added:
type element =
124
Added:
| Paragraph of inline list
125
Added:
| Plain_list of plain_list
126
Added:
| Table of table
127
Added:
| Drawer of drawer
128
Added:
| Block of block
129
Added:
| Keyword of keyword
130
Added:
| Comment of string
131
Added:
| Fixed_width of string list
132
Added:
| Horizontal_rule
133
Added:
```
134
Added:
135
Added:
Avoid generic stringly typed node maps such as:
136
Added:
137
Added:
```ocaml
138
Added:
type node = {
139
Added:
kind : string;
140
Added:
properties : (string * string) list;
141
Added:
children : node list;
142
Added:
}
143
Added:
```
144
Added:
145
Added:
Use ordinary strings only for genuinely open namespaces, including:
146
Added:
147
Added:
* custom block names;
148
Added:
* unknown keywords;
149
Added:
* property names;
150
Added:
* language identifiers;
151
Added:
* link protocols;
152
Added:
* user-defined TODO keywords.
153
Added:
154
Added:
The type system should make important structural distinctions visible
155
Added:
without making extensions impossible.
156
Added:
157
Added:
## Compatibility model
158
Added:
159
Added:
### Supported configuration
160
Added:
161
Added:
External Emacs configuration is unavailable and out of scope.
162
Added:
163
Added:
Start with the defaults documented by the Org syntax
164
Added:
specification. Allow supported file-local declarations to override
165
Added:
those defaults.
166
Added:
167
Added:
Examples include file-local TODO declarations such as:
168
Added:
169
Added:
```org
170
Added:
#+TODO: TODO WAITING | DONE CANCELLED
171
Added:
```
172
Added:
173
Added:
Do not read:
174
Added:
175
Added:
* user Emacs configuration;
176
Added:
* directory-local Emacs variables;
177
Added:
* active minor modes;
178
Added:
* loaded Emacs packages;
179
Added:
* environment-specific Org variables.
180
Added:
181
Added:
### File-wide declarations
182
Added:
183
Added:
Syntax-affecting file declarations may occur anywhere in a document
184
Added:
and may affect constructs appearing before them.
185
Added:
186
Added:
Use a lightweight whole-file pre-scan to collect supported syntax
187
Added:
settings before the main parse.
188
Added:
189
Added:
This does not violate the single-grammar objective. The pre-scan only
190
Added:
discovers document configuration; it does not construct the document
191
Added:
AST.
192
Added:
193
Added:
Ordinary metadata keywords such as `#+TITLE` remain document elements
194
Added:
and must not disappear merely because the pre-scan inspected them.
195
Added:
196
Added:
### Tracking Org syntax
197
Added:
198
Added:
Target the latest published Org syntax rather than freezing
199
Added:
compatibility to an old Org release.
200
Added:
201
Added:
Changes to supported syntax must be:
202
Added:
203
Added:
* isolated in focused commits;
204
Added:
* covered by tests;
205
Added:
* recorded in release notes;
206
Added:
* assessed for AST compatibility.
207
Added:
208
Added:
Avoid speculative support for undocumented behavior.
209
Added:
210
Added:
## Parser architecture
211
Added:
212
Added:
### Menhir prototype
213
Added:
214
Added:
Use Menhir for the initial parser prototype.
215
Added:
216
Added:
Use its conventional deterministic LR parsing mode unless a concrete
217
Added:
grammar problem demonstrates that another mode is necessary.
218
Added:
219
Added:
Do not introduce GLR, Earley parsing, or generalized ambiguity
220
Added:
handling merely because Org has complex syntax. Org usually selects a
221
Added:
preferred interpretation through contextual and ordered recognition
222
Added:
rules rather than requiring multiple parse trees.
223
Added:
224
Added:
### OCaml-native dependencies
225
Added:
226
Added:
Dependencies are acceptable when they belong to the OCaml ecosystem
227
Added:
and do not rely on unstable external runtimes or system libraries.
228
Added:
229
Added:
Acceptable categories include:
230
Added:
231
Added:
* Menhir;
232
Added:
* pure-OCaml Unicode libraries;
233
Added:
* pure-OCaml test libraries;
234
Added:
* Dune tooling.
235
Added:
236
Added:
Avoid dependencies that require:
237
Added:
238
Added:
* C stubs, unless later explicitly approved;
239
Added:
* system-installed parsing libraries;
240
Added:
* an Emacs runtime;
241
Added:
* external language runtimes;
242
Added:
* network access during parsing;
243
Added:
* platform-specific services.
244
Added:
245
Added:
For the prototype, treat UTF-8 text as opaque OCaml
246
Added:
strings. Structural Org delimiters are ASCII. Do not add Unicode
247
Added:
classification until a supported production demonstrably requires it.
248
Added:
249
Added:
Never corrupt, reinterpret, or normalize non-ASCII byte sequences
250
Added:
unnecessarily.
251
Added:
252
Added:
### One grammar, multiple syntactic scales
253
Added:
254
Added:
Org contains two principal scales:
255
Added:
256
Added:
* structural elements such as headings, lists, blocks, drawers,
257
Added:
tables, and paragraphs;
258
Added:
* inline objects such as emphasis, links, timestamps, entities, code,
259
Added:
and verbatim text.
260
Added:
261
Added:
They may use separate Menhir start symbols or lexer modes while
262
Added:
remaining part of one parser implementation and one coherent grammar.
263
Added:
264
Added:
A suitable model is:
265
Added:
266
Added:
```menhir
267
Added:
%start <Raw_ast.document> document
268
Added:
%start <Ast.inline list> inline_document
269
Added:
```
270
Added:
271
Added:
Do not force block-level lines and inline punctuation through one
272
Added:
uniform token stream when that makes the grammar less understandable.
273
Added:
274
Added:
### Line-oriented structural lexer
275
Added:
276
Added:
Use a small line-oriented structural lexer.
277
Added:
278
Added:
Classify physical lines into high-level tokens such as:
279
Added:
280
Added:
```ocaml
281
Added:
type token =
282
Added:
| Blank
283
Added:
| Heading of int * string
284
Added:
| Keyword of string * string
285
Added:
| Begin_block of string * string option
286
Added:
| End_block of string
287
Added:
| Drawer_begin of string
288
Added:
| Drawer_end
289
Added:
| Property of string * string
290
Added:
| List_item of raw_list_item
291
Added:
| Table_row of string
292
Added:
| Fixed_width of string
293
Added:
| Comment_line of string
294
Added:
| Horizontal_rule
295
Added:
| Text_line of string
296
Added:
| Eof
297
Added:
```
298
Added:
299
Added:
The exact constructors may evolve during the design phase.
300
Added:
301
Added:
Keep lexical recognition conservative. A malformed or uncertain
302
Added:
construct should normally become `Text_line`, allowing it to survive
303
Added:
as paragraph text.
304
Added:
305
Added:
Do not place complex document hierarchy or semantic interpretation in
306
Added:
the lexer.
307
Added:
308
Added:
### Raw and semantic representations
309
Added:
310
Added:
It is acceptable and encouraged to distinguish:
311
Added:
312
Added:
1. a private raw parse representation;
313
Added:
2. the public semantic AST.
314
Added:
315
Added:
Menhir should parse syntactic ordering and grouping. A narrow
316
Added:
normalization phase may then handle relationships that are unsuitable
317
Added:
for direct LR productions.
318
Added:
319
Added:
Examples include:
320
Added:
321
Added:
* converting flat headings into a hierarchy;
322
Added:
* interpreting heading title components;
323
Added:
* attaching planning data to headings;
324
Added:
* attaching property drawers to headings;
325
Added:
* nesting list items according to indentation;
326
Added:
* attaching affiliated keywords to eligible elements;
327
Added:
* joining paragraph lines;
328
Added:
* invoking inline parsing on bounded text fields.
329
Added:
330
Added:
The normalization phase must not become an undocumented second parser.
331
Added:
332
Added:
Every normalization rule must have:
333
Added:
334
Added:
* a clear invariant;
335
Added:
* focused unit tests;
336
Added:
* an explanation when the behavior is non-obvious.
337
Added:
338
Added:
### Whole-document parsing
339
Added:
340
Added:
Parse complete input strings.
341
Added:
342
Added:
Streaming and incremental reparsing are out of scope for the initial
343
Added:
library.
344
Added:
345
Added:
A channel-based convenience function may read the complete channel and
346
Added:
call the string parser, but do not expose a streaming guarantee.
347
Added:
348
Added:
## AST guidance
349
Added:
350
Added:
### Document structure
351
Added:
352
Added:
The semantic document should distinguish the content before the first
353
Added:
heading from the heading tree.
354
Added:
355
Added:
A representative shape is:
356
Added:
357
Added:
```ocaml
358
Added:
type document = {
359
Added:
directives : directive list;
360
Added:
preamble : element list;
361
Added:
headings : heading list;
362
Added:
}
363
Added:
```
364
Added:
365
Added:
The final field names should be chosen during design, but the
366
Added:
distinction must remain representable.
367
Added:
368
Added:
### Headings
369
Added:
370
Added:
A heading should expose semantic components rather than only its raw
371
Added:
title:
372
Added:
373
Added:
```ocaml
374
Added:
type heading = {
375
Added:
level : int;
376
Added:
todo : string option;
377
Added:
priority : char option;
378
Added:
commented : bool;
379
Added:
title : inline list;
380
Added:
tags : string list;
381
Added:
planning : planning option;
382
Added:
properties : property list;
383
Added:
contents : element list;
384
Added:
children : heading list;
385
Added:
}
386
Added:
```
387
Added:
388
Added:
Accept skipped heading levels permissively.
389
Added:
390
Added:
For example, a level-three heading following a level-one heading may
391
Added:
become a child of the most recent level-one heading even when no
392
Added:
level-two heading intervenes.
393
Added:
394
Added:
Do not reject a whole document because its hierarchy is
395
Added:
unconventional.
396
Added:
397
Added:
### Blocks
398
Added:
399
Added:
Distinguish blocks with materially different semantics.
400
Added:
401
Added:
Opaque-body blocks should include at least:
402
Added:
403
Added:
* source;
404
Added:
* example;
405
Added:
* export;
406
Added:
* comment.
407
Added:
408
Added:
Recursively parsed blocks should include at least:
409
Added:
410
Added:
* quote;
411
Added:
* center;
412
Added:
* custom blocks where appropriate.
413
Added:
414
Added:
Unknown `#+begin_NAME` forms should become `Custom_block`, not parser
415
Added:
errors.
416
Added:
417
Added:
Preserve source bodies as opaque strings. Do not parse embedded
418
Added:
programming languages.
419
Added:
420
Added:
### Affiliated keywords
421
Added:
422
Added:
Represent affiliated keywords as metadata attached to the element they
423
Added:
modify, rather than as unrelated siblings.
424
Added:
425
Added:
Do not attach an affiliated keyword across an intervening blank line
426
Added:
or in a context where Org would not treat it as affiliated.
427
Added:
428
Added:
Unknown ordinary keywords should remain representable as generic
429
Added:
keyword nodes.
430
Added:
431
Added:
### Planning and properties
432
Added:
433
Added:
Planning information and heading property drawers should be
434
Added:
represented directly on headings where possible.
435
Added:
436
Added:
Avoid constructing semantically impossible states, such as arbitrary
437
Added:
planning lines freely appearing inside every element type.
438
Added:
439
Added:
An ordinary named drawer remains a regular element.
440
Added:
441
Added:
### Inline text
442
Added:
443
Added:
Inline parsing should eventually distinguish at least:
444
Added:
445
Added:
* plain text;
446
Added:
* bold;
447
Added:
* italic;
448
Added:
* underline;
449
Added:
* strike-through;
450
Added:
* code;
451
Added:
* verbatim;
452
Added:
* links;
453
Added:
* timestamps;
454
Added:
* explicit line breaks.
455
Added:
456
Added:
Malformed inline markup should degrade to plain text.
457
Added:
458
Added:
Do not lose surrounding text merely because one inline construct is
459
Added:
malformed.
460
Added:
461
Added:
### Whitespace normalization
462
Added:
463
Added:
Unless a construct preserves literal text:
464
Added:
465
Added:
* blank lines terminate paragraphs but need not become AST nodes;
466
Added:
* multiple blank lines may be treated as equivalent;
467
Added:
* physical lines in one paragraph may be joined with one space;
468
Added:
* explicit Org line breaks remain explicit inline nodes;
469
Added:
* indentation significant to lists must be interpreted before
470
Added:
trimming.
471
Added:
472
Added:
Keep whitespace rules centralized rather than scattering `String.trim`
473
Added:
calls throughout the parser.
474
Added:
475
Added:
## Initial supported scope
476
Added:
477
Added:
The first useful release should aim to support the following.
478
Added:
479
Added:
### Structural syntax
480
Added:
481
Added:
* document preamble or zeroth section;
482
Added:
* heading hierarchy;
483
Added:
* file-local TODO declarations;
484
Added:
* heading TODO states;
485
Added:
* priorities;
486
Added:
* tags;
487
Added:
* planning information;
488
Added:
* property drawers;
489
Added:
* ordinary drawers;
490
Added:
* paragraphs;
491
Added:
* ordered lists;
492
Added:
* unordered lists;
493
Added:
* descriptive lists;
494
Added:
* source blocks;
495
Added:
* example blocks;
496
Added:
* export blocks;
497
Added:
* comment blocks;
498
Added:
* quote blocks;
499
Added:
* center blocks;
500
Added:
* verse blocks;
501
Added:
* custom blocks;
502
Added:
* keywords;
503
Added:
* affiliated keywords;
504
Added:
* Org tables;
505
Added:
* comments;
506
Added:
* fixed-width content;
507
Added:
* horizontal rules.
508
Added:
509
Added:
### Inline syntax
510
Added:
511
Added:
* plain text;
512
Added:
* bold;
513
Added:
* italic;
514
Added:
* underline;
515
Added:
* strike-through;
516
Added:
* code;
517
Added:
* verbatim;
518
Added:
* regular links;
519
Added:
* common plain links;
520
Added:
* angle links;
521
Added:
* active timestamps;
522
Added:
* inactive timestamps;
523
Added:
* timestamp ranges;
524
Added:
* explicit line breaks;
525
Added:
* basic entities or LaTeX fragments only after the core parser is
526
Added:
stable.
527
Added:
528
Added:
### Deferred features
529
Added:
530
Added:
Unless a spec explicitly promotes them into scope, defer:
531
Added:
532
Added:
* citations;
533
Added:
* radio targets;
534
Added:
* radio links;
535
Added:
* macros;
536
Added:
* complex footnotes;
537
Added:
* inline Babel calls;
538
Added:
* inline source blocks;
539
Added:
* diary sexps;
540
Added:
* inlinetasks;
541
Added:
* table formula interpretation;
542
Added:
* link resolution;
543
Added:
* entity expansion;
544
Added:
* Babel execution;
545
Added:
* language-specific source parsing;
546
Added:
* exact compatibility with `org-element`;
547
Added:
* incremental editor parsing;
548
Added:
* lossless printing.
549
Added:
550
Added:
Do not silently expand a feature spec to include deferred behavior.
551
Added:
552
Added:
## Permissive parsing and diagnostics
553
Added:
554
Added:
The parser should produce a useful best-effort tree for malformed
555
Added:
input.
556
Added:
557
Added:
Use deterministic fallback rules.
558
Added:
559
Added:
Examples:
560
Added:
561
Added:
| Input condition | Preferred result |
562
Added:
|-----------------------------|-------------------------------------------------------|
563
Added:
| Unknown ordinary line | Paragraph text |
564
Added:
| Malformed inline markup | Plain text |
565
Added:
| Unknown keyword | Generic keyword |
566
Added:
| Unknown begin block | Custom block |
567
Added:
| Invalid timestamp-like text | Plain text |
568
Added:
| Invalid list marker | Paragraph text |
569
Added:
| Isolated end-block marker | Paragraph or keyword-like text |
570
Added:
| Broken table row | End the table and parse the line normally |
571
Added:
| Unterminated opaque block | Preserve body through the appropriate boundary or EOF |
572
Added:
573
Added:
Where recovery loses likely structure, emit a warning diagnostic.
574
Added:
575
Added:
Diagnostics should initially be lightweight. Line numbers are
576
Added:
acceptable even though full source spans are out of scope.
577
Added:
578
Added:
Do not throw exceptions for ordinary malformed Org input.
579
Added:
580
Added:
Exceptions may be used for:
581
Added:
582
Added:
* violated internal invariants;
583
Added:
* impossible generated-parser states;
584
Added:
* programming errors;
585
Added:
* resource failures.
586
Added:
587
Added:
Public parsing functions should convert recoverable syntax problems
588
Added:
into AST nodes and diagnostics.
589
Added:
590
Added:
## Quality requirements
591
Added:
592
Added:
### Tests are part of the feature
593
Added:
594
Added:
Every supported syntax feature requires tests.
595
Added:
596
Added:
Use several levels of testing:
597
Added:
598
Added:
1. lexer classification tests;
599
Added:
2. grammar production tests;
600
Added:
3. normalization tests;
601
Added:
4. end-to-end document tests;
602
Added:
5. malformed-input recovery tests;
603
Added:
6. regression tests for every fixed bug.
604
Added:
605
Added:
Prefer small readable Org fixtures with explicit expected ASTs.
606
Added:
607
Added:
Use examples from the official syntax specification where licensing
608
Added:
and attribution permit, supplemented by original fixtures.
609
Added:
610
Added:
Do not base correctness only on snapshot tests. Important semantic
611
Added:
fields should be asserted explicitly.
612
Added:
613
Added:
### No premature performance engineering
614
Added:
615
Added:
Favor clear grammar and predictable behavior.
616
Added:
617
Added:
Avoid:
618
Added:
619
Added:
* repeated concatenation that is obviously quadratic;
620
Added:
* unrestricted backtracking;
621
Added:
* repeated whole-document rescans beyond the deliberate configuration
622
Added:
pre-scan;
623
Added:
* regex-heavy designs that obscure grammar rules.
624
Added:
625
Added:
Do not add complex caching, streaming, mutable arenas, or specialized
626
Added:
buffers without profiling.
627
Added:
628
Added:
Expected parsing complexity should normally be linear in input size,
629
Added:
apart from clearly bounded local analyses.
630
Added:
631
Added:
### Maintainability
632
Added:
633
Added:
Keep modules focused.
634
Added:
635
Added:
The module organization is:
636
Added:
637
Added:
```text
638
Added:
lib/
639
Added:
ast.ml (* Public semantic AST types *)
640
Added:
ast.mli
641
Added:
raw_ast.ml (* Private raw parse tree from Menhir *)
642
Added:
config.ml (* Document config from prescan *)
643
Added:
prescan.ml (* Pre-scan for TODO keywords etc. *)
644
Added:
lexer.ml (* Handwritten structural line lexer *)
645
Added:
parser.mly (* Menhir structural grammar *)
646
Added:
inline_lexer.ml (* Handwritten inline lexer *)
647
Added:
inline_parser.mly (* Menhir inline grammar *)
648
Added:
parse_bridge.ml (* Bridges lexers to Menhir parsers *)
649
Added:
normalize.ml (* Raw_ast → Ast transformation *)
650
Added:
diagnostic.ml (* Diagnostic types *)
651
Added:
org.ml (* Public API entry points *)
652
Added:
test/
653
Added:
test_main.ml (* All tests: lexer, parser, inline, integration *)
654
Added:
fixtures/ (* .org fixture files *)
655
Added:
```
656
Added:
657
Added:
This layout may evolve when the design discovers a clearer separation.
658
Added:
659
Added:
Avoid circular module dependencies.
660
Added:
661
Added:
Keep private types private through `.mli` files or Dune module
662
Added:
visibility.
663
Added:
664
Added:
Use descriptive names based on Org terminology.
665
Added:
666
Added:
### OCaml style
667
Added:
668
Added:
Use current stable OCaml and Dune conventions.
669
Added:
670
Added:
Prefer:
671
Added:
672
Added:
* algebraic data types;
673
Added:
* exhaustive pattern matching;
674
Added:
* immutable values;
675
Added:
* total helper functions where practical;
676
Added:
* explicit result types at module boundaries;
677
Added:
* small pure normalization functions;
678
Added:
* local mutation only when it clearly simplifies stack or cursor
679
Added:
processing.
680
Added:
681
Added:
Avoid:
682
Added:
683
Added:
* objects without a demonstrated need;
684
Added:
* polymorphic variants for the central closed AST;
685
Added:
* global mutable parser state;
686
Added:
* exceptions as ordinary control flow;
687
Added:
* unsafe operations;
688
Added:
* PPX dependencies unless explicitly justified;
689
Added:
* clever type-level machinery that makes the library harder to
690
Added:
consume.
691
Added:
692
Added:
Warnings should be treated seriously. New code should compile without
693
Added:
avoidable warnings.
694
Added:
695
Added:
### Documentation
696
Added:
697
Added:
Document:
698
Added:
699
Added:
* the public AST;
700
Added:
* parsing entry points;
701
Added:
* normalization rules visible to consumers;
702
Added:
* supported syntax;
703
Added:
* known deviations from Org;
704
Added:
* recovery behavior;
705
Added:
* version compatibility.
706
Added:
707
Added:
Do not document private implementation details as public guarantees.
708
Added:
709
Added:
Maintain a concise support matrix showing:
710
Added:
711
Added:
* supported;
712
Added:
* partially supported;
713
Added:
* deferred;
714
Added:
* intentionally unsupported.
715
Added:
716
Added:
## Kiro spec-driven workflow
717
Added:
718
Added:
### Use one coherent feature per spec
719
Added:
720
Added:
Each spec should address a bounded capability, such as:
721
Added:
722
Added:
* document and heading parsing;
723
Added:
* paragraph and inline text parsing;
724
Added:
* block parsing;
725
Added:
* drawer and property parsing;
726
Added:
* list parsing;
727
Added:
* table parsing;
728
Added:
* affiliated keywords;
729
Added:
* timestamps;
730
Added:
* diagnostics and recovery.
731
Added:
732
Added:
Do not create one enormous implementation spec for the entire Org
733
Added:
language.
734
Added:
735
Added:
Specs may depend on earlier foundations, but each should leave the
736
Added:
repository compiling and tested.
737
Added:
738
Added:
### Requirements phase
739
Added:
740
Added:
Write requirements in testable terms.
741
Added:
742
Added:
Each requirement should state:
743
Added:
744
Added:
* the syntax recognized;
745
Added:
* the resulting semantic representation;
746
Added:
* the relevant context restrictions;
747
Added:
* normalization behavior;
748
Added:
* malformed-input fallback;
749
Added:
* exclusions.
750
Added:
751
Added:
Use EARS-style acceptance criteria where useful.
752
Added:
753
Added:
Example:
754
Added:
755
Added:
> WHEN the parser encounters a heading whose first title token matches
756
Added:
> a TODO keyword declared anywhere in the same file, THE parser SHALL
757
Added:
> store that token as the heading TODO state.
758
Added:
759
Added:
Avoid vague requirements such as:
760
Added:
761
Added:
> The parser should handle headings correctly.
762
Added:
763
Added:
Explicitly identify deferred cases instead of leaving them ambiguous.
764
Added:
765
Added:
### Design phase
766
Added:
767
Added:
The design must explain:
768
Added:
769
Added:
* relevant AST additions;
770
Added:
* lexer tokens;
771
Added:
* Menhir productions;
772
Added:
* pre-scan behavior;
773
Added:
* normalization steps;
774
Added:
* recovery behavior;
775
Added:
* module boundaries;
776
Added:
* test strategy;
777
Added:
* compatibility implications.
778
Added:
779
Added:
Before introducing a new dependency, explain:
780
Added:
781
Added:
* why existing tools are insufficient;
782
Added:
* whether it is pure OCaml;
783
Added:
* whether it adds runtime or build-time coupling;
784
Added:
* whether it expands the public API.
785
Added:
786
Added:
Do not redesign unrelated modules during a feature unless the
787
Added:
requirement genuinely demands it.
788
Added:
789
Added:
### Task phase
790
Added:
791
Added:
Break implementation into small verifiable tasks.
792
Added:
793
Added:
A normal feature task sequence should resemble:
794
Added:
795
Added:
1. add or refine private raw types;
796
Added:
2. add lexer recognition;
797
Added:
3. add grammar productions;
798
Added:
4. add normalization;
799
Added:
5. add public AST exposure if needed;
800
Added:
6. add positive tests;
801
Added:
7. add malformed-input tests;
802
Added:
8. update support documentation.
803
Added:
804
Added:
Every implementation task should name:
805
Added:
806
Added:
* the expected files or modules;
807
Added:
* the behavior added;
808
Added:
* the tests that verify completion.
809
Added:
810
Added:
Do not mark a task complete while tests fail or the implementation
811
Added:
only contains placeholders.
812
Added:
813
Added:
### During implementation
814
Added:
815
Added:
Follow the accepted requirements and design.
816
Added:
817
Added:
When implementation reveals a design flaw:
818
Added:
819
Added:
1. stop expanding the workaround;
820
Added:
2. identify the inconsistency;
821
Added:
3. update the design or requirement;
822
Added:
4. then continue implementation.
823
Added:
824
Added:
Do not silently diverge from the spec.
825
Added:
826
Added:
Run focused tests after each task and the full suite before
827
Added:
considering the spec complete.
828
Added:
829
Added:
Keep commits and patches scoped to the active task.
830
Added:
831
Added:
### Definition of done
832
Added:
833
Added:
A feature is complete only when:
834
Added:
835
Added:
* requirements are implemented;
836
Added:
* the AST representation is documented;
837
Added:
* valid examples parse as specified;
838
Added:
* malformed examples recover as specified;
839
Added:
* tests pass;
840
Added:
* no deferred feature was accidentally introduced;
841
Added:
* no unnecessary dependency was added;
842
Added:
* public API changes are intentional;
843
Added:
* the syntax support matrix is updated.
844
Added:
845
Added:
## Decision-making rules
846
Added:
847
Added:
When several implementations are possible, prefer them in this order:
848
Added:
849
Added:
1. correct semantic behavior;
850
Added:
2. clear representation of Org concepts;
851
Added:
3. permissive and deterministic recovery;
852
Added:
4. small and stable public API;
853
Added:
5. maintainable grammar;
854
Added:
6. pure-OCaml portability;
855
Added:
7. acceptable performance;
856
Added:
8. minimal code size.
857
Added:
858
Added:
Do not optimize only for the smallest number of lines.
859
Added:
860
Added:
Do not sacrifice AST clarity merely to remove a private intermediate
861
Added:
type.
862
Added:
863
Added:
Do not generalize before at least two concrete features need the
864
Added:
abstraction.
865
Added:
866
Added:
## Explicit architectural decisions
867
Added:
868
Added:
Treat the following as established decisions unless the user
869
Added:
deliberately revises them:
870
Added:
871
Added:
* Menhir is the parser-generator prototype.
872
Added:
* UTF-8 is initially opaque string content.
873
Added:
* Parsing operates on complete documents.
874
Added:
* External Emacs configuration is ignored.
875
Added:
* supported file-local syntax configuration is honored;
876
Added:
* syntax-affecting file declarations may require a pre-scan;
877
Added:
* the parser is permissive;
878
Added:
* the AST is semantic rather than lossless;
879
Added:
* the public AST uses closed variants;
880
Added:
* source block bodies remain opaque;
881
Added:
* parsing is separate from rendering and evaluation;
882
Added:
* incremental reparsing is out of scope;
883
Added:
* exact `org-element` compatibility is not a goal;
884
Added:
* pure-OCaml ecosystem dependencies are acceptable;
885
Added:
* C and system-library dependencies require explicit approval.
886
Added:
887
Added:
When a requested change conflicts with one of these decisions, call
888
Added:
out the conflict rather than silently changing the architecture.
889
Added:
890
Added:
## Concrete implementation choices
891
Added:
892
Added:
The following choices were made during requirements elicitation and
893
Added:
are binding for the current implementation:
894
Added:
895
Added:
* **Package name**: `ocaml-org`.
896
Added:
* **OCaml version**: 5.5.0 (local opam switch).
897
Added:
* **Test framework**: Alcotest.
898
Added:
* **Structural lexer**: handwritten OCaml (not ocamllex). The lexer
899
Added:
classifies physical lines into structural tokens. It is
900
Added:
context-aware (knows TODO keywords from the pre-scan).
901
Added:
* **Structural parser**: Menhir grammar consuming structural tokens,
902
Added:
producing `Raw_ast.document`.
903
Added:
* **Inline parser**: Menhir grammar (separate `.mly` file with its own
904
Added:
`%start` symbol) consuming inline tokens, producing `Ast.inline
905
Added:
list`. Chosen for its good error messages and grammar reasoning.
906
Added:
* **Inline lexer**: handwritten OCaml tokenizer for bounded inline
907
Added:
text.
908
Added:
* **Build system**: Dune 3.x with full opam package metadata.
909
Added:
* **First working increment**: parse a representative fixture document
910
Added:
exercising the 80% most-used Org features, including inline objects.
911
Added:
* **Menhir mode**: deterministic LR (table mode with incremental API
912
Added:
for error reporting).
913
Added:
914
Added:
## Implementation notes
915
Added:
916
Added:
These notes document key design decisions discovered during
917
Added:
implementation that go beyond the original architecture.
918
Added:
919
Added:
### Inline emphasis pre-scanning
920
Added:
921
Added:
The inline lexer pre-scans the entire input for matched emphasis
922
Added:
delimiter pairs *before* tokenizing. For each delimiter character
923
Added:
(`*`, `/`, `_`, `+`), it builds a hashtable mapping positions to
924
Added:
`Open` or `Close` roles. Only positions with confirmed matching
925
Added:
pairs emit `STAR_OPEN`/`STAR_CLOSE` etc. tokens; unmatched
926
Added:
delimiters become `TEXT`.
927
Added:
928
Added:
This eliminates grammar ambiguity entirely. The inline Menhir
929
Added:
grammar has zero conflicts because it never sees unmatched
930
Added:
delimiters. Fallback-to-plain-text is handled at the lexer level,
931
Added:
not in the grammar.
932
Added:
933
Added:
This was adopted after initial attempts with fallback grammar rules
934
Added:
caused reduce/reduce conflicts that Menhir resolved incorrectly.
935
Added:
936
Added:
### Record label prefixing
937
Added:
938
Added:
OCaml 5.x enforces warning 30 (duplicate-definitions) strictly in
939
Added:
mutually recursive type groups. The public AST uses prefixed record
940
Added:
labels to avoid collisions:
941
Added:
942
Added:
* `li_` for list items
943
Added:
* `src_` for source blocks
944
Added:
* `kw_` for keywords
945
Added:
* `dir_` for directives
946
Added:
* `prop_` for properties
947
Added:
* `aff_` for affiliated keywords
948
Added:
949
Added:
### Library wrapping
950
Added:
951
Added:
The library uses Dune's automatic module wrapping. There is no
952
Added:
manual `ocaml_org.ml` wrapper — all modules are sub-modules of
953
Added:
`Ocaml_org` (e.g. `Ocaml_org.Org.parse`, `Ocaml_org.Ast`,
954
Added:
`Ocaml_org.Config`).
955
Added:
956
Added:
The public API entry point is `lib/org.ml` (accessed as
957
Added:
`Ocaml_org.Org`).
958
Added:
959
Added:
### Structural parser conflicts
960
Added:
961
Added:
The structural Menhir grammar has 5 shift/reduce conflicts from
962
Added:
`nonempty_list` / `list` macros where consecutive same-type elements
963
Added:
(e.g. multiple list items, text lines, table rows) can be extended
964
Added:
or ended. Menhir resolves these by preferring shift (extend the
965
Added:
current list), which is correct behavior.
966
Added:
967
Added:
### Default branch
968
Added:
969
Added:
The default branch is `master`.
970
Added:
.ocamlformat
@@ -0,0 +1,2 @@
1
Added:
version = 0.26.2
2
Added:
profile = default
dune-project
@@ -0,0 +1,29 @@
1
Added:
(lang dune 3.0)
2
Added:
3
Added:
(name ocaml-org)
4
Added:
5
Added:
(version 0.1.0)
6
Added:
7
Added:
(generate_opam_files true)
8
Added:
9
Added:
(using menhir 2.1)
10
Added:
11
Added:
(package
12
Added:
(name ocaml-org)
13
Added:
(synopsis "OCaml Org Mode parser library")
14
Added:
(description
15
Added:
"A compact, high-quality OCaml library for parsing Org Mode documents into a semantic, strongly typed abstract syntax tree.")
16
Added:
(license ISC)
17
Added:
(authors "blendux")
18
Added:
(maintainers "blendux")
19
Added:
(homepage "https://github.com/blendux/ocaml-org")
20
Added:
(bug_reports "https://github.com/blendux/ocaml-org/issues")
21
Added:
(depends
22
Added:
(ocaml
23
Added:
(>= 5.0))
24
Added:
(menhir
25
Added:
(>= 20231231))
26
Added:
(alcotest
27
Added:
(and
28
Added:
:with-test
29
Added:
(>= 0.8.5)))))
lib/ast.ml
@@ -0,0 +1,187 @@
1
Added:
(** Public semantic AST types for Org Mode documents. *)
2
Added:
3
Added:
(** {1 Inline objects} *)
4
Added:
5
Added:
(** A link target. *)
6
Added:
type link_target =
7
Added:
| Url of string (** An external URL (https, http, ftp, etc.) *)
8
Added:
| File of string (** A file path *)
9
Added:
| Internal of string (** An internal link target (custom-id, fuzzy) *)
10
Added:
| Protocol of string * string (** protocol:path *)
11
Added:
12
Added:
(** {1 Timestamps} *)
13
Added:
14
Added:
(** A date with optional time. *)
15
Added:
type date = {
16
Added:
year : int;
17
Added:
month : int;
18
Added:
day : int;
19
Added:
dayname : string option;
20
Added:
hour : int option;
21
Added:
minute : int option;
22
Added:
}
23
Added:
24
Added:
(** Repeater or delay mark. *)
25
Added:
type repeater_mark =
26
Added:
| Plus (** + *)
27
Added:
| Double_plus (** ++ *)
28
Added:
| Dot_plus (** .+ *)
29
Added:
| Minus (** - (warning delay) *)
30
Added:
| Double_minus (** -- (warning delay) *)
31
Added:
32
Added:
type duration_unit = Hour | Day | Week | Month | Year
33
Added:
34
Added:
type repeater_or_delay = {
35
Added:
mark : repeater_mark;
36
Added:
value : int;
37
Added:
unit_ : duration_unit;
38
Added:
}
39
Added:
40
Added:
(** A timestamp value. *)
41
Added:
type timestamp =
42
Added:
| Active of date * repeater_or_delay option
43
Added:
| Inactive of date * repeater_or_delay option
44
Added:
| Active_range of date * date
45
Added:
| Inactive_range of date * date
46
Added:
47
Added:
(** {1 Planning} *)
48
Added:
49
Added:
type planning = {
50
Added:
deadline : timestamp option;
51
Added:
scheduled : timestamp option;
52
Added:
closed : timestamp option;
53
Added:
}
54
Added:
55
Added:
(** {1 Properties} *)
56
Added:
57
Added:
type property = {
58
Added:
prop_name : string;
59
Added:
prop_value : string option;
60
Added:
}
61
Added:
62
Added:
(** {1 Affiliated keywords} *)
63
Added:
64
Added:
type affiliated = {
65
Added:
aff_name : string;
66
Added:
aff_optional : string option;
67
Added:
aff_value : string;
68
Added:
}
69
Added:
70
Added:
(** {1 Inline objects} *)
71
Added:
72
Added:
(** Inline objects that can appear within paragraphs, headings, etc. *)
73
Added:
type inline =
74
Added:
| Plain of string (** Plain text *)
75
Added:
| Bold of inline list (** *bold* *)
76
Added:
| Italic of inline list (** /italic/ *)
77
Added:
| Underline of inline list (** _underline_ *)
78
Added:
| Strikethrough of inline list (** +strikethrough+ *)
79
Added:
| Code of string (** ~code~ *)
80
Added:
| Verbatim of string (** =verbatim= *)
81
Added:
| Link of link (** A link object *)
82
Added:
| Timestamp of timestamp (** A timestamp *)
83
Added:
| Line_break (** Explicit line break \\\\ *)
84
Added:
85
Added:
(** A link with optional description. *)
86
Added:
and link = {
87
Added:
target : link_target;
88
Added:
description : inline list option;
89
Added:
}
90
Added:
91
Added:
(** {1 Lists} *)
92
Added:
93
Added:
type list_kind = Ordered | Unordered | Descriptive
94
Added:
95
Added:
type checkbox = Checked | Unchecked | Partial
96
Added:
97
Added:
(** {1 Tables} *)
98
Added:
99
Added:
type table_cell = inline list
100
Added:
101
Added:
type table_row =
102
Added:
| Table_row_standard of table_cell list
103
Added:
| Table_row_rule
104
Added:
105
Added:
type table = {
106
Added:
rows : table_row list;
107
Added:
}
108
Added:
109
Added:
(** {1 Blocks} *)
110
Added:
111
Added:
type src_block = {
112
Added:
src_language : string option;
113
Added:
src_switches : string option;
114
Added:
src_arguments : string option;
115
Added:
src_value : string;
116
Added:
src_affiliated : affiliated list;
117
Added:
}
118
Added:
119
Added:
(** {1 Keywords} *)
120
Added:
121
Added:
type keyword = {
122
Added:
kw_key : string;
123
Added:
kw_value : string;
124
Added:
}
125
Added:
126
Added:
(** {1 Elements} *)
127
Added:
128
Added:
(** Elements are the building blocks of sections. *)
129
Added:
type element =
130
Added:
| Paragraph of inline list * affiliated list
131
Added:
| Plain_list of list_kind * list_item list
132
Added:
| Table of table
133
Added:
| Block of block
134
Added:
| Drawer of string * element list
135
Added:
| Keyword of keyword
136
Added:
| Comment of string list
137
Added:
| Fixed_width of string list
138
Added:
| Horizontal_rule
139
Added:
140
Added:
and list_item = {
141
Added:
li_bullet : string;
142
Added:
li_counter_set : int option;
143
Added:
li_checkbox : checkbox option;
144
Added:
li_tag : inline list option;
145
Added:
li_contents : element list;
146
Added:
}
147
Added:
148
Added:
and block =
149
Added:
| Src_block of src_block
150
Added:
| Example_block of { ex_value : string; ex_switches : string option; ex_affiliated : affiliated list }
151
Added:
| Export_block of { exp_backend : string; exp_value : string; exp_affiliated : affiliated list }
152
Added:
| Comment_block of { cb_value : string; cb_affiliated : affiliated list }
153
Added:
| Quote_block of { qt_contents : element list; qt_affiliated : affiliated list }
154
Added:
| Center_block of { cn_contents : element list; cn_affiliated : affiliated list }
155
Added:
| Verse_block of { vs_contents : inline list; vs_affiliated : affiliated list }
156
Added:
| Custom_block of { cst_name : string; cst_params : string option; cst_contents : element list; cst_affiliated : affiliated list }
157
Added:
158
Added:
(** {1 Headings} *)
159
Added:
160
Added:
type heading = {
161
Added:
level : int;
162
Added:
todo : string option;
163
Added:
priority : char option;
164
Added:
commented : bool;
165
Added:
title : inline list;
166
Added:
tags : string list;
167
Added:
planning : planning option;
168
Added:
properties : property list;
169
Added:
heading_contents : element list;
170
Added:
children : heading list;
171
Added:
}
172
Added:
173
Added:
(** {1 Directives} *)
174
Added:
175
Added:
(** File-level directives like #+TITLE, #+AUTHOR, etc. *)
176
Added:
type directive = {
177
Added:
dir_key : string;
178
Added:
dir_value : string;
179
Added:
}
180
Added:
181
Added:
(** {1 Document} *)
182
Added:
183
Added:
type document = {
184
Added:
directives : directive list;
185
Added:
preamble : element list;
186
Added:
headings : heading list;
187
Added:
}
lib/ast.mli
@@ -0,0 +1,187 @@
1
Added:
(** Public semantic AST types for Org Mode documents.
2
Added:
3
Added:
This module defines the strongly-typed abstract syntax tree
4
Added:
produced by parsing an Org Mode document. The types are designed
5
Added:
to be semantic: they represent the meaning of Org constructs
6
Added:
rather than their exact surface syntax.
7
Added:
8
Added:
The AST is read-only and uses closed variants for known constructs. *)
9
Added:
10
Added:
(** {1 Inline objects} *)
11
Added:
12
Added:
(** A link target. *)
13
Added:
type link_target =
14
Added:
| Url of string
15
Added:
| File of string
16
Added:
| Internal of string
17
Added:
| Protocol of string * string
18
Added:
19
Added:
(** {1 Timestamps} *)
20
Added:
21
Added:
type date = {
22
Added:
year : int;
23
Added:
month : int;
24
Added:
day : int;
25
Added:
dayname : string option;
26
Added:
hour : int option;
27
Added:
minute : int option;
28
Added:
}
29
Added:
30
Added:
type repeater_mark =
31
Added:
| Plus
32
Added:
| Double_plus
33
Added:
| Dot_plus
34
Added:
| Minus
35
Added:
| Double_minus
36
Added:
37
Added:
type duration_unit = Hour | Day | Week | Month | Year
38
Added:
39
Added:
type repeater_or_delay = {
40
Added:
mark : repeater_mark;
41
Added:
value : int;
42
Added:
unit_ : duration_unit;
43
Added:
}
44
Added:
45
Added:
type timestamp =
46
Added:
| Active of date * repeater_or_delay option
47
Added:
| Inactive of date * repeater_or_delay option
48
Added:
| Active_range of date * date
49
Added:
| Inactive_range of date * date
50
Added:
51
Added:
(** {1 Planning} *)
52
Added:
53
Added:
type planning = {
54
Added:
deadline : timestamp option;
55
Added:
scheduled : timestamp option;
56
Added:
closed : timestamp option;
57
Added:
}
58
Added:
59
Added:
(** {1 Properties} *)
60
Added:
61
Added:
type property = {
62
Added:
prop_name : string;
63
Added:
prop_value : string option;
64
Added:
}
65
Added:
66
Added:
(** {1 Affiliated keywords} *)
67
Added:
68
Added:
type affiliated = {
69
Added:
aff_name : string;
70
Added:
aff_optional : string option;
71
Added:
aff_value : string;
72
Added:
}
73
Added:
74
Added:
(** {1 Inline objects} *)
75
Added:
76
Added:
type inline =
77
Added:
| Plain of string
78
Added:
| Bold of inline list
79
Added:
| Italic of inline list
80
Added:
| Underline of inline list
81
Added:
| Strikethrough of inline list
82
Added:
| Code of string
83
Added:
| Verbatim of string
84
Added:
| Link of link
85
Added:
| Timestamp of timestamp
86
Added:
| Line_break
87
Added:
88
Added:
and link = {
89
Added:
target : link_target;
90
Added:
description : inline list option;
91
Added:
}
92
Added:
93
Added:
(** {1 Lists} *)
94
Added:
95
Added:
type list_kind = Ordered | Unordered | Descriptive
96
Added:
97
Added:
type checkbox = Checked | Unchecked | Partial
98
Added:
99
Added:
(** {1 Tables} *)
100
Added:
101
Added:
type table_cell = inline list
102
Added:
103
Added:
type table_row =
104
Added:
| Table_row_standard of table_cell list
105
Added:
| Table_row_rule
106
Added:
107
Added:
type table = {
108
Added:
rows : table_row list;
109
Added:
}
110
Added:
111
Added:
(** {1 Blocks} *)
112
Added:
113
Added:
type src_block = {
114
Added:
src_language : string option;
115
Added:
src_switches : string option;
116
Added:
src_arguments : string option;
117
Added:
src_value : string;
118
Added:
src_affiliated : affiliated list;
119
Added:
}
120
Added:
121
Added:
(** {1 Keywords} *)
122
Added:
123
Added:
type keyword = {
124
Added:
kw_key : string;
125
Added:
kw_value : string;
126
Added:
}
127
Added:
128
Added:
(** {1 Elements} *)
129
Added:
130
Added:
type element =
131
Added:
| Paragraph of inline list * affiliated list
132
Added:
| Plain_list of list_kind * list_item list
133
Added:
| Table of table
134
Added:
| Block of block
135
Added:
| Drawer of string * element list
136
Added:
| Keyword of keyword
137
Added:
| Comment of string list
138
Added:
| Fixed_width of string list
139
Added:
| Horizontal_rule
140
Added:
141
Added:
and list_item = {
142
Added:
li_bullet : string;
143
Added:
li_counter_set : int option;
144
Added:
li_checkbox : checkbox option;
145
Added:
li_tag : inline list option;
146
Added:
li_contents : element list;
147
Added:
}
148
Added:
149
Added:
and block =
150
Added:
| Src_block of src_block
151
Added:
| Example_block of { ex_value : string; ex_switches : string option; ex_affiliated : affiliated list }
152
Added:
| Export_block of { exp_backend : string; exp_value : string; exp_affiliated : affiliated list }
153
Added:
| Comment_block of { cb_value : string; cb_affiliated : affiliated list }
154
Added:
| Quote_block of { qt_contents : element list; qt_affiliated : affiliated list }
155
Added:
| Center_block of { cn_contents : element list; cn_affiliated : affiliated list }
156
Added:
| Verse_block of { vs_contents : inline list; vs_affiliated : affiliated list }
157
Added:
| Custom_block of { cst_name : string; cst_params : string option; cst_contents : element list; cst_affiliated : affiliated list }
158
Added:
159
Added:
(** {1 Headings} *)
160
Added:
161
Added:
type heading = {
162
Added:
level : int;
163
Added:
todo : string option;
164
Added:
priority : char option;
165
Added:
commented : bool;
166
Added:
title : inline list;
167
Added:
tags : string list;
168
Added:
planning : planning option;
169
Added:
properties : property list;
170
Added:
heading_contents : element list;
171
Added:
children : heading list;
172
Added:
}
173
Added:
174
Added:
(** {1 Directives} *)
175
Added:
176
Added:
type directive = {
177
Added:
dir_key : string;
178
Added:
dir_value : string;
179
Added:
}
180
Added:
181
Added:
(** {1 Document} *)
182
Added:
183
Added:
type document = {
184
Added:
directives : directive list;
185
Added:
preamble : element list;
186
Added:
headings : heading list;
187
Added:
}
lib/config.ml
@@ -0,0 +1,34 @@
1
Added:
(** Document configuration from pre-scan.
2
Added:
3
Added:
This module holds document-level settings extracted from
4
Added:
file-local declarations such as #+TODO lines. These affect
5
Added:
how the structural lexer and normalization interpret the document. *)
6
Added:
7
Added:
(** A TODO keyword sequence: active keywords followed by done keywords. *)
8
Added:
type todo_sequence = {
9
Added:
active : string list;
10
Added:
done_ : string list;
11
Added:
}
12
Added:
13
Added:
(** Document configuration. *)
14
Added:
type t = {
15
Added:
todo_sequences : todo_sequence list;
16
Added:
(** All TODO keyword sequences declared in the file.
17
Added:
Default: one sequence with active=["TODO"] done_=["DONE"]. *)
18
Added:
}
19
Added:
20
Added:
(** The default configuration when no #+TODO declarations are present. *)
21
Added:
let default =
22
Added:
{ todo_sequences = [ { active = [ "TODO" ]; done_ = [ "DONE" ] } ] }
23
Added:
24
Added:
(** Return all TODO keywords (both active and done) from the config. *)
25
Added:
let all_todo_keywords config =
26
Added:
List.concat_map
27
Added:
(fun seq -> seq.active @ seq.done_)
28
Added:
config.todo_sequences
29
Added:
30
Added:
(** Check if a word is a known TODO keyword. *)
31
Added:
let is_todo_keyword config word =
32
Added:
List.exists
33
Added:
(fun seq -> List.mem word seq.active || List.mem word seq.done_)
34
Added:
config.todo_sequences
lib/diagnostic.ml
@@ -0,0 +1,52 @@
1
Added:
(** Diagnostic reporting for recoverable parse issues.
2
Added:
3
Added:
Diagnostics are lightweight reports (severity + line + message)
4
Added:
that indicate recoverable issues encountered during parsing.
5
Added:
They do not halt parsing — the parser always produces a
6
Added:
best-effort AST. *)
7
Added:
8
Added:
(** Severity levels for diagnostics. *)
9
Added:
type severity =
10
Added:
| Warning (** Recoverable issue, structure was inferred *)
11
Added:
| Error (** Significant structural issue *)
12
Added:
13
Added:
(** A single diagnostic. *)
14
Added:
type t = {
15
Added:
severity : severity;
16
Added:
line : int; (** 1-based line number, 0 if unknown *)
17
Added:
message : string;
18
Added:
}
19
Added:
20
Added:
(** Create a warning diagnostic. *)
21
Added:
let warning ?(line = 0) message = { severity = Warning; line; message }
22
Added:
23
Added:
(** Create an error diagnostic. *)
24
Added:
let error ?(line = 0) message = { severity = Error; line; message }
25
Added:
26
Added:
(** A mutable diagnostic collector.
27
Added:
Passed through parsing phases to accumulate diagnostics. *)
28
Added:
type collector = {
29
Added:
mutable diagnostics : t list;
30
Added:
}
31
Added:
32
Added:
(** Create a new empty collector. *)
33
Added:
let create_collector () = { diagnostics = [] }
34
Added:
35
Added:
(** Add a diagnostic to the collector. *)
36
Added:
let add collector diag =
37
Added:
collector.diagnostics <- diag :: collector.diagnostics
38
Added:
39
Added:
(** Add a warning to the collector. *)
40
Added:
let warn collector ?(line = 0) message =
41
Added:
add collector (warning ~line message)
42
Added:
43
Added:
(** Get all diagnostics collected, in order. *)
44
Added:
let to_list collector = List.rev collector.diagnostics
45
Added:
46
Added:
(** Format a diagnostic as a human-readable string. *)
47
Added:
let to_string diag =
48
Added:
let sev = match diag.severity with Warning -> "warning" | Error -> "error" in
49
Added:
if diag.line > 0 then
50
Added:
Printf.sprintf "%s (line %d): %s" sev diag.line diag.message
51
Added:
else
52
Added:
Printf.sprintf "%s: %s" sev diag.message
lib/dune
@@ -0,0 +1,8 @@
1
Added:
(library
2
Added:
(name ocaml_org)
3
Added:
(public_name ocaml-org)
4
Added:
(libraries menhirLib))
5
Added:
6
Added:
(menhir
7
Added:
(modules parser inline_parser)
8
Added:
(flags --table --explain))
lib/inline_lexer.ml
@@ -0,0 +1,339 @@
1
Added:
(** Handwritten inline lexer.
2
Added:
3
Added:
Tokenizes bounded text (heading titles, paragraph bodies, etc.)
4
Added:
into tokens suitable for the inline Menhir grammar.
5
Added:
6
Added:
Key design: emphasis delimiters are only emitted as OPEN/CLOSE tokens
7
Added:
when they form valid matched pairs. Unmatched delimiters become TEXT.
8
Added:
This eliminates ambiguity in the Menhir grammar. *)
9
Added:
10
Added:
(** Inline tokens. *)
11
Added:
type token =
12
Added:
| TEXT of string
13
Added:
| STAR_OPEN
14
Added:
| STAR_CLOSE
15
Added:
| SLASH_OPEN
16
Added:
| SLASH_CLOSE
17
Added:
| UNDER_OPEN
18
Added:
| UNDER_CLOSE
19
Added:
| PLUS_OPEN
20
Added:
| PLUS_CLOSE
21
Added:
| TILDE of string
22
Added:
| EQUALS of string
23
Added:
| LINK_OPEN
24
Added:
| LINK_CLOSE
25
Added:
| LINK_SEP
26
Added:
| TIMESTAMP of string
27
Added:
| ANGLE_LINK of string
28
Added:
| PLAIN_LINK of string
29
Added:
| LINE_BREAK
30
Added:
| NEWLINE
31
Added:
| EOF
32
Added:
33
Added:
(** PRE characters that allow an emphasis marker to open. *)
34
Added:
let is_pre ch =
35
Added:
match ch with
36
Added:
| ' ' | '\t' | '-' | '(' | '{' | '\'' | '"' | '\n' -> true
37
Added:
| _ -> false
38
Added:
39
Added:
(** POST characters that allow an emphasis marker to close. *)
40
Added:
let is_post ch =
41
Added:
match ch with
42
Added:
| ' ' | '\t' | '-' | '.' | ',' | ';' | ':' | '!' | '?'
43
Added:
| ')' | '}' | '\'' | '"' | '\n' | '[' -> true
44
Added:
| _ -> false
45
Added:
46
Added:
(** Common link protocols for plain link detection. *)
47
Added:
let link_protocols = ["https://"; "http://"; "ftp://"; "file://"; "mailto:"]
48
Added:
49
Added:
(** Check if a string starts with a prefix at position [pos]. *)
50
Added:
let starts_with_at s pos prefix =
51
Added:
let plen = String.length prefix in
52
Added:
if pos + plen > String.length s then false
53
Added:
else String.sub s pos plen = prefix
54
Added:
55
Added:
(** Pre-scan for matched emphasis pairs in the input.
56
Added:
Returns a set of positions where open/close markers are valid. *)
57
Added:
let find_emphasis_pairs input delim =
58
Added:
let len = String.length input in
59
Added:
let opens = ref [] in
60
Added:
let pairs = Hashtbl.create 16 in
61
Added:
let i = ref 0 in
62
Added:
while !i < len do
63
Added:
if input.[!i] = delim then begin
64
Added:
(* Check if this could be an opener *)
65
Added:
let pre_ok = !i = 0 || is_pre input.[!i - 1] in
66
Added:
let next_not_space = !i + 1 < len &&
67
Added:
(match input.[!i + 1] with ' ' | '\t' | '\n' -> false | _ -> true) in
68
Added:
(* Check if this could be a closer *)
69
Added:
let post_ok = !i + 1 >= len || is_post input.[!i + 1] in
70
Added:
let prev_not_space = !i > 0 &&
71
Added:
(match input.[!i - 1] with ' ' | '\t' | '\n' -> false | _ -> true) in
72
Added:
if prev_not_space && post_ok && !opens <> [] then begin
73
Added:
(* This is a closer — match with most recent opener *)
74
Added:
let open_pos = List.hd !opens in
75
Added:
opens := List.tl !opens;
76
Added:
Hashtbl.replace pairs open_pos `Open;
77
Added:
Hashtbl.replace pairs !i `Close
78
Added:
end
79
Added:
else if pre_ok && next_not_space then begin
80
Added:
(* This is a potential opener *)
81
Added:
opens := !i :: !opens
82
Added:
end
83
Added:
end;
84
Added:
incr i
85
Added:
done;
86
Added:
pairs
87
Added:
88
Added:
(** Lexer state. *)
89
Added:
type state = {
90
Added:
input : string;
91
Added:
len : int;
92
Added:
mutable pos : int;
93
Added:
star_pairs : (int, [ `Open | `Close ]) Hashtbl.t;
94
Added:
slash_pairs : (int, [ `Open | `Close ]) Hashtbl.t;
95
Added:
under_pairs : (int, [ `Open | `Close ]) Hashtbl.t;
96
Added:
plus_pairs : (int, [ `Open | `Close ]) Hashtbl.t;
97
Added:
}
98
Added:
99
Added:
let create input =
100
Added:
{ input; len = String.length input; pos = 0;
101
Added:
star_pairs = find_emphasis_pairs input '*';
102
Added:
slash_pairs = find_emphasis_pairs input '/';
103
Added:
under_pairs = find_emphasis_pairs input '_';
104
Added:
plus_pairs = find_emphasis_pairs input '+';
105
Added:
}
106
Added:
107
Added:
(** Try to match a verbatim/code span. *)
108
Added:
let try_verbatim_code st delim =
109
Added:
let start = st.pos in
110
Added:
let pre_ok = start = 0 || is_pre st.input.[start - 1] in
111
Added:
if not pre_ok then None
112
Added:
else begin
113
Added:
let rec find_close i =
114
Added:
if i >= st.len then None
115
Added:
else if st.input.[i] = '\n' then None
116
Added:
else if st.input.[i] = delim then
117
Added:
let post_ok = i + 1 >= st.len || is_post st.input.[i + 1] in
118
Added:
if post_ok && i > start + 1 then
119
Added:
Some (String.sub st.input (start + 1) (i - start - 1), i + 1)
120
Added:
else find_close (i + 1)
121
Added:
else find_close (i + 1)
122
Added:
in
123
Added:
find_close (start + 1)
124
Added:
end
125
Added:
126
Added:
(** Try to match a complete timestamp. *)
127
Added:
let try_timestamp st =
128
Added:
let c = st.input.[st.pos] in
129
Added:
let closer = if c = '<' then '>' else if c = '[' then ']' else '\x00' in
130
Added:
if closer = '\x00' then None
131
Added:
else begin
132
Added:
let next_pos = st.pos + 1 in
133
Added:
if next_pos >= st.len then None
134
Added:
else if not (st.input.[next_pos] >= '0' && st.input.[next_pos] <= '9') then None
135
Added:
else begin
136
Added:
let rec find_close i =
137
Added:
if i >= st.len then None
138
Added:
else if st.input.[i] = closer then Some i
139
Added:
else if st.input.[i] = '\n' then None
140
Added:
else find_close (i + 1)
141
Added:
in
142
Added:
match find_close next_pos with
143
Added:
| None -> None
144
Added:
| Some end_pos ->
145
Added:
let ts = String.sub st.input st.pos (end_pos - st.pos + 1) in
146
Added:
(* Check for range *)
147
Added:
let after = end_pos + 1 in
148
Added:
if after + 2 < st.len && st.input.[after] = '-' && st.input.[after + 1] = '-' then begin
149
Added:
let range_start = after + 2 in
150
Added:
if range_start < st.len && st.input.[range_start] = c then
151
Added:
let next2 = range_start + 1 in
152
Added:
if next2 < st.len && st.input.[next2] >= '0' && st.input.[next2] <= '9' then
153
Added:
match find_close next2 with
154
Added:
| Some end2 ->
155
Added:
let full = String.sub st.input st.pos (end2 - st.pos + 1) in
156
Added:
Some (full, end2 + 1)
157
Added:
| None -> Some (ts, after)
158
Added:
else Some (ts, after)
159
Added:
else Some (ts, after)
160
Added:
end
161
Added:
else Some (ts, after)
162
Added:
end
163
Added:
end
164
Added:
165
Added:
(** Try to match an angle link: <protocol:path> *)
166
Added:
let try_angle_link st =
167
Added:
if st.input.[st.pos] <> '<' then None
168
Added:
else begin
169
Added:
let start = st.pos + 1 in
170
Added:
let rec find_close i =
171
Added:
if i >= st.len then None
172
Added:
else if st.input.[i] = '>' then
173
Added:
let content = String.sub st.input start (i - start) in
174
Added:
if String.contains content ':' && not (String.contains content ' ') then
175
Added:
Some (content, i + 1)
176
Added:
else None
177
Added:
else if st.input.[i] = '\n' || st.input.[i] = ' ' then None
178
Added:
else find_close (i + 1)
179
Added:
in
180
Added:
find_close start
181
Added:
end
182
Added:
183
Added:
(** Try to match a plain link. *)
184
Added:
let try_plain_link st =
185
Added:
let rec try_protocols = function
186
Added:
| [] -> None
187
Added:
| proto :: rest ->
188
Added:
if starts_with_at st.input st.pos proto then begin
189
Added:
let plen = String.length proto in
190
Added:
let rec find_end i =
191
Added:
if i >= st.len then i
192
Added:
else match st.input.[i] with
193
Added:
| ' ' | '\t' | '\n' | '>' | '<' | ']' -> i
194
Added:
| _ -> find_end (i + 1)
195
Added:
in
196
Added:
let end_pos = find_end (st.pos + plen) in
197
Added:
let end_pos = ref end_pos in
198
Added:
while !end_pos > st.pos + plen &&
199
Added:
(match st.input.[!end_pos - 1] with '.' | ',' | ';' | ':' | '!' | '?' | ')' -> true | _ -> false) do
200
Added:
decr end_pos
201
Added:
done;
202
Added:
if !end_pos > st.pos + plen then
203
Added:
Some (String.sub st.input st.pos (!end_pos - st.pos), !end_pos)
204
Added:
else None
205
Added:
end
206
Added:
else try_protocols rest
207
Added:
in
208
Added:
try_protocols link_protocols
209
Added:
210
Added:
(** Try to match a line break: \\\\ at end of line *)
211
Added:
let try_line_break st =
212
Added:
if st.pos + 1 < st.len && st.input.[st.pos] = '\\' && st.input.[st.pos + 1] = '\\' then begin
213
Added:
let rec skip_space i =
214
Added:
if i >= st.len then Some i
215
Added:
else match st.input.[i] with
216
Added:
| ' ' | '\t' -> skip_space (i + 1)
217
Added:
| '\n' -> Some (i + 1)
218
Added:
| _ -> None
219
Added:
in
220
Added:
skip_space (st.pos + 2)
221
Added:
end
222
Added:
else None
223
Added:
224
Added:
(** Get the next token. *)
225
Added:
let next_token st =
226
Added:
if st.pos >= st.len then EOF
227
Added:
else
228
Added:
let c = st.input.[st.pos] in
229
Added:
(* Try line break *)
230
Added:
match try_line_break st with
231
Added:
| Some new_pos -> st.pos <- new_pos; LINE_BREAK
232
Added:
| None ->
233
Added:
(* Try verbatim/code *)
234
Added:
if c = '~' then
235
Added:
match try_verbatim_code st '~' with
236
Added:
| Some (content, new_pos) -> st.pos <- new_pos; TILDE content
237
Added:
| None -> st.pos <- st.pos + 1; TEXT "~"
238
Added:
else if c = '=' then
239
Added:
match try_verbatim_code st '=' with
240
Added:
| Some (content, new_pos) -> st.pos <- new_pos; EQUALS content
241
Added:
| None -> st.pos <- st.pos + 1; TEXT "="
242
Added:
else
243
Added:
(* Try link brackets *)
244
Added:
if c = '[' && st.pos + 1 < st.len && st.input.[st.pos + 1] = '[' then begin
245
Added:
st.pos <- st.pos + 2; LINK_OPEN
246
Added:
end
247
Added:
else if c = ']' && st.pos + 1 < st.len && st.input.[st.pos + 1] = ']' then begin
248
Added:
st.pos <- st.pos + 2; LINK_CLOSE
249
Added:
end
250
Added:
else if c = ']' && st.pos + 1 < st.len && st.input.[st.pos + 1] = '[' then begin
251
Added:
st.pos <- st.pos + 2; LINK_SEP
252
Added:
end
253
Added:
else
254
Added:
(* Try timestamp *)
255
Added:
if c = '<' || (c = '[' && st.pos + 1 < st.len && st.input.[st.pos + 1] >= '0' && st.input.[st.pos + 1] <= '9') then begin
256
Added:
match try_timestamp st with
257
Added:
| Some (ts, new_pos) -> st.pos <- new_pos; TIMESTAMP ts
258
Added:
| None ->
259
Added:
if c = '<' then
260
Added:
match try_angle_link st with
261
Added:
| Some (content, new_pos) -> st.pos <- new_pos; ANGLE_LINK content
262
Added:
| None -> st.pos <- st.pos + 1; TEXT "<"
263
Added:
else begin
264
Added:
st.pos <- st.pos + 1; TEXT "["
265
Added:
end
266
Added:
end
267
Added:
else
268
Added:
(* Try plain link *)
269
Added:
begin match try_plain_link st with
270
Added:
| Some (link, new_pos) -> st.pos <- new_pos; PLAIN_LINK link
271
Added:
| None ->
272
Added:
(* Try emphasis markers — only emit OPEN/CLOSE if pre-scan found a pair *)
273
Added:
if c = '*' then begin
274
Added:
let tok =
275
Added:
match Hashtbl.find_opt st.star_pairs st.pos with
276
Added:
| Some `Open -> STAR_OPEN
277
Added:
| Some `Close -> STAR_CLOSE
278
Added:
| None -> TEXT "*"
279
Added:
in
280
Added:
st.pos <- st.pos + 1; tok
281
Added:
end
282
Added:
else if c = '/' then begin
283
Added:
let tok =
284
Added:
match Hashtbl.find_opt st.slash_pairs st.pos with
285
Added:
| Some `Open -> SLASH_OPEN
286
Added:
| Some `Close -> SLASH_CLOSE
287
Added:
| None -> TEXT "/"
288
Added:
in
289
Added:
st.pos <- st.pos + 1; tok
290
Added:
end
291
Added:
else if c = '_' then begin
292
Added:
let tok =
293
Added:
match Hashtbl.find_opt st.under_pairs st.pos with
294
Added:
| Some `Open -> UNDER_OPEN
295
Added:
| Some `Close -> UNDER_CLOSE
296
Added:
| None -> TEXT "_"
297
Added:
in
298
Added:
st.pos <- st.pos + 1; tok
299
Added:
end
300
Added:
else if c = '+' then begin
301
Added:
let tok =
302
Added:
match Hashtbl.find_opt st.plus_pairs st.pos with
303
Added:
| Some `Open -> PLUS_OPEN
304
Added:
| Some `Close -> PLUS_CLOSE
305
Added:
| None -> TEXT "+"
306
Added:
in
307
Added:
st.pos <- st.pos + 1; tok
308
Added:
end
309
Added:
else if c = '\n' then begin
310
Added:
st.pos <- st.pos + 1; NEWLINE
311
Added:
end
312
Added:
else begin
313
Added:
(* Accumulate plain text *)
314
Added:
let start = st.pos in
315
Added:
let rec scan i =
316
Added:
if i >= st.len then i
317
Added:
else match st.input.[i] with
318
Added:
| '*' | '/' | '_' | '+' | '~' | '=' | '[' | ']' | '<' | '\n' | '\\' -> i
319
Added:
| _ ->
320
Added:
if List.exists (fun proto -> starts_with_at st.input i proto) link_protocols
321
Added:
then i
322
Added:
else scan (i + 1)
323
Added:
in
324
Added:
let end_pos = scan (start + 1) in
325
Added:
st.pos <- end_pos;
326
Added:
TEXT (String.sub st.input start (end_pos - start))
327
Added:
end
328
Added:
end
329
Added:
330
Added:
(** Tokenize an entire string into a list of tokens. *)
331
Added:
let tokenize input =
332
Added:
let st = create input in
333
Added:
let rec loop acc =
334
Added:
let tok = next_token st in
335
Added:
match tok with
336
Added:
| EOF -> List.rev (EOF :: acc)
337
Added:
| _ -> loop (tok :: acc)
338
Added:
in
339
Added:
loop []
lib/inline_parser.mly
@@ -0,0 +1,181 @@
1
Added:
(* Inline Menhir grammar for Org Mode inline objects.
2
Added:
Parses inline tokens into Ast.inline list.
3
Added:
4
Added:
Key design: the inline lexer pre-scans for matched emphasis pairs
5
Added:
and only emits OPEN/CLOSE tokens for valid pairs. Unmatched
6
Added:
delimiters become TEXT tokens from the lexer. This eliminates
7
Added:
ambiguity in the grammar. *)
8
Added:
9
Added:
%{
10
Added:
open Ast
11
Added:
12
Added:
let merge_plain items =
13
Added:
let rec loop acc = function
14
Added:
| [] -> List.rev acc
15
Added:
| Plain s1 :: Plain s2 :: rest ->
16
Added:
loop acc (Plain (s1 ^ s2) :: rest)
17
Added:
| item :: rest -> loop (item :: acc) rest
18
Added:
in
19
Added:
loop [] items
20
Added:
21
Added:
let parse_link_target s =
22
Added:
if String.length s >= 8 && String.sub s 0 8 = "https://" then Url s
23
Added:
else if String.length s >= 7 && String.sub s 0 7 = "http://" then Url s
24
Added:
else if String.length s >= 6 && String.sub s 0 6 = "ftp://" then Url s
25
Added:
else if String.length s >= 5 && String.sub s 0 5 = "file:" then
26
Added:
File (String.sub s 5 (String.length s - 5))
27
Added:
else
28
Added:
match String.index_opt s ':' with
29
Added:
| Some i when i > 0 ->
30
Added:
let proto = String.sub s 0 i in
31
Added:
let path = String.sub s (i + 1) (String.length s - i - 1) in
32
Added:
Protocol (proto, path)
33
Added:
| _ -> Internal s
34
Added:
35
Added:
let rec parse_timestamp_string s =
36
Added:
let len = String.length s in
37
Added:
if len < 12 then None
38
Added:
else
39
Added:
let is_active = s.[0] = '<' in
40
Added:
(* Check for range *)
41
Added:
let range_sep = if is_active then ">--<" else "]--[" in
42
Added:
let range_idx =
43
Added:
let slen = String.length range_sep in
44
Added:
let rec find i =
45
Added:
if i + slen > len then None
46
Added:
else if String.sub s i slen = range_sep then Some i
47
Added:
else find (i + 1)
48
Added:
in
49
Added:
find 0
50
Added:
in
51
Added:
match range_idx with
52
Added:
| Some idx ->
53
Added:
let ts1 = String.sub s 0 (idx + 1) in
54
Added:
let ts2 = String.sub s (idx + String.length range_sep - 1)
55
Added:
(len - idx - String.length range_sep + 1) in
56
Added:
(match parse_single_date ts1, parse_single_date ts2 with
57
Added:
| Some d1, Some d2 ->
58
Added:
if is_active then Some (Active_range (d1, d2))
59
Added:
else Some (Inactive_range (d1, d2))
60
Added:
| _ -> None)
61
Added:
| None ->
62
Added:
match parse_single_date s with
63
Added:
| Some date ->
64
Added:
if is_active then Some (Active (date, None))
65
Added:
else Some (Inactive (date, None))
66
Added:
| None -> None
67
Added:
68
Added:
and parse_single_date s =
69
Added:
let len = String.length s in
70
Added:
if len < 12 then None
71
Added:
else
72
Added:
let inner = String.sub s 1 (len - 2) in
73
Added:
let parts = String.split_on_char ' ' inner |> List.filter (fun p -> p <> "") in
74
Added:
match parts with
75
Added:
| date_part :: rest ->
76
Added:
let date_parts = String.split_on_char '-' date_part in
77
Added:
(match date_parts with
78
Added:
| [y; m; d] ->
79
Added:
(try
80
Added:
let year = int_of_string y in
81
Added:
let month = int_of_string m in
82
Added:
let day = int_of_string d in
83
Added:
let dayname = ref None in
84
Added:
let hour = ref None in
85
Added:
let minute = ref None in
86
Added:
List.iter (fun part ->
87
Added:
if String.length part = 5 && part.[2] = ':' then begin
88
Added:
(try
89
Added:
hour := Some (int_of_string (String.sub part 0 2));
90
Added:
minute := Some (int_of_string (String.sub part 3 2))
91
Added:
with Failure _ -> ())
92
Added:
end
93
Added:
else if String.length part >= 2 then
94
Added:
dayname := Some part
95
Added:
) rest;
96
Added:
Some { year; month; day; dayname = !dayname; hour = !hour; minute = !minute }
97
Added:
with Failure _ -> None)
98
Added:
| _ -> None)
99
Added:
| [] -> None
100
Added:
%}
101
Added:
102
Added:
%token <string> TEXT
103
Added:
%token STAR_OPEN STAR_CLOSE
104
Added:
%token SLASH_OPEN SLASH_CLOSE
105
Added:
%token UNDER_OPEN UNDER_CLOSE
106
Added:
%token PLUS_OPEN PLUS_CLOSE
107
Added:
%token <string> TILDE
108
Added:
%token <string> EQUALS
109
Added:
%token LINK_OPEN LINK_CLOSE LINK_SEP
110
Added:
%token <string> TIMESTAMP
111
Added:
%token <string> ANGLE_LINK
112
Added:
%token <string> PLAIN_LINK
113
Added:
%token LINE_BREAK
114
Added:
%token NEWLINE
115
Added:
%token EOF
116
Added:
117
Added:
%start <Ast.inline list> inline_content
118
Added:
119
Added:
%%
120
Added:
121
Added:
inline_content:
122
Added:
| items = list(inline_item) EOF
123
Added:
{ merge_plain items }
124
Added:
;
125
Added:
126
Added:
inline_item:
127
Added:
| t = TEXT
128
Added:
{ Plain t }
129
Added:
| STAR_OPEN contents = list(inline_item) STAR_CLOSE
130
Added:
{ Bold (merge_plain contents) }
131
Added:
| SLASH_OPEN contents = list(inline_item) SLASH_CLOSE
132
Added:
{ Italic (merge_plain contents) }
133
Added:
| UNDER_OPEN contents = list(inline_item) UNDER_CLOSE
134
Added:
{ Underline (merge_plain contents) }
135
Added:
| PLUS_OPEN contents = list(inline_item) PLUS_CLOSE
136
Added:
{ Strikethrough (merge_plain contents) }
137
Added:
| c = TILDE
138
Added:
{ Code c }
139
Added:
| v = EQUALS
140
Added:
{ Verbatim v }
141
Added:
| LINK_OPEN target = link_path LINK_CLOSE
142
Added:
{ Link { target = parse_link_target target; description = None } }
143
Added:
| LINK_OPEN target = link_path LINK_SEP desc = list(inline_item) LINK_CLOSE
144
Added:
{ Link { target = parse_link_target target; description = Some (merge_plain desc) } }
145
Added:
| link = ANGLE_LINK
146
Added:
{ Link { target = parse_link_target link; description = None } }
147
Added:
| link = PLAIN_LINK
148
Added:
{ Link { target = parse_link_target link; description = None } }
149
Added:
| ts = TIMESTAMP
150
Added:
{ match parse_timestamp_string ts with
151
Added:
| Some t -> Timestamp t
152
Added:
| None -> Plain ts }
153
Added:
| LINE_BREAK
154
Added:
{ Line_break }
155
Added:
| NEWLINE
156
Added:
{ Plain " " }
157
Added:
;
158
Added:
159
Added:
link_path:
160
Added:
| parts = nonempty_list(link_path_part)
161
Added:
{ String.concat "" parts }
162
Added:
;
163
Added:
164
Added:
link_path_part:
165
Added:
| t = TEXT { t }
166
Added:
| STAR_OPEN { "*" }
167
Added:
| STAR_CLOSE { "*" }
168
Added:
| SLASH_OPEN { "/" }
169
Added:
| SLASH_CLOSE { "/" }
170
Added:
| UNDER_OPEN { "_" }
171
Added:
| UNDER_CLOSE { "_" }
172
Added:
| PLUS_OPEN { "+" }
173
Added:
| PLUS_CLOSE { "+" }
174
Added:
| c = TILDE { "~" ^ c ^ "~" }
175
Added:
| v = EQUALS { "=" ^ v ^ "=" }
176
Added:
| link = PLAIN_LINK { link }
177
Added:
| link = ANGLE_LINK { "<" ^ link ^ ">" }
178
Added:
| ts = TIMESTAMP { ts }
179
Added:
| NEWLINE { " " }
180
Added:
| LINE_BREAK { "\\\\" }
181
Added:
;
lib/lexer.ml
@@ -0,0 +1,536 @@
1
Added:
(** Handwritten structural line lexer.
2
Added:
3
Added:
Classifies physical lines into high-level structural tokens
4
Added:
that the Menhir grammar will consume. The lexer is context-aware:
5
Added:
it knows the TODO keywords from the pre-scan to assist heading
6
Added:
classification (though heading title parsing is deferred to
7
Added:
normalization).
8
Added:
9
Added:
The lexer operates line-by-line. Each call to [next_token]
10
Added:
returns the classification of the next line. *)
11
Added:
12
Added:
(** The bullet type for list items. *)
13
Added:
type bullet_kind =
14
Added:
| Bullet_unordered of char (** '-', '+', or '*' *)
15
Added:
| Bullet_ordered of string * char (** counter, ')' or '.' *)
16
Added:
17
Added:
(** A raw list item token payload. *)
18
Added:
type list_item_data = {
19
Added:
lid_indent : int;
20
Added:
lid_bullet : string; (** The bullet text including trailing space *)
21
Added:
lid_counter_set : int option;
22
Added:
lid_checkbox : string option; (** "[ ]", "[X]", "[-]" *)
23
Added:
lid_rest : string; (** Remainder of line after bullet/checkbox *)
24
Added:
}
25
Added:
26
Added:
(** Structural tokens produced by the lexer. *)
27
Added:
type token =
28
Added:
| Blank
29
Added:
| Heading of int * string (** level, rest of line *)
30
Added:
| Keyword of string * string (** key (uppercase), value *)
31
Added:
| Affiliated_keyword of string * string option * string (** name, optional, value *)
32
Added:
| Begin_block of string * string option (** name (lowercase), params *)
33
Added:
| End_block of string (** name (lowercase) *)
34
Added:
| Drawer_begin of string (** name *)
35
Added:
| Drawer_end
36
Added:
| Property of string * string option (** name, value *)
37
Added:
| Planning of string (** raw planning line content *)
38
Added:
| List_item of list_item_data
39
Added:
| Table_row of string (** raw row content including leading | *)
40
Added:
| Fixed_width of string (** content after ": " *)
41
Added:
| Comment_line of string (** content after "# " *)
42
Added:
| Horizontal_rule
43
Added:
| Text_line of string (** anything else *)
44
Added:
| Eof
45
Added:
46
Added:
(** Lexer state. *)
47
Added:
type state = {
48
Added:
lines : string array;
49
Added:
mutable line_idx : int;
50
Added:
mutable line_number : int; (** 1-based line number *)
51
Added:
config : Config.t;
52
Added:
}
53
Added:
54
Added:
(** Create a new lexer state from input text. *)
55
Added:
let create ~config input =
56
Added:
let lines = String.split_on_char '\n' input |> Array.of_list in
57
Added:
{ lines; line_idx = 0; line_number = 1; config }
58
Added:
59
Added:
(** Get the current (1-based) line number. *)
60
Added:
let line_number st = st.line_number
61
Added:
62
Added:
(** Check if a line is entirely whitespace. *)
63
Added:
let is_blank_line s =
64
Added:
let len = String.length s in
65
Added:
let rec loop i =
66
Added:
if i >= len then true
67
Added:
else match s.[i] with ' ' | '\t' | '\r' -> loop (i + 1) | _ -> false
68
Added:
in
69
Added:
loop 0
70
Added:
71
Added:
(** Count leading spaces (tabs = 1 for simplicity in indentation). *)
72
Added:
let leading_indent s =
73
Added:
let len = String.length s in
74
Added:
let rec loop i =
75
Added:
if i >= len then i
76
Added:
else match s.[i] with ' ' -> loop (i + 1) | '\t' -> loop (i + 8) | _ -> i
77
Added:
in
78
Added:
loop 0
79
Added:
80
Added:
(** Check if string starts with prefix at position [pos]. *)
81
Added:
let starts_at s pos prefix =
82
Added:
let plen = String.length prefix in
83
Added:
if pos + plen > String.length s then false
84
Added:
else
85
Added:
let rec loop i =
86
Added:
if i >= plen then true
87
Added:
else if s.[pos + i] <> prefix.[i] then false
88
Added:
else loop (i + 1)
89
Added:
in
90
Added:
loop 0
91
Added:
92
Added:
(** Case-insensitive prefix check at position. *)
93
Added:
let starts_at_ci s pos prefix =
94
Added:
let plen = String.length prefix in
95
Added:
if pos + plen > String.length s then false
96
Added:
else
97
Added:
let rec loop i =
98
Added:
if i >= plen then true
99
Added:
else
100
Added:
let c1 = Char.lowercase_ascii s.[pos + i] in
101
Added:
let c2 = Char.lowercase_ascii prefix.[i] in
102
Added:
if c1 <> c2 then false
103
Added:
else loop (i + 1)
104
Added:
in
105
Added:
loop 0
106
Added:
107
Added:
(** Strip trailing \r and whitespace from a string. *)
108
Added:
let rstrip s =
109
Added:
let len = String.length s in
110
Added:
let i = ref (len - 1) in
111
Added:
while !i >= 0 && (s.[!i] = ' ' || s.[!i] = '\t' || s.[!i] = '\r') do
112
Added:
decr i
113
Added:
done;
114
Added:
if !i = len - 1 then s else String.sub s 0 (!i + 1)
115
Added:
116
Added:
(** Affiliated keyword names per Org spec defaults. *)
117
Added:
let affiliated_keywords = [ "CAPTION"; "DATA"; "HEADER"; "HEADERS"; "NAME"; "PLOT"; "RESULTS" ]
118
Added:
119
Added:
let attr_prefix = "ATTR_"
120
Added:
121
Added:
(** Check if a keyword key is an affiliated keyword.
122
Added:
Affiliated keywords: CAPTION, DATA, HEADER, HEADERS, NAME, PLOT, RESULTS, ATTR_* *)
123
Added:
let is_affiliated_key key =
124
Added:
let ukey = String.uppercase_ascii key in
125
Added:
List.mem ukey affiliated_keywords
126
Added:
|| (String.length ukey > 5 && String.sub ukey 0 5 = attr_prefix)
127
Added:
128
Added:
(** Try to classify a line as a keyword: #+KEY: VALUE
129
Added:
Returns Some (key, value) or None. *)
130
Added:
let try_keyword line start =
131
Added:
let len = String.length line in
132
Added:
if start + 1 >= len || line.[start] <> '#' || line.[start + 1] <> '+' then
133
Added:
None
134
Added:
else
135
Added:
let rest_start = start + 2 in
136
Added:
(* Find the colon *)
137
Added:
let rec find_colon i =
138
Added:
if i >= len then None
139
Added:
else if line.[i] = ':' then Some i
140
Added:
else if line.[i] = ' ' || line.[i] = '\t' then None (* space before colon = not keyword *)
141
Added:
else find_colon (i + 1)
142
Added:
in
143
Added:
match find_colon rest_start with
144
Added:
| None -> None
145
Added:
| Some colon_pos ->
146
Added:
let key = String.sub line rest_start (colon_pos - rest_start) in
147
Added:
let value =
148
Added:
if colon_pos + 1 < len then
149
Added:
let v = String.sub line (colon_pos + 1) (len - colon_pos - 1) in
150
Added:
(* Strip leading space from value *)
151
Added:
if String.length v > 0 && v.[0] = ' ' then
152
Added:
String.sub v 1 (String.length v - 1)
153
Added:
else v
154
Added:
else ""
155
Added:
in
156
Added:
Some (key, rstrip value)
157
Added:
158
Added:
(** Try to parse a #+begin_NAME line.
159
Added:
Returns Some (name_lowercase, params_option) or None. *)
160
Added:
let try_begin_block line start =
161
Added:
let len = String.length line in
162
Added:
if not (starts_at_ci line start "#+begin_") then None
163
Added:
else
164
Added:
let name_start = start + 8 in
165
Added:
(* Find end of name (next space or end of line) *)
166
Added:
let rec find_end i =
167
Added:
if i >= len then i
168
Added:
else if line.[i] = ' ' || line.[i] = '\t' then i
169
Added:
else find_end (i + 1)
170
Added:
in
171
Added:
let name_end = find_end name_start in
172
Added:
if name_end = name_start then None (* empty name *)
173
Added:
else
174
Added:
let name = String.lowercase_ascii (String.sub line name_start (name_end - name_start)) in
175
Added:
let params =
176
Added:
if name_end < len then
177
Added:
let p = rstrip (String.sub line name_end (len - name_end)) in
178
Added:
let p = if String.length p > 0 && p.[0] = ' ' then
179
Added:
String.sub p 1 (String.length p - 1)
180
Added:
else p in
181
Added:
if String.length p > 0 then Some p else None
182
Added:
else None
183
Added:
in
184
Added:
Some (name, params)
185
Added:
186
Added:
(** Try to parse a #+end_NAME line. *)
187
Added:
let try_end_block line start =
188
Added:
let len = String.length line in
189
Added:
if not (starts_at_ci line start "#+end_") then None
190
Added:
else
191
Added:
let name_start = start + 6 in
192
Added:
let rec find_end i =
193
Added:
if i >= len then i
194
Added:
else if line.[i] = ' ' || line.[i] = '\t' then i
195
Added:
else find_end (i + 1)
196
Added:
in
197
Added:
let name_end = find_end name_start in
198
Added:
if name_end = name_start then None
199
Added:
else
200
Added:
Some (String.lowercase_ascii (String.sub line name_start (name_end - name_start)))
201
Added:
202
Added:
(** Try to parse a drawer begin line: :NAME: *)
203
Added:
let try_drawer_begin line start =
204
Added:
let len = String.length line in
205
Added:
if start >= len || line.[start] <> ':' then None
206
Added:
else
207
Added:
(* Must end with : and contain only word chars, hyphens, underscores between *)
208
Added:
let rec find_end i =
209
Added:
if i >= len then None
210
Added:
else if line.[i] = ':' then
211
Added:
(* Check rest is blank *)
212
Added:
let rest = rstrip (String.sub line (i + 1) (len - i - 1)) in
213
Added:
if String.length rest = 0 then Some i
214
Added:
else None
215
Added:
else if (line.[i] >= 'a' && line.[i] <= 'z')
216
Added:
|| (line.[i] >= 'A' && line.[i] <= 'Z')
217
Added:
|| (line.[i] >= '0' && line.[i] <= '9')
218
Added:
|| line.[i] = '-' || line.[i] = '_' then
219
Added:
find_end (i + 1)
220
Added:
else None
221
Added:
in
222
Added:
match find_end (start + 1) with
223
Added:
| None -> None
224
Added:
| Some end_pos ->
225
Added:
let name = String.sub line (start + 1) (end_pos - start - 1) in
226
Added:
if String.length name = 0 then None
227
Added:
else Some name
228
Added:
229
Added:
(** Check if a line is :end: (drawer end). *)
230
Added:
let is_drawer_end line start =
231
Added:
starts_at_ci line start ":end:"
232
Added:
&& (let rest = String.sub line (start + 5) (String.length line - start - 5) in
233
Added:
is_blank_line rest)
234
Added:
235
Added:
(** Check if a line is a property: :NAME: VALUE or :NAME+: VALUE *)
236
Added:
let try_property line start =
237
Added:
let len = String.length line in
238
Added:
if start >= len || line.[start] <> ':' then None
239
Added:
else
240
Added:
let rec find_colon i =
241
Added:
if i >= len then None
242
Added:
else if line.[i] = ':' then Some i
243
Added:
else if (line.[i] >= 'a' && line.[i] <= 'z')
244
Added:
|| (line.[i] >= 'A' && line.[i] <= 'Z')
245
Added:
|| (line.[i] >= '0' && line.[i] <= '9')
246
Added:
|| line.[i] = '-' || line.[i] = '_' || line.[i] = '+' then
247
Added:
find_colon (i + 1)
248
Added:
else None
249
Added:
in
250
Added:
match find_colon (start + 1) with
251
Added:
| None -> None
252
Added:
| Some colon_pos ->
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 = rstrip (String.sub line value_start (len - value_start)) in
260
Added:
let v = if String.length v > 0 && v.[0] = ' ' then
261
Added:
String.sub v 1 (String.length v - 1) else v in
262
Added:
if String.length v > 0 then Some v else None
263
Added:
else None
264
Added:
in
265
Added:
Some (name, value)
266
Added:
267
Added:
(** Try to classify a line as a list item.
268
Added:
List items start with: - item, + item, * item (not at column 0),
269
Added:
1. item, 1) item, a. item, a) item *)
270
Added:
let try_list_item line =
271
Added:
let len = String.length line in
272
Added:
let indent = leading_indent line in
273
Added:
if indent >= len then None
274
Added:
else
275
Added:
let pos = ref indent in
276
Added:
(* Try bullet markers *)
277
Added:
let bullet_result =
278
Added:
if !pos >= len then None
279
Added:
else
280
Added:
let c = line.[!pos] in
281
Added:
if (c = '-' || c = '+') && !pos + 1 < len && line.[!pos + 1] = ' ' then begin
282
Added:
pos := !pos + 2;
283
Added:
Some (String.make 1 c ^ " ")
284
Added:
end
285
Added:
else if c = '*' && indent > 0 && !pos + 1 < len && line.[!pos + 1] = ' ' then begin
286
Added:
(* * at column >0 is a list bullet; at column 0 it's a heading *)
287
Added:
pos := !pos + 2;
288
Added:
Some "* "
289
Added:
end
290
Added:
else begin
291
Added:
(* Try ordered: digit(s) followed by . or ) then space *)
292
Added:
let start = !pos in
293
Added:
let rec scan_digits i =
294
Added:
if i >= len then None
295
Added:
else if line.[i] >= '0' && line.[i] <= '9' then scan_digits (i + 1)
296
Added:
else if (i > start) && (line.[i] = '.' || line.[i] = ')')
297
Added:
&& i + 1 < len && line.[i + 1] = ' ' then begin
298
Added:
let bullet_text = String.sub line start (i - start + 1) ^ " " in
299
Added:
pos := i + 2;
300
Added:
Some bullet_text
301
Added:
end
302
Added:
else if (i = start) && (line.[i] >= 'a' && line.[i] <= 'z' || line.[i] >= 'A' && line.[i] <= 'Z')
303
Added:
&& i + 1 < len && (line.[i + 1] = '.' || line.[i + 1] = ')')
304
Added:
&& i + 2 < len && line.[i + 2] = ' ' then begin
305
Added:
let bullet_text = String.sub line start 2 ^ " " in
306
Added:
pos := i + 3;
307
Added:
Some bullet_text
308
Added:
end
309
Added:
else None
310
Added:
in
311
Added:
scan_digits start
312
Added:
end
313
Added:
in
314
Added:
match bullet_result with
315
Added:
| None -> None
316
Added:
| Some bullet ->
317
Added:
(* Check for counter set: [@N] *)
318
Added:
let counter_set =
319
Added:
if !pos + 2 < len && line.[!pos] = '[' && line.[!pos + 1] = '@' then begin
320
Added:
let start = !pos + 2 in
321
Added:
let rec find_bracket i =
322
Added:
if i >= len then None
323
Added:
else if line.[i] = ']' then
324
Added:
let num_str = String.sub line start (i - start) in
325
Added:
(try
326
Added:
pos := i + 1;
327
Added:
if !pos < len && line.[!pos] = ' ' then incr pos;
328
Added:
Some (int_of_string num_str)
329
Added:
with Failure _ -> None)
330
Added:
else find_bracket (i + 1)
331
Added:
in
332
Added:
find_bracket start
333
Added:
end
334
Added:
else None
335
Added:
in
336
Added:
(* Check for checkbox: [ ], [X], [-] *)
337
Added:
let checkbox =
338
Added:
if !pos + 2 < len && line.[!pos] = '['
339
Added:
&& (line.[!pos + 1] = ' ' || line.[!pos + 1] = 'X' || line.[!pos + 1] = 'x'
340
Added:
|| line.[!pos + 1] = '-')
341
Added:
&& line.[!pos + 2] = ']' then begin
342
Added:
let cb = String.sub line !pos 3 in
343
Added:
pos := !pos + 3;
344
Added:
if !pos < len && line.[!pos] = ' ' then incr pos;
345
Added:
Some cb
346
Added:
end
347
Added:
else None
348
Added:
in
349
Added:
let rest = if !pos < len then String.sub line !pos (len - !pos) else "" in
350
Added:
Some {
351
Added:
lid_indent = indent;
352
Added:
lid_bullet = bullet;
353
Added:
lid_counter_set = counter_set;
354
Added:
lid_checkbox = checkbox;
355
Added:
lid_rest = rstrip rest;
356
Added:
}
357
Added:
358
Added:
(** Check if a line is a horizontal rule: 5+ hyphens, nothing else. *)
359
Added:
let is_horizontal_rule line start =
360
Added:
let len = String.length line in
361
Added:
let rec count i =
362
Added:
if i >= len then i - start
363
Added:
else if line.[i] = '-' then count (i + 1)
364
Added:
else if line.[i] = ' ' || line.[i] = '\t' || line.[i] = '\r' then
365
Added:
(* trailing whitespace ok *)
366
Added:
let rest = rstrip (String.sub line i (len - i)) in
367
Added:
if String.length rest = 0 then i - start else 0
368
Added:
else 0
369
Added:
in
370
Added:
count start >= 5
371
Added:
372
Added:
(** Check if a line is a planning line (starts with DEADLINE:, SCHEDULED:, or CLOSED:). *)
373
Added:
let is_planning_line line start =
374
Added:
starts_at line start "DEADLINE:" ||
375
Added:
starts_at line start "SCHEDULED:" ||
376
Added:
starts_at line start "CLOSED:"
377
Added:
378
Added:
(** Check if a line is a table row (starts with |). *)
379
Added:
let is_table_row line start =
380
Added:
start < String.length line && line.[start] = '|'
381
Added:
382
Added:
(** Check if a line is a comment: # followed by space or end of line. *)
383
Added:
let try_comment_line line start =
384
Added:
let len = String.length line in
385
Added:
if start >= len || line.[start] <> '#' then None
386
Added:
else if start + 1 >= len then Some ""
387
Added:
else if line.[start + 1] = ' ' then
388
Added:
Some (rstrip (String.sub line (start + 2) (len - start - 2)))
389
Added:
else if line.[start + 1] = '+' then None (* keyword, not comment *)
390
Added:
else None (* # followed by non-space non-+ is not a comment *)
391
Added:
392
Added:
(** Check if a line is fixed-width: ": " or ":" at end of line. *)
393
Added:
let try_fixed_width line start =
394
Added:
let len = String.length line in
395
Added:
if start >= len || line.[start] <> ':' then None
396
Added:
else if start + 1 >= len then Some ""
397
Added:
else if line.[start + 1] = ' ' then
398
Added:
Some (rstrip (String.sub line (start + 2) (len - start - 2)))
399
Added:
else None
400
Added:
401
Added:
(** Check if a line is a heading: starts with one or more * followed by space. *)
402
Added:
let try_heading line =
403
Added:
let len = String.length line in
404
Added:
if len = 0 || line.[0] <> '*' then None
405
Added:
else
406
Added:
let rec count_stars i =
407
Added:
if i >= len then i
408
Added:
else if line.[i] = '*' then count_stars (i + 1)
409
Added:
else i
410
Added:
in
411
Added:
let stars = count_stars 0 in
412
Added:
if stars >= len then
413
Added:
(* Line is all stars with no space — it's a heading with empty title *)
414
Added:
None (* Actually per spec, space after stars is mandatory *)
415
Added:
else if line.[stars] = ' ' then
416
Added:
let rest = String.sub line (stars + 1) (len - stars - 1) in
417
Added:
Some (stars, rstrip rest)
418
Added:
else None
419
Added:
420
Added:
(** Classify the next line and return its token. *)
421
Added:
let classify_line _st line =
422
Added:
let line = rstrip line in
423
Added:
if is_blank_line line then Blank
424
Added:
else
425
Added:
let indent = leading_indent line in
426
Added:
let start = indent in
427
Added:
(* Headings must be at column 0 *)
428
Added:
if indent = 0 then begin
429
Added:
match try_heading line with
430
Added:
| Some (level, rest) -> Heading (level, rest)
431
Added:
| None ->
432
Added:
(* Try keyword/block *)
433
Added:
match try_begin_block line start with
434
Added:
| Some (name, params) -> Begin_block (name, params)
435
Added:
| None ->
436
Added:
match try_end_block line start with
437
Added:
| Some name -> End_block name
438
Added:
| None ->
439
Added:
match try_keyword line start with
440
Added:
| Some (key, value) ->
441
Added:
if is_affiliated_key key then
442
Added:
(* Check for optional value: #+KEY[OPTVAL]: VALUE *)
443
Added:
Affiliated_keyword (String.uppercase_ascii key, None, value)
444
Added:
else
445
Added:
Keyword (String.uppercase_ascii key, value)
446
Added:
| None ->
447
Added:
if is_drawer_end line start then Drawer_end
448
Added:
else
449
Added:
match try_drawer_begin line start with
450
Added:
| Some name -> Drawer_begin name
451
Added:
| None ->
452
Added:
match try_property line start with
453
Added:
| Some (name, value) -> Property (name, value)
454
Added:
| None ->
455
Added:
if is_horizontal_rule line start then Horizontal_rule
456
Added:
else if is_planning_line line start then Planning line
457
Added:
else if is_table_row line start then Table_row line
458
Added:
else
459
Added:
match try_comment_line line start with
460
Added:
| Some content -> Comment_line content
461
Added:
| None ->
462
Added:
match try_fixed_width line start with
463
Added:
| Some content -> Fixed_width content
464
Added:
| None ->
465
Added:
match try_list_item line with
466
Added:
| Some data -> List_item data
467
Added:
| None -> Text_line line
468
Added:
end
469
Added:
else begin
470
Added:
(* Indented lines *)
471
Added:
if is_planning_line line start then Planning line
472
Added:
else if is_table_row line start then Table_row line
473
Added:
else if is_drawer_end line start then Drawer_end
474
Added:
else
475
Added:
match try_drawer_begin line start with
476
Added:
| Some name -> Drawer_begin name
477
Added:
| None ->
478
Added:
match try_begin_block line start with
479
Added:
| Some (name, params) -> Begin_block (name, params)
480
Added:
| None ->
481
Added:
match try_end_block line start with
482
Added:
| Some name -> End_block name
483
Added:
| None ->
484
Added:
match try_keyword line start with
485
Added:
| Some (key, value) ->
486
Added:
if is_affiliated_key key then
487
Added:
Affiliated_keyword (String.uppercase_ascii key, None, value)
488
Added:
else
489
Added:
Keyword (String.uppercase_ascii key, value)
490
Added:
| None ->
491
Added:
match try_property line start with
492
Added:
| Some (name, value) -> Property (name, value)
493
Added:
| None ->
494
Added:
match try_comment_line line start with
495
Added:
| Some content -> Comment_line content
496
Added:
| None ->
497
Added:
match try_fixed_width line start with
498
Added:
| Some content -> Fixed_width content
499
Added:
| None ->
500
Added:
match try_list_item line with
501
Added:
| Some data -> List_item data
502
Added:
| None -> Text_line line
503
Added:
end
504
Added:
505
Added:
(** Get the next token from the lexer. *)
506
Added:
let next_token st =
507
Added:
if st.line_idx >= Array.length st.lines then Eof
508
Added:
else begin
509
Added:
let line = st.lines.(st.line_idx) in
510
Added:
st.line_idx <- st.line_idx + 1;
511
Added:
st.line_number <- st.line_number + 1;
512
Added:
classify_line st line
513
Added:
end
514
Added:
515
Added:
(** Peek at the next token without consuming it. *)
516
Added:
let peek_token st =
517
Added:
if st.line_idx >= Array.length st.lines then Eof
518
Added:
else
519
Added:
let line = st.lines.(st.line_idx) in
520
Added:
classify_line st line
521
Added:
522
Added:
(** Tokenize the entire input into a list of (token, line_number) pairs.
523
Added:
Useful for testing and for feeding Menhir. *)
524
Added:
let tokenize ~config input =
525
Added:
let st = create ~config input in
526
Added:
let rec loop acc =
527
Added:
let ln = st.line_number in
528
Added:
let tok = next_token st in
529
Added:
match tok with
530
Added:
| Eof -> List.rev ((Eof, ln) :: acc)
531
Added:
| _ -> loop ((tok, ln) :: acc)
532
Added:
in
533
Added:
loop []
534
Added:
535
Added:
let _ = starts_at (* suppress warning if unused directly *)
536
Added:
let _ = peek_token
lib/normalize.ml
@@ -0,0 +1,613 @@
1
Added:
(** Raw_ast to Ast normalization.
2
Added:
3
Added:
Transforms the flat [Raw_ast.document] produced by the structural
4
Added:
parser into the semantic [Ast.document] tree. This includes:
5
Added:
- building heading hierarchy from flat headings
6
Added:
- parsing heading titles for TODO/priority/tags/COMMENT
7
Added:
- inline parsing of text fields
8
Added:
- list nesting by indentation
9
Added:
- block classification
10
Added:
- planning and property extraction
11
Added:
- affiliated keyword attachment
12
Added:
- directive collection *)
13
Added:
14
Added:
(* ------------------------------------------------------------------ *)
15
Added:
(* Utility helpers *)
16
Added:
(* ------------------------------------------------------------------ *)
17
Added:
18
Added:
let string_lowercase = String.lowercase_ascii
19
Added:
20
Added:
(** Trim leading and trailing whitespace from a string. *)
21
Added:
let trim = String.trim
22
Added:
23
Added:
(** Split a string on the first space. *)
24
Added:
let split_first_word s =
25
Added:
let s = trim s in
26
Added:
match String.index_opt s ' ' with
27
Added:
| None -> (s, "")
28
Added:
| Some i -> (String.sub s 0 i, String.sub s (i + 1) (String.length s - i - 1))
29
Added:
30
Added:
(* ------------------------------------------------------------------ *)
31
Added:
(* Heading title parsing *)
32
Added:
(* ------------------------------------------------------------------ *)
33
Added:
34
Added:
(** Parse tags from the end of a heading title.
35
Added:
Tags look like :tag1:tag2: at the end of the line. *)
36
Added:
let extract_tags title =
37
Added:
let title = trim title in
38
Added:
let len = String.length title in
39
Added:
if len < 2 || title.[len - 1] <> ':' then (title, [])
40
Added:
else begin
41
Added:
(* Find the start of the tags section: look for a space followed by : *)
42
Added:
let rec find_tag_start i =
43
Added:
if i <= 0 then None
44
Added:
else if title.[i] = ' ' || title.[i] = '\t' then
45
Added:
if i + 1 < len && title.[i + 1] = ':' then Some (i + 1)
46
Added:
else find_tag_start (i - 1)
47
Added:
else find_tag_start (i - 1)
48
Added:
in
49
Added:
match find_tag_start (len - 2) with
50
Added:
| None ->
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
56
Added:
("", tags)
57
Added:
else (title, [])
58
Added:
else (title, [])
59
Added:
| Some tag_start ->
60
Added:
let tag_str = String.sub title (tag_start + 1) (len - tag_start - 2) in
61
Added:
let tags = String.split_on_char ':' tag_str in
62
Added:
if List.for_all (fun t -> String.length t > 0) tags then
63
Added:
let title_part = trim (String.sub title 0 tag_start) in
64
Added:
(title_part, tags)
65
Added:
else (title, [])
66
Added:
end
67
Added:
68
Added:
(** Parse priority from the beginning of a heading title.
69
Added:
Priority looks like [#A] at the start. *)
70
Added:
let extract_priority title =
71
Added:
let title = trim title in
72
Added:
if String.length title >= 4
73
Added:
&& title.[0] = '['
74
Added:
&& title.[1] = '#'
75
Added:
&& title.[3] = ']'
76
Added:
&& (title.[2] >= 'A' && title.[2] <= 'Z') then
77
Added:
let rest = trim (String.sub title 4 (String.length title - 4)) in
78
Added:
(Some title.[2], rest)
79
Added:
else
80
Added:
(None, title)
81
Added:
82
Added:
(** Parse a heading raw title string into its components.
83
Added:
Order: TODO [#PRIORITY] COMMENT title :tags: *)
84
Added:
let parse_heading_title config raw_title =
85
Added:
let raw_title = trim raw_title in
86
Added:
(* Extract tags from end first *)
87
Added:
let (title_no_tags, tags) = extract_tags raw_title in
88
Added:
(* Extract TODO keyword from front *)
89
Added:
let (todo, rest) =
90
Added:
let (first_word, remainder) = split_first_word title_no_tags in
91
Added:
if first_word <> "" && Config.is_todo_keyword config first_word then
92
Added:
(Some first_word, remainder)
93
Added:
else
94
Added:
(None, title_no_tags)
95
Added:
in
96
Added:
(* Extract priority *)
97
Added:
let (priority, rest2) = extract_priority rest in
98
Added:
(* Extract COMMENT marker *)
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)
102
Added:
else (false, rest2)
103
Added:
in
104
Added:
(* Parse remaining text as inline content *)
105
Added:
let title_inline =
106
Added:
if trim rest3 = "" then []
107
Added:
else Parse_bridge.parse_inline (trim rest3)
108
Added:
in
109
Added:
(todo, priority, commented, title_inline, tags)
110
Added:
111
Added:
(* ------------------------------------------------------------------ *)
112
Added:
(* Checkbox parsing *)
113
Added:
(* ------------------------------------------------------------------ *)
114
Added:
115
Added:
let parse_checkbox = function
116
Added:
| Some "[ ]" -> Some Ast.Unchecked
117
Added:
| Some "[X]" | Some "[x]" -> Some Ast.Checked
118
Added:
| Some "[-]" -> Some Ast.Partial
119
Added:
| _ -> None
120
Added:
121
Added:
(* ------------------------------------------------------------------ *)
122
Added:
(* Descriptive list tag extraction *)
123
Added:
(* ------------------------------------------------------------------ *)
124
Added:
125
Added:
(** Extract a descriptive list tag from the first body line.
126
Added:
A descriptive list item has "TAG :: rest" in its text. *)
127
Added:
let extract_list_tag text =
128
Added:
match String.index_opt text ':' with
129
Added:
| None -> (None, text)
130
Added:
| Some i ->
131
Added:
if i + 1 < String.length text && text.[i + 1] = ':' then
132
Added:
let tag = trim (String.sub text 0 i) in
133
Added:
let rest_start = i + 2 in
134
Added:
let rest =
135
Added:
if rest_start < String.length text then
136
Added:
trim (String.sub text rest_start (String.length text - rest_start))
137
Added:
else ""
138
Added:
in
139
Added:
(Some tag, rest)
140
Added:
else (None, text)
141
Added:
142
Added:
(* ------------------------------------------------------------------ *)
143
Added:
(* List nesting *)
144
Added:
(* ------------------------------------------------------------------ *)
145
Added:
146
Added:
(** Determine list kind from the first item. *)
147
Added:
let determine_list_kind (items : Raw_ast.raw_list_item list) =
148
Added:
match items with
149
Added:
| [] -> Ast.Unordered
150
Added:
| first :: _ ->
151
Added:
let bullet = trim first.Raw_ast.rli_bullet in
152
Added:
if first.Raw_ast.rli_tag <> None then Ast.Descriptive
153
Added:
else begin
154
Added:
(* Check if bullet indicates an ordered list *)
155
Added:
let len = String.length bullet in
156
Added:
if len >= 2 then
157
Added:
let last = bullet.[len - 1] in
158
Added:
if last = '.' || last = ')' then
159
Added:
(* Check if prefix is digits or alpha *)
160
Added:
let prefix = String.sub bullet 0 (len - 1) in
161
Added:
let is_ordered =
162
Added:
String.length prefix > 0 &&
163
Added:
(let c = prefix.[0] in
164
Added:
(c >= '0' && c <= '9') || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'))
165
Added:
in
166
Added:
if is_ordered then Ast.Ordered else Ast.Unordered
167
Added:
else Ast.Unordered
168
Added:
else Ast.Unordered
169
Added:
end
170
Added:
171
Added:
(** Check if a raw list item text contains a descriptive tag (::). *)
172
Added:
let item_has_tag (item : Raw_ast.raw_list_item) =
173
Added:
item.Raw_ast.rli_tag <> None ||
174
Added:
(match item.Raw_ast.rli_body_lines with
175
Added:
| first :: _ ->
176
Added:
(match String.index_opt first ':' with
177
Added:
| Some i -> i + 1 < String.length first && first.[i + 1] = ':'
178
Added:
| None -> false)
179
Added:
| [] -> false)
180
Added:
181
Added:
(** Determine list kind considering descriptive tag detection. *)
182
Added:
let determine_list_kind_with_tags (items : Raw_ast.raw_list_item list) =
183
Added:
match items with
184
Added:
| [] -> Ast.Unordered
185
Added:
| first :: _ ->
186
Added:
if item_has_tag first then Ast.Descriptive
187
Added:
else determine_list_kind items
188
Added:
189
Added:
(** Nest flat list items by indentation into a tree.
190
Added:
Items with greater indentation than the first item at this level
191
Added:
become sub-items of the preceding item. *)
192
Added:
let rec nest_list_items (items : Raw_ast.raw_list_item list) : Ast.list_item list =
193
Added:
match items with
194
Added:
| [] -> []
195
Added:
| first :: _ ->
196
Added:
let base_indent = first.Raw_ast.rli_indent in
197
Added:
let rec group acc current_item remaining =
198
Added:
match remaining with
199
Added:
| [] ->
200
Added:
let finished = finish_item current_item [] in
201
Added:
List.rev (finished :: acc)
202
Added:
| next :: _ when next.Raw_ast.rli_indent > base_indent ->
203
Added:
(* Collect all deeper items as sub-items of current_item *)
204
Added:
let (sub_items, remaining') = collect_sub_items base_indent remaining in
205
Added:
let finished = finish_item current_item sub_items in
206
Added:
(match remaining' with
207
Added:
| [] -> List.rev (finished :: acc)
208
Added:
| next_top :: rest_top ->
209
Added:
group (finished :: acc) next_top rest_top)
210
Added:
| next :: rest ->
211
Added:
(* Same level: finish current, start new *)
212
Added:
let finished = finish_item current_item [] in
213
Added:
group (finished :: acc) next rest
214
Added:
in
215
Added:
group [] first (List.tl items)
216
Added:
217
Added:
and collect_sub_items base_indent items =
218
Added:
let rec collect acc = function
219
Added:
| [] -> (List.rev acc, [])
220
Added:
| item :: rest ->
221
Added:
if item.Raw_ast.rli_indent > base_indent then
222
Added:
collect (item :: acc) rest
223
Added:
else
224
Added:
(List.rev acc, item :: rest)
225
Added:
in
226
Added:
collect [] items
227
Added:
228
Added:
and finish_item (raw : Raw_ast.raw_list_item) (sub_items : Raw_ast.raw_list_item list) : Ast.list_item =
229
Added:
let checkbox = parse_checkbox raw.Raw_ast.rli_checkbox in
230
Added:
(* Join body lines *)
231
Added:
let body_text = String.concat " " raw.Raw_ast.rli_body_lines in
232
Added:
(* Check for descriptive tag *)
233
Added:
let (tag_opt, content_text) =
234
Added:
match raw.Raw_ast.rli_tag with
235
Added:
| Some t -> (Some t, body_text)
236
Added:
| None -> extract_list_tag body_text
237
Added:
in
238
Added:
let tag_inline = Option.map (fun t -> Parse_bridge.parse_inline t) tag_opt in
239
Added:
(* Build contents: paragraph from text + sub-list if any *)
240
Added:
let contents =
241
Added:
let text_elements =
242
Added:
if trim content_text = "" then []
243
Added:
else [Ast.Paragraph (Parse_bridge.parse_inline content_text, [])]
244
Added:
in
245
Added:
let sub_list_elements =
246
Added:
if sub_items = [] then []
247
Added:
else
248
Added:
let kind = determine_list_kind_with_tags sub_items in
249
Added:
[Ast.Plain_list (kind, nest_list_items sub_items)]
250
Added:
in
251
Added:
text_elements @ sub_list_elements
252
Added:
in
253
Added:
{ Ast.li_bullet = raw.Raw_ast.rli_bullet;
254
Added:
li_counter_set = raw.Raw_ast.rli_counter_set;
255
Added:
li_checkbox = checkbox;
256
Added:
li_tag = tag_inline;
257
Added:
li_contents = contents;
258
Added:
}
259
Added:
260
Added:
(* ------------------------------------------------------------------ *)
261
Added:
(* Table normalization *)
262
Added:
(* ------------------------------------------------------------------ *)
263
Added:
264
Added:
(** Parse a table row string into cells.
265
Added:
Row format: "| cell1 | cell2 | cell3 |" *)
266
Added:
let parse_table_row_cells row_str =
267
Added:
(* Strip leading and trailing | *)
268
Added:
let s = trim row_str in
269
Added:
let s =
270
Added:
if String.length s > 0 && s.[0] = '|' then
271
Added:
String.sub s 1 (String.length s - 1)
272
Added:
else s
273
Added:
in
274
Added:
let s =
275
Added:
if String.length s > 0 && s.[String.length s - 1] = '|' then
276
Added:
String.sub s 0 (String.length s - 1)
277
Added:
else s
278
Added:
in
279
Added:
let parts = String.split_on_char '|' s in
280
Added:
List.map (fun cell -> Parse_bridge.parse_inline (trim cell)) parts
281
Added:
282
Added:
let normalize_table_row (row : Raw_ast.raw_table_row) : Ast.table_row =
283
Added:
match row with
284
Added:
| Raw_ast.Raw_table_rule -> Ast.Table_row_rule
285
Added:
| Raw_ast.Raw_table_standard s ->
286
Added:
Ast.Table_row_standard (parse_table_row_cells s)
287
Added:
288
Added:
let normalize_table (rows : Raw_ast.raw_table_row list) : Ast.table =
289
Added:
{ Ast.rows = List.map normalize_table_row rows }
290
Added:
291
Added:
(* ------------------------------------------------------------------ *)
292
Added:
(* Block classification *)
293
Added:
(* ------------------------------------------------------------------ *)
294
Added:
295
Added:
(** Parse src block params: first word is language, rest is switches/arguments. *)
296
Added:
let parse_src_params params_opt =
297
Added:
match params_opt with
298
Added:
| None -> (None, None, None)
299
Added:
| Some params ->
300
Added:
let params = trim params in
301
Added:
if params = "" then (None, None, None)
302
Added:
else
303
Added:
let (lang, rest) = split_first_word params in
304
Added:
let language = if lang = "" then None else Some lang in
305
Added:
let arguments = if trim rest = "" then None else Some (trim rest) in
306
Added:
(language, None, arguments)
307
Added:
308
Added:
(** Normalize a block body that contains recursive elements. *)
309
Added:
let rec normalize_recursive_body (elements : Raw_ast.raw_element list) config : Ast.element list =
310
Added:
normalize_elements config elements
311
Added:
312
Added:
(** Classify a raw block into the appropriate Ast.block variant. *)
313
Added:
and classify_block (raw : Raw_ast.raw_block) config (affiliated : Ast.affiliated list) : Ast.block =
314
Added:
let name = string_lowercase raw.rb_name in
315
Added:
match name with
316
Added:
| "src" ->
317
Added:
let body_str = match raw.rb_body with
318
Added:
| Raw_ast.Opaque_body s -> s
319
Added:
| Raw_ast.Recursive_body _ -> ""
320
Added:
in
321
Added:
let (language, switches, arguments) = parse_src_params raw.rb_params in
322
Added:
Ast.Src_block { src_language = language; src_switches = switches;
323
Added:
src_arguments = arguments; src_value = body_str;
324
Added:
src_affiliated = affiliated }
325
Added:
| "example" ->
326
Added:
let body_str = match raw.rb_body with
327
Added:
| Raw_ast.Opaque_body s -> s
328
Added:
| Raw_ast.Recursive_body _ -> ""
329
Added:
in
330
Added:
Ast.Example_block { ex_value = body_str; ex_switches = raw.rb_params;
331
Added:
ex_affiliated = affiliated }
332
Added:
| "export" ->
333
Added:
let body_str = match raw.rb_body with
334
Added:
| Raw_ast.Opaque_body s -> s
335
Added:
| Raw_ast.Recursive_body _ -> ""
336
Added:
in
337
Added:
let backend = match raw.rb_params with
338
Added:
| None -> ""
339
Added:
| Some p -> fst (split_first_word p)
340
Added:
in
341
Added:
Ast.Export_block { exp_backend = backend; exp_value = body_str;
342
Added:
exp_affiliated = affiliated }
343
Added:
| "comment" ->
344
Added:
let body_str = match raw.rb_body with
345
Added:
| Raw_ast.Opaque_body s -> s
346
Added:
| Raw_ast.Recursive_body _ -> ""
347
Added:
in
348
Added:
Ast.Comment_block { cb_value = body_str; cb_affiliated = affiliated }
349
Added:
| "quote" ->
350
Added:
let contents = match raw.rb_body with
351
Added:
| Raw_ast.Recursive_body elems -> normalize_recursive_body elems config
352
Added:
| Raw_ast.Opaque_body s ->
353
Added:
if trim s = "" then []
354
Added:
else [Ast.Paragraph (Parse_bridge.parse_inline s, [])]
355
Added:
in
356
Added:
Ast.Quote_block { qt_contents = contents; qt_affiliated = affiliated }
357
Added:
| "center" ->
358
Added:
let contents = match raw.rb_body with
359
Added:
| Raw_ast.Recursive_body elems -> normalize_recursive_body elems config
360
Added:
| Raw_ast.Opaque_body s ->
361
Added:
if trim s = "" then []
362
Added:
else [Ast.Paragraph (Parse_bridge.parse_inline s, [])]
363
Added:
in
364
Added:
Ast.Center_block { cn_contents = contents; cn_affiliated = affiliated }
365
Added:
| "verse" ->
366
Added:
let inline = match raw.rb_body with
367
Added:
| Raw_ast.Opaque_body s -> Parse_bridge.parse_inline s
368
Added:
| Raw_ast.Recursive_body _ -> []
369
Added:
in
370
Added:
Ast.Verse_block { vs_contents = inline; vs_affiliated = affiliated }
371
Added:
| _ ->
372
Added:
let contents = match raw.rb_body with
373
Added:
| Raw_ast.Recursive_body elems -> normalize_recursive_body elems config
374
Added:
| Raw_ast.Opaque_body s ->
375
Added:
if trim s = "" then []
376
Added:
else [Ast.Paragraph (Parse_bridge.parse_inline s, [])]
377
Added:
in
378
Added:
Ast.Custom_block { cst_name = raw.rb_name; cst_params = raw.rb_params;
379
Added:
cst_contents = contents; cst_affiliated = affiliated }
380
Added:
381
Added:
(* ------------------------------------------------------------------ *)
382
Added:
(* Element normalization with affiliated keyword attachment *)
383
Added:
(* ------------------------------------------------------------------ *)
384
Added:
385
Added:
(** Normalize a list of raw elements into Ast elements.
386
Added:
Handles affiliated keyword collection and attachment. *)
387
Added:
and normalize_elements config (raw_elements : Raw_ast.raw_element list) : Ast.element list =
388
Added:
let rec process acc affiliated = function
389
Added:
| [] ->
390
Added:
(* Any trailing affiliated keywords become plain keywords *)
391
Added:
let trailing = List.rev_map (fun (aff : Ast.affiliated) ->
392
Added:
Ast.Keyword { kw_key = aff.aff_name; kw_value = aff.aff_value }
393
Added:
) affiliated in
394
Added:
List.rev (trailing @ acc)
395
Added:
| Raw_ast.Raw_paragraph [] :: rest ->
396
Added:
(* Blank paragraph: skip it but flush any pending affiliated as keywords *)
397
Added:
if affiliated <> [] then begin
398
Added:
let kws = List.rev_map (fun (aff : Ast.affiliated) ->
399
Added:
Ast.Keyword { kw_key = aff.aff_name; kw_value = aff.aff_value }
400
Added:
) affiliated in
401
Added:
process (kws @ acc) [] rest
402
Added:
end else
403
Added:
process acc [] rest
404
Added:
| Raw_ast.Raw_affiliated (name, opt, value) :: rest ->
405
Added:
let aff = { Ast.aff_name = name; aff_optional = opt; aff_value = value } in
406
Added:
process acc (aff :: affiliated) rest
407
Added:
| elem :: rest ->
408
Added:
let normalized = normalize_single_element config elem (List.rev affiliated) in
409
Added:
(match normalized with
410
Added:
| Some e -> process (e :: acc) [] rest
411
Added:
| None -> process acc [] rest)
412
Added:
in
413
Added:
process [] [] raw_elements
414
Added:
415
Added:
(** Normalize a single raw element into an Ast element. *)
416
Added:
and normalize_single_element config (elem : Raw_ast.raw_element) (affiliated : Ast.affiliated list) : Ast.element option =
417
Added:
match elem with
418
Added:
| Raw_ast.Raw_paragraph [] -> None
419
Added:
| Raw_ast.Raw_paragraph lines ->
420
Added:
let text = String.concat " " lines in
421
Added:
let inline = Parse_bridge.parse_inline text in
422
Added:
Some (Ast.Paragraph (inline, affiliated))
423
Added:
| Raw_ast.Raw_list_items items ->
424
Added:
let kind = determine_list_kind_with_tags items in
425
Added:
let nested = nest_list_items items in
426
Added:
Some (Ast.Plain_list (kind, nested))
427
Added:
| Raw_ast.Raw_table rows ->
428
Added:
Some (Ast.Table (normalize_table rows))
429
Added:
| Raw_ast.Raw_block raw_block ->
430
Added:
Some (Ast.Block (classify_block raw_block config affiliated))
431
Added:
| Raw_ast.Raw_drawer drawer ->
432
Added:
let contents = normalize_elements config drawer.rd_contents in
433
Added:
Some (Ast.Drawer (drawer.rd_name, contents))
434
Added:
| Raw_ast.Raw_keyword (key, value) ->
435
Added:
Some (Ast.Keyword { kw_key = key; kw_value = value })
436
Added:
| Raw_ast.Raw_affiliated (name, _opt, value) ->
437
Added:
(* Standalone affiliated keyword not attached to anything → keyword *)
438
Added:
Some (Ast.Keyword { kw_key = name; kw_value = value })
439
Added:
| Raw_ast.Raw_comment lines ->
440
Added:
Some (Ast.Comment lines)
441
Added:
| Raw_ast.Raw_fixed_width lines ->
442
Added:
Some (Ast.Fixed_width lines)
443
Added:
| Raw_ast.Raw_horizontal_rule ->
444
Added:
Some Ast.Horizontal_rule
445
Added:
| Raw_ast.Raw_planning _ ->
446
Added:
(* Planning outside heading context becomes a paragraph *)
447
Added:
None
448
Added:
| Raw_ast.Raw_property_drawer _ ->
449
Added:
(* Property drawer outside heading context: ignore *)
450
Added:
None
451
Added:
| Raw_ast.Raw_heading _ ->
452
Added:
(* Should not appear in element lists *)
453
Added:
None
454
Added:
455
Added:
(* ------------------------------------------------------------------ *)
456
Added:
(* Planning and property extraction from heading body *)
457
Added:
(* ------------------------------------------------------------------ *)
458
Added:
459
Added:
(** Extract a timestamp from a raw planning entry.
460
Added:
Uses the inline parser which handles timestamps. *)
461
Added:
let extract_timestamp ts_str =
462
Added:
let inlines = Parse_bridge.parse_inline ts_str in
463
Added:
let rec find_ts = function
464
Added:
| [] -> None
465
Added:
| Ast.Timestamp ts :: _ -> Some ts
466
Added:
| _ :: rest -> find_ts rest
467
Added:
in
468
Added:
find_ts inlines
469
Added:
470
Added:
(** Extract planning information from a list of raw_planning entries. *)
471
Added:
let extract_planning (entries : Raw_ast.raw_planning list) : Ast.planning option =
472
Added:
if entries = [] then None
473
Added:
else begin
474
Added:
let deadline = ref None in
475
Added:
let scheduled = ref None in
476
Added:
let closed = ref None in
477
Added:
List.iter (fun (entry : Raw_ast.raw_planning) ->
478
Added:
match entry.rpl_keyword with
479
Added:
| "DEADLINE" -> deadline := extract_timestamp entry.rpl_timestamp
480
Added:
| "SCHEDULED" -> scheduled := extract_timestamp entry.rpl_timestamp
481
Added:
| "CLOSED" -> closed := extract_timestamp entry.rpl_timestamp
482
Added:
| _ -> ()
483
Added:
) entries;
484
Added:
if !deadline = None && !scheduled = None && !closed = None then None
485
Added:
else Some { Ast.deadline = !deadline; scheduled = !scheduled; closed = !closed }
486
Added:
end
487
Added:
488
Added:
(** Extract properties from drawer contents.
489
Added:
In a PROPERTIES drawer, each entry was parsed as Raw_keyword(name, value). *)
490
Added:
let extract_properties (elements : Raw_ast.raw_element list) : Ast.property list =
491
Added:
List.filter_map (fun elem ->
492
Added:
match elem with
493
Added:
| Raw_ast.Raw_keyword (name, value) ->
494
Added:
let prop_value = if trim value = "" then None else Some value in
495
Added:
Some { Ast.prop_name = name; prop_value }
496
Added:
| Raw_ast.Raw_paragraph [] -> None
497
Added:
| _ -> None
498
Added:
) elements
499
Added:
500
Added:
(** Process heading body to extract planning, properties, and remaining elements. *)
501
Added:
let process_heading_body config (body : Raw_ast.raw_element list) =
502
Added:
let (planning, rest1) =
503
Added:
match body with
504
Added:
| Raw_ast.Raw_planning entries :: rest ->
505
Added:
(extract_planning entries, rest)
506
Added:
| _ -> (None, body)
507
Added:
in
508
Added:
let (properties, rest2) =
509
Added:
match rest1 with
510
Added:
| Raw_ast.Raw_drawer { rd_name; rd_contents } :: rest
511
Added:
when string_lowercase rd_name = "properties" ->
512
Added:
(extract_properties rd_contents, rest)
513
Added:
| _ -> ([], rest1)
514
Added:
in
515
Added:
let elements = normalize_elements config rest2 in
516
Added:
(planning, properties, elements)
517
Added:
518
Added:
(* ------------------------------------------------------------------ *)
519
Added:
(* Heading hierarchy *)
520
Added:
(* ------------------------------------------------------------------ *)
521
Added:
522
Added:
(** Build heading hierarchy from a flat list of raw headings.
523
Added:
Each heading's children are subsequent headings with a greater level,
524
Added:
until a heading of equal or lesser level is encountered. *)
525
Added:
let build_heading_tree config (raw_headings : Raw_ast.raw_heading list) : Ast.heading list =
526
Added:
let rec process_headings headings =
527
Added:
match headings with
528
Added:
| [] -> []
529
Added:
| raw :: rest ->
530
Added:
let (children_raw, siblings_raw) = collect_children raw.Raw_ast.rh_level rest in
531
Added:
let (todo, priority, commented, title, tags) =
532
Added:
parse_heading_title config raw.Raw_ast.rh_raw_title
533
Added:
in
534
Added:
let (planning, properties, contents) =
535
Added:
process_heading_body config raw.Raw_ast.rh_body
536
Added:
in
537
Added:
let children = process_headings children_raw in
538
Added:
let heading = {
539
Added:
Ast.level = raw.Raw_ast.rh_level;
540
Added:
todo;
541
Added:
priority;
542
Added:
commented;
543
Added:
title;
544
Added:
tags;
545
Added:
planning;
546
Added:
properties;
547
Added:
heading_contents = contents;
548
Added:
children;
549
Added:
} in
550
Added:
heading :: process_headings siblings_raw
551
Added:
552
Added:
and collect_children parent_level headings =
553
Added:
(* Collect all headings that are deeper than parent_level *)
554
Added:
let rec collect children remaining =
555
Added:
match remaining with
556
Added:
| [] -> (List.rev children, [])
557
Added:
| h :: _ when h.Raw_ast.rh_level <= parent_level ->
558
Added:
(List.rev children, remaining)
559
Added:
| h :: rest ->
560
Added:
collect (h :: children) rest
561
Added:
in
562
Added:
collect [] headings
563
Added:
in
564
Added:
process_headings raw_headings
565
Added:
566
Added:
(* ------------------------------------------------------------------ *)
567
Added:
(* Directive extraction *)
568
Added:
(* ------------------------------------------------------------------ *)
569
Added:
570
Added:
(** Known directive keywords that should be extracted from the preamble. *)
571
Added:
let directive_keywords = [
572
Added:
"TITLE"; "AUTHOR"; "DATE"; "EMAIL"; "LANGUAGE";
573
Added:
"DESCRIPTION"; "OPTIONS"; "STARTUP"; "FILETAGS";
574
Added:
"CATEGORY"; "PROPERTY"; "ARCHIVE"; "COLUMNS";
575
Added:
"LINK"; "PRIORITIES"; "TAGS"; "EXPORT_FILE_NAME";
576
Added:
]
577
Added:
578
Added:
(** Check if a keyword should be treated as a directive. *)
579
Added:
let is_directive_keyword key =
580
Added:
List.mem (String.uppercase_ascii key) directive_keywords
581
Added:
582
Added:
(** Extract directives from the leading keywords of the preamble.
583
Added:
Directives are keywords that appear before any non-keyword/non-blank
584
Added:
element in the preamble. *)
585
Added:
let extract_directives (raw_elements : Raw_ast.raw_element list) :
586
Added:
Ast.directive list * Raw_ast.raw_element list =
587
Added:
let rec collect_leading directives remaining =
588
Added:
match remaining with
589
Added:
| Raw_ast.Raw_keyword (key, value) :: rest when is_directive_keyword key ->
590
Added:
let dir = { Ast.dir_key = key; dir_value = value } in
591
Added:
collect_leading (dir :: directives) rest
592
Added:
| Raw_ast.Raw_paragraph [] :: rest ->
593
Added:
(* Skip blank paragraphs while collecting directives *)
594
Added:
collect_leading directives rest
595
Added:
| Raw_ast.Raw_affiliated _ :: rest ->
596
Added:
(* Skip affiliated keywords in directive zone *)
597
Added:
collect_leading directives rest
598
Added:
| _ -> (List.rev directives, remaining)
599
Added:
in
600
Added:
collect_leading [] raw_elements
601
Added:
602
Added:
(* ------------------------------------------------------------------ *)
603
Added:
(* Top-level normalization *)
604
Added:
(* ------------------------------------------------------------------ *)
605
Added:
606
Added:
let normalize (config : Config.t) (raw : Raw_ast.document) : Ast.document =
607
Added:
(* Extract directives from preamble *)
608
Added:
let (directives, remaining_preamble) = extract_directives raw.rd_preamble in
609
Added:
(* Normalize remaining preamble elements *)
610
Added:
let preamble = normalize_elements config remaining_preamble in
611
Added:
(* Build heading hierarchy *)
612
Added:
let headings = build_heading_tree config raw.rd_headings in
613
Added:
{ Ast.directives; preamble; headings }
lib/org.ml
@@ -0,0 +1,35 @@
1
Added:
(** OCaml Org Mode parser - public entry points.
2
Added:
3
Added:
This module provides the primary API for parsing Org Mode
4
Added:
documents into a semantic AST. *)
5
Added:
6
Added:
let version = "0.1.0"
7
Added:
8
Added:
(** Parse an Org Mode document string into a semantic AST.
9
Added:
10
Added:
This is the primary entry point. It:
11
Added:
1. Pre-scans for file-local declarations (#+TODO etc.)
12
Added:
2. Lexes the input into structural tokens
13
Added:
3. Parses tokens into a raw document tree (Menhir)
14
Added:
4. Normalizes the raw tree into the semantic AST
15
Added:
16
Added:
Malformed input degrades gracefully — the parser always
17
Added:
produces a best-effort document without raising exceptions
18
Added:
for syntax errors. *)
19
Added:
let parse input =
20
Added:
let config = Prescan.scan input in
21
Added:
let raw = Parse_bridge.parse ~config input in
22
Added:
Normalize.normalize config raw
23
Added:
24
Added:
(** Parse an Org Mode document with diagnostic reporting.
25
Added:
26
Added:
Returns both the best-effort AST and a list of diagnostics
27
Added:
for recoverable issues encountered during parsing.
28
Added:
29
Added:
Currently diagnostics are minimal (the parser is permissive
30
Added:
and rarely needs to report issues). Future versions may
31
Added:
report more detailed warnings. *)
32
Added:
let parse_with_diagnostics input =
33
Added:
let _collector = Diagnostic.create_collector () in
34
Added:
let doc = parse input in
35
Added:
(doc, Diagnostic.to_list _collector)
lib/parse_bridge.ml
@@ -0,0 +1,90 @@
1
Added:
(** Bridge between the structural lexer and the Menhir parser.
2
Added:
3
Added:
Converts [Lexer.token] values into [Parser.token] values
4
Added:
and provides the entry point for structural parsing. *)
5
Added:
6
Added:
(** Convert a lexer token to a Menhir parser token. *)
7
Added:
let convert_token (tok : Lexer.token) : Parser.token =
8
Added:
match tok with
9
Added:
| Lexer.Blank -> Parser.BLANK
10
Added:
| Lexer.Heading (level, rest) -> Parser.HEADING (level, rest)
11
Added:
| Lexer.Keyword (key, value) -> Parser.KEYWORD (key, value)
12
Added:
| Lexer.Affiliated_keyword (name, opt, value) -> Parser.AFFILIATED_KEYWORD (name, opt, value)
13
Added:
| Lexer.Begin_block (name, params) -> Parser.BEGIN_BLOCK (name, params)
14
Added:
| Lexer.End_block name -> Parser.END_BLOCK name
15
Added:
| Lexer.Drawer_begin name -> Parser.DRAWER_BEGIN name
16
Added:
| Lexer.Drawer_end -> Parser.DRAWER_END
17
Added:
| Lexer.Property (name, value) -> Parser.PROPERTY (name, value)
18
Added:
| Lexer.Planning line -> Parser.PLANNING line
19
Added:
| Lexer.List_item data -> Parser.LIST_ITEM data
20
Added:
| Lexer.Table_row content -> Parser.TABLE_ROW content
21
Added:
| Lexer.Fixed_width content -> Parser.FIXED_WIDTH content
22
Added:
| Lexer.Comment_line content -> Parser.COMMENT_LINE content
23
Added:
| Lexer.Horizontal_rule -> Parser.HORIZONTAL_RULE
24
Added:
| Lexer.Text_line content -> Parser.TEXT_LINE content
25
Added:
| Lexer.Eof -> Parser.EOF
26
Added:
27
Added:
(** A dummy lexbuf position for Menhir (we track positions ourselves). *)
28
Added:
let dummy_pos = {
29
Added:
Lexing.pos_fname = "";
30
Added:
pos_lnum = 0;
31
Added:
pos_bol = 0;
32
Added:
pos_cnum = 0;
33
Added:
}
34
Added:
35
Added:
(** Parse input text into a Raw_ast.document using the structural
36
Added:
lexer and Menhir parser. *)
37
Added:
let parse ~config input =
38
Added:
let lexer_state = Lexer.create ~config input in
39
Added:
let dummy_lexbuf = Lexing.from_string "" in
40
Added:
dummy_lexbuf.Lexing.lex_start_p <- dummy_pos;
41
Added:
dummy_lexbuf.Lexing.lex_curr_p <- dummy_pos;
42
Added:
let token_fun _lexbuf =
43
Added:
let tok = Lexer.next_token lexer_state in
44
Added:
let menhir_tok = convert_token tok in
45
Added:
let ln = Lexer.line_number lexer_state in
46
Added:
dummy_lexbuf.Lexing.lex_start_p <- { dummy_pos with Lexing.pos_lnum = ln };
47
Added:
dummy_lexbuf.Lexing.lex_curr_p <- { dummy_pos with Lexing.pos_lnum = ln };
48
Added:
menhir_tok
49
Added:
in
50
Added:
Parser.document token_fun dummy_lexbuf
51
Added:
52
Added:
(** Convert an inline lexer token to a Menhir inline parser token. *)
53
Added:
let convert_inline_token (tok : Inline_lexer.token) : Inline_parser.token =
54
Added:
match tok with
55
Added:
| Inline_lexer.TEXT s -> Inline_parser.TEXT s
56
Added:
| Inline_lexer.STAR_OPEN -> Inline_parser.STAR_OPEN
57
Added:
| Inline_lexer.STAR_CLOSE -> Inline_parser.STAR_CLOSE
58
Added:
| Inline_lexer.SLASH_OPEN -> Inline_parser.SLASH_OPEN
59
Added:
| Inline_lexer.SLASH_CLOSE -> Inline_parser.SLASH_CLOSE
60
Added:
| Inline_lexer.UNDER_OPEN -> Inline_parser.UNDER_OPEN
61
Added:
| Inline_lexer.UNDER_CLOSE -> Inline_parser.UNDER_CLOSE
62
Added:
| Inline_lexer.PLUS_OPEN -> Inline_parser.PLUS_OPEN
63
Added:
| Inline_lexer.PLUS_CLOSE -> Inline_parser.PLUS_CLOSE
64
Added:
| Inline_lexer.TILDE s -> Inline_parser.TILDE s
65
Added:
| Inline_lexer.EQUALS s -> Inline_parser.EQUALS s
66
Added:
| Inline_lexer.LINK_OPEN -> Inline_parser.LINK_OPEN
67
Added:
| Inline_lexer.LINK_CLOSE -> Inline_parser.LINK_CLOSE
68
Added:
| Inline_lexer.LINK_SEP -> Inline_parser.LINK_SEP
69
Added:
| Inline_lexer.TIMESTAMP s -> Inline_parser.TIMESTAMP s
70
Added:
| Inline_lexer.ANGLE_LINK s -> Inline_parser.ANGLE_LINK s
71
Added:
| Inline_lexer.PLAIN_LINK s -> Inline_parser.PLAIN_LINK s
72
Added:
| Inline_lexer.LINE_BREAK -> Inline_parser.LINE_BREAK
73
Added:
| Inline_lexer.NEWLINE -> Inline_parser.NEWLINE
74
Added:
| Inline_lexer.EOF -> Inline_parser.EOF
75
Added:
76
Added:
(** Parse inline text into a list of Ast.inline objects. *)
77
Added:
let parse_inline input =
78
Added:
let st = Inline_lexer.create input in
79
Added:
let dummy_lexbuf = Lexing.from_string "" in
80
Added:
dummy_lexbuf.Lexing.lex_start_p <- dummy_pos;
81
Added:
dummy_lexbuf.Lexing.lex_curr_p <- dummy_pos;
82
Added:
let token_fun _lexbuf =
83
Added:
let tok = Inline_lexer.next_token st in
84
Added:
convert_inline_token tok
85
Added:
in
86
Added:
try
87
Added:
Inline_parser.inline_content token_fun dummy_lexbuf
88
Added:
with _ ->
89
Added:
(* Fallback: if inline parsing fails, return plain text *)
90
Added:
[Ast.Plain input]
lib/parser.mly
@@ -0,0 +1,174 @@
1
Added:
(* Structural Menhir grammar for Org Mode documents.
2
Added:
Consumes tokens from the structural lexer and produces Raw_ast.document. *)
3
Added:
4
Added:
%{
5
Added:
open Raw_ast
6
Added:
7
Added:
let convert_list_item (item : Lexer.list_item_data) : raw_list_item =
8
Added:
{ rli_indent = item.Lexer.lid_indent;
9
Added:
rli_bullet = item.Lexer.lid_bullet;
10
Added:
rli_counter_set = item.Lexer.lid_counter_set;
11
Added:
rli_checkbox = item.Lexer.lid_checkbox;
12
Added:
rli_tag = None;
13
Added:
rli_body_lines = [item.Lexer.lid_rest];
14
Added:
}
15
Added:
16
Added:
let parse_planning_entries (line : string) : raw_planning list =
17
Added:
let results = ref [] in
18
Added:
let keywords = ["DEADLINE"; "SCHEDULED"; "CLOSED"] in
19
Added:
List.iter (fun kw ->
20
Added:
let pat = kw ^ ":" in
21
Added:
let len = String.length line in
22
Added:
let plen = String.length pat in
23
Added:
let rec find_from i =
24
Added:
if i + plen > len then ()
25
Added:
else if String.sub line i plen = pat then begin
26
Added:
let rest_start = i + plen in
27
Added:
let rest = String.trim (String.sub line rest_start (len - rest_start)) in
28
Added:
let ts_end =
29
Added:
let rec find_end j closer =
30
Added:
if j >= String.length rest then j
31
Added:
else if rest.[j] = closer then j + 1
32
Added:
else find_end (j + 1) closer
33
Added:
in
34
Added:
if String.length rest > 0 && rest.[0] = '<' then find_end 1 '>'
35
Added:
else if String.length rest > 0 && rest.[0] = '[' then find_end 1 ']'
36
Added:
else 0
37
Added:
in
38
Added:
if ts_end > 0 then
39
Added:
results := { rpl_keyword = kw; rpl_timestamp = String.sub rest 0 ts_end } :: !results
40
Added:
end
41
Added:
else find_from (i + 1)
42
Added:
in
43
Added:
find_from 0
44
Added:
) keywords;
45
Added:
List.rev !results
46
Added:
%}
47
Added:
48
Added:
%token BLANK
49
Added:
%token <int * string> HEADING
50
Added:
%token <string * string> KEYWORD
51
Added:
%token <string * string option * string> AFFILIATED_KEYWORD
52
Added:
%token <string * string option> BEGIN_BLOCK
53
Added:
%token <string> END_BLOCK
54
Added:
%token <string> DRAWER_BEGIN
55
Added:
%token DRAWER_END
56
Added:
%token <string * string option> PROPERTY
57
Added:
%token <string> PLANNING
58
Added:
%token <Lexer.list_item_data> LIST_ITEM
59
Added:
%token <string> TABLE_ROW
60
Added:
%token <string> FIXED_WIDTH
61
Added:
%token <string> COMMENT_LINE
62
Added:
%token HORIZONTAL_RULE
63
Added:
%token <string> TEXT_LINE
64
Added:
%token EOF
65
Added:
66
Added:
%start <Raw_ast.document> document
67
Added:
68
Added:
%%
69
Added:
70
Added:
document:
71
Added:
| preamble = list(element) headings = list(heading) EOF
72
Added:
{ { rd_preamble = preamble; rd_headings = headings } }
73
Added:
;
74
Added:
75
Added:
heading:
76
Added:
| h = HEADING body = list(element)
77
Added:
{ let (level, raw_title) = h in
78
Added:
{ rh_level = level; rh_raw_title = raw_title; rh_body = body } }
79
Added:
;
80
Added:
81
Added:
element:
82
Added:
| BLANK
83
Added:
{ Raw_paragraph [] }
84
Added:
| lines = nonempty_list(TEXT_LINE)
85
Added:
{ Raw_paragraph lines }
86
Added:
| items = nonempty_list(list_item_tok)
87
Added:
{ Raw_list_items (List.map convert_list_item items) }
88
Added:
| rows = nonempty_list(table_row_tok)
89
Added:
{ Raw_table rows }
90
Added:
| b = block
91
Added:
{ Raw_block b }
92
Added:
| d = drawer
93
Added:
{ Raw_drawer d }
94
Added:
| k = KEYWORD
95
Added:
{ let (key, value) = k in Raw_keyword (key, value) }
96
Added:
| a = AFFILIATED_KEYWORD
97
Added:
{ let (name, opt, value) = a in Raw_affiliated (name, opt, value) }
98
Added:
| comments = nonempty_list(COMMENT_LINE)
99
Added:
{ Raw_comment comments }
100
Added:
| lines = nonempty_list(FIXED_WIDTH)
101
Added:
{ Raw_fixed_width lines }
102
Added:
| HORIZONTAL_RULE
103
Added:
{ Raw_horizontal_rule }
104
Added:
| p = PLANNING
105
Added:
{ Raw_planning (parse_planning_entries p) }
106
Added:
;
107
Added:
108
Added:
list_item_tok:
109
Added:
| item = LIST_ITEM { item }
110
Added:
;
111
Added:
112
Added:
table_row_tok:
113
Added:
| row = TABLE_ROW
114
Added:
{ if String.length row > 1 && row.[1] = '-' then Raw_table_rule
115
Added:
else Raw_table_standard row }
116
Added:
;
117
Added:
118
Added:
block:
119
Added:
| b = BEGIN_BLOCK body = list(block_body_line) e = END_BLOCK
120
Added:
{ let (name, params) = b in let _ = e in
121
Added:
{ rb_name = name; rb_params = params; rb_body = Opaque_body (String.concat "\n" body) } }
122
Added:
| b = BEGIN_BLOCK body = list(block_body_line) EOF
123
Added:
{ let (name, params) = b in
124
Added:
{ rb_name = name; rb_params = params; rb_body = Opaque_body (String.concat "\n" body) } }
125
Added:
;
126
Added:
127
Added:
block_body_line:
128
Added:
| t = TEXT_LINE { t }
129
Added:
| BLANK { "" }
130
Added:
| k = KEYWORD { let (key, value) = k in "#+" ^ key ^ ": " ^ value }
131
Added:
| a = AFFILIATED_KEYWORD { let (n, _, v) = a in "#+" ^ n ^ ": " ^ v }
132
Added:
| c = COMMENT_LINE { "# " ^ c }
133
Added:
| f = FIXED_WIDTH { ": " ^ f }
134
Added:
| HORIZONTAL_RULE { "-----" }
135
Added:
| item = LIST_ITEM { item.Lexer.lid_rest }
136
Added:
| row = TABLE_ROW { row }
137
Added:
| p = PLANNING { p }
138
Added:
| prop = PROPERTY { let (n, v) = prop in ":" ^ n ^ ": " ^ (Option.value ~default:"" v) }
139
Added:
| d = DRAWER_BEGIN { ":" ^ d ^ ":" }
140
Added:
| DRAWER_END { ":END:" }
141
Added:
;
142
Added:
143
Added:
(* A drawer handles both property drawers and regular drawers.
144
Added:
Property drawers are distinguished during normalization by their name. *)
145
Added:
drawer:
146
Added:
| name = DRAWER_BEGIN contents = drawer_contents DRAWER_END
147
Added:
{ { rd_name = name; rd_contents = contents } }
148
Added:
| name = DRAWER_BEGIN contents = drawer_contents EOF
149
Added:
{ { rd_name = name; rd_contents = contents } }
150
Added:
;
151
Added:
152
Added:
(* Drawer contents can include properties (for property drawers)
153
Added:
or regular elements (for other drawers). We parse them uniformly
154
Added:
as elements, with properties becoming text that normalization handles. *)
155
Added:
drawer_contents:
156
Added:
| items = list(drawer_item)
157
Added:
{ items }
158
Added:
;
159
Added:
160
Added:
drawer_item:
161
Added:
| BLANK { Raw_paragraph [] }
162
Added:
| lines = nonempty_list(TEXT_LINE) { Raw_paragraph lines }
163
Added:
| p = PROPERTY
164
Added:
{ let (name, value) = p in Raw_keyword (name, Option.value ~default:"" value) }
165
Added:
| k = KEYWORD { let (key, value) = k in Raw_keyword (key, value) }
166
Added:
| a = AFFILIATED_KEYWORD { let (n, _, v) = a in Raw_affiliated (n, None, v) }
167
Added:
| items = nonempty_list(list_item_tok)
168
Added:
{ Raw_list_items (List.map convert_list_item items) }
169
Added:
| rows = nonempty_list(table_row_tok) { Raw_table rows }
170
Added:
| comments = nonempty_list(COMMENT_LINE) { Raw_comment comments }
171
Added:
| lines = nonempty_list(FIXED_WIDTH) { Raw_fixed_width lines }
172
Added:
| HORIZONTAL_RULE { Raw_horizontal_rule }
173
Added:
| pl = PLANNING { Raw_planning (parse_planning_entries pl) }
174
Added:
;
lib/prescan.ml
@@ -0,0 +1,88 @@
1
Added:
(** Pre-scan phase for file-local declarations.
2
Added:
3
Added:
Scans the entire input for syntax-affecting keywords like
4
Added:
#+TODO, #+SEQ_TODO, and #+TYP_TODO before the main parse.
5
Added:
These declarations may appear anywhere in the file and affect
6
Added:
how headings are interpreted. *)
7
Added:
8
Added:
(** Check if a string starts with a prefix (case-insensitive). *)
9
Added:
let starts_with_ci prefix s =
10
Added:
let plen = String.length prefix in
11
Added:
String.length s >= plen
12
Added:
&& String.uppercase_ascii (String.sub s 0 plen) = String.uppercase_ascii prefix
13
Added:
14
Added:
(** Strip leading whitespace from a string. *)
15
Added:
let lstrip s =
16
Added:
let len = String.length s in
17
Added:
let i = ref 0 in
18
Added:
while !i < len && (s.[!i] = ' ' || s.[!i] = '\t') do
19
Added:
incr i
20
Added:
done;
21
Added:
if !i = 0 then s else String.sub s !i (len - !i)
22
Added:
23
Added:
(** Strip trailing whitespace from a string. *)
24
Added:
let rstrip s =
25
Added:
let len = String.length s in
26
Added:
let i = ref (len - 1) in
27
Added:
while !i >= 0 && (s.[!i] = ' ' || s.[!i] = '\t' || s.[!i] = '\r') do
28
Added:
decr i
29
Added:
done;
30
Added:
if !i = len - 1 then s else String.sub s 0 (!i + 1)
31
Added:
32
Added:
(** Strip both leading and trailing whitespace. *)
33
Added:
let strip s = lstrip (rstrip s)
34
Added:
35
Added:
(** Parse a TODO keyword line value into a todo_sequence.
36
Added:
Format: "KEYWORD1 KEYWORD2 | DONE1 DONE2"
37
Added:
If no | is present, all keywords are active and there are no done keywords. *)
38
Added:
let parse_todo_value value =
39
Added:
let value = strip value in
40
Added:
if String.length value = 0 then None
41
Added:
else
42
Added:
let words = String.split_on_char ' ' value |> List.filter (fun s -> s <> "") in
43
Added:
let rec split_at_bar acc = function
44
Added:
| [] -> (List.rev acc, [])
45
Added:
| "|" :: rest -> (List.rev acc, rest)
46
Added:
| w :: rest -> split_at_bar (w :: acc) rest
47
Added:
in
48
Added:
let (active, done_) = split_at_bar [] words in
49
Added:
if active = [] && done_ = [] then None
50
Added:
else Some { Config.active; done_ }
51
Added:
52
Added:
(** Extract the value part after #+KEY: from a line. *)
53
Added:
let extract_keyword_value line =
54
Added:
(* Line format: #+KEY: VALUE *)
55
Added:
let line = lstrip line in
56
Added:
if String.length line < 2 || line.[0] <> '#' || line.[1] <> '+' then
57
Added:
None
58
Added:
else
59
Added:
let rest = String.sub line 2 (String.length line - 2) in
60
Added:
match String.index_opt rest ':' with
61
Added:
| None -> None
62
Added:
| Some colon_pos ->
63
Added:
let key = String.uppercase_ascii (String.sub rest 0 colon_pos) in
64
Added:
let value =
65
Added:
if colon_pos + 1 < String.length rest then
66
Added:
String.sub rest (colon_pos + 1) (String.length rest - colon_pos - 1)
67
Added:
else ""
68
Added:
in
69
Added:
Some (key, strip value)
70
Added:
71
Added:
(** Scan the input for TODO keyword declarations.
72
Added:
Returns a [Config.t] with all discovered TODO sequences. *)
73
Added:
let scan input =
74
Added:
let lines = String.split_on_char '\n' input in
75
Added:
let sequences = ref [] in
76
Added:
List.iter
77
Added:
(fun line ->
78
Added:
match extract_keyword_value line with
79
Added:
| Some (key, value)
80
Added:
when key = "TODO" || key = "SEQ_TODO" || key = "TYP_TODO" ->
81
Added:
(match parse_todo_value value with
82
Added:
| Some seq -> sequences := seq :: !sequences
83
Added:
| None -> ())
84
Added:
| _ -> ())
85
Added:
lines;
86
Added:
match List.rev !sequences with
87
Added:
| [] -> Config.default
88
Added:
| seqs -> { Config.todo_sequences = seqs }
lib/raw_ast.ml
@@ -0,0 +1,82 @@
1
Added:
(** Private raw parse tree types.
2
Added:
3
Added:
These types represent the output of the structural Menhir parser
4
Added:
before normalization. They are flat (no heading hierarchy), store
5
Added:
inline content as raw strings, and preserve the parsing order.
6
Added:
The normalization phase converts these into the public [Ast] types. *)
7
Added:
8
Added:
(** A raw list item as classified by the lexer.
9
Added:
Indentation is preserved for later nesting. *)
10
Added:
type raw_list_item = {
11
Added:
rli_indent : int;
12
Added:
rli_bullet : string;
13
Added:
rli_counter_set : int option;
14
Added:
rli_checkbox : string option; (** "[ ]", "[X]", or "[-]" *)
15
Added:
rli_tag : string option; (** Descriptive list tag text (raw) *)
16
Added:
rli_body_lines : string list; (** Continuation lines *)
17
Added:
}
18
Added:
19
Added:
(** A raw property drawer entry. *)
20
Added:
type raw_property = {
21
Added:
rp_name : string;
22
Added:
rp_value : string option;
23
Added:
}
24
Added:
25
Added:
(** A raw planning line. *)
26
Added:
type raw_planning = {
27
Added:
rpl_keyword : string; (** DEADLINE, SCHEDULED, or CLOSED *)
28
Added:
rpl_timestamp : string; (** Raw timestamp text *)
29
Added:
}
30
Added:
31
Added:
(** A raw table row. *)
32
Added:
type raw_table_row =
33
Added:
| Raw_table_standard of string (** | cell | cell | ... *)
34
Added:
| Raw_table_rule (** |---+---| *)
35
Added:
36
Added:
(** A block body. Opaque blocks store raw text;
37
Added:
recursive blocks store nested raw elements. *)
38
Added:
type raw_block_body =
39
Added:
| Opaque_body of string (** Source, example, export, comment *)
40
Added:
| Recursive_body of raw_element list (** Quote, center, verse, custom *)
41
Added:
42
Added:
(** A raw element produced by the structural parser. *)
43
Added:
and raw_element =
44
Added:
| Raw_heading of raw_heading
45
Added:
| Raw_paragraph of string list (** Consecutive text lines *)
46
Added:
| Raw_list_items of raw_list_item list (** Consecutive list items *)
47
Added:
| Raw_table of raw_table_row list (** Table rows *)
48
Added:
| Raw_block of raw_block
49
Added:
| Raw_drawer of raw_drawer
50
Added:
| Raw_keyword of string * string (** key, value *)
51
Added:
| Raw_affiliated of string * string option * string (** name, optional, value *)
52
Added:
| Raw_comment of string list (** Consecutive comment lines *)
53
Added:
| Raw_fixed_width of string list (** Consecutive fixed-width lines *)
54
Added:
| Raw_horizontal_rule
55
Added:
| Raw_planning of raw_planning list (** Planning line entries *)
56
Added:
| Raw_property_drawer of raw_property list (** Property drawer *)
57
Added:
58
Added:
(** A raw block. *)
59
Added:
and raw_block = {
60
Added:
rb_name : string; (** Block type name (src, quote, etc.) *)
61
Added:
rb_params : string option; (** Parameters after #+begin_NAME *)
62
Added:
rb_body : raw_block_body;
63
Added:
}
64
Added:
65
Added:
(** A raw drawer. *)
66
Added:
and raw_drawer = {
67
Added:
rd_name : string;
68
Added:
rd_contents : raw_element list;
69
Added:
}
70
Added:
71
Added:
(** A raw heading (flat — no hierarchy yet). *)
72
Added:
and raw_heading = {
73
Added:
rh_level : int;
74
Added:
rh_raw_title : string; (** Everything after stars, to be parsed for TODO/priority/tags/inline *)
75
Added:
rh_body : raw_element list; (** Elements until next heading of same or higher level *)
76
Added:
}
77
Added:
78
Added:
(** A raw document produced by the structural parser. *)
79
Added:
type document = {
80
Added:
rd_preamble : raw_element list;
81
Added:
rd_headings : raw_heading list;
82
Added:
}
ocaml-org.opam
@@ -0,0 +1,32 @@
1
Added:
# This file is generated by dune, edit dune-project instead
2
Added:
opam-version: "2.0"
3
Added:
version: "0.1.0"
4
Added:
synopsis: "OCaml Org Mode parser library"
5
Added:
description:
6
Added:
"A compact, high-quality OCaml library for parsing Org Mode documents into a semantic, strongly typed abstract syntax tree."
7
Added:
maintainer: ["blendux"]
8
Added:
authors: ["blendux"]
9
Added:
license: "ISC"
10
Added:
homepage: "https://github.com/blendux/ocaml-org"
11
Added:
bug-reports: "https://github.com/blendux/ocaml-org/issues"
12
Added:
depends: [
13
Added:
"dune" {>= "3.0"}
14
Added:
"ocaml" {>= "5.0"}
15
Added:
"menhir" {>= "20231231"}
16
Added:
"alcotest" {with-test & >= "0.8.5"}
17
Added:
"odoc" {with-doc}
18
Added:
]
19
Added:
build: [
20
Added:
["dune" "subst"] {dev}
21
Added:
[
22
Added:
"dune"
23
Added:
"build"
24
Added:
"-p"
25
Added:
name
26
Added:
"-j"
27
Added:
jobs
28
Added:
"@install"
29
Added:
"@runtest" {with-test}
30
Added:
"@doc" {with-doc}
31
Added:
]
32
Added:
]
test/dune
@@ -0,0 +1,3 @@
1
Added:
(test
2
Added:
(name test_main)
3
Added:
(libraries ocaml-org alcotest))
test/fixtures/.gitkeep
test/fixtures/full.org
@@ -0,0 +1,110 @@
1
Added:
#+TITLE: Integration Test Document
2
Added:
#+AUTHOR: Test Author
3
Added:
#+TODO: TODO NEXT WAITING | DONE CANCELLED
4
Added:
5
Added:
This is the preamble paragraph with *bold*, /italic/, and ~code~.
6
Added:
7
Added:
See https://orgmode.org for more information.
8
Added:
9
Added:
* TODO [#A] First Heading :project:important:
10
Added:
SCHEDULED: <2024-06-15 Sat>
11
Added:
:PROPERTIES:
12
Added:
:CUSTOM_ID: first-heading
13
Added:
:EFFORT: 2h
14
Added:
:END:
15
Added:
16
Added:
A paragraph with [[https://example.com][a link]] and =verbatim text=.
17
Added:
18
Added:
** DONE Sub-heading
19
Added:
CLOSED: [2024-06-10 Mon 14:30]
20
Added:
21
Added:
Another paragraph with +strikethrough+ and _underline_.
22
Added:
23
Added:
** NEXT Another sub-heading :review:
24
Added:
25
Added:
*** Deep heading
26
Added:
27
Added:
Content in a deeply nested heading.
28
Added:
29
Added:
* Heading without TODO
30
Added:
31
Added:
** Child heading
32
Added:
33
Added:
Paragraph text.
34
Added:
35
Added:
* Lists and Blocks
36
Added:
37
Added:
** Unordered list
38
Added:
39
Added:
- First item
40
Added:
- Second item with *bold*
41
Added:
- Nested item
42
Added:
- Another nested item
43
Added:
- Third item
44
Added:
45
Added:
** Ordered list
46
Added:
47
Added:
1. First
48
Added:
2. Second
49
Added:
3. Third
50
Added:
51
Added:
** Descriptive list
52
Added:
53
Added:
- Term one :: Description of term one
54
Added:
- Term two :: Description of term two
55
Added:
56
Added:
** Source block
57
Added:
58
Added:
#+begin_src ocaml
59
Added:
let greeting = "Hello, Org!"
60
Added:
let () = print_endline greeting
61
Added:
#+end_src
62
Added:
63
Added:
** Quote block
64
Added:
65
Added:
#+begin_quote
66
Added:
This is a quoted paragraph.
67
Added:
It spans multiple lines.
68
Added:
#+end_quote
69
Added:
70
Added:
** Example block
71
Added:
72
Added:
#+begin_example
73
Added:
This is example text.
74
Added:
Preserved verbatim.
75
Added:
#+end_example
76
Added:
77
Added:
* Tables
78
Added:
79
Added:
| Name | Age | City |
80
Added:
|-------+-----+----------|
81
Added:
| Alice | 30 | New York |
82
Added:
| Bob | 25 | London |
83
Added:
84
Added:
* Miscellaneous
85
Added:
86
Added:
A fixed-width section:
87
Added:
88
Added:
: This is fixed width
89
Added:
: Another fixed line
90
Added:
91
Added:
A comment:
92
Added:
93
Added:
# This is a comment
94
Added:
# Another comment line
95
Added:
96
Added:
-----
97
Added:
98
Added:
Text after horizontal rule.
99
Added:
100
Added:
:NOTES:
101
Added:
This is content inside a drawer.
102
Added:
:END:
103
Added:
104
Added:
* Timestamps
105
Added:
106
Added:
An active timestamp: <2024-01-15 Mon 10:00>.
107
Added:
108
Added:
An inactive timestamp: [2024-03-20 Wed].
109
Added:
110
Added:
A range: <2024-01-15 Mon>--<2024-01-20 Sat>.
test/test_main.ml
@@ -0,0 +1,663 @@
1
Added:
let test_version () =
2
Added:
Alcotest.(check string) "version" "0.1.0" Ocaml_org.Org.version
3
Added:
4
Added:
(* Prescan tests *)
5
Added:
6
Added:
let test_prescan_default () =
7
Added:
let config = Ocaml_org.Prescan.scan "" in
8
Added:
let kws = Ocaml_org.Config.all_todo_keywords config in
9
Added:
Alcotest.(check (list string)) "default keywords" [ "TODO"; "DONE" ] kws
10
Added:
11
Added:
let test_prescan_custom_todo () =
12
Added:
let input = "#+TODO: NEXT WAITING | DONE CANCELLED\n" in
13
Added:
let config = Ocaml_org.Prescan.scan input in
14
Added:
let kws = Ocaml_org.Config.all_todo_keywords config in
15
Added:
Alcotest.(check (list string)) "custom keywords"
16
Added:
[ "NEXT"; "WAITING"; "DONE"; "CANCELLED" ] kws
17
Added:
18
Added:
let test_prescan_multiple_sequences () =
19
Added:
let input =
20
Added:
"#+TODO: TODO | DONE\n\
21
Added:
#+TODO: OPEN | CLOSED\n"
22
Added:
in
23
Added:
let config = Ocaml_org.Prescan.scan input in
24
Added:
let kws = Ocaml_org.Config.all_todo_keywords config in
25
Added:
Alcotest.(check (list string)) "multiple sequences"
26
Added:
[ "TODO"; "DONE"; "OPEN"; "CLOSED" ] kws
27
Added:
28
Added:
let test_prescan_seq_todo () =
29
Added:
let input = "#+SEQ_TODO: NEXT ACTIVE | DONE\n" in
30
Added:
let config = Ocaml_org.Prescan.scan input in
31
Added:
Alcotest.(check bool) "NEXT is todo" true
32
Added:
(Ocaml_org.Config.is_todo_keyword config "NEXT");
33
Added:
Alcotest.(check bool) "DONE is todo" true
34
Added:
(Ocaml_org.Config.is_todo_keyword config "DONE");
35
Added:
Alcotest.(check bool) "UNKNOWN is not todo" false
36
Added:
(Ocaml_org.Config.is_todo_keyword config "UNKNOWN")
37
Added:
38
Added:
let test_prescan_case_insensitive_key () =
39
Added:
let input = "#+todo: BUG FIX | RESOLVED\n" in
40
Added:
let config = Ocaml_org.Prescan.scan input in
41
Added:
let kws = Ocaml_org.Config.all_todo_keywords config in
42
Added:
Alcotest.(check (list string)) "case insensitive key"
43
Added:
[ "BUG"; "FIX"; "RESOLVED" ] kws
44
Added:
45
Added:
let test_prescan_no_bar () =
46
Added:
let input = "#+TODO: TODO DOING DONE\n" in
47
Added:
let config = Ocaml_org.Prescan.scan input in
48
Added:
let seqs = config.todo_sequences in
49
Added:
let seq = List.hd seqs in
50
Added:
Alcotest.(check (list string)) "all active" [ "TODO"; "DOING"; "DONE" ]
51
Added:
seq.active;
52
Added:
Alcotest.(check (list string)) "no done" [] seq.done_
53
Added:
54
Added:
(* Lexer tests *)
55
Added:
module L = Ocaml_org.Lexer
56
Added:
57
Added:
let config = Ocaml_org.Config.default
58
Added:
59
Added:
let lex input =
60
Added:
L.tokenize ~config input |> List.map fst
61
Added:
62
Added:
let tok_to_string = function
63
Added:
| L.Blank -> "Blank"
64
Added:
| L.Heading (n, s) -> Printf.sprintf "Heading(%d, %S)" n s
65
Added:
| L.Keyword (k, v) -> Printf.sprintf "Keyword(%S, %S)" k v
66
Added:
| L.Affiliated_keyword (n, _, v) -> Printf.sprintf "Affiliated(%S, %S)" n v
67
Added:
| L.Begin_block (n, p) -> Printf.sprintf "Begin_block(%S, %s)" n (match p with Some s -> Printf.sprintf "%S" s | None -> "None")
68
Added:
| L.End_block n -> Printf.sprintf "End_block(%S)" n
69
Added:
| L.Drawer_begin n -> Printf.sprintf "Drawer_begin(%S)" n
70
Added:
| L.Drawer_end -> "Drawer_end"
71
Added:
| L.Property (n, v) -> Printf.sprintf "Property(%S, %s)" n (match v with Some s -> Printf.sprintf "%S" s | None -> "None")
72
Added:
| L.Planning _ -> "Planning"
73
Added:
| L.List_item d -> Printf.sprintf "List_item(indent=%d, bullet=%S)" d.lid_indent d.lid_bullet
74
Added:
| L.Table_row _ -> "Table_row"
75
Added:
| L.Fixed_width s -> Printf.sprintf "Fixed_width(%S)" s
76
Added:
| L.Comment_line s -> Printf.sprintf "Comment_line(%S)" s
77
Added:
| L.Horizontal_rule -> "Horizontal_rule"
78
Added:
| L.Text_line s -> Printf.sprintf "Text_line(%S)" s
79
Added:
| L.Eof -> "Eof"
80
Added:
81
Added:
let check_tok msg expected actual =
82
Added:
Alcotest.(check string) msg expected (tok_to_string actual)
83
Added:
84
Added:
let test_lex_blank () =
85
Added:
let toks = lex "" in
86
Added:
check_tok "empty is blank+eof" "Blank" (List.nth toks 0);
87
Added:
check_tok "eof" "Eof" (List.nth toks 1)
88
Added:
89
Added:
let test_lex_heading () =
90
Added:
let toks = lex "* Hello world" in
91
Added:
check_tok "heading" "Heading(1, \"Hello world\")" (List.nth toks 0)
92
Added:
93
Added:
let test_lex_heading_level () =
94
Added:
let toks = lex "*** Deep heading" in
95
Added:
check_tok "heading level 3" "Heading(3, \"Deep heading\")" (List.nth toks 0)
96
Added:
97
Added:
let test_lex_keyword () =
98
Added:
let toks = lex "#+TITLE: My Document" in
99
Added:
check_tok "keyword" "Keyword(\"TITLE\", \"My Document\")" (List.nth toks 0)
100
Added:
101
Added:
let test_lex_affiliated () =
102
Added:
let toks = lex "#+NAME: my-table" in
103
Added:
check_tok "affiliated" "Affiliated(\"NAME\", \"my-table\")" (List.nth toks 0)
104
Added:
105
Added:
let test_lex_begin_block () =
106
Added:
let toks = lex "#+begin_src ocaml" in
107
Added:
check_tok "begin src" "Begin_block(\"src\", \"ocaml\")" (List.nth toks 0)
108
Added:
109
Added:
let test_lex_end_block () =
110
Added:
let toks = lex "#+end_src" in
111
Added:
check_tok "end src" "End_block(\"src\")" (List.nth toks 0)
112
Added:
113
Added:
let test_lex_drawer () =
114
Added:
let toks = lex ":PROPERTIES:" in
115
Added:
check_tok "drawer begin" "Drawer_begin(\"PROPERTIES\")" (List.nth toks 0)
116
Added:
117
Added:
let test_lex_drawer_end () =
118
Added:
let toks = lex ":END:" in
119
Added:
check_tok "drawer end" "Drawer_end" (List.nth toks 0)
120
Added:
121
Added:
let test_lex_list_unordered () =
122
Added:
let toks = lex "- item one" in
123
Added:
check_tok "unordered list" "List_item(indent=0, bullet=\"- \")" (List.nth toks 0)
124
Added:
125
Added:
let test_lex_list_ordered () =
126
Added:
let toks = lex "1. first item" in
127
Added:
check_tok "ordered list" "List_item(indent=0, bullet=\"1. \")" (List.nth toks 0)
128
Added:
129
Added:
let test_lex_list_indented () =
130
Added:
let toks = lex " - nested" in
131
Added:
check_tok "indented list" "List_item(indent=2, bullet=\"- \")" (List.nth toks 0)
132
Added:
133
Added:
let test_lex_table () =
134
Added:
let toks = lex "| a | b | c |" in
135
Added:
check_tok "table row" "Table_row" (List.nth toks 0)
136
Added:
137
Added:
let test_lex_comment () =
138
Added:
let toks = lex "# a comment" in
139
Added:
check_tok "comment" "Comment_line(\"a comment\")" (List.nth toks 0)
140
Added:
141
Added:
let test_lex_fixed_width () =
142
Added:
let toks = lex ": fixed text" in
143
Added:
check_tok "fixed width" "Fixed_width(\"fixed text\")" (List.nth toks 0)
144
Added:
145
Added:
let test_lex_hrule () =
146
Added:
let toks = lex "-----" in
147
Added:
check_tok "horizontal rule" "Horizontal_rule" (List.nth toks 0)
148
Added:
149
Added:
let test_lex_text () =
150
Added:
let toks = lex "Just some text" in
151
Added:
check_tok "text line" "Text_line(\"Just some text\")" (List.nth toks 0)
152
Added:
153
Added:
let test_lex_planning () =
154
Added:
let toks = lex "DEADLINE: <2024-01-15 Mon>" in
155
Added:
check_tok "planning" "Planning" (List.nth toks 0)
156
Added:
157
Added:
let test_lex_property () =
158
Added:
let toks = lex " :CUSTOM_ID: my-id" in
159
Added:
check_tok "property" "Property(\"CUSTOM_ID\", \"my-id\")" (List.nth toks 0)
160
Added:
161
Added:
(* Parser tests *)
162
Added:
module P = Ocaml_org.Parse_bridge
163
Added:
module R = Ocaml_org.Raw_ast
164
Added:
module A = Ocaml_org.Ast
165
Added:
166
Added:
let parse input = P.parse ~config input
167
Added:
let parse_inline input = P.parse_inline input
168
Added:
169
Added:
let test_parse_empty () =
170
Added:
let doc = parse "" in
171
Added:
Alcotest.(check int) "no headings" 0 (List.length doc.R.rd_headings)
172
Added:
173
Added:
let test_parse_single_heading () =
174
Added:
let doc = parse "* Hello" in
175
Added:
Alcotest.(check int) "one heading" 1 (List.length doc.R.rd_headings);
176
Added:
let h = List.hd doc.R.rd_headings in
177
Added:
Alcotest.(check int) "level 1" 1 h.R.rh_level;
178
Added:
Alcotest.(check string) "title" "Hello" h.R.rh_raw_title
179
Added:
180
Added:
let test_parse_heading_with_body () =
181
Added:
let input = "* Heading\nSome text\nMore text" in
182
Added:
let doc = parse input in
183
Added:
Alcotest.(check int) "one heading" 1 (List.length doc.R.rd_headings);
184
Added:
let h = List.hd doc.R.rd_headings in
185
Added:
let has_paragraph = List.exists (function R.Raw_paragraph ls -> List.length ls > 0 | _ -> false) h.R.rh_body in
186
Added:
Alcotest.(check bool) "has paragraph body" true has_paragraph
187
Added:
188
Added:
let test_parse_preamble () =
189
Added:
let input = "Some preamble text\n\n* Heading" in
190
Added:
let doc = parse input in
191
Added:
let non_blank = List.filter (function R.Raw_paragraph [] -> false | _ -> true) doc.R.rd_preamble in
192
Added:
Alcotest.(check bool) "has preamble" true (List.length non_blank > 0);
193
Added:
Alcotest.(check int) "one heading" 1 (List.length doc.R.rd_headings)
194
Added:
195
Added:
let test_parse_keyword () =
196
Added:
let input = "#+TITLE: My Doc\n* Heading" in
197
Added:
let doc = parse input in
198
Added:
let has_kw = List.exists (function R.Raw_keyword ("TITLE", _) -> true | _ -> false) doc.R.rd_preamble in
199
Added:
Alcotest.(check bool) "has title keyword" true has_kw
200
Added:
201
Added:
let test_parse_block () =
202
Added:
let input = "#+begin_src ocaml\nlet x = 42\n#+end_src" in
203
Added:
let doc = parse input in
204
Added:
let has_block = List.exists (function R.Raw_block _ -> true | _ -> false) doc.R.rd_preamble in
205
Added:
Alcotest.(check bool) "has block" true has_block
206
Added:
207
Added:
let test_parse_list () =
208
Added:
let input = "- item one\n- item two" in
209
Added:
let doc = parse input in
210
Added:
let has_list = List.exists (function R.Raw_list_items _ -> true | _ -> false) doc.R.rd_preamble in
211
Added:
Alcotest.(check bool) "has list" true has_list
212
Added:
213
Added:
(* Inline parser tests *)
214
Added:
let test_inline_plain () =
215
Added:
let result = parse_inline "hello world" in
216
Added:
match result with
217
Added:
| [A.Plain s] -> Alcotest.(check string) "plain" "hello world" s
218
Added:
| _ -> Alcotest.fail "expected single Plain"
219
Added:
220
Added:
let test_inline_bold () =
221
Added:
let result = parse_inline "*bold*" in
222
Added:
match result with
223
Added:
| [A.Bold [A.Plain s]] -> Alcotest.(check string) "bold content" "bold" s
224
Added:
| _ -> Alcotest.fail "expected Bold"
225
Added:
226
Added:
let test_inline_italic () =
227
Added:
let result = parse_inline "/italic/" in
228
Added:
match result with
229
Added:
| [A.Italic [A.Plain s]] -> Alcotest.(check string) "italic content" "italic" s
230
Added:
| _ -> Alcotest.fail "expected Italic"
231
Added:
232
Added:
let test_inline_code () =
233
Added:
let result = parse_inline "~code~" in
234
Added:
match result with
235
Added:
| [A.Code s] -> Alcotest.(check string) "code content" "code" s
236
Added:
| _ -> Alcotest.fail "expected Code"
237
Added:
238
Added:
let test_inline_verbatim () =
239
Added:
let result = parse_inline "=verb=" in
240
Added:
match result with
241
Added:
| [A.Verbatim s] -> Alcotest.(check string) "verbatim content" "verb" s
242
Added:
| _ -> Alcotest.fail "expected Verbatim"
243
Added:
244
Added:
let test_inline_link () =
245
Added:
let result = parse_inline "[[https://org.org][Org]]" in
246
Added:
match result with
247
Added:
| [A.Link lnk] ->
248
Added:
(match lnk.target with
249
Added:
| A.Url u -> Alcotest.(check string) "url" "https://org.org" u
250
Added:
| _ -> Alcotest.fail "expected Url target");
251
Added:
(match lnk.description with
252
Added:
| Some [A.Plain d] -> Alcotest.(check string) "desc" "Org" d
253
Added:
| _ -> Alcotest.fail "expected description")
254
Added:
| _ -> Alcotest.fail "expected Link"
255
Added:
256
Added:
let test_inline_link_no_desc () =
257
Added:
let result = parse_inline "[[file:readme.org]]" in
258
Added:
match result with
259
Added:
| [A.Link lnk] ->
260
Added:
(match lnk.target with
261
Added:
| A.File f -> Alcotest.(check string) "file" "readme.org" f
262
Added:
| _ -> Alcotest.fail "expected File target");
263
Added:
Alcotest.(check bool) "no description" true (lnk.description = None)
264
Added:
| _ -> Alcotest.fail "expected Link"
265
Added:
266
Added:
let test_inline_timestamp () =
267
Added:
let result = parse_inline "<2024-01-15 Mon>" in
268
Added:
match result with
269
Added:
| [A.Timestamp (A.Active (d, _))] ->
270
Added:
Alcotest.(check int) "year" 2024 d.year;
271
Added:
Alcotest.(check int) "month" 1 d.month;
272
Added:
Alcotest.(check int) "day" 15 d.day
273
Added:
| _ -> Alcotest.fail "expected active timestamp"
274
Added:
275
Added:
let test_inline_plain_link () =
276
Added:
let result = parse_inline "see https://example.com for info" in
277
Added:
let has_link = List.exists (function A.Link _ -> true | _ -> false) result in
278
Added:
Alcotest.(check bool) "has plain link" true has_link
279
Added:
280
Added:
let test_inline_mixed () =
281
Added:
let result = parse_inline "Hello *bold* and ~code~" in
282
Added:
let has_bold = List.exists (function A.Bold _ -> true | _ -> false) result in
283
Added:
let has_code = List.exists (function A.Code _ -> true | _ -> false) result in
284
Added:
Alcotest.(check bool) "has bold" true has_bold;
285
Added:
Alcotest.(check bool) "has code" true has_code
286
Added:
287
Added:
(* ================================================================== *)
288
Added:
(* Integration tests *)
289
Added:
(* ================================================================== *)
290
Added:
291
Added:
let full_fixture = {|#+TITLE: Integration Test Document
292
Added:
#+AUTHOR: Test Author
293
Added:
#+TODO: TODO NEXT WAITING | DONE CANCELLED
294
Added:
295
Added:
This is the preamble paragraph with *bold*, /italic/, and ~code~.
296
Added:
297
Added:
See https://orgmode.org for more information.
298
Added:
299
Added:
* TODO [#A] First Heading :project:important:
300
Added:
SCHEDULED: <2024-06-15 Sat>
301
Added:
:PROPERTIES:
302
Added:
:CUSTOM_ID: first-heading
303
Added:
:EFFORT: 2h
304
Added:
:END:
305
Added:
306
Added:
A paragraph with [[https://example.com][a link]] and =verbatim text=.
307
Added:
308
Added:
** DONE Sub-heading
309
Added:
CLOSED: [2024-06-10 Mon 14:30]
310
Added:
311
Added:
Another paragraph with +strikethrough+ and _underline_.
312
Added:
313
Added:
** NEXT Another sub-heading :review:
314
Added:
315
Added:
*** Deep heading
316
Added:
317
Added:
Content in a deeply nested heading.
318
Added:
319
Added:
* Heading without TODO
320
Added:
321
Added:
** Child heading
322
Added:
323
Added:
Paragraph text.
324
Added:
325
Added:
* Lists and Blocks
326
Added:
327
Added:
** Unordered list
328
Added:
329
Added:
- First item
330
Added:
- Second item with *bold*
331
Added:
- Nested item
332
Added:
- Another nested item
333
Added:
- Third item
334
Added:
335
Added:
** Ordered list
336
Added:
337
Added:
1. First
338
Added:
2. Second
339
Added:
3. Third
340
Added:
341
Added:
** Descriptive list
342
Added:
343
Added:
- Term one :: Description of term one
344
Added:
- Term two :: Description of term two
345
Added:
346
Added:
** Source block
347
Added:
348
Added:
#+begin_src ocaml
349
Added:
let greeting = "Hello, Org!"
350
Added:
let () = print_endline greeting
351
Added:
#+end_src
352
Added:
353
Added:
** Quote block
354
Added:
355
Added:
#+begin_quote
356
Added:
This is a quoted paragraph.
357
Added:
It spans multiple lines.
358
Added:
#+end_quote
359
Added:
360
Added:
** Example block
361
Added:
362
Added:
#+begin_example
363
Added:
This is example text.
364
Added:
Preserved verbatim.
365
Added:
#+end_example
366
Added:
367
Added:
* Tables
368
Added:
369
Added:
| Name | Age | City |
370
Added:
|-------+-----+----------|
371
Added:
| Alice | 30 | New York |
372
Added:
| Bob | 25 | London |
373
Added:
374
Added:
* Miscellaneous
375
Added:
376
Added:
A fixed-width section:
377
Added:
378
Added:
: This is fixed width
379
Added:
: Another fixed line
380
Added:
381
Added:
A comment:
382
Added:
383
Added:
# This is a comment
384
Added:
# Another comment line
385
Added:
386
Added:
-----
387
Added:
388
Added:
Text after horizontal rule.
389
Added:
390
Added:
:NOTES:
391
Added:
This is content inside a drawer.
392
Added:
:END:
393
Added:
394
Added:
* Timestamps
395
Added:
396
Added:
An active timestamp: <2024-01-15 Mon 10:00>.
397
Added:
398
Added:
An inactive timestamp: [2024-03-20 Wed].
399
Added:
400
Added:
A range: <2024-01-15 Mon>--<2024-01-20 Sat>.
401
Added:
|}
402
Added:
403
Added:
let full_doc = Ocaml_org.Org.parse full_fixture
404
Added:
405
Added:
let test_integration_structure () =
406
Added:
(* Directives *)
407
Added:
let dirs = full_doc.A.directives in
408
Added:
Alcotest.(check bool) "has directives" true (List.length dirs >= 2);
409
Added:
let title_dir = List.find_opt (fun d -> d.A.dir_key = "TITLE") dirs in
410
Added:
Alcotest.(check bool) "has TITLE" true (Option.is_some title_dir);
411
Added:
Alcotest.(check string) "TITLE value" "Integration Test Document"
412
Added:
(Option.get title_dir).A.dir_value;
413
Added:
let author_dir = List.find_opt (fun d -> d.A.dir_key = "AUTHOR") dirs in
414
Added:
Alcotest.(check bool) "has AUTHOR" true (Option.is_some author_dir);
415
Added:
Alcotest.(check string) "AUTHOR value" "Test Author"
416
Added:
(Option.get author_dir).A.dir_value;
417
Added:
(* Preamble *)
418
Added:
Alcotest.(check bool) "has preamble" true
419
Added:
(List.length full_doc.A.preamble > 0);
420
Added:
(* Top-level headings *)
421
Added:
Alcotest.(check int) "6 top-level headings" 6
422
Added:
(List.length full_doc.A.headings)
423
Added:
424
Added:
let test_integration_headings () =
425
Added:
let h1 = List.nth full_doc.A.headings 0 in
426
Added:
(* First heading: TODO, priority, tags *)
427
Added:
Alcotest.(check (option string)) "h1 todo" (Some "TODO") h1.A.todo;
428
Added:
Alcotest.(check (option char)) "h1 priority" (Some 'A') h1.A.priority;
429
Added:
Alcotest.(check (list string)) "h1 tags" ["project"; "important"] h1.A.tags;
430
Added:
Alcotest.(check int) "h1 level" 1 h1.A.level;
431
Added:
(* Planning *)
432
Added:
Alcotest.(check bool) "h1 has planning" true (Option.is_some h1.A.planning);
433
Added:
let planning = Option.get h1.A.planning in
434
Added:
Alcotest.(check bool) "h1 has scheduled" true
435
Added:
(Option.is_some planning.A.scheduled);
436
Added:
(* Properties *)
437
Added:
Alcotest.(check bool) "h1 has properties" true
438
Added:
(List.length h1.A.properties >= 2);
439
Added:
let custom_id = List.find_opt
440
Added:
(fun p -> p.A.prop_name = "CUSTOM_ID") h1.A.properties in
441
Added:
Alcotest.(check bool) "has CUSTOM_ID" true (Option.is_some custom_id);
442
Added:
Alcotest.(check (option string)) "CUSTOM_ID value" (Some "first-heading")
443
Added:
(Option.get custom_id).A.prop_value;
444
Added:
let effort = List.find_opt
445
Added:
(fun p -> p.A.prop_name = "EFFORT") h1.A.properties in
446
Added:
Alcotest.(check bool) "has EFFORT" true (Option.is_some effort);
447
Added:
Alcotest.(check (option string)) "EFFORT value" (Some "2h")
448
Added:
(Option.get effort).A.prop_value;
449
Added:
(* Children of first heading *)
450
Added:
Alcotest.(check int) "h1 has 2 children" 2 (List.length h1.A.children);
451
Added:
let child1 = List.nth h1.A.children 0 in
452
Added:
Alcotest.(check (option string)) "child1 todo" (Some "DONE") child1.A.todo;
453
Added:
(* DONE sub-heading has CLOSED planning *)
454
Added:
Alcotest.(check bool) "child1 has planning" true
455
Added:
(Option.is_some child1.A.planning);
456
Added:
let child1_planning = Option.get child1.A.planning in
457
Added:
Alcotest.(check bool) "child1 has closed" true
458
Added:
(Option.is_some child1_planning.A.closed);
459
Added:
let child2 = List.nth h1.A.children 1 in
460
Added:
Alcotest.(check (option string)) "child2 todo" (Some "NEXT") child2.A.todo;
461
Added:
Alcotest.(check (list string)) "child2 tags" ["review"] child2.A.tags;
462
Added:
(* Deep heading is a child of child2 *)
463
Added:
Alcotest.(check int) "child2 has 1 child" 1 (List.length child2.A.children);
464
Added:
let deep = List.nth child2.A.children 0 in
465
Added:
Alcotest.(check int) "deep level" 3 deep.A.level;
466
Added:
(* Heading without TODO *)
467
Added:
let h2 = List.nth full_doc.A.headings 1 in
468
Added:
Alcotest.(check (option string)) "h2 no todo" None h2.A.todo;
469
Added:
Alcotest.(check int) "h2 has 1 child" 1 (List.length h2.A.children)
470
Added:
471
Added:
let test_integration_elements () =
472
Added:
(* Lists and Blocks heading is at index 2 *)
473
Added:
let h3 = List.nth full_doc.A.headings 2 in
474
Added:
(* h3 children: Unordered list, Ordered list, Descriptive list,
475
Added:
Source block, Quote block, Example block *)
476
Added:
Alcotest.(check bool) "Lists and Blocks has children" true
477
Added:
(List.length h3.A.children >= 6);
478
Added:
(* Unordered list *)
479
Added:
let ul_heading = List.nth h3.A.children 0 in
480
Added:
let ul_elems = ul_heading.A.heading_contents in
481
Added:
let has_unordered = List.exists (function
482
Added:
| A.Plain_list (A.Unordered, items) -> List.length items >= 3
483
Added:
| _ -> false) ul_elems in
484
Added:
Alcotest.(check bool) "has unordered list" true has_unordered;
485
Added:
(* Ordered list *)
486
Added:
let ol_heading = List.nth h3.A.children 1 in
487
Added:
let ol_elems = ol_heading.A.heading_contents in
488
Added:
let has_ordered = List.exists (function
489
Added:
| A.Plain_list (A.Ordered, items) -> List.length items >= 3
490
Added:
| _ -> false) ol_elems in
491
Added:
Alcotest.(check bool) "has ordered list" true has_ordered;
492
Added:
(* Descriptive list *)
493
Added:
let dl_heading = List.nth h3.A.children 2 in
494
Added:
let dl_elems = dl_heading.A.heading_contents in
495
Added:
let has_descriptive = List.exists (function
496
Added:
| A.Plain_list (A.Descriptive, items) -> List.length items >= 2
497
Added:
| _ -> false) dl_elems in
498
Added:
Alcotest.(check bool) "has descriptive list" true has_descriptive;
499
Added:
(* Source block *)
500
Added:
let src_heading = List.nth h3.A.children 3 in
501
Added:
let src_elems = src_heading.A.heading_contents in
502
Added:
let has_src = List.exists (function
503
Added:
| A.Block (A.Src_block sb) ->
504
Added:
sb.A.src_language = Some "ocaml" &&
505
Added:
String.length sb.A.src_value > 0
506
Added:
| _ -> false) src_elems in
507
Added:
Alcotest.(check bool) "has src block with ocaml" true has_src;
508
Added:
(* Quote block *)
509
Added:
let qt_heading = List.nth h3.A.children 4 in
510
Added:
let qt_elems = qt_heading.A.heading_contents in
511
Added:
let has_quote = List.exists (function
512
Added:
| A.Block (A.Quote_block _) -> true
513
Added:
| _ -> false) qt_elems in
514
Added:
Alcotest.(check bool) "has quote block" true has_quote;
515
Added:
(* Example block *)
516
Added:
let ex_heading = List.nth h3.A.children 5 in
517
Added:
let ex_elems = ex_heading.A.heading_contents in
518
Added:
let has_example = List.exists (function
519
Added:
| A.Block (A.Example_block _) -> true
520
Added:
| _ -> false) ex_elems in
521
Added:
Alcotest.(check bool) "has example block" true has_example;
522
Added:
(* Tables heading is at index 3 *)
523
Added:
let h4 = List.nth full_doc.A.headings 3 in
524
Added:
let table_elems = h4.A.heading_contents in
525
Added:
let has_table = List.exists (function
526
Added:
| A.Table t ->
527
Added:
let has_standard = List.exists (function
528
Added:
| A.Table_row_standard _ -> true | _ -> false) t.A.rows in
529
Added:
let has_rule = List.exists (function
530
Added:
| A.Table_row_rule -> true | _ -> false) t.A.rows in
531
Added:
has_standard && has_rule
532
Added:
| _ -> false) table_elems in
533
Added:
Alcotest.(check bool) "has table with rows and rules" true has_table;
534
Added:
(* Miscellaneous heading is at index 4 *)
535
Added:
let h5 = List.nth full_doc.A.headings 4 in
536
Added:
let misc_elems = h5.A.heading_contents in
537
Added:
let has_fixed_width = List.exists (function
538
Added:
| A.Fixed_width lines -> List.length lines >= 2
539
Added:
| _ -> false) misc_elems in
540
Added:
Alcotest.(check bool) "has fixed-width" true has_fixed_width;
541
Added:
let has_comment = List.exists (function
542
Added:
| A.Comment lines -> List.length lines >= 2
543
Added:
| _ -> false) misc_elems in
544
Added:
Alcotest.(check bool) "has comment" true has_comment;
545
Added:
let has_hrule = List.exists (function
546
Added:
| A.Horizontal_rule -> true
547
Added:
| _ -> false) misc_elems in
548
Added:
Alcotest.(check bool) "has horizontal rule" true has_hrule;
549
Added:
let has_drawer = List.exists (function
550
Added:
| A.Drawer ("NOTES", _) -> true
551
Added:
| _ -> false) misc_elems in
552
Added:
Alcotest.(check bool) "has drawer" true has_drawer
553
Added:
554
Added:
let test_integration_inline () =
555
Added:
(* Preamble paragraph should have inline markup *)
556
Added:
let preamble_para = List.find_opt (function
557
Added:
| A.Paragraph _ -> true | _ -> false) full_doc.A.preamble in
558
Added:
Alcotest.(check bool) "preamble has paragraph" true
559
Added:
(Option.is_some preamble_para);
560
Added:
let inlines = match preamble_para with
561
Added:
| Some (A.Paragraph (il, _)) -> il
562
Added:
| _ -> [] in
563
Added:
let has_bold = List.exists (function A.Bold _ -> true | _ -> false) inlines in
564
Added:
let has_italic = List.exists (function A.Italic _ -> true | _ -> false) inlines in
565
Added:
let has_code = List.exists (function A.Code _ -> true | _ -> false) inlines in
566
Added:
Alcotest.(check bool) "preamble has bold" true has_bold;
567
Added:
Alcotest.(check bool) "preamble has italic" true has_italic;
568
Added:
Alcotest.(check bool) "preamble has code" true has_code;
569
Added:
(* Second preamble paragraph should have a plain link *)
570
Added:
let preamble_paras = List.filter (function
571
Added:
| A.Paragraph _ -> true | _ -> false) full_doc.A.preamble in
572
Added:
Alcotest.(check bool) "preamble has 2+ paragraphs" true
573
Added:
(List.length preamble_paras >= 2);
574
Added:
let para2_inlines = match List.nth preamble_paras 1 with
575
Added:
| A.Paragraph (il, _) -> il
576
Added:
| _ -> [] in
577
Added:
let has_link = List.exists (function A.Link _ -> true | _ -> false)
578
Added:
para2_inlines in
579
Added:
Alcotest.(check bool) "preamble para2 has link" true has_link;
580
Added:
(* Timestamps heading (index 5) *)
581
Added:
let h6 = List.nth full_doc.A.headings 5 in
582
Added:
let ts_elems = h6.A.heading_contents in
583
Added:
let all_inlines = List.concat_map (function
584
Added:
| A.Paragraph (il, _) -> il
585
Added:
| _ -> []) ts_elems in
586
Added:
let has_active_ts = List.exists (function
587
Added:
| A.Timestamp (A.Active _) -> true | _ -> false) all_inlines in
588
Added:
let has_inactive_ts = List.exists (function
589
Added:
| A.Timestamp (A.Inactive _) -> true | _ -> false) all_inlines in
590
Added:
let has_range = List.exists (function
591
Added:
| A.Timestamp (A.Active_range _) -> true | _ -> false) all_inlines in
592
Added:
Alcotest.(check bool) "has active timestamp" true has_active_ts;
593
Added:
Alcotest.(check bool) "has inactive timestamp" true has_inactive_ts;
594
Added:
Alcotest.(check bool) "has timestamp range" true has_range
595
Added:
596
Added:
let () =
597
Added:
Alcotest.run "ocaml-org"
598
Added:
[
599
Added:
("basic", [ Alcotest.test_case "version" `Quick test_version ]);
600
Added:
( "prescan",
601
Added:
[
602
Added:
Alcotest.test_case "default config" `Quick test_prescan_default;
603
Added:
Alcotest.test_case "custom TODO" `Quick test_prescan_custom_todo;
604
Added:
Alcotest.test_case "multiple sequences" `Quick
605
Added:
test_prescan_multiple_sequences;
606
Added:
Alcotest.test_case "SEQ_TODO" `Quick test_prescan_seq_todo;
607
Added:
Alcotest.test_case "case insensitive key" `Quick
608
Added:
test_prescan_case_insensitive_key;
609
Added:
Alcotest.test_case "no bar separator" `Quick test_prescan_no_bar;
610
Added:
] );
611
Added:
( "lexer",
612
Added:
[
613
Added:
Alcotest.test_case "blank" `Quick test_lex_blank;
614
Added:
Alcotest.test_case "heading" `Quick test_lex_heading;
615
Added:
Alcotest.test_case "heading level" `Quick test_lex_heading_level;
616
Added:
Alcotest.test_case "keyword" `Quick test_lex_keyword;
617
Added:
Alcotest.test_case "affiliated keyword" `Quick test_lex_affiliated;
618
Added:
Alcotest.test_case "begin block" `Quick test_lex_begin_block;
619
Added:
Alcotest.test_case "end block" `Quick test_lex_end_block;
620
Added:
Alcotest.test_case "drawer begin" `Quick test_lex_drawer;
621
Added:
Alcotest.test_case "drawer end" `Quick test_lex_drawer_end;
622
Added:
Alcotest.test_case "unordered list" `Quick test_lex_list_unordered;
623
Added:
Alcotest.test_case "ordered list" `Quick test_lex_list_ordered;
624
Added:
Alcotest.test_case "indented list" `Quick test_lex_list_indented;
625
Added:
Alcotest.test_case "table row" `Quick test_lex_table;
626
Added:
Alcotest.test_case "comment" `Quick test_lex_comment;
627
Added:
Alcotest.test_case "fixed width" `Quick test_lex_fixed_width;
628
Added:
Alcotest.test_case "horizontal rule" `Quick test_lex_hrule;
629
Added:
Alcotest.test_case "text line" `Quick test_lex_text;
630
Added:
Alcotest.test_case "planning" `Quick test_lex_planning;
631
Added:
Alcotest.test_case "property" `Quick test_lex_property;
632
Added:
] );
633
Added:
( "parser",
634
Added:
[
635
Added:
Alcotest.test_case "empty document" `Quick test_parse_empty;
636
Added:
Alcotest.test_case "single heading" `Quick test_parse_single_heading;
637
Added:
Alcotest.test_case "heading with body" `Quick test_parse_heading_with_body;
638
Added:
Alcotest.test_case "preamble" `Quick test_parse_preamble;
639
Added:
Alcotest.test_case "keyword" `Quick test_parse_keyword;
640
Added:
Alcotest.test_case "block" `Quick test_parse_block;
641
Added:
Alcotest.test_case "list" `Quick test_parse_list;
642
Added:
] );
643
Added:
( "inline",
644
Added:
[
645
Added:
Alcotest.test_case "plain text" `Quick test_inline_plain;
646
Added:
Alcotest.test_case "bold" `Quick test_inline_bold;
647
Added:
Alcotest.test_case "italic" `Quick test_inline_italic;
648
Added:
Alcotest.test_case "code" `Quick test_inline_code;
649
Added:
Alcotest.test_case "verbatim" `Quick test_inline_verbatim;
650
Added:
Alcotest.test_case "link with desc" `Quick test_inline_link;
651
Added:
Alcotest.test_case "link no desc" `Quick test_inline_link_no_desc;
652
Added:
Alcotest.test_case "timestamp" `Quick test_inline_timestamp;
653
Added:
Alcotest.test_case "plain link" `Quick test_inline_plain_link;
654
Added:
Alcotest.test_case "mixed inline" `Quick test_inline_mixed;
655
Added:
] );
656
Added:
( "integration",
657
Added:
[
658
Added:
Alcotest.test_case "structure" `Quick test_integration_structure;
659
Added:
Alcotest.test_case "headings" `Quick test_integration_headings;
660
Added:
Alcotest.test_case "elements" `Quick test_integration_elements;
661
Added:
Alcotest.test_case "inline" `Quick test_integration_inline;
662
Added:
] );
663
Added:
]