1:- module(musicbrainz,[
2 mb_query/4
3 , mb_query/5
4 , mb_search/4
5 , mb_browse/3
6 , mb_lookup/3
7 , mb_lookup/2
8 , mb_facet/2
9 , mb_relation/5
10 , mb_id/2
11 , mb_id_uri/3
12 , mb_uri/2
13 , mb_class/2
14 , mb_lazy_query/4
15 ]).
163:- use_module(library(http/http_client)). 164:- use_module(library(http/http_open)). 165:- use_module(library(http/http_sgml_plugin)). 166:- use_module(library(http/json)). 167:- use_module(library(xpath)). 168:- use_module(library(error)). 169:- use_module(library(dcg_core)). 170:- use_module(library(sandbox)). 171:- use_module(lucene). 172 173 174:- setting(limit,integer,20,'Default limit for Musicbrainz search and browse queries'). 175:- setting(min_wait,number,0.5,'Minimum time between Musicbrainz requests'). 176 177% for rate limiting. 178:- initialization set_state(next_request_time,0). 179 180:- dynamic state/2. 181set_state(Name,Value) :- retractall(state(Name,_)), assert(state(Name,Value)). 182get_state(Name,Value) :- state(Name,Value).
191mb_search(T,Term,Score,Item) :-
192 mb_query(T,search(Term),[],_,Item),
193 mb_facet(Item,score(Score)).
201mb_browse(T,Link,Item) :- mb_query(T,browse(Link),[],_,Item).208mb_lookup(Class-Id,Opts,Item) :- mb_query(Class,lookup(Id),Opts,Item). 209mb_lookup(URI,Opts,Item) :- atom(URI), mb_id_uri(Class,Id,URI), mb_query(Class,lookup(Id),Opts,Item). 210mb_lookup(E,Opts,Item) :- mb_class(E,T), mb_id(E,Id), mb_query(T,lookup(Id),Opts,Item). 211mb_lookup(E1,E2) :- mb_lookup(E1,[],E2).
auto_page(boolean).
If true (the default), any offset(N) option is ignored, and the the full result
set is returned one by one, on backtracking, executing multiple queries if necessary.
Otherwise, the results for a single query with the given offset (default 0) is produced.
Progress through the whole result set is given in P, which is a term I/N, where N is the total number of items in the result set and I is the index of the current item. If I is bound on input, that single item is fetched directly. The elements returned can be examined using mb_facet/2.
226mb_query(Class,Req,Opts,I/Total,Item) :- ground(I), !, 227 select_option(auto_page(_),Opts,Opts1,true), 228 select_option(limit(_),Opts1,Opts2,1), 229 select_option(offset(_),Opts2,Opts3,0), 230 succ(Offset,I), 231 mb_query(Class,Req,[limit(1),offset(Offset)|Opts3],Total-[Item]). 232 233mb_query(Class,Req,Opts,I/Total,Item) :- 234 setting(limit,DL), 235 select_option(auto_page(Auto),Opts,Opts1,true), 236 select_option(limit(L),Opts1,Opts2,DL), 237 ( Auto=false 238 -> option(offset(Offset),Opts2,0), 239 mb_query(Class,Req,[limit(L)|Opts2],Total-Items), 240 nth1(J,Items,Item), I is Offset+J 241 ; select_option(offset(_),[limit(L)|Opts2],Opts3,0), 242 items(Class,Req,Opts3,0,Total-Items), 243 lazy_nth1(I,Items,0,Total-items(Class,Req,Opts3),Item) 244 ). 245 246% Query results as a lazy list rather than nondet predicate 247mb_lazy_query(Class,Req,Opts1,Items) :- 248 setting(limit,DL), 249 select_option(limit(L),Opts1,Opts2,DL), 250 select_option(offset(O),[limit(L)|Opts2],Opts3,0), 251 freeze(Items,grow_tail(items(Class,Req,Opts3),1,O,Items)). 252 253grow_tail(More,Total,Seen,Items) :- 254 ( Total=<Seen -> Items=[] 255 ; call(More,Seen,Total1-Chunk), % it's ok if Total1 \= Total 256 append(Chunk,Tail,Items), 257 length(Chunk,N), 258 Seen1 is Seen + N, 259 freeze(Tail,grow_tail(More,Total1,Seen1,Tail)) 260 ). 261 262 263 264 265items(Class,Req,Opts,Offset,Items) :- 266 mb_query(Class,Req,[offset(Offset)|Opts],Items).
269lazy_nth1(I, [X|_], M,_, X) :- succ(M,I). 270lazy_nth1(I, [_|Xs], M,TMore, X) :- succ(M,M1), lazy_nth1(I,Xs,M1,TMore,X). 271lazy_nth1(I, [], M,T-More, X) :- 272 T>M, call(More,M,T1-Xs), 273 lazy_nth1(I,Xs,M,T1-More,X).
The request terms and their types are:
lookup(atom) :: request(A,element(A)). browse(eref) :: request(A,items(A)). search(text) :: request(A,items(A)). items(A) == pair(natural,list(element(A))). pair(X,Y) ---> X-Y.
element(A) is the type of XML element terms like element(A,_,_).
300mb_query(Class,Req,Opts,Return) :- 301 debug(musicbrainz,'Doing mb_query(~q,~q,~q,_)...',[Class,Req,Opts]), 302 select_option(fmt(Fmt),Opts,Opts1,xml), 303 insist(mb_class(Class),unrecognised_class(Class)), 304 request_params(Req,Class,Opts1,Decode,PathParts,Params), 305 concat_atom(['/ws/2/'|PathParts],Path), 306 wait_respectfully, 307 get_doc(Fmt, [host('musicbrainz.org'), path(Path), search([fmt=Fmt|Params])], Doc), 308 debug(musicbrainz,'... Got reply.',[]), 309 ( decode_error(Fmt,Doc,Msg) 310 -> throw(mb_error(q(Class,Req,Opts),Msg)) 311 ; call(Decode,Fmt,Class,Doc,Return) 312 ). 313 314decode_error(xml,[element(error,_,E)],Msg) :- get_text(E,Msg). 315decode_error(json,Dict,Msg) :- get_dict(error,Dict,Msg). 316 317% this allows us to respect the rate limit on Musicbrainz requests 318% using a minimum time interval between requests and the next allowable 319% time to make the next request. 320wait_respectfully :- 321 get_time(Now), 322 setting(min_wait,TMin), 323 get_state(next_request_time,T0), T1 is max(Now,T0) + TMin, 324 set_state(next_request_time,T1), 325 ( Now>=T0 -> true 326 ; DT is T0-Now, 327 debug(musicbrainz,"Sleeping for ~f seconds to respect rate limit",[DT]), 328 sleep(DT) 329 ).
338request_params(lookup(Id), C, O, doc_item, [C,'/',Id], Params) :- process_options([inc(C)],O,Params). 339request_params(browse(Link), C, O, doc_items, [C], [LC=Id|Params]) :- 340 (Link=LC-Id; mb_id(Link,Id), mb_class(Link,LC); mb_id_uri(LC,Id,Link)), 341 process_options([inc(C),limit,offset],O,Params), 342 insist(link(C,LC),invalid_link(C,LC)). 343request_params(search(Query), C, O, doc_items, [C], [query=Q|Params]) :- 344 process_options([inc(C),limit,offset],O,Params), 345 ( atom(Query) -> Q=Query 346 ; string(Query) -> atom_string(Q,Query) 347 ; class_fields(C,Fields), 348 lucene_codes(Query,[fields(Fields)],Cs), 349 atom_codes(Q,Cs) 350 ). 351 352% Convert list of valid Name=Value pairs and produce params for HTTP query. 353process_options(ValidOpts,Opts,Params) :- process_options(ValidOpts,Opts,Params,[]). 354 355process_options([],Opts) --> 356 ({Opts=[]} -> []; {throw(unrecognised_options(Opts))}). 357process_options([Spec|SS],O1) --> 358 ({opt(Spec,Param,O1,O2)} -> [Param];{O2=O1}), 359 process_options(SS,O2). 360 361opt(limit,limit=L) --> select_option(limit(L)), {must_be(between(1,inf),L)}. 362opt(offset,offset=O) --> select_option(offset(O)), {must_be(between(0,inf),O)}. 363opt(inc(C),inc=I) --> 364 % first get include, relation, and level-relation lists, 365 % then translate these into MBZ include keywords and accumulate, 366 % finally stick them all together with + (if not empty list). 367 seqmap(select_list_option, [inc(Is),rels(Rs),lrels(LRs)]), 368 {phrase( seqmap(checked_seqmap,[inc(C),rel,lrel(C)],[Is,Rs,LRs]), Incs)}, 369 {Incs\=[], atomics_to_string(Incs,"+",I)}. 370 371inc(C,I) --> [I], { insist(class_inc(C,I),invalid_inc(C,I)) }. 372rel(R) --> [I], { insist(mb_class(R), invalid_rel(R)), string_concat(R,"-rels",I) }. 373lrel(C,R) --> [I], { insist(C=release, invalid_level_rels), 374 insist(member(R,[recording,work]), invalid_level_rel(R)), 375 string_concat(R,"-level-rels",I) }. 376 377select_list_option(Opt,O1,O2) :- select_option(Opt,O1,O2,[]). 378checked_seqmap(P,L) --> {must_be(list,L)}, seqmap(P,L). 379 380doc_item(xml,Class,[Root],Item) :- once(xpath(Root,Class,Item)). 381doc_item(json,Class,Dict,Dict) :- is_dict(Dict,Class). 382 383doc_items(xml,Class,[Root],Total-Items) :- 384 atom_concat(Class,'-list',ListElem), 385 xpath(Root,ListElem,List), 386 mb_facet(List,count(Total)), 387 List=element(_,_,Items). 388 389doc_items(json,Class,Dict,Total-Items) :- 390 atom_concat(Class,'s',ItemsField), 391 get_dict(count,Dict,Total), 392 get_dict(ItemsField,Dict,Items), 393 maplist(tag_dict(Class),Items). 394 395tag_dict(Tag,Dict) :- is_dict(Dict,Tag). 396 397% would like to use http_open, but it doesn't handle MBZ error documents properly. 398get_doc(xml,URLSpec,Doc) :- 399 ( debugging(musicbrainz) 400 -> parse_url(URL,URLSpec), debug(musicbrainz,'HTTP get from ~w',[URL]) 401 ; true 402 ), 403 http_get([port(80)|URLSpec],Doc,[content_type('text/xml'),dialect(xml)]). 404 405get_doc(json,URLSpec,Doc) :- 406 setup_call_cleanup( 407 http_open(URLSpec,Stream,[request_header('Accept'='application/json')]), 408 json_read_dict(Stream,Doc), 409 close(Stream)).
If Facet is unbound on entry, then all facets which true relative to element E are produced on backtracking.
If Facet is nonvar on entry, then the element is scanned to test/bind any variables in the facet.
425mb_facet(E,Facet) :- var(Facet), !, 426 % if Facet is unbound, then this goal ordering results in an 427 % orderly scan through all the components of the element. 428 (Spec=attr(_,_); Spec=elem(_,_,_)), 429 call(Spec,E), 430 ( facet(Facet,Spec,Goal) *-> call(Goal) 431 ; print_message(warning,unrecognised_property(Spec)), fail 432 ). 433 434mb_facet(E,Facet) :- 435 % if Facet is bound, then this goal ordering goes directly to the info. 436 facet(Facet,Spec,Goal), 437 call(Spec,E), 438 call(Goal). 439 440 441sandbox:safe_primitive(musicbrainz:mb_facet(_,_)). 442 443% goals for extracting attributes and subelements from an element 444attr(Name,Value,element(_,Attrs,_)) :- member(Name=Value,Attrs). 445elem(Name,A,C,element(_,_,Elems)) :- member(element(Name,A,C),Elems).
451facet( count(Y), attr(count, X), atom_number(X,Y)). 452facet( offset(Y), attr(offset, X), atom_number(X,Y)). 453facet( id(X), attr(id, X), true). 454facet( score(Y), attr('ext:score', X), atom_number(X,Y)). 455facet( type(X), attr(type, X), true). 456facet( name(Y), elem(name, _, X), get_text(X,Y)). 457facet( gender(Y), elem(gender, _, X), get_text(X,Y)). 458facet( country(Y), elem(country, _, X), get_text(X,Y)). 459facet( born(Y), elem('life-span', _, X), xp(X,begin(text),Y)). 460facet( died(Y), elem('life-span', _, X), xp(X,end(text),Y)). 461facet( birth_place(Y), elem('begin-area', As, Es), Y=element(area,As,Es)). 462facet( death_place(Y), elem('end-area', As, Es), Y=element(area,As,Es)). 463facet( dead, elem('life-span', _, X), xp(X,ended(text),true)). 464facet( title(Y), elem(title, _, X), get_text(X,Y)). 465facet( date(Y), elem(date, _, X), get_text(X,Y)). 466facet( barcode(Y), elem('barcode',_,X), get_text(X,Y)). 467facet( asin(Y), elem('asin',_,X), get_text(X,Y)). 468facet( length(Y), elem(length, _, [X]), atom_number(X,Y)). 469facet( credit(E), elem('artist-credit',_, X), xp(X,'name-credit'/artist,E)). 470facet( text_repn(L,S), elem('text-representation',_,X), (xp(X,language,L),xp(X,script,S))). 471facet( alias(Y), elem('alias-list',_, X), xp(X,alias(text),Y)). 472facet( sort_name(Y), elem('sort-name', _, X), get_text(X,Y)). 473facet( disambiguation(Y), elem(disambiguation, _, X), get_text(X,Y)). 474facet( area(Id,Facets), elem(area,As,Es), get_area(As,Es,Id,Facets)). 475facet( status(Y), elem(status, _, X), get_text(X,Y)). 476facet( packaging(Y), elem(packaging, _, X), get_text(X,Y)). 477facet( group(Y), elem('release-group',As,Es), Y=element('release-group',As,Es)). 478facet( language(L), elem(language, _, [L]), true). 479facet( release(E), elem('release-list',_, X), xp(X,release,E)). 480facet( release_event(Y), elem('release-event-list',_,X), xp(X,'release-event',Y)). 481facet( medium(Y), elem('medium-list',_,X), xp(X,'release-event',Y)). 482facet( label_info(Y), elem('label-info-list',_,X), xp(X,'label-info',Y)). 483facet( label_code(Y), elem('label-code',_,X), get_text(X,Y)). 484facet( tags(Tags), elem('tag-list',_,Es), maplist(get_tag,Es,Tags)). 485facet( iswc(Y), elem('iswc-list',_,X), xp(X,iswc(text),Y)). 486facet( iswc(Y), elem('iswc',_,X), get_text(X,Y)). 487facet( isrc(Y), elem('isrc-list',_,X), xp(X,isrc(text),Y)). 488facet( isrc(Y), elem('isrc',_,X), get_text(X,Y)). 489facet( recording(E), elem('recording-list',_,X), xp(X,recording,E)). 490facet( work(E), elem('work-list',_,X), xp(X,work,E)). 491facet( relation(E,R), elem('relation-list',As,Es), decode_relations(As,Es,E,R)). 492 493get_tag(E,N-CC) :- 494 xpath(E,name(text),N), 495 xpath(E,/self(@count),C), 496 atom_number(C,CC). 497 498mb_relation(E1,E2,Name,Dir,Opts) :- 499 elem('relation-list',As,Rs,E1), 500 member('target-type'=Type,As), 501 decode_relations(Rs,Type,Dir,Name,E2,Opts). 502 503% provides information about relations as normalised terms, with 504% the relation type as the functor name and three arguments. 505decode_relations(As,Rs,E1,Rel) :- 506 member('target-type'=Type,As), 507 decode_relations(Rs,Type,Dir,Name,E2,Opts), 508 normalise_direction(Dir,E1,E2,RE1,RE2), 509 Rel =.. [Name,RE1,RE2,Opts]. 510 511normalise_direction(fwd,E1,E2,E1,E2). 512normalise_direction(bwd,E1,E2,E2,E1). 513 514% provides information about each relation in Rs in fully decomposed 515% form given the list of relation elements and the type of the target element: 516% Dir: direction :oneof([fwd,bwd]) 517% Name: MBZ relation name 518% Val: target MBZ entity 519% Opts: begin(Date), end(Date), attribute(Atom) 520decode_relations(Rs,Type,Dir,Name,Val,Opts) :- 521 % could check to see if all attributes and elements are interpreted... 522 member(R,Rs), 523 xpath(R,/self(@type),Name), 524 xpath(R,Type,Val), 525 relation_opts(R,Opts,[]), 526 ( xpath(R,direction(content),[backward]) 527 -> Dir=bwd 528 ; Dir=fwd 529 ). 530 531 532relation_opts(R) --> 533 if(xpath(R,begin(content),[Begin]), [begin(Begin)]), 534 if(xpath(R,end(content),[End]), [end(End)]), 535 if(setof(attribute(A),xpath(R,'attribute-list'/attribute(content),[A]),As), 536 list(As)). 537 538get_text(Elems,Text) :- xp(Elems,/self(text),Text). 539get_area(As,Es,Id,F2) :- 540 findall(F,mb_facet(element(area,As,Es),F),F1), 541 select(id(Id),F1,F2). 542xp(Elems,Selector,Val) :- xpath(element(e,[],Elems),Selector,Val).
546mb_id(E,Id) :- mb_facet(E,id(Id)).
550mb_class(element(T,_,_),T).558mb_id_uri(Class,Id,URI) :- var(URI), !, 559 format(atom(URI),'http://musicbrainz.org/~w/~w#_',[Class,Id]). 560mb_id_uri(Class,Id,URI) :- 561 atomic_list_concat(['http:','','musicbrainz.org',Class,IdHash],'/',URI), 562 atom_concat(Id,'#_',IdHash).
567mb_uri(E,URI) :-
568 E=element(T,_,_),
569 mb_facet(E,id(Id)),
570 mb_id_uri(T,Id,URI).574mb_class(label). 575mb_class(artist). 576mb_class(work). 577mb_class(recording). 578mb_class(release). 579mb_class('release-group'). 580mb_class(area). 581mb_class(url). 582 583mb_non_core(rating). 584mb_non_core(tag). 585mb_non_core(collection). 586mb_non_core(discid). 587mb_non_core(isrc). 588mb_non_core(iswc). 589 590% For more convenient display of elements. 591user:portray(E) :- 592 E=element(T,_,_), mb_class(T), 593 mb_facet(E,id(Id)), !, 594 ( mb_facet(E,name(Name)), truncate(40,Name,SName) 595 -> format('<mb:~w/~w|~w>',[T,Id,SName]) 596 ; mb_facet(E,title(Title)), truncate(40,Title,STitle) 597 -> format('<mb:~w/~w|~w>',[T,Id,STitle]) 598 ; format('<mb:~w/~w>',[T,Id]) 599 ). 600 601% for dicts 602user:portray(Dict) :- 603 is_dict(Dict,T), nonvar(T), mb_class(T), 604 get_dict(id,Dict,Id), !, 605 ( get_dict(name,Dict,Name), truncate(40,Name,SName) 606 -> format('<mb:~w/~w|~w>',[T,Id,SName]) 607 ; get_dict(title,Dict,Title), truncate(40,Title,STitle) 608 -> format('<mb:~w/~w|~w>',[T,Id,STitle]) 609 ; format('<mb:~w/~w>',[T,Id]) 610 ). 611 612truncate(Max,S,S) :- string_length(S,L), L<Max, !. 613truncate(Max,S1,S3) :- 614 L is Max-3, 615 sub_string(S1,0,L,_,S2), 616 string_concat(S2,"...",S3). 617 618% tables used for validating requests. 619link(url,resource). 620link(label,release). 621link(C1,C2) :- links(C1,Cs), member(C2,Cs). 622links(artist,[recording,release,'release-group',work]). 623links(recording,[artist,release]). 624links(release,[artist,label,recording,'release-group']). 625links('release-group',[artist,release]). 626 627class_fields( artist, 628 [ area,beginarea,endarea,arid,artist,artistaccent,alias,begin,comment 629 , country,end,ended,gender,ipi,sortname,tag,type]). 630class_fields('release-group', 631 [ arid,artist,artistname,comment,creditname,primarytype,rgid,releasegroup 632 , releasegroupaccent,releases,release,reid,secondarytype,status,tag,type ]). 633class_fields( release, 634 [ arid,artist,artistname,asin,barcode,catno,comment,country,creditname 635 , date,discids,discidsmedium,format,laid,label,lang,mediums,primarytype 636 , puid,quality,reid,release,releaseaccent,rgid,script,secondarytype,status 637 , tag,tracks,tracksmedium,type ]). 638class_fields( recording, 639 [ arid,artist,artistname,creditname,comment,country,date,dur,format,isrc 640 , number,position,primarytype,puid,qdur,recording,recordingaccent,reid 641 , release,rgid,rid,secondarytype,status,tid,tnum,tracks,tracksrelease 642 , tag,type,video ]). 643class_fields( label, 644 [ alias,area,begin,code,comment,country,end,ended,ipi,label,labelaccent 645 , laid,sortname,type,tag ]). 646class_fields( work, 647 [ alias,arid,artist,comment,iswc,lang,tag,type,wid,work,workaccent ]). 648class_fields( annotation, [text,type,name,entity]). 649class_fields('FreeDB', [artist,title,discid,cat,year,tracks]). 650 651class_inc(C,I) :- class_incs(C,Is), member(I,Is). 652class_incs(artist, [recordings,releases,'release-groups',works]). 653class_incs(label, [releases]). 654class_incs(recording, [artists,releases]). 655class_incs(release, [artists,labels,recordings,'release-groups']). 656class_incs('release-group',[artists,releases]). 657class_incs(_,[discids,media,isrcs,'artist-credits','various-artists']). 658class_incs(_,[aliases,annotation,tags,ratings,'user-tags','user-ratings']). 659 660insist(G,Ex) :- call(G) -> true; throw(Ex). 661prologmessage(unrecognised_class(C)) --> ["'~w' is not a recognised Musibrainz entity class."-[C]]. 662prologmessage(unrecognised_property(Spec)) --> ["No facet for property ~q"-[Spec]]. 663prologmessage(unrecognised_relation(T,_)) --> ["No facet for relation of type ~q"-[T]]. 664prologmessage(invalid_link(C1,C2)) --> ["Cannot browse class ~w via links to '~w'."-[C1,C2]]. 665prologmessage(invalid_inc(C,I)) --> ["~w in not a valid inc parameter for ~w resources."-[I,C]]. 666prologmessage(invalid_level_rels) --> ["Work- or recording-level relationships can only be requested for releases"]. 667prologmessage(invalid_level_rel(I)) --> ["~w relationships cannot be requested."-[I]]. 668prologmessage(mb_error(_,E)) --> {xpath(E,text(text),Text)}, ["MBZ error: ~w"-[Text]]
Interface to Musicbrainz XML web service
This module provides client methods for the Musicbrainz XML service. The predicates it provides fall broadly into two categories: those for composing and querying the Musicbrainz web service, and those for decoding the resulting XML documents. Then there are a few higher level predicates that combine the two for common query patterns, insulating (mostly) the user from the idiosyncracies of XML. This module can also use the Lucene module (
lucene.pl) to compose Lucene searches.Quick start
A simple search returning a 'goodness of match' in Score, a Musicbrainz ID in ID, and an XML element in E, then extracting info from E with mb_facet/2:
Search for releases with 'trane' in the title, using general purpose mb_query/5 to get progress info:
Search for artist then browse releases:
Lucene search for male artist then direct lookup all releases (with debug on to report unrecognised fields):
Queries
The Musicbrainz XML web service is described at http://musicbrainz.org/doc/Development/XML_Web_Service/Version_2 . A query is logically composed of three parts:
artist,release,worketc.Entity types
The core predicate mb_query/4 can deal with any entity type that the Musicbrainz services recognises. The name is simply represented as an atom of type
mb_class. The core entity types are:artist, release, 'release-group', label, recording, work, area, url.An entity can be referred to either as a pair Class-Id, or an element as returned by a previous query:
Query types
The three query types are represented using three Prolog functors:
browse(artist-ArtistID)applied to a core entity typereleaseretrieves all the releases associated with the given artist. Returns a list of elements and a number giving the total number of matches.lucene.pl.Options
The following options are recognised by mb_query/4 and mb_query/5:
If any inappropriate options are supplied for a given query, an exception is thrown.
XML Decoding
The system for decoding XML documents is based on the idea of 'facets': the main result document consists of a list of items of the requested entity type. Each entity has several facets, each of which can be thought of as a logical statement which is true relative to that item. Each facet is represented by a term with some functor and arguments of the appropriate types. For example, the facet name/1 applies to artists, countries, labels etc looks like
name(Name), where Name is an atom. The name facet is extracted from the XML sub-element 'name', but other facets might result from more comlicated processing of the XML element representing the item. The predicate facet/4 determines which facets are recognised and how they are computed.The predicate mb_facet/2 relates an XML element with its facets.
This module defines a portray/2 clause for terms like
element(Type,_,_)where type is one of the core Musicbrainz entity types. It extracts the facetsid(_)and eithername(_)ortitle(_)(whichever is present, and displays the element in the formMulti-page Queries
Browse and search queries produce a list of answers, a subset of which is returned depending on the limit and offset options. A higher level predicate mb_query/5 gives a general way of accessing the elements of the result set, returning each item one by one on backtracking, along with a progress indicator, which is a term that looks like N/T, which means 'N th out of T'. The option
auto_page(boolean)controls how large result sets are handled. If false, only one HTTP request is fired off, yielding a window into the full result set determined by the optionslimit(integer)andoffset(integer). If true (the default), multiple queries are executed transparently, yielding the full result set in chunks determined by the limit option. This defaults to the value of the settinglimit.