35
36:- module(rdf_write,
37 [ rdf_write_xml/2 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]). 48
49
69
70
71 74
78
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 90
95
(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').
129
133
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).
149
154
155used_namespaces(Triples, NSList) :-
156 decl_used_predicate_ns(Triples),
157 resources(Triples, Resources),
158 empty_assoc(A0),
159 put_assoc(rdf, A0, *, A1), 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).
175
179
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 [].
200
205
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, -)) 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 266
272
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 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).
383
389
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
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
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
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), 452 atom_length(Text, Len),
453 Len < 60,
454 \+ is_bag_li_predicate(P).
455
456
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).
465
467
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, _) :- 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, _) :- 543 number(Value),
544 !,
545 writeq(Out, Value). 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 ).
579
585
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).
591
596
597is_bag_li_predicate(Pred) :-
598 atom_concat('_:', AN, Pred),
599 catch(atom_number(AN, N), _, true), integer(N), N >= 0,
600 !.
601
602
607
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).
621
622
627
628rdf_write_id(Out, NS:Local) :-
629 !,
630 format(Out, '~w:~w', [NS, Local]).
631rdf_write_id(Out, Atom) :-
632 write(Out, Atom).
633
634
636
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).
644
645
657
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 681
682ns(Id, Full) :-
683 rdf_db:ns(Id, Full)