My aggregated monorepo of OCaml code, automaintained
Squashed 'ocaml-bushel/' changes from 2553361e..b87c25ae
b87c25ae Handle %c/%r image directives and video embeds in render
3094fbfc Add bushel render command for markdown resolution
git-subtree-dir: ocaml-bushel
git-subtree-split: b87c25ae880714d3d3fa979e69d5a7d03d350631
+282
-7
+47
-2
bin/main.ml
+47
-2
bin/main.ml
···
100
100
| None -> config.Bushel_config.data_dir
101
101
102
102
(** Load entries using Eio *)
103
-
let with_entries data_dir f =
103
+
let with_entries ?image_output_dir data_dir f =
104
104
Eio_main.run @@ fun env ->
105
105
let fs = Eio.Stdenv.fs env in
106
-
let entries = Bushel_eio.Bushel_loader.load fs data_dir in
106
+
let entries = Bushel_eio.Bushel_loader.load ?image_output_dir fs data_dir in
107
107
f env entries
108
108
109
109
(** {1 List Command} *)
···
244
244
let doc = "Show details of a specific entry." in
245
245
let info = Cmd.info "show" ~doc in
246
246
Cmd.v info Term.(const run $ logging_t $ config_file $ data_dir $ slug_arg)
247
+
248
+
(** {1 Render Command} *)
249
+
250
+
let render_cmd =
251
+
let slug_arg =
252
+
let doc = "The slug of the entry to render." in
253
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"SLUG" ~doc)
254
+
in
255
+
let base_url =
256
+
let doc = "Base URL prefix for entry links (default: empty)." in
257
+
Arg.(value & opt string "" & info ["base-url"] ~docv:"URL" ~doc)
258
+
in
259
+
let image_base =
260
+
let doc = "Base path for images (default: /images)." in
261
+
Arg.(value & opt string "/images" & info ["image-base"] ~docv:"PATH" ~doc)
262
+
in
263
+
let run () config_file data_dir slug base_url image_base =
264
+
match load_config config_file with
265
+
| Error e -> Printf.eprintf "Config error: %s\n" e; 1
266
+
| Ok config ->
267
+
let data_dir = get_data_dir config data_dir in
268
+
let image_output_dir = config.Bushel_config.local_output_dir in
269
+
with_entries ~image_output_dir data_dir @@ fun _env entries ->
270
+
match Bushel.Entry.lookup entries slug with
271
+
| None ->
272
+
Printf.eprintf "Entry not found: %s\n" slug;
273
+
1
274
+
| Some entry ->
275
+
let body = Bushel.Entry.body entry in
276
+
let rendered = Bushel.Md.to_markdown ~base_url ~image_base ~entries body in
277
+
print_string rendered;
278
+
0
279
+
in
280
+
let doc = "Render an entry's markdown with resolved Bushel links." in
281
+
let man = [
282
+
`S Manpage.s_description;
283
+
`P "Converts Bushel-flavored markdown to standard markdown by resolving:";
284
+
`P "- $(b,:slug) links to [Title](URL)";
285
+
`P "- $(b,@@handle) to [Name](contact_url)";
286
+
`P "- $(b,##tag) to [tag](/tags/tag)";
287
+
`P "- $(b,![:image-slug]) to ";
288
+
] in
289
+
let info = Cmd.info "render" ~doc ~man in
290
+
Cmd.v info Term.(const run $ logging_t $ config_file $ data_dir $ slug_arg $ base_url $ image_base)
247
291
248
292
(** {1 Sync Command} *)
249
293
···
674
718
images_cmd;
675
719
stats_cmd;
676
720
show_cmd;
721
+
render_cmd;
677
722
sync_cmd;
678
723
paper_add_cmd;
679
724
video_fetch_cmd;
+13
-2
lib/bushel_entry.ml
+13
-2
lib/bushel_entry.ml
···
24
24
ideas : Bushel_idea.ts;
25
25
videos : Bushel_video.ts;
26
26
contacts : Sortal_schema.Contact.t list;
27
+
images : Srcsetter.t list;
28
+
image_index : (string, Srcsetter.t) Hashtbl.t;
27
29
data_dir : string;
28
30
}
29
31
30
32
(** {1 Constructors} *)
31
33
32
-
let v ~papers ~notes ~projects ~ideas ~videos ~contacts ~data_dir =
34
+
let v ~papers ~notes ~projects ~ideas ~videos ~contacts ?(images=[]) ~data_dir () =
33
35
let slugs : slugs = Hashtbl.create 42 in
34
36
let papers, old_papers = List.partition (fun p -> p.Bushel_paper.latest) papers in
35
37
List.iter (fun n -> Hashtbl.add slugs n.Bushel_note.slug (`Note n)) notes;
···
37
39
List.iter (fun i -> Hashtbl.add slugs i.Bushel_idea.slug (`Idea i)) ideas;
38
40
List.iter (fun v -> Hashtbl.add slugs v.Bushel_video.slug (`Video v)) videos;
39
41
List.iter (fun p -> Hashtbl.add slugs p.Bushel_paper.slug (`Paper p)) papers;
40
-
{ slugs; papers; old_papers; notes; projects; ideas; videos; contacts; data_dir }
42
+
(* Build image index *)
43
+
let image_index = Hashtbl.create (List.length images) in
44
+
List.iter (fun img -> Hashtbl.add image_index (Srcsetter.slug img) img) images;
45
+
{ slugs; papers; old_papers; notes; projects; ideas; videos; contacts; images; image_index; data_dir }
41
46
42
47
(** {1 Accessors} *)
43
48
···
48
53
let notes { notes; _ } = notes
49
54
let projects { projects; _ } = projects
50
55
let old_papers { old_papers; _ } = old_papers
56
+
let images { images; _ } = images
51
57
let data_dir { data_dir; _ } = data_dir
58
+
59
+
(** {1 Image Lookup} *)
60
+
61
+
let lookup_image { image_index; _ } slug =
62
+
Hashtbl.find_opt image_index slug
52
63
53
64
(** {1 Lookup Functions} *)
54
65
+6
lib/bushel_entry.mli
+6
lib/bushel_entry.mli
···
29
29
ideas:Bushel_idea.t list ->
30
30
videos:Bushel_video.t list ->
31
31
contacts:Sortal_schema.Contact.t list ->
32
+
?images:Srcsetter.t list ->
32
33
data_dir:string ->
34
+
unit ->
33
35
t
34
36
(** Create an entry collection from lists of each entry type. *)
35
37
···
42
44
val notes : t -> Bushel_note.ts
43
45
val projects : t -> Bushel_project.ts
44
46
val old_papers : t -> Bushel_paper.ts
47
+
val images : t -> Srcsetter.t list
45
48
val data_dir : t -> string
46
49
47
50
(** {1 Lookup Functions} *)
51
+
52
+
val lookup_image : t -> string -> Srcsetter.t option
53
+
(** [lookup_image entries slug] finds an image by its slug. *)
48
54
49
55
val lookup : t -> string -> entry option
50
56
(** [lookup entries slug] finds an entry by its slug. *)
+207
lib/bushel_md.ml
+207
lib/bushel_md.ml
···
416
416
let slugs = Hashtbl.fold (fun k () a -> k :: a) broken_slugs [] in
417
417
let contacts = Hashtbl.fold (fun k () a -> k :: a) broken_contacts [] in
418
418
(slugs, contacts)
419
+
420
+
(** {1 Markdown to Markdown Conversion} *)
421
+
422
+
(** Create a mapper that converts Bushel markdown to standard markdown.
423
+
424
+
This resolves:
425
+
- [:slug] links to [Title](URL)
426
+
- [@@handle] to [Name](best_url)
427
+
- [##tag] to [tag](/tags/tag)
428
+
-  to 
429
+
*)
430
+
let make_to_markdown_mapper ?(base_url="") ?(image_base="/images") entries =
431
+
let open Cmarkit in
432
+
fun _m ->
433
+
function
434
+
| Inline.Link (lb, meta) ->
435
+
(match link_target_is_bushel lb with
436
+
| Some (url, title) ->
437
+
let s = strip_handle url in
438
+
if is_tag_slug url then
439
+
(* Tag link: ##tag -> [tag](/tags/tag) *)
440
+
let dest = base_url ^ "/tags/" ^ s in
441
+
let txt = Inline.Text (title, meta) in
442
+
let ld = Link_definition.make ~dest:(dest, meta) () in
443
+
let ll = `Inline (ld, meta) in
444
+
let link = Inline.Link.make txt ll in
445
+
Mapper.ret (Inline.Link (link, meta))
446
+
else if is_contact_slug url then
447
+
(* Contact link: @handle -> [Name](best_url) *)
448
+
(match List.find_opt (fun c -> Sortal_schema.Contact.handle c = s) (Bushel_entry.contacts entries) with
449
+
| Some c ->
450
+
let name = Sortal_schema.Contact.name c in
451
+
(match Sortal_schema.Contact.best_url c with
452
+
| Some dest ->
453
+
let txt = Inline.Text (name, meta) in
454
+
let ld = Link_definition.make ~dest:(dest, meta) () in
455
+
let ll = `Inline (ld, meta) in
456
+
let link = Inline.Link.make txt ll in
457
+
Mapper.ret (Inline.Link (link, meta))
458
+
| None ->
459
+
let txt = Inline.Text (name, meta) in
460
+
Mapper.ret txt)
461
+
| None ->
462
+
let txt = Inline.Text (title, meta) in
463
+
Mapper.ret txt)
464
+
else
465
+
(* Entry link: :slug -> [Title](URL) *)
466
+
let dest = base_url ^ Bushel_entry.lookup_site_url entries s in
467
+
let link_text =
468
+
if is_bushel_slug title then
469
+
match Bushel_entry.lookup entries (strip_handle title) with
470
+
| Some ent -> Bushel_entry.title ent
471
+
| None -> title
472
+
else title
473
+
in
474
+
let txt = Inline.Text (link_text, meta) in
475
+
let ld = Link_definition.make ~dest:(dest, meta) () in
476
+
let ll = `Inline (ld, meta) in
477
+
let link = Inline.Link.make txt ll in
478
+
Mapper.ret (Inline.Link (link, meta))
479
+
| None ->
480
+
(* Handle reference-style links *)
481
+
(match Inline.Link.referenced_label lb with
482
+
| Some l ->
483
+
let m = Label.meta l in
484
+
(match Meta.find authorlink m with
485
+
| Some () ->
486
+
let slug = Label.key l in
487
+
let s = strip_handle slug in
488
+
(match List.find_opt (fun c -> Sortal_schema.Contact.handle c = s) (Bushel_entry.contacts entries) with
489
+
| Some c ->
490
+
let name = Sortal_schema.Contact.name c in
491
+
(match Sortal_schema.Contact.best_url c with
492
+
| Some dest ->
493
+
let txt = Inline.Text (name, meta) in
494
+
let ld = Link_definition.make ~dest:(dest, meta) () in
495
+
let ll = `Inline (ld, meta) in
496
+
let link = Inline.Link.make txt ll in
497
+
Mapper.ret (Inline.Link (link, meta))
498
+
| None ->
499
+
let txt = Inline.Text (name, meta) in
500
+
Mapper.ret txt)
501
+
| None ->
502
+
let title = Inline.Link.text lb |> text_of_inline in
503
+
let txt = Inline.Text (title, meta) in
504
+
Mapper.ret txt)
505
+
| None ->
506
+
(match Meta.find sluglink m with
507
+
| Some () ->
508
+
let slug = Label.key l in
509
+
if is_bushel_slug slug then
510
+
let s = strip_handle slug in
511
+
let dest = base_url ^ Bushel_entry.lookup_site_url entries s in
512
+
let title = Inline.Link.text lb |> text_of_inline in
513
+
let link_text =
514
+
let trimmed = String.trim title in
515
+
if is_bushel_slug trimmed then
516
+
match Bushel_entry.lookup entries (strip_handle trimmed) with
517
+
| Some ent -> Bushel_entry.title ent
518
+
| None -> title
519
+
else title
520
+
in
521
+
let txt = Inline.Text (link_text, meta) in
522
+
let ld = Link_definition.make ~dest:(dest, meta) () in
523
+
let ll = `Inline (ld, meta) in
524
+
let link = Inline.Link.make txt ll in
525
+
Mapper.ret (Inline.Link (link, meta))
526
+
else if is_tag_slug slug then
527
+
let s = strip_handle slug in
528
+
let dest = base_url ^ "/tags/" ^ s in
529
+
let title = Inline.Link.text lb |> text_of_inline in
530
+
let txt = Inline.Text (title, meta) in
531
+
let ld = Link_definition.make ~dest:(dest, meta) () in
532
+
let ll = `Inline (ld, meta) in
533
+
let link = Inline.Link.make txt ll in
534
+
Mapper.ret (Inline.Link (link, meta))
535
+
else Mapper.default
536
+
| None -> Mapper.default))
537
+
| None -> Mapper.default))
538
+
| Inline.Image (lb, meta) ->
539
+
(match image_target_is_bushel lb with
540
+
| Some (url, alt, caption) ->
541
+
(* Image:  *)
542
+
let s = strip_handle url in
543
+
(* Convert Block_line.tight list option to string *)
544
+
let title_text = match alt with
545
+
| Some lines ->
546
+
String.concat "" (List.map Cmarkit.Block_line.tight_to_string lines)
547
+
| None -> ""
548
+
in
549
+
(* Check if this is a video embed *)
550
+
(match Bushel_entry.lookup entries s with
551
+
| Some (`Video v) ->
552
+
(* Video embed: rewrite watch URL to embed URL *)
553
+
let video_url = Bushel_video.url v in
554
+
let embed_url =
555
+
let uri = Uri.of_string video_url in
556
+
let path = Uri.path uri |> String.split_on_char '/' in
557
+
let path = List.map (function "watch" -> "embed" | p -> p) path in
558
+
Uri.with_path uri (String.concat "/" path) |> Uri.to_string
559
+
in
560
+
let html = Printf.sprintf
561
+
{|<div class="video-center"><iframe title="%s" width="100%%" height="315px" src="%s" frameborder="0" allowfullscreen sandbox="allow-same-origin allow-scripts allow-popups allow-forms"></iframe></div>|}
562
+
title_text embed_url
563
+
in
564
+
let raw_html = Cmarkit.Block_line.tight_list_of_string html in
565
+
Mapper.ret (Inline.Raw_html (raw_html, meta))
566
+
| _ ->
567
+
(* Image handling *)
568
+
let img_info = Bushel_entry.lookup_image entries s in
569
+
let dest = match img_info with
570
+
| Some img -> image_base ^ "/" ^ Srcsetter.name img
571
+
| None -> image_base ^ "/" ^ s ^ ".webp"
572
+
in
573
+
(* Check for special positioning directives *)
574
+
(match caption with
575
+
| "%c" | "%r" | "%lc" | "%rc" ->
576
+
(* Generate HTML figure element *)
577
+
let fig_class = match caption with
578
+
| "%c" -> "image-center"
579
+
| "%r" -> "image-right"
580
+
| "%lc" -> "image-left-float"
581
+
| "%rc" -> "image-right-float"
582
+
| _ -> "image-center"
583
+
in
584
+
(* Build srcset if we have image info *)
585
+
let srcset_attr = match img_info with
586
+
| Some img ->
587
+
let variants = Srcsetter.variants img in
588
+
let srcset_parts = Srcsetter.MS.fold (fun name (w, _h) acc ->
589
+
Printf.sprintf "%s/%s %dw" image_base name w :: acc
590
+
) variants [] in
591
+
if srcset_parts = [] then ""
592
+
else Printf.sprintf " srcset=\"%s\"" (String.concat ", " srcset_parts)
593
+
| None -> ""
594
+
in
595
+
let html = Printf.sprintf
596
+
{|<figure class="%s"><img src="%s" alt="%s" title="%s" loading="lazy"%s><figcaption>%s</figcaption></figure>|}
597
+
fig_class dest title_text title_text srcset_attr title_text
598
+
in
599
+
(* Create raw HTML as a tight block line list *)
600
+
let raw_html = Cmarkit.Block_line.tight_list_of_string html in
601
+
Mapper.ret (Inline.Raw_html (raw_html, meta))
602
+
| _ ->
603
+
(* Regular image:  *)
604
+
let txt = Inline.Text (caption, meta) in
605
+
let ld = Link_definition.make ?title:alt ~dest:(dest, meta) () in
606
+
let ll = `Inline (ld, meta) in
607
+
let img = Inline.Link.make txt ll in
608
+
Mapper.ret (Inline.Image (img, meta))))
609
+
| None -> Mapper.default)
610
+
| _ -> Mapper.default
611
+
612
+
(** Convert Bushel markdown to standard markdown.
613
+
614
+
@param base_url Base URL prefix for entry links (default: "")
615
+
@param image_base Base path for images (default: "/images")
616
+
@param entries The entry collection for resolving links
617
+
@param md The Bushel-flavored markdown text
618
+
@return Standard markdown with all Bushel extensions resolved
619
+
*)
620
+
let to_markdown ?(base_url="") ?(image_base="/images") ~entries md =
621
+
let open Cmarkit in
622
+
let doc = Doc.of_string ~strict:false ~resolver:with_bushel_links md in
623
+
let mapper = Mapper.make ~inline:(make_to_markdown_mapper ~base_url ~image_base entries) () in
624
+
let mapped_doc = Mapper.map_doc mapper doc in
625
+
Cmarkit_commonmark.of_doc mapped_doc
+2
-1
lib/dune
+2
-1
lib/dune
+7
-2
lib_eio/bushel_loader.ml
+7
-2
lib_eio/bushel_loader.ml
···
120
120
Bushel.Paper.tv papers
121
121
122
122
(** Load all entries from a base directory *)
123
-
let rec load fs base =
123
+
let rec load ?image_output_dir fs base =
124
124
Log.info (fun m -> m "Loading bushel data from %s" base);
125
125
let contacts = load_contacts fs base in
126
126
Log.info (fun m -> m "Loaded %d contacts" (List.length contacts));
···
134
134
Log.info (fun m -> m "Loaded %d videos" (List.length videos));
135
135
let papers = load_papers fs base in
136
136
Log.info (fun m -> m "Loaded %d papers" (List.length papers));
137
+
let images = match image_output_dir with
138
+
| Some output_dir -> load_images fs ~output_dir
139
+
| None -> []
140
+
in
141
+
Log.info (fun m -> m "Loaded %d images" (List.length images));
137
142
let data_dir = Filename.concat base "data" in
138
-
let entries = Bushel.Entry.v ~papers ~notes ~projects ~ideas ~videos ~contacts ~data_dir in
143
+
let entries = Bushel.Entry.v ~papers ~notes ~projects ~ideas ~videos ~contacts ~images ~data_dir () in
139
144
Log.info (fun m -> m "Building link graph");
140
145
let graph = build_link_graph entries in
141
146
Bushel.Link_graph.set_graph graph;