package core_kernel

  1. Overview
  2. Docs
Industrial strength alternative to OCaml's standard library

Install

Dune Dependency

Authors

Maintainers

Sources

v0.17.0.tar.gz
sha256=fd2b8c6715794df7a810a62b226f53720f211cd344b4afc9fab0498796d6b466

doc/src/core_kernel.ansi_kernel/ansi_kernel.ml.html

Source file ansi_kernel.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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
module Stable = struct
  open! Core.Core_stable

  module Color_256 = struct
    module V1 = Color_256.Stable.V1
  end

  module Color = struct
    module V1 = struct
      type primary =
        [ `Black
        | `Red
        | `Green
        | `Yellow
        | `Blue
        | `Magenta
        | `Cyan
        | `White
        ]
      [@@deriving sexp, compare, hash, equal]

      type t =
        [ primary
        | `Color_256 of Color_256.V1.t
        ]
      [@@deriving sexp, compare, hash, equal]
    end

    module V2 = struct
      type primary =
        [ `Black
        | `Red
        | `Green
        | `Yellow
        | `Blue
        | `Magenta
        | `Cyan
        | `White
        ]
      [@@deriving sexp, compare, hash, equal]

      type t =
        [ primary
        | `Color_256 of Color_256.V1.t
        | `Default_color
        ]
      [@@deriving sexp, compare, hash, equal]

      let of_v1 (t : V1.t) = (t :> t)

      let to_v1 (t : t) ~foreground =
        match t with
        | #V1.t as t -> t
        | `Default_color ->
          (* Preserve old behaviour of assuming terminal is white-on-black *)
          if foreground then `White else `Black
      ;;

      let primary_of_v1 (t : V1.primary) : primary = t
      let primary_to_v1 (t : primary) : V1.primary = t
    end
  end

  module Attr = struct
    module V1 = struct
      type t =
        [ `Bright
        | `Dim
        | `Underscore
        | `Reverse
        | Color.V1.t
        | `Bg of Color.V1.t
        ]
      [@@deriving sexp, compare, hash, equal]
    end

    module V2 = struct
      type t =
        [ `Bright
        | `Dim
        | `Underscore
        | `Reverse
        | Color.V2.t
        | `Bg of Color.V2.t
        ]
      [@@deriving sexp, compare, hash, equal]

      let of_v1 (t : V1.t) = (t :> t)

      let to_v1 (t : t) : V1.t =
        match t with
        | #Color.V2.t as fg -> Color.V2.to_v1 fg ~foreground:true
        | `Bg bg -> `Bg (Color.V2.to_v1 bg ~foreground:false)
        | (`Bright | `Dim | `Underscore | `Reverse) as t -> t
      ;;
    end
  end
end

open! Core
module Color_256 = Color_256

(* NOTE: assorted content lifted from lib/console/src/console.ml *)
module Color = struct
  type primary = Stable.Color.V2.primary [@@deriving sexp_of, compare, hash, equal]
  type t = Stable.Color.V2.t [@@deriving sexp_of, compare, hash, equal]

  let to_int_list = function
    | `Black -> [ 30 ]
    | `Red -> [ 31 ]
    | `Green -> [ 32 ]
    | `Yellow -> [ 33 ]
    | `Blue -> [ 34 ]
    | `Magenta -> [ 35 ]
    | `Cyan -> [ 36 ]
    | `White -> [ 37 ]
    | `Color_256 c -> [ 38; 5; Color_256.to_int c ]
    | `Default_color -> [ 39 ]
  ;;
end

module Attr = struct
  type t = Stable.Attr.V2.t [@@deriving sexp_of, compare, hash, equal]

  let to_int_list = function
    | `Bright -> [ 1 ]
    | `Dim -> [ 2 ]
    | `Underscore -> [ 4 ]
    | `Reverse -> [ 7 ]
    (* Background colors are 40..47, foreground 30..37.
       256-color codes start with 48 (bg) or 38 (fg). *)
    | #Color.t as c -> Color.to_int_list c
    | `Bg bg ->
      (match Color.to_int_list bg with
       | ansi_code :: rest -> (ansi_code + 10) :: rest
       | [] -> [] (* NOTE: impossible, but appropriate *))
  ;;

  let list_to_string = function
    | [] -> ""
    | l ->
      sprintf
        "\027[%sm"
        (String.concat
           ~sep:";"
           (List.concat_map l ~f:(fun att -> to_int_list att |> List.map ~f:string_of_int)))
  ;;
end

module With_all_attrs = struct
  type t =
    [ Attr.t
    | `Reset
    | `Blink
    | `Hidden
    ]
  [@@deriving sexp_of, compare, hash, equal]

  let to_int_list = function
    | `Reset -> [ 0 ]
    | `Blink -> [ 5 ]
    | `Hidden -> [ 8 ]
    | #Attr.t as attr -> Attr.to_int_list attr
  ;;

  let list_to_string = function
    | [] -> ""
    | l ->
      sprintf
        "\027[%sm"
        (String.concat
           ~sep:";"
           (List.concat_map l ~f:(fun att -> to_int_list att |> List.map ~f:string_of_int)))
  ;;
end
OCaml

Innovation. Community. Security.