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-2013, University of Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(rdf_parser,
   36          [ xml_to_plrdf/3,             % +XMLTerm, -RDFTerm, +State
   37            element_to_plrdf/3,         % +ContentList, -RDFTerm, +State
   38            make_rdf_state/3,           % +Options, -State, -RestOptions
   39            rdf_modify_state/3,         % +XMLAttrs, +State0, -State
   40            rdf_name_space/1
   41          ]).   42:- use_module(rewrite).   43:- use_module(library(sgml)).           % xml_name/1
   44:- use_module(library(lists)).   45:- use_module(library(uri)).   46:- use_module(library(record)).   47
   48:- op(500, fx, \?).                     % Optional (attrs)
   49
   50term_expansion(F, T) :- rew_term_expansion(F, T).
   51goal_expansion(F, T) :- rew_goal_expansion(F, T).
   52
   53goal_expansion(attrs(Attrs, List), Goal) :-
   54    translate_attrs(List, Attrs, Goal).
   55
   56translate_attrs(Var, Attrs, rewrite(Var, Attrs)) :-
   57    var(Var),
   58    !.
   59translate_attrs([], _, true) :- !.
   60translate_attrs([H], Attrs, Goal) :-
   61    !,
   62    (   var(H)
   63    ->  Goal = rewrite(H, Attrs)
   64    ;   H = \?Optional
   65    ->  Goal = (   member(A, Attrs),
   66                   OptRewrite
   67               ->  true
   68               ;   true
   69               ),
   70        expand_goal(rewrite(\Optional, A), OptRewrite)
   71    ;   Goal = (   member(A, Attrs),
   72                   Rewrite
   73               ->  true
   74               ),
   75        expand_goal(rewrite(H, A), Rewrite)
   76    ).
   77translate_attrs([H|T], Attrs0, (G0, G1)) :-
   78    !,
   79    (   var(H)
   80    ->  G0 = rewrite(H, Attrs0),
   81        Attrs1 = Attrs0
   82    ;   H = \?Optional
   83    ->  G0 = (   select(A, Attrs0, Attrs1),
   84                 OptRewrite
   85             ->  true
   86             ;   Attrs1 = Attrs0
   87             ),
   88        expand_goal(rewrite(\Optional, A), OptRewrite)
   89    ;   G0 = (   select(A, Attrs0, Attrs1),
   90                 Rewrite
   91             ),
   92        expand_goal(rewrite(H, A), Rewrite)
   93    ),
   94    translate_attrs(T, Attrs1, G1).
   95translate_attrs(Rule, Attrs, Goal) :-
   96    expand_goal(rewrite(Rule, Attrs), Goal).
   97
   98
   99:- multifile rdf_name_space/1.  100:- dynamic   rdf_name_space/1.  101
  102%!  rdf_name_space(?URL) is nondet.
  103%
  104%   True if URL must be handled  as rdf: Determines special handling
  105%   of rdf:about, rdf:resource, etc.
  106
  107
  108rdf_name_space('http://www.w3.org/1999/02/22-rdf-syntax-ns#').
  109rdf_name_space('http://www.w3.org/TR/REC-rdf-syntax').
  110
  111
  112:- record
  113    rdf_state(base_uri='',
  114              lang='',
  115              ignore_lang=false,
  116              convert_typed_literal).  117
  118
  119%!  xml_to_plrdf(+RDFElementOrObject, -RDFTerm, +State)
  120%
  121%   Translate an XML (using namespaces)  term   into  an Prolog term
  122%   representing the RDF data.  This  term   can  then  be  fed into
  123%   rdf_triples/[2,3] to create a list of   RDF triples. State is an
  124%   instance of an rdf_state record.
  125
  126xml_to_plrdf(Element, RDF, State) :-
  127    (   is_list(Element)
  128    ->  rewrite(\xml_content_objects(RDF, State), Element)
  129    ;   rewrite(\xml_objects(RDF, State), Element)
  130    ).
  131
  132%!  element_to_plrdf(+DOM, -RDFTerm, +State)
  133%
  134%   Rewrite a single XML element.
  135
  136element_to_plrdf(Element, RDF, State) :-
  137    rewrite(\nodeElementList(RDF, State), [Element]).
  138
  139xml_objects(Objects, Options0) ::=
  140        E0,
  141        { modify_state(E0, Options0, E, Options), !,
  142          rewrite(\xml_objects(Objects, Options), E)
  143        }.
  144xml_objects(Objects, Options) ::=
  145        element((\rdf('RDF'), !),
  146                _,
  147                \nodeElementList(Objects, Options)),
  148        !.
  149xml_objects(Objects, Options) ::=
  150        element(_, _, \xml_content_objects(Objects, Options)).
  151
  152xml_content_objects([], _) ::=
  153        [].
  154xml_content_objects([H|T], Options) ::=
  155        [ \xml_objects(H, Options)
  156        | \xml_content_objects(T, Options)
  157        ].
  158
  159
  160nodeElementList([], _Options) ::=
  161        [], !.
  162nodeElementList(L, Options) ::=
  163        [ (\ws, !)
  164        | \nodeElementList(L, Options)
  165        ].
  166nodeElementList([H|T], Options) ::=
  167        [ \nodeElementOrError(H, Options)
  168        | \nodeElementList(T, Options)
  169        ].
  170
  171nodeElementOrError(H, Options) ::=
  172        \nodeElement(H, Options), !.
  173nodeElementOrError(unparsed(Data), _Options) ::=
  174        Data.
  175
  176nodeElement(description(Type, About, Properties), Options) ::=
  177        \description(Type, About, Properties, Options).
  178
  179
  180                 /*******************************
  181                 *          DESCRIPTION         *
  182                 *******************************/
  183
  184description(Type, About, Properties, Options0) ::=
  185        E0,
  186        { modify_state(E0, Options0, E, Options), !,
  187          rewrite(\description(Type, About, Properties, Options), E)
  188        }.
  189description(description, About, Properties, Options) ::=
  190        element(\rdf('Description'),
  191                \attrs([ \?idAboutAttr(About, Options)
  192                       | \propAttrs(PropAttrs, Options)
  193                       ]),
  194                \propertyElts(PropElts, Options)),
  195        { !, append(PropAttrs, PropElts, Properties)
  196        }.
  197description(Type, About, Properties, Options) ::=
  198        element(\name_uri(Type, Options),
  199                \attrs([ \?idAboutAttr(About, Options)
  200                       | \propAttrs(PropAttrs, Options)
  201                       ]),
  202                \propertyElts(PropElts, Options)),
  203        { append(PropAttrs, PropElts, Properties)
  204        }.
  205
  206propAttrs([], _) ::=
  207        [], !.
  208propAttrs([H|T], Options) ::=
  209        [ \propAttr(H, Options)
  210        | \propAttrs(T, Options)
  211        ].
  212
  213propAttr(rdf:type = URI, Options) ::=
  214        \rdf_or_unqualified(type) = \value_uri(URI, Options), !.
  215propAttr(Name = Literal, Options) ::=
  216        Name = Value,
  217        { mkliteral(Value, Literal, Options)
  218        }.
  219
  220propertyElts([], _) ::=
  221        [], !.
  222propertyElts(Elts, Options) ::=
  223        [ (\ws, !)
  224        | \propertyElts(Elts, Options)
  225        ].
  226propertyElts([H|T], Options) ::=
  227        [ \propertyElt(H, Options)
  228        | \propertyElts(T, Options)
  229        ].
  230
  231propertyElt(E, Options) ::=
  232        \propertyElt(Id, Name, Value, Options),
  233        { mkprop(Name, Value, Prop),
  234          (   var(Id)
  235          ->  E = Prop
  236          ;   E = id(Id, Prop)
  237          )
  238        }.
  239
  240mkprop(NS:Local, Value, rdf:Local = Value) :-
  241    rdf_name_space(NS),
  242    !.
  243mkprop(Name, Value, Name = Value).
  244
  245
  246propertyElt(Id, Name, Value, Options0) ::=
  247        E0,
  248        { modify_state(E0, Options0, E, Options), !,
  249          rewrite(\propertyElt(Id, Name, Value, Options), E)
  250        }.
  251propertyElt(Id, Name, Value, Options) ::=
  252        \literalPropertyElt(Id, Name, Value, Options), !.
  253propertyElt(_, Name, Literal, Options) ::=
  254        element(Name,
  255                \attrs([ \parseLiteral
  256                       ]),
  257                Content),
  258        { !,
  259          literal_value(Content, Literal, Options)
  260        }.
  261propertyElt(Id, Name, collection(Elements), Options) ::=
  262        element(Name,
  263                \attrs([ \parseCollection,
  264                         \?idAttr(Id, Options)
  265                       ]),
  266                \nodeElementList(Elements, Options)).
  267                                        % 5.14 emptyPropertyElt
  268propertyElt(Id, Name, Value, Options) ::=
  269        element(Name, A, \all_ws),
  270        { !,
  271          rewrite(\emptyPropertyElt(Id, Value, Options), A)
  272        }.
  273
  274propertyElt(_, Name, description(description, Id, Properties), Options) ::=
  275        element(Name,
  276                \attrs([ \parseResource,
  277                         \?idAboutAttr(Id, Options)
  278                       ]),
  279                \propertyElts(Properties, Options)),
  280        !.
  281propertyElt(Id, Name, Literal, Options) ::=
  282        element(Name,
  283                \attrs([ \?idAttr(Id, Options)
  284                       ]),
  285                [ Value ]),
  286        { atom(Value), !,
  287          mkliteral(Value, Literal, Options)
  288        }.
  289propertyElt(Id, Name, Value, Options) ::=
  290        element(Name,
  291                \attrs([ \?idAttr(Id, Options)
  292                       ]),
  293                \an_rdf_object(Value, Options)), !.
  294propertyElt(Id, Name, unparsed(Value), Options) ::=
  295        element(Name,
  296                \attrs([ \?idAttr(Id, Options)
  297                       ]),
  298                Value).
  299
  300literalPropertyElt(Id, Name, Literal, Options) ::=
  301        element(Name,
  302                \attrs([ \typeAttr(Type, Options),
  303                         \?idAttr(Id, Options)
  304                       ]),
  305                Content),
  306        { typed_literal(Type, Content, Literal, Options)
  307        }.
  308
  309emptyPropertyElt(Id, Literal, Options) ::=
  310        \attrs([ \?idAttr(Id, Options),
  311                 \?parseLiteral
  312               | \noMoreAttrs
  313               ]),
  314        { !,
  315          mkliteral('', Literal, Options)
  316        }.
  317emptyPropertyElt(Id,
  318                 description(description, About, Properties),
  319                 Options) ::=
  320        \attrs([ \?idAttr(Id, Options),
  321                 \?aboutResourceEmptyElt(About, Options),
  322                 \?parseResource
  323               | \propAttrs(Properties, Options)
  324               ]), !.
  325
  326aboutResourceEmptyElt(about(URI), Options) ::=
  327        \resourceAttr(URI, Options), !.
  328aboutResourceEmptyElt(node(URI), _Options) ::=
  329        \nodeIDAttr(URI).
  330
  331%!  literal_value(+In, -Value, +Options)
  332%
  333%   Create the literal value for rdf:parseType="Literal" attributes.
  334%   The content is the Prolog XML DOM tree for the literal.
  335%
  336%   @tbd    Note that the specs demand a canonical textual representation
  337%           of the XML data as a Unicode string.  For now the user can
  338%           achieve this using the convert_typed_literal hook.
  339
  340literal_value(Value, literal(type(rdf:'XMLLiteral', Value)), _).
  341
  342%!  mkliteral(+Atom, -Object, +Options)
  343%
  344%   Translate attribute value Atom into an RDF object using the
  345%   lang(Lang) option from Options.
  346
  347mkliteral(Text, literal(Val), Options) :-
  348    atom(Text),
  349    (   rdf_state_lang(Options, Lang),
  350        Lang \== ''
  351    ->  Val = lang(Lang, Text)
  352    ;   Val = Text
  353    ).
  354
  355%!  typed_literal(+Type, +Content, -Literal, +Options)
  356%
  357%   Handle a literal attribute with rdf:datatype=Type qualifier. NB:
  358%   possibly  it  is  faster  to  use  a  global  variable  for  the
  359%   conversion hook.
  360
  361typed_literal(Type, Content, literal(Object), Options) :-
  362    rdf_state_convert_typed_literal(Options, Convert),
  363    nonvar(Convert),
  364    !,
  365    (   catch(call(Convert, Type, Content, Object), E, true)
  366    ->  (   var(E)
  367        ->  true
  368        ;   Object = E
  369        )
  370    ;   Object = error(cannot_convert(Type, Content), _)
  371    ).
  372typed_literal(Type, [], literal(type(Type, '')), _Options) :- !.
  373typed_literal(Type, [Text], literal(type(Type, Text)), _Options) :- !.
  374typed_literal(Type, Content, literal(type(Type, Content)), _Options).
  375
  376
  377idAboutAttr(id(Id), Options) ::=
  378        \idAttr(Id, Options), !.
  379idAboutAttr(about(About), Options) ::=
  380        \aboutAttr(About, Options), !.
  381idAboutAttr(node(About), _Options) ::=
  382        \nodeIDAttr(About), !.
  383
  384%!  an_rdf_object(-Object, +OptionsURI)
  385%
  386%   Deals with an object, but there may be spaces around.  I'm still
  387%   not sure where to deal with these.  Best is to ask the XML parser
  388%   to get rid of them, So most likely this code will change if this
  389%   happens.
  390
  391an_rdf_object(Object, Options) ::=
  392        [ \nodeElement(Object, Options)
  393        ], !.
  394an_rdf_object(Object, Options) ::=
  395        [ (\ws, !)
  396        | \an_rdf_object(Object, Options)
  397        ].
  398an_rdf_object(Object, Options) ::=
  399        [ \nodeElement(Object, Options),
  400          \ws
  401        ], !.
  402
  403ws ::=
  404        A,
  405        { atom(A),
  406          atom_chars(A, Chars),
  407          all_blank(Chars), !
  408        }.
  409ws ::=
  410        pi(_).
  411
  412all_ws ::=
  413        [], !.
  414all_ws ::=
  415        [\ws | \all_ws].
  416
  417all_blank([]).
  418all_blank([H|T]) :-
  419    char_type(H, space),            % SWI-Prolog specific
  420    all_blank(T).
  421
  422
  423                 /*******************************
  424                 *         RDF ATTRIBUTES       *
  425                 *******************************/
  426
  427idAttr(Id, Options) ::=
  428        \rdf_or_unqualified('ID') = \uniqueid(Id, Options).
  429
  430aboutAttr(About, Options) ::=
  431        \rdf_or_unqualified(about) = \value_uri(About, Options).
  432
  433nodeIDAttr(About) ::=
  434        \rdf_or_unqualified(nodeID) = About.
  435
  436resourceAttr(URI, Options) ::=
  437        \rdf_or_unqualified(resource) = \value_uri(URI, Options).
  438
  439typeAttr(Type, Options) ::=
  440        \rdf_or_unqualified(datatype) = \value_uri(Type, Options).
  441
  442name_uri(URI, Options) ::=
  443        NS:Local,
  444        {   !, atom_concat(NS, Local, A),
  445            rewrite(\value_uri(URI, Options), A)
  446        }.
  447name_uri(URI, Options) ::=
  448        \value_uri(URI, Options).
  449
  450value_uri(URI, Options) ::=
  451        A,
  452        {   rdf_state_base_uri(Options, Base),
  453            (   Base \== []
  454            ->  iri_normalized(A, Base, URI)
  455            ;   URI = A
  456            )
  457        }.
  458
  459uniqueid(Id, Options) ::=
  460        A,
  461        {   unique_xml_name(A, HashID),
  462            make_globalid(HashID, Options, Id)
  463        }.
  464
  465unique_xml_name(Name, HashID) :-
  466    atom_concat(#, Name, HashID),
  467    (   xml_name(Name)
  468    ->  true
  469    ;   print_message(warning, rdf(not_a_name(Name)))
  470    ).
  471
  472make_globalid(In, Options, Id) :-
  473    rdf_state_base_uri(Options, Base),
  474    iri_normalized(In, Base, Id).
  475
  476parseLiteral    ::= \rdf_or_unqualified(parseType) = 'Literal'.
  477parseResource   ::= \rdf_or_unqualified(parseType) = 'Resource'.
  478parseCollection ::= \rdf_or_unqualified(parseType) = 'Collection'.
  479
  480
  481                 /*******************************
  482                 *           PRIMITIVES         *
  483                 *******************************/
  484
  485rdf(Tag) ::=
  486        NS:Tag,
  487        { rdf_name_space(NS), !
  488        }.
  489
  490rdf_or_unqualified(Tag) ::=
  491        Tag.
  492rdf_or_unqualified(Tag) ::=
  493        NS:Tag,
  494        { rdf_name_space(NS), !
  495        }.
  496
  497
  498                 /*******************************
  499                 *             BASICS           *
  500                 *******************************/
  501
  502/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  503This code is translated by the  goal_expansion/2   rule  at the start of
  504this file. We leave the original code for reference.
  505
  506attrs(Bag) ::=
  507        L0,
  508        { do_attrs(Bag, L0)
  509        }.
  510
  511do_attrs([], _) :- !.
  512do_attrs([\?H|T], L0) :- !,             % optional
  513        (   select(X, L0, L),
  514            rewrite(\H, X)
  515        ->  true
  516        ;   L = L0
  517        ),
  518        do_attrs(T, L).
  519do_attrs([H|T], L0) :-
  520        select(X, L0, L),
  521        rewrite(H, X), !,
  522        do_attrs(T, L).
  523do_attrs(C, L) :-
  524        rewrite(C, L).
  525- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  526
  527%       \noMoreAttrs
  528%
  529%       Check attribute-list is empty.  Reserved xml: attributes are
  530%       excluded from this test.
  531
  532noMoreAttrs ::=
  533        [], !.
  534noMoreAttrs ::=
  535        [ xml:_=_
  536        | \noMoreAttrs
  537        ].
  538
  539%!  modify_state(+Element0, +Options0, -Element, -Options) is semidet.
  540%
  541%   If Element0 contains xml:base = Base, strip it from the
  542%   attributes list and update base_uri(_) in the Options
  543%
  544%   It Element0 contains xml:lang = Lang, strip it from the
  545%   attributes list and update lang(_) in the Options
  546%
  547%   Remove all xmlns=_, xmlns:_=_ and xml:_=_.  Only succeed
  548%   if something changed.
  549
  550modify_state(element(Name, Attrs0, Content), Options0,
  551             element(Name, Attrs,  Content), Options) :-
  552    modify_a_state(Attrs0, Options0, Attrs, Options),
  553    Attrs0 \== Attrs.
  554
  555rdf_modify_state(Attributes, State0, State) :-
  556    modify_a_state(Attributes, State0, _, State).
  557
  558
  559modify_a_state([], Options, [], Options).
  560modify_a_state([Name=Value|T0], Options0, T, Options) :-
  561    modify_a(Name, Value, Options0, Options1),
  562    !,
  563    modify_a_state(T0, Options1, T, Options).
  564modify_a_state([H|T0], Options0, [H|T], Options) :-
  565    modify_a_state(T0, Options0, T, Options).
  566
  567
  568modify_a(xml:base, Base1, Options0, Options) :-
  569    !,
  570    rdf_state_base_uri(Options0, Base0),
  571    remove_fragment(Base1, Base2),
  572    iri_normalized(Base2, Base0, Base),
  573    set_base_uri_of_rdf_state(Base, Options0, Options).
  574modify_a(xml:lang, Lang, Options0, Options) :-
  575    !,
  576    rdf_state_ignore_lang(Options0, false),
  577    !,
  578    set_lang_of_rdf_state(Lang, Options0, Options).
  579modify_a(xmlns, _, Options, Options).
  580modify_a(xmlns:_, _, Options, Options).
  581modify_a(xml:_, _, Options, Options).
  582
  583
  584%!  remove_fragment(+URI, -WithoutFragment)
  585%
  586%   When handling xml:base, we must delete the possible fragment.
  587
  588remove_fragment(URI, Plain) :-
  589    sub_atom(URI, B, _, _, #),
  590    !,
  591    sub_atom(URI, 0, B, _, Plain).
  592remove_fragment(URI, URI).
  593
  594
  595                 /*******************************
  596                 *     HELP PCE-EMACS A BIT     *
  597                 *******************************/
  598
  599:- multifile
  600    emacs_prolog_colours:term_colours/2,
  601    emacs_prolog_colours:goal_classification/2.  602
  603expand(c(X), _, X) :- !.
  604expand(In,   Pattern, Colours) :-
  605    compound(In),
  606    !,
  607    In =.. [F|Args],
  608    expand_list(Args, PatternArgs, ColourArgs),
  609    Pattern =.. [F|PatternArgs],
  610    Colours = functor(F) - ColourArgs.
  611expand(X, X, classify).
  612
  613expand_list([], [], []).
  614expand_list([H|T], [PH|PT], [CH|CT]) :-
  615    expand(H, PH, CH),
  616    expand_list(T, PT, CT).
  617
  618:- discontiguous
  619    term_expansion/2.  620
  621term_expansion(term_colours(C),
  622               emacs_prolog_colours:term_colours(Pattern, Colours)) :-
  623    expand(C, Pattern, Colours).
  624
  625term_colours((c(head(+(1))) ::= c(match), {c(body)})).
  626term_colours((c(head(+(1))) ::= c(match))).
  627
  628emacs_prolog_colours:goal_classification(\_, expanded).
  629
  630:- dynamic
  631    prolog:meta_goal/2.  632:- multifile
  633    prolog:meta_goal/2,
  634    prolog:called_by/2.  635
  636prolog:meta_goal(rewrite(A, _), [A]).
  637prolog:meta_goal(\A,            [A+1]).
  638
  639prolog:called_by(attrs(Attrs, _Term), Called) :-
  640    findall(G+1, sub_term(\?G, Attrs), Called, Tail),
  641    findall(G+1, sub_term(\G, Attrs), Tail)