Commit ab12f7f1 authored by Bruno Guillaume's avatar Bruno Guillaume

Version 0.42.1: Fix json export (missing commmands)

parent 722e49ac
Version 0.42.1 (2017/04/19)
* Fix json export (missing commmands)
Version 0.42.0 (2017/04/18)
* Add json export
......
0.42.0
\ No newline at end of file
0.42.1
\ No newline at end of file
......@@ -24,6 +24,10 @@ module Command = struct
| Pat of Pid.t (* a node identified in the pattern *)
| New of string (* a node introduced by a new_neighbour *) (* TODO: remove *)
let command_node_to_json = function
| Pat pid -> `String (Pid.to_string pid)
| New s -> `String s
(* [item] is a element of the RHS of an update_feat command *)
type item =
| Feat of (command_node * string)
......@@ -31,6 +35,17 @@ module Command = struct
| Param_in of int
| Param_out of int
let item_to_json = function
| Feat (cn, feature_name) -> `Assoc [("copy_feat",
`Assoc [
("node",command_node_to_json cn);
("feature_name", `String feature_name);
]
)]
| String s -> `Assoc [("string", `String s)]
| Param_in i -> `Assoc [("param_in", `Int i)]
| Param_out i -> `Assoc [("param_out", `Int i)]
(* the command in pattern *)
type p =
| DEL_NODE of command_node
......@@ -51,6 +66,91 @@ module Command = struct
type t = p * Loc.t (* remember command location to be able to localize a command failure *)
let to_json ?domain (p, _) = match p with
| DEL_NODE cn -> `Assoc [("del_node", command_node_to_json cn)]
| DEL_EDGE_EXPL (src,tar,edge) ->
`Assoc [("del_edge_expl",
`Assoc [
("src",command_node_to_json src);
("tar",command_node_to_json tar);
("edge", G_edge.to_json ?domain edge);
]
)]
| DEL_EDGE_NAME edge_name -> `Assoc [("del_edge_name", `String edge_name)]
| ADD_EDGE (src,tar,edge) ->
`Assoc [("add_edge",
`Assoc [
("src",command_node_to_json src);
("tar",command_node_to_json tar);
("edge", G_edge.to_json ?domain edge);
]
)]
| DEL_FEAT (cn, feature_name) ->
`Assoc [("del_feat",
`Assoc [
("node",command_node_to_json cn);
("feature_name", `String feature_name);
]
)]
| UPDATE_FEAT (cn, feature_name, items) ->
`Assoc [("update_feat",
`Assoc [
("node",command_node_to_json cn);
("feature_name", `String feature_name);
("items", `List (List.map item_to_json items));
]
)]
| NEW_NODE name -> `Assoc [("new_node", `String name)]
| NEW_BEFORE (name, cn) ->
`Assoc [("new_before",
`Assoc [
("name", `String name);
("node", command_node_to_json cn);
]
)]
| NEW_AFTER (name, cn) ->
`Assoc [("new_after",
`Assoc [
("name", `String name);
("node", command_node_to_json cn);
]
)]
| SHIFT_EDGE (src,tar,label_cst) ->
`Assoc [("shift_edge",
`Assoc [
("src",command_node_to_json src);
("tar",command_node_to_json tar);
("label_cst", Label_cst.to_json ?domain label_cst);
]
)]
| SHIFT_IN (src,tar,label_cst) ->
`Assoc [("shift_in",
`Assoc [
("src",command_node_to_json src);
("tar",command_node_to_json tar);
("label_cst", Label_cst.to_json ?domain label_cst);
]
)]
| SHIFT_OUT (src,tar,label_cst) ->
`Assoc [("shift_out",
`Assoc [
("src",command_node_to_json src);
("tar",command_node_to_json tar);
("label_cst", Label_cst.to_json ?domain label_cst);
]
)]
| MERGE_NODE (src,tar) ->
`Assoc [("merge",
`Assoc [
("src",command_node_to_json src);
("tar",command_node_to_json tar);
]
)]
(* a item in the command history: command applied to a graph *)
type h =
| H_DEL_NODE of Gid.t
......
......@@ -44,6 +44,8 @@ module Command : sig
| MERGE_NODE of (command_node * command_node)
type t = (p * Loc.t)
val to_json: ?domain:Domain.t -> t -> Yojson.Basic.json
type h =
| H_DEL_NODE of Gid.t
| H_DEL_EDGE_EXPL of (Gid.t * Gid.t *G_edge.t)
......
......@@ -108,6 +108,8 @@ module G_edge = struct
let to_string ?domain t = Label.to_string ?domain t
let to_json ?domain t = `String (Label.to_string ?domain t)
let make ?loc ?domain string = Label.from_string ?loc ?domain string
let sub = make "__SUB__"
......
......@@ -56,6 +56,8 @@ module G_edge: sig
val to_string: ?domain:Domain.t -> t -> string
val to_json: ?domain:Domain.t -> t -> Yojson.Basic.json
val make: ?loc:Loc.t -> ?domain:Domain.t -> string -> t
val sub: t
......
......@@ -396,6 +396,7 @@ module Rule = struct
("rule_name", `String t.name);
("match", basic_to_json ?domain (fst t.pattern));
("without", `List (List.map (basic_to_json ?domain) (snd t.pattern)));
("commands", `List (List.map (Command.to_json ?domain) t.commands))
] @ param_json
)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment