Add diff command with fetch caching · jon.recoil.org/monopam@92c7e22

+53 -1

bin/main.ml

··· 807 807 verse_fork_cmd; 808 808 ] 809 809 810 + (* Diff command *) 811 + 812 + let diff_cmd = 813 + let doc = "Show diffs from verse members for repos needing attention" in 814 + let man = 815 + [ 816 + `S Manpage.s_description; 817 + `P 818 + "Shows commit diffs from verse members for repositories where they have \ 819 + commits you don't have. This helps you see what changes are available \ 820 + from collaborators."; 821 + `S "OUTPUT"; 822 + `P "First shows the verse status summary, then for each repository where \ 823 + a verse member is ahead:"; 824 + `I ("Repository name", "With the handle and relationship"); 825 + `I ("Commits", "List of commits they have that you don't (max 20)"); 826 + `S "RELATIONSHIPS"; 827 + `I ("+N", "They have N commits you don't have"); 828 + `I ("+N/-M", "Diverged: they have N new commits, you have M new commits"); 829 + `S "CACHING"; 830 + `P "Remote fetches are cached for 5 minutes to improve performance. \ 831 + Use $(b,--refresh) to force fresh fetches from all remotes."; 832 + `S Manpage.s_examples; 833 + `P "Show diffs for all repos needing attention (uses cache):"; 834 + `Pre "monopam diff"; 835 + `P "Show diff for a specific repository:"; 836 + `Pre "monopam diff ocaml-eio"; 837 + `P "Force fresh fetches from all remotes:"; 838 + `Pre "monopam diff --refresh"; 839 + ] 840 + in 841 + let info = Cmd.info "diff" ~doc ~man in 842 + let repo_arg = 843 + let doc = "Repository name. If not specified, shows diffs for all repos needing attention." in 844 + Arg.(value & pos 0 (some string) None & info [] ~docv:"REPO" ~doc) 845 + in 846 + let refresh_arg = 847 + let doc = "Force fresh fetches from all remotes, ignoring the 5-minute cache." in 848 + Arg.(value & flag & info [ "refresh"; "r" ] ~doc) 849 + in 850 + let run repo refresh () = 851 + Eio_main.run @@ fun env -> 852 + with_config env @@ fun config -> 853 + with_verse_config env @@ fun verse_config -> 854 + let fs = Eio.Stdenv.fs env in 855 + let proc = Eio.Stdenv.process_mgr env in 856 + let result = Monopam.diff ~proc ~fs ~config ~verse_config ?repo ~refresh () in 857 + Fmt.pr "%a" Monopam.pp_diff_result result; 858 + `Ok () 859 + in 860 + Cmd.v info Term.(ret (const run $ repo_arg $ refresh_arg $ logging_term)) 861 + 810 862 (* Doctor command *) 811 863 812 864 let doctor_cmd = ··· 1133 1185 in 1134 1186 let info = Cmd.info "monopam" ~version:"%%VERSION%%" ~doc ~man in 1135 1187 Cmd.group info 1136 - [ status_cmd; sync_cmd; changes_cmd; opam_cmd; doctor_cmd; verse_cmd; feature_cmd ] 1188 + [ status_cmd; diff_cmd; sync_cmd; changes_cmd; opam_cmd; doctor_cmd; verse_cmd; feature_cmd ] 1137 1189 1138 1190 let () = exit (Cmd.eval main_cmd)

+131 -37

lib/forks.ml

··· 6 6 let src = Logs.Src.create "monopam.forks" ~doc:"Fork analysis" 7 7 module Log = (val Logs.src_log src : Logs.LOG) 8 8 9 + (* ==================== Fetch Cache ==================== *) 10 + 11 + (** Default cache timeout in seconds (5 minutes) *) 12 + let default_cache_timeout = 300.0 13 + 14 + (** In-memory cache of last fetch times *) 15 + let fetch_cache : (string, float) Hashtbl.t = Hashtbl.create 64 16 + 17 + (** Cache file path - uses XDG cache directory via Verse_config *) 18 + let cache_file_path () = 19 + Fpath.(to_string (Verse_config.cache_dir () / "fetch-cache.json")) 20 + 21 + (** Load cache from disk *) 22 + let load_cache () = 23 + let path = cache_file_path () in 24 + if Sys.file_exists path then begin 25 + try 26 + let content = In_channel.with_open_text path In_channel.input_all in 27 + (* Simple JSON parsing for {"key": timestamp, ...} *) 28 + let content = String.trim content in 29 + if String.length content > 2 then begin 30 + let inner = String.sub content 1 (String.length content - 2) in 31 + let pairs = String.split_on_char ',' inner in 32 + List.iter (fun pair -> 33 + let pair = String.trim pair in 34 + match String.split_on_char ':' pair with 35 + | [key; value] -> 36 + let key = String.trim key in 37 + let value = String.trim value in 38 + (* Strip quotes from key *) 39 + let key = if String.length key > 2 && key.[0] = '"' then 40 + String.sub key 1 (String.length key - 2) 41 + else key 42 + in 43 + (match float_of_string_opt value with 44 + | Some ts -> Hashtbl.replace fetch_cache key ts 45 + | None -> ()) 46 + | _ -> ()) 47 + pairs 48 + end 49 + with _ -> () 50 + end 51 + 52 + (** Save cache to disk *) 53 + let save_cache () = 54 + let path = cache_file_path () in 55 + try 56 + (* Create directory if needed *) 57 + let dir = Filename.dirname path in 58 + if not (Sys.file_exists dir) then 59 + ignore (Sys.command (Printf.sprintf "mkdir -p %s" (Filename.quote dir))); 60 + (* Write cache as JSON *) 61 + Out_channel.with_open_text path (fun oc -> 62 + output_string oc "{\n"; 63 + let first = ref true in 64 + Hashtbl.iter (fun key ts -> 65 + if not !first then output_string oc ",\n"; 66 + first := false; 67 + Printf.fprintf oc " \"%s\": %.0f" key ts) 68 + fetch_cache; 69 + output_string oc "\n}\n") 70 + with _ -> () 71 + 72 + (** Check if a fetch is needed for a cache key *) 73 + let needs_fetch ~refresh ~timeout key = 74 + if refresh then true 75 + else begin 76 + (* Load cache on first access *) 77 + if Hashtbl.length fetch_cache = 0 then load_cache (); 78 + match Hashtbl.find_opt fetch_cache key with 79 + | None -> true 80 + | Some last_fetch -> 81 + let now = Unix.gettimeofday () in 82 + now -. last_fetch > timeout 83 + end 84 + 85 + (** Record a successful fetch *) 86 + let record_fetch key = 87 + let now = Unix.gettimeofday () in 88 + Hashtbl.replace fetch_cache key now; 89 + save_cache () 90 + 9 91 (** A dev-repo source from a specific member *) 10 92 type repo_source = { 11 93 handle : string; (** Member handle or "me" *) ··· 274 356 package_names 275 357 with _ -> [] 276 358 277 - (** Fetch a verse opam repo *) 278 - let fetch_verse_opam_repo ~proc ~fs path = 279 - let cwd = Eio.Path.(fs / Fpath.to_string path) in 280 - let cmd = ["git"; "fetch"; "--quiet"] in 281 - Log.debug (fun m -> m "Running: %s (in %a)" (String.concat " " cmd) Fpath.pp path); 282 - Eio.Switch.run @@ fun sw -> 283 - let child = Eio.Process.spawn proc ~sw ~cwd 284 - ~stdout:(Eio.Flow.buffer_sink (Buffer.create 16)) 285 - ~stderr:(Eio.Flow.buffer_sink (Buffer.create 16)) 286 - cmd 287 - in 288 - match Eio.Process.await child with 289 - | `Exited 0 -> () 290 - | _ -> Log.debug (fun m -> m "Failed to fetch %a" Fpath.pp path) 359 + (** Fetch a verse opam repo (with caching) *) 360 + let fetch_verse_opam_repo ~proc ~fs ~refresh path = 361 + let cache_key = "verse-opam/" ^ Fpath.to_string path in 362 + if not (needs_fetch ~refresh ~timeout:default_cache_timeout cache_key) then begin 363 + Log.debug (fun m -> m "Skipping fetch for %a (cached)" Fpath.pp path); 364 + () 365 + end else begin 366 + let cwd = Eio.Path.(fs / Fpath.to_string path) in 367 + let cmd = ["git"; "fetch"; "--quiet"] in 368 + Log.debug (fun m -> m "Running: %s (in %a)" (String.concat " " cmd) Fpath.pp path); 369 + Eio.Switch.run @@ fun sw -> 370 + let child = Eio.Process.spawn proc ~sw ~cwd 371 + ~stdout:(Eio.Flow.buffer_sink (Buffer.create 16)) 372 + ~stderr:(Eio.Flow.buffer_sink (Buffer.create 16)) 373 + cmd 374 + in 375 + match Eio.Process.await child with 376 + | `Exited 0 -> record_fetch cache_key 377 + | _ -> Log.debug (fun m -> m "Failed to fetch %a" Fpath.pp path) 378 + end 291 379 292 380 (** Scan all verse opam repos and build a map: repo_basename -> [(handle, url, [packages])] *) 293 - let scan_all_verse_opam_repos ~proc ~fs ~verse_path () = 381 + let scan_all_verse_opam_repos ~proc ~fs ~verse_path ~refresh () = 294 382 let eio_verse = Eio.Path.(fs / Fpath.to_string verse_path) in 295 383 let entries = try Eio.Path.read_dir eio_verse with _ -> [] in 296 384 (* Find opam repo directories (ending in -opam) *) 297 385 let opam_dirs = List.filter (fun name -> String.ends_with ~suffix:"-opam" name) entries in 298 - (* Fetch each opam repo first *) 299 - Log.info (fun m -> m "Fetching %d verse opam repos" (List.length opam_dirs)); 386 + (* Fetch each opam repo first (respecting cache unless refresh) *) 387 + Log.info (fun m -> m "Checking %d verse opam repos" (List.length opam_dirs)); 300 388 List.iter (fun opam_dir -> 301 389 let opam_path = Fpath.(verse_path / opam_dir) in 302 - fetch_verse_opam_repo ~proc ~fs opam_path) 390 + fetch_verse_opam_repo ~proc ~fs ~refresh opam_path) 303 391 opam_dirs; 304 392 (* Build map: repo_basename -> [(handle, url, [packages])] *) 305 393 let repo_map = Hashtbl.create 64 in ··· 377 465 | `Exited 0 -> Ok () 378 466 | _ -> Error "Failed to add remote" 379 467 380 - (** Fetch a remote *) 381 - let fetch_remote ~proc ~fs ~repo ~remote () = 382 - let cwd = Eio.Path.(fs / Fpath.to_string repo) in 383 - let cmd = ["git"; "fetch"; remote] in 384 - Log.info (fun m -> m "Fetching %s in %a" remote Fpath.pp repo); 385 - Log.debug (fun m -> m "Running: %s (in %a)" (String.concat " " cmd) Fpath.pp repo); 386 - Eio.Switch.run @@ fun sw -> 387 - let child = Eio.Process.spawn proc ~sw ~cwd 388 - ~stdout:(Eio.Flow.buffer_sink (Buffer.create 256)) 389 - ~stderr:(Eio.Flow.buffer_sink (Buffer.create 256)) 390 - cmd 391 - in 392 - match Eio.Process.await child with 393 - | `Exited 0 -> Ok () 394 - | _ -> Error "Failed to fetch remote" 468 + (** Fetch a remote (with caching) *) 469 + let fetch_remote ~proc ~fs ~repo ~remote ~refresh () = 470 + let cache_key = Printf.sprintf "checkout/%s/%s" (Fpath.to_string repo) remote in 471 + if not (needs_fetch ~refresh ~timeout:default_cache_timeout cache_key) then begin 472 + Log.debug (fun m -> m "Skipping fetch for %s in %a (cached)" remote Fpath.pp repo); 473 + Ok () (* Return Ok since we have cached data *) 474 + end else begin 475 + let cwd = Eio.Path.(fs / Fpath.to_string repo) in 476 + let cmd = ["git"; "fetch"; remote] in 477 + Log.info (fun m -> m "Fetching %s in %a" remote Fpath.pp repo); 478 + Log.debug (fun m -> m "Running: %s (in %a)" (String.concat " " cmd) Fpath.pp repo); 479 + Eio.Switch.run @@ fun sw -> 480 + let child = Eio.Process.spawn proc ~sw ~cwd 481 + ~stdout:(Eio.Flow.buffer_sink (Buffer.create 256)) 482 + ~stderr:(Eio.Flow.buffer_sink (Buffer.create 256)) 483 + cmd 484 + in 485 + match Eio.Process.await child with 486 + | `Exited 0 -> record_fetch cache_key; Ok () 487 + | _ -> Error "Failed to fetch remote" 488 + end 395 489 396 490 (** Get the commit SHA for a ref *) 397 491 let get_ref_commit ~proc ~fs ~repo ref_name = ··· 482 576 Diverged { common_ancestor = base; my_ahead; their_ahead } 483 577 484 578 (** Compute fork analysis for all repos *) 485 - let compute ~proc ~fs ~verse_config ~monopam_config () = 579 + let compute ~proc ~fs ~verse_config ~monopam_config ?(refresh=false) () = 486 580 let verse_path = Verse_config.verse_path verse_config in 487 581 let opam_repo_path = Config.Paths.opam_repo monopam_config in 488 582 let checkouts_path = Config.Paths.checkouts monopam_config in ··· 493 587 494 588 (* Scan verse opam repos *) 495 589 Log.info (fun m -> m "Scanning verse opam repos"); 496 - let verse_repos = scan_all_verse_opam_repos ~proc ~fs ~verse_path () in 590 + let verse_repos = scan_all_verse_opam_repos ~proc ~fs ~verse_path ~refresh () in 497 591 498 592 (* Build combined list of all repo names *) 499 593 let all_repos = Hashtbl.create 64 in ··· 537 631 Log.info (fun m -> m "Adding remote %s -> %a" remote_name Uri.pp src.url); 538 632 ignore (add_remote ~proc ~fs ~repo:checkout_path ~name:remote_name ~url:src.url ()) 539 633 end; 540 - (* Fetch remote *) 541 - (match fetch_remote ~proc ~fs ~repo:checkout_path ~remote:remote_name () with 634 + (* Fetch remote (respecting cache unless refresh) *) 635 + (match fetch_remote ~proc ~fs ~repo:checkout_path ~remote:remote_name ~refresh () with 542 636 | Error _ -> Not_fetched 543 637 | Ok () -> 544 638 (* Compare refs *)

+4 -2

lib/forks.mli

··· 74 74 fs:Eio.Fs.dir_ty Eio.Path.t -> 75 75 verse_config:Verse_config.t -> 76 76 monopam_config:Config.t -> 77 + ?refresh:bool -> 77 78 unit -> 78 79 t 79 - (** [compute ~proc ~fs ~verse_config ~monopam_config ()] performs full fork 80 + (** [compute ~proc ~fs ~verse_config ~monopam_config ?refresh ()] performs full fork 80 81 analysis by: 81 82 1. Scanning my opam repo for dev-repo URLs 82 83 2. Scanning all verse opam repos for dev-repo URLs 83 84 3. Adding git remotes to my checkouts for each member's fork 84 85 4. Fetching remotes and comparing commit histories 85 86 86 - This is an expensive operation as it fetches from all verse member remotes. *) 87 + Fetches are cached for 5 minutes by default. Use [~refresh:true] to force 88 + fresh fetches from all remotes. *)

+90

lib/monopam.ml

··· 1940 1940 end; 1941 1941 Ok () 1942 1942 end 1943 + 1944 + (* ==================== Diff ==================== *) 1945 + 1946 + type diff_entry = { 1947 + repo_name : string; 1948 + handle : string; 1949 + relationship : Forks.relationship; 1950 + commits : Git.log_entry list; 1951 + } 1952 + 1953 + type diff_result = { 1954 + entries : diff_entry list; 1955 + forks : Forks.t; 1956 + } 1957 + 1958 + let pp_diff_entry ppf entry = 1959 + let n_commits = List.length entry.commits in 1960 + Fmt.pf ppf "@[<v 2>%a %s (%a, %d commit%s):@," 1961 + Fmt.(styled `Bold string) entry.repo_name 1962 + entry.handle 1963 + Forks.pp_relationship entry.relationship 1964 + n_commits (if n_commits = 1 then "" else "s"); 1965 + List.iter (fun (c : Git.log_entry) -> 1966 + let short_hash = String.sub c.hash 0 (min 7 (String.length c.hash)) in 1967 + Fmt.pf ppf " %a %s %a@," 1968 + Fmt.(styled `Yellow string) short_hash 1969 + c.subject 1970 + Fmt.(styled `Faint string) c.author) 1971 + entry.commits; 1972 + Fmt.pf ppf "@]" 1973 + 1974 + let pp_diff_result ppf result = 1975 + (* First show the summary *) 1976 + Fmt.pf ppf "%a@." (Forks.pp_summary' ~show_all:false) result.forks; 1977 + (* Then show diffs for each entry *) 1978 + if result.entries <> [] then begin 1979 + Fmt.pf ppf "@[<v>%a@]@." 1980 + Fmt.(list ~sep:(any "@,@,") pp_diff_entry) result.entries 1981 + end 1982 + 1983 + let diff ~proc ~fs ~config ~verse_config ?repo ?(refresh=false) () = 1984 + let checkouts_path = Config.Paths.checkouts config in 1985 + 1986 + (* Compute fork analysis *) 1987 + let forks = Forks.compute ~proc ~fs ~verse_config ~monopam_config:config ~refresh () in 1988 + 1989 + (* Filter repos if specific one requested *) 1990 + let repos_to_check = match repo with 1991 + | None -> forks.repos 1992 + | Some name -> List.filter (fun r -> r.Forks.repo_name = name) forks.repos 1993 + in 1994 + 1995 + (* For each repo with actionable status, get commits *) 1996 + let entries = 1997 + List.filter_map (fun (r : Forks.repo_analysis) -> 1998 + (* Find actionable verse sources *) 1999 + let actionable = List.filter (fun (_, _, rel) -> 2000 + match rel with 2001 + | Forks.I_am_behind _ -> true 2002 + | Forks.Diverged _ -> true 2003 + | _ -> false) 2004 + r.verse_sources 2005 + in 2006 + match actionable with 2007 + | [] -> None 2008 + | sources -> 2009 + (* Get commits for each actionable source *) 2010 + let entries = List.filter_map (fun (handle, _src, rel) -> 2011 + let checkout_path = Fpath.(checkouts_path / r.repo_name) in 2012 + if not (Git.is_repo ~proc ~fs checkout_path) then None 2013 + else begin 2014 + let remote_name = "verse/" ^ handle in 2015 + let my_ref = "origin/main" in 2016 + let their_ref = remote_name ^ "/main" in 2017 + (* Get commits they have that I don't *) 2018 + match Git.log_range ~proc ~fs ~base:my_ref ~tip:their_ref ~max_count:20 checkout_path with 2019 + | Error _ -> None 2020 + | Ok commits when commits = [] -> None 2021 + | Ok commits -> 2022 + Some { repo_name = r.repo_name; handle; relationship = rel; commits } 2023 + end) 2024 + sources 2025 + in 2026 + match entries with 2027 + | [] -> None 2028 + | _ -> Some entries) 2029 + repos_to_check 2030 + |> List.flatten 2031 + in 2032 + { entries; forks }

+47

lib/monopam.mli

··· 371 371 @param history Number of recent days to include in DAILY-CHANGES.md (default: 30) 372 372 @param dry_run If true, preview changes without writing files 373 373 @param aggregate If true, also generate .changes/YYYYMMDD.json aggregated file *) 374 + 375 + (** {1 Diff} *) 376 + 377 + (** A diff entry for a single repository showing commits from a verse member. *) 378 + type diff_entry = { 379 + repo_name : string; 380 + handle : string; 381 + relationship : Forks.relationship; 382 + commits : Git.log_entry list; 383 + } 384 + 385 + (** Result of computing diffs for repos needing attention. *) 386 + type diff_result = { 387 + entries : diff_entry list; 388 + forks : Forks.t; 389 + } 390 + 391 + val pp_diff_entry : diff_entry Fmt.t 392 + (** [pp_diff_entry] formats a single diff entry. *) 393 + 394 + val pp_diff_result : diff_result Fmt.t 395 + (** [pp_diff_result] formats the full diff result. *) 396 + 397 + val diff : 398 + proc:_ Eio.Process.mgr -> 399 + fs:Eio.Fs.dir_ty Eio.Path.t -> 400 + config:Config.t -> 401 + verse_config:Verse_config.t -> 402 + ?repo:string -> 403 + ?refresh:bool -> 404 + unit -> 405 + diff_result 406 + (** [diff ~proc ~fs ~config ~verse_config ?repo ?refresh ()] computes and displays diffs 407 + for repositories that need attention from verse members. 408 + 409 + For each repository where a verse member is ahead (I_am_behind or Diverged), 410 + retrieves the commit log showing what commits they have that you don't. 411 + 412 + Remote fetches are cached for 5 minutes. Use [~refresh:true] to force fresh 413 + fetches from all remotes. 414 + 415 + @param proc Eio process manager 416 + @param fs Eio filesystem 417 + @param config Monopam configuration 418 + @param verse_config Verse configuration 419 + @param repo Optional specific repository to show diff for 420 + @param refresh If true, force fresh fetches ignoring cache (default: false) *)

+9

lib/verse_config.ml

··· 33 33 | Some home -> Fpath.(v home / ".local" / "share") 34 34 | None -> Fpath.v "/tmp" 35 35 36 + let xdg_cache_home () = 37 + match Sys.getenv_opt "XDG_CACHE_HOME" with 38 + | Some dir when dir <> "" -> Fpath.v dir 39 + | _ -> 40 + match Sys.getenv_opt "HOME" with 41 + | Some home -> Fpath.(v home / ".cache") 42 + | None -> Fpath.v "/tmp" 43 + 36 44 let config_dir () = Fpath.(xdg_config_home () / app_name) 37 45 let data_dir () = Fpath.(xdg_data_home () / app_name) 46 + let cache_dir () = Fpath.(xdg_cache_home () / app_name) 38 47 let config_file () = Fpath.(config_dir () / "opamverse.toml") 39 48 let registry_path () = Fpath.(data_dir () / "opamverse-registry") 40 49

+4

lib/verse_config.mli

··· 50 50 (** [data_dir ()] returns the XDG data directory for monopam 51 51 (~/.local/share/monopam). *) 52 52 53 + val cache_dir : unit -> Fpath.t 54 + (** [cache_dir ()] returns the XDG cache directory for monopam 55 + (~/.cache/monopam). Used for non-essential cached data like fetch timestamps. *) 56 + 53 57 val config_file : unit -> Fpath.t 54 58 (** [config_file ()] returns the path to the opamverse config file 55 59 (~/.config/monopam/opamverse.toml). *)

Configure Feed

Configure Feed