Switch Inotify to irmin-watcher

Irmin-watcher is a portable, filesystem notification library.
On linux it uses inotify and on macOS it uses fsevents. It has
a portable, if slow, polling mode too.

This makes slipshow installable on macOS.

.ocamlformat

@@ -1 +1 @@
-version=0.26.1
+version=0.26.2

compiler/data/dune

@@ -41,8 +41,10 @@
  (mode promote)
  (action
   (run
-    wget --output-document highlight-js.css.crunch https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/styles/default.min.css
-)))
+   wget
+   --output-document
+   highlight-js.css.crunch
+   https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/styles/default.min.css)))
 
 (rule
  (target highlight-js.js.crunch)
@@ -51,8 +53,10 @@
  (mode promote)
  (action
   (run
-    wget --output-document highlight-js.js.crunch https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/highlight.min.js
-)))
+   wget
+   --output-document
+   highlight-js.js.crunch
+   https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/highlight.min.js)))
 
 (rule
  (target highlight-js.ocaml.js.crunch)
@@ -61,11 +65,10 @@
  (mode promote)
  (action
   (run
-    wget --output-document highlight-js.ocaml.js.crunch https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/languages/ocaml.min.js
-)))
-
-
-
+   wget
+   --output-document
+   highlight-js.ocaml.js.crunch
+   https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/languages/ocaml.min.js)))
 
 ; (rule
 ;  (target "tailwindcss.js")
@@ -97,19 +100,10 @@
    (setenv
     SOURCE_DATE_EPOCH
     0
-    (run
-     ocaml-crunch
-     .
-     -e
-     crunch
-     -o
-     %{x}.corrected
-     -m
-     plain
-     -s))
+    (run ocaml-crunch . -e crunch -o %{x}.corrected -m plain -s))
    (diff? %{x} %{x}.corrected))))
 
 (library
  (name data_files)
-  (public_name slipshow.datafiles)
+ (public_name slipshow.datafiles)
  (wrapped false))

compiler/src/bin/dune

@@ -15,8 +15,7 @@
   fmt.tty
   logs.fmt
   serve
-  serve_native
-  ))
+  serve_native))
 
 (rule
  (deps main.ml)
@@ -41,11 +40,10 @@
   fmt.tty
   logs.fmt
   serve
-  serve_js
-  ))
+  serve_js))
 
 (library
  (name serve)
  (virtual_modules serve)
  (modules serve)
- (libraries fpath slipshow))
+ (libraries fpath slipshow lwt))

compiler/src/bin/native/dune

@@ -2,13 +2,8 @@
  (name serve_native)
  (modes native)
  (implements serve)
- (preprocess (pps ppx_blob))
-  (preprocessor_deps client/client.bc.js)
- (libraries
-   slipshow
-   fpath
-   lwt
-   inotify.lwt
-   dream
-  ; bos
-))
+ (preprocess
+  (pps ppx_blob))
+ (preprocessor_deps
+  (file client/client.bc.js))
+ (libraries slipshow fpath lwt irmin-watcher dream))

compiler/src/bin/native/serve.ml

@@ -1,30 +1,33 @@
+open Lwt.Syntax
+
+(* A promise that never returns and consumes a file
+   unwatcher *)
+let wait_forever (_unwatch : unit -> unit Lwt.t) =
+  let forever, _ = Lwt.wait () in
+  forever
+
 let do_watch input f =
   match input with
   | `Stdin -> Error (`Msg "--watch is incompatible with stdin input")
   | `File input ->
       let parent = Fpath.parent input in
       let parent = Fpath.to_string parent in
       let input_filename = Fpath.filename input in
-      let inotify = Inotify.create () in
-      let _watch_descriptor =
-        Inotify.add_watch inotify parent [ Inotify.S_Close_write ]
+      let callback filename =
+        if String.equal filename input_filename then (
+          Logs.app (fun m -> m "Recompiling");
+          match f () with
+          | Ok _ -> Lwt.return_unit
+          | Error (`Msg s) ->
+              Logs.warn (fun m -> m "%s" s);
+              Lwt.return_unit)
+        else Lwt.return_unit
       in
-      let rec loop () =
-        let events = Inotify.read inotify in
-        List.iter
-          (function
-            | _, _, _, Some filename ->
-                if String.equal filename input_filename then (
-                  Logs.app (fun m -> m "Recompiling");
-                  match f () with
-                  | Ok _ -> ()
-                  | Error (`Msg s) -> Logs.warn (fun m -> m "%s" s))
-                else ()
-            | _ -> ())
-          events;
-        loop ()
+      let main =
+        let* unwatch = Irmin_watcher.hook 0 parent callback in
+        wait_forever unwatch
       in
-      loop ()
+      Lwt_main.run main
 
 let html_source =
   Format.sprintf
@@ -51,7 +54,7 @@ let html_source =
 </body>
 </html>
   |html}
-    [%blob "compiler/src/bin/native/client/client.bc.js"]
+    [%blob "client/client.bc.js"]
 
 let do_serve input f =
   let cond = Lwt_condition.create () in
@@ -64,10 +67,6 @@ let do_serve input f =
         let parent = Fpath.parent input in
         let parent = Fpath.to_string parent in
         let input_filename = Fpath.filename input in
-        let* inotify = Lwt_inotify.create () in
-        let _watch_descriptor =
-          Lwt_inotify.add_watch inotify parent [ Inotify.S_Close_write ]
-        in
         let content = ref "" in
         let new_content =
           match f () with
@@ -92,26 +91,22 @@ let do_serve input f =
                      Dream.respond !content);
                ]
         in
-        let rec loop () =
-          let* _descriptor, _event_kinds, _, filename =
-            Lwt_inotify.read inotify
-          in
-          match filename with
-          | Some filename when String.equal filename input_filename ->
-              Logs.app (fun m -> m "Recompiling");
-              let new_content =
-                match f () with
-                | Ok s -> Slipshow.delayed_to_string s
-                | Error (`Msg s) ->
-                    Logs.warn (fun m -> m "%s" s);
-                    s
-              in
-              content := new_content;
-              Lwt_condition.broadcast cond ();
-              loop ()
-          | _ -> loop ()
+        let callback filename =
+          if String.equal filename input_filename then (
+            Logs.app (fun m -> m "Recompiling");
+            let new_content =
+              match f () with
+              | Ok s -> Slipshow.delayed_to_string s
+              | Error (`Msg s) ->
+                  Logs.warn (fun m -> m "%s" s);
+                  s
+            in
+            content := new_content;
+            Lwt_condition.broadcast cond ());
+          Lwt.return_unit
         in
-        loop ()
+        let* unwatch = Irmin_watcher.hook 0 parent callback in
+        wait_forever unwatch
   in
   Logs.app (fun m ->
       m

dune

@@ -1,7 +1,13 @@
 (rule
- (deps (source_tree src) (source_tree build) (file package.json) (source_tree node_modules) (file babel.config.json))
- (targets (dir staged_dist))
-  (mode promote)
+ (deps
+  (source_tree src)
+  (source_tree build)
+  (file package.json)
+  (source_tree node_modules)
+  (file babel.config.json))
+ (targets
+  (dir staged_dist))
+ (mode promote)
  (action
   (run yarn build-staged)))
 

dune-project

@@ -29,7 +29,7 @@
    base64
    bos
    lwt
-   inotify
+   irmin-watcher
    js_of_ocaml-compiler
    js_of_ocaml-lwt
    magic-mime

previewer/dune

@@ -1,9 +1,4 @@
 (library
  (name previewer)
  (public_name slipshow.previewer)
- (libraries
-  brr
-  slipshow
-  js_of_ocaml-lwt
-  lwt
-))
+ (libraries brr slipshow js_of_ocaml-lwt lwt))

slipshow.opam

@@ -17,7 +17,7 @@ depends: [
   "base64"
   "bos"
   "lwt"
-  "inotify"
+  "irmin-watcher"
   "js_of_ocaml-compiler"
   "js_of_ocaml-lwt"
   "magic-mime"