watch.ml

watch.ml

open Rresult_infix
open Bos_unix

(* Watch a directory for changes. First run will create a database
   watchdb in the directory with modification times. Subsquent runs
   will check files against that database. *)

module Db = struct
  let db_file = Path.file "watchdb"
  let exists () = OS.File.exists db_file
  let scan () =             (* returns list of (path, modification time) *)
    let add acc p =
      (OS.Path.stat p >>= fun stats ->
       if stats.Unix.st_kind <> Unix.S_REG then Ok acc else
       Ok ((Path.to_string p, stats.Unix.st_mtime) :: acc))
      |> Log.on_error_msg ~use:acc
    in
    Log.show "Scanning files";
    OS.Dir.current ()
    >>= fun dir -> OS.Dir.fold_contents ~over:`Files add [] dir

  let dump oc db = Ok Marshal.(to_channel oc db [No_sharing; Compat_32])
  let slurp ic () = Ok (Marshal.from_channel ic : float String.Map.t)

  let create files =
    Log.show "Writing modification time database %a" Path.pp db_file;
    let count = ref 0 in
    let add acc (f, time) = incr count; String.Map.add f time acc in
    let db = List.fold_left add String.Map.empty files in
    OS.File.with_outf dump db_file db >>= fun () -> Ok !count

  let check files =
    let count = ref 0 in
    let changes db (f, time) = match (incr count; String.Map.find f db) with
    | None -> Log.show "New file: %s" f
    | Some stamp when stamp <> time -> Log.show "File changed: %s" f
    | _ -> ()
    in
    Log.show "Checking against %a" Path.pp db_file;
    OS.File.with_inf slurp db_file ()
    >>= fun db -> List.iter (changes db) files; Ok !count
end

let watch () =
  Db.scan ()
  >>= fun files -> Db.exists ()
  >>= fun exists -> if exists then Db.check files else Db.create files

let main () =
  let c = Mtime.counter () in
  let count = watch () |> Log.on_error_msg ~use:0 in
  Log.show "Watch completed for %d files in %a on %a"
    count Mtime.pp_span (Mtime.count c) OS.Time.(pp_stamp_now ~human:true) ()

let () = main ()