jon.recoil.org
Testing of the @doc-json output
Merge commit '54c3742b63a0bb28e142a84ab5966f42dbd61ca6' as 'odoc-scrollycode-extension'
+1
odoc-scrollycode-extension/README.md
+1
odoc-scrollycode-extension/README.md
···
1
+
Scrolly
odoc-scrollycode-extension/_build/.db
odoc-scrollycode-extension/_build/.db
This is a binary file and will not be displayed.
odoc-scrollycode-extension/_build/.digest-db
odoc-scrollycode-extension/_build/.digest-db
This is a binary file and will not be displayed.
+1
odoc-scrollycode-extension/_build/.filesystem-clock
+1
odoc-scrollycode-extension/_build/.filesystem-clock
···
1
+
<dummy>
odoc-scrollycode-extension/_build/.lock
odoc-scrollycode-extension/_build/.lock
This is a binary file and will not be displayed.
+2
odoc-scrollycode-extension/_build/default/.dune/configurator
+2
odoc-scrollycode-extension/_build/default/.dune/configurator
···
1
+
(ocamlc /home/jons-agent/.opam/monopam-tools/bin/ocamlc.opt)
2
+
(ocaml_config_vars (afl_instrument false) (align_double false) (align_int64 false) (architecture amd64) (asm as) (asm_cfi_supported true) (asm_size_type_directives true) (ast_impl_magic_number Caml1999M036) (ast_intf_magic_number Caml1999N036) (bytecode_cflags "-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread ") (bytecode_cppflags " -D_FILE_OFFSET_BITS=64 ") (bytecomp_c_compiler "gcc -O2 -fno-strict-aliasing -fwrapv -fPIC -pthread -D_FILE_OFFSET_BITS=64 ") (bytecomp_c_libraries "-lzstd -lm -lpthread") (c_compiler gcc) (ccomp_type cc) (cma_magic_number Caml1999A036) (cmi_magic_number Caml1999I036) (cmo_magic_number Caml1999O036) (cmt_magic_number Caml1999T036) (cmx_magic_number Caml1999Y036) (cmxa_magic_number Caml1999Z036) (cmxs_magic_number Caml1999D036) (compression_c_libraries "-lzstd ") (default_executable_name a.out) (default_safe_string true) (exec_magic_number Caml1999X036) (ext_asm .s) (ext_dll .so) (ext_exe "") (ext_lib .a) (ext_obj .o) (flambda false) (flat_float_array true) (function_sections true) (host x86_64-pc-linux-gnu) (int_size 63) (linear_magic_number Caml1999L036) (model default) (naked_pointers false) (native_c_compiler "gcc -O2 -fno-strict-aliasing -fwrapv -fPIC -pthread -D_FILE_OFFSET_BITS=64 ") (native_c_libraries " -lm -lpthread") (native_cflags "-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread ") (native_compiler true) (native_cppflags " -D_FILE_OFFSET_BITS=64 ") (native_dynlink true) (native_ldflags "") (native_pack_linker "ld -r -o ") (ocamlc_cflags "-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread ") (ocamlc_cppflags " -D_FILE_OFFSET_BITS=64 ") (ocamlopt_cflags "-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread ") (ocamlopt_cppflags " -D_FILE_OFFSET_BITS=64 ") (os_type Unix) (safe_string true) (standard_library /home/jons-agent/.opam/monopam-tools/lib/ocaml) (standard_library_default /home/jons-agent/.opam/monopam-tools/lib/ocaml) (supports_shared_libraries true) (system linux) (systhread_supported true) (target x86_64-pc-linux-gnu) (tsan false) (version 5.4.0) (windows_unicode false) (with_codegen_invariants true) (with_frame_pointers false) (with_nonexecstack_note true) (word_size 64))
+1
odoc-scrollycode-extension/_build/default/.dune/configurator.v2
+1
odoc-scrollycode-extension/_build/default/.dune/configurator.v2
···
1
+
((6:ocamlc51:/home/jons-agent/.opam/monopam-tools/bin/ocamlc.opt)(17:ocaml_config_vars((14:afl_instrument5:false)(12:align_double5:false)(11:align_int645:false)(12:architecture5:amd64)(3:asm2:as)(17:asm_cfi_supported4:true)(24:asm_size_type_directives4:true)(21:ast_impl_magic_number12:Caml1999M036)(21:ast_intf_magic_number12:Caml1999N036)(15:bytecode_cflags49:-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread )(17:bytecode_cppflags24: -D_FILE_OFFSET_BITS=64 )(19:bytecomp_c_compiler78:gcc -O2 -fno-strict-aliasing -fwrapv -fPIC -pthread -D_FILE_OFFSET_BITS=64 )(20:bytecomp_c_libraries23:-lzstd -lm -lpthread)(10:c_compiler3:gcc)(10:ccomp_type2:cc)(16:cma_magic_number12:Caml1999A036)(16:cmi_magic_number12:Caml1999I036)(16:cmo_magic_number12:Caml1999O036)(16:cmt_magic_number12:Caml1999T036)(16:cmx_magic_number12:Caml1999Y036)(17:cmxa_magic_number12:Caml1999Z036)(17:cmxs_magic_number12:Caml1999D036)(23:compression_c_libraries7:-lzstd )(23:default_executable_name5:a.out)(19:default_safe_string4:true)(17:exec_magic_number12:Caml1999X036)(7:ext_asm2:.s)(7:ext_dll3:.so)(7:ext_exe0:)(7:ext_lib2:.a)(7:ext_obj2:.o)(7:flambda5:false)(16:flat_float_array4:true)(17:function_sections4:true)(4:host19:x86_64-pc-linux-gnu)(8:int_size2:63)(19:linear_magic_number12:Caml1999L036)(5:model7:default)(14:naked_pointers5:false)(17:native_c_compiler78:gcc -O2 -fno-strict-aliasing -fwrapv -fPIC -pthread -D_FILE_OFFSET_BITS=64 )(18:native_c_libraries15: -lm -lpthread)(13:native_cflags49:-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread )(15:native_compiler4:true)(15:native_cppflags24: -D_FILE_OFFSET_BITS=64 )(14:native_dynlink4:true)(14:native_ldflags0:)(18:native_pack_linker9:ld -r -o )(13:ocamlc_cflags49:-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread )(15:ocamlc_cppflags24: -D_FILE_OFFSET_BITS=64 )(15:ocamlopt_cflags49:-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread )(17:ocamlopt_cppflags24: -D_FILE_OFFSET_BITS=64 )(7:os_type4:Unix)(11:safe_string4:true)(16:standard_library46:/home/jons-agent/.opam/monopam-tools/lib/ocaml)(24:standard_library_default46:/home/jons-agent/.opam/monopam-tools/lib/ocaml)(25:supports_shared_libraries4:true)(6:system5:linux)(19:systhread_supported4:true)(6:target19:x86_64-pc-linux-gnu)(4:tsan5:false)(7:version5:5.4.0)(15:windows_unicode5:false)(23:with_codegen_invariants4:true)(19:with_frame_pointers5:false)(22:with_nonexecstack_note4:true)(9:word_size2:64))))
+28
odoc-scrollycode-extension/_build/default/odoc-scrollycode-extension.opam
+28
odoc-scrollycode-extension/_build/default/odoc-scrollycode-extension.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Scrollycode tutorial extension for odoc"
4
+
description: """
5
+
Provides @scrolly.warm, @scrolly.dark, and @scrolly.notebook tags
6
+
for creating scroll-driven code tutorials in odoc documentation"""
7
+
depends: [
8
+
"dune" {>= "3.18"}
9
+
"ocaml" {>= "4.14"}
10
+
"odoc"
11
+
]
12
+
build: [
13
+
["dune" "subst"] {dev}
14
+
[
15
+
"dune"
16
+
"build"
17
+
"-p"
18
+
name
19
+
"-j"
20
+
jobs
21
+
"--promote-install-files=false"
22
+
"@install"
23
+
"@runtest" {with-test}
24
+
"@doc" {with-doc}
25
+
]
26
+
["dune" "install" "-p" name "--create-install-files" name]
27
+
]
28
+
x-maintenance-intent: ["(latest)"]
odoc-scrollycode-extension/_build/default/src/.merlin-conf/lib-odoc-scrollycode-extension.impl
odoc-scrollycode-extension/_build/default/src/.merlin-conf/lib-odoc-scrollycode-extension.impl
This is a binary file and will not be displayed.
+1846
odoc-scrollycode-extension/_build/default/src/scrollycode_extension.ml
+1846
odoc-scrollycode-extension/_build/default/src/scrollycode_extension.ml
···
1
+
(** Scrollycode Extension for odoc
2
+
3
+
Provides scroll-driven code tutorials with three visual themes:
4
+
- warm: Earthy, bookish aesthetic (Fraunces + Source Serif)
5
+
- dark: Cinematic terminal aesthetic (JetBrains Mono + Outfit)
6
+
- notebook: Clean editorial aesthetic (Newsreader + DM Sans)
7
+
8
+
Authoring format uses @scrolly.<theme> custom tags with an ordered
9
+
list inside, where each list item is a tutorial step containing
10
+
a bold title, prose paragraphs, and a code block. *)
11
+
12
+
module Comment = Odoc_model.Comment
13
+
module Location_ = Odoc_model.Location_
14
+
module Block = Odoc_document.Types.Block
15
+
module Inline = Odoc_document.Types.Inline
16
+
17
+
(** {1 Step Extraction} *)
18
+
19
+
(** A single tutorial step extracted from the ordered list structure *)
20
+
type step = {
21
+
title : string;
22
+
prose : string;
23
+
code : string;
24
+
focus : int list; (** 1-based line numbers to highlight *)
25
+
}
26
+
27
+
(** Extract plain text from inline elements *)
28
+
let rec text_of_inline (el : Comment.inline_element Location_.with_location) =
29
+
match el.Location_.value with
30
+
| `Space -> " "
31
+
| `Word w -> w
32
+
| `Code_span c -> "`" ^ c ^ "`"
33
+
| `Math_span m -> m
34
+
| `Raw_markup (_, r) -> r
35
+
| `Styled (_, content) -> text_of_inlines content
36
+
| `Reference (_, content) -> text_of_link_content content
37
+
| `Link (_, content) -> text_of_link_content content
38
+
39
+
and text_of_inlines content =
40
+
String.concat "" (List.map text_of_inline content)
41
+
42
+
and text_of_link_content content =
43
+
String.concat "" (List.map text_of_non_link content)
44
+
45
+
and text_of_non_link
46
+
(el : Comment.non_link_inline_element Location_.with_location) =
47
+
match el.Location_.value with
48
+
| `Space -> " "
49
+
| `Word w -> w
50
+
| `Code_span c -> "`" ^ c ^ "`"
51
+
| `Math_span m -> m
52
+
| `Raw_markup (_, r) -> r
53
+
| `Styled (_, content) -> text_of_link_content content
54
+
55
+
let text_of_paragraph (p : Comment.paragraph) =
56
+
String.concat "" (List.map text_of_inline p)
57
+
58
+
(** Extract title, prose, code and focus lines from a single list item *)
59
+
let extract_step
60
+
(item : Comment.nestable_block_element Location_.with_location list) : step
61
+
=
62
+
let title = ref "" in
63
+
let prose_parts = ref [] in
64
+
let code = ref "" in
65
+
let focus = ref [] in
66
+
List.iter
67
+
(fun (el : Comment.nestable_block_element Location_.with_location) ->
68
+
match el.Location_.value with
69
+
| `Paragraph p -> (
70
+
let text = text_of_paragraph p in
71
+
(* Check if the paragraph starts with bold text — that's the title *)
72
+
match p with
73
+
| first :: _
74
+
when (match first.Location_.value with
75
+
| `Styled (`Bold, _) -> true
76
+
| _ -> false) ->
77
+
if !title = "" then title := text
78
+
else prose_parts := text :: !prose_parts
79
+
| _ -> prose_parts := text :: !prose_parts)
80
+
| `Code_block { content = code_content; _ } ->
81
+
let code_text = code_content.Location_.value in
82
+
(* Check for focus annotation in the code: lines starting with >>> *)
83
+
let lines = String.split_on_char '\n' code_text in
84
+
let focused_lines = ref [] in
85
+
let clean_lines =
86
+
List.mapi
87
+
(fun i line ->
88
+
if
89
+
String.length line >= 4
90
+
&& String.sub line 0 4 = "(* >"
91
+
then (
92
+
focused_lines := (i + 1) :: !focused_lines;
93
+
(* Remove the focus marker *)
94
+
let rest = String.sub line 4 (String.length line - 4) in
95
+
let rest =
96
+
if
97
+
String.length rest >= 4
98
+
&& String.sub rest (String.length rest - 4) 4 = "< *)"
99
+
then String.sub rest 0 (String.length rest - 4)
100
+
else rest
101
+
in
102
+
String.trim rest)
103
+
else line)
104
+
lines
105
+
in
106
+
code := String.concat "\n" clean_lines;
107
+
focus := List.rev !focused_lines
108
+
| `Verbatim v -> prose_parts := v :: !prose_parts
109
+
| _ -> ())
110
+
item;
111
+
{
112
+
title = !title;
113
+
prose = String.concat "\n\n" (List.rev !prose_parts);
114
+
code = !code;
115
+
focus = !focus;
116
+
}
117
+
118
+
(** Extract all steps from the tag content (expects an ordered list) *)
119
+
let extract_steps
120
+
(content :
121
+
Comment.nestable_block_element Location_.with_location list) :
122
+
string * step list =
123
+
(* First element might be a paragraph with the tutorial title *)
124
+
let tutorial_title = ref "Tutorial" in
125
+
let steps = ref [] in
126
+
List.iter
127
+
(fun (el : Comment.nestable_block_element Location_.with_location) ->
128
+
match el.Location_.value with
129
+
| `Paragraph p ->
130
+
let text = text_of_paragraph p in
131
+
if !steps = [] then tutorial_title := text
132
+
| `List (`Ordered, items) ->
133
+
steps := List.map extract_step items
134
+
| _ -> ())
135
+
content;
136
+
(!tutorial_title, !steps)
137
+
138
+
(** {1 HTML Escaping} *)
139
+
140
+
let html_escape s =
141
+
let buf = Buffer.create (String.length s) in
142
+
String.iter
143
+
(function
144
+
| '&' -> Buffer.add_string buf "&"
145
+
| '<' -> Buffer.add_string buf "<"
146
+
| '>' -> Buffer.add_string buf ">"
147
+
| '"' -> Buffer.add_string buf """
148
+
| c -> Buffer.add_char buf c)
149
+
s;
150
+
Buffer.contents buf
151
+
152
+
(** {1 Diff Computation} *)
153
+
154
+
type diff_line =
155
+
| Same of string
156
+
| Added of string
157
+
| Removed of string
158
+
159
+
(** Simple LCS-based line diff between two code strings *)
160
+
let diff_lines old_code new_code =
161
+
let old_lines = String.split_on_char '\n' old_code |> Array.of_list in
162
+
let new_lines = String.split_on_char '\n' new_code |> Array.of_list in
163
+
let n = Array.length old_lines in
164
+
let m = Array.length new_lines in
165
+
let dp = Array.make_matrix (n + 1) (m + 1) 0 in
166
+
for i = 1 to n do
167
+
for j = 1 to m do
168
+
if old_lines.(i-1) = new_lines.(j-1) then
169
+
dp.(i).(j) <- dp.(i-1).(j-1) + 1
170
+
else
171
+
dp.(i).(j) <- max dp.(i-1).(j) dp.(i).(j-1)
172
+
done
173
+
done;
174
+
let result = ref [] in
175
+
let i = ref n and j = ref m in
176
+
while !i > 0 || !j > 0 do
177
+
if !i > 0 && !j > 0 && old_lines.(!i-1) = new_lines.(!j-1) then begin
178
+
result := Same old_lines.(!i-1) :: !result;
179
+
decr i; decr j
180
+
end else if !j > 0 && (!i = 0 || dp.(!i).(!j-1) >= dp.(!i-1).(!j)) then begin
181
+
result := Added new_lines.(!j-1) :: !result;
182
+
decr j
183
+
end else begin
184
+
result := Removed old_lines.(!i-1) :: !result;
185
+
decr i
186
+
end
187
+
done;
188
+
!result
189
+
190
+
(** {1 OCaml Syntax Highlighting}
191
+
192
+
A simple lexer-based highlighter for OCaml code. Produces HTML spans
193
+
with classes for keywords, types, strings, comments, operators. *)
194
+
195
+
let ocaml_keywords =
196
+
[
197
+
"let"; "in"; "if"; "then"; "else"; "match"; "with"; "fun"; "function";
198
+
"type"; "module"; "struct"; "sig"; "end"; "open"; "include"; "val";
199
+
"rec"; "and"; "of"; "when"; "as"; "begin"; "do"; "done"; "for"; "to";
200
+
"while"; "downto"; "try"; "exception"; "raise"; "mutable"; "ref";
201
+
"true"; "false"; "assert"; "failwith"; "not";
202
+
]
203
+
204
+
let ocaml_types =
205
+
[
206
+
"int"; "float"; "string"; "bool"; "unit"; "list"; "option"; "array";
207
+
"char"; "bytes"; "result"; "exn"; "ref";
208
+
]
209
+
210
+
(** Tokenize and highlight OCaml code into HTML *)
211
+
let highlight_ocaml code =
212
+
let len = String.length code in
213
+
let buf = Buffer.create (len * 2) in
214
+
let i = ref 0 in
215
+
let peek () = if !i < len then Some code.[!i] else None in
216
+
let advance () = incr i in
217
+
let current () = code.[!i] in
218
+
while !i < len do
219
+
match current () with
220
+
(* Comments *)
221
+
| '(' when !i + 1 < len && code.[!i + 1] = '*' ->
222
+
Buffer.add_string buf "<span class=\"hl-comment\">";
223
+
Buffer.add_string buf "(*";
224
+
i := !i + 2;
225
+
let depth = ref 1 in
226
+
while !depth > 0 && !i < len do
227
+
if !i + 1 < len && code.[!i] = '(' && code.[!i + 1] = '*' then (
228
+
Buffer.add_string buf "(*";
229
+
i := !i + 2;
230
+
incr depth)
231
+
else if !i + 1 < len && code.[!i] = '*' && code.[!i + 1] = ')' then (
232
+
Buffer.add_string buf "*)";
233
+
i := !i + 2;
234
+
decr depth)
235
+
else (
236
+
Buffer.add_string buf (html_escape (String.make 1 code.[!i]));
237
+
advance ())
238
+
done;
239
+
Buffer.add_string buf "</span>"
240
+
(* Strings *)
241
+
| '"' ->
242
+
Buffer.add_string buf "<span class=\"hl-string\">";
243
+
Buffer.add_char buf '"';
244
+
advance ();
245
+
while !i < len && current () <> '"' do
246
+
if current () = '\\' && !i + 1 < len then (
247
+
Buffer.add_string buf (html_escape (String.make 1 (current ())));
248
+
advance ();
249
+
Buffer.add_string buf (html_escape (String.make 1 (current ())));
250
+
advance ())
251
+
else (
252
+
Buffer.add_string buf (html_escape (String.make 1 (current ())));
253
+
advance ())
254
+
done;
255
+
if !i < len then (
256
+
Buffer.add_char buf '"';
257
+
advance ());
258
+
Buffer.add_string buf "</span>"
259
+
(* Char literals *)
260
+
| '\'' when !i + 2 < len && code.[!i + 2] = '\'' ->
261
+
Buffer.add_string buf "<span class=\"hl-string\">";
262
+
Buffer.add_char buf '\'';
263
+
advance ();
264
+
Buffer.add_string buf (html_escape (String.make 1 (current ())));
265
+
advance ();
266
+
Buffer.add_char buf '\'';
267
+
advance ();
268
+
Buffer.add_string buf "</span>"
269
+
(* Numbers *)
270
+
| '0' .. '9' ->
271
+
Buffer.add_string buf "<span class=\"hl-number\">";
272
+
while
273
+
!i < len
274
+
&&
275
+
match current () with
276
+
| '0' .. '9' | '.' | '_' | 'x' | 'o' | 'b' | 'a' .. 'f'
277
+
| 'A' .. 'F' ->
278
+
true
279
+
| _ -> false
280
+
do
281
+
Buffer.add_char buf (current ());
282
+
advance ()
283
+
done;
284
+
Buffer.add_string buf "</span>"
285
+
(* Identifiers and keywords *)
286
+
| 'a' .. 'z' | '_' ->
287
+
let start = !i in
288
+
while
289
+
!i < len
290
+
&&
291
+
match current () with
292
+
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '\'' -> true
293
+
| _ -> false
294
+
do
295
+
advance ()
296
+
done;
297
+
let word = String.sub code start (!i - start) in
298
+
if List.mem word ocaml_keywords then
299
+
Buffer.add_string buf
300
+
(Printf.sprintf "<span class=\"hl-keyword\">%s</span>"
301
+
(html_escape word))
302
+
else if List.mem word ocaml_types then
303
+
Buffer.add_string buf
304
+
(Printf.sprintf "<span class=\"hl-type\">%s</span>"
305
+
(html_escape word))
306
+
else Buffer.add_string buf (html_escape word)
307
+
(* Module/constructor names (capitalized identifiers) *)
308
+
| 'A' .. 'Z' ->
309
+
let start = !i in
310
+
while
311
+
!i < len
312
+
&&
313
+
match current () with
314
+
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '\'' -> true
315
+
| _ -> false
316
+
do
317
+
advance ()
318
+
done;
319
+
let word = String.sub code start (!i - start) in
320
+
Buffer.add_string buf
321
+
(Printf.sprintf "<span class=\"hl-module\">%s</span>"
322
+
(html_escape word))
323
+
(* Operators *)
324
+
| '|' | '-' | '+' | '*' | '/' | '=' | '<' | '>' | '@' | '^' | '~'
325
+
| '!' | '?' | '%' | '&' ->
326
+
Buffer.add_string buf "<span class=\"hl-operator\">";
327
+
Buffer.add_string buf (html_escape (String.make 1 (current ())));
328
+
advance ();
329
+
(* Consume multi-char operators *)
330
+
while
331
+
!i < len
332
+
&&
333
+
match current () with
334
+
| '|' | '-' | '+' | '*' | '/' | '=' | '<' | '>' | '@' | '^'
335
+
| '~' | '!' | '?' | '%' | '&' ->
336
+
true
337
+
| _ -> false
338
+
do
339
+
Buffer.add_string buf (html_escape (String.make 1 (current ())));
340
+
advance ()
341
+
done;
342
+
Buffer.add_string buf "</span>"
343
+
(* Punctuation *)
344
+
| ':' | ';' | '.' | ',' | '[' | ']' | '{' | '}' | '(' | ')' ->
345
+
Buffer.add_string buf
346
+
(Printf.sprintf "<span class=\"hl-punct\">%s</span>"
347
+
(html_escape (String.make 1 (current ()))));
348
+
advance ()
349
+
(* Arrow special case: -> *)
350
+
| ' ' | '\t' | '\n' | '\r' ->
351
+
Buffer.add_char buf (current ());
352
+
advance ()
353
+
| _ ->
354
+
let _ = peek () in
355
+
Buffer.add_string buf (html_escape (String.make 1 (current ())));
356
+
advance ()
357
+
done;
358
+
Buffer.contents buf
359
+
360
+
(** Render a diff as HTML with colored lines *)
361
+
let render_diff_html diff =
362
+
let buf = Buffer.create 1024 in
363
+
List.iter (fun line ->
364
+
match line with
365
+
| Same s ->
366
+
Buffer.add_string buf
367
+
(Printf.sprintf "<div class=\"sc-diff-line sc-diff-same\">%s</div>\n"
368
+
(highlight_ocaml s))
369
+
| Added s ->
370
+
Buffer.add_string buf
371
+
(Printf.sprintf "<div class=\"sc-diff-line sc-diff-added\">%s</div>\n"
372
+
(highlight_ocaml s))
373
+
| Removed s ->
374
+
Buffer.add_string buf
375
+
(Printf.sprintf "<div class=\"sc-diff-line sc-diff-removed\">%s</div>\n"
376
+
(highlight_ocaml s)))
377
+
diff;
378
+
Buffer.contents buf
379
+
380
+
(** {1 Shared JavaScript}
381
+
382
+
The scrollycode runtime handles IntersectionObserver-based step
383
+
detection and line-level transition animations. *)
384
+
385
+
let shared_js =
386
+
{|
387
+
(function() {
388
+
'use strict';
389
+
390
+
function initScrollycode(container) {
391
+
var steps = container.querySelectorAll('.sc-step');
392
+
var codeBody = container.querySelector('.sc-code-body');
393
+
var stepBadge = container.querySelector('.sc-step-badge');
394
+
var pips = container.querySelectorAll('.sc-pip');
395
+
var currentStep = -1;
396
+
397
+
function parseLines(el) {
398
+
if (!el) return [];
399
+
var items = el.querySelectorAll('.sc-line');
400
+
return Array.from(items).map(function(line) {
401
+
return { id: line.dataset.id, html: line.innerHTML, focused: line.classList.contains('sc-focused') };
402
+
});
403
+
}
404
+
405
+
function renderStep(index) {
406
+
if (index === currentStep || index < 0 || index >= steps.length) return;
407
+
408
+
var stepEl = steps[index];
409
+
var codeSlot = stepEl.querySelector('.sc-code-slot');
410
+
var newLines = parseLines(codeSlot);
411
+
var oldLines = parseLines(codeBody);
412
+
var oldById = {};
413
+
oldLines.forEach(function(l) { oldById[l.id] = l; });
414
+
var newById = {};
415
+
newLines.forEach(function(l) { newById[l.id] = l; });
416
+
417
+
// Determine exiting lines
418
+
var exiting = oldLines.filter(function(l) { return !newById[l.id]; });
419
+
420
+
// Animate exit
421
+
exiting.forEach(function(l, i) {
422
+
var el = codeBody.querySelector('[data-id="' + l.id + '"]');
423
+
if (el) {
424
+
el.style.animationDelay = (i * 30) + 'ms';
425
+
el.classList.add('sc-exiting');
426
+
}
427
+
});
428
+
429
+
var exitTime = exiting.length > 0 ? 200 + exiting.length * 30 : 0;
430
+
431
+
setTimeout(function() {
432
+
// Rebuild DOM
433
+
codeBody.innerHTML = '';
434
+
var firstNew = null;
435
+
newLines.forEach(function(l, i) {
436
+
var div = document.createElement('div');
437
+
var isNew = !oldById[l.id];
438
+
div.className = 'sc-line' + (l.focused ? ' sc-focused' : '') + (isNew ? ' sc-entering' : '');
439
+
div.dataset.id = l.id;
440
+
div.innerHTML = '<span class="sc-line-number">' + (i + 1) + '</span>' + l.html;
441
+
if (isNew) {
442
+
div.style.animationDelay = (i * 25) + 'ms';
443
+
if (!firstNew) firstNew = div;
444
+
}
445
+
codeBody.appendChild(div);
446
+
});
447
+
448
+
// Scroll to first new line, with some context above
449
+
if (firstNew) {
450
+
var lineH = firstNew.offsetHeight || 24;
451
+
var scrollTarget = firstNew.offsetTop - lineH * 2;
452
+
codeBody.scrollTo({ top: Math.max(0, scrollTarget), behavior: 'smooth' });
453
+
}
454
+
455
+
// Update badge and pips
456
+
if (stepBadge) stepBadge.textContent = (index + 1) + ' / ' + steps.length;
457
+
pips.forEach(function(pip, i) {
458
+
pip.classList.toggle('sc-active', i === index);
459
+
});
460
+
}, exitTime);
461
+
462
+
currentStep = index;
463
+
}
464
+
465
+
// Set up IntersectionObserver
466
+
var observer = new IntersectionObserver(function(entries) {
467
+
entries.forEach(function(entry) {
468
+
if (entry.isIntersecting) {
469
+
var idx = parseInt(entry.target.dataset.stepIndex, 10);
470
+
renderStep(idx);
471
+
}
472
+
});
473
+
}, {
474
+
rootMargin: '-30% 0px -30% 0px',
475
+
threshold: 0
476
+
});
477
+
478
+
steps.forEach(function(step) { observer.observe(step); });
479
+
480
+
// Initialize first step
481
+
renderStep(0);
482
+
483
+
// Playground overlay
484
+
var overlay = document.getElementById('sc-playground-overlay');
485
+
var closeBtn = overlay ? overlay.querySelector('.sc-playground-close') : null;
486
+
487
+
if (overlay && closeBtn) {
488
+
// Close button
489
+
closeBtn.addEventListener('click', function() {
490
+
overlay.classList.remove('sc-open');
491
+
});
492
+
493
+
// ESC key closes
494
+
document.addEventListener('keydown', function(e) {
495
+
if (e.key === 'Escape') overlay.classList.remove('sc-open');
496
+
});
497
+
498
+
// Click outside closes
499
+
overlay.addEventListener('click', function(e) {
500
+
if (e.target === overlay) overlay.classList.remove('sc-open');
501
+
});
502
+
}
503
+
504
+
// Try it buttons
505
+
container.querySelectorAll('.sc-playground-btn').forEach(function(btn) {
506
+
btn.addEventListener('click', function() {
507
+
var stepIndex = parseInt(btn.dataset.step, 10);
508
+
// Collect code from all steps up to and including this one
509
+
var allCode = [];
510
+
for (var si = 0; si <= stepIndex; si++) {
511
+
var slot = steps[si].querySelector('.sc-code-slot');
512
+
if (slot) {
513
+
var lines = slot.querySelectorAll('.sc-line');
514
+
var code = Array.from(lines).map(function(l) {
515
+
return l.textContent.replace(/^\d+/, '');
516
+
}).join('\n');
517
+
allCode.push(code);
518
+
}
519
+
}
520
+
var fullCode = allCode.join('\n\n');
521
+
522
+
var editor = document.getElementById('sc-playground-x-ocaml');
523
+
if (editor) {
524
+
editor.textContent = fullCode;
525
+
// Trigger re-initialization if x-ocaml supports it
526
+
if (editor.setSource) editor.setSource(fullCode);
527
+
}
528
+
529
+
if (overlay) overlay.classList.add('sc-open');
530
+
});
531
+
});
532
+
}
533
+
534
+
// Initialize all scrollycode containers on the page
535
+
document.addEventListener('DOMContentLoaded', function() {
536
+
document.querySelectorAll('.sc-container').forEach(initScrollycode);
537
+
});
538
+
})();
539
+
|}
540
+
541
+
(** {1 Theme: Warm Workshop}
542
+
543
+
Earthy, bookish. Cream background, burnt sienna accents.
544
+
Fraunces display + Source Serif 4 body.
545
+
Dark navy code panel with warm syntax highlighting. *)
546
+
547
+
let warm_css =
548
+
{|
549
+
.sc-container.sc-warm {
550
+
--sc-bg: #f5f0e6;
551
+
--sc-text: #2c2416;
552
+
--sc-text-dim: #8a7c6a;
553
+
--sc-accent: #c25832;
554
+
--sc-accent-soft: rgba(194, 88, 50, 0.08);
555
+
--sc-code-bg: #1a1a2e;
556
+
--sc-code-text: #d4d0c8;
557
+
--sc-code-gutter: #3a3a52;
558
+
--sc-border: rgba(44, 36, 22, 0.1);
559
+
--sc-focus-bg: rgba(194, 88, 50, 0.06);
560
+
--sc-panel-radius: 12px;
561
+
font-family: 'Source Serif 4', Georgia, serif;
562
+
}
563
+
564
+
.sc-container.sc-warm .sc-hero {
565
+
background: var(--sc-bg);
566
+
text-align: center;
567
+
padding: 5rem 2rem 3rem;
568
+
border-bottom: 1px solid var(--sc-border);
569
+
}
570
+
571
+
.sc-container.sc-warm .sc-hero h1 {
572
+
font-family: 'Fraunces', serif;
573
+
font-size: clamp(2.2rem, 5vw, 3.4rem);
574
+
font-weight: 800;
575
+
font-style: italic;
576
+
color: var(--sc-text);
577
+
letter-spacing: -0.03em;
578
+
line-height: 1.1;
579
+
margin-bottom: 0.75rem;
580
+
}
581
+
582
+
.sc-container.sc-warm .sc-hero p {
583
+
color: var(--sc-text-dim);
584
+
font-size: 1.05rem;
585
+
max-width: 48ch;
586
+
margin: 0 auto;
587
+
line-height: 1.6;
588
+
}
589
+
590
+
.sc-container.sc-warm .sc-tutorial {
591
+
display: flex;
592
+
gap: 0;
593
+
background: var(--sc-bg);
594
+
position: relative;
595
+
}
596
+
597
+
.sc-container.sc-warm .sc-steps-col {
598
+
flex: 1;
599
+
min-width: 0;
600
+
padding: 2rem 2.5rem 50vh 2.5rem;
601
+
}
602
+
603
+
.sc-container.sc-warm .sc-code-col {
604
+
width: 52%;
605
+
flex-shrink: 0;
606
+
}
607
+
608
+
.sc-container.sc-warm .sc-step {
609
+
min-height: 70vh;
610
+
display: flex;
611
+
flex-direction: column;
612
+
justify-content: center;
613
+
padding: 2rem 0;
614
+
}
615
+
616
+
.sc-container.sc-warm .sc-step-number {
617
+
font-family: 'Source Code Pro', monospace;
618
+
font-size: 0.7rem;
619
+
font-weight: 600;
620
+
letter-spacing: 0.1em;
621
+
color: var(--sc-accent);
622
+
text-transform: uppercase;
623
+
margin-bottom: 0.5rem;
624
+
}
625
+
626
+
.sc-container.sc-warm .sc-step h2 {
627
+
font-family: 'Fraunces', serif;
628
+
font-size: 1.5rem;
629
+
font-weight: 700;
630
+
color: var(--sc-text);
631
+
letter-spacing: -0.02em;
632
+
margin-bottom: 0.75rem;
633
+
line-height: 1.25;
634
+
}
635
+
636
+
.sc-container.sc-warm .sc-step p {
637
+
color: var(--sc-text-dim);
638
+
font-size: 0.95rem;
639
+
line-height: 1.7;
640
+
max-width: 44ch;
641
+
}
642
+
643
+
.sc-container.sc-warm .sc-code-panel {
644
+
position: sticky;
645
+
top: 10vh;
646
+
height: 80vh;
647
+
margin: 0 2rem 0 0;
648
+
background: var(--sc-code-bg);
649
+
border-radius: var(--sc-panel-radius);
650
+
overflow: hidden;
651
+
display: flex;
652
+
flex-direction: column;
653
+
box-shadow: 0 20px 60px rgba(26, 26, 46, 0.3), 0 0 0 1px rgba(255,255,255,0.03) inset;
654
+
}
655
+
656
+
.sc-container.sc-warm .sc-code-header {
657
+
display: flex;
658
+
align-items: center;
659
+
padding: 0.85rem 1.25rem;
660
+
background: rgba(255,255,255,0.03);
661
+
border-bottom: 1px solid rgba(255,255,255,0.06);
662
+
gap: 0.6rem;
663
+
}
664
+
665
+
.sc-container.sc-warm .sc-dots {
666
+
display: flex;
667
+
gap: 6px;
668
+
}
669
+
670
+
.sc-container.sc-warm .sc-dots span {
671
+
width: 10px;
672
+
height: 10px;
673
+
border-radius: 50%;
674
+
}
675
+
676
+
.sc-container.sc-warm .sc-dots span:nth-child(1) { background: #ff5f57; }
677
+
.sc-container.sc-warm .sc-dots span:nth-child(2) { background: #ffbd2e; }
678
+
.sc-container.sc-warm .sc-dots span:nth-child(3) { background: #28c840; }
679
+
680
+
.sc-container.sc-warm .sc-filename {
681
+
font-family: 'Source Code Pro', monospace;
682
+
font-size: 0.72rem;
683
+
color: rgba(255,255,255,0.35);
684
+
letter-spacing: 0.04em;
685
+
flex: 1;
686
+
text-align: center;
687
+
}
688
+
689
+
.sc-container.sc-warm .sc-step-badge {
690
+
font-family: 'Source Code Pro', monospace;
691
+
font-size: 0.65rem;
692
+
color: rgba(255,255,255,0.25);
693
+
letter-spacing: 0.06em;
694
+
}
695
+
696
+
.sc-container.sc-warm .sc-code-body {
697
+
flex: 1;
698
+
overflow-y: auto;
699
+
padding: 1.25rem 0;
700
+
font-family: 'Source Code Pro', monospace;
701
+
font-size: 0.82rem;
702
+
line-height: 1.7;
703
+
color: var(--sc-code-text);
704
+
}
705
+
706
+
.sc-container.sc-warm .sc-line {
707
+
padding: 0 1.25rem;
708
+
white-space: pre;
709
+
transition: opacity 0.3s ease;
710
+
opacity: 0.35;
711
+
}
712
+
713
+
.sc-container.sc-warm .sc-line.sc-focused {
714
+
opacity: 1;
715
+
background: rgba(194, 88, 50, 0.06);
716
+
}
717
+
718
+
.sc-container.sc-warm .sc-line-number {
719
+
display: inline-block;
720
+
width: 3ch;
721
+
text-align: right;
722
+
margin-right: 1.5ch;
723
+
color: var(--sc-code-gutter);
724
+
user-select: none;
725
+
}
726
+
727
+
/* Syntax highlighting */
728
+
.sc-container.sc-warm .hl-keyword { color: #f0a6a0; font-weight: 500; }
729
+
.sc-container.sc-warm .hl-type { color: #8ec8e8; }
730
+
.sc-container.sc-warm .hl-string { color: #b8d89a; }
731
+
.sc-container.sc-warm .hl-comment { color: #6a6a82; font-style: italic; }
732
+
.sc-container.sc-warm .hl-number { color: #ddb97a; }
733
+
.sc-container.sc-warm .hl-module { color: #e8c87a; }
734
+
.sc-container.sc-warm .hl-operator { color: #c8a8d8; }
735
+
.sc-container.sc-warm .hl-punct { color: #7a7a92; }
736
+
737
+
/* Progress pips */
738
+
.sc-container.sc-warm .sc-progress {
739
+
position: fixed;
740
+
left: 1.5rem;
741
+
top: 50%;
742
+
transform: translateY(-50%);
743
+
display: flex;
744
+
flex-direction: column;
745
+
gap: 8px;
746
+
z-index: 100;
747
+
}
748
+
749
+
.sc-container.sc-warm .sc-pip {
750
+
width: 6px;
751
+
height: 6px;
752
+
border-radius: 50%;
753
+
background: var(--sc-border);
754
+
transition: all 0.3s ease;
755
+
}
756
+
757
+
.sc-container.sc-warm .sc-pip.sc-active {
758
+
background: var(--sc-accent);
759
+
box-shadow: 0 0 8px rgba(194, 88, 50, 0.4);
760
+
transform: scale(1.4);
761
+
}
762
+
763
+
/* Animations */
764
+
@keyframes sc-line-exit {
765
+
0% { opacity: 1; transform: translateX(0); }
766
+
100% { opacity: 0; transform: translateX(-30px); }
767
+
}
768
+
769
+
@keyframes sc-line-enter {
770
+
0% { opacity: 0; transform: translateX(30px); }
771
+
100% { opacity: 1; transform: translateX(0); }
772
+
}
773
+
774
+
.sc-container.sc-warm .sc-line.sc-exiting {
775
+
animation: sc-line-exit 0.2s cubic-bezier(0.22, 1, 0.36, 1) forwards;
776
+
}
777
+
778
+
.sc-container.sc-warm .sc-line.sc-entering {
779
+
animation: sc-line-enter 0.25s cubic-bezier(0.22, 1, 0.36, 1) both;
780
+
}
781
+
782
+
/* Hidden code slot */
783
+
.sc-code-slot { display: none; }
784
+
785
+
/* Mobile responsive */
786
+
@media (max-width: 700px) {
787
+
.sc-container.sc-warm { padding: 0 1rem; }
788
+
.sc-container.sc-warm .sc-desktop { display: none !important; }
789
+
.sc-container.sc-warm .sc-mobile { display: block !important; }
790
+
.sc-container.sc-warm .sc-progress { display: none; }
791
+
.sc-container.sc-warm .sc-hero h1 { font-size: 2rem; }
792
+
}
793
+
@media (min-width: 701px) {
794
+
.sc-container.sc-warm .sc-mobile { display: none !important; }
795
+
}
796
+
.sc-container.sc-warm .sc-mobile-step {
797
+
margin: 1.5rem 0;
798
+
padding: 1.5rem;
799
+
border-radius: 12px;
800
+
background: rgba(255,255,255,0.5);
801
+
}
802
+
.sc-container.sc-warm .sc-mobile-step-num {
803
+
font-family: 'Fraunces', serif;
804
+
font-size: 0.75rem;
805
+
text-transform: uppercase;
806
+
letter-spacing: 0.15em;
807
+
color: #a0785a;
808
+
margin-bottom: 0.5rem;
809
+
}
810
+
.sc-container.sc-warm .sc-mobile-step h2 {
811
+
font-family: 'Fraunces', serif;
812
+
font-size: 1.3rem;
813
+
color: #3a2e28;
814
+
margin: 0 0 0.75rem;
815
+
}
816
+
.sc-container.sc-warm .sc-mobile-step p {
817
+
font-family: 'Source Serif 4', serif;
818
+
font-size: 1rem;
819
+
color: #5a4a3a;
820
+
line-height: 1.6;
821
+
margin: 0 0 1rem;
822
+
}
823
+
.sc-container.sc-warm .sc-diff-block {
824
+
background: #1e1b2e;
825
+
border-radius: 8px;
826
+
padding: 0.75rem;
827
+
overflow-x: auto;
828
+
font-family: 'Source Code Pro', monospace;
829
+
font-size: 0.8rem;
830
+
line-height: 1.5;
831
+
}
832
+
.sc-container.sc-warm .sc-diff-line { padding: 1px 0.5rem; white-space: pre; }
833
+
.sc-container.sc-warm .sc-diff-added { background: rgba(80, 200, 80, 0.15); border-left: 3px solid #4caf50; }
834
+
.sc-container.sc-warm .sc-diff-removed { background: rgba(255, 80, 80, 0.12); border-left: 3px solid #ef5350; text-decoration: line-through; opacity: 0.7; }
835
+
.sc-container.sc-warm .sc-diff-same { opacity: 0.5; }
836
+
837
+
/* Playground overlay */
838
+
.sc-playground-overlay {
839
+
display: none;
840
+
position: fixed;
841
+
inset: 0;
842
+
z-index: 10000;
843
+
background: rgba(0,0,0,0.6);
844
+
backdrop-filter: blur(4px);
845
+
align-items: center;
846
+
justify-content: center;
847
+
}
848
+
.sc-playground-overlay.sc-open {
849
+
display: flex;
850
+
}
851
+
.sc-playground-container {
852
+
width: 90vw;
853
+
max-width: 900px;
854
+
height: 80vh;
855
+
background: #1e1b2e;
856
+
border-radius: 12px;
857
+
display: flex;
858
+
flex-direction: column;
859
+
overflow: hidden;
860
+
box-shadow: 0 25px 80px rgba(0,0,0,0.5);
861
+
}
862
+
.sc-playground-header {
863
+
display: flex;
864
+
align-items: center;
865
+
justify-content: space-between;
866
+
padding: 0.75rem 1rem;
867
+
background: rgba(255,255,255,0.05);
868
+
border-bottom: 1px solid rgba(255,255,255,0.1);
869
+
}
870
+
.sc-playground-title {
871
+
font-family: 'Fraunces', serif;
872
+
font-size: 0.9rem;
873
+
color: rgba(255,255,255,0.8);
874
+
}
875
+
.sc-playground-close {
876
+
background: none;
877
+
border: none;
878
+
color: rgba(255,255,255,0.5);
879
+
font-size: 1.5rem;
880
+
cursor: pointer;
881
+
padding: 0 0.5rem;
882
+
line-height: 1;
883
+
}
884
+
.sc-playground-close:hover { color: #fff; }
885
+
.sc-playground-editor {
886
+
flex: 1;
887
+
overflow: auto;
888
+
}
889
+
.sc-playground-editor x-ocaml {
890
+
display: block;
891
+
height: 100%;
892
+
}
893
+
.sc-container.sc-warm .sc-playground-btn {
894
+
display: inline-block;
895
+
margin-top: 0.75rem;
896
+
padding: 0.4rem 1rem;
897
+
border: 1px solid rgba(160,120,90,0.3);
898
+
border-radius: 6px;
899
+
background: transparent;
900
+
color: #a0785a;
901
+
font-family: 'Source Serif 4', serif;
902
+
font-size: 0.85rem;
903
+
cursor: pointer;
904
+
transition: all 0.2s;
905
+
}
906
+
.sc-container.sc-warm .sc-playground-btn:hover {
907
+
background: rgba(160,120,90,0.1);
908
+
border-color: #a0785a;
909
+
}
910
+
|}
911
+
912
+
(** {1 Theme: Dark Terminal}
913
+
914
+
Cinematic dark theme. Near-black background, phosphor green and amber.
915
+
JetBrains Mono + Outfit geometric sans.
916
+
Code panel is hero-sized, prose is a narrow overlay strip. *)
917
+
918
+
let dark_css =
919
+
{|
920
+
.sc-container.sc-dark {
921
+
--sc-bg: #0a0a0f;
922
+
--sc-text: #e8e6f0;
923
+
--sc-text-dim: #6e6b80;
924
+
--sc-accent: #4ade80;
925
+
--sc-accent-alt: #fbbf24;
926
+
--sc-code-bg: #0f0f18;
927
+
--sc-code-text: #c8c5d8;
928
+
--sc-code-gutter: #2a2a3e;
929
+
--sc-border: rgba(255, 255, 255, 0.06);
930
+
--sc-panel-radius: 0;
931
+
font-family: 'Outfit', sans-serif;
932
+
background: var(--sc-bg);
933
+
color: var(--sc-text);
934
+
}
935
+
936
+
.sc-container.sc-dark .sc-hero {
937
+
background: var(--sc-bg);
938
+
text-align: left;
939
+
padding: 8rem 4rem 4rem;
940
+
max-width: 800px;
941
+
position: relative;
942
+
}
943
+
944
+
.sc-container.sc-dark .sc-hero::before {
945
+
content: '';
946
+
position: absolute;
947
+
top: 0;
948
+
left: 0;
949
+
right: 0;
950
+
bottom: 0;
951
+
background: radial-gradient(ellipse at 20% 50%, rgba(74, 222, 128, 0.04) 0%, transparent 60%);
952
+
pointer-events: none;
953
+
}
954
+
955
+
.sc-container.sc-dark .sc-hero h1 {
956
+
font-family: 'Outfit', sans-serif;
957
+
font-size: clamp(2.8rem, 6vw, 4.5rem);
958
+
font-weight: 800;
959
+
color: var(--sc-text);
960
+
letter-spacing: -0.04em;
961
+
line-height: 1.0;
962
+
margin-bottom: 1.25rem;
963
+
}
964
+
965
+
.sc-container.sc-dark .sc-hero h1 em {
966
+
font-style: normal;
967
+
color: var(--sc-accent);
968
+
}
969
+
970
+
.sc-container.sc-dark .sc-hero p {
971
+
color: var(--sc-text-dim);
972
+
font-size: 1.1rem;
973
+
max-width: 50ch;
974
+
line-height: 1.6;
975
+
font-weight: 300;
976
+
}
977
+
978
+
.sc-container.sc-dark .sc-tutorial {
979
+
display: flex;
980
+
gap: 0;
981
+
position: relative;
982
+
}
983
+
984
+
.sc-container.sc-dark .sc-steps-col {
985
+
width: 38%;
986
+
flex-shrink: 0;
987
+
padding: 2rem 2.5rem 50vh 4rem;
988
+
border-right: 1px solid var(--sc-border);
989
+
}
990
+
991
+
.sc-container.sc-dark .sc-code-col {
992
+
flex: 1;
993
+
min-width: 0;
994
+
}
995
+
996
+
.sc-container.sc-dark .sc-step {
997
+
min-height: 70vh;
998
+
display: flex;
999
+
flex-direction: column;
1000
+
justify-content: center;
1001
+
padding: 2rem 0;
1002
+
}
1003
+
1004
+
.sc-container.sc-dark .sc-step-number {
1005
+
font-family: 'JetBrains Mono', monospace;
1006
+
font-size: 0.65rem;
1007
+
font-weight: 700;
1008
+
letter-spacing: 0.15em;
1009
+
color: var(--sc-accent);
1010
+
text-transform: uppercase;
1011
+
margin-bottom: 0.75rem;
1012
+
display: flex;
1013
+
align-items: center;
1014
+
gap: 0.75rem;
1015
+
}
1016
+
1017
+
.sc-container.sc-dark .sc-step-number::after {
1018
+
content: '';
1019
+
flex: 1;
1020
+
height: 1px;
1021
+
background: var(--sc-border);
1022
+
}
1023
+
1024
+
.sc-container.sc-dark .sc-step h2 {
1025
+
font-family: 'Outfit', sans-serif;
1026
+
font-size: 1.4rem;
1027
+
font-weight: 700;
1028
+
color: var(--sc-text);
1029
+
letter-spacing: -0.02em;
1030
+
margin-bottom: 0.75rem;
1031
+
line-height: 1.2;
1032
+
}
1033
+
1034
+
.sc-container.sc-dark .sc-step p {
1035
+
color: var(--sc-text-dim);
1036
+
font-size: 0.9rem;
1037
+
line-height: 1.7;
1038
+
max-width: 40ch;
1039
+
font-weight: 300;
1040
+
}
1041
+
1042
+
.sc-container.sc-dark .sc-code-panel {
1043
+
position: sticky;
1044
+
top: 0;
1045
+
height: 100vh;
1046
+
background: var(--sc-code-bg);
1047
+
display: flex;
1048
+
flex-direction: column;
1049
+
border-left: 1px solid var(--sc-border);
1050
+
}
1051
+
1052
+
.sc-container.sc-dark .sc-code-header {
1053
+
display: flex;
1054
+
align-items: center;
1055
+
padding: 1rem 1.5rem;
1056
+
border-bottom: 1px solid var(--sc-border);
1057
+
gap: 1rem;
1058
+
}
1059
+
1060
+
.sc-container.sc-dark .sc-dots {
1061
+
display: flex;
1062
+
gap: 6px;
1063
+
}
1064
+
1065
+
.sc-container.sc-dark .sc-dots span {
1066
+
width: 8px;
1067
+
height: 8px;
1068
+
border-radius: 50%;
1069
+
background: var(--sc-code-gutter);
1070
+
}
1071
+
1072
+
.sc-container.sc-dark .sc-filename {
1073
+
font-family: 'JetBrains Mono', monospace;
1074
+
font-size: 0.7rem;
1075
+
color: var(--sc-text-dim);
1076
+
letter-spacing: 0.04em;
1077
+
flex: 1;
1078
+
}
1079
+
1080
+
.sc-container.sc-dark .sc-step-badge {
1081
+
font-family: 'JetBrains Mono', monospace;
1082
+
font-size: 0.6rem;
1083
+
color: var(--sc-accent);
1084
+
letter-spacing: 0.08em;
1085
+
background: rgba(74, 222, 128, 0.08);
1086
+
padding: 0.25em 0.75em;
1087
+
border-radius: 3px;
1088
+
}
1089
+
1090
+
.sc-container.sc-dark .sc-code-body {
1091
+
flex: 1;
1092
+
overflow-y: auto;
1093
+
padding: 1.5rem 0;
1094
+
font-family: 'JetBrains Mono', monospace;
1095
+
font-size: 0.8rem;
1096
+
line-height: 1.75;
1097
+
color: var(--sc-code-text);
1098
+
}
1099
+
1100
+
.sc-container.sc-dark .sc-line {
1101
+
padding: 0 1.5rem;
1102
+
white-space: pre;
1103
+
transition: opacity 0.3s ease, background 0.3s ease;
1104
+
opacity: 0.25;
1105
+
}
1106
+
1107
+
.sc-container.sc-dark .sc-line.sc-focused {
1108
+
opacity: 1;
1109
+
background: rgba(74, 222, 128, 0.04);
1110
+
border-left: 2px solid var(--sc-accent);
1111
+
padding-left: calc(1.5rem - 2px);
1112
+
}
1113
+
1114
+
.sc-container.sc-dark .sc-line-number {
1115
+
display: inline-block;
1116
+
width: 3ch;
1117
+
text-align: right;
1118
+
margin-right: 2ch;
1119
+
color: var(--sc-code-gutter);
1120
+
user-select: none;
1121
+
}
1122
+
1123
+
/* Syntax highlighting — neon palette */
1124
+
.sc-container.sc-dark .hl-keyword { color: #ff7eb3; font-weight: 500; }
1125
+
.sc-container.sc-dark .hl-type { color: #7dd3fc; }
1126
+
.sc-container.sc-dark .hl-string { color: #4ade80; }
1127
+
.sc-container.sc-dark .hl-comment { color: #4a4a62; font-style: italic; }
1128
+
.sc-container.sc-dark .hl-number { color: #fbbf24; }
1129
+
.sc-container.sc-dark .hl-module { color: #c4b5fd; }
1130
+
.sc-container.sc-dark .hl-operator { color: #67e8f9; }
1131
+
.sc-container.sc-dark .hl-punct { color: #4a4a62; }
1132
+
1133
+
/* Progress pips */
1134
+
.sc-container.sc-dark .sc-progress {
1135
+
position: fixed;
1136
+
right: 1.5rem;
1137
+
top: 50%;
1138
+
transform: translateY(-50%);
1139
+
display: flex;
1140
+
flex-direction: column;
1141
+
gap: 10px;
1142
+
z-index: 100;
1143
+
}
1144
+
1145
+
.sc-container.sc-dark .sc-pip {
1146
+
width: 3px;
1147
+
height: 20px;
1148
+
border-radius: 2px;
1149
+
background: var(--sc-border);
1150
+
transition: all 0.3s ease;
1151
+
}
1152
+
1153
+
.sc-container.sc-dark .sc-pip.sc-active {
1154
+
background: var(--sc-accent);
1155
+
box-shadow: 0 0 12px rgba(74, 222, 128, 0.5);
1156
+
height: 30px;
1157
+
}
1158
+
1159
+
/* Animations */
1160
+
.sc-container.sc-dark .sc-line.sc-exiting {
1161
+
animation: sc-line-exit 0.2s cubic-bezier(0.22, 1, 0.36, 1) forwards;
1162
+
}
1163
+
1164
+
.sc-container.sc-dark .sc-line.sc-entering {
1165
+
animation: sc-line-enter 0.25s cubic-bezier(0.22, 1, 0.36, 1) both;
1166
+
}
1167
+
1168
+
.sc-code-slot { display: none; }
1169
+
1170
+
/* Mobile responsive */
1171
+
@media (max-width: 700px) {
1172
+
.sc-container.sc-dark { padding: 0 1rem; }
1173
+
.sc-container.sc-dark .sc-desktop { display: none !important; }
1174
+
.sc-container.sc-dark .sc-mobile { display: block !important; }
1175
+
.sc-container.sc-dark .sc-progress { display: none; }
1176
+
.sc-container.sc-dark .sc-hero h1 { font-size: 2rem; }
1177
+
}
1178
+
@media (min-width: 701px) {
1179
+
.sc-container.sc-dark .sc-mobile { display: none !important; }
1180
+
}
1181
+
.sc-container.sc-dark .sc-mobile-step {
1182
+
margin: 1.5rem 0;
1183
+
padding: 1.5rem;
1184
+
border-radius: 10px;
1185
+
background: rgba(255,255,255,0.04);
1186
+
border: 1px solid rgba(255,255,255,0.08);
1187
+
}
1188
+
.sc-container.sc-dark .sc-mobile-step-num {
1189
+
font-family: 'Outfit', sans-serif;
1190
+
font-size: 0.7rem;
1191
+
text-transform: uppercase;
1192
+
letter-spacing: 0.2em;
1193
+
color: #00d4aa;
1194
+
margin-bottom: 0.5rem;
1195
+
}
1196
+
.sc-container.sc-dark .sc-mobile-step h2 {
1197
+
font-family: 'Outfit', sans-serif;
1198
+
font-size: 1.3rem;
1199
+
color: #e8e6e3;
1200
+
margin: 0 0 0.75rem;
1201
+
}
1202
+
.sc-container.sc-dark .sc-mobile-step p {
1203
+
font-family: 'Outfit', sans-serif;
1204
+
font-size: 0.95rem;
1205
+
color: rgba(232,230,227,0.7);
1206
+
line-height: 1.6;
1207
+
margin: 0 0 1rem;
1208
+
}
1209
+
.sc-container.sc-dark .sc-diff-block {
1210
+
background: #0d1117;
1211
+
border-radius: 8px;
1212
+
padding: 0.75rem;
1213
+
overflow-x: auto;
1214
+
font-family: 'JetBrains Mono', monospace;
1215
+
font-size: 0.8rem;
1216
+
line-height: 1.5;
1217
+
border: 1px solid rgba(0,212,170,0.15);
1218
+
}
1219
+
.sc-container.sc-dark .sc-diff-line { padding: 1px 0.5rem; white-space: pre; }
1220
+
.sc-container.sc-dark .sc-diff-added { background: rgba(0, 212, 170, 0.12); border-left: 3px solid #00d4aa; }
1221
+
.sc-container.sc-dark .sc-diff-removed { background: rgba(255, 80, 80, 0.1); border-left: 3px solid #ff6b6b; text-decoration: line-through; opacity: 0.6; }
1222
+
.sc-container.sc-dark .sc-diff-same { opacity: 0.4; }
1223
+
1224
+
/* Playground */
1225
+
.sc-container.sc-dark .sc-playground-btn {
1226
+
display: inline-block;
1227
+
margin-top: 0.75rem;
1228
+
padding: 0.4rem 1rem;
1229
+
border: 1px solid rgba(0,212,170,0.3);
1230
+
border-radius: 6px;
1231
+
background: transparent;
1232
+
color: #00d4aa;
1233
+
font-family: 'Outfit', sans-serif;
1234
+
font-size: 0.85rem;
1235
+
cursor: pointer;
1236
+
transition: all 0.2s;
1237
+
}
1238
+
.sc-container.sc-dark .sc-playground-btn:hover {
1239
+
background: rgba(0,212,170,0.1);
1240
+
border-color: #00d4aa;
1241
+
}
1242
+
|}
1243
+
1244
+
(** {1 Theme: Notebook}
1245
+
1246
+
Clean editorial. Soft white, blue-violet accent.
1247
+
Newsreader display + DM Sans body.
1248
+
Vertical layout with code blocks inline but sticky. *)
1249
+
1250
+
let notebook_css =
1251
+
{|
1252
+
.sc-container.sc-notebook {
1253
+
--sc-bg: #fafbfe;
1254
+
--sc-text: #1a1a2e;
1255
+
--sc-text-dim: #64648a;
1256
+
--sc-accent: #6366f1;
1257
+
--sc-accent-soft: rgba(99, 102, 241, 0.06);
1258
+
--sc-code-bg: #1e1e32;
1259
+
--sc-code-text: #d1d0e0;
1260
+
--sc-code-gutter: #3a3a52;
1261
+
--sc-border: rgba(99, 102, 241, 0.08);
1262
+
--sc-panel-radius: 16px;
1263
+
font-family: 'DM Sans', sans-serif;
1264
+
}
1265
+
1266
+
.sc-container.sc-notebook .sc-hero {
1267
+
background: var(--sc-bg);
1268
+
text-align: left;
1269
+
padding: 6rem 0 3rem;
1270
+
max-width: 640px;
1271
+
margin: 0 auto;
1272
+
border-bottom: 2px solid var(--sc-accent);
1273
+
position: relative;
1274
+
}
1275
+
1276
+
.sc-container.sc-notebook .sc-hero::after {
1277
+
content: '';
1278
+
position: absolute;
1279
+
bottom: -2px;
1280
+
left: 0;
1281
+
width: 120px;
1282
+
height: 2px;
1283
+
background: var(--sc-accent);
1284
+
box-shadow: 0 0 16px rgba(99, 102, 241, 0.4);
1285
+
}
1286
+
1287
+
.sc-container.sc-notebook .sc-hero h1 {
1288
+
font-family: 'Newsreader', serif;
1289
+
font-size: clamp(2rem, 4vw, 2.8rem);
1290
+
font-weight: 600;
1291
+
color: var(--sc-text);
1292
+
letter-spacing: -0.02em;
1293
+
line-height: 1.15;
1294
+
margin-bottom: 0.75rem;
1295
+
}
1296
+
1297
+
.sc-container.sc-notebook .sc-hero p {
1298
+
color: var(--sc-text-dim);
1299
+
font-size: 1rem;
1300
+
max-width: 52ch;
1301
+
line-height: 1.6;
1302
+
font-weight: 400;
1303
+
}
1304
+
1305
+
.sc-container.sc-notebook .sc-tutorial {
1306
+
display: flex;
1307
+
gap: 0;
1308
+
background: var(--sc-bg);
1309
+
max-width: 1200px;
1310
+
margin: 0 auto;
1311
+
position: relative;
1312
+
}
1313
+
1314
+
.sc-container.sc-notebook .sc-steps-col {
1315
+
flex: 1;
1316
+
min-width: 0;
1317
+
padding: 2rem 3rem 50vh 0;
1318
+
max-width: 420px;
1319
+
}
1320
+
1321
+
.sc-container.sc-notebook .sc-code-col {
1322
+
flex: 1;
1323
+
min-width: 0;
1324
+
}
1325
+
1326
+
.sc-container.sc-notebook .sc-step {
1327
+
min-height: 60vh;
1328
+
display: flex;
1329
+
flex-direction: column;
1330
+
justify-content: center;
1331
+
padding: 1.5rem 0;
1332
+
position: relative;
1333
+
}
1334
+
1335
+
.sc-container.sc-notebook .sc-step::before {
1336
+
content: '';
1337
+
position: absolute;
1338
+
left: -1.5rem;
1339
+
top: 50%;
1340
+
transform: translateY(-50%);
1341
+
width: 3px;
1342
+
height: 0;
1343
+
background: var(--sc-accent);
1344
+
border-radius: 2px;
1345
+
transition: height 0.4s cubic-bezier(0.22, 1, 0.36, 1);
1346
+
}
1347
+
1348
+
.sc-container.sc-notebook .sc-step-number {
1349
+
font-family: 'DM Sans', sans-serif;
1350
+
font-size: 0.68rem;
1351
+
font-weight: 700;
1352
+
letter-spacing: 0.12em;
1353
+
color: var(--sc-accent);
1354
+
text-transform: uppercase;
1355
+
margin-bottom: 0.5rem;
1356
+
display: flex;
1357
+
align-items: center;
1358
+
gap: 0.5rem;
1359
+
}
1360
+
1361
+
.sc-container.sc-notebook .sc-step h2 {
1362
+
font-family: 'Newsreader', serif;
1363
+
font-size: 1.3rem;
1364
+
font-weight: 600;
1365
+
color: var(--sc-text);
1366
+
letter-spacing: -0.01em;
1367
+
margin-bottom: 0.6rem;
1368
+
line-height: 1.3;
1369
+
}
1370
+
1371
+
.sc-container.sc-notebook .sc-step p {
1372
+
color: var(--sc-text-dim);
1373
+
font-size: 0.88rem;
1374
+
line-height: 1.7;
1375
+
max-width: 42ch;
1376
+
}
1377
+
1378
+
.sc-container.sc-notebook .sc-code-panel {
1379
+
position: sticky;
1380
+
top: 8vh;
1381
+
height: 84vh;
1382
+
margin: 0 0 0 2rem;
1383
+
background: var(--sc-code-bg);
1384
+
border-radius: var(--sc-panel-radius);
1385
+
overflow: hidden;
1386
+
display: flex;
1387
+
flex-direction: column;
1388
+
box-shadow:
1389
+
0 24px 80px rgba(30, 30, 50, 0.15),
1390
+
0 0 0 1px rgba(99, 102, 241, 0.08);
1391
+
}
1392
+
1393
+
.sc-container.sc-notebook .sc-code-header {
1394
+
display: flex;
1395
+
align-items: center;
1396
+
padding: 0.75rem 1.25rem;
1397
+
background: rgba(99, 102, 241, 0.04);
1398
+
border-bottom: 1px solid rgba(255,255,255,0.04);
1399
+
gap: 0.75rem;
1400
+
}
1401
+
1402
+
.sc-container.sc-notebook .sc-dots {
1403
+
display: flex;
1404
+
gap: 5px;
1405
+
}
1406
+
1407
+
.sc-container.sc-notebook .sc-dots span {
1408
+
width: 9px;
1409
+
height: 9px;
1410
+
border-radius: 50%;
1411
+
background: rgba(255,255,255,0.08);
1412
+
}
1413
+
1414
+
.sc-container.sc-notebook .sc-filename {
1415
+
font-family: 'DM Mono', monospace;
1416
+
font-size: 0.7rem;
1417
+
color: rgba(255,255,255,0.3);
1418
+
letter-spacing: 0.04em;
1419
+
flex: 1;
1420
+
text-align: center;
1421
+
}
1422
+
1423
+
.sc-container.sc-notebook .sc-step-badge {
1424
+
font-family: 'DM Mono', monospace;
1425
+
font-size: 0.6rem;
1426
+
color: var(--sc-accent);
1427
+
letter-spacing: 0.06em;
1428
+
}
1429
+
1430
+
.sc-container.sc-notebook .sc-code-body {
1431
+
flex: 1;
1432
+
overflow-y: auto;
1433
+
padding: 1.25rem 0;
1434
+
font-family: 'DM Mono', 'Source Code Pro', monospace;
1435
+
font-size: 0.78rem;
1436
+
line-height: 1.75;
1437
+
color: var(--sc-code-text);
1438
+
}
1439
+
1440
+
.sc-container.sc-notebook .sc-line {
1441
+
padding: 0 1.25rem;
1442
+
white-space: pre;
1443
+
transition: opacity 0.3s ease;
1444
+
opacity: 0.3;
1445
+
}
1446
+
1447
+
.sc-container.sc-notebook .sc-line.sc-focused {
1448
+
opacity: 1;
1449
+
background: rgba(99, 102, 241, 0.05);
1450
+
}
1451
+
1452
+
.sc-container.sc-notebook .sc-line-number {
1453
+
display: inline-block;
1454
+
width: 3ch;
1455
+
text-align: right;
1456
+
margin-right: 1.5ch;
1457
+
color: var(--sc-code-gutter);
1458
+
user-select: none;
1459
+
}
1460
+
1461
+
/* Syntax highlighting — cool tones */
1462
+
.sc-container.sc-notebook .hl-keyword { color: #a78bfa; font-weight: 500; }
1463
+
.sc-container.sc-notebook .hl-type { color: #67e8f9; }
1464
+
.sc-container.sc-notebook .hl-string { color: #86efac; }
1465
+
.sc-container.sc-notebook .hl-comment { color: #4a4a62; font-style: italic; }
1466
+
.sc-container.sc-notebook .hl-number { color: #fde68a; }
1467
+
.sc-container.sc-notebook .hl-module { color: #f9a8d4; }
1468
+
.sc-container.sc-notebook .hl-operator { color: #93c5fd; }
1469
+
.sc-container.sc-notebook .hl-punct { color: #4a4a62; }
1470
+
1471
+
/* Progress pips */
1472
+
.sc-container.sc-notebook .sc-progress {
1473
+
position: fixed;
1474
+
left: 2rem;
1475
+
top: 50%;
1476
+
transform: translateY(-50%);
1477
+
display: flex;
1478
+
flex-direction: column;
1479
+
gap: 6px;
1480
+
z-index: 100;
1481
+
}
1482
+
1483
+
.sc-container.sc-notebook .sc-pip {
1484
+
width: 8px;
1485
+
height: 8px;
1486
+
border-radius: 3px;
1487
+
background: var(--sc-border);
1488
+
transition: all 0.3s ease;
1489
+
}
1490
+
1491
+
.sc-container.sc-notebook .sc-pip.sc-active {
1492
+
background: var(--sc-accent);
1493
+
box-shadow: 0 0 10px rgba(99, 102, 241, 0.4);
1494
+
border-radius: 2px;
1495
+
width: 8px;
1496
+
height: 16px;
1497
+
}
1498
+
1499
+
/* Animations */
1500
+
.sc-container.sc-notebook .sc-line.sc-exiting {
1501
+
animation: sc-line-exit 0.2s cubic-bezier(0.22, 1, 0.36, 1) forwards;
1502
+
}
1503
+
1504
+
.sc-container.sc-notebook .sc-line.sc-entering {
1505
+
animation: sc-line-enter 0.25s cubic-bezier(0.22, 1, 0.36, 1) both;
1506
+
}
1507
+
1508
+
.sc-code-slot { display: none; }
1509
+
1510
+
/* Mobile responsive */
1511
+
@media (max-width: 700px) {
1512
+
.sc-container.sc-notebook { padding: 0 1rem; }
1513
+
.sc-container.sc-notebook .sc-desktop { display: none !important; }
1514
+
.sc-container.sc-notebook .sc-mobile { display: block !important; }
1515
+
.sc-container.sc-notebook .sc-progress { display: none; }
1516
+
.sc-container.sc-notebook .sc-hero h1 { font-size: 2rem; }
1517
+
}
1518
+
@media (min-width: 701px) {
1519
+
.sc-container.sc-notebook .sc-mobile { display: none !important; }
1520
+
}
1521
+
.sc-container.sc-notebook .sc-mobile-step {
1522
+
margin: 1.5rem 0;
1523
+
padding: 1.5rem;
1524
+
border-radius: 6px;
1525
+
background: #ffffff;
1526
+
border: 1px solid #e0ddd8;
1527
+
}
1528
+
.sc-container.sc-notebook .sc-mobile-step-num {
1529
+
font-family: 'DM Sans', sans-serif;
1530
+
font-size: 0.7rem;
1531
+
text-transform: uppercase;
1532
+
letter-spacing: 0.15em;
1533
+
color: #0066cc;
1534
+
font-weight: 600;
1535
+
margin-bottom: 0.5rem;
1536
+
}
1537
+
.sc-container.sc-notebook .sc-mobile-step h2 {
1538
+
font-family: 'Newsreader', serif;
1539
+
font-size: 1.3rem;
1540
+
color: #1a1a1a;
1541
+
margin: 0 0 0.75rem;
1542
+
}
1543
+
.sc-container.sc-notebook .sc-mobile-step p {
1544
+
font-family: 'DM Sans', sans-serif;
1545
+
font-size: 0.95rem;
1546
+
color: #4a4a4a;
1547
+
line-height: 1.6;
1548
+
margin: 0 0 1rem;
1549
+
}
1550
+
.sc-container.sc-notebook .sc-diff-block {
1551
+
background: #282c34;
1552
+
border-radius: 6px;
1553
+
padding: 0.75rem;
1554
+
overflow-x: auto;
1555
+
font-family: 'IBM Plex Mono', monospace;
1556
+
font-size: 0.8rem;
1557
+
line-height: 1.5;
1558
+
border: 1px solid #e0ddd8;
1559
+
}
1560
+
.sc-container.sc-notebook .sc-diff-line { padding: 1px 0.5rem; white-space: pre; }
1561
+
.sc-container.sc-notebook .sc-diff-added { background: rgba(0, 102, 204, 0.12); border-left: 3px solid #0066cc; }
1562
+
.sc-container.sc-notebook .sc-diff-removed { background: rgba(220, 50, 50, 0.1); border-left: 3px solid #dc3232; text-decoration: line-through; opacity: 0.6; }
1563
+
.sc-container.sc-notebook .sc-diff-same { opacity: 0.4; }
1564
+
1565
+
/* Playground */
1566
+
.sc-container.sc-notebook .sc-playground-btn {
1567
+
display: inline-block;
1568
+
margin-top: 0.75rem;
1569
+
padding: 0.4rem 1rem;
1570
+
border: 1px solid rgba(0,102,204,0.3);
1571
+
border-radius: 6px;
1572
+
background: transparent;
1573
+
color: #0066cc;
1574
+
font-family: 'DM Sans', sans-serif;
1575
+
font-size: 0.85rem;
1576
+
cursor: pointer;
1577
+
transition: all 0.2s;
1578
+
}
1579
+
.sc-container.sc-notebook .sc-playground-btn:hover {
1580
+
background: rgba(0,102,204,0.1);
1581
+
border-color: #0066cc;
1582
+
}
1583
+
|}
1584
+
1585
+
(** {1 CSS to hide odoc chrome}
1586
+
1587
+
When a scrollycode block is rendered, we want it to take over
1588
+
the page. This CSS hides the odoc navigation, breadcrumbs, etc. *)
1589
+
1590
+
let chrome_override_css =
1591
+
{|
1592
+
/* Override odoc page chrome for scrollycode pages */
1593
+
.odoc-nav, .odoc-tocs, .odoc-search { display: none !important; }
1594
+
.odoc-preamble > h1, .odoc-preamble > h2, .odoc-preamble > h3 { display: none !important; }
1595
+
.at-tags > li > .at-tag { display: none !important; }
1596
+
.odoc-preamble, .odoc-content {
1597
+
max-width: none !important;
1598
+
padding: 0 !important;
1599
+
margin: 0 !important;
1600
+
display: block !important;
1601
+
}
1602
+
.at-tags {
1603
+
list-style: none !important;
1604
+
padding: 0 !important;
1605
+
margin: 0 !important;
1606
+
}
1607
+
.at-tags > li {
1608
+
display: block !important;
1609
+
margin: 0 !important;
1610
+
padding: 0 !important;
1611
+
}
1612
+
body.odoc, .odoc {
1613
+
padding: 0 !important;
1614
+
margin: 0 !important;
1615
+
max-width: none !important;
1616
+
background: inherit;
1617
+
}
1618
+
|}
1619
+
1620
+
(** {1 Google Fonts links} *)
1621
+
1622
+
let warm_fonts =
1623
+
{|<link rel="preconnect" href="https://fonts.googleapis.com">
1624
+
<link rel="preconnect" href="https://fonts.gstatic.com" crossorigin>
1625
+
<link href="https://fonts.googleapis.com/css2?family=Fraunces:ital,opsz,wght@0,9..144,300..900;1,9..144,300..900&family=Source+Code+Pro:ital,wght@0,300..900;1,300..900&family=Source+Serif+4:ital,opsz,wght@0,8..60,300..900;1,8..60,300..900&display=swap" rel="stylesheet">|}
1626
+
1627
+
let dark_fonts =
1628
+
{|<link rel="preconnect" href="https://fonts.googleapis.com">
1629
+
<link rel="preconnect" href="https://fonts.gstatic.com" crossorigin>
1630
+
<link href="https://fonts.googleapis.com/css2?family=JetBrains+Mono:wght@300..800&family=Outfit:wght@300..900&display=swap" rel="stylesheet">|}
1631
+
1632
+
let notebook_fonts =
1633
+
{|<link rel="preconnect" href="https://fonts.googleapis.com">
1634
+
<link rel="preconnect" href="https://fonts.gstatic.com" crossorigin>
1635
+
<link href="https://fonts.googleapis.com/css2?family=DM+Mono:wght@300;400;500&family=DM+Sans:ital,opsz,wght@0,9..40,300..900;1,9..40,300..900&family=Newsreader:ital,opsz,wght@0,6..72,300..800;1,6..72,300..800&display=swap" rel="stylesheet">|}
1636
+
1637
+
(** {1 HTML Generation} *)
1638
+
1639
+
(** Generate the code lines HTML for a step's code slot *)
1640
+
let generate_code_lines code focus =
1641
+
let lines = String.split_on_char '\n' code in
1642
+
let buf = Buffer.create 1024 in
1643
+
List.iteri
1644
+
(fun i line ->
1645
+
let line_num = i + 1 in
1646
+
let focused = focus = [] || List.mem line_num focus in
1647
+
let highlighted = highlight_ocaml line in
1648
+
Buffer.add_string buf
1649
+
(Printf.sprintf
1650
+
"<div class=\"sc-line%s\" data-id=\"L%d\">%s</div>\n"
1651
+
(if focused then " sc-focused" else "")
1652
+
line_num highlighted))
1653
+
lines;
1654
+
Buffer.contents buf
1655
+
1656
+
(** Generate the mobile stacked layout with diffs between steps *)
1657
+
let generate_mobile_html steps =
1658
+
let buf = Buffer.create 8192 in
1659
+
Buffer.add_string buf "<div class=\"sc-mobile\">\n";
1660
+
let prev_code = ref None in
1661
+
List.iteri (fun i step ->
1662
+
Buffer.add_string buf
1663
+
(Printf.sprintf " <div class=\"sc-mobile-step\">\n");
1664
+
Buffer.add_string buf
1665
+
(Printf.sprintf " <div class=\"sc-mobile-step-num\">Step %02d</div>\n" (i + 1));
1666
+
if step.title <> "" then
1667
+
Buffer.add_string buf
1668
+
(Printf.sprintf " <h2>%s</h2>\n" (html_escape step.title));
1669
+
if step.prose <> "" then
1670
+
Buffer.add_string buf
1671
+
(Printf.sprintf " <p>%s</p>\n" (html_escape step.prose));
1672
+
(* Diff block *)
1673
+
Buffer.add_string buf " <div class=\"sc-diff-block\">\n";
1674
+
let diff = match !prev_code with
1675
+
| None ->
1676
+
List.map (fun l -> Added l) (String.split_on_char '\n' step.code)
1677
+
| Some prev ->
1678
+
diff_lines prev step.code
1679
+
in
1680
+
Buffer.add_string buf (render_diff_html diff);
1681
+
Buffer.add_string buf " </div>\n";
1682
+
Buffer.add_string buf
1683
+
(Printf.sprintf " <button class=\"sc-playground-btn\" data-step=\"%d\">▶ Try it</button>\n" i);
1684
+
Buffer.add_string buf " </div>\n";
1685
+
prev_code := Some step.code)
1686
+
steps;
1687
+
Buffer.add_string buf "</div>\n";
1688
+
Buffer.contents buf
1689
+
1690
+
(** Generate the full scrollycode HTML for a given theme *)
1691
+
let generate_html ~theme ~title ~filename steps =
1692
+
let theme_class, fonts, css =
1693
+
match theme with
1694
+
| "warm" -> ("sc-warm", warm_fonts, warm_css)
1695
+
| "dark" -> ("sc-dark", dark_fonts, dark_css)
1696
+
| "notebook" -> ("sc-notebook", notebook_fonts, notebook_css)
1697
+
| _ -> ("sc-warm", warm_fonts, warm_css)
1698
+
in
1699
+
let buf = Buffer.create 16384 in
1700
+
1701
+
(* Fonts *)
1702
+
Buffer.add_string buf fonts;
1703
+
Buffer.add_char buf '\n';
1704
+
1705
+
(* CSS *)
1706
+
Buffer.add_string buf "<style>\n";
1707
+
Buffer.add_string buf chrome_override_css;
1708
+
Buffer.add_string buf css;
1709
+
Buffer.add_string buf "</style>\n";
1710
+
1711
+
(* Container *)
1712
+
Buffer.add_string buf
1713
+
(Printf.sprintf "<div class=\"sc-container %s\">\n" theme_class);
1714
+
1715
+
(* Hero *)
1716
+
Buffer.add_string buf "<div class=\"sc-hero\">\n";
1717
+
Buffer.add_string buf
1718
+
(Printf.sprintf " <h1>%s</h1>\n" (html_escape title));
1719
+
Buffer.add_string buf "</div>\n";
1720
+
1721
+
(* Progress pips *)
1722
+
Buffer.add_string buf "<nav class=\"sc-progress\">\n";
1723
+
List.iteri
1724
+
(fun i _step ->
1725
+
Buffer.add_string buf
1726
+
(Printf.sprintf " <div class=\"sc-pip%s\"></div>\n"
1727
+
(if i = 0 then " sc-active" else "")))
1728
+
steps;
1729
+
Buffer.add_string buf "</nav>\n";
1730
+
1731
+
(* Desktop layout *)
1732
+
Buffer.add_string buf "<div class=\"sc-desktop\">\n";
1733
+
Buffer.add_string buf "<div class=\"sc-tutorial\">\n";
1734
+
1735
+
(* Steps column *)
1736
+
Buffer.add_string buf " <div class=\"sc-steps-col\">\n";
1737
+
List.iteri
1738
+
(fun i step ->
1739
+
Buffer.add_string buf
1740
+
(Printf.sprintf
1741
+
" <div class=\"sc-step\" data-step-index=\"%d\">\n" i);
1742
+
Buffer.add_string buf
1743
+
(Printf.sprintf
1744
+
" <div class=\"sc-step-number\">Step %02d</div>\n" (i + 1));
1745
+
if step.title <> "" then
1746
+
Buffer.add_string buf
1747
+
(Printf.sprintf " <h2>%s</h2>\n" (html_escape step.title));
1748
+
if step.prose <> "" then
1749
+
Buffer.add_string buf
1750
+
(Printf.sprintf " <p>%s</p>\n" (html_escape step.prose));
1751
+
(* Hidden code slot for JS to read *)
1752
+
Buffer.add_string buf " <div class=\"sc-code-slot\">\n";
1753
+
Buffer.add_string buf (generate_code_lines step.code step.focus);
1754
+
Buffer.add_string buf " </div>\n";
1755
+
Buffer.add_string buf
1756
+
(Printf.sprintf " <button class=\"sc-playground-btn\" data-step=\"%d\">▶ Try it</button>\n" i);
1757
+
Buffer.add_string buf " </div>\n")
1758
+
steps;
1759
+
Buffer.add_string buf " </div>\n";
1760
+
1761
+
(* Code column *)
1762
+
Buffer.add_string buf " <div class=\"sc-code-col\">\n";
1763
+
Buffer.add_string buf " <div class=\"sc-code-panel\">\n";
1764
+
Buffer.add_string buf " <div class=\"sc-code-header\">\n";
1765
+
Buffer.add_string buf
1766
+
" <div class=\"sc-dots\"><span></span><span></span><span></span></div>\n";
1767
+
Buffer.add_string buf
1768
+
(Printf.sprintf " <span class=\"sc-filename\">%s</span>\n"
1769
+
(html_escape filename));
1770
+
Buffer.add_string buf
1771
+
(Printf.sprintf
1772
+
" <span class=\"sc-step-badge\">1 / %d</span>\n"
1773
+
(List.length steps));
1774
+
Buffer.add_string buf " </div>\n";
1775
+
Buffer.add_string buf " <div class=\"sc-code-body\">\n";
1776
+
(* Initial code from first step *)
1777
+
(match steps with
1778
+
| first :: _ -> Buffer.add_string buf (generate_code_lines first.code first.focus)
1779
+
| [] -> ());
1780
+
Buffer.add_string buf " </div>\n";
1781
+
Buffer.add_string buf " </div>\n";
1782
+
Buffer.add_string buf " </div>\n";
1783
+
1784
+
Buffer.add_string buf "</div>\n";
1785
+
Buffer.add_string buf "</div>\n";
1786
+
1787
+
(* Mobile stacked layout *)
1788
+
Buffer.add_string buf (generate_mobile_html steps);
1789
+
1790
+
(* Playground overlay *)
1791
+
Buffer.add_string buf {|<div id="sc-playground-overlay" class="sc-playground-overlay">
1792
+
<div class="sc-playground-container">
1793
+
<div class="sc-playground-header">
1794
+
<span class="sc-playground-title">Playground</span>
1795
+
<button class="sc-playground-close">×</button>
1796
+
</div>
1797
+
<div class="sc-playground-editor">
1798
+
<x-ocaml id="sc-playground-x-ocaml" run-on="click"></x-ocaml>
1799
+
</div>
1800
+
</div>
1801
+
</div>
1802
+
|};
1803
+
1804
+
(* JavaScript *)
1805
+
Buffer.add_string buf "<script>\n";
1806
+
Buffer.add_string buf shared_js;
1807
+
Buffer.add_string buf "</script>\n";
1808
+
1809
+
(* x-ocaml for playground *)
1810
+
Buffer.add_string buf {|<script src="/_x-ocaml/x-ocaml.js" src-worker="/_x-ocaml/worker.js" backend="jtw"></script>
1811
+
|};
1812
+
1813
+
Buffer.contents buf
1814
+
1815
+
(** {1 Extension Registration} *)
1816
+
1817
+
module Scrolly : Odoc_extension_api.Extension = struct
1818
+
let prefix = "scrolly"
1819
+
1820
+
let to_document ~tag content =
1821
+
(* Extract theme from tag: scrolly.warm, scrolly.dark, scrolly.notebook *)
1822
+
let theme =
1823
+
match String.index_opt tag '.' with
1824
+
| None -> "warm"
1825
+
| Some i -> String.sub tag (i + 1) (String.length tag - i - 1)
1826
+
in
1827
+
let tutorial_title, steps = extract_steps content in
1828
+
let filename =
1829
+
match theme with
1830
+
| "dark" -> "main.ml"
1831
+
| "notebook" -> "test.ml"
1832
+
| _ -> "parser.ml"
1833
+
in
1834
+
let html = generate_html ~theme ~title:tutorial_title ~filename steps in
1835
+
let block : Block.t =
1836
+
[
1837
+
{
1838
+
Odoc_document.Types.Block.attr = [ "scrollycode" ];
1839
+
desc = Raw_markup ("html", html);
1840
+
};
1841
+
]
1842
+
in
1843
+
{ Odoc_extension_api.content = block; overrides = []; resources = []; assets = [] }
1844
+
end
1845
+
1846
+
let () = Odoc_extension_api.Registry.register (module Scrolly)
odoc-scrollycode-extension/_build/default/test/.merlin-conf/exe-odoc_scrolly
odoc-scrollycode-extension/_build/default/test/.merlin-conf/exe-odoc_scrolly
This is a binary file and will not be displayed.
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/byte/dune__exe.cmi
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/byte/dune__exe.cmi
This is a binary file and will not be displayed.
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/byte/dune__exe.cmo
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/byte/dune__exe.cmo
This is a binary file and will not be displayed.
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/byte/dune__exe.cmt
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/byte/dune__exe.cmt
This is a binary file and will not be displayed.
+7
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/dune__exe.ml-gen
+7
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/dune__exe.ml-gen
+1
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/dune__exe__Odoc_scrolly.impl.all-deps
+1
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/dune__exe__Odoc_scrolly.impl.all-deps
···
1
+
dune__exe__Odoc_scrolly_main
+1
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/dune__exe__Odoc_scrolly.impl.d
+1
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/dune__exe__Odoc_scrolly.impl.d
···
1
+
test/odoc_scrolly.ml: Odoc_scrolly_main Scrollycode_extension
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/dune__exe__Odoc_scrolly.intf.all-deps
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/dune__exe__Odoc_scrolly.intf.all-deps
This is a binary file and will not be displayed.
+1
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/dune__exe__Odoc_scrolly.intf.d
+1
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/dune__exe__Odoc_scrolly.intf.d
···
1
+
test/odoc_scrolly.mli:
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/dune__exe__Odoc_scrolly_main.impl.all-deps
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/dune__exe__Odoc_scrolly_main.impl.all-deps
This is a binary file and will not be displayed.
+1
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/dune__exe__Odoc_scrolly_main.impl.d
+1
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/dune__exe__Odoc_scrolly_main.impl.d
···
1
+
test/odoc_scrolly_main.ml: Arg Astring Classify Cmd Cmdliner Cmi_format Compile Depends Digest Extract_code Format Fpath Fs Html_fragment Html_page Indexing Io_utils Latex ListLabels Man_page Occurrences Odoc_document Odoc_extension_api Odoc_file Odoc_html Odoc_link Odoc_markdown Odoc_model Odoc_odoc Odoc_utils Printexc Printf Rendering Resolver ResultMonad Sidebar Source String Support_files Sys Term Url
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/native/dune__exe.cmx
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/native/dune__exe.cmx
This is a binary file and will not be displayed.
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/native/dune__exe.o
odoc-scrollycode-extension/_build/default/test/.odoc_scrolly.eobjs/native/dune__exe.o
This is a binary file and will not be displayed.
+14
odoc-scrollycode-extension/_build/default/test/odoc_scrolly.ml
+14
odoc-scrollycode-extension/_build/default/test/odoc_scrolly.ml
···
1
+
(* Custom odoc binary with the scrollycode extension statically linked.
2
+
3
+
The scrollycode extension registers itself when this module is loaded,
4
+
via the [let () = ...] at the bottom of scrollycode_extension.ml.
5
+
6
+
We force it to be linked by referencing it, then invoke the standard
7
+
odoc CLI entry point. *)
8
+
9
+
(* Force-link the extension module *)
10
+
let () =
11
+
ignore (Scrollycode_extension.Scrolly.prefix : string)
12
+
13
+
(* Include the full odoc CLI - this is main.ml without the dune-site loading *)
14
+
include Odoc_scrolly_main
+1
odoc-scrollycode-extension/_build/default/test/odoc_scrolly.mli
+1
odoc-scrollycode-extension/_build/default/test/odoc_scrolly.mli
···
1
+
(* Auto-generated by Dune *)
+1858
odoc-scrollycode-extension/_build/default/test/odoc_scrolly_main.ml
+1858
odoc-scrollycode-extension/_build/default/test/odoc_scrolly_main.ml
···
1
+
(* CR-someday trefis: the "deps" and "targets" subcommands currently output
2
+
their result on stdout.
3
+
It would make the interaction with jenga nicer if we could specify a file to
4
+
output the result to. *)
5
+
6
+
open Odoc_utils
7
+
open ResultMonad
8
+
module List = ListLabels
9
+
open Odoc_odoc
10
+
open Cmdliner
11
+
12
+
(* Load all installed extensions at startup *)
13
+
14
+
15
+
let convert_syntax : Odoc_document.Renderer.syntax Arg.conv =
16
+
let syntax_parser str =
17
+
match str with
18
+
| "ml" | "ocaml" -> Ok Odoc_document.Renderer.OCaml
19
+
| "re" | "reason" -> Ok Odoc_document.Renderer.Reason
20
+
| s -> Error (Printf.sprintf "Unknown syntax '%s'" s)
21
+
in
22
+
let syntax_printer fmt syntax =
23
+
Format.pp_print_string fmt (Odoc_document.Renderer.string_of_syntax syntax)
24
+
in
25
+
Arg.conv' (syntax_parser, syntax_printer)
26
+
27
+
let convert_directory ?(create = false) () : Fs.Directory.t Arg.conv =
28
+
let dir_parser, dir_printer =
29
+
(Arg.conv_parser Arg.string, Arg.conv_printer Arg.string)
30
+
in
31
+
let odoc_dir_parser str =
32
+
let () = if create then Fs.Directory.(mkdir_p (of_string str)) in
33
+
match dir_parser str with
34
+
| Ok res -> Ok (Fs.Directory.of_string res)
35
+
| Error (`Msg e) -> Error e
36
+
in
37
+
let odoc_dir_printer fmt dir = dir_printer fmt (Fs.Directory.to_string dir) in
38
+
Arg.conv' (odoc_dir_parser, odoc_dir_printer)
39
+
40
+
(** On top of the conversion 'file' that checks that the passed file exists. *)
41
+
let convert_fpath =
42
+
let parse inp =
43
+
match Arg.(conv_parser file) inp with
44
+
| Ok s -> Ok (Fs.File.of_string s)
45
+
| Error _ as e -> e
46
+
and print = Fpath.pp in
47
+
Arg.conv (parse, print)
48
+
49
+
let convert_named_root =
50
+
let parse inp =
51
+
match String.cuts inp ~sep:":" with
52
+
| [ s1; s2 ] -> Ok (s1, Fs.Directory.of_string s2)
53
+
| _ -> Error (`Msg "")
54
+
in
55
+
let print ppf (s, t) =
56
+
Format.fprintf ppf "%s:%s" s (Fs.Directory.to_string t)
57
+
in
58
+
Arg.conv (parse, print)
59
+
60
+
let handle_error = function
61
+
| Ok () -> ()
62
+
| Error (`Cli_error msg) ->
63
+
Printf.eprintf "%s\n%!" msg;
64
+
exit 2
65
+
| Error (`Msg msg) ->
66
+
Printf.eprintf "ERROR: %s\n%!" msg;
67
+
exit 1
68
+
69
+
module Antichain = struct
70
+
let absolute_normalization p =
71
+
let p =
72
+
if Fpath.is_rel p then Fpath.( // ) (Fpath.v (Sys.getcwd ())) p else p
73
+
in
74
+
Fpath.normalize p
75
+
76
+
(** Check that a list of directories form an antichain: they are all disjoints
77
+
*)
78
+
let check ~opt l =
79
+
let l =
80
+
List.map
81
+
~f:(fun p -> p |> Fs.Directory.to_fpath |> absolute_normalization)
82
+
l
83
+
in
84
+
let rec check = function
85
+
| [] -> true
86
+
| p1 :: rest ->
87
+
List.for_all
88
+
~f:(fun p2 ->
89
+
(not (Fpath.is_prefix p1 p2)) && not (Fpath.is_prefix p2 p1))
90
+
rest
91
+
&& check rest
92
+
in
93
+
if check l then Ok ()
94
+
else
95
+
let msg =
96
+
Format.sprintf "Paths given to all %s options must be disjoint" opt
97
+
in
98
+
Error (`Msg msg)
99
+
end
100
+
101
+
let docs = "ARGUMENTS"
102
+
103
+
let odoc_file_directories =
104
+
let doc =
105
+
"Where to look for required $(i,.odoc) files. Can be present several times."
106
+
in
107
+
Arg.(
108
+
value
109
+
& opt_all (convert_directory ()) []
110
+
& info ~docs ~docv:"DIR" ~doc [ "I" ])
111
+
112
+
let hidden =
113
+
let doc =
114
+
"Mark the unit as hidden. (Useful for files included in module packs)."
115
+
in
116
+
Arg.(value & flag & info ~docs ~doc [ "hidden" ])
117
+
118
+
let extra_suffix =
119
+
let doc =
120
+
"Extra suffix to append to generated filenames. This is intended for \
121
+
expect tests to use."
122
+
in
123
+
let default = None in
124
+
Arg.(
125
+
value
126
+
& opt (some string) default
127
+
& info ~docv:"SUFFIX" ~doc [ "extra-suffix" ])
128
+
129
+
let warnings_options =
130
+
let warn_error =
131
+
let doc = "Turn warnings into errors." in
132
+
let env =
133
+
Cmd.Env.info "ODOC_WARN_ERROR" ~doc:(doc ^ " See option $(opt).")
134
+
in
135
+
Arg.(value & flag & info ~docs ~doc ~env [ "warn-error" ])
136
+
in
137
+
let print_warnings =
138
+
let doc =
139
+
"Whether warnings should be printed to stderr. See the $(b,errors) \
140
+
command."
141
+
in
142
+
let env = Cmd.Env.info "ODOC_PRINT_WARNINGS" ~doc in
143
+
Arg.(value & opt bool true & info ~docs ~doc ~env [ "print-warnings" ])
144
+
in
145
+
let enable_missing_root_warning =
146
+
let doc =
147
+
"Produce a warning when a root is missing. This is usually a build \
148
+
system problem so is disabled for users by default."
149
+
in
150
+
let env = Cmd.Env.info "ODOC_ENABLE_MISSING_ROOT_WARNING" ~doc in
151
+
Arg.(value & flag & info ~docs ~doc ~env [ "enable-missing-root-warning" ])
152
+
in
153
+
let warnings_tag =
154
+
let doc =
155
+
"Warnings tag. This is useful when you want to declare that warnings \
156
+
that would be generated resolving the references defined in this unit \
157
+
should be ignored if they end up in expansions in other units. If this \
158
+
option is passed, link-time warnings will be suppressed unless the link \
159
+
command is passed the tag via the --warnings-tags parameter. A suitable \
160
+
tag would be the name of the package."
161
+
in
162
+
let env = Cmd.Env.info "ODOC_WARNINGS_TAG" ~doc in
163
+
Arg.(
164
+
value & opt (some string) None & info ~docs ~doc ~env [ "warnings-tag" ])
165
+
in
166
+
Term.(
167
+
const
168
+
(fun warn_error print_warnings enable_missing_root_warning warnings_tag ->
169
+
Odoc_model.Error.enable_missing_root_warning :=
170
+
enable_missing_root_warning;
171
+
{ Odoc_model.Error.warn_error; print_warnings; warnings_tag })
172
+
$ warn_error $ print_warnings $ enable_missing_root_warning $ warnings_tag)
173
+
174
+
let dst ?create () =
175
+
let doc = "Output directory where the HTML tree is expected to be saved." in
176
+
Arg.(
177
+
required
178
+
& opt (some (convert_directory ?create ())) None
179
+
& info ~docs ~docv:"DIR" ~doc [ "o"; "output-dir" ])
180
+
181
+
let open_modules =
182
+
let doc =
183
+
"Initially open module. Can be used more than once. Defaults to 'Stdlib'"
184
+
in
185
+
let default = [ "Stdlib" ] in
186
+
Arg.(value & opt_all string default & info ~docv:"MODULE" ~doc [ "open" ])
187
+
188
+
module Compile : sig
189
+
val output_file : dst:string option -> input:Fs.file -> Fs.file
190
+
191
+
val input : string Term.t
192
+
193
+
val dst : string option Term.t
194
+
195
+
val cmd : unit Term.t
196
+
197
+
val info : docs:string -> Cmd.info
198
+
end = struct
199
+
let has_page_prefix file =
200
+
file |> Fs.File.basename |> Fs.File.to_string
201
+
|> String.is_prefix ~affix:"page-"
202
+
203
+
let unique_id =
204
+
let doc = "For debugging use" in
205
+
Arg.(value & opt (some string) None & info ~doc ~docv:"ID" [ "unique-id" ])
206
+
207
+
let output_file ~dst ~input =
208
+
match dst with
209
+
| Some file ->
210
+
let output = Fs.File.of_string file in
211
+
if Fs.File.has_ext ".mld" input && not (has_page_prefix output) then (
212
+
Printf.eprintf
213
+
"ERROR: the name of the .odoc file produced from a .mld must start \
214
+
with 'page-'\n\
215
+
%!";
216
+
exit 1);
217
+
output
218
+
| None ->
219
+
let output =
220
+
if Fs.File.has_ext ".mld" input && not (has_page_prefix input) then
221
+
let directory = Fs.File.dirname input in
222
+
let name = Fs.File.basename input in
223
+
let name = "page-" ^ Fs.File.to_string name in
224
+
Fs.File.create ~directory ~name
225
+
else input
226
+
in
227
+
Fs.File.(set_ext ".odoc" output)
228
+
229
+
let compile hidden directories resolve_fwd_refs dst output_dir package_opt
230
+
parent_name_opt parent_id_opt open_modules children input warnings_options
231
+
unique_id short_title =
232
+
let _ =
233
+
match unique_id with
234
+
| Some id -> Odoc_model.Names.set_unique_ident id
235
+
| None -> ()
236
+
in
237
+
let resolver =
238
+
Resolver.create ~important_digests:(not resolve_fwd_refs) ~directories
239
+
~open_modules ~roots:None
240
+
in
241
+
let input = Fs.File.of_string input in
242
+
let output = output_file ~dst ~input in
243
+
let cli_spec =
244
+
let error message = Error (`Cli_error message) in
245
+
match
246
+
(parent_name_opt, package_opt, parent_id_opt, children, output_dir)
247
+
with
248
+
| Some _, None, None, _, None ->
249
+
Ok (Compile.CliParent { parent = parent_name_opt; children; output })
250
+
| None, Some p, None, [], None ->
251
+
Ok (Compile.CliPackage { package = p; output })
252
+
| None, None, Some p, [], Some output_dir ->
253
+
Ok (Compile.CliParentId { parent_id = p; output_dir })
254
+
| None, None, None, _ :: _, None ->
255
+
Ok (Compile.CliParent { parent = None; output; children })
256
+
| None, None, None, [], None -> Ok (Compile.CliNoParent output)
257
+
| Some _, Some _, _, _, _ ->
258
+
error "Either --package or --parent should be specified, not both."
259
+
| _, Some _, Some _, _, _ ->
260
+
error "Either --package or --parent-id should be specified, not both."
261
+
| Some _, _, Some _, _, _ ->
262
+
error "Either --parent or --parent-id should be specified, not both."
263
+
| _, _, None, _, Some _ ->
264
+
error "--output-dir can only be passed with --parent-id."
265
+
| None, Some _, _, _ :: _, _ ->
266
+
error "--child cannot be passed with --package."
267
+
| None, _, Some _, _ :: _, _ ->
268
+
error "--child cannot be passed with --parent-id."
269
+
| _, _, Some _, _, None ->
270
+
error "--output-dir is required when passing --parent-id."
271
+
in
272
+
cli_spec >>= fun cli_spec ->
273
+
Fs.Directory.mkdir_p (Fs.File.dirname output);
274
+
Compile.compile ~resolver ~cli_spec ~hidden ~warnings_options ~short_title
275
+
input
276
+
277
+
let input =
278
+
let doc = "Input $(i,.cmti), $(i,.cmt), $(i,.cmi) or $(i,.mld) file." in
279
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE" [])
280
+
281
+
let dst =
282
+
let doc =
283
+
"Output file path. Non-existing intermediate directories are created. If \
284
+
absent outputs a $(i,BASE.odoc) file in the same directory as the input \
285
+
file where $(i,BASE) is the basename of the input file. For mld files \
286
+
the \"page-\" prefix will be added if not already present in the input \
287
+
basename."
288
+
in
289
+
Arg.(value & opt (some string) None & info ~docs ~docv:"PATH" ~doc [ "o" ])
290
+
291
+
let output_dir =
292
+
let doc = "Output file directory. " in
293
+
Arg.(
294
+
value
295
+
& opt (some string) None
296
+
& info ~docs ~docv:"PATH" ~doc [ "output-dir" ])
297
+
298
+
let children =
299
+
let doc =
300
+
"Specify the $(i,.odoc) file as a child. Can be used multiple times. \
301
+
Only applies to mld files."
302
+
in
303
+
let default = [] in
304
+
Arg.(
305
+
value & opt_all string default & info ~docv:"CHILD" ~doc [ "c"; "child" ])
306
+
307
+
let cmd =
308
+
let package_opt =
309
+
let doc =
310
+
"Package the input is part of. Deprecated: use '--parent' instead."
311
+
in
312
+
Arg.(
313
+
value
314
+
& opt (some string) None
315
+
& info ~docs ~docv:"PKG" ~doc [ "package"; "pkg" ])
316
+
in
317
+
let parent_opt =
318
+
let doc = "Parent page or subpage." in
319
+
Arg.(
320
+
value
321
+
& opt (some string) None
322
+
& info ~docs ~docv:"PARENT" ~doc [ "parent" ])
323
+
in
324
+
let parent_id_opt =
325
+
let doc = "Parent id." in
326
+
Arg.(
327
+
value
328
+
& opt (some string) None
329
+
& info ~docs ~docv:"PARENT" ~doc [ "parent-id" ])
330
+
in
331
+
let short_title =
332
+
let doc = "Override short_title of an mld file" in
333
+
Arg.(
334
+
value
335
+
& opt (some string) None
336
+
& info ~docs ~docv:"TITLE" ~doc [ "short-title" ])
337
+
in
338
+
let resolve_fwd_refs =
339
+
let doc = "Try resolving forward references." in
340
+
Arg.(value & flag & info ~doc [ "r"; "resolve-fwd-refs" ])
341
+
in
342
+
Term.(
343
+
const handle_error
344
+
$ (const compile $ hidden $ odoc_file_directories $ resolve_fwd_refs $ dst
345
+
$ output_dir $ package_opt $ parent_opt $ parent_id_opt $ open_modules
346
+
$ children $ input $ warnings_options $ unique_id $ short_title))
347
+
348
+
let info ~docs =
349
+
let man =
350
+
[
351
+
`S "DEPENDENCIES";
352
+
`P
353
+
"Dependencies between compilation units is the same as while \
354
+
compiling the initial OCaml modules.";
355
+
`P "Mld pages don't have any dependency.";
356
+
]
357
+
in
358
+
let doc =
359
+
"Compile a $(i,.cmti), $(i,.cmt), $(i,.cmi) or $(i,.mld) file to an \
360
+
$(i,.odoc) file."
361
+
in
362
+
Cmd.info "compile" ~docs ~doc ~man
363
+
end
364
+
365
+
module Compile_asset = struct
366
+
let compile_asset parent_id name output_dir =
367
+
Odoc_odoc.Asset.compile ~parent_id ~name ~output_dir
368
+
369
+
let output_dir =
370
+
let doc = "Output file directory. " in
371
+
Arg.(
372
+
required
373
+
& opt (some string) None
374
+
& info ~docs ~docv:"PATH" ~doc [ "output-dir" ])
375
+
376
+
let cmd =
377
+
let asset_name =
378
+
let doc = "Name of the asset." in
379
+
Arg.(
380
+
required
381
+
& opt (some string) None
382
+
& info ~docs ~docv:"NAME" ~doc [ "name" ])
383
+
in
384
+
let parent_id =
385
+
let doc = "Parent id." in
386
+
Arg.(
387
+
required
388
+
& opt (some string) None
389
+
& info ~docs ~docv:"PARENT" ~doc [ "parent-id" ])
390
+
in
391
+
Term.(
392
+
const handle_error
393
+
$ (const compile_asset $ parent_id $ asset_name $ output_dir))
394
+
395
+
let info ~docs =
396
+
let man =
397
+
[
398
+
`S "DEPENDENCIES";
399
+
`P
400
+
"There are no dependency for compile assets, in particular you do \
401
+
not need the asset itself at this stage.";
402
+
]
403
+
in
404
+
let doc = "Declare the name of an asset." in
405
+
Cmd.info "compile-asset" ~docs ~doc ~man
406
+
end
407
+
408
+
module Compile_impl = struct
409
+
let prefix = "impl-"
410
+
411
+
let output_dir =
412
+
let doc = "Output file directory. " in
413
+
Arg.(
414
+
value
415
+
& opt (some string) None
416
+
& info ~docs ~docv:"PATH" ~doc [ "output-dir" ])
417
+
418
+
let output_file output_dir parent_id input =
419
+
let name =
420
+
Fs.File.basename input |> Fpath.set_ext "odoc" |> Fs.File.to_string
421
+
|> String.Ascii.uncapitalize
422
+
in
423
+
let name = prefix ^ name in
424
+
425
+
let dir = Fpath.(append output_dir parent_id) in
426
+
Fs.File.create
427
+
~directory:(Fpath.to_string dir |> Fs.Directory.of_string)
428
+
~name
429
+
430
+
let compile_impl directories output_dir parent_id source_id input
431
+
warnings_options =
432
+
let input = Fs.File.of_string input in
433
+
let output_dir =
434
+
match output_dir with Some x -> Fpath.v x | None -> Fpath.v "."
435
+
in
436
+
let output =
437
+
output_file output_dir
438
+
(match parent_id with Some x -> Fpath.v x | None -> Fpath.v ".")
439
+
input
440
+
in
441
+
let resolver =
442
+
Resolver.create ~important_digests:true ~directories ~open_modules:[]
443
+
~roots:None
444
+
in
445
+
Source.compile ~resolver ~source_id ~output ~warnings_options input
446
+
447
+
let cmd =
448
+
let input =
449
+
let doc = "Input $(i,.cmt) file." in
450
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE" [])
451
+
in
452
+
let source_id =
453
+
let doc = "The id of the source file" in
454
+
Arg.(
455
+
value
456
+
& opt (some string) None
457
+
& info [ "source-id" ] ~doc ~docv:"/path/to/source.ml")
458
+
in
459
+
let parent_id =
460
+
let doc = "The parent id of the implementation" in
461
+
Arg.(
462
+
value
463
+
& opt (some string) None
464
+
& info [ "parent-id" ] ~doc ~docv:"/path/to/library")
465
+
in
466
+
467
+
Term.(
468
+
const handle_error
469
+
$ (const compile_impl $ odoc_file_directories $ output_dir $ parent_id
470
+
$ source_id $ input $ warnings_options))
471
+
472
+
let info ~docs =
473
+
let doc =
474
+
"(EXPERIMENTAL) Compile a $(i,NAME.cmt) file to a $(i,src-NAME.odoc) \
475
+
containing the implementation information needed by odoc for the \
476
+
compilation unit."
477
+
in
478
+
Cmd.info "compile-impl" ~docs ~doc
479
+
end
480
+
481
+
module Indexing = struct
482
+
let output_file ~dst marshall =
483
+
match (dst, marshall) with
484
+
| Some file, `JSON
485
+
when not
486
+
(Fpath.has_ext "json" (Fpath.v file)
487
+
|| Fpath.has_ext "js" (Fpath.v file)) ->
488
+
Error
489
+
(`Msg
490
+
"When generating a json index, the output must have a .json or \
491
+
.js file extension")
492
+
| Some file, `Marshall when not (Fpath.has_ext "odoc-index" (Fpath.v file))
493
+
->
494
+
Error
495
+
(`Msg
496
+
"When generating a binary index, the output must have a \
497
+
.odoc-index file extension")
498
+
| Some file, _ -> Ok (Fs.File.of_string file)
499
+
| None, `JSON -> Ok (Fs.File.of_string "index.json")
500
+
| None, `Marshall -> Ok (Fs.File.of_string "index.odoc-index")
501
+
502
+
let index dst json warnings_options roots inputs_in_file inputs occurrences
503
+
simplified_json wrap_json =
504
+
let marshall = if json then `JSON else `Marshall in
505
+
output_file ~dst marshall >>= fun output ->
506
+
Indexing.compile marshall ~output ~warnings_options ~roots ~occurrences
507
+
~inputs_in_file ~simplified_json ~wrap_json ~odocls:inputs
508
+
509
+
let cmd =
510
+
let dst =
511
+
let doc =
512
+
"Output file path. Non-existing intermediate directories are created. \
513
+
Defaults to index.odoc-index, or index.json if --json is passed (in \
514
+
which case, the .odoc-index file extension is mandatory)."
515
+
in
516
+
Arg.(
517
+
value & opt (some string) None & info ~docs ~docv:"PATH" ~doc [ "o" ])
518
+
in
519
+
let occurrences =
520
+
let doc = "Occurrence file." in
521
+
Arg.(
522
+
value
523
+
& opt (some convert_fpath) None
524
+
& info ~docs ~docv:"PATH" ~doc [ "occurrences" ])
525
+
in
526
+
let inputs_in_file =
527
+
let doc =
528
+
"Input text file containing a line-separated list of paths to .odocl \
529
+
files to index."
530
+
in
531
+
Arg.(
532
+
value & opt_all convert_fpath []
533
+
& info ~doc ~docv:"FILE" [ "file-list" ])
534
+
in
535
+
let json =
536
+
let doc = "whether to output a json file, or a binary .odoc-index file" in
537
+
Arg.(value & flag & info ~doc [ "json" ])
538
+
in
539
+
let simplified_json =
540
+
let doc =
541
+
"whether to simplify the json file. Only has an effect in json output \
542
+
mode."
543
+
in
544
+
Arg.(value & flag & info ~doc [ "simplified-json" ])
545
+
in
546
+
let wrap_json =
547
+
let doc =
548
+
"Not intended for general use. Wraps the json output in a JavaScript \
549
+
variable assignment, and assumes the use of fuse.js"
550
+
in
551
+
Arg.(value & flag & info ~doc [ "wrap-json" ])
552
+
in
553
+
554
+
let inputs =
555
+
let doc = ".odocl file to index" in
556
+
Arg.(value & pos_all convert_fpath [] & info ~doc ~docv:"FILE" [])
557
+
in
558
+
let roots =
559
+
let doc =
560
+
"Specifies a directory PATH containing pages or units that should be \
561
+
included in the sidebar."
562
+
in
563
+
Arg.(
564
+
value
565
+
& opt_all (convert_directory ()) []
566
+
& info ~docs ~docv:"NAME:PATH" ~doc [ "root" ])
567
+
in
568
+
Term.(
569
+
const handle_error
570
+
$ (const index $ dst $ json $ warnings_options $ roots $ inputs_in_file
571
+
$ inputs $ occurrences $ simplified_json $ wrap_json))
572
+
573
+
let info ~docs =
574
+
let doc =
575
+
"Generate an index of all identified entries in the .odocl files found \
576
+
in the given directories."
577
+
in
578
+
Cmd.info "compile-index" ~docs ~doc
579
+
end
580
+
581
+
module Sidebar = struct
582
+
let output_file ~dst marshall =
583
+
match (dst, marshall) with
584
+
| Some file, `JSON when not (Fpath.has_ext "json" (Fpath.v file)) ->
585
+
Error
586
+
(`Msg
587
+
"When generating a sidebar with --json, the output must have a \
588
+
.json file extension")
589
+
| Some file, `Marshall
590
+
when not (Fpath.has_ext "odoc-sidebar" (Fpath.v file)) ->
591
+
Error
592
+
(`Msg
593
+
"When generating sidebar, the output must have a .odoc-sidebar \
594
+
file extension")
595
+
| Some file, _ -> Ok (Fs.File.of_string file)
596
+
| None, `JSON -> Ok (Fs.File.of_string "sidebar.json")
597
+
| None, `Marshall -> Ok (Fs.File.of_string "sidebar.odoc-sidebar")
598
+
599
+
let generate dst json warnings_options input =
600
+
let marshall = if json then `JSON else `Marshall in
601
+
output_file ~dst marshall >>= fun output ->
602
+
Sidebar.generate ~marshall ~output ~warnings_options ~index:input
603
+
604
+
let cmd =
605
+
let dst =
606
+
let doc =
607
+
"Output file path. Non-existing intermediate directories are created. \
608
+
Defaults to sidebar.odoc-sidebar, or sidebar.json if --json is \
609
+
passed."
610
+
in
611
+
Arg.(
612
+
value & opt (some string) None & info ~docs ~docv:"PATH" ~doc [ "o" ])
613
+
in
614
+
let json =
615
+
let doc = "whether to output a json file, or a binary .odoc-index file" in
616
+
Arg.(value & flag & info ~doc [ "json" ])
617
+
in
618
+
let inputs =
619
+
let doc = ".odoc-index file to generate a value from" in
620
+
Arg.(
621
+
required & pos 0 (some convert_fpath) None & info ~doc ~docv:"FILE" [])
622
+
in
623
+
Term.(
624
+
const handle_error
625
+
$ (const generate $ dst $ json $ warnings_options $ inputs))
626
+
627
+
let info ~docs =
628
+
let doc = "Generate a sidebar from an index file." in
629
+
Cmd.info "sidebar-generate" ~docs ~doc
630
+
end
631
+
632
+
module Support_files_command = struct
633
+
let support_files without_theme output_dir =
634
+
Support_files.write ~without_theme output_dir
635
+
636
+
let without_theme =
637
+
let doc = "Don't copy the default theme to output directory." in
638
+
Arg.(value & flag & info ~doc [ "without-theme" ])
639
+
640
+
let cmd = Term.(const support_files $ without_theme $ dst ~create:true ())
641
+
642
+
let info ~docs =
643
+
let doc =
644
+
"Copy the support files (e.g. default theme, JavaScript files) to the \
645
+
output directory."
646
+
in
647
+
Cmd.info ~docs ~doc "support-files"
648
+
end
649
+
650
+
module Css = struct
651
+
let cmd = Support_files_command.cmd
652
+
653
+
let info ~docs =
654
+
let doc =
655
+
"DEPRECATED: Use $(i,odoc support-files) to copy the CSS file for the \
656
+
default theme."
657
+
in
658
+
Cmd.info ~docs ~doc "css"
659
+
end
660
+
661
+
module Odoc_link : sig
662
+
val cmd : unit Term.t
663
+
664
+
val info : docs:string -> Cmd.info
665
+
end = struct
666
+
let get_output_file ~output_file ~input =
667
+
match output_file with
668
+
| Some file -> Fs.File.of_string file
669
+
| None -> Fs.File.(set_ext ".odocl" input)
670
+
671
+
(** Find the package/library name the output is part of *)
672
+
let find_root_of_input l o =
673
+
let l =
674
+
List.map
675
+
~f:(fun (x, p) ->
676
+
(x, p, p |> Fs.Directory.to_fpath |> Antichain.absolute_normalization))
677
+
l
678
+
in
679
+
let o = Antichain.absolute_normalization o in
680
+
match l with
681
+
| [] -> None
682
+
| _ ->
683
+
Odoc_utils.List.find_map
684
+
(fun (root, orig_path, norm_path) ->
685
+
if Fpath.is_prefix norm_path o then Some (root, orig_path) else None)
686
+
l
687
+
688
+
let current_library_of_input lib_roots input =
689
+
find_root_of_input lib_roots input
690
+
691
+
(** Checks if the package specified with [--current-package] is consistent
692
+
with the pages roots and with the output path for pages. *)
693
+
let validate_current_package ?detected_package page_roots current_package =
694
+
match (current_package, detected_package) with
695
+
| Some curpkgnane, Some (detected_package, _)
696
+
when detected_package <> curpkgnane ->
697
+
Error
698
+
(`Msg
699
+
"The package name specified with --current-package is not \
700
+
consistent with the packages passed as a -P")
701
+
| _, (Some _ as r) (* we have equality or only detected package *) -> Ok r
702
+
| None, None -> Ok None
703
+
| Some given, None -> (
704
+
try Ok (Some (given, List.assoc given page_roots))
705
+
with Not_found ->
706
+
Error
707
+
(`Msg
708
+
"The package name specified with --current-package do not match \
709
+
any package passed as a -P"))
710
+
711
+
let find_current_package ~current_package page_roots input =
712
+
let detected_package = find_root_of_input page_roots input in
713
+
validate_current_package ?detected_package page_roots current_package
714
+
715
+
let warnings_tags =
716
+
let doc =
717
+
"Filter warnings that were compiled with a tag that is not in the list \
718
+
of --warnings-tags passed."
719
+
in
720
+
let env = Cmd.Env.info "ODOC_WARNINGS_TAGS" ~doc in
721
+
Arg.(value & opt_all string [] & info ~docs ~doc ~env [ "warnings-tags" ])
722
+
723
+
let link directories page_roots lib_roots input_file output_file
724
+
current_package warnings_options open_modules custom_layout warnings_tags
725
+
=
726
+
let input = Fs.File.of_string input_file in
727
+
let output = get_output_file ~output_file ~input in
728
+
let check () =
729
+
if not custom_layout then
730
+
Antichain.check (page_roots |> List.map ~f:snd) ~opt:"-P" >>= fun () ->
731
+
Antichain.check (lib_roots |> List.map ~f:snd) ~opt:"-L"
732
+
else Ok ()
733
+
in
734
+
check () >>= fun () ->
735
+
let current_lib = current_library_of_input lib_roots input in
736
+
find_current_package ~current_package page_roots input
737
+
>>= fun current_package ->
738
+
let current_dir = Fs.File.dirname input in
739
+
let roots =
740
+
Some
741
+
{
742
+
Resolver.page_roots;
743
+
lib_roots;
744
+
current_lib;
745
+
current_package;
746
+
current_dir;
747
+
}
748
+
in
749
+
750
+
let resolver =
751
+
Resolver.create ~important_digests:false ~directories ~open_modules ~roots
752
+
in
753
+
match
754
+
Odoc_link.from_odoc ~resolver ~warnings_options ~warnings_tags input
755
+
output
756
+
with
757
+
| Error _ as e -> e
758
+
| Ok _ -> Ok ()
759
+
760
+
let dst =
761
+
let doc =
762
+
"Output file path. Non-existing intermediate directories are created. If \
763
+
absent outputs a $(i,.odocl) file in the same directory as the input \
764
+
file with the same basename."
765
+
in
766
+
Arg.(
767
+
value
768
+
& opt (some string) None
769
+
& info ~docs ~docv:"PATH.odocl" ~doc [ "o" ])
770
+
771
+
let page_roots =
772
+
let doc =
773
+
"Specifies a directory DIR containing pages that can be referenced by \
774
+
{!/pkgname/pagename}. A pkgname can be specified in the -P command only \
775
+
once. All the trees specified by this option and -L must be disjoint."
776
+
in
777
+
Arg.(
778
+
value
779
+
& opt_all convert_named_root []
780
+
& info ~docs ~docv:"pkgname:DIR" ~doc [ "P" ])
781
+
782
+
let lib_roots =
783
+
let doc =
784
+
"Specifies a library called libname containing the modules in directory \
785
+
DIR. Modules can be referenced both using the flat module namespace \
786
+
{!Module} and the absolute reference {!/libname/Module}. All the trees \
787
+
specified by this option and -P must be disjoint."
788
+
in
789
+
Arg.(
790
+
value
791
+
& opt_all convert_named_root []
792
+
& info ~docs ~docv:"libname:DIR" ~doc [ "L" ])
793
+
794
+
let current_package =
795
+
let doc =
796
+
"Specify the current package name. The matching page root specified with \
797
+
-P is used to resolve references using the '//' syntax. A \
798
+
corresponding -P option must be passed."
799
+
in
800
+
Arg.(
801
+
value
802
+
& opt (some string) None
803
+
& info ~docs ~docv:"pkgname" ~doc [ "current-package" ])
804
+
805
+
let custom_layout =
806
+
let doc =
807
+
"Signal that a custom layout is being used. This disables the checks \
808
+
that the library and package paths are disjoint."
809
+
in
810
+
Arg.(value & flag (info ~doc [ "custom-layout" ]))
811
+
812
+
let cmd =
813
+
let input =
814
+
let doc = "Input file" in
815
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE.odoc" [])
816
+
in
817
+
Term.(
818
+
const handle_error
819
+
$ (const link $ odoc_file_directories $ page_roots $ lib_roots $ input
820
+
$ dst $ current_package $ warnings_options $ open_modules $ custom_layout
821
+
$ warnings_tags))
822
+
823
+
let info ~docs =
824
+
let man =
825
+
[
826
+
`S "DEPENDENCIES";
827
+
`P
828
+
"Any link step depends on the result of all the compile results that \
829
+
could potentially be needed to resolve forward references. A \
830
+
correct approximation is to start linking only after every compile \
831
+
steps are done, passing everything that's possible to $(i,-I). Link \
832
+
steps don't have dependencies between them.";
833
+
]
834
+
in
835
+
let doc =
836
+
"Second stage of compilation. Link a $(i,.odoc) into a $(i,.odocl)."
837
+
in
838
+
Cmd.info ~docs ~doc ~man "link"
839
+
end
840
+
841
+
module type S = sig
842
+
type args
843
+
844
+
val renderer : args Odoc_document.Renderer.t
845
+
846
+
val extra_args : args Cmdliner.Term.t
847
+
end
848
+
849
+
module Make_renderer (R : S) : sig
850
+
val process : docs:string -> unit Term.t * Cmd.info
851
+
852
+
val targets : docs:string -> unit Term.t * Cmd.info
853
+
854
+
val targets_source : docs:string -> unit Term.t * Cmd.info
855
+
856
+
val generate : docs:string -> unit Term.t * Cmd.info
857
+
858
+
val generate_source : docs:string -> unit Term.t * Cmd.info
859
+
860
+
val generate_asset : docs:string -> unit Term.t * Cmd.info
861
+
end = struct
862
+
let input_odoc =
863
+
let doc = "Input file." in
864
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE.odoc" [])
865
+
866
+
let input_odocl =
867
+
let doc = "Input file." in
868
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE.odocl" [])
869
+
870
+
let input_odocl_list =
871
+
let doc = "Input file(s)." in
872
+
Arg.(non_empty & pos_all file [] & info ~doc ~docv:"FILE.odocl" [])
873
+
874
+
module Process = struct
875
+
let process extra _hidden directories output_dir syntax input_file
876
+
warnings_options =
877
+
let resolver =
878
+
Resolver.create ~important_digests:false ~directories ~open_modules:[]
879
+
~roots:None
880
+
in
881
+
let file = Fs.File.of_string input_file in
882
+
Rendering.render_odoc ~renderer:R.renderer ~resolver ~warnings_options
883
+
~syntax ~output:output_dir extra file
884
+
885
+
let cmd =
886
+
let syntax =
887
+
let doc = "Available options: ml | re" in
888
+
let env = Cmd.Env.info "ODOC_SYNTAX" in
889
+
Arg.(
890
+
value
891
+
& opt convert_syntax Odoc_document.Renderer.OCaml
892
+
@@ info ~docv:"SYNTAX" ~doc ~env [ "syntax" ])
893
+
in
894
+
Term.(
895
+
const handle_error
896
+
$ (const process $ R.extra_args $ hidden $ odoc_file_directories
897
+
$ dst ~create:true () $ syntax $ input_odoc $ warnings_options))
898
+
899
+
let info ~docs =
900
+
let doc =
901
+
Format.sprintf
902
+
"Render %s files from a $(i,.odoc). $(i,link) then $(i,%s-generate) \
903
+
should be used instead."
904
+
R.renderer.name R.renderer.name
905
+
in
906
+
Cmd.info ~docs ~doc R.renderer.name
907
+
end
908
+
909
+
let process ~docs = Process.(cmd, info ~docs)
910
+
911
+
module Generate = struct
912
+
let generate extra _hidden output_dir syntax extra_suffix input_files
913
+
warnings_options sidebar =
914
+
let process_file input_file =
915
+
let file = Fs.File.of_string input_file in
916
+
Rendering.generate_odoc ~renderer:R.renderer ~warnings_options ~syntax
917
+
~output:output_dir ~extra_suffix ~sidebar extra file
918
+
in
919
+
List.fold_left
920
+
~f:(fun acc input_file -> acc >>= fun () -> process_file input_file)
921
+
~init:(Ok ()) input_files
922
+
923
+
let sidebar =
924
+
let doc = "A .odoc-index file, used eg to generate the sidebar." in
925
+
Arg.(
926
+
value
927
+
& opt (some convert_fpath) None
928
+
& info [ "sidebar" ] ~doc ~docv:"FILE.odoc-sidebar")
929
+
930
+
let cmd =
931
+
let syntax =
932
+
let doc = "Available options: ml | re" in
933
+
let env = Cmd.Env.info "ODOC_SYNTAX" in
934
+
Arg.(
935
+
value
936
+
& opt convert_syntax Odoc_document.Renderer.OCaml
937
+
@@ info ~docv:"SYNTAX" ~doc ~env [ "syntax" ])
938
+
in
939
+
Term.(
940
+
const handle_error
941
+
$ (const generate $ R.extra_args $ hidden $ dst ~create:true () $ syntax
942
+
$ extra_suffix $ input_odocl_list $ warnings_options $ sidebar))
943
+
944
+
let info ~docs =
945
+
let doc =
946
+
Format.sprintf "Generate %s files from one or more $(i,.odocl) files."
947
+
R.renderer.name
948
+
in
949
+
Cmd.info ~docs ~doc (R.renderer.name ^ "-generate")
950
+
end
951
+
952
+
let generate ~docs = Generate.(cmd, info ~docs)
953
+
954
+
module Generate_source = struct
955
+
let generate extra output_dir syntax extra_suffix input_file
956
+
warnings_options source_file sidebar =
957
+
Rendering.generate_source_odoc ~renderer:R.renderer ~warnings_options
958
+
~syntax ~output:output_dir ~extra_suffix ~source_file ~sidebar extra
959
+
input_file
960
+
961
+
let input_odocl =
962
+
let doc = "Linked implementation file." in
963
+
Arg.(
964
+
required
965
+
& opt (some convert_fpath) None
966
+
& info [ "impl" ] ~doc ~docv:"impl-FILE.odocl")
967
+
968
+
let source_file =
969
+
let doc = "Source code for the implementation unit." in
970
+
Arg.(
971
+
required
972
+
& pos 0 (some convert_fpath) None
973
+
& info ~doc ~docv:"FILE.ml" [])
974
+
975
+
let cmd =
976
+
let syntax =
977
+
let doc = "Available options: ml | re" in
978
+
let env = Cmd.Env.info "ODOC_SYNTAX" in
979
+
Arg.(
980
+
value
981
+
& opt convert_syntax Odoc_document.Renderer.OCaml
982
+
@@ info ~docv:"SYNTAX" ~doc ~env [ "syntax" ])
983
+
in
984
+
let sidebar = Generate.sidebar in
985
+
Term.(
986
+
const handle_error
987
+
$ (const generate $ R.extra_args $ dst ~create:true () $ syntax
988
+
$ extra_suffix $ input_odocl $ warnings_options $ source_file $ sidebar
989
+
))
990
+
991
+
let info ~docs =
992
+
let doc =
993
+
Format.sprintf "Generate %s files from a $(i,impl-*.odocl)."
994
+
R.renderer.name
995
+
in
996
+
Cmd.info ~docs ~doc (R.renderer.name ^ "-generate-source")
997
+
end
998
+
999
+
let generate_source ~docs = Generate_source.(cmd, info ~docs)
1000
+
1001
+
module Generate_asset = struct
1002
+
let generate extra output_dir extra_suffix input_file warnings_options
1003
+
asset_file =
1004
+
Rendering.generate_asset_odoc ~renderer:R.renderer ~warnings_options
1005
+
~output:output_dir ~extra_suffix ~asset_file extra input_file
1006
+
1007
+
let input_odocl =
1008
+
let doc = "Odoc asset unit." in
1009
+
Arg.(
1010
+
required
1011
+
& opt (some convert_fpath) None
1012
+
& info [ "asset-unit" ] ~doc ~docv:"asset-FILE.odocl")
1013
+
1014
+
let asset_file =
1015
+
let doc = "The asset file" in
1016
+
Arg.(
1017
+
required
1018
+
& pos 0 (some convert_fpath) None
1019
+
& info ~doc ~docv:"FILE.ext" [])
1020
+
1021
+
let cmd =
1022
+
Term.(
1023
+
const handle_error
1024
+
$ (const generate $ R.extra_args $ dst ~create:true () $ extra_suffix
1025
+
$ input_odocl $ warnings_options $ asset_file))
1026
+
1027
+
let info ~docs =
1028
+
let doc =
1029
+
Format.sprintf "Generate %s files from a $(i,impl-*.odocl)."
1030
+
R.renderer.name
1031
+
in
1032
+
Cmd.info ~docs ~doc (R.renderer.name ^ "-generate-asset")
1033
+
end
1034
+
1035
+
let generate_asset ~docs = Generate_asset.(cmd, info ~docs)
1036
+
1037
+
module Targets = struct
1038
+
let list_targets output_dir directories extra odoc_file =
1039
+
let odoc_file = Fs.File.of_string odoc_file in
1040
+
let resolver =
1041
+
Resolver.create ~important_digests:false ~directories ~open_modules:[]
1042
+
~roots:None
1043
+
in
1044
+
let warnings_options =
1045
+
{
1046
+
Odoc_model.Error.warn_error = false;
1047
+
print_warnings = false;
1048
+
warnings_tag = None;
1049
+
}
1050
+
in
1051
+
Rendering.targets_odoc ~resolver ~warnings_options ~syntax:OCaml
1052
+
~renderer:R.renderer ~output:output_dir ~extra odoc_file
1053
+
1054
+
let back_compat =
1055
+
let doc =
1056
+
"For backwards compatibility when processing $(i,.odoc) rather than \
1057
+
$(i,.odocl) files."
1058
+
in
1059
+
Arg.(
1060
+
value
1061
+
& opt_all (convert_directory ()) []
1062
+
& info ~docs ~docv:"DIR" ~doc [ "I" ])
1063
+
1064
+
let cmd =
1065
+
Term.(
1066
+
const handle_error
1067
+
$ (const list_targets $ dst () $ back_compat $ R.extra_args
1068
+
$ input_odocl))
1069
+
1070
+
let info ~docs =
1071
+
let doc =
1072
+
Format.sprintf
1073
+
"Print the files that would be generated by $(i,%s-generate)."
1074
+
R.renderer.name
1075
+
in
1076
+
Cmd.info (R.renderer.name ^ "-targets") ~docs ~doc
1077
+
end
1078
+
1079
+
let targets ~docs = Targets.(cmd, info ~docs)
1080
+
1081
+
module Targets_source = struct
1082
+
let list_targets output_dir source_file extra odoc_file =
1083
+
let warnings_options =
1084
+
{
1085
+
Odoc_model.Error.warn_error = false;
1086
+
print_warnings = false;
1087
+
warnings_tag = None;
1088
+
}
1089
+
in
1090
+
Rendering.targets_source_odoc ~warnings_options ~syntax:OCaml
1091
+
~renderer:R.renderer ~output:output_dir ~extra ~source_file odoc_file
1092
+
1093
+
let source_file = Generate_source.source_file
1094
+
let input_odocl = Generate_source.input_odocl
1095
+
1096
+
let cmd =
1097
+
Term.(
1098
+
const handle_error
1099
+
$ (const list_targets $ dst () $ source_file $ R.extra_args
1100
+
$ input_odocl))
1101
+
1102
+
let info ~docs =
1103
+
let doc =
1104
+
Format.sprintf
1105
+
"Print the files that would be generated by $(i,%s-generate-source)."
1106
+
R.renderer.name
1107
+
in
1108
+
Cmd.info (R.renderer.name ^ "-targets-source") ~docs ~doc
1109
+
end
1110
+
1111
+
let targets_source ~docs = Targets_source.(cmd, info ~docs)
1112
+
end
1113
+
1114
+
module Odoc_latex_url : sig
1115
+
val cmd : unit Term.t
1116
+
1117
+
val info : docs:string -> Cmd.info
1118
+
end = struct
1119
+
let reference =
1120
+
let doc = "The reference to be resolved and whose url to be generated." in
1121
+
Arg.(required & pos 0 (some string) None & info ~doc ~docv:"REF" [])
1122
+
1123
+
let reference_to_url = Url.reference_to_url_latex
1124
+
1125
+
let cmd =
1126
+
Term.(
1127
+
const handle_error
1128
+
$ (const reference_to_url $ odoc_file_directories $ reference))
1129
+
1130
+
let info ~docs =
1131
+
Cmd.info ~docs ~doc:"Resolve a reference and output its corresponding url."
1132
+
"latex-url"
1133
+
end
1134
+
1135
+
module Odoc_html_args = struct
1136
+
include Html_page
1137
+
1138
+
let semantic_uris =
1139
+
let doc = "Generate pretty (semantic) links." in
1140
+
Arg.(value & flag (info ~doc [ "semantic-uris"; "pretty-uris" ]))
1141
+
1142
+
let closed_details =
1143
+
let doc =
1144
+
"If this flag is passed <details> tags (used for includes) will be \
1145
+
closed by default."
1146
+
in
1147
+
Arg.(value & flag (info ~doc [ "closed-details" ]))
1148
+
1149
+
let indent =
1150
+
let doc = "Format the output HTML files with indentation." in
1151
+
Arg.(value & flag (info ~doc [ "indent" ]))
1152
+
1153
+
module Uri = struct
1154
+
(* Very basic validation and normalization for URI paths. *)
1155
+
1156
+
open Odoc_html.Types
1157
+
1158
+
let is_absolute str =
1159
+
List.exists [ "http"; "https"; "file"; "data"; "ftp" ] ~f:(fun scheme ->
1160
+
Astring.String.is_prefix ~affix:(scheme ^ ":") str)
1161
+
|| str.[0] = '/'
1162
+
1163
+
let conv_rel_dir rel =
1164
+
let l = String.cuts ~sep:"/" rel in
1165
+
List.fold_left
1166
+
~f:(fun acc seg ->
1167
+
Some Odoc_document.Url.Path.{ kind = `Page; parent = acc; name = seg })
1168
+
l ~init:None
1169
+
1170
+
let convert_dir : uri Arg.conv =
1171
+
let parser str =
1172
+
if String.length str = 0 then Error "invalid URI"
1173
+
else
1174
+
(* The URI is absolute if it starts with a scheme or with '/'. *)
1175
+
let last_char = str.[String.length str - 1] in
1176
+
let str =
1177
+
if last_char <> '/' then str
1178
+
else String.with_range ~len:(String.length str - 1) str
1179
+
in
1180
+
Ok
1181
+
(if is_absolute str then (Absolute str : uri)
1182
+
else
1183
+
Relative
1184
+
(let u = conv_rel_dir str in
1185
+
match u with
1186
+
| None -> None
1187
+
| Some u -> Some { u with kind = `Page }))
1188
+
in
1189
+
let printer ppf = function
1190
+
| (Absolute uri : uri) -> Format.pp_print_string ppf uri
1191
+
| Relative _uri -> Format.pp_print_string ppf ""
1192
+
in
1193
+
Arg.conv' (parser, printer)
1194
+
1195
+
let convert_file_uri : Odoc_html.Types.file_uri Arg.conv =
1196
+
let parser str =
1197
+
if String.length str = 0 then Error "invalid URI"
1198
+
else
1199
+
let conv_rel_file rel =
1200
+
match String.cut ~rev:true ~sep:"/" rel with
1201
+
| Some (before, after) ->
1202
+
let base = conv_rel_dir before in
1203
+
Odoc_document.Url.Path.
1204
+
{ kind = `File; parent = base; name = after }
1205
+
| None ->
1206
+
Odoc_document.Url.Path.
1207
+
{ kind = `File; parent = None; name = rel }
1208
+
in
1209
+
Ok
1210
+
(if is_absolute str then (Absolute str : file_uri)
1211
+
else Relative (conv_rel_file str))
1212
+
in
1213
+
let printer ppf = function
1214
+
| Odoc_html.Types.Absolute uri -> Format.pp_print_string ppf uri
1215
+
| Odoc_html.Types.Relative _uri -> Format.pp_print_string ppf ""
1216
+
in
1217
+
Arg.conv' (parser, printer)
1218
+
end
1219
+
1220
+
let home_breadcrumb =
1221
+
let doc =
1222
+
"Name for a 'Home' breadcrumb to go up the root of the given sidebar."
1223
+
in
1224
+
Arg.(
1225
+
value
1226
+
& opt (some string) None
1227
+
& info ~docv:"escape" ~doc [ "home-breadcrumb" ])
1228
+
1229
+
let theme_uri =
1230
+
let doc =
1231
+
"Where to look for theme files (e.g. `URI/odoc.css'). Relative URIs are \
1232
+
resolved using `--output-dir' as a target."
1233
+
in
1234
+
let default : Odoc_html.Types.uri = Odoc_html.Types.Relative None in
1235
+
Arg.(
1236
+
value
1237
+
& opt Uri.convert_dir default
1238
+
& info ~docv:"URI" ~doc [ "theme-uri" ])
1239
+
1240
+
let support_uri =
1241
+
let doc =
1242
+
"Where to look for support files (e.g. `URI/highlite.pack.js'). Relative \
1243
+
URIs are resolved using `--output-dir' as a target."
1244
+
in
1245
+
let default : Odoc_html.Types.uri = Odoc_html.Types.Relative None in
1246
+
Arg.(
1247
+
value
1248
+
& opt Uri.convert_dir default
1249
+
& info ~docv:"URI" ~doc [ "support-uri" ])
1250
+
1251
+
let search_uri =
1252
+
let doc =
1253
+
"Where to look for search scripts. Relative URIs are resolved using \
1254
+
`--output-dir' as a target."
1255
+
in
1256
+
Arg.(
1257
+
value
1258
+
& opt_all Uri.convert_file_uri []
1259
+
& info ~docv:"URI" ~doc [ "search-uri" ])
1260
+
1261
+
let flat =
1262
+
let doc =
1263
+
"Output HTML files in 'flat' mode, where the hierarchy of modules / \
1264
+
module types / classes and class types are reflected in the filenames \
1265
+
rather than in the directory structure."
1266
+
in
1267
+
Arg.(value & flag & info ~docs ~doc [ "flat" ])
1268
+
1269
+
let as_json =
1270
+
let doc =
1271
+
"EXPERIMENTAL: Output HTML files in 'embeddable json' mode, where HTML \
1272
+
fragments (preamble, content) together with metadata (uses_katex, \
1273
+
breadcrumbs, table of contents) are emitted in JSON format. The \
1274
+
structure of the output should be considered unstable and no guarantees \
1275
+
are made about backward compatibility."
1276
+
in
1277
+
Arg.(value & flag & info ~doc [ "as-json" ])
1278
+
1279
+
let remap =
1280
+
let convert_remap =
1281
+
let parse inp =
1282
+
match String.cut ~sep:":" inp with
1283
+
| Some (orig, mapped) -> Ok (orig, mapped)
1284
+
| _ -> Error (`Msg "Map must be of the form '<orig>:https://...'")
1285
+
and print fmt (orig, mapped) = Format.fprintf fmt "%s:%s" orig mapped in
1286
+
Arg.conv (parse, print)
1287
+
in
1288
+
let doc = "Remap an identifier to an external URL." in
1289
+
Arg.(value & opt_all convert_remap [] & info [ "R" ] ~doc)
1290
+
1291
+
let remap_file =
1292
+
let doc = "File containing remap rules." in
1293
+
Arg.(value & opt (some file) None & info ~docv:"FILE" ~doc [ "remap-file" ])
1294
+
1295
+
let extra_args =
1296
+
let config semantic_uris closed_details indent theme_uri support_uri
1297
+
search_uris flat as_json remap remap_file home_breadcrumb =
1298
+
let open_details = not closed_details in
1299
+
let remap =
1300
+
match remap_file with
1301
+
| None -> remap
1302
+
| Some f ->
1303
+
Io_utils.fold_lines f
1304
+
(fun line acc ->
1305
+
match String.cut ~sep:":" line with
1306
+
| Some (orig, mapped) -> (orig, mapped) :: acc
1307
+
| None -> acc)
1308
+
[]
1309
+
in
1310
+
let html_config =
1311
+
Odoc_html.Config.v ~theme_uri ~support_uri ~search_uris ~semantic_uris
1312
+
~indent ~flat ~open_details ~as_json ~remap ?home_breadcrumb ()
1313
+
in
1314
+
{ Html_page.html_config }
1315
+
in
1316
+
Term.(
1317
+
const config $ semantic_uris $ closed_details $ indent $ theme_uri
1318
+
$ support_uri $ search_uri $ flat $ as_json $ remap $ remap_file
1319
+
$ home_breadcrumb)
1320
+
end
1321
+
1322
+
module Odoc_html = Make_renderer (Odoc_html_args)
1323
+
1324
+
module Odoc_markdown_cmd = Make_renderer (struct
1325
+
type args = Odoc_markdown.Config.t
1326
+
1327
+
let render config _sidebar page = Odoc_markdown.Generator.render ~config page
1328
+
1329
+
let filepath config url = Odoc_markdown.Generator.filepath ~config url
1330
+
1331
+
let extra_args =
1332
+
Term.const { Odoc_markdown.Config.root_url = None; allow_html = true }
1333
+
let renderer = { Odoc_document.Renderer.name = "markdown"; render; filepath }
1334
+
end)
1335
+
1336
+
module Odoc_html_url : sig
1337
+
val cmd : unit Term.t
1338
+
1339
+
val info : docs:string -> Cmd.info
1340
+
end = struct
1341
+
let root_url =
1342
+
let doc =
1343
+
"A string to prepend to the generated relative url. A separating / is \
1344
+
added if needed."
1345
+
in
1346
+
Arg.(value & opt (some string) None & info [ "r"; "root-url" ] ~doc)
1347
+
1348
+
let reference =
1349
+
let doc = "The reference to be resolved and whose url to be generated." in
1350
+
Arg.(required & pos 0 (some string) None & info ~doc ~docv:"REF" [])
1351
+
1352
+
let reference_to_url = Url.reference_to_url_html
1353
+
1354
+
let cmd =
1355
+
Term.(
1356
+
const handle_error
1357
+
$ (const reference_to_url $ Odoc_html_args.extra_args $ root_url
1358
+
$ odoc_file_directories $ reference))
1359
+
1360
+
let info ~docs =
1361
+
Cmd.info ~docs ~doc:"Resolve a reference and output its corresponding url."
1362
+
"html-url"
1363
+
end
1364
+
1365
+
module Html_fragment : sig
1366
+
val cmd : unit Term.t
1367
+
1368
+
val info : docs:string -> Cmd.info
1369
+
end = struct
1370
+
let html_fragment directories xref_base_uri output_file input_file
1371
+
warnings_options =
1372
+
let resolver =
1373
+
Resolver.create ~important_digests:false ~directories ~open_modules:[]
1374
+
~roots:None
1375
+
in
1376
+
let input_file = Fs.File.of_string input_file in
1377
+
let output_file = Fs.File.of_string output_file in
1378
+
let xref_base_uri =
1379
+
if xref_base_uri = "" then xref_base_uri
1380
+
else
1381
+
let last_char = xref_base_uri.[String.length xref_base_uri - 1] in
1382
+
if last_char <> '/' then xref_base_uri ^ "/" else xref_base_uri
1383
+
in
1384
+
Html_fragment.from_mld ~resolver ~xref_base_uri ~output:output_file
1385
+
~warnings_options input_file
1386
+
1387
+
let cmd =
1388
+
let output =
1389
+
let doc = "Output HTML fragment file." in
1390
+
Arg.(
1391
+
value & opt string "/dev/stdout"
1392
+
& info ~docs ~docv:"file.html" ~doc [ "o"; "output-file" ])
1393
+
in
1394
+
let input =
1395
+
let doc = "Input documentation page file." in
1396
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"file.mld" [])
1397
+
in
1398
+
let xref_base_uri =
1399
+
let doc =
1400
+
"Base URI used to resolve cross-references. Set this to the root of \
1401
+
the global docset during local development. By default `.' is used."
1402
+
in
1403
+
Arg.(value & opt string "" & info ~docv:"URI" ~doc [ "xref-base-uri" ])
1404
+
in
1405
+
Term.(
1406
+
const handle_error
1407
+
$ (const html_fragment $ odoc_file_directories $ xref_base_uri $ output
1408
+
$ input $ warnings_options))
1409
+
1410
+
let info ~docs =
1411
+
Cmd.info ~docs ~doc:"Generates an html fragment file from an mld one."
1412
+
"html-fragment"
1413
+
end
1414
+
1415
+
module Odoc_manpage = Make_renderer (struct
1416
+
type args = unit
1417
+
1418
+
let renderer = Man_page.renderer
1419
+
1420
+
let extra_args = Term.const ()
1421
+
end)
1422
+
1423
+
module Odoc_latex = Make_renderer (struct
1424
+
type args = Latex.args
1425
+
1426
+
let renderer = Latex.renderer
1427
+
1428
+
let with_children =
1429
+
let doc = "Include children at the end of the page." in
1430
+
Arg.(value & opt bool true & info ~docv:"BOOL" ~doc [ "with-children" ])
1431
+
1432
+
let shorten_beyond_depth =
1433
+
let doc = "Shorten items beyond the given depth." in
1434
+
Arg.(
1435
+
value
1436
+
& opt (some' int) None
1437
+
& info ~docv:"INT" ~doc [ "shorten-beyond-depth" ])
1438
+
1439
+
let remove_functor_arg_link =
1440
+
let doc = "Remove link to functor argument." in
1441
+
Arg.(
1442
+
value & opt bool false
1443
+
& info ~docv:"BOOL" ~doc [ "remove-functor-arg-link" ])
1444
+
1445
+
let extra_args =
1446
+
let f with_children shorten_beyond_depth remove_functor_arg_link =
1447
+
{ Latex.with_children; shorten_beyond_depth; remove_functor_arg_link }
1448
+
in
1449
+
Term.(
1450
+
const f $ with_children $ shorten_beyond_depth $ remove_functor_arg_link)
1451
+
end)
1452
+
1453
+
module Depends = struct
1454
+
module Compile = struct
1455
+
let list_dependencies input_files =
1456
+
try
1457
+
let deps =
1458
+
Depends.for_compile_step (List.map ~f:Fs.File.of_string input_files)
1459
+
in
1460
+
List.iter
1461
+
~f:(fun t ->
1462
+
Printf.printf "%s %s\n" (Depends.Compile.name t)
1463
+
(Digest.to_hex @@ Depends.Compile.digest t))
1464
+
deps;
1465
+
flush stdout
1466
+
with Cmi_format.Error e ->
1467
+
let msg =
1468
+
match e with
1469
+
| Not_an_interface file ->
1470
+
Printf.sprintf "File %S is not an interface" file
1471
+
| Wrong_version_interface (file, v) ->
1472
+
Printf.sprintf "File %S is compiled for %s version of OCaml" file
1473
+
v
1474
+
| Corrupted_interface file ->
1475
+
Printf.sprintf "File %S is corrupted" file
1476
+
in
1477
+
Printf.eprintf "ERROR: %s\n%!" msg;
1478
+
exit 1
1479
+
1480
+
let cmd =
1481
+
let input =
1482
+
let doc = "Input files" in
1483
+
Arg.(non_empty & pos_all file [] & info ~doc ~docv:"file.cm{i,t,ti}" [])
1484
+
in
1485
+
Term.(const list_dependencies $ input)
1486
+
1487
+
let info ~docs =
1488
+
Cmd.info "compile-deps" ~docs
1489
+
~doc:
1490
+
"List units (with their digest) which needs to be compiled in order \
1491
+
to compile this one. The unit itself and its digest is also \
1492
+
reported in the output.\n\
1493
+
Dependencies between compile steps are the same as when compiling \
1494
+
the ocaml modules."
1495
+
end
1496
+
1497
+
module Link = struct
1498
+
let rec fmt_page pp page =
1499
+
match page.Odoc_model.Paths.Identifier.iv with
1500
+
| `Page (parent_opt, name) ->
1501
+
Format.fprintf pp "%a%a" fmt_parent_opt parent_opt
1502
+
Odoc_model.Names.PageName.fmt name
1503
+
| `LeafPage (parent_opt, name) ->
1504
+
Format.fprintf pp "%a%a" fmt_parent_opt parent_opt
1505
+
Odoc_model.Names.PageName.fmt name
1506
+
1507
+
and fmt_parent_opt pp parent_opt =
1508
+
match parent_opt with
1509
+
| None -> ()
1510
+
| Some p -> Format.fprintf pp "%a/" fmt_page p
1511
+
1512
+
let list_dependencies input_file =
1513
+
Depends.for_rendering_step (Fs.Directory.of_string input_file)
1514
+
>>= fun depends ->
1515
+
List.iter depends ~f:(fun (root : Odoc_model.Root.t) ->
1516
+
match root.id.iv with
1517
+
| `Root (Some p, _) ->
1518
+
Format.printf "%a %s %s\n" fmt_page p
1519
+
(Odoc_model.Root.Odoc_file.name root.file)
1520
+
(Digest.to_hex root.digest)
1521
+
| _ ->
1522
+
Format.printf "none %s %s\n"
1523
+
(Odoc_model.Root.Odoc_file.name root.file)
1524
+
(Digest.to_hex root.digest));
1525
+
Ok ()
1526
+
1527
+
let cmd =
1528
+
let input =
1529
+
let doc = "Input directory" in
1530
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"PKG_DIR" [])
1531
+
in
1532
+
Term.(const handle_error $ (const list_dependencies $ input))
1533
+
1534
+
let info ~docs =
1535
+
Cmd.info "link-deps" ~docs
1536
+
~doc:
1537
+
"Lists a subset of the packages and modules which need to be in \
1538
+
odoc's load path to link the $(i, odoc) files in the given \
1539
+
directory. Additional packages may be required to resolve all \
1540
+
references."
1541
+
end
1542
+
1543
+
module Odoc_html = struct
1544
+
let includes =
1545
+
let doc = "For backwards compatibility. Ignored." in
1546
+
Arg.(
1547
+
value
1548
+
& opt_all (convert_directory ()) []
1549
+
& info ~docs ~docv:"DIR" ~doc [ "I" ])
1550
+
1551
+
let cmd =
1552
+
let input =
1553
+
let doc = "Input directory" in
1554
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"PKG_DIR" [])
1555
+
in
1556
+
let cmd _ = Link.list_dependencies in
1557
+
Term.(const handle_error $ (const cmd $ includes $ input))
1558
+
1559
+
let info ~docs =
1560
+
Cmd.info "html-deps" ~docs ~doc:"DEPRECATED: alias for link-deps"
1561
+
end
1562
+
end
1563
+
1564
+
module Targets = struct
1565
+
module Compile = struct
1566
+
let list_targets dst input =
1567
+
let input = Fs.File.of_string input in
1568
+
let output = Compile.output_file ~dst ~input in
1569
+
Printf.printf "%s\n" (Fs.File.to_string output);
1570
+
flush stdout
1571
+
1572
+
let cmd = Term.(const list_targets $ Compile.dst $ Compile.input)
1573
+
1574
+
let info ~docs =
1575
+
Cmd.info "compile-targets" ~docs
1576
+
~doc:
1577
+
"Print the name of the file produced by $(i,compile). If $(i,-o) is \
1578
+
passed, the same path is printed but error checking is performed."
1579
+
end
1580
+
1581
+
module Support_files = struct
1582
+
let list_targets without_theme output_directory =
1583
+
Support_files.print_filenames ~without_theme output_directory
1584
+
1585
+
let cmd =
1586
+
Term.(const list_targets $ Support_files_command.without_theme $ dst ())
1587
+
1588
+
let info ~docs =
1589
+
Cmd.info "support-files-targets" ~docs
1590
+
~doc:
1591
+
"Lists the names of the files that $(i,odoc support-files) outputs."
1592
+
end
1593
+
end
1594
+
1595
+
module Occurrences = struct
1596
+
let dst_of_string s =
1597
+
let f = Fs.File.of_string s in
1598
+
if not (Fs.File.has_ext ".odoc-occurrences" f) then
1599
+
Error (`Msg "Output file must have '.odoc-occurrences' extension.")
1600
+
else Ok f
1601
+
1602
+
module Count = struct
1603
+
let count directories dst warnings_options include_hidden =
1604
+
dst_of_string dst >>= fun dst ->
1605
+
Occurrences.count ~dst ~warnings_options directories include_hidden
1606
+
1607
+
let cmd =
1608
+
let dst =
1609
+
let doc = "Output file path." in
1610
+
Arg.(
1611
+
required
1612
+
& opt (some string) None
1613
+
& info ~docs ~docv:"PATH" ~doc [ "o" ])
1614
+
in
1615
+
let include_hidden =
1616
+
let doc = "Include hidden identifiers in the table" in
1617
+
Arg.(value & flag & info ~docs ~doc [ "include-hidden" ])
1618
+
in
1619
+
let input =
1620
+
let doc =
1621
+
"Directories to recursively traverse, agregating occurrences from \
1622
+
$(i,impl-*.odocl) files. Can be present several times."
1623
+
in
1624
+
Arg.(
1625
+
value
1626
+
& pos_all (convert_directory ()) []
1627
+
& info ~docs ~docv:"DIR" ~doc [])
1628
+
in
1629
+
Term.(
1630
+
const handle_error
1631
+
$ (const count $ input $ dst $ warnings_options $ include_hidden))
1632
+
1633
+
let info ~docs =
1634
+
let doc =
1635
+
"Generate a hashtable mapping identifiers to number of occurrences, as \
1636
+
computed from the implementations of .odocl files found in the given \
1637
+
directories."
1638
+
in
1639
+
Cmd.info "count-occurrences" ~docs ~doc
1640
+
end
1641
+
module Aggregate = struct
1642
+
let index dst files file_list strip_path warnings_options =
1643
+
match (files, file_list) with
1644
+
| [], [] ->
1645
+
Error
1646
+
(`Msg
1647
+
"At least one of --file-list or a path to a file must be passed \
1648
+
to odoc aggregate-occurrences")
1649
+
| _ ->
1650
+
dst_of_string dst >>= fun dst ->
1651
+
Occurrences.aggregate ~dst ~warnings_options ~strip_path files
1652
+
file_list
1653
+
1654
+
let cmd =
1655
+
let dst =
1656
+
let doc = "Output file path." in
1657
+
Arg.(
1658
+
required
1659
+
& opt (some string) None
1660
+
& info ~docs ~docv:"PATH" ~doc [ "o" ])
1661
+
in
1662
+
let inputs_in_file =
1663
+
let doc =
1664
+
"Input text file containing a line-separated list of paths to files \
1665
+
created with count-occurrences."
1666
+
in
1667
+
Arg.(
1668
+
value & opt_all convert_fpath []
1669
+
& info ~doc ~docv:"FILE" [ "file-list" ])
1670
+
in
1671
+
let inputs =
1672
+
let doc = "file created with count-occurrences" in
1673
+
Arg.(value & pos_all convert_fpath [] & info ~doc ~docv:"FILE" [])
1674
+
in
1675
+
let strip_path =
1676
+
let doc = "Strip package/version information from paths" in
1677
+
Arg.(value & flag & info ~doc [ "strip-path" ])
1678
+
in
1679
+
Term.(
1680
+
const handle_error
1681
+
$ (const index $ dst $ inputs $ inputs_in_file $ strip_path
1682
+
$ warnings_options))
1683
+
1684
+
let info ~docs =
1685
+
let doc = "Aggregate hashtables created with odoc count-occurrences." in
1686
+
Cmd.info "aggregate-occurrences" ~docs ~doc
1687
+
end
1688
+
end
1689
+
1690
+
module Odoc_error = struct
1691
+
let errors input =
1692
+
let open Odoc_odoc in
1693
+
let input = Fs.File.of_string input in
1694
+
Odoc_file.load input >>= fun unit ->
1695
+
Odoc_model.Error.print_errors unit.warnings;
1696
+
Ok ()
1697
+
1698
+
let input =
1699
+
let doc = "Input $(i,.odoc) or $(i,.odocl) file" in
1700
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE" [])
1701
+
1702
+
let cmd = Term.(const handle_error $ (const errors $ input))
1703
+
1704
+
let info ~docs =
1705
+
Cmd.info "errors" ~docs
1706
+
~doc:"Print errors that occurred while compiling or linking."
1707
+
end
1708
+
1709
+
module Classify = struct
1710
+
let libdirs =
1711
+
let doc = "The directories containing the libraries" in
1712
+
Arg.(value & pos_all string [] & info ~doc ~docv:"DIR" [])
1713
+
1714
+
let cmd = Term.(const handle_error $ (const Classify.classify $ libdirs))
1715
+
1716
+
let info ~docs =
1717
+
Cmd.info "classify" ~docs
1718
+
~doc:
1719
+
"Classify the modules into libraries based on heuristics. Libraries \
1720
+
are specified by the --library option."
1721
+
end
1722
+
1723
+
module Extract_code = struct
1724
+
let extract dst input line_directives names warnings_options =
1725
+
Extract_code.extract ~dst ~input ~line_directives ~names ~warnings_options
1726
+
1727
+
let line_directives =
1728
+
let doc = "Whether to include line directives in the output file" in
1729
+
Arg.(value & flag & info ~doc [ "line-directives" ])
1730
+
1731
+
let names =
1732
+
let doc =
1733
+
"From which name(s) of code blocks to extract content. When no names are \
1734
+
provided, extract all OCaml code blocks."
1735
+
in
1736
+
Arg.(value & opt_all string [] & info ~doc [ "name" ])
1737
+
1738
+
let input =
1739
+
let doc = "Input $(i,.mld) file." in
1740
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE" [])
1741
+
1742
+
let dst =
1743
+
let doc = "Output file path." in
1744
+
Arg.(
1745
+
value
1746
+
& opt (some string) None
1747
+
& info ~docs ~docv:"PATH" ~doc [ "o"; "output" ])
1748
+
1749
+
let cmd =
1750
+
Term.(
1751
+
const handle_error
1752
+
$ (const extract $ dst $ input $ line_directives $ names
1753
+
$ warnings_options))
1754
+
1755
+
let info ~docs =
1756
+
Cmd.info "extract-code" ~docs
1757
+
~doc:
1758
+
"Extract code blocks from mld files in order to be able to execute them"
1759
+
end
1760
+
1761
+
let section_pipeline = "COMMANDS: Compilation pipeline"
1762
+
let section_generators = "COMMANDS: Alternative generators"
1763
+
let section_support = "COMMANDS: Scripting"
1764
+
let section_legacy = "COMMANDS: Legacy pipeline"
1765
+
let section_deprecated = "COMMANDS: Deprecated"
1766
+
1767
+
module Extensions = struct
1768
+
let run () =
1769
+
let prefixes = Odoc_extension_api.Registry.list_prefixes () in
1770
+
match prefixes with
1771
+
| [] ->
1772
+
Printf.printf "No extensions installed.\n%!";
1773
+
Printf.printf "Extensions can be installed as opam packages that register with odoc.\n%!"
1774
+
| _ ->
1775
+
Printf.printf "Installed extensions:\n%!";
1776
+
List.iter ~f:(fun prefix -> Printf.printf " @%s\n%!" prefix) prefixes
1777
+
1778
+
let cmd = Term.(const run $ const ())
1779
+
let info ~docs = Cmd.info "extensions" ~docs ~doc:"List installed odoc extensions"
1780
+
end
1781
+
1782
+
(** Sections in the order they should appear. *)
1783
+
let main_page_sections =
1784
+
[
1785
+
section_pipeline;
1786
+
section_generators;
1787
+
section_support;
1788
+
section_legacy;
1789
+
section_deprecated;
1790
+
]
1791
+
1792
+
let () =
1793
+
Printexc.record_backtrace true;
1794
+
let cmd_make (term, info) = Cmd.v info term in
1795
+
let subcommands =
1796
+
List.map ~f:cmd_make
1797
+
@@ [
1798
+
Occurrences.Count.(cmd, info ~docs:section_pipeline);
1799
+
Occurrences.Aggregate.(cmd, info ~docs:section_pipeline);
1800
+
Compile.(cmd, info ~docs:section_pipeline);
1801
+
Compile_asset.(cmd, info ~docs:section_pipeline);
1802
+
Odoc_link.(cmd, info ~docs:section_pipeline);
1803
+
Odoc_html.generate ~docs:section_pipeline;
1804
+
Odoc_html.generate_source ~docs:section_pipeline;
1805
+
Odoc_html.generate_asset ~docs:section_pipeline;
1806
+
Support_files_command.(cmd, info ~docs:section_pipeline);
1807
+
Compile_impl.(cmd, info ~docs:section_pipeline);
1808
+
Indexing.(cmd, info ~docs:section_pipeline);
1809
+
Sidebar.(cmd, info ~docs:section_pipeline);
1810
+
Odoc_markdown_cmd.generate ~docs:section_generators;
1811
+
Odoc_markdown_cmd.generate_source ~docs:section_generators;
1812
+
Odoc_markdown_cmd.targets ~docs:section_support;
1813
+
Odoc_manpage.generate ~docs:section_generators;
1814
+
Odoc_latex.generate ~docs:section_generators;
1815
+
Odoc_html_url.(cmd, info ~docs:section_support);
1816
+
Odoc_latex_url.(cmd, info ~docs:section_support);
1817
+
Targets.Support_files.(cmd, info ~docs:section_support);
1818
+
Odoc_error.(cmd, info ~docs:section_support);
1819
+
Odoc_html.targets ~docs:section_support;
1820
+
Odoc_html.targets_source ~docs:section_support;
1821
+
Odoc_manpage.targets ~docs:section_support;
1822
+
Odoc_latex.targets ~docs:section_support;
1823
+
Depends.Compile.(cmd, info ~docs:section_support);
1824
+
Targets.Compile.(cmd, info ~docs:section_support);
1825
+
Html_fragment.(cmd, info ~docs:section_legacy);
1826
+
Odoc_html.process ~docs:section_legacy;
1827
+
Odoc_manpage.process ~docs:section_legacy;
1828
+
Odoc_latex.process ~docs:section_legacy;
1829
+
Depends.Link.(cmd, info ~docs:section_legacy);
1830
+
Css.(cmd, info ~docs:section_deprecated);
1831
+
Depends.Odoc_html.(cmd, info ~docs:section_deprecated);
1832
+
Classify.(cmd, info ~docs:section_pipeline);
1833
+
Extract_code.(cmd, info ~docs:section_pipeline);
1834
+
Extensions.(cmd, info ~docs:section_support);
1835
+
]
1836
+
in
1837
+
let main =
1838
+
let print_default () =
1839
+
let available_subcommands =
1840
+
List.map subcommands ~f:(fun cmd -> Cmd.name cmd)
1841
+
in
1842
+
Printf.printf
1843
+
"Available subcommands: %s\nSee --help for more information.\n%!"
1844
+
(String.concat ~sep:", " available_subcommands)
1845
+
in
1846
+
let man =
1847
+
(* Show sections in a defined order. *)
1848
+
List.map ~f:(fun s -> `S s) main_page_sections
1849
+
in
1850
+
let default = Term.(const print_default $ const ()) in
1851
+
let info = Cmd.info ~man ~version:"%%VERSION%%" "odoc" in
1852
+
Cmd.group ~default info subcommands
1853
+
in
1854
+
match Cmd.eval_value ~err:Format.err_formatter main with
1855
+
| Error _ ->
1856
+
Format.pp_print_flush Format.err_formatter ();
1857
+
exit 2
1858
+
| _ -> ()
+25
odoc-scrollycode-extension/_build/log
+25
odoc-scrollycode-extension/_build/log
···
1
+
# dune build --root .
2
+
# OCAMLPARAM: unset
3
+
# Shared cache: enabled-except-user-rules
4
+
# Shared build cache location: /home/jons-agent/.cache/dune/db
5
+
# Workspace root: /home/jons-agent/workspace/mono/odoc-scrollycode-extension
6
+
# Auto-detected concurrency: 32
7
+
# Dune context:
8
+
# { name = "default"
9
+
# ; kind = "default"
10
+
# ; profile = Dev
11
+
# ; merlin = true
12
+
# ; fdo_target_exe = None
13
+
# ; build_dir = In_build_dir "default"
14
+
# ; instrument_with = []
15
+
# }
16
+
# DEBUG: expand_packages_with_odoc_config called with packages:
17
+
# odoc-scrollycode-extension
18
+
# DEBUG: expand_packages_with_odoc_config called with packages:
19
+
# odoc-scrollycode-extension
20
+
$ /home/jons-agent/.opam/monopam-tools/bin/ocamlc.opt -config > /tmp/dune_7bcd26_output
21
+
$ (cd _build/default && /home/jons-agent/.opam/monopam-tools/bin/ocamldep.opt -modules -impl test/odoc_scrolly.ml) > _build/default/test/.odoc_scrolly.eobjs/dune__exe__Odoc_scrolly.impl.d
22
+
$ (cd _build/default && /home/jons-agent/.opam/monopam-tools/bin/ocamldep.opt -modules -impl test/odoc_scrolly_main.ml) > _build/default/test/.odoc_scrolly.eobjs/dune__exe__Odoc_scrolly_main.impl.d
23
+
$ (cd _build/default && /home/jons-agent/.opam/monopam-tools/bin/ocamldep.opt -modules -intf test/odoc_scrolly.mli) > _build/default/test/.odoc_scrolly.eobjs/dune__exe__Odoc_scrolly.intf.d
24
+
$ (cd _build/default && /home/jons-agent/.opam/monopam-tools/bin/ocamlc.opt -w @1..3@5..28@31..39@43@46..47@49..57@61..62@67@69-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -53 -w -49 -nopervasives -nostdlib -g -bin-annot -bin-annot-occurrences -I test/.odoc_scrolly.eobjs/byte -no-alias-deps -opaque -o test/.odoc_scrolly.eobjs/byte/dune__exe.cmo -c -impl test/.odoc_scrolly.eobjs/dune__exe.ml-gen)
25
+
$ (cd _build/default && /home/jons-agent/.opam/monopam-tools/bin/ocamlopt.opt -w @1..3@5..28@31..39@43@46..47@49..57@61..62@67@69-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -53 -w -49 -nopervasives -nostdlib -g -I test/.odoc_scrolly.eobjs/byte -I test/.odoc_scrolly.eobjs/native -cmi-file test/.odoc_scrolly.eobjs/byte/dune__exe.cmi -no-alias-deps -opaque -o test/.odoc_scrolly.eobjs/native/dune__exe.cmx -c -impl test/.odoc_scrolly.eobjs/dune__exe.ml-gen)
+14
odoc-scrollycode-extension/dune-project
+14
odoc-scrollycode-extension/dune-project
···
1
+
(lang dune 3.18)
2
+
(using dune_site 0.1)
3
+
(name odoc-scrollycode-extension)
4
+
(generate_opam_files true)
5
+
6
+
(package
7
+
(name odoc-scrollycode-extension)
8
+
(synopsis "Scrollycode tutorial extension for odoc")
9
+
(description
10
+
"Provides @scrolly.warm, @scrolly.dark, and @scrolly.notebook tags
11
+
for creating scroll-driven code tutorials in odoc documentation")
12
+
(depends
13
+
(ocaml (>= 4.14))
14
+
odoc))
+28
odoc-scrollycode-extension/odoc-scrollycode-extension.opam
+28
odoc-scrollycode-extension/odoc-scrollycode-extension.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Scrollycode tutorial extension for odoc"
4
+
description: """
5
+
Provides @scrolly.warm, @scrolly.dark, and @scrolly.notebook tags
6
+
for creating scroll-driven code tutorials in odoc documentation"""
7
+
depends: [
8
+
"dune" {>= "3.18"}
9
+
"ocaml" {>= "4.14"}
10
+
"odoc"
11
+
]
12
+
build: [
13
+
["dune" "subst"] {dev}
14
+
[
15
+
"dune"
16
+
"build"
17
+
"-p"
18
+
name
19
+
"-j"
20
+
jobs
21
+
"--promote-install-files=false"
22
+
"@install"
23
+
"@runtest" {with-test}
24
+
"@doc" {with-doc}
25
+
]
26
+
["dune" "install" "-p" name "--create-install-files" name]
27
+
]
28
+
x-maintenance-intent: ["(latest)"]
+9
odoc-scrollycode-extension/src/dune
+9
odoc-scrollycode-extension/src/dune
+1846
odoc-scrollycode-extension/src/scrollycode_extension.ml
+1846
odoc-scrollycode-extension/src/scrollycode_extension.ml
···
1
+
(** Scrollycode Extension for odoc
2
+
3
+
Provides scroll-driven code tutorials with three visual themes:
4
+
- warm: Earthy, bookish aesthetic (Fraunces + Source Serif)
5
+
- dark: Cinematic terminal aesthetic (JetBrains Mono + Outfit)
6
+
- notebook: Clean editorial aesthetic (Newsreader + DM Sans)
7
+
8
+
Authoring format uses @scrolly.<theme> custom tags with an ordered
9
+
list inside, where each list item is a tutorial step containing
10
+
a bold title, prose paragraphs, and a code block. *)
11
+
12
+
module Comment = Odoc_model.Comment
13
+
module Location_ = Odoc_model.Location_
14
+
module Block = Odoc_document.Types.Block
15
+
module Inline = Odoc_document.Types.Inline
16
+
17
+
(** {1 Step Extraction} *)
18
+
19
+
(** A single tutorial step extracted from the ordered list structure *)
20
+
type step = {
21
+
title : string;
22
+
prose : string;
23
+
code : string;
24
+
focus : int list; (** 1-based line numbers to highlight *)
25
+
}
26
+
27
+
(** Extract plain text from inline elements *)
28
+
let rec text_of_inline (el : Comment.inline_element Location_.with_location) =
29
+
match el.Location_.value with
30
+
| `Space -> " "
31
+
| `Word w -> w
32
+
| `Code_span c -> "`" ^ c ^ "`"
33
+
| `Math_span m -> m
34
+
| `Raw_markup (_, r) -> r
35
+
| `Styled (_, content) -> text_of_inlines content
36
+
| `Reference (_, content) -> text_of_link_content content
37
+
| `Link (_, content) -> text_of_link_content content
38
+
39
+
and text_of_inlines content =
40
+
String.concat "" (List.map text_of_inline content)
41
+
42
+
and text_of_link_content content =
43
+
String.concat "" (List.map text_of_non_link content)
44
+
45
+
and text_of_non_link
46
+
(el : Comment.non_link_inline_element Location_.with_location) =
47
+
match el.Location_.value with
48
+
| `Space -> " "
49
+
| `Word w -> w
50
+
| `Code_span c -> "`" ^ c ^ "`"
51
+
| `Math_span m -> m
52
+
| `Raw_markup (_, r) -> r
53
+
| `Styled (_, content) -> text_of_link_content content
54
+
55
+
let text_of_paragraph (p : Comment.paragraph) =
56
+
String.concat "" (List.map text_of_inline p)
57
+
58
+
(** Extract title, prose, code and focus lines from a single list item *)
59
+
let extract_step
60
+
(item : Comment.nestable_block_element Location_.with_location list) : step
61
+
=
62
+
let title = ref "" in
63
+
let prose_parts = ref [] in
64
+
let code = ref "" in
65
+
let focus = ref [] in
66
+
List.iter
67
+
(fun (el : Comment.nestable_block_element Location_.with_location) ->
68
+
match el.Location_.value with
69
+
| `Paragraph p -> (
70
+
let text = text_of_paragraph p in
71
+
(* Check if the paragraph starts with bold text — that's the title *)
72
+
match p with
73
+
| first :: _
74
+
when (match first.Location_.value with
75
+
| `Styled (`Bold, _) -> true
76
+
| _ -> false) ->
77
+
if !title = "" then title := text
78
+
else prose_parts := text :: !prose_parts
79
+
| _ -> prose_parts := text :: !prose_parts)
80
+
| `Code_block { content = code_content; _ } ->
81
+
let code_text = code_content.Location_.value in
82
+
(* Check for focus annotation in the code: lines starting with >>> *)
83
+
let lines = String.split_on_char '\n' code_text in
84
+
let focused_lines = ref [] in
85
+
let clean_lines =
86
+
List.mapi
87
+
(fun i line ->
88
+
if
89
+
String.length line >= 4
90
+
&& String.sub line 0 4 = "(* >"
91
+
then (
92
+
focused_lines := (i + 1) :: !focused_lines;
93
+
(* Remove the focus marker *)
94
+
let rest = String.sub line 4 (String.length line - 4) in
95
+
let rest =
96
+
if
97
+
String.length rest >= 4
98
+
&& String.sub rest (String.length rest - 4) 4 = "< *)"
99
+
then String.sub rest 0 (String.length rest - 4)
100
+
else rest
101
+
in
102
+
String.trim rest)
103
+
else line)
104
+
lines
105
+
in
106
+
code := String.concat "\n" clean_lines;
107
+
focus := List.rev !focused_lines
108
+
| `Verbatim v -> prose_parts := v :: !prose_parts
109
+
| _ -> ())
110
+
item;
111
+
{
112
+
title = !title;
113
+
prose = String.concat "\n\n" (List.rev !prose_parts);
114
+
code = !code;
115
+
focus = !focus;
116
+
}
117
+
118
+
(** Extract all steps from the tag content (expects an ordered list) *)
119
+
let extract_steps
120
+
(content :
121
+
Comment.nestable_block_element Location_.with_location list) :
122
+
string * step list =
123
+
(* First element might be a paragraph with the tutorial title *)
124
+
let tutorial_title = ref "Tutorial" in
125
+
let steps = ref [] in
126
+
List.iter
127
+
(fun (el : Comment.nestable_block_element Location_.with_location) ->
128
+
match el.Location_.value with
129
+
| `Paragraph p ->
130
+
let text = text_of_paragraph p in
131
+
if !steps = [] then tutorial_title := text
132
+
| `List (`Ordered, items) ->
133
+
steps := List.map extract_step items
134
+
| _ -> ())
135
+
content;
136
+
(!tutorial_title, !steps)
137
+
138
+
(** {1 HTML Escaping} *)
139
+
140
+
let html_escape s =
141
+
let buf = Buffer.create (String.length s) in
142
+
String.iter
143
+
(function
144
+
| '&' -> Buffer.add_string buf "&"
145
+
| '<' -> Buffer.add_string buf "<"
146
+
| '>' -> Buffer.add_string buf ">"
147
+
| '"' -> Buffer.add_string buf """
148
+
| c -> Buffer.add_char buf c)
149
+
s;
150
+
Buffer.contents buf
151
+
152
+
(** {1 Diff Computation} *)
153
+
154
+
type diff_line =
155
+
| Same of string
156
+
| Added of string
157
+
| Removed of string
158
+
159
+
(** Simple LCS-based line diff between two code strings *)
160
+
let diff_lines old_code new_code =
161
+
let old_lines = String.split_on_char '\n' old_code |> Array.of_list in
162
+
let new_lines = String.split_on_char '\n' new_code |> Array.of_list in
163
+
let n = Array.length old_lines in
164
+
let m = Array.length new_lines in
165
+
let dp = Array.make_matrix (n + 1) (m + 1) 0 in
166
+
for i = 1 to n do
167
+
for j = 1 to m do
168
+
if old_lines.(i-1) = new_lines.(j-1) then
169
+
dp.(i).(j) <- dp.(i-1).(j-1) + 1
170
+
else
171
+
dp.(i).(j) <- max dp.(i-1).(j) dp.(i).(j-1)
172
+
done
173
+
done;
174
+
let result = ref [] in
175
+
let i = ref n and j = ref m in
176
+
while !i > 0 || !j > 0 do
177
+
if !i > 0 && !j > 0 && old_lines.(!i-1) = new_lines.(!j-1) then begin
178
+
result := Same old_lines.(!i-1) :: !result;
179
+
decr i; decr j
180
+
end else if !j > 0 && (!i = 0 || dp.(!i).(!j-1) >= dp.(!i-1).(!j)) then begin
181
+
result := Added new_lines.(!j-1) :: !result;
182
+
decr j
183
+
end else begin
184
+
result := Removed old_lines.(!i-1) :: !result;
185
+
decr i
186
+
end
187
+
done;
188
+
!result
189
+
190
+
(** {1 OCaml Syntax Highlighting}
191
+
192
+
A simple lexer-based highlighter for OCaml code. Produces HTML spans
193
+
with classes for keywords, types, strings, comments, operators. *)
194
+
195
+
let ocaml_keywords =
196
+
[
197
+
"let"; "in"; "if"; "then"; "else"; "match"; "with"; "fun"; "function";
198
+
"type"; "module"; "struct"; "sig"; "end"; "open"; "include"; "val";
199
+
"rec"; "and"; "of"; "when"; "as"; "begin"; "do"; "done"; "for"; "to";
200
+
"while"; "downto"; "try"; "exception"; "raise"; "mutable"; "ref";
201
+
"true"; "false"; "assert"; "failwith"; "not";
202
+
]
203
+
204
+
let ocaml_types =
205
+
[
206
+
"int"; "float"; "string"; "bool"; "unit"; "list"; "option"; "array";
207
+
"char"; "bytes"; "result"; "exn"; "ref";
208
+
]
209
+
210
+
(** Tokenize and highlight OCaml code into HTML *)
211
+
let highlight_ocaml code =
212
+
let len = String.length code in
213
+
let buf = Buffer.create (len * 2) in
214
+
let i = ref 0 in
215
+
let peek () = if !i < len then Some code.[!i] else None in
216
+
let advance () = incr i in
217
+
let current () = code.[!i] in
218
+
while !i < len do
219
+
match current () with
220
+
(* Comments *)
221
+
| '(' when !i + 1 < len && code.[!i + 1] = '*' ->
222
+
Buffer.add_string buf "<span class=\"hl-comment\">";
223
+
Buffer.add_string buf "(*";
224
+
i := !i + 2;
225
+
let depth = ref 1 in
226
+
while !depth > 0 && !i < len do
227
+
if !i + 1 < len && code.[!i] = '(' && code.[!i + 1] = '*' then (
228
+
Buffer.add_string buf "(*";
229
+
i := !i + 2;
230
+
incr depth)
231
+
else if !i + 1 < len && code.[!i] = '*' && code.[!i + 1] = ')' then (
232
+
Buffer.add_string buf "*)";
233
+
i := !i + 2;
234
+
decr depth)
235
+
else (
236
+
Buffer.add_string buf (html_escape (String.make 1 code.[!i]));
237
+
advance ())
238
+
done;
239
+
Buffer.add_string buf "</span>"
240
+
(* Strings *)
241
+
| '"' ->
242
+
Buffer.add_string buf "<span class=\"hl-string\">";
243
+
Buffer.add_char buf '"';
244
+
advance ();
245
+
while !i < len && current () <> '"' do
246
+
if current () = '\\' && !i + 1 < len then (
247
+
Buffer.add_string buf (html_escape (String.make 1 (current ())));
248
+
advance ();
249
+
Buffer.add_string buf (html_escape (String.make 1 (current ())));
250
+
advance ())
251
+
else (
252
+
Buffer.add_string buf (html_escape (String.make 1 (current ())));
253
+
advance ())
254
+
done;
255
+
if !i < len then (
256
+
Buffer.add_char buf '"';
257
+
advance ());
258
+
Buffer.add_string buf "</span>"
259
+
(* Char literals *)
260
+
| '\'' when !i + 2 < len && code.[!i + 2] = '\'' ->
261
+
Buffer.add_string buf "<span class=\"hl-string\">";
262
+
Buffer.add_char buf '\'';
263
+
advance ();
264
+
Buffer.add_string buf (html_escape (String.make 1 (current ())));
265
+
advance ();
266
+
Buffer.add_char buf '\'';
267
+
advance ();
268
+
Buffer.add_string buf "</span>"
269
+
(* Numbers *)
270
+
| '0' .. '9' ->
271
+
Buffer.add_string buf "<span class=\"hl-number\">";
272
+
while
273
+
!i < len
274
+
&&
275
+
match current () with
276
+
| '0' .. '9' | '.' | '_' | 'x' | 'o' | 'b' | 'a' .. 'f'
277
+
| 'A' .. 'F' ->
278
+
true
279
+
| _ -> false
280
+
do
281
+
Buffer.add_char buf (current ());
282
+
advance ()
283
+
done;
284
+
Buffer.add_string buf "</span>"
285
+
(* Identifiers and keywords *)
286
+
| 'a' .. 'z' | '_' ->
287
+
let start = !i in
288
+
while
289
+
!i < len
290
+
&&
291
+
match current () with
292
+
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '\'' -> true
293
+
| _ -> false
294
+
do
295
+
advance ()
296
+
done;
297
+
let word = String.sub code start (!i - start) in
298
+
if List.mem word ocaml_keywords then
299
+
Buffer.add_string buf
300
+
(Printf.sprintf "<span class=\"hl-keyword\">%s</span>"
301
+
(html_escape word))
302
+
else if List.mem word ocaml_types then
303
+
Buffer.add_string buf
304
+
(Printf.sprintf "<span class=\"hl-type\">%s</span>"
305
+
(html_escape word))
306
+
else Buffer.add_string buf (html_escape word)
307
+
(* Module/constructor names (capitalized identifiers) *)
308
+
| 'A' .. 'Z' ->
309
+
let start = !i in
310
+
while
311
+
!i < len
312
+
&&
313
+
match current () with
314
+
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '\'' -> true
315
+
| _ -> false
316
+
do
317
+
advance ()
318
+
done;
319
+
let word = String.sub code start (!i - start) in
320
+
Buffer.add_string buf
321
+
(Printf.sprintf "<span class=\"hl-module\">%s</span>"
322
+
(html_escape word))
323
+
(* Operators *)
324
+
| '|' | '-' | '+' | '*' | '/' | '=' | '<' | '>' | '@' | '^' | '~'
325
+
| '!' | '?' | '%' | '&' ->
326
+
Buffer.add_string buf "<span class=\"hl-operator\">";
327
+
Buffer.add_string buf (html_escape (String.make 1 (current ())));
328
+
advance ();
329
+
(* Consume multi-char operators *)
330
+
while
331
+
!i < len
332
+
&&
333
+
match current () with
334
+
| '|' | '-' | '+' | '*' | '/' | '=' | '<' | '>' | '@' | '^'
335
+
| '~' | '!' | '?' | '%' | '&' ->
336
+
true
337
+
| _ -> false
338
+
do
339
+
Buffer.add_string buf (html_escape (String.make 1 (current ())));
340
+
advance ()
341
+
done;
342
+
Buffer.add_string buf "</span>"
343
+
(* Punctuation *)
344
+
| ':' | ';' | '.' | ',' | '[' | ']' | '{' | '}' | '(' | ')' ->
345
+
Buffer.add_string buf
346
+
(Printf.sprintf "<span class=\"hl-punct\">%s</span>"
347
+
(html_escape (String.make 1 (current ()))));
348
+
advance ()
349
+
(* Arrow special case: -> *)
350
+
| ' ' | '\t' | '\n' | '\r' ->
351
+
Buffer.add_char buf (current ());
352
+
advance ()
353
+
| _ ->
354
+
let _ = peek () in
355
+
Buffer.add_string buf (html_escape (String.make 1 (current ())));
356
+
advance ()
357
+
done;
358
+
Buffer.contents buf
359
+
360
+
(** Render a diff as HTML with colored lines *)
361
+
let render_diff_html diff =
362
+
let buf = Buffer.create 1024 in
363
+
List.iter (fun line ->
364
+
match line with
365
+
| Same s ->
366
+
Buffer.add_string buf
367
+
(Printf.sprintf "<div class=\"sc-diff-line sc-diff-same\">%s</div>\n"
368
+
(highlight_ocaml s))
369
+
| Added s ->
370
+
Buffer.add_string buf
371
+
(Printf.sprintf "<div class=\"sc-diff-line sc-diff-added\">%s</div>\n"
372
+
(highlight_ocaml s))
373
+
| Removed s ->
374
+
Buffer.add_string buf
375
+
(Printf.sprintf "<div class=\"sc-diff-line sc-diff-removed\">%s</div>\n"
376
+
(highlight_ocaml s)))
377
+
diff;
378
+
Buffer.contents buf
379
+
380
+
(** {1 Shared JavaScript}
381
+
382
+
The scrollycode runtime handles IntersectionObserver-based step
383
+
detection and line-level transition animations. *)
384
+
385
+
let shared_js =
386
+
{|
387
+
(function() {
388
+
'use strict';
389
+
390
+
function initScrollycode(container) {
391
+
var steps = container.querySelectorAll('.sc-step');
392
+
var codeBody = container.querySelector('.sc-code-body');
393
+
var stepBadge = container.querySelector('.sc-step-badge');
394
+
var pips = container.querySelectorAll('.sc-pip');
395
+
var currentStep = -1;
396
+
397
+
function parseLines(el) {
398
+
if (!el) return [];
399
+
var items = el.querySelectorAll('.sc-line');
400
+
return Array.from(items).map(function(line) {
401
+
return { id: line.dataset.id, html: line.innerHTML, focused: line.classList.contains('sc-focused') };
402
+
});
403
+
}
404
+
405
+
function renderStep(index) {
406
+
if (index === currentStep || index < 0 || index >= steps.length) return;
407
+
408
+
var stepEl = steps[index];
409
+
var codeSlot = stepEl.querySelector('.sc-code-slot');
410
+
var newLines = parseLines(codeSlot);
411
+
var oldLines = parseLines(codeBody);
412
+
var oldById = {};
413
+
oldLines.forEach(function(l) { oldById[l.id] = l; });
414
+
var newById = {};
415
+
newLines.forEach(function(l) { newById[l.id] = l; });
416
+
417
+
// Determine exiting lines
418
+
var exiting = oldLines.filter(function(l) { return !newById[l.id]; });
419
+
420
+
// Animate exit
421
+
exiting.forEach(function(l, i) {
422
+
var el = codeBody.querySelector('[data-id="' + l.id + '"]');
423
+
if (el) {
424
+
el.style.animationDelay = (i * 30) + 'ms';
425
+
el.classList.add('sc-exiting');
426
+
}
427
+
});
428
+
429
+
var exitTime = exiting.length > 0 ? 200 + exiting.length * 30 : 0;
430
+
431
+
setTimeout(function() {
432
+
// Rebuild DOM
433
+
codeBody.innerHTML = '';
434
+
var firstNew = null;
435
+
newLines.forEach(function(l, i) {
436
+
var div = document.createElement('div');
437
+
var isNew = !oldById[l.id];
438
+
div.className = 'sc-line' + (l.focused ? ' sc-focused' : '') + (isNew ? ' sc-entering' : '');
439
+
div.dataset.id = l.id;
440
+
div.innerHTML = '<span class="sc-line-number">' + (i + 1) + '</span>' + l.html;
441
+
if (isNew) {
442
+
div.style.animationDelay = (i * 25) + 'ms';
443
+
if (!firstNew) firstNew = div;
444
+
}
445
+
codeBody.appendChild(div);
446
+
});
447
+
448
+
// Scroll to first new line, with some context above
449
+
if (firstNew) {
450
+
var lineH = firstNew.offsetHeight || 24;
451
+
var scrollTarget = firstNew.offsetTop - lineH * 2;
452
+
codeBody.scrollTo({ top: Math.max(0, scrollTarget), behavior: 'smooth' });
453
+
}
454
+
455
+
// Update badge and pips
456
+
if (stepBadge) stepBadge.textContent = (index + 1) + ' / ' + steps.length;
457
+
pips.forEach(function(pip, i) {
458
+
pip.classList.toggle('sc-active', i === index);
459
+
});
460
+
}, exitTime);
461
+
462
+
currentStep = index;
463
+
}
464
+
465
+
// Set up IntersectionObserver
466
+
var observer = new IntersectionObserver(function(entries) {
467
+
entries.forEach(function(entry) {
468
+
if (entry.isIntersecting) {
469
+
var idx = parseInt(entry.target.dataset.stepIndex, 10);
470
+
renderStep(idx);
471
+
}
472
+
});
473
+
}, {
474
+
rootMargin: '-30% 0px -30% 0px',
475
+
threshold: 0
476
+
});
477
+
478
+
steps.forEach(function(step) { observer.observe(step); });
479
+
480
+
// Initialize first step
481
+
renderStep(0);
482
+
483
+
// Playground overlay
484
+
var overlay = document.getElementById('sc-playground-overlay');
485
+
var closeBtn = overlay ? overlay.querySelector('.sc-playground-close') : null;
486
+
487
+
if (overlay && closeBtn) {
488
+
// Close button
489
+
closeBtn.addEventListener('click', function() {
490
+
overlay.classList.remove('sc-open');
491
+
});
492
+
493
+
// ESC key closes
494
+
document.addEventListener('keydown', function(e) {
495
+
if (e.key === 'Escape') overlay.classList.remove('sc-open');
496
+
});
497
+
498
+
// Click outside closes
499
+
overlay.addEventListener('click', function(e) {
500
+
if (e.target === overlay) overlay.classList.remove('sc-open');
501
+
});
502
+
}
503
+
504
+
// Try it buttons
505
+
container.querySelectorAll('.sc-playground-btn').forEach(function(btn) {
506
+
btn.addEventListener('click', function() {
507
+
var stepIndex = parseInt(btn.dataset.step, 10);
508
+
// Collect code from all steps up to and including this one
509
+
var allCode = [];
510
+
for (var si = 0; si <= stepIndex; si++) {
511
+
var slot = steps[si].querySelector('.sc-code-slot');
512
+
if (slot) {
513
+
var lines = slot.querySelectorAll('.sc-line');
514
+
var code = Array.from(lines).map(function(l) {
515
+
return l.textContent.replace(/^\d+/, '');
516
+
}).join('\n');
517
+
allCode.push(code);
518
+
}
519
+
}
520
+
var fullCode = allCode.join('\n\n');
521
+
522
+
var editor = document.getElementById('sc-playground-x-ocaml');
523
+
if (editor) {
524
+
editor.textContent = fullCode;
525
+
// Trigger re-initialization if x-ocaml supports it
526
+
if (editor.setSource) editor.setSource(fullCode);
527
+
}
528
+
529
+
if (overlay) overlay.classList.add('sc-open');
530
+
});
531
+
});
532
+
}
533
+
534
+
// Initialize all scrollycode containers on the page
535
+
document.addEventListener('DOMContentLoaded', function() {
536
+
document.querySelectorAll('.sc-container').forEach(initScrollycode);
537
+
});
538
+
})();
539
+
|}
540
+
541
+
(** {1 Theme: Warm Workshop}
542
+
543
+
Earthy, bookish. Cream background, burnt sienna accents.
544
+
Fraunces display + Source Serif 4 body.
545
+
Dark navy code panel with warm syntax highlighting. *)
546
+
547
+
let warm_css =
548
+
{|
549
+
.sc-container.sc-warm {
550
+
--sc-bg: #f5f0e6;
551
+
--sc-text: #2c2416;
552
+
--sc-text-dim: #8a7c6a;
553
+
--sc-accent: #c25832;
554
+
--sc-accent-soft: rgba(194, 88, 50, 0.08);
555
+
--sc-code-bg: #1a1a2e;
556
+
--sc-code-text: #d4d0c8;
557
+
--sc-code-gutter: #3a3a52;
558
+
--sc-border: rgba(44, 36, 22, 0.1);
559
+
--sc-focus-bg: rgba(194, 88, 50, 0.06);
560
+
--sc-panel-radius: 12px;
561
+
font-family: 'Source Serif 4', Georgia, serif;
562
+
}
563
+
564
+
.sc-container.sc-warm .sc-hero {
565
+
background: var(--sc-bg);
566
+
text-align: center;
567
+
padding: 5rem 2rem 3rem;
568
+
border-bottom: 1px solid var(--sc-border);
569
+
}
570
+
571
+
.sc-container.sc-warm .sc-hero h1 {
572
+
font-family: 'Fraunces', serif;
573
+
font-size: clamp(2.2rem, 5vw, 3.4rem);
574
+
font-weight: 800;
575
+
font-style: italic;
576
+
color: var(--sc-text);
577
+
letter-spacing: -0.03em;
578
+
line-height: 1.1;
579
+
margin-bottom: 0.75rem;
580
+
}
581
+
582
+
.sc-container.sc-warm .sc-hero p {
583
+
color: var(--sc-text-dim);
584
+
font-size: 1.05rem;
585
+
max-width: 48ch;
586
+
margin: 0 auto;
587
+
line-height: 1.6;
588
+
}
589
+
590
+
.sc-container.sc-warm .sc-tutorial {
591
+
display: flex;
592
+
gap: 0;
593
+
background: var(--sc-bg);
594
+
position: relative;
595
+
}
596
+
597
+
.sc-container.sc-warm .sc-steps-col {
598
+
flex: 1;
599
+
min-width: 0;
600
+
padding: 2rem 2.5rem 50vh 2.5rem;
601
+
}
602
+
603
+
.sc-container.sc-warm .sc-code-col {
604
+
width: 52%;
605
+
flex-shrink: 0;
606
+
}
607
+
608
+
.sc-container.sc-warm .sc-step {
609
+
min-height: 70vh;
610
+
display: flex;
611
+
flex-direction: column;
612
+
justify-content: center;
613
+
padding: 2rem 0;
614
+
}
615
+
616
+
.sc-container.sc-warm .sc-step-number {
617
+
font-family: 'Source Code Pro', monospace;
618
+
font-size: 0.7rem;
619
+
font-weight: 600;
620
+
letter-spacing: 0.1em;
621
+
color: var(--sc-accent);
622
+
text-transform: uppercase;
623
+
margin-bottom: 0.5rem;
624
+
}
625
+
626
+
.sc-container.sc-warm .sc-step h2 {
627
+
font-family: 'Fraunces', serif;
628
+
font-size: 1.5rem;
629
+
font-weight: 700;
630
+
color: var(--sc-text);
631
+
letter-spacing: -0.02em;
632
+
margin-bottom: 0.75rem;
633
+
line-height: 1.25;
634
+
}
635
+
636
+
.sc-container.sc-warm .sc-step p {
637
+
color: var(--sc-text-dim);
638
+
font-size: 0.95rem;
639
+
line-height: 1.7;
640
+
max-width: 44ch;
641
+
}
642
+
643
+
.sc-container.sc-warm .sc-code-panel {
644
+
position: sticky;
645
+
top: 10vh;
646
+
height: 80vh;
647
+
margin: 0 2rem 0 0;
648
+
background: var(--sc-code-bg);
649
+
border-radius: var(--sc-panel-radius);
650
+
overflow: hidden;
651
+
display: flex;
652
+
flex-direction: column;
653
+
box-shadow: 0 20px 60px rgba(26, 26, 46, 0.3), 0 0 0 1px rgba(255,255,255,0.03) inset;
654
+
}
655
+
656
+
.sc-container.sc-warm .sc-code-header {
657
+
display: flex;
658
+
align-items: center;
659
+
padding: 0.85rem 1.25rem;
660
+
background: rgba(255,255,255,0.03);
661
+
border-bottom: 1px solid rgba(255,255,255,0.06);
662
+
gap: 0.6rem;
663
+
}
664
+
665
+
.sc-container.sc-warm .sc-dots {
666
+
display: flex;
667
+
gap: 6px;
668
+
}
669
+
670
+
.sc-container.sc-warm .sc-dots span {
671
+
width: 10px;
672
+
height: 10px;
673
+
border-radius: 50%;
674
+
}
675
+
676
+
.sc-container.sc-warm .sc-dots span:nth-child(1) { background: #ff5f57; }
677
+
.sc-container.sc-warm .sc-dots span:nth-child(2) { background: #ffbd2e; }
678
+
.sc-container.sc-warm .sc-dots span:nth-child(3) { background: #28c840; }
679
+
680
+
.sc-container.sc-warm .sc-filename {
681
+
font-family: 'Source Code Pro', monospace;
682
+
font-size: 0.72rem;
683
+
color: rgba(255,255,255,0.35);
684
+
letter-spacing: 0.04em;
685
+
flex: 1;
686
+
text-align: center;
687
+
}
688
+
689
+
.sc-container.sc-warm .sc-step-badge {
690
+
font-family: 'Source Code Pro', monospace;
691
+
font-size: 0.65rem;
692
+
color: rgba(255,255,255,0.25);
693
+
letter-spacing: 0.06em;
694
+
}
695
+
696
+
.sc-container.sc-warm .sc-code-body {
697
+
flex: 1;
698
+
overflow-y: auto;
699
+
padding: 1.25rem 0;
700
+
font-family: 'Source Code Pro', monospace;
701
+
font-size: 0.82rem;
702
+
line-height: 1.7;
703
+
color: var(--sc-code-text);
704
+
}
705
+
706
+
.sc-container.sc-warm .sc-line {
707
+
padding: 0 1.25rem;
708
+
white-space: pre;
709
+
transition: opacity 0.3s ease;
710
+
opacity: 0.35;
711
+
}
712
+
713
+
.sc-container.sc-warm .sc-line.sc-focused {
714
+
opacity: 1;
715
+
background: rgba(194, 88, 50, 0.06);
716
+
}
717
+
718
+
.sc-container.sc-warm .sc-line-number {
719
+
display: inline-block;
720
+
width: 3ch;
721
+
text-align: right;
722
+
margin-right: 1.5ch;
723
+
color: var(--sc-code-gutter);
724
+
user-select: none;
725
+
}
726
+
727
+
/* Syntax highlighting */
728
+
.sc-container.sc-warm .hl-keyword { color: #f0a6a0; font-weight: 500; }
729
+
.sc-container.sc-warm .hl-type { color: #8ec8e8; }
730
+
.sc-container.sc-warm .hl-string { color: #b8d89a; }
731
+
.sc-container.sc-warm .hl-comment { color: #6a6a82; font-style: italic; }
732
+
.sc-container.sc-warm .hl-number { color: #ddb97a; }
733
+
.sc-container.sc-warm .hl-module { color: #e8c87a; }
734
+
.sc-container.sc-warm .hl-operator { color: #c8a8d8; }
735
+
.sc-container.sc-warm .hl-punct { color: #7a7a92; }
736
+
737
+
/* Progress pips */
738
+
.sc-container.sc-warm .sc-progress {
739
+
position: fixed;
740
+
left: 1.5rem;
741
+
top: 50%;
742
+
transform: translateY(-50%);
743
+
display: flex;
744
+
flex-direction: column;
745
+
gap: 8px;
746
+
z-index: 100;
747
+
}
748
+
749
+
.sc-container.sc-warm .sc-pip {
750
+
width: 6px;
751
+
height: 6px;
752
+
border-radius: 50%;
753
+
background: var(--sc-border);
754
+
transition: all 0.3s ease;
755
+
}
756
+
757
+
.sc-container.sc-warm .sc-pip.sc-active {
758
+
background: var(--sc-accent);
759
+
box-shadow: 0 0 8px rgba(194, 88, 50, 0.4);
760
+
transform: scale(1.4);
761
+
}
762
+
763
+
/* Animations */
764
+
@keyframes sc-line-exit {
765
+
0% { opacity: 1; transform: translateX(0); }
766
+
100% { opacity: 0; transform: translateX(-30px); }
767
+
}
768
+
769
+
@keyframes sc-line-enter {
770
+
0% { opacity: 0; transform: translateX(30px); }
771
+
100% { opacity: 1; transform: translateX(0); }
772
+
}
773
+
774
+
.sc-container.sc-warm .sc-line.sc-exiting {
775
+
animation: sc-line-exit 0.2s cubic-bezier(0.22, 1, 0.36, 1) forwards;
776
+
}
777
+
778
+
.sc-container.sc-warm .sc-line.sc-entering {
779
+
animation: sc-line-enter 0.25s cubic-bezier(0.22, 1, 0.36, 1) both;
780
+
}
781
+
782
+
/* Hidden code slot */
783
+
.sc-code-slot { display: none; }
784
+
785
+
/* Mobile responsive */
786
+
@media (max-width: 700px) {
787
+
.sc-container.sc-warm { padding: 0 1rem; }
788
+
.sc-container.sc-warm .sc-desktop { display: none !important; }
789
+
.sc-container.sc-warm .sc-mobile { display: block !important; }
790
+
.sc-container.sc-warm .sc-progress { display: none; }
791
+
.sc-container.sc-warm .sc-hero h1 { font-size: 2rem; }
792
+
}
793
+
@media (min-width: 701px) {
794
+
.sc-container.sc-warm .sc-mobile { display: none !important; }
795
+
}
796
+
.sc-container.sc-warm .sc-mobile-step {
797
+
margin: 1.5rem 0;
798
+
padding: 1.5rem;
799
+
border-radius: 12px;
800
+
background: rgba(255,255,255,0.5);
801
+
}
802
+
.sc-container.sc-warm .sc-mobile-step-num {
803
+
font-family: 'Fraunces', serif;
804
+
font-size: 0.75rem;
805
+
text-transform: uppercase;
806
+
letter-spacing: 0.15em;
807
+
color: #a0785a;
808
+
margin-bottom: 0.5rem;
809
+
}
810
+
.sc-container.sc-warm .sc-mobile-step h2 {
811
+
font-family: 'Fraunces', serif;
812
+
font-size: 1.3rem;
813
+
color: #3a2e28;
814
+
margin: 0 0 0.75rem;
815
+
}
816
+
.sc-container.sc-warm .sc-mobile-step p {
817
+
font-family: 'Source Serif 4', serif;
818
+
font-size: 1rem;
819
+
color: #5a4a3a;
820
+
line-height: 1.6;
821
+
margin: 0 0 1rem;
822
+
}
823
+
.sc-container.sc-warm .sc-diff-block {
824
+
background: #1e1b2e;
825
+
border-radius: 8px;
826
+
padding: 0.75rem;
827
+
overflow-x: auto;
828
+
font-family: 'Source Code Pro', monospace;
829
+
font-size: 0.8rem;
830
+
line-height: 1.5;
831
+
}
832
+
.sc-container.sc-warm .sc-diff-line { padding: 1px 0.5rem; white-space: pre; }
833
+
.sc-container.sc-warm .sc-diff-added { background: rgba(80, 200, 80, 0.15); border-left: 3px solid #4caf50; }
834
+
.sc-container.sc-warm .sc-diff-removed { background: rgba(255, 80, 80, 0.12); border-left: 3px solid #ef5350; text-decoration: line-through; opacity: 0.7; }
835
+
.sc-container.sc-warm .sc-diff-same { opacity: 0.5; }
836
+
837
+
/* Playground overlay */
838
+
.sc-playground-overlay {
839
+
display: none;
840
+
position: fixed;
841
+
inset: 0;
842
+
z-index: 10000;
843
+
background: rgba(0,0,0,0.6);
844
+
backdrop-filter: blur(4px);
845
+
align-items: center;
846
+
justify-content: center;
847
+
}
848
+
.sc-playground-overlay.sc-open {
849
+
display: flex;
850
+
}
851
+
.sc-playground-container {
852
+
width: 90vw;
853
+
max-width: 900px;
854
+
height: 80vh;
855
+
background: #1e1b2e;
856
+
border-radius: 12px;
857
+
display: flex;
858
+
flex-direction: column;
859
+
overflow: hidden;
860
+
box-shadow: 0 25px 80px rgba(0,0,0,0.5);
861
+
}
862
+
.sc-playground-header {
863
+
display: flex;
864
+
align-items: center;
865
+
justify-content: space-between;
866
+
padding: 0.75rem 1rem;
867
+
background: rgba(255,255,255,0.05);
868
+
border-bottom: 1px solid rgba(255,255,255,0.1);
869
+
}
870
+
.sc-playground-title {
871
+
font-family: 'Fraunces', serif;
872
+
font-size: 0.9rem;
873
+
color: rgba(255,255,255,0.8);
874
+
}
875
+
.sc-playground-close {
876
+
background: none;
877
+
border: none;
878
+
color: rgba(255,255,255,0.5);
879
+
font-size: 1.5rem;
880
+
cursor: pointer;
881
+
padding: 0 0.5rem;
882
+
line-height: 1;
883
+
}
884
+
.sc-playground-close:hover { color: #fff; }
885
+
.sc-playground-editor {
886
+
flex: 1;
887
+
overflow: auto;
888
+
}
889
+
.sc-playground-editor x-ocaml {
890
+
display: block;
891
+
height: 100%;
892
+
}
893
+
.sc-container.sc-warm .sc-playground-btn {
894
+
display: inline-block;
895
+
margin-top: 0.75rem;
896
+
padding: 0.4rem 1rem;
897
+
border: 1px solid rgba(160,120,90,0.3);
898
+
border-radius: 6px;
899
+
background: transparent;
900
+
color: #a0785a;
901
+
font-family: 'Source Serif 4', serif;
902
+
font-size: 0.85rem;
903
+
cursor: pointer;
904
+
transition: all 0.2s;
905
+
}
906
+
.sc-container.sc-warm .sc-playground-btn:hover {
907
+
background: rgba(160,120,90,0.1);
908
+
border-color: #a0785a;
909
+
}
910
+
|}
911
+
912
+
(** {1 Theme: Dark Terminal}
913
+
914
+
Cinematic dark theme. Near-black background, phosphor green and amber.
915
+
JetBrains Mono + Outfit geometric sans.
916
+
Code panel is hero-sized, prose is a narrow overlay strip. *)
917
+
918
+
let dark_css =
919
+
{|
920
+
.sc-container.sc-dark {
921
+
--sc-bg: #0a0a0f;
922
+
--sc-text: #e8e6f0;
923
+
--sc-text-dim: #6e6b80;
924
+
--sc-accent: #4ade80;
925
+
--sc-accent-alt: #fbbf24;
926
+
--sc-code-bg: #0f0f18;
927
+
--sc-code-text: #c8c5d8;
928
+
--sc-code-gutter: #2a2a3e;
929
+
--sc-border: rgba(255, 255, 255, 0.06);
930
+
--sc-panel-radius: 0;
931
+
font-family: 'Outfit', sans-serif;
932
+
background: var(--sc-bg);
933
+
color: var(--sc-text);
934
+
}
935
+
936
+
.sc-container.sc-dark .sc-hero {
937
+
background: var(--sc-bg);
938
+
text-align: left;
939
+
padding: 8rem 4rem 4rem;
940
+
max-width: 800px;
941
+
position: relative;
942
+
}
943
+
944
+
.sc-container.sc-dark .sc-hero::before {
945
+
content: '';
946
+
position: absolute;
947
+
top: 0;
948
+
left: 0;
949
+
right: 0;
950
+
bottom: 0;
951
+
background: radial-gradient(ellipse at 20% 50%, rgba(74, 222, 128, 0.04) 0%, transparent 60%);
952
+
pointer-events: none;
953
+
}
954
+
955
+
.sc-container.sc-dark .sc-hero h1 {
956
+
font-family: 'Outfit', sans-serif;
957
+
font-size: clamp(2.8rem, 6vw, 4.5rem);
958
+
font-weight: 800;
959
+
color: var(--sc-text);
960
+
letter-spacing: -0.04em;
961
+
line-height: 1.0;
962
+
margin-bottom: 1.25rem;
963
+
}
964
+
965
+
.sc-container.sc-dark .sc-hero h1 em {
966
+
font-style: normal;
967
+
color: var(--sc-accent);
968
+
}
969
+
970
+
.sc-container.sc-dark .sc-hero p {
971
+
color: var(--sc-text-dim);
972
+
font-size: 1.1rem;
973
+
max-width: 50ch;
974
+
line-height: 1.6;
975
+
font-weight: 300;
976
+
}
977
+
978
+
.sc-container.sc-dark .sc-tutorial {
979
+
display: flex;
980
+
gap: 0;
981
+
position: relative;
982
+
}
983
+
984
+
.sc-container.sc-dark .sc-steps-col {
985
+
width: 38%;
986
+
flex-shrink: 0;
987
+
padding: 2rem 2.5rem 50vh 4rem;
988
+
border-right: 1px solid var(--sc-border);
989
+
}
990
+
991
+
.sc-container.sc-dark .sc-code-col {
992
+
flex: 1;
993
+
min-width: 0;
994
+
}
995
+
996
+
.sc-container.sc-dark .sc-step {
997
+
min-height: 70vh;
998
+
display: flex;
999
+
flex-direction: column;
1000
+
justify-content: center;
1001
+
padding: 2rem 0;
1002
+
}
1003
+
1004
+
.sc-container.sc-dark .sc-step-number {
1005
+
font-family: 'JetBrains Mono', monospace;
1006
+
font-size: 0.65rem;
1007
+
font-weight: 700;
1008
+
letter-spacing: 0.15em;
1009
+
color: var(--sc-accent);
1010
+
text-transform: uppercase;
1011
+
margin-bottom: 0.75rem;
1012
+
display: flex;
1013
+
align-items: center;
1014
+
gap: 0.75rem;
1015
+
}
1016
+
1017
+
.sc-container.sc-dark .sc-step-number::after {
1018
+
content: '';
1019
+
flex: 1;
1020
+
height: 1px;
1021
+
background: var(--sc-border);
1022
+
}
1023
+
1024
+
.sc-container.sc-dark .sc-step h2 {
1025
+
font-family: 'Outfit', sans-serif;
1026
+
font-size: 1.4rem;
1027
+
font-weight: 700;
1028
+
color: var(--sc-text);
1029
+
letter-spacing: -0.02em;
1030
+
margin-bottom: 0.75rem;
1031
+
line-height: 1.2;
1032
+
}
1033
+
1034
+
.sc-container.sc-dark .sc-step p {
1035
+
color: var(--sc-text-dim);
1036
+
font-size: 0.9rem;
1037
+
line-height: 1.7;
1038
+
max-width: 40ch;
1039
+
font-weight: 300;
1040
+
}
1041
+
1042
+
.sc-container.sc-dark .sc-code-panel {
1043
+
position: sticky;
1044
+
top: 0;
1045
+
height: 100vh;
1046
+
background: var(--sc-code-bg);
1047
+
display: flex;
1048
+
flex-direction: column;
1049
+
border-left: 1px solid var(--sc-border);
1050
+
}
1051
+
1052
+
.sc-container.sc-dark .sc-code-header {
1053
+
display: flex;
1054
+
align-items: center;
1055
+
padding: 1rem 1.5rem;
1056
+
border-bottom: 1px solid var(--sc-border);
1057
+
gap: 1rem;
1058
+
}
1059
+
1060
+
.sc-container.sc-dark .sc-dots {
1061
+
display: flex;
1062
+
gap: 6px;
1063
+
}
1064
+
1065
+
.sc-container.sc-dark .sc-dots span {
1066
+
width: 8px;
1067
+
height: 8px;
1068
+
border-radius: 50%;
1069
+
background: var(--sc-code-gutter);
1070
+
}
1071
+
1072
+
.sc-container.sc-dark .sc-filename {
1073
+
font-family: 'JetBrains Mono', monospace;
1074
+
font-size: 0.7rem;
1075
+
color: var(--sc-text-dim);
1076
+
letter-spacing: 0.04em;
1077
+
flex: 1;
1078
+
}
1079
+
1080
+
.sc-container.sc-dark .sc-step-badge {
1081
+
font-family: 'JetBrains Mono', monospace;
1082
+
font-size: 0.6rem;
1083
+
color: var(--sc-accent);
1084
+
letter-spacing: 0.08em;
1085
+
background: rgba(74, 222, 128, 0.08);
1086
+
padding: 0.25em 0.75em;
1087
+
border-radius: 3px;
1088
+
}
1089
+
1090
+
.sc-container.sc-dark .sc-code-body {
1091
+
flex: 1;
1092
+
overflow-y: auto;
1093
+
padding: 1.5rem 0;
1094
+
font-family: 'JetBrains Mono', monospace;
1095
+
font-size: 0.8rem;
1096
+
line-height: 1.75;
1097
+
color: var(--sc-code-text);
1098
+
}
1099
+
1100
+
.sc-container.sc-dark .sc-line {
1101
+
padding: 0 1.5rem;
1102
+
white-space: pre;
1103
+
transition: opacity 0.3s ease, background 0.3s ease;
1104
+
opacity: 0.25;
1105
+
}
1106
+
1107
+
.sc-container.sc-dark .sc-line.sc-focused {
1108
+
opacity: 1;
1109
+
background: rgba(74, 222, 128, 0.04);
1110
+
border-left: 2px solid var(--sc-accent);
1111
+
padding-left: calc(1.5rem - 2px);
1112
+
}
1113
+
1114
+
.sc-container.sc-dark .sc-line-number {
1115
+
display: inline-block;
1116
+
width: 3ch;
1117
+
text-align: right;
1118
+
margin-right: 2ch;
1119
+
color: var(--sc-code-gutter);
1120
+
user-select: none;
1121
+
}
1122
+
1123
+
/* Syntax highlighting — neon palette */
1124
+
.sc-container.sc-dark .hl-keyword { color: #ff7eb3; font-weight: 500; }
1125
+
.sc-container.sc-dark .hl-type { color: #7dd3fc; }
1126
+
.sc-container.sc-dark .hl-string { color: #4ade80; }
1127
+
.sc-container.sc-dark .hl-comment { color: #4a4a62; font-style: italic; }
1128
+
.sc-container.sc-dark .hl-number { color: #fbbf24; }
1129
+
.sc-container.sc-dark .hl-module { color: #c4b5fd; }
1130
+
.sc-container.sc-dark .hl-operator { color: #67e8f9; }
1131
+
.sc-container.sc-dark .hl-punct { color: #4a4a62; }
1132
+
1133
+
/* Progress pips */
1134
+
.sc-container.sc-dark .sc-progress {
1135
+
position: fixed;
1136
+
right: 1.5rem;
1137
+
top: 50%;
1138
+
transform: translateY(-50%);
1139
+
display: flex;
1140
+
flex-direction: column;
1141
+
gap: 10px;
1142
+
z-index: 100;
1143
+
}
1144
+
1145
+
.sc-container.sc-dark .sc-pip {
1146
+
width: 3px;
1147
+
height: 20px;
1148
+
border-radius: 2px;
1149
+
background: var(--sc-border);
1150
+
transition: all 0.3s ease;
1151
+
}
1152
+
1153
+
.sc-container.sc-dark .sc-pip.sc-active {
1154
+
background: var(--sc-accent);
1155
+
box-shadow: 0 0 12px rgba(74, 222, 128, 0.5);
1156
+
height: 30px;
1157
+
}
1158
+
1159
+
/* Animations */
1160
+
.sc-container.sc-dark .sc-line.sc-exiting {
1161
+
animation: sc-line-exit 0.2s cubic-bezier(0.22, 1, 0.36, 1) forwards;
1162
+
}
1163
+
1164
+
.sc-container.sc-dark .sc-line.sc-entering {
1165
+
animation: sc-line-enter 0.25s cubic-bezier(0.22, 1, 0.36, 1) both;
1166
+
}
1167
+
1168
+
.sc-code-slot { display: none; }
1169
+
1170
+
/* Mobile responsive */
1171
+
@media (max-width: 700px) {
1172
+
.sc-container.sc-dark { padding: 0 1rem; }
1173
+
.sc-container.sc-dark .sc-desktop { display: none !important; }
1174
+
.sc-container.sc-dark .sc-mobile { display: block !important; }
1175
+
.sc-container.sc-dark .sc-progress { display: none; }
1176
+
.sc-container.sc-dark .sc-hero h1 { font-size: 2rem; }
1177
+
}
1178
+
@media (min-width: 701px) {
1179
+
.sc-container.sc-dark .sc-mobile { display: none !important; }
1180
+
}
1181
+
.sc-container.sc-dark .sc-mobile-step {
1182
+
margin: 1.5rem 0;
1183
+
padding: 1.5rem;
1184
+
border-radius: 10px;
1185
+
background: rgba(255,255,255,0.04);
1186
+
border: 1px solid rgba(255,255,255,0.08);
1187
+
}
1188
+
.sc-container.sc-dark .sc-mobile-step-num {
1189
+
font-family: 'Outfit', sans-serif;
1190
+
font-size: 0.7rem;
1191
+
text-transform: uppercase;
1192
+
letter-spacing: 0.2em;
1193
+
color: #00d4aa;
1194
+
margin-bottom: 0.5rem;
1195
+
}
1196
+
.sc-container.sc-dark .sc-mobile-step h2 {
1197
+
font-family: 'Outfit', sans-serif;
1198
+
font-size: 1.3rem;
1199
+
color: #e8e6e3;
1200
+
margin: 0 0 0.75rem;
1201
+
}
1202
+
.sc-container.sc-dark .sc-mobile-step p {
1203
+
font-family: 'Outfit', sans-serif;
1204
+
font-size: 0.95rem;
1205
+
color: rgba(232,230,227,0.7);
1206
+
line-height: 1.6;
1207
+
margin: 0 0 1rem;
1208
+
}
1209
+
.sc-container.sc-dark .sc-diff-block {
1210
+
background: #0d1117;
1211
+
border-radius: 8px;
1212
+
padding: 0.75rem;
1213
+
overflow-x: auto;
1214
+
font-family: 'JetBrains Mono', monospace;
1215
+
font-size: 0.8rem;
1216
+
line-height: 1.5;
1217
+
border: 1px solid rgba(0,212,170,0.15);
1218
+
}
1219
+
.sc-container.sc-dark .sc-diff-line { padding: 1px 0.5rem; white-space: pre; }
1220
+
.sc-container.sc-dark .sc-diff-added { background: rgba(0, 212, 170, 0.12); border-left: 3px solid #00d4aa; }
1221
+
.sc-container.sc-dark .sc-diff-removed { background: rgba(255, 80, 80, 0.1); border-left: 3px solid #ff6b6b; text-decoration: line-through; opacity: 0.6; }
1222
+
.sc-container.sc-dark .sc-diff-same { opacity: 0.4; }
1223
+
1224
+
/* Playground */
1225
+
.sc-container.sc-dark .sc-playground-btn {
1226
+
display: inline-block;
1227
+
margin-top: 0.75rem;
1228
+
padding: 0.4rem 1rem;
1229
+
border: 1px solid rgba(0,212,170,0.3);
1230
+
border-radius: 6px;
1231
+
background: transparent;
1232
+
color: #00d4aa;
1233
+
font-family: 'Outfit', sans-serif;
1234
+
font-size: 0.85rem;
1235
+
cursor: pointer;
1236
+
transition: all 0.2s;
1237
+
}
1238
+
.sc-container.sc-dark .sc-playground-btn:hover {
1239
+
background: rgba(0,212,170,0.1);
1240
+
border-color: #00d4aa;
1241
+
}
1242
+
|}
1243
+
1244
+
(** {1 Theme: Notebook}
1245
+
1246
+
Clean editorial. Soft white, blue-violet accent.
1247
+
Newsreader display + DM Sans body.
1248
+
Vertical layout with code blocks inline but sticky. *)
1249
+
1250
+
let notebook_css =
1251
+
{|
1252
+
.sc-container.sc-notebook {
1253
+
--sc-bg: #fafbfe;
1254
+
--sc-text: #1a1a2e;
1255
+
--sc-text-dim: #64648a;
1256
+
--sc-accent: #6366f1;
1257
+
--sc-accent-soft: rgba(99, 102, 241, 0.06);
1258
+
--sc-code-bg: #1e1e32;
1259
+
--sc-code-text: #d1d0e0;
1260
+
--sc-code-gutter: #3a3a52;
1261
+
--sc-border: rgba(99, 102, 241, 0.08);
1262
+
--sc-panel-radius: 16px;
1263
+
font-family: 'DM Sans', sans-serif;
1264
+
}
1265
+
1266
+
.sc-container.sc-notebook .sc-hero {
1267
+
background: var(--sc-bg);
1268
+
text-align: left;
1269
+
padding: 6rem 0 3rem;
1270
+
max-width: 640px;
1271
+
margin: 0 auto;
1272
+
border-bottom: 2px solid var(--sc-accent);
1273
+
position: relative;
1274
+
}
1275
+
1276
+
.sc-container.sc-notebook .sc-hero::after {
1277
+
content: '';
1278
+
position: absolute;
1279
+
bottom: -2px;
1280
+
left: 0;
1281
+
width: 120px;
1282
+
height: 2px;
1283
+
background: var(--sc-accent);
1284
+
box-shadow: 0 0 16px rgba(99, 102, 241, 0.4);
1285
+
}
1286
+
1287
+
.sc-container.sc-notebook .sc-hero h1 {
1288
+
font-family: 'Newsreader', serif;
1289
+
font-size: clamp(2rem, 4vw, 2.8rem);
1290
+
font-weight: 600;
1291
+
color: var(--sc-text);
1292
+
letter-spacing: -0.02em;
1293
+
line-height: 1.15;
1294
+
margin-bottom: 0.75rem;
1295
+
}
1296
+
1297
+
.sc-container.sc-notebook .sc-hero p {
1298
+
color: var(--sc-text-dim);
1299
+
font-size: 1rem;
1300
+
max-width: 52ch;
1301
+
line-height: 1.6;
1302
+
font-weight: 400;
1303
+
}
1304
+
1305
+
.sc-container.sc-notebook .sc-tutorial {
1306
+
display: flex;
1307
+
gap: 0;
1308
+
background: var(--sc-bg);
1309
+
max-width: 1200px;
1310
+
margin: 0 auto;
1311
+
position: relative;
1312
+
}
1313
+
1314
+
.sc-container.sc-notebook .sc-steps-col {
1315
+
flex: 1;
1316
+
min-width: 0;
1317
+
padding: 2rem 3rem 50vh 0;
1318
+
max-width: 420px;
1319
+
}
1320
+
1321
+
.sc-container.sc-notebook .sc-code-col {
1322
+
flex: 1;
1323
+
min-width: 0;
1324
+
}
1325
+
1326
+
.sc-container.sc-notebook .sc-step {
1327
+
min-height: 60vh;
1328
+
display: flex;
1329
+
flex-direction: column;
1330
+
justify-content: center;
1331
+
padding: 1.5rem 0;
1332
+
position: relative;
1333
+
}
1334
+
1335
+
.sc-container.sc-notebook .sc-step::before {
1336
+
content: '';
1337
+
position: absolute;
1338
+
left: -1.5rem;
1339
+
top: 50%;
1340
+
transform: translateY(-50%);
1341
+
width: 3px;
1342
+
height: 0;
1343
+
background: var(--sc-accent);
1344
+
border-radius: 2px;
1345
+
transition: height 0.4s cubic-bezier(0.22, 1, 0.36, 1);
1346
+
}
1347
+
1348
+
.sc-container.sc-notebook .sc-step-number {
1349
+
font-family: 'DM Sans', sans-serif;
1350
+
font-size: 0.68rem;
1351
+
font-weight: 700;
1352
+
letter-spacing: 0.12em;
1353
+
color: var(--sc-accent);
1354
+
text-transform: uppercase;
1355
+
margin-bottom: 0.5rem;
1356
+
display: flex;
1357
+
align-items: center;
1358
+
gap: 0.5rem;
1359
+
}
1360
+
1361
+
.sc-container.sc-notebook .sc-step h2 {
1362
+
font-family: 'Newsreader', serif;
1363
+
font-size: 1.3rem;
1364
+
font-weight: 600;
1365
+
color: var(--sc-text);
1366
+
letter-spacing: -0.01em;
1367
+
margin-bottom: 0.6rem;
1368
+
line-height: 1.3;
1369
+
}
1370
+
1371
+
.sc-container.sc-notebook .sc-step p {
1372
+
color: var(--sc-text-dim);
1373
+
font-size: 0.88rem;
1374
+
line-height: 1.7;
1375
+
max-width: 42ch;
1376
+
}
1377
+
1378
+
.sc-container.sc-notebook .sc-code-panel {
1379
+
position: sticky;
1380
+
top: 8vh;
1381
+
height: 84vh;
1382
+
margin: 0 0 0 2rem;
1383
+
background: var(--sc-code-bg);
1384
+
border-radius: var(--sc-panel-radius);
1385
+
overflow: hidden;
1386
+
display: flex;
1387
+
flex-direction: column;
1388
+
box-shadow:
1389
+
0 24px 80px rgba(30, 30, 50, 0.15),
1390
+
0 0 0 1px rgba(99, 102, 241, 0.08);
1391
+
}
1392
+
1393
+
.sc-container.sc-notebook .sc-code-header {
1394
+
display: flex;
1395
+
align-items: center;
1396
+
padding: 0.75rem 1.25rem;
1397
+
background: rgba(99, 102, 241, 0.04);
1398
+
border-bottom: 1px solid rgba(255,255,255,0.04);
1399
+
gap: 0.75rem;
1400
+
}
1401
+
1402
+
.sc-container.sc-notebook .sc-dots {
1403
+
display: flex;
1404
+
gap: 5px;
1405
+
}
1406
+
1407
+
.sc-container.sc-notebook .sc-dots span {
1408
+
width: 9px;
1409
+
height: 9px;
1410
+
border-radius: 50%;
1411
+
background: rgba(255,255,255,0.08);
1412
+
}
1413
+
1414
+
.sc-container.sc-notebook .sc-filename {
1415
+
font-family: 'DM Mono', monospace;
1416
+
font-size: 0.7rem;
1417
+
color: rgba(255,255,255,0.3);
1418
+
letter-spacing: 0.04em;
1419
+
flex: 1;
1420
+
text-align: center;
1421
+
}
1422
+
1423
+
.sc-container.sc-notebook .sc-step-badge {
1424
+
font-family: 'DM Mono', monospace;
1425
+
font-size: 0.6rem;
1426
+
color: var(--sc-accent);
1427
+
letter-spacing: 0.06em;
1428
+
}
1429
+
1430
+
.sc-container.sc-notebook .sc-code-body {
1431
+
flex: 1;
1432
+
overflow-y: auto;
1433
+
padding: 1.25rem 0;
1434
+
font-family: 'DM Mono', 'Source Code Pro', monospace;
1435
+
font-size: 0.78rem;
1436
+
line-height: 1.75;
1437
+
color: var(--sc-code-text);
1438
+
}
1439
+
1440
+
.sc-container.sc-notebook .sc-line {
1441
+
padding: 0 1.25rem;
1442
+
white-space: pre;
1443
+
transition: opacity 0.3s ease;
1444
+
opacity: 0.3;
1445
+
}
1446
+
1447
+
.sc-container.sc-notebook .sc-line.sc-focused {
1448
+
opacity: 1;
1449
+
background: rgba(99, 102, 241, 0.05);
1450
+
}
1451
+
1452
+
.sc-container.sc-notebook .sc-line-number {
1453
+
display: inline-block;
1454
+
width: 3ch;
1455
+
text-align: right;
1456
+
margin-right: 1.5ch;
1457
+
color: var(--sc-code-gutter);
1458
+
user-select: none;
1459
+
}
1460
+
1461
+
/* Syntax highlighting — cool tones */
1462
+
.sc-container.sc-notebook .hl-keyword { color: #a78bfa; font-weight: 500; }
1463
+
.sc-container.sc-notebook .hl-type { color: #67e8f9; }
1464
+
.sc-container.sc-notebook .hl-string { color: #86efac; }
1465
+
.sc-container.sc-notebook .hl-comment { color: #4a4a62; font-style: italic; }
1466
+
.sc-container.sc-notebook .hl-number { color: #fde68a; }
1467
+
.sc-container.sc-notebook .hl-module { color: #f9a8d4; }
1468
+
.sc-container.sc-notebook .hl-operator { color: #93c5fd; }
1469
+
.sc-container.sc-notebook .hl-punct { color: #4a4a62; }
1470
+
1471
+
/* Progress pips */
1472
+
.sc-container.sc-notebook .sc-progress {
1473
+
position: fixed;
1474
+
left: 2rem;
1475
+
top: 50%;
1476
+
transform: translateY(-50%);
1477
+
display: flex;
1478
+
flex-direction: column;
1479
+
gap: 6px;
1480
+
z-index: 100;
1481
+
}
1482
+
1483
+
.sc-container.sc-notebook .sc-pip {
1484
+
width: 8px;
1485
+
height: 8px;
1486
+
border-radius: 3px;
1487
+
background: var(--sc-border);
1488
+
transition: all 0.3s ease;
1489
+
}
1490
+
1491
+
.sc-container.sc-notebook .sc-pip.sc-active {
1492
+
background: var(--sc-accent);
1493
+
box-shadow: 0 0 10px rgba(99, 102, 241, 0.4);
1494
+
border-radius: 2px;
1495
+
width: 8px;
1496
+
height: 16px;
1497
+
}
1498
+
1499
+
/* Animations */
1500
+
.sc-container.sc-notebook .sc-line.sc-exiting {
1501
+
animation: sc-line-exit 0.2s cubic-bezier(0.22, 1, 0.36, 1) forwards;
1502
+
}
1503
+
1504
+
.sc-container.sc-notebook .sc-line.sc-entering {
1505
+
animation: sc-line-enter 0.25s cubic-bezier(0.22, 1, 0.36, 1) both;
1506
+
}
1507
+
1508
+
.sc-code-slot { display: none; }
1509
+
1510
+
/* Mobile responsive */
1511
+
@media (max-width: 700px) {
1512
+
.sc-container.sc-notebook { padding: 0 1rem; }
1513
+
.sc-container.sc-notebook .sc-desktop { display: none !important; }
1514
+
.sc-container.sc-notebook .sc-mobile { display: block !important; }
1515
+
.sc-container.sc-notebook .sc-progress { display: none; }
1516
+
.sc-container.sc-notebook .sc-hero h1 { font-size: 2rem; }
1517
+
}
1518
+
@media (min-width: 701px) {
1519
+
.sc-container.sc-notebook .sc-mobile { display: none !important; }
1520
+
}
1521
+
.sc-container.sc-notebook .sc-mobile-step {
1522
+
margin: 1.5rem 0;
1523
+
padding: 1.5rem;
1524
+
border-radius: 6px;
1525
+
background: #ffffff;
1526
+
border: 1px solid #e0ddd8;
1527
+
}
1528
+
.sc-container.sc-notebook .sc-mobile-step-num {
1529
+
font-family: 'DM Sans', sans-serif;
1530
+
font-size: 0.7rem;
1531
+
text-transform: uppercase;
1532
+
letter-spacing: 0.15em;
1533
+
color: #0066cc;
1534
+
font-weight: 600;
1535
+
margin-bottom: 0.5rem;
1536
+
}
1537
+
.sc-container.sc-notebook .sc-mobile-step h2 {
1538
+
font-family: 'Newsreader', serif;
1539
+
font-size: 1.3rem;
1540
+
color: #1a1a1a;
1541
+
margin: 0 0 0.75rem;
1542
+
}
1543
+
.sc-container.sc-notebook .sc-mobile-step p {
1544
+
font-family: 'DM Sans', sans-serif;
1545
+
font-size: 0.95rem;
1546
+
color: #4a4a4a;
1547
+
line-height: 1.6;
1548
+
margin: 0 0 1rem;
1549
+
}
1550
+
.sc-container.sc-notebook .sc-diff-block {
1551
+
background: #282c34;
1552
+
border-radius: 6px;
1553
+
padding: 0.75rem;
1554
+
overflow-x: auto;
1555
+
font-family: 'IBM Plex Mono', monospace;
1556
+
font-size: 0.8rem;
1557
+
line-height: 1.5;
1558
+
border: 1px solid #e0ddd8;
1559
+
}
1560
+
.sc-container.sc-notebook .sc-diff-line { padding: 1px 0.5rem; white-space: pre; }
1561
+
.sc-container.sc-notebook .sc-diff-added { background: rgba(0, 102, 204, 0.12); border-left: 3px solid #0066cc; }
1562
+
.sc-container.sc-notebook .sc-diff-removed { background: rgba(220, 50, 50, 0.1); border-left: 3px solid #dc3232; text-decoration: line-through; opacity: 0.6; }
1563
+
.sc-container.sc-notebook .sc-diff-same { opacity: 0.4; }
1564
+
1565
+
/* Playground */
1566
+
.sc-container.sc-notebook .sc-playground-btn {
1567
+
display: inline-block;
1568
+
margin-top: 0.75rem;
1569
+
padding: 0.4rem 1rem;
1570
+
border: 1px solid rgba(0,102,204,0.3);
1571
+
border-radius: 6px;
1572
+
background: transparent;
1573
+
color: #0066cc;
1574
+
font-family: 'DM Sans', sans-serif;
1575
+
font-size: 0.85rem;
1576
+
cursor: pointer;
1577
+
transition: all 0.2s;
1578
+
}
1579
+
.sc-container.sc-notebook .sc-playground-btn:hover {
1580
+
background: rgba(0,102,204,0.1);
1581
+
border-color: #0066cc;
1582
+
}
1583
+
|}
1584
+
1585
+
(** {1 CSS to hide odoc chrome}
1586
+
1587
+
When a scrollycode block is rendered, we want it to take over
1588
+
the page. This CSS hides the odoc navigation, breadcrumbs, etc. *)
1589
+
1590
+
let chrome_override_css =
1591
+
{|
1592
+
/* Override odoc page chrome for scrollycode pages */
1593
+
.odoc-nav, .odoc-tocs, .odoc-search { display: none !important; }
1594
+
.odoc-preamble > h1, .odoc-preamble > h2, .odoc-preamble > h3 { display: none !important; }
1595
+
.at-tags > li > .at-tag { display: none !important; }
1596
+
.odoc-preamble, .odoc-content {
1597
+
max-width: none !important;
1598
+
padding: 0 !important;
1599
+
margin: 0 !important;
1600
+
display: block !important;
1601
+
}
1602
+
.at-tags {
1603
+
list-style: none !important;
1604
+
padding: 0 !important;
1605
+
margin: 0 !important;
1606
+
}
1607
+
.at-tags > li {
1608
+
display: block !important;
1609
+
margin: 0 !important;
1610
+
padding: 0 !important;
1611
+
}
1612
+
body.odoc, .odoc {
1613
+
padding: 0 !important;
1614
+
margin: 0 !important;
1615
+
max-width: none !important;
1616
+
background: inherit;
1617
+
}
1618
+
|}
1619
+
1620
+
(** {1 Google Fonts links} *)
1621
+
1622
+
let warm_fonts =
1623
+
{|<link rel="preconnect" href="https://fonts.googleapis.com">
1624
+
<link rel="preconnect" href="https://fonts.gstatic.com" crossorigin>
1625
+
<link href="https://fonts.googleapis.com/css2?family=Fraunces:ital,opsz,wght@0,9..144,300..900;1,9..144,300..900&family=Source+Code+Pro:ital,wght@0,300..900;1,300..900&family=Source+Serif+4:ital,opsz,wght@0,8..60,300..900;1,8..60,300..900&display=swap" rel="stylesheet">|}
1626
+
1627
+
let dark_fonts =
1628
+
{|<link rel="preconnect" href="https://fonts.googleapis.com">
1629
+
<link rel="preconnect" href="https://fonts.gstatic.com" crossorigin>
1630
+
<link href="https://fonts.googleapis.com/css2?family=JetBrains+Mono:wght@300..800&family=Outfit:wght@300..900&display=swap" rel="stylesheet">|}
1631
+
1632
+
let notebook_fonts =
1633
+
{|<link rel="preconnect" href="https://fonts.googleapis.com">
1634
+
<link rel="preconnect" href="https://fonts.gstatic.com" crossorigin>
1635
+
<link href="https://fonts.googleapis.com/css2?family=DM+Mono:wght@300;400;500&family=DM+Sans:ital,opsz,wght@0,9..40,300..900;1,9..40,300..900&family=Newsreader:ital,opsz,wght@0,6..72,300..800;1,6..72,300..800&display=swap" rel="stylesheet">|}
1636
+
1637
+
(** {1 HTML Generation} *)
1638
+
1639
+
(** Generate the code lines HTML for a step's code slot *)
1640
+
let generate_code_lines code focus =
1641
+
let lines = String.split_on_char '\n' code in
1642
+
let buf = Buffer.create 1024 in
1643
+
List.iteri
1644
+
(fun i line ->
1645
+
let line_num = i + 1 in
1646
+
let focused = focus = [] || List.mem line_num focus in
1647
+
let highlighted = highlight_ocaml line in
1648
+
Buffer.add_string buf
1649
+
(Printf.sprintf
1650
+
"<div class=\"sc-line%s\" data-id=\"L%d\">%s</div>\n"
1651
+
(if focused then " sc-focused" else "")
1652
+
line_num highlighted))
1653
+
lines;
1654
+
Buffer.contents buf
1655
+
1656
+
(** Generate the mobile stacked layout with diffs between steps *)
1657
+
let generate_mobile_html steps =
1658
+
let buf = Buffer.create 8192 in
1659
+
Buffer.add_string buf "<div class=\"sc-mobile\">\n";
1660
+
let prev_code = ref None in
1661
+
List.iteri (fun i step ->
1662
+
Buffer.add_string buf
1663
+
(Printf.sprintf " <div class=\"sc-mobile-step\">\n");
1664
+
Buffer.add_string buf
1665
+
(Printf.sprintf " <div class=\"sc-mobile-step-num\">Step %02d</div>\n" (i + 1));
1666
+
if step.title <> "" then
1667
+
Buffer.add_string buf
1668
+
(Printf.sprintf " <h2>%s</h2>\n" (html_escape step.title));
1669
+
if step.prose <> "" then
1670
+
Buffer.add_string buf
1671
+
(Printf.sprintf " <p>%s</p>\n" (html_escape step.prose));
1672
+
(* Diff block *)
1673
+
Buffer.add_string buf " <div class=\"sc-diff-block\">\n";
1674
+
let diff = match !prev_code with
1675
+
| None ->
1676
+
List.map (fun l -> Added l) (String.split_on_char '\n' step.code)
1677
+
| Some prev ->
1678
+
diff_lines prev step.code
1679
+
in
1680
+
Buffer.add_string buf (render_diff_html diff);
1681
+
Buffer.add_string buf " </div>\n";
1682
+
Buffer.add_string buf
1683
+
(Printf.sprintf " <button class=\"sc-playground-btn\" data-step=\"%d\">▶ Try it</button>\n" i);
1684
+
Buffer.add_string buf " </div>\n";
1685
+
prev_code := Some step.code)
1686
+
steps;
1687
+
Buffer.add_string buf "</div>\n";
1688
+
Buffer.contents buf
1689
+
1690
+
(** Generate the full scrollycode HTML for a given theme *)
1691
+
let generate_html ~theme ~title ~filename steps =
1692
+
let theme_class, fonts, css =
1693
+
match theme with
1694
+
| "warm" -> ("sc-warm", warm_fonts, warm_css)
1695
+
| "dark" -> ("sc-dark", dark_fonts, dark_css)
1696
+
| "notebook" -> ("sc-notebook", notebook_fonts, notebook_css)
1697
+
| _ -> ("sc-warm", warm_fonts, warm_css)
1698
+
in
1699
+
let buf = Buffer.create 16384 in
1700
+
1701
+
(* Fonts *)
1702
+
Buffer.add_string buf fonts;
1703
+
Buffer.add_char buf '\n';
1704
+
1705
+
(* CSS *)
1706
+
Buffer.add_string buf "<style>\n";
1707
+
Buffer.add_string buf chrome_override_css;
1708
+
Buffer.add_string buf css;
1709
+
Buffer.add_string buf "</style>\n";
1710
+
1711
+
(* Container *)
1712
+
Buffer.add_string buf
1713
+
(Printf.sprintf "<div class=\"sc-container %s\">\n" theme_class);
1714
+
1715
+
(* Hero *)
1716
+
Buffer.add_string buf "<div class=\"sc-hero\">\n";
1717
+
Buffer.add_string buf
1718
+
(Printf.sprintf " <h1>%s</h1>\n" (html_escape title));
1719
+
Buffer.add_string buf "</div>\n";
1720
+
1721
+
(* Progress pips *)
1722
+
Buffer.add_string buf "<nav class=\"sc-progress\">\n";
1723
+
List.iteri
1724
+
(fun i _step ->
1725
+
Buffer.add_string buf
1726
+
(Printf.sprintf " <div class=\"sc-pip%s\"></div>\n"
1727
+
(if i = 0 then " sc-active" else "")))
1728
+
steps;
1729
+
Buffer.add_string buf "</nav>\n";
1730
+
1731
+
(* Desktop layout *)
1732
+
Buffer.add_string buf "<div class=\"sc-desktop\">\n";
1733
+
Buffer.add_string buf "<div class=\"sc-tutorial\">\n";
1734
+
1735
+
(* Steps column *)
1736
+
Buffer.add_string buf " <div class=\"sc-steps-col\">\n";
1737
+
List.iteri
1738
+
(fun i step ->
1739
+
Buffer.add_string buf
1740
+
(Printf.sprintf
1741
+
" <div class=\"sc-step\" data-step-index=\"%d\">\n" i);
1742
+
Buffer.add_string buf
1743
+
(Printf.sprintf
1744
+
" <div class=\"sc-step-number\">Step %02d</div>\n" (i + 1));
1745
+
if step.title <> "" then
1746
+
Buffer.add_string buf
1747
+
(Printf.sprintf " <h2>%s</h2>\n" (html_escape step.title));
1748
+
if step.prose <> "" then
1749
+
Buffer.add_string buf
1750
+
(Printf.sprintf " <p>%s</p>\n" (html_escape step.prose));
1751
+
(* Hidden code slot for JS to read *)
1752
+
Buffer.add_string buf " <div class=\"sc-code-slot\">\n";
1753
+
Buffer.add_string buf (generate_code_lines step.code step.focus);
1754
+
Buffer.add_string buf " </div>\n";
1755
+
Buffer.add_string buf
1756
+
(Printf.sprintf " <button class=\"sc-playground-btn\" data-step=\"%d\">▶ Try it</button>\n" i);
1757
+
Buffer.add_string buf " </div>\n")
1758
+
steps;
1759
+
Buffer.add_string buf " </div>\n";
1760
+
1761
+
(* Code column *)
1762
+
Buffer.add_string buf " <div class=\"sc-code-col\">\n";
1763
+
Buffer.add_string buf " <div class=\"sc-code-panel\">\n";
1764
+
Buffer.add_string buf " <div class=\"sc-code-header\">\n";
1765
+
Buffer.add_string buf
1766
+
" <div class=\"sc-dots\"><span></span><span></span><span></span></div>\n";
1767
+
Buffer.add_string buf
1768
+
(Printf.sprintf " <span class=\"sc-filename\">%s</span>\n"
1769
+
(html_escape filename));
1770
+
Buffer.add_string buf
1771
+
(Printf.sprintf
1772
+
" <span class=\"sc-step-badge\">1 / %d</span>\n"
1773
+
(List.length steps));
1774
+
Buffer.add_string buf " </div>\n";
1775
+
Buffer.add_string buf " <div class=\"sc-code-body\">\n";
1776
+
(* Initial code from first step *)
1777
+
(match steps with
1778
+
| first :: _ -> Buffer.add_string buf (generate_code_lines first.code first.focus)
1779
+
| [] -> ());
1780
+
Buffer.add_string buf " </div>\n";
1781
+
Buffer.add_string buf " </div>\n";
1782
+
Buffer.add_string buf " </div>\n";
1783
+
1784
+
Buffer.add_string buf "</div>\n";
1785
+
Buffer.add_string buf "</div>\n";
1786
+
1787
+
(* Mobile stacked layout *)
1788
+
Buffer.add_string buf (generate_mobile_html steps);
1789
+
1790
+
(* Playground overlay *)
1791
+
Buffer.add_string buf {|<div id="sc-playground-overlay" class="sc-playground-overlay">
1792
+
<div class="sc-playground-container">
1793
+
<div class="sc-playground-header">
1794
+
<span class="sc-playground-title">Playground</span>
1795
+
<button class="sc-playground-close">×</button>
1796
+
</div>
1797
+
<div class="sc-playground-editor">
1798
+
<x-ocaml id="sc-playground-x-ocaml" run-on="click"></x-ocaml>
1799
+
</div>
1800
+
</div>
1801
+
</div>
1802
+
|};
1803
+
1804
+
(* JavaScript *)
1805
+
Buffer.add_string buf "<script>\n";
1806
+
Buffer.add_string buf shared_js;
1807
+
Buffer.add_string buf "</script>\n";
1808
+
1809
+
(* x-ocaml for playground *)
1810
+
Buffer.add_string buf {|<script src="/_x-ocaml/x-ocaml.js" src-worker="/_x-ocaml/worker.js" backend="jtw"></script>
1811
+
|};
1812
+
1813
+
Buffer.contents buf
1814
+
1815
+
(** {1 Extension Registration} *)
1816
+
1817
+
module Scrolly : Odoc_extension_api.Extension = struct
1818
+
let prefix = "scrolly"
1819
+
1820
+
let to_document ~tag content =
1821
+
(* Extract theme from tag: scrolly.warm, scrolly.dark, scrolly.notebook *)
1822
+
let theme =
1823
+
match String.index_opt tag '.' with
1824
+
| None -> "warm"
1825
+
| Some i -> String.sub tag (i + 1) (String.length tag - i - 1)
1826
+
in
1827
+
let tutorial_title, steps = extract_steps content in
1828
+
let filename =
1829
+
match theme with
1830
+
| "dark" -> "main.ml"
1831
+
| "notebook" -> "test.ml"
1832
+
| _ -> "parser.ml"
1833
+
in
1834
+
let html = generate_html ~theme ~title:tutorial_title ~filename steps in
1835
+
let block : Block.t =
1836
+
[
1837
+
{
1838
+
Odoc_document.Types.Block.attr = [ "scrollycode" ];
1839
+
desc = Raw_markup ("html", html);
1840
+
};
1841
+
]
1842
+
in
1843
+
{ Odoc_extension_api.content = block; overrides = []; resources = []; assets = [] }
1844
+
end
1845
+
1846
+
let () = Odoc_extension_api.Registry.register (module Scrolly)
+412
odoc-scrollycode-extension/test/dark_repl.mld
+412
odoc-scrollycode-extension/test/dark_repl.mld
···
1
+
{0 Building a REPL}
2
+
3
+
@scrolly.dark Building a REPL in OCaml
4
+
{ol
5
+
{li
6
+
{b The Expression Type}
7
+
8
+
A REPL evaluates expressions. We start with a tiny language:
9
+
integer literals, addition, let-bindings, and variables.
10
+
Four constructors is all we need.
11
+
12
+
{[
13
+
type expr =
14
+
| Lit of int
15
+
| Add of expr * expr
16
+
| Let of string * expr * expr
17
+
| Var of string
18
+
]}
19
+
}
20
+
{li
21
+
{b Values and Environments}
22
+
23
+
Evaluation produces values. For now, just integers. An
24
+
environment maps variable names to their values using a
25
+
simple association list.
26
+
27
+
{[
28
+
type expr =
29
+
| Lit of int
30
+
| Add of expr * expr
31
+
| Let of string * expr * expr
32
+
| Var of string
33
+
34
+
type value = Int of int
35
+
36
+
type env = (string * value) list
37
+
38
+
let empty_env : env = []
39
+
40
+
let extend env name v = (name, v) :: env
41
+
42
+
let lookup env name =
43
+
match List.assoc_opt name env with
44
+
| Some v -> v
45
+
| None -> failwith ("unbound: " ^ name)
46
+
]}
47
+
}
48
+
{li
49
+
{b The Evaluator}
50
+
51
+
Pattern matching makes the evaluator beautifully direct.
52
+
Each expression form maps to a straightforward computation.
53
+
Let-bindings extend the environment for the body expression.
54
+
55
+
{[
56
+
type expr =
57
+
| Lit of int
58
+
| Add of expr * expr
59
+
| Let of string * expr * expr
60
+
| Var of string
61
+
62
+
type value = Int of int
63
+
64
+
type env = (string * value) list
65
+
66
+
let empty_env : env = []
67
+
68
+
let extend env name v = (name, v) :: env
69
+
70
+
let lookup env name =
71
+
match List.assoc_opt name env with
72
+
| Some v -> v
73
+
| None -> failwith ("unbound: " ^ name)
74
+
75
+
let rec eval env = function
76
+
| Lit n -> Int n
77
+
| Add (a, b) ->
78
+
let (Int x) = eval env a in
79
+
let (Int y) = eval env b in
80
+
Int (x + y)
81
+
| Let (name, rhs, body) ->
82
+
let v = eval env rhs in
83
+
eval (extend env name v) body
84
+
| Var name -> lookup env name
85
+
]}
86
+
}
87
+
{li
88
+
{b A Tiny Tokenizer}
89
+
90
+
To read user input, we need a tokenizer. It splits a string
91
+
into meaningful chunks: numbers, identifiers, operators, and
92
+
parentheses. Whitespace is consumed but not produced.
93
+
94
+
{[
95
+
type expr =
96
+
| Lit of int
97
+
| Add of expr * expr
98
+
| Let of string * expr * expr
99
+
| Var of string
100
+
101
+
type value = Int of int
102
+
type env = (string * value) list
103
+
let empty_env : env = []
104
+
let extend env name v = (name, v) :: env
105
+
let lookup env name =
106
+
match List.assoc_opt name env with
107
+
| Some v -> v
108
+
| None -> failwith ("unbound: " ^ name)
109
+
110
+
let rec eval env = function
111
+
| Lit n -> Int n
112
+
| Add (a, b) ->
113
+
let (Int x) = eval env a in
114
+
let (Int y) = eval env b in
115
+
Int (x + y)
116
+
| Let (name, rhs, body) ->
117
+
let v = eval env rhs in
118
+
eval (extend env name v) body
119
+
| Var name -> lookup env name
120
+
121
+
type token =
122
+
| TNum of int
123
+
| TIdent of string
124
+
| TPlus | TEqual
125
+
| TLParen | TRParen
126
+
| TLet | TIn
127
+
128
+
let is_alpha c =
129
+
(c >= 'a' && c <= 'z')
130
+
|| (c >= 'A' && c <= 'Z')
131
+
|| c = '_'
132
+
133
+
let is_digit c = c >= '0' && c <= '9'
134
+
135
+
let tokenize input =
136
+
let len = String.length input in
137
+
let pos = ref 0 in
138
+
let tokens = ref [] in
139
+
while !pos < len do
140
+
let c = input.[!pos] in
141
+
if c = ' ' || c = '\t' || c = '\n' then
142
+
incr pos
143
+
else if is_digit c then begin
144
+
let start = !pos in
145
+
while !pos < len && is_digit input.[!pos] do
146
+
incr pos done;
147
+
let s = String.sub input start (!pos - start) in
148
+
tokens := TNum (int_of_string s) :: !tokens
149
+
end else if is_alpha c then begin
150
+
let start = !pos in
151
+
while !pos < len && is_alpha input.[!pos] do
152
+
incr pos done;
153
+
let s = String.sub input start (!pos - start) in
154
+
let tok = match s with
155
+
| "let" -> TLet | "in" -> TIn
156
+
| _ -> TIdent s in
157
+
tokens := tok :: !tokens
158
+
end else begin
159
+
let tok = match c with
160
+
| '+' -> TPlus | '=' -> TEqual
161
+
| '(' -> TLParen | ')' -> TRParen
162
+
| _ -> failwith "unexpected char" in
163
+
tokens := tok :: !tokens;
164
+
incr pos
165
+
end
166
+
done;
167
+
List.rev !tokens
168
+
]}
169
+
}
170
+
{li
171
+
{b The Parser}
172
+
173
+
A recursive descent parser turns tokens into our expression AST.
174
+
It handles operator precedence naturally: addition is parsed as
175
+
a left-associative chain of atoms.
176
+
177
+
{[
178
+
type expr =
179
+
| Lit of int
180
+
| Add of expr * expr
181
+
| Let of string * expr * expr
182
+
| Var of string
183
+
184
+
type value = Int of int
185
+
type env = (string * value) list
186
+
let empty_env : env = []
187
+
let extend env name v = (name, v) :: env
188
+
let lookup env name =
189
+
match List.assoc_opt name env with
190
+
| Some v -> v
191
+
| None -> failwith ("unbound: " ^ name)
192
+
193
+
let rec eval env = function
194
+
| Lit n -> Int n
195
+
| Add (a, b) ->
196
+
let (Int x) = eval env a in
197
+
let (Int y) = eval env b in
198
+
Int (x + y)
199
+
| Let (name, rhs, body) ->
200
+
let v = eval env rhs in
201
+
eval (extend env name v) body
202
+
| Var name -> lookup env name
203
+
204
+
type token =
205
+
| TNum of int | TIdent of string
206
+
| TPlus | TEqual
207
+
| TLParen | TRParen
208
+
| TLet | TIn
209
+
210
+
let is_alpha c =
211
+
(c >= 'a' && c <= 'z')
212
+
|| (c >= 'A' && c <= 'Z') || c = '_'
213
+
let is_digit c = c >= '0' && c <= '9'
214
+
215
+
let tokenize input =
216
+
let len = String.length input in
217
+
let pos = ref 0 in
218
+
let tokens = ref [] in
219
+
while !pos < len do
220
+
let c = input.[!pos] in
221
+
if c = ' ' || c = '\t' || c = '\n' then
222
+
incr pos
223
+
else if is_digit c then begin
224
+
let start = !pos in
225
+
while !pos < len && is_digit input.[!pos]
226
+
do incr pos done;
227
+
let s = String.sub input start
228
+
(!pos - start) in
229
+
tokens := TNum (int_of_string s) :: !tokens
230
+
end else if is_alpha c then begin
231
+
let start = !pos in
232
+
while !pos < len && is_alpha input.[!pos]
233
+
do incr pos done;
234
+
let s = String.sub input start
235
+
(!pos - start) in
236
+
let tok = match s with
237
+
| "let" -> TLet | "in" -> TIn
238
+
| _ -> TIdent s in
239
+
tokens := tok :: !tokens
240
+
end else begin
241
+
let tok = match c with
242
+
| '+' -> TPlus | '=' -> TEqual
243
+
| '(' -> TLParen | ')' -> TRParen
244
+
| _ -> failwith "unexpected char" in
245
+
tokens := tok :: !tokens; incr pos
246
+
end
247
+
done;
248
+
List.rev !tokens
249
+
250
+
let parse tokens =
251
+
let toks = ref tokens in
252
+
let next () =
253
+
match !toks with
254
+
| [] -> failwith "unexpected end"
255
+
| t :: rest -> toks := rest; t in
256
+
let peek () =
257
+
match !toks with [] -> None | t :: _ -> Some t in
258
+
let rec parse_expr () =
259
+
let left = parse_atom () in
260
+
parse_add left
261
+
and parse_add left =
262
+
match peek () with
263
+
| Some TPlus ->
264
+
ignore (next ());
265
+
let right = parse_atom () in
266
+
parse_add (Add (left, right))
267
+
| _ -> left
268
+
and parse_atom () =
269
+
match next () with
270
+
| TNum n -> Lit n
271
+
| TIdent s -> Var s
272
+
| TLParen ->
273
+
let e = parse_expr () in
274
+
ignore (next ()); e
275
+
| TLet ->
276
+
let (TIdent name) = next () in
277
+
ignore (next ());
278
+
let rhs = parse_expr () in
279
+
ignore (next ());
280
+
let body = parse_expr () in
281
+
Let (name, rhs, body)
282
+
| _ -> failwith "unexpected token" in
283
+
parse_expr ()
284
+
]}
285
+
}
286
+
{li
287
+
{b The Read-Eval-Print Loop}
288
+
289
+
Now we connect all the pieces. The REPL reads a line,
290
+
tokenizes it, parses the tokens, evaluates the expression,
291
+
and prints the result. A persistent environment accumulates
292
+
bindings across interactions.
293
+
294
+
{[
295
+
type expr =
296
+
| Lit of int
297
+
| Add of expr * expr
298
+
| Let of string * expr * expr
299
+
| Var of string
300
+
301
+
type value = Int of int
302
+
type env = (string * value) list
303
+
let empty_env : env = []
304
+
let extend env name v = (name, v) :: env
305
+
let lookup env name =
306
+
match List.assoc_opt name env with
307
+
| Some v -> v
308
+
| None -> failwith ("unbound: " ^ name)
309
+
310
+
let rec eval env = function
311
+
| Lit n -> Int n
312
+
| Add (a, b) ->
313
+
let (Int x) = eval env a in
314
+
let (Int y) = eval env b in
315
+
Int (x + y)
316
+
| Let (name, rhs, body) ->
317
+
let v = eval env rhs in
318
+
eval (extend env name v) body
319
+
| Var name -> lookup env name
320
+
321
+
type token =
322
+
| TNum of int | TIdent of string
323
+
| TPlus | TEqual
324
+
| TLParen | TRParen
325
+
| TLet | TIn
326
+
327
+
let is_alpha c =
328
+
(c >= 'a' && c <= 'z')
329
+
|| (c >= 'A' && c <= 'Z') || c = '_'
330
+
let is_digit c = c >= '0' && c <= '9'
331
+
332
+
let tokenize input =
333
+
let len = String.length input in
334
+
let pos = ref 0 in
335
+
let tokens = ref [] in
336
+
while !pos < len do
337
+
let c = input.[!pos] in
338
+
if c = ' ' || c = '\t' || c = '\n' then
339
+
incr pos
340
+
else if is_digit c then begin
341
+
let start = !pos in
342
+
while !pos < len && is_digit input.[!pos]
343
+
do incr pos done;
344
+
tokens := TNum (int_of_string
345
+
(String.sub input start
346
+
(!pos - start))) :: !tokens
347
+
end else if is_alpha c then begin
348
+
let start = !pos in
349
+
while !pos < len && is_alpha input.[!pos]
350
+
do incr pos done;
351
+
let s = String.sub input start
352
+
(!pos - start) in
353
+
tokens := (match s with
354
+
| "let" -> TLet | "in" -> TIn
355
+
| _ -> TIdent s) :: !tokens
356
+
end else begin
357
+
tokens := (match c with
358
+
| '+' -> TPlus | '=' -> TEqual
359
+
| '(' -> TLParen | ')' -> TRParen
360
+
| _ -> failwith "unexpected") :: !tokens;
361
+
incr pos
362
+
end
363
+
done; List.rev !tokens
364
+
365
+
let parse tokens =
366
+
let toks = ref tokens in
367
+
let next () = match !toks with
368
+
| [] -> failwith "end"
369
+
| t :: r -> toks := r; t in
370
+
let peek () = match !toks with
371
+
| [] -> None | t :: _ -> Some t in
372
+
let rec expr () =
373
+
let l = atom () in add l
374
+
and add left = match peek () with
375
+
| Some TPlus ->
376
+
ignore (next ());
377
+
add (Add (left, atom ()))
378
+
| _ -> left
379
+
and atom () = match next () with
380
+
| TNum n -> Lit n
381
+
| TIdent s -> Var s
382
+
| TLParen ->
383
+
let e = expr () in
384
+
ignore (next ()); e
385
+
| TLet ->
386
+
let (TIdent name) = next () in
387
+
ignore (next ());
388
+
let rhs = expr () in
389
+
ignore (next ());
390
+
Let (name, rhs, expr ())
391
+
| _ -> failwith "unexpected" in
392
+
expr ()
393
+
394
+
let print_value = function
395
+
| Int n -> Printf.printf "=> %d\n" n
396
+
397
+
let repl () =
398
+
let env = ref empty_env in
399
+
try while true do
400
+
print_string "> ";
401
+
let line = input_line stdin in
402
+
let tokens = tokenize line in
403
+
let ast = parse tokens in
404
+
let result = eval !env ast in
405
+
print_value result
406
+
done with End_of_file ->
407
+
print_endline "Goodbye."
408
+
409
+
let () = repl ()
410
+
]}
411
+
}
412
+
}
+8
odoc-scrollycode-extension/test/dune
+8
odoc-scrollycode-extension/test/dune
+198
odoc-scrollycode-extension/test/index.mld
+198
odoc-scrollycode-extension/test/index.mld
···
1
+
{0 Scrollycode Demos}
2
+
3
+
{%html:
4
+
<link rel="preconnect" href="https://fonts.googleapis.com">
5
+
<link rel="preconnect" href="https://fonts.gstatic.com" crossorigin>
6
+
<link href="https://fonts.googleapis.com/css2?family=Fraunces:ital,opsz,wght@0,9..144,300..900;1,9..144,300..900&family=Source+Code+Pro:ital,wght@0,300..900;1,300..900&family=Source+Serif+4:ital,opsz,wght@0,8..60,300..900;1,8..60,300..900&display=swap" rel="stylesheet">
7
+
<style>
8
+
.odoc-nav, .odoc-tocs, .odoc-search { display: none !important; }
9
+
.odoc-preamble > h1 { display: none !important; }
10
+
.odoc-preamble, .odoc-content { max-width: none !important; padding: 0 !important; margin: 0 !important; }
11
+
body.odoc, .odoc { padding: 0 !important; margin: 0 !important; max-width: none !important; }
12
+
13
+
.demos-index {
14
+
font-family: 'Source Serif 4', Georgia, serif;
15
+
background: #f4f0e8;
16
+
min-height: 100vh;
17
+
}
18
+
19
+
.demos-header {
20
+
max-width: 680px;
21
+
margin: 0 auto;
22
+
padding: 6rem 2rem 3rem;
23
+
text-align: center;
24
+
}
25
+
26
+
.demos-header h1 {
27
+
font-family: 'Fraunces', serif;
28
+
font-size: clamp(2rem, 5vw, 3.2rem);
29
+
font-weight: 800;
30
+
line-height: 1.15;
31
+
letter-spacing: -0.02em;
32
+
margin-bottom: 1rem;
33
+
color: #2c2416;
34
+
}
35
+
36
+
.demos-header h1 em {
37
+
font-style: italic;
38
+
color: #c25832;
39
+
}
40
+
41
+
.demos-header p {
42
+
color: #6b5d4d;
43
+
max-width: 50ch;
44
+
margin: 0 auto;
45
+
font-size: 1.05rem;
46
+
line-height: 1.6;
47
+
}
48
+
49
+
.demos-list {
50
+
max-width: 720px;
51
+
margin: 0 auto;
52
+
padding: 1rem 2rem 6rem;
53
+
display: flex;
54
+
flex-direction: column;
55
+
gap: 1.25rem;
56
+
}
57
+
58
+
.demo-card {
59
+
display: block;
60
+
background: #fff;
61
+
border: 1px solid rgba(44,36,22,0.08);
62
+
border-radius: 10px;
63
+
padding: 1.5rem 1.75rem;
64
+
text-decoration: none;
65
+
color: inherit;
66
+
transition: border-color 0.2s ease, box-shadow 0.2s ease, transform 0.15s ease;
67
+
}
68
+
69
+
.demo-card:hover {
70
+
border-color: #c25832;
71
+
box-shadow: 0 4px 20px rgba(194,88,50,0.1);
72
+
transform: translateY(-2px);
73
+
}
74
+
75
+
.demo-card-header {
76
+
display: flex;
77
+
align-items: baseline;
78
+
gap: 0.75rem;
79
+
margin-bottom: 0.5rem;
80
+
}
81
+
82
+
.demo-card-number {
83
+
font-family: 'Source Code Pro', monospace;
84
+
font-size: 0.68rem;
85
+
font-weight: 600;
86
+
letter-spacing: 0.08em;
87
+
color: #c25832;
88
+
flex-shrink: 0;
89
+
}
90
+
91
+
.demo-card h2 {
92
+
font-family: 'Fraunces', serif;
93
+
font-size: 1.2rem;
94
+
font-weight: 700;
95
+
letter-spacing: -0.01em;
96
+
margin: 0;
97
+
}
98
+
99
+
.demo-card p {
100
+
color: #6b5d4d;
101
+
font-size: 0.92rem;
102
+
line-height: 1.6;
103
+
margin: 0.5rem 0;
104
+
}
105
+
106
+
.demo-card .tags {
107
+
display: flex;
108
+
flex-wrap: wrap;
109
+
gap: 0.4rem;
110
+
margin-top: 0.75rem;
111
+
}
112
+
113
+
.tag {
114
+
font-family: 'Source Code Pro', monospace;
115
+
font-size: 0.65rem;
116
+
letter-spacing: 0.04em;
117
+
padding: 0.2em 0.6em;
118
+
border-radius: 4px;
119
+
background: rgba(194,88,50,0.07);
120
+
color: #c25832;
121
+
}
122
+
123
+
.tag.dark {
124
+
background: #1a1a2e;
125
+
color: rgba(255,255,255,0.5);
126
+
}
127
+
128
+
.demos-footer {
129
+
text-align: center;
130
+
padding: 0 2rem 4rem;
131
+
font-family: 'Source Code Pro', monospace;
132
+
font-size: 0.72rem;
133
+
color: #6b5d4d;
134
+
letter-spacing: 0.04em;
135
+
}
136
+
137
+
.demos-footer a {
138
+
color: #c25832;
139
+
text-decoration: none;
140
+
}
141
+
</style>
142
+
143
+
<div class="demos-index">
144
+
145
+
<div class="demos-header">
146
+
<h1>Scrollycoding in <em>OCaml</em></h1>
147
+
<p>Three odoc extension plugins, each rendering the same scrollycode pattern with a radically different visual theme. Authored as <code>.mld</code> files using <code>@scrolly.<theme></code> custom tags.</p>
148
+
</div>
149
+
150
+
<div class="demos-list">
151
+
152
+
<a class="demo-card" href="warm_parser.html">
153
+
<div class="demo-card-header">
154
+
<span class="demo-card-number">01</span>
155
+
<h2>The Warm Workshop</h2>
156
+
</div>
157
+
<p>Building a JSON parser step by step. Warm cream background with a dark navy code panel, Fraunces serif display type, and earthy burnt-sienna accents. Classic scrollycode split layout.</p>
158
+
<div class="tags">
159
+
<span class="tag">@scrolly.warm</span>
160
+
<span class="tag">Fraunces + Source Serif</span>
161
+
<span class="tag">parser tutorial</span>
162
+
</div>
163
+
</a>
164
+
165
+
<a class="demo-card" href="dark_repl.html">
166
+
<div class="demo-card-header">
167
+
<span class="demo-card-number">02</span>
168
+
<h2>The Dark Terminal</h2>
169
+
</div>
170
+
<p>Building a REPL from scratch. Near-black cinematic theme with phosphor-green accents, JetBrains Mono code font, and the code panel as the visual hero. Prose in a narrow left column.</p>
171
+
<div class="tags">
172
+
<span class="tag dark">@scrolly.dark</span>
173
+
<span class="tag">JetBrains Mono + Outfit</span>
174
+
<span class="tag">REPL tutorial</span>
175
+
</div>
176
+
</a>
177
+
178
+
<a class="demo-card" href="notebook_testing.html">
179
+
<div class="demo-card-header">
180
+
<span class="demo-card-number">03</span>
181
+
<h2>The Notebook</h2>
182
+
</div>
183
+
<p>Building a test framework incrementally. Clean editorial aesthetic with a soft white background, blue-violet accents, Newsreader serif headings, and generous whitespace.</p>
184
+
<div class="tags">
185
+
<span class="tag">@scrolly.notebook</span>
186
+
<span class="tag">Newsreader + DM Sans</span>
187
+
<span class="tag">testing tutorial</span>
188
+
</div>
189
+
</a>
190
+
191
+
</div>
192
+
193
+
<div class="demos-footer">
194
+
Powered by <a href="https://ocaml.github.io/odoc/">odoc</a> custom tag extensions · Inspired by <a href="https://codehike.org">Code Hike</a>
195
+
</div>
196
+
197
+
</div>
198
+
%}
+403
odoc-scrollycode-extension/test/notebook_testing.mld
+403
odoc-scrollycode-extension/test/notebook_testing.mld
···
1
+
{0 Building a Test Framework}
2
+
3
+
@scrolly.notebook Building a Test Framework in OCaml
4
+
{ol
5
+
{li
6
+
{b A Single Assertion}
7
+
8
+
The simplest possible test: check that a condition holds.
9
+
If it fails, raise an exception with a message. This is
10
+
the foundation everything else builds on.
11
+
12
+
{[
13
+
exception Test_failure of string
14
+
15
+
let assert_equal ~expected ~actual msg =
16
+
if expected <> actual then
17
+
raise (Test_failure
18
+
(Printf.sprintf "%s: expected %s, got %s"
19
+
msg
20
+
(string_of_int expected)
21
+
(string_of_int actual)))
22
+
]}
23
+
}
24
+
{li
25
+
{b Collecting Tests}
26
+
27
+
A test is a named function. We store tests in a mutable list
28
+
so they can be registered declaratively with a simple helper.
29
+
Each test is just a unit function that might raise.
30
+
31
+
{[
32
+
exception Test_failure of string
33
+
34
+
let assert_equal ~expected ~actual msg =
35
+
if expected <> actual then
36
+
raise (Test_failure
37
+
(Printf.sprintf "%s: expected %s, got %s"
38
+
msg
39
+
(string_of_int expected)
40
+
(string_of_int actual)))
41
+
42
+
type test = {
43
+
name : string;
44
+
fn : unit -> unit;
45
+
}
46
+
47
+
let tests : test list ref = ref []
48
+
49
+
let register name fn =
50
+
tests := { name; fn } :: !tests
51
+
52
+
let () = register "addition" (fun () ->
53
+
assert_equal ~expected:4 ~actual:(2 + 2)
54
+
"two plus two")
55
+
56
+
let () = register "multiplication" (fun () ->
57
+
assert_equal ~expected:6 ~actual:(2 * 3)
58
+
"two times three")
59
+
]}
60
+
}
61
+
{li
62
+
{b A Test Runner}
63
+
64
+
The runner iterates through registered tests, catching
65
+
exceptions to report pass or fail. It counts results
66
+
and prints a summary at the end.
67
+
68
+
{[
69
+
exception Test_failure of string
70
+
71
+
let assert_equal ~expected ~actual msg =
72
+
if expected <> actual then
73
+
raise (Test_failure
74
+
(Printf.sprintf "%s: expected %s, got %s"
75
+
msg
76
+
(string_of_int expected)
77
+
(string_of_int actual)))
78
+
79
+
type test = {
80
+
name : string;
81
+
fn : unit -> unit;
82
+
}
83
+
84
+
let tests : test list ref = ref []
85
+
86
+
let register name fn =
87
+
tests := { name; fn } :: !tests
88
+
89
+
type result =
90
+
| Pass
91
+
| Fail of string
92
+
93
+
let run_one test =
94
+
try test.fn (); Pass
95
+
with
96
+
| Test_failure msg -> Fail msg
97
+
| exn -> Fail (Printexc.to_string exn)
98
+
99
+
let run_all () =
100
+
let results =
101
+
List.rev !tests
102
+
|> List.map (fun t -> (t.name, run_one t))
103
+
in
104
+
let passed =
105
+
List.length
106
+
(List.filter
107
+
(fun (_, r) -> r = Pass) results)
108
+
in
109
+
let total = List.length results in
110
+
List.iter (fun (name, result) ->
111
+
match result with
112
+
| Pass ->
113
+
Printf.printf " PASS %s\n" name
114
+
| Fail msg ->
115
+
Printf.printf " FAIL %s: %s\n" name msg
116
+
) results;
117
+
Printf.printf "\n%d/%d tests passed\n"
118
+
passed total;
119
+
if passed < total then exit 1
120
+
]}
121
+
}
122
+
{li
123
+
{b Better Assertions}
124
+
125
+
Real frameworks need more than integer equality. We add
126
+
string comparison, boolean checks, and a generic raises
127
+
assertion that checks an exception is thrown.
128
+
129
+
{[
130
+
exception Test_failure of string
131
+
132
+
let assert_equal ~expected ~actual msg =
133
+
if expected <> actual then
134
+
raise (Test_failure
135
+
(Printf.sprintf "%s: expected %s, got %s"
136
+
msg
137
+
(string_of_int expected)
138
+
(string_of_int actual)))
139
+
140
+
let assert_string_equal ~expected ~actual msg =
141
+
if expected <> actual then
142
+
raise (Test_failure
143
+
(Printf.sprintf
144
+
"%s: expected %S, got %S"
145
+
msg expected actual))
146
+
147
+
let assert_true condition msg =
148
+
if not condition then
149
+
raise (Test_failure msg)
150
+
151
+
let assert_raises fn msg =
152
+
try fn ();
153
+
raise (Test_failure
154
+
(msg ^ ": expected exception"))
155
+
with
156
+
| Test_failure _ as e -> raise e
157
+
| _ -> ()
158
+
159
+
type test = {
160
+
name : string;
161
+
fn : unit -> unit;
162
+
}
163
+
164
+
let tests : test list ref = ref []
165
+
166
+
let register name fn =
167
+
tests := { name; fn } :: !tests
168
+
169
+
type result = Pass | Fail of string
170
+
171
+
let run_one test =
172
+
try test.fn (); Pass
173
+
with
174
+
| Test_failure msg -> Fail msg
175
+
| exn -> Fail (Printexc.to_string exn)
176
+
177
+
let run_all () =
178
+
let results =
179
+
List.rev !tests
180
+
|> List.map (fun t -> (t.name, run_one t))
181
+
in
182
+
let passed = List.length
183
+
(List.filter
184
+
(fun (_, r) -> r = Pass) results) in
185
+
let total = List.length results in
186
+
List.iter (fun (name, result) ->
187
+
match result with
188
+
| Pass ->
189
+
Printf.printf " PASS %s\n" name
190
+
| Fail msg ->
191
+
Printf.printf " FAIL %s: %s\n"
192
+
name msg
193
+
) results;
194
+
Printf.printf "\n%d/%d tests passed\n"
195
+
passed total;
196
+
if passed < total then exit 1
197
+
]}
198
+
}
199
+
{li
200
+
{b Test Suites}
201
+
202
+
As projects grow, tests need organization. We add a suite
203
+
concept that groups related tests under a name. Suites
204
+
can be nested and run independently.
205
+
206
+
{[
207
+
exception Test_failure of string
208
+
209
+
let assert_equal ~expected ~actual msg =
210
+
if expected <> actual then
211
+
raise (Test_failure
212
+
(Printf.sprintf "%s: expected %s, got %s"
213
+
msg
214
+
(string_of_int expected)
215
+
(string_of_int actual)))
216
+
217
+
let assert_string_equal ~expected ~actual msg =
218
+
if expected <> actual then
219
+
raise (Test_failure
220
+
(Printf.sprintf "%s: expected %S, got %S"
221
+
msg expected actual))
222
+
223
+
let assert_true condition msg =
224
+
if not condition then
225
+
raise (Test_failure msg)
226
+
227
+
let assert_raises fn msg =
228
+
try fn ();
229
+
raise (Test_failure
230
+
(msg ^ ": expected exception"))
231
+
with Test_failure _ as e -> raise e | _ -> ()
232
+
233
+
type test = { name : string; fn : unit -> unit }
234
+
type result = Pass | Fail of string
235
+
236
+
type suite = {
237
+
suite_name : string;
238
+
mutable suite_tests : test list;
239
+
}
240
+
241
+
let suites : suite list ref = ref []
242
+
243
+
let create_suite name =
244
+
let s = { suite_name = name;
245
+
suite_tests = [] } in
246
+
suites := s :: !suites; s
247
+
248
+
let add_test suite name fn =
249
+
suite.suite_tests <-
250
+
{ name; fn } :: suite.suite_tests
251
+
252
+
let run_one test =
253
+
try test.fn (); Pass
254
+
with
255
+
| Test_failure msg -> Fail msg
256
+
| exn -> Fail (Printexc.to_string exn)
257
+
258
+
let run_suite suite =
259
+
Printf.printf "Suite: %s\n" suite.suite_name;
260
+
let results =
261
+
List.rev suite.suite_tests
262
+
|> List.map (fun t ->
263
+
(t.name, run_one t)) in
264
+
let passed = List.length
265
+
(List.filter
266
+
(fun (_, r) -> r = Pass) results) in
267
+
let total = List.length results in
268
+
List.iter (fun (name, result) ->
269
+
match result with
270
+
| Pass ->
271
+
Printf.printf " PASS %s\n" name
272
+
| Fail msg ->
273
+
Printf.printf " FAIL %s: %s\n"
274
+
name msg
275
+
) results;
276
+
Printf.printf " %d/%d passed\n\n"
277
+
passed total;
278
+
passed = total
279
+
280
+
let run_all_suites () =
281
+
let all_ok = List.for_all run_suite
282
+
(List.rev !suites) in
283
+
if not all_ok then exit 1
284
+
]}
285
+
}
286
+
{li
287
+
{b Expect Tests}
288
+
289
+
The crown jewel: expect tests capture actual output and
290
+
compare it to an expected snapshot. On first run, they
291
+
record the output. On later runs, they detect regressions.
292
+
This is how tools like ppx_expect and Cram tests work.
293
+
294
+
{[
295
+
exception Test_failure of string
296
+
297
+
let assert_equal ~expected ~actual msg =
298
+
if expected <> actual then
299
+
raise (Test_failure
300
+
(Printf.sprintf "%s: expected %s, got %s"
301
+
msg
302
+
(string_of_int expected)
303
+
(string_of_int actual)))
304
+
305
+
let assert_string_equal ~expected ~actual msg =
306
+
if expected <> actual then
307
+
raise (Test_failure
308
+
(Printf.sprintf "%s: expected %S, got %S"
309
+
msg expected actual))
310
+
311
+
let assert_true condition msg =
312
+
if not condition then
313
+
raise (Test_failure msg)
314
+
315
+
let assert_raises fn msg =
316
+
try fn ();
317
+
raise (Test_failure
318
+
(msg ^ ": expected exception"))
319
+
with Test_failure _ as e -> raise e | _ -> ()
320
+
321
+
type test = { name : string; fn : unit -> unit }
322
+
type result = Pass | Fail of string
323
+
324
+
type suite = {
325
+
suite_name : string;
326
+
mutable suite_tests : test list;
327
+
}
328
+
329
+
let suites : suite list ref = ref []
330
+
331
+
let create_suite name =
332
+
let s = { suite_name = name;
333
+
suite_tests = [] } in
334
+
suites := s :: !suites; s
335
+
336
+
let add_test suite name fn =
337
+
suite.suite_tests <-
338
+
{ name; fn } :: suite.suite_tests
339
+
340
+
let run_one test =
341
+
try test.fn (); Pass
342
+
with
343
+
| Test_failure msg -> Fail msg
344
+
| exn -> Fail (Printexc.to_string exn)
345
+
346
+
(* Expect test infrastructure *)
347
+
let expect_dir = "_expect"
348
+
349
+
let expect_test suite name fn =
350
+
add_test suite name (fun () ->
351
+
let buf = Buffer.create 256 in
352
+
fn (Buffer.add_string buf);
353
+
let actual = Buffer.contents buf in
354
+
let path = Printf.sprintf "%s/%s/%s.expected"
355
+
expect_dir suite.suite_name name in
356
+
if Sys.file_exists path then begin
357
+
let ic = open_in path in
358
+
let expected = really_input_string ic
359
+
(in_channel_length ic) in
360
+
close_in ic;
361
+
assert_string_equal
362
+
~expected ~actual
363
+
(name ^ " snapshot")
364
+
end else begin
365
+
let dir = Filename.dirname path in
366
+
ignore (Sys.command
367
+
("mkdir -p " ^ dir));
368
+
let oc = open_out path in
369
+
output_string oc actual;
370
+
close_out oc;
371
+
Printf.printf
372
+
" NEW %s (snapshot saved)\n" name
373
+
end)
374
+
375
+
let run_suite suite =
376
+
Printf.printf "Suite: %s\n" suite.suite_name;
377
+
let results =
378
+
List.rev suite.suite_tests
379
+
|> List.map (fun t ->
380
+
(t.name, run_one t)) in
381
+
let passed = List.length
382
+
(List.filter
383
+
(fun (_, r) -> r = Pass) results) in
384
+
let total = List.length results in
385
+
List.iter (fun (name, result) ->
386
+
match result with
387
+
| Pass ->
388
+
Printf.printf " PASS %s\n" name
389
+
| Fail msg ->
390
+
Printf.printf " FAIL %s: %s\n"
391
+
name msg
392
+
) results;
393
+
Printf.printf " %d/%d passed\n\n"
394
+
passed total;
395
+
passed = total
396
+
397
+
let run_all_suites () =
398
+
let all_ok = List.for_all run_suite
399
+
(List.rev !suites) in
400
+
if not all_ok then exit 1
401
+
]}
402
+
}
403
+
}
+14
odoc-scrollycode-extension/test/odoc_scrolly.ml
+14
odoc-scrollycode-extension/test/odoc_scrolly.ml
···
1
+
(* Custom odoc binary with the scrollycode extension statically linked.
2
+
3
+
The scrollycode extension registers itself when this module is loaded,
4
+
via the [let () = ...] at the bottom of scrollycode_extension.ml.
5
+
6
+
We force it to be linked by referencing it, then invoke the standard
7
+
odoc CLI entry point. *)
8
+
9
+
(* Force-link the extension module *)
10
+
let () =
11
+
ignore (Scrollycode_extension.Scrolly.prefix : string)
12
+
13
+
(* Include the full odoc CLI - this is main.ml without the dune-site loading *)
14
+
include Odoc_scrolly_main
+1858
odoc-scrollycode-extension/test/odoc_scrolly_main.ml
+1858
odoc-scrollycode-extension/test/odoc_scrolly_main.ml
···
1
+
(* CR-someday trefis: the "deps" and "targets" subcommands currently output
2
+
their result on stdout.
3
+
It would make the interaction with jenga nicer if we could specify a file to
4
+
output the result to. *)
5
+
6
+
open Odoc_utils
7
+
open ResultMonad
8
+
module List = ListLabels
9
+
open Odoc_odoc
10
+
open Cmdliner
11
+
12
+
(* Load all installed extensions at startup *)
13
+
14
+
15
+
let convert_syntax : Odoc_document.Renderer.syntax Arg.conv =
16
+
let syntax_parser str =
17
+
match str with
18
+
| "ml" | "ocaml" -> Ok Odoc_document.Renderer.OCaml
19
+
| "re" | "reason" -> Ok Odoc_document.Renderer.Reason
20
+
| s -> Error (Printf.sprintf "Unknown syntax '%s'" s)
21
+
in
22
+
let syntax_printer fmt syntax =
23
+
Format.pp_print_string fmt (Odoc_document.Renderer.string_of_syntax syntax)
24
+
in
25
+
Arg.conv' (syntax_parser, syntax_printer)
26
+
27
+
let convert_directory ?(create = false) () : Fs.Directory.t Arg.conv =
28
+
let dir_parser, dir_printer =
29
+
(Arg.conv_parser Arg.string, Arg.conv_printer Arg.string)
30
+
in
31
+
let odoc_dir_parser str =
32
+
let () = if create then Fs.Directory.(mkdir_p (of_string str)) in
33
+
match dir_parser str with
34
+
| Ok res -> Ok (Fs.Directory.of_string res)
35
+
| Error (`Msg e) -> Error e
36
+
in
37
+
let odoc_dir_printer fmt dir = dir_printer fmt (Fs.Directory.to_string dir) in
38
+
Arg.conv' (odoc_dir_parser, odoc_dir_printer)
39
+
40
+
(** On top of the conversion 'file' that checks that the passed file exists. *)
41
+
let convert_fpath =
42
+
let parse inp =
43
+
match Arg.(conv_parser file) inp with
44
+
| Ok s -> Ok (Fs.File.of_string s)
45
+
| Error _ as e -> e
46
+
and print = Fpath.pp in
47
+
Arg.conv (parse, print)
48
+
49
+
let convert_named_root =
50
+
let parse inp =
51
+
match String.cuts inp ~sep:":" with
52
+
| [ s1; s2 ] -> Ok (s1, Fs.Directory.of_string s2)
53
+
| _ -> Error (`Msg "")
54
+
in
55
+
let print ppf (s, t) =
56
+
Format.fprintf ppf "%s:%s" s (Fs.Directory.to_string t)
57
+
in
58
+
Arg.conv (parse, print)
59
+
60
+
let handle_error = function
61
+
| Ok () -> ()
62
+
| Error (`Cli_error msg) ->
63
+
Printf.eprintf "%s\n%!" msg;
64
+
exit 2
65
+
| Error (`Msg msg) ->
66
+
Printf.eprintf "ERROR: %s\n%!" msg;
67
+
exit 1
68
+
69
+
module Antichain = struct
70
+
let absolute_normalization p =
71
+
let p =
72
+
if Fpath.is_rel p then Fpath.( // ) (Fpath.v (Sys.getcwd ())) p else p
73
+
in
74
+
Fpath.normalize p
75
+
76
+
(** Check that a list of directories form an antichain: they are all disjoints
77
+
*)
78
+
let check ~opt l =
79
+
let l =
80
+
List.map
81
+
~f:(fun p -> p |> Fs.Directory.to_fpath |> absolute_normalization)
82
+
l
83
+
in
84
+
let rec check = function
85
+
| [] -> true
86
+
| p1 :: rest ->
87
+
List.for_all
88
+
~f:(fun p2 ->
89
+
(not (Fpath.is_prefix p1 p2)) && not (Fpath.is_prefix p2 p1))
90
+
rest
91
+
&& check rest
92
+
in
93
+
if check l then Ok ()
94
+
else
95
+
let msg =
96
+
Format.sprintf "Paths given to all %s options must be disjoint" opt
97
+
in
98
+
Error (`Msg msg)
99
+
end
100
+
101
+
let docs = "ARGUMENTS"
102
+
103
+
let odoc_file_directories =
104
+
let doc =
105
+
"Where to look for required $(i,.odoc) files. Can be present several times."
106
+
in
107
+
Arg.(
108
+
value
109
+
& opt_all (convert_directory ()) []
110
+
& info ~docs ~docv:"DIR" ~doc [ "I" ])
111
+
112
+
let hidden =
113
+
let doc =
114
+
"Mark the unit as hidden. (Useful for files included in module packs)."
115
+
in
116
+
Arg.(value & flag & info ~docs ~doc [ "hidden" ])
117
+
118
+
let extra_suffix =
119
+
let doc =
120
+
"Extra suffix to append to generated filenames. This is intended for \
121
+
expect tests to use."
122
+
in
123
+
let default = None in
124
+
Arg.(
125
+
value
126
+
& opt (some string) default
127
+
& info ~docv:"SUFFIX" ~doc [ "extra-suffix" ])
128
+
129
+
let warnings_options =
130
+
let warn_error =
131
+
let doc = "Turn warnings into errors." in
132
+
let env =
133
+
Cmd.Env.info "ODOC_WARN_ERROR" ~doc:(doc ^ " See option $(opt).")
134
+
in
135
+
Arg.(value & flag & info ~docs ~doc ~env [ "warn-error" ])
136
+
in
137
+
let print_warnings =
138
+
let doc =
139
+
"Whether warnings should be printed to stderr. See the $(b,errors) \
140
+
command."
141
+
in
142
+
let env = Cmd.Env.info "ODOC_PRINT_WARNINGS" ~doc in
143
+
Arg.(value & opt bool true & info ~docs ~doc ~env [ "print-warnings" ])
144
+
in
145
+
let enable_missing_root_warning =
146
+
let doc =
147
+
"Produce a warning when a root is missing. This is usually a build \
148
+
system problem so is disabled for users by default."
149
+
in
150
+
let env = Cmd.Env.info "ODOC_ENABLE_MISSING_ROOT_WARNING" ~doc in
151
+
Arg.(value & flag & info ~docs ~doc ~env [ "enable-missing-root-warning" ])
152
+
in
153
+
let warnings_tag =
154
+
let doc =
155
+
"Warnings tag. This is useful when you want to declare that warnings \
156
+
that would be generated resolving the references defined in this unit \
157
+
should be ignored if they end up in expansions in other units. If this \
158
+
option is passed, link-time warnings will be suppressed unless the link \
159
+
command is passed the tag via the --warnings-tags parameter. A suitable \
160
+
tag would be the name of the package."
161
+
in
162
+
let env = Cmd.Env.info "ODOC_WARNINGS_TAG" ~doc in
163
+
Arg.(
164
+
value & opt (some string) None & info ~docs ~doc ~env [ "warnings-tag" ])
165
+
in
166
+
Term.(
167
+
const
168
+
(fun warn_error print_warnings enable_missing_root_warning warnings_tag ->
169
+
Odoc_model.Error.enable_missing_root_warning :=
170
+
enable_missing_root_warning;
171
+
{ Odoc_model.Error.warn_error; print_warnings; warnings_tag })
172
+
$ warn_error $ print_warnings $ enable_missing_root_warning $ warnings_tag)
173
+
174
+
let dst ?create () =
175
+
let doc = "Output directory where the HTML tree is expected to be saved." in
176
+
Arg.(
177
+
required
178
+
& opt (some (convert_directory ?create ())) None
179
+
& info ~docs ~docv:"DIR" ~doc [ "o"; "output-dir" ])
180
+
181
+
let open_modules =
182
+
let doc =
183
+
"Initially open module. Can be used more than once. Defaults to 'Stdlib'"
184
+
in
185
+
let default = [ "Stdlib" ] in
186
+
Arg.(value & opt_all string default & info ~docv:"MODULE" ~doc [ "open" ])
187
+
188
+
module Compile : sig
189
+
val output_file : dst:string option -> input:Fs.file -> Fs.file
190
+
191
+
val input : string Term.t
192
+
193
+
val dst : string option Term.t
194
+
195
+
val cmd : unit Term.t
196
+
197
+
val info : docs:string -> Cmd.info
198
+
end = struct
199
+
let has_page_prefix file =
200
+
file |> Fs.File.basename |> Fs.File.to_string
201
+
|> String.is_prefix ~affix:"page-"
202
+
203
+
let unique_id =
204
+
let doc = "For debugging use" in
205
+
Arg.(value & opt (some string) None & info ~doc ~docv:"ID" [ "unique-id" ])
206
+
207
+
let output_file ~dst ~input =
208
+
match dst with
209
+
| Some file ->
210
+
let output = Fs.File.of_string file in
211
+
if Fs.File.has_ext ".mld" input && not (has_page_prefix output) then (
212
+
Printf.eprintf
213
+
"ERROR: the name of the .odoc file produced from a .mld must start \
214
+
with 'page-'\n\
215
+
%!";
216
+
exit 1);
217
+
output
218
+
| None ->
219
+
let output =
220
+
if Fs.File.has_ext ".mld" input && not (has_page_prefix input) then
221
+
let directory = Fs.File.dirname input in
222
+
let name = Fs.File.basename input in
223
+
let name = "page-" ^ Fs.File.to_string name in
224
+
Fs.File.create ~directory ~name
225
+
else input
226
+
in
227
+
Fs.File.(set_ext ".odoc" output)
228
+
229
+
let compile hidden directories resolve_fwd_refs dst output_dir package_opt
230
+
parent_name_opt parent_id_opt open_modules children input warnings_options
231
+
unique_id short_title =
232
+
let _ =
233
+
match unique_id with
234
+
| Some id -> Odoc_model.Names.set_unique_ident id
235
+
| None -> ()
236
+
in
237
+
let resolver =
238
+
Resolver.create ~important_digests:(not resolve_fwd_refs) ~directories
239
+
~open_modules ~roots:None
240
+
in
241
+
let input = Fs.File.of_string input in
242
+
let output = output_file ~dst ~input in
243
+
let cli_spec =
244
+
let error message = Error (`Cli_error message) in
245
+
match
246
+
(parent_name_opt, package_opt, parent_id_opt, children, output_dir)
247
+
with
248
+
| Some _, None, None, _, None ->
249
+
Ok (Compile.CliParent { parent = parent_name_opt; children; output })
250
+
| None, Some p, None, [], None ->
251
+
Ok (Compile.CliPackage { package = p; output })
252
+
| None, None, Some p, [], Some output_dir ->
253
+
Ok (Compile.CliParentId { parent_id = p; output_dir })
254
+
| None, None, None, _ :: _, None ->
255
+
Ok (Compile.CliParent { parent = None; output; children })
256
+
| None, None, None, [], None -> Ok (Compile.CliNoParent output)
257
+
| Some _, Some _, _, _, _ ->
258
+
error "Either --package or --parent should be specified, not both."
259
+
| _, Some _, Some _, _, _ ->
260
+
error "Either --package or --parent-id should be specified, not both."
261
+
| Some _, _, Some _, _, _ ->
262
+
error "Either --parent or --parent-id should be specified, not both."
263
+
| _, _, None, _, Some _ ->
264
+
error "--output-dir can only be passed with --parent-id."
265
+
| None, Some _, _, _ :: _, _ ->
266
+
error "--child cannot be passed with --package."
267
+
| None, _, Some _, _ :: _, _ ->
268
+
error "--child cannot be passed with --parent-id."
269
+
| _, _, Some _, _, None ->
270
+
error "--output-dir is required when passing --parent-id."
271
+
in
272
+
cli_spec >>= fun cli_spec ->
273
+
Fs.Directory.mkdir_p (Fs.File.dirname output);
274
+
Compile.compile ~resolver ~cli_spec ~hidden ~warnings_options ~short_title
275
+
input
276
+
277
+
let input =
278
+
let doc = "Input $(i,.cmti), $(i,.cmt), $(i,.cmi) or $(i,.mld) file." in
279
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE" [])
280
+
281
+
let dst =
282
+
let doc =
283
+
"Output file path. Non-existing intermediate directories are created. If \
284
+
absent outputs a $(i,BASE.odoc) file in the same directory as the input \
285
+
file where $(i,BASE) is the basename of the input file. For mld files \
286
+
the \"page-\" prefix will be added if not already present in the input \
287
+
basename."
288
+
in
289
+
Arg.(value & opt (some string) None & info ~docs ~docv:"PATH" ~doc [ "o" ])
290
+
291
+
let output_dir =
292
+
let doc = "Output file directory. " in
293
+
Arg.(
294
+
value
295
+
& opt (some string) None
296
+
& info ~docs ~docv:"PATH" ~doc [ "output-dir" ])
297
+
298
+
let children =
299
+
let doc =
300
+
"Specify the $(i,.odoc) file as a child. Can be used multiple times. \
301
+
Only applies to mld files."
302
+
in
303
+
let default = [] in
304
+
Arg.(
305
+
value & opt_all string default & info ~docv:"CHILD" ~doc [ "c"; "child" ])
306
+
307
+
let cmd =
308
+
let package_opt =
309
+
let doc =
310
+
"Package the input is part of. Deprecated: use '--parent' instead."
311
+
in
312
+
Arg.(
313
+
value
314
+
& opt (some string) None
315
+
& info ~docs ~docv:"PKG" ~doc [ "package"; "pkg" ])
316
+
in
317
+
let parent_opt =
318
+
let doc = "Parent page or subpage." in
319
+
Arg.(
320
+
value
321
+
& opt (some string) None
322
+
& info ~docs ~docv:"PARENT" ~doc [ "parent" ])
323
+
in
324
+
let parent_id_opt =
325
+
let doc = "Parent id." in
326
+
Arg.(
327
+
value
328
+
& opt (some string) None
329
+
& info ~docs ~docv:"PARENT" ~doc [ "parent-id" ])
330
+
in
331
+
let short_title =
332
+
let doc = "Override short_title of an mld file" in
333
+
Arg.(
334
+
value
335
+
& opt (some string) None
336
+
& info ~docs ~docv:"TITLE" ~doc [ "short-title" ])
337
+
in
338
+
let resolve_fwd_refs =
339
+
let doc = "Try resolving forward references." in
340
+
Arg.(value & flag & info ~doc [ "r"; "resolve-fwd-refs" ])
341
+
in
342
+
Term.(
343
+
const handle_error
344
+
$ (const compile $ hidden $ odoc_file_directories $ resolve_fwd_refs $ dst
345
+
$ output_dir $ package_opt $ parent_opt $ parent_id_opt $ open_modules
346
+
$ children $ input $ warnings_options $ unique_id $ short_title))
347
+
348
+
let info ~docs =
349
+
let man =
350
+
[
351
+
`S "DEPENDENCIES";
352
+
`P
353
+
"Dependencies between compilation units is the same as while \
354
+
compiling the initial OCaml modules.";
355
+
`P "Mld pages don't have any dependency.";
356
+
]
357
+
in
358
+
let doc =
359
+
"Compile a $(i,.cmti), $(i,.cmt), $(i,.cmi) or $(i,.mld) file to an \
360
+
$(i,.odoc) file."
361
+
in
362
+
Cmd.info "compile" ~docs ~doc ~man
363
+
end
364
+
365
+
module Compile_asset = struct
366
+
let compile_asset parent_id name output_dir =
367
+
Odoc_odoc.Asset.compile ~parent_id ~name ~output_dir
368
+
369
+
let output_dir =
370
+
let doc = "Output file directory. " in
371
+
Arg.(
372
+
required
373
+
& opt (some string) None
374
+
& info ~docs ~docv:"PATH" ~doc [ "output-dir" ])
375
+
376
+
let cmd =
377
+
let asset_name =
378
+
let doc = "Name of the asset." in
379
+
Arg.(
380
+
required
381
+
& opt (some string) None
382
+
& info ~docs ~docv:"NAME" ~doc [ "name" ])
383
+
in
384
+
let parent_id =
385
+
let doc = "Parent id." in
386
+
Arg.(
387
+
required
388
+
& opt (some string) None
389
+
& info ~docs ~docv:"PARENT" ~doc [ "parent-id" ])
390
+
in
391
+
Term.(
392
+
const handle_error
393
+
$ (const compile_asset $ parent_id $ asset_name $ output_dir))
394
+
395
+
let info ~docs =
396
+
let man =
397
+
[
398
+
`S "DEPENDENCIES";
399
+
`P
400
+
"There are no dependency for compile assets, in particular you do \
401
+
not need the asset itself at this stage.";
402
+
]
403
+
in
404
+
let doc = "Declare the name of an asset." in
405
+
Cmd.info "compile-asset" ~docs ~doc ~man
406
+
end
407
+
408
+
module Compile_impl = struct
409
+
let prefix = "impl-"
410
+
411
+
let output_dir =
412
+
let doc = "Output file directory. " in
413
+
Arg.(
414
+
value
415
+
& opt (some string) None
416
+
& info ~docs ~docv:"PATH" ~doc [ "output-dir" ])
417
+
418
+
let output_file output_dir parent_id input =
419
+
let name =
420
+
Fs.File.basename input |> Fpath.set_ext "odoc" |> Fs.File.to_string
421
+
|> String.Ascii.uncapitalize
422
+
in
423
+
let name = prefix ^ name in
424
+
425
+
let dir = Fpath.(append output_dir parent_id) in
426
+
Fs.File.create
427
+
~directory:(Fpath.to_string dir |> Fs.Directory.of_string)
428
+
~name
429
+
430
+
let compile_impl directories output_dir parent_id source_id input
431
+
warnings_options =
432
+
let input = Fs.File.of_string input in
433
+
let output_dir =
434
+
match output_dir with Some x -> Fpath.v x | None -> Fpath.v "."
435
+
in
436
+
let output =
437
+
output_file output_dir
438
+
(match parent_id with Some x -> Fpath.v x | None -> Fpath.v ".")
439
+
input
440
+
in
441
+
let resolver =
442
+
Resolver.create ~important_digests:true ~directories ~open_modules:[]
443
+
~roots:None
444
+
in
445
+
Source.compile ~resolver ~source_id ~output ~warnings_options input
446
+
447
+
let cmd =
448
+
let input =
449
+
let doc = "Input $(i,.cmt) file." in
450
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE" [])
451
+
in
452
+
let source_id =
453
+
let doc = "The id of the source file" in
454
+
Arg.(
455
+
value
456
+
& opt (some string) None
457
+
& info [ "source-id" ] ~doc ~docv:"/path/to/source.ml")
458
+
in
459
+
let parent_id =
460
+
let doc = "The parent id of the implementation" in
461
+
Arg.(
462
+
value
463
+
& opt (some string) None
464
+
& info [ "parent-id" ] ~doc ~docv:"/path/to/library")
465
+
in
466
+
467
+
Term.(
468
+
const handle_error
469
+
$ (const compile_impl $ odoc_file_directories $ output_dir $ parent_id
470
+
$ source_id $ input $ warnings_options))
471
+
472
+
let info ~docs =
473
+
let doc =
474
+
"(EXPERIMENTAL) Compile a $(i,NAME.cmt) file to a $(i,src-NAME.odoc) \
475
+
containing the implementation information needed by odoc for the \
476
+
compilation unit."
477
+
in
478
+
Cmd.info "compile-impl" ~docs ~doc
479
+
end
480
+
481
+
module Indexing = struct
482
+
let output_file ~dst marshall =
483
+
match (dst, marshall) with
484
+
| Some file, `JSON
485
+
when not
486
+
(Fpath.has_ext "json" (Fpath.v file)
487
+
|| Fpath.has_ext "js" (Fpath.v file)) ->
488
+
Error
489
+
(`Msg
490
+
"When generating a json index, the output must have a .json or \
491
+
.js file extension")
492
+
| Some file, `Marshall when not (Fpath.has_ext "odoc-index" (Fpath.v file))
493
+
->
494
+
Error
495
+
(`Msg
496
+
"When generating a binary index, the output must have a \
497
+
.odoc-index file extension")
498
+
| Some file, _ -> Ok (Fs.File.of_string file)
499
+
| None, `JSON -> Ok (Fs.File.of_string "index.json")
500
+
| None, `Marshall -> Ok (Fs.File.of_string "index.odoc-index")
501
+
502
+
let index dst json warnings_options roots inputs_in_file inputs occurrences
503
+
simplified_json wrap_json =
504
+
let marshall = if json then `JSON else `Marshall in
505
+
output_file ~dst marshall >>= fun output ->
506
+
Indexing.compile marshall ~output ~warnings_options ~roots ~occurrences
507
+
~inputs_in_file ~simplified_json ~wrap_json ~odocls:inputs
508
+
509
+
let cmd =
510
+
let dst =
511
+
let doc =
512
+
"Output file path. Non-existing intermediate directories are created. \
513
+
Defaults to index.odoc-index, or index.json if --json is passed (in \
514
+
which case, the .odoc-index file extension is mandatory)."
515
+
in
516
+
Arg.(
517
+
value & opt (some string) None & info ~docs ~docv:"PATH" ~doc [ "o" ])
518
+
in
519
+
let occurrences =
520
+
let doc = "Occurrence file." in
521
+
Arg.(
522
+
value
523
+
& opt (some convert_fpath) None
524
+
& info ~docs ~docv:"PATH" ~doc [ "occurrences" ])
525
+
in
526
+
let inputs_in_file =
527
+
let doc =
528
+
"Input text file containing a line-separated list of paths to .odocl \
529
+
files to index."
530
+
in
531
+
Arg.(
532
+
value & opt_all convert_fpath []
533
+
& info ~doc ~docv:"FILE" [ "file-list" ])
534
+
in
535
+
let json =
536
+
let doc = "whether to output a json file, or a binary .odoc-index file" in
537
+
Arg.(value & flag & info ~doc [ "json" ])
538
+
in
539
+
let simplified_json =
540
+
let doc =
541
+
"whether to simplify the json file. Only has an effect in json output \
542
+
mode."
543
+
in
544
+
Arg.(value & flag & info ~doc [ "simplified-json" ])
545
+
in
546
+
let wrap_json =
547
+
let doc =
548
+
"Not intended for general use. Wraps the json output in a JavaScript \
549
+
variable assignment, and assumes the use of fuse.js"
550
+
in
551
+
Arg.(value & flag & info ~doc [ "wrap-json" ])
552
+
in
553
+
554
+
let inputs =
555
+
let doc = ".odocl file to index" in
556
+
Arg.(value & pos_all convert_fpath [] & info ~doc ~docv:"FILE" [])
557
+
in
558
+
let roots =
559
+
let doc =
560
+
"Specifies a directory PATH containing pages or units that should be \
561
+
included in the sidebar."
562
+
in
563
+
Arg.(
564
+
value
565
+
& opt_all (convert_directory ()) []
566
+
& info ~docs ~docv:"NAME:PATH" ~doc [ "root" ])
567
+
in
568
+
Term.(
569
+
const handle_error
570
+
$ (const index $ dst $ json $ warnings_options $ roots $ inputs_in_file
571
+
$ inputs $ occurrences $ simplified_json $ wrap_json))
572
+
573
+
let info ~docs =
574
+
let doc =
575
+
"Generate an index of all identified entries in the .odocl files found \
576
+
in the given directories."
577
+
in
578
+
Cmd.info "compile-index" ~docs ~doc
579
+
end
580
+
581
+
module Sidebar = struct
582
+
let output_file ~dst marshall =
583
+
match (dst, marshall) with
584
+
| Some file, `JSON when not (Fpath.has_ext "json" (Fpath.v file)) ->
585
+
Error
586
+
(`Msg
587
+
"When generating a sidebar with --json, the output must have a \
588
+
.json file extension")
589
+
| Some file, `Marshall
590
+
when not (Fpath.has_ext "odoc-sidebar" (Fpath.v file)) ->
591
+
Error
592
+
(`Msg
593
+
"When generating sidebar, the output must have a .odoc-sidebar \
594
+
file extension")
595
+
| Some file, _ -> Ok (Fs.File.of_string file)
596
+
| None, `JSON -> Ok (Fs.File.of_string "sidebar.json")
597
+
| None, `Marshall -> Ok (Fs.File.of_string "sidebar.odoc-sidebar")
598
+
599
+
let generate dst json warnings_options input =
600
+
let marshall = if json then `JSON else `Marshall in
601
+
output_file ~dst marshall >>= fun output ->
602
+
Sidebar.generate ~marshall ~output ~warnings_options ~index:input
603
+
604
+
let cmd =
605
+
let dst =
606
+
let doc =
607
+
"Output file path. Non-existing intermediate directories are created. \
608
+
Defaults to sidebar.odoc-sidebar, or sidebar.json if --json is \
609
+
passed."
610
+
in
611
+
Arg.(
612
+
value & opt (some string) None & info ~docs ~docv:"PATH" ~doc [ "o" ])
613
+
in
614
+
let json =
615
+
let doc = "whether to output a json file, or a binary .odoc-index file" in
616
+
Arg.(value & flag & info ~doc [ "json" ])
617
+
in
618
+
let inputs =
619
+
let doc = ".odoc-index file to generate a value from" in
620
+
Arg.(
621
+
required & pos 0 (some convert_fpath) None & info ~doc ~docv:"FILE" [])
622
+
in
623
+
Term.(
624
+
const handle_error
625
+
$ (const generate $ dst $ json $ warnings_options $ inputs))
626
+
627
+
let info ~docs =
628
+
let doc = "Generate a sidebar from an index file." in
629
+
Cmd.info "sidebar-generate" ~docs ~doc
630
+
end
631
+
632
+
module Support_files_command = struct
633
+
let support_files without_theme output_dir =
634
+
Support_files.write ~without_theme output_dir
635
+
636
+
let without_theme =
637
+
let doc = "Don't copy the default theme to output directory." in
638
+
Arg.(value & flag & info ~doc [ "without-theme" ])
639
+
640
+
let cmd = Term.(const support_files $ without_theme $ dst ~create:true ())
641
+
642
+
let info ~docs =
643
+
let doc =
644
+
"Copy the support files (e.g. default theme, JavaScript files) to the \
645
+
output directory."
646
+
in
647
+
Cmd.info ~docs ~doc "support-files"
648
+
end
649
+
650
+
module Css = struct
651
+
let cmd = Support_files_command.cmd
652
+
653
+
let info ~docs =
654
+
let doc =
655
+
"DEPRECATED: Use $(i,odoc support-files) to copy the CSS file for the \
656
+
default theme."
657
+
in
658
+
Cmd.info ~docs ~doc "css"
659
+
end
660
+
661
+
module Odoc_link : sig
662
+
val cmd : unit Term.t
663
+
664
+
val info : docs:string -> Cmd.info
665
+
end = struct
666
+
let get_output_file ~output_file ~input =
667
+
match output_file with
668
+
| Some file -> Fs.File.of_string file
669
+
| None -> Fs.File.(set_ext ".odocl" input)
670
+
671
+
(** Find the package/library name the output is part of *)
672
+
let find_root_of_input l o =
673
+
let l =
674
+
List.map
675
+
~f:(fun (x, p) ->
676
+
(x, p, p |> Fs.Directory.to_fpath |> Antichain.absolute_normalization))
677
+
l
678
+
in
679
+
let o = Antichain.absolute_normalization o in
680
+
match l with
681
+
| [] -> None
682
+
| _ ->
683
+
Odoc_utils.List.find_map
684
+
(fun (root, orig_path, norm_path) ->
685
+
if Fpath.is_prefix norm_path o then Some (root, orig_path) else None)
686
+
l
687
+
688
+
let current_library_of_input lib_roots input =
689
+
find_root_of_input lib_roots input
690
+
691
+
(** Checks if the package specified with [--current-package] is consistent
692
+
with the pages roots and with the output path for pages. *)
693
+
let validate_current_package ?detected_package page_roots current_package =
694
+
match (current_package, detected_package) with
695
+
| Some curpkgnane, Some (detected_package, _)
696
+
when detected_package <> curpkgnane ->
697
+
Error
698
+
(`Msg
699
+
"The package name specified with --current-package is not \
700
+
consistent with the packages passed as a -P")
701
+
| _, (Some _ as r) (* we have equality or only detected package *) -> Ok r
702
+
| None, None -> Ok None
703
+
| Some given, None -> (
704
+
try Ok (Some (given, List.assoc given page_roots))
705
+
with Not_found ->
706
+
Error
707
+
(`Msg
708
+
"The package name specified with --current-package do not match \
709
+
any package passed as a -P"))
710
+
711
+
let find_current_package ~current_package page_roots input =
712
+
let detected_package = find_root_of_input page_roots input in
713
+
validate_current_package ?detected_package page_roots current_package
714
+
715
+
let warnings_tags =
716
+
let doc =
717
+
"Filter warnings that were compiled with a tag that is not in the list \
718
+
of --warnings-tags passed."
719
+
in
720
+
let env = Cmd.Env.info "ODOC_WARNINGS_TAGS" ~doc in
721
+
Arg.(value & opt_all string [] & info ~docs ~doc ~env [ "warnings-tags" ])
722
+
723
+
let link directories page_roots lib_roots input_file output_file
724
+
current_package warnings_options open_modules custom_layout warnings_tags
725
+
=
726
+
let input = Fs.File.of_string input_file in
727
+
let output = get_output_file ~output_file ~input in
728
+
let check () =
729
+
if not custom_layout then
730
+
Antichain.check (page_roots |> List.map ~f:snd) ~opt:"-P" >>= fun () ->
731
+
Antichain.check (lib_roots |> List.map ~f:snd) ~opt:"-L"
732
+
else Ok ()
733
+
in
734
+
check () >>= fun () ->
735
+
let current_lib = current_library_of_input lib_roots input in
736
+
find_current_package ~current_package page_roots input
737
+
>>= fun current_package ->
738
+
let current_dir = Fs.File.dirname input in
739
+
let roots =
740
+
Some
741
+
{
742
+
Resolver.page_roots;
743
+
lib_roots;
744
+
current_lib;
745
+
current_package;
746
+
current_dir;
747
+
}
748
+
in
749
+
750
+
let resolver =
751
+
Resolver.create ~important_digests:false ~directories ~open_modules ~roots
752
+
in
753
+
match
754
+
Odoc_link.from_odoc ~resolver ~warnings_options ~warnings_tags input
755
+
output
756
+
with
757
+
| Error _ as e -> e
758
+
| Ok _ -> Ok ()
759
+
760
+
let dst =
761
+
let doc =
762
+
"Output file path. Non-existing intermediate directories are created. If \
763
+
absent outputs a $(i,.odocl) file in the same directory as the input \
764
+
file with the same basename."
765
+
in
766
+
Arg.(
767
+
value
768
+
& opt (some string) None
769
+
& info ~docs ~docv:"PATH.odocl" ~doc [ "o" ])
770
+
771
+
let page_roots =
772
+
let doc =
773
+
"Specifies a directory DIR containing pages that can be referenced by \
774
+
{!/pkgname/pagename}. A pkgname can be specified in the -P command only \
775
+
once. All the trees specified by this option and -L must be disjoint."
776
+
in
777
+
Arg.(
778
+
value
779
+
& opt_all convert_named_root []
780
+
& info ~docs ~docv:"pkgname:DIR" ~doc [ "P" ])
781
+
782
+
let lib_roots =
783
+
let doc =
784
+
"Specifies a library called libname containing the modules in directory \
785
+
DIR. Modules can be referenced both using the flat module namespace \
786
+
{!Module} and the absolute reference {!/libname/Module}. All the trees \
787
+
specified by this option and -P must be disjoint."
788
+
in
789
+
Arg.(
790
+
value
791
+
& opt_all convert_named_root []
792
+
& info ~docs ~docv:"libname:DIR" ~doc [ "L" ])
793
+
794
+
let current_package =
795
+
let doc =
796
+
"Specify the current package name. The matching page root specified with \
797
+
-P is used to resolve references using the '//' syntax. A \
798
+
corresponding -P option must be passed."
799
+
in
800
+
Arg.(
801
+
value
802
+
& opt (some string) None
803
+
& info ~docs ~docv:"pkgname" ~doc [ "current-package" ])
804
+
805
+
let custom_layout =
806
+
let doc =
807
+
"Signal that a custom layout is being used. This disables the checks \
808
+
that the library and package paths are disjoint."
809
+
in
810
+
Arg.(value & flag (info ~doc [ "custom-layout" ]))
811
+
812
+
let cmd =
813
+
let input =
814
+
let doc = "Input file" in
815
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE.odoc" [])
816
+
in
817
+
Term.(
818
+
const handle_error
819
+
$ (const link $ odoc_file_directories $ page_roots $ lib_roots $ input
820
+
$ dst $ current_package $ warnings_options $ open_modules $ custom_layout
821
+
$ warnings_tags))
822
+
823
+
let info ~docs =
824
+
let man =
825
+
[
826
+
`S "DEPENDENCIES";
827
+
`P
828
+
"Any link step depends on the result of all the compile results that \
829
+
could potentially be needed to resolve forward references. A \
830
+
correct approximation is to start linking only after every compile \
831
+
steps are done, passing everything that's possible to $(i,-I). Link \
832
+
steps don't have dependencies between them.";
833
+
]
834
+
in
835
+
let doc =
836
+
"Second stage of compilation. Link a $(i,.odoc) into a $(i,.odocl)."
837
+
in
838
+
Cmd.info ~docs ~doc ~man "link"
839
+
end
840
+
841
+
module type S = sig
842
+
type args
843
+
844
+
val renderer : args Odoc_document.Renderer.t
845
+
846
+
val extra_args : args Cmdliner.Term.t
847
+
end
848
+
849
+
module Make_renderer (R : S) : sig
850
+
val process : docs:string -> unit Term.t * Cmd.info
851
+
852
+
val targets : docs:string -> unit Term.t * Cmd.info
853
+
854
+
val targets_source : docs:string -> unit Term.t * Cmd.info
855
+
856
+
val generate : docs:string -> unit Term.t * Cmd.info
857
+
858
+
val generate_source : docs:string -> unit Term.t * Cmd.info
859
+
860
+
val generate_asset : docs:string -> unit Term.t * Cmd.info
861
+
end = struct
862
+
let input_odoc =
863
+
let doc = "Input file." in
864
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE.odoc" [])
865
+
866
+
let input_odocl =
867
+
let doc = "Input file." in
868
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE.odocl" [])
869
+
870
+
let input_odocl_list =
871
+
let doc = "Input file(s)." in
872
+
Arg.(non_empty & pos_all file [] & info ~doc ~docv:"FILE.odocl" [])
873
+
874
+
module Process = struct
875
+
let process extra _hidden directories output_dir syntax input_file
876
+
warnings_options =
877
+
let resolver =
878
+
Resolver.create ~important_digests:false ~directories ~open_modules:[]
879
+
~roots:None
880
+
in
881
+
let file = Fs.File.of_string input_file in
882
+
Rendering.render_odoc ~renderer:R.renderer ~resolver ~warnings_options
883
+
~syntax ~output:output_dir extra file
884
+
885
+
let cmd =
886
+
let syntax =
887
+
let doc = "Available options: ml | re" in
888
+
let env = Cmd.Env.info "ODOC_SYNTAX" in
889
+
Arg.(
890
+
value
891
+
& opt convert_syntax Odoc_document.Renderer.OCaml
892
+
@@ info ~docv:"SYNTAX" ~doc ~env [ "syntax" ])
893
+
in
894
+
Term.(
895
+
const handle_error
896
+
$ (const process $ R.extra_args $ hidden $ odoc_file_directories
897
+
$ dst ~create:true () $ syntax $ input_odoc $ warnings_options))
898
+
899
+
let info ~docs =
900
+
let doc =
901
+
Format.sprintf
902
+
"Render %s files from a $(i,.odoc). $(i,link) then $(i,%s-generate) \
903
+
should be used instead."
904
+
R.renderer.name R.renderer.name
905
+
in
906
+
Cmd.info ~docs ~doc R.renderer.name
907
+
end
908
+
909
+
let process ~docs = Process.(cmd, info ~docs)
910
+
911
+
module Generate = struct
912
+
let generate extra _hidden output_dir syntax extra_suffix input_files
913
+
warnings_options sidebar =
914
+
let process_file input_file =
915
+
let file = Fs.File.of_string input_file in
916
+
Rendering.generate_odoc ~renderer:R.renderer ~warnings_options ~syntax
917
+
~output:output_dir ~extra_suffix ~sidebar extra file
918
+
in
919
+
List.fold_left
920
+
~f:(fun acc input_file -> acc >>= fun () -> process_file input_file)
921
+
~init:(Ok ()) input_files
922
+
923
+
let sidebar =
924
+
let doc = "A .odoc-index file, used eg to generate the sidebar." in
925
+
Arg.(
926
+
value
927
+
& opt (some convert_fpath) None
928
+
& info [ "sidebar" ] ~doc ~docv:"FILE.odoc-sidebar")
929
+
930
+
let cmd =
931
+
let syntax =
932
+
let doc = "Available options: ml | re" in
933
+
let env = Cmd.Env.info "ODOC_SYNTAX" in
934
+
Arg.(
935
+
value
936
+
& opt convert_syntax Odoc_document.Renderer.OCaml
937
+
@@ info ~docv:"SYNTAX" ~doc ~env [ "syntax" ])
938
+
in
939
+
Term.(
940
+
const handle_error
941
+
$ (const generate $ R.extra_args $ hidden $ dst ~create:true () $ syntax
942
+
$ extra_suffix $ input_odocl_list $ warnings_options $ sidebar))
943
+
944
+
let info ~docs =
945
+
let doc =
946
+
Format.sprintf "Generate %s files from one or more $(i,.odocl) files."
947
+
R.renderer.name
948
+
in
949
+
Cmd.info ~docs ~doc (R.renderer.name ^ "-generate")
950
+
end
951
+
952
+
let generate ~docs = Generate.(cmd, info ~docs)
953
+
954
+
module Generate_source = struct
955
+
let generate extra output_dir syntax extra_suffix input_file
956
+
warnings_options source_file sidebar =
957
+
Rendering.generate_source_odoc ~renderer:R.renderer ~warnings_options
958
+
~syntax ~output:output_dir ~extra_suffix ~source_file ~sidebar extra
959
+
input_file
960
+
961
+
let input_odocl =
962
+
let doc = "Linked implementation file." in
963
+
Arg.(
964
+
required
965
+
& opt (some convert_fpath) None
966
+
& info [ "impl" ] ~doc ~docv:"impl-FILE.odocl")
967
+
968
+
let source_file =
969
+
let doc = "Source code for the implementation unit." in
970
+
Arg.(
971
+
required
972
+
& pos 0 (some convert_fpath) None
973
+
& info ~doc ~docv:"FILE.ml" [])
974
+
975
+
let cmd =
976
+
let syntax =
977
+
let doc = "Available options: ml | re" in
978
+
let env = Cmd.Env.info "ODOC_SYNTAX" in
979
+
Arg.(
980
+
value
981
+
& opt convert_syntax Odoc_document.Renderer.OCaml
982
+
@@ info ~docv:"SYNTAX" ~doc ~env [ "syntax" ])
983
+
in
984
+
let sidebar = Generate.sidebar in
985
+
Term.(
986
+
const handle_error
987
+
$ (const generate $ R.extra_args $ dst ~create:true () $ syntax
988
+
$ extra_suffix $ input_odocl $ warnings_options $ source_file $ sidebar
989
+
))
990
+
991
+
let info ~docs =
992
+
let doc =
993
+
Format.sprintf "Generate %s files from a $(i,impl-*.odocl)."
994
+
R.renderer.name
995
+
in
996
+
Cmd.info ~docs ~doc (R.renderer.name ^ "-generate-source")
997
+
end
998
+
999
+
let generate_source ~docs = Generate_source.(cmd, info ~docs)
1000
+
1001
+
module Generate_asset = struct
1002
+
let generate extra output_dir extra_suffix input_file warnings_options
1003
+
asset_file =
1004
+
Rendering.generate_asset_odoc ~renderer:R.renderer ~warnings_options
1005
+
~output:output_dir ~extra_suffix ~asset_file extra input_file
1006
+
1007
+
let input_odocl =
1008
+
let doc = "Odoc asset unit." in
1009
+
Arg.(
1010
+
required
1011
+
& opt (some convert_fpath) None
1012
+
& info [ "asset-unit" ] ~doc ~docv:"asset-FILE.odocl")
1013
+
1014
+
let asset_file =
1015
+
let doc = "The asset file" in
1016
+
Arg.(
1017
+
required
1018
+
& pos 0 (some convert_fpath) None
1019
+
& info ~doc ~docv:"FILE.ext" [])
1020
+
1021
+
let cmd =
1022
+
Term.(
1023
+
const handle_error
1024
+
$ (const generate $ R.extra_args $ dst ~create:true () $ extra_suffix
1025
+
$ input_odocl $ warnings_options $ asset_file))
1026
+
1027
+
let info ~docs =
1028
+
let doc =
1029
+
Format.sprintf "Generate %s files from a $(i,impl-*.odocl)."
1030
+
R.renderer.name
1031
+
in
1032
+
Cmd.info ~docs ~doc (R.renderer.name ^ "-generate-asset")
1033
+
end
1034
+
1035
+
let generate_asset ~docs = Generate_asset.(cmd, info ~docs)
1036
+
1037
+
module Targets = struct
1038
+
let list_targets output_dir directories extra odoc_file =
1039
+
let odoc_file = Fs.File.of_string odoc_file in
1040
+
let resolver =
1041
+
Resolver.create ~important_digests:false ~directories ~open_modules:[]
1042
+
~roots:None
1043
+
in
1044
+
let warnings_options =
1045
+
{
1046
+
Odoc_model.Error.warn_error = false;
1047
+
print_warnings = false;
1048
+
warnings_tag = None;
1049
+
}
1050
+
in
1051
+
Rendering.targets_odoc ~resolver ~warnings_options ~syntax:OCaml
1052
+
~renderer:R.renderer ~output:output_dir ~extra odoc_file
1053
+
1054
+
let back_compat =
1055
+
let doc =
1056
+
"For backwards compatibility when processing $(i,.odoc) rather than \
1057
+
$(i,.odocl) files."
1058
+
in
1059
+
Arg.(
1060
+
value
1061
+
& opt_all (convert_directory ()) []
1062
+
& info ~docs ~docv:"DIR" ~doc [ "I" ])
1063
+
1064
+
let cmd =
1065
+
Term.(
1066
+
const handle_error
1067
+
$ (const list_targets $ dst () $ back_compat $ R.extra_args
1068
+
$ input_odocl))
1069
+
1070
+
let info ~docs =
1071
+
let doc =
1072
+
Format.sprintf
1073
+
"Print the files that would be generated by $(i,%s-generate)."
1074
+
R.renderer.name
1075
+
in
1076
+
Cmd.info (R.renderer.name ^ "-targets") ~docs ~doc
1077
+
end
1078
+
1079
+
let targets ~docs = Targets.(cmd, info ~docs)
1080
+
1081
+
module Targets_source = struct
1082
+
let list_targets output_dir source_file extra odoc_file =
1083
+
let warnings_options =
1084
+
{
1085
+
Odoc_model.Error.warn_error = false;
1086
+
print_warnings = false;
1087
+
warnings_tag = None;
1088
+
}
1089
+
in
1090
+
Rendering.targets_source_odoc ~warnings_options ~syntax:OCaml
1091
+
~renderer:R.renderer ~output:output_dir ~extra ~source_file odoc_file
1092
+
1093
+
let source_file = Generate_source.source_file
1094
+
let input_odocl = Generate_source.input_odocl
1095
+
1096
+
let cmd =
1097
+
Term.(
1098
+
const handle_error
1099
+
$ (const list_targets $ dst () $ source_file $ R.extra_args
1100
+
$ input_odocl))
1101
+
1102
+
let info ~docs =
1103
+
let doc =
1104
+
Format.sprintf
1105
+
"Print the files that would be generated by $(i,%s-generate-source)."
1106
+
R.renderer.name
1107
+
in
1108
+
Cmd.info (R.renderer.name ^ "-targets-source") ~docs ~doc
1109
+
end
1110
+
1111
+
let targets_source ~docs = Targets_source.(cmd, info ~docs)
1112
+
end
1113
+
1114
+
module Odoc_latex_url : sig
1115
+
val cmd : unit Term.t
1116
+
1117
+
val info : docs:string -> Cmd.info
1118
+
end = struct
1119
+
let reference =
1120
+
let doc = "The reference to be resolved and whose url to be generated." in
1121
+
Arg.(required & pos 0 (some string) None & info ~doc ~docv:"REF" [])
1122
+
1123
+
let reference_to_url = Url.reference_to_url_latex
1124
+
1125
+
let cmd =
1126
+
Term.(
1127
+
const handle_error
1128
+
$ (const reference_to_url $ odoc_file_directories $ reference))
1129
+
1130
+
let info ~docs =
1131
+
Cmd.info ~docs ~doc:"Resolve a reference and output its corresponding url."
1132
+
"latex-url"
1133
+
end
1134
+
1135
+
module Odoc_html_args = struct
1136
+
include Html_page
1137
+
1138
+
let semantic_uris =
1139
+
let doc = "Generate pretty (semantic) links." in
1140
+
Arg.(value & flag (info ~doc [ "semantic-uris"; "pretty-uris" ]))
1141
+
1142
+
let closed_details =
1143
+
let doc =
1144
+
"If this flag is passed <details> tags (used for includes) will be \
1145
+
closed by default."
1146
+
in
1147
+
Arg.(value & flag (info ~doc [ "closed-details" ]))
1148
+
1149
+
let indent =
1150
+
let doc = "Format the output HTML files with indentation." in
1151
+
Arg.(value & flag (info ~doc [ "indent" ]))
1152
+
1153
+
module Uri = struct
1154
+
(* Very basic validation and normalization for URI paths. *)
1155
+
1156
+
open Odoc_html.Types
1157
+
1158
+
let is_absolute str =
1159
+
List.exists [ "http"; "https"; "file"; "data"; "ftp" ] ~f:(fun scheme ->
1160
+
Astring.String.is_prefix ~affix:(scheme ^ ":") str)
1161
+
|| str.[0] = '/'
1162
+
1163
+
let conv_rel_dir rel =
1164
+
let l = String.cuts ~sep:"/" rel in
1165
+
List.fold_left
1166
+
~f:(fun acc seg ->
1167
+
Some Odoc_document.Url.Path.{ kind = `Page; parent = acc; name = seg })
1168
+
l ~init:None
1169
+
1170
+
let convert_dir : uri Arg.conv =
1171
+
let parser str =
1172
+
if String.length str = 0 then Error "invalid URI"
1173
+
else
1174
+
(* The URI is absolute if it starts with a scheme or with '/'. *)
1175
+
let last_char = str.[String.length str - 1] in
1176
+
let str =
1177
+
if last_char <> '/' then str
1178
+
else String.with_range ~len:(String.length str - 1) str
1179
+
in
1180
+
Ok
1181
+
(if is_absolute str then (Absolute str : uri)
1182
+
else
1183
+
Relative
1184
+
(let u = conv_rel_dir str in
1185
+
match u with
1186
+
| None -> None
1187
+
| Some u -> Some { u with kind = `Page }))
1188
+
in
1189
+
let printer ppf = function
1190
+
| (Absolute uri : uri) -> Format.pp_print_string ppf uri
1191
+
| Relative _uri -> Format.pp_print_string ppf ""
1192
+
in
1193
+
Arg.conv' (parser, printer)
1194
+
1195
+
let convert_file_uri : Odoc_html.Types.file_uri Arg.conv =
1196
+
let parser str =
1197
+
if String.length str = 0 then Error "invalid URI"
1198
+
else
1199
+
let conv_rel_file rel =
1200
+
match String.cut ~rev:true ~sep:"/" rel with
1201
+
| Some (before, after) ->
1202
+
let base = conv_rel_dir before in
1203
+
Odoc_document.Url.Path.
1204
+
{ kind = `File; parent = base; name = after }
1205
+
| None ->
1206
+
Odoc_document.Url.Path.
1207
+
{ kind = `File; parent = None; name = rel }
1208
+
in
1209
+
Ok
1210
+
(if is_absolute str then (Absolute str : file_uri)
1211
+
else Relative (conv_rel_file str))
1212
+
in
1213
+
let printer ppf = function
1214
+
| Odoc_html.Types.Absolute uri -> Format.pp_print_string ppf uri
1215
+
| Odoc_html.Types.Relative _uri -> Format.pp_print_string ppf ""
1216
+
in
1217
+
Arg.conv' (parser, printer)
1218
+
end
1219
+
1220
+
let home_breadcrumb =
1221
+
let doc =
1222
+
"Name for a 'Home' breadcrumb to go up the root of the given sidebar."
1223
+
in
1224
+
Arg.(
1225
+
value
1226
+
& opt (some string) None
1227
+
& info ~docv:"escape" ~doc [ "home-breadcrumb" ])
1228
+
1229
+
let theme_uri =
1230
+
let doc =
1231
+
"Where to look for theme files (e.g. `URI/odoc.css'). Relative URIs are \
1232
+
resolved using `--output-dir' as a target."
1233
+
in
1234
+
let default : Odoc_html.Types.uri = Odoc_html.Types.Relative None in
1235
+
Arg.(
1236
+
value
1237
+
& opt Uri.convert_dir default
1238
+
& info ~docv:"URI" ~doc [ "theme-uri" ])
1239
+
1240
+
let support_uri =
1241
+
let doc =
1242
+
"Where to look for support files (e.g. `URI/highlite.pack.js'). Relative \
1243
+
URIs are resolved using `--output-dir' as a target."
1244
+
in
1245
+
let default : Odoc_html.Types.uri = Odoc_html.Types.Relative None in
1246
+
Arg.(
1247
+
value
1248
+
& opt Uri.convert_dir default
1249
+
& info ~docv:"URI" ~doc [ "support-uri" ])
1250
+
1251
+
let search_uri =
1252
+
let doc =
1253
+
"Where to look for search scripts. Relative URIs are resolved using \
1254
+
`--output-dir' as a target."
1255
+
in
1256
+
Arg.(
1257
+
value
1258
+
& opt_all Uri.convert_file_uri []
1259
+
& info ~docv:"URI" ~doc [ "search-uri" ])
1260
+
1261
+
let flat =
1262
+
let doc =
1263
+
"Output HTML files in 'flat' mode, where the hierarchy of modules / \
1264
+
module types / classes and class types are reflected in the filenames \
1265
+
rather than in the directory structure."
1266
+
in
1267
+
Arg.(value & flag & info ~docs ~doc [ "flat" ])
1268
+
1269
+
let as_json =
1270
+
let doc =
1271
+
"EXPERIMENTAL: Output HTML files in 'embeddable json' mode, where HTML \
1272
+
fragments (preamble, content) together with metadata (uses_katex, \
1273
+
breadcrumbs, table of contents) are emitted in JSON format. The \
1274
+
structure of the output should be considered unstable and no guarantees \
1275
+
are made about backward compatibility."
1276
+
in
1277
+
Arg.(value & flag & info ~doc [ "as-json" ])
1278
+
1279
+
let remap =
1280
+
let convert_remap =
1281
+
let parse inp =
1282
+
match String.cut ~sep:":" inp with
1283
+
| Some (orig, mapped) -> Ok (orig, mapped)
1284
+
| _ -> Error (`Msg "Map must be of the form '<orig>:https://...'")
1285
+
and print fmt (orig, mapped) = Format.fprintf fmt "%s:%s" orig mapped in
1286
+
Arg.conv (parse, print)
1287
+
in
1288
+
let doc = "Remap an identifier to an external URL." in
1289
+
Arg.(value & opt_all convert_remap [] & info [ "R" ] ~doc)
1290
+
1291
+
let remap_file =
1292
+
let doc = "File containing remap rules." in
1293
+
Arg.(value & opt (some file) None & info ~docv:"FILE" ~doc [ "remap-file" ])
1294
+
1295
+
let extra_args =
1296
+
let config semantic_uris closed_details indent theme_uri support_uri
1297
+
search_uris flat as_json remap remap_file home_breadcrumb =
1298
+
let open_details = not closed_details in
1299
+
let remap =
1300
+
match remap_file with
1301
+
| None -> remap
1302
+
| Some f ->
1303
+
Io_utils.fold_lines f
1304
+
(fun line acc ->
1305
+
match String.cut ~sep:":" line with
1306
+
| Some (orig, mapped) -> (orig, mapped) :: acc
1307
+
| None -> acc)
1308
+
[]
1309
+
in
1310
+
let html_config =
1311
+
Odoc_html.Config.v ~theme_uri ~support_uri ~search_uris ~semantic_uris
1312
+
~indent ~flat ~open_details ~as_json ~remap ?home_breadcrumb ()
1313
+
in
1314
+
{ Html_page.html_config }
1315
+
in
1316
+
Term.(
1317
+
const config $ semantic_uris $ closed_details $ indent $ theme_uri
1318
+
$ support_uri $ search_uri $ flat $ as_json $ remap $ remap_file
1319
+
$ home_breadcrumb)
1320
+
end
1321
+
1322
+
module Odoc_html = Make_renderer (Odoc_html_args)
1323
+
1324
+
module Odoc_markdown_cmd = Make_renderer (struct
1325
+
type args = Odoc_markdown.Config.t
1326
+
1327
+
let render config _sidebar page = Odoc_markdown.Generator.render ~config page
1328
+
1329
+
let filepath config url = Odoc_markdown.Generator.filepath ~config url
1330
+
1331
+
let extra_args =
1332
+
Term.const { Odoc_markdown.Config.root_url = None; allow_html = true }
1333
+
let renderer = { Odoc_document.Renderer.name = "markdown"; render; filepath }
1334
+
end)
1335
+
1336
+
module Odoc_html_url : sig
1337
+
val cmd : unit Term.t
1338
+
1339
+
val info : docs:string -> Cmd.info
1340
+
end = struct
1341
+
let root_url =
1342
+
let doc =
1343
+
"A string to prepend to the generated relative url. A separating / is \
1344
+
added if needed."
1345
+
in
1346
+
Arg.(value & opt (some string) None & info [ "r"; "root-url" ] ~doc)
1347
+
1348
+
let reference =
1349
+
let doc = "The reference to be resolved and whose url to be generated." in
1350
+
Arg.(required & pos 0 (some string) None & info ~doc ~docv:"REF" [])
1351
+
1352
+
let reference_to_url = Url.reference_to_url_html
1353
+
1354
+
let cmd =
1355
+
Term.(
1356
+
const handle_error
1357
+
$ (const reference_to_url $ Odoc_html_args.extra_args $ root_url
1358
+
$ odoc_file_directories $ reference))
1359
+
1360
+
let info ~docs =
1361
+
Cmd.info ~docs ~doc:"Resolve a reference and output its corresponding url."
1362
+
"html-url"
1363
+
end
1364
+
1365
+
module Html_fragment : sig
1366
+
val cmd : unit Term.t
1367
+
1368
+
val info : docs:string -> Cmd.info
1369
+
end = struct
1370
+
let html_fragment directories xref_base_uri output_file input_file
1371
+
warnings_options =
1372
+
let resolver =
1373
+
Resolver.create ~important_digests:false ~directories ~open_modules:[]
1374
+
~roots:None
1375
+
in
1376
+
let input_file = Fs.File.of_string input_file in
1377
+
let output_file = Fs.File.of_string output_file in
1378
+
let xref_base_uri =
1379
+
if xref_base_uri = "" then xref_base_uri
1380
+
else
1381
+
let last_char = xref_base_uri.[String.length xref_base_uri - 1] in
1382
+
if last_char <> '/' then xref_base_uri ^ "/" else xref_base_uri
1383
+
in
1384
+
Html_fragment.from_mld ~resolver ~xref_base_uri ~output:output_file
1385
+
~warnings_options input_file
1386
+
1387
+
let cmd =
1388
+
let output =
1389
+
let doc = "Output HTML fragment file." in
1390
+
Arg.(
1391
+
value & opt string "/dev/stdout"
1392
+
& info ~docs ~docv:"file.html" ~doc [ "o"; "output-file" ])
1393
+
in
1394
+
let input =
1395
+
let doc = "Input documentation page file." in
1396
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"file.mld" [])
1397
+
in
1398
+
let xref_base_uri =
1399
+
let doc =
1400
+
"Base URI used to resolve cross-references. Set this to the root of \
1401
+
the global docset during local development. By default `.' is used."
1402
+
in
1403
+
Arg.(value & opt string "" & info ~docv:"URI" ~doc [ "xref-base-uri" ])
1404
+
in
1405
+
Term.(
1406
+
const handle_error
1407
+
$ (const html_fragment $ odoc_file_directories $ xref_base_uri $ output
1408
+
$ input $ warnings_options))
1409
+
1410
+
let info ~docs =
1411
+
Cmd.info ~docs ~doc:"Generates an html fragment file from an mld one."
1412
+
"html-fragment"
1413
+
end
1414
+
1415
+
module Odoc_manpage = Make_renderer (struct
1416
+
type args = unit
1417
+
1418
+
let renderer = Man_page.renderer
1419
+
1420
+
let extra_args = Term.const ()
1421
+
end)
1422
+
1423
+
module Odoc_latex = Make_renderer (struct
1424
+
type args = Latex.args
1425
+
1426
+
let renderer = Latex.renderer
1427
+
1428
+
let with_children =
1429
+
let doc = "Include children at the end of the page." in
1430
+
Arg.(value & opt bool true & info ~docv:"BOOL" ~doc [ "with-children" ])
1431
+
1432
+
let shorten_beyond_depth =
1433
+
let doc = "Shorten items beyond the given depth." in
1434
+
Arg.(
1435
+
value
1436
+
& opt (some' int) None
1437
+
& info ~docv:"INT" ~doc [ "shorten-beyond-depth" ])
1438
+
1439
+
let remove_functor_arg_link =
1440
+
let doc = "Remove link to functor argument." in
1441
+
Arg.(
1442
+
value & opt bool false
1443
+
& info ~docv:"BOOL" ~doc [ "remove-functor-arg-link" ])
1444
+
1445
+
let extra_args =
1446
+
let f with_children shorten_beyond_depth remove_functor_arg_link =
1447
+
{ Latex.with_children; shorten_beyond_depth; remove_functor_arg_link }
1448
+
in
1449
+
Term.(
1450
+
const f $ with_children $ shorten_beyond_depth $ remove_functor_arg_link)
1451
+
end)
1452
+
1453
+
module Depends = struct
1454
+
module Compile = struct
1455
+
let list_dependencies input_files =
1456
+
try
1457
+
let deps =
1458
+
Depends.for_compile_step (List.map ~f:Fs.File.of_string input_files)
1459
+
in
1460
+
List.iter
1461
+
~f:(fun t ->
1462
+
Printf.printf "%s %s\n" (Depends.Compile.name t)
1463
+
(Digest.to_hex @@ Depends.Compile.digest t))
1464
+
deps;
1465
+
flush stdout
1466
+
with Cmi_format.Error e ->
1467
+
let msg =
1468
+
match e with
1469
+
| Not_an_interface file ->
1470
+
Printf.sprintf "File %S is not an interface" file
1471
+
| Wrong_version_interface (file, v) ->
1472
+
Printf.sprintf "File %S is compiled for %s version of OCaml" file
1473
+
v
1474
+
| Corrupted_interface file ->
1475
+
Printf.sprintf "File %S is corrupted" file
1476
+
in
1477
+
Printf.eprintf "ERROR: %s\n%!" msg;
1478
+
exit 1
1479
+
1480
+
let cmd =
1481
+
let input =
1482
+
let doc = "Input files" in
1483
+
Arg.(non_empty & pos_all file [] & info ~doc ~docv:"file.cm{i,t,ti}" [])
1484
+
in
1485
+
Term.(const list_dependencies $ input)
1486
+
1487
+
let info ~docs =
1488
+
Cmd.info "compile-deps" ~docs
1489
+
~doc:
1490
+
"List units (with their digest) which needs to be compiled in order \
1491
+
to compile this one. The unit itself and its digest is also \
1492
+
reported in the output.\n\
1493
+
Dependencies between compile steps are the same as when compiling \
1494
+
the ocaml modules."
1495
+
end
1496
+
1497
+
module Link = struct
1498
+
let rec fmt_page pp page =
1499
+
match page.Odoc_model.Paths.Identifier.iv with
1500
+
| `Page (parent_opt, name) ->
1501
+
Format.fprintf pp "%a%a" fmt_parent_opt parent_opt
1502
+
Odoc_model.Names.PageName.fmt name
1503
+
| `LeafPage (parent_opt, name) ->
1504
+
Format.fprintf pp "%a%a" fmt_parent_opt parent_opt
1505
+
Odoc_model.Names.PageName.fmt name
1506
+
1507
+
and fmt_parent_opt pp parent_opt =
1508
+
match parent_opt with
1509
+
| None -> ()
1510
+
| Some p -> Format.fprintf pp "%a/" fmt_page p
1511
+
1512
+
let list_dependencies input_file =
1513
+
Depends.for_rendering_step (Fs.Directory.of_string input_file)
1514
+
>>= fun depends ->
1515
+
List.iter depends ~f:(fun (root : Odoc_model.Root.t) ->
1516
+
match root.id.iv with
1517
+
| `Root (Some p, _) ->
1518
+
Format.printf "%a %s %s\n" fmt_page p
1519
+
(Odoc_model.Root.Odoc_file.name root.file)
1520
+
(Digest.to_hex root.digest)
1521
+
| _ ->
1522
+
Format.printf "none %s %s\n"
1523
+
(Odoc_model.Root.Odoc_file.name root.file)
1524
+
(Digest.to_hex root.digest));
1525
+
Ok ()
1526
+
1527
+
let cmd =
1528
+
let input =
1529
+
let doc = "Input directory" in
1530
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"PKG_DIR" [])
1531
+
in
1532
+
Term.(const handle_error $ (const list_dependencies $ input))
1533
+
1534
+
let info ~docs =
1535
+
Cmd.info "link-deps" ~docs
1536
+
~doc:
1537
+
"Lists a subset of the packages and modules which need to be in \
1538
+
odoc's load path to link the $(i, odoc) files in the given \
1539
+
directory. Additional packages may be required to resolve all \
1540
+
references."
1541
+
end
1542
+
1543
+
module Odoc_html = struct
1544
+
let includes =
1545
+
let doc = "For backwards compatibility. Ignored." in
1546
+
Arg.(
1547
+
value
1548
+
& opt_all (convert_directory ()) []
1549
+
& info ~docs ~docv:"DIR" ~doc [ "I" ])
1550
+
1551
+
let cmd =
1552
+
let input =
1553
+
let doc = "Input directory" in
1554
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"PKG_DIR" [])
1555
+
in
1556
+
let cmd _ = Link.list_dependencies in
1557
+
Term.(const handle_error $ (const cmd $ includes $ input))
1558
+
1559
+
let info ~docs =
1560
+
Cmd.info "html-deps" ~docs ~doc:"DEPRECATED: alias for link-deps"
1561
+
end
1562
+
end
1563
+
1564
+
module Targets = struct
1565
+
module Compile = struct
1566
+
let list_targets dst input =
1567
+
let input = Fs.File.of_string input in
1568
+
let output = Compile.output_file ~dst ~input in
1569
+
Printf.printf "%s\n" (Fs.File.to_string output);
1570
+
flush stdout
1571
+
1572
+
let cmd = Term.(const list_targets $ Compile.dst $ Compile.input)
1573
+
1574
+
let info ~docs =
1575
+
Cmd.info "compile-targets" ~docs
1576
+
~doc:
1577
+
"Print the name of the file produced by $(i,compile). If $(i,-o) is \
1578
+
passed, the same path is printed but error checking is performed."
1579
+
end
1580
+
1581
+
module Support_files = struct
1582
+
let list_targets without_theme output_directory =
1583
+
Support_files.print_filenames ~without_theme output_directory
1584
+
1585
+
let cmd =
1586
+
Term.(const list_targets $ Support_files_command.without_theme $ dst ())
1587
+
1588
+
let info ~docs =
1589
+
Cmd.info "support-files-targets" ~docs
1590
+
~doc:
1591
+
"Lists the names of the files that $(i,odoc support-files) outputs."
1592
+
end
1593
+
end
1594
+
1595
+
module Occurrences = struct
1596
+
let dst_of_string s =
1597
+
let f = Fs.File.of_string s in
1598
+
if not (Fs.File.has_ext ".odoc-occurrences" f) then
1599
+
Error (`Msg "Output file must have '.odoc-occurrences' extension.")
1600
+
else Ok f
1601
+
1602
+
module Count = struct
1603
+
let count directories dst warnings_options include_hidden =
1604
+
dst_of_string dst >>= fun dst ->
1605
+
Occurrences.count ~dst ~warnings_options directories include_hidden
1606
+
1607
+
let cmd =
1608
+
let dst =
1609
+
let doc = "Output file path." in
1610
+
Arg.(
1611
+
required
1612
+
& opt (some string) None
1613
+
& info ~docs ~docv:"PATH" ~doc [ "o" ])
1614
+
in
1615
+
let include_hidden =
1616
+
let doc = "Include hidden identifiers in the table" in
1617
+
Arg.(value & flag & info ~docs ~doc [ "include-hidden" ])
1618
+
in
1619
+
let input =
1620
+
let doc =
1621
+
"Directories to recursively traverse, agregating occurrences from \
1622
+
$(i,impl-*.odocl) files. Can be present several times."
1623
+
in
1624
+
Arg.(
1625
+
value
1626
+
& pos_all (convert_directory ()) []
1627
+
& info ~docs ~docv:"DIR" ~doc [])
1628
+
in
1629
+
Term.(
1630
+
const handle_error
1631
+
$ (const count $ input $ dst $ warnings_options $ include_hidden))
1632
+
1633
+
let info ~docs =
1634
+
let doc =
1635
+
"Generate a hashtable mapping identifiers to number of occurrences, as \
1636
+
computed from the implementations of .odocl files found in the given \
1637
+
directories."
1638
+
in
1639
+
Cmd.info "count-occurrences" ~docs ~doc
1640
+
end
1641
+
module Aggregate = struct
1642
+
let index dst files file_list strip_path warnings_options =
1643
+
match (files, file_list) with
1644
+
| [], [] ->
1645
+
Error
1646
+
(`Msg
1647
+
"At least one of --file-list or a path to a file must be passed \
1648
+
to odoc aggregate-occurrences")
1649
+
| _ ->
1650
+
dst_of_string dst >>= fun dst ->
1651
+
Occurrences.aggregate ~dst ~warnings_options ~strip_path files
1652
+
file_list
1653
+
1654
+
let cmd =
1655
+
let dst =
1656
+
let doc = "Output file path." in
1657
+
Arg.(
1658
+
required
1659
+
& opt (some string) None
1660
+
& info ~docs ~docv:"PATH" ~doc [ "o" ])
1661
+
in
1662
+
let inputs_in_file =
1663
+
let doc =
1664
+
"Input text file containing a line-separated list of paths to files \
1665
+
created with count-occurrences."
1666
+
in
1667
+
Arg.(
1668
+
value & opt_all convert_fpath []
1669
+
& info ~doc ~docv:"FILE" [ "file-list" ])
1670
+
in
1671
+
let inputs =
1672
+
let doc = "file created with count-occurrences" in
1673
+
Arg.(value & pos_all convert_fpath [] & info ~doc ~docv:"FILE" [])
1674
+
in
1675
+
let strip_path =
1676
+
let doc = "Strip package/version information from paths" in
1677
+
Arg.(value & flag & info ~doc [ "strip-path" ])
1678
+
in
1679
+
Term.(
1680
+
const handle_error
1681
+
$ (const index $ dst $ inputs $ inputs_in_file $ strip_path
1682
+
$ warnings_options))
1683
+
1684
+
let info ~docs =
1685
+
let doc = "Aggregate hashtables created with odoc count-occurrences." in
1686
+
Cmd.info "aggregate-occurrences" ~docs ~doc
1687
+
end
1688
+
end
1689
+
1690
+
module Odoc_error = struct
1691
+
let errors input =
1692
+
let open Odoc_odoc in
1693
+
let input = Fs.File.of_string input in
1694
+
Odoc_file.load input >>= fun unit ->
1695
+
Odoc_model.Error.print_errors unit.warnings;
1696
+
Ok ()
1697
+
1698
+
let input =
1699
+
let doc = "Input $(i,.odoc) or $(i,.odocl) file" in
1700
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE" [])
1701
+
1702
+
let cmd = Term.(const handle_error $ (const errors $ input))
1703
+
1704
+
let info ~docs =
1705
+
Cmd.info "errors" ~docs
1706
+
~doc:"Print errors that occurred while compiling or linking."
1707
+
end
1708
+
1709
+
module Classify = struct
1710
+
let libdirs =
1711
+
let doc = "The directories containing the libraries" in
1712
+
Arg.(value & pos_all string [] & info ~doc ~docv:"DIR" [])
1713
+
1714
+
let cmd = Term.(const handle_error $ (const Classify.classify $ libdirs))
1715
+
1716
+
let info ~docs =
1717
+
Cmd.info "classify" ~docs
1718
+
~doc:
1719
+
"Classify the modules into libraries based on heuristics. Libraries \
1720
+
are specified by the --library option."
1721
+
end
1722
+
1723
+
module Extract_code = struct
1724
+
let extract dst input line_directives names warnings_options =
1725
+
Extract_code.extract ~dst ~input ~line_directives ~names ~warnings_options
1726
+
1727
+
let line_directives =
1728
+
let doc = "Whether to include line directives in the output file" in
1729
+
Arg.(value & flag & info ~doc [ "line-directives" ])
1730
+
1731
+
let names =
1732
+
let doc =
1733
+
"From which name(s) of code blocks to extract content. When no names are \
1734
+
provided, extract all OCaml code blocks."
1735
+
in
1736
+
Arg.(value & opt_all string [] & info ~doc [ "name" ])
1737
+
1738
+
let input =
1739
+
let doc = "Input $(i,.mld) file." in
1740
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE" [])
1741
+
1742
+
let dst =
1743
+
let doc = "Output file path." in
1744
+
Arg.(
1745
+
value
1746
+
& opt (some string) None
1747
+
& info ~docs ~docv:"PATH" ~doc [ "o"; "output" ])
1748
+
1749
+
let cmd =
1750
+
Term.(
1751
+
const handle_error
1752
+
$ (const extract $ dst $ input $ line_directives $ names
1753
+
$ warnings_options))
1754
+
1755
+
let info ~docs =
1756
+
Cmd.info "extract-code" ~docs
1757
+
~doc:
1758
+
"Extract code blocks from mld files in order to be able to execute them"
1759
+
end
1760
+
1761
+
let section_pipeline = "COMMANDS: Compilation pipeline"
1762
+
let section_generators = "COMMANDS: Alternative generators"
1763
+
let section_support = "COMMANDS: Scripting"
1764
+
let section_legacy = "COMMANDS: Legacy pipeline"
1765
+
let section_deprecated = "COMMANDS: Deprecated"
1766
+
1767
+
module Extensions = struct
1768
+
let run () =
1769
+
let prefixes = Odoc_extension_api.Registry.list_prefixes () in
1770
+
match prefixes with
1771
+
| [] ->
1772
+
Printf.printf "No extensions installed.\n%!";
1773
+
Printf.printf "Extensions can be installed as opam packages that register with odoc.\n%!"
1774
+
| _ ->
1775
+
Printf.printf "Installed extensions:\n%!";
1776
+
List.iter ~f:(fun prefix -> Printf.printf " @%s\n%!" prefix) prefixes
1777
+
1778
+
let cmd = Term.(const run $ const ())
1779
+
let info ~docs = Cmd.info "extensions" ~docs ~doc:"List installed odoc extensions"
1780
+
end
1781
+
1782
+
(** Sections in the order they should appear. *)
1783
+
let main_page_sections =
1784
+
[
1785
+
section_pipeline;
1786
+
section_generators;
1787
+
section_support;
1788
+
section_legacy;
1789
+
section_deprecated;
1790
+
]
1791
+
1792
+
let () =
1793
+
Printexc.record_backtrace true;
1794
+
let cmd_make (term, info) = Cmd.v info term in
1795
+
let subcommands =
1796
+
List.map ~f:cmd_make
1797
+
@@ [
1798
+
Occurrences.Count.(cmd, info ~docs:section_pipeline);
1799
+
Occurrences.Aggregate.(cmd, info ~docs:section_pipeline);
1800
+
Compile.(cmd, info ~docs:section_pipeline);
1801
+
Compile_asset.(cmd, info ~docs:section_pipeline);
1802
+
Odoc_link.(cmd, info ~docs:section_pipeline);
1803
+
Odoc_html.generate ~docs:section_pipeline;
1804
+
Odoc_html.generate_source ~docs:section_pipeline;
1805
+
Odoc_html.generate_asset ~docs:section_pipeline;
1806
+
Support_files_command.(cmd, info ~docs:section_pipeline);
1807
+
Compile_impl.(cmd, info ~docs:section_pipeline);
1808
+
Indexing.(cmd, info ~docs:section_pipeline);
1809
+
Sidebar.(cmd, info ~docs:section_pipeline);
1810
+
Odoc_markdown_cmd.generate ~docs:section_generators;
1811
+
Odoc_markdown_cmd.generate_source ~docs:section_generators;
1812
+
Odoc_markdown_cmd.targets ~docs:section_support;
1813
+
Odoc_manpage.generate ~docs:section_generators;
1814
+
Odoc_latex.generate ~docs:section_generators;
1815
+
Odoc_html_url.(cmd, info ~docs:section_support);
1816
+
Odoc_latex_url.(cmd, info ~docs:section_support);
1817
+
Targets.Support_files.(cmd, info ~docs:section_support);
1818
+
Odoc_error.(cmd, info ~docs:section_support);
1819
+
Odoc_html.targets ~docs:section_support;
1820
+
Odoc_html.targets_source ~docs:section_support;
1821
+
Odoc_manpage.targets ~docs:section_support;
1822
+
Odoc_latex.targets ~docs:section_support;
1823
+
Depends.Compile.(cmd, info ~docs:section_support);
1824
+
Targets.Compile.(cmd, info ~docs:section_support);
1825
+
Html_fragment.(cmd, info ~docs:section_legacy);
1826
+
Odoc_html.process ~docs:section_legacy;
1827
+
Odoc_manpage.process ~docs:section_legacy;
1828
+
Odoc_latex.process ~docs:section_legacy;
1829
+
Depends.Link.(cmd, info ~docs:section_legacy);
1830
+
Css.(cmd, info ~docs:section_deprecated);
1831
+
Depends.Odoc_html.(cmd, info ~docs:section_deprecated);
1832
+
Classify.(cmd, info ~docs:section_pipeline);
1833
+
Extract_code.(cmd, info ~docs:section_pipeline);
1834
+
Extensions.(cmd, info ~docs:section_support);
1835
+
]
1836
+
in
1837
+
let main =
1838
+
let print_default () =
1839
+
let available_subcommands =
1840
+
List.map subcommands ~f:(fun cmd -> Cmd.name cmd)
1841
+
in
1842
+
Printf.printf
1843
+
"Available subcommands: %s\nSee --help for more information.\n%!"
1844
+
(String.concat ~sep:", " available_subcommands)
1845
+
in
1846
+
let man =
1847
+
(* Show sections in a defined order. *)
1848
+
List.map ~f:(fun s -> `S s) main_page_sections
1849
+
in
1850
+
let default = Term.(const print_default $ const ()) in
1851
+
let info = Cmd.info ~man ~version:"%%VERSION%%" "odoc" in
1852
+
Cmd.group ~default info subcommands
1853
+
in
1854
+
match Cmd.eval_value ~err:Format.err_formatter main with
1855
+
| Error _ ->
1856
+
Format.pp_print_flush Format.err_formatter ();
1857
+
exit 2
1858
+
| _ -> ()
+384
odoc-scrollycode-extension/test/warm_parser.mld
+384
odoc-scrollycode-extension/test/warm_parser.mld
···
1
+
{0 Building a JSON Parser}
2
+
3
+
@scrolly.warm Building a JSON Parser in OCaml
4
+
{ol
5
+
{li
6
+
{b Defining the Value Type}
7
+
8
+
Every parser starts with a type. JSON has six kinds of values:
9
+
null, booleans, numbers, strings, arrays, and objects.
10
+
We encode this directly as an OCaml variant.
11
+
12
+
{[
13
+
(* >type json =
14
+
(* > | Null
15
+
(* > | Bool of bool
16
+
(* > | Number of float
17
+
(* > | String of string
18
+
(* > | Array of json list
19
+
(* > | Object of (string * json) list
20
+
]}
21
+
}
22
+
{li
23
+
{b A Simple Scanner}
24
+
25
+
Before parsing structure, we need to skip whitespace and
26
+
peek at the next meaningful character. Our scanner works
27
+
on a string with a mutable position index.
28
+
29
+
{[
30
+
type json =
31
+
| Null
32
+
| Bool of bool
33
+
| Number of float
34
+
| String of string
35
+
| Array of json list
36
+
| Object of (string * json) list
37
+
38
+
(* >type scanner = {
39
+
(* > input : string;
40
+
(* > mutable pos : int;
41
+
(* >}
42
+
(* >
43
+
(* >let peek s =
44
+
(* > while s.pos < String.length s.input
45
+
(* > && s.input.[s.pos] = ' ' do
46
+
(* > s.pos <- s.pos + 1
47
+
(* > done;
48
+
(* > if s.pos < String.length s.input
49
+
(* > then Some s.input.[s.pos]
50
+
(* > else None
51
+
(* >
52
+
(* >let advance s = s.pos <- s.pos + 1
53
+
]}
54
+
}
55
+
{li
56
+
{b Parsing Strings}
57
+
58
+
JSON strings are delimited by double quotes. We scan character
59
+
by character, collecting into a buffer. This handles the simple
60
+
case without escape sequences.
61
+
62
+
{[
63
+
type json =
64
+
| Null
65
+
| Bool of bool
66
+
| Number of float
67
+
| String of string
68
+
| Array of json list
69
+
| Object of (string * json) list
70
+
71
+
type scanner = {
72
+
input : string;
73
+
mutable pos : int;
74
+
}
75
+
76
+
let peek s =
77
+
while s.pos < String.length s.input
78
+
&& s.input.[s.pos] = ' ' do
79
+
s.pos <- s.pos + 1
80
+
done;
81
+
if s.pos < String.length s.input
82
+
then Some s.input.[s.pos]
83
+
else None
84
+
85
+
let advance s = s.pos <- s.pos + 1
86
+
87
+
(* >let parse_string s =
88
+
(* > advance s;
89
+
(* > let buf = Buffer.create 64 in
90
+
(* > while s.pos < String.length s.input
91
+
(* > && s.input.[s.pos] <> '"' do
92
+
(* > Buffer.add_char buf s.input.[s.pos];
93
+
(* > advance s
94
+
(* > done;
95
+
(* > advance s;
96
+
(* > Buffer.contents buf
97
+
]}
98
+
}
99
+
{li
100
+
{b Parsing Numbers}
101
+
102
+
Numbers in JSON can be integers or floats. We collect consecutive
103
+
digit and dot characters, then use float_of_string to parse them.
104
+
A production parser would handle exponents too.
105
+
106
+
{[
107
+
type json =
108
+
| Null
109
+
| Bool of bool
110
+
| Number of float
111
+
| String of string
112
+
| Array of json list
113
+
| Object of (string * json) list
114
+
115
+
type scanner = {
116
+
input : string;
117
+
mutable pos : int;
118
+
}
119
+
120
+
let peek s =
121
+
while s.pos < String.length s.input
122
+
&& s.input.[s.pos] = ' ' do
123
+
s.pos <- s.pos + 1
124
+
done;
125
+
if s.pos < String.length s.input
126
+
then Some s.input.[s.pos]
127
+
else None
128
+
129
+
let advance s = s.pos <- s.pos + 1
130
+
131
+
let parse_string s =
132
+
advance s;
133
+
let buf = Buffer.create 64 in
134
+
while s.pos < String.length s.input
135
+
&& s.input.[s.pos] <> '"' do
136
+
Buffer.add_char buf s.input.[s.pos];
137
+
advance s
138
+
done;
139
+
advance s;
140
+
Buffer.contents buf
141
+
142
+
(* >let is_digit c = c >= '0' && c <= '9'
143
+
(* >
144
+
(* >let parse_number s =
145
+
(* > let start = s.pos in
146
+
(* > while s.pos < String.length s.input
147
+
(* > && (is_digit s.input.[s.pos]
148
+
(* > || s.input.[s.pos] = '.'
149
+
(* > || s.input.[s.pos] = '-') do
150
+
(* > advance s
151
+
(* > done;
152
+
(* > float_of_string
153
+
(* > (String.sub s.input start (s.pos - start))
154
+
]}
155
+
}
156
+
{li
157
+
{b The Recursive Core}
158
+
159
+
Now the magic: parse_value dispatches on the next character
160
+
to decide what kind of JSON value to parse. For atoms like
161
+
null, true, false we match literal strings. For compound
162
+
structures, we recurse.
163
+
164
+
{[
165
+
type json =
166
+
| Null
167
+
| Bool of bool
168
+
| Number of float
169
+
| String of string
170
+
| Array of json list
171
+
| Object of (string * json) list
172
+
173
+
type scanner = {
174
+
input : string;
175
+
mutable pos : int;
176
+
}
177
+
178
+
let peek s =
179
+
while s.pos < String.length s.input
180
+
&& s.input.[s.pos] = ' ' do
181
+
s.pos <- s.pos + 1
182
+
done;
183
+
if s.pos < String.length s.input
184
+
then Some s.input.[s.pos]
185
+
else None
186
+
187
+
let advance s = s.pos <- s.pos + 1
188
+
189
+
let parse_string s =
190
+
advance s;
191
+
let buf = Buffer.create 64 in
192
+
while s.pos < String.length s.input
193
+
&& s.input.[s.pos] <> '"' do
194
+
Buffer.add_char buf s.input.[s.pos];
195
+
advance s
196
+
done;
197
+
advance s;
198
+
Buffer.contents buf
199
+
200
+
let is_digit c = c >= '0' && c <= '9'
201
+
202
+
let parse_number s =
203
+
let start = s.pos in
204
+
while s.pos < String.length s.input
205
+
&& (is_digit s.input.[s.pos]
206
+
|| s.input.[s.pos] = '.'
207
+
|| s.input.[s.pos] = '-') do
208
+
advance s
209
+
done;
210
+
float_of_string
211
+
(String.sub s.input start (s.pos - start))
212
+
213
+
(* >let expect s c =
214
+
(* > match peek s with
215
+
(* > | Some c' when c' = c -> advance s
216
+
(* > | _ -> failwith "unexpected character"
217
+
(* >
218
+
(* >let rec parse_value s =
219
+
(* > match peek s with
220
+
(* > | Some '"' -> String (parse_string s)
221
+
(* > | Some c when is_digit c || c = '-' ->
222
+
(* > Number (parse_number s)
223
+
(* > | Some 't' ->
224
+
(* > s.pos <- s.pos + 4; Bool true
225
+
(* > | Some 'f' ->
226
+
(* > s.pos <- s.pos + 5; Bool false
227
+
(* > | Some 'n' ->
228
+
(* > s.pos <- s.pos + 4; Null
229
+
(* > | Some '[' -> parse_array s
230
+
(* > | Some '{' -> parse_object s
231
+
(* > | _ -> failwith "unexpected token"
232
+
(* >
233
+
(* >and parse_array s =
234
+
(* > advance s;
235
+
(* > let items = ref [] in
236
+
(* > (match peek s with
237
+
(* > | Some ']' -> advance s
238
+
(* > | _ ->
239
+
(* > items := [parse_value s];
240
+
(* > while peek s = Some ',' do
241
+
(* > advance s;
242
+
(* > items := parse_value s :: !items
243
+
(* > done;
244
+
(* > expect s ']');
245
+
(* > Array (List.rev !items)
246
+
(* >
247
+
(* >and parse_object s =
248
+
(* > advance s;
249
+
(* > let pairs = ref [] in
250
+
(* > (match peek s with
251
+
(* > | Some '}' -> advance s
252
+
(* > | _ ->
253
+
(* > let key = parse_string s in
254
+
(* > expect s ':';
255
+
(* > let value = parse_value s in
256
+
(* > pairs := [(key, value)];
257
+
(* > while peek s = Some ',' do
258
+
(* > advance s;
259
+
(* > let k = parse_string s in
260
+
(* > expect s ':';
261
+
(* > let v = parse_value s in
262
+
(* > pairs := (k, v) :: !pairs
263
+
(* > done;
264
+
(* > expect s '}');
265
+
(* > Object (List.rev !pairs)
266
+
]}
267
+
}
268
+
{li
269
+
{b The Public API}
270
+
271
+
Finally we wrap the scanner in a clean top-level function.
272
+
Pass a string in, get a JSON value out. The entire parser
273
+
is about 80 lines of OCaml — no dependencies, no magic.
274
+
275
+
{[
276
+
type json =
277
+
| Null
278
+
| Bool of bool
279
+
| Number of float
280
+
| String of string
281
+
| Array of json list
282
+
| Object of (string * json) list
283
+
284
+
type scanner = {
285
+
input : string;
286
+
mutable pos : int;
287
+
}
288
+
289
+
let peek s =
290
+
while s.pos < String.length s.input
291
+
&& s.input.[s.pos] = ' ' do
292
+
s.pos <- s.pos + 1
293
+
done;
294
+
if s.pos < String.length s.input
295
+
then Some s.input.[s.pos]
296
+
else None
297
+
298
+
let advance s = s.pos <- s.pos + 1
299
+
300
+
let parse_string s =
301
+
advance s;
302
+
let buf = Buffer.create 64 in
303
+
while s.pos < String.length s.input
304
+
&& s.input.[s.pos] <> '"' do
305
+
Buffer.add_char buf s.input.[s.pos];
306
+
advance s
307
+
done;
308
+
advance s;
309
+
Buffer.contents buf
310
+
311
+
let is_digit c = c >= '0' && c <= '9'
312
+
313
+
let parse_number s =
314
+
let start = s.pos in
315
+
while s.pos < String.length s.input
316
+
&& (is_digit s.input.[s.pos]
317
+
|| s.input.[s.pos] = '.'
318
+
|| s.input.[s.pos] = '-') do
319
+
advance s
320
+
done;
321
+
float_of_string
322
+
(String.sub s.input start (s.pos - start))
323
+
324
+
let expect s c =
325
+
match peek s with
326
+
| Some c' when c' = c -> advance s
327
+
| _ -> failwith "unexpected character"
328
+
329
+
let rec parse_value s =
330
+
match peek s with
331
+
| Some '"' -> String (parse_string s)
332
+
| Some c when is_digit c || c = '-' ->
333
+
Number (parse_number s)
334
+
| Some 't' ->
335
+
s.pos <- s.pos + 4; Bool true
336
+
| Some 'f' ->
337
+
s.pos <- s.pos + 5; Bool false
338
+
| Some 'n' ->
339
+
s.pos <- s.pos + 4; Null
340
+
| Some '[' -> parse_array s
341
+
| Some '{' -> parse_object s
342
+
| _ -> failwith "unexpected token"
343
+
344
+
and parse_array s =
345
+
advance s;
346
+
let items = ref [] in
347
+
(match peek s with
348
+
| Some ']' -> advance s
349
+
| _ ->
350
+
items := [parse_value s];
351
+
while peek s = Some ',' do
352
+
advance s;
353
+
items := parse_value s :: !items
354
+
done;
355
+
expect s ']');
356
+
Array (List.rev !items)
357
+
358
+
and parse_object s =
359
+
advance s;
360
+
let pairs = ref [] in
361
+
(match peek s with
362
+
| Some '}' -> advance s
363
+
| _ ->
364
+
let key = parse_string s in
365
+
expect s ':';
366
+
let value = parse_value s in
367
+
pairs := [(key, value)];
368
+
while peek s = Some ',' do
369
+
advance s;
370
+
let k = parse_string s in
371
+
expect s ':';
372
+
let v = parse_value s in
373
+
pairs := (k, v) :: !pairs
374
+
done;
375
+
expect s '}');
376
+
Object (List.rev !pairs)
377
+
378
+
(* >let parse input =
379
+
(* > let s = { input; pos = 0 } in
380
+
(* > let v = parse_value s in
381
+
(* > v
382
+
]}
383
+
}
384
+
}