diff --git a/.github/workflows/more-ci.yml b/.github/workflows/more-ci.yml index 07cb8e91..752c1604 100644 --- a/.github/workflows/more-ci.yml +++ b/.github/workflows/more-ci.yml @@ -58,7 +58,7 @@ jobs: # the development workflow and as part of the main CI job. These are the # tests that are checked for every combination of os and ocaml-compiler. - name: Install dependencies - run: opam install ./volgo.opam ./volgo-base.opam ./volgo-vcs.opam ./volgo-git-unix.opam ./volgo-git-eio.opam ./volgo-git-backend.opam ./vcs-test-helpers.opam ./volgo-tests.opam --deps-only --with-test + run: opam install ./volgo.opam ./volgo-base.opam ./volgo-vcs.opam ./volgo-git-unix.opam ./volgo-git-eio.opam ./volgo-git-miou.opam ./volgo-git-backend.opam ./vcs-test-helpers.opam ./volgo-tests.opam --deps-only --with-test - name: Build & Run tests - run: opam exec -- dune build @all @runtest -p volgo,volgo-base,volgo-vcs,volgo-git-unix,volgo-git-eio,volgo-git-backend,vcs-test-helpers,volgo-tests + run: opam exec -- dune build @all @runtest -p volgo,volgo-base,volgo-vcs,volgo-git-unix,volgo-git-eio,volgo-git-miou,volgo-git-backend,vcs-test-helpers,volgo-tests diff --git a/dune-project b/dune-project index 30d9a7ba..1fc41a9a 100644 --- a/dune-project +++ b/dune-project @@ -228,6 +228,38 @@ (volgo-git-backend (= :version)))) +(package + (name volgo-git-miou) + (synopsis + "A Git provider for Vcs based on Volgo_git_backend for Miou programs") + (depends + (ocaml + (>= 5.2)) + (miou + (>= 0.3.0)) + (fpath + (>= 0.7.3)) + (fpath-sexp0 + (>= 0.2.2)) + (pp + (>= 2.0.0)) + (pplumbing + (>= 0.0.13)) + (ppx_sexp_conv + (>= v0.17)) + (ppx_sexp_value + (>= v0.17)) + (ppxlib + (>= 0.33)) + (sexplib0 + (>= v0.17)) + (volgo + (= :version)) + (volgo-git-backend + (= :version)) + (volgo-git-unix + (= :version)))) + (package (name vcs-test-helpers) (synopsis "Helper library to write tests using vcs") @@ -329,6 +361,8 @@ (and :with-doc (>= 2.4))) + (miou + (>= 0.3.0)) (pp (>= 2.0.0)) (pplumbing @@ -400,6 +434,8 @@ (= :version)) (volgo-git-eio (= :version)) + (volgo-git-miou + (= :version)) (volgo-git-unix (= :version)) (volgo-vcs @@ -457,6 +493,8 @@ (>= 0.2.2)) (mdx (>= 2.4)) + (miou + (>= 0.3.0)) (pp (>= 2.0.0)) (pplumbing @@ -528,6 +566,8 @@ (= :version)) (volgo-git-eio (= :version)) + (volgo-git-miou + (= :version)) (volgo-git-unix (= :version)) (volgo-tests diff --git a/headache.sh b/headache.sh index 712428bb..d2178c0d 100755 --- a/headache.sh +++ b/headache.sh @@ -4,20 +4,22 @@ dirs=( # Add new directories below: "bin" "example" + "lib/vcs_test_helpers/src" + "lib/vcs_test_helpers/test" "lib/volgo/src" "lib/volgo/test" "lib/volgo_base/src" "lib/volgo_base/test" - "lib/volgo_vcs_cli/src" - "lib/volgo_vcs_cli/test" - "lib/volgo_git_unix/src" - "lib/volgo_git_unix/test" - "lib/volgo_git_eio/src" - "lib/volgo_git_eio/test" "lib/volgo_git_backend/src" "lib/volgo_git_backend/test" - "lib/vcs_test_helpers/src" - "lib/vcs_test_helpers/test" + "lib/volgo_git_eio/src" + "lib/volgo_git_eio/test" + "lib/volgo_git_miou/src" + "lib/volgo_git_miou/test" + "lib/volgo_git_unix/src" + "lib/volgo_git_unix/test" + "lib/volgo_vcs_cli/src" + "lib/volgo_vcs_cli/test" "test/expect" ) diff --git a/lib/volgo_git_miou/src/dune b/lib/volgo_git_miou/src/dune new file mode 100644 index 00000000..ecd58c24 --- /dev/null +++ b/lib/volgo_git_miou/src/dune @@ -0,0 +1,35 @@ +(library + (name volgo_git_miou) + (public_name volgo-git-miou) + (flags + :standard + -w + +a-4-40-41-42-44-45-48-66 + -warn-error + +a + -open + Fpath_sexp0 + -open + Sexplib0 + -open + Sexplib0.Sexp_conv + -open + Volgo) + (libraries + fpath + fpath-sexp0 + miou + pp + pplumbing.err + pplumbing.pp-tty + sexplib0 + unix + volgo + volgo-git-backend + volgo-git-unix) + (instrumentation + (backend bisect_ppx)) + (lint + (pps ppx_js_style -allow-let-operators -check-doc-comments)) + (preprocess + (pps -unused-code-warnings=force ppx_sexp_conv ppx_sexp_value))) diff --git a/lib/volgo_git_miou/src/import.ml b/lib/volgo_git_miou/src/import.ml new file mode 100644 index 00000000..10303866 --- /dev/null +++ b/lib/volgo_git_miou/src/import.ml @@ -0,0 +1,22 @@ +(*******************************************************************************) +(* Volgo - a Versatile OCaml Library for Git Operations *) +(* Copyright (C) 2024-2025 Mathieu Barbin *) +(* *) +(* This file is part of Volgo. *) +(* *) +(* Volgo is free software; you can redistribute it and/or modify it under *) +(* the terms of the GNU Lesser General Public License as published by the *) +(* Free Software Foundation either version 3 of the License, or any later *) +(* version, with the LGPL-3.0 Linking Exception. *) +(* *) +(* Volgo is distributed in the hope that it will be useful, but WITHOUT ANY *) +(* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(* FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(* the file `NOTICE.md` at the root of this repository for more details. *) +(* *) +(* You should have received a copy of the GNU Lesser General Public License *) +(* and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(* and , respectively. *) +(*******************************************************************************) + +include Vcs.Private.Import diff --git a/lib/volgo_git_miou/src/import.mli b/lib/volgo_git_miou/src/import.mli new file mode 100644 index 00000000..cd250adb --- /dev/null +++ b/lib/volgo_git_miou/src/import.mli @@ -0,0 +1,22 @@ +(*_******************************************************************************) +(*_ Volgo - a Versatile OCaml Library for Git Operations *) +(*_ Copyright (C) 2024-2025 Mathieu Barbin *) +(*_ *) +(*_ This file is part of Volgo. *) +(*_ *) +(*_ Volgo is free software; you can redistribute it and/or modify it under *) +(*_ the terms of the GNU Lesser General Public License as published by the *) +(*_ Free Software Foundation either version 3 of the License, or any later *) +(*_ version, with the LGPL-3.0 Linking Exception. *) +(*_ *) +(*_ Volgo is distributed in the hope that it will be useful, but WITHOUT ANY *) +(*_ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(*_ FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(*_ the file `NOTICE.md` at the root of this repository for more details. *) +(*_ *) +(*_ You should have received a copy of the GNU Lesser General Public License *) +(*_ and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(*_ and , respectively. *) +(*_******************************************************************************) + +include module type of Vcs.Private.Import diff --git a/lib/volgo_git_miou/src/runtime.ml b/lib/volgo_git_miou/src/runtime.ml new file mode 100644 index 00000000..8450699f --- /dev/null +++ b/lib/volgo_git_miou/src/runtime.ml @@ -0,0 +1,207 @@ +(*******************************************************************************) +(* Volgo - a Versatile OCaml Library for Git Operations *) +(* Copyright (C) 2024-2025 Mathieu Barbin *) +(* *) +(* This file is part of Volgo. *) +(* *) +(* Volgo is free software; you can redistribute it and/or modify it under *) +(* the terms of the GNU Lesser General Public License as published by the *) +(* Free Software Foundation either version 3 of the License, or any later *) +(* version, with the LGPL-3.0 Linking Exception. *) +(* *) +(* Volgo is distributed in the hope that it will be useful, but WITHOUT ANY *) +(* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(* FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(* the file `NOTICE.md` at the root of this repository for more details. *) +(* *) +(* You should have received a copy of the GNU Lesser General Public License *) +(* and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(* and , respectively. *) +(*******************************************************************************) + +(* + {[ + module Impl = Volgo_git_unix.Runtime + + type t = Impl.t + + let create () = Impl.create () + let load_file t ~path = Miou.call (fun () -> Impl.load_file t ~path) |> Miou.await_exn + + let save_file t ?perms () ~path ~file_contents = + Miou.call (fun () -> Impl.save_file t ?perms () ~path ~file_contents) + |> Miou.await_exn + ;; + + let read_dir t ~dir = Miou.call (fun () -> Impl.read_dir t ~dir) |> Miou.await_exn + + let git ?env t ~cwd ~args ~f = + Miou.call (fun () -> Impl.git ?env t ~cwd ~args ~f) |> Miou.await_exn + ;; + ]} +*) + +open! Import + +type t = unit + +let create () = () + +let load_file_internal () ~path = + Vcs.Private.try_with (fun () -> + In_channel.with_open_bin (Absolute_path.to_string path) In_channel.input_all + |> Vcs.File_contents.create) +;; + +let save_file_internal + (_ : t) + ?(perms = 0o666) + () + ~path + ~(file_contents : Vcs.File_contents.t) + = + Vcs.Private.try_with (fun () -> + let oc = + open_out_gen + [ Open_wronly; Open_creat; Open_trunc; Open_binary ] + perms + (Absolute_path.to_string path) + in + Fun.protect + ~finally:(fun () -> close_out_noerr oc) + (fun () -> Out_channel.output_string oc (file_contents :> string))) +;; + +let read_dir_internal () ~dir = + Vcs.Private.try_with (fun () -> + let entries = Sys.readdir (Absolute_path.to_string dir) in + Array.sort entries ~compare:String.compare; + entries |> Array.map ~f:Fsegment.v |> Array.to_list) +;; + +let with_cwd ~cwd ~f = + let old_cwd = Unix.getcwd () in + Fun.protect + ~finally:(fun () -> Unix.chdir old_cwd) + (fun () -> + Unix.chdir (Absolute_path.to_string cwd); + f ()) +;; + +module Exit_status = struct + [@@@coverage off] + + type t = + [ `Exited of int + | `Signaled of int + | `Stopped of int + | `Unknown + ] + [@@deriving sexp_of] +end + +module Lines = struct + type t = string list + + let sexp_of_t (t : t) = + match t with + | [] -> [%sexp ""] + | [ hd ] -> [%sexp (hd : string)] + | _ :: _ :: _ as lines -> [%sexp (lines : string list)] + ;; + + let create string : t = String.split_lines string +end + +exception Uncaught_user_exn of exn * Printexc.raw_backtrace + +let git_unix ?env (_ : t) ~cwd ~args ~f = + let prog = "git" in + let env = + match env with + | None -> Unix.environment () + | Some env -> env [@coverage off] + in + let exit_status_r : Exit_status.t ref = ref `Unknown in + let stdout_r = ref "" in + let stderr_r = ref "" in + try + let process_status, stdout, stderr = + with_cwd ~cwd ~f:(fun () -> + let ((stdout, _, stderr) as process_full) = + Unix.open_process_args_full prog (Array.of_list (prog :: args)) env + in + let stdout = In_channel.input_all stdout in + stdout_r := stdout; + let stderr = In_channel.input_all stderr in + stderr_r := stderr; + let process_status = Unix.close_process_full process_full in + process_status, stdout, stderr) + in + let exit_status = + match process_status with + | Unix.WEXITED n -> `Exited n + | Unix.WSIGNALED n -> `Signaled n [@coverage off] + | Unix.WSTOPPED n -> `Stopped n [@coverage off] + in + exit_status_r := exit_status; + let exit_code = + match exit_status with + | `Exited n -> n + | (`Signaled _ | `Stopped _) as exit_status -> + raise_notrace + (Err.E + (Err.create + [ Err.sexp + [%sexp + "git process terminated abnormally" + , { exit_status : [ `Signaled of int | `Stopped of int ] }] + ])) [@coverage off] + in + (* A note regarding the [raise_notrace] below. These cases are indeed + exercised in the test suite, however bisect_ppx inserts a coverage point + on the outer edge of the calls, defeating the coverage reports. Thus we + have to manually disable coverage. + + Illustrating what the inserted unvisitable coverage point looks like: + {[ + ___bisect_post_visit___ 36 (raise_notrace (Vcs.E err)) + ]} + *) + match f { Vcs.Git.Output.exit_code; stdout; stderr } with + | Ok _ as ok -> ok + | Error err -> raise_notrace (Err.E err) [@coverage off] + | exception exn -> + let bt = Printexc.get_raw_backtrace () in + (raise_notrace (Uncaught_user_exn (exn, bt)) [@coverage off]) + with + | Uncaught_user_exn (exn, bt) -> Printexc.raise_with_backtrace exn bt + | exn -> + let err = Err.of_exn exn in + Error + (Err.add_context + err + [ Err.sexp + [%sexp + { prog : string + ; args : string list + ; exit_status = (!exit_status_r : Exit_status.t) + ; cwd : Absolute_path.t + ; stdout = (Lines.create !stdout_r : Lines.t) + ; stderr = (Lines.create !stderr_r : Lines.t) + }] + ]) +;; + +let load_file t ~path = Miou.call (fun () -> load_file_internal t ~path) |> Miou.await_exn + +let save_file t ?perms () ~path ~file_contents = + Miou.call (fun () -> save_file_internal t ?perms () ~path ~file_contents) + |> Miou.await_exn +;; + +let read_dir t ~dir = Miou.call (fun () -> read_dir_internal t ~dir) |> Miou.await_exn + +let git ?env t ~cwd ~args ~f = + Miou.call (fun () -> git_unix ?env t ~cwd ~args ~f) |> Miou.await_exn +;; diff --git a/lib/volgo_git_miou/src/runtime.mli b/lib/volgo_git_miou/src/runtime.mli new file mode 100644 index 00000000..bbf0e10e --- /dev/null +++ b/lib/volgo_git_miou/src/runtime.mli @@ -0,0 +1,26 @@ +(*_******************************************************************************) +(*_ Volgo - a Versatile OCaml Library for Git Operations *) +(*_ Copyright (C) 2024-2025 Mathieu Barbin *) +(*_ *) +(*_ This file is part of Volgo. *) +(*_ *) +(*_ Volgo is free software; you can redistribute it and/or modify it under *) +(*_ the terms of the GNU Lesser General Public License as published by the *) +(*_ Free Software Foundation either version 3 of the License, or any later *) +(*_ version, with the LGPL-3.0 Linking Exception. *) +(*_ *) +(*_ Volgo is distributed in the hope that it will be useful, but WITHOUT ANY *) +(*_ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(*_ FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(*_ the file `NOTICE.md` at the root of this repository for more details. *) +(*_ *) +(*_ You should have received a copy of the GNU Lesser General Public License *) +(*_ and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(*_ and , respectively. *) +(*_******************************************************************************) + +type t + +include Volgo_git_backend.Runtime.S with type t := t + +val create : unit -> t diff --git a/lib/volgo_git_miou/src/volgo_git_miou.ml b/lib/volgo_git_miou/src/volgo_git_miou.ml new file mode 100644 index 00000000..e92ef451 --- /dev/null +++ b/lib/volgo_git_miou/src/volgo_git_miou.ml @@ -0,0 +1,32 @@ +(*******************************************************************************) +(* Volgo - a Versatile OCaml Library for Git Operations *) +(* Copyright (C) 2024-2025 Mathieu Barbin *) +(* *) +(* This file is part of Volgo. *) +(* *) +(* Volgo is free software; you can redistribute it and/or modify it under *) +(* the terms of the GNU Lesser General Public License as published by the *) +(* Free Software Foundation either version 3 of the License, or any later *) +(* version, with the LGPL-3.0 Linking Exception. *) +(* *) +(* Volgo is distributed in the hope that it will be useful, but WITHOUT ANY *) +(* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(* FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(* the file `NOTICE.md` at the root of this repository for more details. *) +(* *) +(* You should have received a copy of the GNU Lesser General Public License *) +(* and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(* and , respectively. *) +(*******************************************************************************) + +type t = Volgo_git_backend.Trait.t Vcs.t + +module Impl = struct + include Runtime + include Volgo_git_backend.Make (Runtime) +end + +let create_class () = new Impl.c (Impl.create ()) +let create () = Vcs.create (create_class ()) + +module Runtime = Runtime diff --git a/lib/volgo_git_miou/src/volgo_git_miou.mli b/lib/volgo_git_miou/src/volgo_git_miou.mli new file mode 100644 index 00000000..e8ead728 --- /dev/null +++ b/lib/volgo_git_miou/src/volgo_git_miou.mli @@ -0,0 +1,71 @@ +(*_******************************************************************************) +(*_ Volgo - a Versatile OCaml Library for Git Operations *) +(*_ Copyright (C) 2024-2025 Mathieu Barbin *) +(*_ *) +(*_ This file is part of Volgo. *) +(*_ *) +(*_ Volgo is free software; you can redistribute it and/or modify it under *) +(*_ the terms of the GNU Lesser General Public License as published by the *) +(*_ Free Software Foundation either version 3 of the License, or any later *) +(*_ version, with the LGPL-3.0 Linking Exception. *) +(*_ *) +(*_ Volgo is distributed in the hope that it will be useful, but WITHOUT ANY *) +(*_ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(*_ FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(*_ the file `NOTICE.md` at the root of this repository for more details. *) +(*_ *) +(*_ You should have received a copy of the GNU Lesser General Public License *) +(*_ and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(*_ and , respectively. *) +(*_******************************************************************************) + +(** Implementation of a git backend for the {!module:Volgo.Vcs} library, based + on [Miou], and {!module:Volgo_git_backend}. + + This implementation is based on the [git] command line tool. We run it as an + external program with utils from [Stdlib] and [Unix], producing the right + command line invocation and parsing the output to produce a typed version of + the expected results with [Volgo_git_backend]. Note that [git] must be found + in the PATH of the running environment. + + The current implementation runs blocking calls with [Miou.call], and then + awaits the result cooperatively from the calling domain with + [Miou.await_exn]. This only works if there are at least 1 extra domain + available. *) + +(** This is a convenient type alias that may be used to designate a backend + with the exact list of traits supported by this implementation. *) +type t = Volgo_git_backend.Trait.t Vcs.t + +val create : unit -> t + +(** The implementation of the provider is exported for convenience and tests. + Casual users should prefer using [Vcs] directly. *) +module Impl : sig + type t + + val create : unit -> t + + (** {1 Provider interfaces} *) + + module Add : Vcs.Trait.Add.S with type t = t + module Branch : Vcs.Trait.Branch.S with type t = t + module Commit : Vcs.Trait.Commit.S with type t = t + module Config : Vcs.Trait.Config.S with type t = t + module File_system : Vcs.Trait.File_system.S with type t = t + module Git : Vcs.Trait.Git.S with type t = t + module Init : Vcs.Trait.Init.S with type t = t + module Log : Vcs.Trait.Log.S with type t = t + module Ls_files : Vcs.Trait.Ls_files.S with type t = t + module Name_status : Vcs.Trait.Name_status.S with type t = t + module Num_status : Vcs.Trait.Num_status.S with type t = t + module Refs : Vcs.Trait.Refs.S with type t = t + module Rev_parse : Vcs.Trait.Rev_parse.S with type t = t + module Show : Vcs.Trait.Show.S with type t = t +end + +(** {1 Runtime} + + Exposed if you need to extend it. *) + +module Runtime = Runtime diff --git a/lib/volgo_git_miou/test/dune b/lib/volgo_git_miou/test/dune new file mode 100644 index 00000000..dd7e527d --- /dev/null +++ b/lib/volgo_git_miou/test/dune @@ -0,0 +1,47 @@ +(library + (name volgo_git_miou_test) + (public_name volgo-tests.volgo_git_miou_test) + (inline_tests) + (flags + :standard + -w + +a-4-40-41-42-44-45-48-66 + -warn-error + +a + -open + Base + -open + Fpath_sexp0 + -open + Expect_test_helpers_base + -open + Volgo) + (libraries + base + expect_test_helpers_core.expect_test_helpers_base + fpath + fpath-sexp0 + miou + miou.unix + pp + pplumbing.err + pplumbing.pp-tty + unix + vcs_test_helpers + volgo + volgo_git_miou) + (instrumentation + (backend bisect_ppx)) + (lint + (pps ppx_js_style -check-doc-comments)) + (preprocess + (pps + -unused-code-warnings=force + ppx_compare + ppx_enumerate + ppx_expect + ppx_hash + ppx_here + ppx_let + ppx_sexp_conv + ppx_sexp_value))) diff --git a/lib/volgo_git_miou/test/test__hello_commit.ml b/lib/volgo_git_miou/test/test__hello_commit.ml new file mode 100644 index 00000000..5de33275 --- /dev/null +++ b/lib/volgo_git_miou/test/test__hello_commit.ml @@ -0,0 +1,91 @@ +(*******************************************************************************) +(* Volgo - a Versatile OCaml Library for Git Operations *) +(* Copyright (C) 2024-2025 Mathieu Barbin *) +(* *) +(* This file is part of Volgo. *) +(* *) +(* Volgo is free software; you can redistribute it and/or modify it under *) +(* the terms of the GNU Lesser General Public License as published by the *) +(* Free Software Foundation either version 3 of the License, or any later *) +(* version, with the LGPL-3.0 Linking Exception. *) +(* *) +(* Volgo is distributed in the hope that it will be useful, but WITHOUT ANY *) +(* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(* FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(* the file `NOTICE.md` at the root of this repository for more details. *) +(* *) +(* You should have received a copy of the GNU Lesser General Public License *) +(* and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(* and , respectively. *) +(*******************************************************************************) + +(* This is a simple test to make sure we can initialize a repo and commit a + file, and verify the mock rev mapping. *) + +let%expect_test "hello commit" = + Miou_unix.run + @@ fun () -> + let vcs = Volgo_git_miou.create () in + let mock_revs = Vcs.Mock_revs.create () in + let repo_root = + let path = Stdlib.Filename.temp_dir ~temp_dir:(Unix.getcwd ()) "vcs" "test" in + Vcs_test_helpers.init vcs ~path:(Absolute_path.v path) + in + let hello_file = Vcs.Path_in_repo.v "hello.txt" in + Vcs.save_file + vcs + ~path:(Vcs.Repo_root.append repo_root hello_file) + ~file_contents:(Vcs.File_contents.create "Hello World!"); + print_s + [%sexp + (Vcs.load_file vcs ~path:(Vcs.Repo_root.append repo_root hello_file) + : Vcs.File_contents.t)]; + [%expect {| "Hello World!" |}]; + print_s + [%sexp + (Vcs.read_dir vcs ~dir:(Vcs.Repo_root.to_absolute_path repo_root) : Fsegment.t list)]; + [%expect {| (.git hello.txt) |}]; + Vcs.add vcs ~repo_root ~path:hello_file; + let rev = + Vcs.commit vcs ~repo_root ~commit_message:(Vcs.Commit_message.v "hello commit") + in + let mock_rev = Vcs.Mock_revs.to_mock mock_revs ~rev in + print_s [%sexp (mock_rev : Vcs.Rev.t)]; + [%expect {| 1185512b92d612b25613f2e5b473e5231185512b |}]; + (* Making sure the default branch name is deterministic. *) + Vcs.rename_current_branch vcs ~repo_root ~to_:Vcs.Branch_name.main; + print_s + [%sexp + (Vcs.Result.show_file_at_rev + vcs + ~repo_root + ~rev:(Vcs.Mock_revs.of_mock mock_revs ~mock_rev |> Option.value_exn ~here:[%here]) + ~path:hello_file + : [ `Present of Vcs.File_contents.t | `Absent ] Vcs.Result.t)]; + [%expect {| (Ok (Present "Hello World!")) |}]; + print_s + [%sexp + (Vcs.Result.show_file_at_rev vcs ~repo_root ~rev ~path:hello_file + : [ `Present of Vcs.File_contents.t | `Absent ] Vcs.Result.t)]; + [%expect {| (Ok (Present "Hello World!")) |}]; + (* Using [Vcs] from within cooperative [Miou.async] constructs. *) + let p1 = + Miou.async (fun () -> [%sexp (Vcs.current_branch vcs ~repo_root : Vcs.Branch_name.t)]) + in + let p2 = + Miou.async (fun () -> + [%sexp + (Vcs.ls_files vcs ~repo_root ~below:Vcs.Path_in_repo.root + : Vcs.Path_in_repo.t list)]) + in + Miou.await_all [ p1; p2 ] + |> List.iter ~f:(function + | Ok sexp -> print_s sexp + | Error exn -> raise exn [@coverage off]); + [%expect + {| + main + (hello.txt) + |}]; + () +;; diff --git a/lib/volgo_git_miou/test/test__hello_commit.mli b/lib/volgo_git_miou/test/test__hello_commit.mli new file mode 100644 index 00000000..db7d84c3 --- /dev/null +++ b/lib/volgo_git_miou/test/test__hello_commit.mli @@ -0,0 +1,20 @@ +(*_******************************************************************************) +(*_ Volgo - a Versatile OCaml Library for Git Operations *) +(*_ Copyright (C) 2024-2025 Mathieu Barbin *) +(*_ *) +(*_ This file is part of Volgo. *) +(*_ *) +(*_ Volgo is free software; you can redistribute it and/or modify it under *) +(*_ the terms of the GNU Lesser General Public License as published by the *) +(*_ Free Software Foundation either version 3 of the License, or any later *) +(*_ version, with the LGPL-3.0 Linking Exception. *) +(*_ *) +(*_ Volgo is distributed in the hope that it will be useful, but WITHOUT ANY *) +(*_ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(*_ FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(*_ the file `NOTICE.md` at the root of this repository for more details. *) +(*_ *) +(*_ You should have received a copy of the GNU Lesser General Public License *) +(*_ and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(*_ and , respectively. *) +(*_******************************************************************************) diff --git a/lib/volgo_git_miou/test/test__no_domain_available.ml b/lib/volgo_git_miou/test/test__no_domain_available.ml new file mode 100644 index 00000000..3aaf90fd --- /dev/null +++ b/lib/volgo_git_miou/test/test__no_domain_available.ml @@ -0,0 +1,68 @@ +(*******************************************************************************) +(* Volgo - a Versatile OCaml Library for Git Operations *) +(* Copyright (C) 2024-2025 Mathieu Barbin *) +(* *) +(* This file is part of Volgo. *) +(* *) +(* Volgo is free software; you can redistribute it and/or modify it under *) +(* the terms of the GNU Lesser General Public License as published by the *) +(* Free Software Foundation either version 3 of the License, or any later *) +(* version, with the LGPL-3.0 Linking Exception. *) +(* *) +(* Volgo is distributed in the hope that it will be useful, but WITHOUT ANY *) +(* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(* FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(* the file `NOTICE.md` at the root of this repository for more details. *) +(* *) +(* You should have received a copy of the GNU Lesser General Public License *) +(* and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(* and , respectively. *) +(*******************************************************************************) + +(* As explained in the documentation, [Vcs_git_miou] requires one extra domain + to run the blocking calls to git. In this test we monitor what happens if + there is no such domain available. *) + +let%expect_test "domains:0" = + Miou_unix.run ~domains:0 + @@ fun () -> + let vcs = Volgo_git_miou.create () in + require_does_raise [%here] (fun () -> + let path = Stdlib.Filename.temp_dir ~temp_dir:(Unix.getcwd ()) "vcs" "test" in + Vcs_test_helpers.init vcs ~path:(Absolute_path.v path)); + [%expect {| (Miou.No_domain_available) |}]; + () +;; + +(* In the next test, we look at a case where the call to git is itself run from + within a call to [Miou.call] when there is no other domain available. This + should be considered a programming error. *) + +let%expect_test "domains:1" = + Miou_unix.run ~domains:1 + @@ fun () -> + let vcs = Volgo_git_miou.create () in + let repo_root = + let path = Stdlib.Filename.temp_dir ~temp_dir:(Unix.getcwd ()) "vcs" "test" in + Vcs_test_helpers.init vcs ~path:(Absolute_path.v path) + in + let hello_file = Vcs.Path_in_repo.v "hello.txt" in + Vcs.save_file + vcs + ~path:(Vcs.Repo_root.append repo_root hello_file) + ~file_contents:(Vcs.File_contents.create "Hello World!"); + print_s + [%sexp + (Vcs.load_file vcs ~path:(Vcs.Repo_root.append repo_root hello_file) + : Vcs.File_contents.t)]; + [%expect {| "Hello World!" |}]; + require_does_raise [%here] (fun () -> + Miou.call (fun () -> + Vcs.save_file + vcs + ~path:(Vcs.Repo_root.append repo_root hello_file) + ~file_contents:(Vcs.File_contents.create "Hello World Again!")) + |> Miou.await_exn); + [%expect {| (Miou.No_domain_available) |}]; + () +;; diff --git a/lib/volgo_git_miou/test/test__no_domain_available.mli b/lib/volgo_git_miou/test/test__no_domain_available.mli new file mode 100644 index 00000000..db7d84c3 --- /dev/null +++ b/lib/volgo_git_miou/test/test__no_domain_available.mli @@ -0,0 +1,20 @@ +(*_******************************************************************************) +(*_ Volgo - a Versatile OCaml Library for Git Operations *) +(*_ Copyright (C) 2024-2025 Mathieu Barbin *) +(*_ *) +(*_ This file is part of Volgo. *) +(*_ *) +(*_ Volgo is free software; you can redistribute it and/or modify it under *) +(*_ the terms of the GNU Lesser General Public License as published by the *) +(*_ Free Software Foundation either version 3 of the License, or any later *) +(*_ version, with the LGPL-3.0 Linking Exception. *) +(*_ *) +(*_ Volgo is distributed in the hope that it will be useful, but WITHOUT ANY *) +(*_ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(*_ FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(*_ the file `NOTICE.md` at the root of this repository for more details. *) +(*_ *) +(*_ You should have received a copy of the GNU Lesser General Public License *) +(*_ and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(*_ and , respectively. *) +(*_******************************************************************************) diff --git a/lib/volgo_git_miou/test/test__no_run.ml b/lib/volgo_git_miou/test/test__no_run.ml new file mode 100644 index 00000000..19fef0fd --- /dev/null +++ b/lib/volgo_git_miou/test/test__no_run.ml @@ -0,0 +1,30 @@ +(*******************************************************************************) +(* Volgo - a Versatile OCaml Library for Git Operations *) +(* Copyright (C) 2024-2025 Mathieu Barbin *) +(* *) +(* This file is part of Volgo. *) +(* *) +(* Volgo is free software; you can redistribute it and/or modify it under *) +(* the terms of the GNU Lesser General Public License as published by the *) +(* Free Software Foundation either version 3 of the License, or any later *) +(* version, with the LGPL-3.0 Linking Exception. *) +(* *) +(* Volgo is distributed in the hope that it will be useful, but WITHOUT ANY *) +(* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(* FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(* the file `NOTICE.md` at the root of this repository for more details. *) +(* *) +(* You should have received a copy of the GNU Lesser General Public License *) +(* and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(* and , respectively. *) +(*******************************************************************************) + +(* The library must be used from without a call to [Miou_unix.run]. *) + +let%expect_test "hello commit" = + let vcs = Volgo_git_miou.create () in + require_does_raise [%here] (fun () -> + Vcs_test_helpers.init vcs ~path:(Absolute_path.v (Unix.getcwd ()))); + [%expect {| ("Stdlib.Effect.Unhandled(Miou.Domains)") |}]; + () +;; diff --git a/lib/volgo_git_miou/test/test__no_run.mli b/lib/volgo_git_miou/test/test__no_run.mli new file mode 100644 index 00000000..db7d84c3 --- /dev/null +++ b/lib/volgo_git_miou/test/test__no_run.mli @@ -0,0 +1,20 @@ +(*_******************************************************************************) +(*_ Volgo - a Versatile OCaml Library for Git Operations *) +(*_ Copyright (C) 2024-2025 Mathieu Barbin *) +(*_ *) +(*_ This file is part of Volgo. *) +(*_ *) +(*_ Volgo is free software; you can redistribute it and/or modify it under *) +(*_ the terms of the GNU Lesser General Public License as published by the *) +(*_ Free Software Foundation either version 3 of the License, or any later *) +(*_ version, with the LGPL-3.0 Linking Exception. *) +(*_ *) +(*_ Volgo is distributed in the hope that it will be useful, but WITHOUT ANY *) +(*_ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(*_ FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(*_ the file `NOTICE.md` at the root of this repository for more details. *) +(*_ *) +(*_ You should have received a copy of the GNU Lesser General Public License *) +(*_ and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(*_ and , respectively. *) +(*_******************************************************************************) diff --git a/volgo-dev.opam b/volgo-dev.opam index 2f2a4351..17570e93 100644 --- a/volgo-dev.opam +++ b/volgo-dev.opam @@ -25,6 +25,7 @@ depends: [ "fpath-base" {>= "0.2.2"} "fpath-sexp0" {>= "0.2.2"} "mdx" {>= "2.4"} + "miou" {>= "0.3.0"} "pp" {>= "2.0.0"} "pplumbing" {>= "0.0.13"} "ppx_compare" {>= "v0.17" & < "v0.18"} @@ -47,6 +48,7 @@ depends: [ "volgo-base" {= version} "volgo-git-backend" {= version} "volgo-git-eio" {= version} + "volgo-git-miou" {= version} "volgo-git-unix" {= version} "volgo-tests" {= version} "volgo-vcs" {= version} diff --git a/volgo-git-miou.opam b/volgo-git-miou.opam new file mode 100644 index 00000000..6ef5bb09 --- /dev/null +++ b/volgo-git-miou.opam @@ -0,0 +1,58 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: + "A Git provider for Vcs based on Volgo_git_backend for Miou programs" +maintainer: ["Mathieu Barbin "] +authors: ["Mathieu Barbin"] +license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" +homepage: "https://github.com/mbarbin/vcs" +doc: "https://mbarbin.github.io/vcs/" +bug-reports: "https://github.com/mbarbin/vcs/issues" +depends: [ + "dune" {>= "3.17"} + "ocaml" {>= "5.2"} + "miou" {>= "0.3.0"} + "fpath" {>= "0.7.3"} + "fpath-sexp0" {>= "0.2.2"} + "pp" {>= "2.0.0"} + "pplumbing" {>= "0.0.13"} + "ppx_sexp_conv" {>= "v0.17"} + "ppx_sexp_value" {>= "v0.17"} + "ppxlib" {>= "0.33"} + "sexplib0" {>= "v0.17"} + "volgo" {= version} + "volgo-git-backend" {= version} + "volgo-git-unix" {= version} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/mbarbin/vcs.git" +description: """\ + +[vcs] is a set of OCaml libraries for interacting with Git +repositories. It provides a type-safe and direct-style API to +programmatically perform Git operations, ranging from creating commits +and branches to loading and navigating commit graphs in memory, +computing diffs between revisions, and more. + +[Vcs_git_miou] implements a Git provider for [vcs] based on [miou]. It +runs the [git] CLI as a subprocess in a non-blocking fashion. + +[miou]: https://github.com/robur-coop/miou + +""" +tags: [ "miou" "git" "vcs" "non-blocking-io" ] +x-maintenance-intent: [ "(latest)" ] diff --git a/volgo-git-miou.opam.template b/volgo-git-miou.opam.template new file mode 100644 index 00000000..90b8599d --- /dev/null +++ b/volgo-git-miou.opam.template @@ -0,0 +1,16 @@ +description: """\ + +[vcs] is a set of OCaml libraries for interacting with Git +repositories. It provides a type-safe and direct-style API to +programmatically perform Git operations, ranging from creating commits +and branches to loading and navigating commit graphs in memory, +computing diffs between revisions, and more. + +[Vcs_git_miou] implements a Git provider for [vcs] based on [miou]. It +runs the [git] CLI as a subprocess in a non-blocking fashion. + +[miou]: https://github.com/robur-coop/miou + +""" +tags: [ "miou" "git" "vcs" "non-blocking-io" ] +x-maintenance-intent: [ "(latest)" ] diff --git a/volgo-tests.opam b/volgo-tests.opam index b7ca9807..7f2d13d6 100644 --- a/volgo-tests.opam +++ b/volgo-tests.opam @@ -24,6 +24,7 @@ depends: [ "fpath-base" {>= "0.2.2"} "fpath-sexp0" {>= "0.2.2"} "mdx" {with-doc & >= "2.4"} + "miou" {>= "0.3.0"} "pp" {>= "2.0.0"} "pplumbing" {>= "0.0.13"} "ppx_compare" {>= "v0.17" & < "v0.18"} @@ -46,6 +47,7 @@ depends: [ "volgo-base" {= version} "volgo-git-backend" {= version} "volgo-git-eio" {= version} + "volgo-git-miou" {= version} "volgo-git-unix" {= version} "volgo-vcs" {= version} "sherlodoc" {with-doc & >= "0.2"}