+2

.ocamlformat

··· 0 0

··· 1 + version = 0.28.1 2 + profile = default

+15

LICENSE

··· 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 1 + ISC License 2 + 3 + Copyright (c) 2024 Anil Madhavapeddy <anil@recoil.org> 4 + 5 + Permission to use, copy, modify, and/or distribute this software for any 6 + purpose with or without fee is hereby granted, provided that the above 7 + copyright notice and this permission notice appear in all copies. 8 + 9 + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH 10 + REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY 11 + AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, 12 + INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM 13 + LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR 14 + OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR 15 + PERFORMANCE OF THIS SOFTWARE.

+190 -106

bin/main.ml

··· 9 Term.(const setup_logging $ Fmt_cli.style_renderer () $ Logs_cli.level ()) 10 11 let config_file_arg = 12 - let doc = "Path to config file. If not specified, searches current directory then XDG locations." in 13 - Arg.(value & opt (some string) None & info [ "c"; "config" ] ~docv:"FILE" ~doc) 0 0 0 0 14 15 let package_arg = 16 let doc = "Package name. If not specified, operates on all packages." in ··· 26 if Fpath.is_abs load_path then 27 Monopam.Config.load ~fs ~root_fs:fs load_path 28 else 29 - match Monopam.Config.load ~fs:(cwd :> _ Eio.Path.t) ~root_fs:fs load_path with 0 0 30 | Ok c -> Ok c 31 | Error msg -> Error msg) 32 | None -> ( 33 (* Try current directory first *) 34 let cwd_config = Fpath.v "monopam.toml" in 35 - match Monopam.Config.load ~fs:(cwd :> _ Eio.Path.t) ~root_fs:fs cwd_config with 0 0 36 | Ok c -> Ok c 37 - | Error _ -> 38 (* Try XDG *) 39 let xdg = Xdge.create fs "monopam" in 40 match Monopam.Config.load_xdg ~xdg () with 41 | Ok c -> Ok c 42 - | Error msg -> Error msg) 43 44 let with_config env config_file f = 45 match load_config env config_file with ··· 52 53 let status_cmd = 54 let doc = "Show synchronization status of all packages" in 55 - let man = [ 56 - `S Manpage.s_description; 57 - `P "Displays the status of each package discovered in the opam overlay. \ 58 - For each package, shows whether the checkout is clean or has local \ 59 - changes, and whether the subtree is present in the monorepo."; 60 - `P "Status indicators:"; 61 - `I ("clean", "Checkout matches remote, no local changes"); 62 - `I ("ahead N, behind M", "Checkout has N unpushed commits and is M commits behind remote"); 63 - `I ("present", "Subtree exists in monorepo"); 64 - `I ("missing", "Subtree not yet added to monorepo"); 65 - ] in 0 0 0 0 0 66 let info = Cmd.info "status" ~doc ~man in 67 let run config_file () = 68 Eio_main.run @@ fun env -> ··· 83 84 let pull_cmd = 85 let doc = "Pull updates from remotes into monorepo" in 86 - let man = [ 87 - `S Manpage.s_description; 88 - `P "Fetches the latest changes from git remotes and updates both the \ 89 - individual checkouts and the monorepo subtrees."; 90 - `P "For each unique repository:"; 91 - `I ("1.", "Clones the repository if not present, or fetches and fast-forward merges"); 92 - `I ("2.", "Adds or pulls the git subtree into the monorepo"); 93 - `P "If a specific package is given, only that package's repository is processed."; 94 - `P "The operation will fail if any checkout has uncommitted changes."; 95 - ] in 0 0 0 0 0 0 0 0 96 let info = Cmd.info "pull" ~doc ~man in 97 let run config_file package () = 98 Eio_main.run @@ fun env -> ··· 107 Fmt.epr "Error: %a@." Monopam.pp_error e; 108 `Error (false, "pull failed") 109 in 110 - Cmd.v info Term.(ret (const run $ config_file_arg $ package_arg $ logging_term)) 0 111 112 (* Push command *) 113 114 let push_cmd = 115 let doc = "Push changes from monorepo to checkouts" in 116 - let man = [ 117 - `S Manpage.s_description; 118 - `P "Extracts changes made in the monorepo and merges them into the \ 119 - individual git checkouts using git subtree split."; 120 - `P "For each unique repository:"; 121 - `I ("1.", "Splits the subtree commits from the monorepo"); 122 - `I ("2.", "Fast-forward merges the split commits into the checkout"); 123 - `P "After running push, you can review the changes in each checkout \ 124 - and manually push them to the git remotes."; 125 - `P "The operation will fail if any checkout has uncommitted changes."; 126 - ] in 0 0 0 0 127 let info = Cmd.info "push" ~doc ~man in 128 let run config_file package () = 129 Eio_main.run @@ fun env -> ··· 138 Fmt.epr "Error: %a@." Monopam.pp_error e; 139 `Error (false, "push failed") 140 in 141 - Cmd.v info Term.(ret (const run $ config_file_arg $ package_arg $ logging_term)) 0 142 143 (* Add command *) 144 145 let add_cmd = 146 let doc = "Add a package to the monorepo" in 147 - let man = [ 148 - `S Manpage.s_description; 149 - `P "Adds a single package from the opam overlay to the monorepo."; 150 - `P "This clones the package's git repository if not already present, \ 151 - then adds it as a git subtree in the monorepo."; 152 - ] in 0 0 0 153 let info = Cmd.info "add" ~doc ~man in 154 let package_arg = 155 let doc = "Package name to add" in ··· 168 Fmt.epr "Error: %a@." Monopam.pp_error e; 169 `Error (false, "add failed") 170 in 171 - Cmd.v info Term.(ret (const run $ config_file_arg $ package_arg $ logging_term)) 0 172 173 (* Remove command *) 174 175 let remove_cmd = 176 let doc = "Remove a package from the monorepo" in 177 - let man = [ 178 - `S Manpage.s_description; 179 - `P "Removes a package's subtree directory from the monorepo."; 180 - `P "This does not delete the git checkout - only the subtree in the monorepo."; 181 - ] in 0 0 0 0 182 let info = Cmd.info "remove" ~doc ~man in 183 let package_arg = 184 let doc = "Package name to remove" in ··· 197 Fmt.epr "Error: %a@." Monopam.pp_error e; 198 `Error (false, "remove failed") 199 in 200 - Cmd.v info Term.(ret (const run $ config_file_arg $ package_arg $ logging_term)) 0 201 202 (* Init command *) 203 204 let prompt_path ~stdin ~stdout ~cwd prompt ~default = 205 - let default_str = match default with Some d -> Fmt.str " [%a]" Fpath.pp d | None -> "" in 0 0 206 Eio.Flow.copy_string (Fmt.str "%s%s: " prompt default_str) stdout; 207 let input = String.trim (Eio.Buf_read.line stdin) in 208 - let input = if input = "" then Option.map Fpath.to_string default else Some input in 0 0 209 match input with 210 | None -> Error "Path is required" 211 - | Some s -> 212 (* Expand tilde *) 213 let s = 214 if String.length s > 0 && s.[0] = '~' then 215 match Sys.getenv_opt "HOME" with 216 | Some home -> 217 if String.length s = 1 then home 218 - else if s.[1] = '/' then home ^ String.sub s 1 (String.length s - 1) 0 219 else s 220 | None -> s 221 else s ··· 225 | Ok path -> 226 (* Convert relative to absolute using cwd *) 227 let path = 228 - if Fpath.is_abs path then path 229 - else Fpath.(cwd // path |> normalize) 230 in 231 - Ok path 232 233 let init_cmd = 234 let doc = "Initialize a new monopam configuration" in 235 - let man = [ 236 - `S Manpage.s_description; 237 - `P "Interactively creates a monopam.toml configuration file in the current \ 238 - directory. Prompts for the paths to the opam overlay, checkouts directory, \ 239 - and monorepo directory."; 240 - `P "All paths must be absolute. You can use ~/ for your home directory, \ 241 - and relative paths will be converted to absolute based on the current \ 242 - working directory."; 243 - ] in 0 0 0 0 244 let info = Cmd.info "init" ~doc ~man in 245 let output_arg = 246 let doc = "Output path for config file (default: monopam.toml)" in 247 - Arg.(value & opt string "monopam.toml" & info [ "o"; "output" ] ~docv:"FILE" ~doc) 0 0 248 in 249 let run output () = 250 Eio_main.run @@ fun env -> 251 let _fs = Eio.Stdenv.fs env in 252 let cwd_path = Eio.Stdenv.cwd env in 253 - let stdin = Eio.Buf_read.of_flow ~max_size:(1024 * 1024) (Eio.Stdenv.stdin env) in 0 0 254 let stdout = Eio.Stdenv.stdout env in 255 (* Get current working directory as Fpath *) 256 let cwd = 257 - let (_, cwd_str) = (cwd_path :> _ Eio.Path.t) in 258 - match Fpath.of_string cwd_str with 259 - | Ok p -> p 260 - | Error _ -> Fpath.v "/" 261 in 262 Eio.Flow.copy_string "Monopam Configuration Setup\n" stdout; 263 Eio.Flow.copy_string "===========================\n\n" stdout; 264 - Eio.Flow.copy_string "All paths must be absolute. Use ~/ for home directory.\n" stdout; 265 - Eio.Flow.copy_string "Relative paths will be converted to absolute.\n\n" stdout; 0 0 266 (* Prompt for opam_repo *) 267 let opam_repo = ref None in 268 while !opam_repo = None do 269 - match prompt_path ~stdin ~stdout ~cwd "Path to opam overlay repository" ~default:None with 0 0 0 270 | Ok p -> opam_repo := Some p 271 | Error msg -> 272 - Eio.Flow.copy_string (Fmt.str "Error: %s. Please try again.\n" msg) stdout 0 0 273 done; 274 let opam_repo = Option.get !opam_repo in 275 (* Prompt for checkouts *) 276 let default_checkouts = Fpath.(parent opam_repo / "src") in 277 let checkouts = ref None in 278 while !checkouts = None do 279 - match prompt_path ~stdin ~stdout ~cwd "Path for git checkouts" ~default:(Some default_checkouts) with 0 0 0 280 | Ok p -> checkouts := Some p 281 | Error msg -> 282 - Eio.Flow.copy_string (Fmt.str "Error: %s. Please try again.\n" msg) stdout 0 0 283 done; 284 let checkouts = Option.get !checkouts in 285 (* Prompt for monorepo *) 286 let default_monorepo = Fpath.(parent opam_repo / "mono") in 287 let monorepo = ref None in 288 while !monorepo = None do 289 - match prompt_path ~stdin ~stdout ~cwd "Path for monorepo" ~default:(Some default_monorepo) with 0 0 0 290 | Ok p -> monorepo := Some p 291 | Error msg -> 292 - Eio.Flow.copy_string (Fmt.str "Error: %s. Please try again.\n" msg) stdout 0 0 293 done; 294 let monorepo = Option.get !monorepo in 295 (* Prompt for default branch *) ··· 297 let branch_input = String.trim (Eio.Buf_read.line stdin) in 298 let default_branch = if branch_input = "" then "main" else branch_input in 299 (* Create config *) 300 - let config = Monopam.Config.create ~opam_repo ~checkouts ~monorepo ~default_branch () in 0 0 301 (* Save config *) 302 let output_path = Fpath.v output in 303 - match Monopam.Config.save ~fs:(cwd_path :> _ Eio.Path.t) config output_path with 0 0 304 | Ok () -> 305 - Eio.Flow.copy_string (Fmt.str "\nConfiguration saved to %s\n" output) stdout; 306 - Eio.Flow.copy_string "\nYou can now run 'monopam pull' to initialize the monorepo.\n" stdout; 0 0 0 0 307 `Ok () 308 | Error msg -> 309 Fmt.epr "Error saving config: %s@." msg; ··· 323 individual git checkouts, and a monorepo using git subtrees."; 324 `S "DIRECTORY STRUCTURE"; 325 `P "Monopam manages three directory trees:"; 326 - `I ("opam-repo/", "The opam overlay repository containing package metadata. \ 327 - Each package's opam file specifies a dev-repo URL pointing to its git source."); 328 - `I ("src/", "Individual git checkouts of each unique repository. Multiple \ 329 - packages may share a checkout if they come from the same dev-repo. \ 330 - Directory names are the repository basename (e.g., ocaml-yaml from \ 331 - https://github.com/foo/ocaml-yaml.git)."); 332 - `I ("mono/", "The monorepo combining all packages as git subtrees. Each \ 333 - subtree directory is named after the repository basename. This is \ 334 - where you make changes that span multiple packages."); 0 0 0 0 0 0 0 335 `S "WORKFLOW"; 336 `P "The typical workflow is:"; 337 - `I ("1. monopam pull", "Fetch latest from all remotes, update checkouts, \ 338 - merge into monorepo subtrees"); 0 0 339 `I ("2. Edit code", "Make changes in the mono/ directory"); 340 `I ("3. git commit", "Commit your changes in mono/"); 341 `I ("4. monopam push", "Extract changes back to individual checkouts"); 342 - `I ("5. Review and push", "Review changes in src/*/, then git push each one"); 0 0 343 `S "CONFIGURATION"; 344 - `P "Run $(b,monopam init) to interactively create a configuration file. \ 345 - Configuration is read from monopam.toml in the current directory \ 346 - or XDG config locations."; 0 347 `P "All paths in the configuration must be absolute. Example:"; 348 - `Pre "opam_repo = \"/home/user/opam-overlay\"\n\ 349 - checkouts = \"/home/user/src\"\n\ 350 - monorepo = \"/home/user/mono\"\n\ 351 - default_branch = \"main\""; 0 352 `S Manpage.s_commands; 353 `P "Use $(b,monopam COMMAND --help) for help on a specific command."; 354 ]

··· 9 Term.(const setup_logging $ Fmt_cli.style_renderer () $ Logs_cli.level ()) 10 11 let config_file_arg = 12 + let doc = 13 + "Path to config file. If not specified, searches current directory then \ 14 + XDG locations." 15 + in 16 + Arg.( 17 + value & opt (some string) None & info [ "c"; "config" ] ~docv:"FILE" ~doc) 18 19 let package_arg = 20 let doc = "Package name. If not specified, operates on all packages." in ··· 30 if Fpath.is_abs load_path then 31 Monopam.Config.load ~fs ~root_fs:fs load_path 32 else 33 + match 34 + Monopam.Config.load ~fs:(cwd :> _ Eio.Path.t) ~root_fs:fs load_path 35 + with 36 | Ok c -> Ok c 37 | Error msg -> Error msg) 38 | None -> ( 39 (* Try current directory first *) 40 let cwd_config = Fpath.v "monopam.toml" in 41 + match 42 + Monopam.Config.load ~fs:(cwd :> _ Eio.Path.t) ~root_fs:fs cwd_config 43 + with 44 | Ok c -> Ok c 45 + | Error _ -> ( 46 (* Try XDG *) 47 let xdg = Xdge.create fs "monopam" in 48 match Monopam.Config.load_xdg ~xdg () with 49 | Ok c -> Ok c 50 + | Error msg -> Error msg)) 51 52 let with_config env config_file f = 53 match load_config env config_file with ··· 60 61 let status_cmd = 62 let doc = "Show synchronization status of all packages" in 63 + let man = 64 + [ 65 + `S Manpage.s_description; 66 + `P 67 + "Displays the status of each package discovered in the opam overlay. \ 68 + For each package, shows whether the checkout is clean or has local \ 69 + changes, and whether the subtree is present in the monorepo."; 70 + `P "Status indicators:"; 71 + `I ("clean", "Checkout matches remote, no local changes"); 72 + `I 73 + ( "ahead N, behind M", 74 + "Checkout has N unpushed commits and is M commits behind remote" ); 75 + `I ("present", "Subtree exists in monorepo"); 76 + `I ("missing", "Subtree not yet added to monorepo"); 77 + ] 78 + in 79 let info = Cmd.info "status" ~doc ~man in 80 let run config_file () = 81 Eio_main.run @@ fun env -> ··· 96 97 let pull_cmd = 98 let doc = "Pull updates from remotes into monorepo" in 99 + let man = 100 + [ 101 + `S Manpage.s_description; 102 + `P 103 + "Fetches the latest changes from git remotes and updates both the \ 104 + individual checkouts and the monorepo subtrees."; 105 + `P "For each unique repository:"; 106 + `I 107 + ( "1.", 108 + "Clones the repository if not present, or fetches and fast-forward \ 109 + merges" ); 110 + `I ("2.", "Adds or pulls the git subtree into the monorepo"); 111 + `P 112 + "If a specific package is given, only that package's repository is \ 113 + processed."; 114 + `P "The operation will fail if any checkout has uncommitted changes."; 115 + ] 116 + in 117 let info = Cmd.info "pull" ~doc ~man in 118 let run config_file package () = 119 Eio_main.run @@ fun env -> ··· 128 Fmt.epr "Error: %a@." Monopam.pp_error e; 129 `Error (false, "pull failed") 130 in 131 + Cmd.v info 132 + Term.(ret (const run $ config_file_arg $ package_arg $ logging_term)) 133 134 (* Push command *) 135 136 let push_cmd = 137 let doc = "Push changes from monorepo to checkouts" in 138 + let man = 139 + [ 140 + `S Manpage.s_description; 141 + `P 142 + "Extracts changes made in the monorepo and merges them into the \ 143 + individual git checkouts using git subtree split."; 144 + `P "For each unique repository:"; 145 + `I ("1.", "Splits the subtree commits from the monorepo"); 146 + `I ("2.", "Fast-forward merges the split commits into the checkout"); 147 + `P 148 + "After running push, you can review the changes in each checkout and \ 149 + manually push them to the git remotes."; 150 + `P "The operation will fail if any checkout has uncommitted changes."; 151 + ] 152 + in 153 let info = Cmd.info "push" ~doc ~man in 154 let run config_file package () = 155 Eio_main.run @@ fun env -> ··· 164 Fmt.epr "Error: %a@." Monopam.pp_error e; 165 `Error (false, "push failed") 166 in 167 + Cmd.v info 168 + Term.(ret (const run $ config_file_arg $ package_arg $ logging_term)) 169 170 (* Add command *) 171 172 let add_cmd = 173 let doc = "Add a package to the monorepo" in 174 + let man = 175 + [ 176 + `S Manpage.s_description; 177 + `P "Adds a single package from the opam overlay to the monorepo."; 178 + `P 179 + "This clones the package's git repository if not already present, then \ 180 + adds it as a git subtree in the monorepo."; 181 + ] 182 + in 183 let info = Cmd.info "add" ~doc ~man in 184 let package_arg = 185 let doc = "Package name to add" in ··· 198 Fmt.epr "Error: %a@." Monopam.pp_error e; 199 `Error (false, "add failed") 200 in 201 + Cmd.v info 202 + Term.(ret (const run $ config_file_arg $ package_arg $ logging_term)) 203 204 (* Remove command *) 205 206 let remove_cmd = 207 let doc = "Remove a package from the monorepo" in 208 + let man = 209 + [ 210 + `S Manpage.s_description; 211 + `P "Removes a package's subtree directory from the monorepo."; 212 + `P 213 + "This does not delete the git checkout - only the subtree in the \ 214 + monorepo."; 215 + ] 216 + in 217 let info = Cmd.info "remove" ~doc ~man in 218 let package_arg = 219 let doc = "Package name to remove" in ··· 232 Fmt.epr "Error: %a@." Monopam.pp_error e; 233 `Error (false, "remove failed") 234 in 235 + Cmd.v info 236 + Term.(ret (const run $ config_file_arg $ package_arg $ logging_term)) 237 238 (* Init command *) 239 240 let prompt_path ~stdin ~stdout ~cwd prompt ~default = 241 + let default_str = 242 + match default with Some d -> Fmt.str " [%a]" Fpath.pp d | None -> "" 243 + in 244 Eio.Flow.copy_string (Fmt.str "%s%s: " prompt default_str) stdout; 245 let input = String.trim (Eio.Buf_read.line stdin) in 246 + let input = 247 + if input = "" then Option.map Fpath.to_string default else Some input 248 + in 249 match input with 250 | None -> Error "Path is required" 251 + | Some s -> ( 252 (* Expand tilde *) 253 let s = 254 if String.length s > 0 && s.[0] = '~' then 255 match Sys.getenv_opt "HOME" with 256 | Some home -> 257 if String.length s = 1 then home 258 + else if s.[1] = '/' then 259 + home ^ String.sub s 1 (String.length s - 1) 260 else s 261 | None -> s 262 else s ··· 266 | Ok path -> 267 (* Convert relative to absolute using cwd *) 268 let path = 269 + if Fpath.is_abs path then path else Fpath.(cwd // path |> normalize) 0 270 in 271 + Ok path) 272 273 let init_cmd = 274 let doc = "Initialize a new monopam configuration" in 275 + let man = 276 + [ 277 + `S Manpage.s_description; 278 + `P 279 + "Interactively creates a monopam.toml configuration file in the \ 280 + current directory. Prompts for the paths to the opam overlay, \ 281 + checkouts directory, and monorepo directory."; 282 + `P 283 + "All paths must be absolute. You can use ~/ for your home directory, \ 284 + and relative paths will be converted to absolute based on the current \ 285 + working directory."; 286 + ] 287 + in 288 let info = Cmd.info "init" ~doc ~man in 289 let output_arg = 290 let doc = "Output path for config file (default: monopam.toml)" in 291 + Arg.( 292 + value & opt string "monopam.toml" 293 + & info [ "o"; "output" ] ~docv:"FILE" ~doc) 294 in 295 let run output () = 296 Eio_main.run @@ fun env -> 297 let _fs = Eio.Stdenv.fs env in 298 let cwd_path = Eio.Stdenv.cwd env in 299 + let stdin = 300 + Eio.Buf_read.of_flow ~max_size:(1024 * 1024) (Eio.Stdenv.stdin env) 301 + in 302 let stdout = Eio.Stdenv.stdout env in 303 (* Get current working directory as Fpath *) 304 let cwd = 305 + let _, cwd_str = (cwd_path :> _ Eio.Path.t) in 306 + match Fpath.of_string cwd_str with Ok p -> p | Error _ -> Fpath.v "/" 0 0 307 in 308 Eio.Flow.copy_string "Monopam Configuration Setup\n" stdout; 309 Eio.Flow.copy_string "===========================\n\n" stdout; 310 + Eio.Flow.copy_string 311 + "All paths must be absolute. Use ~/ for home directory.\n" stdout; 312 + Eio.Flow.copy_string "Relative paths will be converted to absolute.\n\n" 313 + stdout; 314 (* Prompt for opam_repo *) 315 let opam_repo = ref None in 316 while !opam_repo = None do 317 + match 318 + prompt_path ~stdin ~stdout ~cwd "Path to opam overlay repository" 319 + ~default:None 320 + with 321 | Ok p -> opam_repo := Some p 322 | Error msg -> 323 + Eio.Flow.copy_string 324 + (Fmt.str "Error: %s. Please try again.\n" msg) 325 + stdout 326 done; 327 let opam_repo = Option.get !opam_repo in 328 (* Prompt for checkouts *) 329 let default_checkouts = Fpath.(parent opam_repo / "src") in 330 let checkouts = ref None in 331 while !checkouts = None do 332 + match 333 + prompt_path ~stdin ~stdout ~cwd "Path for git checkouts" 334 + ~default:(Some default_checkouts) 335 + with 336 | Ok p -> checkouts := Some p 337 | Error msg -> 338 + Eio.Flow.copy_string 339 + (Fmt.str "Error: %s. Please try again.\n" msg) 340 + stdout 341 done; 342 let checkouts = Option.get !checkouts in 343 (* Prompt for monorepo *) 344 let default_monorepo = Fpath.(parent opam_repo / "mono") in 345 let monorepo = ref None in 346 while !monorepo = None do 347 + match 348 + prompt_path ~stdin ~stdout ~cwd "Path for monorepo" 349 + ~default:(Some default_monorepo) 350 + with 351 | Ok p -> monorepo := Some p 352 | Error msg -> 353 + Eio.Flow.copy_string 354 + (Fmt.str "Error: %s. Please try again.\n" msg) 355 + stdout 356 done; 357 let monorepo = Option.get !monorepo in 358 (* Prompt for default branch *) ··· 360 let branch_input = String.trim (Eio.Buf_read.line stdin) in 361 let default_branch = if branch_input = "" then "main" else branch_input in 362 (* Create config *) 363 + let config = 364 + Monopam.Config.create ~opam_repo ~checkouts ~monorepo ~default_branch () 365 + in 366 (* Save config *) 367 let output_path = Fpath.v output in 368 + match 369 + Monopam.Config.save ~fs:(cwd_path :> _ Eio.Path.t) config output_path 370 + with 371 | Ok () -> 372 + Eio.Flow.copy_string 373 + (Fmt.str "\nConfiguration saved to %s\n" output) 374 + stdout; 375 + Eio.Flow.copy_string 376 + "\nYou can now run 'monopam pull' to initialize the monorepo.\n" 377 + stdout; 378 `Ok () 379 | Error msg -> 380 Fmt.epr "Error saving config: %s@." msg; ··· 394 individual git checkouts, and a monorepo using git subtrees."; 395 `S "DIRECTORY STRUCTURE"; 396 `P "Monopam manages three directory trees:"; 397 + `I 398 + ( "opam-repo/", 399 + "The opam overlay repository containing package metadata. Each \ 400 + package's opam file specifies a dev-repo URL pointing to its git \ 401 + source." ); 402 + `I 403 + ( "src/", 404 + "Individual git checkouts of each unique repository. Multiple \ 405 + packages may share a checkout if they come from the same dev-repo. \ 406 + Directory names are the repository basename (e.g., ocaml-yaml from \ 407 + https://github.com/foo/ocaml-yaml.git)." ); 408 + `I 409 + ( "mono/", 410 + "The monorepo combining all packages as git subtrees. Each subtree \ 411 + directory is named after the repository basename. This is where you \ 412 + make changes that span multiple packages." ); 413 `S "WORKFLOW"; 414 `P "The typical workflow is:"; 415 + `I 416 + ( "1. monopam pull", 417 + "Fetch latest from all remotes, update checkouts, merge into \ 418 + monorepo subtrees" ); 419 `I ("2. Edit code", "Make changes in the mono/ directory"); 420 `I ("3. git commit", "Commit your changes in mono/"); 421 `I ("4. monopam push", "Extract changes back to individual checkouts"); 422 + `I 423 + ( "5. Review and push", 424 + "Review changes in src/*/, then git push each one" ); 425 `S "CONFIGURATION"; 426 + `P 427 + "Run $(b,monopam init) to interactively create a configuration file. \ 428 + Configuration is read from monopam.toml in the current directory or \ 429 + XDG config locations."; 430 `P "All paths in the configuration must be absolute. Example:"; 431 + `Pre 432 + "opam_repo = \"/home/user/opam-overlay\"\n\ 433 + checkouts = \"/home/user/src\"\n\ 434 + monorepo = \"/home/user/mono\"\n\ 435 + default_branch = \"main\""; 436 `S Manpage.s_commands; 437 `P "Use $(b,monopam COMMAND --help) for help on a specific command."; 438 ]

+14 -17

lib/config.ml

··· 50 Tomlt.map 51 ~dec:(fun s -> 52 let s = expand_tilde s in 53 - match Fpath.of_string s with 54 - | Ok p -> p 55 - | Error (`Msg m) -> failwith m) 56 ~enc:Fpath.to_string Tomlt.string 57 58 let codec : t Tomlt.t = 59 Tomlt.( 60 Table.( 61 - obj 62 - (fun opam_repo checkouts monorepo default_branch packages -> 63 { 64 opam_repo; 65 checkouts; ··· 70 |> mem "opam_repo" fpath_codec ~enc:(fun c -> c.opam_repo) 71 |> mem "checkouts" fpath_codec ~enc:(fun c -> c.checkouts) 72 |> mem "monorepo" fpath_codec ~enc:(fun c -> c.monorepo) 73 - |> opt_mem "default_branch" string 74 - ~enc:(fun c -> 75 - if c.default_branch = "main" then None else Some c.default_branch) 76 |> keep_unknown 77 ~enc:(fun c -> c.packages) 78 (Mems.assoc Package_config.codec) ··· 92 Fmt.pf ppf "%s path is not a directory: %a" field Fpath.pp path 93 | Not_an_opam_repo path -> 94 Fmt.pf ppf 95 - "opam_repo is not a valid opam repository (missing packages/ directory): %a" 0 96 Fpath.pp path 97 - | Invalid_path (field, msg) -> 98 - Fmt.pf ppf "%s has invalid path: %s" field msg 99 | Relative_path (field, path) -> 100 - Fmt.pf ppf "%s must be an absolute path, got: %a\n\ 101 - Hint: Use an absolute path starting with / or ~/" field Fpath.pp path 0 0 102 103 let validate ~fs t = 104 (* Get the root filesystem for checking absolute paths *) 105 let root_fs = 106 - let (dir, _) = (fs : _ Eio.Path.t) in 107 (dir, "") 108 in 109 let check_absolute field path = 110 - if Fpath.is_abs path then Ok () 111 - else Error (Relative_path (field, path)) 112 in 113 let check_dir field path = 114 let eio_path = Eio.Path.(root_fs / Fpath.to_string path) in ··· 155 let config = 156 Tomlt_eio.decode_path_exn codec ~fs:config_dir (snd config_path) 157 in 158 - let (dir, _) = config_dir in 159 validate ~fs:(dir, "") config 160 |> Result.map_error (fun e -> Fmt.str "%a" pp_validation_error e) 161 with

··· 50 Tomlt.map 51 ~dec:(fun s -> 52 let s = expand_tilde s in 53 + match Fpath.of_string s with Ok p -> p | Error (`Msg m) -> failwith m) 0 0 54 ~enc:Fpath.to_string Tomlt.string 55 56 let codec : t Tomlt.t = 57 Tomlt.( 58 Table.( 59 + obj (fun opam_repo checkouts monorepo default_branch packages -> 0 60 { 61 opam_repo; 62 checkouts; ··· 67 |> mem "opam_repo" fpath_codec ~enc:(fun c -> c.opam_repo) 68 |> mem "checkouts" fpath_codec ~enc:(fun c -> c.checkouts) 69 |> mem "monorepo" fpath_codec ~enc:(fun c -> c.monorepo) 70 + |> opt_mem "default_branch" string ~enc:(fun c -> 71 + if c.default_branch = "main" then None else Some c.default_branch) 0 72 |> keep_unknown 73 ~enc:(fun c -> c.packages) 74 (Mems.assoc Package_config.codec) ··· 88 Fmt.pf ppf "%s path is not a directory: %a" field Fpath.pp path 89 | Not_an_opam_repo path -> 90 Fmt.pf ppf 91 + "opam_repo is not a valid opam repository (missing packages/ \ 92 + directory): %a" 93 Fpath.pp path 94 + | Invalid_path (field, msg) -> Fmt.pf ppf "%s has invalid path: %s" field msg 0 95 | Relative_path (field, path) -> 96 + Fmt.pf ppf 97 + "%s must be an absolute path, got: %a\n\ 98 + Hint: Use an absolute path starting with / or ~/" 99 + field Fpath.pp path 100 101 let validate ~fs t = 102 (* Get the root filesystem for checking absolute paths *) 103 let root_fs = 104 + let dir, _ = (fs : _ Eio.Path.t) in 105 (dir, "") 106 in 107 let check_absolute field path = 108 + if Fpath.is_abs path then Ok () else Error (Relative_path (field, path)) 0 109 in 110 let check_dir field path = 111 let eio_path = Eio.Path.(root_fs / Fpath.to_string path) in ··· 152 let config = 153 Tomlt_eio.decode_path_exn codec ~fs:config_dir (snd config_path) 154 in 155 + let dir, _ = config_dir in 156 validate ~fs:(dir, "") config 157 |> Result.map_error (fun e -> Fmt.str "%a" pp_validation_error e) 158 with

+40 -41

lib/config.mli

··· 1 (** Configuration management for monopam. 2 3 Configuration is stored in TOML format and loaded from XDG standard 4 - locations or a user-specified path. The config file specifies paths 5 - to the opam overlay, individual checkouts, and the monorepo, along 6 - with optional per-package overrides. *) 7 8 (** {1 Types} *) 9 10 (** Per-package configuration overrides. *) 11 module Package_config : sig 12 - (** Package-specific settings. *) 13 type t 0 14 0 15 (** [branch t] returns the branch override for this package, if set. *) 16 - val branch : t -> string option 17 end 18 0 19 (** The main configuration. *) 20 - type t 21 22 (** {1 Paths Configuration} *) 23 24 (** Path-related accessors. *) 25 module Paths : sig 26 - (** [opam_repo t] returns the path to the opam overlay repository. *) 27 val opam_repo : t -> Fpath.t 0 28 29 - (** [checkouts t] returns the parent directory where individual 30 - package checkouts are stored. *) 31 val checkouts : t -> Fpath.t 0 0 32 0 33 (** [monorepo t] returns the path to the monorepo directory. *) 34 - val monorepo : t -> Fpath.t 35 end 36 37 (** {1 Options} *) 38 0 39 (** [default_branch t] returns the default git branch to track. 40 41 Defaults to "main" if not specified. *) 42 - val default_branch : t -> string 43 44 - (** [package_config t name] returns package-specific configuration 45 - overrides for the named package, if any exist. *) 46 val package_config : t -> string -> Package_config.t option 0 0 47 48 (** {1 Validation} *) 49 50 (** Errors that can occur when validating configuration paths. *) 51 type validation_error = 52 - | Path_not_found of string * Fpath.t 53 - (** A configured path does not exist *) 54 | Not_a_directory of string * Fpath.t 55 (** A configured path is not a directory *) 56 | Not_an_opam_repo of Fpath.t 57 - (** The opam_repo path is not a valid opam repository 58 - (missing packages/ directory) *) 59 - | Invalid_path of string * string 60 - (** A path string could not be parsed *) 61 | Relative_path of string * Fpath.t 62 (** A configured path is relative but must be absolute *) 63 64 - (** [pp_validation_error] formats validation errors. *) 65 val pp_validation_error : validation_error Fmt.t 0 66 67 (** {1 Loading and Saving} *) 68 0 0 69 (** [load ~fs ~root_fs path] loads configuration from the specified TOML file. 70 71 - Validates that paths exist and are valid. Supports tilde expansion 72 - for paths (e.g., [~/src/...]). 73 74 @param fs The filesystem path for locating the config file 75 @param root_fs The root filesystem for validating absolute paths in config 76 77 - Returns [Error msg] if the file cannot be read, parsed, or 78 - if validation fails. *) 79 - val load : fs:_ Eio.Path.t -> root_fs:_ Eio.Path.t -> Fpath.t -> (t, string) result 80 0 81 (** [load_xdg ~xdg ()] loads configuration from XDG standard locations. 82 83 - Searches for "config.toml" in the monopam XDG config directory. 84 - Validates that paths exist and are valid. Supports tilde expansion. 85 86 - Returns [Error msg] if no config file is found, parsing fails, or 87 - if validation fails. 88 89 @param xdg The Xdge context for "monopam" application *) 90 - val load_xdg : xdg:Xdge.t -> unit -> (t, string) result 91 92 - (** [save ~fs t path] writes the configuration to the specified path. *) 93 val save : fs:_ Eio.Path.t -> t -> Fpath.t -> (unit, string) result 0 94 95 (** {1 Construction} *) 96 97 - (** [create ~opam_repo ~checkouts ~monorepo ?default_branch ()] creates 98 - a new configuration with the specified paths. 99 - 100 - @param opam_repo Path to the opam overlay repository 101 - @param checkouts Parent directory for individual git checkouts 102 - @param monorepo Path to the monorepo 103 - @param default_branch Default branch to track (default: "main") *) 104 val create : 105 opam_repo:Fpath.t -> 106 checkouts:Fpath.t -> ··· 108 ?default_branch:string -> 109 unit -> 110 t 0 0 111 112 - (** [with_package_override t ~name ~branch] returns a new config with 113 - a branch override for the named package. *) 0 0 0 114 val with_package_override : t -> name:string -> branch:string -> t 0 0 115 116 (** {1 Pretty Printing} *) 117 118 - (** [pp] is a formatter for configuration. *) 119 val pp : t Fmt.t 0

··· 1 (** Configuration management for monopam. 2 3 Configuration is stored in TOML format and loaded from XDG standard 4 + locations or a user-specified path. The config file specifies paths to the 5 + opam overlay, individual checkouts, and the monorepo, along with optional 6 + per-package overrides. *) 7 8 (** {1 Types} *) 9 10 (** Per-package configuration overrides. *) 11 module Package_config : sig 0 12 type t 13 + (** Package-specific settings. *) 14 15 + val branch : t -> string option 16 (** [branch t] returns the branch override for this package, if set. *) 0 17 end 18 19 + type t 20 (** The main configuration. *) 0 21 22 (** {1 Paths Configuration} *) 23 24 (** Path-related accessors. *) 25 module Paths : sig 0 26 val opam_repo : t -> Fpath.t 27 + (** [opam_repo t] returns the path to the opam overlay repository. *) 28 0 0 29 val checkouts : t -> Fpath.t 30 + (** [checkouts t] returns the parent directory where individual package 31 + checkouts are stored. *) 32 33 + val monorepo : t -> Fpath.t 34 (** [monorepo t] returns the path to the monorepo directory. *) 0 35 end 36 37 (** {1 Options} *) 38 39 + val default_branch : t -> string 40 (** [default_branch t] returns the default git branch to track. 41 42 Defaults to "main" if not specified. *) 0 43 0 0 44 val package_config : t -> string -> Package_config.t option 45 + (** [package_config t name] returns package-specific configuration overrides for 46 + the named package, if any exist. *) 47 48 (** {1 Validation} *) 49 50 (** Errors that can occur when validating configuration paths. *) 51 type validation_error = 52 + | Path_not_found of string * Fpath.t (** A configured path does not exist *) 0 53 | Not_a_directory of string * Fpath.t 54 (** A configured path is not a directory *) 55 | Not_an_opam_repo of Fpath.t 56 + (** The opam_repo path is not a valid opam repository (missing packages/ 57 + directory) *) 58 + | Invalid_path of string * string (** A path string could not be parsed *) 0 59 | Relative_path of string * Fpath.t 60 (** A configured path is relative but must be absolute *) 61 0 62 val pp_validation_error : validation_error Fmt.t 63 + (** [pp_validation_error] formats validation errors. *) 64 65 (** {1 Loading and Saving} *) 66 67 + val load : 68 + fs:_ Eio.Path.t -> root_fs:_ Eio.Path.t -> Fpath.t -> (t, string) result 69 (** [load ~fs ~root_fs path] loads configuration from the specified TOML file. 70 71 + Validates that paths exist and are valid. Supports tilde expansion for paths 72 + (e.g., [~/src/...]). 73 74 @param fs The filesystem path for locating the config file 75 @param root_fs The root filesystem for validating absolute paths in config 76 77 + Returns [Error msg] if the file cannot be read, parsed, or if validation 78 + fails. *) 0 79 80 + val load_xdg : xdg:Xdge.t -> unit -> (t, string) result 81 (** [load_xdg ~xdg ()] loads configuration from XDG standard locations. 82 83 + Searches for "config.toml" in the monopam XDG config directory. Validates 84 + that paths exist and are valid. Supports tilde expansion. 85 86 + Returns [Error msg] if no config file is found, parsing fails, or if 87 + validation fails. 88 89 @param xdg The Xdge context for "monopam" application *) 0 90 0 91 val save : fs:_ Eio.Path.t -> t -> Fpath.t -> (unit, string) result 92 + (** [save ~fs t path] writes the configuration to the specified path. *) 93 94 (** {1 Construction} *) 95 0 0 0 0 0 0 0 96 val create : 97 opam_repo:Fpath.t -> 98 checkouts:Fpath.t -> ··· 100 ?default_branch:string -> 101 unit -> 102 t 103 + (** [create ~opam_repo ~checkouts ~monorepo ?default_branch ()] creates a new 104 + configuration with the specified paths. 105 106 + @param opam_repo Path to the opam overlay repository 107 + @param checkouts Parent directory for individual git checkouts 108 + @param monorepo Path to the monorepo 109 + @param default_branch Default branch to track (default: "main") *) 110 + 111 val with_package_override : t -> name:string -> branch:string -> t 112 + (** [with_package_override t ~name ~branch] returns a new config with a branch 113 + override for the named package. *) 114 115 (** {1 Pretty Printing} *) 116 0 117 val pp : t Fmt.t 118 + (** [pp] is a formatter for configuration. *)

+1 -10

lib/dune

··· 1 (library 2 (name monopam) 3 (public_name monopam) 4 - (libraries 5 - eio 6 - tomlt 7 - tomlt.eio 8 - xdge 9 - opam-file-format 10 - fmt 11 - logs 12 - uri 13 - fpath))

··· 1 (library 2 (name monopam) 3 (public_name monopam) 4 + (libraries eio tomlt tomlt.eio xdge opam-file-format fmt logs uri fpath)) 0 0 0 0 0 0 0 0 0

+9 -5

lib/git.ml

··· 52 else Error (Command_failed (String.concat " " ("git" :: args), result)) 53 54 let path_to_eio ~(fs : Eio.Fs.dir_ty Eio.Path.t) path = 55 - let (dir, _) = fs in 56 (dir, Fpath.to_string path) 57 58 let is_repo ~proc ~fs path = ··· 79 let cwd = Eio.Path.(fs / Fpath.to_string parent) in 80 let target_name = Fpath.basename target in 81 let url_str = Uri.to_string url in 82 - run_git_ok ~proc ~cwd 83 - [ "clone"; "--branch"; branch; url_str; target_name ] 84 |> Result.map ignore 85 86 let fetch ~proc ~fs ?(remote = "origin") path = ··· 115 let ahead_behind ~proc ~fs ?(remote = "origin") ?branch path = 116 let cwd = path_to_eio ~fs path in 117 let branch = 118 - match branch with Some b -> b | None -> Option.value ~default:"HEAD" (current_branch ~proc ~fs path) 0 0 119 in 120 let upstream = remote ^ "/" ^ branch in 121 - match run_git_ok ~proc ~cwd [ "rev-list"; "--left-right"; "--count"; branch ^ "..." ^ upstream ] with 0 0 0 122 | Error e -> Error e 123 | Ok output -> ( 124 match String.split_on_char '\t' output with

··· 52 else Error (Command_failed (String.concat " " ("git" :: args), result)) 53 54 let path_to_eio ~(fs : Eio.Fs.dir_ty Eio.Path.t) path = 55 + let dir, _ = fs in 56 (dir, Fpath.to_string path) 57 58 let is_repo ~proc ~fs path = ··· 79 let cwd = Eio.Path.(fs / Fpath.to_string parent) in 80 let target_name = Fpath.basename target in 81 let url_str = Uri.to_string url in 82 + run_git_ok ~proc ~cwd [ "clone"; "--branch"; branch; url_str; target_name ] 0 83 |> Result.map ignore 84 85 let fetch ~proc ~fs ?(remote = "origin") path = ··· 114 let ahead_behind ~proc ~fs ?(remote = "origin") ?branch path = 115 let cwd = path_to_eio ~fs path in 116 let branch = 117 + match branch with 118 + | Some b -> b 119 + | None -> Option.value ~default:"HEAD" (current_branch ~proc ~fs path) 120 in 121 let upstream = remote ^ "/" ^ branch in 122 + match 123 + run_git_ok ~proc ~cwd 124 + [ "rev-list"; "--left-right"; "--count"; branch ^ "..." ^ upstream ] 125 + with 126 | Error e -> Error e 127 | Ok output -> ( 128 match String.split_on_char '\t' output with

+71 -90

lib/git.mli

··· 1 (** Git operations for monopam. 2 3 - This module provides git operations needed for managing individual 4 - checkouts and git subtree operations in the monorepo. All operations 5 - use Eio for process spawning. *) 6 7 (** {1 Types} *) 8 0 9 (** Result of a git command execution. *) 10 - type cmd_result = { 11 - exit_code : int; 12 - stdout : string; 13 - stderr : string; 14 - } 15 16 (** Errors from git operations. *) 17 type error = 18 | Command_failed of string * cmd_result 19 (** Git command failed: (command, result) *) 20 - | Not_a_repo of Fpath.t 21 - (** Path is not a git repository *) 22 - | Dirty_worktree of Fpath.t 23 - (** Repository has uncommitted changes *) 24 - | Remote_not_found of string 25 - (** Named remote does not exist *) 26 - | Branch_not_found of string 27 - (** Named branch does not exist *) 28 | Subtree_prefix_exists of string 29 (** Subtree prefix already exists in repo *) 30 - | Subtree_prefix_missing of string 31 - (** Subtree prefix does not exist *) 32 - | Io_error of string 33 - (** Filesystem or process error *) 34 35 - (** [pp_error] is a formatter for errors. *) 36 val pp_error : error Fmt.t 0 37 38 (** {1 Repository Queries} *) 39 40 - (** [is_repo ~proc ~fs path] returns true if path is a git repository. *) 41 val is_repo : 42 - proc:_ Eio.Process.mgr -> 43 - fs:Eio.Fs.dir_ty Eio.Path.t -> 44 - Fpath.t -> 45 - bool 46 47 - (** [is_dirty ~proc ~fs path] returns true if the repository has 48 - uncommitted changes (staged or unstaged). *) 49 val is_dirty : 50 - proc:_ Eio.Process.mgr -> 51 - fs:Eio.Fs.dir_ty Eio.Path.t -> 52 - Fpath.t -> 53 - bool 54 55 - (** [current_branch ~proc ~fs path] returns the current branch name, 56 - or [None] if in detached HEAD state. *) 57 val current_branch : 58 proc:_ Eio.Process.mgr -> 59 fs:Eio.Fs.dir_ty Eio.Path.t -> 60 Fpath.t -> 61 string option 0 0 62 63 - (** [head_commit ~proc ~fs path] returns the current HEAD commit hash. *) 64 val head_commit : 65 proc:_ Eio.Process.mgr -> 66 fs:Eio.Fs.dir_ty Eio.Path.t -> 67 Fpath.t -> 68 (string, error) result 0 69 70 (** {1 Basic Operations} *) 71 72 - (** [clone ~proc ~fs ~url ~branch target] clones a repository. 73 - 74 - @param proc Eio process manager 75 - @param fs Eio filesystem 76 - @param url Git remote URL 77 - @param branch Branch to checkout 78 - @param target Destination directory *) 79 val clone : 80 proc:_ Eio.Process.mgr -> 81 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 83 branch:string -> 84 Fpath.t -> 85 (unit, error) result 0 86 87 - (** [fetch ~proc ~fs ?remote path] fetches from the remote. 0 0 0 0 88 89 - @param remote Remote name (default: "origin") *) 90 val fetch : 91 proc:_ Eio.Process.mgr -> 92 fs:Eio.Fs.dir_ty Eio.Path.t -> 93 ?remote:string -> 94 Fpath.t -> 95 (unit, error) result 0 96 97 - (** [merge_ff ~proc ~fs ?remote ?branch path] performs a fast-forward only 98 - merge from the remote tracking branch. 99 100 - @param remote Remote name (default: "origin") 101 - @param branch Branch to merge from (default: current branch) *) 102 val merge_ff : 103 proc:_ Eio.Process.mgr -> 104 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 106 ?branch:string -> 107 Fpath.t -> 108 (unit, error) result 109 - 110 - (** [pull ~proc ~fs ?remote ?branch path] pulls from the remote. 111 112 @param remote Remote name (default: "origin") 113 - @param branch Branch to pull (default: current branch) *) 0 114 val pull : 115 proc:_ Eio.Process.mgr -> 116 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 118 ?branch:string -> 119 Fpath.t -> 120 (unit, error) result 0 121 122 - (** [checkout ~proc ~fs ~branch path] checks out the specified branch. *) 0 0 123 val checkout : 124 proc:_ Eio.Process.mgr -> 125 fs:Eio.Fs.dir_ty Eio.Path.t -> 126 branch:string -> 127 Fpath.t -> 128 (unit, error) result 0 129 130 (** {1 Comparison} *) 131 132 - (** Describes how a local branch relates to its upstream. *) 133 type ahead_behind = { 134 ahead : int; (** Commits ahead of upstream *) 135 behind : int; (** Commits behind upstream *) 136 } 137 - 138 - (** [ahead_behind ~proc ~fs ?remote ?branch path] computes how many 139 - commits the local branch is ahead/behind the remote. 140 141 - @param remote Remote name (default: "origin") 142 - @param branch Branch to compare (default: current branch) *) 143 val ahead_behind : 144 proc:_ Eio.Process.mgr -> 145 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 147 ?branch:string -> 148 Fpath.t -> 149 (ahead_behind, error) result 0 0 0 0 0 150 151 (** {1 Subtree Operations} *) 152 153 (** Operations for git subtree management in the monorepo. *) 154 module Subtree : sig 155 - (** [add ~proc ~fs ~repo ~prefix ~url ~branch ()] adds a new subtree 156 - to the repository. 157 - 158 - @param repo Path to the monorepo 159 - @param prefix Subdirectory for the subtree 160 - @param url Git remote URL for the subtree source 161 - @param branch Branch to add *) 162 val add : 163 proc:_ Eio.Process.mgr -> 164 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 168 branch:string -> 169 unit -> 170 (unit, error) result 171 - 172 - (** [pull ~proc ~fs ~repo ~prefix ~url ~branch ()] pulls updates from 173 - the remote into the subtree. 174 175 @param repo Path to the monorepo 176 - @param prefix Subdirectory of the subtree 177 - @param url Git remote URL 178 - @param branch Branch to pull *) 0 179 val pull : 180 proc:_ Eio.Process.mgr -> 181 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 185 branch:string -> 186 unit -> 187 (unit, error) result 188 - 189 - (** [push ~proc ~fs ~repo ~prefix ~url ~branch ()] pushes subtree 190 - changes to the remote. 191 - 192 - This extracts commits that affected the subtree and pushes them 193 - to the specified remote/branch. 194 195 @param repo Path to the monorepo 196 @param prefix Subdirectory of the subtree 197 @param url Git remote URL 198 - @param branch Branch to push to *) 0 199 val push : 200 proc:_ Eio.Process.mgr -> 201 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 205 branch:string -> 206 unit -> 207 (unit, error) result 0 0 208 209 - (** [split ~proc ~fs ~repo ~prefix ()] extracts commits for a subtree 210 - into a standalone branch. 211 212 - Returns the commit hash of the split branch head. *) 0 0 0 0 213 val split : 214 proc:_ Eio.Process.mgr -> 215 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 217 prefix:string -> 218 unit -> 219 (string, error) result 0 0 220 221 - (** [exists ~fs ~repo ~prefix] returns true if the subtree prefix 222 - directory exists in the repository. *) 223 val exists : 224 - fs:Eio.Fs.dir_ty Eio.Path.t -> 225 - repo:Fpath.t -> 226 - prefix:string -> 227 - bool 228 end 229 230 (** {1 Initialization} *) 231 232 - (** [init ~proc ~fs path] initializes a new git repository. *) 233 val init : 234 proc:_ Eio.Process.mgr -> 235 fs:Eio.Fs.dir_ty Eio.Path.t -> 236 Fpath.t -> 237 (unit, error) result 0 238 239 - (** [commit_allow_empty ~proc ~fs ~message path] creates a commit, 240 - even if there are no changes. Useful for initializing a repository. *) 241 val commit_allow_empty : 242 proc:_ Eio.Process.mgr -> 243 fs:Eio.Fs.dir_ty Eio.Path.t -> 244 message:string -> 245 Fpath.t -> 246 (unit, error) result 0 0

··· 1 (** Git operations for monopam. 2 3 + This module provides git operations needed for managing individual checkouts 4 + and git subtree operations in the monorepo. All operations use Eio for 5 + process spawning. *) 6 7 (** {1 Types} *) 8 9 + type cmd_result = { exit_code : int; stdout : string; stderr : string } 10 (** Result of a git command execution. *) 0 0 0 0 0 11 12 (** Errors from git operations. *) 13 type error = 14 | Command_failed of string * cmd_result 15 (** Git command failed: (command, result) *) 16 + | Not_a_repo of Fpath.t (** Path is not a git repository *) 17 + | Dirty_worktree of Fpath.t (** Repository has uncommitted changes *) 18 + | Remote_not_found of string (** Named remote does not exist *) 19 + | Branch_not_found of string (** Named branch does not exist *) 0 0 0 0 20 | Subtree_prefix_exists of string 21 (** Subtree prefix already exists in repo *) 22 + | Subtree_prefix_missing of string (** Subtree prefix does not exist *) 23 + | Io_error of string (** Filesystem or process error *) 0 0 24 0 25 val pp_error : error Fmt.t 26 + (** [pp_error] is a formatter for errors. *) 27 28 (** {1 Repository Queries} *) 29 0 30 val is_repo : 31 + proc:_ Eio.Process.mgr -> fs:Eio.Fs.dir_ty Eio.Path.t -> Fpath.t -> bool 32 + (** [is_repo ~proc ~fs path] returns true if path is a git repository. *) 0 0 33 0 0 34 val is_dirty : 35 + proc:_ Eio.Process.mgr -> fs:Eio.Fs.dir_ty Eio.Path.t -> Fpath.t -> bool 36 + (** [is_dirty ~proc ~fs path] returns true if the repository has uncommitted 37 + changes (staged or unstaged). *) 0 38 0 0 39 val current_branch : 40 proc:_ Eio.Process.mgr -> 41 fs:Eio.Fs.dir_ty Eio.Path.t -> 42 Fpath.t -> 43 string option 44 + (** [current_branch ~proc ~fs path] returns the current branch name, or [None] 45 + if in detached HEAD state. *) 46 0 47 val head_commit : 48 proc:_ Eio.Process.mgr -> 49 fs:Eio.Fs.dir_ty Eio.Path.t -> 50 Fpath.t -> 51 (string, error) result 52 + (** [head_commit ~proc ~fs path] returns the current HEAD commit hash. *) 53 54 (** {1 Basic Operations} *) 55 0 0 0 0 0 0 0 56 val clone : 57 proc:_ Eio.Process.mgr -> 58 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 60 branch:string -> 61 Fpath.t -> 62 (unit, error) result 63 + (** [clone ~proc ~fs ~url ~branch target] clones a repository. 64 65 + @param proc Eio process manager 66 + @param fs Eio filesystem 67 + @param url Git remote URL 68 + @param branch Branch to checkout 69 + @param target Destination directory *) 70 0 71 val fetch : 72 proc:_ Eio.Process.mgr -> 73 fs:Eio.Fs.dir_ty Eio.Path.t -> 74 ?remote:string -> 75 Fpath.t -> 76 (unit, error) result 77 + (** [fetch ~proc ~fs ?remote path] fetches from the remote. 78 79 + @param remote Remote name (default: "origin") *) 0 80 0 0 81 val merge_ff : 82 proc:_ Eio.Process.mgr -> 83 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 85 ?branch:string -> 86 Fpath.t -> 87 (unit, error) result 88 + (** [merge_ff ~proc ~fs ?remote ?branch path] performs a fast-forward only merge 89 + from the remote tracking branch. 90 91 @param remote Remote name (default: "origin") 92 + @param branch Branch to merge from (default: current branch) *) 93 + 94 val pull : 95 proc:_ Eio.Process.mgr -> 96 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 98 ?branch:string -> 99 Fpath.t -> 100 (unit, error) result 101 + (** [pull ~proc ~fs ?remote ?branch path] pulls from the remote. 102 103 + @param remote Remote name (default: "origin") 104 + @param branch Branch to pull (default: current branch) *) 105 + 106 val checkout : 107 proc:_ Eio.Process.mgr -> 108 fs:Eio.Fs.dir_ty Eio.Path.t -> 109 branch:string -> 110 Fpath.t -> 111 (unit, error) result 112 + (** [checkout ~proc ~fs ~branch path] checks out the specified branch. *) 113 114 (** {1 Comparison} *) 115 0 116 type ahead_behind = { 117 ahead : int; (** Commits ahead of upstream *) 118 behind : int; (** Commits behind upstream *) 119 } 120 + (** Describes how a local branch relates to its upstream. *) 0 0 121 0 0 122 val ahead_behind : 123 proc:_ Eio.Process.mgr -> 124 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 126 ?branch:string -> 127 Fpath.t -> 128 (ahead_behind, error) result 129 + (** [ahead_behind ~proc ~fs ?remote ?branch path] computes how many commits the 130 + local branch is ahead/behind the remote. 131 + 132 + @param remote Remote name (default: "origin") 133 + @param branch Branch to compare (default: current branch) *) 134 135 (** {1 Subtree Operations} *) 136 137 (** Operations for git subtree management in the monorepo. *) 138 module Subtree : sig 0 0 0 0 0 0 0 139 val add : 140 proc:_ Eio.Process.mgr -> 141 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 145 branch:string -> 146 unit -> 147 (unit, error) result 148 + (** [add ~proc ~fs ~repo ~prefix ~url ~branch ()] adds a new subtree to the 149 + repository. 0 150 151 @param repo Path to the monorepo 152 + @param prefix Subdirectory for the subtree 153 + @param url Git remote URL for the subtree source 154 + @param branch Branch to add *) 155 + 156 val pull : 157 proc:_ Eio.Process.mgr -> 158 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 162 branch:string -> 163 unit -> 164 (unit, error) result 165 + (** [pull ~proc ~fs ~repo ~prefix ~url ~branch ()] pulls updates from the 166 + remote into the subtree. 0 0 0 0 167 168 @param repo Path to the monorepo 169 @param prefix Subdirectory of the subtree 170 @param url Git remote URL 171 + @param branch Branch to pull *) 172 + 173 val push : 174 proc:_ Eio.Process.mgr -> 175 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 179 branch:string -> 180 unit -> 181 (unit, error) result 182 + (** [push ~proc ~fs ~repo ~prefix ~url ~branch ()] pushes subtree changes to 183 + the remote. 184 185 + This extracts commits that affected the subtree and pushes them to the 186 + specified remote/branch. 187 188 + @param repo Path to the monorepo 189 + @param prefix Subdirectory of the subtree 190 + @param url Git remote URL 191 + @param branch Branch to push to *) 192 + 193 val split : 194 proc:_ Eio.Process.mgr -> 195 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 197 prefix:string -> 198 unit -> 199 (string, error) result 200 + (** [split ~proc ~fs ~repo ~prefix ()] extracts commits for a subtree into a 201 + standalone branch. 202 203 + Returns the commit hash of the split branch head. *) 204 + 205 val exists : 206 + fs:Eio.Fs.dir_ty Eio.Path.t -> repo:Fpath.t -> prefix:string -> bool 207 + (** [exists ~fs ~repo ~prefix] returns true if the subtree prefix directory 208 + exists in the repository. *) 0 209 end 210 211 (** {1 Initialization} *) 212 0 213 val init : 214 proc:_ Eio.Process.mgr -> 215 fs:Eio.Fs.dir_ty Eio.Path.t -> 216 Fpath.t -> 217 (unit, error) result 218 + (** [init ~proc ~fs path] initializes a new git repository. *) 219 0 0 220 val commit_allow_empty : 221 proc:_ Eio.Process.mgr -> 222 fs:Eio.Fs.dir_ty Eio.Path.t -> 223 message:string -> 224 Fpath.t -> 225 (unit, error) result 226 + (** [commit_allow_empty ~proc ~fs ~message path] creates a commit, even if there 227 + are no changes. Useful for initializing a repository. *)

+297 -228

lib/monopam.ml

··· 5 module Status = Status 6 7 let src = Logs.Src.create "monopam" ~doc:"Monopam operations" 0 8 module Log = (val Logs.src_log src : Logs.LOG) 9 10 type error = ··· 25 | Package_not_found name -> Fmt.pf ppf "Package not found: %s" name 26 27 let fs_typed (fs : _ Eio.Path.t) : Eio.Fs.dir_ty Eio.Path.t = 28 - let (dir, _) = fs in 29 (dir, "") 30 31 let discover_packages ~fs ~config () = 32 let repo_path = Config.Paths.opam_repo config in 33 Log.debug (fun m -> m "Scanning opam repo at %a" Fpath.pp repo_path); 34 - match Opam_repo.scan ~fs repo_path with 35 - | Ok pkgs -> 0 36 Log.info (fun m -> m "Found %d packages in opam repo" (List.length pkgs)); 37 - Ok pkgs 38 - | Error e -> Error (Repo_error e) 39 40 let find_package ~fs ~config name = 41 - match discover_packages ~fs ~config () with 42 - | Error e -> Error e 43 - | Ok pkgs -> ( 44 - match List.find_opt (fun p -> Package.name p = name) pkgs with 45 - | Some p -> Ok p 46 - | None -> Error (Package_not_found name)) 47 48 let rec mkdirs path = 49 match Eio.Path.kind ~follow:true path with ··· 55 (* Parent might not exist, try to create it first *) 56 let parent = Eio.Path.split path in 57 (match parent with 58 - | Some (parent_path, _) -> mkdirs parent_path 59 - | None -> ()); 60 Log.debug (fun m -> m "Creating directory %a" Eio.Path.pp path); 61 Eio.Path.mkdir ~perm:0o755 path 62 63 let ensure_checkouts_dir ~fs ~config = 64 let checkouts = Config.Paths.checkouts config in 65 let checkouts_eio = Eio.Path.(fs / Fpath.to_string checkouts) in 66 - Log.debug (fun m -> m "Ensuring checkouts directory exists: %a" Fpath.pp checkouts); 0 67 mkdirs checkouts_eio 68 69 let status ~proc ~fs ~config () = 70 let fs = fs_typed fs in 71 - (* Ensure checkouts directory exists before computing status *) 72 ensure_checkouts_dir ~fs ~config; 73 - match discover_packages ~fs:(fs :> _ Eio.Path.t) ~config () with 74 - | Error e -> Error e 75 - | Ok pkgs -> Ok (Status.compute_all ~proc ~fs ~config pkgs) 76 77 let get_branch ~config pkg = 0 78 match Package.branch pkg with 79 | Some b -> b 80 - | None -> ( 81 - match Config.package_config config (Package.name pkg) with 82 - | Some pc -> Option.value ~default:(Config.default_branch config) (Config.Package_config.branch pc) 83 - | None -> Config.default_branch config) 0 84 85 let ensure_checkout ~proc ~fs ~config pkg = 86 let checkouts_root = Config.Paths.checkouts config in ··· 88 let checkout_eio = Eio.Path.(fs / Fpath.to_string checkout_dir) in 89 let branch = get_branch ~config pkg in 90 let do_clone () = 91 - Log.info (fun m -> m "Cloning %s from %a (branch: %s)" 92 - (Package.repo_name pkg) Uri.pp (Package.dev_repo pkg) branch); 0 93 Git.clone ~proc ~fs ~url:(Package.dev_repo pkg) ~branch checkout_dir 94 in 95 let is_directory = ··· 112 (* Group packages by their repository *) 113 let group_by_repo pkgs = 114 let tbl = Hashtbl.create 16 in 115 - List.iter (fun pkg -> 116 - let repo = Package.repo_name pkg in 117 - let existing = try Hashtbl.find tbl repo with Not_found -> [] in 118 - Hashtbl.replace tbl repo (pkg :: existing) 119 - ) pkgs; 0 120 (* Sort repos alphabetically and packages within each repo *) 121 - Hashtbl.fold (fun repo pkgs acc -> (repo, List.sort Package.compare pkgs) :: acc) tbl [] 0 0 122 |> List.sort (fun (a, _) (b, _) -> String.compare a b) 123 124 (* Generate README.md content from discovered packages *) ··· 126 let grouped = group_by_repo pkgs in 127 let buf = Buffer.create 4096 in 128 Buffer.add_string buf "# Monorepo Package Index\n\n"; 129 - Buffer.add_string buf "This monorepo contains the following packages, synchronized from their upstream repositories.\n\n"; 0 0 130 Buffer.add_string buf "| Repository | Package | Version | Upstream |\n"; 131 Buffer.add_string buf "|------------|---------|---------|----------|\n"; 132 - List.iter (fun (repo, pkgs) -> 133 - List.iteri (fun i pkg -> 134 - let repo_cell = if i = 0 then Printf.sprintf "**%s**" repo else "" in 135 - let dev_repo = Uri.to_string (Package.dev_repo pkg) in 136 - (* Clean up git+ prefix for display *) 137 - let display_url = 138 - if String.length dev_repo > 4 && String.sub dev_repo 0 4 = "git+" then 139 - String.sub dev_repo 4 (String.length dev_repo - 4) 140 - else dev_repo 141 - in 142 - Buffer.add_string buf (Printf.sprintf "| %s | %s | %s | %s |\n" 143 - repo_cell (Package.name pkg) (Package.version pkg) display_url) 144 - ) pkgs 145 - ) grouped; 0 0 0 146 Buffer.add_string buf "\n---\n\n"; 147 - Buffer.add_string buf (Printf.sprintf "_Generated by monopam. %d packages from %d repositories._\n" 148 - (List.length pkgs) (List.length grouped)); 0 0 149 Buffer.contents buf 150 151 - let claude_md_content = {|# Monorepo Development Guide 0 152 153 This is a monorepo managed by `monopam`. Each subdirectory is a git subtree 154 from a separate upstream repository. ··· 215 Log.info (fun m -> m "Initializing monorepo at %a" Fpath.pp monorepo); 216 match Git.init ~proc ~fs monorepo with 217 | Error e -> Error (Git_error e) 218 - | Ok () -> 219 (* Create dune-project file so the monorepo builds *) 220 let dune_project = Eio.Path.(monorepo_eio / "dune-project") in 221 Log.debug (fun m -> m "Creating dune-project file"); 222 - Eio.Path.save ~create:(`Or_truncate 0o644) dune_project "(lang dune 3.20)\n"; 0 223 (* Create CLAUDE.md for agent instructions *) 224 let claude_md = Eio.Path.(monorepo_eio / "CLAUDE.md") in 225 Log.debug (fun m -> m "Creating CLAUDE.md"); ··· 231 (* Stage the files *) 232 Log.debug (fun m -> m "Staging initial files"); 233 Eio.Switch.run (fun sw -> 234 - let child = Eio.Process.spawn proc ~sw ~cwd:monorepo_eio 235 - [ "git"; "add"; "dune-project"; "CLAUDE.md"; ".gitignore" ] in 236 - ignore (Eio.Process.await child)); 0 0 237 (* Commit *) 238 Log.debug (fun m -> m "Creating initial commit in monorepo"); 239 - match Git.commit_allow_empty ~proc ~fs ~message:"Initial commit with dune-project, CLAUDE.md, and .gitignore" monorepo with 0 0 0 0 0 240 | Ok () -> Ok () 241 - | Error e -> Error (Git_error e) 242 in 243 - let ensure_claude_md () = 244 - let claude_md = Eio.Path.(monorepo_eio / "CLAUDE.md") in 245 let exists = 246 - match Eio.Path.kind ~follow:true claude_md with 247 | `Regular_file -> true 248 - | _ -> false 249 - | exception Eio.Io _ -> false 250 in 251 if not exists then begin 252 - Log.info (fun m -> m "Adding CLAUDE.md to monorepo"); 253 - Eio.Path.save ~create:(`Or_truncate 0o644) claude_md claude_md_content; 254 Eio.Switch.run (fun sw -> 255 - let child = Eio.Process.spawn proc ~sw ~cwd:monorepo_eio 256 - [ "git"; "add"; "CLAUDE.md" ] in 257 - ignore (Eio.Process.await child)); 258 - Eio.Switch.run (fun sw -> 259 - let child = Eio.Process.spawn proc ~sw ~cwd:monorepo_eio 260 - [ "git"; "commit"; "-m"; "Add CLAUDE.md" ] in 261 - ignore (Eio.Process.await child)) 262 - end 263 - in 264 - let ensure_gitignore () = 265 - let gitignore = Eio.Path.(monorepo_eio / ".gitignore") in 266 - let exists = 267 - match Eio.Path.kind ~follow:true gitignore with 268 - | `Regular_file -> true 269 - | _ -> false 270 - | exception Eio.Io _ -> false 271 - in 272 - if not exists then begin 273 - Log.info (fun m -> m "Adding .gitignore to monorepo"); 274 - Eio.Path.save ~create:(`Or_truncate 0o644) gitignore gitignore_content; 275 - Eio.Switch.run (fun sw -> 276 - let child = Eio.Process.spawn proc ~sw ~cwd:monorepo_eio 277 - [ "git"; "add"; ".gitignore" ] in 278 - ignore (Eio.Process.await child)); 279 Eio.Switch.run (fun sw -> 280 - let child = Eio.Process.spawn proc ~sw ~cwd:monorepo_eio 281 - [ "git"; "commit"; "-m"; "Add .gitignore" ] in 282 - ignore (Eio.Process.await child)) 0 0 283 end 284 in 285 let is_directory = ··· 289 | exception Eio.Io _ -> false 290 in 291 if is_directory && Git.is_repo ~proc ~fs monorepo then begin 292 - Log.debug (fun m -> m "Monorepo already initialized at %a" Fpath.pp monorepo); 293 - ensure_claude_md (); 294 - ensure_gitignore (); 0 295 Ok () 296 - end else begin 0 297 if not is_directory then begin 298 Log.debug (fun m -> m "Creating monorepo directory %a" Fpath.pp monorepo); 299 mkdirs monorepo_eio ··· 318 Eio.Path.save ~create:(`Or_truncate 0o644) readme_path content; 319 (* Stage and commit the README *) 320 Eio.Switch.run (fun sw -> 321 - let child = Eio.Process.spawn proc ~sw ~cwd:monorepo_eio 322 - [ "git"; "add"; "README.md" ] in 323 - ignore (Eio.Process.await child)); 0 0 324 Eio.Switch.run (fun sw -> 325 - let child = Eio.Process.spawn proc ~sw ~cwd:monorepo_eio 326 - [ "git"; "commit"; "-m"; "Update README.md package index" ] in 327 - ignore (Eio.Process.await child)); 0 0 328 Log.app (fun m -> m "Updated README.md with %d packages" (List.length pkgs)) 329 end 330 ··· 344 (* Deduplicate packages by dev-repo, keeping first occurrence of each repo *) 345 let unique_repos pkgs = 346 let seen = Hashtbl.create 16 in 347 - List.filter (fun pkg -> 348 - let url = normalize_url_for_comparison (Package.dev_repo pkg) in 349 - Log.debug (fun m -> m "Checking repo URL: %s (from %s)" url (Package.name pkg)); 350 - if Hashtbl.mem seen url then begin 351 - Log.debug (fun m -> m " -> Already seen, skipping"); 352 - false 353 - end else begin 354 - Hashtbl.add seen url (); 355 - Log.debug (fun m -> m " -> New repo, keeping"); 356 - true 357 - end) pkgs 0 0 0 0 358 359 (* Result of pulling a single repo *) 360 type pull_result = { 361 repo_name : string; 362 - cloned : bool; (* true if newly cloned, false if fetched *) 363 commits_pulled : int; (* number of commits pulled, 0 if none or cloned *) 364 subtree_added : bool; (* true if subtree was newly added *) 365 } ··· 375 match Git.Subtree.pull ~proc ~fs ~repo:monorepo ~prefix ~url ~branch () with 376 | Ok () -> Ok false (* not newly added *) 377 | Error e -> Error (Git_error e) 378 - end else begin 0 379 Log.info (fun m -> m "Adding subtree %s" prefix); 380 match Git.Subtree.add ~proc ~fs ~repo:monorepo ~prefix ~url ~branch () with 381 | Ok () -> Ok true (* newly added *) ··· 414 in 415 match result with 416 | Ok () -> () 417 - | Error e -> Log.warn (fun m -> m "Failed to update opam repo: %a" Git.pp_error e) 0 418 end; 419 (* Ensure directories exist before computing status *) 420 ensure_checkouts_dir ~fs:fs_t ~config; 421 match ensure_monorepo_initialized ~proc ~fs:fs_t ~config with 422 | Error e -> Error e 423 - | Ok () -> 424 - match discover_packages ~fs:(fs_t :> _ Eio.Path.t) ~config () with 425 - | Error e -> Error e 426 - | Ok all_pkgs -> 427 - let pkgs = 428 - match package with 429 - | None -> all_pkgs 430 - | Some name -> List.filter (fun p -> Package.name p = name) all_pkgs 431 - in 432 - if pkgs = [] && package <> None then 433 - Error (Package_not_found (Option.get package)) 434 - else begin 435 - Log.info (fun m -> m "Checking status of %d packages" (List.length pkgs)); 436 - let statuses = Status.compute_all ~proc ~fs:fs_t ~config pkgs in 437 - let dirty = 438 - List.filter Status.has_local_changes statuses 439 - |> List.map (fun s -> s.Status.package) 440 - in 441 - if dirty <> [] then Error (Dirty_state dirty) 442 - else begin 443 - (* First, clone/fetch unique repositories *) 444 - let repos = unique_repos pkgs in 445 - Log.info (fun m -> m "Cloning/fetching %d unique repositories" (List.length repos)); 446 - let clone_repos () = 447 - let total = List.length repos in 448 - let rec loop i acc = function 449 - | [] -> Ok (List.rev acc) 450 - | pkg :: rest -> 451 - let repo_name = Package.repo_name pkg in 452 - Log.info (fun m -> m "[%d/%d] Fetching repo %s" i total repo_name); 453 - let existed = checkout_exists ~proc ~fs:fs_t ~config pkg in 454 - let behind_before = 455 - if existed then get_behind ~proc ~fs:fs_t ~config pkg else 0 456 - in 457 - match ensure_checkout ~proc ~fs:fs_t ~config pkg with 458 - | Error e -> Error (Git_error e) 459 - | Ok () -> 460 - let result = { 461 - repo_name; 462 - cloned = not existed; 463 - commits_pulled = behind_before; 464 - subtree_added = false; (* will be updated later *) 465 - } in 466 - loop (i + 1) (result :: acc) rest 467 in 468 - loop 1 [] repos 469 - in 470 - match clone_repos () with 471 - | Error e -> Error e 472 - | Ok checkout_results -> 473 - (* Then, add/pull subtrees for unique repos only *) 474 - Log.info (fun m -> m "Processing %d unique subtrees" (List.length repos)); 475 - let total = List.length repos in 476 - let rec loop i results_acc repos_left checkout_results_left = 477 - match repos_left, checkout_results_left with 478 - | [], [] -> Ok (List.rev results_acc) 479 - | pkg :: rest_repos, cr :: rest_cr -> 480 - Log.info (fun m -> m "[%d/%d] Subtree %s" i total (Package.subtree_prefix pkg)); 481 - (match pull_subtree ~proc ~fs ~config pkg with 482 - | Ok subtree_added -> 483 - let result = { cr with subtree_added } in 484 - loop (i + 1) (result :: results_acc) rest_repos rest_cr 485 - | Error e -> Error e) 486 - | _ -> Ok (List.rev results_acc) (* mismatched lengths, shouldn't happen *) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 487 in 488 - match loop 1 [] repos checkout_results with 489 | Error e -> Error e 490 - | Ok results -> 491 - (* Print summary *) 492 - let cloned = List.filter (fun r -> r.cloned) results in 493 - let updated = List.filter (fun r -> not r.cloned && r.commits_pulled > 0) results in 494 - let added = List.filter (fun r -> r.subtree_added) results in 495 - if cloned <> [] then begin 496 - Log.app (fun m -> m "Cloned %d new repositories:" (List.length cloned)); 497 - List.iter (fun r -> Log.app (fun m -> m " + %s" r.repo_name)) cloned 498 - end; 499 - if updated <> [] then begin 500 - Log.app (fun m -> m "Updated %d repositories:" (List.length updated)); 501 - List.iter (fun r -> 502 - Log.app (fun m -> m " ~ %s (%d new commits)" r.repo_name r.commits_pulled) 503 - ) updated 504 - end; 505 - if added <> [] then begin 506 - Log.app (fun m -> m "Added %d new subtrees:" (List.length added)); 507 - List.iter (fun r -> Log.app (fun m -> m " + %s" r.repo_name)) added 508 - end; 509 - let unchanged = List.length results - List.length cloned - List.length updated in 510 - if cloned = [] && updated = [] && added = [] then 511 - Log.app (fun m -> m "All %d repositories up to date." (List.length results)) 512 - else if unchanged > 0 then 513 - Log.app (fun m -> m "%d repositories unchanged." unchanged); 514 - (* Update README.md with package summary *) 515 - write_readme ~proc ~fs:fs_t ~config all_pkgs; 516 - Ok () 517 - end 518 - end 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 519 520 let run_git_in ~proc ~cwd args = 521 Eio.Switch.run @@ fun sw -> ··· 530 match Eio.Process.await child with 531 | `Exited 0 -> Ok (Buffer.contents buf_stdout |> String.trim) 532 | _ -> 533 - let result = Git.{ 534 - exit_code = 1; 535 - stdout = Buffer.contents buf_stdout; 536 - stderr = Buffer.contents buf_stderr; 537 - } in 0 0 0 538 Error (Git.Command_failed (String.concat " " ("git" :: args), result)) 539 540 let push_one ~proc ~fs ~config pkg = 541 - let ( let* ) r f = Result.bind (Result.map_error (fun e -> Git_error e) r) f in 0 0 542 let fs = fs_typed fs in 543 let monorepo = Config.Paths.monorepo config in 544 let prefix = Package.subtree_prefix pkg in ··· 549 if not (Git.Subtree.exists ~fs ~repo:monorepo ~prefix) then begin 550 Log.debug (fun m -> m "Subtree %s not in monorepo, skipping" prefix); 551 Ok () 552 - end else begin 0 553 let checkout_eio = Eio.Path.(fs / Fpath.to_string checkout_dir) in 554 match Eio.Path.kind ~follow:true checkout_eio with 555 | exception Eio.Io _ -> 556 - Log.debug (fun m -> m "Checkout %a does not exist, skipping" Fpath.pp checkout_dir); 0 557 Ok () 558 | `Directory when Git.is_repo ~proc ~fs checkout_dir -> 559 let monorepo_eio = Eio.Path.(fs / Fpath.to_string monorepo) in 560 let checkout_path = Fpath.to_string checkout_dir in 561 (* Push subtree to a sync branch (avoids "branch is checked out" error) *) 562 Log.info (fun m -> m "Pushing subtree %s to checkout" prefix); 563 - let* _ = run_git_in ~proc ~cwd:monorepo_eio 564 - [ "subtree"; "push"; "--prefix"; prefix; checkout_path; sync_branch ] in 0 0 0 0 565 (* Merge sync branch into the target branch in checkout *) 566 Log.debug (fun m -> m "Merging %s into %s" sync_branch branch); 567 - let* _ = run_git_in ~proc ~cwd:checkout_eio [ "merge"; "--ff-only"; sync_branch ] in 0 0 0 568 (* Delete the sync branch *) 569 Log.debug (fun m -> m "Cleaning up %s branch" sync_branch); 570 - ignore (run_git_in ~proc ~cwd:checkout_eio [ "branch"; "-d"; sync_branch ]); 0 571 Ok () 572 | _ -> 573 - Log.debug (fun m -> m "Checkout %a is not a git repo, skipping" Fpath.pp checkout_dir); 0 574 Ok () 575 end 576 ··· 589 if pkgs = [] && package <> None then 590 Error (Package_not_found (Option.get package)) 591 else begin 592 - Log.info (fun m -> m "Checking status of %d packages" (List.length pkgs)); 0 593 let statuses = Status.compute_all ~proc ~fs:fs_t ~config pkgs in 594 let dirty = 595 List.filter Status.has_local_changes statuses ··· 602 let total = List.length repos in 603 let rec loop i = function 604 | [] -> Ok () 605 - | pkg :: rest -> 606 - Log.info (fun m -> m "[%d/%d] Processing %s" i total (Package.subtree_prefix pkg)); 0 0 607 match push_one ~proc ~fs ~config pkg with 608 | Ok () -> loop (i + 1) rest 609 - | Error e -> Error e 610 in 611 loop 1 repos 612 end ··· 617 ensure_checkouts_dir ~fs:fs_t ~config; 618 match ensure_monorepo_initialized ~proc ~fs:fs_t ~config with 619 | Error e -> Error e 620 - | Ok () -> 621 match find_package ~fs:(fs_t :> _ Eio.Path.t) ~config package with 622 | Error e -> Error e 623 - | Ok pkg -> 624 Log.info (fun m -> m "Adding package %s" (Package.name pkg)); 625 match ensure_checkout ~proc ~fs:fs_t ~config pkg with 626 | Error e -> Error (Git_error e) 627 | Ok () -> 628 - pull_subtree ~proc ~fs ~config pkg 629 - |> Result.map (fun _ -> ()) 630 631 let remove ~proc:_ ~fs ~config ~package () = 632 let fs = fs_typed fs in ··· 638 try 639 Eio.Path.rmtree subtree_path; 640 Ok () 641 - with Eio.Io _ as e -> Error (Git_error (Git.Io_error (Printexc.to_string e))) 0

··· 5 module Status = Status 6 7 let src = Logs.Src.create "monopam" ~doc:"Monopam operations" 8 + 9 module Log = (val Logs.src_log src : Logs.LOG) 10 11 type error = ··· 26 | Package_not_found name -> Fmt.pf ppf "Package not found: %s" name 27 28 let fs_typed (fs : _ Eio.Path.t) : Eio.Fs.dir_ty Eio.Path.t = 29 + let dir, _ = fs in 30 (dir, "") 31 32 let discover_packages ~fs ~config () = 33 let repo_path = Config.Paths.opam_repo config in 34 Log.debug (fun m -> m "Scanning opam repo at %a" Fpath.pp repo_path); 35 + Opam_repo.scan ~fs repo_path 36 + |> Result.map_error (fun e -> Repo_error e) 37 + |> Result.map (fun pkgs -> 38 Log.info (fun m -> m "Found %d packages in opam repo" (List.length pkgs)); 39 + pkgs) 0 40 41 let find_package ~fs ~config name = 42 + Result.bind (discover_packages ~fs ~config ()) (fun pkgs -> 43 + List.find_opt (fun p -> Package.name p = name) pkgs 44 + |> Option.to_result ~none:(Package_not_found name)) 0 0 0 45 46 let rec mkdirs path = 47 match Eio.Path.kind ~follow:true path with ··· 53 (* Parent might not exist, try to create it first *) 54 let parent = Eio.Path.split path in 55 (match parent with 56 + | Some (parent_path, _) -> mkdirs parent_path 57 + | None -> ()); 58 Log.debug (fun m -> m "Creating directory %a" Eio.Path.pp path); 59 Eio.Path.mkdir ~perm:0o755 path 60 61 let ensure_checkouts_dir ~fs ~config = 62 let checkouts = Config.Paths.checkouts config in 63 let checkouts_eio = Eio.Path.(fs / Fpath.to_string checkouts) in 64 + Log.debug (fun m -> 65 + m "Ensuring checkouts directory exists: %a" Fpath.pp checkouts); 66 mkdirs checkouts_eio 67 68 let status ~proc ~fs ~config () = 69 let fs = fs_typed fs in 0 70 ensure_checkouts_dir ~fs ~config; 71 + discover_packages ~fs:(fs :> _ Eio.Path.t) ~config () 72 + |> Result.map (Status.compute_all ~proc ~fs ~config) 0 73 74 let get_branch ~config pkg = 75 + let default = Config.default_branch config in 76 match Package.branch pkg with 77 | Some b -> b 78 + | None -> 79 + Option.bind 80 + (Config.package_config config (Package.name pkg)) 81 + Config.Package_config.branch 82 + |> Option.value ~default 83 84 let ensure_checkout ~proc ~fs ~config pkg = 85 let checkouts_root = Config.Paths.checkouts config in ··· 87 let checkout_eio = Eio.Path.(fs / Fpath.to_string checkout_dir) in 88 let branch = get_branch ~config pkg in 89 let do_clone () = 90 + Log.info (fun m -> 91 + m "Cloning %s from %a (branch: %s)" (Package.repo_name pkg) Uri.pp 92 + (Package.dev_repo pkg) branch); 93 Git.clone ~proc ~fs ~url:(Package.dev_repo pkg) ~branch checkout_dir 94 in 95 let is_directory = ··· 112 (* Group packages by their repository *) 113 let group_by_repo pkgs = 114 let tbl = Hashtbl.create 16 in 115 + List.iter 116 + (fun pkg -> 117 + let repo = Package.repo_name pkg in 118 + let existing = try Hashtbl.find tbl repo with Not_found -> [] in 119 + Hashtbl.replace tbl repo (pkg :: existing)) 120 + pkgs; 121 (* Sort repos alphabetically and packages within each repo *) 122 + Hashtbl.fold 123 + (fun repo pkgs acc -> (repo, List.sort Package.compare pkgs) :: acc) 124 + tbl [] 125 |> List.sort (fun (a, _) (b, _) -> String.compare a b) 126 127 (* Generate README.md content from discovered packages *) ··· 129 let grouped = group_by_repo pkgs in 130 let buf = Buffer.create 4096 in 131 Buffer.add_string buf "# Monorepo Package Index\n\n"; 132 + Buffer.add_string buf 133 + "This monorepo contains the following packages, synchronized from their \ 134 + upstream repositories.\n\n"; 135 Buffer.add_string buf "| Repository | Package | Version | Upstream |\n"; 136 Buffer.add_string buf "|------------|---------|---------|----------|\n"; 137 + List.iter 138 + (fun (repo, pkgs) -> 139 + List.iteri 140 + (fun i pkg -> 141 + let repo_cell = if i = 0 then Printf.sprintf "**%s**" repo else "" in 142 + let dev_repo = Uri.to_string (Package.dev_repo pkg) in 143 + (* Clean up git+ prefix for display *) 144 + let display_url = 145 + if String.starts_with ~prefix:"git+" dev_repo then 146 + String.sub dev_repo 4 (String.length dev_repo - 4) 147 + else dev_repo 148 + in 149 + Buffer.add_string buf 150 + (Printf.sprintf "| %s | %s | %s | %s |\n" repo_cell 151 + (Package.name pkg) (Package.version pkg) display_url)) 152 + pkgs) 153 + grouped; 154 Buffer.add_string buf "\n---\n\n"; 155 + Buffer.add_string buf 156 + (Printf.sprintf 157 + "_Generated by monopam. %d packages from %d repositories._\n" 158 + (List.length pkgs) (List.length grouped)); 159 Buffer.contents buf 160 161 + let claude_md_content = 162 + {|# Monorepo Development Guide 163 164 This is a monorepo managed by `monopam`. Each subdirectory is a git subtree 165 from a separate upstream repository. ··· 226 Log.info (fun m -> m "Initializing monorepo at %a" Fpath.pp monorepo); 227 match Git.init ~proc ~fs monorepo with 228 | Error e -> Error (Git_error e) 229 + | Ok () -> ( 230 (* Create dune-project file so the monorepo builds *) 231 let dune_project = Eio.Path.(monorepo_eio / "dune-project") in 232 Log.debug (fun m -> m "Creating dune-project file"); 233 + Eio.Path.save ~create:(`Or_truncate 0o644) dune_project 234 + "(lang dune 3.20)\n"; 235 (* Create CLAUDE.md for agent instructions *) 236 let claude_md = Eio.Path.(monorepo_eio / "CLAUDE.md") in 237 Log.debug (fun m -> m "Creating CLAUDE.md"); ··· 243 (* Stage the files *) 244 Log.debug (fun m -> m "Staging initial files"); 245 Eio.Switch.run (fun sw -> 246 + let child = 247 + Eio.Process.spawn proc ~sw ~cwd:monorepo_eio 248 + [ "git"; "add"; "dune-project"; "CLAUDE.md"; ".gitignore" ] 249 + in 250 + ignore (Eio.Process.await child)); 251 (* Commit *) 252 Log.debug (fun m -> m "Creating initial commit in monorepo"); 253 + match 254 + Git.commit_allow_empty ~proc ~fs 255 + ~message: 256 + "Initial commit with dune-project, CLAUDE.md, and .gitignore" 257 + monorepo 258 + with 259 | Ok () -> Ok () 260 + | Error e -> Error (Git_error e)) 261 in 262 + let ensure_file ~filename ~content = 263 + let file_path = Eio.Path.(monorepo_eio / filename) in 264 let exists = 265 + match Eio.Path.kind ~follow:true file_path with 266 | `Regular_file -> true 267 + | _ | (exception Eio.Io _) -> false 0 268 in 269 if not exists then begin 270 + Log.info (fun m -> m "Adding %s to monorepo" filename); 271 + Eio.Path.save ~create:(`Or_truncate 0o644) file_path content; 272 Eio.Switch.run (fun sw -> 273 + let child = 274 + Eio.Process.spawn proc ~sw ~cwd:monorepo_eio 275 + [ "git"; "add"; filename ] 276 + in 277 + ignore (Eio.Process.await child)); 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 278 Eio.Switch.run (fun sw -> 279 + let child = 280 + Eio.Process.spawn proc ~sw ~cwd:monorepo_eio 281 + [ "git"; "commit"; "-m"; "Add " ^ filename ] 282 + in 283 + ignore (Eio.Process.await child)) 284 end 285 in 286 let is_directory = ··· 290 | exception Eio.Io _ -> false 291 in 292 if is_directory && Git.is_repo ~proc ~fs monorepo then begin 293 + Log.debug (fun m -> 294 + m "Monorepo already initialized at %a" Fpath.pp monorepo); 295 + ensure_file ~filename:"CLAUDE.md" ~content:claude_md_content; 296 + ensure_file ~filename:".gitignore" ~content:gitignore_content; 297 Ok () 298 + end 299 + else begin 300 if not is_directory then begin 301 Log.debug (fun m -> m "Creating monorepo directory %a" Fpath.pp monorepo); 302 mkdirs monorepo_eio ··· 321 Eio.Path.save ~create:(`Or_truncate 0o644) readme_path content; 322 (* Stage and commit the README *) 323 Eio.Switch.run (fun sw -> 324 + let child = 325 + Eio.Process.spawn proc ~sw ~cwd:monorepo_eio 326 + [ "git"; "add"; "README.md" ] 327 + in 328 + ignore (Eio.Process.await child)); 329 Eio.Switch.run (fun sw -> 330 + let child = 331 + Eio.Process.spawn proc ~sw ~cwd:monorepo_eio 332 + [ "git"; "commit"; "-m"; "Update README.md package index" ] 333 + in 334 + ignore (Eio.Process.await child)); 335 Log.app (fun m -> m "Updated README.md with %d packages" (List.length pkgs)) 336 end 337 ··· 351 (* Deduplicate packages by dev-repo, keeping first occurrence of each repo *) 352 let unique_repos pkgs = 353 let seen = Hashtbl.create 16 in 354 + List.filter 355 + (fun pkg -> 356 + let url = normalize_url_for_comparison (Package.dev_repo pkg) in 357 + Log.debug (fun m -> 358 + m "Checking repo URL: %s (from %s)" url (Package.name pkg)); 359 + if Hashtbl.mem seen url then begin 360 + Log.debug (fun m -> m " -> Already seen, skipping"); 361 + false 362 + end 363 + else begin 364 + Hashtbl.add seen url (); 365 + Log.debug (fun m -> m " -> New repo, keeping"); 366 + true 367 + end) 368 + pkgs 369 370 (* Result of pulling a single repo *) 371 type pull_result = { 372 repo_name : string; 373 + cloned : bool; (* true if newly cloned, false if fetched *) 374 commits_pulled : int; (* number of commits pulled, 0 if none or cloned *) 375 subtree_added : bool; (* true if subtree was newly added *) 376 } ··· 386 match Git.Subtree.pull ~proc ~fs ~repo:monorepo ~prefix ~url ~branch () with 387 | Ok () -> Ok false (* not newly added *) 388 | Error e -> Error (Git_error e) 389 + end 390 + else begin 391 Log.info (fun m -> m "Adding subtree %s" prefix); 392 match Git.Subtree.add ~proc ~fs ~repo:monorepo ~prefix ~url ~branch () with 393 | Ok () -> Ok true (* newly added *) ··· 426 in 427 match result with 428 | Ok () -> () 429 + | Error e -> 430 + Log.warn (fun m -> m "Failed to update opam repo: %a" Git.pp_error e) 431 end; 432 (* Ensure directories exist before computing status *) 433 ensure_checkouts_dir ~fs:fs_t ~config; 434 match ensure_monorepo_initialized ~proc ~fs:fs_t ~config with 435 | Error e -> Error e 436 + | Ok () -> ( 437 + match discover_packages ~fs:(fs_t :> _ Eio.Path.t) ~config () with 438 + | Error e -> Error e 439 + | Ok all_pkgs -> 440 + let pkgs = 441 + match package with 442 + | None -> all_pkgs 443 + | Some name -> List.filter (fun p -> Package.name p = name) all_pkgs 444 + in 445 + if pkgs = [] && package <> None then 446 + Error (Package_not_found (Option.get package)) 447 + else begin 448 + Log.info (fun m -> 449 + m "Checking status of %d packages" (List.length pkgs)); 450 + let statuses = Status.compute_all ~proc ~fs:fs_t ~config pkgs in 451 + let dirty = 452 + List.filter Status.has_local_changes statuses 453 + |> List.map (fun s -> s.Status.package) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 454 in 455 + if dirty <> [] then Error (Dirty_state dirty) 456 + else begin 457 + (* First, clone/fetch unique repositories *) 458 + let repos = unique_repos pkgs in 459 + Log.info (fun m -> 460 + m "Cloning/fetching %d unique repositories" 461 + (List.length repos)); 462 + let clone_repos () = 463 + let total = List.length repos in 464 + let rec loop i acc = function 465 + | [] -> Ok (List.rev acc) 466 + | pkg :: rest -> ( 467 + let repo_name = Package.repo_name pkg in 468 + Log.info (fun m -> 469 + m "[%d/%d] Fetching repo %s" i total repo_name); 470 + let existed = 471 + checkout_exists ~proc ~fs:fs_t ~config pkg 472 + in 473 + let behind_before = 474 + if existed then get_behind ~proc ~fs:fs_t ~config pkg 475 + else 0 476 + in 477 + match ensure_checkout ~proc ~fs:fs_t ~config pkg with 478 + | Error e -> Error (Git_error e) 479 + | Ok () -> 480 + let result = 481 + { 482 + repo_name; 483 + cloned = not existed; 484 + commits_pulled = behind_before; 485 + subtree_added = false; 486 + (* will be updated later *) 487 + } 488 + in 489 + loop (i + 1) (result :: acc) rest) 490 + in 491 + loop 1 [] repos 492 in 493 + match clone_repos () with 494 | Error e -> Error e 495 + | Ok checkout_results -> ( 496 + (* Then, add/pull subtrees for unique repos only *) 497 + Log.info (fun m -> 498 + m "Processing %d unique subtrees" (List.length repos)); 499 + let total = List.length repos in 500 + let rec loop i results_acc repos_left checkout_results_left = 501 + match (repos_left, checkout_results_left) with 502 + | [], [] -> Ok (List.rev results_acc) 503 + | pkg :: rest_repos, cr :: rest_cr -> ( 504 + Log.info (fun m -> 505 + m "[%d/%d] Subtree %s" i total 506 + (Package.subtree_prefix pkg)); 507 + match pull_subtree ~proc ~fs ~config pkg with 508 + | Ok subtree_added -> 509 + let result = { cr with subtree_added } in 510 + loop (i + 1) (result :: results_acc) rest_repos 511 + rest_cr 512 + | Error e -> Error e) 513 + | _ -> Ok (List.rev results_acc) 514 + (* mismatched lengths, shouldn't happen *) 515 + in 516 + match loop 1 [] repos checkout_results with 517 + | Error e -> Error e 518 + | Ok results -> 519 + (* Print summary *) 520 + let cloned = List.filter (fun r -> r.cloned) results in 521 + let updated = 522 + List.filter 523 + (fun r -> (not r.cloned) && r.commits_pulled > 0) 524 + results 525 + in 526 + let added = 527 + List.filter (fun r -> r.subtree_added) results 528 + in 529 + if cloned <> [] then begin 530 + Log.app (fun m -> 531 + m "Cloned %d new repositories:" (List.length cloned)); 532 + List.iter 533 + (fun r -> Log.app (fun m -> m " + %s" r.repo_name)) 534 + cloned 535 + end; 536 + if updated <> [] then begin 537 + Log.app (fun m -> 538 + m "Updated %d repositories:" (List.length updated)); 539 + List.iter 540 + (fun r -> 541 + Log.app (fun m -> 542 + m " ~ %s (%d new commits)" r.repo_name 543 + r.commits_pulled)) 544 + updated 545 + end; 546 + if added <> [] then begin 547 + Log.app (fun m -> 548 + m "Added %d new subtrees:" (List.length added)); 549 + List.iter 550 + (fun r -> Log.app (fun m -> m " + %s" r.repo_name)) 551 + added 552 + end; 553 + let unchanged = 554 + List.length results - List.length cloned 555 + - List.length updated 556 + in 557 + if cloned = [] && updated = [] && added = [] then 558 + Log.app (fun m -> 559 + m "All %d repositories up to date." 560 + (List.length results)) 561 + else if unchanged > 0 then 562 + Log.app (fun m -> 563 + m "%d repositories unchanged." unchanged); 564 + (* Update README.md with package summary *) 565 + write_readme ~proc ~fs:fs_t ~config all_pkgs; 566 + Ok ()) 567 + end 568 + end) 569 570 let run_git_in ~proc ~cwd args = 571 Eio.Switch.run @@ fun sw -> ··· 580 match Eio.Process.await child with 581 | `Exited 0 -> Ok (Buffer.contents buf_stdout |> String.trim) 582 | _ -> 583 + let result = 584 + Git. 585 + { 586 + exit_code = 1; 587 + stdout = Buffer.contents buf_stdout; 588 + stderr = Buffer.contents buf_stderr; 589 + } 590 + in 591 Error (Git.Command_failed (String.concat " " ("git" :: args), result)) 592 593 let push_one ~proc ~fs ~config pkg = 594 + let ( let* ) r f = 595 + Result.bind (Result.map_error (fun e -> Git_error e) r) f 596 + in 597 let fs = fs_typed fs in 598 let monorepo = Config.Paths.monorepo config in 599 let prefix = Package.subtree_prefix pkg in ··· 604 if not (Git.Subtree.exists ~fs ~repo:monorepo ~prefix) then begin 605 Log.debug (fun m -> m "Subtree %s not in monorepo, skipping" prefix); 606 Ok () 607 + end 608 + else begin 609 let checkout_eio = Eio.Path.(fs / Fpath.to_string checkout_dir) in 610 match Eio.Path.kind ~follow:true checkout_eio with 611 | exception Eio.Io _ -> 612 + Log.debug (fun m -> 613 + m "Checkout %a does not exist, skipping" Fpath.pp checkout_dir); 614 Ok () 615 | `Directory when Git.is_repo ~proc ~fs checkout_dir -> 616 let monorepo_eio = Eio.Path.(fs / Fpath.to_string monorepo) in 617 let checkout_path = Fpath.to_string checkout_dir in 618 (* Push subtree to a sync branch (avoids "branch is checked out" error) *) 619 Log.info (fun m -> m "Pushing subtree %s to checkout" prefix); 620 + let* _ = 621 + run_git_in ~proc ~cwd:monorepo_eio 622 + [ 623 + "subtree"; "push"; "--prefix"; prefix; checkout_path; sync_branch; 624 + ] 625 + in 626 (* Merge sync branch into the target branch in checkout *) 627 Log.debug (fun m -> m "Merging %s into %s" sync_branch branch); 628 + let* _ = 629 + run_git_in ~proc ~cwd:checkout_eio 630 + [ "merge"; "--ff-only"; sync_branch ] 631 + in 632 (* Delete the sync branch *) 633 Log.debug (fun m -> m "Cleaning up %s branch" sync_branch); 634 + ignore 635 + (run_git_in ~proc ~cwd:checkout_eio [ "branch"; "-d"; sync_branch ]); 636 Ok () 637 | _ -> 638 + Log.debug (fun m -> 639 + m "Checkout %a is not a git repo, skipping" Fpath.pp checkout_dir); 640 Ok () 641 end 642 ··· 655 if pkgs = [] && package <> None then 656 Error (Package_not_found (Option.get package)) 657 else begin 658 + Log.info (fun m -> 659 + m "Checking status of %d packages" (List.length pkgs)); 660 let statuses = Status.compute_all ~proc ~fs:fs_t ~config pkgs in 661 let dirty = 662 List.filter Status.has_local_changes statuses ··· 669 let total = List.length repos in 670 let rec loop i = function 671 | [] -> Ok () 672 + | pkg :: rest -> ( 673 + Log.info (fun m -> 674 + m "[%d/%d] Processing %s" i total 675 + (Package.subtree_prefix pkg)); 676 match push_one ~proc ~fs ~config pkg with 677 | Ok () -> loop (i + 1) rest 678 + | Error e -> Error e) 679 in 680 loop 1 repos 681 end ··· 686 ensure_checkouts_dir ~fs:fs_t ~config; 687 match ensure_monorepo_initialized ~proc ~fs:fs_t ~config with 688 | Error e -> Error e 689 + | Ok () -> ( 690 match find_package ~fs:(fs_t :> _ Eio.Path.t) ~config package with 691 | Error e -> Error e 692 + | Ok pkg -> ( 693 Log.info (fun m -> m "Adding package %s" (Package.name pkg)); 694 match ensure_checkout ~proc ~fs:fs_t ~config pkg with 695 | Error e -> Error (Git_error e) 696 | Ok () -> 697 + pull_subtree ~proc ~fs ~config pkg |> Result.map (fun _ -> ()))) 0 698 699 let remove ~proc:_ ~fs ~config ~package () = 700 let fs = fs_typed fs in ··· 706 try 707 Eio.Path.rmtree subtree_path; 708 Ok () 709 + with Eio.Io _ as e -> 710 + Error (Git_error (Git.Io_error (Printexc.to_string e)))

+50 -60

lib/monopam.mli

··· 1 (** Monopam - Opam overlay and monorepo manager. 2 3 Monopam manages synchronization between an opam overlay repository, 4 - individual git checkouts of packages, and a monorepo using git 5 - subtrees. 6 7 {1 Overview} 8 9 The typical workflow is: 10 11 - 1. {b init} - Initialize configuration and monorepo 12 - 2. {b status} - Check synchronization state of all packages 13 - 3. {b pull} - Fetch from remotes, update checkouts, merge to monorepo 14 - 4. {b push} - Extract monorepo changes back to checkouts 15 16 {1 Modules} 17 ··· 33 34 (** Errors from high-level operations. *) 35 type error = 36 - | Config_error of string 37 - (** Configuration error *) 38 - | Repo_error of Opam_repo.error 39 - (** Opam repository error *) 40 - | Git_error of Git.error 41 - (** Git operation error *) 42 | Dirty_state of Package.t list 43 (** Operation blocked due to dirty packages *) 44 - | Package_not_found of string 45 - (** Named package not found in opam repo *) 46 47 - (** [pp_error] formats errors. *) 48 val pp_error : error Fmt.t 0 49 50 (** {2 Status} *) 51 52 - (** [status ~proc ~fs ~config ()] computes status for all packages 53 - discovered in the opam repo. 54 - 55 - @param proc Eio process manager 56 - @param fs Eio filesystem 57 - @param config Monopam configuration *) 58 val status : 59 proc:_ Eio.Process.mgr -> 60 fs:Eio.Fs.dir_ty Eio.Path.t -> 61 config:Config.t -> 62 unit -> 63 (Status.t list, error) result 0 0 0 0 0 0 64 65 (** {2 Pull} *) 66 0 0 0 0 0 0 0 67 (** [pull ~proc ~fs ~config ?package ()] pulls updates from remotes. 68 69 - For each package (or the specified package): 70 - 1. Clones or fetches the individual checkout 71 - 2. Adds or pulls the subtree in the monorepo 72 73 Aborts if any checkout or the monorepo has uncommitted changes. 74 ··· 76 @param fs Eio filesystem 77 @param config Monopam configuration 78 @param package Optional specific package to pull *) 79 - val pull : 0 0 0 80 proc:_ Eio.Process.mgr -> 81 fs:Eio.Fs.dir_ty Eio.Path.t -> 82 config:Config.t -> 83 ?package:string -> 84 unit -> 85 (unit, error) result 86 - 87 - (** {2 Push} *) 88 89 - (** [push ~proc ~fs ~config ?package ()] pushes changes from monorepo 90 - to checkouts. 91 - 92 - For each package (or the specified package) with changes in the 93 - monorepo: 94 - 1. Splits the subtree commits 95 - 2. Pushes to the individual checkout 96 97 The user must manually push from checkouts to remotes. 98 ··· 102 @param fs Eio filesystem 103 @param config Monopam configuration 104 @param package Optional specific package to push *) 105 - val push : 0 0 0 106 proc:_ Eio.Process.mgr -> 107 fs:Eio.Fs.dir_ty Eio.Path.t -> 108 config:Config.t -> 109 - ?package:string -> 110 unit -> 111 (unit, error) result 112 - 113 - (** {2 Package Management} *) 114 - 115 (** [add ~proc ~fs ~config ~package ()] adds a package to the monorepo. 116 117 Clones the checkout if needed and adds the subtree. ··· 120 @param fs Eio filesystem 121 @param config Monopam configuration 122 @param package Package name to add *) 123 - val add : 0 124 proc:_ Eio.Process.mgr -> 125 fs:Eio.Fs.dir_ty Eio.Path.t -> 126 config:Config.t -> 127 package:string -> 128 unit -> 129 (unit, error) result 130 - 131 - (** [remove ~proc ~fs ~config ~package ()] removes a package from the 132 - monorepo. 133 134 Removes the subtree directory but does not delete the checkout. 135 ··· 137 @param fs Eio filesystem 138 @param config Monopam configuration 139 @param package Package name to remove *) 140 - val remove : 141 - proc:_ Eio.Process.mgr -> 142 - fs:Eio.Fs.dir_ty Eio.Path.t -> 143 - config:Config.t -> 144 - package:string -> 145 - unit -> 146 - (unit, error) result 147 148 (** {1 Package Discovery} *) 149 150 - (** [discover_packages ~fs ~config ()] scans the opam repo and returns 151 - all packages. 152 - 153 - @param fs Eio filesystem 154 - @param config Monopam configuration *) 155 val discover_packages : 156 fs:Eio.Fs.dir_ty Eio.Path.t -> 157 config:Config.t -> 158 unit -> 159 (Package.t list, error) result 0 0 160 161 - (** [find_package ~fs ~config name] finds a package by name in the 162 - opam repo. 163 164 - @param fs Eio filesystem 165 - @param config Monopam configuration 166 - @param name Package name to find *) 167 val find_package : 168 fs:Eio.Fs.dir_ty Eio.Path.t -> 169 config:Config.t -> 170 string -> 171 (Package.t, error) result 0 0 0 0 0

··· 1 (** Monopam - Opam overlay and monorepo manager. 2 3 Monopam manages synchronization between an opam overlay repository, 4 + individual git checkouts of packages, and a monorepo using git subtrees. 0 5 6 {1 Overview} 7 8 The typical workflow is: 9 10 + 1. {b init} - Initialize configuration and monorepo 2. {b status} - Check 11 + synchronization state of all packages 3. {b pull} - Fetch from remotes, 12 + update checkouts, merge to monorepo 4. {b push} - Extract monorepo changes 13 + back to checkouts 14 15 {1 Modules} 16 ··· 32 33 (** Errors from high-level operations. *) 34 type error = 35 + | Config_error of string (** Configuration error *) 36 + | Repo_error of Opam_repo.error (** Opam repository error *) 37 + | Git_error of Git.error (** Git operation error *) 0 0 0 38 | Dirty_state of Package.t list 39 (** Operation blocked due to dirty packages *) 40 + | Package_not_found of string (** Named package not found in opam repo *) 0 41 0 42 val pp_error : error Fmt.t 43 + (** [pp_error] formats errors. *) 44 45 (** {2 Status} *) 46 0 0 0 0 0 0 47 val status : 48 proc:_ Eio.Process.mgr -> 49 fs:Eio.Fs.dir_ty Eio.Path.t -> 50 config:Config.t -> 51 unit -> 52 (Status.t list, error) result 53 + (** [status ~proc ~fs ~config ()] computes status for all packages discovered in 54 + the opam repo. 55 + 56 + @param proc Eio process manager 57 + @param fs Eio filesystem 58 + @param config Monopam configuration *) 59 60 (** {2 Pull} *) 61 62 + val pull : 63 + proc:_ Eio.Process.mgr -> 64 + fs:Eio.Fs.dir_ty Eio.Path.t -> 65 + config:Config.t -> 66 + ?package:string -> 67 + unit -> 68 + (unit, error) result 69 (** [pull ~proc ~fs ~config ?package ()] pulls updates from remotes. 70 71 + For each package (or the specified package): 1. Clones or fetches the 72 + individual checkout 2. Adds or pulls the subtree in the monorepo 0 73 74 Aborts if any checkout or the monorepo has uncommitted changes. 75 ··· 77 @param fs Eio filesystem 78 @param config Monopam configuration 79 @param package Optional specific package to pull *) 80 + 81 + (** {2 Push} *) 82 + 83 + val push : 84 proc:_ Eio.Process.mgr -> 85 fs:Eio.Fs.dir_ty Eio.Path.t -> 86 config:Config.t -> 87 ?package:string -> 88 unit -> 89 (unit, error) result 90 + (** [push ~proc ~fs ~config ?package ()] pushes changes from monorepo to 91 + checkouts. 92 93 + For each package (or the specified package) with changes in the monorepo: 1. 94 + Splits the subtree commits 2. Pushes to the individual checkout 0 0 0 0 0 95 96 The user must manually push from checkouts to remotes. 97 ··· 101 @param fs Eio filesystem 102 @param config Monopam configuration 103 @param package Optional specific package to push *) 104 + 105 + (** {2 Package Management} *) 106 + 107 + val add : 108 proc:_ Eio.Process.mgr -> 109 fs:Eio.Fs.dir_ty Eio.Path.t -> 110 config:Config.t -> 111 + package:string -> 112 unit -> 113 (unit, error) result 0 0 0 114 (** [add ~proc ~fs ~config ~package ()] adds a package to the monorepo. 115 116 Clones the checkout if needed and adds the subtree. ··· 119 @param fs Eio filesystem 120 @param config Monopam configuration 121 @param package Package name to add *) 122 + 123 + val remove : 124 proc:_ Eio.Process.mgr -> 125 fs:Eio.Fs.dir_ty Eio.Path.t -> 126 config:Config.t -> 127 package:string -> 128 unit -> 129 (unit, error) result 130 + (** [remove ~proc ~fs ~config ~package ()] removes a package from the monorepo. 0 0 131 132 Removes the subtree directory but does not delete the checkout. 133 ··· 135 @param fs Eio filesystem 136 @param config Monopam configuration 137 @param package Package name to remove *) 0 0 0 0 0 0 0 138 139 (** {1 Package Discovery} *) 140 0 0 0 0 0 141 val discover_packages : 142 fs:Eio.Fs.dir_ty Eio.Path.t -> 143 config:Config.t -> 144 unit -> 145 (Package.t list, error) result 146 + (** [discover_packages ~fs ~config ()] scans the opam repo and returns all 147 + packages. 148 149 + @param fs Eio filesystem 150 + @param config Monopam configuration *) 151 0 0 0 152 val find_package : 153 fs:Eio.Fs.dir_ty Eio.Path.t -> 154 config:Config.t -> 155 string -> 156 (Package.t, error) result 157 + (** [find_package ~fs ~config name] finds a package by name in the opam repo. 158 + 159 + @param fs Eio filesystem 160 + @param config Monopam configuration 161 + @param name Package name to find *)

+14 -21

lib/opam_repo.ml

··· 19 | Parse_error (path, msg) -> Fmt.pf ppf "Failed to parse %s: %s" path msg 20 | Io_error msg -> Fmt.pf ppf "I/O error: %s" msg 21 22 - let has_prefix prefix s = 23 - String.length s >= String.length prefix && 24 - String.sub s 0 (String.length prefix) = prefix 25 - 26 - let has_suffix suffix s = 27 - String.length s >= String.length suffix && 28 - String.sub s (String.length s - String.length suffix) (String.length suffix) = suffix 29 - 30 let is_git_url url = 31 - String.length url > 0 && 32 - (has_prefix "git+" url || has_prefix "git://" url || 33 - has_prefix "git@" url || has_suffix ".git" url) 0 34 35 let normalize_git_url url = 36 let url = 37 - if has_prefix "git+" url then 38 - String.sub url 4 (String.length url - 4) 39 - else url 40 in 41 Uri.of_string url 42 ··· 70 let load_package ~fs opam_file_path = 71 let path_str = Fpath.to_string opam_file_path in 72 match parse_package_path opam_file_path with 73 - | None -> Error (Parse_error (path_str, "Cannot determine package name/version")) 0 74 | Some (name, version) -> ( 75 try 76 let eio_path = Eio.Path.(fs / path_str) in ··· 92 try 93 Eio.Path.read_dir eio_path 94 |> List.filter (fun name -> 95 - let child = Eio.Path.(eio_path / name) in 96 - match Eio.Path.kind ~follow:false child with 97 - | `Directory -> true 98 - | _ -> false) 99 with Eio.Io _ -> [] 100 101 let scan_all ~fs repo_path = ··· 113 match load_package ~fs opam_path with 114 | Ok pkg -> (pkg :: pkgs, errs) 115 | Error e -> (pkgs, e :: errs)) 116 - | _ :: _ :: _ as vs -> 117 - (pkgs, Multiple_versions (name, vs) :: errs)) 118 ([], []) package_names 119 in 120 (List.rev packages, List.rev errors)

··· 19 | Parse_error (path, msg) -> Fmt.pf ppf "Failed to parse %s: %s" path msg 20 | Io_error msg -> Fmt.pf ppf "I/O error: %s" msg 21 0 0 0 0 0 0 0 0 22 let is_git_url url = 23 + String.starts_with ~prefix:"git+" url 24 + || String.starts_with ~prefix:"git://" url 25 + || String.starts_with ~prefix:"git@" url 26 + || String.ends_with ~suffix:".git" url 27 28 let normalize_git_url url = 29 let url = 30 + match String.starts_with ~prefix:"git+" url with 31 + | true -> String.sub url 4 (String.length url - 4) 32 + | false -> url 33 in 34 Uri.of_string url 35 ··· 63 let load_package ~fs opam_file_path = 64 let path_str = Fpath.to_string opam_file_path in 65 match parse_package_path opam_file_path with 66 + | None -> 67 + Error (Parse_error (path_str, "Cannot determine package name/version")) 68 | Some (name, version) -> ( 69 try 70 let eio_path = Eio.Path.(fs / path_str) in ··· 86 try 87 Eio.Path.read_dir eio_path 88 |> List.filter (fun name -> 89 + let child = Eio.Path.(eio_path / name) in 90 + match Eio.Path.kind ~follow:false child with 91 + | `Directory -> true 92 + | _ -> false) 93 with Eio.Io _ -> [] 94 95 let scan_all ~fs repo_path = ··· 107 match load_package ~fs opam_path with 108 | Ok pkg -> (pkg :: pkgs, errs) 109 | Error e -> (pkgs, e :: errs)) 110 + | _ :: _ :: _ as vs -> (pkgs, Multiple_versions (name, vs) :: errs)) 0 111 ([], []) package_names 112 in 113 (List.rev packages, List.rev errors)

+23 -37

lib/opam_repo.mli

··· 1 (** Opam repository scanning and package discovery. 2 3 - This module scans an opam overlay repository to discover packages 4 - and extract their git remote URLs. It enforces the monopam constraints: 5 - Only one version per package is allowed 6 - Only git remotes are allowed (no archive URLs) *) 7 ··· 11 type error = 12 | Multiple_versions of string * string list 13 (** Package has multiple versions: (name, versions) *) 14 - | No_dev_repo of string 15 - (** Package has no dev-repo field *) 16 | Invalid_dev_repo of string * string 17 (** Package has invalid dev-repo: (name, url) *) 18 | Not_git_remote of string * string 19 (** Package dev-repo is not a git URL: (name, url) *) 20 | Parse_error of string * string 21 (** Failed to parse opam file: (path, message) *) 22 - | Io_error of string 23 - (** Filesystem error *) 24 25 - (** [pp_error] is a formatter for errors. *) 26 val pp_error : error Fmt.t 0 27 28 (** {1 Scanning} *) 29 30 - (** [scan ~fs repo_path] scans the opam repository at [repo_path] and 31 - returns all discovered packages. 0 32 33 The repository is expected to have the standard opam layout: 34 [repo_path/packages/<name>/<name.version>/opam] ··· 40 41 @param fs Eio filesystem capability 42 @param repo_path Path to the opam repository root *) 43 - val scan : 44 - fs:_ Eio.Path.t -> 45 - Fpath.t -> 46 - (Package.t list, error) result 47 48 - (** [scan_all ~fs repo_path] scans the repository and returns all 49 - packages, collecting errors instead of failing on the first one. 0 50 51 Returns a pair of (valid packages, errors encountered). *) 52 - val scan_all : 53 - fs:_ Eio.Path.t -> 54 - Fpath.t -> 55 - Package.t list * error list 56 57 (** {1 Individual Package Loading} *) 58 59 - (** [load_package ~fs opam_file_path] loads a single package from its 60 - opam file path. 0 61 62 @param fs Eio filesystem capability 63 @param opam_file_path Full path to the opam file *) 64 - val load_package : 65 - fs:_ Eio.Path.t -> 66 - Fpath.t -> 67 - (Package.t, error) result 68 69 (** {1 Validation} *) 70 71 - (** [validate_repo ~fs repo_path] validates the entire repository 72 - without loading packages. Returns a list of validation errors. 0 73 74 This is useful for checking repository health before operations. *) 75 - val validate_repo : 76 - fs:_ Eio.Path.t -> 77 - Fpath.t -> 78 - error list 79 0 80 (** [is_git_url url] returns true if the URL is a valid git remote. 81 82 - Accepts URLs starting with "git+" or "git://" or ending with ".git", 83 - as well as SSH-style URLs like "git\@github.com:...". *) 84 - val is_git_url : string -> bool 85 86 - (** [normalize_git_url url] normalizes a git URL by removing the "git+" 87 - prefix if present. 0 88 89 For example, "git+https://example.com/repo.git" becomes 90 "https://example.com/repo.git". *) 91 - val normalize_git_url : string -> Uri.t

··· 1 (** Opam repository scanning and package discovery. 2 3 + This module scans an opam overlay repository to discover packages and 4 + extract their git remote URLs. It enforces the monopam constraints: 5 - Only one version per package is allowed 6 - Only git remotes are allowed (no archive URLs) *) 7 ··· 11 type error = 12 | Multiple_versions of string * string list 13 (** Package has multiple versions: (name, versions) *) 14 + | No_dev_repo of string (** Package has no dev-repo field *) 0 15 | Invalid_dev_repo of string * string 16 (** Package has invalid dev-repo: (name, url) *) 17 | Not_git_remote of string * string 18 (** Package dev-repo is not a git URL: (name, url) *) 19 | Parse_error of string * string 20 (** Failed to parse opam file: (path, message) *) 21 + | Io_error of string (** Filesystem error *) 0 22 0 23 val pp_error : error Fmt.t 24 + (** [pp_error] is a formatter for errors. *) 25 26 (** {1 Scanning} *) 27 28 + val scan : fs:_ Eio.Path.t -> Fpath.t -> (Package.t list, error) result 29 + (** [scan ~fs repo_path] scans the opam repository at [repo_path] and returns 30 + all discovered packages. 31 32 The repository is expected to have the standard opam layout: 33 [repo_path/packages/<name>/<name.version>/opam] ··· 39 40 @param fs Eio filesystem capability 41 @param repo_path Path to the opam repository root *) 0 0 0 0 42 43 + val scan_all : fs:_ Eio.Path.t -> Fpath.t -> Package.t list * error list 44 + (** [scan_all ~fs repo_path] scans the repository and returns all packages, 45 + collecting errors instead of failing on the first one. 46 47 Returns a pair of (valid packages, errors encountered). *) 0 0 0 0 48 49 (** {1 Individual Package Loading} *) 50 51 + val load_package : fs:_ Eio.Path.t -> Fpath.t -> (Package.t, error) result 52 + (** [load_package ~fs opam_file_path] loads a single package from its opam file 53 + path. 54 55 @param fs Eio filesystem capability 56 @param opam_file_path Full path to the opam file *) 0 0 0 0 57 58 (** {1 Validation} *) 59 60 + val validate_repo : fs:_ Eio.Path.t -> Fpath.t -> error list 61 + (** [validate_repo ~fs repo_path] validates the entire repository without 62 + loading packages. Returns a list of validation errors. 63 64 This is useful for checking repository health before operations. *) 0 0 0 0 65 66 + val is_git_url : string -> bool 67 (** [is_git_url url] returns true if the URL is a valid git remote. 68 69 + Accepts URLs starting with "git+" or "git://" or ending with ".git", as well 70 + as SSH-style URLs like "git@github.com:...". *) 0 71 72 + val normalize_git_url : string -> Uri.t 73 + (** [normalize_git_url url] normalizes a git URL by removing the "git+" prefix 74 + if present. 75 76 For example, "git+https://example.com/repo.git" becomes 77 "https://example.com/repo.git". *) 0

+9 -6

lib/package.ml

··· 5 branch : string option; 6 } 7 8 - let create ~name ~version ~dev_repo ?branch () = { name; version; dev_repo; branch } 0 0 9 let name t = t.name 10 let version t = t.version 11 let dev_repo t = t.dev_repo ··· 17 let basename = Filename.basename path in 18 if Filename.check_suffix basename ".git" then 19 Filename.chop_suffix basename ".git" 20 - else 21 - basename 22 23 let checkout_dir ~checkouts_root t = Fpath.(checkouts_root / repo_name t) 24 let subtree_prefix t = repo_name t 25 let compare a b = String.compare a.name b.name 26 let equal a b = String.equal a.name b.name 27 - 28 let same_repo a b = Uri.equal a.dev_repo b.dev_repo 29 30 let pp ppf t = 31 - Fmt.pf ppf "@[<hov 2>{ name = %S;@ version = %S;@ dev_repo = %a;@ branch = %a }@]" 32 - t.name t.version Uri.pp t.dev_repo Fmt.(option ~none:(any "None") string) t.branch 0 0 0

··· 5 branch : string option; 6 } 7 8 + let create ~name ~version ~dev_repo ?branch () = 9 + { name; version; dev_repo; branch } 10 + 11 let name t = t.name 12 let version t = t.version 13 let dev_repo t = t.dev_repo ··· 19 let basename = Filename.basename path in 20 if Filename.check_suffix basename ".git" then 21 Filename.chop_suffix basename ".git" 22 + else basename 0 23 24 let checkout_dir ~checkouts_root t = Fpath.(checkouts_root / repo_name t) 25 let subtree_prefix t = repo_name t 26 let compare a b = String.compare a.name b.name 27 let equal a b = String.equal a.name b.name 0 28 let same_repo a b = Uri.equal a.dev_repo b.dev_repo 29 30 let pp ppf t = 31 + Fmt.pf ppf 32 + "@[<hov 2>{ name = %S;@ version = %S;@ dev_repo = %a;@ branch = %a }@]" 33 + t.name t.version Uri.pp t.dev_repo 34 + Fmt.(option ~none:(any "None") string) 35 + t.branch

+19 -24

lib/package.mli

··· 1 (** Package metadata and operations. 2 3 - A package represents a single opam package discovered from the opam 4 - overlay repository. It contains the package name, version, git remote 5 - URL, and optional configuration overrides. *) 6 7 (** {1 Types} *) 8 9 - (** A package discovered from the opam overlay. *) 10 type t 0 11 12 (** {1 Constructors} *) 13 0 0 14 (** [create ~name ~version ~dev_repo ?branch ()] creates a new package. 15 16 @param name The opam package name 17 @param version The package version (e.g., "dev") 18 @param dev_repo The git remote URL from the opam file's dev-repo field 19 @param branch Optional branch override; defaults to repository default *) 20 - val create : 21 - name:string -> 22 - version:string -> 23 - dev_repo:Uri.t -> 24 - ?branch:string -> 25 - unit -> 26 - t 27 28 (** {1 Accessors} *) 29 30 - (** [name t] returns the package name. *) 31 val name : t -> string 0 32 0 33 (** [version t] returns the package version string. *) 34 - val version : t -> string 35 0 36 (** [dev_repo t] returns the git remote URI. *) 37 - val dev_repo : t -> Uri.t 38 0 39 (** [branch t] returns the branch to track, if explicitly set. *) 40 - val branch : t -> string option 41 0 42 (** [repo_name t] returns the repository name extracted from the dev-repo URL. 43 44 - This is the basename of the URL path with any ".git" suffix removed. 45 - For example, "https://github.com/foo/bar.git" returns "bar". *) 46 - val repo_name : t -> string 47 48 (** {1 Derived Paths} *) 49 0 50 (** [checkout_dir ~checkouts_root t] returns the expected path for this 51 package's git checkout, based on the repository name. 52 ··· 54 checkouts_root "/home/user/src", this returns "/home/user/src/bar". 55 56 Multiple packages from the same repository will share the same checkout. *) 57 - val checkout_dir : checkouts_root:Fpath.t -> t -> Fpath.t 58 0 59 (** [subtree_prefix t] returns the subdirectory name used in the monorepo. 60 61 This is the repository name (same as [repo_name t]), so multiple packages 62 from the same repository share the same subtree directory. *) 63 - val subtree_prefix : t -> string 64 65 (** {1 Comparison} *) 66 0 67 (** [compare a b] compares packages by name. *) 68 - val compare : t -> t -> int 69 70 - (** [equal a b] returns true if packages have the same name. *) 71 val equal : t -> t -> bool 0 72 0 73 (** [same_repo a b] returns true if packages share the same dev-repo URL. *) 74 - val same_repo : t -> t -> bool 75 76 (** {1 Pretty Printing} *) 77 78 - (** [pp] is a formatter for packages. *) 79 val pp : t Fmt.t 0

··· 1 (** Package metadata and operations. 2 3 + A package represents a single opam package discovered from the opam overlay 4 + repository. It contains the package name, version, git remote URL, and 5 + optional configuration overrides. *) 6 7 (** {1 Types} *) 8 0 9 type t 10 + (** A package discovered from the opam overlay. *) 11 12 (** {1 Constructors} *) 13 14 + val create : 15 + name:string -> version:string -> dev_repo:Uri.t -> ?branch:string -> unit -> t 16 (** [create ~name ~version ~dev_repo ?branch ()] creates a new package. 17 18 @param name The opam package name 19 @param version The package version (e.g., "dev") 20 @param dev_repo The git remote URL from the opam file's dev-repo field 21 @param branch Optional branch override; defaults to repository default *) 0 0 0 0 0 0 0 22 23 (** {1 Accessors} *) 24 0 25 val name : t -> string 26 + (** [name t] returns the package name. *) 27 28 + val version : t -> string 29 (** [version t] returns the package version string. *) 0 30 31 + val dev_repo : t -> Uri.t 32 (** [dev_repo t] returns the git remote URI. *) 0 33 34 + val branch : t -> string option 35 (** [branch t] returns the branch to track, if explicitly set. *) 0 36 37 + val repo_name : t -> string 38 (** [repo_name t] returns the repository name extracted from the dev-repo URL. 39 40 + This is the basename of the URL path with any ".git" suffix removed. For 41 + example, "https://github.com/foo/bar.git" returns "bar". *) 0 42 43 (** {1 Derived Paths} *) 44 45 + val checkout_dir : checkouts_root:Fpath.t -> t -> Fpath.t 46 (** [checkout_dir ~checkouts_root t] returns the expected path for this 47 package's git checkout, based on the repository name. 48 ··· 50 checkouts_root "/home/user/src", this returns "/home/user/src/bar". 51 52 Multiple packages from the same repository will share the same checkout. *) 0 53 54 + val subtree_prefix : t -> string 55 (** [subtree_prefix t] returns the subdirectory name used in the monorepo. 56 57 This is the repository name (same as [repo_name t]), so multiple packages 58 from the same repository share the same subtree directory. *) 0 59 60 (** {1 Comparison} *) 61 62 + val compare : t -> t -> int 63 (** [compare a b] compares packages by name. *) 0 64 0 65 val equal : t -> t -> bool 66 + (** [equal a b] returns true if packages have the same name. *) 67 68 + val same_repo : t -> t -> bool 69 (** [same_repo a b] returns true if packages share the same dev-repo URL. *) 0 70 71 (** {1 Pretty Printing} *) 72 0 73 val pp : t Fmt.t 74 + (** [pp] is a formatter for packages. *)

+10 -13

lib/status.ml

··· 13 } 14 15 let fs_typed (fs : _ Eio.Path.t) : Eio.Fs.dir_ty Eio.Path.t = 16 - let (dir, _) = fs in 17 (dir, "") 18 19 let compute ~proc ~fs ~config pkg = ··· 23 let prefix = Package.subtree_prefix pkg in 24 let fs_t = fs_typed fs in 25 let fs_dir = 26 - let (dir, _) = fs in 27 (dir, Fpath.to_string checkout_dir) 28 in 29 let checkout = 30 match Eio.Path.kind ~follow:true fs_dir with 31 | exception Eio.Io _ -> Missing 32 - | `Directory -> 33 if not (Git.is_repo ~proc ~fs:fs_t checkout_dir) then Not_a_repo 34 else if Git.is_dirty ~proc ~fs:fs_t checkout_dir then Dirty 35 - else ( 36 match Git.ahead_behind ~proc ~fs:fs_t checkout_dir with 37 | Ok ab -> Clean ab 38 | Error _ -> Clean { ahead = 0; behind = 0 }) ··· 47 let compute_all ~proc ~fs ~config packages = 48 List.map (compute ~proc ~fs ~config) packages 49 50 - let is_checkout_clean t = 51 - match t.checkout with Clean _ -> true | _ -> false 52 - 53 - let has_local_changes t = 54 - match t.checkout with Dirty -> true | _ -> false 55 56 let needs_pull t = 57 match t.checkout with Clean ab -> ab.behind > 0 | _ -> false 58 59 - let needs_push t = 60 - match t.checkout with Clean ab -> ab.ahead > 0 | _ -> false 61 62 let is_fully_synced t = 63 match (t.checkout, t.subtree) with ··· 92 let total = List.length statuses in 93 let clean = List.filter is_checkout_clean statuses |> List.length in 94 let synced = List.filter is_fully_synced statuses |> List.length in 95 - Fmt.pf ppf "@[<v>Packages: %d total, %d clean checkouts, %d fully synced@,@,%a@]" 96 - total clean synced 0 97 Fmt.(list ~sep:cut pp) 98 statuses

··· 13 } 14 15 let fs_typed (fs : _ Eio.Path.t) : Eio.Fs.dir_ty Eio.Path.t = 16 + let dir, _ = fs in 17 (dir, "") 18 19 let compute ~proc ~fs ~config pkg = ··· 23 let prefix = Package.subtree_prefix pkg in 24 let fs_t = fs_typed fs in 25 let fs_dir = 26 + let dir, _ = fs in 27 (dir, Fpath.to_string checkout_dir) 28 in 29 let checkout = 30 match Eio.Path.kind ~follow:true fs_dir with 31 | exception Eio.Io _ -> Missing 32 + | `Directory -> ( 33 if not (Git.is_repo ~proc ~fs:fs_t checkout_dir) then Not_a_repo 34 else if Git.is_dirty ~proc ~fs:fs_t checkout_dir then Dirty 35 + else 36 match Git.ahead_behind ~proc ~fs:fs_t checkout_dir with 37 | Ok ab -> Clean ab 38 | Error _ -> Clean { ahead = 0; behind = 0 }) ··· 47 let compute_all ~proc ~fs ~config packages = 48 List.map (compute ~proc ~fs ~config) packages 49 50 + let is_checkout_clean t = match t.checkout with Clean _ -> true | _ -> false 51 + let has_local_changes t = match t.checkout with Dirty -> true | _ -> false 0 0 0 52 53 let needs_pull t = 54 match t.checkout with Clean ab -> ab.behind > 0 | _ -> false 55 56 + let needs_push t = match t.checkout with Clean ab -> ab.ahead > 0 | _ -> false 0 57 58 let is_fully_synced t = 59 match (t.checkout, t.subtree) with ··· 88 let total = List.length statuses in 89 let clean = List.filter is_checkout_clean statuses |> List.length in 90 let synced = List.filter is_fully_synced statuses |> List.length in 91 + Fmt.pf ppf 92 + "@[<v>Packages: %d total, %d clean checkouts, %d fully synced@,@,%a@]" total 93 + clean synced 94 Fmt.(list ~sep:cut pp) 95 statuses

+32 -38

lib/status.mli

··· 1 (** Status computation and display. 2 3 - This module computes the synchronization status of packages across 4 - the three locations: git remote, individual checkout, and monorepo 5 - subtree. *) 6 7 (** {1 Types} *) 8 9 (** Status of an individual checkout relative to its remote. *) 10 type checkout_status = 11 - | Missing 12 - (** Checkout directory does not exist *) 13 - | Not_a_repo 14 - (** Directory exists but is not a git repository *) 15 - | Dirty 16 - (** Has uncommitted changes *) 17 | Clean of Git.ahead_behind 18 (** Clean with ahead/behind info relative to remote *) 19 20 (** Status of a subtree in the monorepo. *) 21 type subtree_status = 22 - | Not_added 23 - (** Subtree has not been added to monorepo *) 24 - | Present 25 - (** Subtree exists in monorepo *) 26 27 - (** Combined status for a package. *) 28 type t = { 29 package : Package.t; 30 checkout : checkout_status; 31 subtree : subtree_status; 32 } 0 33 34 (** {1 Status Computation} *) 35 36 - (** [compute ~proc ~fs ~config pkg] computes the status of a single package. 37 - 38 - @param proc Eio process manager 39 - @param fs Eio filesystem 40 - @param config Monopam configuration 41 - @param pkg Package to check *) 42 val compute : 43 proc:_ Eio.Process.mgr -> 44 fs:Eio.Fs.dir_ty Eio.Path.t -> 45 config:Config.t -> 46 Package.t -> 47 t 48 - 49 - (** [compute_all ~proc ~fs ~config packages] computes status for all 50 - packages in parallel. 51 52 @param proc Eio process manager 53 @param fs Eio filesystem 54 @param config Monopam configuration 55 - @param packages List of packages to check *) 0 56 val compute_all : 57 proc:_ Eio.Process.mgr -> 58 fs:Eio.Fs.dir_ty Eio.Path.t -> 59 config:Config.t -> 60 Package.t list -> 61 t list 0 0 0 0 0 0 0 62 63 (** {1 Predicates} *) 64 65 - (** [is_checkout_clean t] returns true if the checkout is clean 66 - (exists, is a repo, and has no uncommitted changes). *) 67 val is_checkout_clean : t -> bool 0 0 68 69 - (** [has_local_changes t] returns true if either the checkout or 70 - subtree has uncommitted local changes. *) 71 val has_local_changes : t -> bool 0 0 72 73 - (** [needs_pull t] returns true if the checkout is behind the remote. *) 74 val needs_pull : t -> bool 0 75 0 76 (** [needs_push t] returns true if the checkout is ahead of the remote. *) 77 - val needs_push : t -> bool 78 79 - (** [is_fully_synced t] returns true if the package is fully in sync 80 - across all locations. *) 81 val is_fully_synced : t -> bool 0 0 82 83 (** {1 Filtering} *) 84 85 - (** [filter_actionable statuses] returns only packages that need action 86 - (dirty, ahead, behind, or missing subtree). *) 87 val filter_actionable : t list -> t list 0 0 88 89 (** {1 Pretty Printing} *) 90 91 - (** [pp_checkout_status] formats checkout status. *) 92 val pp_checkout_status : checkout_status Fmt.t 0 93 94 - (** [pp_subtree_status] formats subtree status. *) 95 val pp_subtree_status : subtree_status Fmt.t 0 96 97 - (** [pp] formats a single package status. *) 98 val pp : t Fmt.t 0 99 100 - (** [pp_summary] formats a summary of all package statuses. *) 101 val pp_summary : t list Fmt.t 0

··· 1 (** Status computation and display. 2 3 + This module computes the synchronization status of packages across the three 4 + locations: git remote, individual checkout, and monorepo subtree. *) 0 5 6 (** {1 Types} *) 7 8 (** Status of an individual checkout relative to its remote. *) 9 type checkout_status = 10 + | Missing (** Checkout directory does not exist *) 11 + | Not_a_repo (** Directory exists but is not a git repository *) 12 + | Dirty (** Has uncommitted changes *) 0 0 0 13 | Clean of Git.ahead_behind 14 (** Clean with ahead/behind info relative to remote *) 15 16 (** Status of a subtree in the monorepo. *) 17 type subtree_status = 18 + | Not_added (** Subtree has not been added to monorepo *) 19 + | Present (** Subtree exists in monorepo *) 0 0 20 0 21 type t = { 22 package : Package.t; 23 checkout : checkout_status; 24 subtree : subtree_status; 25 } 26 + (** Combined status for a package. *) 27 28 (** {1 Status Computation} *) 29 0 0 0 0 0 0 30 val compute : 31 proc:_ Eio.Process.mgr -> 32 fs:Eio.Fs.dir_ty Eio.Path.t -> 33 config:Config.t -> 34 Package.t -> 35 t 36 + (** [compute ~proc ~fs ~config pkg] computes the status of a single package. 0 0 37 38 @param proc Eio process manager 39 @param fs Eio filesystem 40 @param config Monopam configuration 41 + @param pkg Package to check *) 42 + 43 val compute_all : 44 proc:_ Eio.Process.mgr -> 45 fs:Eio.Fs.dir_ty Eio.Path.t -> 46 config:Config.t -> 47 Package.t list -> 48 t list 49 + (** [compute_all ~proc ~fs ~config packages] computes status for all packages in 50 + parallel. 51 + 52 + @param proc Eio process manager 53 + @param fs Eio filesystem 54 + @param config Monopam configuration 55 + @param packages List of packages to check *) 56 57 (** {1 Predicates} *) 58 0 0 59 val is_checkout_clean : t -> bool 60 + (** [is_checkout_clean t] returns true if the checkout is clean (exists, is a 61 + repo, and has no uncommitted changes). *) 62 0 0 63 val has_local_changes : t -> bool 64 + (** [has_local_changes t] returns true if either the checkout or subtree has 65 + uncommitted local changes. *) 66 0 67 val needs_pull : t -> bool 68 + (** [needs_pull t] returns true if the checkout is behind the remote. *) 69 70 + val needs_push : t -> bool 71 (** [needs_push t] returns true if the checkout is ahead of the remote. *) 0 72 0 0 73 val is_fully_synced : t -> bool 74 + (** [is_fully_synced t] returns true if the package is fully in sync across all 75 + locations. *) 76 77 (** {1 Filtering} *) 78 0 0 79 val filter_actionable : t list -> t list 80 + (** [filter_actionable statuses] returns only packages that need action (dirty, 81 + ahead, behind, or missing subtree). *) 82 83 (** {1 Pretty Printing} *) 84 0 85 val pp_checkout_status : checkout_status Fmt.t 86 + (** [pp_checkout_status] formats checkout status. *) 87 0 88 val pp_subtree_status : subtree_status Fmt.t 89 + (** [pp_subtree_status] formats subtree status. *) 90 0 91 val pp : t Fmt.t 92 + (** [pp] formats a single package status. *) 93 0 94 val pp_summary : t list Fmt.t 95 + (** [pp_summary] formats a summary of all package statuses. *)