package ocamlformat-lib
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 = 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
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>