forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
Add @page-tags extension to odoc-jons-plugins
Renders a row of tag chips from [@page-tags foo bar baz] on any .mld
page. Tags are lowercased and linked to /tags/<tag>. This is the
producer half of the feature; the consumer extension that enumerates
pages by tag will follow.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+134
+134
odoc-jons-plugins/src/odoc_jons_plugins.ml
+134
odoc-jons-plugins/src/odoc_jons_plugins.ml
···
400
400
let () =
401
401
List.iter hidden_tag_extension [ "published"; "notanotebook"; "packages" ]
402
402
403
+
(* --- Page tags extension ---
404
+
405
+
Produces a small row of tag chips from [@page-tags foo bar baz]. Tags
406
+
are lowercase, link to /tags/<tag>. The consumer extension
407
+
([@tagged-pages <tag>]) is a separate plugin that walks the page tree
408
+
at link phase to collect matching pages. *)
409
+
410
+
module Page_tags = struct
411
+
let prefix = "page-tags"
412
+
413
+
let page_tags_css = {|
414
+
/* Page tags extension - neutralize the at-tags list wrapper */
415
+
.jon-shell-main ul.at-tags:has(li.page-tags) {
416
+
list-style: none;
417
+
margin: 0;
418
+
padding: 0;
419
+
}
420
+
.jon-shell-main .at-tags li.page-tags {
421
+
list-style: none;
422
+
margin: 0;
423
+
padding: 0;
424
+
text-indent: 0;
425
+
}
426
+
.page-tags {
427
+
display: flex;
428
+
flex-wrap: wrap;
429
+
gap: 0.4em;
430
+
margin: 0.75em 0 1.5em;
431
+
}
432
+
.page-tags .tag-chip {
433
+
display: inline-block;
434
+
padding: 0.15em 0.65em;
435
+
font-size: 0.8rem;
436
+
line-height: 1.4;
437
+
color: var(--text-muted, #666);
438
+
background: var(--surface-alt, #f3f3f3);
439
+
border: 1px solid var(--border-color, #e0e0e0);
440
+
border-radius: 999px;
441
+
text-decoration: none;
442
+
transition: background 0.15s ease, color 0.15s ease;
443
+
}
444
+
.page-tags .tag-chip:hover {
445
+
color: var(--accent-color, #b44e2d);
446
+
background: var(--bg-hover, #eee);
447
+
}
448
+
@media (prefers-color-scheme: dark) {
449
+
.page-tags .tag-chip {
450
+
color: var(--text-muted, #aaa);
451
+
background: rgba(255,255,255,0.04);
452
+
border-color: rgba(255,255,255,0.1);
453
+
}
454
+
}
455
+
|}
456
+
457
+
(* A tag is lowercase [a-z0-9] with optional internal hyphens. We
458
+
normalise by lowercasing and trimming, and reject anything that
459
+
doesn't match. *)
460
+
let is_tag_char c =
461
+
(c >= 'a' && c <= 'z')
462
+
|| (c >= '0' && c <= '9')
463
+
|| c = '-'
464
+
465
+
let normalise_tag s =
466
+
let s = Stdlib.String.lowercase_ascii (Stdlib.String.trim s) in
467
+
if s = "" then None
468
+
else if Stdlib.String.length s < 1 then None
469
+
else
470
+
let ok = ref true in
471
+
Stdlib.String.iter (fun c -> if not (is_tag_char c) then ok := false) s;
472
+
if !ok then Some s else None
473
+
474
+
(* Parse tags from the block content: take the plain text, split on
475
+
whitespace, dedupe while preserving order. *)
476
+
let extract_tags content =
477
+
let text = Api.text_of_nestable_block_elements content in
478
+
let parts =
479
+
Stdlib.String.split_on_char ' ' text
480
+
|> List.concat_map (fun s -> Stdlib.String.split_on_char '\n' s)
481
+
|> List.concat_map (fun s -> Stdlib.String.split_on_char '\t' s)
482
+
in
483
+
let seen = Hashtbl.create 8 in
484
+
List.filter_map (fun part ->
485
+
match normalise_tag part with
486
+
| None -> None
487
+
| Some tag ->
488
+
if Hashtbl.mem seen tag then None
489
+
else (Hashtbl.add seen tag (); Some tag)
490
+
) parts
491
+
492
+
let raw_block html =
493
+
Odoc_document.Types.Block.{ attr = []; desc = Raw_markup ("html", html) }
494
+
495
+
(* HTML-escape a tag (tags are already constrained to safe chars, but
496
+
be defensive). *)
497
+
let escape_attr s =
498
+
let b = Buffer.create (Stdlib.String.length s) in
499
+
Stdlib.String.iter (fun c ->
500
+
match c with
501
+
| '&' -> Buffer.add_string b "&"
502
+
| '<' -> Buffer.add_string b "<"
503
+
| '>' -> Buffer.add_string b ">"
504
+
| '"' -> Buffer.add_string b """
505
+
| c -> Buffer.add_char b c
506
+
) s;
507
+
Buffer.contents b
508
+
509
+
let render_chips tags =
510
+
let buf = Buffer.create 256 in
511
+
Buffer.add_string buf {|<div class="page-tags">|};
512
+
List.iter (fun tag ->
513
+
let t = escape_attr tag in
514
+
Buffer.add_string buf
515
+
(Printf.sprintf {|<a class="tag-chip" href="/tags/%s">%s</a>|} t t)
516
+
) tags;
517
+
Buffer.add_string buf "</div>";
518
+
Buffer.contents buf
519
+
520
+
let to_document ~tag:_ content =
521
+
let tags = extract_tags content in
522
+
let content =
523
+
if tags = [] then []
524
+
else [ raw_block (render_chips tags) ]
525
+
in
526
+
{
527
+
Api.content;
528
+
overrides = [];
529
+
resources = [ Api.Css_inline page_tags_css ];
530
+
assets = [];
531
+
}
532
+
end
533
+
534
+
let () =
535
+
Api.Registry.register (module Page_tags)
536
+
403
537
(* --- Recent posts extension --- *)
404
538
405
539
module Recent_posts = struct