refactor(stdune): high performance tty detection

Save some syscalls when detecting the functionality of the tty Signed-off-by: Rudi Grinberg <[email protected]> ps-id: e70564a3-cf06-4c6b-bae1-db0839095046
ocaml · Dec 14, 2022 · 0eb0f22 · 0eb0f22
1 parent ab7d530
commit 0eb0f22
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 14 deletions.
diff --git a/otherlibs/stdune/ansi_color.ml b/otherlibs/stdune/ansi_color.ml
@@ -180,31 +180,29 @@ module Style = struct
     Printf.sprintf "\027[%sm" (String.concat l ~sep:";")
 end
 
-let supports_color fd =
+let supports_color isatty =
   let is_smart =
-    match Stdlib.Sys.getenv "TERM" with
-    | exception Not_found -> false
-    | "dumb" -> false
+    match Env.(get initial) "TERM" with
+    | Some "dumb" -> false
     | _ -> true
   and clicolor =
-    match Stdlib.Sys.getenv "CLICOLOR" with
-    | exception Not_found -> true
-    | "0" -> false
+    match Env.(get initial) "CLICOLOR" with
+    | Some "0" -> false
     | _ -> true
   and clicolor_force =
-    match Stdlib.Sys.getenv "CLICOLOR_FORCE" with
-    | exception Not_found -> false
-    | "0" -> false
+    match Env.(get initial) "CLICOLOR_FORCE" with
+    | Some "0" -> false
     | _ -> true
   in
-  (is_smart && Unix.isatty fd && clicolor) || clicolor_force
+  clicolor_force || (is_smart && clicolor && Lazy.force isatty)
 
-let stdout_supports_color = lazy (supports_color Unix.stdout)
-
-let stderr_supports_color = lazy (supports_color Unix.stderr)
+let stdout_supports_color =
+  lazy (supports_color (lazy (Unix.isatty Unix.stdout)))
 
 let output_is_a_tty = lazy (Unix.isatty Unix.stderr)
 
+let stderr_supports_color = lazy (supports_color output_is_a_tty)
+
 let rec tag_handler current_styles ppf styles pp =
   Format.pp_print_as ppf 0 (Style.escape_sequence_no_reset styles);
   Pp.to_fmt_with_tags ppf pp

diff --git a/otherlibs/stdune/env.ml b/otherlibs/stdune/env.ml
@@ -1,3 +1,5 @@
+module Sys = Stdlib.Sys
+
 module Var = struct
   module T = struct
     type t = string