package MlFront_ProgressZig

  1. Overview
  2. Docs

Source file ZigDisplay.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
(** {2 Tree Encodings} *)

type tree_encoding = Utf8 | CodePage437 | Ascii

let tree_encoding_env () =
  match Sys.getenv_opt "MLFRONT_PROGRESS_ZIG_TREE_ENCODING" with
  | None -> None
  | Some value ->
  match String.lowercase_ascii value with
  | "utf8" | "utf-8" -> Some Utf8
  | "cp437" | "codepage437" | "code-page-437" -> Some CodePage437
  | "ascii" -> Some Ascii
  | _ -> None

let tree_encoding_for_ansi console =
  match tree_encoding_env () with
  | Some encoding -> encoding
  | None when Sys.win32 -> (
      match MlFront_Console.Console.windows_codepage console with
      | Some 65001 -> Utf8
      | Some 437 -> CodePage437
      | Some _ | None -> Ascii)
  | None -> Utf8

let tree_encoding_for_plain () =
  match tree_encoding_env () with Some encoding -> encoding | None -> Utf8

let tree_symbol encoding = function
  | `Tee -> (
      match encoding with
      | Utf8 -> "├─ "
      | CodePage437 -> "\xC3\xC4 "
      | Ascii -> "|- ")
  | `Line -> (
      match encoding with
      | Utf8 -> "│  "
      | CodePage437 -> "\xB3  "
      | Ascii -> "|  ")
  | `Langle ->
  match encoding with
  | Utf8 -> "└─ "
  | CodePage437 -> "\xC0\xC4 "
  | Ascii -> "+- "

(** {2 Progress Line} *)

let progress_line ~estimated_total ~completed ~name =
  match (estimated_total, completed) with
  | total, completed when total > 0 ->
      Printf.sprintf "[%d/%d] %s" completed total name
  | _total, completed when completed > 0 ->
      Printf.sprintf "[%d] %s" completed name
  | _ -> name

let truncate_display_width ~encoding ~cols line =
  if cols <= 0 then ""
  else
    match encoding with
    | CodePage437 | Ascii ->
        let byte_len = min cols (String.length line) in
        if byte_len >= String.length line then line
        else String.sub line 0 byte_len
    | Utf8 ->
        let decoder = String.get_utf_8_uchar in
        let line_len = String.length line in
        let rec loop byte_idx display_cols =
          if byte_idx >= line_len || display_cols >= cols then byte_idx
          else
            let decoded = decoder line byte_idx in
            let bytewidth = max 1 (Uchar.utf_decode_length decoded) in
            let uc : Uchar.t = Uchar.utf_decode_uchar decoded in
            let displaywidth =
              match Uucp.Break.tty_width_hint uc with
              | -1 -> 1 (* nonsensical input *)
              | w -> w
            in
            let next_byte_idx = min line_len (byte_idx + bytewidth) in
            loop next_byte_idx (display_cols + displaywidth)
        in
        let byte_len = loop 0 0 in
        if byte_len >= line_len then line else String.sub line 0 byte_len