diff cpack/dml/lib/humdrum_p2r.pl @ 0:718306e29690 tip

commiting public release

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cpack/dml/lib/humdrum_p2r.pl	Tue Feb 09 21:05:06 2016 +0100
@@ -0,0 +1,286 @@
+/* Part of DML (Digital Music Laboratory)
+	Copyright 2014-2015 Samer Abdallah, University of London
+	 
+	This program is free software; you can redistribute it and/or
+	modify it under the terms of the GNU General Public License
+	as published by the Free Software Foundation; either version 2
+	of the License, or (at your option) any later version.
+
+	This program is distributed in the hope that it will be useful,
+	but WITHOUT ANY WARRANTY; without even the implied warranty of
+	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+	GNU General Public License for more details.
+
+	You should have received a copy of the GNU General Public
+	License along with this library; if not, write to the Free Software
+	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+*/
+
+:- module(humdrum_p2r, [ humdrum_import/1, hum_uri_path/2 ]).
+
+/** <module> Manages a database of Humdrum files and mappings to RDF.
+ */
+
+:- use_module(library(memo)).
+:- use_module(library(humdrum)).
+:- use_module(library(humdrum/humdrum_world), [with_kern_module/4]).
+:- use_module(library(fileutils)).
+:- use_module(library(termutils)).
+:- use_module(library(typedef)).
+:- use_module(library(dcg_core)).
+:- use_module(library(musiclab)).
+:- use_module(library(settings)).
+:- use_module(entailment(p2r)).
+
+:- set_prolog_flag(double_quotes,string).
+
+:- rdf_register_prefix(humdb,'http://dml.org/humdrum/data/').
+:- rdf_register_prefix(hum,'http://dml.org/humdrum/schema/').
+:- rdf_register_prefix(kern,'kern:').
+
+:- setting(kern_root,string,"~/lib/kern","Root of kern lib tree").
+:- setting(kern_subdirs,list(atom),[classical,lorraine,jrp,ragtime,ireland,pentatonic,idyom],"Kern library directories to import").
+
+uripattern:def( work(Opus), humdb:work/enc(Opus)).
+uripattern:def( trefcode(C), hum:refcode/trans/enc(C)).
+uripattern:def( refcode(C), hum:refcode/enc(C)).
+uripattern:def( kernfile(F), kern:tail(F)).
+
+% Humdrum schema
+rdf(hum:refcode('OTL'), rdfs:subPropertyOf, dc:title),
+rdf(hum:composer, rdfs:subPropertyOf, foaf:maker),
+rdf(hum:opus, rdfs:subPropertyOf, mo:opus),
+rdf(hum:'Work', rdfs:subClassOf, mo:'MusicalWork'),
+rdf(hum:'File', rdfs:subClassOf, mo:'Score'),
+rdf(hum:encodedBy, rdfs:type, rdf:'ObjectProperty'),
+% rdf(hum:encodedBy, owl:inverseOf, hum:encodes) <== true.
+
+rdf(\refcode(C), rdfs:subPropertyOf, \trefcode(C)) <==
+   setof(C, translated_refcode(C), Codes),
+   member(C, Codes).
+
+rdf(\trefcode(C), rdf:comment, Desc1) <==
+   setof(C, translated_refcode(C), Codes),
+   member(C, Codes),
+   hum_prop_desc(C,Desc),
+   atom_concat(Desc,' (translated)',Desc1).
+
+translated_refcode(Code) :-
+   browse(file_props(_,Props)), 
+   member(Code-((sec-_)-_),Props).
+   
+hum_prop_desc(C,_) ==>
+   rdf(\refcode(C), rdf:type, rdf:'ObjectProperty'),
+   rdf(\refcode(C), rdf:domain, hum:'File').
+
+hum_prop_desc(C,Desc) ==>
+   rdf(\refcode(C), rdf:comment, literal(Desc)).
+
+% -- mappings that use file_opus/2 ---------------
+
+%% file(-File) is nondet.
+%  True when File is a Humdrum file that has been imported into
+%  the current database.
+:- dynamic file/1.
+
+%% file_opus(-File,-Opus) is nondet.
+%  True when Humdrum file File contains an SCT refcode
+%  (scholarly catalog number) Opus.
+file_opus(F,O) :- file(F), file_prop(F,'SCT',_,O).
+
+rdf(\kernfile(F), \trefcode(C), literal(Value)) <==
+   call_with_mode(browse,file_prop(F,C,sec,Value)).
+
+rdf(\kernfile(F), \refcode(C), literal(Value)) <==
+   call_with_mode(browse,file_prop(F,C,pri,Value)).
+
+rdf(\kernfile(F), hum:directory, literal(Dir1)) <==
+   file(F),
+   file_directory_name(F,Dir),
+   atom_concat('/',Dir1,Dir).
+
+file(F) ==> 
+   % rdf(\kernfile(F), hum:language, hum:language/humdrum),
+   rdf(\kernfile(F), rdf:type, hum:'File'). 
+
+file_opus(_,O) ==>
+   rdf(\work(O), rdf:type, hum:'Work'), 
+   rdf(\work(O), hum:opus, literal(O)). 
+
+% file_opus(F,O) ==>
+%    rdf(\kernfile(F), hum:encodes, \work(O)).
+
+
+% rdf(\work(O), dc:title, literal(Title)) <== 
+%    file_opus(F,O), 
+%    (file_has(F,'OTL',Title); file_has(F,'OTP',Title)).
+
+% rdf(\work(O), dc:title, literal(lang(Lang,Title))) <== 
+%    file_opus(F,O), 
+%    file_has(F,'OTL',Title), 
+%    file_has(F,'TXO',Lang).
+
+% rdf(\work(O), hum:partOf, humdb:parent_work/enc(P)) <==
+%    file_opus(F,O),
+%    (file_has(F,'OPT',P); file_has(F,'OPR',P)).
+
+% rdf(\work(O), hum:composer, humdb:agent/enc(C)) <==
+%    file_opus(F,O), file_has(F,'COM',C).
+
+% rdf(\work(O), hum:number, literal(Num)) <== 
+%    file_opus(F,O), file_has(F,'ONM',Num).
+
+% ----- mappings using composers/1 --------
+
+% rdf(humdb:agent/enc(C), foaf:name, literal(C)),
+% rdf(humdb:agent/enc(C), rdf:type, mo:'MusicArtist') <== 
+%    composers(Composers),
+%    member(C,Composers).
+
+% ----- mappings using parent_works/1 --------
+
+% rdf(humdb:parent_work/enc(P), rdf:type, hum:'Work'),
+% rdf(humdb:parent_work/enc(P), dc:title, literal(P)) <==
+%    parent_works(Works),
+%    member(P,Works).
+
+
+has_stripped(Recs,Prop,Status,Literal) :-
+   member(ref(Prop,Lang,RawValue),Recs),
+   split_string(RawValue,""," ",[String]),
+   String\="", atom_string(Value,String),
+   refcode_literal(Lang,Value,Status,Literal).
+
+refcode_literal(def,    Val, pri, Val).
+refcode_literal(P-Lang, Val, P,  lang(L,Val)) :- lang(Lang,L).
+
+:- type prop ---> prop(atom,atom,ground).
+:- volatile_memo file_props(+file:atomic,-props:list(prop)).
+
+file_props(File,Props) :-
+   setting(kern_root,Root0),
+   expand_file_name(Root0,[Root]),
+   string_concat(Root,File,Abs),
+   % !!! FIXME: will barf if Root contains funny characters
+   format(string(Cmd),"grep '^!!!' \"~w\"",[Abs]),
+   hum_read(pipe(Cmd),utf8,Recs),
+   setof(prop(Prop,Status,Lit),has_stripped(Recs,Prop,Status,Lit),Props).
+
+
+:- volatile_memo parent_works(-works:list(ground)).
+parent_works(Works) :-
+   writeln('% Compiling list of parent works...'),
+   setof(P, F^O^(file_opus(F,O),file_prop(F,'OPR',_,P)), Works).
+
+:- volatile_memo composers(-composers:list(atom)).
+
+%% composers(-Composers:list(atom)) is det.
+%  Compiles a list of composer names referenced in the current
+%  Humdrum file property database file_props/2.
+composers(Composers) :-
+   writeln('% Compiling list of composers...'),
+   findall(C, call_with_mode(browse,file_prop(_,'COM',_,C)), CList),
+   sort(CList,Composers).
+
+% rdf(URI,rdf:type,mo:'MusicArtist') <==
+%    composers(Comps),
+%    member(C,Comps),
+%    agent_uri(composer,C,URI).
+
+% rdf(URI,hum:name,literal(Name)) <==
+%    agent_uri(composer,Name,URI).
+
+% rdf(\kernfile(F), hum:composer, literal(Name)) <==
+%    call_with_mode(browse,file_prop(F,'COM',pri,Name)),
+   % agent_uri(composer,Name,URI).
+
+
+file_work_terms(File) -->
+   if(file_prop(File,'OTL',_,Title), [Title]),
+   if(file_prop(File,'OPR',_,Parent), [Parent]),
+   if(file_prop(File,'OPN',_,Opus), [Opus]),
+   if(file_prop(File,'SCT',_,Cat), [Cat]).
+
+
+file_prop(File,Prop,Status,Lit) :-
+   file_props(File,Props),
+   member(prop(Prop,Status,Lit),Props).
+
+
+hum_uri_path(URI,Path) :-
+   atom_concat('kern:',Rel,URI),
+   setting(kern_root,Root),
+   expand_file_name(Root,[Root1]),
+   string_concat(Root1,Rel,Path).
+
+
+%% humdrum_import(+Path:atom) is det.
+%
+%  Searches for files in the directory tree beneath
+%  =|<kern_root>/Path|=, where =|<kern_root"|= is the current
+%  value of the setting =|humdrum_p2r:kern_root|=. Path can
+%  be any relative path. Files are added to memoised property
+%  database predicate file_props/2.
+humdrum_import(Path) :-
+   setting(kern_root,Root0),
+   expand_file_name(Root0,[Root]),
+   with_status_line(
+      forall( (  kern_file(under(Root/Path),File), 
+                 atom_concat(Root,Rel,File),
+                 memo(file_props(Rel,_),_-ok)),
+              (  status(" Imported ~s",[Rel]), 
+                 id_assert(file(Rel))) )).
+
+:- volatile_memo scan_library_dir(+ground,-float).
+scan_library_dir(Dir,T):- humdrum_import(Dir), get_time(T).
+
+
+:- public import/0, import/1.
+import :- 
+   setting(kern_subdirs,Dirs), 
+   import(Dirs).
+import(Dirs) :- 
+   maplist(scan_library_dir,Dirs,_),
+   assert_all(humdrum_p2r).
+
+:- volatile_memo humfile_status(+string,-ground).
+humfile_status(Path,Status) :-
+   status(Path,[]),
+   catch( ( with_kern_module(Path,utf8,_,true) -> Status=ok
+          ; Status=fail),
+          Ex, Status=ex(Ex)).
+
+   
+humdrum_check :-
+    with_status_line( 
+      forall( (rdf_db:rdf(X,rdf:type,hum:'File'), hum_uri_path(X,Path)), 
+              (   humfile_status(Path,Status),
+                  (  Status=ok -> true
+                  ;  Status=fail -> format('\nFailed on: ~w\n',[Path])
+                  ;  Status=ex(Ex) -> format('\nException on: ~w\n',[Path]),
+                                      print_message(error,Ex)
+                  )
+               ))).
+
+kern_file(Findspec,File) :-
+   find_files(Findspec,File),
+   extension_in(File,[krn,kern,'KRN','KERN']).
+
+id_assert(Fact) :- call(Fact) -> true; assert(Fact).
+
+lang('ENG',en).
+lang('EN',en).
+lang('FRA',fr).
+lang('FRE',fr).
+lang('FR',fr).
+lang('DE',de).
+lang('DEU',de).
+lang('GER',de).
+lang('ITA',it).
+lang('IT',it).
+lang('NO',no).
+lang('NOR',no).
+lang('LAT',la).
+lang('LA',la).
+lang('RU',ru).
+lang('RUS',ru).