mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-17 23:05:21 +00:00
9fb4f15dfc
Estimated hours taken: 0.5 Branches: main Fix compilation problems in the extras distribution caused by recent changes. extras/stream/stream.m: Provide a definition for the type stream/1. extras/*/*.m: Conform to the recent changes to the standard library.
269 lines
8.2 KiB
Mathematica
269 lines
8.2 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2000, 2001, 2004-2006 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU Library General
|
|
% Public License - see the file COPYING.LIB in the Mercury distribution.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: xml.ns.m
|
|
% Main author: conway@cs.mu.oz.au, inch@students.cs.mu.oz.au
|
|
%
|
|
% This module provides predicates to turn an XML document into a namespace
|
|
% aware XML document. A normal XML document containing multiple elements
|
|
% and attributes may encounter problems of recognition and collision, ie.
|
|
% same element type or attribute name may have different scope. A namespace
|
|
% aware XML document solves this problem by using URI references to identify
|
|
% elements and attributes.
|
|
%
|
|
% Reference:
|
|
% <http://www.w3.org/TR-REC-xml-names>
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
:- module xml.ns.
|
|
|
|
:- interface.
|
|
|
|
:- import_module list, array, string, pair.
|
|
:- import_module xml.doc.
|
|
|
|
:- type nsDocument
|
|
---> nsDoc(
|
|
prestuff :: list(ref(nsContent)),
|
|
% array index pointing to prestuff
|
|
root :: ref(nsContent),
|
|
% root of the document tree
|
|
poststuff :: list(ref(nsContent)),
|
|
% array index pointing to poststuff
|
|
content :: array(nsContent)
|
|
% array storing all document content
|
|
).
|
|
|
|
:- type nsContent
|
|
---> nsElement(nsElement) % element or attribute
|
|
; pi(string, string) % processing instruction
|
|
; comment(string) % comment
|
|
; data(string) % data
|
|
.
|
|
|
|
:- type nsElement
|
|
---> nsElement(
|
|
eName :: qName,
|
|
% qualified name
|
|
eAttrs :: list(nsAttribute),
|
|
% list of attributes
|
|
eContent :: list(ref(content)),
|
|
% list of index pointing to children
|
|
% in the document tree
|
|
eNamespaces :: nsList
|
|
% list of (Prefix - URI)
|
|
).
|
|
|
|
:- type nsAttribute
|
|
---> nsAttribute(
|
|
aName :: qName, % qualified name
|
|
aValue :: string % attribute value
|
|
).
|
|
|
|
:- type qName
|
|
---> qName(
|
|
localName :: string, % local name without prefix
|
|
nsURI :: nsURI % URI reference
|
|
).
|
|
|
|
:- type nsList == list(pair(string, nsURI)).
|
|
|
|
:- type nsURI == string.
|
|
|
|
% nsTranslate() takes in a normal XML document and returns a namespace
|
|
% aware XML document.
|
|
:- pred nsTranslate(xml.doc.document::in, nsDocument::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- implementation.
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- import_module assoc_list, int, map, require.
|
|
:- import_module xml.parse.
|
|
|
|
:- type namespaces == map(string, nsURI).
|
|
|
|
nsTranslate(Doc, NsDoc) :-
|
|
traverse(Doc, [], NsDocContent),
|
|
NsDoc = nsDoc(Doc^prestuff, Doc^root, Doc^poststuff,
|
|
array(NsDocContent)).
|
|
|
|
% traverse takes in a normal XML document and an accumulator,
|
|
% creates an empty tree, traverses and translates the document tree,
|
|
% and gives back a namespace aware document.
|
|
:- pred traverse(document, list(nsContent), list(nsContent)).
|
|
:- mode traverse(in, in, out) is det.
|
|
|
|
traverse(Doc, Acc0, Acc) :-
|
|
traverse(Doc^content, map__init, "", Doc^root, Acc0, Acc).
|
|
|
|
% Carries out the actual traverse and transformation.
|
|
% If the content is an element, change it to a namespace aware
|
|
% element and visit its siblings, otherwise, convert the type.
|
|
:- pred traverse(array(content), namespaces, string, ref(content),
|
|
list(nsContent), list(nsContent)).
|
|
:- mode traverse(in, in, in, in, in, out) is det.
|
|
|
|
traverse(ContentArray, Namespaces0, Default0, ContentRef, Acc0, Acc) :-
|
|
lookup(ContentArray, ContentRef, Content),
|
|
(
|
|
Content = element(Elem),
|
|
% examine the attributes to find any default namespaces
|
|
(
|
|
defaultNamespace(Elem^eAttrs, Default1, Attrs0)
|
|
->
|
|
Default = Default1,
|
|
Attrs1 = Attrs0
|
|
;
|
|
Default = Default0,
|
|
Attrs1 = Elem^eAttrs
|
|
),
|
|
|
|
% extract any namespace declaration and insert into tree
|
|
extractNamespaceDecls(Attrs1, NSList, _Attrs2),
|
|
list__foldl((pred((Pref - URI)::in, NSs1::in,
|
|
NSs2::out) is det :-
|
|
map__set(NSs1, Pref, URI, NSs2)
|
|
), NSList, Namespaces0, Namespaces),
|
|
|
|
% change element and attributes to namespace aware
|
|
namespaceizeName(Namespaces, Default, Elem^eName, Name),
|
|
map((pred(Attr0::in, Attr::out) is det :-
|
|
Attr0 = attribute(AttrName0, Value),
|
|
namespaceizeName(Namespaces, Default,
|
|
AttrName0, AttrName),
|
|
Attr = nsAttribute(AttrName, Value)
|
|
), Elem^eAttrs, Attrs),
|
|
|
|
% visit its siblings
|
|
Kids = Elem^eContent,
|
|
list__reverse(Kids, Kids0),
|
|
NsElem = nsElement(nsElement(Name, Attrs, Elem^eContent,
|
|
NSList)),
|
|
Acc1 = [NsElem|Acc0],
|
|
xml__ns__foldl(traverse, ContentArray, Namespaces, Default,
|
|
Kids0, Acc1, Acc)
|
|
;
|
|
Content = comment(_),
|
|
Acc = [convert_type(Content) | Acc0]
|
|
;
|
|
Content = data(_),
|
|
Acc = [convert_type(Content) | Acc0]
|
|
;
|
|
Content = pi(_,_),
|
|
Acc = [convert_type(Content) | Acc0]
|
|
).
|
|
|
|
% Searches for any default namespaces.
|
|
:- pred defaultNamespace(list(attribute), string, list(attribute)).
|
|
:- mode defaultNamespace(in, out, out) is semidet.
|
|
|
|
defaultNamespace([], _, _) :- fail.
|
|
defaultNamespace([Attr|Attrs], Default, NewAttrs) :-
|
|
(
|
|
% If a default namespace is found, return the namespace
|
|
% and the list of attributes without the default namespace
|
|
is_xmlns(Attr^aName)
|
|
->
|
|
Default = Attr^aValue,
|
|
NewAttrs = Attrs
|
|
;
|
|
% Otherwise keep searching
|
|
Default = Default0,
|
|
NewAttrs = NewAttrs0,
|
|
defaultNamespace(Attrs, Default0, NewAttrs0)
|
|
).
|
|
|
|
|
|
% Searches the list of attributes and extract any namespace
|
|
% declarations.
|
|
:- pred extractNamespaceDecls(list(attribute), nsList, list(attribute)).
|
|
:- mode extractNamespaceDecls(in, out, out) is det.
|
|
|
|
extractNamespaceDecls([], [], []).
|
|
extractNamespaceDecls([Attr|Attrs], NSList, NewAttrs) :-
|
|
split_on_colon(Attr^aName, Prefix, Suffix),
|
|
(
|
|
% for case like < book xmlns:isbn="someURI" >
|
|
% Prefix = xmlns
|
|
% Suffix = isbn
|
|
is_xmlns(Prefix)
|
|
->
|
|
NSList = [(Suffix - Attr^aValue) | NSList0],
|
|
NewAttrs = NewAttrs0
|
|
;
|
|
NSList = NSList0,
|
|
NewAttrs = [Attr|NewAttrs0]
|
|
),
|
|
extractNamespaceDecls(Attrs, NSList0, NewAttrs0).
|
|
|
|
|
|
% Change Name to QName by matching Name with the Namespaces list.
|
|
% If fails, applies default namespace.
|
|
:- pred namespaceizeName(namespaces, string, string, qName).
|
|
:- mode namespaceizeName(in, in, in, out) is det.
|
|
|
|
namespaceizeName(Namespaces, Default, Name, QName) :-
|
|
split_on_colon(Name, Prefix, Suffix),
|
|
(
|
|
% for case when element name = prefix:suffix
|
|
map__search(Namespaces, Prefix, URI)
|
|
->
|
|
QName = qName(Suffix, URI)
|
|
;
|
|
% for case when attribute name = xmlns:suffix
|
|
is_xmlns(Prefix),
|
|
map__search(Namespaces, Suffix, URI)
|
|
->
|
|
QName = qName(Suffix, URI)
|
|
;
|
|
% for case when element name has no prefix
|
|
QName = qName(Suffix, Default)
|
|
).
|
|
|
|
|
|
% Split a name into prefix and suffix.
|
|
:- pred split_on_colon(string::in, string::out, string::out) is det.
|
|
|
|
split_on_colon(Name, Prefix, Suffix) :-
|
|
(
|
|
string__sub_string_search(Name, ":", Index)
|
|
->
|
|
string__length(Name, Length),
|
|
string__right(Name, Length-(Index+1), Suffix),
|
|
string__left(Name, Index, Prefix)
|
|
;
|
|
Suffix = Name,
|
|
Prefix = ""
|
|
).
|
|
|
|
|
|
% According to the namespaces specification `Namespaces in XML'
|
|
% <http://www.w3.org/TR-REC-xml-names>, a namespace is declared
|
|
% as an attribute with `xmlns' as a prefix.
|
|
:- pred is_xmlns(string::in) is semidet.
|
|
is_xmlns("xmlns").
|
|
|
|
:- func convert_type(content) = nsContent.
|
|
|
|
convert_type(comment(S)) = comment(S).
|
|
convert_type(data(S)) = data(S).
|
|
convert_type(pi(S,S0)) = pi(S,S0).
|
|
convert_type(element(_)) = _ :- require__error("Convert element failed.").
|
|
|
|
|
|
% Traverse children in the document tree.
|
|
:- pred xml__ns__foldl(pred(array(content), namespaces, string, ref(content),
|
|
T, T), array(content), namespaces, string, list(ref(content)), T, T).
|
|
:- mode xml__ns__foldl(pred(in, in, in, in, in, out) is det, in, in, in, in,
|
|
in, out) is det.
|
|
|
|
xml__ns__foldl(_Pred, _, _, _, [], Acc, Acc).
|
|
xml__ns__foldl(Pred, Content, NameSpaces, Default, [Ref|Refs], Acc0, Acc) :-
|
|
foldl(Pred, Content, NameSpaces, Default, Refs, Acc1, Acc),
|
|
call(Pred, Content, NameSpaces, Default, Ref, Acc0, Acc1).
|
|
|