1 2/* faustxml.pure: Parse a Faust XML or JSON file. */ 3 4/* Copyright (c) 2009-2014 by Albert Graef. 5 6 This is free software; you can redistribute it and/or modify it under the 7 terms of the GNU General Public License as published by the Free Software 8 Foundation; either version 3, or (at your option) any later version. 9 10 This software is distributed in the hope that it will be useful, but 11 WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 12 or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 13 more details. 14 15 You should have received a copy of the GNU General Public License along 16 with this program. If not, see <http://www.gnu.org/licenses/>. */ 17 18using dict, regex, system, xml; 19namespace faustxml; 20 21/* .. default-domain:: pure 22 .. module:: faustxml 23 .. namespace:: faustxml 24 25 Appendix: faustxml 26 ================== 27 28 The faustxml module is provided along with faust2pd to retrieve the 29 description of a Faust DSP from its XML or JSON file as a data structure 30 which is ready to be processed by Pure programs. It may also be useful in 31 other Pure applications which need to inspect descriptions of Faust DSPs. 32 33 The main entry point is the :func:`info` function which takes the name of a 34 Faust-generated XML or JSON file as argument and returns a tuple ``(name, 35 descr, version, in, out, controls, options)`` with the name, description, 36 version, number of inputs and outputs, control descriptions and faust2pd 37 options (from the global meta data of the dsp module). A couple of other 38 convenience functions are provided to deal with the control descriptions. 39 40 Usage 41 ----- 42 43 Use the following declaration to import this module in your programs:: 44 45 using faustxml; 46 47 For convenience, you can also use the following to get access to the 48 module's namespace:: 49 50 using namespace faustxml; 51 52 Data Structure 53 -------------- 54 55 The following constructors are used to represent the UI controls of Faust 56 DSPs: 57 58 .. constructor:: button label 59 checkbox label 60 61 A button or checkbox with the given label. 62 63 .. constructor:: nentry (label,init,min,max,step) 64 vslider (label,init,min,max,step) 65 hslider (label,init,min,max,step) 66 67 A numeric input control with the given label, initial value, range and 68 stepwidth. 69 70 .. constructor:: vbargraph (label,min,max) 71 hbargraph (label,min,max) 72 73 A numeric output control with the given label and range. 74 75 .. constructor:: vgroup (label,controls) 76 hgroup (label,controls) 77 tgroup (label,controls) 78 79 A group with the given label and list of controls in the group. */ 80 81nonfix button checkbox nentry vslider hslider vbargraph hbargraph 82 vgroup hgroup tgroup; 83 84public controlp; 85 86/* .. 87 88 Operations 89 ---------- 90 91 .. function:: controlp x 92 93 Check for control description values. */ 94 95controlp x 96= case x of 97 button _ | checkbox _ | nentry _ | vslider _ | hslider _ | 98 vbargraph _ | hbargraph _ | vgroup _ | hgroup _ | tgroup _ = true; 99 _ = false; 100 end; 101 102/* .. function:: control_type x 103 control_label x 104 control_args x 105 106 Access functions for the various components of a control description. */ 107 108public control_type control_label control_args; 109 110control_type x@(f@_ _) = f if controlp x; 111 112control_label x@(_ label::string) | 113control_label x@(_ (label,_)) = label if controlp x; 114 115control_args x@(_ _::string) = () if controlp x; 116control_args x@(_ (_,args)) = args if controlp x; 117 118/* .. function:: controls x 119 120 This function returns a flat representation of a control group ``x`` as 121 a list of basic control descriptions, which provides a quick way to 122 access all the control values of a Faust DSP. The grouping controls 123 themselves are omitted. You can pass the last component of the return 124 value of the :func:`info` function to this function. */ 125 126public controls; 127 128controls x@(_ args) 129= case args of 130 _,ctrls = catmap controls ctrls if listp ctrls; 131 _ = [x] otherwise; 132 end if controlp x; 133 134/* .. function:: pcontrols x 135 136 Works like the :func:`controls` function above, but also replaces the label of 137 each basic control with a fully qualified path consisting of all control 138 labels leading up to the given control. Thus, e.g., the label of a 139 slider ``"gain"`` inside a group ``"voice#0"`` inside the main 140 ``"faust"`` group will be denoted by the label 141 ``"faust/voice#0/gain"``. */ 142 143public pcontrols; 144 145pcontrols x = controls "" x with 146 controls path (f@_ (label::string,args)) 147 = catmap (controls (join path label)) args 148 if listp args; 149 = [f (join path label,args)]; 150 controls path (f@_ label::string) 151 = [f (join path label)]; 152 join "" s | 153 join s "" = s; 154 join s t = s+"/"+t otherwise; 155end if controlp x; 156 157/* .. function:: info fname 158 159 Extract the description of a Faust DSP from its XML or JSON file. This 160 is the main entry point. Returns a tuple with the name, description and 161 version of the DSP, as well as the number of inputs and outputs, the 162 toplevel group with all the control descriptions, and additional 163 faust2pd-specific options specified in the global meta data. Raises an 164 exception if the XML/JSON file doesn't exist or contains invalid 165 contents. 166 167 Example:: 168 169 > using faustxml; 170 > let name,descr,version,in,out,group,opts = 171 > faustxml::info "examples/basic/freeverb.dsp.xml"; 172 > name,descr,version,in,out; 173 "freeverb","freeverb -- a Schroeder reverb","1.0",2,2 174 > using system; 175 > do (puts.str) $ faustxml::pcontrols group; 176 faustxml::hslider ("freeverb/damp",0.5,0.0,1.0,0.025) 177 faustxml::hslider ("freeverb/roomsize",0.5,0.0,1.0,0.025) 178 faustxml::hslider ("freeverb/wet",0.3333,0.0,1.0,0.025) 179 180 Note: As of faust2pd 2.11, the :func:`info` function can also process 181 descriptions in JSON format (as obtained with ``faust -json`` in recent 182 Faust versions). Moreover, instead of a JSON file you may also specify the 183 URL of a running Faust dsp instance (typically something like 184 ``http://localhost:5510``). This works with stand-alone Faust applications 185 which have httpd support enabled (created with, e.g., ``faust2jaqt 186 -httpd``), as well as dsp instances running in Grame's FaustLive 187 application. You also need to have the ``curl`` program installed to make 188 this work. 189 190 The latter currently has some minor limitations. Specifically, the 191 httpd/JSON interface only provides the name of a running dsp; the 192 description, version and other global meta data is not available. In the 193 current implementation, we therefore set the description to the name of the 194 dsp, and the version and auxiliary faust2pd options to empty strings in 195 this case. 196 197 Furthermore, the :func:`info` function can also be invoked with a special 198 URL of the form ``http://localhost:7777/availableInterfaces`` to retrieve 199 the list of dsp instances running in a (local or remote) FaustLive 200 instance. (Replace ``localhost`` with the hostname or IP address and 201 ``7777`` with the actual port number as necessary. FaustLive's default port 202 is usually ``7777``, but you should check the actual IP address with 203 FaustLive's ``Window / View QRcode`` option.) The result is a list of hash 204 pairs of names and URLs of dsp instances which can be queried for their 205 JSON data. 206 207*/ 208 209public info; 210 211private pathname basename extension trim str_val tree node; 212private parse_json parse parse_doc parse_node parse_prop parse_type 213 parse_control make_control parse_group make_group; 214 215info fname::string 216= case regex "^([a-z]+)://(.*)$" REG_EXTENDED fname 0 of 217 // Check for JSON URL, retrieve with curl. 218 1,_,url,_,ty,_,path = case fget (popen ("curl -s "+url) "r") of 219 // list of available dsps in a FaustLive instance 220 s::string = res when 221 data = check s; 222 url = pathname fname; 223 // sort by port numbers 224 res = sort cmp [name=>port | name=>(port:_) = data] with 225 cmp (_=>p1) (_=>p2) 226 = v1 < v2 if intp v1 && intp v2 when 227 v1 = val p1; v2 = val p2; 228 end; 229 // Presumably the port numbers are integers, but if they aren't then 230 // we can still compare them lexicographically as strings instead. 231 = p1 < p2 otherwise; 232 end; 233 // add URL prefix 234 res = [name=>url+"/"+port | name=>port = res]; 235 end if lst == "availableInterfaces"; 236 // ordinary JSON data with dsp description 237 s::string = name,parse_json data when 238 data = check s; 239 name = catch (cst "") (data!"name"); 240 end; 241 _ = throw ("could not retrieve "+url) otherwise; 242 end when 243 ty == "http" || throw "unkown URL type (must be http)"; 244 lst = if null path then "" else last (split "/" path); 245 url = if lst == "JSON" then url else url+"/JSON"; 246 end; 247 // Check for JSON file. 248 _ = case fget (fopen fname "r") of 249 s::string = basename fname,parse_json (check s); 250 _ = throw "could not open JSON file" otherwise; 251 end if extension fname == "json"; 252 // Check for XML file. 253 _ = case xml::load_file fname 0 of 254 doc = name,descr,info,opts when 255 name = basename fname; descr,info = parse name doc; 256 descr = if null descr then name else descr; 257 // Custom global meta data is not available in the XML file. 258 opts = []; 259 end if xml::docp doc; 260 _ = throw "could not open XML file" otherwise; 261 end if extension fname == "xml"; 262 _ = throw ("unkown file type '"+extension fname+"' (must be json or xml)"); 263end with 264 // Trivial JSON parser. Since JSON syntax is valid Pure syntax, we can just 265 // let 'val' do the job, and then convert JSON dictionaries to Pure records 266 // for easier access. 267 check s = case json (val s) of 268 data::smatrix = data; 269 _ = throw "invalid JSON data" otherwise; 270 end; 271 json x::smatrix = record {key=>json val | key:val = x}; 272 json x::list = map json x; 273 json x = x otherwise; 274end; 275 276/* Private operations. *******************************************************/ 277 278/* Determine the pathname of a file (strip off filename and extension). */ 279 280pathname s::string 281= s when 282 s::string = join "/" (if null s then [] else init $ split "/" s); 283end; 284 285/* Determine the basename of a file (strip off path and extension). */ 286 287basename s::string 288= s when 289 s::string = if null s then "" else last $ split "/" s; 290 s::string = if null s then "" else head $ split "." s; 291end; 292 293/* Determine the extension of a file (strip off path and filename). */ 294 295extension s::string 296= s when 297 s::string = if null s then "" else last $ split "/" s; 298 s::string = if null s || index s "." < 0 then "" else last $ split "." s; 299end; 300 301/* Remove leading and trailing whitespace. */ 302 303trim s::string = regex "^[ \t\n]*((.|\n)*[^ \t\n])[ \t\n]*$" REG_EXTENDED 304 s 0!4; 305 306/* Parse a string value. */ 307 308str_val s::string 309= case eval (sprintf "quote (%s)" s) of 310 s::string = s; 311 _ = s otherwise; 312 end; 313 314/* Helper function to parse the contents of a Faust JSON file. */ 315 316parse_json data::smatrix = name,version,in,out, 317 catch (\_ -> throw "invalid JSON data") (parse (data!"ui"!0)), opts 318with 319 parse x = case ty of 320 "vgroup" | "hgroup" | "tgroup" = (tyval ty) (label,map parse (x!"items")); 321 "button" | "checkbox" = (tyval ty) label; 322 "nentry" | "vslider" | "hslider" = (tyval ty) (label,args) when 323 args = tuple (map (double.val) (x!!["init","min","max","step"])); 324 end; 325 "vbargraph" | "hbargraph" = (tyval ty) (label,args) when 326 args = tuple (map (double.val) (x!!["min","max"])); 327 end; 328 end when 329 ty = x!"type"; 330 label = x!"label"; 331 end; 332 tyval ty = val ("faustxml::"+ty); 333end when 334 name = catch (cst "") (data!"name"); 335 meta = catch (cst {}) (data!"meta"); 336 // At present, the global meta data is encoded as a list of dictionaries, 337 // turn it into a single dictionary for convenience. 338 meta = if recordp meta then meta else colcat meta; 339 recordp meta || throw "invalid JSON data"; 340 version = catch (cst "") (meta!"version"); 341 // As of faust2pd 2.11, we allow faust2pd options to be specified in the 342 // Faust source in one chunk using the global 'faust2pd' meta data key. 343 opts = catch (cst []) 344 (regsplit "[[:space:]]+" REG_EXTENDED (meta!"faust2pd") 0); 345 // For compatibility with pd-faust and older faust2pd versions, we also 346 // still allow options to be specified using 'pd' meta data on the toplevel 347 // group. 348 meta_ui = catch (cst {}) (data!"ui"!0!"meta"); 349 opts_ui = map ("--"+) (cat (map (list.(!!["pd"])) meta_ui)); 350 opts = opts+opts_ui; 351 in = catch (cst 0) (val (data!"inputs")); 352 out = catch (cst 0) (val (data!"outputs")); 353end; 354 355/* Generate a tree representation of an entire XML document, or the subtree of 356 an XML document rooted at a given node. */ 357 358tree doc::pointer = tree (xml::root doc) if xml::docp doc; 359tree n::pointer = node (xml::node_info n) 360 [tree m | m = xml::children n; ~xml::is_blank_node m] 361 if xml::nodep n; 362 363/* Helper functions to parse the contents of a Faust XML file. */ 364 365parse nm doc 366= case map (map tree . xml::select doc) 367 ["/faust/name","/faust/version", 368 "/faust/inputs","/faust/outputs", 369 "/faust/ui/activewidgets/widget", 370 "/faust/ui/passivewidgets/widget", 371 "/faust/ui/layout/group"] of 372 [[name],[version],[in],[out],active,passive,layout] = 373 parse_doc nm (name,version,in,out,active+passive,layout); 374 _ = throw "invalid XML data" otherwise; 375 end; 376 377private extern int atoi(char*); 378private extern double atof(char*); 379 380parse_doc nm (node (xml::element "name" _ _) name, 381 node (xml::element "version" _ _) version, 382 node (xml::element "inputs" _ _) in, 383 node (xml::element "outputs" _ _) out, 384 controls,layout) 385= case map (parse_group 0 nm (dict controls)) layout of 386 [controls] = (name,version,in,out,controls); 387 _ = throw "invalid XML data" otherwise; 388 end when 389 [name,version,in,out] = map parse_node [name,version,in,out]; 390 [name,version] = map (parse_prop.trim) [name,version]; 391 [in,out] = map atoi [in,out]; 392 controls = map (parse_control nm) controls; 393 end; 394parse_doc _ _ = throw "invalid XML data" otherwise; 395 396parse_node [node (xml::text s::string) _] = s; 397parse_node [] = ""; 398parse_node _ = throw "invalid XML data" otherwise; 399 400parse_prop s 401= case s of 402 "Unknow" = ""; // sic! (old Faust versions) 403 "Unknown" = ""; 404 _::string = str_val s; 405 _ = "" otherwise; 406 end; 407 408parse_type s::string = eval $ "faustxml::"+s; 409 410using system; 411check_label 0 nm "0x00" = nm; 412check_label 0 nm "" = nm; 413check_label _ _ "" = ""; 414check_label _ _ s = s otherwise; 415 416parse_control nm (node (xml::element "widget" _ attrs) params) 417= case attrs!!["type","id"]+params!!["label"] of 418 [ty,id,label] = 419 make_control (atoi id) ty (check_label 1 nm (str_val label)) params; 420 _ = throw "invalid XML data" otherwise; 421 end when 422 attrs = dict attrs; params = dict $ map param params with 423 param (node (xml::element name::string _ _) val) 424 = name=>val if stringp val when val = parse_node val end; 425 param _ = throw "invalid XML data" otherwise; 426 end; 427 end; 428parse_control _ _ = throw "invalid XML data" otherwise; 429 430make_control id ty label params 431= id => parse_type ty label if any ((==)ty) ["button","checkbox"]; 432= case params!!["init","min","max","step"] of 433 res@[init,min,max,step] = 434 id => parse_type ty (label,tuple (map atof res)); 435 _ = throw "invalid XML data" otherwise; 436 end if any ((==)ty) ["vslider","hslider","nentry"]; 437= case params!!["min","max"] of 438 res@[min,max] = 439 id => parse_type ty (label,tuple (map atof res)); 440 _ = throw "invalid XML data" otherwise; 441 end if any ((==)ty) ["vbargraph","hbargraph"]; 442make_control _ _ _ _ = throw "invalid XML data" otherwise; 443 444parse_group lev nm cdict (node (xml::element "group" _ attrs) params) 445= case attrs!!["type"] of 446 [ty] = make_group lev nm cdict ty params; 447 _ = throw "invalid XML data" otherwise; 448 end when attrs = dict attrs end; 449parse_group lev nm cdict (node (xml::element "widgetref" _ ["id"=>id::string]) []) 450= case cdict!![atoi id] of [c] = c; _ = throw "invalid XML data"; end; 451parse_group _ _ _ _ = throw "invalid XML data" otherwise; 452 453make_group lev nm cdict ty (node (xml::element "label" _ _) label:params) 454= case parse_type ty (check_label lev nm (str_val label), 455 map (parse_group (lev+1) nm cdict) params) of 456 c = c if stringp label && controlp c; 457 _ = throw "invalid XML data" otherwise; 458 end when label = parse_node label end; 459make_group _ _ _ _ _ = throw "invalid XML data" otherwise; 460