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

commiting public release

/* 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).