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

	structure PC = PromConfig
	val prom_prefix = PC.prom_prefix
	val summary_prefix = PC.summary_prefix
	val info_prefix = PC.info_prefix
	val stats_prefix = PC.stats_prefix

	val timestamp = ref (LargeInt.toString (Time.toMilliseconds (Time.now ())))

	val newline = String.str #"\n"
	val summary_header = [
		"# HELP " ^ summary_prefix ^ " sum of nodes and of some attributes" ^ newline ^
		"# TYPE " ^ summary_prefix ^ " gauge" ^ newline ]
	val info_header = [
		"# HELP " ^ info_prefix ^ " static attributes of a node" ^ newline ^
		"# TYPE " ^ info_prefix ^ " counter" ^ newline,
		"# HELP " ^ info_prefix ^ "_fw_version firmware version as an integer value" ^ newline ^
		"# TYPE " ^ info_prefix ^ "_fw_version gauge" ^ newline,
		"# HELP " ^ info_prefix ^ "_lastseen metric for the lastseen attribute of a node" ^ newline ^
		"# TYPE " ^ info_prefix ^ "_lastseen gauge" ^ newline,
		"# HELP " ^ info_prefix ^ "_firstseen metric for the firtseen attribute of a node" ^ newline ^
		"# TYPE " ^ info_prefix ^ "_firstseen gauge" ^ newline ]

	fun stats_header key =
		"# HELP " ^ stats_prefix ^ key ^ " metric for the " ^ key ^ " attribute of a node" ^ newline ^
		"# TYPE " ^ stats_prefix ^ key ^  " 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 firmware2int firmware = 
		foldl (fn (s, i) => 100 * i + valOf (Int.fromString s))
		      0
		      (String.tokens (fn c => c = #".") firmware)

	fun timestring2time ts = (* "timestamp" : "2017-10-01T18:49:11+02:00" *)
		let val tsfields = String.tokens (fn c => c = #"-" orelse c = #"T" orelse c = #":" orelse c = #"+") ts
		    val tsints = map (valOf o Int.fromString) tsfields
		    fun int2month i =
			let open Date
			    val months = [ Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec ]
			in List.nth (months, i - 1)
			end
		    val tsdate =
			Date.date {
				year = List.nth (tsints, 0),
				month = int2month (List.nth (tsints, 1)),
				day = List.nth (tsints, 2),
				hour = List.nth (tsints, 3),
				minute = List.nth (tsints, 4),
				second = List.nth (tsints, 5),
				(* Basis/date.html:
				   ... offset reports time zone information as the amount of time west [sic!] of UTC. *)
				offset = SOME (Time.fromSeconds (~1 * 60 * Int.toLarge ((60 * List.nth (tsints, 6) + List.nth (tsints, 7))))) }
		in Date.toTime tsdate
		end

	fun get_timestamp obj =
		let val tsstring = JU.asString (JU.lookupField obj "timestamp")
		    val tstime = timestring2time tsstring
		in timestamp := LargeInt.toString (Time.toMilliseconds tstime)
		end
		handle exn => json_handler ("get_timestamp") exn

	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 obj "nodes")

	fun extract node =
		let val nodeinfo = JU.lookupField node "nodeinfo"
		    val hostname = JU.asString (JU.lookupField nodeinfo "hostname")
		    val node_id = JU.asString (JU.lookupField nodeinfo "node_id")
		    local val interfaces' = get_fields (JU.lookupField (JU.lookupField (JU.lookupField (JU.lookupField nodeinfo "network") "mesh") "bat0") "interfaces")
			  val interfaces'' = map (fn i => (#1 i) ^ ":" ^ (Int.toString (length (get_list (#2 i))))) interfaces'
			  val interfaces''' = ListMergeSort.sort String.> interfaces''
		    in val interfaces = ListFormat.fmt { init = "", sep = ",", final = "", fmt = (fn s => s) } interfaces'''
		    end
		    val location = JU.findField nodeinfo "location"
		    val (longitude, latitude) =
			case location
			  of SOME l => (SOME (JU.asNumber (JU.lookupField l "longitude")),
					SOME (JU.asNumber (JU.lookupField l "latitude")))
			   | NONE => (NONE, NONE)
		    val software = JU.lookupField nodeinfo "software"
		    val autoupdater = JU.asBool (JU.lookupField (JU.lookupField software "autoupdater") "enabled")
		    val fastd = JU.asBool (JU.lookupField (JU.lookupField software "fastd") "enabled")
		    val firmware = JU.asString (JU.lookupField (JU.lookupField software "firmware") "release")
		    val base = JU.asString (JU.lookupField (JU.lookupField software "firmware") "base")
		    val model = JU.asString (JU.lookupField (JU.lookupField nodeinfo "hardware") "model")

		    val statistics = JU.lookupField node "statistics"
		    val clients = JU.asInt (JU.lookupField statistics "clients")
		    val gateway = JU.asString (JU.lookupField statistics "gateway")
		    val loadavg = JU.asNumber (JU.lookupField statistics "loadavg")
		    val memory_usage = JU.asNumber (JU.lookupField statistics "memory_usage")
		    val rootfs_usage = JU.asNumber (JU.lookupField statistics "rootfs_usage")
		    val uptime = JU.asNumber (JU.lookupField statistics "uptime")
		    val traffic = JU.lookupField statistics "traffic"
		    val tx = SOME (JU.asNumber (JU.lookupField (JU.lookupField traffic "tx") "bytes"))
				 handle exn => NONE
		    val rx = SOME (JU.asNumber (JU.lookupField (JU.lookupField traffic "rx") "bytes"))
				 handle exn => NONE
		    val forward = SOME (JU.asNumber (JU.lookupField (JU.lookupField traffic "forward") "bytes"))
				 handle exn => NONE
		    val mgmt_tx = SOME (JU.asNumber (JU.lookupField (JU.lookupField traffic "mgmt_tx") "bytes"))
				 handle exn => NONE
		    val mgmt_rx = SOME (JU.asNumber (JU.lookupField (JU.lookupField traffic "mgmt_rx") "bytes"))
				 handle exn => NONE
		    val flags = JU.lookupField node "flags"
		    val online = JU.asBool (JU.lookupField flags "online")
		    val uplink = JU.asBool (JU.lookupField flags "uplink")
		    val lastseen = timestring2time (JU.asString (JU.lookupField node "lastseen"))
		    val firstseen = timestring2time (JU.asString (JU.lookupField node "firstseen"))
		in SOME
		   ({	clients = clients,
			online = online,
			uplink = uplink },
		    {	hostname = hostname,
			online = online,
			node_id = node_id,
			interfaces = interfaces,
			longitude = longitude,
			latitude = latitude,
			autoupdater = autoupdater,
			gateway = gateway,
			fastd = fastd,
			firmware = firmware,
			base = base,
			model = model,
			lastseen = lastseen,
			firstseen = firstseen },
		    {	hostname = hostname,
			node_id = node_id,
			clients = clients,
			online = online,
			uplink = uplink,
			loadavg = loadavg,
			memory_usage = memory_usage,
			rootfs_usage = rootfs_usage,
			uptime = uptime,
			tx = tx,
			rx = rx,
			forward = forward,
			mgmt_tx = mgmt_tx,
			mgmt_rx = mgmt_rx }
		   )
		end
		handle exn => (json_handler "extract" exn ; NONE)

	fun nodes_summary node_summaries =
		let fun summate (node_summary, (hcount, ccount, ocount, ucount)) =
			let val { clients, online, uplink } = node_summary
			in (hcount + 1,
			    ccount + clients,
			    if online then ocount + 1 else ocount,
			    if uplink then ucount + 1 else ucount)
			end
		     val (hc, cc, oc, uc) = foldl summate (0, 0, 0, 0) node_summaries
		     val scalars = map Int.toString [hc, cc, oc, uc]
		     val labelvalues = ["nodes", "clients", "online", "uplink"]
		     val items = ListPair.zip (labelvalues, scalars)
		in foldr (fn ((count, scalar), result) =>
				(prom2string (summary_prefix, [("count", count)], scalar)) ^
				result)
			 ""
			 items
		end

	fun node_info {	hostname, online, node_id, interfaces, longitude, latitude, autoupdater, fastd, gateway, firmware, base, model, lastseen, firstseen } =
		let val minitems = [
				("hostname", hostname),
				("node_id", node_id)]
		    val allitems = minitems @ [
				("interfaces", interfaces),
				("longitude", case longitude
						of NONE => "NaN"
						 | SOME l => Real.toString l),
				("latitude", case latitude
						of NONE => "NaN"
						 | SOME l => Real.toString l),
				("autoupdater", Bool.toString autoupdater),
				("fastd", Bool.toString fastd),
				("gateway", gateway),
				("firmware", firmware),
				("base", base),
				("model", model)]
		in [("!info", prom2string (info_prefix, allitems, "1")),
		    ("fw_version", prom2string (info_prefix ^ "_fw_version", minitems, Int.toString (firmware2int firmware))),
		    ("lastseen", prom2string (info_prefix ^ "_lastseen", minitems, LargeInt.toString (Time.toSeconds lastseen))),
		    ("firstseen", prom2string (info_prefix ^ "_firstseen", minitems, LargeInt.toString (Time.toSeconds firstseen)))]
		end

	fun node_stats { hostname, node_id, clients, online, uplink, loadavg, memory_usage, uptime, rootfs_usage, tx, rx, forward, mgmt_tx, mgmt_rx } =
		let val items =
			[SOME ("clients", Int.toString clients),
			 SOME ("online", if online then "1" else "0"),
			 SOME ("uplink", if uplink then "1" else "0"),
			 SOME ("loadavg", Real.toString loadavg),
			 SOME ("memory_usage", Real.toString memory_usage),
			 SOME ("rootfs_usage", Real.toString rootfs_usage),
			 SOME ("uptime", Real.toString(uptime)),
			 case tx of SOME tx' => SOME ("tx", Real.toString(tx')) | NONE => NONE,
			 case rx of SOME rx' => SOME ("rx", Real.toString(rx')) | NONE => NONE,
			 case forward of SOME forward' => SOME ("forward", Real.toString(forward')) | NONE => NONE,
			 case mgmt_tx of SOME mgmt_tx' => SOME ("mgmt_tx", Real.toString(mgmt_tx')) | NONE => NONE,
			 case mgmt_rx of SOME mgmt_rx' => SOME ("mgmt_rx", Real.toString(mgmt_rx')) | NONE => NONE]
		    fun item2prom (key, value) = (key, stats_prefix ^ key ^ "{hostname=\"" ^ hostname ^ "\",node_id=\"" ^ node_id ^ "\"} " ^ value ^ " " ^ !timestamp ^ "\n")
		in List.mapPartial (fn (SOME i) => SOME (item2prom i) | NONE => NONE) items
		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_timestamp json
		     val nodes_json = get_nodes json
				      handle exn => (json_handler "get_nodes" exn ; raise Fail "get_nodes")
		     val nodes_extract = List.mapPartial extract nodes_json
		     val summaries = map #1 nodes_extract
		     val infos = map #2 nodes_extract
		     val (infokeys', infos) =
			ListPair.unzip (ListMergeSort.sort
					(fn ((k1,_), (k2,_)) => String.> (k1, k2))
					(List.concat (List.map node_info infos)))
		     val infokeys = ListMergeSort.uniqueSort String.compare infokeys'
		     val stats' = List.filter (fn stts => #online stts) (map #3 nodes_extract)
		     val (statskeys', stats) =
			ListPair.unzip (ListMergeSort.sort
					(fn ((k1,_), (k2,_)) => String.> (k1, k2))
					(List.concat (List.map node_stats stats')))
		     val statskeys = ListMergeSort.uniqueSort String.compare statskeys'
		 in (app print (List.concat [summary_header, info_header, map stats_header statskeys]) ;
		     print (nodes_summary summaries) ;
		     app print infos ;
		     app print stats ;
		     OS.Process.success)
		 end handle e => complain (p, exnMessage e))
	  | main (p, _) = complain (p, "usage: " ^ p ^ " nodes.json")
end