My aggregated monorepo of OCaml code, automaintained
Port full thumbnail logic and show thumbnails in CLI
- Port thumbnail_slug from old bushel with full fallback chain:
ideas use supervisor faces (active) or project image (completed),
notes try titleimage -> first image -> first video -> slug_ent
- Port thumbnail with project fallback to supervisor faces
- Fix [##tag] reference-style links to strip prefix and use # as dest
- Show thumbnail slug column in bushel list and bushel show
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+151
-18
+9
-1
ocaml-bushel/bin/main.ml
+9
-1
ocaml-bushel/bin/main.ml
···
158
158
in
159
159
(* Build table *)
160
160
let rows = List.map (fun e ->
161
+
let thumb = match Bushel.Entry.thumbnail_slug entries e with
162
+
| Some s -> s
163
+
| None -> "-"
164
+
in
161
165
[ type_string e
162
166
; Bushel.Entry.slug e
163
167
; truncate 50 (Bushel.Entry.title e)
164
168
; format_date (Bushel.Entry.date e)
169
+
; thumb
165
170
]
166
171
) limited in
167
172
let table = Table.make
168
-
~headers:["TYPE"; "SLUG"; "TITLE"; "DATE"]
173
+
~headers:["TYPE"; "SLUG"; "TITLE"; "DATE"; "THUMBNAIL"]
169
174
rows
170
175
in
171
176
Table.print table;
···
235
240
Printf.printf "Title: %s\n" (Bushel.Entry.title entry);
236
241
Printf.printf "Date: %s\n" (format_date (Bushel.Entry.date entry));
237
242
Printf.printf "URL: %s\n" (Bushel.Entry.site_url entry);
243
+
(match Bushel.Entry.thumbnail_slug entries entry with
244
+
| Some s -> Printf.printf "Thumbnail: %s\n" s
245
+
| None -> Printf.printf "Thumbnail: -\n");
238
246
(match Bushel.Entry.synopsis entry with
239
247
| Some s -> Printf.printf "Synopsis: %s\n" s
240
248
| None -> ());
+139
-14
ocaml-bushel/lib/bushel_entry.ml
+139
-14
ocaml-bushel/lib/bushel_entry.ml
···
237
237
| Some img -> Some (smallest_webp_variant img)
238
238
| None -> None
239
239
240
-
(** Get thumbnail slug for an entry - simple version *)
240
+
(** Extract the first image URL from markdown text *)
241
+
let extract_first_image md =
242
+
let open Cmarkit in
243
+
let doc = Doc.of_string md in
244
+
let found_image = ref None in
245
+
let find_image_in_inline _mapper = function
246
+
| Inline.Image (img, _) ->
247
+
(match Inline.Link.reference img with
248
+
| `Inline (ld, _) ->
249
+
(match Link_definition.dest ld with
250
+
| Some (url, _) when !found_image = None ->
251
+
found_image := Some url;
252
+
Mapper.default
253
+
| _ -> Mapper.default)
254
+
| _ -> Mapper.default)
255
+
| _ -> Mapper.default
256
+
in
257
+
let mapper = Mapper.make ~inline:find_image_in_inline () in
258
+
let _ = Mapper.map_doc mapper doc in
259
+
!found_image
260
+
261
+
(** Extract the first video slug from markdown text by looking for bushel video links *)
262
+
let extract_first_video entries md =
263
+
let open Cmarkit in
264
+
let doc = Doc.of_string md in
265
+
let found_video = ref None in
266
+
let find_video_in_inline _mapper = function
267
+
| Inline.Link (link, _) ->
268
+
(match Inline.Link.reference link with
269
+
| `Inline (ld, _) ->
270
+
(match Link_definition.dest ld with
271
+
| Some (url, _) when !found_video = None && String.starts_with ~prefix:":" url ->
272
+
let slug = String.sub url 1 (String.length url - 1) in
273
+
(match lookup entries slug with
274
+
| Some (`Video v) ->
275
+
found_video := Some (Bushel_video.uuid v);
276
+
Mapper.default
277
+
| _ -> Mapper.default)
278
+
| _ -> Mapper.default)
279
+
| _ -> Mapper.default)
280
+
| _ -> Mapper.default
281
+
in
282
+
let mapper = Mapper.make ~inline:find_video_in_inline () in
283
+
let _ = Mapper.map_doc mapper doc in
284
+
!found_video
285
+
286
+
(** Get thumbnail slug for an entry with fallbacks *)
241
287
let rec thumbnail_slug entries = function
242
288
| `Paper p -> Some (Bushel_paper.slug p)
243
289
| `Video v -> Some (Bushel_video.uuid v)
244
290
| `Project p -> Some (Printf.sprintf "project-%s" (Bushel_project.slug p))
245
291
| `Idea i ->
246
-
(* Use project thumbnail for ideas *)
247
-
let project_slug = Bushel_idea.project i in
248
-
(match lookup entries project_slug with
249
-
| Some p -> thumbnail_slug entries p
250
-
| None -> None)
292
+
let is_active = match Bushel_idea.status i with
293
+
| Bushel_idea.Available | Bushel_idea.Discussion | Bushel_idea.Ongoing -> true
294
+
| Bushel_idea.Completed | Bushel_idea.Expired -> false
295
+
in
296
+
if is_active then
297
+
(* Use first supervisor's face image *)
298
+
let supervisors = Bushel_idea.supervisors i in
299
+
match supervisors with
300
+
| sup :: _ ->
301
+
let handle = if String.length sup > 0 && sup.[0] = '@'
302
+
then String.sub sup 1 (String.length sup - 1)
303
+
else sup
304
+
in
305
+
(match List.find_opt (fun c -> Sortal_schema.Contact.handle c = handle) (contacts entries) with
306
+
| Some c ->
307
+
Some (Sortal_schema.Contact.handle c)
308
+
| None ->
309
+
(* Fallback to project thumbnail *)
310
+
let project_slug = Bushel_idea.project i in
311
+
(match lookup entries project_slug with
312
+
| Some p -> thumbnail_slug entries p
313
+
| None -> None))
314
+
| [] ->
315
+
(* No supervisors, use project thumbnail *)
316
+
let project_slug = Bushel_idea.project i in
317
+
(match lookup entries project_slug with
318
+
| Some p -> thumbnail_slug entries p
319
+
| None -> None)
320
+
else
321
+
(* Use project thumbnail for completed/expired ideas *)
322
+
let project_slug = Bushel_idea.project i in
323
+
(match lookup entries project_slug with
324
+
| Some p -> thumbnail_slug entries p
325
+
| None -> None)
251
326
| `Note n ->
252
-
(* Use titleimage if set, otherwise try slug_ent's thumbnail *)
327
+
(* Use titleimage if set, otherwise extract first image from body,
328
+
then try video, otherwise use slug_ent's thumbnail *)
253
329
(match Bushel_note.titleimage n with
254
330
| Some slug -> Some slug
255
331
| None ->
256
-
match Bushel_note.slug_ent n with
257
-
| Some slug_ent ->
258
-
(match lookup entries slug_ent with
259
-
| Some entry -> thumbnail_slug entries entry
260
-
| None -> None)
261
-
| None -> None)
332
+
match extract_first_image (Bushel_note.body n) with
333
+
| Some url when String.starts_with ~prefix:":" url ->
334
+
Some (String.sub url 1 (String.length url - 1))
335
+
| Some _ -> None
336
+
| None ->
337
+
match extract_first_video entries (Bushel_note.body n) with
338
+
| Some video_uuid -> Some video_uuid
339
+
| None ->
340
+
(* Fallback to slug_ent's thumbnail if present *)
341
+
match Bushel_note.slug_ent n with
342
+
| Some slug_ent ->
343
+
(match lookup entries slug_ent with
344
+
| Some entry -> thumbnail_slug entries entry
345
+
| None -> None)
346
+
| None -> None)
262
347
263
348
(** Get thumbnail URL for an entry with fallbacks - resolved through srcsetter *)
264
349
let thumbnail entries entry =
···
267
352
| Some thumb_slug ->
268
353
match lookup_image entries thumb_slug with
269
354
| Some img -> Some (smallest_webp_variant img)
270
-
| None -> None
355
+
| None ->
356
+
(* For projects, fallback to supervisor faces if project image doesn't exist *)
357
+
(match entry with
358
+
| `Project p ->
359
+
(* Find ideas for this project *)
360
+
let project_ideas = List.filter (fun idea ->
361
+
Bushel_idea.project idea = ":" ^ Bushel_project.slug p
362
+
) (ideas entries) in
363
+
(* Collect all unique supervisors from these ideas *)
364
+
let all_supervisors =
365
+
List.fold_left (fun acc idea ->
366
+
List.fold_left (fun acc2 sup ->
367
+
if List.mem sup acc2 then acc2 else sup :: acc2
368
+
) acc (Bushel_idea.supervisors idea)
369
+
) [] project_ideas
370
+
in
371
+
(* Split into avsm and others, preferring others first *)
372
+
let (others, avsm) = List.partition (fun sup ->
373
+
let handle = if String.length sup > 0 && sup.[0] = '@'
374
+
then String.sub sup 1 (String.length sup - 1)
375
+
else sup
376
+
in
377
+
handle <> "avsm"
378
+
) all_supervisors in
379
+
let ordered_supervisors = others @ avsm in
380
+
let rec try_supervisors = function
381
+
| [] -> None
382
+
| sup :: rest ->
383
+
let handle = if String.length sup > 0 && sup.[0] = '@'
384
+
then String.sub sup 1 (String.length sup - 1)
385
+
else sup
386
+
in
387
+
(match List.find_opt (fun c -> Sortal_schema.Contact.handle c = handle) (contacts entries) with
388
+
| Some c ->
389
+
(match lookup_image entries (Sortal_schema.Contact.handle c) with
390
+
| Some img -> Some (smallest_webp_variant img)
391
+
| None -> try_supervisors rest)
392
+
| None -> try_supervisors rest)
393
+
in
394
+
try_supervisors ordered_supervisors
395
+
| _ -> None)
+3
-3
ocaml-bushel/lib/bushel_md.ml
+3
-3
ocaml-bushel/lib/bushel_md.ml
···
216
216
let link = Inline.Link.make txt ll in
217
217
Mapper.ret (Inline.Link (link, meta)))
218
218
else if is_tag_slug slug then
219
-
let title = Inline.Link.text lb |> text_of_inline in
220
-
let txt = Inline.Text (title, meta) in
221
-
let ld = Link_definition.make ~dest:(slug, meta) () in
219
+
let sh = strip_handle slug in
220
+
let txt = Inline.Text (sh, meta) in
221
+
let ld = Link_definition.make ~dest:("#", meta) () in
222
222
let ll = `Inline (ld, meta) in
223
223
let link = Inline.Link.make txt ll in
224
224
Mapper.ret (Inline.Link (link, meta))