Fix feeback & CI

.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 }}
 

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,46 @@
 (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
+   (= :os "linux"))
+  (cf-lwt
+   (>= "0.4"))
+  lwt
+  (eio
+   (>= "1.0"))
+  (eio_main
+   (and
+    :with-test
+    (>= "1.0")))
+  logs
+  fmt
+  astring
+  fsevents-lwt
+  lwt_eio))

irmin-watcher.opam

@@ -17,16 +17,19 @@ 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"}
   "cf-lwt" {>= "0.4"}
   "lwt"
+  "eio" {>= "1.0"}
+  "eio_main" {with-test & >= "1.0"}
   "logs"
   "fmt"
   "astring"
   "fsevents-lwt"
+  "lwt_eio"
   "odoc" {with-doc}
 ]
 build: [
@@ -44,3 +47,6 @@ build: [
   ]
 ]
 dev-repo: "git+https://github.com/mirage/irmin-watcher.git"
+pin-depends: [
+  [ "inotify.dev" "git+https://github.com/whitequark/ocaml-inotify#b9cadad68ef3f4965853ea693171adf1d18c0599" ]
+]

irmin-watcher.opam.template

@@ -0,0 +1,3 @@
+pin-depends: [
+  [ "inotify.dev" "git+https://github.com/whitequark/ocaml-inotify#b9cadad68ef3f4965853ea693171adf1d18c0599" ]
+]

src/backend.fsevents.ml

@@ -18,21 +18,23 @@ let start_runloop 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 stream fn =
   let path_of_event { Fsevents_lwt.path; _ } = path in
   let iter () =
     Lwt_stream.iter_s
@@ -42,35 +44,37 @@ let listen stream fn =
         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 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)
 

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 Lazy.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,8 +4,6 @@
    %%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)
@@ -47,8 +45,6 @@ let listen ~sw dir i fn =
       fn path
     with
     | () -> iter i
-    | exception Unix.Unix_error (Unix.EBADF, _, _) ->
-        () (* i has just been closed by {!stop} *)
     | exception e -> raise e
   in
   Core.stoppable ~sw (fun () -> iter i)
@@ -58,10 +54,9 @@ let listen ~sw dir i fn =
    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 () =
-    let sw = Hook.top_switch () in
+  let listen dir f =
     Log.info (fun l -> l "Inotify mode");
     let events = ref [] in
     let cond = Condition.create () in
@@ -76,13 +71,13 @@ let v =
           `File h
     in
     let unlisten =
-      listen dir i (fun path ->
+      listen ~sw dir i (fun path ->
           events := path :: !events;
           Condition.broadcast cond)
     in
-    let unpoll = Hook.v ~sw ~wait_for_changes ~dir f in
+    Hook.v ~sw ~wait_for_changes ~dir f |> fun unpoll () ->
     stop_watch ();
-    unlisten ~sw ();
+    unlisten ();
     unpoll ()
   in
   lazy (Core.create listen)

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 Lazy.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. *)

src/core.ml

@@ -14,9 +14,10 @@ module Log = (val Logs.src_log src : Logs.LOG)
 (* run [t] and returns an handler to stop the task. *)
 let stoppable ~sw t =
   let p, r = Promise.create () in
-  Fiber.fork ~sw (fun () ->
-      Fiber.both (fun () -> Promise.await_exn p) (fun () -> t ()));
-  fun () -> Promise.resolve_error r (Failure "Cancelled")
+  Fiber.fork_daemon ~sw (fun () ->
+      Fiber.first (fun () -> Promise.await_exn p) (fun () -> t ());
+      `Stop_daemon);
+  fun () -> Promise.resolve r (Ok ())
 
 external unix_realpath : string -> string = "irmin_watcher_unix_realpath"
 

src/dune

@@ -8,17 +8,16 @@
   fmt
   logs
   astring
-  lwt_eio
   eio.unix
   (select
    backend.ml
    from
-   (cf-eio fsevents-eio -> backend.fsevents.ml)
-   (inotify.eio -> backend.inotify.ml)
-   (lwt.unix -> backend.polling.ml))
+   (cf-lwt fsevents-lwt lwt_eio -> backend.fsevents.ml)
+   (inotify-eio -> backend.inotify.ml)
+   (eio -> backend.polling.ml))
   (select
    backend.mli
    from
-   (cf-eio fsevents-eio -> backend.fsevents.mli)
-   (inotify.eio -> backend.inotify.mli)
-   (lwt.unix -> backend.polling.mli))))
+   (cf-lwt fsevents-lwt lwt_eio -> backend.fsevents.mli)
+   (inotify-eio -> backend.inotify.mli)
+   (eio -> backend.polling.mli))))

src/hook.mli

@@ -20,7 +20,7 @@ val v :
   Watchdog.hook
 (** [v ~sw ~wait_for_changes ~dir] is the watchdog hook using [wait_for_changes]
     to detect filesystem updates in the directory [dir]. The polling
-    implemention just calls [Lwt_unix.sleep]. The switch is used for the forked
+    implemention just calls [Eio_unix.sleep]. The switch is used for the forked
     callback function. *)
 
 (*---------------------------------------------------------------------------

test/dune

@@ -1,6 +1,13 @@
 (executable
  (name test)
- (libraries alcotest logs.fmt eio_main irmin-watcher mtime mtime.clock.os))
+ (libraries
+  alcotest
+  logs.fmt
+  eio_main
+  lwt_eio
+  irmin-watcher
+  mtime
+  mtime.clock.os))
 
 (rule
  (alias runtest)

test/test.ml

@@ -64,7 +64,7 @@ let poll ~mkdir:m i () =
 
   write "foo" ("foo" ^ string_of_int i);
   let events = wait () in
-  Alcotest.(check (slist string String.compare)) "updte foo" [ "foo" ] events;
+  Alcotest.(check (slist string String.compare)) "update foo" [ "foo" ] events;
 
   remove "foo";
   let events = wait () in
@@ -151,7 +151,8 @@ let reporter () =
   { Logs.report }
 
 let () =
-  Eio_main.run @@ fun _env ->
+  Eio_main.run @@ fun env ->
+  Lwt_eio.with_event_loop ~clock:env#clock @@ fun _ ->
   Logs.set_level (Some Logs.Debug);
   Logs.set_reporter (reporter ());
   Irmin_watcher.set_polling_time 0.1;