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 -->
|
||||
<!-- -->
|
||||
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
|
||||
|
||||
|
||||
<!--
|
||||
$Revision: 1.5 $
|
||||
-->
|
||||
|
|
@ -24,8 +24,8 @@
|
|||
<!-- Before we start: some useful definitions -->
|
||||
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
|
||||
|
||||
<!-- 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
|
||||
<!-- 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
|
||||
that we can allow HTML block level entities within content elements -->
|
||||
<!ENTITY nbsp " ">
|
||||
<!ENTITY pound "£">
|
||||
|
|
@ -35,7 +35,7 @@ that we can allow HTML block level entities within content elements -->
|
|||
<!-- boolean means true or false -->
|
||||
<!ENTITY % Boolean "(true|false)" >
|
||||
|
||||
<!--
|
||||
<!--
|
||||
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:
|
||||
<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" >
|
||||
|
||||
<!--
|
||||
<!--
|
||||
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
|
||||
greater permission on form than the entity it belongs to
|
||||
|
||||
|
||||
none: none
|
||||
read: select
|
||||
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
|
||||
'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'
|
||||
and type='list'
|
||||
|
||||
|
||||
all : cascade delete, save and update
|
||||
all-delete-orphan : see hibernate documentation; relates to transient objects only
|
||||
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">
|
||||
|
||||
<!--
|
||||
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
|
||||
min and max values
|
||||
<!--
|
||||
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
|
||||
min and max values
|
||||
string: varchar java.sql.Types.VARCHAR
|
||||
integer: int java.sql.Types.INTEGER
|
||||
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
|
||||
time: time java.sql.Types.TIME
|
||||
timestamp: timestamp java.sql.Types.TIMESTAMP
|
||||
uploadable: varchar java.sql.Types.VARCHAR
|
||||
uploadable: 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 but points to an uploadable graphical image file
|
||||
-->
|
||||
<!ENTITY % DefinableDataTypes "string|integer|real|money|date|time|timestamp|uploadable" >
|
||||
|
||||
<!--
|
||||
<!--
|
||||
data types which are fairly straightforward translations of JDBC data types
|
||||
boolean: boolean or java.sql.Types.BIT
|
||||
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
|
||||
-->
|
||||
<!ENTITY % SimpleDataTypes "%DefinableDataTypes;|boolean|text" >
|
||||
|
||||
<!--
|
||||
<!--
|
||||
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);
|
||||
list : a list of some other entity that links to me (i.e. the 'one' end of
|
||||
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" >
|
||||
|
||||
<!--
|
||||
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
|
||||
geopos : a latitude/longitude pair (experimental and 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)
|
||||
user-distinct: all properties which are user-distinct (NOTE: Not yet implemented)
|
||||
listed: only those properties for which fields are explicitly listed
|
||||
-->
|
||||
<!ENTITY % PageAttrs
|
||||
-->
|
||||
<!ENTITY % PageAttrs
|
||||
"name CDATA #REQUIRED
|
||||
properties (all|user-distinct|listed) #REQUIRED" >
|
||||
|
||||
<!-- 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.
|
||||
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.
|
||||
mannual: You contract to supply a generatos class in manually maintained
|
||||
mannual: You contract to supply a generator class in manually maintained
|
||||
code.
|
||||
native: The database will supply a unique value to this field when it
|
||||
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 -
|
||||
typically alpha-numeric, except for dates, etc.
|
||||
reverse-canonical: The reverse of the above
|
||||
|
||||
|
||||
possibly there should be some further values but I have no idea what these are
|
||||
-->
|
||||
<!ENTITY % Sequences "canonical|reverse-canonical">
|
||||
|
|
@ -172,9 +172,9 @@ that we can allow HTML block level entities within content elements -->
|
|||
<!-- Elements -->
|
||||
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
|
||||
|
||||
<!--
|
||||
<!--
|
||||
the application that the document describes: required top level element
|
||||
|
||||
|
||||
name: the name of this application
|
||||
version: the version number of this application
|
||||
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
|
||||
-->
|
||||
<!ELEMENT application ( specification*, documentation?, content?, typedef*, group*, entity*)>
|
||||
<!ATTLIST application
|
||||
<!ATTLIST application
|
||||
name CDATA #REQUIRED
|
||||
version CDATA #IMPLIED
|
||||
revision CDATA #IMPLIED
|
||||
currency CDATA #IMPLIED
|
||||
xmlns CDATA #IMPLIED>
|
||||
|
||||
<!--
|
||||
<!--
|
||||
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 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*) >
|
||||
|
||||
<!ATTLIST typedef
|
||||
<!ATTLIST typedef
|
||||
name CDATA #REQUIRED
|
||||
type (%DefinableDataTypes;) #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
|
||||
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.
|
||||
|
||||
|
||||
target: the 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?)>
|
||||
|
||||
|
|
@ -232,28 +232,28 @@ that we can allow HTML block level entities within content elements -->
|
|||
value CDATA #REQUIRED
|
||||
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
|
||||
parent: the name of a group of which this group is subset
|
||||
-->
|
||||
<!ELEMENT group (documentation?)>
|
||||
|
||||
<!ATTLIST group
|
||||
<!ATTLIST group
|
||||
name CDATA #REQUIRED
|
||||
parent CDATA #IMPLIED>
|
||||
|
||||
|
||||
|
||||
<!--
|
||||
<!--
|
||||
an entity which has properties and relationships; maps onto a database
|
||||
table or a Java serialisable class - or, of course, various other things
|
||||
|
||||
|
||||
name: obviously, the name of this entity
|
||||
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
|
||||
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
|
||||
'key' element, below.
|
||||
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?,
|
||||
property*, permission*, (form | page | list)*)>
|
||||
<!ATTLIST entity
|
||||
<!ATTLIST entity
|
||||
name CDATA #REQUIRED
|
||||
natural-key CDATA #IMPLIED
|
||||
table CDATA #IMPLIED
|
||||
foreign %Boolean; #IMPLIED>
|
||||
|
||||
<!--
|
||||
<!--
|
||||
contains documentation on the element which immediately contains it. TODO:
|
||||
should HTML markup within a documentation element be allowed? If so, are
|
||||
there restrictions?
|
||||
|
|
@ -284,33 +284,33 @@ that we can allow HTML block level entities within content elements -->
|
|||
<!ELEMENT key (property*)>
|
||||
|
||||
|
||||
<!--
|
||||
a property (field) of an entity (table)
|
||||
|
||||
<!--
|
||||
a property (field) of an entity (table)
|
||||
|
||||
name: the name 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!
|
||||
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);
|
||||
distinct='user' implies that the value may be used by users
|
||||
in distinguishing entities even if values are not formally
|
||||
unique;
|
||||
distinct='all' implies that the values are formally unique
|
||||
distinct='user' implies that the value may be used by users
|
||||
in distinguishing entities even if values are not formally
|
||||
unique;
|
||||
distinct='all' implies that the values are formally unique
|
||||
/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.
|
||||
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
|
||||
farkey: if type='list', the name of farside key in the listed
|
||||
entity; if type='entity' and the farside field to join to
|
||||
farkey: if type='list', the name of farside key in the listed
|
||||
entity; if type='entity' and the farside field to join to
|
||||
is not the farside primary key, then the name of that
|
||||
farside field
|
||||
required: whether this propery is required (i.e. 'not null').
|
||||
immutable: if true, once a value has been set it cannot be changed.
|
||||
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
|
||||
be provided to support this)
|
||||
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
|
||||
is stored. TODO: Think about this.
|
||||
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
|
||||
it has been committed
|
||||
-->
|
||||
<!ELEMENT property ( documentation?, generator?, (permission|option|prompt|help|ifmissing)*)>
|
||||
|
||||
<!ATTLIST property
|
||||
<!ATTLIST property
|
||||
name CDATA #REQUIRED
|
||||
type (%AllDataTypes;) #REQUIRED
|
||||
default CDATA #IMPLIED
|
||||
|
|
@ -334,24 +334,24 @@ that we can allow HTML block level entities within content elements -->
|
|||
entity CDATA #IMPLIED
|
||||
farkey CDATA #IMPLIED
|
||||
required %Boolean; #IMPLIED
|
||||
immutable %Boolean; #IMPLIED
|
||||
immutable %Boolean; #IMPLIED
|
||||
size CDATA #IMPLIED
|
||||
column CDATA #IMPLIED
|
||||
concrete %Boolean; #IMPLIED
|
||||
cascade (%CascadeActions;) #IMPLIED>
|
||||
|
||||
|
||||
<!--
|
||||
marks a property which is auto-generated by some part of the system.
|
||||
This is based on the Hibernate construct, except that the Hibernate
|
||||
implementation folds both its internal generators and custom generators
|
||||
onto the same attribute. This separates them onto two attributes so we
|
||||
<!--
|
||||
marks a property which is auto-generated by some part of the system.
|
||||
This is based on the Hibernate construct, except that the Hibernate
|
||||
implementation folds both its internal generators and custom generators
|
||||
onto the same attribute. This separates them onto two attributes so we
|
||||
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
|
||||
class: if action is 'manual', the name of a manually maintained
|
||||
class conforming to the Hibernate IdentifierGenerator
|
||||
class: if action is 'manual', the name of a manually maintained
|
||||
class conforming to the Hibernate IdentifierGenerator
|
||||
interface, or its equivalent in other languages
|
||||
-->
|
||||
<!ELEMENT generator (documentation?, param*)>
|
||||
|
|
@ -360,15 +360,15 @@ that we can allow HTML block level entities within content elements -->
|
|||
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
|
||||
markup is definitely not allowed!
|
||||
|
||||
|
||||
name: the name of this parameter
|
||||
|
||||
|
||||
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
|
||||
our usage is compatible with the XHTML usage, but it might be less
|
||||
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
|
||||
ambiguous to rename it.
|
||||
-->
|
||||
<!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
|
||||
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
|
||||
UNDEFINED whether they're encoded as a single reference data table or as
|
||||
<!--
|
||||
one of an explicit list of optional values a property may have
|
||||
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
|
||||
UNDEFINED whether they're encoded as a single reference data table or as
|
||||
separate reference data tables for each property.
|
||||
|
||||
|
||||
value: the value of this option
|
||||
|
||||
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
|
||||
our usage is compatible with the XHTML usage, but it might be less
|
||||
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
|
||||
ambiguous to rename it.
|
||||
-->
|
||||
<!ELEMENT option (documentation?, prompt*)>
|
||||
<!-- if the value is different from the prompt the user sees, specify it -->
|
||||
<!ATTLIST option
|
||||
<!ATTLIST option
|
||||
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
|
||||
permission: the permission which is granted to that group
|
||||
-->
|
||||
<!ELEMENT permission (documentation?)>
|
||||
<!ATTLIST permission
|
||||
<!ATTLIST permission
|
||||
group CDATA #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
|
||||
will become 'well known', but the whole point of having a pragma
|
||||
architecture is that it is extensible.
|
||||
|
|
@ -420,27 +420,27 @@ that we can allow HTML block level entities within content elements -->
|
|||
name 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
|
||||
per locale; if there are more than one all those matching the locale may
|
||||
be concatenated, or just one may be used.
|
||||
|
||||
|
||||
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?)>
|
||||
<!ATTLIST prompt
|
||||
prompt CDATA #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
|
||||
per locale; if there are more than one all those matching the locale may
|
||||
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)>
|
||||
<!ATTLIST help
|
||||
|
|
@ -448,7 +448,7 @@ that we can allow HTML block level entities within content elements -->
|
|||
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
|
||||
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
|
||||
|
|
@ -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
|
||||
|
||||
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;)*)>
|
||||
<!ATTLIST form %PageAttrs;>
|
||||
|
|
@ -472,7 +472,7 @@ that we can allow HTML block level entities within content elements -->
|
|||
<!ELEMENT page (documentation?, ( %PageStuff;)*)>
|
||||
<!ATTLIST page %PageAttrs;>
|
||||
|
||||
<!-- an ordering or records in a list
|
||||
<!-- an ordering or records in a list
|
||||
property: the property on 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
|
||||
sequence (%Sequences;) #IMPLIED>
|
||||
|
||||
<!--
|
||||
<!--
|
||||
a list on which entities of a given type are listed
|
||||
|
||||
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)*)>
|
||||
<!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
|
||||
entities in the enclosing page or list are listed
|
||||
|
||||
|
||||
property: the property of the enclosing entity that this
|
||||
list displays (obviously, must be of type='list')
|
||||
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>
|
||||
|
||||
<!--
|
||||
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.
|
||||
-->
|
||||
<!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
|
||||
-->
|
||||
<!ELEMENT field (documentation?, (prompt|help|permission)*) >
|
||||
<!ATTLIST field
|
||||
<!ATTLIST field
|
||||
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'
|
||||
attribute of the verb is what gets returned to the controller -->
|
||||
<!ELEMENT verb (documentation?, (prompt|help|permission)*) >
|
||||
|
|
@ -539,14 +539,14 @@ that we can allow HTML block level entities within content elements -->
|
|||
<!ELEMENT content (%Content;)*>
|
||||
|
||||
|
||||
<!--
|
||||
content to place in the head of the generated document; this is #PCDATA
|
||||
because it will almost certainly belong to a different namespace
|
||||
<!--
|
||||
content to place in the head of the generated document; this is #PCDATA
|
||||
because it will almost certainly belong to a different namespace
|
||||
(usually HTML)
|
||||
|
||||
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
|
||||
our usage is compatible with the XHTML usage, but it might be less
|
||||
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
|
||||
ambiguous to rename it.
|
||||
-->
|
||||
<!ELEMENT head (#PCDATA) >
|
||||
|
|
@ -554,30 +554,30 @@ that we can allow HTML block level entities within content elements -->
|
|||
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.
|
||||
-->
|
||||
<!ELEMENT top (#PCDATA) >
|
||||
<!ATTLIST top
|
||||
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.
|
||||
-->
|
||||
<!ELEMENT foot (#PCDATA) >
|
||||
<!ATTLIST foot
|
||||
xmlns CDATA #IMPLIED>
|
||||
|
||||
<!--
|
||||
<!--
|
||||
The 'specification' and 'reference' elements are for documentation only,
|
||||
and do not contribute to the engineering of the application described.
|
||||
|
||||
|
||||
A specification element is intended chiefly to declare the reference
|
||||
documents which may be used in documentation elements later in the
|
||||
document.
|
||||
|
||||
documents which may be used in documentation elements later in the
|
||||
document.
|
||||
|
||||
url: The URL from which the document referenced can be retrieved
|
||||
name: The full name (title) given to this document
|
||||
abbr: A convenient abbreviated name
|
||||
|
|
@ -589,12 +589,12 @@ that we can allow HTML block level entities within content elements -->
|
|||
abbr CDATA #REQUIRED
|
||||
>
|
||||
|
||||
<!--
|
||||
<!--
|
||||
The 'specification' and 'reference' elements are for documentation only,
|
||||
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
|
||||
reference refers
|
||||
section: The 'anchor part' (part following a hash character) which,
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
[clojure.string :as s]
|
||||
[clj-time.core :as t]
|
||||
[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]
|
||||
(let
|
||||
[entity-name (:name (:attrs entity-map))]
|
||||
(str
|
||||
"WHERE " entity-name "."
|
||||
(s/join
|
||||
(str " AND\n\t" entity-name ".")
|
||||
(map #(str % " = " (keyword %)) (key-names entity-map))))))
|
||||
"WHERE " entity-name "."
|
||||
(s/join
|
||||
(str " AND\n\t" entity-name ".")
|
||||
(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]
|
||||
|
|
@ -66,69 +56,77 @@
|
|||
preferred (map
|
||||
#(:name (:attrs %))
|
||||
(filter #(and
|
||||
(= (-> % :attrs :distinct) "user")
|
||||
(#{"all", "user"} (-> % :attrs :distinct))
|
||||
(= (-> % :tag) :property))
|
||||
(-> entity-map :content)))]
|
||||
(concat (properties entity-map)(key-properties entity-map))))]
|
||||
(str
|
||||
"ORDER BY " entity-name "."
|
||||
(s/join
|
||||
(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]
|
||||
(let [entity-name (:name (:attrs entity-map))
|
||||
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 "!")
|
||||
signature ":! :n"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :insert-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc creates a new " pretty-name " record\n"
|
||||
"INSERT INTO " entity-name " ("
|
||||
(s/join ",\n\t" all-property-names)
|
||||
")\nVALUES ("
|
||||
(s/join ",\n\t" (map keyword all-property-names))
|
||||
")"
|
||||
(if
|
||||
(has-primary-key? entity-map)
|
||||
(str "\nreturning " (s/join ",\n\t" (key-names entity-map))))
|
||||
"\n\n")})))
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :insert-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc creates a new " pretty-name " record\n"
|
||||
"INSERT INTO " entity-name " ("
|
||||
(s/join ",\n\t" pnames)
|
||||
")\nVALUES ("
|
||||
(s/join ",\n\t"
|
||||
(map
|
||||
#(let [target (keyword (-> % :attrs :name))]
|
||||
(if
|
||||
(quoted-type? %)
|
||||
(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]
|
||||
(if
|
||||
(and
|
||||
(has-primary-key? entity-map)
|
||||
(has-non-key-properties? entity-map))
|
||||
(has-primary-key? entity-map)
|
||||
(has-non-key-properties? entity-map))
|
||||
(let [entity-name (:name (:attrs entity-map))
|
||||
pretty-name (singularise entity-name)
|
||||
property-names (property-names entity-map)
|
||||
query-name (str "update-" pretty-name "!")
|
||||
signature ":! :n"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :update-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc updates an existing " pretty-name " record\n"
|
||||
"UPDATE " entity-name "\n"
|
||||
"SET "
|
||||
(s/join ",\n\t" (map #(str % " = " (keyword %)) property-names))
|
||||
"\n"
|
||||
(where-clause entity-map)
|
||||
"\n\n")}))
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :update-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc updates an existing " pretty-name " record\n"
|
||||
"UPDATE " entity-name "\n"
|
||||
"SET "
|
||||
(s/join ",\n\t" (map #(str % " = " (keyword %)) property-names))
|
||||
"\n"
|
||||
(where-clause entity-map)
|
||||
"\n\n")}))
|
||||
{}))
|
||||
|
||||
|
||||
|
|
@ -137,11 +135,11 @@
|
|||
pretty-name (singularise entity-name)
|
||||
query-name (str "search-strings-" pretty-name)
|
||||
signature ":? :1"
|
||||
props (concat (properties entity-map) (insertable-key-properties entity-map))
|
||||
string-fields (filter
|
||||
#(and
|
||||
(= (-> % :attrs :type) "string")
|
||||
(= (:tag %) :property))
|
||||
(-> entity-map :content))]
|
||||
;; TODO: should also allow typdefed fields which typedef to string.
|
||||
#(= (-> % :attrs :type) "string")
|
||||
props)]
|
||||
(if
|
||||
(empty? string-fields)
|
||||
{}
|
||||
|
|
@ -164,8 +162,8 @@
|
|||
"\n"
|
||||
(order-by-clause entity-map)
|
||||
"\n"
|
||||
"--~ (if (:offset params) \"OFFSET :offset \") \n"
|
||||
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
|
||||
"--~ (if (:offset params) \"OFFSET :offset \") \n"
|
||||
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
|
||||
"\n\n")}))))
|
||||
|
||||
|
||||
|
|
@ -177,17 +175,17 @@
|
|||
query-name (str "get-" pretty-name)
|
||||
signature ":? :1"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :select-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc selects an existing " pretty-name " record\n"
|
||||
"SELECT * FROM " entity-name "\n"
|
||||
(where-clause entity-map)
|
||||
"\n\n")}))
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :select-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc selects an existing " pretty-name " record\n"
|
||||
"SELECT * FROM " entity-name "\n"
|
||||
(where-clause entity-map)
|
||||
"\n\n")}))
|
||||
{}))
|
||||
|
||||
|
||||
|
|
@ -201,19 +199,19 @@
|
|||
query-name (str "list-" entity-name)
|
||||
signature ":? :*"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :select-many
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc lists all existing " pretty-name " records\n"
|
||||
"SELECT * FROM " entity-name "\n"
|
||||
(order-by-clause entity-map) "\n"
|
||||
"--~ (if (:offset params) \"OFFSET :offset \") \n"
|
||||
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
|
||||
"\n\n")})))
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :select-many
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc lists all existing " pretty-name " records\n"
|
||||
"SELECT * FROM " entity-name "\n"
|
||||
(order-by-clause entity-map) "\n"
|
||||
"--~ (if (:offset params) \"OFFSET :offset \") \n"
|
||||
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
|
||||
"\n\n")})))
|
||||
|
||||
|
||||
(defn foreign-queries [entity-map entities-map]
|
||||
|
|
@ -221,39 +219,39 @@
|
|||
pretty-name (singularise entity-name)
|
||||
links (filter #(-> % :attrs :entity) (-> entity-map :content :properties vals))]
|
||||
(apply
|
||||
merge
|
||||
(map
|
||||
#(let [far-name (-> % :attrs :entity)
|
||||
far-entity ((keyword far-name) entities-map)
|
||||
pretty-far (s/replace (s/replace far-name #"_" "-") #"s$" "")
|
||||
farkey (-> % :attrs :farkey)
|
||||
link-field (-> % :attrs :name)
|
||||
query-name (str "list-" entity-name "-by-" pretty-far)
|
||||
signature ":? :*"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :select-one-to-many
|
||||
:far-entity far-entity
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc lists all existing " pretty-name " records related to a given " pretty-far "\n"
|
||||
"SELECT * \nFROM " entity-name "\n"
|
||||
"WHERE " entity-name "." link-field " = :id\n"
|
||||
(order-by-clause entity-map)
|
||||
"\n\n")}))
|
||||
links))))
|
||||
merge
|
||||
(map
|
||||
#(let [far-name (-> % :attrs :entity)
|
||||
far-entity ((keyword far-name) entities-map)
|
||||
pretty-far (s/replace (s/replace far-name #"_" "-") #"s$" "")
|
||||
farkey (-> % :attrs :farkey)
|
||||
link-field (-> % :attrs :name)
|
||||
query-name (str "list-" entity-name "-by-" pretty-far)
|
||||
signature ":? :*"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :select-one-to-many
|
||||
:far-entity far-entity
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc lists all existing " pretty-name " records related to a given " pretty-far "\n"
|
||||
"SELECT * \nFROM " entity-name "\n"
|
||||
"WHERE " entity-name "." link-field " = :id\n"
|
||||
(order-by-clause entity-map)
|
||||
"\n\n")}))
|
||||
links))))
|
||||
|
||||
|
||||
(defn link-table-query [near link far]
|
||||
(let [properties (-> link :content :properties vals)
|
||||
links (apply
|
||||
merge
|
||||
(map
|
||||
#(hash-map (keyword (-> % :attrs :entity)) %)
|
||||
(filter #(-> % :attrs :entity) properties)))
|
||||
merge
|
||||
(map
|
||||
#(hash-map (keyword (-> % :attrs :entity)) %)
|
||||
(filter #(-> % :attrs :entity) properties)))
|
||||
near-name (-> near :attrs :name)
|
||||
link-name (-> link :attrs :name)
|
||||
far-name (-> far :attrs :name)
|
||||
|
|
@ -261,37 +259,37 @@
|
|||
query-name (str "list-" link-name "-" near-name "-by-" pretty-far)
|
||||
signature ":? :*"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity link
|
||||
:type :select-many-to-many
|
||||
:near-entity near
|
||||
:far-entity far
|
||||
:query
|
||||
(str "-- :name " query-name " " signature " \n"
|
||||
"-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far "\n"
|
||||
"SELECT "near-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"
|
||||
"AND " link-name "." (-> (links (keyword far-name)) :attrs :name) " = :id\n"
|
||||
(order-by-clause near)
|
||||
"\n\n")})))
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity link
|
||||
:type :select-many-to-many
|
||||
:near-entity near
|
||||
:far-entity far
|
||||
:query
|
||||
(str "-- :name " query-name " " signature " \n"
|
||||
"-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far "\n"
|
||||
"SELECT "near-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"
|
||||
"AND " link-name "." (-> (links (keyword far-name)) :attrs :name) " = :id\n"
|
||||
(order-by-clause near)
|
||||
"\n\n")})))
|
||||
|
||||
|
||||
(defn link-table-queries [entity-map entities-map]
|
||||
(let
|
||||
[entities (map
|
||||
#((keyword %) entities-map)
|
||||
(remove nil? (map #(-> % :attrs :entity) (-> entity-map :content :properties vals))))
|
||||
#((keyword %) entities-map)
|
||||
(remove nil? (map #(-> % :attrs :entity) (-> entity-map :content :properties vals))))
|
||||
pairs (combinations entities 2)]
|
||||
(apply
|
||||
merge
|
||||
(map
|
||||
#(merge
|
||||
(link-table-query (nth % 0) entity-map (nth % 1))
|
||||
(link-table-query (nth % 1) entity-map (nth % 0)))
|
||||
pairs))))
|
||||
merge
|
||||
(map
|
||||
#(merge
|
||||
(link-table-query (nth % 0) entity-map (nth % 1))
|
||||
(link-table-query (nth % 1) entity-map (nth % 0)))
|
||||
pairs))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -303,34 +301,34 @@
|
|||
query-name (str "delete-" pretty-name "!")
|
||||
signature ":! :n"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :delete-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc updates an existing " pretty-name " record\n"
|
||||
"DELETE FROM " entity-name "\n"
|
||||
(where-clause entity-map)
|
||||
"\n\n")}))))
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :delete-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc updates an existing " pretty-name " record\n"
|
||||
"DELETE FROM " entity-name "\n"
|
||||
(where-clause entity-map)
|
||||
"\n\n")}))))
|
||||
|
||||
|
||||
(defn queries
|
||||
[entity-map entities-map]
|
||||
(merge
|
||||
{}
|
||||
(insert-query entity-map)
|
||||
(update-query entity-map)
|
||||
(delete-query entity-map)
|
||||
(if
|
||||
(is-link-table? entity-map)
|
||||
(link-table-queries entity-map entities-map)
|
||||
(merge
|
||||
(select-query entity-map)
|
||||
(list-query entity-map)
|
||||
(search-query entity-map)
|
||||
(foreign-queries entity-map entities-map)))))
|
||||
{}
|
||||
(insert-query entity-map)
|
||||
(update-query entity-map)
|
||||
(delete-query entity-map)
|
||||
(if
|
||||
(is-link-table? entity-map)
|
||||
(link-table-queries entity-map entities-map)
|
||||
(merge
|
||||
(select-query entity-map)
|
||||
(list-query entity-map)
|
||||
(search-query entity-map)
|
||||
(foreign-queries entity-map entities-map)))))
|
||||
|
||||
|
||||
;; (defn migrations-to-queries-sql
|
||||
|
|
|
|||
|
|
@ -1,11 +1,126 @@
|
|||
(ns adl.utils
|
||||
(: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"))
|
||||
|
||||
(defn entities
|
||||
[application-map]
|
||||
(filter #(= (-> % :tag) :entity) (:content application-map)))
|
||||
|
||||
(defn is-link-table?
|
||||
"Does this `entity-map` represent a pure link table?"
|
||||
[entity-map]
|
||||
(let [properties (-> entity-map :content :properties vals)
|
||||
links (filter #(-> % :attrs :entity) properties)]
|
||||
(= (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
|
||||
(:require [clojure.test :refer :all]
|
||||
[adl.to-hugsql-queries :refer :all]))
|
||||
(:require [clojure.string :as s]
|
||||
[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
|
||||
(let [xml {:tag :entity,
|
||||
|
|
@ -32,67 +48,120 @@
|
|||
(testing "user distinct properties should provide the default ordering"
|
||||
(let [expected "ORDER BY address.street,\n\taddress.postcode,\n\taddress.id"
|
||||
actual (order-by-clause xml)]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "keys name extraction"
|
||||
(let [expected '("id")
|
||||
actual (key-names xml)]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "primary key test"
|
||||
(let [expected true
|
||||
actual (has-primary-key? xml)]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "non-key properties test"
|
||||
(let [expected true
|
||||
actual (has-non-key-properties? xml)]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(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))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "insert query signature"
|
||||
(let [expected ":! :n"
|
||||
actual (:signature (first (vals (insert-query xml))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(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"
|
||||
actual (:query (first (vals (update-query xml))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "update query signature"
|
||||
(let [expected ":! :n"
|
||||
actual (:signature (first (vals (update-query xml))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(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"
|
||||
actual (:query (first (vals (search-query xml))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "search query signature"
|
||||
(let [expected ":? :1"
|
||||
actual (:signature (first (vals (search-query xml))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(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"
|
||||
actual (:query (first (vals (select-query xml))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "select query signature"
|
||||
(let [expected ":? :1"
|
||||
actual (:signature (first (vals (select-query xml))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(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"
|
||||
actual (:query (first (vals (list-query xml))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "list query signature"
|
||||
(let [expected ":? :*"
|
||||
actual (:signature (first (vals (list-query xml))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(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"
|
||||
actual (:query (first (vals (delete-query xml))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "delete query signature"
|
||||
(let [expected ":! :n"
|
||||
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