zapashcanon/sun
1
0
Fork 0
Code Issues 1 Pull Requests Actions Releases Wiki Activity

use prelude

Browse Source
This commit is contained in:
zapashcanon 2024-12-29 19:13:43 +01:00
parent ccf757d99d
commit b927b63d12
Signed by: zapashcanon
GPG Key ID: 8981C3C62D1D28F1
3 changed files with 79 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.ocamlformat
View File

@ -1,4 +1,4 @@
version=0.24.1
version=0.27.0
assignment-operator=end-line
break-cases=fit
break-fun-decl=wrap
@ -24,8 +24,9 @@ let-and=sparse
let-binding-spacing=compact
let-module=compact
margin=80
max-indent=68
max-indent=2
module-item-spacing=sparse
ocaml-version=4.14.0
ocp-indent-compat=false
parens-ite=false
parens-tuple=always

13
src/dune
View File

@ -1,4 +1,13 @@
(executable
(public_name sun)
(modules sun)
(libraries cmdliner directories scfg unix))
(libraries
astring
cmdliner
directories
scfg
prelude
ptime
ptime.clock
rresult)
(flags
(:standard -open Prelude)))

102
src/sun.ml
View File

@ -6,10 +6,6 @@ module App_id = struct
let application = "sun"
end
let error msg =
Format.eprintf "error: %s@." msg;
exit 1
(** Choose the correct filename output. *)
let choose_output = function
| None ->
@ -18,50 +14,84 @@ let choose_output = function
let config_dir =
let module Project_dirs = Directories.Project_dirs (App_id) in
match Project_dirs.config_dir with
| None -> error "can't compute configuration directory path"
| Some config_dir -> config_dir
| None -> Fmt.failwith "can't compute configuration directory path"
| Some config_dir -> Fpath.v config_dir
in
let file_name = Filename.concat config_dir "config.scfg" in
let file_name = Fpath.(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 Result.fold ~error ~ok:Fun.id (Scfg.Parse.from_file file_name)
match Bos.OS.File.exists file_name with
| Error (`Msg e) -> Fmt.failwith "%s" e
| Ok false -> []
| Ok true -> (
match Scfg.Parse.from_file (Fpath.to_string file_name) with
| Error e -> Fmt.failwith "%s" e
| Ok file -> file )
in
let output_dir =
match Scfg.Query.get_dir "output_dir" config with
| None ->
(* `output_dir` isn't specified in the user's configuration, we'll try the user's `picture_dir`. *)
let module User_dirs = Directories.User_dirs () in
let module
(* `output_dir` isn't specified in the user's configuration, we'll try the user's `picture_dir`. *)
User_dirs =
Directories.User_dirs ()
in
(* If we can't compute `picture_dir`, we use the current working directory. *)
Option.value User_dirs.picture_dir ~default:(Unix.getcwd ())
begin
match User_dirs.picture_dir with
| Some dir -> begin
match Fpath.of_string dir with
| Error (`Msg e) -> Fmt.failwith "%s" e
| Ok dir -> dir
end
| None -> (
match Bos.OS.Dir.current () with
| Error (`Msg e) -> Fmt.failwith "%s" e
| Ok dir -> dir )
end
| Some output_dir ->
(* `output_dir` is specified in the user's config, we juste get its value. *)
Result.fold ~error ~ok:Fun.id (Scfg.Query.get_param 0 output_dir)
begin
match Scfg.Query.get_param 0 output_dir with
| Error e -> Fmt.failwith "%s" e
| Ok dir -> (
match Bos.Pat.of_string dir with
| Error (`Msg e) -> Fmt.failwith "%s" e
| Ok pat -> (
let s =
Bos.Pat.format
~undef:(fun s ->
match Bos.OS.Env.var s with
| None -> Fmt.failwith "unbound environment variable %s" s
| Some v -> v )
Astring.String.Map.empty pat
in
match Fpath.of_string s with
| Error (`Msg e) -> Fmt.failwith "%s" e
| Ok v -> v ) )
end
in
(* Now that we have `output_dir`, we need to choose a file name. We'll use the current time. *)
let t = Unix.localtime @@ Unix.gettimeofday () in
let file_name =
Format.sprintf "%d%02d%02d_%02dh%02dm%02ds_sun.png" (1900 + t.tm_year)
(1 + t.tm_mon) t.tm_mday t.tm_hour t.tm_min t.tm_sec
in
Filename.concat output_dir file_name
let now = Ptime_clock.now () in
let (y, mo, d), ((h, m, s), _tz) = Ptime.to_date_time now in
let file_name = Fmt.str "%d%02d%02d_%02dh%02dm%02ds_sun.png" y mo d h m s in
Fpath.(output_dir / file_name)
| Some output_file -> output_file
let screenshot output_file =
let output_file = choose_output output_file in
let region =
let chan = Unix.open_process_in "slurp" in
try
let output = input_line chan in
match Unix.close_process_in chan with
| WEXITED 0 -> output
| _err -> error "slurp failed"
with End_of_file -> error "slurp failed"
(* TODO: better error handling to avoid ignoring the error when slup fails... *)
match Bos.OS.Cmd.run_out Bos.Cmd.(v "slurp") |> Bos.OS.Cmd.to_string with
| Error (`Msg e) -> Fmt.failwith "%s" e
| Ok region -> region
in
let cmd = Format.sprintf {|grim -g "%s" "%s"|} region output_file in
let chan = Unix.open_process_in cmd in
match Unix.close_process_in chan with
| WEXITED 0 -> Format.printf "screenshot saved at %s@\n" output_file
| _err -> error "grim failed"
match
Bos.OS.Cmd.run_status Bos.Cmd.(v "grim" % "-g" % region % p output_file)
with
| Error (`Msg e) -> Fmt.failwith "%s" e
| Ok (`Exited 0) -> Fmt.pr "screenshot saved at %a@\n" Fpath.pp output_file
| Ok (`Exited n) -> Fmt.epr "grim exited with code %d@\n" n
| Ok (`Signaled n) -> Fmt.epr "grim got (OCaml) signal %d@\n" n
let cli =
let open Cmdliner in
@ -74,12 +104,10 @@ let cli =
in
let output_file =
let doc = "output file" in
let parse s = Ok (Some s) in
Arg.(
value
& pos 0
(conv (parse, Format.pp_print_option Format.pp_print_string))
None (info [] ~doc) )
let parse s =
match Fpath.of_string s with Error _ as e -> e | Ok p -> Ok (Some p)
in
Arg.(value & pos 0 (conv (parse, Fmt.option Fpath.pp)) None (info [] ~doc))
in
Cmd.v info Term.(const screenshot $ output_file)