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(dml_crawler, []). Daniel@0: Daniel@0: :- use_module(library(http/html_write)). Daniel@0: :- use_module(library(semweb/rdf_db)). Daniel@0: :- use_module(library(semweb/rdfs)). Daniel@0: :- use_module(library(semweb/rdf_label)). Daniel@0: :- use_module(library(sparkle)). Daniel@0: :- use_module(library(crawler)). Daniel@0: :- use_module(library(musicbrainz)). Daniel@0: :- use_module(library(memo)). Daniel@0: :- use_module(applications(browse)). Daniel@0: :- use_module(api(lod_crawler)). Daniel@0: :- use_module(cliopatria(hooks)). Daniel@0: Daniel@0: :- sparql_endpoint(mb, 'http://dbtune.org/musicbrainz/sparql'). Daniel@0: :- sparql_endpoint(lb, 'http://linkedbrainz.org/sparql/'). Daniel@0: :- sparql_endpoint(dbp, 'http://dbpedia.org/sparql/'). Daniel@0: :- sparql_endpoint(self, 'http://localhost:3020/sparql/'). Daniel@0: Daniel@0: % :- sparql_endpoint(bbc, 'http://dbtune.org/bbc/programmes/sparql/'). Daniel@0: % :- sparql_endpoint(peel,'http://dbtune.org/bbc/peel/sparql/'), Daniel@0: % :- sparql_endpoint(classical,'http://dbtune.org/classical/sparql/'), Daniel@0: % :- sparql_endpoint(jamendo,'http://dbtune.org/jamendo/sparql/'), Daniel@0: % :- sparql_endpoint(magnatune,'http://dbtune.org/magnatune/sparql/'), Daniel@0: % :- sparql_endpoint(henry,'http://dbtune.org/henry/sparql/'), Daniel@0: Daniel@0: Daniel@0: crawler:source(dbp, dml_crawler:sparql_crawler(dbp), []). Daniel@0: crawler:source(lbz, dml_crawler:sparql_crawler(lb), []). Daniel@0: crawler:source(mbz, dml_crawler:mbz_crawler, []). Daniel@0: crawler:source(lod, dml_crawler:lod_crawler, []). Daniel@0: Daniel@0: crawler:authority( begins('http://dbpedia.org'), dbp, [auto(true)]). Daniel@0: crawler:authority( begins('http://musicbrainz.org'), lbz, [auto(true)]). Daniel@0: crawler:authority( begins('http://musicbrainz.org'), mbz, [auto(true)]). Daniel@0: crawler:authority( begins('http://id.loc.gov/vocabulary'), lod, [auto(true)]). Daniel@0: crawler:authority( begins('http://yago-knowledge.org'), lod, [auto(true)]). Daniel@0: crawler:authority( ( (begins('http://'); begins('https://')), Daniel@0: \+begins('http://dbpedia.org/'), Daniel@0: \+begins('http://musicbrainz.org/'), Daniel@0: \+begins('http://dml.org/'), Daniel@0: \+begins('http://sounds.bl.uk/') Daniel@0: ), lod, [auto(false)]). Daniel@0: Daniel@0: :- volatile_memo instrument(+label:atom,-uri:atom). Daniel@0: Daniel@0: instrument(Label,Instr) :- Daniel@0: rdf(Instr,skos:prefLabel,literal(exact(Label),_)). Daniel@0: Daniel@0: :- rdf_meta censor(+,t). Daniel@0: censor(lb, rdf(_,'http://purl.org/muto/core#taggedResource',_)). Daniel@0: censor(lb, rdf(_,mo:musicbrainz_guid,_)). Daniel@0: censor(lb, rdf(_,foaf:made,_)). Daniel@0: Daniel@0: % not needed after all: it was me giving the recordings type 'Signal', not lb. Daniel@0: % sparql_crawler:modify(lb,Tin,Tout) :- Daniel@0: % debug(sparql_crawler,"checking ~q",[Tin]), Daniel@0: % once(relink_brainz(Tin,Tout)). Daniel@0: Daniel@0: % :- rdf_meta relink_brainz(t,t). Daniel@0: % relink_brainz(rdf(MBZRecording,rdf:type,mo:'Track'),rdf(MBZRecording,rdf:type,mo:'Signal')):- Daniel@0: % mb_id_uri(recording,_,MBZRecording). Daniel@0: Daniel@0: % connects patched ClioPatria resource viewer to sparql_crawler module Daniel@0: cliopatria:resource_crawler(URI,NT) --> html(div(class(crawler),\crawl_ui(URI,NT))). Daniel@0: Daniel@0: % --------- SPARQL crawler using sparkle --------------- Daniel@0: Daniel@0: sparql_crawler(dbp,name('DBPedia')). Daniel@0: sparql_crawler(lb,name('LinkedBrainz')). Daniel@0: Daniel@0: sparql_crawler(EP,uri_graph(_,Graph)) :- Daniel@0: current_sparql_endpoint(EP,Host,Port,Path,_), Daniel@0: parse_url(Graph,[protocol(http),host(Host),port(Port),path(Path)]). Daniel@0: Daniel@0: sparql_crawler(EP,describe(URI,Triple)) :- Daniel@0: describe(EP,URI,Triple), Daniel@0: \+censor(EP,Triple). Daniel@0: Daniel@0: Daniel@0: describe(EP,URI,rdf(Subj,Pred,URI)) :- EP ?? rdf(Subj,Pred,URI). Daniel@0: describe(EP,URI,rdf(URI,Pred,Obj)) :- EP ?? rdf(URI,Pred,Obj). Daniel@0: % !!! FIXME This was to slow for URIs with many linked resources Daniel@0: % Need to get asynchronous crawling working first.. Daniel@0: % describe(EP,URI,rdf(Subj,Pred,Obj)) :- Daniel@0: % (EP ?? rdf(URI,P1,O1)), Daniel@0: % ( Subj=URI, Pred=P1, Obj=O1 Daniel@0: % ; Subj=O1, Pred=P2, Obj=O2, Daniel@0: % O1\=literal(_), Daniel@0: % (EP ?? rdf(O1,P2,O2)) Daniel@0: % ). Daniel@0: Daniel@0: % ----------- LOD crawler --------------------------- Daniel@0: lod_crawler(name('LOD Cloud')). Daniel@0: lod_crawler(uri_graph(URI,Graph)) :- Daniel@0: uri_components(URI, uri_components(Sch,Auth,_,_,_)), Daniel@0: uri_components(Graph, uri_components(Sch,Auth,_,_,_)). Daniel@0: Daniel@0: lod_crawler(crawl(URI,Graph)) :- Daniel@0: lod_uri_graph(URI,URL), Daniel@0: rdf_load(URL,[graph(Graph)]). Daniel@0: Daniel@0: % ----------- MusicBrainz crawler ------------------- Daniel@0: mbz_crawler(uri_graph(_,'http://musicbrainz.org/ws/2')). Daniel@0: mbz_crawler(name('MusicBrainz')). Daniel@0: mbz_crawler(describe(URI,Triple)) :- Daniel@0: debug(crawler,'Doing ~q.',[mbz_crawler(describe(URI,Triple))]), Daniel@0: ( mb_id_uri(Type,_,URI) -> Context=Type Daniel@0: ; event_uri(URI,EvType,BaseURI,Extra), Daniel@0: mb_id_uri(BaseType,_,BaseURI) Daniel@0: -> Context=event(BaseType,BaseURI,EvType,Extra) Daniel@0: ; debug(crawler,'Unrecognised URI: ~w',[URI]), Daniel@0: fail Daniel@0: ), Daniel@0: mbz_triple(Context,URI,Triple1), Daniel@0: rdf_global_term(Triple1,Triple). Daniel@0: Daniel@0: Daniel@0: mbz_triple(artist,URI,rdf(URI,rdf:type,mo:'MusicArtist')). Daniel@0: mbz_triple(artist,URI,Triple) :- Daniel@0: mb_lookup(URI,[inc([aliases]), rels([recording,work,artist])],Artist), Daniel@0: subject_triple(Artist-URI,artist,Triple). Daniel@0: Daniel@0: mbz_triple(recording,URI,rdf(URI,rdf:type,mo:'Signal')). Daniel@0: mbz_triple(recording,URI,rdf(Event,rdf:type,mo:'Recording')) :- Daniel@0: event_uri(Event,production,URI). Daniel@0: Daniel@0: mbz_triple(recording,URI,Triple) :- Daniel@0: mb_lookup(URI,[inc([artists,'artist-credits']),rels([artist,work])],Recording), Daniel@0: event_uri(Event,production,URI), Daniel@0: subject_triple(Recording-URI, recording(Event), Triple). Daniel@0: Daniel@0: mbz_triple(work,URI,rdf(URI,rdf:type,mo:'MusicalWork')). Daniel@0: mbz_triple(work,URI,Triple) :- Daniel@0: mb_lookup(URI,[inc([aliases]),rels([recording,artist,work])],Work), Daniel@0: subject_triple(Work-URI, work, Triple). Daniel@0: Daniel@0: mbz_triple(event(work,_,composition,''),Event,rdf(Event,rdf:type:mo:'Composition')). Daniel@0: mbz_triple(event(work,W,composition,''),Event,Triple) :- Daniel@0: mb_lookup(W,[rels([artist,work])],Work), % need work rels here? Daniel@0: event_uri(Event,composition,WorkURI), Daniel@0: subject_triple(Work-WorkURI, work, Triple). Daniel@0: Daniel@0: mbz_triple(event(recording,Signal,production,''),Event,Triple) :- Daniel@0: production_triple(Signal,Event,Triple). Daniel@0: Daniel@0: production_triple(_, Ev, rdf(Ev,rdf:type,mo:'Performance')). Daniel@0: production_triple(_, Ev, rdf(Ev,rdf:type,mo:'Recording')). Daniel@0: production_triple(S, Ev, rdf(Ev,mo:produced_signal,S)). Daniel@0: production_triple(S, Ev, T) :- Daniel@0: mb_lookup(S,[inc([artists,'artist-credits']),rels([work,artist])],Recording), Daniel@0: mb_uri(Recording,Signal), Daniel@0: subject_triple(Recording-Signal,recording(Ev),T). Daniel@0: Daniel@0: %% subject_triple( +Subj:pair(element,resource), +Content:ground, -T:triple) is nondet. Daniel@0: % Produce triples relating to this subject without doing any more musicbrainz queries. Daniel@0: Daniel@0: % first deal with the non-relation facets Daniel@0: subject_triple(E-URI, Context, T) :- Daniel@0: dif(Facet,relation(_,_)), Daniel@0: mb_facet(E,Facet), Daniel@0: facet_triple(URI, Context, Facet, T). Daniel@0: Daniel@0: % then deal with relations Daniel@0: subject_triple(E1-URI1, _Context, T) :- Daniel@0: mb_relation(E1, E2, Name, Dir, Opts), Daniel@0: mb_uri(E2,URI2), Daniel@0: ( mb_class(E2,C2), Daniel@0: subject_triple(E2-URI2, C2, T) % do all facets of related object Daniel@0: ; normalise_direction(Dir,URI1,URI2,URI_A,URI_B), Daniel@0: relation_triple(Name,URI_A,URI_B,Opts,T) Daniel@0: ). Daniel@0: Daniel@0: normalise_direction(fwd,E1,E2,E1,E2). Daniel@0: normalise_direction(bwd,E1,E2,E2,E1). Daniel@0: Daniel@0: Daniel@0: facet_triple(_, _, credit(A), T) :- mb_uri(A,Agent), subject_triple(A-Agent,artist,T). Daniel@0: facet_triple(URI, _, title(T), rdf(URI,dc:title,literal(T))). Daniel@0: facet_triple(URI, artist, name(N), rdf(URI,foaf:name,literal(N))). Daniel@0: facet_triple(URI, artist, alias(A), rdf(URI,dml:alias,literal(A))). Daniel@0: facet_triple(URI, artist, gender(G), rdf(URI,foaf:gender,literal(GG))) :- downcase_atom(G,GG). Daniel@0: facet_triple(URI, artist, type(Type), rdf(URI,rdf:type,foaf:Type)) :- member(Type,['Person','Group']). Daniel@0: facet_triple(URI, artist, born(X), T) :- life_event_triple(URI,birth,time(X),T). Daniel@0: facet_triple(URI, artist, died(X), T) :- life_event_triple(URI,death,time(X),T). Daniel@0: facet_triple(URI, artist, birth_place(X), T) :- life_event_triple(URI,birth,area(X),T). Daniel@0: facet_triple(URI, artist, death_place(X), T) :- life_event_triple(URI,death,area(X),T). Daniel@0: Daniel@0: facet_triple(_, recording(E), credit(A), rdf(E,event:agent,Agent)) :- mb_uri(A,Agent). Daniel@0: facet_triple(URI, recording(_), length(L), rdf(URI,mo:duration,literal(type(xsd:float,LenA)))) :- Daniel@0: atom_number(LenA,L). Daniel@0: Daniel@0: life_event_triple(Agent,Type,Property,T) :- Daniel@0: event_uri(Event,Type,Agent), Daniel@0: ( T=rdf(Event,rdf:type,event:'Event') Daniel@0: ; T=rdf(Event,event:agent,Agent) Daniel@0: ; life_event_property_triple(Event,Property,T) Daniel@0: ). Daniel@0: Daniel@0: Daniel@0: life_event_property_triple(Event,area(A),rdf(Event,event:place,URI)) :- mb_uri(A,URI). Daniel@0: life_event_property_triple(Event,time(T),Triple) :- Daniel@0: prefix_uri('/time',Event,Time), Daniel@0: ( Triple=rdf(Event,event:time,Time) Daniel@0: ; time_instant_triple(Time-T,Triple) Daniel@0: ). Daniel@0: Daniel@0: % ----------------------------------------------------------------------------- Daniel@0: % relation_triple Daniel@0: Daniel@0: relation_triple(parts, Whole, Part, _, rdf(Part,dml:part_of,Whole)). Daniel@0: relation_triple(composer, Agent, Work, _, rdf(Work,dml:composer,Agent)). Daniel@0: relation_triple('is person', Agent, Person, _, rdf(Agent,dml:persona_of,Person)). Daniel@0: relation_triple('performing orchestra', _, Group, _, rdf(Group,rdf:type,mo:'Orchestra')). Daniel@0: relation_triple(Name, _, Group, _, rdf(Group,rdf:type,mo:'MusicGroup')) :- membership_role(Name). Daniel@0: relation_triple(Name, Agent, Group, _, rdf(Group,mo:member,Agent)) :- membership_role(Name). Daniel@0: Daniel@0: relation_triple(Role, Agent, _, _, rdf(Agent,rdf:type,mo:'MusicArtist')) :- Daniel@0: musical_role(Role). Daniel@0: relation_triple(Name, R1, R2, Opts, T) :- Daniel@0: relation_event(Name, R1, R2, Opts, Event, Relation), Daniel@0: relation_event_triple(Relation, Event, T). Daniel@0: Daniel@0: relation_event( based_on, Orig, Deriv, _, Ev, based_on(Orig)) :- event_uri(Ev,composition,Deriv). Daniel@0: relation_event( composer, A, W, O, Ev, composition(composer,A,W,O)) :- event_uri(Ev,composition,W). Daniel@0: relation_event( lyricist, A, W, _, Ev, composition(lyricist,A,W,[])) :- event_uri(Ev,composition,W). Daniel@0: relation_event( writer, A, W, _, Ev, composition(writer,A,W,[])) :- event_uri(Ev,composition,W). Daniel@0: relation_event( arrangement, W1, W2, O, Ev, arrangement(W1,W2,O)) :- event_uri(Ev,arrangement,W2). Daniel@0: relation_event( performance, Sig, W, O, Ev, performance(W,O)) :- event_uri(Ev,production,Sig). Daniel@0: relation_event( performance, Sig, _, _, Ev, recording(Sig)) :- event_uri(Ev,production,Sig). Daniel@0: relation_event( performer, _, Sig, _, Ev, recording(Sig)) :- event_uri(Ev,production,Sig). Daniel@0: relation_event( 'performing orchestra', _, Sig, _, Ev, recording(Sig)) :- event_uri(Ev,production,Sig). Daniel@0: relation_event( vocal, Ag, Sig, O, Ev, ED) :- relation_event( instrument, Ag, Sig, [attribute(voice)|O], Ev, ED). Daniel@0: relation_event( 'instrument arranger', Ag, Sig, O, Ev, ED) :- relation_event(instrument,Ag,Sig,O,Ev,ED). Daniel@0: relation_event( 'instrument arranger', Ag, Sig, O, Ev, ED) :- relation_event(arranger,Ag,Sig,O,Ev,ED). Daniel@0: relation_event( instrument, _, Sig, _, Ev, recording(Sig)) :- event_uri(Ev,production,Sig). Daniel@0: relation_event( instrument, Ag, Sig, O, Ev, instrument(Prod,Ag,O)) :- Daniel@0: mb_id_uri(_,PerformerID,Ag), Daniel@0: event_uri(Prod,production,Sig), Daniel@0: event_uri(Ev,performance,Sig,PerformerID). Daniel@0: relation_event( Name, Agent, Sig, _, Ev, role(Pred,Agent)) :- Daniel@0: production_role(Name,Pred), Daniel@0: mb_id_uri(recording,_,Sig), Daniel@0: event_uri(Ev,production,Sig). Daniel@0: Daniel@0: relation_event( Name, Agent, Group, Opts, Ev, membership(Agent,Group,[role(Role)|Opts])) :- Daniel@0: membership_role(Name,Role), Daniel@0: mb_id_uri(_,AID,Agent), Daniel@0: term_hash(t(AID,Role,Opts),Hash), Daniel@0: number_string(Hash,HashString), Daniel@0: event_uri(Ev,membership,Group,HashString). Daniel@0: Daniel@0: production_role(producer,mo:producer). Daniel@0: production_role(arranger,mo:arranger). Daniel@0: production_role(conductor,mo:conductor). Daniel@0: production_role(performer,mo:performer). Daniel@0: production_role('performing orchestra',mo:performer). Daniel@0: production_role(vocal,mo:performer). Daniel@0: Daniel@0: membership_role(Name) :- membership_role(Name,_). Daniel@0: membership_role('member of band',member). Daniel@0: membership_role('conductor position',conductor). Daniel@0: membership_role('vocal supporting musician',vocal_support). Daniel@0: Daniel@0: musical_role(composer). Daniel@0: musical_role(arranger). Daniel@0: musical_role(lyricist). Daniel@0: musical_role(instrument). Daniel@0: musical_role(performer). Daniel@0: musical_role('performing orchestra'). Daniel@0: musical_role('vocal supporting musician'). Daniel@0: musical_role(Name) :- membership_role(Name). Daniel@0: Daniel@0: relation_event_triple( based_on(_), Ev, rdf(Ev,rdf:type,mo:'Composition')). Daniel@0: relation_event_triple( based_on(Orig), Ev, rdf(Ev,event:factor,Orig)). Daniel@0: Daniel@0: relation_event_triple( membership(_,_,_), Ev, rdf(Ev,rdf:type,mo:'Membership')). Daniel@0: relation_event_triple( membership(A,_,_), Ev, rdf(Ev,mo:artist,A)). Daniel@0: relation_event_triple( membership(_,G,_), Ev, rdf(Ev,mo:group,G)). Daniel@0: relation_event_triple( membership(_,_,O), Ev, T) :- membership_triple(Ev,O,T). Daniel@0: relation_event_triple( membership(_,_,O), Ev, T) :- event_time_triple(Ev,O,T). Daniel@0: Daniel@0: relation_event_triple( composition(_,_,_,_), Ev, rdf(Ev,rdf:type,mo:'Composition')). Daniel@0: relation_event_triple( composition(_,_,W,_), Ev, rdf(Ev,mo:produced_work,W)). Daniel@0: relation_event_triple( composition(R,A,_,_), Ev, rdf(Ev,mo:R,A)). Daniel@0: relation_event_triple( composition(_,_,_,O), Ev, T) :- event_time_triple(Ev,O,T). Daniel@0: Daniel@0: relation_event_triple( arrangement(_,_,_), Ev, rdf(Ev,rdf:type,mo:'Arrangement')). Daniel@0: relation_event_triple( arrangement(W,_,_), Ev, rdf(Ev,mo:arrangement_of,W)). Daniel@0: relation_event_triple( arrangement(_,W,_), Ev, rdf(Ev,mo:produced_work,W)). Daniel@0: relation_event_triple( arrangement(_,_,O), Ev, T) :- event_time_triple(Ev,O,T). Daniel@0: Daniel@0: relation_event_triple( performance(_,_), Ev, rdf(Ev,rdf:type,mo:'Performance')). Daniel@0: relation_event_triple( performance(_,O), Ev, T) :- event_time_triple(Ev,O,T). Daniel@0: relation_event_triple( performance(W,O), Ev, rdf(Ev,Pred,W)) :- Daniel@0: ( member(attribute(partial),O) Daniel@0: -> Pred=mo:partial_performance_of Daniel@0: ; Pred=mo:performance_of Daniel@0: ). Daniel@0: Daniel@0: relation_event_triple( recording(_), Ev, rdf(Ev,rdf:type,mo:'Recording')). Daniel@0: relation_event_triple( recording(S), Ev, rdf(Ev,mo:produced_signal,S)). Daniel@0: Daniel@0: relation_event_triple( instrument(_,_,_), Ev, rdf(Ev,rdf:type,mo:'Performance')). Daniel@0: relation_event_triple( instrument(_,A,_), Ev, rdf(Ev,mo:performer,A)). Daniel@0: relation_event_triple( instrument(P,_,_), Ev, rdf(P,event:sub_event,Ev)). Daniel@0: relation_event_triple( instrument(_,_,O), Ev, T) :- event_time_triple(Ev,O,T). Daniel@0: % relation_event_triple( instrument(_,_,O), Ev, rdf(Ev,mo:instrument,literal(Instr))) :- Daniel@0: % member(attribute(Instr),O). Daniel@0: relation_event_triple( instrument(_,_,O), Ev, rdf(Ev,mo:instrument,Instr)) :- Daniel@0: member(attribute(Label),O), Daniel@0: ( instrument(Label,Instr) -> true Daniel@0: ; Instr=literal(Label) Daniel@0: ). Daniel@0: Daniel@0: membership_triple(E, O, rdf(E,dml:role,literal(R))) :- member(role(R),O), R\=member. Daniel@0: membership_triple(E, O, rdf(E,dml:modifier,literal(A))) :- member(attribute(A),O). Daniel@0: Daniel@0: event_time_triple(Event,Opts,T) :- Daniel@0: (memberchk(begin(_),Opts); memberchk(end(_),Opts); memberchk(in(_),Opts)), Daniel@0: prefix_uri('/time',Event,Time), Daniel@0: ( T=rdf(Event,event:time,Time) Daniel@0: ; ( member(in(DT),Opts) Daniel@0: -> time_instant_triple(Time-DT,T) Daniel@0: ; ( member(begin(DT),Opts), prefix_uri('/begin',Time,Pt), Pred=time:hasBeginning Daniel@0: ; member(end(DT),Opts), prefix_uri('/end',Time,Pt), Pred=time:hasEnd Daniel@0: ), Daniel@0: time_interval_triple(Time,Pred,Pt-DT,T) Daniel@0: ) Daniel@0: ). Daniel@0: Daniel@0: time_instant_triple(Time-_, rdf(Time,rdf:type,time:'Instant')). Daniel@0: time_instant_triple(Time-DT, rdf(Time,time:inXSDDateTime,literal(type(xsd:dateTime,DT)))). Daniel@0: Daniel@0: time_interval_triple(T, _, _, rdf(T,rdf:type, time:'Interval')). Daniel@0: time_interval_triple(T, Pred, Pt-_, rdf(T,Pred,Pt)). Daniel@0: time_interval_triple(_, _, PtDT, T) :- time_instant_triple(PtDT,T). Daniel@0: Daniel@0: Daniel@0: %% event_uri(-EventURI,+Type,+BaseURI) is det. Daniel@0: %% event_uri(-EventURI,+Type,+BaseURI) is det. Daniel@0: event_uri(EventURI,Type,BaseURI) :- event_uri(EventURI,Type,BaseURI,''). Daniel@0: Daniel@0: %% event_uri(+EventURI,-Type,-BaseURI,-Extra) is det. Daniel@0: %% event_uri(-EventURI,+Type,+BaseURI,+Extra) is det. Daniel@0: event_uri(EventURI,Type,BaseURI,Extra) :- Daniel@0: ( var(EventURI) Daniel@0: -> uri_components(BaseURI,uri_components(Sc,Ho,Pa,Extra,'_')), Daniel@0: uri_components(EventURI,uri_components(Sc,Ho,Pa,Extra,Type)), Type\='_' Daniel@0: ; uri_components(EventURI,uri_components(Sc,Ho,Pa,Extra,Type)), Type\='_', Daniel@0: uri_components(BaseURI,uri_components(Sc,Ho,Pa,Extra,'_')) Daniel@0: ). Daniel@0: Daniel@0: % prefix_uri(_,_,N) :- rdf_bnode(N), !. Daniel@0: prefix_uri(Prefix,URI,PURI) :- Daniel@0: uri_components(URI,uri_components(Sc,Ho,Pa,Extra,Type)), atom_concat(Prefix,Pa,TPa), Daniel@0: uri_components(PURI,uri_components(Sc,Ho,TPa,Extra,Type)). Daniel@0: Daniel@0: % -------------- display hooks --------------- Daniel@0: :- rdf_meta label(r,r,-). Daniel@0: label(time:'Instant',URI, Label) :- Daniel@0: ( rdf_has(URI,time:inXSDDateTime,literal(type(xsd:dateTime,DT))) Daniel@0: -> format(string(Label),'~w',[DT]) Daniel@0: ; Label='' Daniel@0: ). Daniel@0: Daniel@0: label(time:'Interval',URI, Label) :- Daniel@0: (rdf_has(URI,time:hasBeginning,Begin) -> rdf_display_label(Begin,L1); L1=''), Daniel@0: (rdf_has(URI,time:hasEnd,End) -> rdf_display_label(End,L2); L2=''), Daniel@0: ( L1=L2 Daniel@0: -> format(string(Label),'~s',[L1]) Daniel@0: ; format(string(Label),'~s to ~s',[L1,L2]) Daniel@0: ). Daniel@0: Daniel@0: label(mo:'Recording',Ev, Label) :- Daniel@0: rdf_has(Ev,mo:produced_signal,Sig), !, Daniel@0: rdf_display_label(Sig,Title), Daniel@0: ( rdf_has(Ev,event:agent,Agent) Daniel@0: -> rdf_display_label(Agent,Name), Daniel@0: format(string(Label),'Recording of ~w by ~w',[Title,Name]) Daniel@0: ; format(string(Label),'Recording of ~w',[Title]) Daniel@0: ). Daniel@0: Daniel@0: label(mo:'Membership',Ev, Label) :- Daniel@0: rdf_has(Ev,mo:artist,A), Daniel@0: rdf_has(Ev,mo:group,G), !, Daniel@0: rdf_display_label(A,AL), Daniel@0: rdf_display_label(G,GL), Daniel@0: format(string(Label),'Membership of ~w in ~w',[AL,GL]). Daniel@0: Daniel@0: label(mo:'Performance',Ev, Label) :- Daniel@0: ( rdf_has(Ev,mo:produced_signal,Sig) Daniel@0: ; rdf_has(SEv,event:sub_event,Ev), Daniel@0: rdf_has(SEv,mo:produced_signal,Sig) Daniel@0: ), !, Daniel@0: rdf_display_label(Sig,Title), Daniel@0: rdf_has(Ev,mo:performer,Performer), rdf_display_label(Performer,Name), Daniel@0: rdf_has(Ev,mo:instrument,Instr), rdf_display_label(Instr,IName), Daniel@0: format(string(Label),'~w playing ~w on ~w',[Name,IName,Title]). Daniel@0: Daniel@0: Daniel@0: label(mo:'Composition',E,Label) :- Daniel@0: rdf_has(E,mo:produced_work,Work), Daniel@0: rdfs_individual_of(Work,mo:'MusicalWork'), !, Daniel@0: rdf_display_label(Work,Title), Daniel@0: format(string(Label),'Composition of ~w',[Title]). Daniel@0: Daniel@0: rdf_label:display_label_hook(URI, _, Label) :- Daniel@0: rdf(URI,rdf:type,Class), Daniel@0: label(Class,URI,Label). Daniel@0: Daniel@0: rdf_label:display_label_hook(URI, _, Label) :- Daniel@0: atom(URI), Daniel@0: sub_atom(URI,0,_,_,'http://musicbrainz.org'), Daniel@0: event_uri(URI,EvType,Base), Daniel@0: event_label(EvType,URI,Base,Label). Daniel@0: Daniel@0: event_label(birth,_,Person,Label) :- Daniel@0: rdfs_individual_of(Person,foaf:'Person'), !, Daniel@0: rdf_display_label(Person,Name), Daniel@0: format(string(Label),'Birth of ~w',[Name]). Daniel@0: event_label(death,_,Person,Label) :- Daniel@0: rdfs_individual_of(Person,foaf:'Person'), !, Daniel@0: rdf_display_label(Person,Name), Daniel@0: format(string(Label),'Death of ~w',[Name]). Daniel@0: Daniel@0: