[OCaml] Mobile-friendly clone of cgit.
refactor split into qualified sub-libraries
Extract three sub-libraries with proper module namespacing: ogit.ui — Ui (generic HTML building blocks) ogit.highlight — Highlight.{Detect, Engine, Grammars} ogit.prose — Prose.{Render, Format, Markdown, Org, Mld, Plaintext} The views directory remains in the root ogit library (it depends on Resolvers and Routes types, creating a circular dep that prevents extraction). File renames: highlight.ml → highlight/engine.ml highlight_grammars.ml → highlight/grammars.ml syntax.ml → highlight/detect.ml prose.ml → prose/render.ml prose_format.ml → prose/format.ml prose_markdown.ml → prose/markdown.ml prose_org.ml → prose/org.ml prose_mld.ml → prose/mld.ml prose_plaintext.ml → prose/plaintext.ml views/ui.ml → ui/ui.ml External module paths: Highlight.Engine.highlight (was Highlight.highlight) Highlight.Detect.detect (was Syntax.detect) Highlight.Grammars (was Highlight_grammars) Prose.Render.render (was Prose.render) Prose.Format (was Prose_format) Prose.Markdown (was Prose_markdown) Ui (unchanged, wrapped false)
Changed files
- lib/dune
- lib/highlight/detect.ml
- lib/highlight/dune
- lib/highlight/engine.ml
- lib/highlight/grammars.ml
- lib/highlight/highlight.ml
- lib/highlight/highlight_grammars.ml
- lib/highlight/syntax.ml
- lib/prose/dune
- lib/prose/format.ml
- lib/prose/format.mli
- lib/prose/markdown.ml
- lib/prose/markdown.mli
- lib/prose/mld.ml
- lib/prose/mld.mli
- lib/prose/org.ml
- lib/prose/org.mli
- lib/prose/plaintext.ml
- lib/prose/prose.ml
- lib/prose/prose.mli
- lib/prose/prose_format.ml
- lib/prose/prose_format.mli
- lib/prose/prose_markdown.ml
- lib/prose/prose_markdown.mli
- lib/prose/prose_mld.ml
- lib/prose/prose_mld.mli
- lib/prose/prose_org.ml
- lib/prose/prose_org.mli
- lib/prose/prose_plaintext.ml
- lib/prose/render.ml
- lib/prose/render.mli
- lib/ui/dune
- lib/ui/ui.ml
- lib/ui/ui.mli
- lib/views/components.ml
- lib/views/repo.ml
- lib/views/ui.ml
- lib/views/ui.mli
- test/dune
- test/test_readme.ml
lib/dune
@@ -3,16 +3,9 @@
3
3
(library
4
4
(name ogit)
5
5
(public_name ogit)
6
Removed:
(libraries dream dream-html git-unix toml hilite textmate-language yojson)
6
Added:
(libraries dream dream-html git-unix toml ogit.ui ogit.highlight ogit.prose)
7
7
(preprocess
8
8
(pps dream-html.ppx)))
9
Removed:
10
Removed:
(rule
11
Removed:
(target grammar_data.ml)
12
Removed:
(deps
13
Removed:
(source_tree highlight/grammars))
14
Removed:
(action
15
Removed:
(run ocaml-crunch -m plain -s -o %{target} highlight/grammars)))
16
9
17
10
(rule
18
11
(target static_assets.ml)
lib/highlight/detect.ml
@@ -0,0 +1,275 @@
1
Added:
(** Guessing a file's language for syntax highlighting.
2
Added:
3
Added:
Detection is best-effort and purely advisory: the blob renders identically
4
Added:
whether or not a language is found, so a wrong guess degrades to plain text
5
Added:
rather than breaking the page.
6
Added:
7
Added:
Sources are tried in descending order of reliability: the filename
8
Added:
extension, then a shebang, then an Emacs file variable, then a Vim modeline.
9
Added:
*)
10
Added:
11
Added:
let of_filename name =
12
Added:
(* First check the bare filename for well-known extensionless files *)
13
Added:
let basename = Filename.basename name |> String.lowercase_ascii in
14
Added:
match basename with
15
Added:
| "makefile" | "gnumakefile" -> Some "makefile"
16
Added:
| "dockerfile" -> Some "dockerfile"
17
Added:
| "dune" | "dune-project" | "dune-workspace" -> Some "dune"
18
Added:
| "jenkinsfile" -> Some "groovy"
19
Added:
| _ -> (
20
Added:
match Filename.extension name |> String.lowercase_ascii with
21
Added:
| ".ml" | ".mli" -> Some "ocaml"
22
Added:
| ".mld" -> Some "ocamldoc"
23
Added:
| ".c" | ".h" -> Some "c"
24
Added:
| ".clj" | ".cljs" | ".cljc" | ".edn" -> Some "clojure"
25
Added:
| ".cpp" | ".cc" | ".cxx" | ".hpp" -> Some "cpp"
26
Added:
| ".cs" -> Some "csharp"
27
Added:
| ".css" -> Some "css"
28
Added:
| ".dart" -> Some "dart"
29
Added:
| ".diff" | ".patch" -> Some "diff"
30
Added:
| ".dune" -> Some "dune"
31
Added:
| ".el" | ".lisp" | ".cl" | ".scm" | ".ss" -> Some "lisp"
32
Added:
| ".erl" | ".hrl" -> Some "erlang"
33
Added:
| ".ex" | ".exs" -> Some "elixir"
34
Added:
| ".f90" | ".f95" | ".f03" | ".f08" | ".f" | ".for" -> Some "fortran"
35
Added:
| ".go" -> Some "go"
36
Added:
| ".gradle" | ".groovy" -> Some "groovy"
37
Added:
| ".hs" -> Some "haskell"
38
Added:
| ".html" | ".htm" -> Some "html"
39
Added:
| ".java" -> Some "java"
40
Added:
| ".jl" -> Some "julia"
41
Added:
| ".js" | ".mjs" | ".cjs" -> Some "javascript"
42
Added:
| ".json" -> Some "json"
43
Added:
| ".kt" | ".kts" -> Some "kotlin"
44
Added:
| ".lua" -> Some "lua"
45
Added:
| ".m" -> Some "objective-c"
46
Added:
| ".md" -> Some "markdown"
47
Added:
| ".nix" -> Some "nix"
48
Added:
| ".opam" -> Some "opam"
49
Added:
| ".org" -> Some "org"
50
Added:
| ".php" -> Some "php"
51
Added:
| ".pl" | ".pm" | ".t" -> Some "perl"
52
Added:
| ".proto" -> Some "protobuf"
53
Added:
| ".ps1" | ".psm1" | ".psd1" -> Some "powershell"
54
Added:
| ".py" -> Some "python"
55
Added:
| ".r" -> Some "r"
56
Added:
| ".rb" -> Some "ruby"
57
Added:
| ".rs" -> Some "rust"
58
Added:
| ".scala" | ".sc" -> Some "scala"
59
Added:
| ".sh" | ".bash" | ".zsh" -> Some "bash"
60
Added:
| ".sql" -> Some "sql"
61
Added:
| ".swift" -> Some "swift"
62
Added:
| ".tf" | ".hcl" -> Some "terraform"
63
Added:
| ".toml" -> Some "toml"
64
Added:
| ".ts" | ".tsx" -> Some "typescript"
65
Added:
| ".vue" -> Some "vue"
66
Added:
| ".xml" | ".svg" | ".xsl" -> Some "xml"
67
Added:
| ".yaml" | ".yml" -> Some "yaml"
68
Added:
| ".zig" -> Some "zig"
69
Added:
| _ -> None)
70
Added:
71
Added:
let of_shebang line =
72
Added:
if not (String.starts_with ~prefix:"#!" line) then None
73
Added:
else
74
Added:
(* Extract the last path component, ignoring env and arguments *)
75
Added:
let rest = String.sub line 2 (String.length line - 2) in
76
Added:
let parts = String.split_on_char ' ' (String.trim rest) in
77
Added:
let interpreter =
78
Added:
match parts with
79
Added:
| [] -> ""
80
Added:
| cmd :: args ->
81
Added:
let base = Filename.basename cmd in
82
Added:
if base = "env" then
83
Added:
(* /usr/bin/env python3 — take next non-flag argument *)
84
Added:
List.find_opt (fun s -> s <> "" && s.[0] <> '-') args
85
Added:
|> Option.value ~default:"" |> Filename.basename
86
Added:
else base
87
Added:
in
88
Added:
(* Strip version suffixes: python3.11 -> python, ruby3.2 -> ruby *)
89
Added:
let strip_trailing_digits s =
90
Added:
let len = String.length s in
91
Added:
let rec find_end i =
92
Added:
if i < 0 then s
93
Added:
else if s.[i] >= '0' && s.[i] <= '9' then find_end (i - 1)
94
Added:
else String.sub s 0 (i + 1)
95
Added:
in
96
Added:
find_end (len - 1)
97
Added:
in
98
Added:
let interpreter =
99
Added:
match String.split_on_char '.' interpreter with
100
Added:
| [] -> ""
101
Added:
| base :: _ -> strip_trailing_digits base
102
Added:
in
103
Added:
match String.lowercase_ascii interpreter with
104
Added:
| "sh" | "bash" | "dash" | "ash" | "zsh" -> Some "bash"
105
Added:
| "python" -> Some "python"
106
Added:
| "ruby" -> Some "ruby"
107
Added:
| "perl" -> Some "perl"
108
Added:
| "node" | "deno" | "bun" -> Some "javascript"
109
Added:
| "lua" -> Some "lua"
110
Added:
| "php" -> Some "php"
111
Added:
| "elixir" -> Some "elixir"
112
Added:
| "awk" | "gawk" | "mawk" -> Some "awk"
113
Added:
| "ocaml" -> Some "ocaml"
114
Added:
| _ -> None
115
Added:
116
Added:
let of_emacs_variables line =
117
Added:
let find_between s prefix suffix =
118
Added:
let plen = String.length prefix in
119
Added:
let slen = String.length suffix in
120
Added:
let total = String.length s in
121
Added:
let rec find_start i =
122
Added:
if i > total - plen then None
123
Added:
else if String.sub s i plen = prefix then
124
Added:
let after = i + plen in
125
Added:
let rec find_end j =
126
Added:
if j > total - slen then None
127
Added:
else if String.sub s j slen = suffix then
128
Added:
Some (String.sub s after (j - after) |> String.trim)
129
Added:
else find_end (j + 1)
130
Added:
in
131
Added:
find_end after
132
Added:
else find_start (i + 1)
133
Added:
in
134
Added:
find_start 0
135
Added:
in
136
Added:
let extract_mode between =
137
Added:
let props = String.split_on_char ';' between in
138
Added:
let mode_prop =
139
Added:
List.find_map
140
Added:
(fun prop ->
141
Added:
match String.split_on_char ':' (String.trim prop) with
142
Added:
| [ key; value ]
143
Added:
when String.trim (String.lowercase_ascii key) = "mode" ->
144
Added:
Some (String.trim value)
145
Added:
| _ -> None)
146
Added:
props
147
Added:
in
148
Added:
match mode_prop with
149
Added:
| Some _ -> mode_prop
150
Added:
| None ->
151
Added:
if
152
Added:
(not (String.contains between ':'))
153
Added:
&& not (String.contains between ';')
154
Added:
then Some (String.trim between)
155
Added:
else None
156
Added:
in
157
Added:
let normalize_mode mode =
158
Added:
match String.lowercase_ascii mode with
159
Added:
| "tuareg" | "caml" | "ocaml" -> Some "ocaml"
160
Added:
| "emacs-lisp" | "lisp" | "elisp" -> Some "lisp"
161
Added:
| "shell-script" | "sh" | "bash" -> Some "bash"
162
Added:
| "python" -> Some "python"
163
Added:
| "ruby" -> Some "ruby"
164
Added:
| "perl" | "cperl" -> Some "perl"
165
Added:
| "c" -> Some "c"
166
Added:
| "c++" -> Some "cpp"
167
Added:
| "javascript" | "js" -> Some "javascript"
168
Added:
| "typescript" -> Some "typescript"
169
Added:
| "rust" -> Some "rust"
170
Added:
| "go" -> Some "go"
171
Added:
| "haskell" -> Some "haskell"
172
Added:
| "lua" -> Some "lua"
173
Added:
| "sql" -> Some "sql"
174
Added:
| "yaml" -> Some "yaml"
175
Added:
| "nix" -> Some "nix"
176
Added:
| "makefile" -> Some "makefile"
177
Added:
| m -> Some m
178
Added:
in
179
Added:
let ( >>= ) = Option.bind in
180
Added:
find_between line "-*-" "-*-" >>= extract_mode >>= normalize_mode
181
Added:
182
Added:
let of_vim_modeline line =
183
Added:
let contains_substring s sub =
184
Added:
let slen = String.length s in
185
Added:
let sublen = String.length sub in
186
Added:
let rec check i =
187
Added:
if i > slen - sublen then false
188
Added:
else if String.sub s i sublen = sub then true
189
Added:
else check (i + 1)
190
Added:
in
191
Added:
sublen <= slen && check 0
192
Added:
in
193
Added:
let l = String.lowercase_ascii line in
194
Added:
let has_vim_prefix =
195
Added:
contains_substring l "vim:"
196
Added:
|| contains_substring l "vi:" || contains_substring l "ex:"
197
Added:
in
198
Added:
if not has_vim_prefix then None
199
Added:
else
200
Added:
let find_value prefix s =
201
Added:
let plen = String.length prefix in
202
Added:
let slen = String.length s in
203
Added:
let rec find_at i =
204
Added:
if i > slen - plen then None
205
Added:
else if String.sub s i plen = prefix then
206
Added:
let vstart = i + plen in
207
Added:
let rec scan_end j =
208
Added:
if j >= slen || s.[j] = ' ' || s.[j] = ':' || s.[j] = '\t' then j
209
Added:
else scan_end (j + 1)
210
Added:
in
211
Added:
let vend = scan_end vstart in
212
Added:
Some (String.sub s vstart (vend - vstart))
213
Added:
else find_at (i + 1)
214
Added:
in
215
Added:
find_at 0
216
Added:
in
217
Added:
let ft =
218
Added:
match find_value "ft=" l with
219
Added:
| Some _ as r -> r
220
Added:
| None -> find_value "filetype=" l
221
Added:
in
222
Added:
match ft with
223
Added:
| None -> None
224
Added:
| Some ft -> (
225
Added:
match ft with
226
Added:
| "sh" | "bash" | "zsh" -> Some "bash"
227
Added:
| "python" -> Some "python"
228
Added:
| "ruby" -> Some "ruby"
229
Added:
| "perl" -> Some "perl"
230
Added:
| "javascript" | "js" -> Some "javascript"
231
Added:
| "typescript" -> Some "typescript"
232
Added:
| "ocaml" -> Some "ocaml"
233
Added:
| "c" -> Some "c"
234
Added:
| "cpp" -> Some "cpp"
235
Added:
| "rust" -> Some "rust"
236
Added:
| "go" -> Some "go"
237
Added:
| "haskell" -> Some "haskell"
238
Added:
| "lua" -> Some "lua"
239
Added:
| "make" | "makefile" -> Some "makefile"
240
Added:
| "yaml" -> Some "yaml"
241
Added:
| "sql" -> Some "sql"
242
Added:
| "nix" -> Some "nix"
243
Added:
| other -> Some other)
244
Added:
245
Added:
(** Inspect the first and last five lines, where editors conventionally place
246
Added:
mode declarations. *)
247
Added:
let of_content content =
248
Added:
let lines = String.split_on_char '\n' content in
249
Added:
let len = List.length lines in
250
Added:
let rec take n = function
251
Added:
| _ when n <= 0 -> []
252
Added:
| [] -> []
253
Added:
| x :: rest -> x :: take (n - 1) rest
254
Added:
in
255
Added:
let rec drop n = function
256
Added:
| l when n <= 0 -> l
257
Added:
| [] -> []
258
Added:
| _ :: rest -> drop (n - 1) rest
259
Added:
in
260
Added:
let first_lines = take (min 5 len) lines in
261
Added:
let last_lines = drop (max 0 (len - 5)) lines in
262
Added:
let try_lines detector lines = List.find_map detector lines in
263
Added:
let ( <|> ) a b = match a with Some _ -> a | None -> b () in
264
Added:
match first_lines with
265
Added:
| [] -> None
266
Added:
| first :: _ ->
267
Added:
( (of_shebang first <|> fun () -> try_lines of_emacs_variables first_lines)
268
Added:
<|> fun () -> try_lines of_vim_modeline first_lines )
269
Added:
<|> fun () -> try_lines of_vim_modeline last_lines
270
Added:
271
Added:
(** Prefer the filename, falling back to markers inside the content. *)
272
Added:
let detect ~filename content =
273
Added:
match Option.bind filename of_filename with
274
Added:
| Some _ as found -> found
275
Added:
| None -> of_content content
lib/highlight/dune
@@ -0,0 +1,13 @@
1
Added:
(include_subdirs no)
2
Added:
3
Added:
(library
4
Added:
(name highlight)
5
Added:
(public_name ogit.highlight)
6
Added:
(libraries dream-html hilite textmate-language yojson))
7
Added:
8
Added:
(rule
9
Added:
(target grammar_data.ml)
10
Added:
(deps
11
Added:
(source_tree grammars))
12
Added:
(action
13
Added:
(run ocaml-crunch -m plain -s -o %{target} grammars)))
lib/highlight/engine.ml
@@ -0,0 +1,51 @@
1
Added:
(** Server-side syntax highlighting engine.
2
Added:
3
Added:
Tokenizes source code using TextMate grammars (via hilite) and produces
4
Added:
{!Dream_html.node} spans ready for embedding in the page. Falls back
5
Added:
gracefully to plain text when no grammar is available for the requested
6
Added:
language. *)
7
Added:
8
Added:
open Dream_html
9
Added:
10
Added:
type line = node list
11
Added:
(** A single highlighted line: a list of HTML nodes (spans with classes). *)
12
Added:
13
Added:
(** Highlight source code for the given language.
14
Added:
15
Added:
Returns a list of lines, each line being a list of [<span>] nodes with
16
Added:
appropriate CSS classes. If [lang] is [None] or the language is not
17
Added:
supported, returns plain-text lines (no spans, just escaped text).
18
Added:
19
Added:
The CSS classes follow hilite's convention:
20
Added:
[{lang_scope}-{token_scope_segments}], e.g.
21
Added:
[source.python-storage-type-function]. *)
22
Added:
let highlight ~lang source : line list =
23
Added:
let plain_lines () =
24
Added:
String.split_on_char '\n' source
25
Added:
|> List.map (fun line -> [ txt "%s\n" line ])
26
Added:
in
27
Added:
match lang with
28
Added:
| None -> plain_lines ()
29
Added:
| Some lang_name -> (
30
Added:
let scope = Grammars.scope_of_lang lang_name in
31
Added:
match scope with
32
Added:
| None -> plain_lines ()
33
Added:
| Some scope_name -> (
34
Added:
let tm = Lazy.force Grammars.registry in
35
Added:
match
36
Added:
Hilite.src_code_to_pairs ~escape:true ~lookup_method:`Scope_name ~tm
37
Added:
~lang:scope_name source
38
Added:
with
39
Added:
| Error _ -> plain_lines ()
40
Added:
| Ok pairs ->
41
Added:
List.map
42
Added:
(fun line_pairs ->
43
Added:
List.map
44
Added:
(fun (css_class, content) ->
45
Added:
if css_class = "" then txt ~raw:true "%s" content
46
Added:
else
47
Added:
HTML.span
48
Added:
[ HTML.class_ "%s" css_class ]
49
Added:
[ txt ~raw:true "%s" content ])
50
Added:
line_pairs)
51
Added:
pairs))
lib/highlight/grammars.ml
@@ -0,0 +1,95 @@
1
Added:
(** Registry of bundled TextMate grammars for syntax highlighting.
2
Added:
3
Added:
Loads grammars embedded at build time via [ocaml-crunch] and registers them
4
Added:
with a shared {!TmLanguage.t} instance. Language lookup is by the canonical
5
Added:
name string produced by {!Detect.detect}.
6
Added:
7
Added:
The {!languages} table is the single source of truth for which grammars are
8
Added:
shipped and what scope each language maps to. Both the registry loader and
9
Added:
{!scope_of_lang} derive from it. *)
10
Added:
11
Added:
(** Each entry is [(grammar_file, scope_name, aliases)] where [aliases] includes
12
Added:
the canonical name and any accepted variants. *)
13
Added:
let languages =
14
Added:
[
15
Added:
("c", "source.c", [ "c" ]);
16
Added:
("clojure", "source.clojure", [ "clojure" ]);
17
Added:
("cpp", "source.cpp", [ "cpp" ]);
18
Added:
("csharp", "source.cs", [ "csharp" ]);
19
Added:
("css", "source.css", [ "css" ]);
20
Added:
("dart", "source.dart", [ "dart" ]);
21
Added:
("diff", "source.diff", [ "diff" ]);
22
Added:
("dockerfile", "source.dockerfile", [ "dockerfile" ]);
23
Added:
("dune", "source.dune", [ "dune" ]);
24
Added:
("elixir", "source.elixir", [ "elixir" ]);
25
Added:
("erlang", "source.erlang", [ "erlang" ]);
26
Added:
("fortran", "source.fortran.free", [ "fortran" ]);
27
Added:
("go", "source.go", [ "go" ]);
28
Added:
("groovy", "source.groovy", [ "groovy" ]);
29
Added:
("haskell", "source.haskell", [ "haskell" ]);
30
Added:
("html", "text.html.basic", [ "html" ]);
31
Added:
("java", "source.java", [ "java" ]);
32
Added:
("javascript", "source.js", [ "javascript" ]);
33
Added:
("json", "source.json", [ "json" ]);
34
Added:
("julia", "source.julia", [ "julia" ]);
35
Added:
("kotlin", "source.kotlin", [ "kotlin" ]);
36
Added:
("lisp", "source.lisp", [ "lisp" ]);
37
Added:
("lua", "source.lua", [ "lua" ]);
38
Added:
("makefile", "source.makefile", [ "makefile" ]);
39
Added:
("markdown", "text.html.markdown", [ "markdown" ]);
40
Added:
("nix", "source.nix", [ "nix" ]);
41
Added:
("objective-c", "source.objc", [ "objective-c"; "objc" ]);
42
Added:
("ocaml", "source.ocaml", [ "ocaml" ]);
43
Added:
("ocamldoc", "source.ocaml.ocamldoc", [ "ocamldoc"; "mld" ]);
44
Added:
("opam", "source.ocaml.opam", [ "opam" ]);
45
Added:
("org", "source.org", [ "org" ]);
46
Added:
("perl", "source.perl", [ "perl" ]);
47
Added:
("php", "source.php", [ "php" ]);
48
Added:
("powershell", "source.powershell", [ "powershell" ]);
49
Added:
("protobuf", "source.proto", [ "protobuf"; "proto" ]);
50
Added:
("python", "source.python", [ "python" ]);
51
Added:
("r", "source.r", [ "r" ]);
52
Added:
("ruby", "source.ruby", [ "ruby" ]);
53
Added:
("rust", "source.rust", [ "rust" ]);
54
Added:
("scala", "source.scala", [ "scala" ]);
55
Added:
("shell", "source.shell", [ "bash"; "shell"; "sh" ]);
56
Added:
("sql", "source.sql", [ "sql" ]);
57
Added:
("swift", "source.swift", [ "swift" ]);
58
Added:
("terraform", "source.hcl.terraform", [ "terraform"; "hcl" ]);
59
Added:
("toml", "source.toml", [ "toml"; "ini" ]);
60
Added:
("typescript", "source.ts", [ "typescript" ]);
61
Added:
("vue", "text.html.vue", [ "vue" ]);
62
Added:
("xml", "text.html.basic", [ "xml" ]);
63
Added:
("yaml", "source.yaml", [ "yaml" ]);
64
Added:
("zig", "source.zig", [ "zig" ]);
65
Added:
]
66
Added:
67
Added:
(** The shared grammar registry, lazily initialised. *)
68
Added:
let registry : TmLanguage.t Lazy.t =
69
Added:
lazy
70
Added:
(let t = TmLanguage.create () in
71
Added:
let load filename =
72
Added:
match Grammar_data.read filename with
73
Added:
| None -> ()
74
Added:
| Some data -> (
75
Added:
try
76
Added:
let json = Yojson.Basic.from_string data in
77
Added:
let grammar = TmLanguage.of_yojson_exn json in
78
Added:
TmLanguage.add_grammar t grammar
79
Added:
with _ -> ())
80
Added:
in
81
Added:
List.iter (fun (name, _, _) -> load (name ^ ".json")) languages;
82
Added:
t)
83
Added:
84
Added:
(** Scope lookup table, built once from {!languages}. *)
85
Added:
let scope_table : (string, string) Hashtbl.t =
86
Added:
let tbl = Hashtbl.create 128 in
87
Added:
List.iter
88
Added:
(fun (_, scope, aliases) ->
89
Added:
List.iter (fun alias -> Hashtbl.replace tbl alias scope) aliases)
90
Added:
languages;
91
Added:
tbl
92
Added:
93
Added:
(** Map from the canonical language name (as returned by {!Detect.detect}) to
94
Added:
the scopeName used by the grammar file. *)
95
Added:
let scope_of_lang name = Hashtbl.find_opt scope_table name
lib/highlight/highlight.ml
@@ -1,51 +0,0 @@
1
Removed:
(** Server-side syntax highlighting engine.
2
Removed:
3
Removed:
Tokenizes source code using TextMate grammars (via hilite) and produces
4
Removed:
{!Dream_html.node} spans ready for embedding in the page. Falls back
5
Removed:
gracefully to plain text when no grammar is available for the requested
6
Removed:
language. *)
7
Removed:
8
Removed:
open Dream_html
9
Removed:
10
Removed:
type line = node list
11
Removed:
(** A single highlighted line: a list of HTML nodes (spans with classes). *)
12
Removed:
13
Removed:
(** Highlight source code for the given language.
14
Removed:
15
Removed:
Returns a list of lines, each line being a list of [<span>] nodes with
16
Removed:
appropriate CSS classes. If [lang] is [None] or the language is not
17
Removed:
supported, returns plain-text lines (no spans, just escaped text).
18
Removed:
19
Removed:
The CSS classes follow hilite's convention:
20
Removed:
[{lang_scope}-{token_scope_segments}], e.g.
21
Removed:
[source.python-storage-type-function]. *)
22
Removed:
let highlight ~lang source : line list =
23
Removed:
let plain_lines () =
24
Removed:
String.split_on_char '\n' source
25
Removed:
|> List.map (fun line -> [ txt "%s\n" line ])
26
Removed:
in
27
Removed:
match lang with
28
Removed:
| None -> plain_lines ()
29
Removed:
| Some lang_name -> (
30
Removed:
let scope = Highlight_grammars.scope_of_lang lang_name in
31
Removed:
match scope with
32
Removed:
| None -> plain_lines ()
33
Removed:
| Some scope_name -> (
34
Removed:
let tm = Lazy.force Highlight_grammars.registry in
35
Removed:
match
36
Removed:
Hilite.src_code_to_pairs ~escape:true ~lookup_method:`Scope_name ~tm
37
Removed:
~lang:scope_name source
38
Removed:
with
39
Removed:
| Error _ -> plain_lines ()
40
Removed:
| Ok pairs ->
41
Removed:
List.map
42
Removed:
(fun line_pairs ->
43
Removed:
List.map
44
Removed:
(fun (css_class, content) ->
45
Removed:
if css_class = "" then txt ~raw:true "%s" content
46
Removed:
else
47
Removed:
HTML.span
48
Removed:
[ HTML.class_ "%s" css_class ]
49
Removed:
[ txt ~raw:true "%s" content ])
50
Removed:
line_pairs)
51
Removed:
pairs))
lib/highlight/highlight_grammars.ml
@@ -1,95 +0,0 @@
1
Removed:
(** Registry of bundled TextMate grammars for syntax highlighting.
2
Removed:
3
Removed:
Loads grammars embedded at build time via [ocaml-crunch] and registers them
4
Removed:
with a shared {!TmLanguage.t} instance. Language lookup is by the canonical
5
Removed:
name string produced by {!Syntax.detect}.
6
Removed:
7
Removed:
The {!languages} table is the single source of truth for which grammars are
8
Removed:
shipped and what scope each language maps to. Both the registry loader and
9
Removed:
{!scope_of_lang} derive from it. *)
10
Removed:
11
Removed:
(** Each entry is [(grammar_file, scope_name, aliases)] where [aliases] includes
12
Removed:
the canonical name and any accepted variants. *)
13
Removed:
let languages =
14
Removed:
[
15
Removed:
("c", "source.c", [ "c" ]);
16
Removed:
("clojure", "source.clojure", [ "clojure" ]);
17
Removed:
("cpp", "source.cpp", [ "cpp" ]);
18
Removed:
("csharp", "source.cs", [ "csharp" ]);
19
Removed:
("css", "source.css", [ "css" ]);
20
Removed:
("dart", "source.dart", [ "dart" ]);
21
Removed:
("diff", "source.diff", [ "diff" ]);
22
Removed:
("dockerfile", "source.dockerfile", [ "dockerfile" ]);
23
Removed:
("dune", "source.dune", [ "dune" ]);
24
Removed:
("elixir", "source.elixir", [ "elixir" ]);
25
Removed:
("erlang", "source.erlang", [ "erlang" ]);
26
Removed:
("fortran", "source.fortran.free", [ "fortran" ]);
27
Removed:
("go", "source.go", [ "go" ]);
28
Removed:
("groovy", "source.groovy", [ "groovy" ]);
29
Removed:
("haskell", "source.haskell", [ "haskell" ]);
30
Removed:
("html", "text.html.basic", [ "html" ]);
31
Removed:
("java", "source.java", [ "java" ]);
32
Removed:
("javascript", "source.js", [ "javascript" ]);
33
Removed:
("json", "source.json", [ "json" ]);
34
Removed:
("julia", "source.julia", [ "julia" ]);
35
Removed:
("kotlin", "source.kotlin", [ "kotlin" ]);
36
Removed:
("lisp", "source.lisp", [ "lisp" ]);
37
Removed:
("lua", "source.lua", [ "lua" ]);
38
Removed:
("makefile", "source.makefile", [ "makefile" ]);
39
Removed:
("markdown", "text.html.markdown", [ "markdown" ]);
40
Removed:
("nix", "source.nix", [ "nix" ]);
41
Removed:
("objective-c", "source.objc", [ "objective-c"; "objc" ]);
42
Removed:
("ocaml", "source.ocaml", [ "ocaml" ]);
43
Removed:
("ocamldoc", "source.ocaml.ocamldoc", [ "ocamldoc"; "mld" ]);
44
Removed:
("opam", "source.ocaml.opam", [ "opam" ]);
45
Removed:
("org", "source.org", [ "org" ]);
46
Removed:
("perl", "source.perl", [ "perl" ]);
47
Removed:
("php", "source.php", [ "php" ]);
48
Removed:
("powershell", "source.powershell", [ "powershell" ]);
49
Removed:
("protobuf", "source.proto", [ "protobuf"; "proto" ]);
50
Removed:
("python", "source.python", [ "python" ]);
51
Removed:
("r", "source.r", [ "r" ]);
52
Removed:
("ruby", "source.ruby", [ "ruby" ]);
53
Removed:
("rust", "source.rust", [ "rust" ]);
54
Removed:
("scala", "source.scala", [ "scala" ]);
55
Removed:
("shell", "source.shell", [ "bash"; "shell"; "sh" ]);
56
Removed:
("sql", "source.sql", [ "sql" ]);
57
Removed:
("swift", "source.swift", [ "swift" ]);
58
Removed:
("terraform", "source.hcl.terraform", [ "terraform"; "hcl" ]);
59
Removed:
("toml", "source.toml", [ "toml"; "ini" ]);
60
Removed:
("typescript", "source.ts", [ "typescript" ]);
61
Removed:
("vue", "text.html.vue", [ "vue" ]);
62
Removed:
("xml", "text.html.basic", [ "xml" ]);
63
Removed:
("yaml", "source.yaml", [ "yaml" ]);
64
Removed:
("zig", "source.zig", [ "zig" ]);
65
Removed:
]
66
Removed:
67
Removed:
(** The shared grammar registry, lazily initialised. *)
68
Removed:
let registry : TmLanguage.t Lazy.t =
69
Removed:
lazy
70
Removed:
(let t = TmLanguage.create () in
71
Removed:
let load filename =
72
Removed:
match Grammar_data.read filename with
73
Removed:
| None -> ()
74
Removed:
| Some data -> (
75
Removed:
try
76
Removed:
let json = Yojson.Basic.from_string data in
77
Removed:
let grammar = TmLanguage.of_yojson_exn json in
78
Removed:
TmLanguage.add_grammar t grammar
79
Removed:
with _ -> ())
80
Removed:
in
81
Removed:
List.iter (fun (name, _, _) -> load (name ^ ".json")) languages;
82
Removed:
t)
83
Removed:
84
Removed:
(** Scope lookup table, built once from {!languages}. *)
85
Removed:
let scope_table : (string, string) Hashtbl.t =
86
Removed:
let tbl = Hashtbl.create 128 in
87
Removed:
List.iter
88
Removed:
(fun (_, scope, aliases) ->
89
Removed:
List.iter (fun alias -> Hashtbl.replace tbl alias scope) aliases)
90
Removed:
languages;
91
Removed:
tbl
92
Removed:
93
Removed:
(** Map from the canonical language name (as returned by {!Syntax.detect}) to
94
Removed:
the scopeName used by the grammar file. *)
95
Removed:
let scope_of_lang name = Hashtbl.find_opt scope_table name
lib/highlight/syntax.ml
@@ -1,265 +0,0 @@
1
Removed:
(** Guessing a file's language for syntax highlighting.
2
Removed:
3
Removed:
Detection is best-effort and purely advisory: the blob renders identically
4
Removed:
whether or not a language is found, so a wrong guess degrades to plain text
5
Removed:
rather than breaking the page.
6
Removed:
7
Removed:
Sources are tried in descending order of reliability: the filename
8
Removed:
extension, then a shebang, then an Emacs file variable, then a Vim modeline.
9
Removed:
*)
10
Removed:
11
Removed:
let of_filename name =
12
Removed:
(* First check the bare filename for well-known extensionless files *)
13
Removed:
let basename = Filename.basename name |> String.lowercase_ascii in
14
Removed:
match basename with
15
Removed:
| "makefile" | "gnumakefile" -> Some "makefile"
16
Removed:
| "dockerfile" -> Some "dockerfile"
17
Removed:
| "dune" | "dune-project" | "dune-workspace" -> Some "dune"
18
Removed:
| "jenkinsfile" -> Some "groovy"
19
Removed:
| _ -> (
20
Removed:
match Filename.extension name |> String.lowercase_ascii with
21
Removed:
| ".ml" | ".mli" -> Some "ocaml"
22
Removed:
| ".mld" -> Some "ocamldoc"
23
Removed:
| ".c" | ".h" -> Some "c"
24
Removed:
| ".clj" | ".cljs" | ".cljc" | ".edn" -> Some "clojure"
25
Removed:
| ".cpp" | ".cc" | ".cxx" | ".hpp" -> Some "cpp"
26
Removed:
| ".cs" -> Some "csharp"
27
Removed:
| ".css" -> Some "css"
28
Removed:
| ".dart" -> Some "dart"
29
Removed:
| ".diff" | ".patch" -> Some "diff"
30
Removed:
| ".dune" -> Some "dune"
31
Removed:
| ".el" | ".lisp" | ".cl" | ".scm" | ".ss" -> Some "lisp"
32
Removed:
| ".erl" | ".hrl" -> Some "erlang"
33
Removed:
| ".ex" | ".exs" -> Some "elixir"
34
Removed:
| ".f90" | ".f95" | ".f03" | ".f08" | ".f" | ".for" -> Some "fortran"
35
Removed:
| ".go" -> Some "go"
36
Removed:
| ".gradle" | ".groovy" -> Some "groovy"
37
Removed:
| ".hs" -> Some "haskell"
38
Removed:
| ".html" | ".htm" -> Some "html"
39
Removed:
| ".java" -> Some "java"
40
Removed:
| ".jl" -> Some "julia"
41
Removed:
| ".js" | ".mjs" | ".cjs" -> Some "javascript"
42
Removed:
| ".json" -> Some "json"
43
Removed:
| ".kt" | ".kts" -> Some "kotlin"
44
Removed:
| ".lua" -> Some "lua"
45
Removed:
| ".m" -> Some "objective-c"
46
Removed:
| ".md" -> Some "markdown"
47
Removed:
| ".nix" -> Some "nix"
48
Removed:
| ".opam" -> Some "opam"
49
Removed:
| ".org" -> Some "org"
50
Removed:
| ".php" -> Some "php"
51
Removed:
| ".pl" | ".pm" | ".t" -> Some "perl"
52
Removed:
| ".proto" -> Some "protobuf"
53
Removed:
| ".ps1" | ".psm1" | ".psd1" -> Some "powershell"
54
Removed:
| ".py" -> Some "python"
55
Removed:
| ".r" -> Some "r"
56
Removed:
| ".rb" -> Some "ruby"
57
Removed:
| ".rs" -> Some "rust"
58
Removed:
| ".scala" | ".sc" -> Some "scala"
59
Removed:
| ".sh" | ".bash" | ".zsh" -> Some "bash"
60
Removed:
| ".sql" -> Some "sql"
61
Removed:
| ".swift" -> Some "swift"
62
Removed:
| ".tf" | ".hcl" -> Some "terraform"
63
Removed:
| ".toml" -> Some "toml"
64
Removed:
| ".ts" | ".tsx" -> Some "typescript"
65
Removed:
| ".vue" -> Some "vue"
66
Removed:
| ".xml" | ".svg" | ".xsl" -> Some "xml"
67
Removed:
| ".yaml" | ".yml" -> Some "yaml"
68
Removed:
| ".zig" -> Some "zig"
69
Removed:
| _ -> None)
70
Removed:
71
Removed:
let of_shebang line =
72
Removed:
if not (String.starts_with ~prefix:"#!" line) then None
73
Removed:
else
74
Removed:
(* Extract the last path component, ignoring env and arguments *)
75
Removed:
let rest = String.sub line 2 (String.length line - 2) in
76
Removed:
let parts = String.split_on_char ' ' (String.trim rest) in
77
Removed:
let interpreter =
78
Removed:
match parts with
79
Removed:
| [] -> ""
80
Removed:
| cmd :: args ->
81
Removed:
let base = Filename.basename cmd in
82
Removed:
if base = "env" then
83
Removed:
(* /usr/bin/env python3 — take next non-flag argument *)
84
Removed:
List.find_opt (fun s -> s <> "" && s.[0] <> '-') args
85
Removed:
|> Option.value ~default:"" |> Filename.basename
86
Removed:
else base
87
Removed:
in
88
Removed:
(* Strip version suffixes: python3.11 -> python, ruby3.2 -> ruby *)
89
Removed:
let strip_trailing_digits s =
90
Removed:
let len = String.length s in
91
Removed:
let rec find_end i =
92
Removed:
if i < 0 then s
93
Removed:
else if s.[i] >= '0' && s.[i] <= '9' then find_end (i - 1)
94
Removed:
else String.sub s 0 (i + 1)
95
Removed:
in
96
Removed:
find_end (len - 1)
97
Removed:
in
98
Removed:
let interpreter =
99
Removed:
match String.split_on_char '.' interpreter with
100
Removed:
| [] -> ""
101
Removed:
| base :: _ -> strip_trailing_digits base
102
Removed:
in
103
Removed:
match String.lowercase_ascii interpreter with
104
Removed:
| "sh" | "bash" | "dash" | "ash" | "zsh" -> Some "bash"
105
Removed:
| "python" -> Some "python"
106
Removed:
| "ruby" -> Some "ruby"
107
Removed:
| "perl" -> Some "perl"
108
Removed:
| "node" | "deno" | "bun" -> Some "javascript"
109
Removed:
| "lua" -> Some "lua"
110
Removed:
| "php" -> Some "php"
111
Removed:
| "elixir" -> Some "elixir"
112
Removed:
| "awk" | "gawk" | "mawk" -> Some "awk"
113
Removed:
| "ocaml" -> Some "ocaml"
114
Removed:
| _ -> None
115
Removed:
116
Removed:
let of_emacs_variables line =
117
Removed:
let find_between s prefix suffix =
118
Removed:
let plen = String.length prefix in
119
Removed:
let slen = String.length suffix in
120
Removed:
let total = String.length s in
121
Removed:
let rec find_start i =
122
Removed:
if i > total - plen then None
123
Removed:
else if String.sub s i plen = prefix then
124
Removed:
let after = i + plen in
125
Removed:
let rec find_end j =
126
Removed:
if j > total - slen then None
127
Removed:
else if String.sub s j slen = suffix then
128
Removed:
Some (String.sub s after (j - after) |> String.trim)
129
Removed:
else find_end (j + 1)
130
Removed:
in
131
Removed:
find_end after
132
Removed:
else find_start (i + 1)
133
Removed:
in
134
Removed:
find_start 0
135
Removed:
in
136
Removed:
let extract_mode between =
137
Removed:
let props = String.split_on_char ';' between in
138
Removed:
let mode_prop =
139
Removed:
List.find_map
140
Removed:
(fun prop ->
141
Removed:
match String.split_on_char ':' (String.trim prop) with
142
Removed:
| [ key; value ]
143
Removed:
when String.trim (String.lowercase_ascii key) = "mode" ->
144
Removed:
Some (String.trim value)
145
Removed:
| _ -> None)
146
Removed:
props
147
Removed:
in
148
Removed:
match mode_prop with
149
Removed:
| Some _ -> mode_prop
150
Removed:
| None ->
151
Removed:
if
152
Removed:
(not (String.contains between ':'))
153
Removed:
&& not (String.contains between ';')
154
Removed:
then Some (String.trim between)
155
Removed:
else None
156
Removed:
in
157
Removed:
let normalize_mode mode =
158
Removed:
match String.lowercase_ascii mode with
159
Removed:
| "tuareg" | "caml" | "ocaml" -> Some "ocaml"
160
Removed:
| "emacs-lisp" | "lisp" | "elisp" -> Some "lisp"
161
Removed:
| "shell-script" | "sh" | "bash" -> Some "bash"
162
Removed:
| "python" -> Some "python"
163
Removed:
| "ruby" -> Some "ruby"
164
Removed:
| "perl" | "cperl" -> Some "perl"
165
Removed:
| "c" -> Some "c"
166
Removed:
| "c++" -> Some "cpp"
167
Removed:
| "javascript" | "js" -> Some "javascript"
168
Removed:
| "typescript" -> Some "typescript"
169
Removed:
| "rust" -> Some "rust"
170
Removed:
| "go" -> Some "go"
171
Removed:
| "haskell" -> Some "haskell"
172
Removed:
| "lua" -> Some "lua"
173
Removed:
| "sql" -> Some "sql"
174
Removed:
| "yaml" -> Some "yaml"
175
Removed:
| "nix" -> Some "nix"
176
Removed:
| "makefile" -> Some "makefile"
177
Removed:
| m -> Some m
178
Removed:
in
179
Removed:
let ( >>= ) = Option.bind in
180
Removed:
find_between line "-*-" "-*-" >>= extract_mode >>= normalize_mode
181
Removed:
182
Removed:
let of_vim_modeline line =
183
Removed:
let contains_substring s sub =
184
Removed:
let slen = String.length s in
185
Removed:
let sublen = String.length sub in
186
Removed:
let rec check i =
187
Removed:
if i > slen - sublen then false
188
Removed:
else if String.sub s i sublen = sub then true
189
Removed:
else check (i + 1)
190
Removed:
in
191
Removed:
sublen <= slen && check 0
192
Removed:
in
193
Removed:
let l = String.lowercase_ascii line in
194
Removed:
let has_vim_prefix =
195
Removed:
contains_substring l "vim:"
196
Removed:
|| contains_substring l "vi:" || contains_substring l "ex:"
197
Removed:
in
198
Removed:
if not has_vim_prefix then None
199
Removed:
else
200
Removed:
let find_value prefix s =
201
Removed:
let plen = String.length prefix in
202
Removed:
let slen = String.length s in
203
Removed:
let rec find_at i =
204
Removed:
if i > slen - plen then None
205
Removed:
else if String.sub s i plen = prefix then
206
Removed:
let vstart = i + plen in
207
Removed:
let rec scan_end j =
208
Removed:
if j >= slen || s.[j] = ' ' || s.[j] = ':' || s.[j] = '\t' then j
209
Removed:
else scan_end (j + 1)
210
Removed:
in
211
Removed:
let vend = scan_end vstart in
212
Removed:
Some (String.sub s vstart (vend - vstart))
213
Removed:
else find_at (i + 1)
214
Removed:
in
215
Removed:
find_at 0
216
Removed:
in
217
Removed:
let ft =
218
Removed:
match find_value "ft=" l with
219
Removed:
| Some _ as r -> r
220
Removed:
| None -> find_value "filetype=" l
221
Removed:
in
222
Removed:
match ft with
223
Removed:
| None -> None
224
Removed:
| Some ft -> (
225
Removed:
match ft with
226
Removed:
| "sh" | "bash" | "zsh" -> Some "bash"
227
Removed:
| "python" -> Some "python"
228
Removed:
| "ruby" -> Some "ruby"
229
Removed:
| "perl" -> Some "perl"
230
Removed:
| "javascript" | "js" -> Some "javascript"
231
Removed:
| "typescript" -> Some "typescript"
232
Removed:
| "ocaml" -> Some "ocaml"
233
Removed:
| "c" -> Some "c"
234
Removed:
| "cpp" -> Some "cpp"
235
Removed:
| "rust" -> Some "rust"
236
Removed:
| "go" -> Some "go"
237
Removed:
| "haskell" -> Some "haskell"
238
Removed:
| "lua" -> Some "lua"
239
Removed:
| "make" | "makefile" -> Some "makefile"
240
Removed:
| "yaml" -> Some "yaml"
241
Removed:
| "sql" -> Some "sql"
242
Removed:
| "nix" -> Some "nix"
243
Removed:
| other -> Some other)
244
Removed:
245
Removed:
(** Inspect the first and last five lines, where editors conventionally place
246
Removed:
mode declarations. *)
247
Removed:
let of_content content =
248
Removed:
let lines = String.split_on_char '\n' content in
249
Removed:
let len = List.length lines in
250
Removed:
let first_lines = List_ext.take (min 5 len) lines in
251
Removed:
let last_lines = List_ext.drop (max 0 (len - 5)) lines in
252
Removed:
let try_lines detector lines = List.find_map detector lines in
253
Removed:
let ( <|> ) a b = match a with Some _ -> a | None -> b () in
254
Removed:
match first_lines with
255
Removed:
| [] -> None
256
Removed:
| first :: _ ->
257
Removed:
( (of_shebang first <|> fun () -> try_lines of_emacs_variables first_lines)
258
Removed:
<|> fun () -> try_lines of_vim_modeline first_lines )
259
Removed:
<|> fun () -> try_lines of_vim_modeline last_lines
260
Removed:
261
Removed:
(** Prefer the filename, falling back to markers inside the content. *)
262
Removed:
let detect ~filename content =
263
Removed:
match Option.bind filename of_filename with
264
Removed:
| Some _ as found -> found
265
Removed:
| None -> of_content content
lib/prose/dune
@@ -0,0 +1,6 @@
1
Added:
(include_subdirs no)
2
Added:
3
Added:
(library
4
Added:
(name prose)
5
Added:
(public_name ogit.prose)
6
Added:
(libraries ogit.ui ogit.highlight dream-html))
lib/prose/format.ml
@@ -0,0 +1,218 @@
1
Added:
(** Shared document AST and renderer for prose formats.
2
Added:
3
Added:
Format-specific parsing is supplied by the {!format} type; the renderer, TOC
4
Added:
generation, and anchor management are format-independent.
5
Added:
6
Added:
Every text fragment is emitted through {!Ui}, ensuring safe escaping of
7
Added:
repository content. *)
8
Added:
9
Added:
(* {1 Document AST} *)
10
Added:
11
Added:
type inline =
12
Added:
| Text of string
13
Added:
| Code of string
14
Added:
| Verbatim of string
15
Added:
| Link of { href : string; text : string }
16
Added:
17
Added:
type block =
18
Added:
| Heading of int * string
19
Added:
| Paragraph of string
20
Added:
| Unordered_list of string list
21
Added:
| Ordered_list of string list
22
Added:
| Definition_list of (string * string) list
23
Added:
| Code_block of string option * string
24
Added:
25
Added:
type document = {
26
Added:
title : string option;
27
Added:
metadata : (string * string) list;
28
Added:
blocks : block list;
29
Added:
}
30
Added:
31
Added:
(* {1 Format interface} *)
32
Added:
33
Added:
type format = {
34
Added:
name : string;
35
Added:
css_class : string;
36
Added:
parse : string -> document;
37
Added:
inline : string -> Ui.node list;
38
Added:
}
39
Added:
(** A documentation format provides parsing and inline markup rendering. *)
40
Added:
41
Added:
(* {1 Shared utilities} *)
42
Added:
43
Added:
let first_word text =
44
Added:
match
45
Added:
String.split_on_char ' ' text |> List.filter (fun word -> word <> "")
46
Added:
with
47
Added:
| word :: _ -> Some word
48
Added:
| [] -> None
49
Added:
50
Added:
(** A continuation line belongs to the current list item if it is indented
51
Added:
(starts with whitespace) and is not blank. *)
52
Added:
let is_continuation line =
53
Added:
String.length line > 0
54
Added:
&& (line.[0] = ' ' || line.[0] = '\t')
55
Added:
&& String.trim line <> ""
56
Added:
57
Added:
let take_continuations rest =
58
Added:
let rec loop acc = function
59
Added:
| line :: rest when is_continuation line ->
60
Added:
loop (String.trim line :: acc) rest
61
Added:
| remaining -> (List.rev acc, remaining)
62
Added:
in
63
Added:
loop [] rest
64
Added:
65
Added:
let rec take_until close collected = function
66
Added:
| [] -> (List.rev collected, [])
67
Added:
| line :: rest when close line -> (List.rev collected, rest)
68
Added:
| line :: rest -> take_until close (line :: collected) rest
69
Added:
70
Added:
(* {1 Shared list-item classifiers} *)
71
Added:
72
Added:
(** Recognise an unordered list item ([-], [+], or indented [*]). *)
73
Added:
let unordered_item line =
74
Added:
let length = String.length line in
75
Added:
let trimmed = String.trim line in
76
Added:
let tlen = String.length trimmed in
77
Added:
if tlen >= 2 && List.mem trimmed.[0] [ '-'; '+' ] && trimmed.[1] = ' ' then
78
Added:
Some (String.sub trimmed 2 (tlen - 2) |> String.trim)
79
Added:
else if
80
Added:
tlen >= 2
81
Added:
&& trimmed.[0] = '*'
82
Added:
&& trimmed.[1] = ' '
83
Added:
&& length > 0
84
Added:
&& (line.[0] = ' ' || line.[0] = '\t')
85
Added:
then Some (String.sub trimmed 2 (tlen - 2) |> String.trim)
86
Added:
else None
87
Added:
88
Added:
(** Recognise an ordered list item ([1.], [2)], etc.). *)
89
Added:
let ordered_item line =
90
Added:
let trimmed = String.trim line in
91
Added:
let tlen = String.length trimmed in
92
Added:
let rec digits i =
93
Added:
if i < tlen && trimmed.[i] >= '0' && trimmed.[i] <= '9' then digits (i + 1)
94
Added:
else i
95
Added:
in
96
Added:
let d = digits 0 in
97
Added:
if d = 0 || d >= tlen then None
98
Added:
else if
99
Added:
(trimmed.[d] = '.' || trimmed.[d] = ')')
100
Added:
&& d + 1 < tlen
101
Added:
&& trimmed.[d + 1] = ' '
102
Added:
then Some (String.sub trimmed (d + 2) (tlen - d - 2) |> String.trim)
103
Added:
else None
104
Added:
105
Added:
(** True when a line starts a new block (blank, or a list item). *)
106
Added:
let is_boundary_common line =
107
Added:
String.trim line = ""
108
Added:
|| Option.is_some (unordered_item line)
109
Added:
|| Option.is_some (ordered_item line)
110
Added:
111
Added:
(* {1 Anchor generation} *)
112
Added:
113
Added:
let new_anchor () =
114
Added:
let seen = Hashtbl.create 16 in
115
Added:
fun text ->
116
Added:
let base =
117
Added:
let buffer = Buffer.create (String.length text) in
118
Added:
let pending_separator = ref false in
119
Added:
String.iter
120
Added:
(fun character ->
121
Added:
if
122
Added:
(character >= 'a' && character <= 'z')
123
Added:
|| (character >= 'A' && character <= 'Z')
124
Added:
|| (character >= '0' && character <= '9')
125
Added:
then (
126
Added:
if !pending_separator && Buffer.length buffer > 0 then
127
Added:
Buffer.add_char buffer '-';
128
Added:
pending_separator := false;
129
Added:
Buffer.add_char buffer (Char.lowercase_ascii character))
130
Added:
else pending_separator := true)
131
Added:
text;
132
Added:
if Buffer.length buffer = 0 then "section" else Buffer.contents buffer
133
Added:
in
134
Added:
let count = Option.value (Hashtbl.find_opt seen base) ~default:0 + 1 in
135
Added:
Hashtbl.replace seen base count;
136
Added:
if count = 1 then base else Printf.sprintf "%s-%d" base count
137
Added:
138
Added:
(* {1 Rendering} *)
139
Added:
140
Added:
let render_heading anchor level text =
141
Added:
let id = anchor text in
142
Added:
Ui.heading ~id ~level ~class_:"readme-heading"
143
Added:
[ Ui.text_link ~class_:"readme-heading-link" ~href:("#" ^ id) text ]
144
Added:
145
Added:
let render_code_block language source =
146
Added:
let nodes =
147
Added:
match language with
148
Added:
| None | Some "" -> [ Ui.text source ]
149
Added:
| Some language ->
150
Added:
Highlight.Engine.highlight ~lang:(Some language) source |> List.concat
151
Added:
in
152
Added:
Ui.code_block ~class_:"readme-code-block" nodes
153
Added:
154
Added:
let render_block format anchor = function
155
Added:
| Heading (level, text) -> render_heading anchor level text
156
Added:
| Paragraph text ->
157
Added:
Ui.paragraph ~class_:"readme-paragraph" (format.inline text)
158
Added:
| Unordered_list items ->
159
Added:
Ui.items ~class_:"readme-list"
160
Added:
(List.map (fun item -> Ui.item (format.inline item)) items)
161
Added:
| Ordered_list items ->
162
Added:
Ui.ordered_items ~class_:"readme-list readme-ordered-list"
163
Added:
(List.map (fun item -> Ui.item (format.inline item)) items)
164
Added:
| Definition_list items ->
165
Added:
Ui.definitions ~class_:"readme-definition-list"
166
Added:
(List.map (fun (term, desc) -> (term, format.inline desc)) items)
167
Added:
| Code_block (language, source) -> render_code_block language source
168
Added:
169
Added:
let render_toc ~title_text body_headings =
170
Added:
let toc_anchor = new_anchor () in
171
Added:
(match title_text with Some t -> ignore (toc_anchor t) | None -> ());
172
Added:
(* Build a nested tree from a flat (level, text) list. Headings at a deeper
173
Added:
level than the current base become children of the preceding entry. *)
174
Added:
let rec build base_level headings =
175
Added:
match headings with
176
Added:
| [] -> ([], [])
177
Added:
| (level, _) :: _ when level < base_level -> ([], headings)
178
Added:
| (level, text) :: rest ->
179
Added:
let id = toc_anchor text in
180
Added:
let children, rest' = build (level + 1) rest in
181
Added:
let entry = Ui.toc_entry ~children ~href:("#" ^ id) text in
182
Added:
let siblings, rest'' = build base_level rest' in
183
Added:
(entry :: siblings, rest'')
184
Added:
in
185
Added:
let min_level =
186
Added:
List.fold_left (fun acc (l, _) -> min acc l) max_int body_headings
187
Added:
in
188
Added:
let entries, _ = build min_level body_headings in
189
Added:
Ui.toc ~class_:"readme-toc" ~title:"Table of Contents" entries
190
Added:
191
Added:
(** Render a document using the given format. *)
192
Added:
let render format content =
193
Added:
let doc = format.parse content in
194
Added:
let body_headings =
195
Added:
List.filter_map
196
Added:
(function Heading (level, text) -> Some (level, text) | _ -> None)
197
Added:
doc.blocks
198
Added:
in
199
Added:
let toc = render_toc ~title_text:doc.title body_headings in
200
Added:
let anchor = new_anchor () in
201
Added:
let title =
202
Added:
match doc.title with
203
Added:
| None -> None
204
Added:
| Some t -> Some (render_heading anchor 1 t)
205
Added:
in
206
Added:
let metadata_node =
207
Added:
match doc.metadata with
208
Added:
| [] -> Ui.nothing
209
Added:
| entries ->
210
Added:
Ui.definitions ~class_:"readme-org-metadata"
211
Added:
(List.map
212
Added:
(fun (key, value) ->
213
Added:
(String.capitalize_ascii key, [ Ui.text value ]))
214
Added:
entries)
215
Added:
in
216
Added:
Ui.region ~class_:format.css_class
217
Added:
(Option.to_list title @ [ metadata_node; toc ]
218
Added:
@ List.map (render_block format anchor) doc.blocks)
lib/prose/format.mli
@@ -0,0 +1,75 @@
1
Added:
(** Shared document AST and renderer for prose formats.
2
Added:
3
Added:
Format-specific parsing is supplied by the {!format} type; the renderer, TOC
4
Added:
generation, and anchor management are format-independent.
5
Added:
6
Added:
Every text fragment is emitted through {!Ui}, ensuring safe escaping of
7
Added:
repository content. *)
8
Added:
9
Added:
(** {1 Document AST} *)
10
Added:
11
Added:
type inline =
12
Added:
| Text of string
13
Added:
| Code of string
14
Added:
| Verbatim of string
15
Added:
| Link of { href : string; text : string } (** Inline markup elements. *)
16
Added:
17
Added:
type block =
18
Added:
| Heading of int * string
19
Added:
| Paragraph of string
20
Added:
| Unordered_list of string list
21
Added:
| Ordered_list of string list
22
Added:
| Definition_list of (string * string) list
23
Added:
| Code_block of string option * string (** Block-level document elements. *)
24
Added:
25
Added:
type document = {
26
Added:
title : string option;
27
Added:
metadata : (string * string) list;
28
Added:
blocks : block list;
29
Added:
}
30
Added:
(** A parsed document with optional title, metadata, and body blocks. *)
31
Added:
32
Added:
(** {1 Format interface} *)
33
Added:
34
Added:
type format = {
35
Added:
name : string;
36
Added:
css_class : string;
37
Added:
parse : string -> document;
38
Added:
inline : string -> Ui.node list;
39
Added:
}
40
Added:
(** A documentation format provides parsing and inline markup rendering. *)
41
Added:
42
Added:
(** {1 Shared utilities} *)
43
Added:
44
Added:
val first_word : string -> string option
45
Added:
(** Extract the first whitespace-delimited word from a string. *)
46
Added:
47
Added:
val is_continuation : string -> bool
48
Added:
(** [true] when a line is indented and non-blank, indicating it continues the
49
Added:
previous list item. *)
50
Added:
51
Added:
val take_continuations : string list -> string list * string list
52
Added:
(** Split off leading continuation lines from the remaining input. *)
53
Added:
54
Added:
val take_until :
55
Added:
(string -> bool) -> string list -> string list -> string list * string list
56
Added:
(** [take_until close collected lines] collects lines until [close] returns
57
Added:
[true], returning the collected lines and the remainder after the closing
58
Added:
line. *)
59
Added:
60
Added:
(** {1 Shared list-item classifiers} *)
61
Added:
62
Added:
val unordered_item : string -> string option
63
Added:
(** Recognise an unordered list item ([-], [+], or indented [*]). *)
64
Added:
65
Added:
val ordered_item : string -> string option
66
Added:
(** Recognise an ordered list item ([1.], [2)], etc.). *)
67
Added:
68
Added:
val is_boundary_common : string -> bool
69
Added:
(** [true] when a line starts a new block (blank, or a list item). *)
70
Added:
71
Added:
(** {1 Rendering} *)
72
Added:
73
Added:
val render : format -> string -> Ui.node
74
Added:
(** Render document content using the given format. Handles parsing, TOC
75
Added:
generation, and block rendering. *)
lib/prose/markdown.ml
@@ -0,0 +1,130 @@
1
Added:
(** Markdown documentation format.
2
Added:
3
Added:
Parses ATX headings, fenced code blocks, unordered and ordered lists, and
4
Added:
paragraphs. Inline markup is passed through as plain text. *)
5
Added:
6
Added:
(* {1 Line classifiers} *)
7
Added:
8
Added:
let trim_end_hashes text =
9
Added:
let text = String.trim text in
10
Added:
let rec last_non_hash index =
11
Added:
if index < 0 || text.[index] <> '#' then index else last_non_hash (index - 1)
12
Added:
in
13
Added:
let last = last_non_hash (String.length text - 1) in
14
Added:
String.sub text 0 (last + 1) |> String.trim
15
Added:
16
Added:
let heading line =
17
Added:
let length = String.length line in
18
Added:
let rec count_hashes index =
19
Added:
if index < length && line.[index] = '#' then count_hashes (index + 1)
20
Added:
else index
21
Added:
in
22
Added:
let level = count_hashes 0 in
23
Added:
if level = 0 || level > 6 || level >= length || line.[level] <> ' ' then None
24
Added:
else
25
Added:
Some
26
Added:
( level,
27
Added:
String.sub line (level + 1) (length - level - 1) |> trim_end_hashes )
28
Added:
29
Added:
let unordered_item = Format.unordered_item
30
Added:
let ordered_item = Format.ordered_item
31
Added:
32
Added:
let fence line =
33
Added:
let line = String.trim line in
34
Added:
if String.length line < 3 then None
35
Added:
else
36
Added:
let marker = String.sub line 0 3 in
37
Added:
if marker <> "```" && marker <> "~~~" then None
38
Added:
else
39
Added:
let language =
40
Added:
String.sub line 3 (String.length line - 3)
41
Added:
|> String.trim |> Format.first_word
42
Added:
in
43
Added:
Some (marker, language)
44
Added:
45
Added:
(* {1 Block parsing} *)
46
Added:
47
Added:
let is_boundary_common = Format.is_boundary_common
48
Added:
49
Added:
let parse_blocks lines =
50
Added:
let is_boundary line =
51
Added:
is_boundary_common line
52
Added:
|| Option.is_some (heading line)
53
Added:
|| Option.is_some (fence line)
54
Added:
in
55
Added:
let rec take_paragraph collected = function
56
Added:
| line :: _ as rest when is_boundary line -> (List.rev collected, rest)
57
Added:
| line :: rest -> take_paragraph (String.trim line :: collected) rest
58
Added:
| [] -> (List.rev collected, [])
59
Added:
in
60
Added:
let rec take_unordered collected = function
61
Added:
| line :: rest -> (
62
Added:
match unordered_item line with
63
Added:
| Some first_line ->
64
Added:
let continuations, rest = Format.take_continuations rest in
65
Added:
let item = String.concat " " (first_line :: continuations) in
66
Added:
take_unordered (item :: collected) rest
67
Added:
| None -> (List.rev collected, line :: rest))
68
Added:
| [] -> (List.rev collected, [])
69
Added:
in
70
Added:
let rec take_ordered collected = function
71
Added:
| line :: rest -> (
72
Added:
match ordered_item line with
73
Added:
| Some first_line ->
74
Added:
let continuations, rest = Format.take_continuations rest in
75
Added:
let item = String.concat " " (first_line :: continuations) in
76
Added:
take_ordered (item :: collected) rest
77
Added:
| None -> (List.rev collected, line :: rest))
78
Added:
| [] -> (List.rev collected, [])
79
Added:
in
80
Added:
let open Format in
81
Added:
let rec loop blocks = function
82
Added:
| [] -> List.rev blocks
83
Added:
| line :: rest when String.trim line = "" -> loop blocks rest
84
Added:
| line :: rest -> (
85
Added:
match heading line with
86
Added:
| Some (level, text) -> loop (Heading (level, text) :: blocks) rest
87
Added:
| None -> (
88
Added:
match fence line with
89
Added:
| Some (marker, language) ->
90
Added:
let lines, rest =
91
Added:
Format.take_until
92
Added:
(fun candidate ->
93
Added:
String.starts_with ~prefix:marker (String.trim candidate))
94
Added:
[] rest
95
Added:
in
96
Added:
loop
97
Added:
(Code_block (language, String.concat "\n" lines) :: blocks)
98
Added:
rest
99
Added:
| None -> (
100
Added:
match unordered_item line with
101
Added:
| Some _ ->
102
Added:
let items, rest = take_unordered [] (line :: rest) in
103
Added:
loop (Unordered_list items :: blocks) rest
104
Added:
| None -> (
105
Added:
match ordered_item line with
106
Added:
| Some _ ->
107
Added:
let items, rest = take_ordered [] (line :: rest) in
108
Added:
loop (Ordered_list items :: blocks) rest
109
Added:
| None ->
110
Added:
let paragraph, rest =
111
Added:
take_paragraph [] (line :: rest)
112
Added:
in
113
Added:
loop
114
Added:
(Paragraph (String.concat " " paragraph) :: blocks)
115
Added:
rest))))
116
Added:
in
117
Added:
loop [] lines
118
Added:
119
Added:
(* {1 Format definition} *)
120
Added:
121
Added:
let format : Format.format =
122
Added:
{
123
Added:
name = "markdown";
124
Added:
css_class = "readme-document readme-markdown";
125
Added:
parse =
126
Added:
(fun content ->
127
Added:
let lines = String.split_on_char '\n' content in
128
Added:
{ Format.title = None; metadata = []; blocks = parse_blocks lines });
129
Added:
inline = (fun text -> [ Ui.text text ]);
130
Added:
}
lib/prose/markdown.mli
@@ -0,0 +1,8 @@
1
Added:
(** Markdown documentation format.
2
Added:
3
Added:
Parses ATX headings, fenced code blocks, unordered and ordered lists, and
4
Added:
paragraphs. Inline markup is passed through as plain text. *)
5
Added:
6
Added:
val format : Format.format
7
Added:
(** The Markdown format descriptor. Used as the default for README files and
8
Added:
[.md] / [.markdown] extensions. *)
lib/prose/mld.ml
@@ -0,0 +1,162 @@
1
Added:
(** Mld (ocamldoc) documentation format.
2
Added:
3
Added:
Parses section headings, code blocks, and paragraphs. Inline markup handles
4
Added:
bold, italic, emphasis, and code spans. *)
5
Added:
6
Added:
(* {1 Line classifiers} *)
7
Added:
8
Added:
let heading line =
9
Added:
let trimmed = String.trim line in
10
Added:
let len = String.length trimmed in
11
Added:
if len < 4 || trimmed.[0] <> '{' then None
12
Added:
else
13
Added:
match trimmed.[1] with
14
Added:
| '0' .. '6' when len > 3 && trimmed.[2] = ' ' ->
15
Added:
let level = Char.code trimmed.[1] - Char.code '0' in
16
Added:
let text_start = 3 in
17
Added:
let text_end = if trimmed.[len - 1] = '}' then len - 1 else len in
18
Added:
let text =
19
Added:
String.sub trimmed text_start (text_end - text_start) |> String.trim
20
Added:
in
21
Added:
Some (max 1 level, text)
22
Added:
| _ -> None
23
Added:
24
Added:
let code_block_open line =
25
Added:
let trimmed = String.trim line in
26
Added:
if String.starts_with ~prefix:"{[" trimmed then
27
Added:
let rest = String.sub trimmed 2 (String.length trimmed - 2) in
28
Added:
if
29
Added:
String.length rest > 0
30
Added:
&& rest.[String.length rest - 1] = ']'
31
Added:
&& String.length rest > 1
32
Added:
&& rest.[String.length rest - 2] = '}'
33
Added:
then
34
Added:
(* Single-line code block: {[code]} on one line *)
35
Added:
None
36
Added:
else Some rest
37
Added:
else None
38
Added:
39
Added:
let code_block_single line =
40
Added:
let trimmed = String.trim line in
41
Added:
let len = String.length trimmed in
42
Added:
if
43
Added:
len >= 4
44
Added:
&& String.starts_with ~prefix:"{[" trimmed
45
Added:
&& trimmed.[len - 2] = ']'
46
Added:
&& trimmed.[len - 1] = '}'
47
Added:
then Some (String.sub trimmed 2 (len - 4))
48
Added:
else None
49
Added:
50
Added:
let is_code_block_close line =
51
Added:
let trimmed = String.trim line in
52
Added:
String.length trimmed >= 2
53
Added:
&& trimmed.[String.length trimmed - 2] = ']'
54
Added:
&& trimmed.[String.length trimmed - 1] = '}'
55
Added:
56
Added:
(* {1 Block parsing} *)
57
Added:
58
Added:
let parse_blocks lines =
59
Added:
let is_boundary line =
60
Added:
String.trim line = ""
61
Added:
|| Option.is_some (heading line)
62
Added:
|| Option.is_some (code_block_open line)
63
Added:
|| Option.is_some (code_block_single line)
64
Added:
in
65
Added:
let rec take_paragraph collected = function
66
Added:
| line :: _ as rest when is_boundary line -> (List.rev collected, rest)
67
Added:
| line :: rest -> take_paragraph (String.trim line :: collected) rest
68
Added:
| [] -> (List.rev collected, [])
69
Added:
in
70
Added:
let open Format in
71
Added:
let rec loop blocks = function
72
Added:
| [] -> List.rev blocks
73
Added:
| line :: rest when String.trim line = "" -> loop blocks rest
74
Added:
| line :: rest -> (
75
Added:
match heading line with
76
Added:
| Some (level, text) -> loop (Heading (level, text) :: blocks) rest
77
Added:
| None -> (
78
Added:
match code_block_single line with
79
Added:
| Some code -> loop (Code_block (None, code) :: blocks) rest
80
Added:
| None -> (
81
Added:
match code_block_open line with
82
Added:
| Some first_line ->
83
Added:
let code_lines, rest =
84
Added:
Format.take_until is_code_block_close [] rest
85
Added:
in
86
Added:
let all_lines =
87
Added:
if first_line = "" then code_lines
88
Added:
else first_line :: code_lines
89
Added:
in
90
Added:
let code = String.concat "\n" all_lines in
91
Added:
loop (Code_block (None, code) :: blocks) rest
92
Added:
| None ->
93
Added:
let paragraph, rest = take_paragraph [] (line :: rest) in
94
Added:
loop
95
Added:
(Paragraph (String.concat " " paragraph) :: blocks)
96
Added:
rest)))
97
Added:
in
98
Added:
loop [] lines
99
Added:
100
Added:
(* {1 Inline markup} *)
101
Added:
102
Added:
let inline text =
103
Added:
let len = String.length text in
104
Added:
let buf = Buffer.create 64 in
105
Added:
let nodes = ref [] in
106
Added:
let flush () =
107
Added:
if Buffer.length buf > 0 then (
108
Added:
nodes := Ui.text (Buffer.contents buf) :: !nodes;
109
Added:
Buffer.clear buf)
110
Added:
in
111
Added:
let rec loop i =
112
Added:
if i >= len then flush ()
113
Added:
else
114
Added:
match text.[i] with
115
Added:
| '{' when i + 1 < len -> (
116
Added:
match text.[i + 1] with
117
Added:
| ('b' | 'i' | 'e') when i + 2 < len && text.[i + 2] = ' ' ->
118
Added:
flush ();
119
Added:
let close = find_brace_close (i + 3) 1 in
120
Added:
let content = String.sub text (i + 3) (close - i - 3) in
121
Added:
nodes :=
122
Added:
Ui.inline ~class_:"readme-emphasis" [ Ui.text content ]
123
Added:
:: !nodes;
124
Added:
loop (close + 1)
125
Added:
| '[' ->
126
Added:
flush ();
127
Added:
let close = find_code_close (i + 2) in
128
Added:
let content = String.sub text (i + 2) (close - i - 2) in
129
Added:
nodes := Ui.code_inline ~class_:"readme-code" content :: !nodes;
130
Added:
loop (close + 2)
131
Added:
| _ ->
132
Added:
Buffer.add_char buf '{';
133
Added:
loop (i + 1))
134
Added:
| c ->
135
Added:
Buffer.add_char buf c;
136
Added:
loop (i + 1)
137
Added:
and find_brace_close start depth =
138
Added:
if start >= len then len
139
Added:
else if text.[start] = '}' then
140
Added:
if depth <= 1 then start else find_brace_close (start + 1) (depth - 1)
141
Added:
else if text.[start] = '{' then find_brace_close (start + 1) (depth + 1)
142
Added:
else find_brace_close (start + 1) depth
143
Added:
and find_code_close start =
144
Added:
if start + 1 >= len then len
145
Added:
else if text.[start] = ']' && text.[start + 1] = '}' then start
146
Added:
else find_code_close (start + 1)
147
Added:
in
148
Added:
loop 0;
149
Added:
List.rev !nodes
150
Added:
151
Added:
(* {1 Format definition} *)
152
Added:
153
Added:
let format : Format.format =
154
Added:
{
155
Added:
name = "mld";
156
Added:
css_class = "readme-document readme-mld";
157
Added:
parse =
158
Added:
(fun content ->
159
Added:
let lines = String.split_on_char '\n' content in
160
Added:
{ Format.title = None; metadata = []; blocks = parse_blocks lines });
161
Added:
inline;
162
Added:
}
lib/prose/mld.mli
@@ -0,0 +1,7 @@
1
Added:
(** Mld (ocamldoc) documentation format.
2
Added:
3
Added:
Parses section headings, code blocks, and paragraphs. Inline markup handles
4
Added:
bold, italic, emphasis, and code spans. *)
5
Added:
6
Added:
val format : Format.format
7
Added:
(** The mld format descriptor, for [.mld] files. *)
lib/prose/org.ml
@@ -0,0 +1,291 @@
1
Added:
(** Org mode documentation format.
2
Added:
3
Added:
Parses Org headings, #+BEGIN_SRC blocks, metadata directives, unordered,
4
Added:
ordered, and definition lists, and paragraphs. Inline markup handles
5
Added:
=verbatim=, ~code~, and [[link][desc]] syntax. *)
6
Added:
7
Added:
(* {1 Inline markup} *)
8
Added:
9
Added:
let org_inline text =
10
Added:
let len = String.length text in
11
Added:
let buf = Buffer.create 64 in
12
Added:
let nodes = ref [] in
13
Added:
let flush () =
14
Added:
if Buffer.length buf > 0 then (
15
Added:
nodes := Ui.text (Buffer.contents buf) :: !nodes;
16
Added:
Buffer.clear buf)
17
Added:
in
18
Added:
let rec loop i =
19
Added:
if i >= len then flush ()
20
Added:
else
21
Added:
match text.[i] with
22
Added:
| '[' when i + 1 < len && text.[i + 1] = '[' ->
23
Added:
flush ();
24
Added:
parse_link (i + 2)
25
Added:
| ('=' | '~') as marker -> (
26
Added:
let close = find_close marker (i + 1) in
27
Added:
match close with
28
Added:
| Some end_pos ->
29
Added:
flush ();
30
Added:
let content = String.sub text (i + 1) (end_pos - i - 1) in
31
Added:
let node =
32
Added:
match marker with
33
Added:
| '~' -> Ui.code_inline ~class_:"readme-code" content
34
Added:
| _ -> Ui.inline ~class_:"readme-verbatim" [ Ui.text content ]
35
Added:
in
36
Added:
nodes := node :: !nodes;
37
Added:
loop (end_pos + 1)
38
Added:
| None ->
39
Added:
Buffer.add_char buf text.[i];
40
Added:
loop (i + 1))
41
Added:
| c ->
42
Added:
Buffer.add_char buf c;
43
Added:
loop (i + 1)
44
Added:
and find_close marker start =
45
Added:
let rec search j =
46
Added:
if j >= len then None
47
Added:
else if text.[j] = marker then Some j
48
Added:
else if text.[j] = '\n' then None
49
Added:
else search (j + 1)
50
Added:
in
51
Added:
if start >= len then None else search start
52
Added:
and parse_link start =
53
Added:
let rec find_end j _depth =
54
Added:
if j >= len then None
55
Added:
else if j + 1 < len && text.[j] = ']' && text.[j + 1] = ']' then Some j
56
Added:
else find_end (j + 1) 0
57
Added:
in
58
Added:
match find_end start 0 with
59
Added:
| None ->
60
Added:
Buffer.add_string buf "[[";
61
Added:
loop start
62
Added:
| Some close_pos ->
63
Added:
let inner = String.sub text start (close_pos - start) in
64
Added:
let href, desc =
65
Added:
match String.index_opt inner ']' with
66
Added:
| Some bracket_pos
67
Added:
when bracket_pos + 1 < String.length inner
68
Added:
&& inner.[bracket_pos + 1] = '[' ->
69
Added:
let href = String.sub inner 0 bracket_pos in
70
Added:
let desc =
71
Added:
String.sub inner (bracket_pos + 2)
72
Added:
(String.length inner - bracket_pos - 2)
73
Added:
in
74
Added:
(href, desc)
75
Added:
| _ -> (inner, inner)
76
Added:
in
77
Added:
let node = Ui.link ~class_:"readme-link" ~href [ Ui.text desc ] in
78
Added:
nodes := node :: !nodes;
79
Added:
loop (close_pos + 2)
80
Added:
in
81
Added:
loop 0;
82
Added:
List.rev !nodes
83
Added:
84
Added:
(* {1 Line classifiers} *)
85
Added:
86
Added:
let heading line =
87
Added:
let length = String.length line in
88
Added:
let rec count_stars index =
89
Added:
if index < length && line.[index] = '*' then count_stars (index + 1)
90
Added:
else index
91
Added:
in
92
Added:
let level = count_stars 0 in
93
Added:
if level = 0 || level >= length || line.[level] <> ' ' then None
94
Added:
else
95
Added:
Some
96
Added:
( min 6 level,
97
Added:
String.sub line (level + 1) (length - level - 1) |> String.trim )
98
Added:
99
Added:
let unordered_item = Format.unordered_item
100
Added:
let ordered_item = Format.ordered_item
101
Added:
102
Added:
let definition_item line =
103
Added:
let trimmed = String.trim line in
104
Added:
let tlen = String.length trimmed in
105
Added:
if tlen < 2 || trimmed.[0] <> '-' || trimmed.[1] <> ' ' then None
106
Added:
else
107
Added:
let rest = String.sub trimmed 2 (tlen - 2) in
108
Added:
let rec find_sep i =
109
Added:
if i + 3 >= String.length rest then None
110
Added:
else if
111
Added:
rest.[i] = ' '
112
Added:
&& rest.[i + 1] = ':'
113
Added:
&& rest.[i + 2] = ':'
114
Added:
&& rest.[i + 3] = ' '
115
Added:
then
116
Added:
let term = String.sub rest 0 i |> String.trim in
117
Added:
let desc =
118
Added:
String.sub rest (i + 4) (String.length rest - i - 4) |> String.trim
119
Added:
in
120
Added:
Some (term, desc)
121
Added:
else find_sep (i + 1)
122
Added:
in
123
Added:
find_sep 0
124
Added:
125
Added:
let src_begin line =
126
Added:
let prefix = "#+begin_src" in
127
Added:
let lower = String.lowercase_ascii (String.trim line) in
128
Added:
if not (String.starts_with ~prefix lower) then None
129
Added:
else
130
Added:
let language =
131
Added:
String.sub lower (String.length prefix)
132
Added:
(String.length lower - String.length prefix)
133
Added:
|> String.trim |> Format.first_word
134
Added:
in
135
Added:
Some language
136
Added:
137
Added:
let is_src_end line =
138
Added:
String.trim line |> String.lowercase_ascii
139
Added:
|> String.starts_with ~prefix:"#+end_src"
140
Added:
141
Added:
let is_example_begin line =
142
Added:
String.trim line |> String.lowercase_ascii
143
Added:
|> String.starts_with ~prefix:"#+begin_example"
144
Added:
145
Added:
let is_example_end line =
146
Added:
String.trim line |> String.lowercase_ascii
147
Added:
|> String.starts_with ~prefix:"#+end_example"
148
Added:
149
Added:
(* {1 Block parsing} *)
150
Added:
151
Added:
let is_boundary_common line =
152
Added:
Format.is_boundary_common line || Option.is_some (definition_item line)
153
Added:
154
Added:
let parse_blocks lines =
155
Added:
let is_boundary line =
156
Added:
is_boundary_common line
157
Added:
|| Option.is_some (heading line)
158
Added:
|| Option.is_some (src_begin line)
159
Added:
|| is_example_begin line
160
Added:
in
161
Added:
let rec take_paragraph collected = function
162
Added:
| line :: _ as rest when is_boundary line -> (List.rev collected, rest)
163
Added:
| line :: rest -> take_paragraph (String.trim line :: collected) rest
164
Added:
| [] -> (List.rev collected, [])
165
Added:
in
166
Added:
let rec take_unordered collected = function
167
Added:
| line :: rest -> (
168
Added:
match unordered_item line with
169
Added:
| Some first_line ->
170
Added:
let continuations, rest = Format.take_continuations rest in
171
Added:
let item = String.concat " " (first_line :: continuations) in
172
Added:
take_unordered (item :: collected) rest
173
Added:
| None -> (List.rev collected, line :: rest))
174
Added:
| [] -> (List.rev collected, [])
175
Added:
in
176
Added:
let rec take_ordered collected = function
177
Added:
| line :: rest -> (
178
Added:
match ordered_item line with
179
Added:
| Some first_line ->
180
Added:
let continuations, rest = Format.take_continuations rest in
181
Added:
let item = String.concat " " (first_line :: continuations) in
182
Added:
take_ordered (item :: collected) rest
183
Added:
| None -> (List.rev collected, line :: rest))
184
Added:
| [] -> (List.rev collected, [])
185
Added:
in
186
Added:
let rec take_definitions collected = function
187
Added:
| line :: rest -> (
188
Added:
match definition_item line with
189
Added:
| Some (term, first_desc) ->
190
Added:
let continuations, rest = Format.take_continuations rest in
191
Added:
let desc = String.concat " " (first_desc :: continuations) in
192
Added:
take_definitions ((term, desc) :: collected) rest
193
Added:
| None -> (List.rev collected, line :: rest))
194
Added:
| [] -> (List.rev collected, [])
195
Added:
in
196
Added:
let open Format in
197
Added:
let rec loop blocks = function
198
Added:
| [] -> List.rev blocks
199
Added:
| line :: rest when String.trim line = "" -> loop blocks rest
200
Added:
| line :: rest -> (
201
Added:
match heading line with
202
Added:
| Some (level, text) -> loop (Heading (level, text) :: blocks) rest
203
Added:
| None -> (
204
Added:
match src_begin line with
205
Added:
| Some language ->
206
Added:
let lines, rest = Format.take_until is_src_end [] rest in
207
Added:
loop
208
Added:
(Code_block (language, String.concat "\n" lines) :: blocks)
209
Added:
rest
210
Added:
| None when is_example_begin line ->
211
Added:
let lines, rest = Format.take_until is_example_end [] rest in
212
Added:
loop
213
Added:
(Code_block (None, String.concat "\n" lines) :: blocks)
214
Added:
rest
215
Added:
| None -> (
216
Added:
match definition_item line with
217
Added:
| Some _ ->
218
Added:
let items, rest = take_definitions [] (line :: rest) in
219
Added:
loop (Definition_list items :: blocks) rest
220
Added:
| None -> (
221
Added:
match unordered_item line with
222
Added:
| Some _ ->
223
Added:
let items, rest = take_unordered [] (line :: rest) in
224
Added:
loop (Unordered_list items :: blocks) rest
225
Added:
| None -> (
226
Added:
match ordered_item line with
227
Added:
| Some _ ->
228
Added:
let items, rest = take_ordered [] (line :: rest) in
229
Added:
loop (Ordered_list items :: blocks) rest
230
Added:
| None ->
231
Added:
let paragraph, rest =
232
Added:
take_paragraph [] (line :: rest)
233
Added:
in
234
Added:
loop
235
Added:
(Paragraph (String.concat " " paragraph) :: blocks)
236
Added:
rest)))))
237
Added:
in
238
Added:
loop [] lines
239
Added:
240
Added:
(* {1 Org metadata} *)
241
Added:
242
Added:
let metadata_line line =
243
Added:
let prefix = "#+" in
244
Added:
let line = String.trim line in
245
Added:
if not (String.starts_with ~prefix line) then None
246
Added:
else
247
Added:
match String.index_opt line ':' with
248
Added:
| None -> None
249
Added:
| Some colon ->
250
Added:
let key = String.sub line 2 (colon - 2) |> String.lowercase_ascii in
251
Added:
let value =
252
Added:
String.sub line (colon + 1) (String.length line - colon - 1)
253
Added:
|> String.trim
254
Added:
in
255
Added:
if List.mem key [ "title"; "author"; "date"; "email"; "language" ] then
256
Added:
Some (key, value)
257
Added:
else None
258
Added:
259
Added:
let split_metadata lines =
260
Added:
List.fold_left
261
Added:
(fun (metadata, body) line ->
262
Added:
match metadata_line line with
263
Added:
| None -> (metadata, line :: body)
264
Added:
| Some entry -> (entry :: metadata, body))
265
Added:
([], []) lines
266
Added:
|> fun (metadata, body) -> (List.rev metadata, List.rev body)
267
Added:
268
Added:
(* {1 Format definition} *)
269
Added:
270
Added:
let format : Format.format =
271
Added:
{
272
Added:
name = "org";
273
Added:
css_class = "readme-document readme-org";
274
Added:
parse =
275
Added:
(fun content ->
276
Added:
let lines = String.split_on_char '\n' content in
277
Added:
let metadata, lines = split_metadata lines in
278
Added:
let title =
279
Added:
List.find_opt (fun (key, _) -> key = "title") metadata
280
Added:
|> Option.map snd
281
Added:
in
282
Added:
let metadata_entries =
283
Added:
List.filter (fun (key, _) -> key <> "title") metadata
284
Added:
in
285
Added:
{
286
Added:
Format.title;
287
Added:
metadata = metadata_entries;
288
Added:
blocks = parse_blocks lines;
289
Added:
});
290
Added:
inline = org_inline;
291
Added:
}
lib/prose/org.mli
@@ -0,0 +1,8 @@
1
Added:
(** Org mode documentation format.
2
Added:
3
Added:
Parses Org headings, [#+BEGIN_SRC] blocks, metadata directives, unordered,
4
Added:
ordered, and definition lists, and paragraphs. Inline markup handles
5
Added:
[=verbatim=], [~code~], and [[[link][desc]]] syntax. *)
6
Added:
7
Added:
val format : Format.format
8
Added:
(** The Org mode format descriptor, for [.org] files. *)
lib/prose/plaintext.ml
@@ -0,0 +1,21 @@
1
Added:
(** Plain text documentation format.
2
Added:
3
Added:
Each non-blank line becomes a paragraph. No inline markup is applied. *)
4
Added:
5
Added:
let format : Format.format =
6
Added:
{
7
Added:
name = "plaintext";
8
Added:
css_class = "readme-document readme-plaintext";
9
Added:
parse =
10
Added:
(fun content ->
11
Added:
let lines = String.split_on_char '\n' content in
12
Added:
let blocks =
13
Added:
List.filter_map
14
Added:
(fun line ->
15
Added:
let trimmed = String.trim line in
16
Added:
if trimmed = "" then None else Some (Format.Paragraph trimmed))
17
Added:
lines
18
Added:
in
19
Added:
{ Format.title = None; metadata = []; blocks });
20
Added:
inline = (fun text -> [ Ui.text text ]);
21
Added:
}
lib/prose/prose.ml
@@ -1,25 +0,0 @@
1
Removed:
(** Prose rendering façade.
2
Removed:
3
Removed:
Detects documentation formats by filename extension and renders content as
4
Removed:
styled HTML. This module is the single entry point for prose rendering
5
Removed:
throughout ogit. *)
6
Removed:
7
Removed:
let is_readme_filename filename =
8
Removed:
Filename.basename filename |> String.lowercase_ascii
9
Removed:
|> String.starts_with ~prefix:"readme"
10
Removed:
11
Removed:
let is_doc_filename filename =
12
Removed:
match Filename.extension filename |> String.lowercase_ascii with
13
Removed:
| ".md" | ".markdown" | ".org" | ".mld" | ".txt" -> true
14
Removed:
| _ -> false
15
Removed:
16
Removed:
let format_of_filename filename =
17
Removed:
match Filename.extension filename |> String.lowercase_ascii with
18
Removed:
| ".org" -> Prose_org.format
19
Removed:
| ".mld" -> Prose_mld.format
20
Removed:
| ".txt" -> Prose_plaintext.format
21
Removed:
| _ -> Prose_markdown.format
22
Removed:
23
Removed:
let render ~filename content =
24
Removed:
let format = format_of_filename filename in
25
Removed:
Prose_format.render format content
lib/prose/prose.mli
@@ -1,16 +0,0 @@
1
Removed:
(** Prose rendering facade.
2
Removed:
3
Removed:
Detects documentation formats by filename extension and renders content as
4
Removed:
styled HTML. This module is the single entry point for prose rendering
5
Removed:
throughout ogit. *)
6
Removed:
7
Removed:
val is_readme_filename : string -> bool
8
Removed:
(** [true] when the filename starts with "readme" (case-insensitive). *)
9
Removed:
10
Removed:
val is_doc_filename : string -> bool
11
Removed:
(** [true] when the extension indicates a renderable documentation format (.md,
12
Removed:
.markdown, .org, .mld, .txt). *)
13
Removed:
14
Removed:
val render : filename:string -> string -> Ui.node
15
Removed:
(** [render ~filename content] detects the format from the extension and
16
Removed:
produces a styled HTML region. *)
lib/prose/prose_format.ml
@@ -1,218 +0,0 @@
1
Removed:
(** Shared document AST and renderer for prose formats.
2
Removed:
3
Removed:
Format-specific parsing is supplied by the {!format} type; the renderer, TOC
4
Removed:
generation, and anchor management are format-independent.
5
Removed:
6
Removed:
Every text fragment is emitted through {!Ui}, ensuring safe escaping of
7
Removed:
repository content. *)
8
Removed:
9
Removed:
(* {1 Document AST} *)
10
Removed:
11
Removed:
type inline =
12
Removed:
| Text of string
13
Removed:
| Code of string
14
Removed:
| Verbatim of string
15
Removed:
| Link of { href : string; text : string }
16
Removed:
17
Removed:
type block =
18
Removed:
| Heading of int * string
19
Removed:
| Paragraph of string
20
Removed:
| Unordered_list of string list
21
Removed:
| Ordered_list of string list
22
Removed:
| Definition_list of (string * string) list
23
Removed:
| Code_block of string option * string
24
Removed:
25
Removed:
type document = {
26
Removed:
title : string option;
27
Removed:
metadata : (string * string) list;
28
Removed:
blocks : block list;
29
Removed:
}
30
Removed:
31
Removed:
(* {1 Format interface} *)
32
Removed:
33
Removed:
type format = {
34
Removed:
name : string;
35
Removed:
css_class : string;
36
Removed:
parse : string -> document;
37
Removed:
inline : string -> Ui.node list;
38
Removed:
}
39
Removed:
(** A documentation format provides parsing and inline markup rendering. *)
40
Removed:
41
Removed:
(* {1 Shared utilities} *)
42
Removed:
43
Removed:
let first_word text =
44
Removed:
match
45
Removed:
String.split_on_char ' ' text |> List.filter (fun word -> word <> "")
46
Removed:
with
47
Removed:
| word :: _ -> Some word
48
Removed:
| [] -> None
49
Removed:
50
Removed:
(** A continuation line belongs to the current list item if it is indented
51
Removed:
(starts with whitespace) and is not blank. *)
52
Removed:
let is_continuation line =
53
Removed:
String.length line > 0
54
Removed:
&& (line.[0] = ' ' || line.[0] = '\t')
55
Removed:
&& String.trim line <> ""
56
Removed:
57
Removed:
let take_continuations rest =
58
Removed:
let rec loop acc = function
59
Removed:
| line :: rest when is_continuation line ->
60
Removed:
loop (String.trim line :: acc) rest
61
Removed:
| remaining -> (List.rev acc, remaining)
62
Removed:
in
63
Removed:
loop [] rest
64
Removed:
65
Removed:
let rec take_until close collected = function
66
Removed:
| [] -> (List.rev collected, [])
67
Removed:
| line :: rest when close line -> (List.rev collected, rest)
68
Removed:
| line :: rest -> take_until close (line :: collected) rest
69
Removed:
70
Removed:
(* {1 Shared list-item classifiers} *)
71
Removed:
72
Removed:
(** Recognise an unordered list item ([-], [+], or indented [*]). *)
73
Removed:
let unordered_item line =
74
Removed:
let length = String.length line in
75
Removed:
let trimmed = String.trim line in
76
Removed:
let tlen = String.length trimmed in
77
Removed:
if tlen >= 2 && List.mem trimmed.[0] [ '-'; '+' ] && trimmed.[1] = ' ' then
78
Removed:
Some (String.sub trimmed 2 (tlen - 2) |> String.trim)
79
Removed:
else if
80
Removed:
tlen >= 2
81
Removed:
&& trimmed.[0] = '*'
82
Removed:
&& trimmed.[1] = ' '
83
Removed:
&& length > 0
84
Removed:
&& (line.[0] = ' ' || line.[0] = '\t')
85
Removed:
then Some (String.sub trimmed 2 (tlen - 2) |> String.trim)
86
Removed:
else None
87
Removed:
88
Removed:
(** Recognise an ordered list item ([1.], [2)], etc.). *)
89
Removed:
let ordered_item line =
90
Removed:
let trimmed = String.trim line in
91
Removed:
let tlen = String.length trimmed in
92
Removed:
let rec digits i =
93
Removed:
if i < tlen && trimmed.[i] >= '0' && trimmed.[i] <= '9' then digits (i + 1)
94
Removed:
else i
95
Removed:
in
96
Removed:
let d = digits 0 in
97
Removed:
if d = 0 || d >= tlen then None
98
Removed:
else if
99
Removed:
(trimmed.[d] = '.' || trimmed.[d] = ')')
100
Removed:
&& d + 1 < tlen
101
Removed:
&& trimmed.[d + 1] = ' '
102
Removed:
then Some (String.sub trimmed (d + 2) (tlen - d - 2) |> String.trim)
103
Removed:
else None
104
Removed:
105
Removed:
(** True when a line starts a new block (blank, or a list item). *)
106
Removed:
let is_boundary_common line =
107
Removed:
String.trim line = ""
108
Removed:
|| Option.is_some (unordered_item line)
109
Removed:
|| Option.is_some (ordered_item line)
110
Removed:
111
Removed:
(* {1 Anchor generation} *)
112
Removed:
113
Removed:
let new_anchor () =
114
Removed:
let seen = Hashtbl.create 16 in
115
Removed:
fun text ->
116
Removed:
let base =
117
Removed:
let buffer = Buffer.create (String.length text) in
118
Removed:
let pending_separator = ref false in
119
Removed:
String.iter
120
Removed:
(fun character ->
121
Removed:
if
122
Removed:
(character >= 'a' && character <= 'z')
123
Removed:
|| (character >= 'A' && character <= 'Z')
124
Removed:
|| (character >= '0' && character <= '9')
125
Removed:
then (
126
Removed:
if !pending_separator && Buffer.length buffer > 0 then
127
Removed:
Buffer.add_char buffer '-';
128
Removed:
pending_separator := false;
129
Removed:
Buffer.add_char buffer (Char.lowercase_ascii character))
130
Removed:
else pending_separator := true)
131
Removed:
text;
132
Removed:
if Buffer.length buffer = 0 then "section" else Buffer.contents buffer
133
Removed:
in
134
Removed:
let count = Option.value (Hashtbl.find_opt seen base) ~default:0 + 1 in
135
Removed:
Hashtbl.replace seen base count;
136
Removed:
if count = 1 then base else Printf.sprintf "%s-%d" base count
137
Removed:
138
Removed:
(* {1 Rendering} *)
139
Removed:
140
Removed:
let render_heading anchor level text =
141
Removed:
let id = anchor text in
142
Removed:
Ui.heading ~id ~level ~class_:"readme-heading"
143
Removed:
[ Ui.text_link ~class_:"readme-heading-link" ~href:("#" ^ id) text ]
144
Removed:
145
Removed:
let render_code_block language source =
146
Removed:
let nodes =
147
Removed:
match language with
148
Removed:
| None | Some "" -> [ Ui.text source ]
149
Removed:
| Some language ->
150
Removed:
Highlight.highlight ~lang:(Some language) source |> List.concat
151
Removed:
in
152
Removed:
Ui.code_block ~class_:"readme-code-block" nodes
153
Removed:
154
Removed:
let render_block format anchor = function
155
Removed:
| Heading (level, text) -> render_heading anchor level text
156
Removed:
| Paragraph text ->
157
Removed:
Ui.paragraph ~class_:"readme-paragraph" (format.inline text)
158
Removed:
| Unordered_list items ->
159
Removed:
Ui.items ~class_:"readme-list"
160
Removed:
(List.map (fun item -> Ui.item (format.inline item)) items)
161
Removed:
| Ordered_list items ->
162
Removed:
Ui.ordered_items ~class_:"readme-list readme-ordered-list"
163
Removed:
(List.map (fun item -> Ui.item (format.inline item)) items)
164
Removed:
| Definition_list items ->
165
Removed:
Ui.definitions ~class_:"readme-definition-list"
166
Removed:
(List.map (fun (term, desc) -> (term, format.inline desc)) items)
167
Removed:
| Code_block (language, source) -> render_code_block language source
168
Removed:
169
Removed:
let render_toc ~title_text body_headings =
170
Removed:
let toc_anchor = new_anchor () in
171
Removed:
(match title_text with Some t -> ignore (toc_anchor t) | None -> ());
172
Removed:
(* Build a nested tree from a flat (level, text) list. Headings at a deeper
173
Removed:
level than the current base become children of the preceding entry. *)
174
Removed:
let rec build base_level headings =
175
Removed:
match headings with
176
Removed:
| [] -> ([], [])
177
Removed:
| (level, _) :: _ when level < base_level -> ([], headings)
178
Removed:
| (level, text) :: rest ->
179
Removed:
let id = toc_anchor text in
180
Removed:
let children, rest' = build (level + 1) rest in
181
Removed:
let entry = Ui.toc_entry ~children ~href:("#" ^ id) text in
182
Removed:
let siblings, rest'' = build base_level rest' in
183
Removed:
(entry :: siblings, rest'')
184
Removed:
in
185
Removed:
let min_level =
186
Removed:
List.fold_left (fun acc (l, _) -> min acc l) max_int body_headings
187
Removed:
in
188
Removed:
let entries, _ = build min_level body_headings in
189
Removed:
Ui.toc ~class_:"readme-toc" ~title:"Table of Contents" entries
190
Removed:
191
Removed:
(** Render a document using the given format. *)
192
Removed:
let render format content =
193
Removed:
let doc = format.parse content in
194
Removed:
let body_headings =
195
Removed:
List.filter_map
196
Removed:
(function Heading (level, text) -> Some (level, text) | _ -> None)
197
Removed:
doc.blocks
198
Removed:
in
199
Removed:
let toc = render_toc ~title_text:doc.title body_headings in
200
Removed:
let anchor = new_anchor () in
201
Removed:
let title =
202
Removed:
match doc.title with
203
Removed:
| None -> None
204
Removed:
| Some t -> Some (render_heading anchor 1 t)
205
Removed:
in
206
Removed:
let metadata_node =
207
Removed:
match doc.metadata with
208
Removed:
| [] -> Ui.nothing
209
Removed:
| entries ->
210
Removed:
Ui.definitions ~class_:"readme-org-metadata"
211
Removed:
(List.map
212
Removed:
(fun (key, value) ->
213
Removed:
(String.capitalize_ascii key, [ Ui.text value ]))
214
Removed:
entries)
215
Removed:
in
216
Removed:
Ui.region ~class_:format.css_class
217
Removed:
(Option.to_list title @ [ metadata_node; toc ]
218
Removed:
@ List.map (render_block format anchor) doc.blocks)
lib/prose/prose_format.mli
@@ -1,75 +0,0 @@
1
Removed:
(** Shared document AST and renderer for prose formats.
2
Removed:
3
Removed:
Format-specific parsing is supplied by the {!format} type; the renderer, TOC
4
Removed:
generation, and anchor management are format-independent.
5
Removed:
6
Removed:
Every text fragment is emitted through {!Ui}, ensuring safe escaping of
7
Removed:
repository content. *)
8
Removed:
9
Removed:
(** {1 Document AST} *)
10
Removed:
11
Removed:
type inline =
12
Removed:
| Text of string
13
Removed:
| Code of string
14
Removed:
| Verbatim of string
15
Removed:
| Link of { href : string; text : string } (** Inline markup elements. *)
16
Removed:
17
Removed:
type block =
18
Removed:
| Heading of int * string
19
Removed:
| Paragraph of string
20
Removed:
| Unordered_list of string list
21
Removed:
| Ordered_list of string list
22
Removed:
| Definition_list of (string * string) list
23
Removed:
| Code_block of string option * string (** Block-level document elements. *)
24
Removed:
25
Removed:
type document = {
26
Removed:
title : string option;
27
Removed:
metadata : (string * string) list;
28
Removed:
blocks : block list;
29
Removed:
}
30
Removed:
(** A parsed document with optional title, metadata, and body blocks. *)
31
Removed:
32
Removed:
(** {1 Format interface} *)
33
Removed:
34
Removed:
type format = {
35
Removed:
name : string;
36
Removed:
css_class : string;
37
Removed:
parse : string -> document;
38
Removed:
inline : string -> Ui.node list;
39
Removed:
}
40
Removed:
(** A documentation format provides parsing and inline markup rendering. *)
41
Removed:
42
Removed:
(** {1 Shared utilities} *)
43
Removed:
44
Removed:
val first_word : string -> string option
45
Removed:
(** Extract the first whitespace-delimited word from a string. *)
46
Removed:
47
Removed:
val is_continuation : string -> bool
48
Removed:
(** [true] when a line is indented and non-blank, indicating it continues the
49
Removed:
previous list item. *)
50
Removed:
51
Removed:
val take_continuations : string list -> string list * string list
52
Removed:
(** Split off leading continuation lines from the remaining input. *)
53
Removed:
54
Removed:
val take_until :
55
Removed:
(string -> bool) -> string list -> string list -> string list * string list
56
Removed:
(** [take_until close collected lines] collects lines until [close] returns
57
Removed:
[true], returning the collected lines and the remainder after the closing
58
Removed:
line. *)
59
Removed:
60
Removed:
(** {1 Shared list-item classifiers} *)
61
Removed:
62
Removed:
val unordered_item : string -> string option
63
Removed:
(** Recognise an unordered list item ([-], [+], or indented [*]). *)
64
Removed:
65
Removed:
val ordered_item : string -> string option
66
Removed:
(** Recognise an ordered list item ([1.], [2)], etc.). *)
67
Removed:
68
Removed:
val is_boundary_common : string -> bool
69
Removed:
(** [true] when a line starts a new block (blank, or a list item). *)
70
Removed:
71
Removed:
(** {1 Rendering} *)
72
Removed:
73
Removed:
val render : format -> string -> Ui.node
74
Removed:
(** Render document content using the given format. Handles parsing, TOC
75
Removed:
generation, and block rendering. *)
lib/prose/prose_markdown.ml
@@ -1,134 +0,0 @@
1
Removed:
(** Markdown documentation format.
2
Removed:
3
Removed:
Parses ATX headings, fenced code blocks, unordered and ordered lists, and
4
Removed:
paragraphs. Inline markup is passed through as plain text. *)
5
Removed:
6
Removed:
(* {1 Line classifiers} *)
7
Removed:
8
Removed:
let trim_end_hashes text =
9
Removed:
let text = String.trim text in
10
Removed:
let rec last_non_hash index =
11
Removed:
if index < 0 || text.[index] <> '#' then index else last_non_hash (index - 1)
12
Removed:
in
13
Removed:
let last = last_non_hash (String.length text - 1) in
14
Removed:
String.sub text 0 (last + 1) |> String.trim
15
Removed:
16
Removed:
let heading line =
17
Removed:
let length = String.length line in
18
Removed:
let rec count_hashes index =
19
Removed:
if index < length && line.[index] = '#' then count_hashes (index + 1)
20
Removed:
else index
21
Removed:
in
22
Removed:
let level = count_hashes 0 in
23
Removed:
if level = 0 || level > 6 || level >= length || line.[level] <> ' ' then None
24
Removed:
else
25
Removed:
Some
26
Removed:
( level,
27
Removed:
String.sub line (level + 1) (length - level - 1) |> trim_end_hashes )
28
Removed:
29
Removed:
let unordered_item = Prose_format.unordered_item
30
Removed:
let ordered_item = Prose_format.ordered_item
31
Removed:
32
Removed:
let fence line =
33
Removed:
let line = String.trim line in
34
Removed:
if String.length line < 3 then None
35
Removed:
else
36
Removed:
let marker = String.sub line 0 3 in
37
Removed:
if marker <> "```" && marker <> "~~~" then None
38
Removed:
else
39
Removed:
let language =
40
Removed:
String.sub line 3 (String.length line - 3)
41
Removed:
|> String.trim |> Prose_format.first_word
42
Removed:
in
43
Removed:
Some (marker, language)
44
Removed:
45
Removed:
(* {1 Block parsing} *)
46
Removed:
47
Removed:
let is_boundary_common = Prose_format.is_boundary_common
48
Removed:
49
Removed:
let parse_blocks lines =
50
Removed:
let is_boundary line =
51
Removed:
is_boundary_common line
52
Removed:
|| Option.is_some (heading line)
53
Removed:
|| Option.is_some (fence line)
54
Removed:
in
55
Removed:
let rec take_paragraph collected = function
56
Removed:
| line :: _ as rest when is_boundary line -> (List.rev collected, rest)
57
Removed:
| line :: rest -> take_paragraph (String.trim line :: collected) rest
58
Removed:
| [] -> (List.rev collected, [])
59
Removed:
in
60
Removed:
let rec take_unordered collected = function
61
Removed:
| line :: rest -> (
62
Removed:
match unordered_item line with
63
Removed:
| Some first_line ->
64
Removed:
let continuations, rest = Prose_format.take_continuations rest in
65
Removed:
let item = String.concat " " (first_line :: continuations) in
66
Removed:
take_unordered (item :: collected) rest
67
Removed:
| None -> (List.rev collected, line :: rest))
68
Removed:
| [] -> (List.rev collected, [])
69
Removed:
in
70
Removed:
let rec take_ordered collected = function
71
Removed:
| line :: rest -> (
72
Removed:
match ordered_item line with
73
Removed:
| Some first_line ->
74
Removed:
let continuations, rest = Prose_format.take_continuations rest in
75
Removed:
let item = String.concat " " (first_line :: continuations) in
76
Removed:
take_ordered (item :: collected) rest
77
Removed:
| None -> (List.rev collected, line :: rest))
78
Removed:
| [] -> (List.rev collected, [])
79
Removed:
in
80
Removed:
let open Prose_format in
81
Removed:
let rec loop blocks = function
82
Removed:
| [] -> List.rev blocks
83
Removed:
| line :: rest when String.trim line = "" -> loop blocks rest
84
Removed:
| line :: rest -> (
85
Removed:
match heading line with
86
Removed:
| Some (level, text) -> loop (Heading (level, text) :: blocks) rest
87
Removed:
| None -> (
88
Removed:
match fence line with
89
Removed:
| Some (marker, language) ->
90
Removed:
let lines, rest =
91
Removed:
Prose_format.take_until
92
Removed:
(fun candidate ->
93
Removed:
String.starts_with ~prefix:marker (String.trim candidate))
94
Removed:
[] rest
95
Removed:
in
96
Removed:
loop
97
Removed:
(Code_block (language, String.concat "\n" lines) :: blocks)
98
Removed:
rest
99
Removed:
| None -> (
100
Removed:
match unordered_item line with
101
Removed:
| Some _ ->
102
Removed:
let items, rest = take_unordered [] (line :: rest) in
103
Removed:
loop (Unordered_list items :: blocks) rest
104
Removed:
| None -> (
105
Removed:
match ordered_item line with
106
Removed:
| Some _ ->
107
Removed:
let items, rest = take_ordered [] (line :: rest) in
108
Removed:
loop (Ordered_list items :: blocks) rest
109
Removed:
| None ->
110
Removed:
let paragraph, rest =
111
Removed:
take_paragraph [] (line :: rest)
112
Removed:
in
113
Removed:
loop
114
Removed:
(Paragraph (String.concat " " paragraph) :: blocks)
115
Removed:
rest))))
116
Removed:
in
117
Removed:
loop [] lines
118
Removed:
119
Removed:
(* {1 Format definition} *)
120
Removed:
121
Removed:
let format : Prose_format.format =
122
Removed:
{
123
Removed:
name = "markdown";
124
Removed:
css_class = "readme-document readme-markdown";
125
Removed:
parse =
126
Removed:
(fun content ->
127
Removed:
let lines = String.split_on_char '\n' content in
128
Removed:
{
129
Removed:
Prose_format.title = None;
130
Removed:
metadata = [];
131
Removed:
blocks = parse_blocks lines;
132
Removed:
});
133
Removed:
inline = (fun text -> [ Ui.text text ]);
134
Removed:
}
lib/prose/prose_markdown.mli
@@ -1,8 +0,0 @@
1
Removed:
(** Markdown documentation format.
2
Removed:
3
Removed:
Parses ATX headings, fenced code blocks, unordered and ordered lists, and
4
Removed:
paragraphs. Inline markup is passed through as plain text. *)
5
Removed:
6
Removed:
val format : Prose_format.format
7
Removed:
(** The Markdown format descriptor. Used as the default for README files and
8
Removed:
[.md] / [.markdown] extensions. *)
lib/prose/prose_mld.ml
@@ -1,166 +0,0 @@
1
Removed:
(** Mld (ocamldoc) documentation format.
2
Removed:
3
Removed:
Parses section headings, code blocks, and paragraphs. Inline markup handles
4
Removed:
bold, italic, emphasis, and code spans. *)
5
Removed:
6
Removed:
(* {1 Line classifiers} *)
7
Removed:
8
Removed:
let heading line =
9
Removed:
let trimmed = String.trim line in
10
Removed:
let len = String.length trimmed in
11
Removed:
if len < 4 || trimmed.[0] <> '{' then None
12
Removed:
else
13
Removed:
match trimmed.[1] with
14
Removed:
| '0' .. '6' when len > 3 && trimmed.[2] = ' ' ->
15
Removed:
let level = Char.code trimmed.[1] - Char.code '0' in
16
Removed:
let text_start = 3 in
17
Removed:
let text_end = if trimmed.[len - 1] = '}' then len - 1 else len in
18
Removed:
let text =
19
Removed:
String.sub trimmed text_start (text_end - text_start) |> String.trim
20
Removed:
in
21
Removed:
Some (max 1 level, text)
22
Removed:
| _ -> None
23
Removed:
24
Removed:
let code_block_open line =
25
Removed:
let trimmed = String.trim line in
26
Removed:
if String.starts_with ~prefix:"{[" trimmed then
27
Removed:
let rest = String.sub trimmed 2 (String.length trimmed - 2) in
28
Removed:
if
29
Removed:
String.length rest > 0
30
Removed:
&& rest.[String.length rest - 1] = ']'
31
Removed:
&& String.length rest > 1
32
Removed:
&& rest.[String.length rest - 2] = '}'
33
Removed:
then
34
Removed:
(* Single-line code block: {[code]} on one line *)
35
Removed:
None
36
Removed:
else Some rest
37
Removed:
else None
38
Removed:
39
Removed:
let code_block_single line =
40
Removed:
let trimmed = String.trim line in
41
Removed:
let len = String.length trimmed in
42
Removed:
if
43
Removed:
len >= 4
44
Removed:
&& String.starts_with ~prefix:"{[" trimmed
45
Removed:
&& trimmed.[len - 2] = ']'
46
Removed:
&& trimmed.[len - 1] = '}'
47
Removed:
then Some (String.sub trimmed 2 (len - 4))
48
Removed:
else None
49
Removed:
50
Removed:
let is_code_block_close line =
51
Removed:
let trimmed = String.trim line in
52
Removed:
String.length trimmed >= 2
53
Removed:
&& trimmed.[String.length trimmed - 2] = ']'
54
Removed:
&& trimmed.[String.length trimmed - 1] = '}'
55
Removed:
56
Removed:
(* {1 Block parsing} *)
57
Removed:
58
Removed:
let parse_blocks lines =
59
Removed:
let is_boundary line =
60
Removed:
String.trim line = ""
61
Removed:
|| Option.is_some (heading line)
62
Removed:
|| Option.is_some (code_block_open line)
63
Removed:
|| Option.is_some (code_block_single line)
64
Removed:
in
65
Removed:
let rec take_paragraph collected = function
66
Removed:
| line :: _ as rest when is_boundary line -> (List.rev collected, rest)
67
Removed:
| line :: rest -> take_paragraph (String.trim line :: collected) rest
68
Removed:
| [] -> (List.rev collected, [])
69
Removed:
in
70
Removed:
let open Prose_format in
71
Removed:
let rec loop blocks = function
72
Removed:
| [] -> List.rev blocks
73
Removed:
| line :: rest when String.trim line = "" -> loop blocks rest
74
Removed:
| line :: rest -> (
75
Removed:
match heading line with
76
Removed:
| Some (level, text) -> loop (Heading (level, text) :: blocks) rest
77
Removed:
| None -> (
78
Removed:
match code_block_single line with
79
Removed:
| Some code -> loop (Code_block (None, code) :: blocks) rest
80
Removed:
| None -> (
81
Removed:
match code_block_open line with
82
Removed:
| Some first_line ->
83
Removed:
let code_lines, rest =
84
Removed:
Prose_format.take_until is_code_block_close [] rest
85
Removed:
in
86
Removed:
let all_lines =
87
Removed:
if first_line = "" then code_lines
88
Removed:
else first_line :: code_lines
89
Removed:
in
90
Removed:
let code = String.concat "\n" all_lines in
91
Removed:
loop (Code_block (None, code) :: blocks) rest
92
Removed:
| None ->
93
Removed:
let paragraph, rest = take_paragraph [] (line :: rest) in
94
Removed:
loop
95
Removed:
(Paragraph (String.concat " " paragraph) :: blocks)
96
Removed:
rest)))
97
Removed:
in
98
Removed:
loop [] lines
99
Removed:
100
Removed:
(* {1 Inline markup} *)
101
Removed:
102
Removed:
let inline text =
103
Removed:
let len = String.length text in
104
Removed:
let buf = Buffer.create 64 in
105
Removed:
let nodes = ref [] in
106
Removed:
let flush () =
107
Removed:
if Buffer.length buf > 0 then (
108
Removed:
nodes := Ui.text (Buffer.contents buf) :: !nodes;
109
Removed:
Buffer.clear buf)
110
Removed:
in
111
Removed:
let rec loop i =
112
Removed:
if i >= len then flush ()
113
Removed:
else
114
Removed:
match text.[i] with
115
Removed:
| '{' when i + 1 < len -> (
116
Removed:
match text.[i + 1] with
117
Removed:
| ('b' | 'i' | 'e') when i + 2 < len && text.[i + 2] = ' ' ->
118
Removed:
flush ();
119
Removed:
let close = find_brace_close (i + 3) 1 in
120
Removed:
let content = String.sub text (i + 3) (close - i - 3) in
121
Removed:
nodes :=
122
Removed:
Ui.inline ~class_:"readme-emphasis" [ Ui.text content ]
123
Removed:
:: !nodes;
124
Removed:
loop (close + 1)
125
Removed:
| '[' ->
126
Removed:
flush ();
127
Removed:
let close = find_code_close (i + 2) in
128
Removed:
let content = String.sub text (i + 2) (close - i - 2) in
129
Removed:
nodes := Ui.code_inline ~class_:"readme-code" content :: !nodes;
130
Removed:
loop (close + 2)
131
Removed:
| _ ->
132
Removed:
Buffer.add_char buf '{';
133
Removed:
loop (i + 1))
134
Removed:
| c ->
135
Removed:
Buffer.add_char buf c;
136
Removed:
loop (i + 1)
137
Removed:
and find_brace_close start depth =
138
Removed:
if start >= len then len
139
Removed:
else if text.[start] = '}' then
140
Removed:
if depth <= 1 then start else find_brace_close (start + 1) (depth - 1)
141
Removed:
else if text.[start] = '{' then find_brace_close (start + 1) (depth + 1)
142
Removed:
else find_brace_close (start + 1) depth
143
Removed:
and find_code_close start =
144
Removed:
if start + 1 >= len then len
145
Removed:
else if text.[start] = ']' && text.[start + 1] = '}' then start
146
Removed:
else find_code_close (start + 1)
147
Removed:
in
148
Removed:
loop 0;
149
Removed:
List.rev !nodes
150
Removed:
151
Removed:
(* {1 Format definition} *)
152
Removed:
153
Removed:
let format : Prose_format.format =
154
Removed:
{
155
Removed:
name = "mld";
156
Removed:
css_class = "readme-document readme-mld";
157
Removed:
parse =
158
Removed:
(fun content ->
159
Removed:
let lines = String.split_on_char '\n' content in
160
Removed:
{
161
Removed:
Prose_format.title = None;
162
Removed:
metadata = [];
163
Removed:
blocks = parse_blocks lines;
164
Removed:
});
165
Removed:
inline;
166
Removed:
}
lib/prose/prose_mld.mli
@@ -1,7 +0,0 @@
1
Removed:
(** Mld (ocamldoc) documentation format.
2
Removed:
3
Removed:
Parses section headings, code blocks, and paragraphs. Inline markup handles
4
Removed:
bold, italic, emphasis, and code spans. *)
5
Removed:
6
Removed:
val format : Prose_format.format
7
Removed:
(** The mld format descriptor, for [.mld] files. *)
lib/prose/prose_org.ml
@@ -1,293 +0,0 @@
1
Removed:
(** Org mode documentation format.
2
Removed:
3
Removed:
Parses Org headings, #+BEGIN_SRC blocks, metadata directives, unordered,
4
Removed:
ordered, and definition lists, and paragraphs. Inline markup handles
5
Removed:
=verbatim=, ~code~, and [[link][desc]] syntax. *)
6
Removed:
7
Removed:
(* {1 Inline markup} *)
8
Removed:
9
Removed:
let org_inline text =
10
Removed:
let len = String.length text in
11
Removed:
let buf = Buffer.create 64 in
12
Removed:
let nodes = ref [] in
13
Removed:
let flush () =
14
Removed:
if Buffer.length buf > 0 then (
15
Removed:
nodes := Ui.text (Buffer.contents buf) :: !nodes;
16
Removed:
Buffer.clear buf)
17
Removed:
in
18
Removed:
let rec loop i =
19
Removed:
if i >= len then flush ()
20
Removed:
else
21
Removed:
match text.[i] with
22
Removed:
| '[' when i + 1 < len && text.[i + 1] = '[' ->
23
Removed:
flush ();
24
Removed:
parse_link (i + 2)
25
Removed:
| ('=' | '~') as marker -> (
26
Removed:
let close = find_close marker (i + 1) in
27
Removed:
match close with
28
Removed:
| Some end_pos ->
29
Removed:
flush ();
30
Removed:
let content = String.sub text (i + 1) (end_pos - i - 1) in
31
Removed:
let node =
32
Removed:
match marker with
33
Removed:
| '~' -> Ui.code_inline ~class_:"readme-code" content
34
Removed:
| _ -> Ui.inline ~class_:"readme-verbatim" [ Ui.text content ]
35
Removed:
in
36
Removed:
nodes := node :: !nodes;
37
Removed:
loop (end_pos + 1)
38
Removed:
| None ->
39
Removed:
Buffer.add_char buf text.[i];
40
Removed:
loop (i + 1))
41
Removed:
| c ->
42
Removed:
Buffer.add_char buf c;
43
Removed:
loop (i + 1)
44
Removed:
and find_close marker start =
45
Removed:
let rec search j =
46
Removed:
if j >= len then None
47
Removed:
else if text.[j] = marker then Some j
48
Removed:
else if text.[j] = '\n' then None
49
Removed:
else search (j + 1)
50
Removed:
in
51
Removed:
if start >= len then None else search start
52
Removed:
and parse_link start =
53
Removed:
let rec find_end j _depth =
54
Removed:
if j >= len then None
55
Removed:
else if j + 1 < len && text.[j] = ']' && text.[j + 1] = ']' then Some j
56
Removed:
else find_end (j + 1) 0
57
Removed:
in
58
Removed:
match find_end start 0 with
59
Removed:
| None ->
60
Removed:
Buffer.add_string buf "[[";
61
Removed:
loop start
62
Removed:
| Some close_pos ->
63
Removed:
let inner = String.sub text start (close_pos - start) in
64
Removed:
let href, desc =
65
Removed:
match String.index_opt inner ']' with
66
Removed:
| Some bracket_pos
67
Removed:
when bracket_pos + 1 < String.length inner
68
Removed:
&& inner.[bracket_pos + 1] = '[' ->
69
Removed:
let href = String.sub inner 0 bracket_pos in
70
Removed:
let desc =
71
Removed:
String.sub inner (bracket_pos + 2)
72
Removed:
(String.length inner - bracket_pos - 2)
73
Removed:
in
74
Removed:
(href, desc)
75
Removed:
| _ -> (inner, inner)
76
Removed:
in
77
Removed:
let node = Ui.link ~class_:"readme-link" ~href [ Ui.text desc ] in
78
Removed:
nodes := node :: !nodes;
79
Removed:
loop (close_pos + 2)
80
Removed:
in
81
Removed:
loop 0;
82
Removed:
List.rev !nodes
83
Removed:
84
Removed:
(* {1 Line classifiers} *)
85
Removed:
86
Removed:
let heading line =
87
Removed:
let length = String.length line in
88
Removed:
let rec count_stars index =
89
Removed:
if index < length && line.[index] = '*' then count_stars (index + 1)
90
Removed:
else index
91
Removed:
in
92
Removed:
let level = count_stars 0 in
93
Removed:
if level = 0 || level >= length || line.[level] <> ' ' then None
94
Removed:
else
95
Removed:
Some
96
Removed:
( min 6 level,
97
Removed:
String.sub line (level + 1) (length - level - 1) |> String.trim )
98
Removed:
99
Removed:
let unordered_item = Prose_format.unordered_item
100
Removed:
let ordered_item = Prose_format.ordered_item
101
Removed:
102
Removed:
let definition_item line =
103
Removed:
let trimmed = String.trim line in
104
Removed:
let tlen = String.length trimmed in
105
Removed:
if tlen < 2 || trimmed.[0] <> '-' || trimmed.[1] <> ' ' then None
106
Removed:
else
107
Removed:
let rest = String.sub trimmed 2 (tlen - 2) in
108
Removed:
let rec find_sep i =
109
Removed:
if i + 3 >= String.length rest then None
110
Removed:
else if
111
Removed:
rest.[i] = ' '
112
Removed:
&& rest.[i + 1] = ':'
113
Removed:
&& rest.[i + 2] = ':'
114
Removed:
&& rest.[i + 3] = ' '
115
Removed:
then
116
Removed:
let term = String.sub rest 0 i |> String.trim in
117
Removed:
let desc =
118
Removed:
String.sub rest (i + 4) (String.length rest - i - 4) |> String.trim
119
Removed:
in
120
Removed:
Some (term, desc)
121
Removed:
else find_sep (i + 1)
122
Removed:
in
123
Removed:
find_sep 0
124
Removed:
125
Removed:
let src_begin line =
126
Removed:
let prefix = "#+begin_src" in
127
Removed:
let lower = String.lowercase_ascii (String.trim line) in
128
Removed:
if not (String.starts_with ~prefix lower) then None
129
Removed:
else
130
Removed:
let language =
131
Removed:
String.sub lower (String.length prefix)
132
Removed:
(String.length lower - String.length prefix)
133
Removed:
|> String.trim |> Prose_format.first_word
134
Removed:
in
135
Removed:
Some language
136
Removed:
137
Removed:
let is_src_end line =
138
Removed:
String.trim line |> String.lowercase_ascii
139
Removed:
|> String.starts_with ~prefix:"#+end_src"
140
Removed:
141
Removed:
let is_example_begin line =
142
Removed:
String.trim line |> String.lowercase_ascii
143
Removed:
|> String.starts_with ~prefix:"#+begin_example"
144
Removed:
145
Removed:
let is_example_end line =
146
Removed:
String.trim line |> String.lowercase_ascii
147
Removed:
|> String.starts_with ~prefix:"#+end_example"
148
Removed:
149
Removed:
(* {1 Block parsing} *)
150
Removed:
151
Removed:
let is_boundary_common line =
152
Removed:
Prose_format.is_boundary_common line || Option.is_some (definition_item line)
153
Removed:
154
Removed:
let parse_blocks lines =
155
Removed:
let is_boundary line =
156
Removed:
is_boundary_common line
157
Removed:
|| Option.is_some (heading line)
158
Removed:
|| Option.is_some (src_begin line)
159
Removed:
|| is_example_begin line
160
Removed:
in
161
Removed:
let rec take_paragraph collected = function
162
Removed:
| line :: _ as rest when is_boundary line -> (List.rev collected, rest)
163
Removed:
| line :: rest -> take_paragraph (String.trim line :: collected) rest
164
Removed:
| [] -> (List.rev collected, [])
165
Removed:
in
166
Removed:
let rec take_unordered collected = function
167
Removed:
| line :: rest -> (
168
Removed:
match unordered_item line with
169
Removed:
| Some first_line ->
170
Removed:
let continuations, rest = Prose_format.take_continuations rest in
171
Removed:
let item = String.concat " " (first_line :: continuations) in
172
Removed:
take_unordered (item :: collected) rest
173
Removed:
| None -> (List.rev collected, line :: rest))
174
Removed:
| [] -> (List.rev collected, [])
175
Removed:
in
176
Removed:
let rec take_ordered collected = function
177
Removed:
| line :: rest -> (
178
Removed:
match ordered_item line with
179
Removed:
| Some first_line ->
180
Removed:
let continuations, rest = Prose_format.take_continuations rest in
181
Removed:
let item = String.concat " " (first_line :: continuations) in
182
Removed:
take_ordered (item :: collected) rest
183
Removed:
| None -> (List.rev collected, line :: rest))
184
Removed:
| [] -> (List.rev collected, [])
185
Removed:
in
186
Removed:
let rec take_definitions collected = function
187
Removed:
| line :: rest -> (
188
Removed:
match definition_item line with
189
Removed:
| Some (term, first_desc) ->
190
Removed:
let continuations, rest = Prose_format.take_continuations rest in
191
Removed:
let desc = String.concat " " (first_desc :: continuations) in
192
Removed:
take_definitions ((term, desc) :: collected) rest
193
Removed:
| None -> (List.rev collected, line :: rest))
194
Removed:
| [] -> (List.rev collected, [])
195
Removed:
in
196
Removed:
let open Prose_format in
197
Removed:
let rec loop blocks = function
198
Removed:
| [] -> List.rev blocks
199
Removed:
| line :: rest when String.trim line = "" -> loop blocks rest
200
Removed:
| line :: rest -> (
201
Removed:
match heading line with
202
Removed:
| Some (level, text) -> loop (Heading (level, text) :: blocks) rest
203
Removed:
| None -> (
204
Removed:
match src_begin line with
205
Removed:
| Some language ->
206
Removed:
let lines, rest = Prose_format.take_until is_src_end [] rest in
207
Removed:
loop
208
Removed:
(Code_block (language, String.concat "\n" lines) :: blocks)
209
Removed:
rest
210
Removed:
| None when is_example_begin line ->
211
Removed:
let lines, rest =
212
Removed:
Prose_format.take_until is_example_end [] rest
213
Removed:
in
214
Removed:
loop
215
Removed:
(Code_block (None, String.concat "\n" lines) :: blocks)
216
Removed:
rest
217
Removed:
| None -> (
218
Removed:
match definition_item line with
219
Removed:
| Some _ ->
220
Removed:
let items, rest = take_definitions [] (line :: rest) in
221
Removed:
loop (Definition_list items :: blocks) rest
222
Removed:
| None -> (
223
Removed:
match unordered_item line with
224
Removed:
| Some _ ->
225
Removed:
let items, rest = take_unordered [] (line :: rest) in
226
Removed:
loop (Unordered_list items :: blocks) rest
227
Removed:
| None -> (
228
Removed:
match ordered_item line with
229
Removed:
| Some _ ->
230
Removed:
let items, rest = take_ordered [] (line :: rest) in
231
Removed:
loop (Ordered_list items :: blocks) rest
232
Removed:
| None ->
233
Removed:
let paragraph, rest =
234
Removed:
take_paragraph [] (line :: rest)
235
Removed:
in
236
Removed:
loop
237
Removed:
(Paragraph (String.concat " " paragraph) :: blocks)
238
Removed:
rest)))))
239
Removed:
in
240
Removed:
loop [] lines
241
Removed:
242
Removed:
(* {1 Org metadata} *)
243
Removed:
244
Removed:
let metadata_line line =
245
Removed:
let prefix = "#+" in
246
Removed:
let line = String.trim line in
247
Removed:
if not (String.starts_with ~prefix line) then None
248
Removed:
else
249
Removed:
match String.index_opt line ':' with
250
Removed:
| None -> None
251
Removed:
| Some colon ->
252
Removed:
let key = String.sub line 2 (colon - 2) |> String.lowercase_ascii in
253
Removed:
let value =
254
Removed:
String.sub line (colon + 1) (String.length line - colon - 1)
255
Removed:
|> String.trim
256
Removed:
in
257
Removed:
if List.mem key [ "title"; "author"; "date"; "email"; "language" ] then
258
Removed:
Some (key, value)
259
Removed:
else None
260
Removed:
261
Removed:
let split_metadata lines =
262
Removed:
List.fold_left
263
Removed:
(fun (metadata, body) line ->
264
Removed:
match metadata_line line with
265
Removed:
| None -> (metadata, line :: body)
266
Removed:
| Some entry -> (entry :: metadata, body))
267
Removed:
([], []) lines
268
Removed:
|> fun (metadata, body) -> (List.rev metadata, List.rev body)
269
Removed:
270
Removed:
(* {1 Format definition} *)
271
Removed:
272
Removed:
let format : Prose_format.format =
273
Removed:
{
274
Removed:
name = "org";
275
Removed:
css_class = "readme-document readme-org";
276
Removed:
parse =
277
Removed:
(fun content ->
278
Removed:
let lines = String.split_on_char '\n' content in
279
Removed:
let metadata, lines = split_metadata lines in
280
Removed:
let title =
281
Removed:
List.find_opt (fun (key, _) -> key = "title") metadata
282
Removed:
|> Option.map snd
283
Removed:
in
284
Removed:
let metadata_entries =
285
Removed:
List.filter (fun (key, _) -> key <> "title") metadata
286
Removed:
in
287
Removed:
{
288
Removed:
Prose_format.title;
289
Removed:
metadata = metadata_entries;
290
Removed:
blocks = parse_blocks lines;
291
Removed:
});
292
Removed:
inline = org_inline;
293
Removed:
}
lib/prose/prose_org.mli
@@ -1,8 +0,0 @@
1
Removed:
(** Org mode documentation format.
2
Removed:
3
Removed:
Parses Org headings, [#+BEGIN_SRC] blocks, metadata directives, unordered,
4
Removed:
ordered, and definition lists, and paragraphs. Inline markup handles
5
Removed:
[=verbatim=], [~code~], and [[[link][desc]]] syntax. *)
6
Removed:
7
Removed:
val format : Prose_format.format
8
Removed:
(** The Org mode format descriptor, for [.org] files. *)
lib/prose/prose_plaintext.ml
@@ -1,22 +0,0 @@
1
Removed:
(** Plain text documentation format.
2
Removed:
3
Removed:
Each non-blank line becomes a paragraph. No inline markup is applied. *)
4
Removed:
5
Removed:
let format : Prose_format.format =
6
Removed:
{
7
Removed:
name = "plaintext";
8
Removed:
css_class = "readme-document readme-plaintext";
9
Removed:
parse =
10
Removed:
(fun content ->
11
Removed:
let lines = String.split_on_char '\n' content in
12
Removed:
let blocks =
13
Removed:
List.filter_map
14
Removed:
(fun line ->
15
Removed:
let trimmed = String.trim line in
16
Removed:
if trimmed = "" then None
17
Removed:
else Some (Prose_format.Paragraph trimmed))
18
Removed:
lines
19
Removed:
in
20
Removed:
{ Prose_format.title = None; metadata = []; blocks });
21
Removed:
inline = (fun text -> [ Ui.text text ]);
22
Removed:
}
lib/prose/render.ml
@@ -0,0 +1,25 @@
1
Added:
(** Prose rendering façade.
2
Added:
3
Added:
Detects documentation formats by filename extension and renders content as
4
Added:
styled HTML. This module is the single entry point for prose rendering
5
Added:
throughout ogit. *)
6
Added:
7
Added:
let is_readme_filename filename =
8
Added:
Filename.basename filename |> String.lowercase_ascii
9
Added:
|> String.starts_with ~prefix:"readme"
10
Added:
11
Added:
let is_doc_filename filename =
12
Added:
match Filename.extension filename |> String.lowercase_ascii with
13
Added:
| ".md" | ".markdown" | ".org" | ".mld" | ".txt" -> true
14
Added:
| _ -> false
15
Added:
16
Added:
let format_of_filename filename =
17
Added:
match Filename.extension filename |> String.lowercase_ascii with
18
Added:
| ".org" -> Org.format
19
Added:
| ".mld" -> Mld.format
20
Added:
| ".txt" -> Plaintext.format
21
Added:
| _ -> Markdown.format
22
Added:
23
Added:
let render ~filename content =
24
Added:
let format = format_of_filename filename in
25
Added:
Format.render format content
lib/prose/render.mli
@@ -0,0 +1,16 @@
1
Added:
(** Prose rendering facade.
2
Added:
3
Added:
Detects documentation formats by filename extension and renders content as
4
Added:
styled HTML. This module is the single entry point for prose rendering
5
Added:
throughout ogit. *)
6
Added:
7
Added:
val is_readme_filename : string -> bool
8
Added:
(** [true] when the filename starts with "readme" (case-insensitive). *)
9
Added:
10
Added:
val is_doc_filename : string -> bool
11
Added:
(** [true] when the extension indicates a renderable documentation format (.md,
12
Added:
.markdown, .org, .mld, .txt). *)
13
Added:
14
Added:
val render : filename:string -> string -> Ui.node
15
Added:
(** [render ~filename content] detects the format from the extension and
16
Added:
produces a styled HTML region. *)
lib/ui/dune
@@ -0,0 +1,7 @@
1
Added:
(include_subdirs no)
2
Added:
3
Added:
(library
4
Added:
(name ui)
5
Added:
(public_name ogit.ui)
6
Added:
(wrapped false)
7
Added:
(libraries dream-html))
lib/ui/ui.ml
@@ -0,0 +1,471 @@
1
Added:
(* Implementation of the site building blocks. The API and its rationale are
2
Added:
documented in ui.mli; comments here cover implementation choices only.
3
Added:
4
Added:
Attribute order is deliberate and load-bearing for readability of the
5
Added:
rendered HTML: id, then href, then class, then ARIA. Keeping it uniform means
6
Added:
a page's markup diffs cleanly when a block changes. *)
7
Added:
8
Added:
open Dream_html
9
Added:
10
Added:
type node = Dream_html.node
11
Added:
12
Added:
let classes parts =
13
Added:
parts |> List.filter (fun part -> part <> "") |> String.concat " "
14
Added:
15
Added:
(* Optional attributes collapse to the empty list so they can be concatenated
16
Added:
unconditionally at each call site. *)
17
Added:
let opt_id = function None -> [] | Some value -> [ HTML.id "%s" value ]
18
Added:
let opt_class = function None -> [] | Some value -> [ HTML.class_ "%s" value ]
19
Added:
let opt_aria_label = function None -> [] | Some v -> [ Aria.label "%s" v ]
20
Added:
let flag_current = function false -> [] | true -> [ Aria.current `page ]
21
Added:
let flag_open = function false -> [] | true -> HTML.[ open_ ]
22
Added:
23
Added:
(* Text and grouping *)
24
Added:
25
Added:
let nothing = HTML.null []
26
Added:
let text value = txt "%s" value
27
Added:
let group nodes = HTML.null nodes
28
Added:
29
Added:
(* Inline *)
30
Added:
31
Added:
let inline ?class_ ?(decorative = false) children =
32
Added:
let hidden = if decorative then [ Aria.hidden true ] else [] in
33
Added:
HTML.span (opt_class class_ @ hidden) children
34
Added:
35
Added:
let inline_text ?class_ ?decorative value =
36
Added:
inline ?class_ ?decorative [ text value ]
37
Added:
38
Added:
(* Links *)
39
Added:
40
Added:
let link ?id ?class_ ?label ~href children =
41
Added:
HTML.a
42
Added:
(opt_id id
43
Added:
@ [ HTML.href "%s" href ]
44
Added:
@ opt_class class_ @ opt_aria_label label)
45
Added:
children
46
Added:
47
Added:
let text_link ?id ?class_ ?label ~href value =
48
Added:
link ?id ?class_ ?label ~href [ text value ]
49
Added:
50
Added:
(* Images *)
51
Added:
52
Added:
let image ?class_ ?alt ~src () =
53
Added:
let describe =
54
Added:
match alt with
55
Added:
| Some value -> [ HTML.alt "%s" value ]
56
Added:
(* An empty alt alone is enough for most readers, but the explicit
57
Added:
presentation role removes any doubt. *)
58
Added:
| None -> [ HTML.alt ""; HTML.role `presentation ]
59
Added:
in
60
Added:
HTML.img ((HTML.src "%s" src :: describe) @ opt_class class_)
61
Added:
62
Added:
(* Blocks *)
63
Added:
64
Added:
let block ?id ?class_ children =
65
Added:
HTML.div (opt_id id @ opt_class class_) children
66
Added:
67
Added:
let region ?id ?class_ children =
68
Added:
HTML.section (opt_id id @ opt_class class_) children
69
Added:
70
Added:
let paragraph ?class_ children = HTML.p (opt_class class_) children
71
Added:
let paragraph_text ?class_ value = paragraph ?class_ [ text value ]
72
Added:
73
Added:
let heading ?id ?(level = 1) ?class_ children =
74
Added:
let element =
75
Added:
match level with
76
Added:
| 1 -> HTML.h1
77
Added:
| 2 -> HTML.h2
78
Added:
| 3 -> HTML.h3
79
Added:
| 4 -> HTML.h4
80
Added:
| 5 -> HTML.h5
81
Added:
| _ -> HTML.h6
82
Added:
in
83
Added:
element (opt_id id @ opt_class class_) children
84
Added:
85
Added:
let code_block ?class_ children =
86
Added:
(* Pre-serialize the entire <code> block into a single raw text node placed
87
Added:
directly inside <pre>. This prevents the pretty-printer from injecting
88
Added:
visible whitespace between the <pre> open tag and the code content.
89
Added:
Dream_html.to_string appends a newline after each element; strip those to
90
Added:
avoid spurious line breaks between inline spans. *)
91
Added:
let raw_content =
92
Added:
children
93
Added:
|> List.map (fun node ->
94
Added:
let s = Dream_html.to_string node in
95
Added:
if String.length s > 0 && s.[String.length s - 1] = '\n' then
96
Added:
String.sub s 0 (String.length s - 1)
97
Added:
else s)
98
Added:
|> String.concat ""
99
Added:
in
100
Added:
HTML.pre (opt_class class_) [ txt ~raw:true "<code>%s</code>" raw_content ]
101
Added:
102
Added:
(* Lists *)
103
Added:
104
Added:
let items ?id ?class_ children = HTML.ul (opt_id id @ opt_class class_) children
105
Added:
106
Added:
let ordered_items ?id ?class_ children =
107
Added:
HTML.ol (opt_id id @ opt_class class_) children
108
Added:
109
Added:
let item ?class_ ?(current = false) children =
110
Added:
HTML.li (opt_class class_ @ flag_current current) children
111
Added:
112
Added:
let items_of ?id ?class_ render values =
113
Added:
items ?id ?class_ (List.map render values)
114
Added:
115
Added:
let code_inline ?class_ value = HTML.code (opt_class class_) [ text value ]
116
Added:
117
Added:
(* Badges *)
118
Added:
119
Added:
let badge ?(base_class = "badge") ?variant ?href value =
120
Added:
let classes =
121
Added:
match variant with
122
Added:
| None -> base_class
123
Added:
| Some variant -> Printf.sprintf "%s %s-%s" base_class base_class variant
124
Added:
in
125
Added:
(* Only the text is linked: a link wrapping the whole badge would make its
126
Added:
padding clickable, which reads as a button rather than a label. *)
127
Added:
let body =
128
Added:
match href with
129
Added:
| None -> [ text value ]
130
Added:
| Some href -> [ link ~href [ text value ] ]
131
Added:
in
132
Added:
inline ~class_:classes body
133
Added:
134
Added:
(* Time *)
135
Added:
136
Added:
let timestamp ~machine display =
137
Added:
HTML.time [ HTML.datetime "%s" machine ] [ text display ]
138
Added:
139
Added:
(* Definition lists *)
140
Added:
141
Added:
let definitions ?class_ pairs =
142
Added:
(* dt and dd are siblings, not nested, so each pair becomes a flat group. *)
143
Added:
let entry (term, description) =
144
Added:
group [ HTML.dt [] [ text term ]; HTML.dd [] description ]
145
Added:
in
146
Added:
HTML.dl (opt_class class_) (List.map entry pairs)
147
Added:
148
Added:
(* Disclosure *)
149
Added:
150
Added:
let chevron ?(class_ = "tree-chevron") () =
151
Added:
inline ~class_ ~decorative:true [ text "\xe2\x80\xba" ]
152
Added:
153
Added:
let disclosure ?id ?class_ ?(expanded = false) ?summary_class ~summary children
154
Added:
=
155
Added:
HTML.details
156
Added:
(opt_id id @ opt_class class_ @ flag_open expanded)
157
Added:
(HTML.summary (opt_class summary_class) summary :: children)
158
Added:
159
Added:
let css_toggle ~id:toggle_id ~toggle_class ~control_class ~label:control_label
160
Added:
~glyph () =
161
Added:
group
162
Added:
[
163
Added:
HTML.input
164
Added:
[
165
Added:
HTML.type_ "checkbox";
166
Added:
HTML.id "%s" toggle_id;
167
Added:
HTML.class_ "%s" toggle_class;
168
Added:
];
169
Added:
HTML.label
170
Added:
[
171
Added:
HTML.for_ "%s" toggle_id;
172
Added:
HTML.class_ "%s" control_class;
173
Added:
Aria.label "%s" control_label;
174
Added:
]
175
Added:
[ text glyph ];
176
Added:
]
177
Added:
178
Added:
(* Table of contents *)
179
Added:
180
Added:
type toc_entry = {
181
Added:
toc_href : string;
182
Added:
toc_label : string;
183
Added:
toc_children : toc_entry list;
184
Added:
}
185
Added:
186
Added:
let toc_entry ?(children = []) ~href label =
187
Added:
{ toc_href = href; toc_label = label; toc_children = children }
188
Added:
189
Added:
let rec toc_items entries =
190
Added:
items ~class_:"toc-list"
191
Added:
(List.map
192
Added:
(fun { toc_href; toc_label; toc_children } ->
193
Added:
let nested =
194
Added:
match toc_children with [] -> [] | kids -> [ toc_items kids ]
195
Added:
in
196
Added:
item (text_link ~href:toc_href toc_label :: nested))
197
Added:
entries)
198
Added:
199
Added:
let toc ?class_ ~title entries =
200
Added:
let rec count = function
201
Added:
| [] -> 0
202
Added:
| e :: rest -> 1 + count e.toc_children + count rest
203
Added:
in
204
Added:
match entries with
205
Added:
| [] -> nothing
206
Added:
| _ when count entries < 2 -> nothing
207
Added:
| _ ->
208
Added:
let outer_class = classes [ "toc"; Option.value class_ ~default:"" ] in
209
Added:
disclosure ~class_:outer_class ~summary_class:"toc-summary"
210
Added:
~summary:[ text title ]
211
Added:
[ toc_items entries ]
212
Added:
213
Added:
(* Trees *)
214
Added:
215
Added:
let tree_leaf ?(modifier = "") ~href label =
216
Added:
item ~class_:(classes [ "tree-file"; modifier ]) [ text_link ~href label ]
217
Added:
218
Added:
let tree_branch ?(modifier = "") ?(expanded = false) ~href label children =
219
Added:
item
220
Added:
~class_:(classes [ "tree-dir"; modifier ])
221
Added:
[
222
Added:
disclosure ~expanded ~summary_class:"tree-toggle"
223
Added:
~summary:[ chevron (); text_link ~class_:"tree-link" ~href label ]
224
Added:
[ items ~class_:"tree-nested" children ];
225
Added:
]
226
Added:
227
Added:
let tree_overflow ?(class_ = "tree-overflow") ~href label =
228
Added:
item ~class_ [ text_link ~href label ]
229
Added:
230
Added:
(* Breadcrumbs *)
231
Added:
232
Added:
type crumb = { crumb_text : string; crumb_href : string option }
233
Added:
234
Added:
let crumb ?href text = { crumb_text = text; crumb_href = href }
235
Added:
236
Added:
let breadcrumb ?id ?class_ ?link_class ?separator_class
237
Added:
?(separator_decorative = false) ~separator crumbs =
238
Added:
(* The separator precedes every crumb but the first, so the trail has no
239
Added:
leading or trailing delimiter. *)
240
Added:
let render index { crumb_text; crumb_href } =
241
Added:
let body =
242
Added:
match crumb_href with
243
Added:
| Some href -> text_link ?class_:link_class ~href crumb_text
244
Added:
| None -> inline_text ?class_:link_class crumb_text
245
Added:
in
246
Added:
if index = 0 then body
247
Added:
else
248
Added:
group
249
Added:
[
250
Added:
inline_text ?class_:separator_class ~decorative:separator_decorative
251
Added:
separator;
252
Added:
body;
253
Added:
]
254
Added:
in
255
Added:
HTML.span (opt_id id @ opt_class class_) (List.mapi render crumbs)
256
Added:
257
Added:
(* Navigation *)
258
Added:
259
Added:
type nav_link = { nav_href : string; nav_text : string; nav_current : bool }
260
Added:
261
Added:
let nav_link ?(current = false) ~href text =
262
Added:
{ nav_href = href; nav_text = text; nav_current = current }
263
Added:
264
Added:
let navigation ?id ?class_ ~label children =
265
Added:
HTML.nav (opt_id id @ opt_class class_ @ [ Aria.label "%s" label ]) children
266
Added:
267
Added:
let nav_links ?id ?class_ ?item_class links =
268
Added:
(* aria-current goes on the list item rather than the link so the marker
269
Added:
survives styling the item as the highlighted row. *)
270
Added:
let render { nav_href; nav_text; nav_current } =
271
Added:
item ?class_:item_class ~current:nav_current
272
Added:
[ text_link ~href:nav_href nav_text ]
273
Added:
in
274
Added:
items ?id ?class_ (List.map render links)
275
Added:
276
Added:
(* Toolbars *)
277
Added:
278
Added:
let toolbar ?id ?class_ ?label children =
279
Added:
match children with
280
Added:
| [] -> nothing
281
Added:
| _ ->
282
Added:
HTML.div
283
Added:
(opt_id id @ opt_class class_
284
Added:
@ [ HTML.role `toolbar ]
285
Added:
@ opt_aria_label label)
286
Added:
children
287
Added:
288
Added:
let button_link ?(class_ = "toolbar-button") ?label ~href text =
289
Added:
text_link ~class_ ?label ~href text
290
Added:
291
Added:
let dismissible ?(class_ = "toolbar-filter")
292
Added:
?(dismiss_class = "toolbar-dismiss") ~value_class ~dismiss_href
293
Added:
~dismiss_label value =
294
Added:
inline ~class_
295
Added:
[
296
Added:
inline_text ~class_:value_class value;
297
Added:
text_link ~class_:dismiss_class ~label:dismiss_label ~href:dismiss_href
298
Added:
"\xc3\x97";
299
Added:
]
300
Added:
301
Added:
(* Pagination *)
302
Added:
303
Added:
let pagination ?(label = "Pagination") ?(previous_text = "<") ?(next_text = ">")
304
Added:
?(previous_label = "Previous page") ?(next_label = "Next page")
305
Added:
?previous_href ?next_href page_number =
306
Added:
(* An unavailable neighbour still occupies its slot, so the page number does
307
Added:
not shift horizontally as the reader moves through the list. *)
308
Added:
let control href_opt glyph control_label =
309
Added:
match href_opt with
310
Added:
| Some href ->
311
Added:
text_link ~class_:"pagination-btn" ~label:control_label ~href glyph
312
Added:
| None ->
313
Added:
inline_text ~class_:"pagination-btn pagination-disabled"
314
Added:
~decorative:true glyph
315
Added:
in
316
Added:
navigation ~class_:"toolbar-pagination" ~label
317
Added:
[
318
Added:
control previous_href previous_text previous_label;
319
Added:
HTML.span
320
Added:
[ HTML.class_ "pagination-page"; Aria.current `page ]
321
Added:
[ text (string_of_int page_number) ];
322
Added:
control next_href next_text next_label;
323
Added:
]
324
Added:
325
Added:
(* Code *)
326
Added:
327
Added:
let numbered_lines ?id ?class_ ?(anchor_prefix = "") render_line lines =
328
Added:
let numbered_line index line =
329
Added:
let number = index + 1 in
330
Added:
let name = Printf.sprintf "%s%d" anchor_prefix number in
331
Added:
[
332
Added:
HTML.a
333
Added:
[
334
Added:
HTML.id "%s" name;
335
Added:
HTML.class_ "line-anchor";
336
Added:
HTML.href "#%s" name;
337
Added:
Aria.label "Line %d" number;
338
Added:
]
339
Added:
[ text (string_of_int number) ];
340
Added:
HTML.span [ HTML.class_ "line" ] (render_line line);
341
Added:
]
342
Added:
in
343
Added:
block ?id ?class_ (List.mapi numbered_line lines |> List.concat)
344
Added:
345
Added:
let code_listing ?id ?class_ ?anchor_prefix content =
346
Added:
(* Anchor and text alternate as siblings of one grid container, so the
347
Added:
stylesheet can align numbers against wrapping lines without a table. The
348
Added:
leading tab and trailing newline preserve the source's shape when the
349
Added:
listing is copied. *)
350
Added:
numbered_lines ?id ?class_ ?anchor_prefix
351
Added:
(fun line -> [ txt "\t%s\n" line ])
352
Added:
(String.split_on_char '\n' content)
353
Added:
354
Added:
let highlighted_code_listing ?id ?class_ ?anchor_prefix lines =
355
Added:
(* Same grid layout as code_listing, but each line is a list of pre-rendered
356
Added:
nodes (highlighted spans) rather than plain text. The tab/newline framing
357
Added:
is identical so copy-paste behaviour is preserved. *)
358
Added:
numbered_lines ?id ?class_ ?anchor_prefix
359
Added:
(fun line_nodes -> txt "\t" :: line_nodes)
360
Added:
lines
361
Added:
362
Added:
(* Diffs *)
363
Added:
364
Added:
module Diff = struct
365
Added:
type change = Unchanged | Added | Removed
366
Added:
367
Added:
type line = {
368
Added:
before : string;
369
Added:
after : string;
370
Added:
change : change;
371
Added:
content : string;
372
Added:
}
373
Added:
374
Added:
type section = { section_heading : string; lines : line list }
375
Added:
376
Added:
type file = {
377
Added:
path : string;
378
Added:
detail : string;
379
Added:
sections : section list;
380
Added:
note : string option;
381
Added:
}
382
Added:
383
Added:
let line_node { before; after; change; content } =
384
Added:
let variant, marker, announcement =
385
Added:
match change with
386
Added:
| Unchanged -> ("context", " ", "")
387
Added:
| Added -> ("addition", "+", "Added: ")
388
Added:
| Removed -> ("deletion", "-", "Removed: ")
389
Added:
in
390
Added:
block ~class_:("diff-line " ^ variant)
391
Added:
[
392
Added:
inline_text ~class_:"line-number" before;
393
Added:
inline_text ~class_:"line-number" after;
394
Added:
inline_text ~class_:"diff-marker" ~decorative:true marker;
395
Added:
(* Restores, for screen readers, the meaning the marker conveys
396
Added:
visually. *)
397
Added:
inline_text ~class_:"sr-only" announcement;
398
Added:
inline_text ~class_:"diff-text" content;
399
Added:
]
400
Added:
401
Added:
let section_node { section_heading; lines } =
402
Added:
disclosure ~class_:"diff-hunk" ~expanded:true ~summary_class:"hunk-header"
403
Added:
~summary:[ text section_heading ]
404
Added:
[
405
Added:
(* The inner scroll container keeps long lines from widening the page. *)
406
Added:
block ~class_:"diff-lines-scroll"
407
Added:
[ block ~class_:"diff-lines" (List.map line_node lines) ];
408
Added:
]
409
Added:
410
Added:
let file_id index = Printf.sprintf "file-%d" (index + 1)
411
Added:
412
Added:
let file_node index { path; detail; sections; note } =
413
Added:
let body =
414
Added:
match note with
415
Added:
| Some note -> [ paragraph_text ~class_:"binary-diff" note ]
416
Added:
| None -> List.map section_node sections
417
Added:
in
418
Added:
disclosure ~class_:"diff-file" ~expanded:true
419
Added:
~summary_class:"diff-file-header"
420
Added:
~summary:[ text path ]
421
Added:
~id:(file_id index)
422
Added:
(block ~class_:"diff-meta" [ text detail ] :: body)
423
Added:
424
Added:
let file_toc files =
425
Added:
toc ~class_:"diff-toc" ~title:"Changed files"
426
Added:
(List.mapi
427
Added:
(fun index { path; _ } -> toc_entry ~href:("#" ^ file_id index) path)
428
Added:
files)
429
Added:
430
Added:
let view ~empty_message = function
431
Added:
| [] -> [ paragraph_text empty_message ]
432
Added:
| files -> file_toc files :: List.mapi file_node files
433
Added:
end
434
Added:
435
Added:
(* Document scaffolding *)
436
Added:
437
Added:
let meta_viewport =
438
Added:
HTML.meta
439
Added:
[ HTML.name "viewport"; HTML.content "width=device-width, initial-scale=1" ]
440
Added:
441
Added:
let stylesheet href = HTML.link [ HTML.rel "stylesheet"; HTML.href "%s" href ]
442
Added:
443
Added:
let icon ?(media_type = "image/x-icon") href =
444
Added:
HTML.link [ HTML.rel "icon"; HTML.type_ "%s" media_type; HTML.href "%s" href ]
445
Added:
446
Added:
let deferred_script src = HTML.script [ HTML.src "%s" src; HTML.defer ] ""
447
Added:
let inline_script source = HTML.script [] "%s" source
448
Added:
449
Added:
let document_head ~title:document_title extra =
450
Added:
HTML.head [] (HTML.title [] "%s" document_title :: extra)
451
Added:
452
Added:
let skip_link ~href label = text_link ~class_:"skip-link" ~href label
453
Added:
454
Added:
let page_banner ?id ?class_ children =
455
Added:
HTML.header (opt_id id @ opt_class class_) children
456
Added:
457
Added:
let page_content ?id ?class_ children =
458
Added:
HTML.main (opt_id id @ opt_class class_) children
459
Added:
460
Added:
let page_footer ?class_ children = HTML.footer (opt_class class_) children
461
Added:
let document_body ?class_ children = HTML.body (opt_class class_) children
462
Added:
463
Added:
let document ?(lang = "en") ~head ~body () =
464
Added:
HTML.html [ HTML.lang "%s" lang ] [ head; body ]
465
Added:
466
Added:
(* Responses *)
467
Added:
468
Added:
let respond ?status page =
469
Added:
match status with
470
Added:
| None -> Dream_html.respond page
471
Added:
| Some status -> Dream_html.respond ~status page
lib/ui/ui.mli
@@ -0,0 +1,435 @@
1
Added:
(** Generic site building blocks.
2
Added:
3
Added:
This module is the only place in the view layer that names HTML elements. It
4
Added:
knows nothing about the application domain — no Git, repositories, or ogit
5
Added:
routes — so the same vocabulary would serve any static-first web
6
Added:
application: every function takes plain strings and already-built nodes.
7
Added:
8
Added:
{2 Conventions}
9
Added:
10
Added:
- {b Semantic first.} Each block picks the most meaningful element available
11
Added:
([nav], [header], [time], [dl], [details]) rather than a [div] with a
12
Added:
class. Callers choose blocks by meaning, not by appearance.
13
Added:
- {b Classes are a contract.} Blocks emit a fixed vocabulary of class names
14
Added:
— [tree-dir], [tree-toggle], [line-anchor], [pagination-btn] and so on —
15
Added:
which a stylesheet is expected to implement. Those names are structural,
16
Added:
never domain-specific: a "tree" here is any hierarchical list, not a file
17
Added:
tree in particular. Optional [?class_] arguments add a modifier
18
Added:
{i alongside} the base class rather than replacing it.
19
Added:
- {b No scripting.} Interactive blocks ({!val-disclosure},
20
Added:
{!val-css_toggle}) rely on native HTML and CSS, so pages stay usable with
21
Added:
JavaScript disabled.
22
Added:
- {b Accessibility is not optional.} Where a block can only be used
23
Added:
correctly with an accessible name, that name is a required argument rather
24
Added:
than an optional one — see {!val-navigation} and {!val-dismissible}.
25
Added:
26
Added:
Nothing here performs I/O. The attribute plumbing that assembles these
27
Added:
blocks is deliberately not exported: callers compose blocks, they do not
28
Added:
assemble attributes. *)
29
Added:
30
Added:
type node = Dream_html.node
31
Added:
(** A rendered fragment. Exposed so callers can annotate lists of children
32
Added:
without opening [Dream_html] themselves. *)
33
Added:
34
Added:
val classes : string list -> string
35
Added:
(** Join class names, dropping empty ones. Lets callers pass a modifier without
36
Added:
having to manage separators or risk a stray leading space. *)
37
Added:
38
Added:
(** {1 Text and grouping} *)
39
Added:
40
Added:
val nothing : node
41
Added:
(** Renders no markup. Use for absent optional content. *)
42
Added:
43
Added:
val text : string -> node
44
Added:
(** Escaped text. *)
45
Added:
46
Added:
val group : node list -> node
47
Added:
(** Several nodes where one is expected, without introducing a wrapper element.
48
Added:
*)
49
Added:
50
Added:
(** {1 Inline} *)
51
Added:
52
Added:
val inline : ?class_:string -> ?decorative:bool -> node list -> node
53
Added:
(** An inline run of text or nodes.
54
Added:
55
Added:
@param decorative
56
Added:
hides the span from assistive technology, for glyphs that repeat
57
Added:
information already available as text. *)
58
Added:
59
Added:
val inline_text : ?class_:string -> ?decorative:bool -> string -> node
60
Added:
(** {!val-inline} around a single string. *)
61
Added:
62
Added:
(** {1 Links} *)
63
Added:
64
Added:
val link :
65
Added:
?id:string ->
66
Added:
?class_:string ->
67
Added:
?label:string ->
68
Added:
href:string ->
69
Added:
node list ->
70
Added:
node
71
Added:
(** A hyperlink.
72
Added:
73
Added:
@param label
74
Added:
an accessible name, for links whose visible text is not descriptive on its
75
Added:
own. *)
76
Added:
77
Added:
val text_link :
78
Added:
?id:string -> ?class_:string -> ?label:string -> href:string -> string -> node
79
Added:
(** {!link} around a single string. *)
80
Added:
81
Added:
(** {1 Images} *)
82
Added:
83
Added:
val image : ?class_:string -> ?alt:string -> src:string -> unit -> node
84
Added:
(** @param alt
85
Added:
omit for decorative images; the block then marks itself presentational so
86
Added:
screen readers skip it. *)
87
Added:
88
Added:
(** {1 Blocks} *)
89
Added:
90
Added:
val block : ?id:string -> ?class_:string -> node list -> node
91
Added:
(** A generic grouping box. Reach for {!region} or one of the page landmarks
92
Added:
first; this is for layout wrappers that carry no meaning of their own. *)
93
Added:
94
Added:
val region : ?id:string -> ?class_:string -> node list -> node
95
Added:
(** A self-contained part of a page. *)
96
Added:
97
Added:
val paragraph : ?class_:string -> node list -> node
98
Added:
val paragraph_text : ?class_:string -> string -> node
99
Added:
100
Added:
val heading : ?id:string -> ?level:int -> ?class_:string -> node list -> node
101
Added:
(** A heading. [level] follows the document outline: 1 for the page's subject, 2
102
Added:
and 3 for nested sections. Skipping levels breaks screen-reader navigation,
103
Added:
so pass the level that matches the structure rather than the one that looks
104
Added:
right. Levels outside 1–6 clamp to 6. [id] provides a local fragment target.
105
Added:
*)
106
Added:
107
Added:
val code_block : ?class_:string -> node list -> node
108
Added:
(** A preformatted code block without line numbers. The children can be escaped
109
Added:
text or server-rendered syntax-highlight spans. *)
110
Added:
111
Added:
(** {1 Lists} *)
112
Added:
113
Added:
val items : ?id:string -> ?class_:string -> node list -> node
114
Added:
(** An unordered list wrapping already-built {!item} nodes. *)
115
Added:
116
Added:
val ordered_items : ?id:string -> ?class_:string -> node list -> node
117
Added:
(** An ordered list wrapping already-built {!item} nodes. *)
118
Added:
119
Added:
val item : ?class_:string -> ?current:bool -> node list -> node
120
Added:
(** A list entry.
121
Added:
122
Added:
@param current
123
Added:
marks the entry as the one matching the current page, for navigation
124
Added:
lists. *)
125
Added:
126
Added:
val items_of : ?id:string -> ?class_:string -> ('a -> node) -> 'a list -> node
127
Added:
(** A list built from values, saving callers a [List.map]. *)
128
Added:
129
Added:
val code_inline : ?class_:string -> string -> node
130
Added:
(** An inline code fragment. *)
131
Added:
132
Added:
(** {1 Badges} *)
133
Added:
134
Added:
val badge :
135
Added:
?base_class:string -> ?variant:string -> ?href:string -> string -> node
136
Added:
(** A small rounded label. [variant] is appended to the base class as
137
Added:
[<base> <base>-<variant>] so a stylesheet can colour each kind. [href] turns
138
Added:
the label's text into a link while leaving the badge itself inert. *)
139
Added:
140
Added:
(** {1 Time} *)
141
Added:
142
Added:
val timestamp : machine:string -> string -> node
143
Added:
(** A machine-readable timestamp: [machine] fills the [datetime] attribute, the
144
Added:
positional argument is the visible text. *)
145
Added:
146
Added:
(** {1 Definition lists} *)
147
Added:
148
Added:
val definitions : ?class_:string -> (string * node list) list -> node
149
Added:
(** Term/description pairs, for metadata panels. *)
150
Added:
151
Added:
(** {1 Disclosure} *)
152
Added:
153
Added:
val chevron : ?class_:string -> unit -> node
154
Added:
(** Decorative open/close indicator, rotated by CSS from the enclosing
155
Added:
[details]. It carries no textual meaning, so it is hidden from assistive
156
Added:
technology. *)
157
Added:
158
Added:
val disclosure :
159
Added:
?id:string ->
160
Added:
?class_:string ->
161
Added:
?expanded:bool ->
162
Added:
?summary_class:string ->
163
Added:
summary:node list ->
164
Added:
node list ->
165
Added:
node
166
Added:
(** A native disclosure widget: [details] wrapping a clickable [summary] and its
167
Added:
panel. No JavaScript involved.
168
Added:
169
Added:
@param expanded renders the panel open on load.
170
Added:
@param summary the always-visible header contents. *)
171
Added:
172
Added:
val css_toggle :
173
Added:
id:string ->
174
Added:
toggle_class:string ->
175
Added:
control_class:string ->
176
Added:
label:string ->
177
Added:
glyph:string ->
178
Added:
unit ->
179
Added:
node
180
Added:
(** A CSS-only toggle: a visually hidden checkbox paired with a [label] acting
181
Added:
as its control. Lets stylesheets reveal and collapse content without
182
Added:
scripting.
183
Added:
184
Added:
@param label the accessible name of the control, whose [glyph] has none. *)
185
Added:
186
Added:
(** {1 Table of contents} *)
187
Added:
188
Added:
type toc_entry
189
Added:
(** One entry in a table of contents. Build with {!val-toc_entry}. Entries may
190
Added:
contain nested children to represent subheading hierarchy. *)
191
Added:
192
Added:
val toc_entry : ?children:toc_entry list -> href:string -> string -> toc_entry
193
Added:
(** A TOC entry linking to a fragment.
194
Added:
195
Added:
@param children
196
Added:
nested sub-entries displayed as an indented list beneath this entry. *)
197
Added:
198
Added:
val toc : ?class_:string -> title:string -> toc_entry list -> node
199
Added:
(** A collapsible table of contents with support for nested sub-entries. Renders
200
Added:
as a disclosure widget with classes [toc], [toc-summary], and [toc-list].
201
Added:
Nested children produce nested [toc-list] elements for semantic indentation.
202
Added:
Returns {!nothing} when the list has fewer than two entries.
203
Added:
204
Added:
@param class_ an additional modifier alongside the base [toc] class. *)
205
Added:
206
Added:
(** {1 Trees}
207
Added:
208
Added:
A "tree" is any hierarchical list: rows that either stand alone or expand to
209
Added:
reveal nested rows. Compose these into {!items}. *)
210
Added:
211
Added:
val tree_leaf : ?modifier:string -> href:string -> string -> node
212
Added:
(** A leaf row.
213
Added:
214
Added:
@param modifier a class added alongside the base [tree-file] class. *)
215
Added:
216
Added:
val tree_branch :
217
Added:
?modifier:string ->
218
Added:
?expanded:bool ->
219
Added:
href:string ->
220
Added:
string ->
221
Added:
node list ->
222
Added:
node
223
Added:
(** A branch row.
224
Added:
225
Added:
Renders a disclosure inside the list item: the summary holds a chevron and a
226
Added:
link, the panel holds the nested list. Clicking the summary padding or the
227
Added:
chevron toggles; clicking the link navigates. Every nested collection on a
228
Added:
site therefore gets the same keyboard and pointer behaviour.
229
Added:
230
Added:
@param modifier a class added alongside the base [tree-dir] class.
231
Added:
@param expanded renders the nested list open on load. *)
232
Added:
233
Added:
val tree_overflow : ?class_:string -> href:string -> string -> node
234
Added:
(** A row standing in for entries omitted from a truncated list. *)
235
Added:
236
Added:
(** {1 Breadcrumbs} *)
237
Added:
238
Added:
type crumb
239
Added:
(** One step in a trail. Build with {!val-crumb}. *)
240
Added:
241
Added:
val crumb : ?href:string -> string -> crumb
242
Added:
(** A trail step. Without an href it renders as plain text, which is how the
243
Added:
current location should be shown. *)
244
Added:
245
Added:
val breadcrumb :
246
Added:
?id:string ->
247
Added:
?class_:string ->
248
Added:
?link_class:string ->
249
Added:
?separator_class:string ->
250
Added:
?separator_decorative:bool ->
251
Added:
separator:string ->
252
Added:
crumb list ->
253
Added:
node
254
Added:
(** A trail of links joined by a separator.
255
Added:
256
Added:
@param separator_decorative
257
Added:
hides the separators from assistive technology. Appropriate when the trail
258
Added:
already reads as a list of links; leave it off when the separator carries
259
Added:
meaning, such as a path delimiter worth reading aloud. *)
260
Added:
261
Added:
(** {1 Navigation} *)
262
Added:
263
Added:
type nav_link
264
Added:
(** A destination in a navigation list. Build with {!val-nav_link}. *)
265
Added:
266
Added:
val nav_link : ?current:bool -> href:string -> string -> nav_link
267
Added:
268
Added:
val navigation :
269
Added:
?id:string -> ?class_:string -> label:string -> node list -> node
270
Added:
(** A navigation landmark. [label] is required because it names the landmark for
271
Added:
assistive technology, which matters as soon as a page has more than one. *)
272
Added:
273
Added:
val nav_links :
274
Added:
?id:string -> ?class_:string -> ?item_class:string -> nav_link list -> node
275
Added:
(** A list of navigation links; the current page's item carries
276
Added:
[aria-current="page"]. *)
277
Added:
278
Added:
(** {1 Toolbars} *)
279
Added:
280
Added:
val toolbar : ?id:string -> ?class_:string -> ?label:string -> node list -> node
281
Added:
(** A bar of controls acting on the current page. An empty toolbar renders
282
Added:
nothing, so layout offsets that depend on its presence stay consistent. *)
283
Added:
284
Added:
val button_link :
285
Added:
?class_:string -> ?label:string -> href:string -> string -> node
286
Added:
(** A link styled as a toolbar button. Still a link, not a [button], because it
287
Added:
navigates rather than acting on the current page — which keeps middle-click
288
Added:
and "open in new tab" working. *)
289
Added:
290
Added:
val dismissible :
291
Added:
?class_:string ->
292
Added:
?dismiss_class:string ->
293
Added:
value_class:string ->
294
Added:
dismiss_href:string ->
295
Added:
dismiss_label:string ->
296
Added:
string ->
297
Added:
node
298
Added:
(** An active filter together with a control that removes it.
299
Added:
300
Added:
@param value_class styles the displayed value.
301
Added:
@param dismiss_label
302
Added:
accessible name of the remove control, required because its glyph conveys
303
Added:
nothing on its own. *)
304
Added:
305
Added:
(** {1 Pagination} *)
306
Added:
307
Added:
val pagination :
308
Added:
?label:string ->
309
Added:
?previous_text:string ->
310
Added:
?next_text:string ->
311
Added:
?previous_label:string ->
312
Added:
?next_label:string ->
313
Added:
?previous_href:string ->
314
Added:
?next_href:string ->
315
Added:
int ->
316
Added:
node
317
Added:
(** Previous/next controls around a page number.
318
Added:
319
Added:
A missing neighbour — an absent [previous_href] or [next_href] — renders as
320
Added:
an inert, aria-hidden placeholder rather than disappearing, so the controls
321
Added:
keep their position between pages.
322
Added:
323
Added:
The glyphs are decorative; [previous_label] and [next_label] carry the
324
Added:
accessible names. *)
325
Added:
326
Added:
(** {1 Code} *)
327
Added:
328
Added:
val code_listing :
329
Added:
?id:string -> ?class_:string -> ?anchor_prefix:string -> string -> node
330
Added:
(** A line-numbered listing of source text.
331
Added:
332
Added:
Every line gets a stable anchor so single lines can be linked and
333
Added:
highlighted. [anchor_prefix] namespaces those anchors, which is required
334
Added:
when one page shows more than one listing.
335
Added:
336
Added:
Content is emitted verbatim as plain text with no syntax colouring. For
337
Added:
highlighted output, use {!highlighted_code_listing} instead. *)
338
Added:
339
Added:
val highlighted_code_listing :
340
Added:
?id:string ->
341
Added:
?class_:string ->
342
Added:
?anchor_prefix:string ->
343
Added:
node list list ->
344
Added:
node
345
Added:
(** A line-numbered listing of pre-highlighted source code.
346
Added:
347
Added:
Like {!code_listing} but accepts lines already tokenized into styled spans
348
Added:
(e.g. from {!Highlight.highlight}). Each inner list represents one line's
349
Added:
worth of nodes; the function adds line numbers and anchors in the same grid
350
Added:
layout as [code_listing]. *)
351
Added:
352
Added:
(** {1 Diffs} *)
353
Added:
354
Added:
(** A viewer for line-oriented change sets. The data types are deliberately
355
Added:
plain so any producer of diffs can feed them. *)
356
Added:
module Diff : sig
357
Added:
type change = Unchanged | Added | Removed
358
Added:
359
Added:
type line = {
360
Added:
before : string; (** line number in the old revision, or [""] *)
361
Added:
after : string; (** line number in the new revision, or [""] *)
362
Added:
change : change;
363
Added:
content : string;
364
Added:
}
365
Added:
366
Added:
type section = { section_heading : string; lines : line list }
367
Added:
368
Added:
type file = {
369
Added:
path : string;
370
Added:
detail : string; (** provenance line, e.g. revision identifiers *)
371
Added:
sections : section list;
372
Added:
note : string option; (** shown instead of sections, e.g. binary files *)
373
Added:
}
374
Added:
375
Added:
val view : empty_message:string -> file list -> node list
376
Added:
(** Render a change set, or a single paragraph carrying [empty_message] when
377
Added:
there is nothing to show. *)
378
Added:
end
379
Added:
380
Added:
(** {1 Document scaffolding}
381
Added:
382
Added:
Two families, kept apart by prefix. The [document_] functions build the
383
Added:
envelope a browser reads — [html], [head], [body] — and the [page_]
384
Added:
functions build the landmarks a reader sees inside it. [document_head] and
385
Added:
[page_banner] are the pair most easily confused: the first is metadata, the
386
Added:
second is the visible masthead. *)
387
Added:
388
Added:
val meta_viewport : node
389
Added:
(** Opts the page into responsive layout. Without it mobile browsers assume a
390
Added:
desktop-width viewport and scale the page down. *)
391
Added:
392
Added:
val stylesheet : string -> node
393
Added:
val icon : ?media_type:string -> string -> node
394
Added:
395
Added:
val deferred_script : string -> node
396
Added:
(** An external script that does not block rendering. *)
397
Added:
398
Added:
val inline_script : string -> node
399
Added:
(** Inline behaviour. Reserved for progressive enhancement: pages must stay
400
Added:
usable when it does not run. *)
401
Added:
402
Added:
val skip_link : href:string -> string -> node
403
Added:
(** A link that jumps past repeated navigation, revealed on focus. Expected on
404
Added:
every page for keyboard users. *)
405
Added:
406
Added:
(** {2 The document envelope} *)
407
Added:
408
Added:
val document_head : title:string -> node list -> node
409
Added:
(** The [head] element: title, metadata and asset links. [title] comes first so
410
Added:
it cannot be forgotten. *)
411
Added:
412
Added:
val document_body : ?class_:string -> node list -> node
413
Added:
(** The [body] element. *)
414
Added:
415
Added:
val document : ?lang:string -> head:node -> body:node -> unit -> node
416
Added:
(** A complete document. [lang] defaults to ["en"]; set it so screen readers
417
Added:
pick the right pronunciation. *)
418
Added:
419
Added:
(** {2 Landmarks within the page} *)
420
Added:
421
Added:
val page_banner : ?id:string -> ?class_:string -> node list -> node
422
Added:
(** The [header] element introducing the page — its masthead. Named for the ARIA
423
Added:
landmark it maps to, and to keep it distinct from {!val-document_head}. *)
424
Added:
425
Added:
val page_content : ?id:string -> ?class_:string -> node list -> node
426
Added:
(** The [main] element: the content unique to this page, which the skip link
427
Added:
targets. At most one per document. *)
428
Added:
429
Added:
val page_footer : ?class_:string -> node list -> node
430
Added:
(** The [footer] element closing the page. *)
431
Added:
432
Added:
(** {1 Responses} *)
433
Added:
434
Added:
val respond : ?status:[< Dream.status ] -> node -> Dream.response Dream.promise
435
Added:
(** Send a rendered document as an HTTP response. *)
lib/views/components.ml
@@ -165,4 +165,4 @@
165
165
Markdown and Org mode receive dedicated rendering; other README filenames
166
166
use the Markdown-compatible fallback until additional formats are added. *)
167
167
let inline_readme ?(filename = "README.md") content =
168
Removed:
Prose.render ~filename content
168
Added:
Prose.Render.render ~filename content
lib/views/repo.ml
@@ -262,11 +262,11 @@
262
262
in
263
263
Ui.block ~class_:"image-preview"
264
264
[ Ui.image ~class_:"file-image" ~alt:filename ~src () ]
265
Removed:
| Some filename when Prose.is_doc_filename filename ->
266
Removed:
Prose.render ~filename blob.content
265
Added:
| Some filename when Prose.Render.is_doc_filename filename ->
266
Added:
Prose.Render.render ~filename blob.content
267
267
| _ ->
268
Removed:
let language = Syntax.detect ~filename blob.content in
269
Removed:
let lines = Highlight.highlight ~lang:language blob.content in
268
Added:
let language = Highlight.Detect.detect ~filename blob.content in
269
Added:
let lines = Highlight.Engine.highlight ~lang:language blob.content in
270
270
Ui.highlighted_code_listing ~id:"blob" lines
271
271
in
272
272
let toolbar = [ path_trail context.repo trail ] in
lib/views/ui.ml
@@ -1,471 +0,0 @@
1
Removed:
(* Implementation of the site building blocks. The API and its rationale are
2
Removed:
documented in ui.mli; comments here cover implementation choices only.
3
Removed:
4
Removed:
Attribute order is deliberate and load-bearing for readability of the
5
Removed:
rendered HTML: id, then href, then class, then ARIA. Keeping it uniform means
6
Removed:
a page's markup diffs cleanly when a block changes. *)
7
Removed:
8
Removed:
open Dream_html
9
Removed:
10
Removed:
type node = Dream_html.node
11
Removed:
12
Removed:
let classes parts =
13
Removed:
parts |> List.filter (fun part -> part <> "") |> String.concat " "
14
Removed:
15
Removed:
(* Optional attributes collapse to the empty list so they can be concatenated
16
Removed:
unconditionally at each call site. *)
17
Removed:
let opt_id = function None -> [] | Some value -> [ HTML.id "%s" value ]
18
Removed:
let opt_class = function None -> [] | Some value -> [ HTML.class_ "%s" value ]
19
Removed:
let opt_aria_label = function None -> [] | Some v -> [ Aria.label "%s" v ]
20
Removed:
let flag_current = function false -> [] | true -> [ Aria.current `page ]
21
Removed:
let flag_open = function false -> [] | true -> HTML.[ open_ ]
22
Removed:
23
Removed:
(* Text and grouping *)
24
Removed:
25
Removed:
let nothing = HTML.null []
26
Removed:
let text value = txt "%s" value
27
Removed:
let group nodes = HTML.null nodes
28
Removed:
29
Removed:
(* Inline *)
30
Removed:
31
Removed:
let inline ?class_ ?(decorative = false) children =
32
Removed:
let hidden = if decorative then [ Aria.hidden true ] else [] in
33
Removed:
HTML.span (opt_class class_ @ hidden) children
34
Removed:
35
Removed:
let inline_text ?class_ ?decorative value =
36
Removed:
inline ?class_ ?decorative [ text value ]
37
Removed:
38
Removed:
(* Links *)
39
Removed:
40
Removed:
let link ?id ?class_ ?label ~href children =
41
Removed:
HTML.a
42
Removed:
(opt_id id
43
Removed:
@ [ HTML.href "%s" href ]
44
Removed:
@ opt_class class_ @ opt_aria_label label)
45
Removed:
children
46
Removed:
47
Removed:
let text_link ?id ?class_ ?label ~href value =
48
Removed:
link ?id ?class_ ?label ~href [ text value ]
49
Removed:
50
Removed:
(* Images *)
51
Removed:
52
Removed:
let image ?class_ ?alt ~src () =
53
Removed:
let describe =
54
Removed:
match alt with
55
Removed:
| Some value -> [ HTML.alt "%s" value ]
56
Removed:
(* An empty alt alone is enough for most readers, but the explicit
57
Removed:
presentation role removes any doubt. *)
58
Removed:
| None -> [ HTML.alt ""; HTML.role `presentation ]
59
Removed:
in
60
Removed:
HTML.img ((HTML.src "%s" src :: describe) @ opt_class class_)
61
Removed:
62
Removed:
(* Blocks *)
63
Removed:
64
Removed:
let block ?id ?class_ children =
65
Removed:
HTML.div (opt_id id @ opt_class class_) children
66
Removed:
67
Removed:
let region ?id ?class_ children =
68
Removed:
HTML.section (opt_id id @ opt_class class_) children
69
Removed:
70
Removed:
let paragraph ?class_ children = HTML.p (opt_class class_) children
71
Removed:
let paragraph_text ?class_ value = paragraph ?class_ [ text value ]
72
Removed:
73
Removed:
let heading ?id ?(level = 1) ?class_ children =
74
Removed:
let element =
75
Removed:
match level with
76
Removed:
| 1 -> HTML.h1
77
Removed:
| 2 -> HTML.h2
78
Removed:
| 3 -> HTML.h3
79
Removed:
| 4 -> HTML.h4
80
Removed:
| 5 -> HTML.h5
81
Removed:
| _ -> HTML.h6
82
Removed:
in
83
Removed:
element (opt_id id @ opt_class class_) children
84
Removed:
85
Removed:
let code_block ?class_ children =
86
Removed:
(* Pre-serialize the entire <code> block into a single raw text node placed
87
Removed:
directly inside <pre>. This prevents the pretty-printer from injecting
88
Removed:
visible whitespace between the <pre> open tag and the code content.
89
Removed:
Dream_html.to_string appends a newline after each element; strip those to
90
Removed:
avoid spurious line breaks between inline spans. *)
91
Removed:
let raw_content =
92
Removed:
children
93
Removed:
|> List.map (fun node ->
94
Removed:
let s = Dream_html.to_string node in
95
Removed:
if String.length s > 0 && s.[String.length s - 1] = '\n' then
96
Removed:
String.sub s 0 (String.length s - 1)
97
Removed:
else s)
98
Removed:
|> String.concat ""
99
Removed:
in
100
Removed:
HTML.pre (opt_class class_) [ txt ~raw:true "<code>%s</code>" raw_content ]
101
Removed:
102
Removed:
(* Lists *)
103
Removed:
104
Removed:
let items ?id ?class_ children = HTML.ul (opt_id id @ opt_class class_) children
105
Removed:
106
Removed:
let ordered_items ?id ?class_ children =
107
Removed:
HTML.ol (opt_id id @ opt_class class_) children
108
Removed:
109
Removed:
let item ?class_ ?(current = false) children =
110
Removed:
HTML.li (opt_class class_ @ flag_current current) children
111
Removed:
112
Removed:
let items_of ?id ?class_ render values =
113
Removed:
items ?id ?class_ (List.map render values)
114
Removed:
115
Removed:
let code_inline ?class_ value = HTML.code (opt_class class_) [ text value ]
116
Removed:
117
Removed:
(* Badges *)
118
Removed:
119
Removed:
let badge ?(base_class = "badge") ?variant ?href value =
120
Removed:
let classes =
121
Removed:
match variant with
122
Removed:
| None -> base_class
123
Removed:
| Some variant -> Printf.sprintf "%s %s-%s" base_class base_class variant
124
Removed:
in
125
Removed:
(* Only the text is linked: a link wrapping the whole badge would make its
126
Removed:
padding clickable, which reads as a button rather than a label. *)
127
Removed:
let body =
128
Removed:
match href with
129
Removed:
| None -> [ text value ]
130
Removed:
| Some href -> [ link ~href [ text value ] ]
131
Removed:
in
132
Removed:
inline ~class_:classes body
133
Removed:
134
Removed:
(* Time *)
135
Removed:
136
Removed:
let timestamp ~machine display =
137
Removed:
HTML.time [ HTML.datetime "%s" machine ] [ text display ]
138
Removed:
139
Removed:
(* Definition lists *)
140
Removed:
141
Removed:
let definitions ?class_ pairs =
142
Removed:
(* dt and dd are siblings, not nested, so each pair becomes a flat group. *)
143
Removed:
let entry (term, description) =
144
Removed:
group [ HTML.dt [] [ text term ]; HTML.dd [] description ]
145
Removed:
in
146
Removed:
HTML.dl (opt_class class_) (List.map entry pairs)
147
Removed:
148
Removed:
(* Disclosure *)
149
Removed:
150
Removed:
let chevron ?(class_ = "tree-chevron") () =
151
Removed:
inline ~class_ ~decorative:true [ text "\xe2\x80\xba" ]
152
Removed:
153
Removed:
let disclosure ?id ?class_ ?(expanded = false) ?summary_class ~summary children
154
Removed:
=
155
Removed:
HTML.details
156
Removed:
(opt_id id @ opt_class class_ @ flag_open expanded)
157
Removed:
(HTML.summary (opt_class summary_class) summary :: children)
158
Removed:
159
Removed:
let css_toggle ~id:toggle_id ~toggle_class ~control_class ~label:control_label
160
Removed:
~glyph () =
161
Removed:
group
162
Removed:
[
163
Removed:
HTML.input
164
Removed:
[
165
Removed:
HTML.type_ "checkbox";
166
Removed:
HTML.id "%s" toggle_id;
167
Removed:
HTML.class_ "%s" toggle_class;
168
Removed:
];
169
Removed:
HTML.label
170
Removed:
[
171
Removed:
HTML.for_ "%s" toggle_id;
172
Removed:
HTML.class_ "%s" control_class;
173
Removed:
Aria.label "%s" control_label;
174
Removed:
]
175
Removed:
[ text glyph ];
176
Removed:
]
177
Removed:
178
Removed:
(* Table of contents *)
179
Removed:
180
Removed:
type toc_entry = {
181
Removed:
toc_href : string;
182
Removed:
toc_label : string;
183
Removed:
toc_children : toc_entry list;
184
Removed:
}
185
Removed:
186
Removed:
let toc_entry ?(children = []) ~href label =
187
Removed:
{ toc_href = href; toc_label = label; toc_children = children }
188
Removed:
189
Removed:
let rec toc_items entries =
190
Removed:
items ~class_:"toc-list"
191
Removed:
(List.map
192
Removed:
(fun { toc_href; toc_label; toc_children } ->
193
Removed:
let nested =
194
Removed:
match toc_children with [] -> [] | kids -> [ toc_items kids ]
195
Removed:
in
196
Removed:
item (text_link ~href:toc_href toc_label :: nested))
197
Removed:
entries)
198
Removed:
199
Removed:
let toc ?class_ ~title entries =
200
Removed:
let rec count = function
201
Removed:
| [] -> 0
202
Removed:
| e :: rest -> 1 + count e.toc_children + count rest
203
Removed:
in
204
Removed:
match entries with
205
Removed:
| [] -> nothing
206
Removed:
| _ when count entries < 2 -> nothing
207
Removed:
| _ ->
208
Removed:
let outer_class = classes [ "toc"; Option.value class_ ~default:"" ] in
209
Removed:
disclosure ~class_:outer_class ~summary_class:"toc-summary"
210
Removed:
~summary:[ text title ]
211
Removed:
[ toc_items entries ]
212
Removed:
213
Removed:
(* Trees *)
214
Removed:
215
Removed:
let tree_leaf ?(modifier = "") ~href label =
216
Removed:
item ~class_:(classes [ "tree-file"; modifier ]) [ text_link ~href label ]
217
Removed:
218
Removed:
let tree_branch ?(modifier = "") ?(expanded = false) ~href label children =
219
Removed:
item
220
Removed:
~class_:(classes [ "tree-dir"; modifier ])
221
Removed:
[
222
Removed:
disclosure ~expanded ~summary_class:"tree-toggle"
223
Removed:
~summary:[ chevron (); text_link ~class_:"tree-link" ~href label ]
224
Removed:
[ items ~class_:"tree-nested" children ];
225
Removed:
]
226
Removed:
227
Removed:
let tree_overflow ?(class_ = "tree-overflow") ~href label =
228
Removed:
item ~class_ [ text_link ~href label ]
229
Removed:
230
Removed:
(* Breadcrumbs *)
231
Removed:
232
Removed:
type crumb = { crumb_text : string; crumb_href : string option }
233
Removed:
234
Removed:
let crumb ?href text = { crumb_text = text; crumb_href = href }
235
Removed:
236
Removed:
let breadcrumb ?id ?class_ ?link_class ?separator_class
237
Removed:
?(separator_decorative = false) ~separator crumbs =
238
Removed:
(* The separator precedes every crumb but the first, so the trail has no
239
Removed:
leading or trailing delimiter. *)
240
Removed:
let render index { crumb_text; crumb_href } =
241
Removed:
let body =
242
Removed:
match crumb_href with
243
Removed:
| Some href -> text_link ?class_:link_class ~href crumb_text
244
Removed:
| None -> inline_text ?class_:link_class crumb_text
245
Removed:
in
246
Removed:
if index = 0 then body
247
Removed:
else
248
Removed:
group
249
Removed:
[
250
Removed:
inline_text ?class_:separator_class ~decorative:separator_decorative
251
Removed:
separator;
252
Removed:
body;
253
Removed:
]
254
Removed:
in
255
Removed:
HTML.span (opt_id id @ opt_class class_) (List.mapi render crumbs)
256
Removed:
257
Removed:
(* Navigation *)
258
Removed:
259
Removed:
type nav_link = { nav_href : string; nav_text : string; nav_current : bool }
260
Removed:
261
Removed:
let nav_link ?(current = false) ~href text =
262
Removed:
{ nav_href = href; nav_text = text; nav_current = current }
263
Removed:
264
Removed:
let navigation ?id ?class_ ~label children =
265
Removed:
HTML.nav (opt_id id @ opt_class class_ @ [ Aria.label "%s" label ]) children
266
Removed:
267
Removed:
let nav_links ?id ?class_ ?item_class links =
268
Removed:
(* aria-current goes on the list item rather than the link so the marker
269
Removed:
survives styling the item as the highlighted row. *)
270
Removed:
let render { nav_href; nav_text; nav_current } =
271
Removed:
item ?class_:item_class ~current:nav_current
272
Removed:
[ text_link ~href:nav_href nav_text ]
273
Removed:
in
274
Removed:
items ?id ?class_ (List.map render links)
275
Removed:
276
Removed:
(* Toolbars *)
277
Removed:
278
Removed:
let toolbar ?id ?class_ ?label children =
279
Removed:
match children with
280
Removed:
| [] -> nothing
281
Removed:
| _ ->
282
Removed:
HTML.div
283
Removed:
(opt_id id @ opt_class class_
284
Removed:
@ [ HTML.role `toolbar ]
285
Removed:
@ opt_aria_label label)
286
Removed:
children
287
Removed:
288
Removed:
let button_link ?(class_ = "toolbar-button") ?label ~href text =
289
Removed:
text_link ~class_ ?label ~href text
290
Removed:
291
Removed:
let dismissible ?(class_ = "toolbar-filter")
292
Removed:
?(dismiss_class = "toolbar-dismiss") ~value_class ~dismiss_href
293
Removed:
~dismiss_label value =
294
Removed:
inline ~class_
295
Removed:
[
296
Removed:
inline_text ~class_:value_class value;
297
Removed:
text_link ~class_:dismiss_class ~label:dismiss_label ~href:dismiss_href
298
Removed:
"\xc3\x97";
299
Removed:
]
300
Removed:
301
Removed:
(* Pagination *)
302
Removed:
303
Removed:
let pagination ?(label = "Pagination") ?(previous_text = "<") ?(next_text = ">")
304
Removed:
?(previous_label = "Previous page") ?(next_label = "Next page")
305
Removed:
?previous_href ?next_href page_number =
306
Removed:
(* An unavailable neighbour still occupies its slot, so the page number does
307
Removed:
not shift horizontally as the reader moves through the list. *)
308
Removed:
let control href_opt glyph control_label =
309
Removed:
match href_opt with
310
Removed:
| Some href ->
311
Removed:
text_link ~class_:"pagination-btn" ~label:control_label ~href glyph
312
Removed:
| None ->
313
Removed:
inline_text ~class_:"pagination-btn pagination-disabled"
314
Removed:
~decorative:true glyph
315
Removed:
in
316
Removed:
navigation ~class_:"toolbar-pagination" ~label
317
Removed:
[
318
Removed:
control previous_href previous_text previous_label;
319
Removed:
HTML.span
320
Removed:
[ HTML.class_ "pagination-page"; Aria.current `page ]
321
Removed:
[ text (string_of_int page_number) ];
322
Removed:
control next_href next_text next_label;
323
Removed:
]
324
Removed:
325
Removed:
(* Code *)
326
Removed:
327
Removed:
let numbered_lines ?id ?class_ ?(anchor_prefix = "") render_line lines =
328
Removed:
let numbered_line index line =
329
Removed:
let number = index + 1 in
330
Removed:
let name = Printf.sprintf "%s%d" anchor_prefix number in
331
Removed:
[
332
Removed:
HTML.a
333
Removed:
[
334
Removed:
HTML.id "%s" name;
335
Removed:
HTML.class_ "line-anchor";
336
Removed:
HTML.href "#%s" name;
337
Removed:
Aria.label "Line %d" number;
338
Removed:
]
339
Removed:
[ text (string_of_int number) ];
340
Removed:
HTML.span [ HTML.class_ "line" ] (render_line line);
341
Removed:
]
342
Removed:
in
343
Removed:
block ?id ?class_ (List.mapi numbered_line lines |> List.concat)
344
Removed:
345
Removed:
let code_listing ?id ?class_ ?anchor_prefix content =
346
Removed:
(* Anchor and text alternate as siblings of one grid container, so the
347
Removed:
stylesheet can align numbers against wrapping lines without a table. The
348
Removed:
leading tab and trailing newline preserve the source's shape when the
349
Removed:
listing is copied. *)
350
Removed:
numbered_lines ?id ?class_ ?anchor_prefix
351
Removed:
(fun line -> [ txt "\t%s\n" line ])
352
Removed:
(String.split_on_char '\n' content)
353
Removed:
354
Removed:
let highlighted_code_listing ?id ?class_ ?anchor_prefix lines =
355
Removed:
(* Same grid layout as code_listing, but each line is a list of pre-rendered
356
Removed:
nodes (highlighted spans) rather than plain text. The tab/newline framing
357
Removed:
is identical so copy-paste behaviour is preserved. *)
358
Removed:
numbered_lines ?id ?class_ ?anchor_prefix
359
Removed:
(fun line_nodes -> txt "\t" :: line_nodes)
360
Removed:
lines
361
Removed:
362
Removed:
(* Diffs *)
363
Removed:
364
Removed:
module Diff = struct
365
Removed:
type change = Unchanged | Added | Removed
366
Removed:
367
Removed:
type line = {
368
Removed:
before : string;
369
Removed:
after : string;
370
Removed:
change : change;
371
Removed:
content : string;
372
Removed:
}
373
Removed:
374
Removed:
type section = { section_heading : string; lines : line list }
375
Removed:
376
Removed:
type file = {
377
Removed:
path : string;
378
Removed:
detail : string;
379
Removed:
sections : section list;
380
Removed:
note : string option;
381
Removed:
}
382
Removed:
383
Removed:
let line_node { before; after; change; content } =
384
Removed:
let variant, marker, announcement =
385
Removed:
match change with
386
Removed:
| Unchanged -> ("context", " ", "")
387
Removed:
| Added -> ("addition", "+", "Added: ")
388
Removed:
| Removed -> ("deletion", "-", "Removed: ")
389
Removed:
in
390
Removed:
block ~class_:("diff-line " ^ variant)
391
Removed:
[
392
Removed:
inline_text ~class_:"line-number" before;
393
Removed:
inline_text ~class_:"line-number" after;
394
Removed:
inline_text ~class_:"diff-marker" ~decorative:true marker;
395
Removed:
(* Restores, for screen readers, the meaning the marker conveys
396
Removed:
visually. *)
397
Removed:
inline_text ~class_:"sr-only" announcement;
398
Removed:
inline_text ~class_:"diff-text" content;
399
Removed:
]
400
Removed:
401
Removed:
let section_node { section_heading; lines } =
402
Removed:
disclosure ~class_:"diff-hunk" ~expanded:true ~summary_class:"hunk-header"
403
Removed:
~summary:[ text section_heading ]
404
Removed:
[
405
Removed:
(* The inner scroll container keeps long lines from widening the page. *)
406
Removed:
block ~class_:"diff-lines-scroll"
407
Removed:
[ block ~class_:"diff-lines" (List.map line_node lines) ];
408
Removed:
]
409
Removed:
410
Removed:
let file_id index = Printf.sprintf "file-%d" (index + 1)
411
Removed:
412
Removed:
let file_node index { path; detail; sections; note } =
413
Removed:
let body =
414
Removed:
match note with
415
Removed:
| Some note -> [ paragraph_text ~class_:"binary-diff" note ]
416
Removed:
| None -> List.map section_node sections
417
Removed:
in
418
Removed:
disclosure ~class_:"diff-file" ~expanded:true
419
Removed:
~summary_class:"diff-file-header"
420
Removed:
~summary:[ text path ]
421
Removed:
~id:(file_id index)
422
Removed:
(block ~class_:"diff-meta" [ text detail ] :: body)
423
Removed:
424
Removed:
let file_toc files =
425
Removed:
toc ~class_:"diff-toc" ~title:"Changed files"
426
Removed:
(List.mapi
427
Removed:
(fun index { path; _ } -> toc_entry ~href:("#" ^ file_id index) path)
428
Removed:
files)
429
Removed:
430
Removed:
let view ~empty_message = function
431
Removed:
| [] -> [ paragraph_text empty_message ]
432
Removed:
| files -> file_toc files :: List.mapi file_node files
433
Removed:
end
434
Removed:
435
Removed:
(* Document scaffolding *)
436
Removed:
437
Removed:
let meta_viewport =
438
Removed:
HTML.meta
439
Removed:
[ HTML.name "viewport"; HTML.content "width=device-width, initial-scale=1" ]
440
Removed:
441
Removed:
let stylesheet href = HTML.link [ HTML.rel "stylesheet"; HTML.href "%s" href ]
442
Removed:
443
Removed:
let icon ?(media_type = "image/x-icon") href =
444
Removed:
HTML.link [ HTML.rel "icon"; HTML.type_ "%s" media_type; HTML.href "%s" href ]
445
Removed:
446
Removed:
let deferred_script src = HTML.script [ HTML.src "%s" src; HTML.defer ] ""
447
Removed:
let inline_script source = HTML.script [] "%s" source
448
Removed:
449
Removed:
let document_head ~title:document_title extra =
450
Removed:
HTML.head [] (HTML.title [] "%s" document_title :: extra)
451
Removed:
452
Removed:
let skip_link ~href label = text_link ~class_:"skip-link" ~href label
453
Removed:
454
Removed:
let page_banner ?id ?class_ children =
455
Removed:
HTML.header (opt_id id @ opt_class class_) children
456
Removed:
457
Removed:
let page_content ?id ?class_ children =
458
Removed:
HTML.main (opt_id id @ opt_class class_) children
459
Removed:
460
Removed:
let page_footer ?class_ children = HTML.footer (opt_class class_) children
461
Removed:
let document_body ?class_ children = HTML.body (opt_class class_) children
462
Removed:
463
Removed:
let document ?(lang = "en") ~head ~body () =
464
Removed:
HTML.html [ HTML.lang "%s" lang ] [ head; body ]
465
Removed:
466
Removed:
(* Responses *)
467
Removed:
468
Removed:
let respond ?status page =
469
Removed:
match status with
470
Removed:
| None -> Dream_html.respond page
471
Removed:
| Some status -> Dream_html.respond ~status page
lib/views/ui.mli
@@ -1,435 +0,0 @@
1
Removed:
(** Generic site building blocks.
2
Removed:
3
Removed:
This module is the only place in the view layer that names HTML elements. It
4
Removed:
knows nothing about the application domain — no Git, repositories, or ogit
5
Removed:
routes — so the same vocabulary would serve any static-first web
6
Removed:
application: every function takes plain strings and already-built nodes.
7
Removed:
8
Removed:
{2 Conventions}
9
Removed:
10
Removed:
- {b Semantic first.} Each block picks the most meaningful element available
11
Removed:
([nav], [header], [time], [dl], [details]) rather than a [div] with a
12
Removed:
class. Callers choose blocks by meaning, not by appearance.
13
Removed:
- {b Classes are a contract.} Blocks emit a fixed vocabulary of class names
14
Removed:
— [tree-dir], [tree-toggle], [line-anchor], [pagination-btn] and so on —
15
Removed:
which a stylesheet is expected to implement. Those names are structural,
16
Removed:
never domain-specific: a "tree" here is any hierarchical list, not a file
17
Removed:
tree in particular. Optional [?class_] arguments add a modifier
18
Removed:
{i alongside} the base class rather than replacing it.
19
Removed:
- {b No scripting.} Interactive blocks ({!val-disclosure},
20
Removed:
{!val-css_toggle}) rely on native HTML and CSS, so pages stay usable with
21
Removed:
JavaScript disabled.
22
Removed:
- {b Accessibility is not optional.} Where a block can only be used
23
Removed:
correctly with an accessible name, that name is a required argument rather
24
Removed:
than an optional one — see {!val-navigation} and {!val-dismissible}.
25
Removed:
26
Removed:
Nothing here performs I/O. The attribute plumbing that assembles these
27
Removed:
blocks is deliberately not exported: callers compose blocks, they do not
28
Removed:
assemble attributes. *)
29
Removed:
30
Removed:
type node = Dream_html.node
31
Removed:
(** A rendered fragment. Exposed so callers can annotate lists of children
32
Removed:
without opening [Dream_html] themselves. *)
33
Removed:
34
Removed:
val classes : string list -> string
35
Removed:
(** Join class names, dropping empty ones. Lets callers pass a modifier without
36
Removed:
having to manage separators or risk a stray leading space. *)
37
Removed:
38
Removed:
(** {1 Text and grouping} *)
39
Removed:
40
Removed:
val nothing : node
41
Removed:
(** Renders no markup. Use for absent optional content. *)
42
Removed:
43
Removed:
val text : string -> node
44
Removed:
(** Escaped text. *)
45
Removed:
46
Removed:
val group : node list -> node
47
Removed:
(** Several nodes where one is expected, without introducing a wrapper element.
48
Removed:
*)
49
Removed:
50
Removed:
(** {1 Inline} *)
51
Removed:
52
Removed:
val inline : ?class_:string -> ?decorative:bool -> node list -> node
53
Removed:
(** An inline run of text or nodes.
54
Removed:
55
Removed:
@param decorative
56
Removed:
hides the span from assistive technology, for glyphs that repeat
57
Removed:
information already available as text. *)
58
Removed:
59
Removed:
val inline_text : ?class_:string -> ?decorative:bool -> string -> node
60
Removed:
(** {!val-inline} around a single string. *)
61
Removed:
62
Removed:
(** {1 Links} *)
63
Removed:
64
Removed:
val link :
65
Removed:
?id:string ->
66
Removed:
?class_:string ->
67
Removed:
?label:string ->
68
Removed:
href:string ->
69
Removed:
node list ->
70
Removed:
node
71
Removed:
(** A hyperlink.
72
Removed:
73
Removed:
@param label
74
Removed:
an accessible name, for links whose visible text is not descriptive on its
75
Removed:
own. *)
76
Removed:
77
Removed:
val text_link :
78
Removed:
?id:string -> ?class_:string -> ?label:string -> href:string -> string -> node
79
Removed:
(** {!link} around a single string. *)
80
Removed:
81
Removed:
(** {1 Images} *)
82
Removed:
83
Removed:
val image : ?class_:string -> ?alt:string -> src:string -> unit -> node
84
Removed:
(** @param alt
85
Removed:
omit for decorative images; the block then marks itself presentational so
86
Removed:
screen readers skip it. *)
87
Removed:
88
Removed:
(** {1 Blocks} *)
89
Removed:
90
Removed:
val block : ?id:string -> ?class_:string -> node list -> node
91
Removed:
(** A generic grouping box. Reach for {!region} or one of the page landmarks
92
Removed:
first; this is for layout wrappers that carry no meaning of their own. *)
93
Removed:
94
Removed:
val region : ?id:string -> ?class_:string -> node list -> node
95
Removed:
(** A self-contained part of a page. *)
96
Removed:
97
Removed:
val paragraph : ?class_:string -> node list -> node
98
Removed:
val paragraph_text : ?class_:string -> string -> node
99
Removed:
100
Removed:
val heading : ?id:string -> ?level:int -> ?class_:string -> node list -> node
101
Removed:
(** A heading. [level] follows the document outline: 1 for the page's subject, 2
102
Removed:
and 3 for nested sections. Skipping levels breaks screen-reader navigation,
103
Removed:
so pass the level that matches the structure rather than the one that looks
104
Removed:
right. Levels outside 1–6 clamp to 6. [id] provides a local fragment target.
105
Removed:
*)
106
Removed:
107
Removed:
val code_block : ?class_:string -> node list -> node
108
Removed:
(** A preformatted code block without line numbers. The children can be escaped
109
Removed:
text or server-rendered syntax-highlight spans. *)
110
Removed:
111
Removed:
(** {1 Lists} *)
112
Removed:
113
Removed:
val items : ?id:string -> ?class_:string -> node list -> node
114
Removed:
(** An unordered list wrapping already-built {!item} nodes. *)
115
Removed:
116
Removed:
val ordered_items : ?id:string -> ?class_:string -> node list -> node
117
Removed:
(** An ordered list wrapping already-built {!item} nodes. *)
118
Removed:
119
Removed:
val item : ?class_:string -> ?current:bool -> node list -> node
120
Removed:
(** A list entry.
121
Removed:
122
Removed:
@param current
123
Removed:
marks the entry as the one matching the current page, for navigation
124
Removed:
lists. *)
125
Removed:
126
Removed:
val items_of : ?id:string -> ?class_:string -> ('a -> node) -> 'a list -> node
127
Removed:
(** A list built from values, saving callers a [List.map]. *)
128
Removed:
129
Removed:
val code_inline : ?class_:string -> string -> node
130
Removed:
(** An inline code fragment. *)
131
Removed:
132
Removed:
(** {1 Badges} *)
133
Removed:
134
Removed:
val badge :
135
Removed:
?base_class:string -> ?variant:string -> ?href:string -> string -> node
136
Removed:
(** A small rounded label. [variant] is appended to the base class as
137
Removed:
[<base> <base>-<variant>] so a stylesheet can colour each kind. [href] turns
138
Removed:
the label's text into a link while leaving the badge itself inert. *)
139
Removed:
140
Removed:
(** {1 Time} *)
141
Removed:
142
Removed:
val timestamp : machine:string -> string -> node
143
Removed:
(** A machine-readable timestamp: [machine] fills the [datetime] attribute, the
144
Removed:
positional argument is the visible text. *)
145
Removed:
146
Removed:
(** {1 Definition lists} *)
147
Removed:
148
Removed:
val definitions : ?class_:string -> (string * node list) list -> node
149
Removed:
(** Term/description pairs, for metadata panels. *)
150
Removed:
151
Removed:
(** {1 Disclosure} *)
152
Removed:
153
Removed:
val chevron : ?class_:string -> unit -> node
154
Removed:
(** Decorative open/close indicator, rotated by CSS from the enclosing
155
Removed:
[details]. It carries no textual meaning, so it is hidden from assistive
156
Removed:
technology. *)
157
Removed:
158
Removed:
val disclosure :
159
Removed:
?id:string ->
160
Removed:
?class_:string ->
161
Removed:
?expanded:bool ->
162
Removed:
?summary_class:string ->
163
Removed:
summary:node list ->
164
Removed:
node list ->
165
Removed:
node
166
Removed:
(** A native disclosure widget: [details] wrapping a clickable [summary] and its
167
Removed:
panel. No JavaScript involved.
168
Removed:
169
Removed:
@param expanded renders the panel open on load.
170
Removed:
@param summary the always-visible header contents. *)
171
Removed:
172
Removed:
val css_toggle :
173
Removed:
id:string ->
174
Removed:
toggle_class:string ->
175
Removed:
control_class:string ->
176
Removed:
label:string ->
177
Removed:
glyph:string ->
178
Removed:
unit ->
179
Removed:
node
180
Removed:
(** A CSS-only toggle: a visually hidden checkbox paired with a [label] acting
181
Removed:
as its control. Lets stylesheets reveal and collapse content without
182
Removed:
scripting.
183
Removed:
184
Removed:
@param label the accessible name of the control, whose [glyph] has none. *)
185
Removed:
186
Removed:
(** {1 Table of contents} *)
187
Removed:
188
Removed:
type toc_entry
189
Removed:
(** One entry in a table of contents. Build with {!val-toc_entry}. Entries may
190
Removed:
contain nested children to represent subheading hierarchy. *)
191
Removed:
192
Removed:
val toc_entry : ?children:toc_entry list -> href:string -> string -> toc_entry
193
Removed:
(** A TOC entry linking to a fragment.
194
Removed:
195
Removed:
@param children
196
Removed:
nested sub-entries displayed as an indented list beneath this entry. *)
197
Removed:
198
Removed:
val toc : ?class_:string -> title:string -> toc_entry list -> node
199
Removed:
(** A collapsible table of contents with support for nested sub-entries. Renders
200
Removed:
as a disclosure widget with classes [toc], [toc-summary], and [toc-list].
201
Removed:
Nested children produce nested [toc-list] elements for semantic indentation.
202
Removed:
Returns {!nothing} when the list has fewer than two entries.
203
Removed:
204
Removed:
@param class_ an additional modifier alongside the base [toc] class. *)
205
Removed:
206
Removed:
(** {1 Trees}
207
Removed:
208
Removed:
A "tree" is any hierarchical list: rows that either stand alone or expand to
209
Removed:
reveal nested rows. Compose these into {!items}. *)
210
Removed:
211
Removed:
val tree_leaf : ?modifier:string -> href:string -> string -> node
212
Removed:
(** A leaf row.
213
Removed:
214
Removed:
@param modifier a class added alongside the base [tree-file] class. *)
215
Removed:
216
Removed:
val tree_branch :
217
Removed:
?modifier:string ->
218
Removed:
?expanded:bool ->
219
Removed:
href:string ->
220
Removed:
string ->
221
Removed:
node list ->
222
Removed:
node
223
Removed:
(** A branch row.
224
Removed:
225
Removed:
Renders a disclosure inside the list item: the summary holds a chevron and a
226
Removed:
link, the panel holds the nested list. Clicking the summary padding or the
227
Removed:
chevron toggles; clicking the link navigates. Every nested collection on a
228
Removed:
site therefore gets the same keyboard and pointer behaviour.
229
Removed:
230
Removed:
@param modifier a class added alongside the base [tree-dir] class.
231
Removed:
@param expanded renders the nested list open on load. *)
232
Removed:
233
Removed:
val tree_overflow : ?class_:string -> href:string -> string -> node
234
Removed:
(** A row standing in for entries omitted from a truncated list. *)
235
Removed:
236
Removed:
(** {1 Breadcrumbs} *)
237
Removed:
238
Removed:
type crumb
239
Removed:
(** One step in a trail. Build with {!val-crumb}. *)
240
Removed:
241
Removed:
val crumb : ?href:string -> string -> crumb
242
Removed:
(** A trail step. Without an href it renders as plain text, which is how the
243
Removed:
current location should be shown. *)
244
Removed:
245
Removed:
val breadcrumb :
246
Removed:
?id:string ->
247
Removed:
?class_:string ->
248
Removed:
?link_class:string ->
249
Removed:
?separator_class:string ->
250
Removed:
?separator_decorative:bool ->
251
Removed:
separator:string ->
252
Removed:
crumb list ->
253
Removed:
node
254
Removed:
(** A trail of links joined by a separator.
255
Removed:
256
Removed:
@param separator_decorative
257
Removed:
hides the separators from assistive technology. Appropriate when the trail
258
Removed:
already reads as a list of links; leave it off when the separator carries
259
Removed:
meaning, such as a path delimiter worth reading aloud. *)
260
Removed:
261
Removed:
(** {1 Navigation} *)
262
Removed:
263
Removed:
type nav_link
264
Removed:
(** A destination in a navigation list. Build with {!val-nav_link}. *)
265
Removed:
266
Removed:
val nav_link : ?current:bool -> href:string -> string -> nav_link
267
Removed:
268
Removed:
val navigation :
269
Removed:
?id:string -> ?class_:string -> label:string -> node list -> node
270
Removed:
(** A navigation landmark. [label] is required because it names the landmark for
271
Removed:
assistive technology, which matters as soon as a page has more than one. *)
272
Removed:
273
Removed:
val nav_links :
274
Removed:
?id:string -> ?class_:string -> ?item_class:string -> nav_link list -> node
275
Removed:
(** A list of navigation links; the current page's item carries
276
Removed:
[aria-current="page"]. *)
277
Removed:
278
Removed:
(** {1 Toolbars} *)
279
Removed:
280
Removed:
val toolbar : ?id:string -> ?class_:string -> ?label:string -> node list -> node
281
Removed:
(** A bar of controls acting on the current page. An empty toolbar renders
282
Removed:
nothing, so layout offsets that depend on its presence stay consistent. *)
283
Removed:
284
Removed:
val button_link :
285
Removed:
?class_:string -> ?label:string -> href:string -> string -> node
286
Removed:
(** A link styled as a toolbar button. Still a link, not a [button], because it
287
Removed:
navigates rather than acting on the current page — which keeps middle-click
288
Removed:
and "open in new tab" working. *)
289
Removed:
290
Removed:
val dismissible :
291
Removed:
?class_:string ->
292
Removed:
?dismiss_class:string ->
293
Removed:
value_class:string ->
294
Removed:
dismiss_href:string ->
295
Removed:
dismiss_label:string ->
296
Removed:
string ->
297
Removed:
node
298
Removed:
(** An active filter together with a control that removes it.
299
Removed:
300
Removed:
@param value_class styles the displayed value.
301
Removed:
@param dismiss_label
302
Removed:
accessible name of the remove control, required because its glyph conveys
303
Removed:
nothing on its own. *)
304
Removed:
305
Removed:
(** {1 Pagination} *)
306
Removed:
307
Removed:
val pagination :
308
Removed:
?label:string ->
309
Removed:
?previous_text:string ->
310
Removed:
?next_text:string ->
311
Removed:
?previous_label:string ->
312
Removed:
?next_label:string ->
313
Removed:
?previous_href:string ->
314
Removed:
?next_href:string ->
315
Removed:
int ->
316
Removed:
node
317
Removed:
(** Previous/next controls around a page number.
318
Removed:
319
Removed:
A missing neighbour — an absent [previous_href] or [next_href] — renders as
320
Removed:
an inert, aria-hidden placeholder rather than disappearing, so the controls
321
Removed:
keep their position between pages.
322
Removed:
323
Removed:
The glyphs are decorative; [previous_label] and [next_label] carry the
324
Removed:
accessible names. *)
325
Removed:
326
Removed:
(** {1 Code} *)
327
Removed:
328
Removed:
val code_listing :
329
Removed:
?id:string -> ?class_:string -> ?anchor_prefix:string -> string -> node
330
Removed:
(** A line-numbered listing of source text.
331
Removed:
332
Removed:
Every line gets a stable anchor so single lines can be linked and
333
Removed:
highlighted. [anchor_prefix] namespaces those anchors, which is required
334
Removed:
when one page shows more than one listing.
335
Removed:
336
Removed:
Content is emitted verbatim as plain text with no syntax colouring. For
337
Removed:
highlighted output, use {!highlighted_code_listing} instead. *)
338
Removed:
339
Removed:
val highlighted_code_listing :
340
Removed:
?id:string ->
341
Removed:
?class_:string ->
342
Removed:
?anchor_prefix:string ->
343
Removed:
node list list ->
344
Removed:
node
345
Removed:
(** A line-numbered listing of pre-highlighted source code.
346
Removed:
347
Removed:
Like {!code_listing} but accepts lines already tokenized into styled spans
348
Removed:
(e.g. from {!Highlight.highlight}). Each inner list represents one line's
349
Removed:
worth of nodes; the function adds line numbers and anchors in the same grid
350
Removed:
layout as [code_listing]. *)
351
Removed:
352
Removed:
(** {1 Diffs} *)
353
Removed:
354
Removed:
(** A viewer for line-oriented change sets. The data types are deliberately
355
Removed:
plain so any producer of diffs can feed them. *)
356
Removed:
module Diff : sig
357
Removed:
type change = Unchanged | Added | Removed
358
Removed:
359
Removed:
type line = {
360
Removed:
before : string; (** line number in the old revision, or [""] *)
361
Removed:
after : string; (** line number in the new revision, or [""] *)
362
Removed:
change : change;
363
Removed:
content : string;
364
Removed:
}
365
Removed:
366
Removed:
type section = { section_heading : string; lines : line list }
367
Removed:
368
Removed:
type file = {
369
Removed:
path : string;
370
Removed:
detail : string; (** provenance line, e.g. revision identifiers *)
371
Removed:
sections : section list;
372
Removed:
note : string option; (** shown instead of sections, e.g. binary files *)
373
Removed:
}
374
Removed:
375
Removed:
val view : empty_message:string -> file list -> node list
376
Removed:
(** Render a change set, or a single paragraph carrying [empty_message] when
377
Removed:
there is nothing to show. *)
378
Removed:
end
379
Removed:
380
Removed:
(** {1 Document scaffolding}
381
Removed:
382
Removed:
Two families, kept apart by prefix. The [document_] functions build the
383
Removed:
envelope a browser reads — [html], [head], [body] — and the [page_]
384
Removed:
functions build the landmarks a reader sees inside it. [document_head] and
385
Removed:
[page_banner] are the pair most easily confused: the first is metadata, the
386
Removed:
second is the visible masthead. *)
387
Removed:
388
Removed:
val meta_viewport : node
389
Removed:
(** Opts the page into responsive layout. Without it mobile browsers assume a
390
Removed:
desktop-width viewport and scale the page down. *)
391
Removed:
392
Removed:
val stylesheet : string -> node
393
Removed:
val icon : ?media_type:string -> string -> node
394
Removed:
395
Removed:
val deferred_script : string -> node
396
Removed:
(** An external script that does not block rendering. *)
397
Removed:
398
Removed:
val inline_script : string -> node
399
Removed:
(** Inline behaviour. Reserved for progressive enhancement: pages must stay
400
Removed:
usable when it does not run. *)
401
Removed:
402
Removed:
val skip_link : href:string -> string -> node
403
Removed:
(** A link that jumps past repeated navigation, revealed on focus. Expected on
404
Removed:
every page for keyboard users. *)
405
Removed:
406
Removed:
(** {2 The document envelope} *)
407
Removed:
408
Removed:
val document_head : title:string -> node list -> node
409
Removed:
(** The [head] element: title, metadata and asset links. [title] comes first so
410
Removed:
it cannot be forgotten. *)
411
Removed:
412
Removed:
val document_body : ?class_:string -> node list -> node
413
Removed:
(** The [body] element. *)
414
Removed:
415
Removed:
val document : ?lang:string -> head:node -> body:node -> unit -> node
416
Removed:
(** A complete document. [lang] defaults to ["en"]; set it so screen readers
417
Removed:
pick the right pronunciation. *)
418
Removed:
419
Removed:
(** {2 Landmarks within the page} *)
420
Removed:
421
Removed:
val page_banner : ?id:string -> ?class_:string -> node list -> node
422
Removed:
(** The [header] element introducing the page — its masthead. Named for the ARIA
423
Removed:
landmark it maps to, and to keep it distinct from {!val-document_head}. *)
424
Removed:
425
Removed:
val page_content : ?id:string -> ?class_:string -> node list -> node
426
Removed:
(** The [main] element: the content unique to this page, which the skip link
427
Removed:
targets. At most one per document. *)
428
Removed:
429
Removed:
val page_footer : ?class_:string -> node list -> node
430
Removed:
(** The [footer] element closing the page. *)
431
Removed:
432
Removed:
(** {1 Responses} *)
433
Removed:
434
Removed:
val respond : ?status:[< Dream.status ] -> node -> Dream.response Dream.promise
435
Removed:
(** Send a rendered document as an HTTP response. *)
test/dune
@@ -1,3 +1,3 @@
1
1
(test
2
2
(name test_ogit)
3
Removed:
(libraries ogit alcotest unix lwt.unix))
3
Added:
(libraries ogit prose alcotest unix lwt.unix))
test/test_readme.ml
@@ -22,7 +22,7 @@
22
22
if fragment_length > text_length then 0 else loop 0 0
23
23
24
24
let render ~filename content =
25
Removed:
Ogit.Prose.render ~filename content |> Dream_html.to_string
25
Added:
Prose.Render.render ~filename content |> Dream_html.to_string
26
26
27
27
let test_markdown_document () =
28
28
let html =
@@ -72,10 +72,10 @@
72
72
let test_readme_filename_detection () =
73
73
Alcotest.(check bool)
74
74
"case-insensitive README name" true
75
Removed:
(Ogit.Prose.is_readme_filename "ReadMe.ORG");
75
Added:
(Prose.Render.is_readme_filename "ReadMe.ORG");
76
76
Alcotest.(check bool)
77
77
"ordinary file is not a README" false
78
Removed:
(Ogit.Prose.is_readme_filename "guide.md")
78
Added:
(Prose.Render.is_readme_filename "guide.md")
79
79
80
80
let test_markdown_toc () =
81
81
let html =