irmin-unix: extract irmin-graphql.unix

irmin-graphql.opam

@@ -14,20 +14,21 @@ build: [
 ]
 
 depends: [
-  "ocaml"          {>= "4.03.0"}
-  "dune"           {>= "2.9.0"}
-  "irmin"          {= version}
-  "graphql"        {>= "0.13.0"}
-  "graphql-lwt"    {>= "0.13.0"}
-  "graphql-cohttp" {>= "0.13.0"}
-  "graphql_parser" {>= "0.13.0"}
-  "cohttp-lwt"
+  "ocaml"           {>= "4.03.0"}
+  "dune"            {>= "2.9.0"}
+  "irmin"           {= version}
+  "graphql"         {>= "0.13.0"}
+  "graphql-lwt"     {>= "0.13.0"}
+  "graphql-cohttp"  {>= "0.13.0"}
+  "graphql_parser"  {>= "0.13.0"}
   "cohttp"
+  "cohttp-lwt"
+  "cohttp-lwt-unix"
+  "git-unix"        {>= "3.7.0"}
   "fmt"
-  "lwt"            {>= "5.3.0"}
+  "lwt"             {>= "5.3.0"}
   "alcotest-lwt"    {with-test & >= "1.1.0"}
   "yojson"          {with-test}
-  "cohttp-lwt-unix" {with-test}
   "alcotest"        {with-test & >= "1.2.3"}
   "logs"            {with-test}
 ]

src/irmin-graphql/unix/dune

@@ -0,0 +1,8 @@
+(library
+ (public_name irmin-graphql.unix)
+ (name irmin_graphql_unix)
+ (libraries cohttp-lwt-unix irmin-graphql git-unix lwt.unix)
+ (preprocess
+  (pps ppx_irmin.internal))
+ (instrumentation
+  (backend bisect_ppx)))

src/irmin-graphql/unix/info.ml

@@ -0,0 +1,34 @@
+(*
+ * Copyright (c) 2013-2021 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+module Make (I : Irmin.Info.S) = struct
+  include I
+
+  let v ?author fmt =
+    Fmt.kstr
+      (fun message () ->
+        let date = Int64.of_float (Unix.gettimeofday ()) in
+        let author =
+          match author with
+          | Some a -> a
+          | None ->
+              (* XXX: get "git config user.name" *)
+              Printf.sprintf "Irmin %s.[%d]" (Unix.gethostname ())
+                (Unix.getpid ())
+        in
+        v ~author ~message date)
+      fmt
+end

src/irmin-graphql/unix/info.mli

@@ -0,0 +1,21 @@
+(*
+ * Copyright (c) 2013-2021 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+module Make (I : Irmin.Info.S) : sig
+  include Irmin.Info.S with type t = I.t
+
+  val v : ?author:string -> ('b, Format.formatter, unit, f) format4 -> 'b
+end

src/irmin-unix/graphql.ml → src/irmin-graphql/unix/irmin_graphql_unix.ml

@@ -14,6 +14,9 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
+type remote_fn =
+  ?ctx:Mimic.ctx -> ?headers:Cohttp.Header.t -> string -> Irmin.remote Lwt.t
+
 module Server = struct
   module Remote = struct
     module None = struct
@@ -23,7 +26,7 @@ module Server = struct
 
   module Make_ext
       (S : Irmin.Generic_key.S) (Remote : sig
-        val remote : Resolver.Store.remote_fn option
+        val remote : remote_fn option
       end)
       (T : Irmin_graphql.Server.CUSTOM_TYPES
              with type path := S.path
@@ -53,7 +56,7 @@ module Server = struct
 
   module Make
       (S : Irmin.Generic_key.S) (Remote : sig
-        val remote : Resolver.Store.remote_fn option
+        val remote : remote_fn option
       end) =
     Irmin_graphql.Server.Make
       (Cohttp_lwt_unix.Server)

src/irmin-unix/graphql.mli → src/irmin-graphql/unix/irmin_graphql_unix.mli

@@ -14,24 +14,27 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
+type remote_fn =
+  ?ctx:Mimic.ctx -> ?headers:Cohttp.Header.t -> string -> Irmin.remote Lwt.t
+
 module Server : sig
   module Remote : sig
     module None : sig
-      val remote : Resolver.Store.remote_fn option
+      val remote : remote_fn option
     end
   end
 
   module Make
       (S : Irmin.Generic_key.S) (Remote : sig
-        val remote : Resolver.Store.remote_fn option
+        val remote : remote_fn option
       end) :
     Irmin_graphql.Server.S
       with type repo = S.repo
        and type server = Cohttp_lwt_unix.Server.t
 
   module Make_ext
       (S : Irmin.Generic_key.S) (Remote : sig
-        val remote : Resolver.Store.remote_fn option
+        val remote : remote_fn option
       end)
       (T : Irmin_graphql.Server.CUSTOM_TYPES
              with type path := S.path

src/irmin-unix/cli.ml

@@ -18,6 +18,7 @@ open! Import
 open Cmdliner
 open Resolver
 module Http = Irmin_http_unix
+module Graphql = Irmin_graphql_unix
 
 let deprecated_info = (Term.info [@alert "-deprecated"])
 let deprecated_man_format = (Term.man_format [@alert "-deprecated"])

src/irmin-unix/dune

@@ -18,7 +18,7 @@
   irmin
   irmin-git.unix
   irmin-fs.unix
-  irmin-graphql
+  irmin-graphql.unix
   irmin-http.unix
   irmin.mem
   irmin-pack

src/irmin-unix/irmin_unix.ml

@@ -23,7 +23,7 @@ let info = I.v
 module Info = Info.Make
 module Git = Irmin_git_unix
 module Http = Irmin_http_unix
-module Graphql = Graphql
+module Graphql = Irmin_graphql_unix
 module FS = Irmin_fs_unix
 module Cli = Cli
 module Resolver = Resolver

src/irmin-unix/irmin_unix.mli

@@ -55,6 +55,6 @@ val set_listen_dir_hook : unit -> unit
 (** Install {!Irmin_watcher.hook} as the listen hook for watching changes in
     directories. *)
 
-module Graphql = Graphql
+module Graphql : module type of Irmin_graphql_unix
 module Cli = Cli
 module Resolver = Resolver

test/irmin-graphql/common.ml

@@ -31,17 +31,11 @@ let ctx =
   Cohttp_lwt_unix.Client.custom_ctx ~resolver ()
 
 module Server =
-  Irmin_graphql.Server.Make
-    (Cohttp_lwt_unix.Server)
+  Irmin_graphql_unix.Server.Make
+    (Store)
     (struct
       let remote = None
-
-      type info = Store.info
-
-      let info ?(author = "graphql-test-author") =
-        Format.kasprintf (fun message () -> Store.Info.v ~author ~message 0L)
     end)
-    (Store)
 
 let mkdir d =
   Lwt.catch

test/irmin-graphql/dune

@@ -6,7 +6,7 @@
   alcotest-lwt
   yojson
   irmin
-  irmin-graphql
+  irmin-graphql.unix
   irmin.mem
   cohttp-lwt-unix
   logs.fmt