[m-dev.] for review: namespaces in xml interface
Tyson Dowd
trd at cs.mu.OZ.AU
Thu Jan 4 22:54:52 AEDT 2001
On 04-Jan-2001, Ina Cheng <inch at students.cs.mu.oz.au> wrote:
> Hi,
>
> Here is the new cvs diff after addressing Tyson's comment.
> Thank you.
> +:- type qName
> + ---> qName(
> + localName :: string, % local name without prefix
> + nsURI :: nsURI % URI reference
> + ).
> +
> +:- type nsList == list(pair(string, string)).
I'm pretty sure the second "string" here should be "nsURI" instead.
> +
> +:- 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, string).
Likewise, the second string here should be nsURI as well.
> +
> +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, traverse and translate the document tree,
> + % and gives back a namespace aware document.
> +:- pred traverse(document, list(nsContent), list(nsContent)).
> +:- mode traverse(in, in, out) is det.
s/traverse and translate/traverses and translates/
> +
> +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)
> + ;
> + inst_cast_content(Content, Content1),
> + Acc = [convert_type(Content1) | Acc0]
> + ).
Hmmm... you shouldn't have to inst_cast the content.
If you write
(
Content = element(...)
... code for element ....
;
Content = comment(_),
Acc = [convert_type(Content) | Acc0]
;
Content = data(_),
Acc = [convert_type(Content) | Acc0]
;
Content = pi(_),
Acc = [convert_type(Content) | Acc0]
).
Then it will work without the cast.
The Mercury compiler should be smarter about setting the inst of Content
in the else case of the original code, but it isn't. However it's
pretty good about figuring out insts in switches.
Note that I'd also be perfectly happy for you to just call error/1 if
convert_type is called with element(_).
Otherwise this is fine, if you make these changes feel free to commit.
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
trd at cs.mu.oz.au #
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list