Daniel@0: /* Part of DML (Digital Music Laboratory) Daniel@0: Copyright 2014-2015 Samer Abdallah, University of London Daniel@0: Daniel@0: This program is free software; you can redistribute it and/or Daniel@0: modify it under the terms of the GNU General Public License Daniel@0: as published by the Free Software Foundation; either version 2 Daniel@0: of the License, or (at your option) any later version. Daniel@0: Daniel@0: This program is distributed in the hope that it will be useful, Daniel@0: but WITHOUT ANY WARRANTY; without even the implied warranty of Daniel@0: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the Daniel@0: GNU General Public License for more details. Daniel@0: Daniel@0: You should have received a copy of the GNU General Public Daniel@0: License along with this library; if not, write to the Free Software Daniel@0: Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Daniel@0: */ Daniel@0: Daniel@0: :- module(vis2, []). Daniel@0: Daniel@0: /** DML Visualisation web service Daniel@0: */ Daniel@0: Daniel@0: Daniel@0: :- use_module(library(http/html_write)). Daniel@0: :- use_module(library(http/html_head)). Daniel@0: :- use_module(library(http/http_dispatch)). Daniel@0: :- use_module(library(http/http_parameters)). Daniel@0: :- use_module(library(http/http_json)). Daniel@0: :- use_module(library(http/json)). Daniel@0: :- use_module(library(thread_pool)). Daniel@0: :- use_module(library(sandbox)). Daniel@0: :- use_module(library(dcg_core)). Daniel@0: :- use_module(library(dcg_codes)). Daniel@0: :- use_module(library(dcg_macros)). Daniel@0: :- use_module(library(fileutils)). Daniel@0: :- use_module(library(swipe)). Daniel@0: :- use_module(library(memo)). Daniel@0: :- use_module(library(rdfutils)). Daniel@0: :- use_module(library(httpfiles)). Daniel@0: :- use_module(library(dataset)). Daniel@0: :- use_module(library(insist)). Daniel@0: :- use_module(library(lambda)). Daniel@0: :- use_module(library(dcg/basics), [string_without//2, integer//1]). Daniel@0: :- use_module(library(solution_sequences)). Daniel@0: Daniel@0: :- set_prolog_flag(double_quotes,codes). Daniel@0: :- set_prolog_flag(back_quotes,string). Daniel@0: Daniel@0: http:location(v2,api(v2),[]). Daniel@0: Daniel@0: :- http_handler(v2(dataset), list_datasets, []). Daniel@0: :- http_handler(v2(dataset/define), define_dataset, []). Daniel@0: :- http_handler(v2(view/dataset/index), dataset_views, []). Daniel@0: :- http_handler(v2(view/dataset/items), dataset_items, []). Daniel@0: :- http_handler(v2(view/dataset/summary), dataset_summary, []). Daniel@0: :- http_handler(v2(view/recording/index), recording_views, []). Daniel@0: :- http_handler(v2(view/recording/properties), recording_properties, []). Daniel@0: Daniel@0: :- initialization Daniel@0: current_thread_pool(dmlvis), !; Daniel@0: thread_pool_create(vis, 8, [backlog(100)]). Daniel@0: Daniel@0: % ------------------------------------------------------------------------------------ Daniel@0: % Handlers with documentation Daniel@0: Daniel@0: %% list_datasets(+Request) is det. Daniel@0: % Lists previously defined datsets and the Prolog queries that define them. Daniel@0: list_datasets(R) :- vis(list_datasets,R). Daniel@0: Daniel@0: %% define_dataset(+Request) is det. Daniel@0: % Define a dataset satisfying given search terms. Result is a dataset Daniel@0: % ID, which may be the same as a previously defined dataset if it consists Daniel@0: % of the same items. Daniel@0: define_dataset(R) :- vis(define_dataset,R). Daniel@0: Daniel@0: %% dataset_views(+Request) is det. Daniel@0: % Lists available views for datasets. Daniel@0: dataset_views(R) :- vis(list_views(dataset),R). Daniel@0: Daniel@0: %% dataset_items(+Request) is det. Daniel@0: % Lists items in a given dataset specified by its ID.. Daniel@0: dataset_items(R) :- vis(dataset_items,R). Daniel@0: Daniel@0: %% dataset_summary(+Request) is det. Daniel@0: % Returns some summary information about a dataset. Daniel@0: dataset_summary(R) :- vis(dataset_summary,R). Daniel@0: Daniel@0: %% recording_views(+Request) is det. Daniel@0: % Lists available views for recordings. Daniel@0: recording_views(R) :- vis(list_views(recording),R). Daniel@0: Daniel@0: %% recording_properties(+Request) is det. Daniel@0: % Returns all the properties currently held in the RDF graph about a given recording. Daniel@0: recording_properties(R) :- vis(recording_properties,R). Daniel@0: Daniel@0: Daniel@0: % ------------------------------------------------------------------------------------ Daniel@0: Daniel@0: %% vis(+Method,+Request) is det. Daniel@0: % Daniel@0: % Top level predicate for implementing VIS API. Handles common tasks Daniel@0: % like determining the reply format, handling errors, and formatting the reply. Daniel@0: vis(Method,Request) :- Daniel@0: method_params_goal(Method,Params,Goal), Daniel@0: vis(Params,Goal,Request). Daniel@0: Daniel@0: vis(Params,Goal,Request) :- Daniel@0: http_parameters(Request, [format(Format), callback(Callback) | Params], Daniel@0: [attribute_declarations(param)]), Daniel@0: (Format=jsonp -> Fmt=jsonp(Callback); Fmt=json), Daniel@0: member(request_uri(Query),Request), Daniel@0: catch( insist(call(Goal,Result,Status)), Daniel@0: Ex, (error_result(Ex,Result), Status=error)), Daniel@0: result_response(Fmt,Query,Result,Status,Response), Daniel@0: write(Response). Daniel@0: Daniel@0: result_response(Fmt,Q,Result,Status,Response) :- Daniel@0: with_output_to(string(Response), Daniel@0: reply_as(Fmt,Status,_{ query:Q, result: Result})). Daniel@0: Daniel@0: reply_as(json,Status,Dict) :- Daniel@0: write_headers([Status,type(json)]), Daniel@0: json_write_dict(current_output, Dict). Daniel@0: reply_as(jsonp(Cb),Status,Dict) :- Daniel@0: write_headers([Status,type(jsonp)]), Daniel@0: write(Cb), write('('), Daniel@0: json_write_dict(current_output, Dict), Daniel@0: write(');'). Daniel@0: Daniel@0: Daniel@0: error_result(dml_error(Code,Descriptor),_{ code: Code, desc:Desc }) :- !, Daniel@0: format(string(Desc),'ERROR: ~w',[Descriptor]). Daniel@0: Daniel@0: error_result(Ex, _{ code: 500, desc: Msg }) :- Daniel@0: message_to_string(Ex,Msg). Daniel@0: Daniel@0: % ------------------------------------------------------------------------------------ Daniel@0: % Implementation of methods Daniel@0: Daniel@0: :- multifile param/2. Daniel@0: Daniel@0: % general Daniel@0: param( format, [oneof([json,jsonp]), default(jsonp), description('Reply format')]). Daniel@0: param( callback, [atom,default(jsonp_cb), description('Callback for jsonp reply')]). Daniel@0: Daniel@0: % define_dataset Daniel@0: param( library, [oneof([beets,charm,bl,ilm]), default(bl), description('Library to search within')]). Daniel@0: param( dv, [nonneg, optional(false), description('Database version ID')]). Daniel@0: param( genres, [atom, default(*), description('Semicolon separated list of genre names, or "*"')]). Daniel@0: param( years, [atom, default(*), description('Semicolon separeted list of release years or a range (Y1-Y2) or "*"')]). Daniel@0: param( composers, [atom, default(*), description('Semicolon separated list of composers or "*"')]). Daniel@0: param( performers,[atom, default(*), description('Semicolon separated list of performers or "*"')]). Daniel@0: Daniel@0: param( cid, [atom, optional(false), description('Collection ID')]). Daniel@0: param( cids, [atom, optional(false), description('Semicolon separated list of Collection IDs')]). Daniel@0: param( uri, [atom, optional(false), description('Recording URI')]). Daniel@0: param( limit, [integer, default(5000), description('Maximum number of things to return')]). Daniel@0: param( offset, [integer, default(0), description('Offset within list')]). Daniel@0: Daniel@0: method_params(listCollections, []). Daniel@0: method_params(listPerspectives, [method(_)]). Daniel@0: method_params(collection_id, [library(_),dv(_),genres(_),years(_),composers(_),performers(_)]). Daniel@0: method_params(Method, [ pid(_) | Params ]) :- Daniel@0: perspective(Method,_,_,_,_), Daniel@0: setof(P, perspective_param_name(Method,P), Ps), Daniel@0: maplist(param_name_term,Ps,Params). Daniel@0: Daniel@0: param_name_term(Name,Term) :- functor(Term,Name,1). Daniel@0: perspective_param_name(Method,Name) :- Daniel@0: perspective(Method,_,_,Specs,_), Daniel@0: member(S,Specs), Daniel@0: optspec_name(S,Name). Daniel@0: Daniel@0: Daniel@0: :- multifile perspective/5. Daniel@0: Daniel@0: method_result(listCollections, _, _{ collections:List }, unstable) :- Daniel@0: findall( _{ cid:Id, query:QA, dv:DV, size:SZ }, Daniel@0: ( browse(dataset:dataset(dmlvis:Q, DV, Id, SZ, _)), Daniel@0: term_to_atom(Q,QA) Daniel@0: ), Daniel@0: List). Daniel@0: method_result(Method,Opts,Result,stable) :- Daniel@0: method_result(Method,Opts,Result). Daniel@0: Daniel@0: Daniel@0: Daniel@0: method_result(listPerspectives, Opts, _{ perspectives:List }) :- Daniel@0: option(method(Method), Opts), Daniel@0: findall( P, perspective(Method,P,_,_,_), List). Daniel@0: Daniel@0: method_result(collection_id, Opts, _{ cid:Id, size:Size }) :- Daniel@0: option(dv(DBV),Opts), Daniel@0: option(library(Coll),Opts), Daniel@0: collection_query(Coll, Opts, Query), Daniel@0: dataset_query_id( Query, DBV, Id), Daniel@0: dataset_size(Id, Size). Daniel@0: Daniel@0: options_optspec(_,Opts,\O) :- option(O,Opts). Daniel@0: options_optspec(_,Opts,O-Def) :- option(O,Opts,Def). Daniel@0: options_optspec(M,Opts,O>Goal) :- options_optspec(M,Opts,O), call(M:Goal). Daniel@0: Daniel@0: optspec_name(\O,Name) :- functor(O,Name,1). Daniel@0: optspec_name(O-_,Name) :- functor(O,Name,1). Daniel@0: optspec_name(O>_,Name) :- optspec_name(O,Name). Daniel@0: Daniel@0: perspective(getRecordingPerspective, properties, dmlvis, [\uri(URI)], recording_info(URI)). Daniel@0: perspective(getCollectionPerspective, summary, dmlvis, [\cid(C)], collection_summary(C)). Daniel@0: perspective(getCollectionPerspective, list, dmlvis, [\cid(C),limit(Lim)-5000,offset(Off)-0], collection_list(C,Lim,Off)). Daniel@0: % perspective(getCollectionPairPerspective, summary, dmlvis, [\cids(A)>parse_atom(cids([C1,C2]),A)], binary(summary,C1,C2)). Daniel@0: % perspective(getMultiCollectionPerspective, summary, dmlvis, [\cids(A)>parse_atom(cids(Cs),A)], multi(summary,Cs)). Daniel@0: Daniel@0: collection_summary(Id,Result) :- Daniel@0: insist(browse(dataset:dataset(Goal,DV,Id,Size,_)), unknown_collection(Id)), Daniel@0: term_to_atom(Goal,GoalA), Daniel@0: Result = _{cid:Id, size:Size, goal:GoalA, dv:DV }. Daniel@0: Daniel@0: collection_list(Id, Lim, Offset, _{cid:Id, size:Size, items:Items}) :- Daniel@0: dataset_size(Id,Size), Daniel@0: findall(Item,limit(Lim,offset(Offset,dataset_item(Id,Item))),Items). Daniel@0: Daniel@0: % --------------- recording_properties ----------------------------- Daniel@0: Daniel@0: recording_info(URI, Result) :- Daniel@0: ( a(mo:'AudioFile',URI) -> G=audiofile_info(URI) Daniel@0: ; a(mo:'Track',URI) -> G=track_info(URI) Daniel@0: ; a(mo:'Signal',URI) -> G=signal_info(URI) Daniel@0: ; rdf(URI,charm:file_name,_) -> G=charm_info(URI) Daniel@0: ; throw(not_a_recording(URI)) Daniel@0: ), Daniel@0: insist(call(G,Result),failed(G)). Daniel@0: Daniel@0: audiofile_info(URI,Result) :- Daniel@0: rdf_text(URI,beets:title,Title), Daniel@0: rdf_text(URI,beets:album,AlbumName), Daniel@0: rdf_text(URI,beets:artist,ArtistName), Daniel@0: rdf_number(URI,beets:length,Duration), Daniel@0: Result = _{ type:audiofile, title:Title, artist:ArtistName, album:AlbumName, duration:Duration }. Daniel@0: Daniel@0: track_info(Track, Result) :- Daniel@0: rdf_number(Track,mo:duration,DurationMs), Duration is DurationMs/1000.0, Daniel@0: rdf_text(Track,dc:title,Title), Daniel@0: rdf(Record,mo:track,Track), Daniel@0: rdf(Release,mo:record,Record), Daniel@0: rdf_text(Release,dc:title,AlbumName), Daniel@0: rdf(Artist,foaf:made,Track), Daniel@0: rdf_text(Artist,foaf:name,ArtistName), Daniel@0: Result = _{ type:track, title:Title, artist:ArtistName, album:AlbumName, duration:Duration }. Daniel@0: Daniel@0: signal_info(Signal, _{type:signal, tracks:Infos}) :- Daniel@0: setof(T,rdf(T,mo:publication_of,Signal),Tracks), Daniel@0: maplist(track_info,Tracks,Infos). Daniel@0: Daniel@0: charm_info(URI, PropDict) :- Daniel@0: setof(Pred-Vals,setof(Val1,Val^(rdf(URI,Pred,literal(Val)),atomise_literal(Val,Val1)),Vals),Info), Daniel@0: dict_pairs(PropDict,_,Info). Daniel@0: Daniel@0: atomise_literal(type(_,Val),Val) :- !. Daniel@0: atomise_literal(lang(_,Val),Val) :- !. Daniel@0: atomise_literal(Val,Val). Daniel@0: Daniel@0: % -------------------- defining a dataset ------------------------------ Daniel@0: Daniel@0: qc(beets,Opts,X) :- maplist(filter(beets,X),Opts), a(mo:'AudioFile',X). Daniel@0: qc(charm,Opts,X) :- maplist(filter(charm,X),Opts), rdf(X,charm:file_name,_). Daniel@0: qc(bl,Opts,X) :- maplist(filter(bl,X),Opts), rdf(X,rdf:type,mo:'Signal',bl_p2r). Daniel@0: Daniel@0: filter(_,_,genres(*)) :- true. Daniel@0: filter(beets,X,genres(any(Gs))) :- member(G,Gs), rdf_has(X,beets:genre,literal(substring(G),_)). Daniel@0: Daniel@0: filter(_,_,years(*)) :- true. Daniel@0: filter(D,X,years(any(Ys))) :- member(Y,Ys), filter(D,X,years(Y-Y)). Daniel@0: filter(D,X,years(L-U)) :- succ(U,U1), atom_number(LA,L), atom_number(U1A,U1), filter(D,X,years(LA,U1A)). Daniel@0: filter(beets,X,years(L,U)) :- rdf(X, beets:original_year, literal(between(L,U),_)). Daniel@0: filter(charm,X,years(L,U)) :- rdf(X, charm:recording_date, literal(between(L,U),_)). Daniel@0: filter(bl,X,years(L,U)) :- rdf(X, dcterms:created, literal(between(L,U),_)). Daniel@0: Daniel@0: filter(_,_,composers(*)) :- true. Daniel@0: filter(D,X,composers(any(List))) :- member(C,List), filter(D,X,composer(C)). Daniel@0: filter(charm,X,composer(C)) :- rdf(X, charm:composer, literal(prefix(C),_)). Daniel@0: filter(bl,X,composer(C)) :- rdf(X, marcrel:cmp, literal(prefix(C),_)). Daniel@0: filter(_,_,performers(*)) :- true. Daniel@0: filter(D,X,performers(any(List))) :- member(C,List), filter(D,X,performer(C)). Daniel@0: filter(charm,X,performer(C)) :- rdf(X, charm:performer, literal(prefix(C),_)). Daniel@0: filter(bl,X,performer(C)) :- rdf(X, marcrel:prf, literal(prefix(C),_)). Daniel@0: filter(beets,X,performer(C)) :- rdf(X, beets:artist, literal(prefix(C),_)). Daniel@0: filter(charm,X,title(C)) :- rdf(X, charm:title, literal(substring(C),_)). Daniel@0: filter(bl,X,title(C)) :- rdf(X, dc:title, literal(substring(C),_)). Daniel@0: filter(beets,X,title(C)) :- rdf(X, beets:title, literal(like(C),_)). Daniel@0: Daniel@0: Daniel@0: collection_query(Coll, Opts, qc(Coll,Filters)) :- Daniel@0: seqmap(process_qopt(Opts), Daniel@0: [ qo( genres(GA), genres(GS), genres(*), parse_atom(atoms(GS), GA)) Daniel@0: , qo( composers(CA), composers(CS), composers(*), parse_atom(atoms(CS), CA)) Daniel@0: , qo( performers(PA), performers(PS), performers(*), parse_atom(atoms(PS), PA)) Daniel@0: , qo( years(YA), years(YS), years(*), parse_atom(years(YS), YA)) Daniel@0: , qo( title(T), title(T), title(*), true) Daniel@0: ], Daniel@0: Filters, []). Daniel@0: Daniel@0: process_qopt(Opts,qo(Opt,Filter,NullFilter,Goal)) --> Daniel@0: {option(Opt,Opts,'*'), call(Goal)}, Daniel@0: ({Filter=NullFilter} -> []; [Filter]). Daniel@0: Daniel@0: Daniel@0: % --------- parsers ----------- Daniel@0: Daniel@0: % cids(Ids) --> seqmap_with_sep(",",alphanum,Ids). Daniel@0: cids(Ids) --> semicolon_sep(atom_codes,Ids). Daniel@0: Daniel@0: atoms('*') --> "*", !. Daniel@0: atoms(any(AS)) --> semicolon_sep(atom_codes,AS). Daniel@0: Daniel@0: years('*') --> "*", !. Daniel@0: years(L-U) --> integer(L), "-", integer(U). Daniel@0: years(any(Ys)) --> semicolon_sep(number_codes,Ys). Daniel@0: Daniel@0: Daniel@0: Daniel@0: % alphanum(X) --> string_without(",",S), {atom_string(X,S)}. Daniel@0: Daniel@0: item(Conv,Item) --> string_without(";",Codes), {call(Conv,Item,Codes)}. Daniel@0: semicolon_sep(Conv,Items) --> Daniel@0: seqmap_with_sep(";",item(Conv),Items). Daniel@0: Daniel@0: Daniel@0: parse_atom(Phrase,Atom) :- Daniel@0: atom_codes(Atom,Codes), Daniel@0: debug(vis,'Attempting to parse ~q with ~q...',[Atom,Phrase]), Daniel@0: insist( phrase(Phrase,Codes), parse_failure(Phrase)), Daniel@0: debug(vis,'...got ~q',[Phrase]). Daniel@0: