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(dmlvis, Daniel@0: [ cc/3 Daniel@0: , recording_property/3 Daniel@0: ]). 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/thread_httpd)). 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(semweb/rdf_label)). Daniel@0: :- use_module(library(sandbox)). Daniel@0: :- use_module(library(dcg_core)). Daniel@0: :- use_module(library(dcg_pair)). 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(listutils)). Daniel@0: :- use_module(library(optutils)). 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(computations), [rows_cols/3]). Daniel@0: :- use_module(library(csvutils), [uri_to_csv/2]). 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: :- use_module(components(audio)). Daniel@0: Daniel@0: :- meta_predicate cc(2,2,1). Daniel@0: :- meta_predicate method_result_cc(+,+,2,1). Daniel@0: Daniel@0: :- set_prolog_flag(double_quotes,codes). Daniel@0: :- set_prolog_flag(back_quotes,string). Daniel@0: Daniel@0: http:location(v1,root(api/v4),[]). Daniel@0: Daniel@0: :- http_handler(v1(getCollectionId), getCollectionId, []). Daniel@0: :- http_handler(v1(getCollectionPerspective), getCollectionPerspective, []). Daniel@0: :- http_handler(v1(getRecordingPerspective), getRecordingPerspective, [spawn(vis_recording)]). Daniel@0: :- http_handler(v1(listCollections), listCollections, []). Daniel@0: :- http_handler(v1(listPlaces), listPlaces, []). Daniel@0: :- http_handler(v1(listPerspectives), listPerspectives, []). Daniel@0: :- http_handler(v1(csv_time_window), csv_time_window, []). Daniel@0: Daniel@0: % ------------------------------------------------------------------------------------ Daniel@0: Daniel@0: %% vis(+Method,+Request) is det. Daniel@0: % Daniel@0: % General VIS API HTTP handler. Returns either JSON or JSONP depending on the Daniel@0: % format parameter. If JSONP is selected (the default), the callback parameter Daniel@0: % determines the Javascript callback function. The JSON result structure is of Daniel@0: % type Daniel@0: % == Daniel@0: % { Daniel@0: % query: string ~'The original query, excluding protocol and host', Daniel@0: % result: (error_struct|A) ~'Result structure A or error information' Daniel@0: % } Daniel@0: % == Daniel@0: % where Daniel@0: % == Daniel@0: % error_struct == { code: integer, decs:string } Daniel@0: % == Daniel@0: % See individual methods for more information about their return types. Daniel@0: vis(Method,Request) :- Daniel@0: get_time(T0), Daniel@0: method_params(Method,Params), Daniel@0: member(request_uri(Query),Request), Daniel@0: vis_parameters(Request, [format(Format), callback(Callback) | Params],ROpts), Daniel@0: (Format=jsonp -> Fmt=jsonp(Callback,ROpts); Fmt=json(ROpts)), Daniel@0: Responder=send_response(Fmt,Query,T0), Daniel@0: debug(dmlvis(method),'~q',[method_result_cc(Method,Params,Responder,writeln)]), Daniel@0: method_result_cc(Method,Params,dmlvis:Responder,error_cont(Query,Responder)). Daniel@0: Daniel@0: send_response(Fmt,Query,T0,Result,Status) :- Daniel@0: get_time(T1), DT=T1-T0, Daniel@0: debug(dmlvis(response),'Sending response after ~3f s to ~q',[DT,Query]), Daniel@0: once(reply_as(Fmt,Status,_{ query:Query, result: Result})). Daniel@0: Daniel@0: error_cont(Q,Cont,Ex) :- Daniel@0: debug(dmlvis(error),'Sending error ~W in response to ~q',[Ex,[quoted(true),max_depth(8)],Q]), Daniel@0: error_result(Ex,Result), Daniel@0: call(Cont,Result,error). Daniel@0: Daniel@0: vis_parameters(Request,Params,ReplyOpts) :- Daniel@0: Params1=[random(_, [optional(true)]) | Params], Daniel@0: http_parameters(Request, Params1, [attribute_declarations(param), form_data(AllParams)]), Daniel@0: findall(N, (member(N=_,AllParams), \+used_param(N,Params1)), Unused), Daniel@0: (select(indent,Unused,Unused1) -> ReplyOpts=[]; ReplyOpts=[width(0)], Unused1=Unused), Daniel@0: (select(dv,Unused1,Unused2) -> true; Unused2=Unused1), Daniel@0: insist(Unused2=[], unrecognised_parameters(Unused2)). Daniel@0: Daniel@0: used_param(N,ValidParams) :- Daniel@0: member(Q,ValidParams), Daniel@0: functor(Q,N,_). 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(Opts),Status,Dict) :- !, Daniel@0: write_headers([Status,type(json)]), Daniel@0: json_write_dict(current_output, Dict, Opts). Daniel@0: reply_as(jsonp(Cb,Opts),Status,Dict) :- !, Daniel@0: write_headers([Status,type(jsonp)]), Daniel@0: write(Cb), write('('), Daniel@0: json_write_dict(current_output, Dict, Opts), Daniel@0: write(');'). Daniel@0: Daniel@0: Daniel@0: error_result(Ex, _{ errors:[Err] }) :- error_result1(Ex,Err). Daniel@0: Daniel@0: error_result1(dml_error(Code,Descriptor),_{ code: Code, desc:Descriptor }) :- !. Daniel@0: Daniel@0: error_result1(Ex, _{ code: 500, desc: Msg }) :- Daniel@0: message_to_string(Ex,Msg). Daniel@0: Daniel@0: % ------------------------------------------------------------------------------------ Daniel@0: % Handlers with documentation Daniel@0: Daniel@0: %% getCollectionId(+Request) is det. Daniel@0: % Daniel@0: % Define a collection satisfying given search terms. Result is a collection Daniel@0: % ID, which may be the same as a previously defined collection if it consists Daniel@0: % of the same items. Daniel@0: % Daniel@0: % Parameters are as follows. In all cases, =|sclist(Type)|= denotes a semicolon Daniel@0: % separated list of values of given type OR the string '*', which is the default. Daniel@0: % The value '*' means that no filtering is done on the releveant property. The Daniel@0: % list is interpreted as an AND-list or an OR-list depending on which property Daniel@0: % is being tested. String matching is case insensitive. Daniel@0: % The only required parameter is =|dv|=. Daniel@0: % == Daniel@0: % dv : integer ~ database version Daniel@0: % library : sclist(lib_name) ~ OR-list of libraries to search Daniel@0: % collection : sclist(pattern) ~ OR-list of BL collection name patterns Daniel@0: % composer : sclist(string) ~ OR-list of composer prefixes Daniel@0: % performer : sclist(string) ~ OR-list of performer prefixes Daniel@0: % title : sclist(string) ~ AND-list of title substrings Daniel@0: % genre : sclist(string) ~ OR-list of genre substrings Daniel@0: % place : sclist(string) ~ OR-list of place substrings Daniel@0: % language : sclist(string) ~ OR-list of langauage name prefixes Daniel@0: % year : sclist(year) | range ~ OR-list of genre substrings Daniel@0: % sample : nonneg | 'all' ~ sample a random subset of this size Daniel@0: % sv : integer ~ sample version for sample Daniel@0: % Daniel@0: % lib_name --> 'bl' | 'charm' | 'ilm' | 'mazurka' | 'beets'. Daniel@0: % range --> year, '-', year. Daniel@0: % == Daniel@0: % NB. A =|pattern|= is a string which may contain '*' to match any sequence of Daniel@0: % characters. The pattern must match the WHOLE value being tested, eg to search Daniel@0: % for the substring 'Botswana', you must include '*' at both ends of the pattern, Daniel@0: % eg =|'*botswana*'|=. Daniel@0: % Daniel@0: % A successful result is of type Daniel@0: % == Daniel@0: % result(getCollectionId) == { Daniel@0: % cid: string ~'collection id', Daniel@0: % size: natural ~'number of items in collection' Daniel@0: % }. Daniel@0: % == Daniel@0: getCollectionId(R) :- vis(getCollectionId,R). Daniel@0: Daniel@0: %% getCollectionPerspective(+Request) is det. Daniel@0: % Daniel@0: % Get a given perspective on a previously defined collection. Daniel@0: % Result will depend on the particular perspective chosen. Daniel@0: % All perspectives require the parameter =|cid(string)|=. Most Daniel@0: % perspectives accept the parameters =|recompute(oneof([none,failed,force]))|= Daniel@0: % and =|vamp_on_demand(boolean)|=. Daniel@0: % Defined perspectives are Daniel@0: % Daniel@0: % == Daniel@0: % summary : [] -> { cid:string, size: natural, goal: string }. Daniel@0: % Daniel@0: % list : Daniel@0: % [ limit(natural)/5000, offset(natural)/0, sort_by(oneof([label, date]))/label ] Daniel@0: % -> { cid:string, items: list( {uri:uri, label:string, audio:list(link(audio)), date:string }) }. Daniel@0: % Daniel@0: % midi_pitch_histogram : Daniel@0: % [ weighting(oneof([none,dur,vel]))/none ] Daniel@0: % -> { values:list(integer), counts:list(natural) }. Daniel@0: % Daniel@0: % pitch_histogram : Daniel@0: % [ weighting(oneof([none,dur,vel]))/none, quant(natural)/5, min(integer)/20, max(integer)/100, lang(oneof([ml,r]))/ml ] Daniel@0: % -> { edges:list(nonneg), counts:list(natural) }. Daniel@0: % Daniel@0: % tempo_histogram : Daniel@0: % [ period(nonneg)/1, min(integer)/20, max(integer)/100, num_bins(natural)/50, lang(oneof([ml,r]))/ml ] Daniel@0: % -> { edges:list(nonneg), counts:list(natural) }. Daniel@0: % Daniel@0: % mean_tempo_curve : Daniel@0: % [ num_samples(natural)/20, lang(oneof([ml,r]))/ml ] Daniel@0: % -> { means:list(nonneg), std_devs:list(nonneg) }. Daniel@0: % Daniel@0: % tonic_relative_pitch_class_histogram : [] Daniel@0: % -> { values:list(string), counts:list(nonneg), ok_count:natural, failed:{prolog:list, python:list}}. Daniel@0: % Daniel@0: % pitch_lookup : Daniel@0: % [ midi_pitch(between(0,127)), weighting(oneof([none,dur,vel]))/none, Daniel@0: % limit(natural)/5000, offset(natural)/0 ] Daniel@0: % -> { }. Daniel@0: % Daniel@0: % tonic_histogram : [] -> { }. Daniel@0: % Daniel@0: % pitch_class_histogram : [] -> { }. Daniel@0: % Daniel@0: % tuning_stats : [] -> { }. Daniel@0: % Daniel@0: % tuning_stats_by_year : [] -> { }. Daniel@0: % Daniel@0: % places_hist : [] -> { }. Daniel@0: % Daniel@0: % key_relative_chord_seq : Daniel@0: % [ spm_minlen(natural)/2, spm_maxseqs(natural)/500, spm_algorithm(Alg)/'CM-SPADE', Daniel@0: % spm_ignore_n(natural)/1, spm_maxtime(number)/60, spm_minsupport(number)/50 ] Daniel@0: % -> { }. Daniel@0: % Daniel@0: % similarity : Daniel@0: % [ sim_downsample(number)/1,sim_clusters(number)/40,sim_reclimit(number)/2000, Daniel@0: % sim_type(string)/'euclidean',sim_features(string)/'chromagram', Daniel@0: % sim_compressor(string)/'zlib'] Daniel@0: % -> { }. Daniel@0: % == Daniel@0: getCollectionPerspective(R) :- vis(getCollectionPerspective,R). Daniel@0: Daniel@0: %% getCollectionPairPerspective(+Request) is det. Daniel@0: % Daniel@0: % Get a given comparative perspective on a pair of previously defined collections. Daniel@0: % Result will depend on the particular perspective chosen. Defined perspectives are: Daniel@0: getCollectionPairPerspective(R) :- vis(getCollectionPairPerspective,R). Daniel@0: Daniel@0: %% getMultiCollectionPerspective(+Request) is det. Daniel@0: % Get a given comparative perspective on a set of previously defined collections. Daniel@0: getMultiCollectionPerspective(R) :- vis(getMultiCollectionPerspective,R). Daniel@0: Daniel@0: %% getRecordingPerspective(+Request) is det. Daniel@0: % Get a given perspective for a given recording URI. Perspectives, their parameters and Daniel@0: % their output types are as follows (all perspectives require a uri parameter) Daniel@0: % == Daniel@0: % properties : [] -> { Daniel@0: % library:string, Daniel@0: % title:string, Daniel@0: % composer:list(string), Daniel@0: % performer:list(string), Daniel@0: % genre:list(string), Daniel@0: % place:string, Daniel@0: % language:string, Daniel@0: % recording_date:string Daniel@0: % }. Daniel@0: % Daniel@0: % transcription : [] -> { csv: uri(csv([time,dur,freq,vel,pitch_name])) }. Daniel@0: % transcription_fine : [] -> { csv: uri(csv([time,dur,freq,vel,pitch_name)) }. Daniel@0: % chords : [] -> { csv: uri(csv([time,chord_name])) }. Daniel@0: % chords_notes : [] -> { csv: uri(csv([time,dur,integer)) }. Daniel@0: % key : [] -> { csv: uri(csv([time,integer,string])) }. Daniel@0: % key_tonic : [] -> { csv: uri(csv) }. Daniel@0: % tempo : [] -> { csv: uri(csv([time,nonneg,tempo_string])). Daniel@0: % beats : [] -> { csv: uri(csv([time,tempo_string])) }. Daniel@0: % beatroot : [] -> { csv: uri(csv([time])) }. Daniel@0: % Daniel@0: % tempo_nonuniform : [] -> { times:list(float), values:list(float) }. Daniel@0: % tempo_uniform : [ lang(oneof([ml,r]))/ml ] -> { times:list(float), values:list(float) }. Daniel@0: % tempo_normalised : [ lang(oneof([ml,r]))/ml ] -> { times:list(float), values:list(float) }. Daniel@0: % tempo_histogram : Daniel@0: % [ period(nonneg)/1, num_bins(natural)/50, min(nonneg)/20, max(nonneg)/100, lang(oneof([ml,r]))/ml ] Daniel@0: % -> { edges: list(float), counts: list(natural) }. Daniel@0: % Daniel@0: % midi_pitch_histogram : Daniel@0: % [ weighting(note_weight)/none ] Daniel@0: % -> { values: list(integer), counts: list(natural) }. Daniel@0: % Daniel@0: % pitch_histogram : Daniel@0: % [weighting(note_weight)/none, quant(natural)/5, min(integer)/20, max(integer)/100, lang(oneof([ml,r]))/ml ] Daniel@0: % -> { edges: list(float), counts: list(natural) }. Daniel@0: % Daniel@0: % chord_histogram : [] -> { values:list(string), counts:list(natural) }. Daniel@0: % Daniel@0: % spectrogram : [offset(nonneg)/0, length(nonneg)/60 ] -> { csv: uri }. Daniel@0: % == Daniel@0: % Daniel@0: % Supplementary types: Daniel@0: % == Daniel@0: % note_weight --> 'none'; 'dur'; 'vel'; 'dur*vel'. Daniel@0: % Daniel@0: % time == float. Daniel@0: % dur == nonneg. Daniel@0: % freq == nonneg. Daniel@0: % vel == nonneg. Daniel@0: % == Daniel@0: getRecordingPerspective(R) :- vis(getRecordingPerspective,R). Daniel@0: Daniel@0: %% listCollections(+Request) is det. Daniel@0: % Lists previously defined collections and the Prolog queries that define them. Daniel@0: % == Daniel@0: % listCollections : [] -> { Daniel@0: % collections: list({ cid : string, Daniel@0: % query : string, Daniel@0: % dv : integer, Daniel@0: % size : natural, Daniel@0: % timestamp : string Daniel@0: % }) Daniel@0: % }. Daniel@0: listCollections(R) :- vis(listCollections,R). Daniel@0: Daniel@0: %% listPlaces(+Request) is det. Daniel@0: % Lists known place names, currently the distinct values of the dcterms:spatial predicate. Daniel@0: % == Daniel@0: % listPlaces : [] -> { Daniel@0: % places: list({ name : string Daniel@0: % }) Daniel@0: % }. Daniel@0: listPlaces(R) :- vis(listPlaces,R). Daniel@0: Daniel@0: %% listPerspectives(+Request) is det. Daniel@0: % Lists available perspective for a given method. Daniel@0: listPerspectives(R) :- vis(listPerspectives,R). Daniel@0: Daniel@0: %% csv_time_window(+Request) is det. Daniel@0: % Daniel@0: % Returns the contents of a CSV file between between given time limits, Daniel@0: % assuming the the first column is a time value. Daniel@0: % Also returns the time of the last row. Parameters and return structure are Daniel@0: % == Daniel@0: % csv_time_window : Daniel@0: % [uri(uri(csv)), start(float), end(float) ] Daniel@0: % -> { duration:float, columns: list(list) }. Daniel@0: % == Daniel@0: % URI parameter must be the URI of a CSV file. Daniel@0: % Data is returned a list of lists, where each inner list is one column Daniel@0: % of the CSV. Daniel@0: csv_time_window(R) :- vis(csv_time_window,R). Daniel@0: Daniel@0: Daniel@0: % ------------------------------------------------------------------------------------ Daniel@0: % Implementation of methods Daniel@0: Daniel@0: :- multifile param/2. Daniel@0: 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: param( dv, [nonneg, optional(false), description('Database version ID')]). Daniel@0: Daniel@0: param( cid, [atom, optional(false), description('Collection ID')]). Daniel@0: param( pid, [atom, optional(false), description('Perspective ID')]). Daniel@0: param( cids, [atom, optional(false), description('Semicolon separated list of Collection IDs')]). Daniel@0: param( uri, [atom, optional(false), description('Item URI')]). Daniel@0: param( library, [atom, default(*), description('Semicolon separated list of libraries to search')]). Daniel@0: param( genre, [atom, default(*), description('Semicolon separated list of genre names, or "*"')]). Daniel@0: param( year, [atom, default(*), description('Semicolon separeted list of release years or a range (Y1-Y2) or "*"')]). Daniel@0: param( composer, [atom, default(*), description('Semicolon separated list of composers or "*"')]). Daniel@0: param( performer, [atom, default(*), description('Semicolon separated list of performers or "*"')]). Daniel@0: param( place, [atom, default(*), description('Semicolon separated list of place names or "*"')]). Daniel@0: param( language, [atom, default(*), description('Semicolon separated list of language name prefixes or "*"')]). Daniel@0: param( collection,[atom, default(*), description('Semicolon separated list of BL collection names or "*"')]). Daniel@0: param( title, [atom, default(*), description('Semicolon separated AND-list of title substrings or "*"')]). Daniel@0: param( method, [atom, optional(false), description('API method name')]). 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: param( sort_by, [oneof([label,date]), default(label), description('Sort recordings list by this property')]). Daniel@0: param( start, [number, optional(false), description('Start of window in seconds')]). Daniel@0: param( end, [number, optional(false), description('End of window in seconds')]). Daniel@0: param( sample, [number, default(all), description('Sample a random subset of this size')]). Daniel@0: param( sv, [number, default(1), description('Version of random subset')]). Daniel@0: param( midi_pitch,[nonneg, default(60), description('MIDI note number 0..127')]). Daniel@0: Daniel@0: method_params(listCollections, []). Daniel@0: method_params(listPlaces, []). Daniel@0: method_params(listPerspectives, [ method(_) ]). Daniel@0: method_params(getCollectionId, [ dv(_), library(_), genre(_), place(_), language(_), year(_), composer(_), Daniel@0: performer(_), collection(_), title(_), sample(_), sv(_) ]). Daniel@0: method_params(csv_time_window, [ uri(_), start(_), end(_) ]). Daniel@0: method_params(Method, [ pid(_) | Params ]) :- Daniel@0: once(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/4. Daniel@0: Daniel@0: %% cc(+Pred:pred(-A,-cc_status), +Cont:pred(+A,+cc_status), +ErrorCont:pred(+exception)) is det. Daniel@0: % Call a predicate with success and error continuations. Daniel@0: % Pred roduces a result of type A and a status. If it succeeds, the result and status are passed Daniel@0: % to the continuation Cont. Otherwise, an exception is passed to ErrorCont. Daniel@0: cc(Goal,Cont,ErrorCont) :- catch(cc_wrapper(Goal,Cont), Ex, call(ErrorCont,Ex)). Daniel@0: cc_wrapper(Goal,Cont) :- insist(call(Goal,Result,Status)), call(Cont,Result,Status). Daniel@0: Daniel@0: place_name(P) :- rdf(_,dcterms:spatial,literal(P)). Daniel@0: Daniel@0: %% method_result_cc(+Method,+Params:options,+C:success_cont,+E:error_cont) is det. Daniel@0: % Daniel@0: % Perspectives are handle using continuations to allow spawning Daniel@0: % == Daniel@0: % success_cont == pred(+dict,+vis_status). Daniel@0: % error_cont == pred(+exception). Daniel@0: % vis_status ---> stable; unstable. Daniel@0: % == Daniel@0: % Method must be a method id registered in perspective/2 or handled my method_resut/4. Daniel@0: method_result_cc(Method,Params,Cont,ErrorCont) :- Daniel@0: perspective(Method,_), !, Daniel@0: option(pid(PId),Params), Daniel@0: catch(( insist( perspective(Method,PId,Specs,Pred), unknown_perspective(PId)), Daniel@0: insist( maplist(options_optspec(Params),Specs)), Daniel@0: call(Pred,Cont,ErrorCont) Daniel@0: ), Ex, call(ErrorCont,Ex)). Daniel@0: Daniel@0: % all non-perspective methods are handled in this thread Daniel@0: method_result_cc(Method,Params,Cont,ErrorCont) :- Daniel@0: cc( method_result(Method,Params), Cont, ErrorCont). Daniel@0: Daniel@0: %% method_result(+Method, +Opts, -Result, -Status:vis_status) is det. Daniel@0: % Daniel@0: % Handles methods =|listCollections, listPerspectives, getCollectionId, csv_time_window|=. Daniel@0: method_result(listCollections, _, _{ collections:List }, unstable) :- Daniel@0: findall( _{ cid:Id, query:QA, dv:DV, size:SZ, timestamp:TS }, Daniel@0: ( browse(dataset:dataset(dmlvis:Q, DV, Id, SZ, _),comp(_,Timestamp,_)-ok), Daniel@0: format_time(string(TS),'%FT%T%:z',Timestamp), Daniel@0: term_to_atom(Q,QA) Daniel@0: ), Daniel@0: List). Daniel@0: Daniel@0: method_result(listPlaces, _, _{ places:List }, unstable) :- Daniel@0: findall( _{ name:Name, count:N }, aggregate(count,place_name(Name),N), List). Daniel@0: Daniel@0: Daniel@0: method_result(listPerspectives, Opts, _{ perspectives:List }, stable) :- Daniel@0: option(method(Method), Opts), Daniel@0: findall( P, perspective(Method,P), List). Daniel@0: Daniel@0: method_result(getCollectionId, Opts, _{ cid:Id, size:Size, full_size:FullSize }, stable) :- Daniel@0: build_dataset_query(Query,DBV,Size-FullSize,Opts,Remaining), Daniel@0: insist(Remaining=[], unrecognised_search_criteria(Remaining)), Daniel@0: insist(dataset_query_id( Query, DBV, Id),empty_dataset(Query)), Daniel@0: dataset_size(Id, Size). Daniel@0: Daniel@0: method_result(csv_time_window, Opts, _{ duration:Dur, columns:Columns }, stable) :- Daniel@0: maplist(options_optspec(Opts), [ \uri(URI), \start(Start), \end(End) ]), Daniel@0: uri_to_csv(URI,Rows), Daniel@0: insist(Rows\=[], empty_csv(URI)), Daniel@0: Daniel@0: append(_,[EndRow],Rows), Daniel@0: functor(EndRow,_,NumCols), Daniel@0: arg(1,EndRow,Dur), Daniel@0: Daniel@0: numlist(1,NumCols,Is), Daniel@0: drop_while(row_before(Start),Rows,Rows1), Daniel@0: take_while(row_before(End),Rows1,Rows2), Daniel@0: rows_cols(Is,Rows2,Columns). Daniel@0: Daniel@0: row_before(T0,Row) :- arg(1,Row,T), TGoal) :- 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(Method,Perspective) :- perspective(Method,Perspective,_,_). Daniel@0: Daniel@0: perspective(getRecordingPerspective, properties, [+uri(URI)], cc(recording_info(URI))). Daniel@0: perspective(getCollectionPerspective, summary, [+cid(C)], cc(collection_summary(C))). Daniel@0: perspective(getCollectionPerspective, list, [+cid(C),limit(Lim)-5000,offset(Off)-0,sort_by(SortBy)-label], cc(collection_list(C,Lim,Off,SortBy))). Daniel@0: Daniel@0: collection_summary(Id,Result,stable) :- Daniel@0: insist(dataset_size(Id,Size), unknown_collection(Id)), Daniel@0: findall( _{goal:GoalA, dv:DV}, ( dataset_query_dv(Id,Goal,DV), Daniel@0: term_to_atom(Goal,GoalA) ), Queries), Daniel@0: Result = _{cid:Id, size:Size, queries:Queries }. Daniel@0: Daniel@0: Daniel@0: collection_list(Id, Lim, Offset, SortBy, _{cid:Id, size:Size, items:Items}, stable) :- Daniel@0: insist(dataset_size(Id,Size), unknown_collection(Id)), Daniel@0: findall(SortVal-Item, dataset_itemx(SortBy,Id,Item,SortVal), KeyedItems), sort(KeyedItems,Sorted), Daniel@0: findall(Item,limit(Lim,offset(Offset,member(_-Item,Sorted))),Items). Daniel@0: Daniel@0: dataset_itemx(SortProp, Id, Itemx, SortVal) :- Daniel@0: dataset_item(Id,URI), Daniel@0: filter(Lib,URI,in_library), Daniel@0: findall(Prop:Val, ( member(Prop,[label,audio,date]), Daniel@0: recording_property(URI,Lib,Prop,Val) ), Props), Daniel@0: (member(SortProp:Val,Props) -> SortVal=just(Val); SortVal=nothing), Daniel@0: dict_create(Itemx,_,[uri:URI | Props]). Daniel@0: Daniel@0: Daniel@0: recording_info(URI, Result, stable) :- Daniel@0: insist(filter(Lib,URI,in_library),unknown_recording(URI)), Daniel@0: findall(Prop:Val, recording_property(URI,Lib,Prop,Val), Props), Daniel@0: dict_create(Result,_,[ library:Lib | Props ]). Daniel@0: Daniel@0: recording_property(URI,Prop,Val) :- Daniel@0: filter(Lib,URI,in_library), Daniel@0: recording_property(URI,Lib,Prop,Val). Daniel@0: Daniel@0: recording_property(URI,_,label,Label) :- Daniel@0: rdf_display_label(URI,Label). Daniel@0: recording_property(URI,_,audio,Links) :- Daniel@0: % !!! HACK: force scraping for BL items here.. Daniel@0: % DISABLED - seems to upset BL server... Daniel@0: % (rdf(URI,dml:blpage,_) -> once(bl_p2r:scrape_audio_link(URI,_)); true), Daniel@0: setof(L,F^audio_link(URI,L,F),Links). Daniel@0: recording_property(URI,Lib,Prop,Val) :- Daniel@0: lib_property_read(Lib, Prop, Reader), Daniel@0: pred_values(URI,Lib:Prop,Reader,Val). Daniel@0: Daniel@0: Daniel@0: pred_values(URI,Lib:Prop,-Converter,Val) :- Daniel@0: lib_property(Lib,Prop,Pred), Daniel@0: once(rdf(URI,Pred,Obj)), Daniel@0: call(Converter,Obj,Val). Daniel@0: pred_values(URI,LibProp,+Converter,Vals) :- Daniel@0: findall(Val, pred_values(URI,LibProp,-Converter,Val), Vals). Daniel@0: Daniel@0: lib_property_read(_, collection, -literal_text). Daniel@0: lib_property_read(_, composer, +literal_text). Daniel@0: lib_property_read(_, performer, +literal_text). Daniel@0: lib_property_read(_, title, -literal_text). Daniel@0: lib_property_read(_, date, -literal_text). Daniel@0: lib_property_read(_, place, -literal_text). Daniel@0: lib_property_read(_, language, +literal_text). Daniel@0: lib_property_read(ilm, genre, +genre_label). Daniel@0: Daniel@0: genre_label(Genre,Label) :- Daniel@0: rdf(Genre,rdfs:label,Lit), Daniel@0: literal_text(Lit,Label). Daniel@0: Daniel@0: % ------------------- DEFINING NEW COLLECTIONS ----------------------- Daniel@0: Daniel@0: build_dataset_query(Query,DBV,Size-FullSize) --> Daniel@0: select_option(dv(DBV)), Daniel@0: select_option(sample(Subset)), Daniel@0: select_option(sv(SV)), Daniel@0: full_query(FQ), Daniel@0: { Subset=all -> Query=FQ, Size=FullSize Daniel@0: ; Query=sample(Subset,SV,FQ), Daniel@0: aggregate_all(count,call(FQ,_),FullSize) Daniel@0: }. Daniel@0: Daniel@0: full_query(qc(Filters)) --> Daniel@0: run_left(seqmap(process_qopt, Daniel@0: [ qo( library, atoms(LS), libraries(LS)) Daniel@0: , qo( collection, atoms(CC), any(collection,CC)) Daniel@0: , qo( title, atoms(TS), all(title,TS)) Daniel@0: , qo( composer, atoms(CS), any(composer,CS)) Daniel@0: , qo( performer, atoms(PS), any(performer,PS)) Daniel@0: , qo( genre, atoms(GS), any(genre,GS)) Daniel@0: , qo( year, years(YS), year(YS)) Daniel@0: , qo( place, atoms(PS), any(place,PS)) Daniel@0: , qo( language, atoms(LNS), any(language,LNS)) Daniel@0: ]), Filters, []). Daniel@0: Daniel@0: process_qopt(qo(OptName,Parser,Filter)) --> Daniel@0: { Opt=..[OptName,OptVal] }, Daniel@0: \> option_default_select(Opt,'*'), Daniel@0: ( {OptVal='*'} -> [] Daniel@0: ; {parse_atom(Parser,OptVal)}, Daniel@0: \< [Filter] Daniel@0: ). Daniel@0: Daniel@0: sample(Size,_,Query,X) :- Daniel@0: setof(X, call(Query,X), All), Daniel@0: length(All,Total), Daniel@0: ( Total= Subset=All Daniel@0: ; randset(Size, Total, All, [], Subset) Daniel@0: ), Daniel@0: member(X,Subset). Daniel@0: Daniel@0: randset(0, _, _) --> !. Daniel@0: randset(K, N, [A|As]) --> Daniel@0: ({random(N)>=K} -> {K1=K}; {K1 is K-1}, cons(A)), Daniel@0: {N1 is N-1}, randset(K1,N1,As). Daniel@0: Daniel@0: Daniel@0: qc(Filters,X) :- maplist(filter(Lib,X),Filters), filter(Lib,X,in_library). Daniel@0: Daniel@0: %% lib_property(-Library, -Property, -Predicate) is nondet. Daniel@0: % Daniel@0: % This predicate manages the mapping from API search fields to RDF Daniel@0: % predicates. There are still some questions about: Daniel@0: % Daniel@0: % $ composer : marcrel cmp, arr, lyr Daniel@0: % $ performer : marcrel prf, sng, cnd, drt Daniel@0: :- rdf_meta lib_property(?,+,r). Daniel@0: lib_property(bl, collection, dcterms:isPartOf). Daniel@0: lib_property(bl, language, dcterms:language). Daniel@0: lib_property(bl, language, dc:language). Daniel@0: lib_property(bl, place, dcterms:spatial). Daniel@0: lib_property(ilm, genre, mo:genre). Daniel@0: Daniel@0: % lib_property(beets, date, beets:original_year). Daniel@0: lib_property(ilm, date, ilm:release_date). Daniel@0: lib_property(charm, date, charm:recording_date). Daniel@0: lib_property(mazurka, date, mazurka:recording_date). Daniel@0: lib_property(bl, date, dcterms:created). Daniel@0: Daniel@0: lib_property(charm, composer, charm:composer). Daniel@0: lib_property(mazurka, composer, mazurka:composer). Daniel@0: lib_property(bl, composer, marcrel:cmp). Daniel@0: lib_property(bl, composer, marcrel:arr). Daniel@0: lib_property(beets, composer, beets:composer). Daniel@0: Daniel@0: lib_property(charm, performer, charm:performer). Daniel@0: lib_property(mazurka, performer, mazurka:performer). Daniel@0: lib_property(bl, performer, marcrel:prf). Daniel@0: lib_property(bl, performer, marcrel:sng). Daniel@0: lib_property(beets, performer, beets:artist). Daniel@0: lib_property(ilm, performer, ilm:arist). Daniel@0: Daniel@0: lib_property(charm, title, charm:title). Daniel@0: lib_property(mazurka, title, mazurka:title). Daniel@0: lib_property(bl, title, dc:title). Daniel@0: lib_property(beets, title, beets:title). Daniel@0: lib_property(ilm, title, dc:title). Daniel@0: Daniel@0: lib_property_search(_,collection,X, substring(X)). Daniel@0: lib_property_search(_,place, X, substring(X)). Daniel@0: lib_property_search(_,language, X, prefix(X)). Daniel@0: lib_property_search(_,composer, X, prefix(X)). Daniel@0: lib_property_search(_,performer, X, prefix(X)). Daniel@0: lib_property_search(_,title, X, substring(X)). Daniel@0: lib_property_search(beets, date, L-U, between(L,U1)) :- succ(U,U1). Daniel@0: lib_property_search(_Lib, date, L-U, between(LA,U1A)) :- Daniel@0: % Lib\=beets, Daniel@0: succ(U,U1), Daniel@0: atom_number(LA,L), Daniel@0: atom_number(U1A,U1). Daniel@0: Daniel@0: %% filter(+Lib, -Resource, +SearchSpec) is nondet. Daniel@0: filter(Lib, _, libraries(Ls)) :- member(Lib,Ls). Daniel@0: filter(Lib, X, any(Prop,Vals)) :- member(Val,Vals), filter(Lib,X,Prop,Val). Daniel@0: filter(Lib, X, all(Prop,Vals)) :- maplist(filter(Lib,X,Prop),Vals). Daniel@0: filter(Lib, X, year(any(Ys))) :- member(Y,Ys), filter(Lib,X,date,Y-Y). Daniel@0: filter(Lib, X, year(L-U)) :- filter(Lib,X,date,L-U). Daniel@0: filter(Lib, X, Prop-Val) :- filter(Lib,X,Prop,Val). Daniel@0: Daniel@0: filter(charm, X, in_library) :- rdf(X,charm:file_name,_,charm_p2r). Daniel@0: filter(mazurka, X, in_library) :- rdf(X,mazurka:pid,_,mazurka_p2r). Daniel@0: filter(bl, X, in_library) :- rdf(X,rdf:type,mo:'Signal',bl_p2r). Daniel@0: filter(ilm, X, in_library) :- rdf(X,mo:track_number,_,ilm_p2r). Daniel@0: filter(beets, X, in_library) :- rdf(X,rdf:type,mo:'AudioFile',beets_p2r). Daniel@0: Daniel@0: %% filter(+Lib, -Resource, +Property, +Value) is nondet. Daniel@0: Daniel@0: % filter(beets, X,genre,G) :- rdf_has(X,beets:genre,literal(substring(G),_)). Daniel@0: filter(ilm, X,genre,G) :- Daniel@0: rdf(GR,rdfs:label,literal(substring(G),_),ilm_p2r), Daniel@0: rdf(GR,rdf:type,mo:'Genre',ilm_p2r), Daniel@0: rdf(X,mo:genre,GR). Daniel@0: Daniel@0: filter(Lib, X, Prop, Val) :- Daniel@0: lib_property(Lib,Prop,Pred), Daniel@0: lib_property_search(Lib,Prop,Val,Search), Daniel@0: rdf(X,Pred,literal(Search,_)). 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(AS) --> semicolon_sep(atom_codes,AS1), {maplist(downcase_atom,AS1,AS2),sort(AS2,AS)}. Daniel@0: whole(A) --> string_without("",Codes), {atom_codes(A1,Codes), downcase_atom(A1,A)}. Daniel@0: Daniel@0: % years('*') --> "*", !. Daniel@0: years(L-U) --> integer(L), "-", integer(U). Daniel@0: years(any(Ys)) --> semicolon_sep(number_codes,Ys1), {sort(Ys1,Ys)}. 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: insist( phrase(Phrase,Codes), parse_failure(Phrase)). Daniel@0: Daniel@0: thread_pool:create_pool(vis_recording) :- Daniel@0: current_prolog_flag(cpu_count,N), Daniel@0: thread_pool_create(vis_recording, N, [backlog(50)]).