Experimental Miou Backend

dune-project

@@ -235,6 +235,42 @@
   (vcs-git-provider
    (= :version))))
 
+(package
+ (name vcs-git-miou)
+ (synopsis
+  "A Git provider for Vcs based on Vcs_git_provider for Miou programs")
+ (depends
+  (ocaml
+   (>= 5.2))
+  (miou
+   (>= 0.3.0))
+  (fpath
+   (>= 0.7.3))
+  (fpath-sexp0
+   (>= 0.2.2))
+  (ppx_sexp_conv
+   (and
+    (>= v0.17)
+    (< v0.18)))
+  (ppx_sexp_value
+   (and
+    (>= v0.17)
+    (< v0.18)))
+  (ppxlib
+   (>= 0.33))
+  (provider
+   (>= 0.0.11))
+  (sexplib0
+   (and
+    (>= v0.17)
+    (< v0.18)))
+  (vcs
+   (= :version))
+  (vcs-git-blocking
+   (= :version))
+  (vcs-git-provider
+   (= :version))))
+
 (package
  (name vcs-tests)
  (synopsis "Tests & Examples for [Vcs]")
@@ -289,6 +325,8 @@
    (and
     :with-doc
     (>= 2.4)))
+  (miou
+   (>= 0.3.0))
   (pp-log
    (>= 0.0.8))
   (ppx_compare
@@ -356,6 +394,8 @@
    (= :version))
   (vcs-git-eio
    (= :version))
+  (vcs-git-miou
+   (= :version))
   (vcs-git-provider
    (= :version))
   (vcs-test-helpers

headache.sh

@@ -13,6 +13,8 @@ dirs=(
     "lib/vcs_git_blocking/test"
     "lib/vcs_git_eio/src"
     "lib/vcs_git_eio/test"
+    "lib/vcs_git_miou/src"
+    "lib/vcs_git_miou/test"
     "lib/vcs_git_provider/src"
     "lib/vcs_git_provider/test"
     "lib/vcs_test_helpers/src"

lib/vcs_git_miou/src/dune

@@ -0,0 +1,30 @@
+(library
+ (name vcs_git_miou)
+ (public_name vcs-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)
+ (libraries
+  fpath
+  fpath-sexp0
+  miou
+  provider
+  sexplib0
+  vcs
+  vcs-git-blocking
+  vcs-git-provider)
+ (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)))

lib/vcs_git_miou/src/runtime.ml

@@ -0,0 +1,37 @@
+(*******************************************************************************)
+(*  Vcs - a Versatile OCaml Library for Git Operations                         *)
+(*  Copyright (C) 2024 Mathieu Barbin <mathieu.barbin@gmail.com>               *)
+(*                                                                             *)
+(*  This file is part of Vcs.                                                  *)
+(*                                                                             *)
+(*  Vcs 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.                              *)
+(*                                                                             *)
+(*  Vcs 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    *)
+(*  <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.       *)
+(*******************************************************************************)
+
+module Impl = Vcs_git_blocking.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 ?perms t ~path ~file_contents =
+  Miou.call (fun () -> Impl.save_file ?perms t ~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
+;;

lib/vcs_git_miou/src/runtime.mli

@@ -0,0 +1,26 @@
+(*_******************************************************************************)
+(*_  Vcs - a Versatile OCaml Library for Git Operations                         *)
+(*_  Copyright (C) 2024 Mathieu Barbin <mathieu.barbin@gmail.com>               *)
+(*_                                                                             *)
+(*_  This file is part of Vcs.                                                  *)
+(*_                                                                             *)
+(*_  Vcs 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.                              *)
+(*_                                                                             *)
+(*_  Vcs 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    *)
+(*_  <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.       *)
+(*_******************************************************************************)
+
+type t
+
+include Vcs_git_provider.Runtime.S with type t := t
+
+val create : unit -> t

lib/vcs_git_miou/src/vcs_git_miou.ml

@@ -0,0 +1,34 @@
+(*******************************************************************************)
+(*  Vcs - a Versatile OCaml Library for Git Operations                         *)
+(*  Copyright (C) 2024 Mathieu Barbin <mathieu.barbin@gmail.com>               *)
+(*                                                                             *)
+(*  This file is part of Vcs.                                                  *)
+(*                                                                             *)
+(*  Vcs 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.                              *)
+(*                                                                             *)
+(*  Vcs 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    *)
+(*  <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.       *)
+(*******************************************************************************)
+
+type 'a t = ([> Vcs_git_provider.Trait.t ] as 'a) Vcs.t
+type t' = Vcs_git_provider.Trait.t t
+
+module Impl = struct
+  include Runtime
+  include Vcs_git_provider.Make (Runtime)
+end
+
+let create () =
+  Vcs.create (Provider.T { t = Impl.create (); provider = Impl.provider () })
+;;
+
+module Runtime = Runtime

lib/vcs_git_miou/src/vcs_git_miou.mli

@@ -0,0 +1,73 @@
+(*_******************************************************************************)
+(*_  Vcs - a Versatile OCaml Library for Git Operations                         *)
+(*_  Copyright (C) 2024 Mathieu Barbin <mathieu.barbin@gmail.com>               *)
+(*_                                                                             *)
+(*_  This file is part of Vcs.                                                  *)
+(*_                                                                             *)
+(*_  Vcs 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.                              *)
+(*_                                                                             *)
+(*_  Vcs 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    *)
+(*_  <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.       *)
+(*_******************************************************************************)
+
+(** Implementation of a git provider for the {!module:Vcs} library, based on
+    [Miou], and {!module:Vcs_git_provider}.
+
+    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 [Vcs_git_provider]. 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. *)
+
+type 'a t = ([> Vcs_git_provider.Trait.t ] as 'a) Vcs.t
+
+(** This is a convenient type alias that may be used to designate a provider
+    with the exact list of traits supported by this implementation. *)
+type t' = Vcs_git_provider.Trait.t 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

lib/vcs_git_miou/test/dune

@@ -0,0 +1,42 @@
+(library
+ (name vcs_git_miou_test)
+ (public_name vcs-tests.vcs_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)
+ (libraries
+  base
+  miou
+  miou.unix
+  expect_test_helpers_core.expect_test_helpers_base
+  fpath
+  fpath-sexp0
+  unix
+  vcs
+  vcs_git_miou
+  vcs_test_helpers)
+ (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)))