Move to Eio

.github/workflows/test.yml

@@ -12,11 +12,8 @@ jobs:
         os:
           - macos-latest
         ocaml-version:
-          - 4.12.0
-          - 4.11.1
-          - 4.10.2
-          - 4.09.1
-          - 4.08.1
+          - 5.1.1
+          - 5.1.0
 
     runs-on: ${{ matrix.os }}
 

.ocamlformat

@@ -1,4 +1,4 @@
-version = 0.18.0
+version = 0.26.1
 break-infix = fit-or-vertical
 parse-docstrings = true
 indicate-multiline-delimiters = no

CHANGES.md

@@ -1,5 +1,6 @@
 ### Pending
 
+- Move to Eio (#37, @patricoferris, @clecat)
 - Use _WIN32 and MAX_PATH on Windows to support MSVC (#34, @jonahbeckford)
 
 ### 0.5.0 (2020-04-30)

dune-project

@@ -1,34 +1,55 @@
 (lang dune 2.8)
+
 (name irmin-watcher)
 
 (generate_opam_files true)
 
-(source (github mirage/irmin-watcher))
+(source
+ (github mirage/irmin-watcher))
+
 (license ISC)
+
 (authors "Thomas Gazagnaire")
+
 (maintainers "Thomas Gazagnaire")
+
 (documentation "https://mirage.github.io/irmin-watcher/")
 
 (package
  (name irmin-watcher)
  (synopsis "Portable Irmin watch backends using FSevents or Inotify")
- (description "irmin-watcher implements [Irmin's watch hooks][watch] for various OS,
-using FSevents in macOS and Inotify on Linux.
-
-irmin-watcher is distributed under the ISC license.
-
-[watch]: http://mirage.github.io/irmin/irmin/Irmin/Private/Watch/index.html#type-hook
-")
+ (description
+  "irmin-watcher implements [Irmin's watch hooks][watch] for various OS,\nusing FSevents in macOS and Inotify on Linux.\n\nirmin-watcher is distributed under the ISC license.\n\n[watch]: http://mirage.github.io/irmin/irmin/Irmin/Private/Watch/index.html#type-hook\n")
  (depends
-   (ocaml (>= "4.02.0"))
-   (alcotest :with-test)
-   (mtime (and :with-test (>= "2.0.0")))
-   (inotify (= :os "linux"))
-   (cf-lwt (>="0.4"))
-   lwt
-   logs
-   fmt
-   astring
-   fsevents-lwt
- )
-)
+  (ocaml
+   (>= "5.1.0"))
+  (alcotest :with-test)
+  (mtime
+   (and
+    :with-test
+    (>= "2.0.0")))
+  (inotify
+   (and
+    (>= "2.6")
+    (= :os "linux")))
+  (inotify-eio
+   (and
+    (>= "2.6")
+    (= :os "linux")))
+  (cf-lwt
+   (>= "0.4"))
+  lwt
+  (eio
+   (>= "1.0"))
+  (eio_main
+   (and
+    :with-test
+    (>= "1.0")))
+  logs
+  fmt
+  astring
+  fsevents-lwt
+  (lwt_eio
+   (or
+    :with-test
+    (= :os "macos")))))

irmin-watcher.opam

@@ -17,16 +17,20 @@ doc: "https://mirage.github.io/irmin-watcher/"
 bug-reports: "https://github.com/mirage/irmin-watcher/issues"
 depends: [
   "dune" {>= "2.8"}
-  "ocaml" {>= "4.02.0"}
+  "ocaml" {>= "5.1.0"}
   "alcotest" {with-test}
   "mtime" {with-test & >= "2.0.0"}
-  "inotify" {os = "linux"}
+  "inotify" {>= "2.6" & os = "linux"}
+  "inotify-eio" {>= "2.6" & os = "linux"}
   "cf-lwt" {>= "0.4"}
   "lwt"
+  "eio" {>= "1.0"}
+  "eio_main" {with-test & >= "1.0"}
   "logs"
   "fmt"
   "astring"
   "fsevents-lwt"
+  "lwt_eio" {with-test | os = "macos"}
   "odoc" {with-doc}
 ]
 build: [

src/backend.fsevents.ml

@@ -11,69 +11,73 @@ let src = Logs.Src.create "irw-fsevents" ~doc:"Irmin watcher using FSevents"
 module Log = (val Logs.src_log src : Logs.LOG)
 
 let create_flags = Fsevents.CreateFlags.detailed_interactive
-
 let run_loop_mode = Cf.RunLoop.Mode.Default
 
 let start_runloop dir =
+  let dir = Eio.Path.native_exn dir in
   Log.debug (fun l -> l "start_runloop %s" dir);
   let watcher = Fsevents_lwt.create 0. create_flags [ dir ] in
   let stream = Fsevents_lwt.stream watcher in
   let event_stream = Fsevents_lwt.event_stream watcher in
-  Cf_lwt.RunLoop.run_thread (fun runloop ->
-      Fsevents.schedule_with_run_loop event_stream runloop run_loop_mode;
-      if not (Fsevents.start event_stream) then
-        prerr_endline "failed to start FSEvents stream")
-  >|= fun _scheduler ->
+  let _scheduler =
+    Lwt_eio.run_lwt @@ fun () ->
+    Cf_lwt.RunLoop.run_thread (fun runloop ->
+        Fsevents.schedule_with_run_loop event_stream runloop run_loop_mode;
+        if not (Fsevents.start event_stream) then
+          prerr_endline "failed to start FSEvents stream")
+  in
   (* FIXME: should probably do something with the scheduler *)
   let stop_scheduler () =
-    Fsevents_lwt.flush watcher >|= fun () ->
+    (Lwt_eio.run_lwt @@ fun () -> Fsevents_lwt.flush watcher);
     Fsevents_lwt.stop watcher;
     Fsevents_lwt.invalidate watcher;
     Fsevents_lwt.release watcher
   in
   (stream, stop_scheduler)
 
-let listen stream fn =
+let listen ~sw dir stream fn =
   let path_of_event { Fsevents_lwt.path; _ } = path in
   let iter () =
     Lwt_stream.iter_s
       (fun e ->
-        let path = path_of_event e in
-        Log.debug (fun l -> l "fsevents: %s" path);
+        let path = Eio.Path.(dir / path_of_event e) in
+        Log.debug (fun l -> l "fsevents: %a" Eio.Path.pp path);
         fn @@ path)
       stream
   in
-  Core.stoppable iter
+  Core.stoppable ~sw (fun () -> Lwt_eio.run_lwt iter)
 
 (* Note: we use FSevents to detect any change, and we re-read the full
    tree on every change (so very similar to active polling, but
    blocking on incoming FSevents instead of sleeping). We could
    probably do better, but at the moment it is more robust to do so,
    to avoid possible duplicated events. *)
-let v =
+let v ~sw =
   let listen dir f =
     Log.info (fun l -> l "FSevents mode");
     let events = ref [] in
     let cond = Lwt_condition.create () in
-    start_runloop dir >>= fun (stream, stop_runloop) ->
+    let stream, stop_runloop = start_runloop dir in
     let rec wait_for_changes () =
       match List.rev !events with
       | [] -> Lwt_condition.wait cond >>= wait_for_changes
       | h :: t ->
           events := List.rev t;
           Lwt.return (`File h)
     in
+    let wait_for_changes () = Lwt_eio.run_lwt wait_for_changes in
     let unlisten =
-      listen stream (fun path ->
+      listen ~sw dir stream (fun path ->
           events := path :: !events;
           Lwt_condition.signal cond ();
           Lwt.return_unit)
     in
-    Hook.v ~wait_for_changes ~dir f >|= fun unpoll () ->
-    stop_runloop () >>= fun () ->
-    unlisten () >>= fun () -> unpoll ()
+    Hook.v ~sw ~wait_for_changes ~dir f |> fun unpoll () ->
+    stop_runloop ();
+    unlisten ();
+    unpoll ()
   in
-  lazy (Core.create listen)
+  Core.create listen
 
 let mode = `FSEvents
 

src/backend.fsevents.mli

@@ -8,7 +8,7 @@
 
     {e %%VERSION%% — {{:%%PKG_HOMEPAGE%%} homepage}} *)
 
-val v : Core.t Lazy.t
+val v : sw:Eio.Switch.t -> Core.t
 (** [v id p f] is the hook calling [f] everytime a sub-path of [p] is modified.
     Return a function to call to remove the hook. Use the FSevent framework to
     be notified on filesystem changes. *)

src/backend.inotify.ml

@@ -4,81 +4,77 @@
    %%NAME%% %%VERSION%%
   ---------------------------------------------------------------------------*)
 
-open Lwt.Infix
-
 let src = Logs.Src.create "irw-inotify" ~doc:"Irmin watcher using Inotify"
 
 module Log = (val Logs.src_log src : Logs.LOG)
 
-let rec mkdir d =
+let mkdir d =
   let perm = 0o0700 in
-  try Unix.mkdir d perm with
-  | Unix.Unix_error (Unix.EEXIST, "mkdir", _) -> ()
-  | Unix.Unix_error (Unix.ENOENT, "mkdir", _) ->
-      mkdir (Filename.dirname d);
-      Unix.mkdir d perm
+  Eio.Path.mkdirs ~perm d
 
 let start_watch dir =
-  Log.debug (fun l -> l "start_watch %s" dir);
-  if not (Sys.file_exists dir) then mkdir dir;
-  Lwt_inotify.create () >>= fun i ->
-  Lwt_inotify.add_watch i dir
-    [ Inotify.S_Create; Inotify.S_Modify; Inotify.S_Move; Inotify.S_Delete ]
-  >|= fun u ->
-  let stop () = Lwt_inotify.rm_watch i u >>= fun () -> Lwt_inotify.close i in
+  Log.debug (fun l -> l "start_watch %a" Eio.Path.pp dir);
+  if Eio.Path.kind ~follow:false dir = `Not_found then mkdir dir;
+  let i = Eio_inotify.create () in
+  let u =
+    Eio_inotify.add_watch i (Eio.Path.native_exn dir)
+      [ Inotify.S_Create; Inotify.S_Modify; Inotify.S_Move; Inotify.S_Delete ]
+  in
+  let stop () =
+    Eio_inotify.rm_watch i u;
+    Eio_inotify.close i
+  in
   (i, stop)
 
-let listen dir i fn =
+let listen ~sw dir i fn =
   let event_kinds (_, es, _, _) = es in
   let pp_kind = Fmt.of_to_string Inotify.string_of_event_kind in
   let path_of_event (_, _, _, p) =
-    match p with None -> dir | Some p -> Filename.concat dir p
+    match p with None -> dir | Some p -> Eio.Path.(dir / p)
   in
   let rec iter i =
-    Lwt.try_bind
-      (fun () ->
-        Lwt_inotify.read i >>= fun e ->
-        let path = path_of_event e in
-        let es = event_kinds e in
-        Log.debug (fun l -> l "inotify: %s %a" path Fmt.(Dump.list pp_kind) es);
-        fn path;
-        Lwt.return_unit)
-      (fun () -> iter i)
-      (function
-        | Unix.Unix_error (Unix.EBADF, _, _) ->
-            Lwt.return_unit (* i has just been closed by {!stop} *)
-        | e -> Lwt.fail e)
+    let e = Eio_inotify.read i in
+    let path = path_of_event e in
+    let es = event_kinds e in
+    Log.debug (fun l ->
+        l "inotify: %a %a" Eio.Path.pp path Fmt.(Dump.list pp_kind) es);
+    fn path;
+    iter i
   in
-  Core.stoppable (fun () -> iter i)
+  Core.stoppable ~sw (fun () -> iter i)
 
 (* Note: we use Inotify to detect any change, and we re-read the full
    tree on every change (so very similar to active polling, but
    blocking on incoming Inotify events instead of sleeping). We could
    probably do better, but at the moment it is more robust to do so,
    to avoid possible duplicated events. *)
-let v =
+let v ~sw =
+  let open Eio in
   let listen dir f =
     Log.info (fun l -> l "Inotify mode");
     let events = ref [] in
-    let cond = Lwt_condition.create () in
-    start_watch dir >>= fun (i, stop_watch) ->
+    let cond = Condition.create () in
+    let i, stop_watch = start_watch dir in
     let rec wait_for_changes () =
       match List.rev !events with
-      | [] -> Lwt_condition.wait cond >>= wait_for_changes
+      | [] ->
+          Condition.await_no_mutex cond;
+          wait_for_changes ()
       | h :: t ->
           events := List.rev t;
-          Lwt.return (`File h)
+          `File h
     in
     let unlisten =
-      listen dir i (fun path ->
+      listen ~sw dir i (fun path ->
           events := path :: !events;
-          Lwt_condition.signal cond ())
+          Condition.broadcast cond)
     in
-    Hook.v ~wait_for_changes ~dir f >|= fun unpoll () ->
-    stop_watch () >>= fun () ->
-    unlisten () >>= fun () -> unpoll ()
+    Hook.v ~sw ~wait_for_changes ~dir f |> fun unpoll () ->
+    stop_watch ();
+    unlisten ();
+    unpoll ()
   in
-  lazy (Core.create listen)
+  Core.create listen
 
 let mode = `Inotify
 

src/backend.inotify.mli

@@ -8,7 +8,7 @@
 
     {e %%VERSION%% — {{:%%PKG_HOMEPAGE%%} homepage}} *)
 
-val v : Core.t Lazy.t
+val v : sw:Eio.Switch.t -> Core.t
 (** [v id p f] is the hook calling [f] everytime a sub-path of [p] is modified.
     Return a function to call to remove the hook. Use inofity to be notified on
     filesystem changes. *)