1:- encoding(utf8).
2:- module(
3 xsd,
4 [
5 xsd_date_time/3, 6 xsd_date_time_type/1, 7 xsd_encode_string//0, 8 xsd_numeric_type/1, 9 xsd_strict_subtype/2, 10 xsd_subtype/2 11 ]
12).
20:- use_module(library(dif)). 21:- use_module(library(error)). 22:- use_module(library(semweb/rdf11)). 23:- use_module(library(xsdp_types)). 24
25:- use_module(library(abnf)). 26:- use_module(library(dcg)). 27:- use_module(library(xml_ext)). 28
29:- rdf_meta
30 dt_to_xsd_date_time_(?, r, ?), xsd_date_time(?, r, -), xsd_date_time_to_dt_(?, r, ?), xsd_numeric_type(r), xsd_strict_subtype(r, r), xsd_subtype(r, r).
44xsd_date_time(RdfDateTime, DatatypeIri, XsdDateTime) :-
45 nonvar(RdfDateTime), !,
46 dt_to_xsd_date_time_(RdfDateTime, DatatypeIri, XsdDateTime).
47xsd_date_time(RdfDateTime, DatatypeIri, XsdDateTime) :-
48 nonvar(XsdDateTime), !,
49 xsd_date_time_to_dt_(XsdDateTime, DatatypeIri, RdfDateTime).
50xsd_date_time(RdfDateTime, _, XsdDateTime) :-
51 instantiation_error(args([RdfDateTime,XsdDateTime])).
52
53dt_to_xsd_date_time_(dt(Y,Mo,D,_,_,_,_), xsd:date, date(Y,Mo,D)) :- !.
54dt_to_xsd_date_time_(dt(Y,Mo,D,H,Mi,S1,_), xsd:dateTime, date_time(Y,Mo,D,H,Mi,S2)) :- !,
55 (nonvar(S1) -> S2 is float(S1) ; true).
56dt_to_xsd_date_time_(dt(_,_,D,_,_,_,_), xsd:gDay, D) :- !.
57dt_to_xsd_date_time_(dt(_,Mo,_,_,_,_,_), xsd:gMonth, Mo) :- !.
58dt_to_xsd_date_time_(dt(_,Mo,D,_,_,_,_), xsd:gMonthDay, month_day(Mo,D)) :- !.
59dt_to_xsd_date_time_(dt(Y,_,_,_,_,_,_), xsd:gYear, Y) :- !.
60dt_to_xsd_date_time_(dt(Y,Mo,_,_,_,_,_), xsd:gYearMonth, year_month(Y,Mo)) :- !.
61dt_to_xsd_date_time_(dt(_,_,_,H,Mi,S1,_), xsd:time, time(H,Mi,S2)) :-
62 (nonvar(S1) -> S2 is float(S1) ; true).
63
65xsd_date_time_to_dt_(date(Y,Mo,D), xsd:date, dt(Y,Mo,D,_,_,_,_)) :- !.
67xsd_date_time_to_dt_(date_time(Y,Mo,D,H,Mi,S1), xsd:dateTime, dt(Y,Mo,D,H,Mi,S2,_)) :- !,
68 S2 is rationalize(S1).
69xsd_date_time_to_dt_(date_time(Y,Mo,D,H,Mi,S1,TZ1), xsd:dateTime, dt(Y,Mo,D,H,Mi,S2,TZ2)) :- !,
70 S2 is rationalize(S1),
71 TZ2 is TZ1 / 60.
73xsd_date_time_to_dt_(D, xsd:gDay, dt(_,_,D,_,_,_,_)) :- !.
75xsd_date_time_to_dt_(Mo, xsd:gMonth, dt(_,Mo,_,_,_,_,_)) :- !.
77xsd_date_time_to_dt_(month_day(Mo,D), xsd:gMonthDay, dt(_,Mo,D,_,_,_,_)) :- !.
79xsd_date_time_to_dt_(Y, xsd:gYear, dt(Y,_,_,_,_,_,_)) :- !.
81xsd_date_time_to_dt_(year_month(Y,Mo), xsd:gYearMonth, dt(Y,Mo,_,_,_,_,_)) :- !.
83xsd_date_time_to_dt_(time(H,Mi,S1), xsd:time, dt(_,_,_,H,Mi,S2,_)) :-
84 S2 is rationalize(S1).
91xsd_date_time_type(DatatypeIri) :-
92 rdf11:xsd_date_time_type(DatatypeIri).
103xsd_encode_string, [Code] --> 'Char'(version(1,1), Code), !, xsd_encode_string.
105xsd_encode_string, uchar(Code) --> [Code], !, xsd_encode_string.
106xsd_encode_string --> "".
107
108uchar(N) -->
109 {
110 int_to_hex_weights(N, Weights),
111 length(Weights, Length)
112 },
113 ( {Length > 4}
114 -> "\\u", zero_padded(4, Weights)
115 ; "\\U", zero_padded(8, Weights)
116 ).
117
118int_to_hex_weights(0, []) :- !.
119int_to_hex_weights(N1, [H|T]) :-
120 H is N1 mod 16,
121 N2 is N1 // 16,
122 int_to_hex_weights(N2, T).
123
124zero_padded(N, []) --> !,
125 #(N, digit_weight(0)).
126zero_padded(N1, [H|T]) -->
127 digit_weight(H),
128 {N2 is N1 - 1},
129 zero_padded(N2, T).
136xsd_numeric_type(xsd:double).
137xsd_numeric_type(xsd:float).
138xsd_numeric_type(DatatypeIri) :-
139 xsd_subtype(DatatypeIri, xsd:decimal).
145xsd_strict_subtype(X, Y) :-
146 dif(X, Y),
147 xsd_subtype(X, Y).
153xsd_subtype(SubGlobal, SuperGlobal) :-
154 xsd_global_local_(SubGlobal, SubLocal),
155 xsd_global_local_(SuperGlobal, SuperLocal),
156 xsdp_subtype_of(SubLocal, SuperLocal),
157 xsd_global_local_(SubGlobal, SubLocal),
158 xsd_global_local_(SuperGlobal, SuperLocal).
159
160xsd_global_local_(Global, Local) :-
161 var(Global),
162 var(Local), !.
163xsd_global_local_(Global, Local) :-
164 rdf_global_id(xsd:Local, Global)
Support for XML Schema Datatypes (XSD)
*/