:- module(ascii_rewrite,
	  [convert_ascii/0,
	   convert_quarter/2
	  ]).

:- use_module(library(csvrdf)).
:- use_module(library(semweb/rdf_db)).
:- use_module(library(semweb/rdf_turtle_write)).
:- use_module(library(xmlrdf/rdf_rewrite)).
:- use_module(library(xmlrdf/rdf_convert_util)).

:- rdf_meta
	code_to_uri(+,+,r).

:- dynamic
	table_map/3.

user:file_search_path(ascii, '../fda_data/ascii').
user:file_search_path(ascii_rdf, '../rdf/aers_ascii').

filename('Report', 'DEMO').
filename('Drug', 'DRUG').
filename('Reaction', 'REAC').
filename('Outcome', 'OUTC').
filename('Source', 'RPSR').
filename('Therapy', 'THER').
filename('Indication', 'INDI').

:- debug(csvrdf).


quarter('04Q1').
quarter('04Q2').
quarter('04Q3').
quarter('04Q4').
quarter('05Q1').
quarter('05Q2').
quarter('05Q3').
quarter('05Q4').
quarter('06Q1').
quarter('06Q2').
quarter('06Q3').
quarter('06Q4').
quarter('07Q1').
quarter('07Q2').
quarter('07Q3').
quarter('07Q4').
quarter('08Q1').
quarter('08Q2').
quarter('08Q3').
quarter('08Q4').
quarter('09Q1').
quarter('09Q2').
quarter('09Q3').
quarter('09Q4').
quarter('10Q1').
quarter('10Q2').
quarter('10Q3').
quarter('10Q4').
quarter('11Q1').
quarter('11Q2').
quarter('11Q3').
quarter('11Q4').
quarter('12Q1').
quarter('12Q2').

convert_ascii :-
	(   quarter(Q),
	    atom_concat(aers, Q, Graph),
	    atom_concat(Graph, '.ttl', RDF_FileName),
	    absolute_file_name(ascii_rdf(RDF_FileName), RDF_File),
	    convert_quarter(Q, Graph),
	    debug(csvrdf, 'save ~w to ~w', [Graph, RDF_File]),
	    rdf_save_turtle(RDF_File, [graph(Graph)]),
	    debug(csvrdf, 'remove ~w', [Graph]),
	    rdf_retractall(_,_,_,Graph),
	    fail
	;   true
	).

convert_quarter(Quarter, Graph) :-
	ascii_to_rdf(Quarter, Graph),
	rewrite_graph(Graph).

ascii_to_rdf(Quarter, Graph) :-
	rdf_current_ns(aers, Prefix),
	FileExt = '.TXT',
	(   filename(Class, FilePrefix),
	    concat_atom([FilePrefix,Quarter,FileExt], FileName),
	    absolute_file_name(ascii(FileName), File),
	    debug(csvrdf, 'convert ~w to ~w', [FileName, Graph]),
	    load_csv_as_rdf(File, [prefix(Prefix),
				   class(Class),
				   graph(Graph),
				   separator(0'$),
				   match_arity(false)
				   ]),
	    fail
	;   true
	).

rewrite_graph(Graph) :-
	debug(csvrdf, 'rewrite ~w', [Graph]),
	rdf_rewrite(Graph).



% report

report_uri @@
{S, rdf:type, aers:'Report'},
{S, aers:isr, literal(Id)}\
{S}
<=>
id_to_uri(Id, aers_r, URI),
{URI}.

report_properties @@
{S, rdf:type, aers:'Report'}\
{S, aers:image, _}?,
{S, aers:i_f_cod, literal(Follow)}?,
{S, aers:rept_cod, literal(Type)}?,
{S, aers:occp_cod, literal(Reporter)}?
<=>
code_to_uri(followup, Follow, Follow_URI),
code_to_uri(type, Type, Type_URI),
code_to_uri(reporter, Reporter, Reporter_URI),
{S, aers:followup_status, Follow_URI},
{S, aers:report_type, Type_URI},
{S, aers:reporter_type, Reporter_URI}.


% patient

patient @@
{S, rdf:type, aers:'Report'}\
{S, aers:gndr_cod, literal(GND)}?,
{S, aers:age, A}?,
{S, aers:age_cod, literal(AC)}?,
{S, aers:wt, W}?,
{S, aers:wt_cod, literal(WC)}?,
{S, aers:death_dt, D}?
<=>
at_least_one_given([GND,A,W,D]),
code_to_uri(gender, GND, Gender),
code_to_uri(age, AC, A_URI),
code_to_uri(weight, WC, W_URI),
{S, aers:patient,
 bnode([ aers:gender = Gender,
	 aers:age = A,
	 aers:age_type = A_URI,
	 aers:weight = W,
	 aers:weight_type = W_URI,
	 aers:death_dt = D
       ])
}.


% drug
%
% aers:drug_seq is replaced by drug_id so that we can quickly find drugs
% later on

drug_uri @@
{S, rdf:type, aers:'Drug'},
{S, aers:isr, literal(ISR)},
{S, aers:drug_seq, literal(Drug_Seq)}\
{S}
<=>
id_to_uri(ISR, aers_r, R),
id_to_uri(Drug_Seq, aers_d, D),
{D},
{R, aers:drug, D}.

drug_properties @@
{S, rdf:type, aers:'Drug'}\
{S, aers:isr, _},
{S, aers:role_cod, literal(Role)}?,
{S, aers:val_vbm, literal(Type)}?,
{S, aers:dechal, literal(DChal)}?,
{S, aers:rechal, literal(RChal)}?
<=>
code_to_uri(role, Role, Role_URI),
code_to_uri(name_type, Type, Type_URI),
code_to_uri(chal, DChal, DChal_URI),
code_to_uri(chal, RChal, RChal_URI),
{S, aers:role, Role_URI},
{S, aers:name_type, Type_URI},
{S, aers:dechal, DChal_URI},
{S, aers:rechal, RChal_URI}.


% reaction

reaction @@
{S, rdf:type, aers:'Reaction'},
{S, aers:isr, literal(ISR)},
{S, aers:pt, Term}
<=>
id_to_uri(ISR, aers_r, R),
{R, aers:reaction, Term}.


% outcome

outcome @@
{S, rdf:type, aers:'Outcome'},
{S, aers:isr, literal(ISR)},
{S, aers:outc_cod, literal(Code)}
<=>
id_to_uri(ISR, aers_r, R),
code_to_uri(outcome, Code, URI),
{R, aers:outcome, URI}.


% source

source @@
{S, rdf:type, aers:'Source'},
{S, aers:isr, literal(ISR)},
{S, aers:rpsr_cod, literal(Code)}
<=>
id_to_uri(ISR, aers_r, R),
code_to_uri(source, Code, URI),
{R, aers:source, URI}.


% Therapy

therapy @@
{S, rdf:type, aers:'Therapy'},
{S, aers:drug_seq, literal(DrugSeq)},
{S, aers:isr, _}
<=>
id_to_uri(DrugSeq, aers_d, D),
{D, aers:therapy, S}.


% Indications

indication @@
{S, rdf:type, aers:'Indication'},
{S, aers:drug_seq, literal(DrugSeq)},
{S, aers:isr, _},
{S, aers:indi_pt, Term}
<=>
id_to_uri(DrugSeq, aers_d, D),
{D, aers:indication, Term}.


code_to_uri(_, V, V) :- var(V), !.

code_to_uri(followup, 'I', aers:'report/initial') :- !.
code_to_uri(followup, 'F', aers:'report/followup'):- !.

code_to_uri(type, 'EXP', aers:'report/expedited') :- !.
code_to_uri(type, 'PER', aers:'report/periodic') :- !.
code_to_uri(type, 'DIR', aers:'report/direct') :- !.

code_to_uri(reporter, 'MD', aers:'reporter/physician') :- !.
code_to_uri(reporter, 'PH', aers:'reporter/pharmacist') :- !.
code_to_uri(reporter, 'OT', aers:'reporter/health_professional') :- !.
code_to_uri(reporter, 'LW', aers:'reporter/lawyer') :- !.
code_to_uri(reporter, 'CN', aers:'reporter/consumer') :- !.

code_to_uri(gender, 'UNK', aers:'unknown') :- !.
code_to_uri(gender, 'M',   aers:'gender/male') :- !.
code_to_uri(gender, 'F',   aers:'gender/female') :- !.
code_to_uri(gender, 'NS',  aers:'not_specified') :- !.

code_to_uri(weight, 'KG',  aers:'weight/kg') :- !.
code_to_uri(weight, 'LBS', aers:'weight/lbs') :- !.
code_to_uri(weight, 'GMS', aers:'weight/gms') :- !.

code_to_uri(age, 'Dec',	aers:'duration/decade') :- !.
code_to_uri(age, 'YR',  aers:'duration/year') :- !.
code_to_uri(age, 'MON', aers:'duration/month') :- !.
code_to_uri(age, 'WK',  aers:'duration/week') :- !.
code_to_uri(age, 'DY',  aers:'duration/day') :- !.
code_to_uri(age, 'HR',  aers:'duration/hour') :- !.

code_to_uri(role, 'PS', aers:'drug/primary_suspect') :- !.
code_to_uri(role, 'SS',	aers:'drug/secondary_suspect') :- !.
code_to_uri(role, 'C',  aers:'drug/concomitant') :- !.
code_to_uri(role, 'I',  aers:'drug/interacting') :- !.

code_to_uri(name_type, '1', aers:'drug/tradename') :- !.
code_to_uri(name_type, '2', aers:'drug/verbatim') :- !.

code_to_uri(chal, 'Y', aers:'drug/positive') :- !.
code_to_uri(chal, 'N', aers:'drug/negative') :- !.
code_to_uri(chal, 'U', aers:'drug/unknown') :- !.
code_to_uri(chal, 'D', aers:'drug/does_not_apply') :- !.

code_to_uri(outcome, 'DE', aers:'outcome/death') :- !.
code_to_uri(outcome, 'LT', aers:'outcome/life_threatening') :- !.
code_to_uri(outcome, 'HO', aers:'outcome/hospitalization') :- !.
code_to_uri(outcome, 'DS', aers:'outcome/disability') :- !.
code_to_uri(outcome, 'CA', aers:'outcome/congenital_anomaly') :- !.
code_to_uri(outcome, 'RI', aers:'outcome/required_intervention') :- !.
code_to_uri(outcome, 'OT', aers:'outcome/other') :- !.

code_to_uri(source, 'FGN', aers:'source/foreign') :- !.
code_to_uri(source, 'SDY', aers:'source/study') :- !.
code_to_uri(source, 'LIT', aers:'source/literature') :- !.
code_to_uri(source, 'CSM', aers:'source/consumer') :- !.
code_to_uri(source, 'HP',  aers:'source/health_professional') :- !.
code_to_uri(source, 'UF',  aers:'source/user_facility') :- !.
code_to_uri(source, 'CR',  aers:'source/company_representative') :- !.
code_to_uri(source, 'DT',  aers:'source/distributor') :- !.
code_to_uri(source, 'OTH', aers:'other') :- !.

code_to_uri(_, Code, literal(Code)).

id_to_uri(Id, NS, URI) :-
	rdf_current_ns(NS, Prefix),
	atom_concat(Prefix, Id, URI).

at_least_one_given(Values) :-
	member(V, Values),
	ground(V),
	!.