[m-rev.] for review: add xmlable typeclass to term_to_xml module
Ian MacLarty
maclarty at cs.mu.OZ.AU
Sat Jul 23 13:21:03 AEST 2005
For review by anyone.
Estimated hours taken: 6
Branches: main
Add a new method to convert terms to XML using a typeclass.
The new method is more flexible than the previous method, but DTDs cannot
be automatically generated using the new method.
library/term_to_xml.m:
Update the documentation to describe the new method.
Divide the interface into two parts -- one for the new method and
one for the old method.
Rename some function symbols and variables of the old method to
distinguish them from names used in the new method.
Implement predicates for writing terms that are members of the xmlable
typeclass.
tests/hard_coded/Mmakefile:
tests/hard_coded/xmlable_test.exp:
tests/hard_coded/xmlable_test.m:
Test the new method.
tests/hard_coded/write_xml.m:
Use attr_from_source instead of attribute.
Index: library/term_to_xml.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/term_to_xml.m,v
retrieving revision 1.7
diff -u -r1.7 term_to_xml.m
--- library/term_to_xml.m 16 Jun 2005 04:08:06 -0000 1.7
+++ library/term_to_xml.m 23 Jul 2005 02:54:14 -0000
@@ -1,4 +1,4 @@
-%-----------------------------------------------------------------------------r
+%-----------------------------------------------------------------------------%
% Copyright (C) 1993-2005 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.
@@ -8,54 +8,42 @@
% Main author: maclarty.
% Stability: low.
%
-% A Mercury term to XML converter.
-%
-% This module contains predicates that write arbitrary Mercury terms to
-% an output stream as XML.
-%
-% Each functor in a term is given a corresponding well-formed element name
-% in the XML document according to a mapping. Some predefined mappings are
-% provided, but user defined mappings may also be used.
-%
-% The following attributes can be set for each XML element:
-%
-% functor - the original functor name as returned by
-% deconstruct.deconstruct/5.
-%
-% arity - the arity of the functor as returned by deconstruct.deconstruct/5.
-%
-% type - the type name of the Mercury type the element represents.
-%
-% field - the field name of a discriminated union functor argument if it has
-% one.
-%
-% The names of the above attributes can also be customized.
+% This module provides two mechanisms whereby Mercury terms can be converted to
+% XML documents.
%
-% The XML document can be annotated with a stylesheet reference. Once a
-% Mercury term is in XML it can be converted to many different formats using
-% the appropriate stylesheet. For example in the extras/xml_stylesheets
-% distribution there are stylesheets to convert XML documents generated with
-% this library back to Mercury terms that can be read with io.read/3.
-%
-% To support third parties generating XML which is compatible with the XML
-% generated by this library, a DTD for a Mercury type can also be generated.
-% A DTD for a given type and functor-to-element mapping may be generated
-% provided the following conditions hold:
-%
-% 1. If the type is a discriminated union then there must be only
-% one top-level functor for the type. This is because the top
-% level functor will be used to generate the document type name.
-%
-% 2. The functor to element mapping must map each functor to a unique
-% element name for every functor that could appear in terms of the type.
-%
-% 3. Only types whose terms consist of discriminated unions, arrays
-% and the builtin types `int', `string', `character' and `float' can be
-% used to automatically generate DTDs. This list may be extended in the
-% future.
-%
-% The generated DTD is also a good reference when creating a stylesheet as
-% it contains comments describing the mapping from functors to elements.
+% Method 1
+% --------
+% The first method requires a type to be an instance of the xmlable typeclass
+% before values of the type can be written as XML.
+% Members of the xmlable typeclass must implement a to_xml method which
+% maps values of the type to XML elements.
+% The XML elements may contain arbitrary children, comments and data.
+%
+% Method 2
+% --------
+% The second method is less flexible than the first, but it allows for the
+% automatic generation of a DTD.
+% In the second method each functor in a term is given a corresponding
+% well-formed element name in the XML document according to a mapping. Some
+% predefined mappings are provided, but user defined mappings may also be used.
+%
+% Method 1 vs. Method 2
+% ---------------------
+%
+% Method 1 allows values of a specific type to be mapped to arbitrary XML
+% elements with arbitrary children and arbitrary attributes.
+% In method 2 each functor in a term can be mapped to only one XML element.
+% Method 2 also only allows a selected set of attributes.
+% In method 2 a DTD can be automatically generated. In method 1 DTDs cannot
+% be automatically generated.
+%
+% Method 1 is useful for mapping a specific type to XML,
+% for example mapping terms which represent mathematical expressions to
+% MathML.
+% Method 2 is useful for mapping arbitrary terms of any type to XML.
+%
+% In both methods the XML document can be annotated with a stylesheet
+% reference.
%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -67,9 +55,68 @@
:- import_module int.
:- import_module io.
:- import_module list.
+:- import_module std_util.
:- import_module type_desc.
%-----------------------------------------------------------------------------%
+% Method 1 interface
+%
+
+ % Instances of this typeclass can be converted to XML.
+ %
+:- typeclass xmlable(T) where [
+ func to_xml(T::in) = (xml::out(xml_doc)) is det
+].
+
+ % Values of this type represent an XML document or a portion of
+ % an XML document.
+ %
+:- type xml
+ %
+ % An XML element with a name, list of attributes
+ % and a list of children.
+ %
+ ---> elem(
+ element_name :: string,
+ attributes :: list(attr),
+ children :: list(xml)
+ )
+
+ % Textual data. `<', `>', `&', `'' and `"' characters
+ % will be replaced by `<', `>', `&', `''
+ % and `"' respectively.
+ ; data(string)
+
+ % Data to be enclosed in `<![CDATA[' and `]]>' tags.
+ % Any occurances of `]]>' in the data will be
+ % converted to `]]>'.
+ ; cdata(string)
+
+ % An XML comment. The comment should not
+ % include the `<!--' and `-->'. Any occurances of
+ % `--' will be replaced by ` - '.
+ ; comment(string)
+
+ % An entity reference. The string will
+ % have `&' prepended and `;' appended before being
+ % output.
+ ; entity(string)
+
+ % Raw XML data. The data will be written out verbatim.
+ ; raw(string).
+
+ % An XML document must have an element at the top-level.
+ %
+:- inst xml_doc
+ ---> elem(
+ ground, % element_name
+ ground, % attributes
+ ground % children
+ ).
+
+ % An element attribute, mapping a name to a value.
+ %
+:- type attr ---> attr(string, string).
% Values of this type specify the DOCTYPE of an XML document when
% the DOCTYPE is defined by an external DTD.
@@ -83,15 +130,21 @@
% a generated XML document and if so how.
%
:- type maybe_dtd
- % Generate and embed the entire DTD in the document.
+ % Generate and embed the entire DTD in the document
+ % (only available for method 2).
---> embed
% Included a reference to an external DTD.
; external(doctype)
% Do not include any DOCTYPE information.
; no_dtd.
+:- inst non_embedded_dtd
+ ---> external(ground)
+ ; no_dtd.
+
% Values of this type indicate whether a stylesheet reference should be
% included in a generated XML document.
+ %
:- type maybe_stylesheet
---> with_stylesheet(
stylesheet_type :: string, % For example "text/xsl"
@@ -99,50 +152,68 @@
)
; no_stylesheet.
- % Values of this type indicate whether a DTD was successfully generated
- % or not. A DTD cannot be generated for a type with more than one
- % top-level functor since only one root element can be specified by a
- % DTD. A DTD also cannot be generated for a type where the mapping
- % from functors of the type to elements is not unique (since then the
- % DTD rules for legal children cannot be expressed properly). We also
- % do not support generation of DTDs for functors with existentially
- % typed arguments.
+ % write_xml_doc(Term, !IO).
+ % Output Term as an XML document to the current output stream.
+ % Term must be an instance of the xmlable typeclass.
%
-:- type dtd_generation_result
- ---> ok
- % The root type is a discriminated union with
- % multiple functors.
- %
- ; multiple_functors_for_root
+:- pred write_xml_doc(T::in, io::di, io::uo) is det <= xmlable(T).
- % The functor-to-element mapping maps different
- % functors to the same element. The duplicate element
- % and a list of types whose functors map to that
- % element is given.
- %
- ; duplicate_elements(
- duplicate_element :: string,
- duplicate_types :: list(type_desc)
- )
- ;
- % At the moment we only support generation of DTDs for
- % types made up of discriminated unions, arrays,
- % strings, ints, characters and floats. If a type is
- % not supported, then it is returned as the argument
- % of this functor.
- %
- unsupported_dtd_type(type_desc)
- ;
- % If one of the arguments of a functor is existentially
- % typed, then the pseudo_type_desc for the
- % existentially quantified argument is returned as the
- % argument of this functor. Since the values of
- % existentially typed arguments can be of any type
- % (provided any typeclass constraints are satisfied) it
- % is not generally possible to generate DTD rules for
- % functors with existentially typed arguments.
- %
- type_not_ground(pseudo_type_desc).
+ % write_xml_doc(Stream, Term, !IO).
+ % Same as write_xml_doc/3, but use the given output stream.
+ %
+:- pred write_xml_doc(io.output_stream::in, T::in, io::di, io::uo) is det
+ <= xmlable(T).
+
+ % write_xml_doc(Term, MaybeStyleSheet, MaybeDTD, !IO).
+ % Write Term to the current output stream as an XML document.
+ % Term should be an instance of the xmlable typeclass.
+ % MaybeStyleSheet and MaybeDTD specify whether or not a stylesheet
+ % reference and/or a DTD should be included.
+ % Using this predicate only external DTDs can be included, i.e.
+ % a DTD cannot be automatically generated and embedded
+ % (that fearure is available only for method 2 -- see below).
+ %
+:- pred write_xml_doc(T::in, maybe_stylesheet::in,
+ maybe_dtd::in(non_embedded_dtd), io::di, io::uo) is det <= xmlable(T).
+
+ % write_xml_doc(Stream, Term, MaybeStyleSheet, MaybeDTD, !IO).
+ % Same as write_xml_doc/5, but write output to the given output
+ % stream.
+ %
+:- pred write_xml_doc(io.output_stream::in, T::in, maybe_stylesheet::in,
+ maybe_dtd::in(non_embedded_dtd), io::di, io::uo) is det <= xmlable(T).
+
+ % write_xml_element(Indent, Term, !IO).
+ % Write Term out as XML to the current output stream,
+ % using indentation level Indent (each indentation level is one
+ % tab character).
+ % No `<?xml ... ?>' header will be written.
+ % This is useful for generating large XML documents in pieces.
+ %
+:- pred write_xml_element(int::in, T::in, io::di, io::uo) is det <= xmlable(T).
+
+ % write_xml_element(Stream, Indent, Term, !IO).
+ % Same as write_xml_element/4, but use the given output stream.
+ %
+:- pred write_xml_element(io.output_stream::in, int::in, T::in, io::di, io::uo)
+ is det <= xmlable(T).
+
+ % write_xml_header(MaybeEncoding, !IO).
+ % Write an XML header (i.e. `<?xml version="1.0"?>) to the
+ % current output stream.
+ % If MaybeEncoding is yes(Encoding), then include `encoding="Encoding"'
+ % in the header.
+ %
+:- pred write_xml_header(maybe(string)::in, io::di, io::uo) is det.
+
+ % Same as write_xml_header/3, but use the given output stream.
+ %
+:- pred write_xml_header(io.output_stream::in, maybe(string)::in, io::di,
+ io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+% Method 2 interface
+%
% Values of this type specify which mapping from functors to elements
% to use when generating XML. The role of a mapping is twofold:
@@ -194,6 +265,122 @@
; unique
; custom(element_pred).
+ % Deterministic procedures with the following signature can be used as
+ % custom functor to element mappings. The inputs to the procedure are
+ % a type and some information about a functor for that type
+ % if the type is a discriminated union. The output should be a well
+ % formed XML element name and a list of attributes that should be set
+ % for that element. See the types `maybe_functor_info' and
+ % `attr_from_source' below.
+ %
+:- type element_pred == (pred(type_desc.type_desc, maybe_functor_info, string,
+ list(attr_from_source))).
+
+:- inst element_pred == (pred(in, in, out, out) is det).
+
+ % Values of this type are passed to custom functor-to-element
+ % mapping predicates to tell the predicate which functor to generate
+ % an element name for if the type is a discriminated union. If the
+ % type is not a discriminated union, then none_du is passed to
+ % the predicate when requesting an element for the type.
+ %
+:- type maybe_functor_info
+ % The functor's name and arity.
+ ---> du_functor(
+ functor_name :: string,
+ functor_arity :: int
+ )
+ % The type is not a discriminated union.
+ ; none_du.
+
+ % Values of this type specify attributes that should be set from
+ % a particular source. The attribute_name field specifies the name
+ % of the attribute in the generated XML and the attribute_source
+ % field indicates where the attribute's value should come from.
+ %
+:- type attr_from_source
+ ---> attr_from_source(
+ attr_name :: string,
+ attr_source :: attr_source
+ ).
+
+ % Possible attribute sources.
+ %
+:- type attr_source
+ % The original functor name as returned by
+ % deconstruct.deconstruct/5.
+ ---> functor
+ % The field name if the functor appears in a
+ % named field (If the field is not named then this
+ % attribute is omitted.
+ ; field_name
+ % The fully qualified type name the functor is for.
+ ; type_name
+ % The arity of the functor as returned by
+ % deconstruct.deconstruct/5.
+ ; arity.
+
+ % To support third parties generating XML which is compatible with the
+ % XML generated using method 2, a DTD for a Mercury type can also be
+ % generated. A DTD for a given type and functor-to-element mapping may
+ % be generated provided the following conditions hold:
+ %
+ % 1. If the type is a discriminated union then there must be only
+ % one top-level functor for the type. This is because the top
+ % level functor will be used to generate the document type name.
+ %
+ % 2. The functor to element mapping must map each functor to a
+ % unique element name for every functor that could appear in
+ % terms of the type.
+ %
+ % 3. Only types whose terms consist of discriminated unions,
+ % arrays and the builtin types `int', `string', `character' and
+ % `float' can be used to automatically generate DTDs.
+ % Existential types are also not supported.
+ %
+ % The generated DTD is also a good reference when creating a stylesheet
+ % as it contains comments describing the mapping from functors to
+ % elements.
+ %
+ % Values of the following type indicate whether a DTD was successfully
+ % generated or not.
+ %
+:- type dtd_generation_result
+ ---> ok
+ % The root type is a discriminated union with
+ % multiple functors.
+ %
+ ; multiple_functors_for_root
+
+ % The functor-to-element mapping maps different
+ % functors to the same element. The duplicate element
+ % and a list of types whose functors map to that
+ % element is given.
+ %
+ ; duplicate_elements(
+ duplicate_element :: string,
+ duplicate_types :: list(type_desc.type_desc)
+ )
+ ;
+ % At the moment we only support generation of DTDs for
+ % types made up of discriminated unions, arrays,
+ % strings, ints, characters and floats. If a type is
+ % not supported, then it is returned as the argument
+ % of this functor.
+ %
+ unsupported_dtd_type(type_desc.type_desc)
+ ;
+ % If one of the arguments of a functor is existentially
+ % typed, then the pseudo_type_desc for the
+ % existentially quantified argument is returned as the
+ % argument of this functor. Since the values of
+ % existentially typed arguments can be of any type
+ % (provided any typeclass constraints are satisfied) it
+ % is not generally possible to generate DTD rules for
+ % functors with existentially typed arguments.
+ %
+ type_not_ground(pseudo_type_desc).
+
% write_xml_doc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
% DTDResult, !IO).
% Write Term to the current output stream as an XML document using
@@ -251,8 +438,8 @@
% dtd_generation_result type for the meaning of the return value when
% it is not `ok'.
%
-:- func can_generate_dtd(element_mapping::in(element_mapping), type_desc::in)
- = (dtd_generation_result::out) is det.
+:- func can_generate_dtd(element_mapping::in(element_mapping),
+ type_desc.type_desc::in) = (dtd_generation_result::out) is det.
% write_dtd(Term, ElementMapping, DTDResult, !IO).
% Write a DTD for the given term to the current output stream using
@@ -302,69 +489,14 @@
% module in the standard library for more information on this argument.
%
:- pred write_xml_element(deconstruct.noncanon_handling,
- element_pred, int, T, io, io).
-:- mode write_xml_element(in(do_not_allow), in(element_pred), in, in, di, uo)
- is det.
-:- mode write_xml_element(in(canonicalize), in(element_pred), in, in, di, uo)
+ element_mapping, int, T, io, io).
+:- mode write_xml_element(in(do_not_allow), in(element_mapping), in, in, di, uo)
is det.
-:- mode write_xml_element(in(include_details_cc), in(element_pred), in, in,
+:- mode write_xml_element(in(canonicalize), in(element_mapping), in, in,
+ di, uo) is det.
+:- mode write_xml_element(in(include_details_cc), in(element_mapping), in, in,
di, uo) is cc_multi.
-:- mode write_xml_element(in, in(element_pred), in, in, di, uo) is cc_multi.
-
- % Deterministic procedures with the following signature can be used as
- % custom functor to element mappings. The inputs to the procedure are
- % a type and some information about the required functor for that type
- % if the type is a discriminated union. The output should be a well
- % formed XML element name and a list of attributes that should be set
- % for that element. See the types `maybe_functor_info' and
- % `attribute' below.
- %
-:- type element_pred == (pred(type_desc, maybe_functor_info, string,
- list(attribute))).
-
-:- inst element_pred == (pred(in, in, out, out) is det).
-
- % Values of this type are passed to custom functor-to-element
- % mapping predicates to tell the predicate which functor to generate
- % an element name for if the type is a discriminated union. If the
- % type is not a discriminated union, then none_du is passed to
- % the predicate when requesting an element for the type.
- %
-:- type maybe_functor_info
- % The functor's name and arity.
- ---> du_functor(
- functor_name :: string,
- functor_arity :: int
- )
- % The type is not a discriminated union.
- ; none_du.
-
- % Values of this type specify attributes that should be set by
- % particular element. The attribute_name field specifies the name
- % of the attribute in the generated XML and the attribute_source
- % field indicates where the attribute's value should come from.
- %
-:- type attribute
- ---> attribute(
- attribute_name :: string,
- attribute_source :: attribute_source
- ).
-
- % Possible attribute sources.
- %
-:- type attribute_source
- % The original functor name as returned by
- % deconstruct.deconstruct/5.
- ---> functor
- % The field name if the functor appears in a
- % named field (If the field is not named then this
- % attribute is omitted.
- ; field_name
- % The fully qualified type name the functor is for.
- ; type_name
- % The arity of the functor as returned by
- % deconstruct.deconstruct/5.
- ; arity.
+:- mode write_xml_element(in, in(element_mapping), in, in, di, uo) is cc_multi.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -378,23 +510,65 @@
:- import_module exception.
:- import_module map.
:- import_module require.
-:- import_module std_util.
:- import_module string.
%-----------------------------------------------------------------------------%
+write_xml_doc(X, !IO) :-
+ write_xml_doc(X, no_stylesheet, no_dtd, !IO).
+
+write_xml_doc(Stream, X, !IO) :-
+ write_xml_doc(Stream, X, no_stylesheet, no_dtd, !IO).
+
+write_xml_doc(X, MaybeStyleSheet, MaybeDTD, !IO) :-
+ write_xml_header(no, !IO),
+ write_stylesheet_ref(MaybeStyleSheet, !IO),
+ Root = to_xml(X),
+ Root = elem(RootName, _, Children),
+ (
+ MaybeDTD = no_dtd
+ ;
+ MaybeDTD = external(DocType),
+ write_external_doctype(RootName, DocType, !IO)
+ ),
+ ( if contains_noformat_xml(Children) then
+ ChildrenFormat = no_format
+ else
+ ChildrenFormat = format
+ ),
+ write_xml_element_format(ChildrenFormat, 0, Root, !IO).
+
+write_xml_doc(Stream, X, MaybeStyleSheet, MaybeDTD, !IO) :-
+ io.set_output_stream(Stream, OrigStream, !IO),
+ write_xml_doc(X, MaybeStyleSheet, MaybeDTD, !IO),
+ io.set_output_stream(OrigStream, _, !IO).
+
+write_xml_element(Indent, X, !IO) :-
+ Root = to_xml(X),
+ Root = elem(_, _, Children),
+ ( if contains_noformat_xml(Children) then
+ ChildrenFormat = no_format
+ else
+ ChildrenFormat = format
+ ),
+ write_xml_element_format(ChildrenFormat, Indent, Root, !IO).
+
+write_xml_element(Stream, Indent, X, !IO) :-
+ io.set_output_stream(Stream, OrigStream, !IO),
+ write_xml_element(Indent, X, !IO),
+ io.set_output_stream(OrigStream, _, !IO).
+
write_xml_doc(X, ElementMapping, MaybeStyleSheet, MaybeDTD, DTDResult, !IO) :-
DTDResult = can_generate_dtd(MaybeDTD, ElementMapping,
type_desc.type_of(X)),
(
DTDResult = ok
->
- get_element_pred(ElementMapping, MakeElement),
write_xml_header(no, !IO),
write_stylesheet_ref(MaybeStyleSheet, !IO),
write_doctype(canonicalize, X, ElementMapping, MaybeDTD, _,
!IO),
- write_xml_element(canonicalize, MakeElement, 0, X, !IO)
+ write_xml_element(canonicalize, ElementMapping, 0, X, !IO)
;
true
).
@@ -413,12 +587,12 @@
(
DTDResult = ok
->
- get_element_pred(ElementMapping, MakeElement),
write_xml_header(no, !IO),
write_stylesheet_ref(MaybeStyleSheet, !IO),
write_doctype(include_details_cc, X, ElementMapping, MaybeDTD,
_, !IO),
- write_xml_element(include_details_cc, MakeElement, 0, X, !IO)
+ write_xml_element(include_details_cc, ElementMapping,
+ 0, X, !IO)
;
true
).
@@ -430,8 +604,9 @@
DTDResult, !IO),
io.set_output_stream(OrigStream, _, !IO).
-write_xml_element(NonCanon, MakeElement, IndentLevel, X, !IO) :-
+write_xml_element(NonCanon, ElementMapping, IndentLevel, X, !IO) :-
type_to_univ(X, Univ),
+ get_element_pred(ElementMapping, MakeElement),
write_xml_element_univ(NonCanon, MakeElement, IndentLevel, Univ, [], _,
!IO).
@@ -449,8 +624,6 @@
write_dtd_from_type(TypeDesc, ElementMapping, DTDResult, !IO),
io.set_output_stream(OrigStream, _, !IO).
-:- pred write_xml_header(maybe(string)::in, io::di, io::uo) is det.
-
write_xml_header(MaybeEncoding, !IO) :-
io.write_string("<?xml version=""1.0""", !IO),
(
@@ -463,6 +636,11 @@
io.write_string("?>\n", !IO)
).
+write_xml_header(Stream, MaybeEncoding, !IO) :-
+ io.set_output_stream(Stream, OrigStream, !IO),
+ write_xml_header(MaybeEncoding, !IO),
+ io.set_output_stream(OrigStream, _, !IO).
+
:- pred write_stylesheet_ref(maybe_stylesheet::in, io::di, io::uo) is det.
write_stylesheet_ref(no_stylesheet, !IO).
@@ -499,6 +677,12 @@
Request = none_du
),
MakeElement(type_desc.type_of(T), Request, Root, _),
+ write_external_doctype(Root, DocType, !IO).
+
+:- pred write_external_doctype(string::in, doctype::in, io::di, io::uo)
+ is det.
+
+write_external_doctype(Root, DocType, !IO) :-
io.write_string("<!DOCTYPE ", !IO),
io.write_string(Root, !IO),
(
@@ -521,14 +705,14 @@
% Implementation of the `unique' predefined mapping scheme.
%
:- pred make_unique_element(type_desc.type_desc::in, maybe_functor_info::in,
- string::out, list(attribute)::out) is det.
+ string::out, list(attr_from_source)::out) is det.
% XXX This should be uncommented once memoing can be switched off for grades
% which don't support it.
% :- pragma memo(make_unique_element/4).
make_unique_element(TypeDesc, du_functor(Functor, Arity), Element,
- all_attributes) :-
+ all_attr_sources) :-
(
common_mercury_functor(Functor, ReservedElement)
->
@@ -538,34 +722,34 @@
),
Element = MangledElement ++ "--" ++ string.int_to_string(Arity) ++
"--" ++ mangle(type_desc.type_name(TypeDesc)).
-make_unique_element(TypeDesc, none_du, Element, Attributes) :-
+make_unique_element(TypeDesc, none_du, Element, AttrFromSources) :-
(
is_primitive_type(TypeDesc, PrimitiveElement)
->
Element = PrimitiveElement,
- Attributes = [attribute("type", type_name),
- attribute("field", field_name)]
+ AttrFromSources = [attr_from_source("type", type_name),
+ attr_from_source("field", field_name)]
;
is_array(TypeDesc, _)
->
Element = array_element ++ "--" ++
mangle(type_desc.type_name(TypeDesc)),
- Attributes = all_attributes
+ AttrFromSources = all_attr_sources
;
Element = mangle(type_desc.type_name(TypeDesc)),
- Attributes = all_attributes
+ AttrFromSources = all_attr_sources
).
% Implementation of the `simple' mapping scheme.
%
:- pred make_simple_element(type_desc.type_desc::in, maybe_functor_info::in,
- string::out, list(attribute)::out) is det.
+ string::out, list(attr_from_source)::out) is det.
% XXX This should be uncommented once memoing can be switched off for grades
% which don't support it.
% :- pragma memo(make_simple_element/4).
-make_simple_element(_, du_functor(Functor, _), Element, all_attributes) :-
+make_simple_element(_, du_functor(Functor, _), Element, all_attr_sources) :-
(
common_mercury_functor(Functor, ReservedElement)
->
@@ -573,30 +757,30 @@
;
Element = mangle(Functor)
).
-make_simple_element(TypeDesc, none_du, Element, Attributes) :-
+make_simple_element(TypeDesc, none_du, Element, AttrFromSources) :-
(
is_primitive_type(TypeDesc, PrimitiveElement)
->
Element = PrimitiveElement,
- Attributes = [attribute("type", type_name),
- attribute("field", field_name)]
+ AttrFromSources = [attr_from_source("type", type_name),
+ attr_from_source("field", field_name)]
;
is_array(TypeDesc, _)
->
Element = array_element,
- Attributes = all_attributes
+ AttrFromSources = all_attr_sources
;
Element = "Unknown",
- Attributes = all_attributes
+ AttrFromSources = all_attr_sources
).
-:- func all_attributes = list(attribute).
+:- func all_attr_sources = list(attr_from_source).
-all_attributes = [
- attribute("functor", functor),
- attribute("field", field_name),
- attribute("type", type_name),
- attribute("arity", arity)
+all_attr_sources = [
+ attr_from_source("functor", functor),
+ attr_from_source("field", field_name),
+ attr_from_source("type", type_name),
+ attr_from_source("arity", arity)
].
:- pred get_element_pred(element_mapping::in(element_mapping),
@@ -714,7 +898,7 @@
type_desc.type_desc::in, list(string)::out,
list(maybe(string))::out,
list(maybe(int))::out, list(list(type_desc.pseudo_type_desc))::out,
- list(list(attribute))::out) is det.
+ list(list(attr_from_source))::out) is det.
% XXX This should be uncommented once memoing can be switched off for grades
% which don't support it.
@@ -744,9 +928,9 @@
"get_functor failed for discriminated union"))
)
;
- MakeElement(TypeDesc, none_du, Element, Attributes),
+ MakeElement(TypeDesc, none_du, Element, AttrFromSources),
Elements = [Element],
- AttributeLists = [Attributes],
+ AttributeLists = [AttrFromSources],
MaybeFunctors = [no],
MaybeArities = [no],
(
@@ -784,6 +968,104 @@
%-----------------------------------------------------------------------------%
+ % The following type is used to decide if an entity should be
+ % formated (i.e. be indented and have a newline at the end).
+ % We do not format sibling entities if there is anything besides
+ % elements, Cdata or comments in the siblings, since then whitespaces
+ % are more likely to be significant.
+ % (Although technically spaces are always significant, they are
+ % usually interpreted as only formatting when they are between
+ % markup).
+ %
+:- type maybe_format
+ ---> format
+ ; no_format.
+
+:- pred write_xml_element_format(maybe_format::in, int::in, xml::in,
+ io::di, io::uo) is det.
+
+write_xml_element_format(Format, IndentLevel, elem(Name, Attrs, Children), !IO)
+ :-
+ maybe_indent(Format, IndentLevel, !IO),
+ (
+ Children = [],
+ write_empty_element(Name, Attrs, !IO),
+ maybe_nl(Format, !IO)
+ ;
+ Children = [_ | _],
+ write_element_start(Name, Attrs, !IO),
+ ( if contains_noformat_xml(Children) then
+ ChildrenFormat = no_format
+ else
+ ChildrenFormat = format,
+ io.nl(!IO)
+ ),
+ list.foldl(write_xml_element_format(ChildrenFormat,
+ IndentLevel + 1), Children, !IO),
+ maybe_indent(ChildrenFormat, IndentLevel, !IO),
+ write_element_end(Name, !IO),
+ maybe_nl(Format, !IO)
+ ).
+write_xml_element_format(_, _, data(Data), !IO) :-
+ write_xml_escaped_string(Data, !IO).
+write_xml_element_format(Format, IndentLevel, cdata(CData), !IO) :-
+ maybe_indent(Format, IndentLevel, !IO),
+ io.write_string("<![CDATA[", !IO),
+ % CData may not contain "]]>", so replace with "]]>".
+ string.replace_all(CData, "]]>", "]]>", EscapedCData),
+ io.write_string(EscapedCData, !IO),
+ io.write_string("]]>", !IO),
+ maybe_nl(Format, !IO).
+write_xml_element_format(Format, IndentLevel, comment(Comment), !IO) :-
+ maybe_indent(Format, IndentLevel, !IO),
+ io.write_string("<!-- ", !IO),
+ % Comments may not contain "--", so replace with " - ".
+ string.replace_all(Comment, "--", " - ", EscapedComment),
+ io.write_string(EscapedComment, !IO),
+ io.write_string(" -->", !IO),
+ maybe_nl(Format, !IO).
+write_xml_element_format(_, _, entity(EntityName), !IO) :-
+ io.write_char('&', !IO),
+ io.write_string(EntityName, !IO),
+ io.write_char(';', !IO).
+write_xml_element_format(_, _, raw(RawString), !IO) :-
+ io.write_string(RawString, !IO).
+
+:- func can_format_siblings(xml) = bool.
+
+can_format_siblings(elem(_, _, _)) = yes.
+can_format_siblings(data(_)) = no.
+can_format_siblings(cdata(_)) = yes.
+can_format_siblings(comment(_)) = yes.
+can_format_siblings(raw(_)) = no.
+can_format_siblings(entity(_)) = no.
+
+:- pred contains_noformat_xml(list(xml)::in) is semidet.
+
+contains_noformat_xml([XML | Rest]) :-
+ (
+ can_format_siblings(XML) = no
+ ;
+ contains_noformat_xml(Rest)
+ ).
+
+:- pred maybe_nl(maybe_format::in, io::di, io::uo) is det.
+
+maybe_nl(no_format, !IO).
+maybe_nl(format, !IO) :- io.nl(!IO).
+
+:- pred maybe_indent(maybe_format::in, int::in, io::di, io::uo) is det.
+
+maybe_indent(Format, Indent, !IO) :-
+ (
+ Format = format,
+ indent(Indent, !IO)
+ ;
+ Format = no_format
+ ).
+
+%-----------------------------------------------------------------------------%
+
:- pred write_xml_element_univ(deconstruct.noncanon_handling,
element_pred, int, univ, list(maybe(string)),
list(maybe(string)), io, io).
@@ -820,32 +1102,36 @@
;
Request = none_du
),
- MakeElement(TypeDesc, Request, Element, Attributes),
+ MakeElement(TypeDesc, Request, Element, AttrFromSources),
(
primitive_value(Univ, PrimValue)
->
indent(IndentLevel, !IO),
- write_primitive_element(Element, Attributes, PrimValue,
- MaybeFieldName, TypeDesc, !IO)
+ write_primitive_element_with_attr_from_source(Element,
+ AttrFromSources, PrimValue, MaybeFieldName, TypeDesc,
+ !IO)
;
(
Args = [],
indent(IndentLevel, !IO),
- write_empty_element(Element, Attributes, yes(Functor),
+ write_empty_element_with_attr_from_source(Element,
+ AttrFromSources, yes(Functor),
yes(Arity), MaybeFieldName, TypeDesc, !IO)
;
Args = [_ | _],
ChildMaybeFieldNames = get_field_names(TypeDesc,
Functor, Arity),
indent(IndentLevel, !IO),
- write_element_start(Element, Attributes, yes(Functor),
+ write_element_start_with_attr_from_source(Element,
+ AttrFromSources, yes(Functor),
yes(Arity), MaybeFieldName,
TypeDesc, !IO),
write_child_xml_elements(NonCanon, MakeElement,
IndentLevel + 1,
Args, ChildMaybeFieldNames, !IO),
indent(IndentLevel, !IO),
- write_element_end(Element, !IO)
+ write_element_end(Element, !IO),
+ io.nl(!IO)
)
).
@@ -990,89 +1276,132 @@
true
).
-:- pred write_primitive_element(string::in, list(attribute)::in, string::in,
- maybe(string)::in, type_desc.type_desc::in, io::di, io::uo) is det.
+:- pred write_primitive_element_with_attr_from_source(
+ string::in, list(attr_from_source)::in,
+ string::in, maybe(string)::in, type_desc.type_desc::in, io::di, io::uo)
+ is det.
-write_primitive_element(Element, Attributes, Value, MaybeFieldName,
- TypeDesc, !IO) :-
+write_primitive_element_with_attr_from_source(Element, AttrFromSources, Value,
+ MaybeField, TypeDesc, !IO) :-
io.write_string("<", !IO),
io.write_string(Element, !IO),
- list.foldl(write_attribute(no, no, TypeDesc, MaybeFieldName),
- Attributes, !IO),
+ Attrs = make_attrs_from_sources(no, no,
+ TypeDesc, MaybeField, AttrFromSources),
+ list.foldl(write_attribute, Attrs, !IO),
io.write_string(">", !IO),
write_xml_escaped_string(Value, !IO),
io.write_string("</", !IO),
io.write_string(Element, !IO),
io.write_string(">\n", !IO).
-:- pred write_element_start(string::in, list(attribute)::in, maybe(string)::in,
- maybe(int)::in, maybe(string)::in, type_desc.type_desc::in,
- io::di, io::uo) is det.
+:- pred write_element_start_with_attr_from_source(string::in,
+ list(attr_from_source)::in,
+ maybe(string)::in, maybe(int)::in, maybe(string)::in,
+ type_desc.type_desc::in, io::di, io::uo) is det.
-write_element_start(Element, Attributes, MaybeFunctor, MaybeArity, MaybeField,
- TypeDesc, !IO) :-
+write_element_start_with_attr_from_source(Element, AttrFromSources,
+ MaybeFunctor, MaybeArity, MaybeField, TypeDesc, !IO) :-
+ Attrs = make_attrs_from_sources(MaybeFunctor, MaybeArity,
+ TypeDesc, MaybeField, AttrFromSources),
+ write_element_start(Element, Attrs, !IO),
+ io.nl(!IO).
+
+:- pred write_element_start(string::in, list(attr)::in, io::di, io::uo) is det.
+
+write_element_start(Element, Attributes, !IO) :-
io.write_string("<", !IO),
io.write_string(Element, !IO),
- list.foldl(write_attribute(MaybeFunctor, MaybeArity, TypeDesc,
- MaybeField), Attributes, !IO),
- io.write_string(">\n", !IO).
+ list.foldl(write_attribute, Attributes, !IO),
+ io.write_string(">", !IO).
-:- pred write_empty_element(string::in, list(attribute)::in,
+:- pred write_empty_element_with_attr_from_source(string::in,
+ list(attr_from_source)::in,
maybe(string)::in, maybe(int)::in, maybe(string)::in,
type_desc.type_desc::in, io::di, io::uo) is det.
-write_empty_element(Element, Attributes, MaybeFunctor, MaybeArity, MaybeField,
- TypeDesc, !IO) :-
+write_empty_element_with_attr_from_source(Element, AttrFromSources,
+ MaybeFunctor, MaybeArity, MaybeField, TypeDesc, !IO) :-
+ Attrs = make_attrs_from_sources(MaybeFunctor, MaybeArity,
+ TypeDesc, MaybeField, AttrFromSources),
+ write_empty_element(Element, Attrs, !IO),
+ io.nl(!IO).
+
+:- pred write_empty_element(string::in, list(attr)::in, io::di, io::uo) is det.
+
+write_empty_element(Element, Attributes, !IO) :-
io.write_string("<", !IO),
io.write_string(Element, !IO),
- list.foldl(write_attribute(MaybeFunctor, MaybeArity, TypeDesc,
- MaybeField), Attributes, !IO),
- io.write_string(" />\n", !IO).
+ list.foldl(write_attribute, Attributes, !IO),
+ io.write_string(" />", !IO).
:- pred write_element_end(string::in, io::di, io::uo) is det.
write_element_end(Element, !IO) :-
io.write_string("</", !IO),
io.write_string(Element, !IO),
- io.write_string(">\n", !IO).
+ io.write_string(">", !IO).
-:- pred write_attribute(maybe(string)::in, maybe(int)::in,
- type_desc.type_desc::in, maybe(string)::in, attribute::in,
- io::di, io::uo) is det.
+:- func attr_from_source_to_maybe_attr(maybe(string),
+ maybe(int), type_desc.type_desc, maybe(string), attr_from_source)
+ = maybe(attr).
-write_attribute(MaybeFunctor, MaybeArity, TypeDesc, MaybeFieldName,
- attribute(Name, Source), !IO) :-
+attr_from_source_to_maybe_attr(MaybeFunctor, MaybeArity, TypeDesc,
+ MaybeFieldName, attr_from_source(Name, Source)) = MaybeAttr :-
(
Source = functor,
- MaybeValue = MaybeFunctor
+ (
+ MaybeFunctor = yes(Functor),
+ MaybeAttr = yes(attr(Name, Functor))
+ ;
+ MaybeFunctor = no,
+ MaybeAttr = no
+ )
;
Source = arity,
(
MaybeArity = yes(Arity),
- MaybeValue = yes(string.int_to_string(Arity))
+ MaybeAttr = yes(attr(Name,
+ string.int_to_string(Arity)))
;
MaybeArity = no,
- MaybeValue = no
+ MaybeAttr = no
)
;
Source = type_name,
- MaybeValue = yes(type_desc.type_name(TypeDesc))
+ MaybeAttr = yes(attr(Name, type_desc.type_name(TypeDesc)))
;
Source = field_name,
- MaybeValue = MaybeFieldName
- ),
- (
- MaybeValue = yes(Value)
- ->
- io.write_string(" ", !IO),
- io.write_string(Name, !IO),
- io.write_string("=""", !IO),
- write_xml_escaped_string(Value, !IO),
- io.write_string("""", !IO)
- ;
- true
+ (
+ MaybeFieldName = yes(FieldName),
+ MaybeAttr = yes(attr(Name, FieldName))
+ ;
+ MaybeFieldName = no,
+ MaybeAttr = no
+ )
).
+:- func make_attrs_from_sources(maybe(string), maybe(int), type_desc.type_desc,
+ maybe(string), list(attr_from_source)) = list(attr).
+
+make_attrs_from_sources(MaybeFunctor, MaybeArity, TypeDesc, MaybeField,
+ AttrFromSources) = Attrs :-
+ MaybeAttrs = list.map(attr_from_source_to_maybe_attr(MaybeFunctor,
+ MaybeArity, TypeDesc, MaybeField), AttrFromSources),
+ list.filter_map(is_maybe_yes, MaybeAttrs, Attrs).
+
+:- pred is_maybe_yes(maybe(T)::in, T::out) is semidet.
+
+is_maybe_yes(yes(X), X).
+
+:- pred write_attribute(attr::in, io::di, io::uo) is det.
+
+write_attribute(attr(Name, Value), !IO) :-
+ io.write_string(" ", !IO),
+ io.write_string(Name, !IO),
+ io.write_string("=""", !IO),
+ write_xml_escaped_string(Value, !IO),
+ io.write_string("""", !IO).
+
:- pred write_xml_escaped_string(string::in, io::di, io::uo) is det.
write_xml_escaped_string(Str, !IO) :-
@@ -1255,7 +1584,7 @@
% Write the IMPLIED, FIXED or REQUIRED part of the ATTLIST entry.
%
-:- pred write_attribute_source_kind(attribute_source::in, maybe(string)::in,
+:- pred write_attribute_source_kind(attr_source::in, maybe(string)::in,
io::di, io::uo) is det.
write_attribute_source_kind(functor, no, !IO) :-
@@ -1282,10 +1611,10 @@
% Write an ATTLIST entry for the given attribute.
%
:- pred write_dtd_attlist(string::in, maybe(string)::in, maybe(int)::in,
- type_desc.type_desc::in, attribute::in, io::di, io::uo) is det.
+ type_desc.type_desc::in, attr_from_source::in, io::di, io::uo) is det.
write_dtd_attlist(Element, MaybeFunctor, MaybeArity, TypeDesc,
- attribute(Name, Source), !IO) :-
+ attr_from_source(Name, Source), !IO) :-
(
Source = functor,
MaybeValue = MaybeFunctor
@@ -1313,13 +1642,14 @@
write_attribute_source_kind(Source, MaybeValue, !IO),
io.write_string(">\n", !IO).
-:- pred write_dtd_attlists(string::in, list(attribute)::in, maybe(string)::in,
- maybe(int)::in, type_desc.type_desc::in, io::di, io::uo) is det.
+:- pred write_dtd_attlists(string::in, list(attr_from_source)::in,
+ maybe(string)::in, maybe(int)::in, type_desc.type_desc::in,
+ io::di, io::uo) is det.
-write_dtd_attlists(Element, Attributes, MaybeFunctor, MaybeArity, TypeDesc,
- !IO) :-
+write_dtd_attlists(Element, AttrFromSources, MaybeFunctor, MaybeArity,
+ TypeDesc, !IO) :-
list.foldl(write_dtd_attlist(Element, MaybeFunctor, MaybeArity,
- TypeDesc), Attributes, !IO).
+ TypeDesc), AttrFromSources, !IO).
% Write DTD entries for all the functors for a type.
%
@@ -1343,7 +1673,7 @@
:- pred write_dtd_entries(element_pred::in(element_pred),
type_desc.type_desc::in, list(string)::in, list(maybe(string))::in,
list(maybe(int))::in, list(list(type_desc.type_desc))::in,
- list(list(attribute))::in, io::di, io::uo) is det.
+ list(list(attr_from_source))::in, io::di, io::uo) is det.
% Write all the given DTD entries.
%
@@ -1446,4 +1776,6 @@
io.write_list(Elements, "|", io.write_string, !IO)
).
+%-----------------------------------------------------------------------------%
+:- end_module term_to_xml.
%-----------------------------------------------------------------------------%
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.256
diff -u -r1.256 Mmakefile
--- tests/hard_coded/Mmakefile 23 May 2005 03:15:48 -0000 1.256
+++ tests/hard_coded/Mmakefile 22 Jul 2005 12:59:42 -0000
@@ -201,7 +201,8 @@
write \
write_reg1 \
write_reg2 \
- write_xml
+ write_xml \
+ xmlable_test
# JAVA_PASS_PROGS lists those tests which will succeed in grade Java.
Index: tests/hard_coded/write_xml.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/write_xml.m,v
retrieving revision 1.3
diff -u -r1.3 write_xml.m
--- tests/hard_coded/write_xml.m 15 Dec 2004 04:40:24 -0000 1.3
+++ tests/hard_coded/write_xml.m 22 Jul 2005 10:09:00 -0000
@@ -57,7 +57,7 @@
:- type wrap(T) ---> wrap(T).
:- pred p1(type_desc::in, maybe_functor_info::in, string::out,
- list(attribute)::out) is det.
+ list(attr_from_source)::out) is det.
p1(_, _, "X", []).
Index: tests/hard_coded/xmlable_test.exp
===================================================================
RCS file: tests/hard_coded/xmlable_test.exp
diff -N tests/hard_coded/xmlable_test.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/xmlable_test.exp 23 Jul 2005 02:42:14 -0000
@@ -0,0 +1,108 @@
+<?xml version="1.0"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html>
+ <head>
+ <title>Testing <123></title>
+ </head>
+ <!-- Hi - Mom! -->
+ <body><table border="1" cellspacing="0" cellpadding="5">
+ <tr>
+ <td>1</td>
+ <td>"one"</td>
+ </tr>
+ <tr>
+ <td>2</td>
+ <td>"two"</td>
+ </tr>
+ <tr>
+ <td>3</td>
+ <td>"three"</td>
+ </tr>
+ <tr>
+ <td>4</td>
+ <td>"four"</td>
+ </tr>
+ <tr>
+ <td>5</td>
+ <td>"five"</td>
+ </tr>
+ <tr>
+ <td>6</td>
+ <td>"six &<>!@$%^`&*()-+='"</td>
+ </tr>
+ </table><hr /> <!-- inline comment --><script type="text/javascript">
+ <![CDATA[document.write('hello');]]>
+ </script></body>
+</html>
+
+<?xml version="1.0"?>
+<html>
+ <head>
+ <title>Testing <123></title>
+ </head>
+ <!-- Hi - Mom! -->
+ <body><table border="1" cellspacing="0" cellpadding="5">
+ <tr>
+ <td>1</td>
+ <td>"one"</td>
+ </tr>
+ <tr>
+ <td>2</td>
+ <td>"two"</td>
+ </tr>
+ <tr>
+ <td>3</td>
+ <td>"three"</td>
+ </tr>
+ <tr>
+ <td>4</td>
+ <td>"four"</td>
+ </tr>
+ <tr>
+ <td>5</td>
+ <td>"five"</td>
+ </tr>
+ <tr>
+ <td>6</td>
+ <td>"six &<>!@$%^`&*()-+='"</td>
+ </tr>
+ </table><hr /> <!-- inline comment --><script type="text/javascript">
+ <![CDATA[document.write('hello');]]>
+ </script></body>
+</html>
+
+ <html>
+ <head>
+ <title>Testing <123></title>
+ </head>
+ <!-- Hi - Mom! -->
+ <body><table border="1" cellspacing="0" cellpadding="5">
+ <tr>
+ <td>1</td>
+ <td>"one"</td>
+ </tr>
+ <tr>
+ <td>2</td>
+ <td>"two"</td>
+ </tr>
+ <tr>
+ <td>3</td>
+ <td>"three"</td>
+ </tr>
+ <tr>
+ <td>4</td>
+ <td>"four"</td>
+ </tr>
+ <tr>
+ <td>5</td>
+ <td>"five"</td>
+ </tr>
+ <tr>
+ <td>6</td>
+ <td>"six &<>!@$%^`&*()-+='"</td>
+ </tr>
+ </table><hr /> <!-- inline comment --><script type="text/javascript">
+ <![CDATA[document.write('hello');]]>
+ </script></body>
+ </html>
+
Index: tests/hard_coded/xmlable_test.m
===================================================================
RCS file: tests/hard_coded/xmlable_test.m
diff -N tests/hard_coded/xmlable_test.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/xmlable_test.m 23 Jul 2005 02:40:24 -0000
@@ -0,0 +1,74 @@
+:- module xmlable_test.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module term_to_xml, map, svmap, std_util, list, string.
+
+main(!IO) :-
+ map.init(Map),
+ some [!Map] (
+ !:Map = Map,
+ svmap.set(1, "one", !Map),
+ svmap.set(2, "two", !Map),
+ svmap.set(3, "three", !Map),
+ svmap.set(4, "four", !Map),
+ svmap.set(5, "five", !Map),
+ svmap.set(6, "six &<>!@$%^`&*()-+='", !Map),
+ write_xml_doc(!.Map, no_stylesheet,
+ external(public("-//W3C//DTD XHTML 1.0 Strict//EN",
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd")),
+ !IO),
+ io.nl(!IO),
+ write_xml_doc(!.Map, !IO),
+ io.nl(!IO),
+ write_xml_element(2, !.Map, !IO)
+ ),
+ nl(!IO).
+
+:- instance xmlable(map(K, V)) where [
+ func(to_xml/1) is map_to_xhtml
+].
+
+:- func map_to_xhtml(map(K, V)::in) = (xml::out(xml_doc)) is det.
+
+map_to_xhtml(Map) =
+ elem("html", [], [
+ elem("head", [], [
+ elem("title", [], [
+ data("Testing <123>")
+ ])
+ ]),
+ comment("Hi -- Mom!"),
+ elem("body", [], [
+ elem("table",
+ [
+ attr("border", "1"),
+ attr("cellspacing", "0"),
+ attr("cellpadding", "5")
+ ],
+ Rows),
+ raw("<hr />"),
+ entity("nbsp"),
+ comment("inline comment"),
+ elem("script",
+ [attr("type", "text/javascript")],
+ [cdata("document.write('hello');")]
+ )
+ ])
+ ]) :-
+ map.to_assoc_list(Map, AssocList),
+ Rows = list.map(make_table_row, AssocList).
+
+:- func make_table_row(pair(K, V)) = xml.
+
+make_table_row(K - V) =
+ elem("tr", [], [
+ elem("td", [], [data(string.string(K))]),
+ elem("td", [], [data(string.string(V))])
+ ]).
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list