swh:1:snp:e3b0b9991945262e7cc28768373af4560caf7afa
Tip revision: ad0c16675d221938530269610308cd5a2c142687 authored by Software Heritage on 17 October 2018, 13:20:37 UTC
hal: Deposit 205 in collection hal
hal: Deposit 205 in collection hal
Tip revision: ad0c166
jsonHelpers.ml
(**************************************************************************)
(* -*- tuareg -*- *)
(* *)
(* Copyright (C) 2017,2018 Yann RĂ©gis-Gianas, Nicolas Jeannerod, *)
(* Ralf Treinen. *)
(* *)
(* This is free software: you can redistribute it and/or modify it *)
(* under the terms of the GNU General Public License, version 3. *)
(* *)
(* Additional terms apply, due to the reproduction of portions of *)
(* the POSIX standard. Please refer to the file COPYING for details. *)
(**************************************************************************)
let rec json_filter_positions =
let open Yojson.Safe in
function
| `Assoc sjl ->
if List.for_all (fun (s, j) -> s = "value" || s = "position") sjl then
let (_, j) = List.find (fun (s, _) -> s = "value") sjl in
json_filter_positions j
else
`Assoc (List.map (fun (s, j) ->
Format.printf "%s@." s; (s, json_filter_positions j)) sjl
)
| `Bool b -> `Bool b
| `Float f -> `Float f
| `Int i -> `Int i
| `Intlit s -> `Intlit s
| `List jl -> `List (List.map json_filter_positions jl)
| `Null -> `Null
| `String s -> `String s
| `Tuple jl -> `Tuple (List.map json_filter_positions jl)
| `Variant (s, None) -> `Variant (s, None)
| `Variant (s, Some j) -> `Variant (s, Some (json_filter_positions j))
let convert_to_json simplified csts =
CSTHelpers.program_to_json csts
|> (if simplified then json_filter_positions else function x-> x)
let save_as_json simplified cout csts =
convert_to_json simplified csts
|> Yojson.Safe.pretty_to_channel cout
let load_from_json cin =
Yojson.Safe.from_channel cin |> CST.program_of_yojson
|> Ppx_deriving_yojson_runtime.Result.(function
| Ok cst -> cst
| Error msg -> raise (Errors.DuringIO msg)
)
let json_to_dot cout json =
Printf.(
let fresh =
let r = ref 0 in
fun () ->
incr r;
Printf.sprintf "node%d" !r
in
let rec traverse = function
| `List (`String name :: children) ->
let nodeid = fresh () in
fprintf cout "%s [label=\"%s\"];\n" nodeid name;
let childrenids = List.map traverse children in
List.iter (fun c -> fprintf cout "%s -> %s;\n" nodeid c) childrenids;
nodeid
| `String name ->
let nodeid = fresh () in
fprintf cout "%s [label=\"%s\"];\n" nodeid (String.escaped name);
nodeid
| `List [x] ->
traverse x
| `List children ->
let nodeid = fresh () in
fprintf cout "%s [shape=point];\n" nodeid;
let childrenids = List.map traverse children in
List.iter (fun c -> fprintf cout "%s -> %s;\n" nodeid c) childrenids;
nodeid
| _ ->
assert false
in
fprintf cout "digraph {\n";
ignore (traverse json);
fprintf cout "}\n"
)
let save_as_dot cout csts =
convert_to_json true csts
|> json_to_dot cout