package ocamlformat-lib

  1. Overview
  2. Docs
OCaml Code Formatter

Install

Dune Dependency

Authors

Maintainers

Sources

ocamlformat-0.26.2.tbz
sha256=2e4f596bf7aa367a844fe83ba0f6b0bf14b2a65179ddc082363fe9793d0375c5
sha512=b03d57462e65b11aa9f78dd5c4548251e8d1c5a1c9662f7502bdb10472aeb9df33c1d407350767a5223fbff9c01d53de85bafacd0274b49abc4b43701b159bee

doc/src/ocamlformat-lib.parser_shims/parser_shims.ml.html

Source file parser_shims.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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
module List = struct
  include List

  let rec find_map f = function
    | [] -> None
    | x :: l ->
        begin match f x with
        | Some _ as result -> result
        | None -> find_map f l
        end
end

module Int = struct
  include Int

  let min x y = if x <= y then x else y
  let max x y = if x >= y then x else y
end

module Misc = struct
  include Misc

  module Color = struct
    include Color

    external isatty : out_channel -> bool = "caml_sys_isatty"

    (* reasonable heuristic on whether colors should be enabled *)
    let should_enable_color () =
      let term = try Sys.getenv "TERM" with Not_found -> "" in
      term <> "dumb"
      && term <> ""
      && isatty stderr

    let default_setting = Auto
    let enabled = ref true
  end

  module Error_style = struct
    include Error_style

    let default_setting = Contextual
  end

  module Style = struct
    (* use ANSI color codes, see https://en.wikipedia.org/wiki/ANSI_escape_code *)
    type color =
      | Black
      | Red
      | Green
      | Yellow
      | Blue
      | Magenta
      | Cyan
      | White

    type style =
      | FG of color (* foreground *)
      | BG of color (* background *)
      | Bold
      | Reset

    let ansi_of_color = function
      | Black -> "0"
      | Red -> "1"
      | Green -> "2"
      | Yellow -> "3"
      | Blue -> "4"
      | Magenta -> "5"
      | Cyan -> "6"
      | White -> "7"

    let code_of_style = function
      | FG c -> "3" ^ ansi_of_color c
      | BG c -> "4" ^ ansi_of_color c
      | Bold -> "1"
      | Reset -> "0"

    let ansi_of_style_l l =
      let s = match l with
        | [] -> code_of_style Reset
        | [s] -> code_of_style s
        | _ -> String.concat ";" (List.map code_of_style l)
      in
      "\x1b[" ^ s ^ "m"

    type Format.stag += Style of style list

    type tag_style ={
      ansi: style list;
      text_open:string;
      text_close:string
    }

    type styles = {
      error: tag_style;
      warning: tag_style;
      loc: tag_style;
      hint: tag_style;
      inline_code: tag_style;
    }

    let no_markup stl = { ansi = stl; text_close = ""; text_open = "" }

    let default_styles = {
        warning = no_markup [Bold; FG Magenta];
        error = no_markup [Bold; FG Red];
        loc = no_markup [Bold];
        hint = no_markup [Bold; FG Blue];
        inline_code= { ansi=[Bold]; text_open = {|"|}; text_close = {|"|} }
      }

    let cur_styles = ref default_styles

    (* map a tag to a style, if the tag is known.
     @raise Not_found otherwise *)
    let style_of_tag s = match s with
      | Format.String_tag "error" ->  (!cur_styles).error
      | Format.String_tag "warning" ->(!cur_styles).warning
      | Format.String_tag "loc" -> (!cur_styles).loc
      | Format.String_tag "hint" -> (!cur_styles).hint
      | Format.String_tag "inline_code" -> (!cur_styles).inline_code
      | Style s -> no_markup s
      | _ -> raise Not_found

    let as_inline_code printer ppf x =
      Format.pp_open_stag ppf (Format.String_tag "inline_code");
      printer ppf x;
      Format.pp_close_stag ppf ()

    let inline_code ppf s = as_inline_code Format.pp_print_string ppf s

    (* either prints the tag of [s] or delegates to [or_else] *)
    let mark_open_tag ~or_else s =
      try
        let style = style_of_tag s in
        if !Color.enabled then ansi_of_style_l style.ansi else style.text_open
      with Not_found -> or_else s

    let mark_close_tag ~or_else s =
      try
        let style = style_of_tag s in
        if !Color.enabled then ansi_of_style_l [Reset] else style.text_close
      with Not_found -> or_else s

    (* add tag handling to formatter [ppf] *)
    let set_tag_handling ppf =
      let open Format in
      let functions = pp_get_formatter_stag_functions ppf () in
      let functions' = {functions with
        mark_open_stag=(mark_open_tag ~or_else:functions.mark_open_stag);
        mark_close_stag=(mark_close_tag ~or_else:functions.mark_close_stag);
      } in
      pp_set_mark_tags ppf true; (* enable tags *)
      pp_set_formatter_stag_functions ppf functions';
      ()

    let setup =
      let first = ref true in (* initialize only once *)
      let formatter_l =
        [Format.std_formatter; Format.err_formatter; Format.str_formatter]
      in
      let enable_color = function
        | Color.Auto -> Color.should_enable_color ()
        | Color.Always -> true
        | Color.Never -> false
      in
      fun o ->
        if !first then (
          first := false;
          Format.set_mark_tags true;
          List.iter set_tag_handling formatter_l;
          Color.enabled := (match o with
            | Some s -> enable_color s
            | None -> enable_color Color.default_setting)
        );
        ()
  end
end

module Clflags = struct
  let include_dirs = ref ([] : string list)(* -I *)
  let hidden_include_dirs = ref ([] : string list)
  let debug = ref false                   (* -g *)
  let unsafe = ref false                  (* -unsafe *)
  let absname = ref false                 (* -absname *)
  let use_threads = ref false             (* -thread *)
  let open_modules = ref []               (* -open *)
  let principal = ref false               (* -principal *)
  let recursive_types = ref false         (* -rectypes *)
  let applicative_functors = ref true     (* -no-app-funct *)
  let for_package = ref (None: string option) (* -for-pack *)
  let transparent_modules = ref false     (* -trans-mod *)
  let locations = ref true                (* -d(no-)locations *)
  let color = ref None                    (* -color *)
  let error_style = ref None              (* -error-style *)
  let unboxed_types = ref false
  let no_std_include = ref false
end

module Load_path = struct
  type dir

  type auto_include_callback =
    (dir -> string -> string option) -> string -> string

  type paths = {visible: string list; hidden: string list}

  let get_paths () = {visible= []; hidden= []}

  let init ~auto_include:_ ~visible:_ ~hidden:_ = ()

  let auto_include_otherlibs _ _ s = s
end

module Builtin_attributes = struct
  type current_phase = Parser | Invariant_check

  let register_attr _ _ = ()

  let mark_payload_attrs_used _ = ()
end
OCaml

Innovation. Community. Security.