nodes2grafana/src/graph2prom.sml

structure Main :
sig
	val main: string * string list -> OS.Process.status
end =
struct
	structure J = JSON
	structure JP = JSONParser
	structure JU = JSONUtil

	structure M : MESH = Mesh
	structure PC = PromConfig

	val link_prefix = PC.link_prefix
	val mesh_prefix = PC.mesh_prefix

	val newline = String.str #"\n"
	val link_header =
		"# HELP " ^ link_prefix ^ " link quality between two nodes" ^ newline ^
		"# TYPE " ^ link_prefix ^ " gauge" ^ newline
	val mesh_header =
		"# HELP " ^ mesh_prefix ^ " members and (nodes + edges / 1000) of a mesh" ^ newline ^
		"# TYPE " ^ mesh_prefix ^ " gauge" ^ newline

	fun prom2string (metric, labels, scalar) =
		let fun esc #"\"" = "\\\""
		      | esc #"\\" = "\\\\"
		      | esc #"\n" = "\\n"
		      | esc c = str c
		in metric ^
		   (ListFormat.fmt {init = "{", sep= ",", final = "}",
				    fmt = fn (label, value) => label ^ "=\"" ^ (String.translate esc value) ^ "\""}
				   labels) ^ " " ^
		   scalar ^ (* " " ^
		   timestamp ^ *) newline
		end

	(* exnMessage from JSONUtil - slightly extended *)

	fun v2bs' (J.ARRAY []) = "[]"
	  | v2bs' (J.ARRAY _) = "[...]"
	  | v2bs' (J.BOOL v) = Bool.toString v
	  | v2bs' (J.FLOAT v) = Real.toString v
	  | v2bs' (J.INT v) = IntInf.toString v
	  | v2bs' J.NULL = "null"
	  | v2bs' (J.OBJECT []) = "{}"
	  | v2bs' (J.OBJECT _) = "{...}"
	  | v2bs' (J.STRING v) = v

	fun v2bs (J.ARRAY []) = "[]"
	  | v2bs (J.ARRAY vl) =
		ListFormat.fmt { init = "[", sep = ",", final = "]", fmt = v2bs' } vl
	  | v2bs (J.OBJECT []) = "{}"
	  | v2bs (J.OBJECT fl) =
		ListFormat.fmt { init = "{", sep = ",", final = "}",
				 fmt = fn (n, v) => n ^ ":" ^ (v2bs' v) } fl
	  | v2bs v = v2bs' v

	fun json_handler logstring exn =
		(TextIO.output (TextIO.stdErr, 
		 "json_handler(" ^ logstring ^ "): " ^ (JU.exnMessage exn) ^ ": " ^
		 (v2bs (case exn
			 of JU.NotBool v => v
			  | JU.NotInt v => v
			  | JU.NotNumber v => v
		 	  | JU.NotString v => v
		 	  | JU.NotObject v => v
		 	  | JU.FieldNotFound(v, fld) => v
		 	  | JU.NotArray v => v
			  | _ => raise exn)) ^
		 "\n") ; ())

	fun get_version obj = JU.asInt (JU.lookupField obj "version")

	fun get_fields (J.OBJECT flds) = flds
	  | get_fields v = raise Fail ("value is not an object (" ^ (v2bs v) ^ ")")

	fun get_list (J.OBJECT flds) = map #2 flds
	  | get_list (J.ARRAY nds) = nds
	  | get_list v = raise Fail ("value does not contain a list (" ^ (v2bs v) ^ ")")

	fun get_nodes obj = get_list (JU.lookupField (JU.lookupField obj "batadv") "nodes")
	fun get_links obj = get_list (JU.lookupField (JU.lookupField obj "batadv") "links")

	fun extract_node obj = { id = JU.asString (JU.lookupField obj "id"),
				 node_id = JU.asString (JU.lookupField obj "node_id") }

	fun extract_link obj = { source = JU.asInt (JU.lookupField obj "source"),
				 target = JU.asInt (JU.lookupField obj "target"),
				 tq = JU.asNumber (JU.lookupField obj "tq"),
				 vpn = JU.asBool (JU.lookupField obj "vpn") }

	fun link2prom nodes_id_vector { source, target, tq, vpn } =
		let val source_id = Vector.sub (nodes_id_vector, source)
		    val target_id = Vector.sub (nodes_id_vector, target)
		in prom2string (link_prefix,
				[("source", source_id), ("target", target_id), ("vpn", Bool.toString vpn)],
				Real.toString tq)
		end

	fun mesh2prom nodes_id_vector { nodes, edges } =
		let val node_count = Real.fromInt (M.Set.numItems nodes)
		    val edge_count = Real.fromInt (M.PairSet.numItems edges)
		    val members = ListMergeSort.sort String.>
					(map (fn i => Vector.sub (nodes_id_vector, i))
					     (M.Set.listItems nodes))
		in prom2string (mesh_prefix,
				[("node_id", hd members),
				 ("members", ListFormat.fmt { init = "", final = "", sep = "|",
							      fmt = fn m => m }
							    members)],
				Real.toString (node_count + edge_count / 1000.0))
		end

	fun complain (p, s) =
		(TextIO.output (TextIO.stdErr, concat [p, ": ", s, "\n"]);
		 OS.Process.failure)

	fun main (p, [inf]) =
		(let val json = JP.parseFile inf
		     val _ = get_version json = 1 orelse raise Fail "version must be 1"
		     val nodes_json = get_nodes json
				      handle exn => (json_handler "get_nodes" exn ; raise Fail "get_nodes")
		     val nodes_vector = Vector.fromList (map extract_node nodes_json)
		     val nodes_id_vector = Vector.map #node_id nodes_vector
		     val links_json = get_links json
				      handle exn => (json_handler "get_links" exn ; raise Fail "get_links")
		     val links_extract = map extract_link links_json
		     val links_prom = map (link2prom nodes_id_vector) links_extract
		     val graph = M.links2graph (map (fn l => (#source l, #target l))
						    links_extract)
		     val meshes_prom = map (mesh2prom nodes_id_vector)
					   (M.Map.listItems (#meshes graph))
		 in (print link_header ;
		     print mesh_header ;
		     app print links_prom ;
		     app print meshes_prom ;
		     OS.Process.success)
		 end handle e => complain (p, exnMessage e))
	  | main (p, _) = complain (p, "usage: " ^ p ^ " graph.json")
end