From fa7946e36c97cd2ab3d39bc089921b47b2b3885c Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Tue, 9 May 2017 12:30:59 +0200 Subject: [PATCH] client: create a Datakit_client namespace Rename Datakit_path into Datakit_client.Path and Datakit_S into Datakit_client.S Signed-off-by: Thomas Gazagnaire --- Makefile | 2 +- api/ocaml/9p/datakit_client_9p.ml | 33 ++-- api/ocaml/9p/datakit_client_9p.mli | 3 +- api/ocaml/datakit_client.ml | 186 ++++++++++++++++++ .../{datakit_S.ml => datakit_client.mli} | 115 ++++++++--- api/ocaml/datakit_path.ml | 72 ------- api/ocaml/datakit_path.mli | 62 ------ bridge/github/datakit_github_sync.ml | 14 +- bridge/github/datakit_github_sync.mli | 2 +- bridge/local/sync.ml | 2 +- bridge/local/sync.mli | 2 +- ci/src/cI_cache.ml | 2 +- ci/src/cI_cache.mli | 4 +- ci/src/cI_history.ml | 19 +- ci/src/cI_target.ml | 7 +- ci/src/cI_term.ml | 4 +- ci/src/cI_utils.mli | 2 +- ci/src/datakit_ci.mli | 4 +- ci/tests/test_ci.ml | 8 +- ci/tests/test_utils.ml | 13 +- src/datakit-github/datakit_github_conv.ml | 72 +++---- src/datakit-github/datakit_github_conv.mli | 2 +- src/datakit-io/jbuild | 2 +- tests/common/test_client.ml | 29 +-- tests/common/test_client.mli | 2 +- tests/common/test_utils.ml | 6 +- tests/datakit-bridge-github/test.ml | 29 +-- 27 files changed, 412 insertions(+), 286 deletions(-) create mode 100644 api/ocaml/datakit_client.ml rename api/ocaml/{datakit_S.ml => datakit_client.mli} (76%) delete mode 100644 api/ocaml/datakit_path.ml delete mode 100644 api/ocaml/datakit_path.mli diff --git a/Makefile b/Makefile index d3bc95209..39283758b 100644 --- a/Makefile +++ b/Makefile @@ -56,7 +56,7 @@ clean: rm -f com.docker.db test: - jbuilder runtest + jbuilder runtest --dev bundle: opam remove tls ssl -y diff --git a/api/ocaml/9p/datakit_client_9p.ml b/api/ocaml/9p/datakit_client_9p.ml index 33f7d2184..8bbace9dc 100644 --- a/api/ocaml/9p/datakit_client_9p.ml +++ b/api/ocaml/9p/datakit_client_9p.ml @@ -1,6 +1,7 @@ open Result open Astring open Lwt.Infix +open Datakit_client let src = Logs.Src.create "datakit.client" ~doc:"DataKit client bindings" module Log = (val Logs.src_log src: Logs.LOG) @@ -22,7 +23,7 @@ let symlink = ~owner:rwx ~group:rx ~other:rx ~is_symlink:true () let ( / ) dir leaf = dir @ [leaf] -let ( /@ ) dir user_path = dir @ Datakit_path.unwrap user_path +let ( /@ ) dir user_path = dir @ Path.unwrap user_path let pp_path = Fmt.Dump.list String.dump let rec last = function @@ -157,7 +158,7 @@ module Make(P9p : Protocol_9p.Client.S) = struct match String.cut ~sep:" " line with | None -> err "missing space" | Some (op, path) -> - match Datakit_path.of_string path with + match Path.of_string path with | Error e -> err e | Ok path -> match op with | "+" -> (`Added path ) :: acc @@ -343,7 +344,7 @@ module Make(P9p : Protocol_9p.Client.S) = struct else if List.mem `Execute mode.FileMode.owner then `Exec else `File in ok (Some { - Datakit_S.kind; + kind; size = info.Stat.length; }) @@ -354,12 +355,12 @@ module Make(P9p : Protocol_9p.Client.S) = struct let exists_dir t path = stat t path >|*= function - | Some { Datakit_S.kind = `Dir; _ } -> true + | Some { kind = `Dir; _ } -> true | _ -> false let exists_file t path = stat t path >|*= function - | None | Some { Datakit_S.kind = `Dir; _ } -> false + | None | Some { kind = `Dir; _ } -> false | _ -> true let set_executable t path exec = @@ -418,7 +419,7 @@ module Make(P9p : Protocol_9p.Client.S) = struct (* Ensure that [base @ path] exists (assuming that [base] already exists). *) let make_dirs t ~base path = - let path = Datakit_path.unwrap path in + let path = Path.unwrap path in let rec aux user_path = Log.debug (fun f -> f "make_dirs.aux(%a)" (Fmt.Dump.list String.dump) user_path); match rdecons user_path with @@ -447,20 +448,20 @@ module Make(P9p : Protocol_9p.Client.S) = struct module Tree = struct type value = [ `Dir of string list | `File of Cstruct.t | `Link of string ] - type 'a cache = ('a, error) Result.result Datakit_path.Map.t ref + type 'a cache = ('a, error) Result.result Path.Map.t ref type t = { fs : FS.t; path : string list; reads: value cache; - stats: Datakit_S.stat option cache; + stats: stat option cache; } let find_cache c p = - try Some (Datakit_path.Map.find p !c) with Not_found -> None + try Some (Path.Map.find p !c) with Not_found -> None - let empty () = ref Datakit_path.Map.empty - let add_cache c p v = c := Datakit_path.Map.add p v !c + let empty () = ref Path.Map.empty + let add_cache c p v = c := Path.Map.add p v !c let v fs path = { fs; reads = empty () ; stats = empty (); path } let of_id fs id = v fs ["trees"; id] @@ -491,14 +492,14 @@ module Make(P9p : Protocol_9p.Client.S) = struct let exists_dir t path = stat t path >|= function - | Ok (Some { Datakit_S.kind = `Dir; _ }) -> Ok true + | Ok (Some { kind = `Dir; _ }) -> Ok true | Ok Some _ -> Ok false | Ok None -> Ok false | Error _ as e -> e let exists_file t path = stat t path >|= function - | Ok (Some { Datakit_S.kind = `File; _ }) -> Ok true + | Ok (Some { kind = `File; _ }) -> Ok true | Ok Some _ -> Ok false | Ok None -> Ok false | Error _ as e -> e @@ -568,7 +569,7 @@ module Make(P9p : Protocol_9p.Client.S) = struct t.path / "rw" /@ path let split_for_create path = - match Datakit_path.pop path with + match Path.pop path with | Some x -> x | None -> raise (Invalid_argument "Can't create '/'!") @@ -616,7 +617,7 @@ module Make(P9p : Protocol_9p.Client.S) = struct let rec aux = function | [] -> Ok [] | x :: xs -> - match Datakit_path.of_string x with + match Path.of_string x with | Error e -> Error (`Internal (Fmt.strf "Invalid path in conflicts: %s" e)) | Ok path -> match aux xs with @@ -737,7 +738,7 @@ module Make(P9p : Protocol_9p.Client.S) = struct (fun hash -> fn (commit_of_hash t hash)) let wait_for_path t ?switch path fn = - let path = Datakit_path.unwrap path in + let path = Path.unwrap path in let path = List.map (fun x -> x ^ ".node") path in FS.wait_for t.fs ?switch (branch_dir t / "watch" @ (path / "tree.live")) (fun hash -> node_of_hash t hash >>*= fn) diff --git a/api/ocaml/9p/datakit_client_9p.mli b/api/ocaml/9p/datakit_client_9p.mli index 33186875f..3481d5677 100644 --- a/api/ocaml/9p/datakit_client_9p.mli +++ b/api/ocaml/9p/datakit_client_9p.mli @@ -1,8 +1,7 @@ (** A DataKit client that connects to the server over a 9p connection. *) module Make(P9p : Protocol_9p.Client.S) : sig - include Datakit_S.CLIENT - + include Datakit_client.S val connect : P9p.t -> t (** [connect c] is a Datakit connection using the 9p connection [c]. *) end diff --git a/api/ocaml/datakit_client.ml b/api/ocaml/datakit_client.ml new file mode 100644 index 000000000..b6eeee918 --- /dev/null +++ b/api/ocaml/datakit_client.ml @@ -0,0 +1,186 @@ +type stat = { + kind: [`File | `Dir | `Link | `Exec]; + size: int64; +} + +type status_state = + [ `Pending + | `Success + | `Error + | `Failure ] + +type 'a diff = [ `Added of 'a | `Removed of 'a | `Updated of 'a ] +type value = [`File of Cstruct.t | `Dir of string list | `Link of string] + +module Path = struct + + open Result + + type t = string list + + let empty = [] + + let validate = function + | "" | "." | ".." as x -> Error (Fmt.strf "Invalid path component %S" x) + | x when String.contains x '/' -> Error (Fmt.strf "'/' in path step %S" x) + | _ -> Ok () + + let of_steps steps = + let rec aux = function + | [] -> Ok steps + | x :: xs -> + match validate x with + | Ok () -> aux xs + | Error _ as e -> e in + aux steps + + let of_string path = + of_steps (Astring.String.cuts ~sep:"/" path) + + let of_string_exn path = + match of_string path with + | Ok x -> x + | Error msg -> raise (Invalid_argument msg) + + let pp = Fmt.(list ~sep:(const string "/") string) + + let of_steps_exn steps = + match of_steps steps with + | Ok x -> x + | Error msg -> + raise (Invalid_argument (Fmt.strf "Bad path %a: %s" pp steps msg)) + + let unwrap x = x + + let to_hum = Fmt.to_to_string pp + + let compare = compare + + let dirname t = match List.rev t with + | [] -> [] + | _::t -> List.rev t + + let basename t = match List.rev t with + | [] -> None + | h::_ -> Some h + + let pop = function + | [] -> None + | x::xs -> + let rec aux dir this = function + | [] -> Some (List.rev dir, this) + | x::xs -> aux (this :: dir) x xs + in + aux [] x xs + + module Set = Set.Make(struct type t = string list let compare = compare end) + module Map = Map.Make(struct type t = string list let compare = compare end) + + module Infix = struct + + let ( / ) path s = + match validate s with + | Ok () -> path @ [s] + | Error msg -> raise (Invalid_argument msg) + + let ( /@ ) = ( @ ) + + end + +end + +module type READABLE_TREE = sig + type t + type +'a result + val read: t -> Path.t -> value result + val stat: t -> Path.t -> stat option result + val exists: t -> Path.t -> bool result + val exists_file: t -> Path.t -> bool result + val exists_dir: t -> Path.t -> bool result + val read_file: t -> Path.t -> Cstruct.t result + val read_dir: t -> Path.t -> string list result + val read_link: t -> Path.t -> string result +end + +module type S = sig + type t + type error = private + [>`Already_exists + | `Does_not_exist + | `Is_dir + | `Not_dir + | `Not_file + | `Not_symlink] + + val pp_error: error Fmt.t + type +'a result = ('a, error) Result.result Lwt.t + module Infix: sig + val (>>=): 'a result -> ('a -> 'b result) -> 'b result + val (>|=): 'a result -> ('a -> 'b) -> 'b result + end + module Tree: READABLE_TREE with type 'a result := 'a result + module Commit: sig + type t + val pp: t Fmt.t + val compare: t -> t -> int + val id: t -> string + val tree: t -> Tree.t result + val message: t -> string result + val parents: t -> t list result + val diff: t -> t -> Path.t diff list result + end + + module Transaction: sig + include READABLE_TREE with type 'a result := 'a result + val create_dir: t -> Path.t -> unit result + val create_file: t -> Path.t -> ?executable:bool -> + Cstruct.t -> unit result + val create_symlink: t -> Path.t -> string -> unit result + val replace_file: t -> Path.t -> Cstruct.t -> unit result + val create_or_replace_file: t -> Path.t -> Cstruct.t -> unit result + val set_executable: t -> Path.t -> bool -> unit result + val remove: t -> Path.t -> unit result + val rename: t -> Path.t -> string -> unit result + val truncate: t -> Path.t -> int64 -> unit result + val make_dirs: t -> Path.t -> unit result + val commit: t -> message:string -> unit result + val abort: t -> unit result + type merge_inputs = { + ours: Tree.t; + theirs: Tree.t; + base: Tree.t; + } + val merge: t -> Commit.t -> (merge_inputs * Path.t list) result + val parents: t -> Commit.t list result + val set_parents: t -> Commit.t list -> unit result + val conflicts: t -> Path.t list result + val diff: t -> Commit.t -> Path.t diff list result + val closed: t -> bool + end + + module Branch: sig + type t + val name: t -> string + val remove: t -> unit result + val rename: t -> string -> unit result + val head: t -> Commit.t option result + val wait_for_head: t -> ?switch:Lwt_switch.t -> + (Commit.t option -> [`Finish of 'a | `Again | `Abort] result) -> + [`Abort | `Finish of 'a] result + val wait_for_path: t -> ?switch:Lwt_switch.t -> Path.t -> + ([`File of Cstruct.t | `Dir of Tree.t + | `Link of string | `Exec of Cstruct.t] option -> + [`Finish of 'a | `Again | `Abort] result) -> + [`Abort | `Finish of 'a] result + val fast_forward: t -> Commit.t -> unit result + val with_transaction: t -> (Transaction.t -> 'a result) -> 'a result + val transaction: t -> Transaction.t result + end + val branches: t -> string list result + val remove_branch: t -> string -> unit result + val branch: t -> string -> Branch.t result + val commit: t -> string -> Commit.t result + val tree: t -> string -> Tree.t result + val fetch: t -> url:string -> branch:string -> Commit.t result + val disconnect: t -> unit result +end diff --git a/api/ocaml/datakit_S.ml b/api/ocaml/datakit_client.mli similarity index 76% rename from api/ocaml/datakit_S.ml rename to api/ocaml/datakit_client.mli index 355dc94bf..16c424541 100644 --- a/api/ocaml/datakit_S.ml +++ b/api/ocaml/datakit_client.mli @@ -17,6 +17,73 @@ type 'a diff = [ `Added of 'a | `Removed of 'a | `Updated of 'a ] type value = [`File of Cstruct.t | `Dir of string list | `Link of string] (** The type for values. *) +module Path: sig + + (** Locate files and directories within a DataKit tree. *) + + open Result + + type t + (** A [path] identifies a file or directory (relative to some other directory). + No component may be empty or contain a '/' character. "." and ".." steps + are not permitted in a path. *) + + val empty : t + (** The empty path. *) + + val of_steps : string list -> (t, string) result + (** Converts a list of the form ["a"; "b"; "c"] to a path. *) + + val of_steps_exn : string list -> t + (** Converts a list of the form ["a"; "b"; "c"] to a path. *) + + val of_string : string -> (t, string) result + (** Converts a path of the form ["a/b/c"] to a path. *) + + val of_string_exn : string -> t + + val unwrap : t -> string list + (** Cast to a list of strings *) + + val pop : t -> (t * string) option + (** [pop (dir / leaf)] is [Some (dir, leaf)]. + [pop empty] is [None]. *) + + val pp : t Fmt.t + (** [pp] is a formatter for human-readable paths. *) + + val compare: t -> t -> int + (** [compare] is the comparison function for paths. *) + + val to_hum : t -> string + (** Convert to a string, in the same format as [pp]. *) + + val basename: t -> string option + (** [basename t] is [t]'s basename. *) + + val dirname: t -> t + (** [dirname t] is [t]'s dirname. *) + + module Set: Set.S with type elt = t + (** Sets of paths. *) + + module Map: Map.S with type key = t + (** Maps of paths. *) + + module Infix: sig + + val ( / ) : t -> string -> t + (** [a / b] is the path [a] with step [b] appended. Raises an + exception if [b] is not a valid step, so this should only be + used with string constants, not user input. *) + + val ( /@ ) : t -> t -> t + (** [a /@ b] is the concatenation of paths [a] and [b]. *) + + end + +end + module type READABLE_TREE = sig type t @@ -25,37 +92,37 @@ module type READABLE_TREE = sig type +'a result (** The type for results. *) - val read: t -> Datakit_path.t -> value result + val read: t -> Path.t -> value result (** [read t path] is the contents of the object at the [path]. *) - val stat: t -> Datakit_path.t -> stat option result + val stat: t -> Path.t -> stat option result (** [stat t path] is the metadata of the object at [path]. *) - val exists: t -> Datakit_path.t -> bool result + val exists: t -> Path.t -> bool result (** [exists t path] is [true] if [stat t path] isn't [None]. *) - val exists_file: t -> Datakit_path.t -> bool result + val exists_file: t -> Path.t -> bool result (** [exists_file t path] is similar to {!exists} but for files only. *) - val exists_dir: t -> Datakit_path.t -> bool result + val exists_dir: t -> Path.t -> bool result (** [exists_dir t path] is similar to {!exists} but for directories only. *) - val read_file: t -> Datakit_path.t -> Cstruct.t result + val read_file: t -> Path.t -> Cstruct.t result (** [read_file t path] resolves [path] to a file, or returns an error if it isn't a file. *) - val read_dir: t -> Datakit_path.t -> string list result + val read_dir: t -> Path.t -> string list result (** [read_dir t path] resolves [path] to a directory, or returns an error if it isn't one. *) - val read_link: t -> Datakit_path.t -> string result + val read_link: t -> Path.t -> string result (** [read_link t path] resolves [path] to a symlink, or returns an error if it isn't one. *) end -module type CLIENT = sig +module type S = sig type t (** A [t] is a connection to a Datakit server. *) @@ -104,7 +171,7 @@ module type CLIENT = sig val parents: t -> t list result (** [parents t] is the list of [t]'s parent commits. *) - val diff: t -> t -> Datakit_path.t diff list result + val diff: t -> t -> Path.t diff list result (** [diff a b] returns the paths with differences between [a] and [b]. *) end @@ -119,44 +186,44 @@ module type CLIENT = sig (** {2 Writing} *) - val create_dir: t -> Datakit_path.t -> unit result + val create_dir: t -> Path.t -> unit result (** [create_dir t path] creates the directory [path]. *) - val create_file: t -> Datakit_path.t -> ?executable:bool -> + val create_file: t -> Path.t -> ?executable:bool -> Cstruct.t -> unit result (** [create_file t path ?executable content] creates the file [path]. *) - val create_symlink: t -> Datakit_path.t -> string -> unit result + val create_symlink: t -> Path.t -> string -> unit result (** [create_symlink t path target] creates the symlink [path]. *) - val replace_file: t -> Datakit_path.t -> Cstruct.t -> unit result + val replace_file: t -> Path.t -> Cstruct.t -> unit result (** [replace_file t path new_content] changes the content of the existing file [path]. *) - val create_or_replace_file: t -> Datakit_path.t -> Cstruct.t -> unit result + val create_or_replace_file: t -> Path.t -> Cstruct.t -> unit result (** [create_or_replace_file t path content] uses either [create_file] or [replace_file] as appropriate to set the contents. *) - val set_executable: t -> Datakit_path.t -> bool -> unit result + val set_executable: t -> Path.t -> bool -> unit result (** [set_executable t path flag] marks the file at [path] as executable or not. *) - val remove: t -> Datakit_path.t -> unit result + val remove: t -> Path.t -> unit result (** [remove t path] removes [path]. If [path] is a directory then the entire subtree is removed. *) - val rename: t -> Datakit_path.t -> string -> unit result + val rename: t -> Path.t -> string -> unit result (** [rename t path new_name] changes the basename of [path] to [new_name]. Note: it is only possible to rename within a directory (this is a 9p limitation). *) - val truncate: t -> Datakit_path.t -> int64 -> unit result + val truncate: t -> Path.t -> int64 -> unit result (** [truncate t path length] sets the length of the file at [path] to [length]. If [length] is longer than the current length, the file is padded with zero bytes. *) - val make_dirs: t -> Datakit_path.t -> unit result + val make_dirs: t -> Path.t -> unit result (** [make_dirs t path] ensures that [path] exists and is a directory, creating it and any missing parents as necessary. *) @@ -187,7 +254,7 @@ module type CLIENT = sig merged and [base] is a least common ancestor. If there is no common ancestor then [base] is an empty tree. *) - val merge: t -> Commit.t -> (merge_inputs * Datakit_path.t list) result + val merge: t -> Commit.t -> (merge_inputs * Path.t list) result (** [merge t commit] merges [commit] into the transaction. It performs any trivial merges it can and returns [(merge_inputs, conflicts)] to allow you to resolve the remaining ones. You @@ -207,12 +274,12 @@ module type CLIENT = sig updates the parents, so it is not necessary to call it manually in that case. *) - val conflicts: t -> Datakit_path.t list result + val conflicts: t -> Path.t list result (** [conflicts t] returns the current list of paths that had merge conflicts and have not been written to since. It is not possible to commit while this is non-empty. *) - val diff: t -> Commit.t -> Datakit_path.t diff list result + val diff: t -> Commit.t -> Path.t diff list result (** [diff t c] returns the paths differences between [c] and [t]'s head. *) @@ -251,7 +318,7 @@ module type CLIENT = sig off the switch will make the wait return [`Abort] at the next opportunity. *) - val wait_for_path: t -> ?switch:Lwt_switch.t -> Datakit_path.t -> + val wait_for_path: t -> ?switch:Lwt_switch.t -> Path.t -> ([`File of Cstruct.t | `Dir of Tree.t | `Link of string | `Exec of Cstruct.t] option -> [`Finish of 'a | `Again | `Abort] result) -> diff --git a/api/ocaml/datakit_path.ml b/api/ocaml/datakit_path.ml deleted file mode 100644 index 246dd2c67..000000000 --- a/api/ocaml/datakit_path.ml +++ /dev/null @@ -1,72 +0,0 @@ -open Result - -type t = string list - -let empty = [] - -let validate = function - | "" | "." | ".." as x -> Error (Fmt.strf "Invalid path component %S" x) - | x when String.contains x '/' -> Error (Fmt.strf "'/' in path step %S" x) - | _ -> Ok () - -let of_steps steps = - let rec aux = function - | [] -> Ok steps - | x :: xs -> - match validate x with - | Ok () -> aux xs - | Error _ as e -> e in - aux steps - -let of_string path = - of_steps (Astring.String.cuts ~sep:"/" path) - -let of_string_exn path = - match of_string path with - | Ok x -> x - | Error msg -> raise (Invalid_argument msg) - -let pp = Fmt.(list ~sep:(const string "/") string) - -let of_steps_exn steps = - match of_steps steps with - | Ok x -> x - | Error msg -> - raise (Invalid_argument (Fmt.strf "Bad path %a: %s" pp steps msg)) - -let unwrap x = x - -let to_hum = Fmt.to_to_string pp - -let compare = compare - -let dirname t = match List.rev t with - | [] -> [] - | _::t -> List.rev t - -let basename t = match List.rev t with - | [] -> None - | h::_ -> Some h - -let pop = function - | [] -> None - | x::xs -> - let rec aux dir this = function - | [] -> Some (List.rev dir, this) - | x::xs -> aux (this :: dir) x xs - in - aux [] x xs - -module Set = Set.Make(struct type t = string list let compare = compare end) -module Map = Map.Make(struct type t = string list let compare = compare end) - -module Infix = struct - - let ( / ) path s = - match validate s with - | Ok () -> path @ [s] - | Error msg -> raise (Invalid_argument msg) - - let ( /@ ) = ( @ ) - -end diff --git a/api/ocaml/datakit_path.mli b/api/ocaml/datakit_path.mli deleted file mode 100644 index f54398944..000000000 --- a/api/ocaml/datakit_path.mli +++ /dev/null @@ -1,62 +0,0 @@ -(** Locate files and directories within a DataKit tree. *) - -open Result - -type t -(** A [path] identifies a file or directory (relative to some other directory). - No component may be empty or contain a '/' character. "." and ".." steps - are not permitted in a path. *) - -val empty : t -(** The empty path. *) - -val of_steps : string list -> (t, string) result -(** Converts a list of the form ["a"; "b"; "c"] to a path. *) - -val of_steps_exn : string list -> t -(** Converts a list of the form ["a"; "b"; "c"] to a path. *) - -val of_string : string -> (t, string) result -(** Converts a path of the form ["a/b/c"] to a path. *) - -val of_string_exn : string -> t - -val unwrap : t -> string list -(** Cast to a list of strings *) - -val pop : t -> (t * string) option -(** [pop (dir / leaf)] is [Some (dir, leaf)]. - [pop empty] is [None]. *) - -val pp : t Fmt.t -(** [pp] is a formatter for human-readable paths. *) - -val compare: t -> t -> int -(** [compare] is the comparison function for paths. *) - -val to_hum : t -> string -(** Convert to a string, in the same format as [pp]. *) - -val basename: t -> string option -(** [basename t] is [t]'s basename. *) - -val dirname: t -> t -(** [dirname t] is [t]'s dirname. *) - -module Set: Set.S with type elt = t -(** Sets of paths. *) - -module Map: Map.S with type key = t -(** Maps of paths. *) - -module Infix: sig - - val ( / ) : t -> string -> t - (** [a / b] is the path [a] with step [b] appended. Raises an - exception if [b] is not a valid step, so this should only be - used with string constants, not user input. *) - - val ( /@ ) : t -> t -> t - (** [a /@ b] is the concatenation of paths [a] and [b]. *) - -end diff --git a/bridge/github/datakit_github_sync.ml b/bridge/github/datakit_github_sync.ml index 2e1223a00..a16b8769a 100644 --- a/bridge/github/datakit_github_sync.ml +++ b/bridge/github/datakit_github_sync.ml @@ -1,7 +1,7 @@ open Result open Lwt.Infix open Datakit_github -open Datakit_path.Infix +open Datakit_client.Path.Infix let src = Logs.Src.create "dkt-github" ~doc:"Github to Git bridge" module Log = (val Logs.src_log src : Logs.LOG) @@ -13,20 +13,20 @@ let ( >>*= ) x f = let ok x = Lwt.return (Ok x) -module Make (API: API) (DK: Datakit_S.CLIENT) = struct +module Make (API: API) (DK: Datakit_client.S) = struct module State = Datakit_github_state.Make(API) module Conv = Datakit_github_conv.Make(DK) (* [bridge] [datakit] - [in memory Snapshot.t] [9p/datakit endpoint] + [in memory Snapshot.t] [9p/datakit endpoint] | | - GH --events--> | | <--commits-- Users + GH --events--> | | <--commits-- Users | | | <--watch-- | | | - GH --API GET--> | | - GH <--API SET-- | | + GH --API GET--> | | + GH <--API SET-- | | | --write--> | | | *) @@ -78,7 +78,7 @@ module Make (API: API) (DK: Datakit_S.CLIENT) = struct | Some _ -> ok () | None -> DK.Branch.with_transaction br (fun tr -> - let file = Datakit_path.(empty / "README.md") in + let file = Datakit_client.Path.(empty / "README.md") in let data = Cstruct.of_string "### DataKit -- GitHub bridge\n" in DK.Transaction.create_or_replace_file tr file data >>= function diff --git a/bridge/github/datakit_github_sync.mli b/bridge/github/datakit_github_sync.mli index 3576ee208..6672f82d1 100644 --- a/bridge/github/datakit_github_sync.mli +++ b/bridge/github/datakit_github_sync.mli @@ -1,6 +1,6 @@ open Datakit_github -module Make (API: API) (DK: Datakit_S.CLIENT): sig +module Make (API: API) (DK: Datakit_client.S): sig type t (** The type for synchronizer state. *) diff --git a/bridge/local/sync.ml b/bridge/local/sync.ml index 61ba36e09..8cc81163f 100644 --- a/bridge/local/sync.ml +++ b/bridge/local/sync.ml @@ -6,7 +6,7 @@ module Log = (val Logs.src_log src : Logs.LOG) module Make (S : Irmin.S with type branch = string) - (DK : Datakit_S.CLIENT) + (DK : Datakit_client.S) = struct module Conv = Datakit_github_conv.Make(DK) diff --git a/bridge/local/sync.mli b/bridge/local/sync.mli index 0f76bee28..93600209a 100644 --- a/bridge/local/sync.mli +++ b/bridge/local/sync.mli @@ -1,5 +1,5 @@ module Make (S : Irmin.S with type branch = string) - (DK : Datakit_S.CLIENT) : sig + (DK : Datakit_client.S) : sig val run : DK.t -> (Datakit_github.Repo.t * S.Repo.t) list -> 'a Lwt.t end diff --git a/ci/src/cI_cache.ml b/ci/src/cI_cache.ml index 533b00662..c25ca1b78 100644 --- a/ci/src/cI_cache.ml +++ b/ci/src/cI_cache.ml @@ -49,7 +49,7 @@ module Path = struct - /value may contain extra artifacts/data (depending on the builder) - /rebuild-requested (if present) indicates that the current results are not acceptable *) - let v = Datakit_path.of_string_exn + let v = Datakit_client.Path.of_string_exn let log = v "log" let failure = v "failure" let rebuild = v "rebuild-requested" diff --git a/ci/src/cI_cache.mli b/ci/src/cI_cache.mli index 7c50afb51..ffd6d6e81 100644 --- a/ci/src/cI_cache.mli +++ b/ci/src/cI_cache.mli @@ -3,8 +3,8 @@ open CI_utils module Path : sig - val log : Datakit_path.t (* The job's log output *) - val value : Datakit_path.t (* Store build results in this directory *) + val log : Datakit_client.Path.t (* The job's log output *) + val value: Datakit_client.Path.t (* Store build results in this directory *) end module Make(B : CI_s.BUILDER) : sig diff --git a/ci/src/cI_history.ml b/ci/src/cI_history.ml index c2b19835e..575a61ec6 100644 --- a/ci/src/cI_history.ml +++ b/ci/src/cI_history.ml @@ -1,16 +1,16 @@ open CI_utils.Infix open Lwt.Infix open Astring +open Datakit_client +open Datakit_client.Path.Infix module DK = CI_utils.DK -let metadata_commit_path = Datakit_path.of_string_exn "metadata-commit" -let source_commit_path = Datakit_path.of_string_exn "source-commit" +let metadata_commit_path = Path.of_string_exn "metadata-commit" +let source_commit_path = Path.of_string_exn "source-commit" let index_branch = "commit-index" -let ( / ) = Datakit_path.Infix.( / ) - module State = struct type t = { parents : string list; @@ -79,10 +79,10 @@ let load commit = let parents = List.map DK.Commit.id parents in read_opt_string tree source_commit_path >>= fun source_commit -> read_opt_string tree metadata_commit_path >>= fun metadata_commit -> - begin DK.Tree.read_dir tree (Datakit_path.of_steps_exn ["job"]) >>= function + begin DK.Tree.read_dir tree (Path.of_steps_exn ["job"]) >>= function | Ok items -> items |> Lwt_list.filter_map_p (fun job_name -> - let path = Datakit_path.of_steps_exn ["job"; job_name; "output"] in + let path = Path.of_steps_exn ["job"; job_name; "output"] in DK.Tree.read_file tree path >|= function | Ok data -> Some (job_name, Saved_output.of_cstruct data) | Error `Does_not_exist -> None @@ -123,7 +123,7 @@ let diff _id prev next = let index_dir ~repo ~source_commit = let {Datakit_github.Repo.user; repo} = repo in - Datakit_path.of_steps_exn [user; repo; "commit"; source_commit] + Path.of_steps_exn [user; repo; "commit"; source_commit] let record t dk ~source_commit input jobs = Lwt_mutex.with_lock t.lock @@ fun () -> @@ -134,7 +134,6 @@ let record t dk ~source_commit input jobs = t.commit <- Some {state with State.jobs}; Lwt.return () ) else ( - let open! Datakit_path.Infix in let messages = ref [] in let add_msg fmt = fmt |> Fmt.kstrf @@ fun msg -> @@ -150,11 +149,11 @@ let record t dk ~source_commit input jobs = DK.Transaction.create_or_replace_file tr metadata_commit_path metadata_commit >>*= fun () -> String.Map.bindings patch |> Lwt_list.iter_s (function | (job, `Delete) -> - let dir = Datakit_path.of_steps_exn ["job"; job] in + let dir = Path.of_steps_exn ["job"; job] in add_msg "Remove old job %s" job; DK.Transaction.remove tr dir >>*= Lwt.return | (job, `Write output) -> - let dir = Datakit_path.of_steps_exn ["job"; job] in + let dir = Path.of_steps_exn ["job"; job] in add_msg "%s -> %s" job (CI_output.descr output); let json = CI_output.json_of output in let data = Saved_output.to_cstruct json in diff --git a/ci/src/cI_target.ml b/ci/src/cI_target.ml index 77f742b28..5959d8388 100644 --- a/ci/src/cI_target.ml +++ b/ci/src/cI_target.ml @@ -1,6 +1,7 @@ open Datakit_github open! Astring open !Asetmap +open Datakit_client type t = [ `PR of PR.id | `Ref of Ref.id ] @@ -45,9 +46,9 @@ let parse s = let repo = Repo.v ~user ~repo in let parse_target = function | ("heads" | "tags") as ref_type, ref -> - let open! Datakit_path.Infix in - begin match Datakit_path.of_string ref with - | Ok path -> `Ok (`Ref (repo, ref_type :: Datakit_path.unwrap path)) + begin match Path.of_string ref with + | Ok path -> + `Ok (`Ref (repo, ref_type :: Path.unwrap path)) | Error msg -> `Error msg end | "prs", id -> diff --git a/ci/src/cI_term.ml b/ci/src/cI_term.ml index 3f42e12d6..b0d1c27b5 100644 --- a/ci/src/cI_term.ml +++ b/ci/src/cI_term.ml @@ -59,9 +59,9 @@ let target id = let head id = target id >|= CI_target.head let ref_head repo ref_name = - match Datakit_path.of_string ref_name with + match Datakit_client.Path.of_string ref_name with | Error msg -> fail "Invalid ref name %S: %s" ref_name msg - | Ok ref_path -> head @@ `Ref (repo, Datakit_path.unwrap ref_path) + | Ok ref_path -> head @@ `Ref (repo, Datakit_client.Path.unwrap ref_path) let branch_head repo branch = ref_head repo ("heads/" ^ branch) diff --git a/ci/src/cI_utils.mli b/ci/src/cI_utils.mli index 978937da2..00c63a5be 100644 --- a/ci/src/cI_utils.mli +++ b/ci/src/cI_utils.mli @@ -11,7 +11,7 @@ module Client9p: sig t Protocol_9p.Error.t Lwt.t end module DK: sig - include Datakit_S.CLIENT + include Datakit_client.S val connect: Client9p.t -> t end diff --git a/ci/src/datakit_ci.mli b/ci/src/datakit_ci.mli index 493cf1b43..ffe8bfc2a 100644 --- a/ci/src/datakit_ci.mli +++ b/ci/src/datakit_ci.mli @@ -19,7 +19,7 @@ (** {1:core Core} *) -module DK: Datakit_S.CLIENT +module DK: Datakit_client.S (** Datakit client library. *) module Live_log: sig @@ -623,7 +623,7 @@ module Cache: sig A cache for values computed (slowly) by terms. *) module Path: sig - val value: Datakit_path.t + val value: Datakit_client.Path.t (** Build results are stored in this directory *) end diff --git a/ci/tests/test_ci.ml b/ci/tests/test_ci.ml index 2a9c258cb..e8de22658 100644 --- a/ci/tests/test_ci.ml +++ b/ci/tests/test_ci.ml @@ -3,7 +3,7 @@ open Datakit_ci open! Astring open Utils.Infix -let ( / ) = Datakit_path.Infix.( / ) +let ( / ) = Datakit_client.Path.Infix.( / ) let src = Logs.Src.create "datakit-ci.tests" ~doc:"CI Tests" module Log = (val Logs.src_log src : Logs.LOG) @@ -77,7 +77,7 @@ let test_simple conn = | None -> Alcotest.fail "Missing status branch!" | Some head -> DK.Commit.tree head >>*= fun tree -> - DK.Tree.read_file tree (Datakit_path.of_string_exn "job/test/output") + DK.Tree.read_file tree (Datakit_client.Path.of_string_exn "job/test/output") >>*= fun data -> Alcotest.check Test_utils.json "Status JSON" ( `Assoc [ @@ -234,7 +234,7 @@ module Builder = struct Lwt.return @@ Ok (int_of_string key) let load _t tr _key = - DK.Tree.read_file tr (Datakit_path.of_string_exn "value/x") >>*= fun data -> + DK.Tree.read_file tr (Datakit_client.Path.of_string_exn "value/x") >>*= fun data -> Lwt.return (int_of_string (Cstruct.to_string data)) let branch _t key = Printf.sprintf "cache-of-%s" key @@ -409,7 +409,7 @@ let test_git_dir conn ~clone = | None -> Alcotest.fail "Missing results branch!" | Some head -> DK.Commit.tree head >>*= fun tree -> - DK.Tree.read_file tree (Datakit_path.of_string_exn "log") >>*= fun log -> + DK.Tree.read_file tree (Datakit_client.Path.of_string_exn "log") >>*= fun log -> let log = Cstruct.to_string log in if not (String.is_infix ~affix:"Running \"ls\"...\nsrc" log) then Alcotest.fail "Missing 'src' in log output" diff --git a/ci/tests/test_utils.ml b/ci/tests/test_utils.ml index 45cc285b7..c107488e2 100644 --- a/ci/tests/test_utils.ml +++ b/ci/tests/test_utils.ml @@ -3,8 +3,9 @@ open Result open Lwt.Infix open! Astring open Datakit_ci +open Datakit_client -let ( / ) = Datakit_path.Infix.( / ) +let ( / ) = Path.Infix.( / ) (* Chain operations together, returning early if we get an error *) let ( >>*= ) x f = @@ -42,7 +43,7 @@ let make_task msg = module Server = Fs9p.Make(Protocol_9p_unix.Flow_lwt_unix) module Filesystem = Ivfs.Make(Store) -let p = Datakit_path.of_string_exn +let p = Path.of_string_exn let () = CI_log_reporter.init None (Some Logs.Info); @@ -118,8 +119,8 @@ let update branch values ~message = values |> Lwt_list.iter_s (fun (path, value) -> let dir, leaf = match String.cut ~rev:true ~sep:"/" path with - | None -> Datakit_path.empty, path - | Some (dir, leaf) -> Datakit_path.of_string_exn dir, leaf in + | None -> Path.empty, path + | Some (dir, leaf) -> Path.of_string_exn dir, leaf in DK.Transaction.make_dirs t dir >>*= fun () -> DK.Transaction.create_or_replace_file t (dir / leaf) (Cstruct.of_string value) >>*= Lwt.return ) @@ -140,7 +141,7 @@ let single_line data = Also fails if it becomes a non-file object or if the switch is turned off. *) let wait_for_file ?switch branch path ?old expected = Logs.info (fun f -> f "wait_for_file %s %s" path expected); - DK.Branch.wait_for_path ?switch branch (Datakit_path.of_string_exn path) (function + DK.Branch.wait_for_path ?switch branch (Path.of_string_exn path) (function | Some (`File data) -> let data = single_line data in if data = expected then ( @@ -208,7 +209,7 @@ let with_handler set_handler ~logs ?pending key fn = set_handler key { result; output = Output.Live log }; Lwt.wakeup waker () -let repo_root { Repo.user; repo } = Datakit_path.(empty / user / repo) +let repo_root { Repo.user; repo } = Path.(empty / user / repo) (* [with_ci conn workflow fn] is [fn ~logs ~switch dk with_handler], where: - switch is turned off when [fn] ends and will stop the CI diff --git a/src/datakit-github/datakit_github_conv.ml b/src/datakit-github/datakit_github_conv.ml index e45caa86b..5fb40d11b 100644 --- a/src/datakit-github/datakit_github_conv.ml +++ b/src/datakit-github/datakit_github_conv.ml @@ -1,7 +1,8 @@ open Lwt.Infix -open Datakit_path.Infix +open Datakit_client.Path.Infix open Datakit_github open Result +open Datakit_client let src = Logs.Src.create "dkt-github" ~doc:"Github to Git bridge" module Log = (val Logs.src_log src : Logs.LOG) @@ -16,13 +17,13 @@ let mapo f = function None -> None | Some x -> Some (f x) let failf fmt = Fmt.kstrf failwith fmt -module Make (DK: Datakit_S.CLIENT) = struct +module Make (DK: S) = struct type tree = DK.Tree.t (* conversion between GitHub and DataKit states. *) - let path s = Datakit_path.of_steps_exn s + let path s = Path.of_steps_exn s (* TODO: Lots of these functions used to ignore errors silently. This can lead to bugs in the users of the library (e.g. we lost our 9p connection but @@ -35,48 +36,48 @@ module Make (DK: Datakit_S.CLIENT) = struct DK.Transaction.remove t path >|= function | Error `Does_not_exist | Ok () -> () | Error e -> - failf "remove_if_exists(%a): %a" Datakit_path.pp path DK.pp_error e + failf "remove_if_exists(%a): %a" Path.pp path DK.pp_error e let read_dir_if_exists t dir = DK.Tree.read_dir t dir >|= function | Ok dirs -> dirs | Error (`Does_not_exist | `Not_dir) -> [] | Error e -> - failf "safe_read_dir(%a): %a" Datakit_path.pp dir DK.pp_error e + failf "safe_read_dir(%a): %a" Path.pp dir DK.pp_error e let exists_dir t dir = DK.Tree.exists_dir t dir >|= function | Ok b -> b | Error `Not_dir -> false (* Some parent doesn't exist or isn't a directory *) | Error e -> - failf "exists_dir(%a): %a" Datakit_path.pp dir DK.pp_error e + failf "exists_dir(%a): %a" Path.pp dir DK.pp_error e let exists_file t file = DK.Tree.exists_file t file >|= function | Ok b -> b | Error `Not_dir -> false (* Some parent doesn't exist or isn't a directory *) | Error e -> - failf "exists_file(%a): %a" Datakit_path.pp file DK.pp_error e + failf "exists_file(%a): %a" Path.pp file DK.pp_error e let read_file_if_exists t file = DK.Tree.read_file t file >|= function | Ok b -> Some (String.trim (Cstruct.to_string b)) | Error (`Does_not_exist | `Not_dir) -> None | Error e -> - failf "read_file(%a): %a" Datakit_path.pp file DK.pp_error e + failf "read_file(%a): %a" Path.pp file DK.pp_error e let create_file tr file contents = - match Datakit_path.basename file with + match Path.basename file with | None -> - failf "%a is not a file" Datakit_path.pp file + failf "%a is not a file" Path.pp file | Some _ -> - let dir = Datakit_path.dirname file in + let dir = Path.dirname file in (DK.Transaction.make_dirs tr dir >>*= fun () -> DK.Transaction.create_or_replace_file tr file contents) >|= function | Ok () -> () | Error e -> - failf "Got %a while creating %a" DK.pp_error e Datakit_path.pp file + failf "Got %a while creating %a" DK.pp_error e Path.pp file let tr_diff tr c = DK.Transaction.diff tr c >|= function @@ -89,7 +90,7 @@ module Make (DK: Datakit_S.CLIENT) = struct | Ok x -> Lwt.return x let path_of_diff = function - | `Added f | `Removed f | `Updated f -> Datakit_path.unwrap f + | `Added f | `Removed f | `Updated f -> Path.unwrap f let safe_tree c = DK.Commit.tree c >>= function @@ -145,7 +146,7 @@ module Make (DK: Datakit_S.CLIENT) = struct let rec aux acc = function | [] -> Lwt.return acc | context :: todo -> - match Datakit_path.of_steps context with + match Path.of_steps context with | Error e -> Log.err (fun l -> l "%s" e); aux acc todo | Ok ctx -> let dir = root /@ ctx in @@ -154,13 +155,13 @@ module Make (DK: Datakit_S.CLIENT) = struct exists_file tree (dir / file) >>= function | false -> aux acc todo | true -> - fn (Datakit_path.unwrap ctx) >>= function + fn (Path.unwrap ctx) >>= function | None -> aux acc todo | Some e -> aux (Set.add e acc) todo in aux Set.empty [ [] ] - let empty = Datakit_path.empty + let empty = Path.empty let root r = empty / r.Repo.user / r.Repo.repo @@ -178,7 +179,7 @@ module Make (DK: Datakit_S.CLIENT) = struct let reduce_repos = List.fold_left Repo.Set.union Repo.Set.empty let repos tree = - let root = Datakit_path.empty in + let root = Path.empty in read_dir_if_exists tree root >>= fun users -> Lwt_list.map_p (fun user -> read_dir_if_exists tree (root / user) >>= fun repos -> @@ -215,7 +216,7 @@ module Make (DK: Datakit_S.CLIENT) = struct let update_pr t pr = let dir = root (PR.repo pr) / "pr" / string_of_int pr.PR.number in - Log.debug (fun l -> l "update_pr %s" @@ Datakit_path.to_hum dir); + Log.debug (fun l -> l "update_pr %s" @@ Path.to_hum dir); let update = DK.Transaction.make_dirs t dir >>*= fun () -> let write k v = @@ -231,12 +232,12 @@ module Make (DK: Datakit_S.CLIENT) = struct let remove_pr t (repo, num) = let dir = root repo / "pr" / string_of_int num in - Log.debug (fun l -> l "remove_pr %s" @@ Datakit_path.to_hum dir); + Log.debug (fun l -> l "remove_pr %s" @@ Path.to_hum dir); remove_if_exists t dir let pr tree (repo, number) = let dir = root repo / "pr" / string_of_int number in - Log.debug (fun l -> l "pr %a" Datakit_path.pp dir); + Log.debug (fun l -> l "pr %a" Path.pp dir); read_file_if_exists tree (dir / "head") >>= fun head -> read_file_if_exists tree (dir / "state") >>= fun state -> read_file_if_exists tree (dir / "title") >>= fun title -> @@ -337,7 +338,7 @@ module Make (DK: Datakit_S.CLIENT) = struct let dir = root (Status.repo s) / "commit" / (Status.commit_hash s) / "status" /@ path (Status.context s) in - Log.debug (fun l -> l "update_status %a" Datakit_path.pp dir); + Log.debug (fun l -> l "update_status %a" Path.pp dir); lift_errors "update_status" (DK.Transaction.make_dirs t dir) >>= fun () -> let description = match Status.description s with | None -> None @@ -357,7 +358,7 @@ module Make (DK: Datakit_S.CLIENT) = struct ) kvs let status tree (commit, context) = - let context = Datakit_path.of_steps_exn context in + let context = Path.of_steps_exn context in let dir = root (Commit.repo commit) / "commit" / Commit.hash commit / "status" /@ context @@ -365,7 +366,7 @@ module Make (DK: Datakit_S.CLIENT) = struct read_file_if_exists tree (dir / "state") >>= fun state -> match state with | None -> - Log.debug (fun l -> l "status %a -> None" Datakit_path.pp dir); + Log.debug (fun l -> l "status %a -> None" Path.pp dir); Lwt.return_none | Some str -> let state = match Status_state.of_string str with @@ -375,10 +376,10 @@ module Make (DK: Datakit_S.CLIENT) = struct `Failure in Log.debug (fun l -> l "status %a -> %a" - Datakit_path.pp context Status_state.pp state); + Path.pp context Status_state.pp state); read_file_if_exists tree (dir / "description") >>= fun description -> read_file_if_exists tree (dir / "target_url") >|= fun url -> - let context = Datakit_path.unwrap context in + let context = Path.unwrap context in let url = mapo Uri.of_string url in Some (Status.v ?description ?url commit context state) @@ -410,7 +411,7 @@ module Make (DK: Datakit_S.CLIENT) = struct (* Refs *) let ref tree (repo, name) = - let path = Datakit_path.of_steps_exn name in + let path = Path.of_steps_exn name in let head = root repo / "ref" /@ path / "head" in read_file_if_exists tree head >|= function | None -> @@ -439,9 +440,9 @@ module Make (DK: Datakit_S.CLIENT) = struct refs let update_ref tr r = - let path = Datakit_path.of_steps_exn (Ref.name r) in + let path = Path.of_steps_exn (Ref.name r) in let dir = root (Ref.repo r) / "ref" /@ path in - Log.debug (fun l -> l "update_ref %a" Datakit_path.pp dir); + Log.debug (fun l -> l "update_ref %a" Path.pp dir); let update = DK.Transaction.make_dirs tr dir >>*= fun () -> let head = Cstruct.of_string (Ref.commit_hash r ^ "\n") in @@ -450,9 +451,9 @@ module Make (DK: Datakit_S.CLIENT) = struct lift_errors "update_ref" update let remove_ref tr (repo, name) = - let path = Datakit_path.of_steps_exn name in + let path = Path.of_steps_exn name in let dir = root repo / "ref" /@ path in - Log.debug (fun l -> l "remove_ref %a" Datakit_path.pp dir); + Log.debug (fun l -> l "remove_ref %a" Path.pp dir); remove_if_exists tr dir let update_event t = function @@ -485,7 +486,7 @@ module Make (DK: Datakit_S.CLIENT) = struct let reduce_elts = List.fold_left Elt.IdSet.union Elt.IdSet.empty let dirty_repos tree = - let root = Datakit_path.empty in + let root = Path.empty in read_dir_if_exists tree root >>= fun users -> Lwt_list.map_p (fun user -> read_dir_if_exists tree (root / user) >>= fun repos -> @@ -528,10 +529,11 @@ module Make (DK: Datakit_S.CLIENT) = struct >|= fun more -> dirty_repos ++ reduce_elts more - let dirty_file: Elt.id -> Datakit_path.t = function - | `Repo r -> root r / ".dirty" - | `PR (r, id) -> root r / "pr" / string_of_int id / ".dirty" - | `Ref (r, n) -> root r / "ref" /@ Datakit_path.of_steps_exn n / ".dirty" + let dirty_file: Elt.id -> Path.t = function + | `Repo r -> root r / ".dirty" + | `PR (r, id) -> root r / "pr" / string_of_int id / ".dirty" + | `Ref (r, n) -> + root r / "ref" /@ Path.of_steps_exn n / ".dirty" | _ -> failwith "TODO" let clean tr dirty = diff --git a/src/datakit-github/datakit_github_conv.mli b/src/datakit-github/datakit_github_conv.mli index 458563884..e92c6da1a 100644 --- a/src/datakit-github/datakit_github_conv.mli +++ b/src/datakit-github/datakit_github_conv.mli @@ -4,7 +4,7 @@ open Datakit_github (** Conversion between GitHub and DataKit states. *) -module Make (DK: Datakit_S.CLIENT): sig +module Make (DK: Datakit_client.S): sig type tree = DK.Tree.t (** The type for trees. *) diff --git a/src/datakit-io/jbuild b/src/datakit-io/jbuild index 95ce58330..dcb78d6bc 100644 --- a/src/datakit-io/jbuild +++ b/src/datakit-io/jbuild @@ -3,5 +3,5 @@ (library ((name datakit_io) (wrapped false) - (libraries (irmin-git conduit.lwt-unix camlzip)) + (libraries (irmin-git conduit.lwt-unix zip)) )) diff --git a/tests/common/test_client.ml b/tests/common/test_client.ml index 900e5bdf0..f2feabe58 100644 --- a/tests/common/test_client.ml +++ b/tests/common/test_client.ml @@ -1,9 +1,10 @@ open Lwt.Infix open Test_utils open Result +open Datakit_client module type S = sig - include Datakit_S.CLIENT + include S val run: (t -> unit Lwt.t) -> unit end @@ -58,13 +59,13 @@ module Make (DK: S) = struct | Some (parent, name) -> ensure_dir parent >>= fun () -> Hashtbl.add dirs d (); - DK.Transaction.create_dir t (Datakit_path.of_steps_exn parent / name) + DK.Transaction.create_dir t (Path.of_steps_exn parent / name) >>*= Lwt.return ) in files |> Lwt_list.iter_s (fun (path, value) -> let dir, name = split path in ensure_dir dir >>= fun () -> - let dir = Datakit_path.of_steps_exn dir in + let dir = Path.of_steps_exn dir in DK.Transaction.create_file t (dir / name) (Cstruct.of_string value) >>*= Lwt.return ) >>= fun () -> @@ -136,9 +137,11 @@ module Make (DK: S) = struct | None -> Alcotest.fail "Branch does not exist!" | Some head -> DK.Commit.tree head >>*= fun root -> + DK.Tree.read_file root (p "src/Makefile") >>*= fun v -> + Printf.printf "XXX %s %d\n%!" (Cstruct.to_string v) (Cstruct.len v); DK.Tree.stat root (p "src/Makefile") >>*= function | None -> Alcotest.fail "Missing Makefile!" - | Some {Datakit_S.size; _} -> + | Some {size; _} -> Alcotest.(check int) "File size" 15 (Int64.to_int size); DK.Commit.message head >|*= fun msg -> Alcotest.(check string) "Message" "My commit\n" msg @@ -248,7 +251,7 @@ module Make (DK: S) = struct stat >>*= function | None -> Alcotest.fail "Missing file" | Some actual -> - Alcotest.(check (of_pp pp_kind)) msg expected actual.Datakit_S.kind; + Alcotest.(check (of_pp pp_kind)) msg expected actual.kind; Lwt.return_unit let test_merge dk = @@ -297,14 +300,14 @@ module Make (DK: S) = struct Alcotest.(check string) "Merge result" "from-master+pr" (Cstruct.to_string merged) - let diff: Datakit_path.t Datakit_S.diff Alcotest.testable = + let diff: Path.t diff Alcotest.testable = (module struct - type t = Datakit_path.t Datakit_S.diff + type t = Path.t diff let equal = (=) let pp ppf = function - | `Added p -> Fmt.pf ppf "+ %a" Datakit_path.pp p - | `Removed p -> Fmt.pf ppf "- %a" Datakit_path.pp p - | `Updated p -> Fmt.pf ppf "* %a" Datakit_path.pp p + | `Added p -> Fmt.pf ppf "+ %a" Path.pp p + | `Removed p -> Fmt.pf ppf "- %a" Path.pp p + | `Updated p -> Fmt.pf ppf "* %a" Path.pp p end) let diffs = Alcotest.slist diff compare @@ -491,7 +494,7 @@ module Make (DK: S) = struct |> check_file "dir" "** Conflict **\nFile vs dir\n" >>= fun () -> DK.Transaction.conflicts t >>*= fun conflicts -> - let conflicts = List.map Datakit_path.to_hum conflicts in + let conflicts = List.map Path.to_hum conflicts in Alcotest.(check (list string)) "conflicts" ["a"; "dir"; "dir2"; "f"; "h"] conflicts; DK.Transaction.remove t (p "a") >>*= fun () -> @@ -500,7 +503,7 @@ module Make (DK: S) = struct DK.Tree.read_file theirs (p "f") >>*= DK.Transaction.replace_file t (p "f") >>*= fun () -> DK.Transaction.conflicts t >>*= fun conflicts -> - let conflicts = List.map Datakit_path.to_hum conflicts in + let conflicts = List.map Path.to_hum conflicts in Alcotest.(check (list string)) "conflicts" ["h"] conflicts; DK.Transaction.remove t (p "h") ) >>= fun () -> @@ -532,7 +535,7 @@ module Make (DK: S) = struct let events, push = Lwt_stream.create () in let th = DK.Branch.wait_for_path branch ~switch path (fun node -> - Logs.warn (fun f -> f "Update: %a" Datakit_path.pp path); + Logs.warn (fun f -> f "Update: %a" Path.pp path); push (Some node); Lwt.return (Ok `Again) ) >>*= Lwt.return diff --git a/tests/common/test_client.mli b/tests/common/test_client.mli index e949e447e..05d7043f2 100644 --- a/tests/common/test_client.mli +++ b/tests/common/test_client.mli @@ -1,5 +1,5 @@ module type S = sig - include Datakit_S.CLIENT + include Datakit_client.S val run: (t -> unit Lwt.t) -> unit end diff --git a/tests/common/test_utils.ml b/tests/common/test_utils.ml index e25ca4b8a..b6953e38e 100644 --- a/tests/common/test_utils.ml +++ b/tests/common/test_utils.ml @@ -9,10 +9,10 @@ let default d = function | Some x -> x let p = function - | "" -> Datakit_path.empty - | path -> Datakit_path.of_string_exn path + | "" -> Datakit_client.Path.empty + | path -> Datakit_client.Path.of_string_exn path -let ( / ) = Datakit_path.Infix.( / ) +let ( / ) = Datakit_client.Path.Infix.( / ) let v = Cstruct.of_string diff --git a/tests/datakit-bridge-github/test.ml b/tests/datakit-bridge-github/test.ml index 1f80ac50d..bf685072a 100644 --- a/tests/datakit-bridge-github/test.ml +++ b/tests/datakit-bridge-github/test.ml @@ -1,7 +1,8 @@ open Astring open Test_utils open Lwt.Infix -open Datakit_path.Infix +open Datakit_client +open Datakit_client.Path.Infix open Datakit_github open Result @@ -1169,7 +1170,7 @@ module Make (DK: Test_client.S) = struct API.apply_events t; t - let root { Repo.user; repo } = Datakit_path.(empty / user / repo) + let root { Repo.user; repo } = Path.(empty / user / repo) let run_with_test_test f () = DK.run (fun dkt -> @@ -1267,7 +1268,7 @@ module Make (DK: Test_client.S) = struct DK.Branch.with_transaction br (fun tr -> let dir = root repo / "commit" / commit / "status" - /@ Datakit_path.of_steps_exn context + /@ Path.of_steps_exn context in DK.Transaction.make_dirs tr dir >>*= fun () -> let state = Cstruct.of_string (Status_state.to_string state ^ "\n") in @@ -1506,7 +1507,7 @@ module Make (DK: Test_client.S) = struct DK.Tree.read_dir tree path >>= function | Error _ -> Lwt.return [] | Ok items -> - let open Datakit_path.Infix in + let open Path.Infix in DK.Tree.read_file tree (path / "state") >>= begin function | Error _ -> Lwt.return [] | Ok status -> @@ -1539,21 +1540,21 @@ module Make (DK: Test_client.S) = struct | Error x -> failwith (Fmt.to_to_string DK.pp_error x) let read_commits tree ~user ~repo = - let path = Datakit_path.of_steps_exn [user; repo; "commit"] in + let path = Path.of_steps_exn [user; repo; "commit"] in read_opt_dir tree path >>= Lwt_list.map_p (fun commit -> let path = - Datakit_path.of_steps_exn [user; repo; "commit"; commit; "status"] + Path.of_steps_exn [user; repo; "commit"; commit; "status"] in read_state ~user ~repo ~commit tree path [] >>= fun states -> Lwt.return (commit, states) ) let read_prs tree ~user ~repo = - let path = Datakit_path.of_steps_exn [user; repo; "pr"] in + let path = Path.of_steps_exn [user; repo; "pr"] in read_opt_dir tree path >>= Lwt_list.map_p (fun number -> - let path = Datakit_path.of_steps_exn [user; repo; "pr"; number] in + let path = Path.of_steps_exn [user; repo; "pr"; number] in let number = int_of_string number in let read name = DK.Tree.read_file tree (path / name) >>*= fun data -> @@ -1568,9 +1569,9 @@ module Make (DK: Test_client.S) = struct ) let read_refs tree ~user ~repo = - let path = Datakit_path.of_steps_exn [user; repo; "ref"] in + let path = Path.of_steps_exn [user; repo; "ref"] in let rec aux acc name = - let path = Datakit_path.(path /@ of_steps_exn name) in + let path = Path.(path /@ of_steps_exn name) in DK.Tree.read_file tree (path / "head") >|= begin function | Error _ -> acc | Ok head -> @@ -1599,12 +1600,12 @@ module Make (DK: Test_client.S) = struct let state_of_branch b = expect_head b >>*= fun head -> DK.Commit.tree head >>*= fun tree -> - DK.Tree.read_dir tree Datakit_path.empty >>*= + DK.Tree.read_dir tree Path.empty >>*= Lwt_list.fold_left_s (fun acc user -> - DK.Tree.exists_dir tree Datakit_path.(empty / user) >>*= function + DK.Tree.exists_dir tree Path.(empty / user) >>*= function | false -> Lwt.return acc | true -> - let path = Datakit_path.of_steps_exn [user] in + let path = Path.of_steps_exn [user] in DK.Tree.read_dir tree path >>*= Lwt_list.fold_left_s (fun acc repo -> safe_exists_file tree (path / repo / ".monitor") >>= function @@ -1748,7 +1749,7 @@ module Make (DK: Test_client.S) = struct let events = Users.diff_events users (Users.empty ()) in DK.Branch.with_transaction branch (fun tr -> Lwt_list.iter_p (fun { Repo.user; repo } -> - safe_remove tr Datakit_path.(empty / user / repo) + safe_remove tr Path.(empty / user / repo) ) (Repo.Set.elements all_repos) >>= fun () -> Lwt_list.iter_p (Conv.update_event tr) events >>= fun () ->