Something went wrong. Try again.
A local Git merge queue with content-bound gate verdicts
Something went wrong. Try again.
2.5 kB · 66 lines
OCaml
at main
12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667module M = Merge_queueopen Commandmodule Init_loop = Loop.Make (M.Init) (Perform_init)
(* The queue, then the dependencies its entry branch's lock names, each one cloned set up the same way (doc/commands.md, "A fresh clone"). *)let rec set_up ?(fetch = true) ctx = with_queue ~writes:true ctx (fun q -> let machine, actions = M.Init.v ~fetch () in let machine = Init_loop.run ~clock:q.perform.clock q.perform machine actions in match M.Init.ending machine with | Some (Ok report) -> ( match Dependency_init.run ~set_up:(set_up ~fetch) ~fetch ctx q with | Ok () -> Ok report | Error outcome -> Error outcome) | Some (Error _ as ending) -> ending | None -> raise (Defect "mq init ended with no outcome"))
(* mq init URL is git clone URL, then mq init in the clone. *)let clone ctx url ~dir = let dir = match dir with | None -> M.Init.clone_directory url | Some d -> Fpath.of_string d in match (dir, ctx.directory, ctx.environment) with | Error (`Msg m), _, _ | _, Error m, _ -> Error (refused m) | _, _, Error m -> Error (unavailable m) | Ok dir, Ok cwd, Ok environment -> ( let dir = Fpath.(cwd // dir) in (* As Git prints a remote (transport_anonymize_url): never a password the URL names. *) let shown = Git.Uri.anonymize url in match Repo.clone ~network:(network ctx) ~environment ~clock:(Eio.Stdenv.clock ctx.env) ~base:cwd ~url dir with | Error `Exists -> Error (Fmt.kstr refused "destination path %a already exists and is not an empty \ directory" Fpath.pp dir) | Error (`Unreachable why) -> Error (Fmt.kstr unavailable "%s cannot be reached (%s): nothing was cloned" shown why) | Error (`Unsupported why) -> Error (Fmt.kstr refused "%s: nothing was cloned" why) | Error (`Untrusted why) -> Error (Fmt.kstr refused "%s: %s: nothing was cloned" shown why) | Ok () -> Fmt.epr "cloned %s into %a@." shown Fpath.pp dir; set_up { ctx with directory = Ok dir })
let run ?dir ?(fetch = true) ctx ~url = match url with | Some url when not fetch -> Error (Fmt.kstr refused "--no-fetch contacts no remote, and mq init %s clones from one" (Git.Uri.anonymize url)) | Some url -> clone ctx url ~dir | None -> set_up ~fetch ctx