package ppx_log
Ppx_sexp_message-like extension nodes for lazily rendering log messages
Install
Dune Dependency
Authors
Maintainers
Sources
v0.17.0.tar.gz
sha256=2208f047b699d0661e94415868e8e9e4a6e5287a8eceaf7318f572ccd622859a
doc/src/ppx_log_kernel/log_statement.ml.html
Source file log_statement.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
open! Base open! Import open Ppxlib type t = { format : [ `Message_with_extra_tag_parentheses | Extension_kind.Format.t ] ; log : [ `Global | `Instance of expression ] ; args : Extension_payload.t ; level : Optional_arg.t ; time : Optional_arg.t ; legacy_tags : Optional_arg.t ; loc : location } let level_arg ~level_attr ~extension_name_level ~loc = match level_attr, extension_name_level with | None, None -> None | None, Some level -> Some (`Labelled (Extension_kind.Level.to_expression level ~loc)) | Some expr, None -> Some (`Optional expr) | Some _, Some _ -> Some (`Labelled (Ast_builder.Default.pexp_extension ~loc (Location.error_extensionf ~loc "Cannot provide a [@@level] attribute if the extension name already has a \ level"))) ;; let ~ ~loc ~log_source_position = let pos = Ppx_here_expander.lift_position ~loc in let pos_tag = [%expr [ "pos", Source_code_position.to_string [%e pos] ]] in let = if log_source_position then [ pos_tag ] else [] in let = tags_attr |> Option.to_list in match src_tags @ attr_tags with | [] -> None | [ e ] -> Some (`Labelled e) | _ :: _ as es -> Some (`Labelled [%expr List.concat [%e Ast_builder.Default.elist ~loc es]]) ;; let create { Extension_kind.format; log_kind; level = extension_name_level } { Parsed_extension.args ; ; level_attr ; time_attr ; legacy_add_extra_tag_parentheses } ~loc ~log_source_position = let loc = { loc with loc_ghost = true } in let = tags ~tags_attr ~loc ~log_source_position in let level = level_arg ~level_attr ~extension_name_level ~loc in let time = Optional_arg.of_optional_expr time_attr in let format = match format with | `Message -> if legacy_add_extra_tag_parentheses then `Message_with_extra_tag_parentheses else `Message | (`Printf | `Sexp | `String) as format -> format in let log, args = match log_kind with | `Global -> `Global, Extension_payload.Expression args | `Instance () -> Ast_pattern.(parse (pexp_apply __ __)) loc args (fun log_expr args -> `Instance log_expr, Extension_payload.Args args) in { format; log; args; level; time; legacy_tags; loc } ;; let render_source ~loc = let open (val Ast_builder.make loc) in [%expr Ppx_log_types.Message_source.Private.code ~pos_fname:[%e estring loc.loc_start.pos_fname] ~pos_lnum:[%e eint loc.loc_start.pos_lnum] ~module_name:Stdlib.__MODULE__ [@merlin.hide]] ;; let message_data format extension_payload ~loc = let open (val Ast_builder.make loc) in match format with | (`Message | `Message_with_extra_tag_parentheses) as format -> let render_with_additional_parentheses = match format with | `Message -> false | `Message_with_extra_tag_parentheses -> true in let payload = Message_sexp.of_extension_payload extension_payload ~loc |> Message_sexp.render ~render_with_additional_parentheses in [%expr `Structured [%e payload]] | `Sexp -> let payload = match Extension_payload.single_expression_or_error extension_payload ~loc with (* [%log.global.sexp (... : T.t)] uses [T.sexp_of_t]. *) | [%expr ([%e? expr] : [%t? typ])] -> let sexp_of_fn = Ppx_sexp_conv_expander.Sexp_of.core_type typ in Ast_builder.Default.eapply sexp_of_fn [ expr ] ~loc (* [%log.global.sexp my_expr] assumes [my_expr] is a [Sexp.t]. *) | expr -> expr in [%expr `Sexp [%e payload]] | `String -> let payload = match Extension_payload.single_expression_or_error extension_payload ~loc with | { pexp_desc = Pexp_constant (Pconst_string (s, loc, delimiter)); pexp_loc; _ } -> Ppx_string.expand ~config:Ppx_string.config_for_string ~expr_loc:pexp_loc ~string_loc:loc ~string:s ~delimiter |> Merlin_helpers.hide_expression | expr -> expr in [%expr `String [%e payload]] ;; (* The below is copied from [ppx_sexp_message_expander] - see there for reasoning. *) let wrap_in_cold_function ~loc expr = [%expr (let[@cold] ppx_log_statement () = [%e expr] in ppx_log_statement () [@nontail]) [@merlin.hide]] ;; let render { format; log; args; level; time; ; loc } = let open (val Ast_builder.make loc) in let function_name = Log_kind.log_function log ~loc in let make_log_statement data = List.filter_opt [ Optional_arg.to_arg level ~name:"level" ; Optional_arg.to_arg time ~name:"time" ; Optional_arg.to_arg legacy_tags ~name:"tags" ; Log_kind.log_arg log ; Some (Nolabel, data) ; Some (Nolabel, render_source ~loc) ] |> Ast_builder.Default.pexp_apply function_name ~loc in let log_statement = match format with | `Printf -> (* Printf is handled with a ksprintf, so it's separated out from [message_data]. We could maybe use a [sprintf] instead, but it causes format strings to have a slightly different type (the last type parameter which represents the return value of the format string is a string, not unit). The log statement itself returns unit, so I think unit makes sense here. *) pexp_apply [%expr Printf.ksprintf (fun str -> [%e make_log_statement [%expr `String str]])] (Extension_payload.to_args args) | (`String | `Sexp | `Message | `Message_with_extra_tag_parentheses) as format -> make_log_statement (message_data format args ~loc) in [%expr if [%e Log_kind.would_log log ~level ~loc] [@merlin.hide] then [%e wrap_in_cold_function log_statement ~loc] else [%e Log_kind.log_default log ~loc]] ;;
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>