%**********************************************************************
%   XML PARSER AND VALIDATOR (Version 1.0)
%
%   HOW TO USE:
%       get_file_as_list(+FileName,-L),document(NAME,ATTR,CHILDREN,ENCODING,L,[]).
%
%   If the document is valid, the above query will return the structure of the document
%   If the document is invalid, the document/4 DCG will fail
%
%   Current support for the following node types:
%       Elements
%       Attributes
%       CDATA sections
%       comments <!--  ... -->
%       processing instructions <? ... ?>
%
%
%   An XML element will have the following structure:
%       (NAME,ATTRIBUTES,CHILDREN)
%   where ATTRIBUTES is a list of the form:
%       [(attr1,value1),(attr2,value2), ... ,(attrn,valuen)]
%   and CHILDREN is a list of the form:
%       [(NAME1,TYPE1),(NAME2,TYPE2), ... ,(NAMEN,TYPEN)]
%   where:
%       TYPE represents the node type, i.e.
%       TYPE = 1 means element node
%       TYPE = 8 means comment node
%       TYPE = 4 means CDATA section node
%       TYPE = 7 means processing instruction node
%       TYPE = 3 means text node
%   The node types are according to the DOM type designations.
%
%   Examples:
%       (a,[],[]) translates to:
%       <a/>
%
%       (a,[(a1,'1'),(a2,'x')],[(text,3)]) translates to:
%       <a a1='1' a2='x'>text</a>
%
%       (a,[],[(b,[],[])]) translates to:
%       <a><b/></a>
%**********************************************************************
get_file_as_list(L) :- get_file_as_list('xmltest.xml', L).

get_file_as_list(Filename, L) :-
    open(Filename, read, Stream),
    get_contents(Stream, L),
    close(Stream).

get_contents(Stream, []) :- at_end_of_stream(Stream), !.
get_contents(Stream, [CharCode|Contents]) :-
    get_char(Stream, Char),
    char_code(Char,CharCode),
    get_contents(Stream, Contents).

document(NAME,ATTR,CHILDREN,ENCODING) --> xmlProlog(ENCODING), spn, element(NAME,ATTR,CHILDREN).

xmlDoctype([]) --> [].
xmlProlog(ENCODING) --> lt, "?", spn, "xml", sp, versionInfo, sp, encodingDecl(ENCODING), spn, "?", gt.
xmlProlog(ENCODING) --> lt, "?", spn, "xml", sp, versionInfo, sp, encodingDecl(ENCODING), sp, sDecl, spn, "?", gt.
xmlProlog([]) --> [].
versionInfo --> "version", spn, eq, spn, quot, "1.0", quot.
versionInfo --> "version", spn, eq, spn, apos, "1.0", apos.
encodingDecl(ENCODING) --> "encoding", spn, eq, spn, quot, textword(ENCODING), quot.
encodingDecl(ENCODING) --> "encoding", spn, eq, spn, apos, textword(ENCODING), apos.
sDecl --> "standalone", spn, eq, spn, quot, yesNo, quot.
sDecl --> "standalone", spn, eq, spn, apos, yesNo, apos.
yesNo --> "yes".
yesNo --> "no".

element(NAME,ATTRLIST,CHILDREN) --> starttag(NAME,ATTRLIST), nodelist(CHILDREN), endtag(NAME).
element(NAME,ATTRLIST,[]) --> solotag(NAME,ATTRLIST).
element(NAME,ATTRLIST,[]) --> starttag(NAME,ATTRLIST), endtag(NAME).

nodelist([(NAME,TYPE)|T]) --> node(NAME,TYPE), nodelist(T).
nodelist([]) --> { ! }.

node((NAME,ATTRLIST,CHILDREN),1) --> element(NAME,ATTRLIST,CHILDREN).
node(X,8) --> comment(X).
node(X,4) --> cdata(X).
node(X,7) --> pi(X).
node(X,3) --> textword(X).

docTypeDecl(DECL) --> lt, "!DOCTYPE", spn, textword(DECL), spn, gt.
comment(TEXT) --> lt, "!--", spn, textword(TEXT), spn, "--", gt.
cdata(CDATA) --> lt, "![CDATA[", spn, textword(CDATA), spn, "]]", gt.
pi(PI) --> lt, "?", spn, textword(PI), spn, "?", gt.

starttag(NAME,ATTRLIST) --> lt, spn, nameword(NAME), sp, attributelist(ATTRLIST), spn, gt.
starttag(NAME,[]) --> lt, spn, nameword(NAME), spn, gt.
endtag(NAME) --> lt, "/", spn, nameword(NAME), spn, gt.
solotag(NAME,ATTRLIST) --> lt, spn, nameword(NAME), sp, attributelist(ATTRLIST), spn, "/", gt.
solotag(NAME,[]) --> lt, spn, nameword(NAME), spn, "/", gt.

attributelist([(N,V)|T]) --> attribute(N,V), spn, attributelist(T).
attributelist([]) --> [].

attribute(NAME,VALUE) --> nameword(NAME), spn, eq, spn, quot, textword(VALUE), quot.
attribute(NAME,VALUE) --> nameword(NAME), spn, eq, spn, apos, textword(VALUE), apos.

nameword(WORD) --> { var(WORD), ! },
   namechars(CHARS), { atom_codes(WORD, CHARS) }.
nameword(WORD) --> { nonvar(WORD) },
   { atom_codes(WORD, CHARS) }, namechars(CHARS).

textword(WORD) --> { var(WORD), ! },
   textchars(CHARS), { atom_codes(WORD, CHARS) }.
textword(WORD) --> { nonvar(WORD) },
   { atom_codes(WORD, CHARS) }, textchars(CHARS).

namechars([X|Y]) --> namechar(X), namechars(Y).
namechars([X]) --> namechar(X).
textchars([X|Y]) --> textchar(X), textchars(Y).
textchars([X]) --> textchar(X).

sp --> spchar(_).
sp --> spchar(_), sp.
spn --> sp.
spn --> [].

namechar(X) --> [X], { is_namechar(X) }.
textchar(X) --> [X], { is_textchar(X) }.
spchar(X) --> [X], { member(X," \n\t"), ! }.

is_letter(X) :- X >= 0'a, X =< 0'z, !.
is_letter(X) :- X >= 0'A, X =< 0'Z, !.
is_digit(X) :- X >= 0'0, X =< 0'9, !.
is_namechar(X) :- is_letter(X), !.
is_namechar(X) :- is_digit(X), !.
is_namechar(X) :- member(X,"_:.-"), !.
is_textchar(X) :- is_namechar(X), !.
is_textchar(X) :- member(X," \n\t`~!@#$%^&*()-=\\_+|[]{};:,./?"), !.

quot --> "\"".
apos --> "\'".
lt --> "<".
gt --> ">".
eq --> "=".