Version 0.42.1: Fix json export (missing commmands)

CHANGES

+Version 0.42.1 (2017/04/19)
+  * Fix json export (missing commmands)
+
 Version 0.42.0 (2017/04/18)
   * Add json export
 

VERSION

-0.42.0
\ No newline at end of file
+0.42.1
\ No newline at end of file

src/grew_command.ml

@@ -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

src/grew_command.mli

@@ -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)

src/grew_edge.ml

@@ -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__"

src/grew_edge.mli

@@ -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

src/grew_rule.ml

@@ -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
     )