Skip to content
Permalink
Browse files

dune build @fmt

with ocamlformat 0.11.0
  • Loading branch information...
samoht committed Aug 8, 2019
1 parent 8e06238 commit 3427c60c729aa6d9feb52a5e65d803614ec23793
Showing with 2,067 additions and 1,968 deletions.
  1. +1 −0 .ocamlformat
  2. +4 −4 examples/custom_merge.ml
  3. +48 −32 examples/process.ml
  4. +10 −13 examples/readme.ml
  5. +1 −1 examples/trees.ml
  6. +5 −5 src/irmin-chunk/irmin_chunk.ml
  7. +2 −2 src/irmin-chunk/irmin_chunk.mli
  8. +9 −8 src/irmin-fs/irmin_fs.ml
  9. +2 −2 src/irmin-fs/irmin_fs.mli
  10. +58 −50 src/irmin-git/irmin_git.ml
  11. +35 −32 src/irmin-git/irmin_git.mli
  12. +94 −71 src/irmin-graphql/server.ml
  13. +8 −8 src/irmin-graphql/server.mli
  14. +14 −12 src/irmin-http/irmin_http.ml
  15. +9 −9 src/irmin-http/irmin_http.mli
  16. +23 −18 src/irmin-http/irmin_http_server.ml
  17. +2 −2 src/irmin-http/irmin_http_server.mli
  18. +3 −3 src/irmin-mem/irmin_mem.ml
  19. +4 −4 src/irmin-mem/irmin_mem.mli
  20. +28 −50 src/irmin-mirage/git/irmin_mirage_git.ml
  21. +33 −33 src/irmin-mirage/git/irmin_mirage_git.mli
  22. +2 −2 src/irmin-mirage/graphql/irmin_mirage_graphql.ml
  23. +3 −3 src/irmin-mirage/graphql/irmin_mirage_graphql.mli
  24. +1 −2 src/irmin-mirage/irmin_mirage.ml
  25. +8 −6 src/irmin-pack/IO.ml
  26. +1 −1 src/irmin-pack/dict.ml
  27. +115 −110 src/irmin-pack/inode.ml
  28. +4 −4 src/irmin-pack/inode.mli
  29. +9 −9 src/irmin-pack/irmin_pack.ml
  30. +10 −10 src/irmin-pack/irmin_pack.mli
  31. +3 −3 src/irmin-pack/lru.ml
  32. +24 −22 src/irmin-pack/pack.ml
  33. +1 −1 src/irmin-pack/pack.mli
  34. +8 −7 src/irmin-test/common.ml
  35. +12 −10 src/irmin-test/irmin_bench.ml
  36. +5 −5 src/irmin-test/irmin_test.mli
  37. +1 −1 src/irmin-test/rusage.ml
  38. +61 −44 src/irmin-test/store.ml
  39. +71 −51 src/irmin-unix/cli.ml
  40. +3 −3 src/irmin-unix/cli.mli
  41. +15 −15 src/irmin-unix/fs.ml
  42. +6 −6 src/irmin-unix/graphql.ml
  43. +10 −10 src/irmin-unix/graphql.mli
  44. +9 −9 src/irmin-unix/http.mli
  45. +1 −1 src/irmin-unix/info.ml
  46. +66 −66 src/irmin-unix/irmin_unix.mli
  47. +16 −14 src/irmin-unix/resolver.ml
  48. +1 −1 src/irmin-unix/resolver.mli
  49. +24 −42 src/irmin-unix/xgit.ml
  50. +58 −76 src/irmin-unix/xgit.mli
  51. +22 −20 src/irmin/commit.ml
  52. +12 −12 src/irmin/commit.mli
  53. +3 −3 src/irmin/conf.ml
  54. +10 −9 src/irmin/contents.ml
  55. +3 −3 src/irmin/contents.mli
  56. +3 −3 src/irmin/diff.ml
  57. +9 −11 src/irmin/dot.ml
  58. +4 −4 src/irmin/irmin.ml
  59. +227 −226 src/irmin/irmin.mli
  60. +38 −39 src/irmin/merge.ml
  61. +20 −19 src/irmin/node.ml
  62. +22 −22 src/irmin/node.mli
  63. +7 −6 src/irmin/object_graph.ml
  64. +10 −10 src/irmin/object_graph.mli
  65. +1 −1 src/irmin/path.ml
  66. +33 −32 src/irmin/s.ml
  67. +7 −6 src/irmin/slice.ml
  68. +3 −3 src/irmin/slice.mli
  69. +40 −34 src/irmin/store.ml
  70. +13 −13 src/irmin/store.mli
  71. +42 −42 src/irmin/sync_ext.ml
  72. +198 −191 src/irmin/tree.ml
  73. +4 −4 src/irmin/tree.mli
  74. +68 −49 src/irmin/type.ml
  75. +18 −17 src/irmin/watch.ml
  76. +9 −6 test/irmin-chunk/test.ml
  77. +2 −2 test/irmin-chunk/test_chunk.ml
  78. +12 −8 test/irmin-git/test_git.ml
  79. +1 −1 test/irmin-http/test.ml
  80. +6 −5 test/irmin-http/test_http.ml
  81. +4 −3 test/irmin-pack/test_pack.ml
  82. +1 −1 test/irmin-unix/test.ml
  83. +1 −1 test/irmin-unix/test_unix.ml
  84. +273 −269 test/irmin/test.ml
@@ -1 +1,2 @@
version = 0.11.0
profile = conventional
@@ -43,8 +43,8 @@ end = struct
match String.cut ~sep:": " str with
| None -> Error (`Msg ("invalid entry: " ^ str))
| Some (x, message) -> (
try Ok { timestamp = Int64.of_string x; message }
with Failure e -> Error (`Msg e) )
try Ok { timestamp = Int64.of_string x; message }
with Failure e -> Error (`Msg e) )

let t =
let open Irmin.Type in
@@ -79,7 +79,7 @@ end = struct
(fun acc l ->
match Irmin.Type.of_string Entry.t l with
| Ok x -> x :: acc
| Error (`Msg e) -> failwith e )
| Error (`Msg e) -> failwith e)
[] lines
|> fun l -> Ok l
with Failure e -> Error (`Msg e)
@@ -129,7 +129,7 @@ let log t fmt =
(fun message ->
all_logs t >>= fun logs ->
let logs = Log.add logs (Entry.v message) in
Store.set_exn t ~info:(info "Adding a new entry") log_file logs )
Store.set_exn t ~info:(info "Adding a new entry") log_file logs)
fmt

let print_logs name t =
@@ -9,61 +9,77 @@ let fin () =

type action = {
message : string;
files : (string list * (unit -> string)) list
files : (string list * (unit -> string)) list;
}

type image = { name : string; actions : action list }

let ubuntu =
{ name = "official-images/ubuntu:14.04";
{
name = "official-images/ubuntu:14.04";
actions =
[ { message = "Updating source lists";
[
{
message = "Updating source lists";
files =
[ ( [ "etc"; "source.list" ],
fun () -> sprintf "deb %d" (Random.int 10) )
]
[
( [ "etc"; "source.list" ],
fun () -> sprintf "deb %d" (Random.int 10) );
];
};
{ message = "grep -v '^#' /etc/apt/sources.list"; files = [] };
{ message = "cat /etc/issue"; files = [] }
]
{ message = "cat /etc/issue"; files = [] };
];
}

let wordpress =
{ name = "official-images/wordpress:latest";
{
name = "official-images/wordpress:latest";
actions =
[ { message = "user logging";
[
{
message = "user logging";
files =
[ ( [ "wordpress"; "wp-users.php" ],
fun () -> sprintf "<?php ...%d" (Random.int 10) )
]
[
( [ "wordpress"; "wp-users.php" ],
fun () -> sprintf "<?php ...%d" (Random.int 10) );
];
};
{ message = "configuration updates";
{
message = "configuration updates";
files =
[ ( [ "wordpress"; "wp-settings.php" ],
fun () -> sprintf "<?php .. %d" (Random.int 10) )
]
}
]
[
( [ "wordpress"; "wp-settings.php" ],
fun () -> sprintf "<?php .. %d" (Random.int 10) );
];
};
];
}

let mysql =
{ name = "local/mysql:5.5.41";
{
name = "local/mysql:5.5.41";
actions =
[ { message = "Reading table wp_users"; files = [] };
{ message = "Writing table wp_users";
[
{ message = "Reading table wp_users"; files = [] };
{
message = "Writing table wp_users";
files =
[ ( [ "var"; "lib"; "mysql" ],
fun () -> sprintf "X%duYYt" (Random.int 10) )
]
[
( [ "var"; "lib"; "mysql" ],
fun () -> sprintf "X%duYYt" (Random.int 10) );
];
};
{ message = "Reading table wp_posts"; files = [] };
{ message = "Writing table wp_posts";
{
message = "Writing table wp_posts";
files =
[ ( [ "var"; "lib"; "mysql" ],
fun () -> sprintf "X%dxYYt" (Random.int 10) )
]
}
]
[
( [ "var"; "lib"; "mysql" ],
fun () -> sprintf "X%dxYYt" (Random.int 10) );
];
};
];
}

let branch image = String.map (function ':' -> '/' | c -> c) image.name
@@ -131,7 +147,7 @@ let rec protect fn x =
(fun () -> fn x)
(fun e ->
Printf.eprintf "error: %s" (Printexc.to_string e);
protect fn x )
protect fn x)

let rec watchdog () =
Printf.printf "I'm alive!\n%!";
@@ -1,7 +1,7 @@
open Lwt.Infix

(* Irmin store with string contents *)
module Store = Irmin_unix.Git.FS.KV(Irmin.Contents.String)
module Store = Irmin_unix.Git.FS.KV (Irmin.Contents.String)

(* Database configuration *)
let config = Irmin_git.config ~bare:true "/tmp/irmin/test"
@@ -13,18 +13,15 @@ let author = "Example <example@example.com>"
let info fmt = Irmin_unix.info ~author fmt

let main =
(* Open the repo *)
Store.Repo.v config >>=

(* Load the master branch *)
Store.master >>= fun t ->

(* Set key "foo/bar" to "testing 123" *)
Store.set_exn t ~info:(info "Updating foo/bar") ["foo"; "bar"] "testing 123" >>= fun () ->

(* Get key "foo/bar" and print it to stdout *)
Store.get t ["foo"; "bar"] >|= fun x ->
Printf.printf "foo/bar => '%s'\n" x
(* Open the repo *)
Store.Repo.v config >>= (* Load the master branch *)
Store.master >>= fun t ->
(* Set key "foo/bar" to "testing 123" *)
Store.set_exn t ~info:(info "Updating foo/bar") [ "foo"; "bar" ]
"testing 123"
>>= fun () ->
(* Get key "foo/bar" and print it to stdout *)
Store.get t [ "foo"; "bar" ] >|= fun x -> Printf.printf "foo/bar => '%s'\n" x

(* Run the program *)
let () = Lwt_main.run main
@@ -16,7 +16,7 @@ let tree_of_t t =
(fun (v, i) t2 ->
let si = string_of_int i in
Tree.add v [ si; "x" ] t2.x >>= fun v ->
Tree.add v [ si; "y" ] (string_of_int t2.y) >|= fun v -> (v, i + 1) )
Tree.add v [ si; "y" ] (string_of_int t2.y) >|= fun v -> (v, i + 1))
(Tree.empty, 0) t
>|= fun (v, _) -> v

@@ -76,8 +76,8 @@ module Chunk (K : Irmin.Hash.S) = struct

let v =
let open Irmin.Type in
variant "chunk" (fun d i -> function
| Data data -> d data | Index index -> i index )
variant "chunk" (fun d i ->
function Data data -> d data | Index index -> i index)
|~ case1 "Data" string (fun d -> Data d)
|~ case1 "Index" (list ~len:`Int16 K.t) (fun i -> Index i)
|> sealv
@@ -133,7 +133,7 @@ struct
(* the size of chunks. *)
max_children : int;
(* the maximum number of children a node can have. *)
max_data : int
max_data : int;
(* the maximum length (in bytes) of data stored in one
chunk. *)
}
@@ -161,7 +161,7 @@ struct
(fun acc key ->
CA.find t.db key >>= function
| None -> Lwt.return acc
| Some v -> aux acc v )
| Some v -> aux acc v)
acc i
in
aux [] root >|= List.rev
@@ -206,7 +206,7 @@ struct
err_too_small ~min chunk_size );
Log.debug (fun l ->
l "config: chunk-size=%d digest-size=%d max-data=%d max-children=%d"
chunk_size K.hash_size max_data max_children );
chunk_size K.hash_size max_data max_children);
CA.v config >|= fun db ->
{ chunking; db; chunk_size; max_children; max_data }

@@ -82,7 +82,7 @@ val config :
the smaller [size] is, the bigger the risk of hash collisions, so
use reasonable values. *)

(** [Content_addressable(X)] is a content-addressable store which store values
cut into chunks into the underlying store [X]. *)
module Content_addressable (S : Irmin.APPEND_ONLY_STORE_MAKER) :
Irmin.CONTENT_ADDRESSABLE_STORE_MAKER
(** [Content_addressable(X)] is a content-addressable store which store values
cut into chunks into the underlying store [X]. *)
@@ -126,7 +126,7 @@ struct
if n <= p + 1 then acc
else
let file = String.with_range file ~first:(p + 1) in
file :: acc )
file :: acc)
[] files
in
List.fold_left
@@ -135,7 +135,7 @@ struct
| Ok k -> k :: acc
| Error (`Msg e) ->
Log.err (fun l -> l "Irmin_fs.list: %s" e);
acc )
acc)
[] files
end

@@ -223,7 +223,8 @@ struct
W.watch_key t.w key ?init f >|= fun w -> (w, stop)

let watch t ?init f =
listen_dir t >>= fun stop -> W.watch t.w ?init f >|= fun w -> (w, stop)
listen_dir t >>= fun stop ->
W.watch t.w ?init f >|= fun w -> (w, stop)

let unwatch t (id, stop) = stop () >>= fun () -> W.unwatch t.w id

@@ -319,7 +320,7 @@ module KV (IO : IO) (C : Irmin.Contents.S) =
module IO_mem = struct
type t = {
watches : (string, string -> unit Lwt.t) Hashtbl.t;
files : (string, string) Hashtbl.t
files : (string, string) Hashtbl.t;
}

let t = { watches = Hashtbl.create 3; files = Hashtbl.create 13 }
@@ -345,14 +346,14 @@ module IO_mem = struct
Hashtbl.replace t.watches dir f;
Lwt.return (fun () ->
Hashtbl.remove t.watches dir;
Lwt.return_unit )
Lwt.return_unit)
in
Irmin.Private.Watch.set_listen_dir_hook h

let notify file =
Hashtbl.fold
(fun dir f acc ->
if String.is_prefix ~affix:dir file then f file :: acc else acc )
if String.is_prefix ~affix:dir file then f file :: acc else acc)
t.watches []
|> Lwt_list.iter_p (fun x -> x)

@@ -361,7 +362,7 @@ module IO_mem = struct
let remove_file ?lock file =
with_lock lock (fun () ->
Hashtbl.remove t.files file;
Lwt.return_unit )
Lwt.return_unit)

let rec_files dir =
Hashtbl.fold
@@ -380,7 +381,7 @@ module IO_mem = struct
let write_file ?temp_dir:_ ?lock file v =
with_lock lock (fun () ->
Hashtbl.replace t.files file v;
Lwt.return_unit )
Lwt.return_unit)
>>= fun () -> notify file

let equal x y =
@@ -24,8 +24,8 @@ val config : ?config:Irmin.config -> string -> Irmin.config
module type IO = sig
(** {1 File-system abstractions} *)

(** The type for paths. *)
type path = string
(** The type for paths. *)

(** {2 Read operations} *)

@@ -45,8 +45,8 @@ module type IO = sig
val mkdir : path -> unit Lwt.t
(** Create a directory. *)

(** The type for file locks. *)
type lock
(** The type for file locks. *)

val lock_file : path -> lock
(** [lock_file f] is the lock associated to the file [f]. *)

0 comments on commit 3427c60

Please sign in to comment.
You can’t perform that action at this time.