Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add json mapper for pp_ast #526

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open

Add json mapper for pp_ast #526

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 8 additions & 3 deletions bin/pp_ast.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -97,6 +97,10 @@ let loc_mode =
in
named (fun x -> `Loc_mode x) Cmdliner.Arg.(value & vflag `Short [ full_locs ])

let json =
let doc = "Show AST as json" in
named (fun x -> `Json x) Cmdliner.Arg.(value & flag & info ~doc [ "json" ])

let kind =
let make_vflag (flag, (kind : Kind.t), doc) =
(Some kind, Cmdliner.Arg.info ~doc [ flag ])
Expand Down Expand Up @@ -126,7 +130,7 @@ let input =
let errorf fmt = Printf.ksprintf (fun s -> Error s) fmt

let run (`Show_attrs show_attrs) (`Show_locs show_locs) (`Loc_mode loc_mode)
(`Kind kind) (`Input input) =
(`Json json) (`Kind kind) (`Input input) =
let open Stdppx.Result in
let kind =
match kind with
Expand All @@ -147,13 +151,14 @@ let run (`Show_attrs show_attrs) (`Show_locs show_locs) (`Loc_mode loc_mode)
match input with Stdin -> "<stdin>" | File fn -> fn | Source _ -> "<cli>"
in
let ast = load_input ~kind ~input_name input in
let config = Pp_ast.Config.make ~show_attrs ~show_locs ~loc_mode () in
let config = Pp_ast.Config.make ~show_attrs ~show_locs ~loc_mode ~json () in
pp_ast ~config ast;
Format.printf "%!\n";
Ok ()

let term =
Cmdliner.Term.(const run $ show_attrs $ show_locs $ loc_mode $ kind $ input)
Cmdliner.Term.(
const run $ show_attrs $ show_locs $ loc_mode $ json $ kind $ input)

let tool_name = "ppxlib-pp-ast"

Expand Down
71 changes: 66 additions & 5 deletions src/pp_ast.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,21 +2,28 @@ open Import

module Config = struct
type loc_mode = [ `Short | `Full ]
type t = { show_attrs : bool; show_locs : bool; loc_mode : loc_mode }

type t = {
show_attrs : bool;
show_locs : bool;
loc_mode : loc_mode;
json : bool;
}

module Default = struct
let show_attrs = false
let show_locs = false
let loc_mode = `Short
let json = false
end

let default =
let open Default in
{ show_attrs; show_locs; loc_mode }
{ show_attrs; show_locs; loc_mode; json }

let make ?(show_attrs = Default.show_attrs) ?(show_locs = Default.show_locs)
?(loc_mode = Default.loc_mode) () =
{ show_attrs; show_locs; loc_mode }
?(json = Default.json) ?(loc_mode = Default.loc_mode) () =
{ show_attrs; show_locs; loc_mode; json }
end

let cnum (pos : Lexing.position) = pos.pos_cnum - pos.pos_bol
Expand All @@ -38,6 +45,58 @@ type simple_val =
| List of simple_val list
| Special of string

let pp_simple_val_to_json fmt simple_val =
let rec aux indent fmt simple_val =
match simple_val with
| Unit -> Format.fprintf fmt {|"null"|}
| Int i -> Format.fprintf fmt "%d" i
| String s -> Format.fprintf fmt {|"%s"|} s
| Special s -> Format.fprintf fmt {|"%s"|} s
| Bool b -> Format.fprintf fmt "%b" b
| Char c -> Format.fprintf fmt {|"%c"|} c
| Float f -> Format.fprintf fmt "%f" f
| Int32 i32 -> Format.fprintf fmt "%ld" i32
| Int64 i64 -> Format.fprintf fmt "%Ld" i64
| Nativeint ni -> Format.fprintf fmt "%nd" ni
| Array l | Tuple l | List l ->
Format.fprintf fmt "[\n";
List.iteri
~f:(fun i sv ->
if i > 0 then Format.fprintf fmt ",\n";
Format.fprintf fmt "%s" (String.make (indent + 2) ' ');
aux (indent + 2) fmt sv)
l;
Format.fprintf fmt "\n%s]" (String.make indent ' ')
| Record fields ->
Format.fprintf fmt "{\n";
List.iteri
~f:(fun i (k, v) ->
if i > 0 then Format.fprintf fmt ",\n";
Format.fprintf fmt "%s\"%s\": " (String.make (indent + 2) ' ') k;
aux (indent + 2) fmt v)
fields;
Format.fprintf fmt "\n%s}" (String.make indent ' ')
| Constr (cname, []) -> Format.fprintf fmt {|"%s"|} cname
| Constr (cname, [ (Constr (_, _ :: _) as x) ]) ->
Format.fprintf fmt "{\n%s\"%s\": " (String.make (indent + 2) ' ') cname;
aux (indent + 2) fmt x;
Format.fprintf fmt "\n%s}" (String.make indent ' ')
| Constr (cname, [ x ]) ->
Format.fprintf fmt "{\n%s\"%s\": " (String.make (indent + 2) ' ') cname;
aux (indent + 2) fmt x;
Format.fprintf fmt "\n%s}" (String.make indent ' ')
| Constr (cname, l) ->
Format.fprintf fmt "{\n%s\"%s\": [\n" (String.make (indent + 2) ' ') cname;
List.iteri
~f:(fun i sv ->
if i > 0 then Format.fprintf fmt ",\n";
Format.fprintf fmt "%s" (String.make (indent + 4) ' ');
aux (indent + 4) fmt sv)
l;
Format.fprintf fmt "\n%s]\n%s}" (String.make (indent + 2) ' ') (String.make indent ' ')
in
aux 0 fmt simple_val
Comment on lines +48 to +98
Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@patricoferris @NathanReb I've just pushed this simple pretty-printing json function to remove the yojson.

One workaround if this were to be merged here would be to add yojson as a dependency for ppxlib-pp-ast and then ppxlib could return the polymorphic variants that happen to correspond to the Yojson.Safe.t variants?

I could let yojson as a ppxlib_pp_ast dep and return the poly-vars to print jsons only at ppxlib_pp_ast or on the usage of Ppxlib.pp_ast, but it looked hacky as we would have the "pretty-printing" not printing the json but return those poly vars.

Another alternative would be ppxlib-tools to have this dependency and pp_ast to use it.

But as it was not hard to create a simple pp for json, I created it. It isn't as pretty as yojson cause we break every array/list/tuple/record line, but it does not feel like a problem right now.

BTW, I tried to follow pp_simple_val way to print, but it had a strange indent structure, and I created this way. If any issue, just let me now.


let pp_collection ~pp_elm ~open_ ~close ~sep fmt l =
match l with
| [] -> Format.fprintf fmt "%s%s" open_ close
Expand Down Expand Up @@ -271,7 +330,9 @@ let with_config ~config ~f =

let pp_with_config (type a) (lifter : a -> simple_val)
?(config = Config.default) fmt (x : a) =
with_config ~config ~f:(fun () -> pp_simple_val fmt (lifter x))
with_config ~config ~f:(fun () ->
if config.json then pp_simple_val_to_json fmt (lifter x)
else pp_simple_val fmt (lifter x))

let structure = pp_with_config lift_simple_val#structure
let structure_item = pp_with_config lift_simple_val#structure_item
Expand Down
1 change: 1 addition & 0 deletions src/pp_ast.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,7 @@ module Config : sig
val make :
?show_attrs:bool ->
?show_locs:bool ->
?json:bool ->
?loc_mode:[ `Short | `Full ] ->
unit ->
t
Expand Down
Loading