1:- module(io_utils,
    2          [
    3           write_result/1,
    4           write_result/2
    5           ]).    6
    7:- use_module(library(semweb/rdf11)).    8:- use_module(library(sparqlprog/labelutils)).    9
   10is_pass_thru(inject_labels).
   11
   12
   13write_result(Term) :-
   14        write_result(Term,[]).
   15write_result(Term,Opts) :-
   16        option(format(Fmt),Opts),
   17        Fmt == prolog,
   18        !,
   19        format('~q.~n',[Term]).
   20        
   21write_result(Term,Opts) :-
   22        opt_if(dynlabel(true),Opts,Opts2),
   23        !,
   24        row_labelify(Term,Term2),
   25        write_result(Term2,Opts2).
   26write_result(Term,Opts) :-
   27        member(format(Fmt),Opts),
   28        csv_format_separator(Fmt,Sep),
   29        term_saferow(Term,Term2),
   30        debug(row,'ROW: ~q',[Term2]),
   31        csv_write_stream(current_output, [Term2], [separator(Sep)]),
   32        !.
   33write_result(Term,_Opts) :-
   34        write_canonical(Term),
   35        writeln('.').
   36
   37atomize(T,A) :-
   38        sformat(A,'~w',[T]).
   39
   40% translate a prolog term into an object that is suitable to send to csv_write_stream
   41%  - translate literals to atoms
   42%  - flatten lists
   43%  - translate args in a compound term
   44
   45term_saferow(T,T3) :-
   46        term_saferow1(T,T2),
   47        % flatten to one leve;
   48        T2 =.. [P|Args],
   49        maplist(atomize,Args,Args2),
   50        T3 =.. [P|Args2].
   51
   52
   53term_saferow1(T,'?') :- var(T),!.
   54term_saferow1(T^^_,A) :- string(T),!, atom_string(A,T).
   55term_saferow1(T@_, A) :- string(T),!, atom_string(A,T).
   56term_saferow1(T@_, A) :- string(T),!, atom_string(A,T).
   57term_saferow1(literal(type(_,A)), A) :- !.
   58term_saferow1(literal(lang(_,A)), A) :- !.
   59term_saferow1(literal(A), A) :- !.
   60term_saferow1(L,A) :- is_list(L), !, maplist(term_saferow1,L,L2),maplist(atomize,L2,L3),concat_atom(L3,',',A).
   61term_saferow1(T,T2) :-
   62        T =.. [P|Args],
   63        Args = [_|_],
   64        !,
   65        maplist(term_saferow1,Args,Args2),
   66        T2 =.. [P|Args2].
   67term_saferow1(T,T2) :-
   68        rdf_global_id(Pre:Id,T),
   69        !,
   70        concat_atom([Pre,Id],:,T2).
   71term_saferow1(T,T).
   72
   73
   74csv_format_separator(csv,0',).
   75csv_format_separator(tsv,0'\t).
   76csv_format_separator(psv,0'|)