1:- encoding(utf8).
    2:- module(
    3  xsd,
    4  [
    5    xsd_date_time/3,       % ?RdfDateTime, ?DatatypeIri, ?XsdDateTime
    6    xsd_date_time_type/1,  % ?DatatypeIri
    7    xsd_encode_string//0,  % +String, -EncodedString
    8    xsd_numeric_type/1,    % ?DatatypeIri
    9    xsd_strict_subtype/2,  % ?Sub, ?Super
   10    xsd_subtype/2          % ?Sub, ?Super
   11  ]
   12).

Support for XML Schema Datatypes (XSD)

Compatibility
- XML Schema 1.1 Part 2 ― Datatypes

*/

   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).
 xsd_date_time(+RdfDateTime:compound, +DatatypeIri:atom, -XsdDateTime:compound) is det
xsd_date_time(-RdfDateTime:compound, ?DatatypeIri:atom, +XsdDateTime:compound) is det
   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
   64% xsd:date
   65xsd_date_time_to_dt_(date(Y,Mo,D), xsd:date, dt(Y,Mo,D,_,_,_,_)) :- !.
   66% xsd:dateTime
   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.
   72% xsd:gDay
   73xsd_date_time_to_dt_(D, xsd:gDay, dt(_,_,D,_,_,_,_)) :- !.
   74% xsd:gMonth
   75xsd_date_time_to_dt_(Mo, xsd:gMonth, dt(_,Mo,_,_,_,_,_)) :- !.
   76% xsd:gMonthDay
   77xsd_date_time_to_dt_(month_day(Mo,D), xsd:gMonthDay, dt(_,Mo,D,_,_,_,_)) :- !.
   78% xsd:gYear
   79xsd_date_time_to_dt_(Y, xsd:gYear, dt(Y,_,_,_,_,_,_)) :- !.
   80% xsd:gYearMonth
   81xsd_date_time_to_dt_(year_month(Y,Mo), xsd:gYearMonth, dt(Y,Mo,_,_,_,_,_)) :- !.
   82% xsd:time
   83xsd_date_time_to_dt_(time(H,Mi,S1), xsd:time, dt(_,_,_,H,Mi,S2,_)) :-
   84  S2 is rationalize(S1).
 xsd_date_time_type(+DatatypeIri:atom) is semidet
xsd_date_time_type(-DatatypeIri:atom) is multi
   91xsd_date_time_type(DatatypeIri) :-
   92  rdf11:xsd_date_time_type(DatatypeIri).
 xsd_encode_string//
Turtle 1.1 ECHAR (backslash escape sequences) are handled by turtle:turtle_write_quoted_string/2. This encoding predicate only takes care of restrictions that are specific to `xsd:string'.
  102% XML 1.1 Char
  103xsd_encode_string, [Code] --> 'Char'(version(1,1), Code), !, xsd_encode_string.
  104% Turtle 1.1 UCHAR
  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).
 xsd_numeric_type(+DatatypeIri:atom) is semidet
xsd_numeric_type(-DatatypeIri:atom) is multi
  136xsd_numeric_type(xsd:double).
  137xsd_numeric_type(xsd:float).
  138xsd_numeric_type(DatatypeIri) :-
  139  xsd_subtype(DatatypeIri, xsd:decimal).
 xsd_strict_subtype(?Sub:atom, ?Super:atom) is nondet
  145xsd_strict_subtype(X, Y) :-
  146  dif(X, Y),
  147  xsd_subtype(X, Y).
 xsd_subtype(?Sub:atom, ?Super:atom) is nondet
  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)