mooreryan / InteinFinder / 17

Build # 17

Build Type

push

github

Committed by Ryan M. Moore

Commit Message

Install tree on macOS runner

Run Details

1165 of 1218 relevant lines covered (95.65%)

5433.21 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

92.5

/lib/utils.ml

open! Core
module Sh = Shexp_process

(* Return list of entries in [path] as [path/entry] *)
let ls_dir path =
  List.fold
    ~init:[]
    ~f:(fun acc entry -> Filename.concat path entry :: acc)
    (Sys_unix.ls_dir path)

(* May raise some unix errors? *)
let rec rm_rf name =
  match Core_unix.lstat name with
  | {st_kind= S_DIR; _} ->
      List.iter (ls_dir name) ~f:rm_rf ;
      Core_unix.rmdir name
  | _ ->
      Core_unix.unlink name
  | exception Core_unix.Unix_error (ENOENT, _, _) ->
      ()

let with_temp_dir ?(perm = 0o700) ?in_dir ?(prefix = "tmp") ?(suffix = "tmp") f
    =
  let dir = Filename_unix.temp_dir ~perm ?in_dir prefix suffix in
  Exn.protectx
    ~f
    ~finally:(fun name -> if Sys_unix.file_exists_exn name then rm_rf name)
    dir

let with_temp_file ?(perm = 0o600) ?in_dir ?(prefix = "tmp") ?(suffix = "tmp") f
    =
  let file = Filename_unix.temp_file ~perm ?in_dir prefix suffix in
  Exn.protectx
    ~f
    ~finally:(fun name ->
      if Sys_unix.file_exists_exn name then Sys_unix.remove name )
    file

let remove_file_if_empty file_name =
  let ({st_size; _} : Core_unix.stats) = Core_unix.stat file_name in
  if Int64.(st_size = of_int 0) then Sys_unix.remove file_name

let remove_if_exists file_name =
  if Sys_unix.file_exists_exn file_name then Sys_unix.remove file_name

let touch ?(perm = 0o644) ?(fail_if_exists = true) name =
  Out_channel.close @@ Out_channel.create ~perm ~fail_if_exists name ;
  name

let redirect_out_err out proc = Sh.outputs_to ~append:() out proc

let eval_sh log proc = Sh.eval @@ redirect_out_err log proc

(** On systems without the local timezone set up properly (e.g., alpine linux
    docker images), we fallback to UTC timezone. *)
let zone () =
  try Lazy.force Time_unix.Zone.local with Sys_error _ -> Time_unix.Zone.utc

let now_coarse () =
  let now = Time.now () in
  Time_unix.format now "%Y-%m-%d %H:%M:%S" ~zone:(zone ())

let now () = Time.to_filename_string ~zone:(zone ()) @@ Time.now ()

let log_name ~log_base ~desc =
  let now = now () in
  [%string "%{log_base}.%{now}.%{desc}.txt"]

let string_of_int_option = function None -> "None" | Some i -> Int.to_string i

let assert_all_files_exist : string list -> unit =
 fun files ->
  List.map files ~f:(fun file ->
      if Sys_unix.file_exists_exn file then Or_error.return file
      else Or_error.errorf "Expected '%s' to exist, but it does not" file )
  |> Or_error.all |> Or_error.ok_exn |> ignore

let iter_if_ok (v : 'a Async.Deferred.Or_error.t) ~f =
  match%bind.Async.Deferred v with
  | Ok x ->
      f x
  | Error _ ->
      Async.Deferred.return ()

(** Run an async function that may raise with [Async.try_with]. If it passes or
    fails return [unit Async.Deferred.t]. *)
let iter_and_swallow_error f =
  match%map.Async.Deferred Async.try_with f with Ok () | Error _ -> ()

let float_to_string_hum x = Float.to_string_hum ~strip_zero:true ~decimals:6 x

(** Raises failure. Like [failwithf] but gives standardized message for things
    that should be impossible. *)
let impossible' fmt =
  ksprintf
    (fun s () ->
      let msg = [%string "internal error (impossible state): %{s}"] in
      failwith msg )
    fmt
  [@@coverage off]

(** Raises failure. Like [failwith] but gives standardized message for things
    that should be impossible. *)
let impossible msg =
  let msg = [%string "internal error (impossible state): %{msg}"] in
  failwith msg
  [@@coverage off]

1	open! Core
2	module Sh = Shexp_process
3
4	(* Return list of entries in [path] as [path/entry] *)
5	let ls_dir path =
6	List.fold	35✔
7	~init:[]
8	~f:(fun acc entry -> Filename.concat path entry :: acc)	335✔
9	(Sys_unix.ls_dir path)	35✔
10
11	(* May raise some unix errors? *)
12	let rec rm_rf name =
13	match Core_unix.lstat name with	132✔
14	\| {st_kind= S_DIR; _} ->	21✔
15	List.iter (ls_dir name) ~f:rm_rf ;	21✔
16	Core_unix.rmdir name	21✔
17	\| _ ->	111✔
18	Core_unix.unlink name
19	\| exception Core_unix.Unix_error (ENOENT, _, _) ->	×
20	()
21
22	let with_temp_dir ?(perm = 0o700) ?in_dir ?(prefix = "tmp") ?(suffix = "tmp") f	4✔
23	=
24	let dir = Filename_unix.temp_dir ~perm ?in_dir prefix suffix in	4✔
25	Exn.protectx	4✔
26	~f
27	~finally:(fun name -> if Sys_unix.file_exists_exn name then rm_rf name)	4✔
28	dir
29
30	let with_temp_file ?(perm = 0o600) ?in_dir ?(prefix = "tmp") ?(suffix = "tmp") f	41✔
31	=
32	let file = Filename_unix.temp_file ~perm ?in_dir prefix suffix in	41✔
33	Exn.protectx	41✔
34	~f
35	~finally:(fun name ->
36	if Sys_unix.file_exists_exn name then Sys_unix.remove name )	26✔
37	file
38
39	let remove_file_if_empty file_name =
40	let ({st_size; _} : Core_unix.stats) = Core_unix.stat file_name in	37✔
41	if Int64.(st_size = of_int 0) then Sys_unix.remove file_name	16✔
42
43	let remove_if_exists file_name =
44	if Sys_unix.file_exists_exn file_name then Sys_unix.remove file_name	1✔
45
46	let touch ?(perm = 0o644) ?(fail_if_exists = true) name =	8✔
47	Out_channel.close @@ Out_channel.create ~perm ~fail_if_exists name ;	8✔
48	name	8✔
49
50	let redirect_out_err out proc = Sh.outputs_to ~append:() out proc	14✔
51
52	let eval_sh log proc = Sh.eval @@ redirect_out_err log proc	14✔
53
54	(** On systems without the local timezone set up properly (e.g., alpine linux
55	docker images), we fallback to UTC timezone. *)
56	let zone () =
57	try Lazy.force Time_unix.Zone.local with Sys_error _ -> Time_unix.Zone.utc	×
58
59	let now_coarse () =
60	let now = Time.now () in	124✔
61	Time_unix.format now "%Y-%m-%d %H:%M:%S" ~zone:(zone ())	124✔
62
63	let now () = Time.to_filename_string ~zone:(zone ()) @@ Time.now ()	85✔
64
65	let log_name ~log_base ~desc =
66	let now = now () in	85✔
67	[%string "%{log_base}.%{now}.%{desc}.txt"]	85✔
68
69	let string_of_int_option = function None -> "None" \| Some i -> Int.to_string i	30✔
70
71	let assert_all_files_exist : string list -> unit =
72	fun files ->
73	List.map files ~f:(fun file ->	3✔
74	if Sys_unix.file_exists_exn file then Or_error.return file	2✔
75	else Or_error.errorf "Expected '%s' to exist, but it does not" file )	3✔
76	\|> Or_error.all \|> Or_error.ok_exn \|> ignore	1✔
77
78	let iter_if_ok (v : 'a Async.Deferred.Or_error.t) ~f =
79	match%bind.Async.Deferred v with
80	\| Ok x ->	64✔
81	f x
82	\| Error _ ->	×
83	Async.Deferred.return ()
84
85	(** Run an async function that may raise with [Async.try_with]. If it passes or
86	fails return [unit Async.Deferred.t]. *)
87	let iter_and_swallow_error f =
88	match%map.Async.Deferred Async.try_with f with Ok () \| Error _ -> ()	21✔
89
90	let float_to_string_hum x = Float.to_string_hum ~strip_zero:true ~decimals:6 x	22✔
91
92	(** Raises failure. Like [failwithf] but gives standardized message for things
93	that should be impossible. *)
94	let impossible' fmt =
95	ksprintf
96	(fun s () ->
97	let msg = [%string "internal error (impossible state): %{s}"] in
98	failwith msg )
99	fmt
100	[@@coverage off]
101
102	(** Raises failure. Like [failwith] but gives standardized message for things
103	that should be impossible. *)
104	let impossible msg =
105	let msg = [%string "internal error (impossible state): %{msg}"] in
106	failwith msg
107	[@@coverage off]

mooreryan / InteinFinder / 17

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous