Queries improved, all tests in adl.to-hugsql-queries-test pass.
This commit is contained in:
parent
5cf0a4cbed
commit
dcbe9ee01b
|
|
@ -11,7 +11,7 @@
|
||||||
<!-- Copyright: (c) 2007 Cygnet Solutions -->
|
<!-- Copyright: (c) 2007 Cygnet Solutions -->
|
||||||
<!-- -->
|
<!-- -->
|
||||||
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
|
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
$Revision: 1.5 $
|
$Revision: 1.5 $
|
||||||
-->
|
-->
|
||||||
|
|
@ -24,8 +24,8 @@
|
||||||
<!-- Before we start: some useful definitions -->
|
<!-- Before we start: some useful definitions -->
|
||||||
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
|
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
|
||||||
|
|
||||||
<!-- some basic character entities inherited from HTML. Actually we probably ought to
|
<!-- some basic character entities inherited from HTML. Actually we probably ought to
|
||||||
import all the HTML4 character entity files, and possibly the HTML4 Strict DTD (so
|
import all the HTML4 character entity files, and possibly the HTML4 Strict DTD (so
|
||||||
that we can allow HTML block level entities within content elements -->
|
that we can allow HTML block level entities within content elements -->
|
||||||
<!ENTITY nbsp " ">
|
<!ENTITY nbsp " ">
|
||||||
<!ENTITY pound "£">
|
<!ENTITY pound "£">
|
||||||
|
|
@ -35,7 +35,7 @@ that we can allow HTML block level entities within content elements -->
|
||||||
<!-- boolean means true or false -->
|
<!-- boolean means true or false -->
|
||||||
<!ENTITY % Boolean "(true|false)" >
|
<!ENTITY % Boolean "(true|false)" >
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
Locale is a string comprising an ISO 639 language code followed by a space
|
Locale is a string comprising an ISO 639 language code followed by a space
|
||||||
followed by an ISO 3166 country code, or else the string 'default'. See:
|
followed by an ISO 3166 country code, or else the string 'default'. See:
|
||||||
<URL:http://www.ics.uci.edu/pub/ietf/http/related/iso639.txt>
|
<URL:http://www.ics.uci.edu/pub/ietf/http/related/iso639.txt>
|
||||||
|
|
@ -43,12 +43,12 @@ that we can allow HTML block level entities within content elements -->
|
||||||
-->
|
-->
|
||||||
<!ENTITY % Locale "CDATA" >
|
<!ENTITY % Locale "CDATA" >
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
permissions a group may have on an entity, list, page, form or field
|
permissions a group may have on an entity, list, page, form or field
|
||||||
permissions are deemed to increase as you go right. A group cannot
|
permissions are deemed to increase as you go right. A group cannot
|
||||||
have greater permission on a field than on the form it is in, or
|
have greater permission on a field than on the form it is in, or
|
||||||
greater permission on form than the entity it belongs to
|
greater permission on form than the entity it belongs to
|
||||||
|
|
||||||
none: none
|
none: none
|
||||||
read: select
|
read: select
|
||||||
insert: insert
|
insert: insert
|
||||||
|
|
@ -61,10 +61,10 @@ that we can allow HTML block level entities within content elements -->
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
actions which should be cascaded to dependent objects. All these values except
|
actions which should be cascaded to dependent objects. All these values except
|
||||||
'manual' are taken from Hibernate and should be passed through the adl2hibernate
|
'manual' are taken from Hibernate and should be passed through the adl2hibernate
|
||||||
mapping transparently. Relevent only for properties with type='entity', type='link'
|
mapping transparently. Relevent only for properties with type='entity', type='link'
|
||||||
and type='list'
|
and type='list'
|
||||||
|
|
||||||
all : cascade delete, save and update
|
all : cascade delete, save and update
|
||||||
all-delete-orphan : see hibernate documentation; relates to transient objects only
|
all-delete-orphan : see hibernate documentation; relates to transient objects only
|
||||||
delete : cascade delete actions, but not save and update
|
delete : cascade delete actions, but not save and update
|
||||||
|
|
@ -74,10 +74,10 @@ that we can allow HTML block level entities within content elements -->
|
||||||
-->
|
-->
|
||||||
<!ENTITY % CascadeActions "all|all-delete-orphan|delete|manual|save-update">
|
<!ENTITY % CascadeActions "all|all-delete-orphan|delete|manual|save-update">
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
data types which can be used in a typedef to provide validation -
|
data types which can be used in a typedef to provide validation -
|
||||||
e.g. a string can be used with a regexp or a scalar can be used with
|
e.g. a string can be used with a regexp or a scalar can be used with
|
||||||
min and max values
|
min and max values
|
||||||
string: varchar java.sql.Types.VARCHAR
|
string: varchar java.sql.Types.VARCHAR
|
||||||
integer: int java.sql.Types.INTEGER
|
integer: int java.sql.Types.INTEGER
|
||||||
real: double java.sql.Types.DOUBLE
|
real: double java.sql.Types.DOUBLE
|
||||||
|
|
@ -85,26 +85,26 @@ that we can allow HTML block level entities within content elements -->
|
||||||
date: date java.sql.Types.DATE
|
date: date java.sql.Types.DATE
|
||||||
time: time java.sql.Types.TIME
|
time: time java.sql.Types.TIME
|
||||||
timestamp: timestamp java.sql.Types.TIMESTAMP
|
timestamp: timestamp java.sql.Types.TIMESTAMP
|
||||||
uploadable: varchar java.sql.Types.VARCHAR
|
uploadable: varchar java.sql.Types.VARCHAR
|
||||||
image: varchar java.sql.Types.VARCHAR
|
image: varchar java.sql.Types.VARCHAR
|
||||||
|
|
||||||
uploadable is as string but points to an uploaded file; image is as
|
uploadable is as string but points to an uploaded file; image is as
|
||||||
uploadable but points to an uploadable graphical image file
|
uploadable but points to an uploadable graphical image file
|
||||||
-->
|
-->
|
||||||
<!ENTITY % DefinableDataTypes "string|integer|real|money|date|time|timestamp|uploadable" >
|
<!ENTITY % DefinableDataTypes "string|integer|real|money|date|time|timestamp|uploadable" >
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
data types which are fairly straightforward translations of JDBC data types
|
data types which are fairly straightforward translations of JDBC data types
|
||||||
boolean: boolean or java.sql.Types.BIT
|
boolean: boolean or java.sql.Types.BIT
|
||||||
char(1) java.sql.Types.CHAR
|
char(1) java.sql.Types.CHAR
|
||||||
text: text or java.sql.Types.LONGVARCHAR
|
text: text or java.sql.Types.LONGVARCHAR
|
||||||
memo java.sql.Types.CLOB
|
memo java.sql.Types.CLOB
|
||||||
-->
|
-->
|
||||||
<!ENTITY % SimpleDataTypes "%DefinableDataTypes;|boolean|text" >
|
<!ENTITY % SimpleDataTypes "%DefinableDataTypes;|boolean|text" >
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
data types which are more complex than SimpleDataTypes...
|
data types which are more complex than SimpleDataTypes...
|
||||||
entity : a foreign key link to another entity (i.e. the 'many' end of a
|
entity : a foreign key link to another entity (i.e. the 'many' end of a
|
||||||
one-to-many link);
|
one-to-many link);
|
||||||
list : a list of some other entity that links to me (i.e. the 'one' end of
|
list : a list of some other entity that links to me (i.e. the 'one' end of
|
||||||
a one-to-many link);
|
a one-to-many link);
|
||||||
|
|
@ -114,7 +114,7 @@ that we can allow HTML block level entities within content elements -->
|
||||||
<!ENTITY % ComplexDataTypes "entity|link|list|defined" >
|
<!ENTITY % ComplexDataTypes "entity|link|list|defined" >
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
data types which require special handling - which don't simply map onto
|
data types which require special handling - which don't simply map onto
|
||||||
common SQL data types
|
common SQL data types
|
||||||
geopos : a latitude/longitude pair (experimental and not yet implemented)
|
geopos : a latitude/longitude pair (experimental and not yet implemented)
|
||||||
image : a raster image file, in jpeg|gif|png format (experimental, not yet implemented)
|
image : a raster image file, in jpeg|gif|png format (experimental, not yet implemented)
|
||||||
|
|
@ -142,17 +142,17 @@ that we can allow HTML block level entities within content elements -->
|
||||||
present)
|
present)
|
||||||
user-distinct: all properties which are user-distinct (NOTE: Not yet implemented)
|
user-distinct: all properties which are user-distinct (NOTE: Not yet implemented)
|
||||||
listed: only those properties for which fields are explicitly listed
|
listed: only those properties for which fields are explicitly listed
|
||||||
-->
|
-->
|
||||||
<!ENTITY % PageAttrs
|
<!ENTITY % PageAttrs
|
||||||
"name CDATA #REQUIRED
|
"name CDATA #REQUIRED
|
||||||
properties (all|user-distinct|listed) #REQUIRED" >
|
properties (all|user-distinct|listed) #REQUIRED" >
|
||||||
|
|
||||||
<!-- Actions for generators (mainly for keyfields - see entity 'generator', below
|
<!-- Actions for generators (mainly for keyfields - see entity 'generator', below
|
||||||
assigned: In manually-maintained code, you contract to assign a value
|
assigned: In manually-maintained code, you contract to assign a value
|
||||||
to this property before it is persisted.
|
to this property before it is persisted.
|
||||||
guid: The system will supply a unique GUid value to this field
|
guid: The system will supply a unique GUid value to this field
|
||||||
before it is persisted.
|
before it is persisted.
|
||||||
mannual: You contract to supply a generatos class in manually maintained
|
mannual: You contract to supply a generator class in manually maintained
|
||||||
code.
|
code.
|
||||||
native: The database will supply a unique value to this field when it
|
native: The database will supply a unique value to this field when it
|
||||||
is persisted; the value will be an integer. RECOMMENDED!
|
is persisted; the value will be an integer. RECOMMENDED!
|
||||||
|
|
@ -163,7 +163,7 @@ that we can allow HTML block level entities within content elements -->
|
||||||
canonical: Whatever the normal canonical ordering for this datatype is -
|
canonical: Whatever the normal canonical ordering for this datatype is -
|
||||||
typically alpha-numeric, except for dates, etc.
|
typically alpha-numeric, except for dates, etc.
|
||||||
reverse-canonical: The reverse of the above
|
reverse-canonical: The reverse of the above
|
||||||
|
|
||||||
possibly there should be some further values but I have no idea what these are
|
possibly there should be some further values but I have no idea what these are
|
||||||
-->
|
-->
|
||||||
<!ENTITY % Sequences "canonical|reverse-canonical">
|
<!ENTITY % Sequences "canonical|reverse-canonical">
|
||||||
|
|
@ -172,9 +172,9 @@ that we can allow HTML block level entities within content elements -->
|
||||||
<!-- Elements -->
|
<!-- Elements -->
|
||||||
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
|
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
the application that the document describes: required top level element
|
the application that the document describes: required top level element
|
||||||
|
|
||||||
name: the name of this application
|
name: the name of this application
|
||||||
version: the version number of this application
|
version: the version number of this application
|
||||||
revision: the revision of the ADL document
|
revision: the revision of the ADL document
|
||||||
|
|
@ -182,14 +182,14 @@ that we can allow HTML block level entities within content elements -->
|
||||||
xmlns: XML namespace, in case required
|
xmlns: XML namespace, in case required
|
||||||
-->
|
-->
|
||||||
<!ELEMENT application ( specification*, documentation?, content?, typedef*, group*, entity*)>
|
<!ELEMENT application ( specification*, documentation?, content?, typedef*, group*, entity*)>
|
||||||
<!ATTLIST application
|
<!ATTLIST application
|
||||||
name CDATA #REQUIRED
|
name CDATA #REQUIRED
|
||||||
version CDATA #IMPLIED
|
version CDATA #IMPLIED
|
||||||
revision CDATA #IMPLIED
|
revision CDATA #IMPLIED
|
||||||
currency CDATA #IMPLIED
|
currency CDATA #IMPLIED
|
||||||
xmlns CDATA #IMPLIED>
|
xmlns CDATA #IMPLIED>
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
the definition of a defined type. At this stage a defined type is either
|
the definition of a defined type. At this stage a defined type is either
|
||||||
a string in which case it must have size and pattern, or
|
a string in which case it must have size and pattern, or
|
||||||
a scalar in which case it must have minimum and/or maximum
|
a scalar in which case it must have minimum and/or maximum
|
||||||
|
|
@ -208,7 +208,7 @@ that we can allow HTML block level entities within content elements -->
|
||||||
-->
|
-->
|
||||||
<!ELEMENT typedef (documentation?, in-implementation*, help*) >
|
<!ELEMENT typedef (documentation?, in-implementation*, help*) >
|
||||||
|
|
||||||
<!ATTLIST typedef
|
<!ATTLIST typedef
|
||||||
name CDATA #REQUIRED
|
name CDATA #REQUIRED
|
||||||
type (%DefinableDataTypes;) #IMPLIED
|
type (%DefinableDataTypes;) #IMPLIED
|
||||||
size CDATA #IMPLIED
|
size CDATA #IMPLIED
|
||||||
|
|
@ -218,12 +218,12 @@ that we can allow HTML block level entities within content elements -->
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
information about how to translate a type into types known to different target
|
information about how to translate a type into types known to different target
|
||||||
languages. TODO: Once again I'm not wholly comfortable with the name; I'm not
|
languages. TODO: Once again I'm not wholly comfortable with the name; I'm not
|
||||||
really comfortable that this belongs in ADL at all.
|
really comfortable that this belongs in ADL at all.
|
||||||
|
|
||||||
target: the target language
|
target: the target language
|
||||||
value: the type to use in that target language
|
value: the type to use in that target language
|
||||||
kind: OK, I confess I don't understand this, but Andrew needs it...
|
kind: OK, I confess I don't understand this, but Andrew needs it...
|
||||||
-->
|
-->
|
||||||
<!ELEMENT in-implementation (documentation?)>
|
<!ELEMENT in-implementation (documentation?)>
|
||||||
|
|
||||||
|
|
@ -232,28 +232,28 @@ that we can allow HTML block level entities within content elements -->
|
||||||
value CDATA #REQUIRED
|
value CDATA #REQUIRED
|
||||||
kind CDATA #IMPLIED>
|
kind CDATA #IMPLIED>
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
a group of people with similar permissions to one another
|
a group of people with similar permissions to one another
|
||||||
|
|
||||||
name: the name of this group
|
name: the name of this group
|
||||||
parent: the name of a group of which this group is subset
|
parent: the name of a group of which this group is subset
|
||||||
-->
|
-->
|
||||||
<!ELEMENT group (documentation?)>
|
<!ELEMENT group (documentation?)>
|
||||||
|
|
||||||
<!ATTLIST group
|
<!ATTLIST group
|
||||||
name CDATA #REQUIRED
|
name CDATA #REQUIRED
|
||||||
parent CDATA #IMPLIED>
|
parent CDATA #IMPLIED>
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
an entity which has properties and relationships; maps onto a database
|
an entity which has properties and relationships; maps onto a database
|
||||||
table or a Java serialisable class - or, of course, various other things
|
table or a Java serialisable class - or, of course, various other things
|
||||||
|
|
||||||
name: obviously, the name of this entity
|
name: obviously, the name of this entity
|
||||||
natural-key: if present, the name of a property of this entity which forms
|
natural-key: if present, the name of a property of this entity which forms
|
||||||
a natural primary key [NOTE: Only partly implemented. NOTE: much of
|
a natural primary key [NOTE: Only partly implemented. NOTE: much of
|
||||||
the present implementation assumes all primary keys will be
|
the present implementation assumes all primary keys will be
|
||||||
integers. This needs to be fixed!] DEPRECATED: remove; replace with the
|
integers. This needs to be fixed!] DEPRECATED: remove; replace with the
|
||||||
'key' element, below.
|
'key' element, below.
|
||||||
table: the name of the table in which this entity is stored. Defaults to same
|
table: the name of the table in which this entity is stored. Defaults to same
|
||||||
|
|
@ -264,13 +264,13 @@ that we can allow HTML block level entities within content elements -->
|
||||||
-->
|
-->
|
||||||
<!ELEMENT entity ( documentation?, prompt*, content?, key?,
|
<!ELEMENT entity ( documentation?, prompt*, content?, key?,
|
||||||
property*, permission*, (form | page | list)*)>
|
property*, permission*, (form | page | list)*)>
|
||||||
<!ATTLIST entity
|
<!ATTLIST entity
|
||||||
name CDATA #REQUIRED
|
name CDATA #REQUIRED
|
||||||
natural-key CDATA #IMPLIED
|
natural-key CDATA #IMPLIED
|
||||||
table CDATA #IMPLIED
|
table CDATA #IMPLIED
|
||||||
foreign %Boolean; #IMPLIED>
|
foreign %Boolean; #IMPLIED>
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
contains documentation on the element which immediately contains it. TODO:
|
contains documentation on the element which immediately contains it. TODO:
|
||||||
should HTML markup within a documentation element be allowed? If so, are
|
should HTML markup within a documentation element be allowed? If so, are
|
||||||
there restrictions?
|
there restrictions?
|
||||||
|
|
@ -284,33 +284,33 @@ that we can allow HTML block level entities within content elements -->
|
||||||
<!ELEMENT key (property*)>
|
<!ELEMENT key (property*)>
|
||||||
|
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
a property (field) of an entity (table)
|
a property (field) of an entity (table)
|
||||||
|
|
||||||
name: the name of this property.
|
name: the name of this property.
|
||||||
type: the type of this property.
|
type: the type of this property.
|
||||||
default: the default value of this property. There will probably be
|
default: the default value of this property. There will probably be
|
||||||
magic values of this!
|
magic values of this!
|
||||||
typedef: name of the typedef to use, it type = 'defined'.
|
typedef: name of the typedef to use, it type = 'defined'.
|
||||||
distinct: distinct='system' required that every value in the system
|
distinct: distinct='system' required that every value in the system
|
||||||
will be distinct (i.e. natural primary key);
|
will be distinct (i.e. natural primary key);
|
||||||
distinct='user' implies that the value may be used by users
|
distinct='user' implies that the value may be used by users
|
||||||
in distinguishing entities even if values are not formally
|
in distinguishing entities even if values are not formally
|
||||||
unique;
|
unique;
|
||||||
distinct='all' implies that the values are formally unique
|
distinct='all' implies that the values are formally unique
|
||||||
/and/ are user friendly (NOTE: not implemented).
|
/and/ are user friendly (NOTE: not implemented).
|
||||||
entity: if type='entity', the name of the entity this property is
|
entity: if type='entity', the name of the entity this property is
|
||||||
a foreign key link to.
|
a foreign key link to.
|
||||||
if type='list', the name of the entity that has a foreign
|
if type='list', the name of the entity that has a foreign
|
||||||
key link to this entity
|
key link to this entity
|
||||||
farkey: if type='list', the name of farside key in the listed
|
farkey: if type='list', the name of farside key in the listed
|
||||||
entity; if type='entity' and the farside field to join to
|
entity; if type='entity' and the farside field to join to
|
||||||
is not the farside primary key, then the name of that
|
is not the farside primary key, then the name of that
|
||||||
farside field
|
farside field
|
||||||
required: whether this propery is required (i.e. 'not null').
|
required: whether this propery is required (i.e. 'not null').
|
||||||
immutable: if true, once a value has been set it cannot be changed.
|
immutable: if true, once a value has been set it cannot be changed.
|
||||||
size: fieldwidth of the property if specified.
|
size: fieldwidth of the property if specified.
|
||||||
concrete: if set to 'false', this property is not stored in the
|
concrete: if set to 'false', this property is not stored in the
|
||||||
database but must be computed (manually written code must
|
database but must be computed (manually written code must
|
||||||
be provided to support this)
|
be provided to support this)
|
||||||
cascade: what action(s) on the parent entity should be cascaded to
|
cascade: what action(s) on the parent entity should be cascaded to
|
||||||
|
|
@ -319,13 +319,13 @@ that we can allow HTML block level entities within content elements -->
|
||||||
column: name of the column in a SQL database table in which this property
|
column: name of the column in a SQL database table in which this property
|
||||||
is stored. TODO: Think about this.
|
is stored. TODO: Think about this.
|
||||||
unsaved-value:
|
unsaved-value:
|
||||||
of a property whose persistent value is set on first being
|
of a property whose persistent value is set on first being
|
||||||
committed to persistent store, the value which it holds before
|
committed to persistent store, the value which it holds before
|
||||||
it has been committed
|
it has been committed
|
||||||
-->
|
-->
|
||||||
<!ELEMENT property ( documentation?, generator?, (permission|option|prompt|help|ifmissing)*)>
|
<!ELEMENT property ( documentation?, generator?, (permission|option|prompt|help|ifmissing)*)>
|
||||||
|
|
||||||
<!ATTLIST property
|
<!ATTLIST property
|
||||||
name CDATA #REQUIRED
|
name CDATA #REQUIRED
|
||||||
type (%AllDataTypes;) #REQUIRED
|
type (%AllDataTypes;) #REQUIRED
|
||||||
default CDATA #IMPLIED
|
default CDATA #IMPLIED
|
||||||
|
|
@ -334,24 +334,24 @@ that we can allow HTML block level entities within content elements -->
|
||||||
entity CDATA #IMPLIED
|
entity CDATA #IMPLIED
|
||||||
farkey CDATA #IMPLIED
|
farkey CDATA #IMPLIED
|
||||||
required %Boolean; #IMPLIED
|
required %Boolean; #IMPLIED
|
||||||
immutable %Boolean; #IMPLIED
|
immutable %Boolean; #IMPLIED
|
||||||
size CDATA #IMPLIED
|
size CDATA #IMPLIED
|
||||||
column CDATA #IMPLIED
|
column CDATA #IMPLIED
|
||||||
concrete %Boolean; #IMPLIED
|
concrete %Boolean; #IMPLIED
|
||||||
cascade (%CascadeActions;) #IMPLIED>
|
cascade (%CascadeActions;) #IMPLIED>
|
||||||
|
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
marks a property which is auto-generated by some part of the system.
|
marks a property which is auto-generated by some part of the system.
|
||||||
This is based on the Hibernate construct, except that the Hibernate
|
This is based on the Hibernate construct, except that the Hibernate
|
||||||
implementation folds both its internal generators and custom generators
|
implementation folds both its internal generators and custom generators
|
||||||
onto the same attribute. This separates them onto two attributes so we
|
onto the same attribute. This separates them onto two attributes so we
|
||||||
can police values for Hibernate's 'builtin' generators.
|
can police values for Hibernate's 'builtin' generators.
|
||||||
|
|
||||||
action: one of the supported Hibernate builtin generators, or
|
action: one of the supported Hibernate builtin generators, or
|
||||||
'manual'. 'native' is strongly recommended in most instances
|
'manual'. 'native' is strongly recommended in most instances
|
||||||
class: if action is 'manual', the name of a manually maintained
|
class: if action is 'manual', the name of a manually maintained
|
||||||
class conforming to the Hibernate IdentifierGenerator
|
class conforming to the Hibernate IdentifierGenerator
|
||||||
interface, or its equivalent in other languages
|
interface, or its equivalent in other languages
|
||||||
-->
|
-->
|
||||||
<!ELEMENT generator (documentation?, param*)>
|
<!ELEMENT generator (documentation?, param*)>
|
||||||
|
|
@ -360,15 +360,15 @@ that we can allow HTML block level entities within content elements -->
|
||||||
class CDATA #IMPLIED>
|
class CDATA #IMPLIED>
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
A parameter passed to the generator. Again, based on the Hibernate
|
A parameter passed to the generator. Again, based on the Hibernate
|
||||||
implementation. TODO: #PCDATA is wrong as the content model, as embedded
|
implementation. TODO: #PCDATA is wrong as the content model, as embedded
|
||||||
markup is definitely not allowed!
|
markup is definitely not allowed!
|
||||||
|
|
||||||
name: the name of this parameter
|
name: the name of this parameter
|
||||||
|
|
||||||
TODO: This needs to be renamed or removed because it conflicts with the
|
TODO: This needs to be renamed or removed because it conflicts with the
|
||||||
XHTML element of the same name. In fact it could be simply removed since
|
XHTML element of the same name. In fact it could be simply removed since
|
||||||
our usage is compatible with the XHTML usage, but it might be less
|
our usage is compatible with the XHTML usage, but it might be less
|
||||||
ambiguous to rename it.
|
ambiguous to rename it.
|
||||||
-->
|
-->
|
||||||
<!ELEMENT param (#PCDATA)>
|
<!ELEMENT param (#PCDATA)>
|
||||||
|
|
@ -377,40 +377,40 @@ that we can allow HTML block level entities within content elements -->
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
one of an explicit list of optional values a property may have
|
one of an explicit list of optional values a property may have
|
||||||
NOTE: whether options get encoded at application layer or at database layer
|
NOTE: whether options get encoded at application layer or at database layer
|
||||||
is UNDEFINED; either behaviour is correct. If at database layer it's also
|
is UNDEFINED; either behaviour is correct. If at database layer it's also
|
||||||
UNDEFINED whether they're encoded as a single reference data table or as
|
UNDEFINED whether they're encoded as a single reference data table or as
|
||||||
separate reference data tables for each property.
|
separate reference data tables for each property.
|
||||||
|
|
||||||
value: the value of this option
|
value: the value of this option
|
||||||
|
|
||||||
TODO: This needs to be renamed or removed because it conflicts with the
|
TODO: This needs to be renamed or removed because it conflicts with the
|
||||||
XHTML element of the same name. In fact it could be simply removed since
|
XHTML element of the same name. In fact it could be simply removed since
|
||||||
our usage is compatible with the XHTML usage, but it might be less
|
our usage is compatible with the XHTML usage, but it might be less
|
||||||
ambiguous to rename it.
|
ambiguous to rename it.
|
||||||
-->
|
-->
|
||||||
<!ELEMENT option (documentation?, prompt*)>
|
<!ELEMENT option (documentation?, prompt*)>
|
||||||
<!-- if the value is different from the prompt the user sees, specify it -->
|
<!-- if the value is different from the prompt the user sees, specify it -->
|
||||||
<!ATTLIST option
|
<!ATTLIST option
|
||||||
value CDATA #IMPLIED>
|
value CDATA #IMPLIED>
|
||||||
|
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
permissions policy on an entity, a page, form, list or field
|
permissions policy on an entity, a page, form, list or field
|
||||||
|
|
||||||
group: the group to which permission is granted
|
group: the group to which permission is granted
|
||||||
permission: the permission which is granted to that group
|
permission: the permission which is granted to that group
|
||||||
-->
|
-->
|
||||||
<!ELEMENT permission (documentation?)>
|
<!ELEMENT permission (documentation?)>
|
||||||
<!ATTLIST permission
|
<!ATTLIST permission
|
||||||
group CDATA #REQUIRED
|
group CDATA #REQUIRED
|
||||||
permission (%Permissions;) #REQUIRED>
|
permission (%Permissions;) #REQUIRED>
|
||||||
|
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
pragmatic advice to generators of lists and forms, in the form of
|
pragmatic advice to generators of lists and forms, in the form of
|
||||||
name/value pairs which may contain anything. Over time some pragmas
|
name/value pairs which may contain anything. Over time some pragmas
|
||||||
will become 'well known', but the whole point of having a pragma
|
will become 'well known', but the whole point of having a pragma
|
||||||
architecture is that it is extensible.
|
architecture is that it is extensible.
|
||||||
|
|
@ -420,27 +420,27 @@ that we can allow HTML block level entities within content elements -->
|
||||||
name CDATA #REQUIRED
|
name CDATA #REQUIRED
|
||||||
value CDATA #REQUIRED>
|
value CDATA #REQUIRED>
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
a prompt for a property or field; used as the prompt text for a widget
|
a prompt for a property or field; used as the prompt text for a widget
|
||||||
which edits it. Typically there will be only one of these per property
|
which edits it. Typically there will be only one of these per property
|
||||||
per locale; if there are more than one all those matching the locale may
|
per locale; if there are more than one all those matching the locale may
|
||||||
be concatenated, or just one may be used.
|
be concatenated, or just one may be used.
|
||||||
|
|
||||||
prompt: the prompt to use
|
prompt: the prompt to use
|
||||||
locale: the locale in which to prefer this prompt
|
locale: the locale in which to prefer this prompt
|
||||||
-->
|
-->
|
||||||
<!ELEMENT prompt (documentation?)>
|
<!ELEMENT prompt (documentation?)>
|
||||||
<!ATTLIST prompt
|
<!ATTLIST prompt
|
||||||
prompt CDATA #REQUIRED
|
prompt CDATA #REQUIRED
|
||||||
locale %Locale; #REQUIRED >
|
locale %Locale; #REQUIRED >
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
helptext about a property of an entity, or a field of a page, form or
|
helptext about a property of an entity, or a field of a page, form or
|
||||||
list, or a typedef. Typically there will be only one of these per property
|
list, or a typedef. Typically there will be only one of these per property
|
||||||
per locale; if there are more than one all those matching the locale may
|
per locale; if there are more than one all those matching the locale may
|
||||||
be concatenated, or just one may be used.
|
be concatenated, or just one may be used.
|
||||||
|
|
||||||
locale: the locale in which to prefer this prompt
|
locale: the locale in which to prefer this prompt
|
||||||
-->
|
-->
|
||||||
<!ELEMENT help (#PCDATA)>
|
<!ELEMENT help (#PCDATA)>
|
||||||
<!ATTLIST help
|
<!ATTLIST help
|
||||||
|
|
@ -448,7 +448,7 @@ that we can allow HTML block level entities within content elements -->
|
||||||
xmlns CDATA #IMPLIED >
|
xmlns CDATA #IMPLIED >
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
helpful text to be shown if a property value is missing, typically when
|
helpful text to be shown if a property value is missing, typically when
|
||||||
a form is submitted. Typically there will be only one of these per property
|
a form is submitted. Typically there will be only one of these per property
|
||||||
per locale; if there are more than one all those matching the locale may
|
per locale; if there are more than one all those matching the locale may
|
||||||
be concatenated, or just one may be used. Later there may be more sophisticated
|
be concatenated, or just one may be used. Later there may be more sophisticated
|
||||||
|
|
@ -462,7 +462,7 @@ that we can allow HTML block level entities within content elements -->
|
||||||
<!-- a form through which an entity may be added or edited
|
<!-- a form through which an entity may be added or edited
|
||||||
|
|
||||||
TODO: This needs to be renamed because it conflicts with the
|
TODO: This needs to be renamed because it conflicts with the
|
||||||
XHTML element of the same name.
|
XHTML element of the same name.
|
||||||
-->
|
-->
|
||||||
<!ELEMENT form (documentation?, ( %PageStuff;)*)>
|
<!ELEMENT form (documentation?, ( %PageStuff;)*)>
|
||||||
<!ATTLIST form %PageAttrs;>
|
<!ATTLIST form %PageAttrs;>
|
||||||
|
|
@ -472,7 +472,7 @@ that we can allow HTML block level entities within content elements -->
|
||||||
<!ELEMENT page (documentation?, ( %PageStuff;)*)>
|
<!ELEMENT page (documentation?, ( %PageStuff;)*)>
|
||||||
<!ATTLIST page %PageAttrs;>
|
<!ATTLIST page %PageAttrs;>
|
||||||
|
|
||||||
<!-- an ordering or records in a list
|
<!-- an ordering or records in a list
|
||||||
property: the property on which to order
|
property: the property on which to order
|
||||||
sequence: the sequence in which to order
|
sequence: the sequence in which to order
|
||||||
-->
|
-->
|
||||||
|
|
@ -481,11 +481,11 @@ that we can allow HTML block level entities within content elements -->
|
||||||
property CDATA #REQUIRED
|
property CDATA #REQUIRED
|
||||||
sequence (%Sequences;) #IMPLIED>
|
sequence (%Sequences;) #IMPLIED>
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
a list on which entities of a given type are listed
|
a list on which entities of a given type are listed
|
||||||
|
|
||||||
onselect: name of form/page/list to go to when
|
onselect: name of form/page/list to go to when
|
||||||
a selection is made from the list
|
a selection is made from the list
|
||||||
-->
|
-->
|
||||||
<!ELEMENT list (documentation?, ( %PageStuff;|order)*)>
|
<!ELEMENT list (documentation?, ( %PageStuff;|order)*)>
|
||||||
<!ATTLIST list %PageAttrs;
|
<!ATTLIST list %PageAttrs;
|
||||||
|
|
@ -495,7 +495,7 @@ that we can allow HTML block level entities within content elements -->
|
||||||
<!--
|
<!--
|
||||||
a subsidiary list, on which entities related to primary
|
a subsidiary list, on which entities related to primary
|
||||||
entities in the enclosing page or list are listed
|
entities in the enclosing page or list are listed
|
||||||
|
|
||||||
property: the property of the enclosing entity that this
|
property: the property of the enclosing entity that this
|
||||||
list displays (obviously, must be of type='list')
|
list displays (obviously, must be of type='list')
|
||||||
onselect: the form or page of the listed entity to call
|
onselect: the form or page of the listed entity to call
|
||||||
|
|
@ -510,7 +510,7 @@ that we can allow HTML block level entities within content elements -->
|
||||||
canadd %Boolean; #IMPLIED>
|
canadd %Boolean; #IMPLIED>
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
a group of fields and other controls within a form or list, which the
|
a group of fields and other controls within a form or list, which the
|
||||||
renderer might render as a single pane in a tabbed display, for example.
|
renderer might render as a single pane in a tabbed display, for example.
|
||||||
-->
|
-->
|
||||||
<!ELEMENT fieldgroup (documentation?, (prompt|permission|%FieldStuff;)*)>
|
<!ELEMENT fieldgroup (documentation?, (prompt|permission|%FieldStuff;)*)>
|
||||||
|
|
@ -523,10 +523,10 @@ that we can allow HTML block level entities within content elements -->
|
||||||
property: the property which this field displays/edits
|
property: the property which this field displays/edits
|
||||||
-->
|
-->
|
||||||
<!ELEMENT field (documentation?, (prompt|help|permission)*) >
|
<!ELEMENT field (documentation?, (prompt|help|permission)*) >
|
||||||
<!ATTLIST field
|
<!ATTLIST field
|
||||||
property CDATA #REQUIRED >
|
property CDATA #REQUIRED >
|
||||||
|
|
||||||
<!-- a verb is something that may be done through a form. Probably the verbs 'store'
|
<!-- a verb is something that may be done through a form. Probably the verbs 'store'
|
||||||
and 'delete' are implied, but maybe they need to be explicitly declared. The 'verb'
|
and 'delete' are implied, but maybe they need to be explicitly declared. The 'verb'
|
||||||
attribute of the verb is what gets returned to the controller -->
|
attribute of the verb is what gets returned to the controller -->
|
||||||
<!ELEMENT verb (documentation?, (prompt|help|permission)*) >
|
<!ELEMENT verb (documentation?, (prompt|help|permission)*) >
|
||||||
|
|
@ -539,14 +539,14 @@ that we can allow HTML block level entities within content elements -->
|
||||||
<!ELEMENT content (%Content;)*>
|
<!ELEMENT content (%Content;)*>
|
||||||
|
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
content to place in the head of the generated document; this is #PCDATA
|
content to place in the head of the generated document; this is #PCDATA
|
||||||
because it will almost certainly belong to a different namespace
|
because it will almost certainly belong to a different namespace
|
||||||
(usually HTML)
|
(usually HTML)
|
||||||
|
|
||||||
TODO: This needs to be renamed or removed because it conflicts with the
|
TODO: This needs to be renamed or removed because it conflicts with the
|
||||||
XHTML element of the same name. In fact it could be simply removed since
|
XHTML element of the same name. In fact it could be simply removed since
|
||||||
our usage is compatible with the XHTML usage, but it might be less
|
our usage is compatible with the XHTML usage, but it might be less
|
||||||
ambiguous to rename it.
|
ambiguous to rename it.
|
||||||
-->
|
-->
|
||||||
<!ELEMENT head (#PCDATA) >
|
<!ELEMENT head (#PCDATA) >
|
||||||
|
|
@ -554,30 +554,30 @@ that we can allow HTML block level entities within content elements -->
|
||||||
xmlns CDATA #IMPLIED>
|
xmlns CDATA #IMPLIED>
|
||||||
|
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
content to place in the top of the body of the generated document;
|
content to place in the top of the body of the generated document;
|
||||||
this is %Flow; which is any HTML block or inline level element.
|
this is %Flow; which is any HTML block or inline level element.
|
||||||
-->
|
-->
|
||||||
<!ELEMENT top (#PCDATA) >
|
<!ELEMENT top (#PCDATA) >
|
||||||
<!ATTLIST top
|
<!ATTLIST top
|
||||||
xmlns CDATA #IMPLIED>
|
xmlns CDATA #IMPLIED>
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
content to place at the foot of the body of the generated document;
|
content to place at the foot of the body of the generated document;
|
||||||
this is %Flow; which is any HTML block or inline level element.
|
this is %Flow; which is any HTML block or inline level element.
|
||||||
-->
|
-->
|
||||||
<!ELEMENT foot (#PCDATA) >
|
<!ELEMENT foot (#PCDATA) >
|
||||||
<!ATTLIST foot
|
<!ATTLIST foot
|
||||||
xmlns CDATA #IMPLIED>
|
xmlns CDATA #IMPLIED>
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
The 'specification' and 'reference' elements are for documentation only,
|
The 'specification' and 'reference' elements are for documentation only,
|
||||||
and do not contribute to the engineering of the application described.
|
and do not contribute to the engineering of the application described.
|
||||||
|
|
||||||
A specification element is intended chiefly to declare the reference
|
A specification element is intended chiefly to declare the reference
|
||||||
documents which may be used in documentation elements later in the
|
documents which may be used in documentation elements later in the
|
||||||
document.
|
document.
|
||||||
|
|
||||||
url: The URL from which the document referenced can be retrieved
|
url: The URL from which the document referenced can be retrieved
|
||||||
name: The full name (title) given to this document
|
name: The full name (title) given to this document
|
||||||
abbr: A convenient abbreviated name
|
abbr: A convenient abbreviated name
|
||||||
|
|
@ -589,12 +589,12 @@ that we can allow HTML block level entities within content elements -->
|
||||||
abbr CDATA #REQUIRED
|
abbr CDATA #REQUIRED
|
||||||
>
|
>
|
||||||
|
|
||||||
<!--
|
<!--
|
||||||
The 'specification' and 'reference' elements are for documentation only,
|
The 'specification' and 'reference' elements are for documentation only,
|
||||||
and do not contribute to the engineering of the application described.
|
and do not contribute to the engineering of the application described.
|
||||||
|
|
||||||
A reference element is a reference to a specifying document.
|
A reference element is a reference to a specifying document.
|
||||||
|
|
||||||
abbr: The abbreviated name of the specification to which this
|
abbr: The abbreviated name of the specification to which this
|
||||||
reference refers
|
reference refers
|
||||||
section: The 'anchor part' (part following a hash character) which,
|
section: The 'anchor part' (part following a hash character) which,
|
||||||
|
|
|
||||||
|
|
@ -6,7 +6,7 @@
|
||||||
[clojure.string :as s]
|
[clojure.string :as s]
|
||||||
[clj-time.core :as t]
|
[clj-time.core :as t]
|
||||||
[clj-time.format :as f]
|
[clj-time.format :as f]
|
||||||
[adl.utils :refer [singularise is-link-table?]]))
|
[adl.utils :refer :all]))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;;;;
|
;;;;
|
||||||
|
|
@ -32,32 +32,22 @@
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
|
||||||
(defn key-names [entity-map]
|
|
||||||
(let [k (first (filter #(= (:tag %) :key) (:content entity-map)))]
|
|
||||||
(remove
|
|
||||||
nil?
|
|
||||||
(map
|
|
||||||
#(:name (:attrs %))
|
|
||||||
(filter #(= (:tag %) :property) (:content k))))))
|
|
||||||
|
|
||||||
|
|
||||||
(defn has-primary-key? [entity-map]
|
|
||||||
(not (empty? (key-names entity-map))))
|
|
||||||
|
|
||||||
|
|
||||||
(defn has-non-key-properties? [entity-map]
|
|
||||||
(not
|
|
||||||
(empty? (filter #(= (:tag %) :property) (:content entity-map)))))
|
|
||||||
|
|
||||||
|
|
||||||
(defn where-clause [entity-map]
|
(defn where-clause [entity-map]
|
||||||
(let
|
(let
|
||||||
[entity-name (:name (:attrs entity-map))]
|
[entity-name (:name (:attrs entity-map))]
|
||||||
(str
|
(str
|
||||||
"WHERE " entity-name "."
|
"WHERE " entity-name "."
|
||||||
(s/join
|
(s/join
|
||||||
(str " AND\n\t" entity-name ".")
|
(str " AND\n\t" entity-name ".")
|
||||||
(map #(str % " = " (keyword %)) (key-names entity-map))))))
|
(map
|
||||||
|
#(let [target (keyword (-> % :attrs :name))]
|
||||||
|
(str
|
||||||
|
(name target) " = "
|
||||||
|
(if
|
||||||
|
(quoted-type? %)
|
||||||
|
(str "'" target "'")
|
||||||
|
target)))
|
||||||
|
(key-properties entity-map))))))
|
||||||
|
|
||||||
|
|
||||||
(defn order-by-clause [entity-map]
|
(defn order-by-clause [entity-map]
|
||||||
|
|
@ -66,69 +56,77 @@
|
||||||
preferred (map
|
preferred (map
|
||||||
#(:name (:attrs %))
|
#(:name (:attrs %))
|
||||||
(filter #(and
|
(filter #(and
|
||||||
(= (-> % :attrs :distinct) "user")
|
(#{"all", "user"} (-> % :attrs :distinct))
|
||||||
(= (-> % :tag) :property))
|
(= (-> % :tag) :property))
|
||||||
(-> entity-map :content)))]
|
(concat (properties entity-map)(key-properties entity-map))))]
|
||||||
(str
|
(str
|
||||||
"ORDER BY " entity-name "."
|
"ORDER BY " entity-name "."
|
||||||
(s/join
|
(s/join
|
||||||
(str ",\n\t" entity-name ".")
|
(str ",\n\t" entity-name ".")
|
||||||
(doall (flatten (cons preferred (key-names entity-map))))))))
|
(doall (flatten (cons preferred (filter
|
||||||
|
#(not (#{"all", "user"} %))
|
||||||
|
(key-names entity-map)))))))))
|
||||||
|
|
||||||
(defn property-names [entity-map]
|
|
||||||
(map #(:name (:attrs %)) (filter #(= (-> % :tag) :property) (:content entity-map))))
|
|
||||||
|
|
||||||
(defn insert-query [entity-map]
|
(defn insert-query [entity-map]
|
||||||
(let [entity-name (:name (:attrs entity-map))
|
(let [entity-name (:name (:attrs entity-map))
|
||||||
pretty-name (singularise entity-name)
|
pretty-name (singularise entity-name)
|
||||||
all-property-names (property-names entity-map)
|
props (concat (properties entity-map) (insertable-key-properties entity-map))
|
||||||
|
pnames (map #(-> % :attrs :name) props)
|
||||||
query-name (str "create-" pretty-name "!")
|
query-name (str "create-" pretty-name "!")
|
||||||
signature ":! :n"]
|
signature ":! :n"]
|
||||||
(hash-map
|
(hash-map
|
||||||
(keyword query-name)
|
(keyword query-name)
|
||||||
{:name query-name
|
{:name query-name
|
||||||
:signature signature
|
:signature signature
|
||||||
:entity entity-map
|
:entity entity-map
|
||||||
:type :insert-1
|
:type :insert-1
|
||||||
:query
|
:query
|
||||||
(str "-- :name " query-name " " signature "\n"
|
(str "-- :name " query-name " " signature "\n"
|
||||||
"-- :doc creates a new " pretty-name " record\n"
|
"-- :doc creates a new " pretty-name " record\n"
|
||||||
"INSERT INTO " entity-name " ("
|
"INSERT INTO " entity-name " ("
|
||||||
(s/join ",\n\t" all-property-names)
|
(s/join ",\n\t" pnames)
|
||||||
")\nVALUES ("
|
")\nVALUES ("
|
||||||
(s/join ",\n\t" (map keyword all-property-names))
|
(s/join ",\n\t"
|
||||||
")"
|
(map
|
||||||
(if
|
#(let [target (keyword (-> % :attrs :name))]
|
||||||
(has-primary-key? entity-map)
|
(if
|
||||||
(str "\nreturning " (s/join ",\n\t" (key-names entity-map))))
|
(quoted-type? %)
|
||||||
"\n\n")})))
|
(str "'" target "'")
|
||||||
|
target))
|
||||||
|
props))
|
||||||
|
")"
|
||||||
|
(if
|
||||||
|
(has-primary-key? entity-map)
|
||||||
|
(str "\nreturning " (s/join ",\n\t" (key-names entity-map))))
|
||||||
|
"\n\n")})))
|
||||||
|
|
||||||
|
|
||||||
(defn update-query [entity-map]
|
(defn update-query [entity-map]
|
||||||
(if
|
(if
|
||||||
(and
|
(and
|
||||||
(has-primary-key? entity-map)
|
(has-primary-key? entity-map)
|
||||||
(has-non-key-properties? entity-map))
|
(has-non-key-properties? entity-map))
|
||||||
(let [entity-name (:name (:attrs entity-map))
|
(let [entity-name (:name (:attrs entity-map))
|
||||||
pretty-name (singularise entity-name)
|
pretty-name (singularise entity-name)
|
||||||
property-names (property-names entity-map)
|
property-names (property-names entity-map)
|
||||||
query-name (str "update-" pretty-name "!")
|
query-name (str "update-" pretty-name "!")
|
||||||
signature ":! :n"]
|
signature ":! :n"]
|
||||||
(hash-map
|
(hash-map
|
||||||
(keyword query-name)
|
(keyword query-name)
|
||||||
{:name query-name
|
{:name query-name
|
||||||
:signature signature
|
:signature signature
|
||||||
:entity entity-map
|
:entity entity-map
|
||||||
:type :update-1
|
:type :update-1
|
||||||
:query
|
:query
|
||||||
(str "-- :name " query-name " " signature "\n"
|
(str "-- :name " query-name " " signature "\n"
|
||||||
"-- :doc updates an existing " pretty-name " record\n"
|
"-- :doc updates an existing " pretty-name " record\n"
|
||||||
"UPDATE " entity-name "\n"
|
"UPDATE " entity-name "\n"
|
||||||
"SET "
|
"SET "
|
||||||
(s/join ",\n\t" (map #(str % " = " (keyword %)) property-names))
|
(s/join ",\n\t" (map #(str % " = " (keyword %)) property-names))
|
||||||
"\n"
|
"\n"
|
||||||
(where-clause entity-map)
|
(where-clause entity-map)
|
||||||
"\n\n")}))
|
"\n\n")}))
|
||||||
{}))
|
{}))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -137,11 +135,11 @@
|
||||||
pretty-name (singularise entity-name)
|
pretty-name (singularise entity-name)
|
||||||
query-name (str "search-strings-" pretty-name)
|
query-name (str "search-strings-" pretty-name)
|
||||||
signature ":? :1"
|
signature ":? :1"
|
||||||
|
props (concat (properties entity-map) (insertable-key-properties entity-map))
|
||||||
string-fields (filter
|
string-fields (filter
|
||||||
#(and
|
;; TODO: should also allow typdefed fields which typedef to string.
|
||||||
(= (-> % :attrs :type) "string")
|
#(= (-> % :attrs :type) "string")
|
||||||
(= (:tag %) :property))
|
props)]
|
||||||
(-> entity-map :content))]
|
|
||||||
(if
|
(if
|
||||||
(empty? string-fields)
|
(empty? string-fields)
|
||||||
{}
|
{}
|
||||||
|
|
@ -164,8 +162,8 @@
|
||||||
"\n"
|
"\n"
|
||||||
(order-by-clause entity-map)
|
(order-by-clause entity-map)
|
||||||
"\n"
|
"\n"
|
||||||
"--~ (if (:offset params) \"OFFSET :offset \") \n"
|
"--~ (if (:offset params) \"OFFSET :offset \") \n"
|
||||||
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
|
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
|
||||||
"\n\n")}))))
|
"\n\n")}))))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -177,17 +175,17 @@
|
||||||
query-name (str "get-" pretty-name)
|
query-name (str "get-" pretty-name)
|
||||||
signature ":? :1"]
|
signature ":? :1"]
|
||||||
(hash-map
|
(hash-map
|
||||||
(keyword query-name)
|
(keyword query-name)
|
||||||
{:name query-name
|
{:name query-name
|
||||||
:signature signature
|
:signature signature
|
||||||
:entity entity-map
|
:entity entity-map
|
||||||
:type :select-1
|
:type :select-1
|
||||||
:query
|
:query
|
||||||
(str "-- :name " query-name " " signature "\n"
|
(str "-- :name " query-name " " signature "\n"
|
||||||
"-- :doc selects an existing " pretty-name " record\n"
|
"-- :doc selects an existing " pretty-name " record\n"
|
||||||
"SELECT * FROM " entity-name "\n"
|
"SELECT * FROM " entity-name "\n"
|
||||||
(where-clause entity-map)
|
(where-clause entity-map)
|
||||||
"\n\n")}))
|
"\n\n")}))
|
||||||
{}))
|
{}))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -201,19 +199,19 @@
|
||||||
query-name (str "list-" entity-name)
|
query-name (str "list-" entity-name)
|
||||||
signature ":? :*"]
|
signature ":? :*"]
|
||||||
(hash-map
|
(hash-map
|
||||||
(keyword query-name)
|
(keyword query-name)
|
||||||
{:name query-name
|
{:name query-name
|
||||||
:signature signature
|
:signature signature
|
||||||
:entity entity-map
|
:entity entity-map
|
||||||
:type :select-many
|
:type :select-many
|
||||||
:query
|
:query
|
||||||
(str "-- :name " query-name " " signature "\n"
|
(str "-- :name " query-name " " signature "\n"
|
||||||
"-- :doc lists all existing " pretty-name " records\n"
|
"-- :doc lists all existing " pretty-name " records\n"
|
||||||
"SELECT * FROM " entity-name "\n"
|
"SELECT * FROM " entity-name "\n"
|
||||||
(order-by-clause entity-map) "\n"
|
(order-by-clause entity-map) "\n"
|
||||||
"--~ (if (:offset params) \"OFFSET :offset \") \n"
|
"--~ (if (:offset params) \"OFFSET :offset \") \n"
|
||||||
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
|
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
|
||||||
"\n\n")})))
|
"\n\n")})))
|
||||||
|
|
||||||
|
|
||||||
(defn foreign-queries [entity-map entities-map]
|
(defn foreign-queries [entity-map entities-map]
|
||||||
|
|
@ -221,39 +219,39 @@
|
||||||
pretty-name (singularise entity-name)
|
pretty-name (singularise entity-name)
|
||||||
links (filter #(-> % :attrs :entity) (-> entity-map :content :properties vals))]
|
links (filter #(-> % :attrs :entity) (-> entity-map :content :properties vals))]
|
||||||
(apply
|
(apply
|
||||||
merge
|
merge
|
||||||
(map
|
(map
|
||||||
#(let [far-name (-> % :attrs :entity)
|
#(let [far-name (-> % :attrs :entity)
|
||||||
far-entity ((keyword far-name) entities-map)
|
far-entity ((keyword far-name) entities-map)
|
||||||
pretty-far (s/replace (s/replace far-name #"_" "-") #"s$" "")
|
pretty-far (s/replace (s/replace far-name #"_" "-") #"s$" "")
|
||||||
farkey (-> % :attrs :farkey)
|
farkey (-> % :attrs :farkey)
|
||||||
link-field (-> % :attrs :name)
|
link-field (-> % :attrs :name)
|
||||||
query-name (str "list-" entity-name "-by-" pretty-far)
|
query-name (str "list-" entity-name "-by-" pretty-far)
|
||||||
signature ":? :*"]
|
signature ":? :*"]
|
||||||
(hash-map
|
(hash-map
|
||||||
(keyword query-name)
|
(keyword query-name)
|
||||||
{:name query-name
|
{:name query-name
|
||||||
:signature signature
|
:signature signature
|
||||||
:entity entity-map
|
:entity entity-map
|
||||||
:type :select-one-to-many
|
:type :select-one-to-many
|
||||||
:far-entity far-entity
|
:far-entity far-entity
|
||||||
:query
|
:query
|
||||||
(str "-- :name " query-name " " signature "\n"
|
(str "-- :name " query-name " " signature "\n"
|
||||||
"-- :doc lists all existing " pretty-name " records related to a given " pretty-far "\n"
|
"-- :doc lists all existing " pretty-name " records related to a given " pretty-far "\n"
|
||||||
"SELECT * \nFROM " entity-name "\n"
|
"SELECT * \nFROM " entity-name "\n"
|
||||||
"WHERE " entity-name "." link-field " = :id\n"
|
"WHERE " entity-name "." link-field " = :id\n"
|
||||||
(order-by-clause entity-map)
|
(order-by-clause entity-map)
|
||||||
"\n\n")}))
|
"\n\n")}))
|
||||||
links))))
|
links))))
|
||||||
|
|
||||||
|
|
||||||
(defn link-table-query [near link far]
|
(defn link-table-query [near link far]
|
||||||
(let [properties (-> link :content :properties vals)
|
(let [properties (-> link :content :properties vals)
|
||||||
links (apply
|
links (apply
|
||||||
merge
|
merge
|
||||||
(map
|
(map
|
||||||
#(hash-map (keyword (-> % :attrs :entity)) %)
|
#(hash-map (keyword (-> % :attrs :entity)) %)
|
||||||
(filter #(-> % :attrs :entity) properties)))
|
(filter #(-> % :attrs :entity) properties)))
|
||||||
near-name (-> near :attrs :name)
|
near-name (-> near :attrs :name)
|
||||||
link-name (-> link :attrs :name)
|
link-name (-> link :attrs :name)
|
||||||
far-name (-> far :attrs :name)
|
far-name (-> far :attrs :name)
|
||||||
|
|
@ -261,37 +259,37 @@
|
||||||
query-name (str "list-" link-name "-" near-name "-by-" pretty-far)
|
query-name (str "list-" link-name "-" near-name "-by-" pretty-far)
|
||||||
signature ":? :*"]
|
signature ":? :*"]
|
||||||
(hash-map
|
(hash-map
|
||||||
(keyword query-name)
|
(keyword query-name)
|
||||||
{:name query-name
|
{:name query-name
|
||||||
:signature signature
|
:signature signature
|
||||||
:entity link
|
:entity link
|
||||||
:type :select-many-to-many
|
:type :select-many-to-many
|
||||||
:near-entity near
|
:near-entity near
|
||||||
:far-entity far
|
:far-entity far
|
||||||
:query
|
:query
|
||||||
(str "-- :name " query-name " " signature " \n"
|
(str "-- :name " query-name " " signature " \n"
|
||||||
"-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far "\n"
|
"-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far "\n"
|
||||||
"SELECT "near-name ".*\n"
|
"SELECT "near-name ".*\n"
|
||||||
"FROM " near-name ", " link-name "\n"
|
"FROM " near-name ", " link-name "\n"
|
||||||
"WHERE " near-name "." (first (key-names near)) " = " link-name "." (-> (links (keyword near-name)) :attrs :name) "\n\t"
|
"WHERE " near-name "." (first (key-names near)) " = " link-name "." (-> (links (keyword near-name)) :attrs :name) "\n\t"
|
||||||
"AND " link-name "." (-> (links (keyword far-name)) :attrs :name) " = :id\n"
|
"AND " link-name "." (-> (links (keyword far-name)) :attrs :name) " = :id\n"
|
||||||
(order-by-clause near)
|
(order-by-clause near)
|
||||||
"\n\n")})))
|
"\n\n")})))
|
||||||
|
|
||||||
|
|
||||||
(defn link-table-queries [entity-map entities-map]
|
(defn link-table-queries [entity-map entities-map]
|
||||||
(let
|
(let
|
||||||
[entities (map
|
[entities (map
|
||||||
#((keyword %) entities-map)
|
#((keyword %) entities-map)
|
||||||
(remove nil? (map #(-> % :attrs :entity) (-> entity-map :content :properties vals))))
|
(remove nil? (map #(-> % :attrs :entity) (-> entity-map :content :properties vals))))
|
||||||
pairs (combinations entities 2)]
|
pairs (combinations entities 2)]
|
||||||
(apply
|
(apply
|
||||||
merge
|
merge
|
||||||
(map
|
(map
|
||||||
#(merge
|
#(merge
|
||||||
(link-table-query (nth % 0) entity-map (nth % 1))
|
(link-table-query (nth % 0) entity-map (nth % 1))
|
||||||
(link-table-query (nth % 1) entity-map (nth % 0)))
|
(link-table-query (nth % 1) entity-map (nth % 0)))
|
||||||
pairs))))
|
pairs))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -303,34 +301,34 @@
|
||||||
query-name (str "delete-" pretty-name "!")
|
query-name (str "delete-" pretty-name "!")
|
||||||
signature ":! :n"]
|
signature ":! :n"]
|
||||||
(hash-map
|
(hash-map
|
||||||
(keyword query-name)
|
(keyword query-name)
|
||||||
{:name query-name
|
{:name query-name
|
||||||
:signature signature
|
:signature signature
|
||||||
:entity entity-map
|
:entity entity-map
|
||||||
:type :delete-1
|
:type :delete-1
|
||||||
:query
|
:query
|
||||||
(str "-- :name " query-name " " signature "\n"
|
(str "-- :name " query-name " " signature "\n"
|
||||||
"-- :doc updates an existing " pretty-name " record\n"
|
"-- :doc updates an existing " pretty-name " record\n"
|
||||||
"DELETE FROM " entity-name "\n"
|
"DELETE FROM " entity-name "\n"
|
||||||
(where-clause entity-map)
|
(where-clause entity-map)
|
||||||
"\n\n")}))))
|
"\n\n")}))))
|
||||||
|
|
||||||
|
|
||||||
(defn queries
|
(defn queries
|
||||||
[entity-map entities-map]
|
[entity-map entities-map]
|
||||||
(merge
|
(merge
|
||||||
{}
|
{}
|
||||||
(insert-query entity-map)
|
(insert-query entity-map)
|
||||||
(update-query entity-map)
|
(update-query entity-map)
|
||||||
(delete-query entity-map)
|
(delete-query entity-map)
|
||||||
(if
|
(if
|
||||||
(is-link-table? entity-map)
|
(is-link-table? entity-map)
|
||||||
(link-table-queries entity-map entities-map)
|
(link-table-queries entity-map entities-map)
|
||||||
(merge
|
(merge
|
||||||
(select-query entity-map)
|
(select-query entity-map)
|
||||||
(list-query entity-map)
|
(list-query entity-map)
|
||||||
(search-query entity-map)
|
(search-query entity-map)
|
||||||
(foreign-queries entity-map entities-map)))))
|
(foreign-queries entity-map entities-map)))))
|
||||||
|
|
||||||
|
|
||||||
;; (defn migrations-to-queries-sql
|
;; (defn migrations-to-queries-sql
|
||||||
|
|
|
||||||
|
|
@ -1,11 +1,126 @@
|
||||||
(ns adl.utils
|
(ns adl.utils
|
||||||
(:require [clojure.string :as s]))
|
(:require [clojure.string :as s]))
|
||||||
|
|
||||||
(defn singularise [string]
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;;;
|
||||||
|
;;;; adl.utils: utility functions generally useful to generators.
|
||||||
|
;;;;
|
||||||
|
;;;; This program is free software; you can redistribute it and/or
|
||||||
|
;;;; modify it under the terms of the GNU General Public License
|
||||||
|
;;;; as published by the Free Software Foundation; either version 2
|
||||||
|
;;;; of the License, or (at your option) any later version.
|
||||||
|
;;;;
|
||||||
|
;;;; This program is distributed in the hope that it will be useful,
|
||||||
|
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;;; GNU General Public License for more details.
|
||||||
|
;;;;
|
||||||
|
;;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;;; along with this program; if not, write to the Free Software
|
||||||
|
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
|
||||||
|
;;;; USA.
|
||||||
|
;;;;
|
||||||
|
;;;; Copyright (C) 2018 Simon Brooke
|
||||||
|
;;;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;;; **Argument name conventions**: arguments with names of the form `*-map`
|
||||||
|
;;; represent elements extracted from an ADL XML file as parsed by
|
||||||
|
;;; `clojure.xml/parse`. Thus `entity-map` represents an ADL entity,
|
||||||
|
;;; `property-map` a property, and so on.
|
||||||
|
;;;
|
||||||
|
;;; Generally, `(:tag x-map) => "x"`, and for every such object
|
||||||
|
;;; `(:attrs x-map)` should return a map of attributes whose keys
|
||||||
|
;;; are keywords and whose values are strings.
|
||||||
|
|
||||||
|
(defn singularise
|
||||||
|
"Assuming this string represents an English language plural noun,
|
||||||
|
construct a Clojure symbol name which represents the singular."
|
||||||
|
[string]
|
||||||
(s/replace (s/replace (s/replace string #"_" "-") #"s$" "") #"ie$" "y"))
|
(s/replace (s/replace (s/replace string #"_" "-") #"s$" "") #"ie$" "y"))
|
||||||
|
|
||||||
|
(defn entities
|
||||||
|
[application-map]
|
||||||
|
(filter #(= (-> % :tag) :entity) (:content application-map)))
|
||||||
|
|
||||||
(defn is-link-table?
|
(defn is-link-table?
|
||||||
|
"Does this `entity-map` represent a pure link table?"
|
||||||
[entity-map]
|
[entity-map]
|
||||||
(let [properties (-> entity-map :content :properties vals)
|
(let [properties (-> entity-map :content :properties vals)
|
||||||
links (filter #(-> % :attrs :entity) properties)]
|
links (filter #(-> % :attrs :entity) properties)]
|
||||||
(= (count properties) (count links))))
|
(= (count properties) (count links))))
|
||||||
|
|
||||||
|
|
||||||
|
(defn key-properties
|
||||||
|
"Return a list of all properties in the primary key of this `entity-map`."
|
||||||
|
[entity-map]
|
||||||
|
(filter
|
||||||
|
#(= (:tag %) :property)
|
||||||
|
(:content
|
||||||
|
;; there's required to be only one key element in and entity element
|
||||||
|
(first
|
||||||
|
(filter
|
||||||
|
#(= (:tag %) :key)
|
||||||
|
(:content entity-map))))))
|
||||||
|
|
||||||
|
|
||||||
|
(defn insertable-key-properties
|
||||||
|
"List properties in the key of the entity indicated by this `entity-map`
|
||||||
|
which should be inserted.
|
||||||
|
A key property is insertable it it is not `system` (database) generated.
|
||||||
|
But note that `system` is the default."
|
||||||
|
[entity-map]
|
||||||
|
(filter
|
||||||
|
#(let
|
||||||
|
[generator (-> % :attrs :generator)]
|
||||||
|
(not
|
||||||
|
(or (nil? generator)
|
||||||
|
(= generator "system"))))
|
||||||
|
(key-properties entity-map)))
|
||||||
|
|
||||||
|
|
||||||
|
(defn key-names
|
||||||
|
"List the names of all properties in the primary key of this `entity-map`."
|
||||||
|
[entity-map]
|
||||||
|
(remove
|
||||||
|
nil?
|
||||||
|
(map
|
||||||
|
#(:name (:attrs %))
|
||||||
|
(key-properties entity-map))))
|
||||||
|
|
||||||
|
|
||||||
|
(defn has-primary-key?
|
||||||
|
"True if this `entity-map` has a primary key."
|
||||||
|
[entity-map]
|
||||||
|
(not (empty? (key-names entity-map))))
|
||||||
|
|
||||||
|
|
||||||
|
(defn properties
|
||||||
|
"List the non-primary-key properties of this `entity-map`."
|
||||||
|
[entity-map]
|
||||||
|
(filter #(= (-> % :tag) :property) (:content entity-map)))
|
||||||
|
|
||||||
|
|
||||||
|
(defn has-non-key-properties?
|
||||||
|
"True if this `entity-map` has properties which do not form part of the
|
||||||
|
primary key."
|
||||||
|
[entity-map]
|
||||||
|
(not
|
||||||
|
(empty? (properties entity-map))))
|
||||||
|
|
||||||
|
|
||||||
|
(defn property-names
|
||||||
|
"List the names of non-primary-key properties of this `entity-map`."
|
||||||
|
[entity-map]
|
||||||
|
(map #(:name (:attrs %)) (properties entity-map)))
|
||||||
|
|
||||||
|
|
||||||
|
(defn quoted-type?
|
||||||
|
"Is the type of the property represented by this `property-map` one whose
|
||||||
|
values should be quoted in SQL queries?
|
||||||
|
TODO: this won't work for typedef types, which means we need to pass the
|
||||||
|
entire parsed ADL down the chain to here (and probably, generally) so that
|
||||||
|
we can resolve issues like that."
|
||||||
|
[property-map]
|
||||||
|
(#{"string", "text", "date", "time", "timestamp"} (-> property-map :attrs :type)))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,22 @@
|
||||||
(ns adl.to-hugsql-queries-test
|
(ns adl.to-hugsql-queries-test
|
||||||
(:require [clojure.test :refer :all]
|
(:require [clojure.string :as s]
|
||||||
[adl.to-hugsql-queries :refer :all]))
|
[clojure.test :refer :all]
|
||||||
|
[adl.to-hugsql-queries :refer :all]
|
||||||
|
[adl.utils :refer :all]))
|
||||||
|
|
||||||
|
(defn string-equal-ignore-whitespace
|
||||||
|
"I don't want unit tests to fail just because emitted whitespace changes."
|
||||||
|
[a b]
|
||||||
|
(if
|
||||||
|
(and
|
||||||
|
(string? a)
|
||||||
|
(string? b))
|
||||||
|
(let
|
||||||
|
[pattern #"[\s]+"
|
||||||
|
aa (s/replace a pattern " ")
|
||||||
|
bb (s/replace b pattern " ")]
|
||||||
|
(= aa bb))
|
||||||
|
(= a b)))
|
||||||
|
|
||||||
(deftest entity-tests
|
(deftest entity-tests
|
||||||
(let [xml {:tag :entity,
|
(let [xml {:tag :entity,
|
||||||
|
|
@ -32,67 +48,120 @@
|
||||||
(testing "user distinct properties should provide the default ordering"
|
(testing "user distinct properties should provide the default ordering"
|
||||||
(let [expected "ORDER BY address.street,\n\taddress.postcode,\n\taddress.id"
|
(let [expected "ORDER BY address.street,\n\taddress.postcode,\n\taddress.id"
|
||||||
actual (order-by-clause xml)]
|
actual (order-by-clause xml)]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
(testing "keys name extraction"
|
(testing "keys name extraction"
|
||||||
(let [expected '("id")
|
(let [expected '("id")
|
||||||
actual (key-names xml)]
|
actual (key-names xml)]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
(testing "primary key test"
|
(testing "primary key test"
|
||||||
(let [expected true
|
(let [expected true
|
||||||
actual (has-primary-key? xml)]
|
actual (has-primary-key? xml)]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
(testing "non-key properties test"
|
(testing "non-key properties test"
|
||||||
(let [expected true
|
(let [expected true
|
||||||
actual (has-non-key-properties? xml)]
|
actual (has-non-key-properties? xml)]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
(testing "insert query generation"
|
(testing "insert query generation"
|
||||||
(let [expected "-- :name create-addres! :! :n\n-- :doc creates a new addres record\nINSERT INTO address (street,\n\ttown,\n\tpostcode)\nVALUES (:street,\n\t:town,\n\t:postcode)\nreturning id\n\n"
|
(let [expected "-- :name create-addres! :! :n\n-- :doc creates a new addres record\nINSERT INTO address (street,\n\ttown,\n\tpostcode)\nVALUES (':street',\n\t':town',\n\t':postcode')\nreturning id\n\n"
|
||||||
actual (:query (first (vals (insert-query xml))))]
|
actual (:query (first (vals (insert-query xml))))]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
(testing "insert query signature"
|
(testing "insert query signature"
|
||||||
(let [expected ":! :n"
|
(let [expected ":! :n"
|
||||||
actual (:signature (first (vals (insert-query xml))))]
|
actual (:signature (first (vals (insert-query xml))))]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
(testing "update query generation"
|
(testing "update query generation"
|
||||||
(let [expected "-- :name update-addres! :! :n\n-- :doc updates an existing addres record\nUPDATE address\nSET street = :street,\n\ttown = :town,\n\tpostcode = :postcode\nWHERE address.id = :id\n\n"
|
(let [expected "-- :name update-addres! :! :n\n-- :doc updates an existing addres record\nUPDATE address\nSET street = :street,\n\ttown = :town,\n\tpostcode = :postcode\nWHERE address.id = :id\n\n"
|
||||||
actual (:query (first (vals (update-query xml))))]
|
actual (:query (first (vals (update-query xml))))]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
(testing "update query signature"
|
(testing "update query signature"
|
||||||
(let [expected ":! :n"
|
(let [expected ":! :n"
|
||||||
actual (:signature (first (vals (update-query xml))))]
|
actual (:signature (first (vals (update-query xml))))]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
(testing "search query generation"
|
(testing "search query generation"
|
||||||
(let [expected "-- :name search-strings-addres :? :1\n-- :doc selects existing address records having any string field matching `:pattern` by substring match\nSELECT * FROM address\nWHERE street LIKE '%:pattern%'\n\tOR town LIKE '%:pattern%'\n\tOR postcode LIKE '%:pattern%'\nORDER BY address.street,\n\taddress.postcode,\n\taddress.id\n--~ (if (:offset params) \"OFFSET :offset \") \n--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
|
(let [expected "-- :name search-strings-addres :? :1\n-- :doc selects existing address records having any string field matching `:pattern` by substring match\nSELECT * FROM address\nWHERE street LIKE '%:pattern%'\n\tOR town LIKE '%:pattern%'\n\tOR postcode LIKE '%:pattern%'\nORDER BY address.street,\n\taddress.postcode,\n\taddress.id\n--~ (if (:offset params) \"OFFSET :offset \") \n--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
|
||||||
actual (:query (first (vals (search-query xml))))]
|
actual (:query (first (vals (search-query xml))))]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
(testing "search query signature"
|
(testing "search query signature"
|
||||||
(let [expected ":? :1"
|
(let [expected ":? :1"
|
||||||
actual (:signature (first (vals (search-query xml))))]
|
actual (:signature (first (vals (search-query xml))))]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
(testing "select query generation"
|
(testing "select query generation"
|
||||||
(let [expected "-- :name get-addres :? :1\n-- :doc selects an existing addres record\nSELECT * FROM address\nWHERE address.id = :id\n\n"
|
(let [expected "-- :name get-addres :? :1\n-- :doc selects an existing addres record\nSELECT * FROM address\nWHERE address.id = :id\n\n"
|
||||||
actual (:query (first (vals (select-query xml))))]
|
actual (:query (first (vals (select-query xml))))]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
(testing "select query signature"
|
(testing "select query signature"
|
||||||
(let [expected ":? :1"
|
(let [expected ":? :1"
|
||||||
actual (:signature (first (vals (select-query xml))))]
|
actual (:signature (first (vals (select-query xml))))]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
(testing "list query generation"
|
(testing "list query generation"
|
||||||
(let [expected "-- :name list-address :? :*\n-- :doc lists all existing addres records\nSELECT * FROM address\nORDER BY address.street,\n\taddress.postcode,\n\taddress.id\n--~ (if (:offset params) \"OFFSET :offset \") \n--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
|
(let [expected "-- :name list-address :? :*\n-- :doc lists all existing addres records\nSELECT * FROM address\nORDER BY address.street,\n\taddress.postcode,\n\taddress.id\n--~ (if (:offset params) \"OFFSET :offset \") \n--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
|
||||||
actual (:query (first (vals (list-query xml))))]
|
actual (:query (first (vals (list-query xml))))]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
(testing "list query signature"
|
(testing "list query signature"
|
||||||
(let [expected ":? :*"
|
(let [expected ":? :*"
|
||||||
actual (:signature (first (vals (list-query xml))))]
|
actual (:signature (first (vals (list-query xml))))]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
(testing "delete query generation"
|
(testing "delete query generation"
|
||||||
(let [expected "-- :name delete-addres! :! :n\n-- :doc updates an existing addres record\nDELETE FROM address\nWHERE address.id = :id\n\n"
|
(let [expected "-- :name delete-addres! :! :n\n-- :doc updates an existing addres record\nDELETE FROM address\nWHERE address.id = :id\n\n"
|
||||||
actual (:query (first (vals (delete-query xml))))]
|
actual (:query (first (vals (delete-query xml))))]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
(testing "delete query signature"
|
(testing "delete query signature"
|
||||||
(let [expected ":! :n"
|
(let [expected ":! :n"
|
||||||
actual (:signature (first (vals (delete-query xml))))]
|
actual (:signature (first (vals (delete-query xml))))]
|
||||||
(is (= actual expected))))
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
|
|
||||||
))
|
))
|
||||||
|
|
||||||
|
(deftest complex-key-tests
|
||||||
|
(let [xml {:tag :entity,
|
||||||
|
:attrs {:name "address"},
|
||||||
|
:content
|
||||||
|
[{:tag :key,
|
||||||
|
:attrs nil,
|
||||||
|
:content
|
||||||
|
[{:tag :property,
|
||||||
|
:attrs
|
||||||
|
{:immutable "true",
|
||||||
|
:required "true",
|
||||||
|
:distinct "system",
|
||||||
|
:type "integer",
|
||||||
|
:name "id"},
|
||||||
|
:content
|
||||||
|
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
|
||||||
|
{:tag :property,
|
||||||
|
:attrs
|
||||||
|
{:immutable "true",
|
||||||
|
:required "true",
|
||||||
|
:distinct "all",
|
||||||
|
:generator "assigned"
|
||||||
|
:type "string",
|
||||||
|
:size "12"
|
||||||
|
:name "postcode"},
|
||||||
|
:content
|
||||||
|
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
|
||||||
|
]}
|
||||||
|
{:tag :property,
|
||||||
|
:attrs
|
||||||
|
{:distinct "user", :size "128", :type "string", :name "street"},
|
||||||
|
:content nil}
|
||||||
|
{:tag :property,
|
||||||
|
:attrs {:size "64", :type "string", :name "town"},
|
||||||
|
:content nil}
|
||||||
|
]}]
|
||||||
|
(testing "insert query generation - compound key, non system generated field in key"
|
||||||
|
(let [expected "-- :name create-addres! :! :n\n-- :doc creates a new addres record\nINSERT INTO address (street,\n\ttown,\n\tpostcode)\nVALUES (':street',\n\t':town',\n\t':postcode')\nreturning id,\n\tpostcode\n\n"
|
||||||
|
actual (:query (first (vals (insert-query xml))))]
|
||||||
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
|
(testing "update query generation - compound key"
|
||||||
|
(let [expected "-- :name update-addres! :! :n\n-- :doc updates an existing addres record\nUPDATE address\nSET street = :street,\n\ttown = :town\nWHERE address.id = :id AND\n\taddress.postcode = ':postcode'\n\n"
|
||||||
|
actual (:query (first (vals (update-query xml))))]
|
||||||
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
|
(testing "search query generation - user-distinct field in key"
|
||||||
|
(let [expected "-- :name search-strings-addres :? :1\n-- :doc selects existing address records having any string field matching `:pattern` by substring match\nSELECT * FROM address\nWHERE street LIKE '%:pattern%'\n\tOR town LIKE '%:pattern%'\n\tOR postcode LIKE '%:pattern%'\nORDER BY address.street,\n\taddress.postcode,\n\taddress.id,\n\taddress.postcode\n--~ (if (:offset params) \"OFFSET :offset \") \n--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
|
||||||
|
actual (:query (first (vals (search-query xml))))]
|
||||||
|
(is (string-equal-ignore-whitespace actual expected))))
|
||||||
|
(testing "delete query generation - compound key"
|
||||||
|
(let [expected "-- :name delete-addres! :! :n\n-- :doc updates an existing addres record\nDELETE FROM address\nWHERE address.id = :id AND\n\taddress.postcode = ':postcode'\n\n"
|
||||||
|
actual (:query (first (vals (delete-query xml))))]
|
||||||
|
(is (string-equal-ignore-whitespace actual expected))))))
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue