1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2010-2020, University of Amsterdam 7 CWI, Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(rdf_write, 37 [ rdf_write_xml/2 % +Stream, +Triples 38 ]). 39:- autoload(library(assoc), 40 [empty_assoc/1,put_assoc/4,assoc_to_keys/2,get_assoc/3]). 41:- autoload(library(debug),[assertion/1]). 42:- autoload(library(lists),[member/2,append/3,select/3]). 43:- autoload(library(sgml), 44 [xml_quote_attribute/3, xml_name/1, xml_quote_cdata/3, xml_is_dom/1]). 45:- autoload(library(sgml_write),[xml_write/3]). 46:- autoload(library(semweb/rdf_db), 47 [rdf_global_id/2, rdf_register_ns/2, rdf_is_bnode/1, rdf_equal/2]).
71 /******************************* 72 * WRITE RDFXML * 73 *******************************/
79rdf_write_xml(Out, Triples) :- 80 sort(Triples, Unique), 81 rdf_write_header(Out, Unique), 82 node_id_map(Unique, AnonIDs), 83 rdf_write_triples(Unique, AnonIDs, Out), 84 rdf_write_footer(Out). 85 86 87 /******************************* 88 * HEADER/FOOTER * 89 *******************************/
96rdf_write_header(Out, Triples) :- 97 xml_encoding(Out, Enc, Encoding), 98 format(Out, '<?xml version=\'1.0\' encoding=\'~w\'?>~n', [Encoding]), 99 format(Out, '<!DOCTYPE rdf:RDF [', []), 100 used_namespaces(Triples, NSList), 101 ( member(Id, NSList), 102 ns(Id, NS), 103 xml_quote_attribute(NS, NSText0, Enc), 104 xml_escape_parameter_entity(NSText0, NSText), 105 format(Out, '~N <!ENTITY ~w \'~w\'>', [Id, NSText]), 106 fail 107 ; true 108 ), 109 format(Out, '~N]>~n~n', []), 110 format(Out, '<rdf:RDF', []), 111 ( member(Id, NSList), 112 format(Out, '~N xmlns:~w="&~w;"~n', [Id, Id]), 113 fail 114 ; true 115 ), 116 format(Out, '>~n', []). 117 118 119xml_encoding(Out, Enc, Encoding) :- 120 stream_property(Out, encoding(Enc)), 121 ( xml_encoding_name(Enc, Encoding) 122 -> true 123 ; throw(error(domain_error(rdf_encoding, Enc), _)) 124 ). 125 126xml_encoding_name(ascii, 'US-ASCII'). 127xml_encoding_name(iso_latin_1, 'ISO-8859-1'). 128xml_encoding_name(utf8, 'UTF-8').
134xml_escape_parameter_entity(In, Out) :- 135 sub_atom(In, _, _, _, '%'), 136 !, 137 atom_codes(In, Codes), 138 phrase(escape_parent(Codes), OutCodes), 139 atom_codes(Out, OutCodes). 140xml_escape_parameter_entity(In, In). 141 142escape_parent([]) --> []. 143escape_parent([H|T]) --> 144 ( { H == 37 } 145 -> "%" 146 ; [H] 147 ), 148 escape_parent(T).
155used_namespaces(Triples, NSList) :- 156 decl_used_predicate_ns(Triples), 157 resources(Triples, Resources), 158 empty_assoc(A0), 159 put_assoc(rdf, A0, *, A1), % needed for rdf:RDF 160 res_used_namespaces(Resources, _NoNS, A1, A), 161 assoc_to_keys(A, NSList). 162 163 164res_used_namespaces([], [], A, A). 165res_used_namespaces([Resource|T], NoNS, A0, A) :- 166 ns(NS, Full), 167 Full \== '', 168 atom_concat(Full, Local, Resource), 169 xml_name(Local), 170 !, 171 put_assoc(NS, A0, *, A1), 172 res_used_namespaces(T, NoNS, A1, A). 173res_used_namespaces([R|T0], [R|T], A0, A) :- 174 res_used_namespaces(T0, T, A0, A).
180resources(Triples, Resources) :- 181 phrase(resources(Triples), Raw), 182 sort(Raw, Resources). 183 184resources([]) --> 185 []. 186resources([rdf(S,P,O)|T]) --> 187 [S,P], 188 object_resources(O), 189 resources(T). 190 191object_resources(Atom) --> 192 { atom(Atom) }, 193 !, 194 [ Atom ]. 195object_resources(literal(type(Type, _))) --> 196 !, 197 [ Type ]. 198object_resources(_) --> 199 [].
206:- thread_local 207 predicate_ns/2. 208 209decl_used_predicate_ns(Triples) :- 210 retractall(predicate_ns(_,_)), 211 ( member(rdf(_,P,_), Triples), 212 decl_predicate_ns(P), 213 fail 214 ; true 215 ). 216 217decl_predicate_ns(Pred) :- 218 predicate_ns(Pred, _), 219 !. 220decl_predicate_ns(Pred) :- 221 rdf_global_id(NS:Local, Pred), 222 xml_name(Local), 223 !, 224 assert(predicate_ns(Pred, NS)). 225decl_predicate_ns(Pred) :- 226 is_bag_li_predicate(Pred), 227 !. 228decl_predicate_ns(Pred) :- 229 atom_codes(Pred, Codes), 230 append(NSCodes, LocalCodes, Codes), 231 xml_codes(LocalCodes), 232 !, 233 ( NSCodes \== [] 234 -> atom_codes(NS, NSCodes), 235 ( ns(Id, NS) 236 -> assert(predicate_ns(Pred, Id)) 237 ; between(1, infinite, N), 238 atom_concat(ns, N, Id), 239 \+ ns(Id, _) 240 -> rdf_register_ns(Id, NS), 241 print_message(informational, 242 rdf(using_namespace(Id, NS))) 243 ), 244 assert(predicate_ns(Pred, Id)) 245 ; assert(predicate_ns(Pred, -)) % no namespace used 246 ). 247 248xml_codes([]). 249xml_codes([H|T]) :- 250 xml_code(H), 251 xml_codes(T). 252 253xml_code(X) :- 254 code_type(X, csym), 255 !. 256xml_code(0'-). % ' 257 258 (Out) :- 260 format(Out, '</rdf:RDF>~n', []). 261 262 263 /******************************* 264 * ANONYMOUS IDS * 265 *******************************/
273node_id_map(Triples, IdMap) :- 274 anonymous_objects(Triples, Objs), 275 msort(Objs, Sorted), 276 empty_assoc(IdMap0), 277 nodeid_map(Sorted, 0, IdMap0, IdMap). 278 279anonymous_objects([], []). 280anonymous_objects([rdf(_,_,O)|T0], Anon) :- 281 rdf_is_bnode(O), 282 !, 283 Anon = [O|T], 284 anonymous_objects(T0, T). 285anonymous_objects([_|T0], T) :- 286 anonymous_objects(T0, T). 287 288nodeid_map([], _, Map, Map). 289nodeid_map([H,H|T0], Id, Map0, Map) :- 290 !, 291 remove_leading(H, T0, T), 292 atom_concat(bn, Id, NodeId), 293 put_assoc(H, Map0, NodeId, Map1), 294 Id2 is Id + 1, 295 nodeid_map(T, Id2, Map1, Map). 296nodeid_map([_|T], Id, Map0, Map) :- 297 nodeid_map(T, Id, Map0, Map). 298 299remove_leading(H, [H|T0], T) :- 300 !, 301 remove_leading(H, T0, T). 302remove_leading(_, T, T). 303 304 305 /******************************* 306 * TRIPLES * 307 *******************************/ 308 309rdf_write_triples(Triples, NodeIDs, Out) :- 310 rdf_write_triples(Triples, NodeIDs, Out, [], Anon), 311 rdf_write_anon(Anon, NodeIDs, Out, Anon). 312 313rdf_write_triples([], _, _, Anon, Anon). 314rdf_write_triples([H|T0], NodeIDs, Out, Anon0, Anon) :- 315 arg(1, H, S), 316 subject_triples(S, [H|T0], T, OnSubject), 317 ( rdf_is_bnode(S) 318 -> rdf_write_triples(T, NodeIDs, Out, [anon(S,_,OnSubject)|Anon0], Anon) 319 ; rdf_write_subject(OnSubject, S, NodeIDs, Out, Anon0), 320 rdf_write_triples(T, NodeIDs, Out, Anon0, Anon) 321 ). 322 323subject_triples(S, [H|T0], T, [H|M]) :- 324 arg(1, H, S), 325 !, 326 subject_triples(S, T0, T, M). 327subject_triples(_, T, T, []). 328 329 330rdf_write_anon([], _, _, _). 331rdf_write_anon([anon(Subject, Done, Triples)|T], NodeIDs, Out, Anon) :- 332 Done \== true, 333 !, 334 Done = true, 335 rdf_write_subject(Triples, Subject, NodeIDs, Out, Anon), 336 rdf_write_anon(T, NodeIDs, Out, Anon). 337rdf_write_anon([_|T], NodeIDs, Out, Anon) :- 338 rdf_write_anon(T, NodeIDs, Out, Anon). 339 340rdf_write_subject(Triples, Subject, NodeIDs, Out, Anon) :- 341 rdf_write_subject(Triples, Out, Subject, NodeIDs, -, 0, Anon), 342 !, 343 format(Out, '~n', []). 344rdf_write_subject(_, Subject, _, _, _) :- 345 throw(error(rdf_save_failed(Subject), 'Internal error')). 346 347rdf_write_subject(Triples, Out, Subject, NodeIDs, DefNS, Indent, Anon) :- 348 rdf_equal(rdf:type, RdfType), 349 select(rdf(_, RdfType,Type), Triples, Triples1), 350 \+ rdf_is_bnode(Type), 351 rdf_id(Type, DefNS, TypeId), 352 xml_is_name(TypeId), 353 !, 354 format(Out, '~*|<', [Indent]), 355 rdf_write_id(Out, TypeId), 356 save_about(Out, Subject, NodeIDs), 357 save_attributes(Triples1, DefNS, Out, NodeIDs, TypeId, Indent, Anon). 358rdf_write_subject(Triples, Out, Subject, NodeIDs, _DefNS, Indent, Anon) :- 359 format(Out, '~*|<rdf:Description', [Indent]), 360 save_about(Out, Subject, NodeIDs), 361 save_attributes(Triples, rdf, Out, NodeIDs, rdf:'Description', Indent, Anon). 362 363xml_is_name(_NS:Atom) :- 364 !, 365 xml_name(Atom). 366xml_is_name(Atom) :- 367 xml_name(Atom). 368 369save_about(Out, Subject, NodeIDs) :- 370 rdf_is_bnode(Subject), 371 !, 372 ( get_assoc(Subject, NodeIDs, NodeID) 373 -> format(Out,' rdf:nodeID="~w"', [NodeID]) 374 ; true 375 ). 376save_about(Out, Subject, _) :- 377 stream_property(Out, encoding(Encoding)), 378 rdf_value(Subject, QSubject, Encoding), 379 format(Out, ' rdf:about="~w"', [QSubject]), 380 !. 381save_about(_, _, _) :- 382 assertion(fail).
390save_attributes(Triples, DefNS, Out, NodeIDs, Element, Indent, Anon) :- 391 split_attributes(Triples, InTag, InBody), 392 SubIndent is Indent + 2, 393 save_attributes2(InTag, DefNS, tag, Out, NodeIDs, SubIndent, Anon), 394 ( InBody == [] 395 -> format(Out, '/>~n', []) 396 ; format(Out, '>~n', []), 397 save_attributes2(InBody, _, body, Out, NodeIDs, SubIndent, Anon), 398 format(Out, '~N~*|</~w>~n', [Indent, Element]) 399 ). 400 401% split_attributes(+Triples, -HeadAttrs, -BodyAttr) 402% 403% Split attribute (Name=Value) list into attributes for the head 404% and body. Attributes can only be in the head if they are literal 405% and appear only one time in the attribute list. 406 407split_attributes(Triples, HeadAttr, BodyAttr) :- 408 duplicate_attributes(Triples, Dupls, Singles), 409 simple_literal_attributes(Singles, HeadAttr, Rest), 410 append(Dupls, Rest, BodyAttr). 411 412% duplicate_attributes(+Attrs, -Duplicates, -Singles) 413% 414% Extract attributes that appear more than onces as we cannot 415% dublicate an attribute in the head according to the XML rules. 416 417duplicate_attributes([], [], []). 418duplicate_attributes([H|T], Dupls, Singles) :- 419 arg(2, H, Name), 420 named_attributes(Name, T, D, R), 421 D \== [], 422 append([H|D], Dupls2, Dupls), 423 !, 424 duplicate_attributes(R, Dupls2, Singles). 425duplicate_attributes([H|T], Dupls2, [H|Singles]) :- 426 duplicate_attributes(T, Dupls2, Singles). 427 428named_attributes(_, [], [], []) :- !. 429named_attributes(Name, [H|T], D, R) :- 430 ( arg(2, H, Name) 431 -> D = [H|DT], 432 named_attributes(Name, T, DT, R) 433 ; R = [H|RT], 434 named_attributes(Name, T, D, RT) 435 ). 436 437% simple_literal_attributes(+Attributes, -Inline, -Body) 438% 439% Split attributes for (literal) attributes to be used in the 440% begin-tag and ones that have to go into the body of the description. 441 442simple_literal_attributes([], [], []). 443simple_literal_attributes([H|TA], [H|TI], B) :- 444 in_tag_attribute(H), 445 !, 446 simple_literal_attributes(TA, TI, B). 447simple_literal_attributes([H|TA], I, [H|TB]) :- 448 simple_literal_attributes(TA, I, TB). 449 450in_tag_attribute(rdf(_,P,literal(Text))) :- 451 atom(Text), % may not have lang qualifier 452 atom_length(Text, Len), 453 Len < 60, 454 \+ is_bag_li_predicate(P). 455 456 457% save_attributes(+List, +DefNS, +TagOrBody, +Out, +NodeIDs, +Indent, +Anon) 458% 459% Save a list of attributes. 460 461save_attributes2([], _, _, _, _, _, _). 462save_attributes2([H|T], DefNS, Where, Out, NodeIDs, Indent, Anon) :- 463 save_attribute(Where, H, DefNS, Out, NodeIDs, Indent, Anon), 464 save_attributes2(T, DefNS, Where, Out, NodeIDs, Indent, Anon).
468save_attribute(tag, rdf(_, Name, literal(Value)), DefNS, Out, _, Indent, _Anon) :- 469 AttIndent is Indent + 2, 470 rdf_att_id(Name, DefNS, NameText), 471 stream_property(Out, encoding(Encoding)), 472 xml_quote_attribute(Value, QVal, Encoding), 473 format(Out, '~N~*|', [AttIndent]), 474 rdf_write_id(Out, NameText), 475 format(Out, '="~w"', [QVal]). 476save_attribute(body, rdf(_,Name,literal(Literal)), DefNS, Out, _, Indent, _) :- 477 !, 478 rdf_p_id(Name, DefNS, NameText), 479 format(Out, '~N~*|<', [Indent]), 480 rdf_write_id(Out, NameText), 481 ( Literal = lang(Lang, Value) 482 -> rdf_id(Lang, DefNS, LangText), 483 format(Out, ' xml:lang="~w">', [LangText]) 484 ; Literal = type(Type, Value) 485 -> ( rdf_equal(Type, rdf:'XMLLiteral') 486 -> write(Out, ' rdf:parseType="Literal">'), 487 Value = Literal 488 ; stream_property(Out, encoding(Encoding)), 489 rdf_value(Type, QVal, Encoding), 490 format(Out, ' rdf:datatype="~w">', [QVal]) 491 ) 492 ; atomic(Literal) 493 -> write(Out, '>'), 494 Value = Literal 495 ; write(Out, ' rdf:parseType="Literal">'), 496 Value = Literal 497 ), 498 save_attribute_value(Value, Out, Indent), 499 write(Out, '</'), rdf_write_id(Out, NameText), write(Out, '>'). 500save_attribute(body, rdf(_, Name, Value), DefNS, Out, NodeIDs, Indent, Anon) :- 501 rdf_is_bnode(Value), 502 !, 503 ( memberchk(anon(Value, Done, ValueTriples), Anon) 504 -> true 505 ; ValueTriples = [] 506 ), 507 rdf_p_id(Name, DefNS, NameText), 508 format(Out, '~N~*|<', [Indent]), 509 rdf_write_id(Out, NameText), 510 ( var(Done) 511 -> Done = true, 512 SubIndent is Indent + 2, 513 ( rdf_equal(RdfType, rdf:type), 514 rdf_equal(ListClass, rdf:'List'), 515 memberchk(rdf(_, RdfType, ListClass), ValueTriples) 516 -> format(Out, ' rdf:parseType="Collection">~n', []), 517 rdf_save_list(ValueTriples, Out, Value, NodeIDs, DefNS, SubIndent, Anon) 518 ; format(Out, '>~n', []), 519 rdf_write_subject(ValueTriples, Out, Value, NodeIDs, DefNS, SubIndent, Anon) 520 ), 521 format(Out, '~N~*|</', [Indent]), 522 rdf_write_id(Out, NameText), 523 format(Out, '>~n', []) 524 ; get_assoc(Value, NodeIDs, NodeID) 525 -> format(Out, ' rdf:nodeID="~w"/>', [NodeID]) 526 ; assertion(fail) 527 ). 528save_attribute(body, rdf(_, Name, Value), DefNS, Out, _, Indent, _Anon) :- 529 stream_property(Out, encoding(Encoding)), 530 rdf_value(Value, QVal, Encoding), 531 rdf_p_id(Name, DefNS, NameText), 532 format(Out, '~N~*|<', [Indent]), 533 rdf_write_id(Out, NameText), 534 format(Out, ' rdf:resource="~w"/>', [QVal]). 535 536save_attribute_value(Value, Out, _) :- % strings 537 atom(Value), 538 !, 539 stream_property(Out, encoding(Encoding)), 540 xml_quote_cdata(Value, QVal, Encoding), 541 write(Out, QVal). 542save_attribute_value(Value, Out, _) :- % numbers 543 number(Value), 544 !, 545 writeq(Out, Value). % quoted: preserve floats 546save_attribute_value(Value, Out, Indent) :- 547 xml_is_dom(Value), 548 !, 549 XMLIndent is Indent+2, 550 xml_write(Out, Value, 551 [ header(false), 552 indent(XMLIndent) 553 ]). 554save_attribute_value(Value, _Out, _) :- 555 throw(error(save_attribute_value(Value), _)). 556 557rdf_save_list(_, _, List, _, _, _, _) :- 558 rdf_equal(List, rdf:nil), 559 !. 560rdf_save_list(ListTriples, Out, List, NodeIDs, DefNS, Indent, Anon) :- 561 rdf_equal(RdfFirst, rdf:first), 562 memberchk(rdf(List, RdfFirst, First), ListTriples), 563 ( rdf_is_bnode(First), 564 memberchk(anon(First, true, FirstTriples), Anon) 565 -> nl(Out), 566 rdf_write_subject(FirstTriples, Out, First, NodeIDs, DefNS, Indent, Anon) 567 ; stream_property(Out, encoding(Encoding)), 568 rdf_value(First, QVal, Encoding), 569 format(Out, '~N~*|<rdf:Description about="~w"/>', 570 [Indent, QVal]) 571 ), 572 ( rdf_equal(RdfRest, rdf:rest), 573 memberchk(rdf(List, RdfRest, List2), ListTriples), 574 \+ rdf_equal(List2, rdf:nil), 575 memberchk(anon(List2, true, List2Triples), Anon) 576 -> rdf_save_list(List2Triples, Out, List2, NodeIDs, DefNS, Indent, Anon) 577 ; true 578 ).
586rdf_p_id(LI, _, 'rdf:li') :- 587 is_bag_li_predicate(LI), 588 !. 589rdf_p_id(Resource, DefNS, NSLocal) :- 590 rdf_id(Resource, DefNS, NSLocal).
597is_bag_li_predicate(Pred) :-
598 atom_concat('_:', AN, Pred),
599 catch(atom_number(AN, N), _, true), integer(N), N >= 0,
600 !.608rdf_id(Id, NS, NS:Local) :- 609 ns(NS, Full), 610 Full \== '', 611 atom_concat(Full, Local, Id), 612 xml_name(Local), 613 !. 614rdf_id(Id, _, NS:Local) :- 615 ns(NS, Full), 616 Full \== '', 617 atom_concat(Full, Local, Id), 618 xml_name(Local), 619 !. 620rdf_id(Id, _, Id).
628rdf_write_id(Out, NS:Local) :- 629 !, 630 format(Out, '~w:~w', [NS, Local]). 631rdf_write_id(Out, Atom) :- 632 write(Out, Atom).
637rdf_att_id(Id, _, NS:Local) :- 638 ns(NS, Full), 639 Full \== '', 640 atom_concat(Full, Local, Id), 641 xml_name(Local), 642 !. 643rdf_att_id(Id, _, Id).
NOTE: the to_be_described/1 trick ensures entity rewrite in resources that start with 'http://t-d-b.org?'. This is a of a hack to save the artchive data in the MultimediaN project. We should use a more general mechanism.
658rdf_value(V, Text, Encoding) :- 659 to_be_described(Prefix), 660 atom_concat(Prefix, V1, V), 661 ns(NS, Full), 662 atom_concat(Full, Local, V1), 663 !, 664 xml_quote_attribute(Local, QLocal, Encoding), 665 atomic_list_concat([Prefix, '&', NS, (';'), QLocal], Text). 666rdf_value(V, Text, Encoding) :- 667 ns(NS, Full), 668 atom_concat(Full, Local, V), 669 !, 670 xml_quote_attribute(Local, QLocal, Encoding), 671 atomic_list_concat(['&', NS, (';'), QLocal], Text). 672rdf_value(V, Q, Encoding) :- 673 xml_quote_attribute(V, Q, Encoding). 674 675to_be_described('http://t-d-b.org?'). 676 677 678 /******************************* 679 * UTIL * 680 *******************************/ 681 682ns(Id, Full) :- 683 rdf_db:ns(Id, Full)
Write RDF/XML from a list of triples
This module writes an RDF/XML document from a list of triples of the format
rdf(Subject, Predicate, Object). It is primarily intended for communicating computed RDF model fragments to external programs using RDF/XML.When used from the HTTP library, use the following code:
reply_graph(RDF) :- format('Content-type: application/rdf+xml; charset=UTF-8~n~n'), rdf_write_xml(current_output, RDF).