+105 -6

ocaml-bushel/bin/main.ml

reviewed

··· 184 184 | Error e -> Printf.eprintf "Config error: %s\n" e; 1 185 185 | Ok config -> 186 186 let data_dir = get_data_dir config data_dir in 187 187 - with_entries data_dir @@ fun _env entries -> 187 187 + Eio_main.run @@ fun env -> 188 188 + let fs = Eio.Stdenv.fs env in 189 189 + let entries = Bushel_eio.Bushel_loader.load fs data_dir in 188 190 let papers = List.length (Bushel.Entry.papers entries) in 189 191 let notes = List.length (Bushel.Entry.notes entries) in 190 192 let projects = List.length (Bushel.Entry.projects entries) in 191 193 let ideas = List.length (Bushel.Entry.ideas entries) in 192 194 let videos = List.length (Bushel.Entry.videos entries) in 193 195 let contacts = List.length (Bushel.Entry.contacts entries) in 196 196 + let images = List.length (Bushel_eio.Bushel_loader.load_images fs 197 197 + ~output_dir:config.Bushel_config.local_output_dir) in 194 198 Printf.printf "Bushel Statistics\n"; 195 199 Printf.printf "=================\n"; 196 200 Printf.printf "Papers: %4d\n" papers; ··· 199 203 Printf.printf "Ideas: %4d\n" ideas; 200 204 Printf.printf "Videos: %4d\n" videos; 201 205 Printf.printf "Contacts: %4d\n" contacts; 206 206 + Printf.printf "Images: %4d\n" images; 202 207 Printf.printf "-----------------\n"; 203 208 Printf.printf "Total: %4d\n" (papers + notes + projects + ideas + videos); 204 209 0 ··· 247 252 let doc = "Also upload to Typesense (remote sync)." in 248 253 Arg.(value & flag & info ["remote"] ~doc) 249 254 in 255 255 + let dry_run = 256 256 + let doc = "Show what commands would be run without executing them." in 257 257 + Arg.(value & flag & info ["dry-run"; "n"] ~doc) 258 258 + in 250 259 let only = 251 260 let doc = "Only run specific step (images, srcsetter, thumbs, faces, videos, typesense)." in 252 261 Arg.(value & opt (some string) None & info ["only"] ~docv:"STEP" ~doc) 253 262 in 254 254 - let run () config_file data_dir remote only = 263 263 + let run () config_file data_dir remote dry_run only = 255 264 match load_config config_file with 256 265 | Error e -> Printf.eprintf "Config error: %s\n" e; 1 257 266 | Ok config -> ··· 274 283 let fs = Eio.Stdenv.fs env in 275 284 let entries = Bushel_eio.Bushel_loader.load fs data_dir in 276 285 277 277 - Printf.printf "Running sync pipeline...\n"; 286 286 + Printf.printf "%s sync pipeline...\n" (if dry_run then "Dry-run" else "Running"); 278 287 List.iter (fun step -> 279 288 Printf.printf " - %s\n" (Bushel_sync.string_of_step step) 280 289 ) steps; 281 290 Printf.printf "\n"; 282 291 283 283 - let results = Bushel_sync.run ~env ~config ~steps ~entries in 292 292 + let results = Bushel_sync.run ~dry_run ~env ~config ~steps ~entries in 284 293 285 294 Printf.printf "\nResults:\n"; 286 295 List.iter (fun r -> ··· 288 297 Printf.printf " [%s] %s: %s\n" 289 298 status 290 299 (Bushel_sync.string_of_step r.step) 291 291 - r.message 300 300 + r.message; 301 301 + (* In dry-run mode, show the details (commands) *) 302 302 + if dry_run && r.Bushel_sync.details <> [] then begin 303 303 + List.iter (fun d -> Printf.printf " %s\n" d) r.Bushel_sync.details 304 304 + end 292 305 ) results; 293 306 294 307 let failures = List.filter (fun r -> not r.Bushel_sync.success) results in ··· 304 317 `P "4. $(b,faces) - Fetch contact face thumbnails from Immich"; 305 318 `P "5. $(b,videos) - Fetch video thumbnails from PeerTube"; 306 319 `P "6. $(b,typesense) - Upload to Typesense (with --remote)"; 320 320 + `P "Use $(b,--dry-run) to see what commands would be run without executing them."; 307 321 ] in 308 322 let info = Cmd.info "sync" ~doc ~man in 309 309 - Cmd.v info Term.(const run $ logging_t $ config_file $ data_dir $ remote $ only) 323 323 + Cmd.v info Term.(const run $ logging_t $ config_file $ data_dir $ remote $ dry_run $ only) 310 324 311 325 (** {1 Paper Add Command} *) 312 326 ··· 506 520 let info = Cmd.info "video" ~doc in 507 521 Cmd.v info Term.(const run $ logging_t $ config_file $ data_dir $ server $ channel) 508 522 523 523 + (** {1 Images Command} *) 524 524 + 525 525 + let images_cmd = 526 526 + let limit = 527 527 + let doc = "Maximum number of images to show." in 528 528 + Arg.(value & opt (some int) None & info ["n"; "limit"] ~docv:"N" ~doc) 529 529 + in 530 530 + let sort_by = 531 531 + let doc = "Sort by field (slug, width, height, variants). Default: slug." in 532 532 + Arg.(value & opt string "slug" & info ["s"; "sort"] ~docv:"FIELD" ~doc) 533 533 + in 534 534 + let run () config_file limit sort_by = 535 535 + match load_config config_file with 536 536 + | Error e -> Printf.eprintf "Config error: %s\n" e; 1 537 537 + | Ok config -> 538 538 + Eio_main.run @@ fun env -> 539 539 + let fs = Eio.Stdenv.fs env in 540 540 + let output_dir = config.Bushel_config.local_output_dir in 541 541 + let images = Bushel_eio.Bushel_loader.load_images fs ~output_dir in 542 542 + if images = [] then begin 543 543 + Printf.printf "No images found.\n"; 544 544 + Printf.printf "Run 'bushel sync' to generate image index.\n"; 545 545 + 0 546 546 + end else begin 547 547 + (* Sort *) 548 548 + let sorted = match sort_by with 549 549 + | "width" -> 550 550 + List.sort (fun a b -> 551 551 + let (wa, _) = Srcsetter.dims a in 552 552 + let (wb, _) = Srcsetter.dims b in 553 553 + compare wb wa (* largest first *) 554 554 + ) images 555 555 + | "height" -> 556 556 + List.sort (fun a b -> 557 557 + let (_, ha) = Srcsetter.dims a in 558 558 + let (_, hb) = Srcsetter.dims b in 559 559 + compare hb ha (* largest first *) 560 560 + ) images 561 561 + | "variants" -> 562 562 + List.sort (fun a b -> 563 563 + let va = Srcsetter.MS.cardinal (Srcsetter.variants a) in 564 564 + let vb = Srcsetter.MS.cardinal (Srcsetter.variants b) in 565 565 + compare vb va (* most variants first *) 566 566 + ) images 567 567 + | _ -> (* slug, default *) 568 568 + List.sort (fun a b -> 569 569 + String.compare (Srcsetter.slug a) (Srcsetter.slug b) 570 570 + ) images 571 571 + in 572 572 + (* Limit *) 573 573 + let limited = match limit with 574 574 + | None -> sorted 575 575 + | Some n -> List.filteri (fun i _ -> i < n) sorted 576 576 + in 577 577 + (* Build table *) 578 578 + let rows = List.map (fun img -> 579 579 + let (w, h) = Srcsetter.dims img in 580 580 + let num_variants = Srcsetter.MS.cardinal (Srcsetter.variants img) in 581 581 + [ Srcsetter.slug img 582 582 + ; Printf.sprintf "%dx%d" w h 583 583 + ; string_of_int num_variants 584 584 + ; Srcsetter.origin img 585 585 + ] 586 586 + ) limited in 587 587 + let table = Table.make 588 588 + ~headers:["SLUG"; "DIMS"; "VARIANTS"; "ORIGIN"] 589 589 + rows 590 590 + in 591 591 + Table.print table; 592 592 + Printf.printf "\nTotal: %d images\n" (List.length limited); 593 593 + 0 594 594 + end 595 595 + in 596 596 + let doc = "List images from the srcsetter index." in 597 597 + let man = [ 598 598 + `S Manpage.s_description; 599 599 + `P "Lists images that have been processed by srcsetter."; 600 600 + `P "Images are stored separately from other entries and are referenced \ 601 601 + by slug in markdown content using the :slug syntax."; 602 602 + `P "Run $(b,bushel sync) to process images and generate the index."; 603 603 + ] in 604 604 + let info = Cmd.info "images" ~doc ~man in 605 605 + Cmd.v info Term.(const run $ logging_t $ config_file $ limit $ sort_by) 606 606 + 509 607 (** {1 Config Command} *) 510 608 511 609 let config_cmd = ··· 573 671 Cmd.group info [ 574 672 init_cmd; 575 673 list_cmd; 674 674 + images_cmd; 576 675 stats_cmd; 577 676 show_cmd; 578 677 sync_cmd;

-4

ocaml-bushel/lib/bushel.ml

reviewed

··· 12 12 13 13 {1 Entry Types} 14 14 15 15 - - {!Contact} - People/researchers with social links 16 15 - {!Note} - Blog posts and research notes 17 16 - {!Paper} - Academic papers with BibTeX metadata 18 17 - {!Project} - Research projects ··· 44 43 *) 45 44 46 45 (** {1 Entry Types} *) 47 47 - 48 48 - module Contact = Bushel_contact 49 49 - (** Contact/person entries. *) 50 46 51 47 module Note = Bushel_note 52 48 (** Blog post and research note entries. *)

-154

ocaml-bushel/lib/bushel_contact.ml

reviewed

··· 1 1 - (*--------------------------------------------------------------------------- 2 2 - Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 3 - SPDX-License-Identifier: ISC 4 4 - ---------------------------------------------------------------------------*) 5 5 - 6 6 - (** Contact/person entry type for Bushel *) 7 7 - 8 8 - type t = { 9 9 - names : string list; 10 10 - handle : string; 11 11 - email : string option; 12 12 - icon : string option; 13 13 - github : string option; 14 14 - twitter : string option; 15 15 - bluesky : string option; 16 16 - mastodon : string option; 17 17 - orcid : string option; 18 18 - url : string option; 19 19 - atom : string list option; 20 20 - } 21 21 - 22 22 - type ts = t list 23 23 - 24 24 - (** {1 Constructors} *) 25 25 - 26 26 - let v ?email ?github ?twitter ?bluesky ?mastodon ?orcid ?icon ?url ?atom handle names = 27 27 - { names; handle; email; github; twitter; bluesky; mastodon; orcid; url; icon; atom } 28 28 - 29 29 - let make names email icon github twitter bluesky mastodon orcid url atom = 30 30 - v ?email ?github ?twitter ?bluesky ?mastodon ?orcid ?icon ?url ?atom "" names 31 31 - 32 32 - (** {1 Accessors} *) 33 33 - 34 34 - let names { names; _ } = names 35 35 - 36 36 - let name c = 37 37 - match c.names with 38 38 - | n :: _ -> n 39 39 - | [] -> failwith (Printf.sprintf "Contact with handle '%s' has empty names list" c.handle) 40 40 - 41 41 - let handle { handle; _ } = handle 42 42 - let email { email; _ } = email 43 43 - let icon { icon; _ } = icon 44 44 - let github { github; _ } = github 45 45 - let twitter { twitter; _ } = twitter 46 46 - let bluesky { bluesky; _ } = bluesky 47 47 - let mastodon { mastodon; _ } = mastodon 48 48 - let orcid { orcid; _ } = orcid 49 49 - let url { url; _ } = url 50 50 - let atom { atom; _ } = atom 51 51 - 52 52 - (** {1 Jsont Codec} *) 53 53 - 54 54 - let jsont : t Jsont.t = 55 55 - let open Jsont in 56 56 - let open Jsont.Object in 57 57 - let mem_opt f v ~enc = mem f v ~dec_absent:None ~enc_omit:Option.is_none ~enc in 58 58 - map ~kind:"Contact" make 59 59 - |> mem "names" (list string) ~dec_absent:[] ~enc:names 60 60 - |> mem_opt "email" (some string) ~enc:email 61 61 - |> mem_opt "icon" (some string) ~enc:icon 62 62 - |> mem_opt "github" (some string) ~enc:github 63 63 - |> mem_opt "twitter" (some string) ~enc:twitter 64 64 - |> mem_opt "bluesky" (some string) ~enc:bluesky 65 65 - |> mem_opt "mastodon" (some string) ~enc:mastodon 66 66 - |> mem_opt "orcid" (some string) ~enc:orcid 67 67 - |> mem_opt "url" (some string) ~enc:url 68 68 - |> mem_opt "atom" (some (list string)) ~enc:atom 69 69 - |> finish 70 70 - 71 71 - (** {1 Parsing} *) 72 72 - 73 73 - let of_frontmatter ~handle (fm : Frontmatter.t) : (t, string) result = 74 74 - match Frontmatter.decode jsont fm with 75 75 - | Ok c -> Ok { c with handle } 76 76 - | Error e -> Error e 77 77 - 78 78 - (** {1 Lookup Functions} *) 79 79 - 80 80 - let compare a b = String.compare a.handle b.handle 81 81 - 82 82 - let find_by_handle ts h = List.find_opt (fun { handle; _ } -> handle = h) ts 83 83 - 84 84 - let best_url c = 85 85 - match c.url with 86 86 - | Some _ as url -> url 87 87 - | None -> 88 88 - match c.github with 89 89 - | Some g -> Some ("https://github.com/" ^ g) 90 90 - | None -> Option.map (fun e -> "mailto:" ^ e) c.email 91 91 - 92 92 - (** Given a name, turn it lowercase and return the concatenation of the 93 93 - initials of all the words in the name and the full last name. *) 94 94 - let handle_of_name name = 95 95 - let name = String.lowercase_ascii name in 96 96 - let words = String.split_on_char ' ' name in 97 97 - let initials = String.concat "" (List.map (fun w -> String.sub w 0 1) words) in 98 98 - initials ^ List.hd (List.rev words) 99 99 - 100 100 - (** Fuzzy lookup for an author by name. *) 101 101 - let lookup_by_name ts a = 102 102 - let a = String.lowercase_ascii a in 103 103 - let rec aux acc = function 104 104 - | [] -> acc 105 105 - | t :: ts -> 106 106 - if List.exists (fun n -> String.lowercase_ascii n = a) t.names 107 107 - then aux (t :: acc) ts 108 108 - else aux acc ts 109 109 - in 110 110 - match aux [] ts with 111 111 - | [ a ] -> a 112 112 - | [] -> raise (Failure ("Contact not found: " ^ a)) 113 113 - | _ -> raise (Failure ("Ambiguous contact: " ^ a)) 114 114 - 115 115 - (** {1 Pretty Printing} *) 116 116 - 117 117 - let pp ppf c = 118 118 - let open Fmt in 119 119 - pf ppf "@[<v>"; 120 120 - pf ppf "%a: %a@," (styled `Bold string) "Type" (styled `Cyan string) "Contact"; 121 121 - pf ppf "%a: @%a@," (styled `Bold string) "Handle" string (handle c); 122 122 - pf ppf "%a: %a@," (styled `Bold string) "Name" string (name c); 123 123 - let ns = names c in 124 124 - if List.length ns > 1 then 125 125 - pf ppf "%a: @[<h>%a@]@," (styled `Bold string) "Aliases" (list ~sep:comma string) (List.tl ns); 126 126 - (match email c with 127 127 - | Some e -> pf ppf "%a: %a@," (styled `Bold string) "Email" string e 128 128 - | None -> ()); 129 129 - (match github c with 130 130 - | Some g -> pf ppf "%a: https://github.com/%a@," (styled `Bold string) "GitHub" string g 131 131 - | None -> ()); 132 132 - (match twitter c with 133 133 - | Some t -> pf ppf "%a: https://twitter.com/%a@," (styled `Bold string) "Twitter" string t 134 134 - | None -> ()); 135 135 - (match bluesky c with 136 136 - | Some b -> pf ppf "%a: %a@," (styled `Bold string) "Bluesky" string b 137 137 - | None -> ()); 138 138 - (match mastodon c with 139 139 - | Some m -> pf ppf "%a: %a@," (styled `Bold string) "Mastodon" string m 140 140 - | None -> ()); 141 141 - (match orcid c with 142 142 - | Some o -> pf ppf "%a: https://orcid.org/%a@," (styled `Bold string) "ORCID" string o 143 143 - | None -> ()); 144 144 - (match url c with 145 145 - | Some u -> pf ppf "%a: %a@," (styled `Bold string) "URL" string u 146 146 - | None -> ()); 147 147 - (match icon c with 148 148 - | Some i -> pf ppf "%a: %a@," (styled `Bold string) "Icon" string i 149 149 - | None -> ()); 150 150 - (match atom c with 151 151 - | Some atoms when atoms <> [] -> 152 152 - pf ppf "%a: @[<h>%a@]@," (styled `Bold string) "Atom Feeds" (list ~sep:comma string) atoms 153 153 - | _ -> ()); 154 154 - pf ppf "@]"

+9 -4

ocaml-bushel/lib/bushel_entry.ml

reviewed

··· 23 23 projects : Bushel_project.ts; 24 24 ideas : Bushel_idea.ts; 25 25 videos : Bushel_video.ts; 26 26 - contacts : Bushel_contact.ts; 26 26 + contacts : Sortal_schema.Contact.t list; 27 27 data_dir : string; 28 28 } 29 29 ··· 153 153 (** {1 Contact Lookups} *) 154 154 155 155 let lookup_by_name { contacts; _ } n = 156 156 - match Bushel_contact.lookup_by_name contacts n with 157 157 - | v -> Some v 158 158 - | exception _ -> None 156 156 + let name_lower = String.lowercase_ascii n in 157 157 + let matches = List.filter (fun c -> 158 158 + List.exists (fun name -> String.lowercase_ascii name = name_lower) 159 159 + (Sortal_schema.Contact.names c) 160 160 + ) contacts in 161 161 + match matches with 162 162 + | [contact] -> Some contact 163 163 + | _ -> None 159 164 160 165 (** {1 Tag Functions} *) 161 166

+3 -3

ocaml-bushel/lib/bushel_entry.mli

reviewed

··· 28 28 projects:Bushel_project.t list -> 29 29 ideas:Bushel_idea.t list -> 30 30 videos:Bushel_video.t list -> 31 31 - contacts:Bushel_contact.t list -> 31 31 + contacts:Sortal_schema.Contact.t list -> 32 32 data_dir:string -> 33 33 t 34 34 (** Create an entry collection from lists of each entry type. *) 35 35 36 36 (** {1 Accessors} *) 37 37 38 38 - val contacts : t -> Bushel_contact.ts 38 38 + val contacts : t -> Sortal_schema.Contact.t list 39 39 val videos : t -> Bushel_video.ts 40 40 val ideas : t -> Bushel_idea.ts 41 41 val papers : t -> Bushel_paper.ts ··· 111 111 112 112 (** {1 Contact Lookups} *) 113 113 114 114 - val lookup_by_name : t -> string -> Bushel_contact.t option 114 114 + val lookup_by_name : t -> string -> Sortal_schema.Contact.t option 115 115 (** [lookup_by_name entries name] finds a contact by name. *) 116 116 117 117 (** {1 Tag Functions} *)

+2 -2

ocaml-bushel/lib/bushel_link_graph.ml

reviewed

··· 144 144 ) (Bushel_entry.all_entries entries) in 145 145 146 146 let contact_nodes = List.map (fun contact -> 147 147 - let handle = Bushel_contact.handle contact in 148 148 - let name = Bushel_contact.name contact in 147 147 + let handle = Sortal_schema.Contact.handle contact in 148 148 + let name = Sortal_schema.Contact.name contact in 149 149 `O [ 150 150 ("id", `String handle); 151 151 ("title", `String name);

+5 -5

ocaml-bushel/lib/bushel_md.ml

reviewed

··· 137 137 | Some () -> 138 138 let slug = Label.key l in 139 139 let s = strip_handle slug in 140 140 - (match Bushel_contact.find_by_handle (Bushel_entry.contacts entries) s with 140 140 + (match List.find_opt (fun c -> Sortal_schema.Contact.handle c = s) (Bushel_entry.contacts entries) with 141 141 | Some c -> 142 142 - let name = Bushel_contact.name c in 143 143 - (match Bushel_contact.best_url c with 142 142 + let name = Sortal_schema.Contact.name c in 143 143 + (match Sortal_schema.Contact.best_url c with 144 144 | Some dest -> 145 145 let txt = Inline.Text (name, meta) in 146 146 let ld = Link_definition.make ~dest:(dest, meta) () in ··· 370 370 | Some (url, _title) -> 371 371 let s = strip_handle url in 372 372 if is_contact_slug url then 373 373 - (match Bushel_contact.find_by_handle (Bushel_entry.contacts entries) s with 373 373 + (match List.find_opt (fun c -> Sortal_schema.Contact.handle c = s) (Bushel_entry.contacts entries) with 374 374 | None -> Hashtbl.replace broken_contacts url () 375 375 | Some _ -> ()) 376 376 else if is_bushel_slug url then ··· 386 386 | Some () -> 387 387 let slug = Label.key l in 388 388 let handle = strip_handle slug in 389 389 - (match Bushel_contact.find_by_handle (Bushel_entry.contacts entries) handle with 389 389 + (match List.find_opt (fun c -> Sortal_schema.Contact.handle c = handle) (Bushel_entry.contacts entries) with 390 390 | None -> Hashtbl.replace broken_contacts slug () 391 391 | Some _ -> ()); 392 392 Mapper.default

+2 -1

ocaml-bushel/lib/dune

reviewed

··· 10 10 re 11 11 uri 12 12 fmt 13 13 - yamlrw)) 13 13 + yamlrw 14 14 + sortal.schema))

+25 -12

ocaml-bushel/lib_eio/bushel_loader.ml

reviewed

··· 8 8 let src = Logs.Src.create "bushel.loader" ~doc:"Bushel loader" 9 9 module Log = (val Logs.src_log src : Logs.LOG) 10 10 11 11 + (** Load images from srcsetter index.json *) 12 12 + let load_images fs ~output_dir = 13 13 + let index_path = Filename.concat output_dir "index.json" in 14 14 + let path = Eio.Path.(fs / index_path) in 15 15 + try 16 16 + let content = Eio.Path.load path in 17 17 + match Srcsetter.list_of_json content with 18 18 + | Ok images -> 19 19 + Log.info (fun m -> m "Loaded %d images from %s" (List.length images) index_path); 20 20 + images 21 21 + | Error e -> 22 22 + Log.warn (fun m -> m "Failed to parse %s: %s" index_path e); 23 23 + [] 24 24 + with 25 25 + | Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> 26 26 + Log.info (fun m -> m "No image index found at %s" index_path); 27 27 + [] 28 28 + 11 29 (** List markdown files in a directory *) 12 30 let list_md_files fs dir = 13 31 let path = Eio.Path.(fs / dir) in ··· 38 56 None 39 57 ) files 40 58 41 41 - (** Load contacts from data/contacts/ *) 42 42 - let load_contacts fs base = 43 43 - map_category fs base "contacts" (fun fm -> 44 44 - let handle = 45 45 - match Frontmatter.fname fm with 46 46 - | Some fname -> Filename.basename fname |> Filename.chop_extension 47 47 - | None -> "" 48 48 - in 49 49 - Bushel.Contact.of_frontmatter ~handle fm 50 50 - ) 59 59 + (** Load contacts from Sortal XDG store *) 60 60 + let load_contacts fs _base = 61 61 + let store = Sortal.Store.create fs "sortal" in 62 62 + Sortal.Store.list store 51 63 52 64 (** Load projects from data/projects/ *) 53 65 let load_projects fs base = ··· 165 177 | None -> ()) 166 178 else if Bushel.Md.is_contact_slug link then 167 179 let handle = Bushel.Md.strip_handle link in 168 168 - (match Bushel.Contact.find_by_handle (Bushel.Entry.contacts entries) handle with 180 180 + let contacts = Bushel.Entry.contacts entries in 181 181 + (match List.find_opt (fun c -> Sortal_schema.Contact.handle c = handle) contacts with 169 182 | Some c -> 170 170 - add_internal_link source_slug (Bushel.Contact.handle c) `Contact 183 183 + add_internal_link source_slug (Sortal_schema.Contact.handle c) `Contact 171 184 | None -> ()) 172 185 else if Bushel.Md.is_tag_slug link || Bushel.Md.is_type_filter_slug link then 173 186 () (* Skip tag links *)

+3 -1

ocaml-bushel/lib_eio/dune

reviewed

··· 5 5 bushel 6 6 frontmatter-eio 7 7 eio 8 8 - logs)) 8 8 + logs 9 9 + sortal 10 10 + srcsetter))

+3 -3

ocaml-bushel/lib_sync/bushel_immich.ml

reviewed

··· 73 73 (** {1 Contact Face Fetching} *) 74 74 75 75 let fetch_face_for_contact ~proc_mgr ~endpoint ~api_key ~output_dir contact = 76 76 - let names = Bushel.Contact.names contact in 77 77 - let handle = Bushel.Contact.handle contact in 76 76 + let names = Sortal_schema.Contact.names contact in 77 77 + let handle = Sortal_schema.Contact.handle contact in 78 78 let output_path = Filename.concat output_dir (handle ^ ".jpg") in 79 79 80 80 (* Skip if already exists *) ··· 113 113 Unix.mkdir output_dir 0o755; 114 114 115 115 let results = List.map (fun contact -> 116 116 - let handle = Bushel.Contact.handle contact in 116 116 + let handle = Sortal_schema.Contact.handle contact in 117 117 let result = fetch_face_for_contact ~proc_mgr ~endpoint ~api_key ~output_dir contact in 118 118 (handle, result) 119 119 ) contacts in

+223 -120

ocaml-bushel/lib_sync/bushel_sync.ml

reviewed

··· 55 55 | "typesense" -> Some Typesense 56 56 | _ -> None 57 57 58 58 - let all_steps = [Images; Srcsetter; Thumbs; Faces; Videos] 58 58 + let all_steps = [Images; Thumbs; Faces; Srcsetter; Videos] 59 59 let all_steps_with_remote = all_steps @ [Typesense] 60 60 61 61 (** {1 Step Results} *) ··· 77 77 78 78 (** {1 Rsync Images} *) 79 79 80 80 - let sync_images ~proc_mgr config = 80 80 + let sync_images ~dry_run ~fs ~proc_mgr config = 81 81 Log.info (fun m -> m "Syncing images from remote..."); 82 82 - let cmd = Bushel_config.rsync_command config in 83 83 - Log.debug (fun m -> m "Running: %s" cmd); 84 84 - 85 85 - (* Ensure local directory exists *) 86 82 let local_dir = config.Bushel_config.local_source_dir in 87 87 - if not (Sys.file_exists local_dir) then begin 88 88 - Log.info (fun m -> m "Creating directory: %s" local_dir); 89 89 - Unix.mkdir local_dir 0o755 90 90 - end; 83 83 + let args = ["rsync"; "-avz"; 84 84 + Bushel_config.rsync_source config ^ "/"; 85 85 + local_dir ^ "/"] in 86 86 + let cmd = String.concat " " args in 91 87 92 92 - try 93 93 - let args = ["rsync"; "-avz"; 94 94 - Bushel_config.rsync_source config ^ "/"; 95 95 - local_dir ^ "/"] in 96 96 - Eio.Process.run proc_mgr args; 88 88 + if dry_run then begin 97 89 { step = Images; success = true; 98 98 - message = "Images synced from remote"; 99 99 - details = [] } 100 100 - with e -> 101 101 - { step = Images; success = false; 102 102 - message = Printf.sprintf "Rsync failed: %s" (Printexc.to_string e); 103 103 - details = [] } 90 90 + message = "Would run rsync"; 91 91 + details = [cmd] } 92 92 + end else begin 93 93 + Log.debug (fun m -> m "Running: %s" cmd); 94 94 + 95 95 + (* Ensure local directory exists (recursive) *) 96 96 + let local_path = Eio.Path.(fs / local_dir) in 97 97 + Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 local_path; 98 98 + 99 99 + try 100 100 + Eio.Process.run proc_mgr args; 101 101 + { step = Images; success = true; 102 102 + message = "Images synced from remote"; 103 103 + details = [] } 104 104 + with e -> 105 105 + { step = Images; success = false; 106 106 + message = Printf.sprintf "Rsync failed: %s" (Printexc.to_string e); 107 107 + details = [] } 108 108 + end 104 109 105 110 (** {1 Srcsetter} *) 106 111 107 107 - let run_srcsetter ~proc_mgr config = 112 112 + let run_srcsetter ~dry_run ~fs ~proc_mgr config = 108 113 Log.info (fun m -> m "Running srcsetter..."); 109 114 let src_dir = config.Bushel_config.local_source_dir in 110 115 let dst_dir = config.Bushel_config.local_output_dir in 111 116 112 112 - (* Ensure output directory exists *) 113 113 - if not (Sys.file_exists dst_dir) then begin 114 114 - Log.info (fun m -> m "Creating directory: %s" dst_dir); 115 115 - Unix.mkdir dst_dir 0o755 116 116 - end; 117 117 - 118 118 - try 119 119 - let args = ["srcsetter"; src_dir; dst_dir] in 120 120 - Eio.Process.run proc_mgr args; 117 117 + if dry_run then begin 121 118 { step = Srcsetter; success = true; 122 122 - message = "Srcsetter completed"; 123 123 - details = [] } 124 124 - with e -> 125 125 - { step = Srcsetter; success = false; 126 126 - message = Printf.sprintf "Srcsetter failed: %s" (Printexc.to_string e); 127 127 - details = [] } 119 119 + message = "Would run srcsetter"; 120 120 + details = [Printf.sprintf "srcsetter %s %s" src_dir dst_dir] } 121 121 + end else begin 122 122 + (* Ensure output directory exists (recursive) *) 123 123 + let src_path = Eio.Path.(fs / src_dir) in 124 124 + let dst_path = Eio.Path.(fs / dst_dir) in 125 125 + Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 dst_path; 126 126 + 127 127 + try 128 128 + let entries = Srcsetter_cmd.run 129 129 + ~proc_mgr 130 130 + ~src_dir:src_path 131 131 + ~dst_dir:dst_path 132 132 + ~preserve:true 133 133 + () 134 134 + in 135 135 + { step = Srcsetter; success = true; 136 136 + message = Printf.sprintf "Srcsetter completed: %d images processed" 137 137 + (List.length entries); 138 138 + details = [] } 139 139 + with e -> 140 140 + { step = Srcsetter; success = false; 141 141 + message = Printf.sprintf "Srcsetter failed: %s" (Printexc.to_string e); 142 142 + details = [] } 143 143 + end 128 144 129 145 (** {1 Paper Thumbnails} *) 130 146 131 131 - let generate_paper_thumbnails ~proc_mgr config = 147 147 + let generate_paper_thumbnails ~dry_run ~fs ~proc_mgr config = 132 148 Log.info (fun m -> m "Generating paper thumbnails..."); 133 149 let pdfs_dir = config.Bushel_config.paper_pdfs_dir in 134 134 - let output_dir = Bushel_config.paper_thumbs_dir config in 150 150 + (* Output to local_source_dir/papers/ so srcsetter processes them *) 151 151 + let output_dir = Filename.concat config.Bushel_config.local_source_dir "papers" in 135 152 136 153 if not (Sys.file_exists pdfs_dir) then begin 137 154 Log.warn (fun m -> m "PDFs directory does not exist: %s" pdfs_dir); ··· 139 156 message = "No PDFs directory"; 140 157 details = [] } 141 158 end else begin 142 142 - (* Ensure output directory exists *) 143 143 - if not (Sys.file_exists output_dir) then 144 144 - Unix.mkdir output_dir 0o755; 145 145 - 146 159 let pdfs = Sys.readdir pdfs_dir |> Array.to_list 147 160 |> List.filter (fun f -> Filename.check_suffix f ".pdf") in 148 161 149 149 - let results = List.map (fun pdf_file -> 150 150 - let slug = Filename.chop_extension pdf_file in 151 151 - let pdf_path = Filename.concat pdfs_dir pdf_file in 152 152 - let output_path = Filename.concat output_dir (slug ^ ".webp") in 153 153 - 154 154 - if Sys.file_exists output_path then begin 155 155 - Log.debug (fun m -> m "Skipping %s: thumbnail exists" slug); 156 156 - `Skipped slug 157 157 - end else begin 158 158 - Log.info (fun m -> m "Generating thumbnail for %s" slug); 159 159 - try 160 160 - (* ImageMagick command: render PDF at 600 DPI, crop top 50%, resize to 2048px *) 162 162 + if dry_run then begin 163 163 + let would_run = List.filter_map (fun pdf_file -> 164 164 + let slug = Filename.chop_extension pdf_file in 165 165 + let pdf_path = Filename.concat pdfs_dir pdf_file in 166 166 + (* Output as PNG - srcsetter will convert to webp *) 167 167 + let output_path = Filename.concat output_dir (slug ^ ".png") in 168 168 + if Sys.file_exists output_path then None 169 169 + else begin 161 170 let args = [ 162 162 - "magick"; 163 163 - "-density"; "600"; 164 164 - "-quality"; "100"; 165 165 - pdf_path ^ "[0]"; (* First page only *) 166 166 - "-gravity"; "North"; 167 167 - "-crop"; "100%x50%+0+0"; 168 168 - "-resize"; "2048x"; 169 169 - output_path 171 171 + "magick"; "-density"; "600"; "-quality"; "100"; 172 172 + pdf_path ^ "[0]"; "-gravity"; "North"; 173 173 + "-crop"; "100%x50%+0+0"; "-resize"; "2048x"; output_path 170 174 ] in 171 171 - Eio.Process.run proc_mgr args; 172 172 - `Ok slug 173 173 - with e -> 174 174 - Log.err (fun m -> m "Failed to generate thumbnail for %s: %s" 175 175 - slug (Printexc.to_string e)); 176 176 - `Error slug 177 177 - end 178 178 - ) pdfs in 175 175 + Some (String.concat " " args) 176 176 + end 177 177 + ) pdfs in 178 178 + let skipped = List.length pdfs - List.length would_run in 179 179 + { step = Thumbs; success = true; 180 180 + message = Printf.sprintf "Would generate %d thumbnails (%d already exist)" 181 181 + (List.length would_run) skipped; 182 182 + details = would_run } 183 183 + end else begin 184 184 + (* Ensure output directory exists (recursive) *) 185 185 + let output_path = Eio.Path.(fs / output_dir) in 186 186 + Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 output_path; 187 187 + 188 188 + let results = List.map (fun pdf_file -> 189 189 + let slug = Filename.chop_extension pdf_file in 190 190 + let pdf_path = Filename.concat pdfs_dir pdf_file in 191 191 + (* Output as PNG - srcsetter will convert to webp *) 192 192 + let output_path = Filename.concat output_dir (slug ^ ".png") in 193 193 + 194 194 + if Sys.file_exists output_path then begin 195 195 + Log.debug (fun m -> m "Skipping %s: thumbnail exists" slug); 196 196 + `Skipped slug 197 197 + end else begin 198 198 + Log.info (fun m -> m "Generating thumbnail for %s" slug); 199 199 + try 200 200 + (* ImageMagick command: render PDF at 600 DPI, crop top 50%, resize to 2048px *) 201 201 + let args = [ 202 202 + "magick"; 203 203 + "-density"; "600"; 204 204 + "-quality"; "100"; 205 205 + pdf_path ^ "[0]"; (* First page only *) 206 206 + "-gravity"; "North"; 207 207 + "-crop"; "100%x50%+0+0"; 208 208 + "-resize"; "2048x"; 209 209 + output_path 210 210 + ] in 211 211 + Eio.Process.run proc_mgr args; 212 212 + `Ok slug 213 213 + with e -> 214 214 + Log.err (fun m -> m "Failed to generate thumbnail for %s: %s" 215 215 + slug (Printexc.to_string e)); 216 216 + `Error slug 217 217 + end 218 218 + ) pdfs in 179 219 180 180 - let ok_count = List.fold_left (fun acc r -> match r with `Ok _ -> acc + 1 | _ -> acc) 0 results in 181 181 - let skipped_count = List.fold_left (fun acc r -> match r with `Skipped _ -> acc + 1 | _ -> acc) 0 results in 182 182 - let error_count = List.fold_left (fun acc r -> match r with `Error _ -> acc + 1 | _ -> acc) 0 results in 220 220 + let ok_count = List.fold_left (fun acc r -> match r with `Ok _ -> acc + 1 | _ -> acc) 0 results in 221 221 + let skipped_count = List.fold_left (fun acc r -> match r with `Skipped _ -> acc + 1 | _ -> acc) 0 results in 222 222 + let error_count = List.fold_left (fun acc r -> match r with `Error _ -> acc + 1 | _ -> acc) 0 results in 183 223 184 184 - { step = Thumbs; success = error_count = 0; 185 185 - message = Printf.sprintf "%d generated, %d skipped, %d errors" 186 186 - ok_count skipped_count error_count; 187 187 - details = List.filter_map (fun r -> match r with `Error s -> Some s | _ -> None) results } 224 224 + { step = Thumbs; success = error_count = 0; 225 225 + message = Printf.sprintf "%d generated, %d skipped, %d errors" 226 226 + ok_count skipped_count error_count; 227 227 + details = List.filter_map (fun r -> match r with `Error s -> Some s | _ -> None) results } 228 228 + end 188 229 end 189 230 190 231 (** {1 Contact Faces} *) 191 232 192 192 - let sync_faces ~proc_mgr config entries = 193 193 - Log.info (fun m -> m "Syncing contact faces from Immich..."); 194 194 - let output_dir = Bushel_config.contact_faces_dir config in 233 233 + let sync_faces ~dry_run ~fs config entries = 234 234 + Log.info (fun m -> m "Syncing contact faces from Sortal..."); 235 235 + (* Output to local_source_dir/faces/ so srcsetter processes them *) 236 236 + let output_dir = Filename.concat config.Bushel_config.local_source_dir "faces" in 237 237 + let contacts = Bushel.Entry.contacts entries in 195 238 196 196 - match Bushel_config.immich_api_key config with 197 197 - | Error e -> 198 198 - Log.warn (fun m -> m "Cannot read Immich API key: %s" e); 199 199 - { step = Faces; success = false; 200 200 - message = "Missing Immich API key"; 201 201 - details = [e] } 202 202 - | Ok api_key -> 203 203 - let contacts = Bushel.Entry.contacts entries in 204 204 - let results = Bushel_immich.fetch_all_faces 205 205 - ~proc_mgr 206 206 - ~endpoint:config.immich_endpoint 207 207 - ~api_key 208 208 - ~output_dir 209 209 - contacts in 239 239 + (* Load sortal store to get thumbnail paths *) 240 240 + let sortal_store = Sortal.Store.create fs "sortal" in 210 241 211 211 - let ok_count = List.length (List.filter (fun (_, r) -> 212 212 - match r with Bushel_immich.Ok _ -> true | _ -> false) results) in 213 213 - let skipped_count = List.length (List.filter (fun (_, r) -> 214 214 - match r with Bushel_immich.Skipped _ -> true | _ -> false) results) in 215 215 - let error_count = List.length (List.filter (fun (_, r) -> 216 216 - match r with Bushel_immich.Error _ -> true | _ -> false) results) in 242 242 + (* Find contacts with PNG thumbnails that need copying *) 243 243 + let contacts_with_thumbs = List.filter_map (fun c -> 244 244 + match Sortal.Store.png_thumbnail_path sortal_store c with 245 245 + | Some path -> Some (c, path) 246 246 + | None -> None 247 247 + ) contacts in 217 248 249 249 + if dry_run then begin 250 250 + let would_copy = List.filter (fun (c, _src_path) -> 251 251 + let handle = Sortal_schema.Contact.handle c in 252 252 + let output_path = Filename.concat output_dir (handle ^ ".png") in 253 253 + not (Sys.file_exists output_path) 254 254 + ) contacts_with_thumbs in 255 255 + let skipped = List.length contacts_with_thumbs - List.length would_copy in 256 256 + let no_thumb = List.length contacts - List.length contacts_with_thumbs in 218 257 { step = Faces; success = true; 219 219 - message = Printf.sprintf "%d fetched, %d skipped, %d errors" 220 220 - ok_count skipped_count error_count; 258 258 + message = Printf.sprintf "Would copy %d faces from Sortal (%d already exist, %d without thumbnails)" 259 259 + (List.length would_copy) skipped no_thumb; 260 260 + details = List.map (fun (c, src_path) -> 261 261 + let handle = Sortal_schema.Contact.handle c in 262 262 + Printf.sprintf "cp %s %s/%s.png" (Eio.Path.native_exn src_path) output_dir handle 263 263 + ) (List.filteri (fun i _ -> i < 5) would_copy) @ 264 264 + (if List.length would_copy > 5 then ["...and more"] else []) } 265 265 + end else begin 266 266 + (* Ensure output directory exists *) 267 267 + let output_path = Eio.Path.(fs / output_dir) in 268 268 + Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 output_path; 269 269 + 270 270 + let results = List.map (fun (c, src_path) -> 271 271 + let handle = Sortal_schema.Contact.handle c in 272 272 + let dst_path = Filename.concat output_dir (handle ^ ".png") in 273 273 + 274 274 + if Sys.file_exists dst_path then begin 275 275 + Log.debug (fun m -> m "Skipping %s: already exists" handle); 276 276 + (handle, `Skipped) 277 277 + end else begin 278 278 + Log.info (fun m -> m "Copying face for %s" handle); 279 279 + try 280 280 + let content = Eio.Path.load src_path in 281 281 + let oc = open_out_bin dst_path in 282 282 + output_string oc content; 283 283 + close_out oc; 284 284 + (handle, `Ok) 285 285 + with e -> 286 286 + Log.err (fun m -> m "Failed to copy face for %s: %s" handle (Printexc.to_string e)); 287 287 + (handle, `Error (Printexc.to_string e)) 288 288 + end 289 289 + ) contacts_with_thumbs in 290 290 + 291 291 + let ok_count = List.length (List.filter (fun (_, r) -> r = `Ok) results) in 292 292 + let skipped_count = List.length (List.filter (fun (_, r) -> r = `Skipped) results) in 293 293 + let error_count = List.length (List.filter (fun (_, r) -> match r with `Error _ -> true | _ -> false) results) in 294 294 + let no_thumb = List.length contacts - List.length contacts_with_thumbs in 295 295 + 296 296 + { step = Faces; success = error_count = 0; 297 297 + message = Printf.sprintf "%d copied, %d skipped, %d errors, %d without thumbnails" 298 298 + ok_count skipped_count error_count no_thumb; 221 299 details = List.filter_map (fun (h, r) -> 222 222 - match r with Bushel_immich.Error e -> Some (h ^ ": " ^ e) | _ -> None 300 300 + match r with `Error e -> Some (h ^ ": " ^ e) | _ -> None 223 301 ) results } 302 302 + end 224 303 225 304 (** {1 Video Thumbnails} *) 226 305 227 227 - let sync_video_thumbnails ~proc_mgr config = 306 306 + let sync_video_thumbnails ~dry_run ~proc_mgr config = 228 307 Log.info (fun m -> m "Syncing video thumbnails from PeerTube..."); 229 308 let output_dir = Bushel_config.video_thumbs_dir config in 230 309 let videos_yml = Filename.concat config.data_dir "videos.yml" in 231 310 232 311 let index = Bushel_peertube.VideoIndex.load_file videos_yml in 233 233 - let count = List.length (Bushel_peertube.VideoIndex.to_list index) in 312 312 + let video_list = Bushel_peertube.VideoIndex.to_list index in 313 313 + let count = List.length video_list in 234 314 235 315 if count = 0 then begin 236 316 Log.info (fun m -> m "No videos in index"); 237 317 { step = Videos; success = true; 238 318 message = "No videos in index"; 239 319 details = [] } 320 320 + end else if dry_run then begin 321 321 + let would_fetch = List.filter (fun (uuid, _server) -> 322 322 + let output_path = Filename.concat output_dir (uuid ^ ".jpg") in 323 323 + not (Sys.file_exists output_path) 324 324 + ) video_list in 325 325 + let skipped = count - List.length would_fetch in 326 326 + { step = Videos; success = true; 327 327 + message = Printf.sprintf "Would fetch %d video thumbnails from PeerTube (%d already exist)" 328 328 + (List.length would_fetch) skipped; 329 329 + details = List.map (fun (uuid, server) -> 330 330 + Printf.sprintf "curl <server:%s>/api/v1/videos/%s -> %s.jpg" server uuid uuid 331 331 + ) (List.filteri (fun i _ -> i < 5) would_fetch) @ 332 332 + (if List.length would_fetch > 5 then ["...and more"] else []) } 240 333 end else begin 241 334 let results = Bushel_peertube.fetch_thumbnails_from_index 242 335 ~proc_mgr ··· 261 354 262 355 (** {1 Typesense Upload} *) 263 356 264 264 - let upload_typesense config _entries = 357 357 + let upload_typesense ~dry_run config _entries = 265 358 Log.info (fun m -> m "Uploading to Typesense..."); 266 359 267 360 match Bushel_config.typesense_api_key config with ··· 270 363 message = "Missing Typesense API key"; 271 364 details = [e] } 272 365 | Ok _api_key -> 273 273 - (* TODO: Implement actual Typesense upload using bushel-typesense *) 274 274 - { step = Typesense; success = true; 275 275 - message = "Typesense upload (not yet implemented)"; 276 276 - details = [] } 366 366 + if dry_run then 367 367 + { step = Typesense; success = true; 368 368 + message = "Would upload to Typesense"; 369 369 + details = ["POST to Typesense API (not yet implemented)"] } 370 370 + else 371 371 + (* TODO: Implement actual Typesense upload using bushel-typesense *) 372 372 + { step = Typesense; success = true; 373 373 + message = "Typesense upload (not yet implemented)"; 374 374 + details = [] } 277 375 278 376 (** {1 Run Pipeline} *) 279 377 280 280 - let run ~env ~config ~steps ~entries = 378 378 + let run ~dry_run ~env ~config ~steps ~entries = 281 379 let proc_mgr = Eio.Stdenv.process_mgr env in 380 380 + let fs = Eio.Stdenv.fs env in 282 381 283 382 let results = List.map (fun step -> 284 284 - Log.info (fun m -> m "Running step: %s" (string_of_step step)); 383 383 + Log.info (fun m -> m "%s step: %s" 384 384 + (if dry_run then "Dry-run" else "Running") 385 385 + (string_of_step step)); 285 386 match step with 286 286 - | Images -> sync_images ~proc_mgr config 287 287 - | Srcsetter -> run_srcsetter ~proc_mgr config 288 288 - | Thumbs -> generate_paper_thumbnails ~proc_mgr config 289 289 - | Faces -> sync_faces ~proc_mgr config entries 290 290 - | Videos -> sync_video_thumbnails ~proc_mgr config 291 291 - | Typesense -> upload_typesense config entries 387 387 + | Images -> sync_images ~dry_run ~fs ~proc_mgr config 388 388 + | Srcsetter -> run_srcsetter ~dry_run ~fs ~proc_mgr config 389 389 + | Thumbs -> generate_paper_thumbnails ~dry_run ~fs ~proc_mgr config 390 390 + | Faces -> sync_faces ~dry_run ~fs config entries 391 391 + | Videos -> sync_video_thumbnails ~dry_run ~proc_mgr config 392 392 + | Typesense -> upload_typesense ~dry_run config entries 292 393 ) steps in 293 394 294 395 (* Summary *) 295 396 let success_count = List.length (List.filter (fun r -> r.success) results) in 296 397 let total = List.length results in 297 297 - Log.info (fun m -> m "Sync complete: %d/%d steps succeeded" success_count total); 398 398 + Log.info (fun m -> m "%s complete: %d/%d steps succeeded" 399 399 + (if dry_run then "Dry-run" else "Sync") 400 400 + success_count total); 298 401 299 402 results

+4 -1

ocaml-bushel/lib_sync/dune

reviewed

··· 13 13 uri 14 14 ptime 15 15 logs 16 16 - fmt)) 16 16 + fmt 17 17 + sortal.schema 18 18 + sortal 19 19 + srcsetter-cmd))

+23 -13

ocaml-bushel/lib_typesense/bushel_typesense.ml

reviewed

··· 265 265 (match Bushel.Video.paper v with Some p -> [("paper", `A [`String p])] | None -> []) @ 266 266 (match Bushel.Video.project v with Some p -> [("project", `A [`String p])] | None -> [])) 267 267 268 268 - let contact_to_document (c : Bushel.Contact.t) = 268 268 + let contact_to_document (c : Sortal_schema.Contact.t) = 269 269 + (* Extract atom feed URLs from Sortal feeds *) 270 270 + let atom_urls = match Sortal_schema.Contact.feeds c with 271 271 + | Some feeds -> 272 272 + List.filter_map (fun f -> 273 273 + if Sortal_schema.Feed.feed_type f = Sortal_schema.Feed.Atom 274 274 + then Some (Sortal_schema.Feed.url f) 275 275 + else None 276 276 + ) feeds 277 277 + | None -> [] 278 278 + in 269 279 `O ([ 270 270 - ("id", `String (Bushel.Contact.handle c)); 271 271 - ("handle", `String (Bushel.Contact.handle c)); 272 272 - ("name", `String (Bushel.Contact.name c)); 273 273 - ("names", `A (List.map (fun n -> `String n) (Bushel.Contact.names c))); 280 280 + ("id", `String (Sortal_schema.Contact.handle c)); 281 281 + ("handle", `String (Sortal_schema.Contact.handle c)); 282 282 + ("name", `String (Sortal_schema.Contact.name c)); 283 283 + ("names", `A (List.map (fun n -> `String n) (Sortal_schema.Contact.names c))); 274 284 ] @ 275 275 - (match Bushel.Contact.email c with Some e -> [("email", `A [`String e])] | None -> []) @ 276 276 - (match Bushel.Contact.github c with Some g -> [("github", `A [`String g])] | None -> []) @ 277 277 - (match Bushel.Contact.twitter c with Some t -> [("twitter", `A [`String t])] | None -> []) @ 278 278 - (match Bushel.Contact.bluesky c with Some b -> [("bluesky", `A [`String b])] | None -> []) @ 279 279 - (match Bushel.Contact.mastodon c with Some m -> [("mastodon", `A [`String m])] | None -> []) @ 280 280 - (match Bushel.Contact.orcid c with Some o -> [("orcid", `A [`String o])] | None -> []) @ 281 281 - (match Bushel.Contact.url c with Some u -> [("url", `A [`String u])] | None -> []) @ 282 282 - (match Bushel.Contact.atom c with Some a -> [("atom", `A (List.map (fun x -> `String x) a))] | None -> [])) 285 285 + (match Sortal_schema.Contact.current_email c with Some e -> [("email", `A [`String e])] | None -> []) @ 286 286 + (match Sortal_schema.Contact.github_handle c with Some g -> [("github", `A [`String g])] | None -> []) @ 287 287 + (match Sortal_schema.Contact.twitter_handle c with Some t -> [("twitter", `A [`String t])] | None -> []) @ 288 288 + (match Sortal_schema.Contact.bluesky_handle c with Some b -> [("bluesky", `A [`String b])] | None -> []) @ 289 289 + (match Sortal_schema.Contact.mastodon_handle c with Some m -> [("mastodon", `A [`String m])] | None -> []) @ 290 290 + (match Sortal_schema.Contact.orcid c with Some o -> [("orcid", `A [`String o])] | None -> []) @ 291 291 + (match Sortal_schema.Contact.current_url c with Some u -> [("url", `A [`String u])] | None -> []) @ 292 292 + (if atom_urls = [] then [] else [("atom", `A (List.map (fun x -> `String x) atom_urls))]))

+1 -1

ocaml-bushel/lib_typesense/dune

reviewed

··· 1 1 (library 2 2 (name bushel_typesense) 3 3 (public_name bushel.typesense) 4 4 - (libraries bushel jsont ptime)) 4 4 + (libraries bushel jsont ptime sortal.schema))

+1 -1

ocaml-immich/bin/cmd_server.ml

reviewed

··· 38 38 | None -> 39 39 Fmt.epr "%a No server specified and not logged in.@." error_style "Error:"; 40 40 Fmt.epr "Use --server or login first.@."; 41 41 - exit 1 41 41 + raise (Immich_auth.Error.Exit_code 1) 42 42 in 43 43 (* Create session using requests config *) 44 44 let session = Requests.Cmd.create requests_config env sw in

+6

ocaml-immich/bin/main.ml

reviewed

··· 31 31 in 32 32 Cmd.eval (Cmd.group info cmds) 33 33 with 34 34 + | Eio.Cancel.Cancelled Stdlib.Exit -> 35 35 + (* Eio wraps Exit in Cancelled when a fiber is cancelled *) 36 36 + 0 37 37 + | Immich_auth.Error.Exit_code code -> 38 38 + (* Exit code from Error.wrap - already printed error message *) 39 39 + code 34 40 | Openapi.Runtime.Api_error _ as exn -> 35 41 (* Handle Immich API errors with nice formatting *) 36 42 Immich_auth.Error.handle_exn exn

+5 -4

ocaml-immich/lib/cmd.ml

reviewed

··· 88 88 error_style "Error:" 89 89 profile_style profile_name 90 90 Fmt.(styled `Bold string) "immich auth login"; 91 91 - exit 1 91 91 + raise (Error.Exit_code 1) 92 92 | Some session -> f fs session 93 93 94 94 let with_client ?requests_config ?profile f env = ··· 161 161 | Some _, Some _ -> 162 162 Fmt.epr "%a Cannot specify both --api-key and --email. Choose one authentication method.@." 163 163 error_style "Error:"; 164 164 - exit 1 164 164 + raise (Error.Exit_code 1) 165 165 166 166 let login_cmd env fs = 167 167 let doc = "Login to an Immich server." in 168 168 let info = Cmd.info "login" ~doc in 169 169 let login' (style_renderer, level) requests_config server api_key email password profile key_name = 170 170 setup_logging_with_config style_renderer level requests_config; 171 171 - login_action ~requests_config ~server ~api_key ~email ~password ~profile ~key_name env 171 171 + Error.wrap (fun () -> 172 172 + login_action ~requests_config ~server ~api_key ~email ~password ~profile ~key_name env) 172 173 in 173 174 Cmd.v info 174 175 Term.(const login' $ setup_logging $ requests_config_term fs $ server_arg $ api_key_arg $ email_arg $ password_arg $ profile_arg $ key_name_arg) ··· 302 303 Fmt.epr "%a %a@." 303 304 label_style "Available profiles:" 304 305 Fmt.(list ~sep:(any ", ") profile_style) profiles; 305 305 - exit 1 306 306 + raise (Error.Exit_code 1) 306 307 end 307 308 308 309 let profile_switch_cmd env =

+16 -4

ocaml-immich/lib/error.ml

reviewed

··· 117 117 try f (); 0 118 118 with exn -> handle_exn exn 119 119 120 120 + (** Exception to signal desired exit code without calling [exit] directly. 121 121 + This avoids issues when running inside Eio's event loop. *) 122 122 + exception Exit_code of int 123 123 + 120 124 (** Wrap a command action to handle API errors gracefully. 121 125 122 126 This is designed to be used in cmdliner command definitions: ··· 133 137 ]} 134 138 135 139 The wrapper catches API errors and prints a nice message, 136 136 - then exits with an appropriate code. *) 140 140 + then raises [Exit_code] with an appropriate code. This exception 141 141 + should be caught by the main program outside the Eio event loop. *) 137 142 let wrap f = 138 143 try f () 139 139 - with exn -> 140 140 - let code = handle_exn exn in 141 141 - exit code 144 144 + with 145 145 + | Stdlib.Exit -> 146 146 + (* exit() was called somewhere - treat as success *) 147 147 + () 148 148 + | Eio.Cancel.Cancelled Stdlib.Exit -> 149 149 + (* Eio wraps Exit in Cancelled - treat as success *) 150 150 + () 151 151 + | exn -> 152 152 + let code = handle_exn exn in 153 153 + raise (Exit_code code)

+9 -2

ocaml-immich/lib/error.mli

reviewed

··· 53 53 54 54 (** {1 Exception Handling} *) 55 55 56 56 + exception Exit_code of int 57 57 + (** Exception raised to signal a desired exit code. 58 58 + This is used instead of calling [exit] directly to avoid issues 59 59 + when running inside Eio's event loop. Catch this exception in 60 60 + the main program outside the Eio context. *) 61 61 + 56 62 val handle_exn : exn -> int 57 63 (** Handle an exception, printing a nice error message if it's an API error. 58 64 ··· 82 88 (** Wrap a command action to handle API errors gracefully. 83 89 84 90 This is designed to be used in cmdliner command definitions. 85 85 - Catches API errors, prints a nice message, and exits with 86 86 - an appropriate code. 91 91 + Catches API errors, prints a nice message, and raises {!Exit_code} 92 92 + with an appropriate code. The calling code should catch this 93 93 + exception outside the Eio event loop. 87 94 88 95 Usage: 89 96 {[

+16 -9

sortal/lib/core/sortal_cmd.ml

reviewed

··· 124 124 Logs.info (fun m -> m "@%s: already PNG (%s)" handle (Filename.basename path)); 125 125 incr skipped 126 126 end else begin 127 127 - Logs.app (fun m -> m "@%s: converting %s to PNG..." handle (Filename.basename path)); 128 128 - match convert_to_png path with 129 129 - | Ok new_path -> 130 130 - Logs.app (fun m -> m " Converted: %s -> %s" 131 131 - (Filename.basename path) (Filename.basename new_path)); 132 132 - incr converted 133 133 - | Error msg -> 134 134 - Logs.err (fun m -> m " Failed to convert %s: %s" path msg); 135 135 - incr errors 127 127 + (* Check if PNG version already exists *) 128 128 + let png_path = Filename.remove_extension path ^ ".png" in 129 129 + if Sys.file_exists png_path then begin 130 130 + Logs.info (fun m -> m "@%s: PNG already exists (%s)" handle (Filename.basename png_path)); 131 131 + incr skipped 132 132 + end else begin 133 133 + Logs.app (fun m -> m "@%s: converting %s to PNG..." handle (Filename.basename path)); 134 134 + match convert_to_png path with 135 135 + | Ok new_path -> 136 136 + Logs.app (fun m -> m " Converted: %s -> %s" 137 137 + (Filename.basename path) (Filename.basename new_path)); 138 138 + incr converted 139 139 + | Error msg -> 140 140 + Logs.err (fun m -> m " Failed to convert %s: %s" path msg); 141 141 + incr errors 142 142 + end 136 143 end 137 144 ) contacts; 138 145 Logs.app (fun m -> m "Sync complete:");

+15

sortal/lib/core/sortal_store.ml

reviewed

··· 329 329 ) all in 330 330 List.sort Contact.compare matches 331 331 332 332 + let find_by_handle t handle = 333 333 + lookup t handle 334 334 + 335 335 + let lookup_by_name t name = 336 336 + let name_lower = String.lowercase_ascii name in 337 337 + let all_contacts = list t in 338 338 + let matches = List.filter (fun c -> 339 339 + List.exists (fun n -> String.lowercase_ascii n = name_lower) 340 340 + (Contact.names c) 341 341 + ) all_contacts in 342 342 + match matches with 343 343 + | [contact] -> contact 344 344 + | [] -> failwith ("Contact not found: " ^ name) 345 345 + | _ -> failwith ("Ambiguous contact: " ^ name) 346 346 + 332 347 let find_by_email_at t ~email ~date = 333 348 let all = list t in 334 349 List.find_opt (fun c ->

+18

sortal/lib/core/sortal_store.mli

reviewed

··· 173 173 174 174 (** {1 Searching} *) 175 175 176 176 + (** [find_by_handle t handle] finds a contact by exact handle match. 177 177 + 178 178 + This is an alias for {!lookup} for API compatibility. 179 179 + 180 180 + @return [Some contact] if found, [None] if not found *) 181 181 + val find_by_handle : t -> string -> Contact.t option 182 182 + 176 183 (** [find_by_name t name] searches for contacts by name. 177 184 178 185 Performs a case-insensitive search through all contacts, ··· 183 190 @raise Not_found if no contacts match the name 184 191 @raise Invalid_argument if multiple contacts match the name *) 185 192 val find_by_name : t -> string -> Contact.t 193 193 + 194 194 + (** [lookup_by_name t name] searches for contacts by name, raising on failure. 195 195 + 196 196 + Like {!find_by_name} but raises [Failure] instead of [Not_found] 197 197 + or [Invalid_argument]. This matches the semantics of Bushel's 198 198 + original contact lookup. 199 199 + 200 200 + @param name The name to search for (case-insensitive) 201 201 + @return The matching contact if exactly one match is found 202 202 + @raise Failure if no contacts match or multiple contacts match *) 203 203 + val lookup_by_name : t -> string -> Contact.t 186 204 187 205 (** [find_by_name_opt t name] searches for contacts by name, returning an option. 188 206

+80 -6

sortal/lib/schema/sortal_schema_contact_v1.ml

reviewed

··· 7 7 8 8 type contact_kind = Person | Organization | Group | Role 9 9 10 10 + type activitypub_variant = 11 11 + | Mastodon 12 12 + | Pixelfed 13 13 + | PeerTube 14 14 + | Other_activitypub of string 15 15 + 10 16 type service_kind = 11 11 - | ActivityPub 17 17 + | ActivityPub of activitypub_variant 18 18 + | Bluesky 12 19 | Github 13 20 | Git 14 14 - | Social 21 21 + | Twitter 15 22 | Photo 16 23 | Custom of string 17 24 ··· 122 129 let orcid t = t.orcid 123 130 let feeds t = t.feeds 124 131 132 132 + (* Service convenience accessors *) 133 133 + let github t = 134 134 + List.find_opt (fun (s : service) -> 135 135 + match s.kind with Some Github -> true | _ -> false 136 136 + ) t.services 137 137 + 138 138 + let github_handle t = 139 139 + match github t with 140 140 + | Some s -> s.handle 141 141 + | None -> None 142 142 + 143 143 + let twitter t = 144 144 + List.find_opt (fun (s : service) -> 145 145 + match s.kind with Some Twitter -> true | _ -> false 146 146 + ) t.services 147 147 + 148 148 + let twitter_handle t = 149 149 + match twitter t with 150 150 + | Some s -> s.handle 151 151 + | None -> None 152 152 + 153 153 + let mastodon t = 154 154 + List.find_opt (fun (s : service) -> 155 155 + match s.kind with Some (ActivityPub Mastodon) -> true | _ -> false 156 156 + ) t.services 157 157 + 158 158 + let mastodon_handle t = 159 159 + match mastodon t with 160 160 + | Some s -> s.handle 161 161 + | None -> None 162 162 + 163 163 + let bluesky t = 164 164 + List.find_opt (fun (s : service) -> 165 165 + match s.kind with Some Bluesky -> true | _ -> false 166 166 + ) t.services 167 167 + 168 168 + let bluesky_handle t = 169 169 + match bluesky t with 170 170 + | Some s -> s.handle 171 171 + | None -> None 172 172 + 125 173 (* Temporal queries *) 126 174 let emails_at t ~date = 127 175 Sortal_schema_temporal.at_date ~get:(fun (e : email) -> e.range) ~date t.emails ··· 210 258 | "role" -> Some Role 211 259 | _ -> None 212 260 261 261 + let activitypub_variant_to_string = function 262 262 + | Mastodon -> "mastodon" 263 263 + | Pixelfed -> "pixelfed" 264 264 + | PeerTube -> "peertube" 265 265 + | Other_activitypub s -> s 266 266 + 267 267 + let activitypub_variant_of_string s = 268 268 + match String.lowercase_ascii s with 269 269 + | "mastodon" -> Mastodon 270 270 + | "pixelfed" -> Pixelfed 271 271 + | "peertube" -> PeerTube 272 272 + | _ -> Other_activitypub s 273 273 + 213 274 let service_kind_to_string = function 214 214 - | ActivityPub -> "activitypub" 275 275 + | ActivityPub v -> "activitypub:" ^ activitypub_variant_to_string v 276 276 + | Bluesky -> "bluesky" 215 277 | Github -> "github" 216 278 | Git -> "git" 217 217 - | Social -> "social" 279 279 + | Twitter -> "twitter" 218 280 | Photo -> "photo" 219 281 | Custom s -> s 220 282 221 283 let service_kind_of_string s = 222 284 match String.lowercase_ascii s with 223 223 - | "activitypub" -> Some ActivityPub 285 285 + | "bluesky" -> Some Bluesky 224 286 | "github" -> Some Github 225 287 | "git" -> Some Git 226 226 - | "social" -> Some Social 288 288 + | "twitter" -> Some Twitter 227 289 | "photo" -> Some Photo 228 290 | "" | "custom" -> None 291 291 + | s when String.length s > 11 && String.sub s 0 11 = "activitypub" -> 292 292 + (* Handle activitypub:variant format *) 293 293 + let rest = String.sub s 11 (String.length s - 11) in 294 294 + let variant = if rest = "" then Mastodon 295 295 + else if String.length rest > 1 && rest.[0] = ':' then 296 296 + activitypub_variant_of_string (String.sub rest 1 (String.length rest - 1)) 297 297 + else Mastodon 298 298 + in 299 299 + Some (ActivityPub variant) 300 300 + | "mastodon" -> Some (ActivityPub Mastodon) 301 301 + | "pixelfed" -> Some (ActivityPub Pixelfed) 302 302 + | "peertube" -> Some (ActivityPub PeerTube) 229 303 | _ -> Some (Custom s) 230 304 231 305 let email_type_to_string = function

+41 -2

sortal/lib/schema/sortal_schema_contact_v1.mli

reviewed

··· 29 29 | Group (** Research group, project team *) 30 30 | Role (** Generic role email like info@, admin@ *) 31 31 32 32 + (** ActivityPub service variants. *) 33 33 + type activitypub_variant = 34 34 + | Mastodon (** Mastodon instance *) 35 35 + | Pixelfed (** Pixelfed instance *) 36 36 + | PeerTube (** PeerTube instance *) 37 37 + | Other_activitypub of string (** Other ActivityPub-compatible service *) 38 38 + 32 39 (** Service kind - categorization of online presence. *) 33 40 type service_kind = 34 34 - | ActivityPub (** Mastodon, Pixelfed, PeerTube, etc *) 41 41 + | ActivityPub of activitypub_variant (** ActivityPub-compatible services *) 42 42 + | Bluesky (** Bluesky / AT Protocol *) 35 43 | Github (** GitHub *) 36 44 | Git (** GitLab, Gitea, Codeberg, etc *) 37 37 - | Social (** Twitter/X, LinkedIn, etc *) 45 45 + | Twitter (** Twitter/X *) 38 46 | Photo (** Immich, Flickr, Instagram, etc *) 39 47 | Custom of string (** Other service types *) 40 48 ··· 204 212 val orcid : t -> string option 205 213 val feeds : t -> Sortal_schema_feed.t list option 206 214 215 215 + (** {1 Service Convenience Accessors} 216 216 + 217 217 + These accessors provide easy access to common service types. *) 218 218 + 219 219 + (** [github t] returns the GitHub service entry if present. *) 220 220 + val github : t -> service option 221 221 + 222 222 + (** [github_handle t] returns the GitHub username if present. *) 223 223 + val github_handle : t -> string option 224 224 + 225 225 + (** [twitter t] returns the Twitter/X service entry if present. *) 226 226 + val twitter : t -> service option 227 227 + 228 228 + (** [twitter_handle t] returns the Twitter/X username if present. *) 229 229 + val twitter_handle : t -> string option 230 230 + 231 231 + (** [mastodon t] returns the Mastodon service entry if present. *) 232 232 + val mastodon : t -> service option 233 233 + 234 234 + (** [mastodon_handle t] returns the Mastodon handle if present. *) 235 235 + val mastodon_handle : t -> string option 236 236 + 237 237 + (** [bluesky t] returns the Bluesky service entry if present. *) 238 238 + val bluesky : t -> service option 239 239 + 240 240 + (** [bluesky_handle t] returns the Bluesky handle if present. *) 241 241 + val bluesky_handle : t -> string option 242 242 + 207 243 (** {1 Temporal Queries} *) 208 244 209 245 (** [email_at t ~date] returns the primary email valid at [date]. *) ··· 269 305 270 306 val contact_kind_to_string : contact_kind -> string 271 307 val contact_kind_of_string : string -> contact_kind option 308 308 + 309 309 + val activitypub_variant_to_string : activitypub_variant -> string 310 310 + val activitypub_variant_of_string : string -> activitypub_variant 272 311 273 312 val service_kind_to_string : service_kind -> string 274 313 val service_kind_of_string : string -> service_kind option

+5 -82

srcsetter/bin/srcsetter.ml

reviewed

··· 15 15 PERFORMANCE OF THIS SOFTWARE. 16 16 *) 17 17 18 18 - module SC = Srcsetter_cmd 19 19 - 20 20 - let min_interval = Some (Mtime.Span.of_uint64_ns 1000L) 21 21 - 22 22 - let stage1 { SC.img_exts; src_dir; _ } = 23 23 - let filter f = List.exists (Filename.check_suffix ("." ^ f)) img_exts in 24 24 - let fs = SC.file_seq ~filter src_dir in 25 25 - let total = Seq.length fs in 26 26 - Format.printf "[1/3] Scanned %d images from %a.\n%!" total Eio.Path.pp src_dir; 27 27 - fs 28 28 - 29 29 - let stage2 ({ SC.max_fibers; dst_dir; _ } as cfg) fs = 30 30 - let display = 31 31 - Progress.Display.start 32 32 - ~config:(Progress.Config.v ~persistent:false ~min_interval ()) 33 33 - (SC.main_bar_heading "[2/3] Processing images..." (Seq.length fs)) 34 34 - in 35 35 - let [ _; main_rep ] = Progress.Display.reporters display in 36 36 - let ents = ref [] in 37 37 - SC.iter_seq_p ~max_fibers 38 38 - (fun src -> 39 39 - let ent = SC.process_file cfg (display, main_rep) src in 40 40 - ents := ent :: !ents) 41 41 - fs; 42 42 - Progress.Display.finalise display; 43 43 - Format.printf "[2/3] Processed %d images to %a.\n%!" (List.length !ents) 44 44 - Eio.Path.pp dst_dir; 45 45 - !ents 46 46 - 47 47 - let stage3 ({ SC.dst_dir; max_fibers; _ } as cfg) ents = 48 48 - let ents_seq = List.to_seq ents in 49 49 - let oents = ref [] in 50 50 - let display = 51 51 - Progress.Display.start 52 52 - ~config:(Progress.Config.v ~persistent:false ~min_interval ()) 53 53 - (SC.main_bar_heading "[3/3] Verifying images..." (List.length ents)) 54 54 - in 55 55 - let [ _; rep ] = Progress.Display.reporters display in 56 56 - SC.iter_seq_p ~max_fibers 57 57 - (fun ent -> 58 58 - let w, h = SC.dims cfg Eio.Path.(dst_dir / Srcsetter.name ent) in 59 59 - let variants = 60 60 - Srcsetter.MS.bindings ent.variants 61 61 - |> List.map (fun (k, _) -> (k, SC.dims cfg Eio.Path.(dst_dir / k))) 62 62 - |> Srcsetter.MS.of_list 63 63 - in 64 64 - rep 1; 65 65 - oents := { ent with Srcsetter.dims = (w, h); variants } :: !oents) 66 66 - ents_seq; 67 67 - Progress.Display.finalise display; 68 68 - Printf.printf "[3/3] Verified %d generated image sizes.\n%!" 69 69 - (List.length ents); 70 70 - !oents 71 71 - 72 18 let _ = 73 19 (* TODO cmdliner *) 74 20 Eio_main.run @@ fun env -> 75 21 Eio.Switch.run @@ fun _ -> 22 22 + let fs = Eio.Stdenv.fs env in 76 23 let path_env p = 77 77 - if String.starts_with ~prefix:"/" p then Eio.(Path.(Stdenv.fs env / p)) 78 78 - else Eio.(Path.(Stdenv.cwd env / p)) 24 24 + if String.starts_with ~prefix:"/" p then Eio.Path.(fs / p) 25 25 + else Eio.Path.(Eio.Stdenv.cwd env / p) 79 26 in 80 27 let src_dir = path_env Sys.argv.(1) in 81 28 let dst_dir = path_env Sys.argv.(2) in 82 29 let proc_mgr = Eio.Stdenv.process_mgr env in 83 83 - let idx_file = "index.json" in 84 84 - let img_widths = 85 85 - [ 320; 480; 640; 768; 1024; 1280; 1440; 1600; 1920; 2560; 3840 ] 86 86 - in 87 87 - let img_exts = [ "png"; "webp"; "jpeg"; "jpg"; "bmp"; "heic"; "gif" ] in 88 88 - let img_widths = List.sort (fun a b -> compare b a) img_widths in 89 89 - let max_fibers = 8 in 90 90 - let cfg = 91 91 - { 92 92 - Srcsetter_cmd.dummy = false; 93 93 - preserve = true; 94 94 - proc_mgr; 95 95 - src_dir; 96 96 - dst_dir; 97 97 - idx_file; 98 98 - img_widths; 99 99 - img_exts; 100 100 - max_fibers; 101 101 - } 102 102 - in 103 103 - let fs = stage1 cfg in 104 104 - let ents = stage2 cfg fs in 105 105 - let oents = stage3 cfg ents in 106 106 - let j = Srcsetter.list_to_json oents |> Result.get_ok in 107 107 - let idx = Eio.Path.(dst_dir / idx_file) in 108 108 - Eio.Path.save ~append:false ~create:(`Or_truncate 0o644) idx j 30 30 + let _entries = Srcsetter_cmd.run ~proc_mgr ~src_dir ~dst_dir () in 31 31 + ()

+1 -1

srcsetter/lib/dune

reviewed

··· 2 2 (name srcsetter_cmd) 3 3 (public_name srcsetter-cmd) 4 4 (modules srcsetter_cmd) 5 5 - (libraries srcsetter eio fpath progress)) 5 5 + (libraries srcsetter eio fpath progress mtime)) 6 6 7 7 (library 8 8 (name srcsetter)

+166 -21

srcsetter/lib/srcsetter_cmd.ml

reviewed

··· 101 101 let output = Process.parse_out proc_mgr Buf_read.take_all args in 102 102 Scanf.sscanf output "%d %d" (fun w h -> (w, h)) 103 103 104 104 + (** [try_dims cfg path] returns [Some (w, h)] if identify succeeds, [None] otherwise. *) 105 105 + let try_dims cfg path = 106 106 + try Some (dims cfg path) 107 107 + with _ -> None 108 108 + 109 109 + (** [file_size path] returns the size of the file in bytes. *) 110 110 + let file_size path = 111 111 + let stat = Path.stat ~follow:true path in 112 112 + Optint.Int63.to_int stat.size 113 113 + 114 114 + (** [is_valid_image cfg path] returns true if the file exists, has non-zero size, 115 115 + and identify can read its dimensions. *) 116 116 + let is_valid_image cfg path = 117 117 + Path.is_file path && 118 118 + file_size path > 0 && 119 119 + Option.is_some (try_dims cfg path) 120 120 + 121 121 + (** [width_from_variant_name name] extracts the width from a variant filename. 122 122 + 123 123 + Variant filenames have the form "path/name.WIDTH.webp". Returns [None] for 124 124 + base images (no width suffix). *) 125 125 + let width_from_variant_name name = 126 126 + let base = Filename.chop_extension name in (* remove .webp *) 127 127 + let parts = String.split_on_char '.' base in 128 128 + match List.rev parts with 129 129 + | last :: _ -> ( 130 130 + match int_of_string_opt last with 131 131 + | Some w -> Some w 132 132 + | None -> None) 133 133 + | [] -> None 134 134 + 104 135 (** [run cfg args] executes a shell command unless in dummy mode. *) 105 136 let run { dummy; proc_mgr; _ } args = 106 137 if not dummy then Process.run proc_mgr args ··· 166 197 let dst = Path.(dst_dir / dst_file) in 167 198 (src_file, dst_file, w, needs_conversion ~preserve dst) 168 199 169 169 - (** [calc_needed cfg ~img_widths ~w src] computes which conversions are needed. 170 170 - 171 171 - Returns [(base, variants)] where each is tagged with [`Exists] or [`Todo]. *) 172 172 - let calc_needed { src_dir; dst_dir; preserve; _ } ~img_widths ~w src = 173 173 - let check_dst fname tw = 174 174 - let dst = Path.(dst_dir / fname) in 175 175 - let ent = (src, dst, tw) in 176 176 - if preserve && Path.is_file dst then `Exists ent else `Todo ent 177 177 - in 178 178 - let file = relativize_path src_dir src in 179 179 - let base_name = Filename.chop_extension file in 180 180 - let base = check_dst (Printf.sprintf "%s.webp" base_name) w in 181 181 - let variants = 182 182 - List.filter_map 183 183 - (fun tw -> 184 184 - if tw <= w then Some (check_dst (Printf.sprintf "%s.%d.webp" base_name tw) tw) 185 185 - else None) 186 186 - img_widths 187 187 - in 188 188 - (base, variants) 189 189 - 190 200 (** {1 Progress Bar Rendering} *) 191 201 192 202 (** [main_bar total] creates a progress bar for [total] items. *) ··· 269 279 main_rep 1 270 280 end; 271 281 ent 282 282 + 283 283 + (** {1 Pipeline Execution} *) 284 284 + 285 285 + let min_interval = Some (Mtime.Span.of_uint64_ns 1000L) 286 286 + 287 287 + (** [stage1 cfg] scans for images in the source directory. 288 288 + 289 289 + Returns a sequence of file paths matching the configured extensions. *) 290 290 + let stage1 { img_exts; src_dir; _ } = 291 291 + let filter f = List.exists (Filename.check_suffix ("." ^ f)) img_exts in 292 292 + let fs = file_seq ~filter src_dir in 293 293 + let total = Seq.length fs in 294 294 + Format.printf "[1/3] Scanned %d images from %a.\n%!" total Path.pp src_dir; 295 295 + fs 296 296 + 297 297 + (** [stage2 cfg fs] processes images, converting to WebP at multiple sizes. 298 298 + 299 299 + @return List of {!Srcsetter.t} entries with placeholder dimensions. *) 300 300 + let stage2 ({ max_fibers; dst_dir; _ } as cfg) fs = 301 301 + let display = 302 302 + Progress.Display.start 303 303 + ~config:(Progress.Config.v ~persistent:false ~min_interval ()) 304 304 + (main_bar_heading "[2/3] Processing images..." (Seq.length fs)) 305 305 + in 306 306 + let [ _; main_rep ] = Progress.Display.reporters display in 307 307 + let ents = ref [] in 308 308 + iter_seq_p ~max_fibers 309 309 + (fun src -> 310 310 + let ent = process_file cfg (display, main_rep) src in 311 311 + ents := ent :: !ents) 312 312 + fs; 313 313 + Progress.Display.finalise display; 314 314 + Format.printf "[2/3] Processed %d images to %a.\n%!" (List.length !ents) 315 315 + Path.pp dst_dir; 316 316 + !ents 317 317 + 318 318 + (** [stage3 cfg ents] verifies generated images and records their dimensions. 319 319 + 320 320 + Regenerates any images that have zero length or fail identify validation. 321 321 + 322 322 + @return List of {!Srcsetter.t} entries with actual dimensions. *) 323 323 + let stage3 ({ src_dir; dst_dir; max_fibers; _ } as cfg) ents = 324 324 + let ents_seq = List.to_seq ents in 325 325 + let oents = ref [] in 326 326 + let regenerated = ref 0 in 327 327 + let display = 328 328 + Progress.Display.start 329 329 + ~config:(Progress.Config.v ~persistent:false ~min_interval ()) 330 330 + (main_bar_heading "[3/3] Verifying images..." (List.length ents)) 331 331 + in 332 332 + let [ _; rep ] = Progress.Display.reporters display in 333 333 + iter_seq_p ~max_fibers 334 334 + (fun ent -> 335 335 + let src_path = Path.(src_dir / Srcsetter.origin ent) in 336 336 + let orig_w, _ = dims cfg src_path in 337 337 + (* Verify and regenerate base image if needed *) 338 338 + let base_path = Path.(dst_dir / Srcsetter.name ent) in 339 339 + if not (is_valid_image cfg base_path) then begin 340 340 + incr regenerated; 341 341 + convert cfg (Srcsetter.origin ent, Srcsetter.name ent, orig_w) 342 342 + end; 343 343 + let w, h = dims cfg base_path in 344 344 + (* Verify and regenerate variants if needed *) 345 345 + let variants = 346 346 + Srcsetter.MS.bindings ent.variants 347 347 + |> List.map (fun (k, _) -> 348 348 + let variant_path = Path.(dst_dir / k) in 349 349 + if not (is_valid_image cfg variant_path) then begin 350 350 + incr regenerated; 351 351 + let target_w = Option.value (width_from_variant_name k) ~default:orig_w in 352 352 + convert cfg (Srcsetter.origin ent, k, target_w) 353 353 + end; 354 354 + (k, dims cfg variant_path)) 355 355 + |> Srcsetter.MS.of_list 356 356 + in 357 357 + rep 1; 358 358 + oents := { ent with Srcsetter.dims = (w, h); variants } :: !oents) 359 359 + ents_seq; 360 360 + Progress.Display.finalise display; 361 361 + if !regenerated > 0 then 362 362 + Printf.printf "[3/3] Verified %d images, regenerated %d invalid outputs.\n%!" 363 363 + (List.length ents) !regenerated 364 364 + else 365 365 + Printf.printf "[3/3] Verified %d generated image sizes.\n%!" 366 366 + (List.length ents); 367 367 + !oents 368 368 + 369 369 + (** [run ~proc_mgr ~src_dir ~dst_dir ()] runs the full srcsetter pipeline. 370 370 + 371 371 + Scans [src_dir] for images, converts them to WebP format at multiple 372 372 + responsive sizes, and writes an index file to [dst_dir]. 373 373 + 374 374 + @param proc_mgr Eio process manager for running ImageMagick 375 375 + @param src_dir Source directory containing original images 376 376 + @param dst_dir Destination directory for generated images 377 377 + @param idx_file Name of the index file (default ["index.json"]) 378 378 + @param img_widths List of target widths (default common responsive breakpoints) 379 379 + @param img_exts List of extensions to process (default common image formats) 380 380 + @param max_fibers Maximum concurrent operations (default 8) 381 381 + @param dummy When true, skip actual conversions (default false) 382 382 + @param preserve When true, skip existing files (default true) 383 383 + @return List of {!Srcsetter.t} entries describing generated images *) 384 384 + let run 385 385 + ~proc_mgr 386 386 + ~src_dir 387 387 + ~dst_dir 388 388 + ?(idx_file = "index.json") 389 389 + ?(img_widths = [ 320; 480; 640; 768; 1024; 1280; 1440; 1600; 1920; 2560; 3840 ]) 390 390 + ?(img_exts = [ "png"; "webp"; "jpeg"; "jpg"; "bmp"; "heic"; "gif" ]) 391 391 + ?(max_fibers = 8) 392 392 + ?(dummy = false) 393 393 + ?(preserve = true) 394 394 + () 395 395 + = 396 396 + let img_widths = List.sort (fun a b -> compare b a) img_widths in 397 397 + let cfg = 398 398 + { 399 399 + dummy; 400 400 + preserve; 401 401 + proc_mgr; 402 402 + src_dir; 403 403 + dst_dir; 404 404 + idx_file; 405 405 + img_widths; 406 406 + img_exts; 407 407 + max_fibers; 408 408 + } 409 409 + in 410 410 + let fs = stage1 cfg in 411 411 + let ents = stage2 cfg fs in 412 412 + let oents = stage3 cfg ents in 413 413 + let j = Srcsetter.list_to_json oents |> Result.get_ok in 414 414 + let idx = Path.(dst_dir / idx_file) in 415 415 + Path.save ~append:false ~create:(`Or_truncate 0o644) idx j; 416 416 + oents

+122

srcsetter/lib/srcsetter_cmd.mli

reviewed

··· 1 1 + (* Copyright (c) 2024, Anil Madhavapeddy <anil@recoil.org> 2 2 + 3 3 + Permission to use, copy, modify, and/or distribute this software for 4 4 + any purpose with or without fee is hereby granted, provided that the 5 5 + above copyright notice and this permission notice appear in all 6 6 + copies. 7 7 + 8 8 + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL 9 9 + WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED 10 10 + WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE 11 11 + AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL 12 12 + DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA 13 13 + OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER 14 14 + TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR 15 15 + PERFORMANCE OF THIS SOFTWARE. *) 16 16 + 17 17 + (** Command-line image processing operations for srcsetter. 18 18 + 19 19 + This module provides the core image processing pipeline including 20 20 + file discovery, image conversion, and progress reporting. 21 21 + 22 22 + {1 High-Level Pipeline} 23 23 + 24 24 + The simplest way to use this module is via {!run}, which executes 25 25 + the complete pipeline: 26 26 + 27 27 + {[ 28 28 + Srcsetter_cmd.run 29 29 + ~proc_mgr:(Eio.Stdenv.process_mgr env) 30 30 + ~src_dir:Eio.Path.(fs / "images/originals") 31 31 + ~dst_dir:Eio.Path.(fs / "images/output") 32 32 + () 33 33 + ]} 34 34 + 35 35 + {1 Configuration} *) 36 36 + 37 37 + (** Configuration for the image processing pipeline. *) 38 38 + type ('a, 'b) config = { 39 39 + dummy : bool; (** When true, skip actual image conversion (dry run) *) 40 40 + preserve : bool; (** When true, skip conversion if destination exists *) 41 41 + proc_mgr : 'a Eio.Process.mgr; (** Eio process manager for running ImageMagick *) 42 42 + src_dir : 'b Eio.Path.t; (** Source directory containing original images *) 43 43 + dst_dir : 'b Eio.Path.t; (** Destination directory for generated images *) 44 44 + img_widths : int list; (** List of target widths for responsive variants *) 45 45 + img_exts : string list; (** File extensions to process (e.g., ["jpg"; "png"]) *) 46 46 + idx_file : string; (** Name of the JSON index file to generate *) 47 47 + max_fibers : int; (** Maximum concurrent conversion operations *) 48 48 + } 49 49 + 50 50 + (** {1 File Operations} *) 51 51 + 52 52 + val file_seq : 53 53 + filter:(string -> bool) -> 54 54 + ([> Eio.Fs.dir_ty ] as 'a) Eio.Path.t -> 55 55 + 'a Eio.Path.t Seq.t 56 56 + (** [file_seq ~filter path] recursively enumerates files in [path]. 57 57 + 58 58 + Returns a sequence of file paths where [filter filename] is true. 59 59 + Directories are traversed depth-first. *) 60 60 + 61 61 + val iter_seq_p : ?max_fibers:int -> ('a -> unit) -> 'a Seq.t -> unit 62 62 + (** [iter_seq_p ?max_fibers fn seq] iterates [fn] over [seq] in parallel. 63 63 + 64 64 + @param max_fibers Optional limit on concurrent fibers. Must be positive. 65 65 + @raise Invalid_argument if [max_fibers] is not positive. *) 66 66 + 67 67 + (** {1 Image Operations} *) 68 68 + 69 69 + val dims : ('a, 'b) config -> 'b Eio.Path.t -> int * int 70 70 + (** [dims cfg path] returns the [(width, height)] dimensions of an image. 71 71 + 72 72 + Uses ImageMagick's [identify] command to read image metadata. *) 73 73 + 74 74 + val convert : ('a, 'b) config -> string * string * int -> unit 75 75 + (** [convert cfg (src, dst, size)] converts an image to WebP format. 76 76 + 77 77 + Creates the destination directory if needed, then uses ImageMagick 78 78 + to resize and convert the image with auto-orientation. 79 79 + 80 80 + @param src Source filename relative to [cfg.src_dir] 81 81 + @param dst Destination filename relative to [cfg.dst_dir] 82 82 + @param size Target width in pixels *) 83 83 + 84 84 + val convert_pdf : 85 85 + ('a, 'b) config -> 86 86 + size:string -> 87 87 + dst:'b Eio.Path.t -> 88 88 + src:'b Eio.Path.t -> 89 89 + unit 90 90 + (** [convert_pdf cfg ~size ~dst ~src] converts a PDF's first page to an image. 91 91 + 92 92 + Renders at 300 DPI, crops the top half, and resizes to the target width. *) 93 93 + 94 94 + (** {1 Pipeline Execution} *) 95 95 + 96 96 + val run : 97 97 + proc_mgr:'a Eio.Process.mgr -> 98 98 + src_dir:'b Eio.Path.t -> 99 99 + dst_dir:'b Eio.Path.t -> 100 100 + ?idx_file:string -> 101 101 + ?img_widths:int list -> 102 102 + ?img_exts:string list -> 103 103 + ?max_fibers:int -> 104 104 + ?dummy:bool -> 105 105 + ?preserve:bool -> 106 106 + unit -> 107 107 + Srcsetter.t list 108 108 + (** [run ~proc_mgr ~src_dir ~dst_dir ()] runs the full srcsetter pipeline. 109 109 + 110 110 + Scans [src_dir] for images, converts them to WebP format at multiple 111 111 + responsive sizes, and writes an index file to [dst_dir]. 112 112 + 113 113 + @param proc_mgr Eio process manager for running ImageMagick 114 114 + @param src_dir Source directory containing original images 115 115 + @param dst_dir Destination directory for generated images 116 116 + @param idx_file Name of the index file (default ["index.json"]) 117 117 + @param img_widths List of target widths (default common responsive breakpoints) 118 118 + @param img_exts List of extensions to process (default common image formats) 119 119 + @param max_fibers Maximum concurrent operations (default 8) 120 120 + @param dummy When true, skip actual conversions (default false) 121 121 + @param preserve When true, skip existing files (default true) 122 122 + @return List of {!Srcsetter.t} entries describing generated images *)