104 lines
2.5 KiB
OCaml
104 lines
2.5 KiB
OCaml
|
open Stdppx
|
||
|
|
open Ppxlib
|
||
|
|
|
||
|
|
|
||
|
|
(* Linters *)
|
||
|
|
|
||
|
|
let lint = object
|
||
|
|
inherit [Driver.Lint_error.t list] Ast_traverse.fold as super
|
||
|
|
|
||
|
|
method! type_declaration td acc =
|
||
|
|
let acc = super#type_declaration td acc in
|
||
|
|
match td.ptype_kind with
|
||
|
|
| Ptype_record lds ->
|
||
|
|
if Poly.(<>)
|
||
|
|
(List.sort lds ~cmp:(fun a b -> String.compare a.pld_name.txt b.pld_name.txt))
|
||
|
|
lds
|
||
|
|
then
|
||
|
|
Driver.Lint_error.of_string { td.ptype_loc with loc_ghost = true }
|
||
|
|
"Fields are not sorted!"
|
||
|
|
:: acc
|
||
|
|
else
|
||
|
|
acc
|
||
|
|
| _ -> acc
|
||
|
|
end
|
||
|
|
let () =
|
||
|
|
Driver.register_transformation "lint" ~lint_impl:(fun st -> lint#structure st [])
|
||
|
|
[%%expect{|
|
||
|
|
val lint : Driver.Lint_error.t list Ast_traverse.fold = <obj>
|
||
|
|
|}]
|
||
|
|
|
||
|
|
type t =
|
||
|
|
{ b : int
|
||
|
|
; a : int
|
||
|
|
}
|
||
|
|
[%%expect{|
|
||
|
|
Line _, characters 0-36:
|
||
|
|
Error (warning 22): Fields are not sorted!
|
||
|
|
|}]
|
||
|
|
|
||
|
|
|
||
|
|
(* Extension with a path argument *)
|
||
|
|
|
||
|
|
let () =
|
||
|
|
Driver.register_transformation "plop"
|
||
|
|
~rules:[Context_free.Rule.extension
|
||
|
|
(Extension.declare_with_path_arg "plop"
|
||
|
|
Expression
|
||
|
|
Ast_pattern.(pstr nil)
|
||
|
|
(fun ~loc ~path:_ ~arg ->
|
||
|
|
let open Ast_builder.Default in
|
||
|
|
match arg with
|
||
|
|
| None -> estring ~loc "-"
|
||
|
|
| Some { loc; txt } -> estring ~loc (Longident.name txt)))]
|
||
|
|
[%%expect{|
|
||
|
|
|}]
|
||
|
|
|
||
|
|
let _ = Stdlib.Printf.sprintf "%s\n" [%plop]
|
||
|
|
[%%expect{|
|
||
|
|
- : string = "-\n"
|
||
|
|
|}]
|
||
|
|
|
||
|
|
let _ = Stdlib.Printf.sprintf "%s\n" [%plop.Truc]
|
||
|
|
[%%expect{|
|
||
|
|
- : string = "Truc\n"
|
||
|
|
|}]
|
||
|
|
|
||
|
|
let _ = Stdlib.Printf.sprintf "%s\n" [%plop.Truc.Bidule]
|
||
|
|
[%%expect{|
|
||
|
|
- : string = "Truc.Bidule\n"
|
||
|
|
|}]
|
||
|
|
|
||
|
|
|
||
|
|
(* Extension with a path argument and ctxt *)
|
||
|
|
|
||
|
|
let () =
|
||
|
|
Driver.register_transformation "plop_ctxt"
|
||
|
|
~rules:[Context_free.Rule.extension
|
||
|
|
(Extension.V3.declare_with_path_arg "plop_ctxt"
|
||
|
|
Expression
|
||
|
|
Ast_pattern.(pstr nil)
|
||
|
|
(fun ~ctxt ~arg ->
|
||
|
|
let open Ast_builder.Default in
|
||
|
|
let loc = Expansion_context.Extension.extension_point_loc ctxt in
|
||
|
|
match arg with
|
||
|
|
| None -> estring ~loc "-"
|
||
|
|
| Some { loc; txt } -> estring ~loc (Longident.name txt)))]
|
||
|
|
[%%expect{|
|
||
|
|
|}]
|
||
|
|
|
||
|
|
let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt]
|
||
|
|
[%%expect{|
|
||
|
|
- : string = "-\n"
|
||
|
|
|}]
|
||
|
|
|
||
|
|
let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt.Truc]
|
||
|
|
[%%expect{|
|
||
|
|
- : string = "Truc\n"
|
||
|
|
|}]
|
||
|
|
|
||
|
|
let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt.Truc.Bidule]
|
||
|
|
[%%expect{|
|
||
|
|
- : string = "Truc.Bidule\n"
|
||
|
|
|}]
|