New API for getting list of classes

datastructures.ml

@@ -18,3 +18,5 @@
 module StringSet = Set.Make(String)
 module StringMap = Map.Make(String)
 module UuidSet = StringSet
+
+let string_map_keys m = StringMap.fold (fun k _ acc -> k :: acc) m []

factory.ml

@@ -33,6 +33,9 @@ let register_class name factory =
       else (Log.info "Registered node class" [Str name];
 	    classes := StringMap.add name factory !classes))
 
+let all_class_names () =
+  Datastructures.string_map_keys !classes
+
 let lookup_class name =
   try Some (StringMap.find name !classes)
   with Not_found -> None

json.ml

@@ -25,6 +25,8 @@ type t =
 
 exception Syntax_error
 
+let str s = Str s
+
 let escape_char c =
   match c with
   | '\"' -> Some (fun (s, pos) -> ("\\\"", pos + 1))

ui_main.ml

@@ -65,6 +65,10 @@ let api_server_stats id r =
 		      "boot_time", Json.Num boot_time;
 		      "uptime", Json.Num (Unix.time () -. boot_time)])
 
+let api_all_classes id r =
+  Json.resp_ok [] (Json.Arr (List.map Json.str (Factory.all_class_names ())))
+
 let init () =
   register_dispatcher ("/_/server_stats", api_server_stats);
+  register_dispatcher ("/_/all_classes", api_all_classes);
   ignore (Util.create_thread "HTTP listener" None (Net.start_net "HTTP" 5678) start)

web/ui_main.js

@@ -26,6 +26,12 @@ function refresh_server_stats() {
     }).error(server_disconnected);
 }
 
+function refresh_all_classes() {
+    $.getJSON("/_/all_classes", function (data) {
+	$("#debug_container").append(JSON.stringify(data));
+    });
+}
+
 var Ocamlmsg = {
     _send: function (msg) {
 	$tap.send({data: JSON.stringify(msg)});
@@ -89,6 +95,7 @@ function reset_tap_stream() {
 
         open: function (event, stream) {
 	    refresh_server_stats();
+	    refresh_all_classes();
 	    Ocamlmsg.post(stream.id, {"test":true});
 	    Ocamlmsg.create("fanout", ["system.log"], "completion1");
 	    Ocamlmsg.subscribe("meta", "system.log", "sub_messages", "completion2");