pax_global_header00006660000000000000000000000064146164733610014525gustar00rootroot0000000000000052 comment=e350dfffaa1ef6b3bbc9cb0cc717dde20788912f ppx_sexp_message-0.17.0/000077500000000000000000000000001461647336100151645ustar00rootroot00000000000000ppx_sexp_message-0.17.0/.gitignore000066400000000000000000000000411461647336100171470ustar00rootroot00000000000000_build *.install *.merlin _opam ppx_sexp_message-0.17.0/.ocamlformat000066400000000000000000000000231461647336100174640ustar00rootroot00000000000000profile=janestreet ppx_sexp_message-0.17.0/CHANGES.md000066400000000000000000000006231461647336100165570ustar00rootroot00000000000000## v0.11 - Depend on ppxlib instead of (now deprecated) ppx\_core, ppx\_driver and ppx\_metaquot. ## v0.10 - Added syntax `%message.omit_nil`, which is like `%message`, but omits expressions whose sexp is `()`. ## v0.9 ## 113.43.00 - Expand `%message` to: `List []` - Allow to use `sexp_option` in more places in ppx\_sexp\_message, to make it to display information only some of the time. ppx_sexp_message-0.17.0/CONTRIBUTING.md000066400000000000000000000044101461647336100174140ustar00rootroot00000000000000This repository contains open source software that is developed and maintained by [Jane Street][js]. Contributions to this project are welcome and should be submitted via GitHub pull requests. Signing contributions --------------------- We require that you sign your contributions. Your signature certifies that you wrote the patch or otherwise have the right to pass it on as an open-source patch. The rules are pretty simple: if you can certify the below (from [developercertificate.org][dco]): ``` Developer Certificate of Origin Version 1.1 Copyright (C) 2004, 2006 The Linux Foundation and its contributors. 1 Letterman Drive Suite D4700 San Francisco, CA, 94129 Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Developer's Certificate of Origin 1.1 By making a contribution to this project, I certify that: (a) The contribution was created in whole or in part by me and I have the right to submit it under the open source license indicated in the file; or (b) The contribution is based upon previous work that, to the best of my knowledge, is covered under an appropriate open source license and I have the right under that license to submit that work with modifications, whether created in whole or in part by me, under the same open source license (unless I am permitted to submit under a different license), as indicated in the file; or (c) The contribution was provided directly to me by some other person who certified (a), (b) or (c) and I have not modified it. (d) I understand and agree that this project and the contribution are public and that a record of the contribution (including all personal information I submit with it, including my sign-off) is maintained indefinitely and may be redistributed consistent with this project or the open source license(s) involved. ``` Then you just add a line to every git commit message: ``` Signed-off-by: Joe Smith ``` Use your real name (sorry, no pseudonyms or anonymous contributions.) If you set your `user.name` and `user.email` git configs, you can sign your commit automatically with git commit -s. [dco]: http://developercertificate.org/ [js]: https://opensource.janestreet.com/ ppx_sexp_message-0.17.0/LICENSE.md000066400000000000000000000021461461647336100165730ustar00rootroot00000000000000The MIT License Copyright (c) 2015--2024 Jane Street Group, LLC Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ppx_sexp_message-0.17.0/Makefile000066400000000000000000000004031461647336100166210ustar00rootroot00000000000000INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) default: dune build install: dune install $(INSTALL_ARGS) uninstall: dune uninstall $(INSTALL_ARGS) reinstall: uninstall install clean: dune clean .PHONY: default install uninstall reinstall clean ppx_sexp_message-0.17.0/README.md000066400000000000000000000130571461647336100164510ustar00rootroot00000000000000ppx_sexp_message - Easy construction of s-expressions ===================================================== Overview -------- The aim of ppx\_sexp\_message is to ease the creation of s-expressions in OCaml. This is mainly motivated by writing error and debugging messages, where one needs to construct a s-expression based on various element of the context such as function arguments. For instance: ```ocaml open Core let rename ~src ~dst = try Unix.rename ~src:tmpfile ~dst with Unix.Unix_Error (error, _, _) -> raise_s [%message "Error while renaming file" ~source:(tmpfile : string) ~dest: (dst : string) (error : Unix.Error.t) ] ``` would produce the following s-expression: ```scheme ("Error while renaming file" (source tmp/XYZ) (dest blah) (error ENOENT)) ``` Syntax ------ Ppx\_sexp\_message expands the `[%message ...]` extension point into an expression that evaluates to an s-expression, i.e. an expression of type `Sexplib.Sexp.t`. The grammar of the payload is a small DSL that specifies what the generated s-expression looks like. The user can then format and display such an s-expression as usual, using [sexplib](https://github.com/janestreet/sexplib), or as [explained here](https://dev.realworldocaml.org/data-serialization.html#basic-usage). ### Basic syntax Ppx\_sexp\_message recognizes the form `[%message expr1 expr2 ...]`, and maps it pointwise to an s-expression that looks like `(( ) ... ( ))`. A single expression also works (but it can't syntactically be an application). Every `expr` is mapped to an an optional tag and value as follows. The tag is determined by the following rules: - no tag if the labelled expression has the label `_` - the tag is the label when the label is not `_` - when the expression is not labelled - the tag is `expr` if the expression has the form `(expr : typ)` - otherwise there is no tag Here are examples of each of these rules: - `[%message "error" ~_:(msg : string)]` becomes `(error "value of msg")` - `[%message "error" ~tag:(msg : string)]` becomes `(error (tag "value of msg"))` - `[%message "error" (msg : string)]` becomes `(error (msg "value of msg"))` - `[%message "error" "value of msg"]` becomes `(error "value of msg")` Having the tag derived from the expression is by far the most common case, since it is convenient to not have to come up with a descriptive name. This is especially valuable for debugging messages. The rest of this section describe how each expression is converted to a value in the s-expression. #### Conversion of expressions Literals of base types (constant strings, integers, floats, ...) are converted to their natural sexp representation. When an expression is annotated with a type, the type is used to convert the value exactly like `ppx_sexp_conv` does. Otherwise, expressions are assumed to be valid ocaml expressions of type string and the resulting string ends up as an atom in the s-expression. For instance: - `"foo"` becomes `foo` - `(Map.keys m : string list)` becomes `("Map.keys m" (.bashrc .emacs))` - `(sprintf "expected %s of type" ast_type)` becomes `"expected a pattern of type"` #### Optionally displayed expression When an expression is annotated with a type, if the type has the syntax `a option [@sexp.option]` for some `a`, then: - when the value is `None`, the tag and expression are omitted - when the value is `Some x`, then the tag and `x` are displayed If the type annotation has the attribute `[@sexp.omit_nil]`, then when the expression is converted into an sexp, if that sexp is `()`, then both the tag and the expression are omitted. One can also use `[%message.omit_nil exprs]`, which is a variation of `[%message exprs]` which behaves as if all `option` types were annotated with `[@sexp.option]` and all other expressions were annotated with `[@sexp.omit_nil]`. #### Special case of the empty string An exception to the previous rules is the treatment of the empty string. An empty string will be treated as if it did not appear in the source code. It it useful to work around syntactic limitations: - the inability to put a label on the first expression - the inability to tell the difference between an application and a single expression which is an application For instance: ```ocaml `[%message "" ~problem:(error : Error.t)] ``` ```ocaml `[%message "" (sprintf "invalid %s" name)] ``` #### Eagerness The extension points `[%lazy_message]` and `[%lazy_message.omit_nil]` are additionally provided, which just wrap the generated code in `[lazy]` to delay computing and allocating of possibly large sexps. This is intended to be used with, for example, `[Error.of_lazy_sexp]`, where the error messages may be large, but are typically not used: ```ocaml let execute_query_exn ~database ~query = Database.execute_query ~database ~query |> Option.value_exn ~error: (Error.of_lazy_sexp [%lazy_message "Query failed" (database : Database.t) (query : Query.t)]) ``` #### Misc For convenience and continuity of the syntax `[%message]` becomes `()`. Difference with ppx\_sexp\_value -------------------------------- Ppx\_sexp\_message is similar to [ppx_sexp_value](https://github.com/janestreet/ppx_sexp_value) in the sense that it makes the creation of s-expression nicer. The main difference is that ppx\_sexp\_value is a more general rewriter that build a s-expression based closely on what the user wrote. On the other hand ppx\_sexp\_message tries to focus on having a DSL that is as light as possible for building error messages. ppx_sexp_message-0.17.0/dune000066400000000000000000000000001461647336100160300ustar00rootroot00000000000000ppx_sexp_message-0.17.0/dune-project000066400000000000000000000000211461647336100174770ustar00rootroot00000000000000(lang dune 3.11) ppx_sexp_message-0.17.0/expander/000077500000000000000000000000001461647336100167725ustar00rootroot00000000000000ppx_sexp_message-0.17.0/expander/dune000066400000000000000000000003601461647336100176470ustar00rootroot00000000000000(library (name ppx_sexp_message_expander) (public_name ppx_sexp_message.expander) (libraries base ppxlib ppx_sexp_conv.expander ppx_here.expander) (preprocess (pps ppxlib.metaquot)) (ppx_runtime_libraries ppx_sexp_conv.runtime-lib)) ppx_sexp_message-0.17.0/expander/ppx_sexp_message_expander.ml000066400000000000000000000144441461647336100245730ustar00rootroot00000000000000open Base open Ppxlib open Ast_builder.Default let omit_nil_attr = Attribute.declare "sexp_message.sexp.omit_nil" Attribute.Context.core_type Ast_pattern.(pstr nil) () ;; let option_attr = Attribute.declare "sexp_message.sexp.option" Attribute.Context.core_type Ast_pattern.(pstr nil) () ;; let sexp_atom ~loc x = [%expr Ppx_sexp_conv_lib.Sexp.Atom [%e x]] let sexp_list ~loc x = [%expr Ppx_sexp_conv_lib.Sexp.List [%e x]] let sexp_inline ~loc l = match l with | [ x ] -> x | _ -> sexp_list ~loc (elist ~loc l) ;; (* Same as Ppx_sexp_value.omittable_sexp *) type omittable_sexp = | Present of expression | Optional of Location.t * expression * (expression -> expression) | Omit_nil of Location.t * expression * (expression -> expression) | Absent let present_or_omit_nil ~loc ~omit_nil expr = if omit_nil then Omit_nil (loc, expr, Fn.id) else Present expr ;; let wrap_sexp_if_present omittable_sexp ~f = match omittable_sexp with | Present e -> Present (f e) | Optional (loc, e, k) -> Optional (loc, e, fun e -> f (k e)) | Omit_nil (loc, e, k) -> Omit_nil (loc, e, fun e -> f (k e)) | Absent -> Absent ;; let sexp_of_constraint ~omit_nil ~loc expr ctyp = let optional ty = let sexp_of = Ppx_sexp_conv_expander.Sexp_of.core_type ty in Optional (loc, expr, fun expr -> eapply ~loc sexp_of [ expr ]) in match ctyp with | [%type: [%t? ty] option] when Option.is_some (Attribute.get option_attr ctyp) -> optional ty | [%type: [%t? ty] option] when omit_nil -> optional ty | _ -> let expr = let sexp_of = Ppx_sexp_conv_expander.Sexp_of.core_type ctyp in eapply ~loc sexp_of [ expr ] in let omit_nil_attr = lazy (* this is lazy so using [@omit_nil] inside [%message.omit_nil] is an error (unused attribute) *) (match Attribute.get omit_nil_attr ctyp with | Some () -> true | None -> false) in present_or_omit_nil ~loc expr ~omit_nil:(omit_nil || Lazy.force omit_nil_attr) ;; let sexp_of_constant ~loc const = let f typ = eapply ~loc (evar ~loc ("Ppx_sexp_conv_lib.Conv.sexp_of_" ^ typ)) [ pexp_constant ~loc const ] in match const with | Pconst_integer _ -> f "int" | Pconst_char _ -> f "char" | Pconst_string _ -> f "string" | Pconst_float _ -> f "float" ;; let rewrite_here e = match e.pexp_desc with | Pexp_extension ({ txt = "here"; _ }, PStr []) -> Ppx_here_expander.lift_position_as_string ~loc:e.pexp_loc | _ -> e ;; let sexp_of_expr ~omit_nil e = let e = rewrite_here e in let loc = { e.pexp_loc with loc_ghost = true } in match e.pexp_desc with | Pexp_constant (Pconst_string ("", _, _)) -> Absent | Pexp_constant const -> present_or_omit_nil ~loc ~omit_nil:false (sexp_of_constant ~loc const) | Pexp_constraint (expr, ctyp) -> sexp_of_constraint ~omit_nil ~loc expr ctyp | _ -> present_or_omit_nil ~loc ~omit_nil:false [%expr Ppx_sexp_conv_lib.Conv.sexp_of_string [%e e]] ;; let sexp_of_labelled_expr ~omit_nil (label, e) = let loc = { e.pexp_loc with loc_ghost = true } in match label, e.pexp_desc with | Nolabel, Pexp_constraint (expr, _) -> let expr_str = Pprintast.string_of_expression expr in let k e = sexp_inline ~loc [ sexp_atom ~loc (estring ~loc expr_str); e ] in wrap_sexp_if_present (sexp_of_expr ~omit_nil e) ~f:k | Nolabel, _ -> sexp_of_expr ~omit_nil e | Labelled "_", _ -> sexp_of_expr ~omit_nil e | Labelled label, _ -> let k e = sexp_inline ~loc [ sexp_atom ~loc (estring ~loc label); e ] in wrap_sexp_if_present (sexp_of_expr ~omit_nil e) ~f:k | Optional _, _ -> (* Could be used to encode sexp_option if that's ever needed. *) Location.raise_errorf ~loc "ppx_sexp_value: optional argument not allowed here" ;; (* Wrap up the generated code in a [@cold] function so it doesn't pollute the call site. Also, give that cold function a nice name so it's easy for assembly readers to figure out why that function is being called. *) let wrap_in_cold_function ~loc expr = [%expr let[@cold] ppx_sexp_message () = [%e expr] in (* Prevent tail calls so the closure environment is always allocated locally (with Jane Street extensions). The sexp this is generating is still allocated globally, but it's nice to keep the closure allocation cheap where it's easy. *) ppx_sexp_message () [@nontail]] ;; let sexp_of_labelled_exprs ~omit_nil ~loc labels_and_exprs = let loc = { loc with loc_ghost = true } in let l = List.map labels_and_exprs ~f:(sexp_of_labelled_expr ~omit_nil) in let res = List.fold_left (List.rev l) ~init:(elist ~loc []) ~f:(fun acc e -> match e with | Absent -> acc | Present e -> [%expr [%e e] :: [%e acc]] | Optional (_, v_opt, k) -> (* We match simultaneously on the head and tail in the generated code to avoid changing their respective typing environments. *) [%expr match [%e v_opt], [%e acc] with | None, tl -> tl | Some v, tl -> [%e k [%expr v]] :: tl] | Omit_nil (_, e, k) -> [%expr match [%e e], [%e acc] with | Ppx_sexp_conv_lib.Sexp.List [], tl -> tl | v, tl -> [%e k [%expr v]] :: tl]) in let has_optional_values = List.exists l ~f:(function | (Optional _ | Omit_nil _ : omittable_sexp) -> true | Present _ | Absent -> false) in (* The two branches do the same thing, but when there are no optional values, we can do it at compile-time, which avoids making the generated code ugly. *) let final_expr = if has_optional_values then [%expr match [%e res] with | [ h ] -> h | ([] | _ :: _ :: _) as res -> [%e sexp_list ~loc [%expr res]]] else ( match res with | [%expr [ [%e? h] ]] -> h | _ -> sexp_list ~loc res) in wrap_in_cold_function ~loc final_expr ;; let expand ~omit_nil ~path:_ e = let loc = e.pexp_loc in let labelled_exprs = match e.pexp_desc with | Pexp_apply (f, args) -> (Nolabel, f) :: args | _ -> [ Nolabel, e ] in sexp_of_labelled_exprs ~omit_nil ~loc labelled_exprs ;; let expand_opt ~omit_nil ~loc ~path = function | None -> let loc = { loc with loc_ghost = true } in wrap_in_cold_function ~loc (sexp_list ~loc (elist ~loc [])) | Some e -> expand ~omit_nil ~path e ;; ppx_sexp_message-0.17.0/expander/ppx_sexp_message_expander.mli000066400000000000000000000004661461647336100247430ustar00rootroot00000000000000open Base open Ppxlib val sexp_of_labelled_exprs : omit_nil:bool -> loc:location -> (arg_label * expression) list -> expression val expand : omit_nil:bool -> path:'a -> expression -> expression val expand_opt : omit_nil:bool -> loc:location -> path:'a -> expression option -> expression ppx_sexp_message-0.17.0/ppx_sexp_message.opam000066400000000000000000000015541461647336100214210ustar00rootroot00000000000000opam-version: "2.0" version: "v0.17.0" maintainer: "Jane Street developers" authors: ["Jane Street Group, LLC"] homepage: "https://github.com/janestreet/ppx_sexp_message" bug-reports: "https://github.com/janestreet/ppx_sexp_message/issues" dev-repo: "git+https://github.com/janestreet/ppx_sexp_message.git" doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/ppx_sexp_message/index.html" license: "MIT" build: [ ["dune" "build" "-p" name "-j" jobs] ] depends: [ "ocaml" {>= "5.1.0"} "base" {>= "v0.17" & < "v0.18"} "ppx_here" {>= "v0.17" & < "v0.18"} "ppx_sexp_conv" {>= "v0.17" & < "v0.18"} "dune" {>= "3.11.0"} "ppxlib" {>= "0.28.0"} ] available: arch != "arm32" & arch != "x86_32" synopsis: "A ppx rewriter for easy construction of s-expressions" description: " Part of the Jane Street's PPX rewriters collection. " ppx_sexp_message-0.17.0/src/000077500000000000000000000000001461647336100157535ustar00rootroot00000000000000ppx_sexp_message-0.17.0/src/dune000066400000000000000000000002611461647336100166300ustar00rootroot00000000000000(library (name ppx_sexp_message) (public_name ppx_sexp_message) (kind ppx_rewriter) (libraries base ppxlib ppx_sexp_message_expander) (preprocess (pps ppxlib.metaquot))) ppx_sexp_message-0.17.0/src/ppx_sexp_message.ml000066400000000000000000000015121461647336100216560ustar00rootroot00000000000000open! Base open Ppxlib let pattern = let open Ast_pattern in map (single_expr_payload __) ~f:(fun f x -> f (Some x)) ||| map (pstr nil) ~f:(fun f -> f None) ;; let expand ~omit_nil ~lazy_ ~loc ~path expr_opt = let expr = Ppx_sexp_message_expander.expand_opt ~omit_nil ~loc ~path expr_opt in if lazy_ then [%expr lazy [%e expr]] else expr ;; let message ~name ~omit_nil ~lazy_ = Extension.declare name Extension.Context.expression pattern (expand ~omit_nil ~lazy_) ;; let () = Driver.register_transformation "sexp_message" ~extensions: [ message ~name:"message" ~omit_nil:false ~lazy_:false ; message ~name:"@message.omit_nil" ~omit_nil:true ~lazy_:false ; message ~name:"lazy_message" ~omit_nil:false ~lazy_:true ; message ~name:"@lazy_message.omit_nil" ~omit_nil:true ~lazy_:true ] ;; ppx_sexp_message-0.17.0/src/ppx_sexp_message.mli000066400000000000000000000000001461647336100220160ustar00rootroot00000000000000ppx_sexp_message-0.17.0/test/000077500000000000000000000000001461647336100161435ustar00rootroot00000000000000ppx_sexp_message-0.17.0/test/dune000066400000000000000000000003041461647336100170160ustar00rootroot00000000000000(library (name test_ppx_sexp_message_lib) (libraries core expect_test_helpers_core.expect_test_helpers_base) (preprocess (pps ppx_here ppx_sexp_conv ppx_sexp_message ppx_expect ppx_string))) ppx_sexp_message-0.17.0/test/test.ml000066400000000000000000000123701461647336100174570ustar00rootroot00000000000000open Core let () = Expect_test_helpers_base.sexp_style := To_string_hum let pr sexp = Expect_test_helpers_base.print_s ~hide_positions:true sexp let%expect_test "[%message]" = let x = 42 and y = "forty-two" in pr [%message "foo" 1 2 3 "blah"]; [%expect {| (foo 1 2 3 blah) |}]; pr [%message "foo" (x : int) (y : string) (x + String.length y : int)]; [%expect {| (foo (x 42) (y forty-two) ("x + (String.length y)" 51)) |}]; pr [%message "foo" (x : int) (y : string) ~blah:(x + String.length y : int)]; [%expect {| (foo (x 42) (y forty-two) (blah 51)) |}]; pr [%message "foo" ~_:(x : int) ~_:1 ~blah:(0 : int)]; [%expect {| (foo 42 1 (blah 0)) |}]; pr [%message "foo" [%here]]; [%expect {| (foo ppx/ppx_sexp_message/test/test.ml:LINE:COL) |}]; pr [%message "foo" ~loc:[%here]]; [%expect {| (foo (loc ppx/ppx_sexp_message/test/test.ml:LINE:COL)) |}]; pr [%message "foo" ~_:[%here]]; [%expect {| (foo ppx/ppx_sexp_message/test/test.ml:LINE:COL) |}]; pr [%message [%here] "blah"]; [%expect "(ppx/ppx_sexp_message/test/test.ml:LINE:COL blah)"]; pr [%message (sprintf "foo %d" x) (y : string)]; [%expect {| ("foo 42" (y forty-two)) |}]; pr [%message "hello"]; [%expect {| hello |}]; pr [%message y y]; [%expect {| (forty-two forty-two) |}]; pr [%message (sprintf "a") ""]; [%expect {| a |}]; pr [%message "" (sprintf "%s" "a")]; [%expect {| a |}]; pr [%message [%here]]; [%expect {| ppx/ppx_sexp_message/test/test.ml:LINE:COL |}]; pr [%message [%string "foo"]]; [%expect {| foo |}]; pr [%message (x : int)]; [%expect {| (x 42) |}]; pr [%message (x : int) (y : string)]; [%expect {| ((x 42) (y forty-two)) |}]; pr [%message "" ~_:(x : int) (y : string)]; [%expect {| (42 (y forty-two)) |}]; (* This is a bit weird but consistent. *) pr [%message "foo" ~a:""]; [%expect {| foo |}]; pr [%message]; [%expect {| () |}]; pr [%message (Some 1 : (int option[@sexp.option])) (None : (int option[@sexp.option]))]; [%expect {| ("Some 1" 1) |}]; pr [%message ([ 1 ] : (int list[@omit_nil])) ([] : (int list[@omit_nil]))]; [%expect {| ([1] (1)) |}]; pr [%message.omit_nil (Some 1 : int option) (None : int option)]; [%expect {| ("Some 1" 1) |}]; pr [%message.omit_nil ([ 1 ] : int list) ([] : int list)]; [%expect {| ([1] (1)) |}] ;; let pr_lazy lazy_sexp = pr (Lazy.force lazy_sexp) let%expect_test "[%lazy_message]" = let x = 42 and y = "forty-two" in pr_lazy [%lazy_message "foo" 1 2 3 "blah"]; [%expect {| (foo 1 2 3 blah) |}]; pr_lazy [%lazy_message "foo" (x : int) (y : string) (x + String.length y : int)]; [%expect {| (foo (x 42) (y forty-two) ("x + (String.length y)" 51)) |}]; pr_lazy [%lazy_message "foo" (x : int) (y : string) ~blah:(x + String.length y : int)]; [%expect {| (foo (x 42) (y forty-two) (blah 51)) |}]; pr_lazy [%lazy_message "foo" ~_:(x : int) ~_:1 ~blah:(0 : int)]; [%expect {| (foo 42 1 (blah 0)) |}]; pr_lazy [%lazy_message "foo" [%here]]; [%expect {| (foo ppx/ppx_sexp_message/test/test.ml:LINE:COL) |}]; pr_lazy [%lazy_message "foo" ~loc:[%here]]; [%expect {| (foo (loc ppx/ppx_sexp_message/test/test.ml:LINE:COL)) |}]; pr_lazy [%lazy_message "foo" ~_:[%here]]; [%expect {| (foo ppx/ppx_sexp_message/test/test.ml:LINE:COL) |}]; pr_lazy [%lazy_message [%here] "blah"]; [%expect "(ppx/ppx_sexp_message/test/test.ml:LINE:COL blah)"]; pr_lazy [%lazy_message (sprintf "foo %d" x) (y : string)]; [%expect {| ("foo 42" (y forty-two)) |}]; pr_lazy [%lazy_message "hello"]; [%expect {| hello |}]; pr_lazy [%lazy_message y y]; [%expect {| (forty-two forty-two) |}]; pr_lazy [%lazy_message (sprintf "a") ""]; [%expect {| a |}]; pr_lazy [%lazy_message "" (sprintf "%s" "a")]; [%expect {| a |}]; pr_lazy [%lazy_message [%here]]; [%expect {| ppx/ppx_sexp_message/test/test.ml:LINE:COL |}]; pr_lazy [%lazy_message [%string "foo"]]; [%expect {| foo |}]; pr_lazy [%lazy_message (x : int)]; [%expect {| (x 42) |}]; pr_lazy [%lazy_message (x : int) (y : string)]; [%expect {| ((x 42) (y forty-two)) |}]; pr_lazy [%lazy_message "" ~_:(x : int) (y : string)]; [%expect {| (42 (y forty-two)) |}]; (* This is a bit weird but consistent. *) pr_lazy [%lazy_message "foo" ~a:""]; [%expect {| foo |}]; pr_lazy [%lazy_message]; [%expect {| () |}]; pr_lazy [%lazy_message (Some 1 : (int option[@sexp.option])) (None : (int option[@sexp.option]))]; [%expect {| ("Some 1" 1) |}]; pr_lazy [%lazy_message ([ 1 ] : (int list[@omit_nil])) ([] : (int list[@omit_nil]))]; [%expect {| ([1] (1)) |}]; pr_lazy [%lazy_message.omit_nil (Some 1 : int option) (None : int option)]; [%expect {| ("Some 1" 1) |}]; pr_lazy [%lazy_message.omit_nil ([ 1 ] : int list) ([] : int list)]; [%expect {| ([1] (1)) |}] ;; let%expect_test "[%message] is not lazy" = let side_effect = ref false in let _ = [%message (side_effect := true : unit)] in Expect_test_helpers_base.require [%here] !side_effect; [%expect {| |}] ;; let%expect_test "[%message_lazy] is lazy" = let side_effect = ref false in let lazy_message = [%lazy_message (side_effect := true : unit)] in Expect_test_helpers_base.require_equal [%here] (module Bool) !side_effect false; [%expect {| |}]; let _ = Lazy.force lazy_message in Expect_test_helpers_base.require [%here] !side_effect; [%expect {| |}] ;; ppx_sexp_message-0.17.0/test/test.mli000066400000000000000000000000551461647336100176250ustar00rootroot00000000000000(*_ This signature is deliberately empty. *)