use scfg, clean code

src/ccbg.ml

@@ -1,61 +1,91 @@
-module Project_dirs = Directories.Project_dirs (struct
-  let qualifier = "org"
+module App_id = struct
+  let qualifier = "fr"
 
   let organization = "zapashcanon"
 
   let application = "ccbg"
-end)
+end
+
+module Project_dirs = Directories.Project_dirs (App_id)
 
 module User_dirs = Directories.User_dirs ()
 
-let err msg =
+let error msg =
   Format.eprintf "error: %s@." msg;
   exit 1
 
-let config_dir =
-  match Project_dirs.config_dir with
-  | None -> err "can't compute config directory path"
-  | Some dir -> dir
+let some_or_fail msg = function None -> error msg | Some v -> v
 
-let wallpaper_dir =
-  match User_dirs.picture_dir with
-  | None -> err "can't compute picture directory path"
-  | Some dir -> Filename.concat dir "wallpaper"
+let ok_or_fail r = Result.fold ~error ~ok:Fun.id r
 
-let time = 600
+let config =
+  (* we look if there's some configuration *)
+  let config_dir =
+    let module Project_dirs = Directories.Project_dirs (App_id) in
+    some_or_fail "can't compute configuration directory path"
+      Project_dirs.config_dir
+  in
+  let file_name = Filename.concat config_dir "config.scfg" in
+  (* if the config file doesn't exist, then we use the empty configuration *)
+  if not @@ Sys.file_exists file_name then []
+  else ok_or_fail (Scfg.Parse.from_file file_name)
+
+let wallpaper_dir =
+  match Scfg.Query.get_dir "wallpaper_dir" config with
+  | None ->
+    some_or_fail "can't compute picture directory path" User_dirs.picture_dir
+  | Some wallpaper_dir -> ok_or_fail (Scfg.Query.get_param 0 wallpaper_dir)
 
-let time = Format.sprintf "%ds" time
+let interval =
+  let interval =
+    match Scfg.Query.get_dir "interval" config with
+    | None -> 600
+    | Some interval -> ok_or_fail (Scfg.Query.get_param_pos_int 0 interval)
+  in
+  Format.sprintf "%ds" interval
 
-let () = Random.self_init ()
+let mode =
+  match Scfg.Query.get_dir "mode" config with
+  | None -> "fill"
+  | Some mode -> (
+    match ok_or_fail (Scfg.Query.get_param 0 mode) with
+    | ("center" | "fill" | "fit" | "solid_color" | "stretch" | "tile") as mode
+      ->
+      mode
+    | invalid_mode -> error (Format.sprintf "invalid mode `%s`" invalid_mode) )
 
 let wallpaper_files =
   match Bos.OS.Dir.contents (Fpath.v wallpaper_dir) with
-  | Ok cnt ->
+  | Error (`Msg e) -> error e
+  | Ok cnt -> (
+    (* remove directories from the list... *)
     let cnt =
       List.filter
         (fun path ->
-          match Bos.OS.Dir.exists path with
-          | Ok false -> true
-          | Ok true -> false
-          | _ -> false )
+          match Bos.OS.Dir.exists path with Ok b -> not b | _ -> false )
         cnt
     in
-    Array.of_list (List.map Fpath.to_string cnt)
-  | Error (`Msg e) -> err e
+    match Array.of_list (List.map Fpath.to_string cnt) with
+    | [||] -> error (Format.sprintf "no wallpaper found in %s" wallpaper_dir)
+    | wallpaper_files -> wallpaper_files )
 
 let random_wallpaper =
   let len = Array.length wallpaper_files in
   fun () -> wallpaper_files.(Random.int len)
 
 let rec new_wallpaper () =
+  let open Bos in
   match
-    Bos.OS.Cmd.run
-      Bos.Cmd.(
-        v "timeout" % time % "swaybg" % "--mode" % "fill" % "--image"
+    OS.Cmd.run ~err:OS.Cmd.err_null
+      Cmd.(
+        v "timeout" % interval % "swaybg" % "--mode" % mode % "--image"
         % random_wallpaper () )
   with
-  | _ -> new_wallpaper ()
+  | Ok () -> error "timeout failed"
+  | Error (`Msg (_s : string)) ->
+    (* timeout killed the swaybg process, we can launch a new one *)
+    new_wallpaper ()
 
 let () =
-  match Bos.OS.Cmd.run Bos.Cmd.(v "killall" % "swaybg") with
-  | _ -> new_wallpaper ()
+  Random.self_init ();
+  new_wallpaper ()

src/dune

@@ -1,4 +1,4 @@
 (executable
  (public_name ccbg)
  (modules ccbg)
- (libraries bos directories fpath))
+ (libraries bos directories fpath scfg))