(!****************************************************** Mosel Example Programs ====================== file json.mos ````````````` Package providing advanced union operators for representing a JSON document along with some display functionality (c) 2022 Fair Isaac Corporation author: Y. Colombani, S. Heipcke, Nov. 2021, rev. Nov. 2022 *******************************************************!) package json version 0.2.0 uses 'mmxml','mmsystem','mmhttp' parameters (!@doc.cparam. @descr jcolfmt Format selection for aggregate table column printing @value jcolfmt 0 Mosel text format @value jcolfmt 1 JSON format !) "jcolfmt":integer (!@doc.cparam. @descr jcolmaxw Maximum column width for table format array display @info jcolmaxw Values need to be positive integers !) "jcolmaxw":integer end-parameters ! **** Package type definitions **** public declarations !@doc.descr Type definition: JSON object jobj=array(string) of any !@doc.descr Type definition: JSON array jarr=array(range) of any !@doc.descr Type definition: a null value is stored as a string jnull=string !@doc.descr Type definition: JSON value !@doc.info A 'jval' is either a scalar of type real, text, boolean, or jobj, jarr or jnull. jval=text or real or boolean or jobj or jarr or jnull end-declarations ! **** [private] Parser related data **** !@doc.ignore declarations afct:array(range) of any ! jparser callbacks public jsctx= record l:list of jval ! List of active elements end-record datafile="forjson"+newmuid ! Unique identifier for temp. filename jstxt=newmuid ! Unique identifier for temp. output filename end-declarations ! **** Internal subroutines for table-format display of arrays **** !@doc.ignore declarations function genheaders(o:jobj, level:integer, prefix:string): set of string function genheaders(a:jarr, level:integer, prefix:string): set of string function displayrow(o: jobj, txt:array(range,string) of text, rct:integer, hsel:string, subhead: set of string, level:integer, hasarray:boolean, cpyhead:set of string): integer function displayrow(a: jarr, txt:array(range,string) of text, rct:integer, hsel:string, subhead: set of string, level:integer): integer end-declarations ! **** [private] Internal representations of package parameters **** !@doc.ignore declarations colfmt:integer colmaxw:integer end-declarations ! **** Public subroutines **** ! Generic routines for handling package control parameters !@doc.autogen=false ! Get integer package parameter public function json~getiparam(p:string):integer case p of "jcolfmt": returned:=colfmt "jcolmaxw": returned:=colmaxw end-case end-function ! Set value for integer package parameters public procedure json~setparam(p:string,v:integer) case p of "jcolfmt": if v in 0..1: colfmt:=v "jcolmaxw": if v>0: colmaxw:=v end-case end-procedure !@doc.autogen (!@doc. @descr Retrieve the indexing set of a 'jobj' entity @param o JSON object @return indexing set (set of labels occurring in the JSON object) !) public function getfields(o:jobj):set of string returned:=o.index(1) end-function (!@doc. @descr Retrieve the indexing (range) set of a 'jarr' entity @param o JSON array @return index range set (position count of objects within the JSON array) @info Index numbering starts with the value 1. !) public function getrange(o:jarr):range returned:=o.index(1) end-function (!@doc. @descr Load a JSON document @param fname (extended) file name of a JSON document @param doc structure for storing the JSON contents @return 0 if successful, 1 in case of parsing error. @info The entity 'doc' passed as argument is reset by this function. !) public function loadjson(fname:text,doc:jval):integer declarations ctx:jsctx end-declarations reset(doc) fopen(fname,F_INPUT) returned:=jsonparse(afct,ctx) ! Invoke the JSON parsing fclose(F_INPUT) if ctx.l.size>0 then doc:=ctx.l(1) end-if end-function (!@doc. @descr Parse a text as a JSON document @param data text containing JSON data @param doc structure for storing the JSON contents @return 0 if successful, 1 in case of parsing error. @info The entity 'doc' passed as argument is reset by this function. @related Invokes loadjson !) public function parsejson(data:text,doc:jval):integer publish(datafile,data) returned:=loadjson(text("text:")+datafile,doc) unpublish(datafile) end-function (!@doc. @descr Create a JSON representation in text form for a Mosel entity @param mosobj a Mosel entity @param flag optional format configuration (see documentation of 'jsonwrite') !) public function jsontext(mosobj:any):text publish(jstxt,returned) jsonwrite("text:"+jstxt,mosobj) unpublish(jstxt) end-function public function jsontext(mosobj:any, flag:integer):text publish(jstxt,returned) jsonwrite("text:"+jstxt,mosobj,flag) unpublish(jstxt) end-function (!@doc. @descr Display a JSON array in table format @param a the array to be displayed @param level depth of nesting for table columns (0-3, default: 2) @param headers preselected set of table headers (optional) @info The package parameter jcolmaxw configures the maximum table column width and the parameters jcolfmt selects whether aggregate output is using Mosel's default text output format (value 0) or JSON format (value 1). !) public procedure displaytable(a:jarr, level:integer, headers: list of string) declarations aheaders: list of string tmptxt: dynamic array(R:range,sheaders: set of string) of text colwidth: array(sheaders) of integer subhead,cpyhead,genhead: set of string tmpt: text end-declarations if level>3: level:=3 ! Too deep nesting will be unreadable if headers.size=0 then aheaders:= list(genheaders(a,level,"")) else aheaders:=headers ! Complete specified headers with paths to subheaders forall(h in aheaders) do tmpt:=h while (findtext(tmpt,".",1)>0 and tmpt<>"") do asproc(pathsplit(SYS_EXTN,tmpt,tmpt)) if findfirst(aheaders,string(tmpt))=0 then aheaders+=[string(tmpt)] genhead+={string(tmpt)} end-if end-do end-do end-if rct:=0 forall(i in a.range, anobj=a(i)) do ! At the top level the format expects an array containing collections if anobj is jobj then rct+=1; hasarray:=false forall(h in aheaders | exists(anobj.jobj(h)), ao=anobj.jobj(h)) do if ao is jarr then if level>0 and not hasarray then subhead:=union(k in aheaders | startswith(k,h+".")) {substr(k,h.size+2,k.size)} cpyhead:=union(k in aheaders | startswith(k,h+".")) {k} newct:=displayrow(ao.jarr, tmptxt, rct, h+".", subhead, level-1) hasarray:=true else tmptxt(rct,h):= if(colfmt=1, text(jsontext(ao),colmaxw), text(ao,colmaxw)) end-if elif ao is jobj then if level>0 then subhead:=union(k in aheaders | startswith(k,h+".")) {substr(k,h.size+2,k.size)} newct:=displayrow(ao.jobj, tmptxt, rct, h+".", subhead, level-1, hasarray, cpyhead) if newct>rct : hasarray:=true else tmptxt(rct,h):= if(colfmt=1, text(jsontext(ao),colmaxw), text(ao,colmaxw)) end-if else tmptxt(rct,h):= text(ao,colmaxw) end-if end-do if newct>rct then tmphead:=union(s in sheaders-cpyhead | exists(tmptxt(rct,s))) {s} forall(jj in tmphead, tmpt2=tmptxt(rct,jj), ii in (rct+1)..newct) tmptxt(ii,jj):=tmpt2 rct:=newct hasarray:=false end-if end-if end-do ! Calculate actual column widths forall(h in sheaders | h not in genhead) colwidth(h):=maxlist(h.size, minlist(colmaxw, max(r in R) tmptxt(r,h).size))+1 ctwidth:=if(R.size>0, ceil(log(R.last))+2, 1) ! Display the headers write(" "*ctwidth) forall(h in sheaders | h not in genhead) write(textfmt(h,-colwidth(h))) writeln ! Display the table body forall(r in R) do write(textfmt(r,-ctwidth)) forall(h in sheaders | h not in genhead) if exists(tmptxt(r,h)) then write(textfmt(tmptxt(r,h),-colwidth(h))) else write(textfmt("Nan",-colwidth(h))) end-if writeln end-do end-procedure public procedure displaytable(a:jarr, headers: list of string) displaytable(a,2,headers) end-procedure public procedure displaytable(a:jarr, level:integer) displaytable(a,level,[]) end-procedure public procedure displaytable(a:jarr) displaytable(a,2,[]) end-procedure !------------Internal subroutines: json parser callback funtions------------- ! jparser callback: open an object function js_open_object(ctx:jsctx, name:text):integer if ctx.l.size>0 then with o=ctx.l(ctx.l.size) do if o is jobj then sname:=string(name) create(o.jobj(sname).jobj) ctx.l+=[o.jobj(sname).jobj] else ! jarr create(o.jarr(o.jarr.size+1).jobj) ctx.l+=[o.jarr(o.jarr.size).jobj] end-if end-do else ctx.l+=[(jobj)] end-if end-function ! jparser callback: close an object function js_close_object(ctx:jsctx):integer if ctx.l.size>1 then cuttail(ctx.l,1) end-if end-function ! jparser callback: open an array function js_open_array(ctx:jsctx, name:text):integer if ctx.l.size>0 then with o=ctx.l(ctx.l.size) do if o is jobj then sname:=string(name) create(o.jobj(sname).jarr) ctx.l+=[o.jobj(sname).jarr] else ! jarr create(o.jarr(o.jarr.size+1).jarr) ctx.l+=[o.jarr(o.jarr.size).jarr] end-if end-do else ctx.l+=[(jarr)] end-if end-function ! jparser callback: close an array function js_close_array(ctx:jsctx):integer if ctx.l.size>1 then cuttail(ctx.l,1) end-if end-function ! jparser callback: a textual value function js_text_val(ctx:jsctx, name:text, type:integer, val:text):integer if ctx.l.size>0 then with o=ctx.l(ctx.l.size) do if o is jobj then o.jobj(string(name)):=val else ! jarr o.jarr(o.jarr.size+1):=val end-if end-do else ctx.l+=[val] end-if end-function ! jparser callback: a numerical value function js_num_val(ctx:jsctx, name:text, val:real):integer if ctx.l.size>0 then with o=ctx.l(ctx.l.size) do if o is jobj then o.jobj(string(name)):=val else ! jarr o.jarr(o.jarr.size+1):=val end-if end-do else ctx.l+=[val] end-if end-function ! jparser callback: a Boolean value function js_bool_val(ctx:jsctx, name:text, val:boolean):integer if ctx.l.size>0 then with o=ctx.l(ctx.l.size) do if o is jobj then o.jobj(string(name)):=val else ! jarr o.jarr(o.jarr.size+1):=val end-if end-do else ctx.l+=[val] end-if end-function ! jparser callback: the 'null' value function js_null_val(ctx:jsctx, name:text):integer if ctx.l.size>0 then with o=ctx.l(ctx.l.size) do if o is jobj then o.jobj(string(name)):="null" else ! jarr o.jarr(o.jarr.size+1):="null" end-if end-do else ctx.l+=["null"] end-if end-function !------------Internal subroutines: Table-format display of arrays------------ ! Generating the set of table headers function genheaders(o:jobj, level:integer, prefix:string): set of string fset:=getfields(o) forall(f in fset) returned+={prefix+f} if level>0 then forall(f in fset) do if o(f) is jobj then returned+=genheaders(o(f).jobj, level-1, prefix+f+".") elif o(f) is jarr then returned+=genheaders(o(f).jarr, level-1, prefix+f+".") end-if end-do end-if end-function function genheaders(a:jarr, level:integer, prefix:string): set of string forall(i in a.range, anobj=a(i)) if anobj is jobj then returned+=genheaders(anobj.jobj, level, prefix) end-if end-function ! Displaying a collection (jobj) function displayrow(o: jobj, txt:array(range,string) of text, rct:integer, hsel:string, subhead: set of string, level:integer, hasarray:boolean, cpyhead:set of string): integer returned:=rct forall(h in subhead | exists(o(h)), ao=o(h)) do if ao is jarr then if level>0 and not hasarray then newsubhead:=union(k in subhead | startswith(k,h+".")) {substr(k,h.size+2,k.size)} cpyhead:=union(k in subhead | startswith(k,hsel+h+".")) {k} returned:=displayrow(ao.jarr, txt, rct, hsel+h+".", newsubhead, level-1) hasarray:=true else txt(rct,hsel+h):= if(colfmt=1, text(jsontext(ao),colmaxw),text(ao,colmaxw)) end-if elif ao is jobj then if level>0 then newsubhead:=union(k in subhead | startswith(k,h+".")) {substr(k,h.size+2,k.size)} returned:=displayrow(ao.jobj, txt, rct, hsel+h+".", newsubhead, level-1, hasarray, cpyhead) if returned>rct: hasarray:=true else txt(rct,hsel+h):= if(colfmt=1, text(jsontext(ao),colmaxw),text(ao,colmaxw)) end-if else txt(rct,hsel+h):= text(ao,colmaxw) end-if end-do end-function ! Displaying an array (jarr) function displayrow(a: jarr, txt:array(range,string) of text, rct:integer, hsel:string, subhead: set of string, level:integer): integer declarations cpyhead: set of string end-declarations returned:=rct forall(i in a.range, anobj=a(i)) do if anobj is jobj then forall(h in subhead | exists(anobj.jobj(h)), ao=anobj.jobj(h)) do if ao is jarr then txt(returned,hsel+h):= if(colfmt=1, text(jsontext(ao),colmaxw),text(ao,colmaxw)) elif ao is jobj then if level>0 then newsubhead:=union(k in subhead | startswith(k,h+".")) {substr(k,h.size+2,k.size)} newct:=displayrow(ao.jobj, txt, returned, hsel+h+".", newsubhead, level-1, true, cpyhead) else txt(returned,hsel+h):= if(colfmt=1, text(jsontext(ao),colmaxw),text(ao,colmaxw)) end-if else txt(returned,hsel+h):= text(ao,colmaxw) end-if end-do if ijs_open_object afct(JSON_FCT_CLOSE_OBJ):=->js_close_object afct(JSON_FCT_OPEN_ARR):=->js_open_array afct(JSON_FCT_CLOSE_ARR):=->js_close_array afct(JSON_FCT_TEXT):=->js_text_val afct(JSON_FCT_NUM):=->js_num_val afct(JSON_FCT_BOOL):=->js_bool_val afct(JSON_FCT_NULL):=->js_null_val end-package