Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Port to latest ocaml-git and clean-up handling of remote stores #545

Merged
merged 2 commits into from
Sep 24, 2018
Merged

Port to latest ocaml-git and clean-up handling of remote stores #545

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
5a4ea1e
Port to latest ocaml-git and clean-up handling of remote stores
samoht Sep 19, 2018
5fe0dc4
irmin-http: limit the number of concurrent connection in the test server
samoht Sep 24, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
140 changes: 81 additions & 59 deletions src/irmin-git/irmin_git.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -560,29 +560,32 @@ module Irmin_branch_store
end

module Irmin_sync_store
(Net: Git.Sync.NET)
(G : Git.S)
(B : Irmin.Branch.S) =
(G: Git.S)
(S: Git.Sync.S with module Store := G)
(B: Irmin.Branch.S) =
struct

(* FIXME: should not need to pass G.Digest and G.Inflate... *)
module Sync = Git.Sync.Make(Net)(G)
module H = Irmin.Hash.Make(G.Hash)

type t = G.t
type commit = H.t
type branch = B.t

type endpoint = S.Endpoint.t

type Irmin.remote += E of endpoint
let remote e = E e

let git_of_branch_str str = G.Reference.of_string ("refs/heads/" ^ str)
let git_of_branch r = git_of_branch_str (Fmt.to_to_string B.pp r)

let o_head_of_git = function
| None -> Error `No_head
| Some k -> Ok k

let fetch t ?depth ~uri br =
Log.debug (fun f -> f "fetch %s" uri);
let uri = Uri.of_string uri in
let fetch t ?depth e br =
let uri = S.Endpoint.uri e in
Log.debug (fun f -> f "fetch %a" Uri.pp_hum uri);
let _deepen = depth in (* FIXME: need to be exposed in the Git API *)
let reference = git_of_branch br in
let result refs =
Expand All @@ -601,16 +604,16 @@ struct
[ G.Reference.of_string ("refs/remotes/origin/" ^ (Fmt.to_to_string B.pp br));
reference ]
in
Sync.fetch_one t uri ~reference:references >|= function
| Error e -> Fmt.kstrf (fun e -> Error (`Msg e)) "%a" Sync.pp_error e
S.fetch_one t e ~reference:references >|= function
| Error e -> Fmt.kstrf (fun e -> Error (`Msg e)) "%a" S.pp_error e
| Ok (`Sync refs) -> result refs
| Ok `AlreadySync ->
(* FIXME: we want to get the hash *)
Error (`Msg "XXX")

let push t ?depth:_ ~uri br =
Log.debug (fun f -> f "push %s" uri);
let uri = Uri.of_string uri in
let push t ?depth:_ e br =
let uri = S.Endpoint.uri e in
Log.debug (fun f -> f "push %a" Uri.pp_hum uri);
let reference = git_of_branch br in
let result refs =
(* FIXME: needs pp_push *)
Expand All @@ -629,11 +632,10 @@ struct
(* local *) reference
(* remote *) [reference ]
in
Sync.update_and_create t ~references uri >|= function
| Error e -> Fmt.kstrf (fun e -> Error (`Msg e)) "%a" Sync.pp_error e
S.update_and_create t ~references e >|= function
| Error e -> Fmt.kstrf (fun e -> Error (`Msg e)) "%a" S.pp_error e
| Ok r -> result r


end

type reference = [
Expand Down Expand Up @@ -716,11 +718,11 @@ module type G = sig
end

module Make_ext
(Net: Git.Sync.NET)
(G : G)
(C : Irmin.Contents.S)
(P : Irmin.Path.S)
(B : BRANCH)
(G: G)
(S: Git.Sync.S with module Store := G)
(C: Irmin.Contents.S)
(P: Irmin.Path.S)
(B: BRANCH)
= struct

module R = Irmin_branch_store(G)(B)
Expand All @@ -734,7 +736,7 @@ module Make_ext

module P = struct
module XSync = struct
include Irmin_sync_store(Net)(G)(R.Key)
include Irmin_sync_store(G)(S)(R.Key)
let v repo = Lwt.return repo.g
end
include Make_private(G)(C)(P)
Expand Down Expand Up @@ -807,9 +809,9 @@ module Make_ext

end

module Mem (H: Digestif.S) = struct
module Mem = struct

include Git.Mem.Make(H)(Git.Inflate)(Git.Deflate)
include Git.Mem.Store

let confs = Hashtbl.create 10 (* XXX: should probably be a weak table *)

Expand All @@ -836,26 +838,15 @@ module Mem (H: Digestif.S) = struct
end

module Make
(Net: Git.Sync.NET)
(S : G)
(G : G)
(S : Git.Sync.S with module Store := G)
(C : Irmin.Contents.S)
(P : Irmin.Path.S)
(B : Irmin.Branch.S)
=
Make_ext (Net)(S)(C)(P)(Branch(B))

module NoNet = struct
type socket = unit
type error = unit
let pp_error _ _ = assert false
let read () _ _ = assert false
let write () _ _ _ = assert false
let socket _ = Lwt.return ()
let close _ = Lwt.return ()
end
Make_ext (G)(S)(C)(P)(Branch(B))

module AO (G: Git.S) (V: Irmin.Contents.Conv)
= struct
module AO (G: Git.S) (V: Irmin.Contents.Conv) = struct
module G = struct
include G
let v ?dotgit:_ ?compression:_ ?buffers:_ _root =
Expand All @@ -865,7 +856,32 @@ module AO (G: Git.S) (V: Irmin.Contents.Conv)
include V
let merge = Irmin.Merge.default Irmin.Type.(option V.t)
end
module M = Make_ext (NoNet)(G)(V)(Irmin.Path.String_list)(Reference)
module NoSync = struct
(* XXX(samoht): so much boilerplate... *)
module Store = G
module Endpoint = struct
type t = unit
let uri _ = assert false
end
type error = unit
let pp_error _ _ = assert false

type command =
[ `Create of Store.Hash.t * Store.Reference.t
| `Delete of Store.Hash.t * Store.Reference.t
| `Update of Store.Hash.t * Store.Hash.t * Store.Reference.t ]

let pp_command _ _ = assert false
let push _ = assert false
let ls _ = assert false
let fetch _ = assert false
let fetch_one _ = assert false
let fetch_some _ = assert false
let fetch_all _ = assert false
let clone _ = assert false
let update_and_create _ = assert false
end
module M = Make_ext (G)(NoSync)(V)(Irmin.Path.String_list)(Reference)
module X = M.Private.Contents
let state t =
M.repo_of_git t >|= fun r ->
Expand All @@ -892,45 +908,51 @@ struct
end

module KV
(Net: Git.Sync.NET)
(S : G)
(C : Irmin.Contents.S)
= Make (Net)(S)(C)(Irmin.Path.String_list)(Irmin.Branch.String)
(G: G)
(S: Git.Sync.S with module Store := G)
(C: Irmin.Contents.S)
= Make (G)(S)(C)(Irmin.Path.String_list)(Irmin.Branch.String)

module Ref
(Net: Git.Sync.NET)
(S : G)
(C : Irmin.Contents.S)
= Make_ext (Net)(S)(C)(Irmin.Path.String_list)(Reference)
(G: G)
(S: Git.Sync.S with module Store := G)
(C: Irmin.Contents.S)
= Make_ext (G)(S)(C)(Irmin.Path.String_list)(Reference)

module type S_MAKER =
functor (G: G) ->
functor (C: Irmin.Contents.S) ->
functor (P: Irmin.Path.S) ->
functor (B: Irmin.Branch.S) ->
module type S_MAKER = functor
(G: G)
(S: Git.Sync.S with module Store := G)
(C: Irmin.Contents.S)
(P: Irmin.Path.S)
(B: Irmin.Branch.S) ->
S with type key = P.t
and type step = P.step
and module Key = P
and type contents = C.t
and type branch = B.t
and module Git = G
and type endpoint = S.Endpoint.t

module type KV_MAKER =
functor (G: G) ->
functor (C: Irmin.Contents.S) ->
module type KV_MAKER = functor
(G: G)
(S: Git.Sync.S with module Store := G)
(C: Irmin.Contents.S) ->
S with type key = string list
and type step = string
and type contents = C.t
and type branch = string
and module Git = G
and type endpoint = S.Endpoint.t

module type REF_MAKER =
functor (G: G) ->
functor (C: Irmin.Contents.S) ->
module type REF_MAKER = functor
(G: G)
(S: Git.Sync.S with module Store := G)
(C: Irmin.Contents.S) ->
S with type key = string list
and type step = string
and type contents = C.t
and type branch = reference
and module Git = G
and type endpoint = S.Endpoint.t

include Conf
80 changes: 43 additions & 37 deletions src/irmin-git/irmin_git.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,7 @@ module type G = sig
Fpath.t -> (t, error) result Lwt.t
end

module Mem (H: Digestif.S): G
module Mem: G
(** In-memory Git store. *)

module type S = sig
Expand Down Expand Up @@ -82,26 +82,30 @@ module type S = sig

end

module type S_MAKER =
functor (G: G) ->
functor (C: Irmin.Contents.S) ->
functor (P: Irmin.Path.S) ->
functor (B: Irmin.Branch.S) ->
S with type key = P.t
and type step = P.step
and module Key = P
and type contents = C.t
and type branch = B.t
and module Git = G

module type KV_MAKER =
functor (G: G) ->
functor (C: Irmin.Contents.S) ->
S with type key = string list
and type step = string
and type contents = C.t
and type branch = string
and module Git = G
module type S_MAKER = functor
(G: G)
(S: Git.Sync.S with module Store := G)
(C: Irmin.Contents.S)
(P: Irmin.Path.S)
(B: Irmin.Branch.S) ->
S with type key = P.t
and type step = P.step
and module Key = P
and type contents = C.t
and type branch = B.t
and module Git = G
and type endpoint = S.Endpoint.t

module type KV_MAKER = functor
(G: G)
(S: Git.Sync.S with module Store := G)
(C: Irmin.Contents.S) ->
S with type key = string list
and type step = string
and type contents = C.t
and type branch = string
and module Git = G
and type endpoint = S.Endpoint.t

type reference = [
| `Branch of string
Expand All @@ -110,18 +114,20 @@ type reference = [
| `Other of string
]

module type REF_MAKER =
functor (G: G) ->
functor (C: Irmin.Contents.S) ->
S with type key = string list
and type step = string
and type contents = C.t
and type branch = reference
and module Git = G
module type REF_MAKER = functor
(G: G)
(S: Git.Sync.S with module Store := G)
(C: Irmin.Contents.S) ->
S with type key = string list
and type step = string
and type contents = C.t
and type branch = reference
and module Git = G
and type endpoint = S.Endpoint.t

module Make (Net: Git.Sync.NET) : S_MAKER
module Ref (Net: Git.Sync.NET): REF_MAKER
module KV (Net: Git.Sync.NET): KV_MAKER
module Make: S_MAKER
module Ref : REF_MAKER
module KV : KV_MAKER

module type BRANCH = sig
include Irmin.Branch.S
Expand All @@ -134,11 +140,11 @@ module Branch (B: Irmin.Branch.S): BRANCH
module Reference: BRANCH with type t = reference

module Make_ext
(Net: Git.Sync.NET)
(S : G)
(C : Irmin.Contents.S)
(P : Irmin.Path.S)
(B : BRANCH):
(G: G)
(S: Git.Sync.S with module Store := G)
(C: Irmin.Contents.S)
(P: Irmin.Path.S)
(B: BRANCH):
S with type key = P.t
and type step = P.step
and module Key = P
Expand Down
Loading