1/*  Part of SWI-Prolog WSDL pack
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2012, VU University Amsterdam
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalidate any other reasons why the executable file might be covered by
   27    the GNU General Public License.
   28*/
   29
   30:- module(xml_schema,
   31	  [ xsd_read/2,			% :File, +Options
   32	    xsd_load/2,			% :DOM, +Options
   33	    xsd_clean/1,		% :Options
   34	    xsd_create_element/3,	% +ElementName, +Values, -DOM
   35	    xsd_type_description/2,	% :DOM, -PrologType
   36	    xsd_element_documentation/3 % ?Element, ?Type, ?Documentation
   37	  ]).   38:- use_module(library(sgml)).   39:- use_module(library(xpath)).   40:- use_module(library(option)).   41:- use_module(library(error)).   42:- use_module(library(assoc)).   43:- use_module(library(apply)).   44
   45:- meta_predicate
   46	xsd_read(:, +),
   47	xsd_create_element(+, :, -),
   48	xsd_element_documentation(:, ?, ?),
   49	xsd_type_description(:, -),
   50	qualify_dom(+, -, 2, +).

Query XML Schema files

Provide a simple mapping between Prolog structures and an XML DOM structure that satisfies a given XSD type. Input is

How it works:

To be done
- This library is very incomplete. It currently only supports a few XML primitive types (string, integer and boolean). There is no clear view how to deal with abiguities and documents that demand complicated nesting. It mainly supports simple SOAP messages that typically require simple attribute-value pairs. */
 xsd_create_element(+ElementName, :Values, -DOM) is det
Create a valid XML DOM, given the name of the outer elements and a list of Name=Value pairs.
   81xsd_create_element(ElementName, Module:Values, DOM) :-
   82	var(DOM), !,
   83	must_be(list, Values),
   84	maplist(normalize_input, Values, Values1),
   85	xsd_create_element(ElementName, Values1, RestValues,
   86			   [], DOM, [module(Module)]),
   87	assertion(RestValues == []).
   88xsd_create_element(ElementName, Module:Values, DOM) :-
   89	xsd_create_element(ElementName, Values, [],
   90			   [], DOM, [module(Module)]).
   91
   92normalize_input(Name=Value, Name=Value) :- !.
   93normalize_input(Term, Name=Value) :-
   94	Term =.. [Name,Value], !.
   95normalize_input(Term, _) :-
   96	type_error(input_value, Term).
   97
   98xsd_create_element(ElementName,
   99		   Values, RestValues,
  100		   Path,
  101		   Element,
  102		   Options) :-
  103	find_element(ElementName, QName, Type, Options),
  104	create_element(QName, Type, Values, RestValues, Path, Element, Options).
  105
  106create_element(QName, Type, Values, RestValues, Path, Element, Options) :-
  107	Element = element(QName, Attrs, Content),
  108	fill_attributes(Type, Values, RestValues1, Attrs, Options),
  109	fill_content(Type, RestValues1, RestValues, [QName|Path],
  110		     Content, Options).
 fill_attributes(+Type, +Values, -RestValues, -Attributes, +Options)
fill_attributes(+Type, +Values, -RestValues, +Attributes, +Options)
Use values to fill attributes from type.
To be done
- Currently only the fallback clause
  120fill_attributes(_, Values0, Values, Attributes, _) :-
  121	var(Attributes), !,
  122	Attributes = [],
  123	Values = Values0.
  124fill_attributes(_, Values0, Values, Attributes, _) :-
  125	exclude(xmlns_attribute, Attributes, RealAttributes),
  126	append(RealAttributes, Values, Values0).
  127
  128xmlns_attribute(xmlns=_).
  129xmlns_attribute(xmlns:_=_).
 fill_content(+Type, +Values, -RestValues, +Path, -Content, +Options)
Fill the contents
  136fill_content('http://www.w3.org/2001/XMLSchema':string,
  137	     Values, RestValues, [_:Name|_], [Value], _Options) :- !,
  138	(   select(Name=Value, Values, RestValues)
  139	->  true
  140	;   existence_error(parameter, Name:'xsd:string')
  141	).
  142fill_content(Type, Values, RestValues, Path, Content, Options) :-
  143	option(module(M), Options),
  144	call(M:xsd_type(Type, Descr)), !,
  145	xml_fill_content(Descr, Values, RestValues, Path, Content, Options).
  146
  147xml_fill_content(Descr, Values, RestValues, Path, Content, Options) :-
  148	sequence_type(Descr, Seq, Options), !,
  149	findall(Part, xml_element_info(Seq, Part, Options), Parts),
  150	content(Parts, Values, RestValues, Path, Content, Options).
 xsd_type_description(:XMLDescription, -PrologDescription)
Transform an XSD type description into a readable Prolog one.
To be done
- Very incomplete.
  158xsd_type_description('http://www.w3.org/2001/XMLSchema':boolean, boolean) :- !.
  159xsd_type_description('http://www.w3.org/2001/XMLSchema':string, atom) :- !.
  160xsd_type_description('http://www.w3.org/2001/XMLSchema':integer, integer) :- !.
  161xsd_type_description(Module:XML, Prolog) :-
  162	xsd_type_description(XML, Prolog, [module(Module)]).
  163
  164xsd_type_description(XML, Prolog, Options) :-
  165	sequence_type(XML, Sequence, Options), !,
  166	Prolog = sequence(Sequence).
  167xsd_type_description(XML, Prolog, _Options) :-
  168	enum_type(XML, Values), !,
  169	Prolog = oneof(Values).
 sequence_type(+Description, -Sequence, +Options) is semidet
True if Description describes a sequence of elements. Currently deals with plain sequences and extensions of plain sequences.
Arguments:
Sequence- is a DOM element.
  179sequence_type(Descr, Seq, _) :-
  180	xpath_chk(Descr, /(_:complexType(self)), _),
  181	xpath_chk(Descr, _:sequence(self), Seq), !.
  182sequence_type(Descr, Seq, Options) :-
  183	xpath_chk(Descr, /(_:complexType(self)), _),
  184	xpath_chk(Descr, (_:complexContent)/(_:extension(@base=Base)), Ext),
  185	xpath_chk(Ext, _:sequence(self), ExtSeq),
  186	option(module(M), Options),
  187	call(M:xsd_type(Base, BaseDescr)),
  188	sequence_type(BaseDescr, BaseSeq, Options), !,
  189	append_content(BaseSeq, ExtSeq, Seq).
  190
  191append_content(element(Name, Attrs, Content0),
  192	       element(_, _, ExtraContent),
  193	       element(Name, Attrs, Content)) :-
  194	append(Content0, ExtraContent, Content).
 enum_type(+Description, -Values) is semidet
True when Descriptions describes an XSD type that is a restriction of string as an enumeration and Values is a list holding all enumerations.
  202enum_type(Descr, Values) :-
  203	xpath_chk(Descr, /(_:simpleType), _),
  204	xpath(Descr, /(_:simpleType)/(_:restriction(@base=_:string)), Res), !,
  205	findall(V, xpath(Res, _:enumeration(@value=V), _), Values).
 xml_element_info(+SequenceType, -Info, +Options) is nondet
Enumerate info about a sequence of elements.
Arguments:
Info- is a term c(ElementName, Type, ElOpts), where ElOpts is a list of additional options. Currently defined options are min_occurs(Min) and max_occurs(Max), where Max is unbounded or an integer and min is always an integer.
  217xml_element_info(Seq, Info, Options) :-
  218	xpath(Seq, _:element, Elem),
  219	element_info(Elem, Info, Options).
  220
  221element_info(Elem, c(Name,Type,Opts), _Options) :-
  222	xpath(Elem, /(_:element(@name=Name,@type=Type)), _),
  223	Elem = element(_, Attrs, _),
  224	elem_info(Attrs, Opts).
  225element_info(Elem, c(Ref,Type,Opts), Options) :-
  226	xpath(Elem, /(_:element(@ref=Ref)), _),
  227	option(module(M), Options),
  228	M:xsd_element(Ref, Type, _), !,
  229	Elem = element(_, Attrs, _),
  230	elem_info(Attrs, Opts).
  231
  232elem_info([], []).
  233elem_info([H|T], Opts) :-
  234	elem_info_1(H, Opt), !,
  235	Opts = [Opt|Rest],
  236	elem_info(T, Rest).
  237elem_info([_|T], Opts) :-
  238	elem_info(T, Opts).
  239
  240elem_info_1(minOccurs=Atom, min_occurs(N)) :- !,
  241	(   atom_number(Atom, N)
  242	->  true
  243	;   domain_error(number_text, Atom)
  244	).
  245elem_info_1(maxOccurs=Atom, max_occurs(N)) :- !,
  246	(   Atom == unbounded
  247	->  N = unbounded
  248	;   atom_number(Atom, N)
  249	->  true
  250	;   domain_error(number_text, Atom)
  251	).
  252
  253
  254content([], Values, Values, _, [], _).
  255content([H|T], Values0, Values, Path, Content, Options) :-
  256	content1(H, Values0, Values1, Path, Content, Tail, Options),
  257	content(T, Values1, Values, Path, Tail, Options).
  258
  259content1(c(Name,Type,Opts), Values0, Values1, Path, Content, Tail, Options) :-
  260	var(Content), !,
  261	Name = _NS:Local,
  262	(   complex_type(Type, Options)
  263	->  create_element(Name, Type, Values0, Values1, [Name|Path],
  264			   Element, Options),
  265	    Content = [Element|Tail]
  266	;   select(Local=Value, Values0, Values1)
  267	->  (   is_list(Value)
  268	    ->  check_cardinality(Value, Opts),
  269		maplist(map_make_element(Type, Name, Options), Value, Elements),
  270		append(Elements, Tail, Content)
  271	    ;   make_element(Type, Value, Name, Element, Options),
  272		Content = [Element|Tail]
  273	    )
  274	;   option(min_occurs(0), Opts)
  275	->  Tail = Content,
  276	    Values1 = Values0
  277	;   existence_error(parameter, Name:Type)
  278	).
  279content1(c(Name,Type,Opts), Values0, Values1, Path, Content, Tail, Options) :-
  280	Name = _NS:Local,
  281	partition(named(Name), Content, ValueElements, Tail),
  282	(   option(min_occurs(0), Opts),
  283	    ValueElements == []
  284	->  Values1 = Values0
  285	;   complex_type(Type, Options),
  286	    (   multi_valued(Opts)
  287	    ->	Values0 = [Local=Values|Values1],
  288		maplist(element_content(Type, Options, [Name|Path]),
  289			ValueElements, Values)
  290	    ;	ValueElements = [element(_,_,SubContent)],
  291		fill_content(Type, Values0, Values1, [Name|Path],
  292			     SubContent, Options)
  293	    )
  294	->  true
  295	;   multi_valued(Opts)
  296	->  Values0 = [Local=Values|Values1],
  297	    maplist(element_value(Name,Type,Options), ValueElements, Values)
  298	;   ValueElements = [ValueElement]
  299	->  Values0 = [Local=Value|Values1],
  300	    element_value(Name, Type, Options, ValueElement, Value)
  301	;   assertion(fail)
  302	).
  303
  304named(Name, element(Name,_,_)).
  305
  306multi_valued(Opts) :-
  307	option(max_occurs(NotOne), Opts), NotOne \== 1.
 complex_type(+Type, +Options) is semidet
True if Type is an XSD complex type.
  313complex_type(Type, Options) :-
  314	option(module(M), Options),
  315	M:xsd_type(Type, Descr),
  316	xpath(Descr, /(_:complexType), _), !.
  317
  318element_content(Type, Options, Path, element(_,_,Content), Value) :-
  319	fill_content(Type, Value, [], Path, Content, Options).
  320
  321element_value(Name, Type, Options, Element0, Value) :-
  322	strip_xmlns(Element0, Element),
  323	make_element(Type, Value, Name, Element, Options).
  324
  325strip_xmlns(element(Name, Atts0, Content),
  326	    element(Name, Atts,  Content)) :-
  327	exclude(xmlns_attribute, Atts0, Atts).
  328
  329map_make_element(Type, Name, Options, Value, Element) :-
  330	make_element(Type, Value, Name, Element, Options).
 make_element(+Type, +Value, +Name, -Element, +Options) is det
Create a DOM Element with tag Name, creating the content from Value, given that the content is of type Type.
  337make_element('http://www.w3.org/2001/XMLSchema':string,
  338	     Value, Name, element(Name, [], [Value]), _) :- !.
  339make_element('http://www.w3.org/2001/XMLSchema':language,
  340	     Value, Name, element(Name, [], [Value]), _) :- !.
  341make_element('http://www.w3.org/2001/XMLSchema':boolean,
  342	     Value, Name, element(Name, [], [Value]), _) :- !,
  343	must_be(boolean, Value).
  344make_element('http://www.w3.org/2001/XMLSchema':integer,
  345	     Value, Name, element(Name, [], [Atom]), _) :- !,
  346	atom_number(Atom, Value).
  347make_element('http://www.w3.org/2001/XMLSchema':nonNegativeInteger,
  348	     Value, Name, element(Name, [], [Atom]), _) :- !,
  349	atom_number(Atom, Value),
  350	must_be(nonneg, Value).
  351make_element('http://www.w3.org/2001/XMLSchema':base64Binary,
  352	     Value, Name, element(Name, [], [Encoded]), _) :- !,
  353	base64(Value, Encoded).
  354make_element('http://www.w3.org/2001/XMLSchema':dateTime,
  355	     Stamp, Name, element(Name, [], [Value]), _) :- !,
  356	(   nonvar(Value)
  357	->  parse_time(Value, Stamp)
  358	;   number(Stamp), Stamp > 3000		% Time stamp, not a year
  359	->  format_time(atom(Value), '%FT%T%:z', Stamp)
  360	;   Value = Stamp			% User supplied time
  361	).
  362make_element(Type, Value, Name, Element, Options) :-
  363	option(module(M), Options),
  364	M:xsd_type(Type, Descr),
  365	xpath(Descr, /(_:simpleType)/(_:restriction(@base=Base)), _), !,
  366	make_element(Base, Value, Name, Element, Options).
  367make_element(Type, Value, Name, element(Name, [], [Value]), _) :-
  368	(   debugging(soap)
  369	->  print_message(warning, literal_type(Type))
  370	;   true
  371	).
  372
  373check_cardinality(Value, Options) :-
  374	option(max_occurs(Max), Options), !,
  375	(   (   Max == unbounded
  376	    ;	length(Value, Len),
  377		Len =< Max
  378	    )
  379	->  (   option(min_occurs(Min), Options),
  380	        Len < Min
  381	    ->	domain_error(min_occurs(Min), Value)
  382	    ;	true
  383	    )
  384	;   domain_error(max_occurs(Max), Value)
  385	).
  386check_cardinality(Value, Options) :-
  387	option(min_occurs(Min), Options), !,
  388	length(Value, Len),
  389	(   Len >= Min
  390	->  true
  391	;   domain_error(min_occurs(Min), Value)
  392	).
 xsd_read(:File, +Options) is det
Read definitions from File. Asserts the following facts:
xsd_element(Name, Type, Options)
xsd_type(Type, Description)
Description is simply the XSD DOM
  403xsd_read(Module:File, Options) :-
  404	(   option(namespace(NameSpace), Options)
  405	->  LoadOptions = [xmlns(NameSpace)]
  406	;   LoadOptions = []
  407	),
  408	load_structure(File, [Schema],
  409		       [ dialect(xmlns),
  410			 space(remove)
  411		       | LoadOptions
  412		       ]),
  413	prefix_map(Schema, PrefixMap),
  414	(   xpath(Schema, /(_:schema(@targetNamespace)), TargetNameSpace)
  415	->  TSOptions = [target_namespace(TargetNameSpace)]
  416	;   TSOptions = []
  417	),
  418	merge_options([ file(File),
  419			prefixmap(PrefixMap)
  420		      | TSOptions
  421		      ],
  422		      Options, NewOptions),
  423
  424	xsd_load(Module:Schema, NewOptions).
  425
  426prefix_map(element(_, Attrs, _), PrefixMap) :-
  427	prefix_list(Attrs, Pairs),
  428	list_to_assoc(Pairs, PrefixMap).
  429
  430prefix_list([], []).
  431prefix_list([xmlns:Name=Prefix|T0], [Name-Prefix|T]) :- !,
  432	prefix_list(T0, T).
  433prefix_list([xmlns=Prefix|T0], [''-Prefix|T]) :- !,
  434	prefix_list(T0, T).
  435prefix_list([_|T0], T) :-
  436	prefix_list(T0, T).
 xsd_load(:Schema, +Options)
Build XSD types from a parsed XML xsd:schema DOM structure.
  443xsd_load(Module:Schema, Options) :-
  444	xsd_clean(Module:Options),
  445	extract_imports(Schema, Module, Options),
  446	extract_elements(Schema, Module, Options),
  447	extract_types(Schema, Module, Options).
  448
  449xsd_clean(Module:Options) :-
  450	(   option(cleanup(true), Options, true)
  451	->  retractall(Module:xsd_element(_,_,_)),
  452	    retractall(Module:xsd_type(_,_))
  453	;   true
  454	).
  455
  456extract_imports(Schema, Module, Options) :-
  457	forall(xpath(Schema, _:import(@namespace=NameSpace,
  458				      @schemaLocation=Import), _),
  459	       import_schema(Import, NameSpace, Module, Options)).
  460
  461import_schema(File, NameSpace, Module, Options) :-
  462	option(file(RelativeTo), Options),
  463	absolute_file_name(File, Path,
  464			   [ access(read),
  465			     relative_to(RelativeTo)
  466			   ]),
  467	merge_options([ namespace(NameSpace)
  468		      ], Options, NewOptions),
  469	xsd_read(Module:Path, [cleanup(false)|NewOptions]).
  470
  471
  472extract_elements(Schema, Module, Options) :-
  473	forall(xpath(Schema, _:element(@name=Name), Element),
  474	       extract_element(Element, Name, Module, Options)).
  475
  476extract_element(Element, Name, Module, Options) :-
  477	xpath(Element, /(_:element(@type)), Type), !,
  478	qualify_name(Name, QName, Options),
  479	qualify_name(Type, QType, Options),
  480	element_options(Element, ElOpts),
  481	assert_element(QName, QType, ElOpts, Module).
  482extract_element(Element, Name, Module, Options) :-
  483	Element = element(_, _, [Description]),
  484	qualify_name(Name, QName, Options),
  485	(   QName = Prefix:Local
  486	->  atomic_list_concat([typeof_, Prefix, :, Local], Type)
  487	;   assertion(fail)
  488	),
  489	qualify_dom(Description, QDescription, qattr, Options),
  490	element_options(Element, ElOpts),
  491	assert_element(QName, Type, ElOpts, Module),
  492	assert_type(Type, QDescription, Module).
  493
  494assert_element(QName, QType, ElOpts, Module) :-
  495	Module:xsd_element(QName, QType, ElOpts), !.
  496assert_element(QName, QType, ElOpts, Module) :-
  497	assertz(Module:xsd_element(QName, QType, ElOpts)).
  498
  499assert_type(Type, QDescription, Module) :-
  500	Module:xsd_type(Type, QDescription), !.
  501assert_type(Type, QDescription, Module) :-
  502	assertz(Module:xsd_type(Type, QDescription)).
  503
  504
  505element_options(Element, Documentation) :-
  506	findall(documentation(Doc),
  507		xpath(Element, //(_:documentation(text)), Doc),
  508		Documentation).
  509
  510qattr(type, xmlns).
  511qattr(base, xmlns).
  512qattr(name, tns).
  513qattr(ref,  tns).
  514
  515extract_types(Schema, Module, Options) :-
  516	forall(xpath(Schema, _:complexType(@name=Type), Description),
  517	       ( qualify_name(Type, QType, Options),
  518		 qualify_dom(Description, QDescription, qattr, Options),
  519		 assertz(Module:xsd_type(QType, QDescription)))),
  520	forall(xpath(Schema, _:simpleType(@name=Type), Description),
  521	       ( qualify_name(Type, QType, Options),
  522		 qualify_dom(Description, QDescription, qattr, Options),
  523		 assertz(Module:xsd_type(QType, QDescription)))).
 find_element(+Name, -QName, -Type, +Options) is det
Find an element from Name.
Errors
- existence_error(xsd_element, Name)
  532find_element(QName, QName, Type, Options) :-
  533	option(module(M), Options),
  534	M:xsd_element(QName, Type, _), !.
  535find_element(Name, _, _, _) :-
  536	existence_error(xsd_element, Name).
  537
  538
  539		 /*******************************
  540		 *	       UTIL		*
  541		 *******************************/
 qualify_name(+Name, -QName, -Options) is det
  545qualify_name(Name, QName, Options) :-
  546	qualify_name(Name, tns, QName, Options).
  547
  548qualify_name(Name, _, Prefix:LN, Options) :-
  549	sub_atom(Name, B, _, A, :), !,
  550	sub_atom(Name, 0, B, _, NS),
  551	sub_atom(Name, _, A, 0, LN),
  552	option(prefixmap(PrefixMap), Options),
  553	(   get_assoc(NS, PrefixMap, Prefix)
  554	->  true
  555	;   existence_error(namespace, NS)
  556	).
  557qualify_name(Name, xmlns, Prefix:Name, Options) :- !,
  558	option(prefixmap(PrefixMap), Options),
  559	get_assoc('', PrefixMap, Prefix),
  560	(   Prefix == 'http://www.w3.org/2001/XMLSchema'
  561	->  true
  562	;   writeln(Prefix)
  563	).
  564qualify_name(Name, tns, Prefix:Name, Options) :-
  565	option(target_namespace(Prefix), Options).
 qualify_dom(+DOM, -QDOM, :Qualify, +Options) is det
Qualify attributes in DOM for which call(Qualify, Attr) is try.
  571qualify_dom(element(Name,  Attrs,  Content),
  572	    element(Name, QAttrs, QContent),
  573	    Qualify, Options) :- !,
  574	maplist(qualify_attr(Qualify, Options), Attrs, QAttrs),
  575	qualify_content(Content, QContent, Qualify, Options).
  576qualify_dom(DOM, DOM, _, _).
  577
  578qualify_attr(Qualify, Options, Name=Value, Name=QValue) :-
  579	atom(Value),
  580	call(Qualify, Name, How), !,
  581	qualify_name(Value, How, QValue, Options).
  582qualify_attr(_, _, Attr, Attr).
  583
  584qualify_content([], [], _, _).
  585qualify_content([H0|T0], [H|T], Qualify, Options) :-
  586	qualify_dom(H0, H, Qualify, Options),
  587	qualify_content(T0, T, Qualify, Options).
  588
  589
  590		 /*******************************
  591		 *	  DOCUMENTATION		*
  592		 *******************************/
 xsd_element_documentation(:Element, ?Type, ?Doc)
Element is the local name (i.e., without namespace)
  598xsd_element_documentation(Module:Element, Type, Doc) :-
  599	Term = element_documentation(Element, Type, Doc, Module),
  600	setof(Term, Term, Results),
  601	member(Term, Results).
  602
  603element_documentation(Element, Type, Doc, Module) :-
  604	Module:xsd_element(_:Element, TypeName, Doc),
  605	type_description(TypeName, Type, Module).
  606element_documentation(Element, Type, Doc, Module) :-
  607	Module:xsd_type(_Type, Descr),
  608	xpath(Descr, //(_:element(@name=(_:Element), @type=TypeName)), DOM),
  609	element_options(DOM, Doc),
  610	type_description(TypeName, Type, Module).
  611
  612type_description(TypeName, Type, Module) :-
  613	Module:xsd_type(TypeName, TypeDOM), !,
  614	(   xsd_type_description(Module:TypeDOM, Type)
  615	->  true
  616	;   Type = TypeDOM
  617	).
  618type_description(TypeName, Type, _) :-
  619	xsd_type_description(TypeName, Type), !.
  620type_description(TypeName, TypeName, _)