simon/adl
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Merge branch 'release/1.4.1'

Browse source
This commit is contained in:
Simon Brooke 2018-07-18 23:19:43 +01:00
parent dacc4a6429 549d4ad2be
commit 7c66029957
58 changed files with 8273 additions and 376 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.cvsignore
View file

@ -1,2 +0,0 @@
obj
bin

25
.gitignore vendored Normal file
View file

@ -0,0 +1,25 @@
/target
/classes
/checkouts
pom.xml
pom.xml.asc
*.jar
*.class
/.lein-*
/.nrepl-port
.hgignore
.hg/
.idea
resources/auto/
generated/resources/sql/
generated/resources/templates/auto/
generated/src/clj/youyesyet/routes/
*.iml
node_modules/

86
LICENSE Normal file
View file

@ -0,0 +1,86 @@
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Lesser General Public License instead.) You can apply it to your programs, too.
When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights.
We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations.
Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and modification follow.
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program.
You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License.
c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program.
In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License.
3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable.
If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance.
5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License.
7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances.
It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice.
This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns.
Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation.
10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.

340
LICENSE.md Normal file
View file

@ -0,0 +1,340 @@
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc., <http://fsf.org/>
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Lesser General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
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.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) year name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
{signature of Ty Coon}, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License.

78
README.md Normal file
View file

@ -0,0 +1,78 @@
# Application Description Language
A language for describing applications, from which code can be automatically generated.
## Usage
A document describing the proposed application should be written in XML using the DTD `resources/schemas/adl-1.4.1.dtd`. It may then be transformed into a C# or Java application using the XSL transforms, see **History** below, but this code is very out of date and the resulting application is unlikely to be very usable. Alternatively, it can be transformed into a Clojure [Luminus](http://www.luminusweb.net/) application using the Clojure transformation, as follows:
simon@fletcher:~/workspace/adl$ java -jar target/adl-1.4.1-SNAPSHOT-standalone.jar --help
Usage: java -jar adl-[VERSION]-SNAPSHOT-standalone.jar -options [adl-file]
where options include:
-a, --abstract-key-name-convention [string]: the abstract key name convention to use for generated key fields (TODO: not yet implemented); (default: id)
-h, --help: Show this message
-l, --locale [LOCALE]: set the locale to generate; (default: en_GB.UTF-8)
-p, --path [PATH]: The path under which generated files should be written; (default: generated)
-v, --verbosity [LEVEL], : Verbosity level - integer value required; (default: 0)
This is not yet complete but it is at an advanced stage and already produces code which is useful.
## History
This idea started back in 2007, when I felt that web development in Java had really reached the end of the road - one spent all one's time writing boilerplate, and the amount of time taken to achieve anything useful had expanded far beyond common sense. So I thought: write one high level document describing an application; write a series of transforms from that document to the different files required to build the application; and a great deal of time would be saved.
And this worked. When it was used commercially, the target language was mostly C#, which I don't much like, but...
Then, in 2010, I had one of my periodic spells of mental illness, and development stopped. Later, when my former employers ceased to develop software, copyright in the project was turned over to me.
More recently, I've found myself in the same situation with Clojure that I was in 2007 with Java: I'm writing fairly large applications and the amount of mindless boilerplate that has to be written is a real problem. So I'm looking at reviving this old framework and bringing it up to date.
## Why this is a good idea
Web applications contain an awful lot of repetitive code. Not only does this take a lot of time to write; when you have an awful lot of repetitive code, if you find a bug in one place and fix it, it also probably has to be found and fixed in many other places. Also, underlying libraries, frameworks and (sometimes) even languages have breaking changes from one version to the next. Fixing the issue in the code generator, and then automatically regenerating the code for all of your applications, is enormously quicker than finding and fixing the issues in each file of each application separately.
Also, you can port all your applications to new technologies simply by writing transforms for those new technologies and regenerating.
The idea is that the ADL framework should autogenerate 95% of your application. This means human programmer effort can be concentrated on the 5% which is actually interesting.
## What exists
### The DTD
A Document Type Definition is the core of this; the current version is `adl-1.4.dtd`.
### The Clojure transformer application
This is the future direction of the project. Currently it converts a valid ADL XML document into most of the files required for a Clojure web-app. Shortly it will produce a complete Clojure [Luminus](http://www.luminusweb.net/) web-app. In future it may produce web-apps in other languages and frameworks.
### XSL transforms
XSL transforms exist which transform conforming documents as follows:
* `adl2activerecord.xslt` - generate C# ActiveRecord classes
* `adl2canonical.xslt` - canonicalises ADL, adding useful defaults
* `adl2controllerclasses.xslt` - generates C# controller classes
* `adl2documentation.xslt` - generates documentation
* `adl2entityclasses.xslt` - generates C# entity classes
* `adl2hibernate.xslt` - generates [N]Hibernate mapping files
* `adl2mssql.xslt` - generates Microsoft SQL Server database initialisation scripts
* `adl2psql.xslt` - generates Postgres database initialisation scripts
* `adl2views.xslt` - generates Velocity templates
All of this worked (well) back in 2010, but it relied on some proprietary libraries which are not my copyright. So you can't just pick it up and use it. But it provides a basis for writing new transforms in XSL, should you choose to do so.
## Future direction
Back in 2007, XSLT seemed a really good technology for doing this sort of thing. But it's prolix, and while back then I was expert in it, I don't really use it much now. So my plan is to write future transforms in Clojure, and, because these days I work mostly in Clojure, the transforms I shall write will mostly target the Clojure ecosystem.
This doesn't mean you can't pick up the framework and write transforms in other languages and/or to other language ecosystems. In fact, I'd encourage you to do so.
## Contributing
I will happily accept pull requests for new XSL transforms (although I'd like some evidence they work). I'll also happily accept pull requests for new transforms written in Clojure. Changes to the DTD I shall be more conservative about, simply because there is a potential to break a lot of stuff and the DTD is fairly good. All schemas are generated off the DTD using `[trang](https://github.com/relaxng/jing-trang)`, so there is no point in sending pull requests on schema changes.
## License
Copyright © Simon Brooke 2007-2018; some work was done under contract to [Cygnet Solutions Ltd](http://cygnets.co.uk/), but they have kindly transferred the copyright back to me.
Distributed under the Gnu GPL version 2 or any later version; I am open to licensing this project under additional licences if required.

12
RELEASENOTES.md Normal file
View file

@ -0,0 +1,12 @@
# Release 1.4.1
Release 1.4.1 adds a 'magnitude' element to entities, in order to provide a pragma for when
to switch to asynchronous select widgets.
It also provides a family of transforms, written in Clojure, to generate a skeleton Clojure
web app from an ADL specification.
# Release 1.4
Release 1.4 adds an 'order' element as a possible child of the 'list' element, in order to specify
the default order of lists. Otherwise unchanged from 1.3.

2
RELEASENOTES.txt
View file

@ -1,2 +0,0 @@
Release 1.4 adds an 'order' element as a possible child of the 'list' element, in order to specify
the default order of lists. Otherwise unchanged from 1.3.

2
TestApp/Auto/1
View file

@ -1,2 +0,0 @@

1
TestApp/Web/Controllers/Auto/1
View file

@ -1 +0,0 @@

17
TestApp/Web/Views/Auto/test/1
View file

@ -1,17 +0,0 @@
<!-- DOCTYPE application PUBLIC "-//CYGNETS//DTD ADL 0.1//EN" "http://www.cygnets.co.uk/schemas/adl-0.1.1.dtd" -->
<!-- DOCTYPE application SYSTEM "file:/C:/Projects/ADL/schemas/adl-0.dtd" -->
<!--
Application Description Language framework
testapp.adl.xml
the object of this file is to exercise as many aspects of ADL as possible;
it isn't expected to describe an application which does anything useful
Copyright (c) 2008 Cygnet Solutions Ltd
$Author: sb $
$Revision: 1.3 $
$Date: 2008-07-01 16:08:18 $
-->
<output xmlns="http://cygnets.co.uk/schemas/adl-1.2" xmlns:adl="http://cygnets.co.uk/schemas/adl-1.2" xmlns:msxsl="urn:schemas-microsoft-com:xslt">
<!--Layout is default-->

82
TestApp/testapp.adl.xml
View file

@ -1,82 +0,0 @@
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE application PUBLIC "-//JOURNEYMAN//DTD ADL 1.4//EN"
"http://bowyer.journeyman.cc/adl/stable/adl/schemas/adl-1.4.dtd">
<!--
Application Description Language framework
testapp.adl.xml
the object of this file is to exercise as many aspects of ADL as possible;
in the first instance, this is an attempt to recreate PRES in ADL
$Author: simon $
$Revision: 1.3 $
$Date: 2010-07-20 19:53:40 $
-->
<application name="pres" xmlns="http://bowyer.journeyman.cc/adl/stable/">
<specification abbr="regexplib" name="RegexpLib.com" url="http://regexlib.com/"/>
<content>
<head/>
<top/>
<foot/>
</content>
<typedef name="postcode"
pattern="^([A-PR-UWYZ0-9][A-HK-Y0-9][AEHMNPRTVXY0-9]?[ABEHMNPRVWXY0-9]? {1,2}[0-9][ABD-HJLN-UW-Z]{2}|GIR 0AA)$"
size="10" type="string">
<documentation>
<reference abbr="regexplib" section="REDetails.aspx?regexp_id=260"/>
a postcode follows arcane rules.
</documentation>
</typedef>
<typedef maximum="120" minimum="0" name="age" type="integer">
<documentation>
We don't believe people who claim to be over 120.
</documentation>
</typedef>
<typedef name="email"
pattern="^([a-zA-Z0-9_\-\.]+)@((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.)|(([a-zA-Z0-9\-]+\.)+))([a-zA-Z]{2,4}|[0-9]{1,3})(\]?)$" size="128">
<documentation>
<reference abbr="regexplib" section="REDetails.aspx?regexp_id=26"/>
</documentation>
</typedef>
<group name="public"/>
<group name="admin" parent="public"/>
<entity name="Actor">
<documentation>
A real (administrative) user of this system with a first-class, database layer login,
as opposed to a Subscriber with a second-class, application layer login.
</documentation>
<property name="Name" size="64" type="string"/>
<property name="EMail" type="defined" typedef="email"/>
<property name="Approved" type="boolean"/>
</entity>
<entity name="Article">
<property name="Created" type="date"/>
<property name="Embargo" type="date"/>
<property entity="Category" name="Category" type="entity"/>
<property name="Title" size="128" type="string"/>
<property entity="Actor" name="Author" type="entity"/>
<property name="Location" type="entity" entity="Location"/>
</entity>
<entity name="Author">
<property name="CanonicalName" size="128" type="string"/>
<property entity="NomDePlume" name="NomsDePlume" type="list"/>
<property name="Disambiguation" size="256" type="string">
<documentation>
If the canonical name is a common one, or there are known to be two or more authors
with the same canonical name, some brief text about the author to disambiguate.
</documentation>
</property>
</entity>
<entity name="Book">
<property entity="Article" name="Article" type="entity"/>
<property name="AuthorAsEntered" size="128" type="string">
<documentation>The name of the author as entered by the original user, prior to being resolved against known authors</documentation>
</property>
<property entity="Author" name="Authors" type="link"/>
<property name="Title" size="128" type="string"/>
</entity>
<entity name="NomDePlume">
<property name="Name" size="128" type="string"/>
<property entity="Author" name="Author" type="entity"/>
</entity>
</application>

11
UnitTests/Program.cs
View file

@ -1,11 +0,0 @@
using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
namespace UnitTests {
class Program {
static void Main(string[] args) {
}
}
}

36
UnitTests/Properties/AssemblyInfo.cs
View file

@ -1,36 +0,0 @@
using System.Reflection;
using System.Runtime.CompilerServices;
using System.Runtime.InteropServices;
// General Information about an assembly is controlled through the following
// set of attributes. Change these attribute values to modify the information
// associated with an assembly.
[assembly: AssemblyTitle("UnitTests")]
[assembly: AssemblyDescription("")]
[assembly: AssemblyConfiguration("")]
[assembly: AssemblyCompany("")]
[assembly: AssemblyProduct("UnitTests")]
[assembly: AssemblyCopyright("Copyright © 2008")]
[assembly: AssemblyTrademark("")]
[assembly: AssemblyCulture("")]
// Setting ComVisible to false makes the types in this assembly not visible
// to COM components. If you need to access a type in this assembly from
// COM, set the ComVisible attribute to true on that type.
[assembly: ComVisible(false)]
// The following GUID is for the ID of the typelib if this project is exposed to COM
[assembly: Guid("a5d9274a-d36f-45f3-a01a-b552e1a69a77")]
// Version information for an assembly consists of the following four values:
//
// Major Version
// Minor Version
// Build Number
// Revision
//
// You can specify all the values or you can default the Build and Revision Numbers
// by using the '*' as shown below:
// [assembly: AssemblyVersion("1.0.*")]
[assembly: AssemblyVersion("1.0.0.0")]
[assembly: AssemblyFileVersion("1.0.0.0")]

59
UnitTests/UnitTests.csproj
View file

@ -1,59 +0,0 @@
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="3.5" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ProductVersion>9.0.21022</ProductVersion>
<SchemaVersion>2.0</SchemaVersion>
<ProjectGuid>{D705F7CA-EB87-48EF-8F18-7D1AD90660BA}</ProjectGuid>
<OutputType>Exe</OutputType>
<AppDesignerFolder>Properties</AppDesignerFolder>
<RootNamespace>UnitTests</RootNamespace>
<AssemblyName>UnitTests</AssemblyName>
<TargetFrameworkVersion>v3.5</TargetFrameworkVersion>
<FileAlignment>512</FileAlignment>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<Optimize>false</Optimize>
<OutputPath>bin\Debug\</OutputPath>
<DefineConstants>DEBUG;TRACE</DefineConstants>
<ErrorReport>prompt</ErrorReport>
<WarningLevel>4</WarningLevel>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>
<Optimize>true</Optimize>
<OutputPath>bin\Release\</OutputPath>
<DefineConstants>TRACE</DefineConstants>
<ErrorReport>prompt</ErrorReport>
<WarningLevel>4</WarningLevel>
</PropertyGroup>
<ItemGroup>
<Reference Include="System" />
<Reference Include="System.Core">
<RequiredTargetFramework>3.5</RequiredTargetFramework>
</Reference>
<Reference Include="System.Xml.Linq">
<RequiredTargetFramework>3.5</RequiredTargetFramework>
</Reference>
<Reference Include="System.Data.DataSetExtensions">
<RequiredTargetFramework>3.5</RequiredTargetFramework>
</Reference>
<Reference Include="System.Data" />
<Reference Include="System.Xml" />
</ItemGroup>
<ItemGroup>
<Compile Include="Program.cs" />
<Compile Include="Properties\AssemblyInfo.cs" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.CSharp.targets" />
<!-- To modify your build process, add your task inside one of the targets below and uncomment it.
Other similar extension points exist, see Microsoft.Common.targets.
<Target Name="BeforeBuild">
</Target>
<Target Name="AfterBuild">
</Target>
-->
</Project>

10
UnitTests/obj/Debug/UnitTests.csproj.FileListAbsolute.txt
View file

@ -1,10 +0,0 @@
C:\Projects\UnitTests\bin\Debug\UnitTests.exe
C:\Projects\UnitTests\bin\Debug\UnitTests.pdb
C:\Projects\UnitTests\obj\Debug\ResolveAssemblyReference.cache
C:\Projects\UnitTests\obj\Debug\UnitTests.exe
C:\Projects\UnitTests\obj\Debug\UnitTests.pdb
C:\Projects\ADL\UnitTests\bin\Debug\UnitTests.exe
C:\Projects\ADL\UnitTests\bin\Debug\UnitTests.pdb
C:\Projects\ADL\UnitTests\obj\Debug\ResolveAssemblyReference.cache
C:\Projects\ADL\UnitTests\obj\Debug\UnitTests.exe
C:\Projects\ADL\UnitTests\obj\Debug\UnitTests.pdb

765
doc/intro.md Normal file
View file

@ -0,0 +1,765 @@
# Introduction
**NOTE**: *this markdown was automatically generated from `adl_user_doc.html`, which in turn was taken from the Wiki page on which this documentation was originally written.*
Application Description Language framework
==========================================
## Contents
--------
* [1 What is Application Description Language?](#What_is_Application_Description_Language.3F)
* [2 Current versions](#Current_versions)
* [3 What is the Application Description Language Framework?](#What_is_the_Application_Description_Language_Framework.3F)
* [4 Why does it matter?](#Why_does_it_matter.3F)
* [4.1 Automated Application Generation](#Automated_Application_Generation)
* [4.2 Integration with hand-written code](#Integration_with_hand-written_code)
* [4.3 High quality auto-generated code](#High_quality_auto-generated_code)
* [5 What can the Application Description Language framework now do?](#What_can_the_Application_Description_Language_framework_now_do.3F)
* [5.1 adl2entityclass.xsl](#adl2entityclass.xsl)
* [5.2 adl2mssql.xsl](#adl2mssql.xsl)
* [5.3 adl2views.xsl](#adl2views.xsl)
* [5.4 adl2controllerclasses.xsl](#adl2controllerclasses.xsl)
* [5.5 adl2hibernate.xsl](#adl2hibernate.xsl)
* [5.6 adl2pgsql.xsl](#adl2pgsql.xsl)
* [6 So is ADL a quick way to build Monorail applications?](#So_is_ADL_a_quick_way_to_build_Monorail_applications.3F)
* [7 Limitations on ADL](#Limitations_on_ADL)
* [7.1 Current limitations](#Current_limitations)
* [7.1.1 Authentication model](#Authentication_model)
* [7.1.2 Alternative Verbs](#Alternative_Verbs)
* [7.2 Inherent limitations](#Inherent_limitations)
* [8 ADL Vocabulary](#ADL_Vocabulary)
* [8.1 Basic definitions](#Basic_definitions)
* [8.1.1 Permissions](#Permissions)
* [8.1.2 Data types](#Data_types)
* [8.1.3 Definable data types](#Definable_data_types)
* [8.1.4 Page content](#Page_content)
* [8.2 The Elements](#The_Elements)
* [8.2.1 Application](#Application)
* [8.2.2 Definition](#Definition)
* [8.2.3 Groups](#Groups)
* [8.2.4 Enities and Properties](#Enities_and_Properties)
* [8.2.5 Options](#Options)
* [8.2.6 Permissions](#Permissions_2)
* [8.2.7 Pragmas](#Pragmas)
* [8.2.8 Prompts, helptexts and error texts](#Prompts.2C_helptexts_and_error_texts)
* [8.2.9 Forms, Pages and Lists](#Forms.2C_Pages_and_Lists)
* [9 Using ADL in your project](#Using_ADL_in_your_project)
* [9.1 Selecting the version](#Selecting_the_version)
* [9.2 Integrating into your build](#Integrating_into_your_build)
* [9.2.1 Properties](#Properties)
* [9.2.2 Canonicalisation](#Canonicalisation)
* [9.2.3 Generate NHibernate mapping](#Generate_NHibernate_mapping)
* [9.2.4 Generate SQL](#Generate_SQL)
* [9.2.5 Generate C# entity classes ('POCOs')](#Generate_C.23_entity_classes_.28.27POCOs.27.29)
* [9.2.6 Generate Monorail controller classes](#Generate_Monorail_controller_classes)
* [9.2.7 Generate Velocity views for use with Monorail](#Generate_Velocity_views_for_use_with_Monorail)
## What is Application Description Language?
--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Application Description Language is an XML vocabulary, defined in a [Document Type Definition](http://en.wikipedia.org/wiki/Document_Type_Definition "http://en.wikipedia.org/wiki/Document_Type_Definition"), which declaratively describes the entities in an application domain, their relationships, and their properties. Because ADL is defined in a formal definition which can be parsed by XML editors, any DTD-aware XML editor (such as that built into Visual studio) can provide context-sensitive auto-completion for ADL, making the vocabulary easy to learn and to edit. It would perhaps be desirable to replace this DTD at some future stage with an XML Schema, since it is desirable to be able to mix HTML in with ADL in the same document.
ADL is thus a '[Fourth Generation Language](http://en.wikipedia.org/wiki/Fourth-generation_programming_language "http://en.wikipedia.org/wiki/Fourth-generation_programming_language")' as understood in the 1980s - an ultra-high level language for a specific problem domain; but it is a purely declarative 4GL.
## Current versions
------------------------------------------------------------------------------------------------------------------------------------------------------------------------
* The current STABLE version of ADL is 1.1.
* The namespace URL for ADL 1.1 is [http://libs.cygnets.co.uk/adl/1.1/](http://libs.cygnets.co.uk/adl/1.1/ "http://libs.cygnets.co.uk/adl/1.1/")
* Transforms for ADL 1.1 can be found at [http://libs.cygnets.co.uk/adl/1.1/ADL/transforms/](http://libs.cygnets.co.uk/adl/1.1/ADL/transforms/ "http://libs.cygnets.co.uk/adl/1.1/ADL/transforms/")
* The document type definition for ADL 1.1 can be found at [http://libs.cygnets.co.uk/adl/1.1/ADL/schemas/adl-1.1.dtd](http://libs.cygnets.co.uk/adl/1.1/ADL/schemas/adl-1.1.dtd "http://libs.cygnets.co.uk/adl/1.1/ADL/schemas/adl-1.1.dtd")
* the current UNSTABLE version of ADL is 1.2. The namespace URL for ADL 1.2 is [http://libs.cygnets.co.uk/adl/1.2/](http://libs.cygnets.co.uk/adl/1.2/ "http://libs.cygnets.co.uk/adl/1.2/")
* The namespace URL for ADL 1.2 is [http://libs.cygnets.co.uk/adl/1.2/](http://libs.cygnets.co.uk/adl/1.2/ "http://libs.cygnets.co.uk/adl/1.2/")
* Transforms for ADL 1.2 can be found at [http://libs.cygnets.co.uk/adl/1.2/ADL/transforms/](http://libs.cygnets.co.uk/adl/1.2/ADL/transforms/ "http://libs.cygnets.co.uk/adl/1.2/ADL/transforms/")
* The document type definition for ADL 1.2 can be found at [http://libs.cygnets.co.uk/adl/1.2/ADL/schemas/adl-1.2.dtd](http://libs.cygnets.co.uk/adl/1.2/ADL/schemas/adl-1.2.dtd "http://libs.cygnets.co.uk/adl/1.2/ADL/schemas/adl-1.2.dtd")
\ What is the Application Description Language Framework?
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
The Application Description Language Framework is principally a set of XSL transforms which transform a single ADL file into all the various source files required to build an application.
## Why does it matter?
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
The average data driven web application comprises pages (lists) which show lists of entities, pages (forms) that edit instances of entities, and pages (inspectors) that show details of instances of entities. That comprises 100% of many applications and 90% of others; traditionally, even with modern tools like Monorail, coding these lists, forms and inspectors has taken 90% of the development effort.
I realised about three years ago that I was doing essentially the same job over and over again, and I don't like doing that. I see my mission in life as being to automate people out of jobs, and that includes me. So the object of the Application Description Language is to raise the level of abstraction with which we define data driven applications one level higher, and automate the process we have thus far done as programmers. This isn't a new insight; it's fundamentally the same insight that led machine code programmers to develop the first macro assembler, and led assembly language programmers to write the first high level language compiler. Computers are tools which can be used to mung information from one representation to another, and all we need to do is to work out how to write a powerful enough representation, and how to transform it.
The whole purpose of ADL is to increase productivity - mine, and that of anyone else who chooses to follow me down this path. It is pragmatic technology - it is designed to be an 80/20 or 90/10 solution, taking the repetitious grunt-work out of application development so that we can devote more time to the fun, interesting and novel bits. It is not intended to be an academic, perfect, 100% solution - although for many applications it may in practice be a 100% solution.
### Automated Application Generation
Thus to create a new application, all that should be necessary is to create a new ADL file, and to compile it using a single, standardised \[[NAnt](http://nant.sourceforge.net/ "http://nant.sourceforge.net/")\] (or \[[Ant](http://ant.apache.org/ "http://ant.apache.org/")\]) build file using scripts already created as part of the framework. All these scripts (with the exception of the PSQL one, which was pre-existing) have been created as part of the [C1873 - SRU - Hospitality](http://wiki.cygnets.co.uk/index.php/C1873_-_SRU_-_Hospitality "C1873 - SRU - Hospitality") contract, but they contain almost no SRU specific material (and what does exist has been designed to be factored out). Prototype 1 of the SRU Hospitality Application contains no hand-written code whatever - all the application code is automatically generated from the single ADL file. The one exception to this rule is the CSS stylesheet which provides look-and-feel and branding.
### Integration with hand-written code
Application-specific procedural code, covering specific business procedures, may still need to be hand written; the code generated by the ADL framework is specifically designed to make it easy to integrate hand-written code. Thus for example the C# entity controller classes generated are intentionally generated as _partial_ classes, so that they may be complemented by other partial classes which may be manually maintained and held in a version control system.
### High quality auto-generated code
One key objective of the framework is that the code which is generated should be as clear and readable - and as well commented - as the best hand-written code. Consider this example:
/// <summary>
/// Store the record represented by the parameters passed in an HTTP service
/// Without Id -> it's new, I create a new persistent object;
/// With Id -> it's existing, I update the existing persistent object
/// </summary>
\[AccessibleThrough( Verb.Post)\]
public void Store()
{
ISession hibernator =
NHibernateHelper.GetCurrentSession( Session\[ NHibernateHelper.USERTOKEN\],
Session\[NHibernateHelper.PASSTOKEN\]);
SRU.Hospitality.Entities.Event record;
if ( Params\[ "instance.Date" \] == null)
{
AddError( "You must supply a value for Date");
}
if ( Params\[ "instance.Description" \] == null)
{
AddError( "You must supply a value for Description");
}
string id = Params\["instance.EventId"\];
if ( String.IsNullOrEmpty( id))
{
/\* it's new, create persistent object */
record = new SRU.Hospitality.Entities.Event();
/\* perform any domain knowledge behaviour on the new record
\* after instantiation */
record.AfterCreationHook();
}
else
{
/\* it's existing, retrieve it */
record =
hibernator.CreateCriteria(typeof(Event))
.Add(Expression.Eq("EventId", Int32.Parse(id)))
.UniqueResult<SRU.Hospitality.Entities.Event>();
}
if ( record != null)
{
/\* perform any domain knowledge behaviour on the record prior to updating */
record.BeforeUpdateHook();
/\* actually update the record */
BindObjectInstance( record, ParamStore.Form, "instance");
/\* write the record to the database, in order to guarantee we have a valid key */
hibernator.Save(record);
hibernator.Flush();
/\* perform any domain knowledge behaviour on the record after updating */
record.AfterUpdateHook();
PropertyBag\["username"\] = Session\[ NHibernateHelper.USERTOKEN\];
PropertyBag\["instance"\] = record;
RenderViewWithFailover("edit.vm", "edit.auto.vm");
}
else
{
throw new Exception( String.Format( "No record of type Event with key value {0} found", id));
}
}
This means that it should be trivial to decide at some point in development of a project to manually modify and maintain auto-generated code.
## What can the Application Description Language framework now do?
----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Currently the framework includes:
### adl2entityclass.xsl
Transforms the ADL file into C# source files for classes which describe the entities in a manner acceptable to [NHibernate](http://www.hibernate.org/ "http://www.hibernate.org/"), a widely used Object/Relational mapping layer.
### adl2mssql.xsl
Transforms the ADL file into an SQL script in Microsoft SQL Server 2000 syntax which initialises the database required by the application, with all relationships, permissions, referential integrity constraints and so on.
### adl2views.xsl
Transforms the ADL file into [Velocity](http://velocity.apache.org/ "http://velocity.apache.org/") template files as used by the [Monorail](http://www.castleproject.org/monorail/index.html "http://www.castleproject.org/monorail/index.html") framework, one template each for all the lists, forms and inspectors described in the ADL.
### adl2controllerclasses.xsl
Transforms the ADL file into a series of C# source files for classes which are controllers as used by the Monorail framework.
### adl2hibernate.xsl
Transforms the ADL file into a Hibernate mapping file, used by the [Hibernate](http://www.hibernate.org/ "http://www.hibernate.org/") ([Java](http://java.sun.com/ "http://java.sun.com")) and [NHibernate](http://www.hibernate.org/ "http://www.hibernate.org/") (C#) Object/Relational mapping layers. This transform is relatively trivial, since ADL is not greatly different from being a superset of the Hibernate vocabulary - it describes the same sorts of things but in more detail.
### adl2pgsql.xsl
Transforms the ADL file into an SQL script in [Postgres](http://www.postgresql.org/ "http://www.postgresql.org/") 7 syntax which initialises the database required by the application, with all relationships, permissions, referential integrity constraints and so on.
## So is ADL a quick way to build Monorail applications?
---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Yes and no.
ADL _is_ a quick way to build Monorail applications, because it seemed to me that as Monorail/NHibernate are technologies that the company is adopting and it would be better to work with technologies with which we already have expertise - it's no good doing these things if other people can't maintain them afterwards.
However ADL wasn't originally conceived with Monorail in mind. It was originally intended to generated LISP for [CLHTTPD](http://www.cl-http.org:8001/cl-http/ "http://www.cl-http.org:8001/cl-http/"), and I have a half-finished set of scripts to generate Java as part of the Jacquard2 project which I never finished. Because ADL is at a level of abstraction considerably above any [3GL](http://en.wikipedia.org/wiki/Third-generation_programming_language "http://en.wikipedia.org/wiki/Third-generation_programming_language"), it is inherently agnostic to what 3GL it is compiled down to - so that it would be as easy to write transforms that compiled ADL to [Struts](http://struts.apache.org/ "http://struts.apache.org/") or [Ruby on Rails](http://www.rubyonrails.org/ "http://www.rubyonrails.org/") as to C#/Monorail. More importantly, ADL isn't inherently limited to Web applications - it doesn't actually know anything about the Web. It should be possible to write transforms which compile ADL down to Windows native applications or to native applications for mobile phones (and, indeed, if we did have those transforms then we could make all our applications platform agnostic).
## Limitations on ADL
-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
### Current limitations
Although I've built experimental systems before using ADL, the SRU project is the first time I've really used it in anger. There are some features I need which it can't yet represent.
#### Authentication model
For SRU, I have implemented an authentication model which authenticates the user against real database user accounts. I've done this because I think, in general, this is the correct solution, and because without this sort of authentication you cannot implement table-layer security. However most web applications use application layer authentication rather than database layer authentication, and I have not yet written controller-layer code to deal with this. So unless you do so, ADL applications can currently only authenticate at database layer.
ADL defines field-level permissions, but the current controller generator does not implement this.
#### Alternative Verbs
Generically, with an entity form, one needs to be able to save the record being edited, and one (often) needs to be able to delete it. But sometimes one needs to be able to do other things. With SRU, for example, there is a need to be able to export event data to [Perfect Table Plan](http://www.perfecttableplan.com/ "http://www.perfecttableplan.com/"), and to reimport data from Perfect Table Plan. This will need custom buttons on the event entity form, and will also need hand-written code at the controller layer to respond to those buttons.
Also, a person will have, over the course of their interaction with the SRU, potentially many invitations. In order to access those invitations it will be necessary to associate lists of dependent records with forms. Currently ADL cannot represent these.
### Inherent limitations
At this stage I doubt whether there is much point in extending ADL to include a vocabulary to describe business processes. It would make the language much more complicated, and would be unlikely to be able to offer a significantly higher level of abstraction than current 3GLs. If using ADL does not save work, it isn't worth doing it in ADL; remember this is conceived as an 80/20 solution, and you need to be prepared to write the 20 in something else.
## ADL Vocabulary
---------------------------------------------------------------------------------------------------------------------------------------------------------------------
This section of this document presents and comments on the existing ADL document type definition (DTD).
### Basic definitions
The DTD starts with some basic definitions
<!\-\- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: \-\->
<!\-\- Before we start: some useful definitions -->
<!\-\- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: \-\->
<!\-\- 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>
<URL:http://www.chemie.fu-berlin.de/diverse/doc/ISO_3166.html>
-->
<!ENTITY % Locale "CDATA" >
#### Permissions
Key to any data driven application is who has authority to do what to what: 'permissions'.
<!\-\-
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
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
noedit: select, insert
edit: select, insert, update
all: select, insert, update, delete
-->
<!ENTITY % Permissions "none|read|insert|noedit|edit|all" >
#### Data types
ADL needs to know what type of data can be stored on different properties of different entities. The data types were originally based on JDBC data types:
<!\-\-
data types which can be used in a definition 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
money: money java.sql.Types.INTEGER
date: date java.sql.Types.DATE
time: time java.sql.Types.TIME
timestamp: timestamp java.sql.Types.TIMESTAMP
-->
#### Definable data types
However, in order to be able to do data validation, it's useful to associate rules with data types. ADL has the concept of definable data types, to allow data validation code to be generated from the declarative description. These definable data types are used in the ADL application, for example, to define derived types for phone numbers, email addresses, postcodes, and range types.
<!ENTITY % DefinableDataTypes "string|integer|real|money|date|time|timestamp" >
<!\-\-
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
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;
link : a many to many link (via a link table);
defined : a type defined by a definition.
-->
<!ENTITY % ComplexDataTypes "entity|link|defined" >
<!\-\- all data types -->
<!ENTITY % AllDataTypes "%ComplexDataTypes;|%SimpleDataTypes;" >
#### Page content
Pages in applications typically have common, often largely static, sections above, below, to the left or right of the main content which incorporates things like branding, navigation, and so on. This can be defined globally or per page. The intention is that the `head`, `top` and `foot` elements in ADL should be allowed to contain arbitrary HTML, but currently I don't have enough skill with DTD design to know how to specify this.
<!\-\- content, for things like pages (i.e. forms, lists, pages) -->
<!ENTITY % Content "head|top|foot" >
<!ENTITY % PageContent "%Content;|field" >
<!ENTITY % PageStuff "%PageContent;|permission|pragma" >
<!ENTITY % PageAttrs
"name CDATA #REQUIRED
properties (all|listed) #REQUIRED" >
### The Elements
#### Application
The top level element of an Application Description Language file is the application element:
<!\-\- the application that the document describes: required top level element -->
<!ELEMENT application ( content?, definition*, group*, entity*)>
<!ATTLIST application
name CDATA #REQUIRED
version CDATA #IMPLIED>
#### Definition
In order to be able to use defined types, you need to be able to provide definitions of these types:
<!\-\-
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
pattern must be a regular expression as interpreted by org.apache.regexp.RE
minimum and maximum must be of appropriate format for the datatype specified.
Validation may be done client-side and/or server-side at application layer
and/or server side at database layer.
-->
<!ELEMENT definition (help*) >
<!ATTLIST definition
name CDATA #REQUIRED
type (%DefinableDataTypes;) #REQUIRED
size CDATA #IMPLIED
pattern CDATA #IMPLIED
minimum CDATA #IMPLIED
maximum CDATA #IMPLIED>
#### Groups
In order to be able to user permissions, we need to define who has those permissions. Groups in ADL map directly onto groups/roles at SQL level, but the intention with ADL is that groups should be defined hierarchically.
<!\-\- a group of people with similar permissions to one another -->
<!ELEMENT group EMPTY>
<!\-\- the name of this group -->
<!ATTLIST group name CDATA #REQUIRED>
<!\-\- the name of a group of which this group is subset -->
<!ATTLIST group parent CDATA #IMPLIED>
#### Enities and Properties
A thing-in-the-domain has properties. Things in the domain fall into regularities, groups of things which share similar collections of properties, such that the values of these properties may have are constrained. This is a representation of the world which is not perfect, but which is sufficiently useful to be recognised by the software technologies which ADL abstracts, so we need to be able to define these. Hence we have entities and properties/
<!\-\-
an entity which has properties and relationships; maps onto a database
table or a Java serialisable class - or, of course, various other things
-->
<!ELEMENT entity ( content?, property*, permission*, (form | page | list)*)>
<!ATTLIST entity name CDATA #REQUIRED>
<!\-\-
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
magic values of this!
definition: name of the definition to use, it type = 'defined'.
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
/and/ are user friendly.
entity: if type='entity', the name of the entity this property is
a foreign key link to.
required: whether this propery is required (i.e. 'not null').
size: fieldwidth of the property if specified.
-->
<!ELEMENT property ( option*, prompt*, help*, ifmissing*)>
<!ATTLIST property
name CDATA #REQUIRED
type (%AllDataTypes;) #REQUIRED
default CDATA #IMPLIED
definition CDATA #IMPLIED
distinct (none|all|user|system) #IMPLIED
entity CDATA #IMPLIED
required %Boolean; #IMPLIED
size CDATA #IMPLIED>
#### Options
Sometimes a property has a constrained list of specific values; this is represented for example in the enumerated types supported by many programming languages. Again, we need to be able to represent this.
<!\-\-
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.
-->
<!ELEMENT option (prompt*)>
<!\-\- if the value is different from the prompt the user sees, specify it -->
<!ATTLIST option value CDATA #IMPLIED>
#### Permissions
Permissions define policies to allow groups of users to access forms, pages, fields (not yet implemented) or entities. Only entity permissions are enforced at database layer, and field protection is not yet implemented at controller layer. But the ADL allows it to be described, and future implementations of the controller generating transform will do this.
<!\-\-
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 EMPTY>
<!ATTLIST permission
group CDATA #REQUIRED
permission (%Permissions;) #REQUIRED>
#### Pragmas
Pragmas are currently not used at all. They are there as a possible means to provide additional controls on forms, but may not be the correct solutions for that.
<!--
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.
-->
<!ELEMENT pragma EMPTY>
<!ATTLIST pragma
name CDATA #REQUIRED
value CDATA #REQUIRED>
#### Prompts, helptexts and error texts
When soliciting a value for a property from the user, we need to be able to offer the user a prompt to describe what we're asking for, and we need to be able to offer that in the user's preferred natural language. Prompts are typically brief. Sometimes, however, we need to give the user a more extensive description of what is being solicited - 'help text'. Finally, if the data offered by the user isn't adequate for some reason, we need ways of feeding that back. Currently the only error text which is carried in the ADL is 'ifmissing', text to be shown if the value for a required property is missing. All prompts, helptexts and error texts have locale information, so that it should be possible to generate variants of all pages for different natural languages from the same ADL.
<!\-\-
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
-->
<!ELEMENT prompt EMPTY>
<!ATTLIST prompt
prompt CDATA #REQUIRED
locale %Locale; #IMPLIED >
<!\-\-
helptext about a property of an entity, or a field of a page, form or
list, or a definition. 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
-->
<!ELEMENT help (#PCDATA)>
<!ATTLIST help
locale %Locale; #IMPLIED >
<!--
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
behaviour here.
-->
<!ELEMENT ifmissing (#PCDATA)>
<!ATTLIST ifmissing
locale %Locale; #IMPLIED>
#### Forms, Pages and Lists
The basic pages of the user interface. Pages and Forms by default show fields for all the properties of the entity they describe, or they may show only a listed subset. Currently lists show fields for only those properties which are 'user distinct'. Forms, pages and lists may each have their own head, top and foot content, or they may inherit the content defined for the application.
<!\-\- a form through which an entity may be added or edited -->
<!ELEMENT form ( %PageStuff;)*>
<!ATTLIST form %PageAttrs;>
<!\-\- a page on which an entity may be displayed -->
<!ELEMENT page ( %PageStuff;)*>
<!ATTLIST page %PageAttrs;>
<!\-\-
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
-->
<!ELEMENT list ( %PageStuff;)*>
<!ATTLIST list %PageAttrs;
onselect CDATA #IMPLIED >
<!\-\- a field in a form or page -->
<!ELEMENT field (prompt*, help*, permission*) >
<!ATTLIST field property CDATA #REQUIRED >
<!\-\- a container for global content -->
<!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
(usually HTML)
-->
<!ELEMENT head (#PCDATA) >
<!\-\-
content to place in the top of the body of the generated document;
this is #PCDATA because it will almost certainly belong to a different
namespace (usually HTML)
-->
<!ELEMENT top (#PCDATA) >
<!\-\-
content to place at the foot of the body of the generated document;
this is #PCDATA because it will almost certainly belong to a different
namespace (usually HTML)
-->
<!ELEMENT foot (#PCDATA) >
## Using ADL in your project
-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
### Selecting the version
Current versions of ADL are given at the top of this document. Historical versions are as follows:
* **Version 0.1**: Used by the SRU Hospitality application only. The Hospitality Application will be upgraded to the current version whenever it has further work done on it.
* You cannot access Version 1.0 at all, as nothing in current development should be using it. It is in CVS as part of the SRU Hospitality application
* As soon as SRU Hospitality has been updated to **stable**, version 0.1 will be unmaintained.
* **Version 0.3**: Identical to Version 1.0, except that the obsolete _transforms01_ directory has not been removed.
* You can access 0.3, should you need to, here: [http://libs.cygnets.co.uk/adl/0.3/ADL/](http://libs.cygnets.co.uk/adl/0.3/ADL/ "http://libs.cygnets.co.uk/adl/0.3/ADL/")
* I do not plan to maintain 0.3 even for bugfixes; you should ensure your project builds with 1.0
* **Version 1.0**: Identical to Version 3.0, except tidied up.
* * the obsolete _transforms01_ directory has been removed.
* _adl2entityclass.xslt_ has been renamed to _adl2entityclasses.xslt_, for consistency
* This is the current **stable** branch; it is the HEAD branch in CVS.
* If there are bugs, I (sb) will fix them.
* If you want new functionality, it belongs in 'unstable'.
* You can access 1.0 here: [http://libs.cygnets.co.uk/adl/1.0/ADL/](http://libs.cygnets.co.uk/adl/1.0/ADL/ "http://libs.cygnets.co.uk/adl/1.0/ADL/")
* Projects using ADL 1.0 should be built with the 1.0 version of CygnetToolkit
* **unstable**: this is the current development branch, the branch tagged **b_development** in CVS.
* It should be backwards compatible with 1.0 (i.e. anything which builds satisfactorily with 1.0 should also build with unstable)
* It may have additional features
* It is not guaranteed to work, and before a final release of a product to a customer we may wish to move changes into a new 'stable' branch.
* You can access the unstable branch here: [http://libs.cygnets.co.uk/adl/unstable/ADL/](http://libs.cygnets.co.uk/adl/unstable/ADL/ "http://libs.cygnets.co.uk/adl/unstable/ADL/")
* The version at that location is automatically updated from CVS every night
* Projects using the **b_development** branch of ADL should be built against the **b_development** branch of CygnetToolkit.
### Integrating into your build
To use ADL, it is currently most convenient to use NAnt. It is probably possible to do this with MSBuild, but as of yet I don't know how.
#### Properties
For the examples given here to work, you will need to set up at least the following properties in your NAnt `.build` file:
<property name="project.name" value="YourProjectName"/>
<property name="src.dir" value="YourSourceDir"/>
<property name="tmpdir" value="tmp"/>
<property name="assembly" value="${project.name}"/>
<property name="adl" value="L:/adl/unstable/ADL/"/>
<property name="adl-transforms" value="${adl}/transforms"/>
<property name="adl-src" value="${src.dir}/${project.name}.adl.xml"/>
<property name="canonical" value="${tmpdir}/Canonical.adl.xml"/>
<property name="nant-tasks" value="${tmpdir}/NantTasks.dll"/>
<property name="nsroot" value="Uk.Co.Cygnets"/>
<property name="entityns" value="${nsroot}.${assembly}.Entities"/>
<property name="controllerns" value="${nsroot}.${assembly}.Controllers"/>
<property name="entities" value="${src-dir}/Entities"/>
<property name="controllers" value="${src-dir}/Controllers"/>
where, obviously, **YourProjectName**, **YourSourceDir** and **YourADL.adl.xml** stand in for the actual names of your project, your source directory (relative to your solution directory, where the .build file is) and your ADL file, respectively. Note that if it is to be used as an assembly name, the project name should include neither spaces, hyphens nor periods. If it must do so, you should give an assembly name which does not, explicitly.
#### Canonicalisation
The first thing you need to do with your ADL file is canonicalise it. You should generally not need to alter this, you should copy and paste it verbatim:
<target name="canonicalise" description="canonicalises adl">
<style verbose="true" style="${adl-transforms}/adl2canonical.xslt"
in="${adl-src}"
out="${canonical}">
<parameters>
<parameter name="abstract-key-name-convention" value="Name_Id"/>
</parameters>
</style>
</target>
#### Generate NHibernate mapping
You should generally not need to alter this at all, just copy and paste it verbatim:
<target name="hbm" description="generates NHibernate mapping for database"
depends="canonicalise">
<style verbose="true" style="${adl-transforms}/adl2hibernate.xslt"
in="${canonical}"
out="${src.dir}/${project.name}.auto.hbm.xml">
<parameters>
<parameter name="namespace" value="${entityns}"/>
<parameter name="assembly" value="${assembly}"/>
</parameters>
</style>
</target>
#### Generate SQL
<target name="sql" description="Generates cadlink database initialisation script"
depends="canonicalise">
<style verbose="true" style="${adl-transforms}/adl2mssql.xslt"
in="${canonical}"
out="${src.dir}/${project.name}.auto.sql">
<parameters>
<parameter name="abstract-key-name-convention" value="Name_Id"/>
<parameter name="database" value="ESA-McIntosh-CADLink"/>
</parameters>
</style>
</target>
#### Generate C# entity classes ('POCOs')
Note that for this to work you must have the following:
* '[Artistic Style](http://astyle.sourceforge.net/ "http://astyle.sourceforge.net/")' installed as `c:\Program Files\astyle\bin\astyle.exe`
<target name="fetchtasks" depends="prepare"
description="fetches our NantTasks library from the well known place where it resides">
<get src="http://libs.cygnets.co.uk/NantTasks.dll"
dest="${nant-tasks}"/>
</target>
<target name="classes" description="creates C# classes for entities in the database"
depends="fetchtasks canonicalise">
<loadtasks assembly="${nant-tasks}" />
<style verbose="true" style="${adl-transforms}/adl2entityclass.xslt"
in="${canonical}"
out="${tmpdir}/classes.auto.cs">
<parameters>
<parameter name="locale" value="en-UK"/>
<parameter name="controllerns" value="${controllerns}"/>
<parameter name="entityns" value="${entityns}"/>
</parameters>
</style>
<exec program="c:\\Program Files\\astyle\\bin\\astyle.exe"
basedir="."
commandline="--style=java --indent=tab=4 --indent-namespaces ${tmpdir}/classes.auto.cs"/>
<split-regex in="${tmpdir}/classes.auto.cs"
destdir="${src.dir}/Entities"
pattern="cut here: next file '(\[a-zA-Z0-9_.\]*)'"/>
</target>
#### Generate Monorail controller classes
Note that for this to work you must have
* '[Artistic Style](http://astyle.sourceforge.net/ "http://astyle.sourceforge.net/")' installed as `c:\Program Files\astyle\bin\astyle.exe`
* The 'fetchtasks' target from the 'entity classes' stanza, above.
<target name="controllers" description="creates C# controller classes"
depends="fetchtasks canonicalise">
<loadtasks assembly="${nant-tasks}" />
<loadtasks assembly="${nant-contrib}" />
<style verbose="true" style="${adl-transforms}/adl2controllerclasses.xslt"
in="${canonical}"
out="${tmpdir}/controllers.auto.cs">
<parameters>
<parameter name="locale" value="en-UK"/>
<parameter name="controllerns" value="${controllerns}"/>
<parameter name="entityns" value="${entityns}"/>
<parameter name="layout-name" value="default"/>
<parameter name="rescue-name" value="generalerror"/>
</parameters>
</style>
<exec program="c:\\Program Files\\astyle\\bin\\astyle.exe"
basedir="."
commandline="--style=java --indent=tab=4 --indent-namespaces ${tmpdir}/controllers.auto.cs"/>
<split-regex in="${tmpdir}/controllers.auto.cs"
destdir="${controllers}/Auto" pattern="cut here: next file '(\[a-zA-Z0-9_.\]*)'"/>
</target>
#### Generate Velocity views for use with Monorail
Note that for this to work you must have
* The 'fetchtasks' target from the 'entity classes' stanza, above.
<target name="views" description="creates Velocity templates"
depends="fetchtasks canonicalise">
<loadtasks assembly="${nant-tasks}" />
<style verbose="true" style="${adl-transforms}/adl2views.xslt"
in="${canonical}"
out="${tmpdir}/views.auto.vm">
<parameters>
<parameter name="layout-name" value="default"/>
<parameter name="locale" value="en-UK"/>
<parameter name="controllerns" value="${controllerns}"/>
<parameter name="entityns" value="${entityns}"/>
<parameter name="generate-site-navigation" value="false"/>
<parameter name="permissions-group" value="partsbookeditors"/>
<parameter name="show-messages" value="true"/>
</parameters>
</style>
<split-regex in="${tmpdir}/views.auto.vm"
destdir="${views}" pattern="cut here: next file '(\[a-zA-Z0-9_./\]*)'"/>
</target>

15
project.clj Normal file
View file

@ -0,0 +1,15 @@
(defproject adl "1.4.1"
:description "An application to transform an ADL application specification document into skeleton code for a Clojure web-app"
:url "http://example.com/FIXME"
:license {:name "GNU General Public License,version 2.0 or (at your option) any later version"
:url "https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html"}
:dependencies [[adl-support "0.1.0-SNAPSHOT"]
[org.clojure/clojure "1.8.0"]
[org.clojure/math.combinatorics "0.1.4"]
[org.clojure/tools.cli "0.3.7"]
[bouncer "1.0.1"]
[environ "1.1.0"]
[hiccup "1.0.5"]]
:aot [adl.main]
:main adl.main
:plugins [[lein-codox "0.10.3"]])

14
resources/js/select-widget-support.js Normal file
View file

@ -0,0 +1,14 @@
/**
* update the select menu with id `wid` from this `data` whose fields include
* this `entity_key` and these `fields`
*/
function updateMenuOptions(wid, entity_key, fields, data){
$('#' + wid).children().filter(function(){
return $(this).attr('selected') === undefined;
}).remove().end();
$.each(data, function(key, entry){
$('#' + wid).append(
$('<option></option>').attr('value', key).text(entry));
});
}

29
resources/js/selectize-one.js Normal file
View file

@ -0,0 +1,29 @@
/**
* selectize one select widget. Substitute the actual id of the widget for `{{widget_id}}`,
* and the current value for {{widget_value}}.
*/
$('#{{widget_id}}').selectize({
valueField: '{{key}}',
labelField: '{{field}}',
searchField: '{{field}}',
hideSelected: false,
create: false,
load: function(query, callback) {
console.log('Desperately seeking ' + query);
if (query === null || !query.length) return callback();
$.ajax({
url: '/json/auto/search-strings-{{entity}}?{{field}}=' + query,
type: 'GET',
dataType: 'jsonp',
error: function() {
console.log( 'Query ' + query + ' failed.');
callback();
},
success: function(res) {
console.log('Received ' + res + ' records for ' + query);
callback(res);
}
});
}
})[0].selectize.setValue('{{widget_value}}', true);

22
resources/js/text-area-md-support.js Normal file
View file

@ -0,0 +1,22 @@
/**
* Provide SimpleMDE support for textareas on this page. TODO: this is
* slightly problematic since it assumes (and saves autosave data for)
* only one text area on the page. Perhaps we should disable autosave?
*/
var simplemde = new SimpleMDE({
autosave: {
enabled: true,
uniqueId: "{{page}}-{{record.id}}",
delay: 1000,
},
indentWithTabs: true,
insertTexts: {
horizontalRule: ["", "\n\n-----\n\n"],
image: ["![](http://", ")"],
link: ["[", "](http://)"],
table: ["", "\n\n| Column 1 | Column 2 | Column 3 |\n| -------- | -------- | -------- |\n| Text | Text | Text |\n\n"],
},
showIcons: ["code"], //, "table"], - sadly, markdown-clj does not support tables
spellChecker: true,
status: ["autosave", "lines", "words", "cursor"]
});

0
schemas/adl-1.3.dtd → resources/schemas/adl-1.3.dtd
View file

621
resources/schemas/adl-1.4.1.dtd Normal file
View file

@ -0,0 +1,621 @@
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
<!-- -->
<!-- adl-1.4.1.dtd -->
<!-- -->
<!-- Purpose: -->
<!-- Document Type Description for Application Description -->
<!-- Language. Normative for now; will be replaced by a schema. ` -->
<!-- -->
<!-- Author: Simon Brooke <simon@journeyman.cc> -->
<!-- Created: 3rd June 2018 -->
<!-- Copyright: (c) 2018 Simon Brooke -->
<!-- -->
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
<!-- Before we start: import XHTML for use in documentation sections -->
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
<!-- 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
that we can allow HTML block level entities within content elements -->
<!ENTITY nbsp "&#160;">
<!ENTITY pound "&#163;">
<!ENTITY copy "&#169;">
<!-- 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>
<URL:http://www.chemie.fu-berlin.de/diverse/doc/ISO_3166.html>
-->
<!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
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
noedit: select, insert
edit: select, insert, update
all: select, insert, update, delete
-->
<!ENTITY % Permissions "none|read|insert|noedit|edit|all" >
<!--
actions which should be cascaded to dependent objects. All these values except
'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
manual : cascading will be handled in manually managed code, code to
handle cascading should not be generated
save-update : cascade save and update actions, but not delete.
-->
<!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
string: varchar java.sql.Types.VARCHAR
integer: int java.sql.Types.INTEGER
real: double java.sql.Types.DOUBLE
money: money java.sql.Types.INTEGER
date: date java.sql.Types.DATE
time: time java.sql.Types.TIME
timestamp: timestamp java.sql.Types.TIMESTAMP
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
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
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);
link : a many to many link (via a link table);
defined : a type defined by a typedef.
-->
<!ENTITY % ComplexDataTypes "entity|link|list|defined" >
<!--
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)
message : an internationalised message, having different translations for different locales
-->
<!ENTITY % SpecialDataTypes "geopos|image|message" >
<!-- all data types -->
<!ENTITY % AllDataTypes "%ComplexDataTypes;|%SimpleDataTypes;|%SpecialDataTypes;" >
<!-- content, for things like pages (i.e. forms, lists, pages) -->
<!ENTITY % Content "head|top|foot" >
<!ENTITY % FieldStuff "field|fieldgroup|auxlist|verb">
<!ENTITY % PageContent "%Content;|%FieldStuff;" >
<!ENTITY % PageStuff "%PageContent;|permission|pragma" >
<!-- Properties for pages:
name: obviously, the name (URL stub) of the page
properties: the properties of the entity the page describes to be shown
as fields on the page
all: obviously, all properties (except the abstract primary key, if
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
"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
to this property before it is persisted.
guid: The system will supply a unique GUid value to this field
before it is persisted.
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!
-->
<!ENTITY % GeneratorActions "assigned|guid|manual|native">
<!-- sequences for orderings of lists - see entity 'order'
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">
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
<!-- 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
currency: the base monetary currency, in the form of an ISO 4217 three-letter code
xmlns: XML namespace, in case required
-->
<!ELEMENT application ( specification*, documentation?, content?, typedef*, group*, entity*)>
<!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
pattern must be a regular expression as interpreted by org.apache.regexp.RE
minimum and maximum must be of appropriate format for the datatype specified.
Validation may be done client-side and/or server-side at application layer
and/or server side at database layer.
name: the name of this typedef
type: the simple type on which this defined type is based; must be
present unless in-implementation children are supplied
size: the data size of this defined type
pattern: a regular expression which values for this type must match
minimum: the minimum value for this type (if base type is scalar)
maximum: the maximum value for this type (if base type is scalar)
-->
<!ELEMENT typedef (documentation?, in-implementation*, help*) >
<!ATTLIST typedef
name CDATA #REQUIRED
type (%DefinableDataTypes;) #IMPLIED
size CDATA #IMPLIED
pattern CDATA #IMPLIED
minimum CDATA #IMPLIED
maximum CDATA #IMPLIED>
<!--
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
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...
-->
<!ELEMENT in-implementation (documentation?)>
<!ATTLIST in-implementation
target CDATA #REQUIRED
value CDATA #REQUIRED
kind CDATA #IMPLIED>
<!--
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
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
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
as name of entity. Strongly recommend this is not used unless it needs
to be different from the name of the entity.
foreign: this entity is part of some other system; no code will be generated
for it, although code which links to it will be generated.
magnitude: The power of ten which approximates the expected number of records; thus
if ten records are expected, the magnitude is 1; if a million, the
magnitude is 6.
volatility: Number representing the anticipated rate of change of records in this
entity; if 0, results should never be cached; otherwise, a power of
10 representing the number of seconds the data may safely be cached.
thus 5 represents a cach time to live of 100,000 seconds, or slightly
more than one day.
-->
<!ELEMENT entity ( documentation?, prompt*, content?, key?,
property*, permission*, (form | page | list)*)>
<!ATTLIST entity
name CDATA #REQUIRED
natural-key CDATA #IMPLIED
table CDATA #IMPLIED
foreign %Boolean; #IMPLIED
magnitude CDATA #IMPLIED
volatility CDATA #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?
-->
<!ELEMENT documentation ( #PCDATA|reference)*>
<!ATTLIST documentation
xmlns CDATA #IMPLIED>
<!-- an explicit primary key, possibly compound -->
<!ELEMENT key (property*)>
<!--
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
magic values of this!
typedef: name of the typedef to use, it type = 'defined'.
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
/and/ are user friendly (NOTE: not implemented).
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
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
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
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
entitie(s) linked on this property. Valid only if type='entity',
type='link' or type='list'.
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
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
name CDATA #REQUIRED
type (%AllDataTypes;) #REQUIRED
default CDATA #IMPLIED
typedef CDATA #IMPLIED
distinct (none|all|user|system) #IMPLIED
entity CDATA #IMPLIED
farkey CDATA #IMPLIED
required %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
can police values for Hibernate's 'builtin' generators.
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
interface, or its equivalent in other languages
-->
<!ELEMENT generator (documentation?, param*)>
<!ATTLIST generator
action (%GeneratorActions;) #REQUIRED
class CDATA #IMPLIED>
<!--
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
ambiguous to rename it.
-->
<!ELEMENT param (#PCDATA)>
<!ATTLIST param
name CDATA #REQUIRED>
<!--
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
ambiguous to rename it.
-->
<!ELEMENT option (documentation?, prompt*)>
<!-- if the value is different from the prompt the user sees, specify it -->
<!ATTLIST option
value CDATA #IMPLIED>
<!--
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
group CDATA #REQUIRED
permission (%Permissions;) #REQUIRED>
<!--
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.
-->
<!ELEMENT pragma (documentation?)>
<!ATTLIST pragma
name CDATA #REQUIRED
value CDATA #REQUIRED>
<!--
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
-->
<!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
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
-->
<!ELEMENT help (#PCDATA)>
<!ATTLIST help
locale %Locale; #REQUIRED
xmlns CDATA #IMPLIED >
<!--
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
behaviour here.
-->
<!ELEMENT ifmissing (#PCDATA)>
<!ATTLIST ifmissing
locale %Locale; #REQUIRED
xmlns CDATA #IMPLIED>
<!-- 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.
-->
<!ELEMENT form (documentation?, ( %PageStuff;)*)>
<!ATTLIST form %PageAttrs;>
<!-- a page on which an entity may be displayed -->
<!ELEMENT page (documentation?, ( %PageStuff;)*)>
<!ATTLIST page %PageAttrs;>
<!-- an ordering or records in a list
property: the property on which to order
sequence: the sequence in which to order
-->
<!ELEMENT order (documentation?)>
<!ATTLIST order
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
-->
<!ELEMENT list (documentation?, ( %PageStuff;|order)*)>
<!ATTLIST list %PageAttrs;
onselect CDATA #IMPLIED >
<!--
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
when an item from the list is selected
canadd: true if the user should be able to add records
to this list
-->
<!ELEMENT auxlist (documentation?, (prompt|%FieldStuff;)*)>
<!ATTLIST auxlist %PageAttrs;
property CDATA #REQUIRED
onselect CDATA #IMPLIED
canadd %Boolean; #IMPLIED>
<!--
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;)*)>
<!ATTLIST fieldgroup
name CDATA #REQUIRED>
<!-- a field in a form or page
property: the property which this field displays/edits
-->
<!ELEMENT field (documentation?, (prompt|help|permission)*) >
<!ATTLIST field
property CDATA #REQUIRED >
<!-- 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)*) >
<!ATTLIST verb
verb CDATA #REQUIRED
dangerous %Boolean; #REQUIRED>
<!-- a container for global content -->
<!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
(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
ambiguous to rename it.
-->
<!ELEMENT head (#PCDATA) >
<!ATTLIST head
xmlns CDATA #IMPLIED>
<!--
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;
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.
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
-->
<!ELEMENT specification (documentation?, reference*)>
<!ATTLIST specification
url CDATA #IMPLIED
name CDATA #REQUIRED
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.
abbr: The abbreviated name of the specification to which this
reference refers
section: The 'anchor part' (part following a hash character) which,
when appended to the URL, will locate the exact section
referenced.
entity: A reference to another entity within this ADL document
property: A reference to another property within this ADL document;
if entity is also specified then of that entity, else of
the ancestor entity if any
-->
<!ELEMENT reference (documentation?)>
<!ATTLIST reference
abbr CDATA #IMPLIED
section CDATA #IMPLIED
entity CDATA #IMPLIED
property CDATA #IMPLIED
>

38
schemas/adl-1.4.dtd → resources/schemas/adl-1.4.dtd
View file

@ -78,15 +78,15 @@ that we can allow HTML block level entities within content elements -->
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
money: money java.sql.Types.INTEGER money: money java.sql.Types.INTEGER
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
@ -96,20 +96,20 @@ that we can allow HTML block level entities within content elements -->
<!-- <!--
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);
link : a many to many link (via a link table); link : a many to many link (via a link table);
defined : a type defined by a typedef. defined : a type defined by a typedef.
--> -->
<!ENTITY % ComplexDataTypes "entity|link|list|defined" > <!ENTITY % ComplexDataTypes "entity|link|list|defined" >
@ -152,7 +152,7 @@ that we can allow HTML block level entities within content elements -->
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!
@ -209,12 +209,12 @@ 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
pattern CDATA #IMPLIED pattern CDATA #IMPLIED
minimum CDATA #IMPLIED minimum CDATA #IMPLIED
maximum CDATA #IMPLIED> maximum CDATA #IMPLIED>
<!-- <!--
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

545
resources/schemas/adl-1.4.rnc Normal file
View file

@ -0,0 +1,545 @@
# ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#
# adl-1.4.dtd
#
# Purpose:
# Document Type Description for Application Description
# Language. Normative for now; will be replaced by a schema. `
#
# Author: Simon Brooke <simon@cygnets.co.uk>
# Created: 24th January 2006
# Copyright: (c) 2007 Cygnet Solutions
#
# ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# $Revision: 1.5 $
# ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# Before we start: import XHTML for use in documentation sections
# ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# 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
# that we can allow HTML block level entities within content elements
# boolean means true or false
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>
# <URL:http://www.chemie.fu-berlin.de/diverse/doc/ISO_3166.html>
Locale = string
# 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
# 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
# noedit: select, insert
# edit: select, insert, update
# all: select, insert, update, delete
Permissions = "none" | "read" | "insert" | "noedit" | "edit" | "all"
# actions which should be cascaded to dependent objects. All these values except
# '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
# manual : cascading will be handled in manually managed code, code to
# handle cascading should not be generated
# save-update : cascade save and update actions, but not delete.
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
# string: varchar java.sql.Types.VARCHAR
# integer: int java.sql.Types.INTEGER
# real: double java.sql.Types.DOUBLE
# money: money java.sql.Types.INTEGER
# date: date java.sql.Types.DATE
# time: time java.sql.Types.TIME
# timestamp: timestamp java.sql.Types.TIMESTAMP
# 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
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
# memo java.sql.Types.CLOB
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
# 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);
# link : a many to many link (via a link table);
# defined : a type defined by a typedef.
ComplexDataTypes = "entity" | "link" | "list" | "defined"
# 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)
# message : an internationalised message, having different translations for different locales
SpecialDataTypes = "geopos" | "image" | "message"
# all data types
AllDataTypes = ComplexDataTypes | SimpleDataTypes | SpecialDataTypes
# content, for things like pages (i.e. forms, lists, pages)
Content = head | top | foot
FieldStuff = field | fieldgroup | auxlist | verb
PageContent = Content | FieldStuff
PageStuff = PageContent | permission | pragma
# Properties for pages:
# name: obviously, the name (URL stub) of the page
# properties: the properties of the entity the page describes to be shown
# as fields on the page
# all: obviously, all properties (except the abstract primary key, if
# present)
# user-distinct: all properties which are user-distinct (NOTE: Not yet implemented)
# listed: only those properties for which fields are explicitly listed
PageAttrs =
attribute name { text },
attribute properties { "all" | "user-distinct" | "listed" }
# Actions for generators (mainly for keyfields - see entity 'generator', below
# 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
# before it is persisted.
# mannual: You contract to supply a generatos 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!
GeneratorActions = "assigned" | "guid" | "manual" | "native"
# sequences for orderings of lists - see entity 'order'
# 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
Sequences = "canonical" | "reverse-canonical"
# ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# 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
# currency: the base monetary currency, in the form of an ISO 4217 three-letter code
# xmlns: XML namespace, in case required
application =
element application {
attlist.application,
specification*,
documentation?,
content?,
typedef*,
group*,
entity*
}
attlist.application &=
attribute name { text },
attribute version { text }?,
attribute revision { text }?,
attribute currency { text }?
# 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
# pattern must be a regular expression as interpreted by org.apache.regexp.RE
# minimum and maximum must be of appropriate format for the datatype specified.
# Validation may be done client-side and/or server-side at application layer
# and/or server side at database layer.
#
# name: the name of this typedef
# type: the simple type on which this defined type is based; must be
# present unless in-implementation children are supplied
# size: the data size of this defined type
# pattern: a regular expression which values for this type must match
# minimum: the minimum value for this type (if base type is scalar)
# maximum: the maximum value for this type (if base type is scalar)
typedef =
element typedef {
attlist.typedef, documentation?, in-implementation*, help*
}
attlist.typedef &=
attribute name { text },
attribute type { DefinableDataTypes }?,
attribute size { text }?,
attribute pattern { text }?,
attribute minimum { text }?,
attribute maximum { text }?
# 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
# 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...
in-implementation =
element in-implementation {
attlist.in-implementation, documentation?
}
attlist.in-implementation &=
attribute target { text },
attribute value { text },
attribute kind { text }?
# 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
group = element group { attlist.group, documentation? }
attlist.group &=
attribute name { text },
attribute parent { text }?
# 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
# 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
# as name of entity. Strongly recommend this is not used unless it needs
# to be different from the name of the entity
# foreign: this entity is part of some other system; no code will be generated
# for it, although code which links to it will be generated
entity =
element entity {
attlist.entity,
documentation?,
prompt*,
content?,
key?,
property*,
permission*,
(form | page | \list)*
}
attlist.entity &=
attribute name { text },
attribute natural-key { text }?,
attribute table { text }?,
attribute foreign { Boolean }?
# contains documentation on the element which immediately contains it. TODO:
# should HTML markup within a documentation element be allowed? If so, are
# there restrictions?
documentation =
element documentation { attlist.documentation, (text | reference)* }
attlist.documentation &= empty
# an explicit primary key, possibly compound
key = element key { attlist.key, property* }
attlist.key &= empty
# 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
# magic values of this!
# typedef: name of the typedef to use, it type = 'defined'.
# 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
# /and/ are user friendly (NOTE: not implemented).
# 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
# 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
# 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
# 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
# entitie(s) linked on this property. Valid only if type='entity',
# type='link' or type='list'.
# 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
# committed to persistent store, the value which it holds before
# it has been committed
property =
element property {
attlist.property,
documentation?,
generator?,
(permission | option | prompt | help | ifmissing)*
}
attlist.property &=
attribute name { text },
attribute type { AllDataTypes },
attribute default { text }?,
attribute typedef { text }?,
attribute distinct { "none" | "all" | "user" | "system" }?,
attribute entity { text }?,
attribute farkey { text }?,
attribute required { Boolean }?,
attribute immutable { Boolean }?,
attribute size { text }?,
attribute column { text }?,
attribute concrete { Boolean }?,
attribute cascade { CascadeActions }?
# 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
# '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
# interface, or its equivalent in other languages
generator =
element generator { attlist.generator, documentation?, param* }
attlist.generator &=
attribute action { GeneratorActions },
attribute class { text }?
# 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
# ambiguous to rename it.
param = element param { attlist.param, text }
attlist.param &= attribute name { text }
# 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
# ambiguous to rename it.
option = element option { attlist.option, documentation?, prompt* }
# if the value is different from the prompt the user sees, specify it
attlist.option &= attribute value { text }?
# 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
permission = element permission { attlist.permission, documentation? }
attlist.permission &=
attribute group { text },
attribute permission { Permissions }
# 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.
pragma = element pragma { attlist.pragma, documentation? }
attlist.pragma &=
attribute name { text },
attribute value { text }
# 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
prompt = element prompt { attlist.prompt, documentation? }
attlist.prompt &=
attribute prompt { text },
attribute locale { Locale }
# 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
help = element help { attlist.help, text }
attlist.help &= attribute locale { Locale }
# 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
# behaviour here.
ifmissing = element ifmissing { attlist.ifmissing, text }
attlist.ifmissing &= attribute locale { Locale }
# 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.
form = element form { attlist.form, documentation?, PageStuff* }
attlist.form &= PageAttrs
# a page on which an entity may be displayed
page = element page { attlist.page, documentation?, PageStuff* }
attlist.page &= PageAttrs
# an ordering or records in a list
# property: the property on which to order
# sequence: the sequence in which to order
order = element order { attlist.order, documentation? }
attlist.order &=
attribute property { text },
attribute sequence { Sequences }?
# 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
\list =
element list { attlist.list, documentation?, (PageStuff | order)* }
attlist.list &=
PageAttrs,
attribute onselect { text }?
# 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
# when an item from the list is selected
# canadd: true if the user should be able to add records
# to this list
auxlist =
element auxlist {
attlist.auxlist, documentation?, (prompt | FieldStuff)*
}
attlist.auxlist &=
PageAttrs,
attribute property { text },
attribute onselect { text }?,
attribute canadd { Boolean }?
# 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.
fieldgroup =
element fieldgroup {
attlist.fieldgroup,
documentation?,
(prompt | permission | FieldStuff)*
}
attlist.fieldgroup &= attribute name { text }
# a field in a form or page
#
# property: the property which this field displays/edits
field =
element field {
attlist.field, documentation?, (prompt | help | permission)*
}
attlist.field &= attribute property { text }
# 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
verb =
element verb {
attlist.verb, documentation?, (prompt | help | permission)*
}
attlist.verb &=
attribute verb { text },
attribute dangerous { Boolean }
# a container for global content
content = element content { attlist.content, Content* }
attlist.content &= empty
# 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
# ambiguous to rename it.
head = element head { attlist.head, text }
attlist.head &= empty
# 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.
top = element top { attlist.top, text }
attlist.top &= empty
# 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.
foot = element foot { attlist.foot, text }
attlist.foot &= empty
# 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.
#
# 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
specification =
element specification {
attlist.specification, documentation?, reference*
}
attlist.specification &=
attribute url { text }?,
attribute name { text },
attribute abbr { text }
# 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.
#
# abbr: The abbreviated name of the specification to which this
# reference refers
# section: The 'anchor part' (part following a hash character) which,
# when appended to the URL, will locate the exact section
# referenced.
# entity: A reference to another entity within this ADL document
# property: A reference to another property within this ADL document;
# if entity is also specified then of that entity, else of
# the ancestor entity if any
reference = element reference { attlist.reference, documentation? }
attlist.reference &=
attribute abbr { text }?,
attribute section { text }?,
attribute entity { text }?,
attribute property { text }?
start = application

0
schemas/adl-1.4.rng → resources/schemas/adl-1.4.rng
View file

547
resources/schemas/adl-1.4.xsd Normal file
View file

@ -0,0 +1,547 @@
<schema
xmlns='http://www.w3.org/2000/10/XMLSchema'
targetNamespace='http://www.w3.org/namespace/'
xmlns:t='http://www.w3.org/namespace/'>
<element name='application'>
<complexType>
<sequence>
<element ref='t:specification' minOccurs='0' maxOccurs='unbounded'/>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
<element ref='t:content' minOccurs='0' maxOccurs='1'/>
<element ref='t:typedef' minOccurs='0' maxOccurs='unbounded'/>
<element ref='t:group' minOccurs='0' maxOccurs='unbounded'/>
<element ref='t:entity' minOccurs='0' maxOccurs='unbounded'/>
</sequence>
<attribute name='name' type='string' use='required'/>
<attribute name='version' type='string' use='optional'/>
<attribute name='revision' type='string' use='optional'/>
<attribute name='currency' type='string' use='optional'/>
<attribute name='xmlns' type='string' use='optional'/>
</complexType>
</element>
<element name='typedef'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
<element ref='t:in-implementation' minOccurs='0' maxOccurs='unbounded'/>
<element ref='t:help' minOccurs='0' maxOccurs='unbounded'/>
</sequence>
<attribute name='name' type='string' use='required'/>
<attribute name='type' use='optional'>
<simpleType>
<restriction base='string'>
<enumeration value='string'/>
<enumeration value='integer'/>
<enumeration value='real'/>
<enumeration value='money'/>
<enumeration value='date'/>
<enumeration value='time'/>
<enumeration value='timestamp'/>
<enumeration value='uploadable'/>
</restriction>
</simpleType>
</attribute>
<attribute name='size' type='string' use='optional'/>
<attribute name='pattern' type='string' use='optional'/>
<attribute name='minimum' type='string' use='optional'/>
<attribute name='maximum' type='string' use='optional'/>
</complexType>
</element>
<element name='in-implementation'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
</sequence>
<attribute name='target' type='string' use='required'/>
<attribute name='value' type='string' use='required'/>
<attribute name='kind' type='string' use='optional'/>
</complexType>
</element>
<element name='group'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
</sequence>
<attribute name='name' type='string' use='required'/>
<attribute name='parent' type='string' use='optional'/>
</complexType>
</element>
<element name='entity'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
<element ref='t:prompt' minOccurs='0' maxOccurs='unbounded'/>
<element ref='t:content' minOccurs='0' maxOccurs='1'/>
<element ref='t:key' minOccurs='0' maxOccurs='1'/>
<element ref='t:property' minOccurs='0' maxOccurs='unbounded'/>
<element ref='t:permission' minOccurs='0' maxOccurs='unbounded'/>
<choice minOccurs='0' maxOccurs='unbounded'>
<element ref='t:form'/>
<element ref='t:page'/>
<element ref='t:list'/>
</choice>
</sequence>
<attribute name='name' type='string' use='required'/>
<attribute name='natural-key' type='string' use='optional'/>
<attribute name='table' type='string' use='optional'/>
<attribute name='foreign' use='optional'>
<simpleType>
<restriction base='string'>
<enumeration value='true'/>
<enumeration value='false'/>
</restriction>
</simpleType>
</attribute>
</complexType>
</element>
<element name='documentation'>
<complexType mixed='true'>
<sequence minOccurs='0' maxOccurs='unbounded'>
<element ref='t:reference'/>
</sequence>
<attribute name='xmlns' type='string' use='optional'/>
</complexType>
</element>
<element name='key'>
<complexType>
<sequence>
<element ref='t:property' minOccurs='0' maxOccurs='unbounded'/>
</sequence>
</complexType>
</element>
<element name='property'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
<element ref='t:generator' minOccurs='0' maxOccurs='1'/>
<choice minOccurs='0' maxOccurs='unbounded'>
<element ref='t:permission'/>
<element ref='t:option'/>
<element ref='t:prompt'/>
<element ref='t:help'/>
<element ref='t:ifmissing'/>
</choice>
</sequence>
<attribute name='name' type='string' use='required'/>
<attribute name='type' use='required'>
<simpleType>
<restriction base='string'>
<enumeration value='entity'/>
<enumeration value='link'/>
<enumeration value='list'/>
<enumeration value='defined'/>
<enumeration value='string'/>
<enumeration value='integer'/>
<enumeration value='real'/>
<enumeration value='money'/>
<enumeration value='date'/>
<enumeration value='time'/>
<enumeration value='timestamp'/>
<enumeration value='uploadable'/>
<enumeration value='boolean'/>
<enumeration value='text'/>
<enumeration value='geopos'/>
<enumeration value='image'/>
<enumeration value='message'/>
</restriction>
</simpleType>
</attribute>
<attribute name='default' type='string' use='optional'/>
<attribute name='typedef' type='string' use='optional'/>
<attribute name='distinct' use='optional'>
<simpleType>
<restriction base='string'>
<enumeration value='none'/>
<enumeration value='all'/>
<enumeration value='user'/>
<enumeration value='system'/>
</restriction>
</simpleType>
</attribute>
<attribute name='entity' type='string' use='optional'/>
<attribute name='farkey' type='string' use='optional'/>
<attribute name='required' use='optional'>
<simpleType>
<restriction base='string'>
<enumeration value='true'/>
<enumeration value='false'/>
</restriction>
</simpleType>
</attribute>
<attribute name='immutable' use='optional'>
<simpleType>
<restriction base='string'>
<enumeration value='true'/>
<enumeration value='false'/>
</restriction>
</simpleType>
</attribute>
<attribute name='size' type='string' use='optional'/>
<attribute name='column' type='string' use='optional'/>
<attribute name='concrete' use='optional'>
<simpleType>
<restriction base='string'>
<enumeration value='true'/>
<enumeration value='false'/>
</restriction>
</simpleType>
</attribute>
<attribute name='cascade' use='optional'>
<simpleType>
<restriction base='string'>
<enumeration value='all'/>
<enumeration value='all-delete-orphan'/>
<enumeration value='delete'/>
<enumeration value='manual'/>
<enumeration value='save-update'/>
</restriction>
</simpleType>
</attribute>
</complexType>
</element>
<element name='generator'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
<element ref='t:param' minOccurs='0' maxOccurs='unbounded'/>
</sequence>
<attribute name='action' use='required'>
<simpleType>
<restriction base='string'>
<enumeration value='assigned'/>
<enumeration value='guid'/>
<enumeration value='manual'/>
<enumeration value='native'/>
</restriction>
</simpleType>
</attribute>
<attribute name='class' type='string' use='optional'/>
</complexType>
</element>
<element name='param'>
<complexType mixed='true'>
<attribute name='name' type='string' use='required'/>
</complexType>
</element>
<element name='option'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
<element ref='t:prompt' minOccurs='0' maxOccurs='unbounded'/>
</sequence>
<attribute name='value' type='string' use='optional'/>
</complexType>
</element>
<element name='permission'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
</sequence>
<attribute name='group' type='string' use='required'/>
<attribute name='permission' use='required'>
<simpleType>
<restriction base='string'>
<enumeration value='none'/>
<enumeration value='read'/>
<enumeration value='insert'/>
<enumeration value='noedit'/>
<enumeration value='edit'/>
<enumeration value='all'/>
</restriction>
</simpleType>
</attribute>
</complexType>
</element>
<element name='pragma'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
</sequence>
<attribute name='name' type='string' use='required'/>
<attribute name='value' type='string' use='required'/>
</complexType>
</element>
<element name='prompt'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
</sequence>
<attribute name='prompt' type='string' use='required'/>
<attribute name='locale' type='string' use='required'/>
</complexType>
</element>
<element name='help'>
<complexType mixed='true'>
<attribute name='locale' type='string' use='required'/>
<attribute name='xmlns' type='string' use='optional'/>
</complexType>
</element>
<element name='ifmissing'>
<complexType mixed='true'>
<attribute name='locale' type='string' use='required'/>
<attribute name='xmlns' type='string' use='optional'/>
</complexType>
</element>
<element name='form'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
<choice minOccurs='0' maxOccurs='unbounded'>
<element ref='t:head'/>
<element ref='t:top'/>
<element ref='t:foot'/>
<element ref='t:field'/>
<element ref='t:fieldgroup'/>
<element ref='t:auxlist'/>
<element ref='t:verb'/>
<element ref='t:permission'/>
<element ref='t:pragma'/>
</choice>
</sequence>
<attribute name='name' type='string' use='required'/>
<attribute name='properties' use='required'>
<simpleType>
<restriction base='string'>
<enumeration value='all'/>
<enumeration value='user-distinct'/>
<enumeration value='listed'/>
</restriction>
</simpleType>
</attribute>
</complexType>
</element>
<element name='page'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
<choice minOccurs='0' maxOccurs='unbounded'>
<element ref='t:head'/>
<element ref='t:top'/>
<element ref='t:foot'/>
<element ref='t:field'/>
<element ref='t:fieldgroup'/>
<element ref='t:auxlist'/>
<element ref='t:verb'/>
<element ref='t:permission'/>
<element ref='t:pragma'/>
</choice>
</sequence>
<attribute name='name' type='string' use='required'/>
<attribute name='properties' use='required'>
<simpleType>
<restriction base='string'>
<enumeration value='all'/>
<enumeration value='user-distinct'/>
<enumeration value='listed'/>
</restriction>
</simpleType>
</attribute>
</complexType>
</element>
<element name='order'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
</sequence>
<attribute name='property' type='string' use='required'/>
<attribute name='sequence' use='optional'>
<simpleType>
<restriction base='string'>
<enumeration value='canonical'/>
<enumeration value='reverse-canonical'/>
</restriction>
</simpleType>
</attribute>
</complexType>
</element>
<element name='list'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
<choice minOccurs='0' maxOccurs='unbounded'>
<element ref='t:head'/>
<element ref='t:top'/>
<element ref='t:foot'/>
<element ref='t:field'/>
<element ref='t:fieldgroup'/>
<element ref='t:auxlist'/>
<element ref='t:verb'/>
<element ref='t:permission'/>
<element ref='t:pragma'/>
<element ref='t:order'/>
</choice>
</sequence>
<attribute name='name' type='string' use='required'/>
<attribute name='properties' use='required'>
<simpleType>
<restriction base='string'>
<enumeration value='all'/>
<enumeration value='user-distinct'/>
<enumeration value='listed'/>
</restriction>
</simpleType>
</attribute>
<attribute name='onselect' type='string' use='optional'/>
</complexType>
</element>
<element name='auxlist'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
<choice minOccurs='0' maxOccurs='unbounded'>
<element ref='t:prompt'/>
<element ref='t:field'/>
<element ref='t:fieldgroup'/>
<element ref='t:auxlist'/>
<element ref='t:verb'/>
</choice>
</sequence>
<attribute name='name' type='string' use='required'/>
<attribute name='properties' use='required'>
<simpleType>
<restriction base='string'>
<enumeration value='all'/>
<enumeration value='user-distinct'/>
<enumeration value='listed'/>
</restriction>
</simpleType>
</attribute>
<attribute name='property' type='string' use='required'/>
<attribute name='onselect' type='string' use='optional'/>
<attribute name='canadd' use='optional'>
<simpleType>
<restriction base='string'>
<enumeration value='true'/>
<enumeration value='false'/>
</restriction>
</simpleType>
</attribute>
</complexType>
</element>
<element name='fieldgroup'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
<choice minOccurs='0' maxOccurs='unbounded'>
<element ref='t:prompt'/>
<element ref='t:permission'/>
<element ref='t:field'/>
<element ref='t:fieldgroup'/>
<element ref='t:auxlist'/>
<element ref='t:verb'/>
</choice>
</sequence>
<attribute name='name' type='string' use='required'/>
</complexType>
</element>
<element name='field'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
<choice minOccurs='0' maxOccurs='unbounded'>
<element ref='t:prompt'/>
<element ref='t:help'/>
<element ref='t:permission'/>
</choice>
</sequence>
<attribute name='property' type='string' use='required'/>
</complexType>
</element>
<element name='verb'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
<choice minOccurs='0' maxOccurs='unbounded'>
<element ref='t:prompt'/>
<element ref='t:help'/>
<element ref='t:permission'/>
</choice>
</sequence>
<attribute name='verb' type='string' use='required'/>
<attribute name='dangerous' use='required'>
<simpleType>
<restriction base='string'>
<enumeration value='true'/>
<enumeration value='false'/>
</restriction>
</simpleType>
</attribute>
</complexType>
</element>
<element name='content'>
<complexType>
<choice minOccurs='0' maxOccurs='unbounded'>
<element ref='t:head'/>
<element ref='t:top'/>
<element ref='t:foot'/>
</choice>
</complexType>
</element>
<element name='head'>
<complexType mixed='true'>
<attribute name='xmlns' type='string' use='optional'/>
</complexType>
</element>
<element name='top'>
<complexType mixed='true'>
<attribute name='xmlns' type='string' use='optional'/>
</complexType>
</element>
<element name='foot'>
<complexType mixed='true'>
<attribute name='xmlns' type='string' use='optional'/>
</complexType>
</element>
<element name='specification'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
<element ref='t:reference' minOccurs='0' maxOccurs='unbounded'/>
</sequence>
<attribute name='url' type='string' use='optional'/>
<attribute name='name' type='string' use='required'/>
<attribute name='abbr' type='string' use='required'/>
</complexType>
</element>
<element name='reference'>
<complexType>
<sequence>
<element ref='t:documentation' minOccurs='0' maxOccurs='1'/>
</sequence>
<attribute name='abbr' type='string' use='optional'/>
<attribute name='section' type='string' use='optional'/>
<attribute name='entity' type='string' use='optional'/>
<attribute name='property' type='string' use='optional'/>
</complexType>
</element>
</schema>

0
schemas/permitted-html-head.rng → resources/schemas/permitted-html-head.rng
View file

0
schemas/permitted-html.rng → resources/schemas/permitted-html.rng
View file

0
schemas/strict.dtd → resources/schemas/strict.dtd
View file

9
resources/test/documentation-only.adl.xml Normal file
View file

@ -0,0 +1,9 @@
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE application PUBLIC "-//JOURNEYMAN//DTD ADL 1.4//EN"
"http://www.journeyman.cc/adl/stable/adl/schemas/adl-1.4.dtd">
<application name='test1' version='0.0.1'>
<!--
xmlns:h="http://www.w3.org/TR/html4/"
xmlns="ttp://www.journeyman.cc/adl/stable/adl/schemas/adl-1.4.dtd" -->
<documentation>Some test documentation</documentation>
</application>

77
resources/test/test1.adl.xml Normal file
View file

@ -0,0 +1,77 @@
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE application PUBLIC "-//JOURNEYMAN//DTD ADL 1.4//EN" "http://www.journeyman.cc/adl/stable/adl/schemas/adl-1.4.dtd">
<application xmlns:h="http://www.w3.org/TR/html4/" xmlns="http://www.journeyman.cc/adl/stable/adl/schemas/adl-1.4.dtd" name="test1" version="0.0.1">
<documentation>This is a very simple test document just to exercise validator and generators.</documentation>
<content>
<head>
<h:meta xmlns="http://www.w3.org/1999/xhtml" name="generator" content="Application Description Language framework"/>
</head>
<top>
<h:h1 xmlns="http://www.w3.org/1999/xhtml">Test 1</h:h1>
</top>
<foot>
<h:p xmlns="http://www.w3.org/1999/xhtml" class="footer">That's all folks!</h:p>
</foot>
</content>
<group name="public">
<documentation>All users</documentation>
</group>
<group name="admin">
<documentation>Administrative users</documentation>
</group>
<entity name="person">
<documentation>A person</documentation>
<prompt prompt="Person" locale="en-GB"/>
<key>
<property name="id" type="integer" distinct="system" required="true" immutable="true">
<generator action="native"/>
</property>
</key>
<property name="name" type="string" size="32" distinct="user" required="true">
<!-- documentation>The name of the person</documentation -->
<prompt prompt="Name" locale="en-GB"/>
<prompt prompt="Nomme" locale="fr-FR"/>
</property>
<property name="gender" type="string" size="8" default="Unknown">
<option value="Female">
<prompt prompt="Femme" locale="fr-FR"/>
<prompt prompt="Female" locale="en-GB"/>
</option>
<option value="Male">
<prompt prompt="Homme" locale="fr-FR"/>
<prompt prompt="Male" locale="en-GB"/>
</option>
<option value="Non-bin">
<prompt prompt="Non binaire" locale="fr-FR"/>
<prompt prompt="Non-binary" locale="en-GB"/>
</option>
<option value="Unknown">
<prompt prompt="Inconnu" locale="fr-FR"/>
<prompt prompt="Unknown" locale="en-GB"/>
</option>
</property>
<property name="age" type="integer">
</property>
<property name="address" type="entity" entity="address"/>
<form name="edit-person" properties="listed">
<field property="name"/>
<field property="gender"/>
<field property="age"/>
<field property="address"/>
<permission group="admin" permission="all"/>
<permission group="public" permission="insert"/>
</form>
<page name="inspect-person" properties="all"/>
<list name="list-people" properties="all" on-select="edit-person"/>
</entity>
<entity name="address">
<key>
<property name="id" type="integer" distinct="system" required="true" immutable="true">
<generator action="native"/>
</property>
</key>
<property name="street" type="string" size="128" distinct="user"/>
<property name="town" type="string" size="64"/>
<property name="postcode" type="string" size="12" distinct="user"/>
</entity>
</application>

0
transforms/adl2activerecord.xslt → resources/transforms/adl2activerecord.xslt
View file

70
transforms/adl2canonical.xslt → resources/transforms/adl2canonical.xslt
View file

@ -25,8 +25,8 @@
--> -->
<xsl:stylesheet version="1.0" <xsl:stylesheet version="1.0"
xmlns="http://bowyer.journeyman.cc/adl/1.4/" xmlns="http://bowyer.journeyman.cc/adl/1.4.1/"
xmlns:adl="http://bowyer.journeyman.cc/adl/1.4/" xmlns:adl="http://bowyer.journeyman.cc/adl/1.4.1/"
xmlns:xsl="http://www.w3.org/1999/XSL/Transform" xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
exclude-result-prefixes="adl"> exclude-result-prefixes="adl">
@ -69,46 +69,54 @@
*************************************************************************** ***************************************************************************
* *
* <xsl:value-of select="$product-version"/> * <xsl:value-of select="$product-version"/>
* ©2007 Cygnet Solutions Ltd
* *
* THIS FILE IS AUTOMATICALLY GENERATED AND SHOULD NOT * THIS FILE IS AUTOMATICALLY GENERATED AND SHOULD NOT
* BE MANUALLY EDITED. * BE MANUALLY EDITED.
* *
* Generated using adl2canonical.xslt <xsl:value-of select="substring('$Revision: 1.10 $', 12)"/> * Generated using adl2canonical.xslt <xsl:value-of select="substring('$Revision: 1.10 $', 12)"/>
* *
*************************************************************************** ***************************************************************************
</xsl:comment> </xsl:comment>
<xsl:apply-templates select="*"/> <xsl:apply-templates select="*"/>
</xsl:copy> </xsl:copy>
</xsl:template> </xsl:template>
<!-- an entity which already has a key tag - just copy it through --> <!-- an entity which already has a key tag - just copy it through -->
<xsl:template match="adl:entity[adl:key]"> <xsl:template match="adl:entity[adl:key]">
<xsl:if test="not( @table)"> <xsl:comment>
<xsl:attribute name="table"> entity <xsl:value-of select="@name"/> already has a key - not generating one
<xsl:value-of select="concat( $tablename-prefix, @name)"/> </xsl:comment>
</xsl:attribute> <entity>
</xsl:if> <xsl:if test="not(@magnitude)">
<xsl:comment> <xsl:attribute name="magnitude">6</xsl:attribute>
entity <xsl:value-of select="@name"/> already has a key - not generating one </xsl:if>
</xsl:comment> <xsl:if test="not(@volatility)">
<entity> <xsl:attribute name="volatility">0</xsl:attribute>
<xsl:apply-templates select="@* | node()"/> </xsl:if>
</entity> <xsl:if test="not( @table)">
</xsl:template> <xsl:attribute name="table">
<xsl:value-of select="concat( $tablename-prefix, @name)"/>
</xsl:attribute>
</xsl:if>
<xsl:apply-templates select="@* | node()"/>
</entity>
</xsl:template>
<!-- an entity which has a '@natural-key' attribute. <!-- an entity which has a '@natural-key' attribute.
Since we've got the key tag, I think this should be disallowed --> Since we've got the key tag, I think this should be disallowed -->
<xsl:template match="adl:entity[@natural-key]"> <xsl:template match="adl:entity[@natural-key]">
<xsl:if test="not( @table)">
<xsl:attribute name="table">
<xsl:value-of select="concat( $tablename-prefix, @name)"/>
</xsl:attribute>
</xsl:if>
<xsl:message terminate="no"> <xsl:message terminate="no">
ADL WARNING: [In entity '<xsl:value-of select="@name"/>']: '@natural-key' is deprecated - use the 'key' sub element instead ADL WARNING: [In entity '<xsl:value-of select="@name"/>']: '@natural-key' is deprecated - use the 'key' sub element instead
</xsl:message> </xsl:message>
<entity> <entity>
<xsl:if test="not(@magnitude)">
<xsl:attribute name="magnitude">6</xsl:attribute>
</xsl:if>
<xsl:if test="not( @table)">
<xsl:attribute name="table">
<xsl:value-of select="concat( $tablename-prefix, @name)"/>
</xsl:attribute>
</xsl:if>
<xsl:variable name="nkey" select="@natural-key"/> <xsl:variable name="nkey" select="@natural-key"/>
<xsl:apply-templates select="@*"/> <xsl:apply-templates select="@*"/>
<!-- children copied through in legal order, to ensure the document remains valid --> <!-- children copied through in legal order, to ensure the document remains valid -->
@ -141,13 +149,16 @@
</xsl:comment> </xsl:comment>
<entity> <entity>
<xsl:if test="not(@magnitude)">
<xsl:attribute name="magnitude">6</xsl:attribute>
</xsl:if>
<xsl:if test="not( @table)">
<xsl:attribute name="table">
<xsl:value-of select="concat( $tablename-prefix, @name)"/>
</xsl:attribute>
</xsl:if>
<!-- copy attributes through --> <!-- copy attributes through -->
<xsl:apply-templates select="@*"/> <xsl:apply-templates select="@*"/>
<xsl:if test="not( @table)">
<xsl:attribute name="table">
<xsl:value-of select="concat( $tablename-prefix, @name)"/>
</xsl:attribute>
</xsl:if>
<!-- children copied through in legal order, to ensure the document remains valid --> <!-- children copied through in legal order, to ensure the document remains valid -->
<xsl:apply-templates select="adl:documentation"/> <xsl:apply-templates select="adl:documentation"/>
<xsl:apply-templates select="adl:content"/> <xsl:apply-templates select="adl:content"/>
@ -410,6 +421,7 @@
<xsl:attribute name="property"> <xsl:attribute name="property">
<xsl:value-of select="@name"/> <xsl:value-of select="@name"/>
</xsl:attribute> </xsl:attribute>
<xsl:copy-of select="*"/>
</field> </field>
</xsl:for-each> </xsl:for-each>
</xsl:template> </xsl:template>
@ -427,6 +439,7 @@
<xsl:attribute name="property"> <xsl:attribute name="property">
<xsl:value-of select="@name"/> <xsl:value-of select="@name"/>
</xsl:attribute> </xsl:attribute>
<xsl:copy-of select="*"/>
</field> </field>
</xsl:otherwise> </xsl:otherwise>
</xsl:choose> </xsl:choose>
@ -446,6 +459,7 @@
</xsl:attribute> </xsl:attribute>
<xsl:apply-templates select="adl:prompt"/> <xsl:apply-templates select="adl:prompt"/>
<xsl:apply-templates select="adl:help"/> <xsl:apply-templates select="adl:help"/>
<xsl:copy-of select="*"/>
</field> </field>
</xsl:for-each> </xsl:for-each>
</xsl:template> </xsl:template>

0
transforms/adl2controllerclasses.xslt → resources/transforms/adl2controllerclasses.xslt
View file

0
transforms/adl2documentation.xslt → resources/transforms/adl2documentation.xslt
View file

0
transforms/adl2entityclasses.xslt → resources/transforms/adl2entityclasses.xslt
View file

0
transforms/adl2hibernate.xslt → resources/transforms/adl2hibernate.xslt
View file

0
transforms/adl2mssql.xslt → resources/transforms/adl2mssql.xslt
View file

12
transforms/adl2psql.xslt → resources/transforms/adl2psql.xslt
View file

@ -1,7 +1,7 @@
<?xml version="1.0"?> <?xml version="1.0"?>
<xsl:stylesheet version="1.0" <xsl:stylesheet version="1.0"
xmlns="http://bowyer.journeyman.cc/adl/1.4/" xmlns="http://bowyer.journeyman.cc/adl/1.4.1/"
xmlns:adl="http://bowyer.journeyman.cc/adl/1.4/" xmlns:adl="http://bowyer.journeyman.cc/adl/1.4.1/"
xmlns:xsl="http://www.w3.org/1999/XSL/Transform"> xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --> <!-- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -->
<!-- --> <!-- -->
@ -300,10 +300,11 @@
print the names of the distinguishing fields in this table, print the names of the distinguishing fields in this table,
concatenating into a single string. concatenating into a single string.
--> -->
<xsl:for-each select="/application/entity[@name=$table]"> Template distinctfield entered, table is <xsl:value-of select="$table"/>.
<xsl:for-each select="property[@distinct='user' or @distinct='all']"> <xsl:for-each select="//entity[@name=$table]/property[@distinct='user' or @distinct='all']">
<xsl:choose> <xsl:choose>
<xsl:when test="@type='entity'"> <xsl:when test="@type='entity'">
Entity <xsl:value-of select="@name"/> detected.
<xsl:call-template name="distinctfield"> <xsl:call-template name="distinctfield">
<xsl:with-param name="table" select="@entity"/> <xsl:with-param name="table" select="@entity"/>
<xsl:with-param name="alias" select="concat( $alias, '_', @name)"></xsl:with-param> <xsl:with-param name="alias" select="concat( $alias, '_', @name)"></xsl:with-param>
@ -311,12 +312,11 @@
</xsl:when> </xsl:when>
<xsl:otherwise> <xsl:otherwise>
<xsl:value-of select="$alias"/>.<xsl:value-of <xsl:value-of select="$alias"/>.<xsl:value-of
select="@name"/><xsl:if test="position() != last()"> | ' ' | </xsl:if> select="@name"/><xsl:if test="position() != last()"> | ', ' | </xsl:if>
</xsl:otherwise> </xsl:otherwise>
</xsl:choose> </xsl:choose>
</xsl:for-each> </xsl:for-each>
</xsl:for-each>
</xsl:template> </xsl:template>
<xsl:template name="permission"> <xsl:template name="permission">

4
transforms/adl2views.xslt → resources/transforms/adl2views.xslt
View file

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8" ?> <?xml version="1.0" encoding="UTF-8" ?>
<xsl:stylesheet version="1.0" <xsl:stylesheet version="1.0"
xmlns="http://libs.cygnets.co.uk/adl/1.4/" xmlns="http://bowyer.journeyman.cc/adl/1.4/"
xmlns:adl="http://libs.cygnets.co.uk/adl/1.4/" xmlns:adl="http://bowyer.journeyman.cc/adl/1.4/"
xmlns:xsl="http://www.w3.org/1999/XSL/Transform" xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
xmlns:msxsl="urn:schemas-microsoft-com:xslt" xmlns:msxsl="urn:schemas-microsoft-com:xslt"
xmlns:exsl="urn:schemas-microsoft-com:xslt" xmlns:exsl="urn:schemas-microsoft-com:xslt"

0
transforms/base-type-include.xslt → resources/transforms/base-type-include.xslt
View file

0
transforms/csharp-type-include.xslt → resources/transforms/csharp-type-include.xslt
View file

0
transforms/i18n-en-GB-include.xslt → resources/transforms/i18n-en-GB-include.xslt
View file

0
transforms/localise-transform.xslt → resources/transforms/localise-transform.xslt
View file

0
transforms/permissions-include.xslt → resources/transforms/permissions-include.xslt
View file

103
src/adl/main.clj Normal file
View file

@ -0,0 +1,103 @@
(ns ^{:doc "Application Description Language - command line invocation."
:author "Simon Brooke"}
adl.main
(:require [adl-support.utils :refer :all]
[adl-support.print-usage :refer [print-usage]]
[adl.to-hugsql-queries :as h]
[adl.to-json-routes :as j]
[adl.to-psql :as p]
[adl.to-selmer-routes :as s]
[adl.to-selmer-templates :as t]
[clojure.java.io :refer [make-parents]]
[clojure.string :refer [join]]
[clojure.tools.cli :refer [parse-opts]]
[clojure.xml :as x]
[environ.core :refer [env]])
(:gen-class))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; adl.main
;;;;
;;;; 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
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def cli-options
[["-a" "--abstract-key-name-convention [string]" "the abstract key name convention to use for generated key fields (TODO: not yet implemented)"
:default "id"]
["-h" "--help" "Show this message"
:default false]
["-l" "--locale [LOCALE]" "set the locale to generate"
:default (env :lang)]
["-p" "--path [PATH]" "The path under which generated files should be written"
:default "generated"]
["-v" "--verbosity [LEVEL]" nil "Verbosity level - integer value required"
:parse-fn #(Integer/parseInt %)
:default 0]
])
(defn usage [parsed-options]
"Show a usage message. `parsed-options` should be options as
parsed by [clojure.tools.cli](https://github.com/clojure/tools.cli)"
(print-usage
"adl"
parsed-options
{"adl-file" "An XML file conforming to the ADL DTD"}))
(defn -main
"Expects as arg the path-name of an ADL file."
[& args]
(let [options (parse-opts args cli-options)]
(cond
(empty? args)
(usage options)
(not (empty? (:errors options)))
(do
(doall
(map
println
(:errors options)))
(usage options))
(-> options :options :help)
(usage options)
true
(do
(let [p (:path (:options options))
op (if (.endsWith p "/") p (str p "/"))]
(binding [*output-path* op
*locale* (-> options :options :locale)
*verbosity* (-> options :options :verbosity)]
(make-parents *output-path*)
(doall
(map
#(if
(.exists (java.io.File. %))
(let [application (x/parse %)]
(h/to-hugsql-queries application)
(j/to-json-routes application)
(p/to-psql application)
(s/to-selmer-routes application)
(t/to-selmer-templates application))
(println (str "ERROR: File not found: " %)))
(-> options :arguments)))))))))

411
src/adl/to_hugsql_queries.clj Normal file
View file

@ -0,0 +1,411 @@
(ns ^{:doc "Application Description Language - generate HUGSQL queries file."
:author "Simon Brooke"}
adl.to-hugsql-queries
(:require [clojure.java.io :refer [file make-parents]]
[clojure.math.combinatorics :refer [combinations]]
[clojure.string :as s]
[clojure.xml :as x]
[clj-time.core :as t]
[clj-time.format :as f]
[adl-support.utils :refer :all]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; adl.to-hugsql-queries: generate HUGSQL queries file.
;;;;
;;;; 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
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def expanded-token "_expanded")
(defn where-clause
"Generate an appropriate `where` clause for queries on this `entity`;
if `properties` are passed, filter on those properties, otherwise the key
properties."
([entity]
(where-clause entity (key-properties entity)))
([entity properties]
(let
[entity-name (:name (:attrs entity))
property-names (map #(:name (:attrs %)) properties)]
(if
(not (empty? property-names))
(str
"WHERE "
(s/join
"\n\tAND"
(map #(str entity-name "." % " = :" %) property-names)))))))
(defn order-by-clause
"Generate an appropriate `order by` clause for queries on this `entity`"
([entity]
(order-by-clause entity "" false))
([entity prefix]
(order-by-clause entity prefix false))
([entity prefix expanded?]
(let
[entity-name (safe-name (:name (:attrs entity)) :sql)
preferred (filter #(#{"user" "all"} (-> % :attrs :distinct))
(children entity #(= (:tag %) :property)))]
(if
(empty? preferred)
""
(str
"ORDER BY " prefix entity-name "."
(s/join
(str ",\n\t" prefix entity-name ".")
(map
#(if
(and expanded? (= "entity" (-> % :attrs :type)))
(str (safe-name % :sql) expanded-token)
(safe-name % :sql))
(flatten (cons preferred (key-properties entity))))))))))
;; (def a (x/parse "../youyesyet/youyesyet.adl.xml"))
;; (def e (child-with-tag a :entity #(= "dwellings" (-> % :attrs :name))))
;; (order-by-clause e "" true)
(defn insert-query
"Generate an appropriate `insert` query for this `entity`.
TODO: this depends on the idea that system-unique properties
are not insertable, which is... dodgy."
[entity]
(let [entity-name (safe-name (:name (:attrs entity)) :sql)
pretty-name (singularise entity-name)
insertable-property-names (map
#(safe-name (:name (:attrs %)) :sql)
(insertable-properties entity))
query-name (str "create-" pretty-name "!")
signature ":! :n"]
(hash-map
(keyword query-name)
{:name query-name
:signature signature
:entity entity
: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" insertable-property-names)
")\nVALUES ("
(s/join ",\n\t" (map keyword insertable-property-names))
")"
(if
(has-primary-key? entity)
(str "\nreturning "
(s/join
",\n\t"
(map
#(safe-name % :sql)
(key-names entity))))))})))
(defn update-query
"Generate an appropriate `update` query for this `entity`"
[entity]
(let [entity-name (safe-name (:name (:attrs entity)) :sql)
pretty-name (singularise entity-name)
property-names (map #(:name (:attrs %)) (insertable-properties entity))
query-name (str "update-" pretty-name "!")
signature ":! :n"]
(hash-map
(keyword query-name)
{:name query-name
:signature signature
:entity entity
: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 (safe-name % :sql) " = " (keyword %)) property-names))
"\n"
(where-clause entity))})))
(defn search-query [entity application]
"Generate an appropriate search query for string fields of this `entity`"
(let [entity-name (safe-name (:name (:attrs entity)) :sql)
pretty-name (singularise entity-name)
query-name (str "search-strings-" entity-name)
signature ":? :*"
properties (remove #(#{"link"}(:type (:attrs %))) (all-properties entity))]
(hash-map
(keyword query-name)
{:name query-name
:signature signature
:entity entity
:type :text-search
:query
(s/join
"\n"
(remove
empty?
(list
(str "-- :name " query-name " " signature)
(str
"-- :doc selects existing "
pretty-name
" records having any string field matching the parameter of the same name by substring match")
(str "SELECT DISTINCT * FROM lv_" entity-name)
(s/join
"\n\t--~ "
(cons
"WHERE true"
(filter
string?
(map
#(let
[sn (safe-name (-> % :attrs :name) :sql)]
(str
"(if (:" (-> % :attrs :name) " params) (str \"AND "
(case (-> % :attrs :type)
("string" "text")
(str
sn
" LIKE '%\" (:" (-> % :attrs :name) " params) \"%' ")
("date" "time" "timestamp")
(str
sn
" = ':" (-> % :attrs :name) "'")
"entity"
(str
sn
"_expanded LIKE '%\" (:" (-> % :attrs :name) " params) \"%'")
(str
sn
" = :"
(-> % :attrs :name)))
"\"))"))
properties))))
(order-by-clause entity "lv_" true)
"--~ (if (:offset params) \"OFFSET :offset \")"
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")")))})))
;; (search-query e a)
(defn select-query
"Generate an appropriate `select` query for this `entity`"
([entity properties]
(if
(not (empty? properties))
(let [entity-name (safe-name (:name (:attrs entity)) :sql)
pretty-name (singularise entity-name)
query-name (if (= properties (key-properties entity))
(str "get-" pretty-name)
(str "get-" pretty-name "-by-" (s/join "=" (map #(:name (:attrs %)) properties))))
signature ":? :1"]
(hash-map
(keyword query-name)
{:name query-name
:signature signature
:entity entity
:type :select-1
:query
(s/join
"\n"
(remove
empty?
(list
(str "-- :name " query-name " " signature)
(str "-- :doc selects an existing " pretty-name " record")
(str "SELECT * FROM " entity-name)
(where-clause entity properties)
(order-by-clause entity))))}))
{}))
([entity]
(let [distinct-fields (distinct-properties entity)]
(apply
merge
(cons
(select-query entity (key-properties entity))
(map
#(select-query entity %)
(combinations distinct-fields (count distinct-fields))))))))
(defn list-query
"Generate a query to list records in the table represented by this `entity`.
Parameters `:limit` and `:offset` may be supplied. If not present limit defaults
to 100 and offset to 0."
[entity]
(let [entity-name (safe-name (:name (:attrs entity)) :sql)
pretty-name (singularise entity-name)
query-name (str "list-" entity-name)
signature ":? :*"]
(hash-map
(keyword query-name)
{:name query-name
:signature signature
:entity entity
:type :select-many
:query
(s/join
"\n"
(remove
empty?
(list
(str "-- :name " query-name " " signature)
(str "-- :doc lists all existing " pretty-name " records")
(str "SELECT DISTINCT * FROM lv_" entity-name)
(order-by-clause entity "lv_" false)
"--~ (if (:offset params) \"OFFSET :offset \")"
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")")))})))
(defn foreign-queries
[entity application]
(let [entity-name (:name (:attrs entity))
pretty-name (singularise entity-name)
links (filter #(#{"link" "entity"} (:type (:attrs %))) (children-with-tag entity :property))]
(apply
merge
(map
#(let [far-name (:entity (:attrs %))
far-entity (first
(children
application
(fn [x]
(and
(= (:tag x) :entity)
(= (:name (:attrs x)) far-name)))))
pretty-far (singularise far-name)
farkey (-> % :attrs :farkey)
link-type (-> % :attrs :type)
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
:type :select-one-to-many
:far-entity far-entity
:query
(s/join
"\n"
(remove
empty?
(case link-type
"entity" (list
(str "-- :name " query-name " " signature)
(str "-- :doc lists all existing " pretty-name " records related to a given " pretty-far)
(str "SELECT * \nFROM lv_" entity-name ", " entity-name)
(str "WHERE lv_" entity-name "." (first (key-names entity)) " = "
entity-name "." (first (key-names entity))
"\n\tAND " entity-name "." link-field " = :id")
(order-by-clause entity "lv_" false))
"link" (let [link-table-name
(link-table-name % entity far-entity)]
(list
(str "-- :name " query-name " " signature)
(str "-- :doc links all existing " pretty-name " records related to a given " pretty-far)
(str "SELECT * \nFROM " entity-name ", " link-table-name)
(str "WHERE " entity-name "."
(first (key-names entity))
" = " link-table-name "." (singularise entity-name) "_id")
(str "\tAND " link-table-name "." (singularise far-name) "_id = :id")
(order-by-clause entity)))
(list (str "ERROR: unexpected type " link-type " of property " %)))))
}))
links))))
(defn delete-query [entity]
"Generate an appropriate `delete` query for this `entity`"
(if
(has-primary-key? entity)
(let [entity-name (:name (:attrs entity))
pretty-name (singularise entity-name)
query-name (str "delete-" pretty-name "!")
signature ":! :n"]
(hash-map
(keyword query-name)
{:name query-name
:signature signature
:entity entity
: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))}))))
(defn queries
"Generate all standard queries for this `entity` in this `application`; if
no entity is specified, generate all queries for the application."
([application entity]
(merge
;; TODO: queries that look through link tables
(insert-query entity)
(update-query entity)
(delete-query entity)
(select-query entity)
(list-query entity)
(search-query entity application)
(foreign-queries entity application)))
([application]
(apply
merge
(map #(queries application %)
(children-with-tag application :entity)))))
(defn to-hugsql-queries
"Generate all [HugSQL](https://www.hugsql.org/) queries implied by this ADL `application` spec."
[application]
(let [filepath (str *output-path* "resources/sql/queries.auto.sql")]
(make-parents filepath)
(try
(spit
filepath
(s/join
"\n\n"
(cons
(emit-header
"--"
"File queries.sql"
(str "autogenerated by adl.to-hugsql-queries at " (t/now))
"See [Application Description Language](https://github.com/simon-brooke/adl).")
(map
#(:query %)
(sort
#(compare (:name %1) (:name %2))
(vals
(queries application)))))))
(if (> *verbosity* 0)
(println (str "\tGenerated " filepath)))
(catch
Exception any
(println
(str
"ERROR: Exception "
(.getName (.getClass any))
(.getMessage any)
" while printing "
filepath))))))

288
src/adl/to_json_routes.clj Normal file
View file

@ -0,0 +1,288 @@
(ns ^{:doc "Application Description Language: generate RING routes for REST requests."
:author "Simon Brooke"}
adl.to-json-routes
(:require [adl-support.utils :refer :all]
[adl.to-hugsql-queries :refer [queries]]
[clj-time.core :as t]
[clj-time.format :as f]
[clojure.java.io :refer [file make-parents writer]]
[clojure.pprint :refer [pprint]]
[clojure.string :as s]
[clojure.xml :as x]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; adl.to-json-routes: generate RING routes for REST requests.
;;;;
;;;; 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
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The overall structure of this has quite closely to follow the structure of
;;; to-hugsql-queries, because essentially we need one JSON entry point to wrap
;;; each query.
;;; TODO: memoisation of handlers probably doesn't make sense, because every request
;;; will be different. I don't think we can memoise HugSQL, at least not without
;;; hacking the library (might be worth doing that and contributing a patch).
;;; So the solution may be to an intervening namespace 'cache', which has one
;;; memoised function for each hugsql query.
(defn file-header [application]
(list
'ns
(symbol (str (safe-name (:name (:attrs application))) ".routes.auto-json"))
(str "JSON routes for " (:name (:attrs application))
" auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at "
(f/unparse (f/formatters :basic-date-time) (t/now)))
(list
:require
'[adl-support.core :as support]
'[clojure.core.memoize :as memo]
'[clojure.java.io :as io]
'[clojure.tools.logging :as log]
'[compojure.core :refer [defroutes GET POST]]
'[hugsql.core :as hugsql]
'[noir.response :as nresponse]
'[noir.util.route :as route]
'[ring.util.http-response :as response]
(vector (symbol (str (safe-name (:name (:attrs application))) ".db.core")) :as 'db))))
(defn declarations [handlers-map]
(cons 'declare (sort (map #(symbol (name %)) (keys handlers-map)))))
(defn generate-handler-body
"Generate and return the function body for the handler for this `query`."
[query]
(let [action (list
(symbol (str "db/" (:name query)))
'db/*db*
(list 'support/massage-params
'params
'form-params
(key-names (:entity query))))]
(list
[{:keys ['params 'form-params]}]
(case
(:type query)
(:delete-1 :update-1)
(list
action
`(log/debug (str ~(:name query) " called with params " ~'params "."))
'(response/found "/"))
(list
'let
(vector 'result action)
`(log/debug (~(symbol (str "db/" (:name query) "-sqlvec")) ~'params))
`(log/debug (str ~(str "'" (:name query) "' with params ") ~'params " returned " (count ~'result) " records."))
(list 'response/ok 'result))))))
(defn generate-handler-src
"Generate and return the handler for this `query`."
[handler-name query-map method doc]
(hash-map
:method method
:src (remove
nil?
(if
(or
(zero? (volatility (:entity query-map)))
(#{:delete-1 :insert-1 :update-1} (:type query-map)))
(concat
(list
'defn
handler-name
(str "Auto-generated method to " doc))
(generate-handler-body query-map))
(concat
(list
'def
handler-name
(list
'memo/ttl
(cons 'fn (generate-handler-body query-map))
:ttl/threshold
(* (volatility (:entity query-map)) 1000))))))))
(defn handler
"Generate declarations for handlers from query with this `query-key` in this `queries-map`
taken from within this `application`. This method must follow the structure of
`to-hugsql-queries/queries` quite closely, because we must generate the same names."
[query-key queries-map application]
(let [query (query-key queries-map)
handler-name (symbol (name query-key))]
(hash-map
(keyword handler-name)
(merge
{:name handler-name
:route (str "/json/" handler-name)}
(case
(:type query)
:delete-1
(generate-handler-src
handler-name query :post
(str "delete one record from the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(-> query :entity key-names)
"`."))
:insert-1
(generate-handler-src
handler-name query :post
(str "insert one record to the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(pr-str
(map
#(keyword (:name (:attrs %)))
(-> query :entity insertable-properties )))
"`. Returns a map containing the keys `"
(-> query :entity key-names)
"` identifying the record created."))
:update-1
(generate-handler-src
handler-name query :post
(str "update one record in the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(pr-str
(distinct
(sort
(map
#(keyword (:name (:attrs %)))
(flatten
(cons
(-> query :entity key-properties)
(-> query :entity insertable-properties)))))))
"`."))
:select-1
(generate-handler-src
handler-name query :get
(str "select one record from the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(-> query :entity key-names)
"`. Returns a map containing the following keys: `"
(map #(keyword (:name (:attrs %))) (-> query :entity all-properties))
"`."))
:select-many
(generate-handler-src
handler-name query :get
(str "select all records from the `"
(-> query :entity :attrs :name)
"` table. If the keys `(:limit :offset)` are present in the request then they will be used to page through the data. Returns a sequence of maps each containing the following keys: `"
(pr-str
(map
#(keyword (:name (:attrs %)))
(-> query :entity all-properties)))
"`."))
:text-search
(generate-handler-src
handler-name query :get
(str "select all records from the `"
(-> query :entity :attrs :name)
;; TODO: this doc-string is out of date
"` table with any text field matching the value of the key `:pattern` which should be in the request. If the keys `(:limit :offset)` are present in the request then they will be used to page through the data. Returns a sequence of maps each containing the following keys: `"
(pr-str
(map
#(keyword (:name (:attrs %)))
(-> query :entity all-properties)))
"`."))
(:select-many-to-many
:select-one-to-many)
(hash-map :method :get
:src (list 'defn handler-name [{:keys ['params]}]
(list 'do (list (symbol (str "db/" (:name query))) 'params))))
;; default
(hash-map
:src
(str ";; don't know what to do with query `" :key "` of type `" (:type query) "`.")))))))
(defn defroutes [handlers-map]
"Generate JSON routes for all queries implied by this ADL `application` spec."
(cons
'defroutes
(cons
'auto-rest-routes
(map
#(let [handler (handlers-map %)]
(list
(symbol (s/upper-case (name (:method handler))))
(str "/json/auto/" (safe-name (:name handler)))
'request
(list
'route/restricted
(list (:name handler) 'request))))
(sort
(keys handlers-map))))))
(defn make-handlers-map
[application]
(reduce
merge
{}
(map
(fn [e]
(let [qmap (queries application e)]
(reduce
merge
{}
(map
(fn [k]
(handler k qmap application))
(keys qmap)))))
(children-with-tag application :entity))))
(defn to-json-routes
[application]
(let [handlers-map (make-handlers-map application)
filepath (str *output-path* "src/clj/" (:name (:attrs application)) "/routes/auto_json.clj")]
(make-parents filepath)
(try
(with-open [output (writer filepath)]
(binding [*out* output]
(pprint (file-header application))
(println)
(doall
(map
(fn [h]
(pprint (:src (handlers-map h)))
(println)
h)
(sort (keys handlers-map))))
(pprint (defroutes handlers-map))))
(if (> *verbosity* 0)
(println (str "\tGenerated " filepath)))
(catch
Exception any
(println
(str
"ERROR: Exception "
(.getName (.getClass any))
(.getMessage any)
" while printing "
filepath))))))

585
src/adl/to_psql.clj Normal file
View file

@ -0,0 +1,585 @@
(ns ^{:doc "Application Description Language: generate Postgres database definition."
:author "Simon Brooke"}
adl.to-psql
(:require [clojure.java.io :refer [file make-parents writer]]
[clojure.pprint :refer [pprint]]
[clojure.string :as s]
[clojure.xml :as x]
[clj-time.core :as t]
[clj-time.format :as f]
[adl-support.utils :refer :all]
[adl.to-hugsql-queries :refer [queries]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; adl.to-psql: generate Postgres database definition.
;;;;
;;;; 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
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; this is a pretty straight translation of adl2psql.xslt, and was written because
;;; Clojure is easier to debug.
(declare emit-field-type emit-property)
(defn emit-defined-field-type
[property application]
(let [typedef (typedef property application)]
;; this is a hack based on the fact that emit-field-type doesn't check
;; that the argument passed as `property` is indeed a property.
(str (emit-field-type typedef nil application false)
(cond
(:pattern (:attrs typedef))
(str
" CONSTRAINT "
(gensym "pattern_")
" CHECK ("
(:name (:attrs property))
" ~* '"
(:pattern (:attrs typedef))
"')")
(and (:maximum (:attrs typedef))(:minimum (:attrs typedef)))
;; TODO: if base type is date, time or timestamp, values should be quoted.
(str
" CONSTRAINT "
(gensym "minmax_")
" CHECK ("
(:minimum (:attrs typedef))
" < "
(:name (:attrs property))
" AND "
(:name (:attrs property))
" < "
(:maximum (:attrs typedef))
")")
(:maximum (:attrs typedef))
(str
" CONSTRAINT "
(gensym "max_")
" CHECK ("
(:name (:attrs property))
" < "
(:maximum (:attrs typedef))
")")
(:minimum (:attrs typedef))
(str
" CONSTRAINT "
(gensym "min_")
" CHECK ("
(:minimum (:attrs typedef))
" < "
(:name (:attrs property)))))))
(defn emit-entity-field-type
[property application]
(let [farside (child
application
#(and
(entity? %)
(= (:name (:attrs %)) (:entity (:attrs property)))))
key-properties (children-with-tag
(first (children-with-tag farside :key))
:property)]
(if
(> (count key-properties) 1)
(str
"-- ERROR: cannot generate link to entity "
(:name (:attrs farside))
" with compound primary key\n")
(emit-field-type (first key-properties) farside application false))))
(defn emit-field-type
[property entity application key?]
(case (:type (:attrs property))
"integer" (if key? "SERIAL" "INTEGER")
"real" "DOUBLE PRECISION"
("string" "image" "uploadable")
(str "VARCHAR(" (:size (:attrs property)) ")")
"defined" (emit-defined-field-type property application)
"entity" (emit-entity-field-type property application)
("date" "time" "timestamp" "boolean" "text" "money")
(.toUpperCase (:type (:attrs property)))
(str "-- ERROR: unknown type " (:type (:attrs property)))))
(defn emit-link-field
[property entity application]
(emit-property
{:tag :property
:attrs {:name (str (:name (:attrs entity)) "_id")
:type "entity"
:entity (:name (:attrs entity))
:cascade (:cascade (:attrs property))}}
entity
application))
(defn emit-permissions-grant
[table-name privilege permissions]
(let [selector
(case privilege
:SELECT #{"read" "noedit" "edit" "all"}
:INSERT #{"insert" "noedit" "edit" "all"}
:UPDATE #{"edit" "all"}
(:DELETE :ALL) #{"all"})
group-names
(set
(remove
nil?
(map
#(if (selector (:permission (:attrs %)))
(safe-name (:group (:attrs %)) :sql))
permissions)))]
(if
(not (empty? group-names))
(s/join
" "
(list
"GRANT"
(name privilege)
"ON"
(safe-name table-name :sql)
"TO"
(s/join
",\n\t"
(sort group-names))
";")))))
(defn field-name
[property]
(safe-name
(or
(:column (:attrs property))
(:name (:attrs property)))
:sql))
(defn emit-property
([property entity application]
(emit-property property entity application false))
([property entity application key?]
(let [default (:default (:attrs property))]
(if
(and
(= (:tag property) :property)
(not (#{"link"} (:type (:attrs property)))))
(s/join
" "
(remove
nil?
(flatten
(list
"\t"
(field-name property)
(emit-field-type property entity application key?)
(if
default
(list
"DEFAULT"
(if
(is-quotable-type? property application)
(str "'" default "'") ;; TODO: but if the default value seems to be a function invocation, should it be quoted?
;; it's quite common for 'now()' to be the default for a date, time or timestamp field.
default)))
(if
key?
"NOT NULL PRIMARY KEY"
(if (= (:required (:attrs property)) "true") "NOT NULL"))))))))))
(defn compose-convenience-entity-field
[field entity application]
(let [farside (child
application
#(and
(entity? %)
(= (:name (:attrs %)) (:entity (:attrs field)))))]
(flatten
(map
(fn [f]
(if
(= (:type (:attrs f)) "entity")
(compose-convenience-entity-field f farside application)
(str (safe-name (:table (:attrs farside))) "." (field-name f))))
(user-distinct-properties farside)))))
(defn compose-convenience-view-select-list
[entity application top-level?]
(remove
nil?
(flatten
(cons
(safe-name (:table (:attrs entity)) :sql)
(map
(fn [f]
(if
(= (:type (:attrs f)) "entity")
(compose-convenience-view-select-list
(child application #(and (entity? %) (= (:name (:attrs %))(:entity (:attrs f)))))
application
false)))
(if
top-level?
(all-properties entity)
(user-distinct-properties entity)))))))
(defn compose-convenience-where-clause
;; TODO: does not correctly compose links at one stage down the tree.
;; See lv_electors, lv_followuprequests for examples of the problem.
[entity application top-level?]
(remove
nil?
(flatten
(map
(fn [f]
(if
(= (:type (:attrs f)) "entity")
(let [farside (entity-for-property f application)]
(cons
(str
(safe-name (:table (:attrs entity)) :sql)
"."
(field-name f)
" = "
(safe-name (:table (:attrs farside)) :sql)
"."
(safe-name (first (key-names farside)) :sql))
#(compose-convenience-where-clause farside application false)))))
(if
top-level?
(all-properties entity)
(user-distinct-properties entity))))))
(defn emit-convenience-entity-field
[field entity application]
(str
(s/join
" ||', '|| "
(compose-convenience-entity-field field entity application))
" AS "
(field-name field)
"_expanded"))
(defn emit-convenience-view
"Emit a convenience view of this `entity` of this `application` for use in generating lists,
menus, et cetera."
[entity application]
(let [view-name (safe-name (str "lv_" (:table (:attrs entity))) :sql)
entity-fields (filter
#(= (:type (:attrs %)) "entity")
(properties entity))]
(s/join
"\n"
(remove
nil?
(flatten
(list
(emit-header
"--"
(str "convenience view " view-name " of entity " (:name (:attrs entity)) " for lists, et cetera"))
(s/join
" "
(list "CREATE VIEW" view-name "AS"))
(str
"SELECT "
(s/join
",\n\t"
(flatten
(map
#(if
(= (:type (:attrs %)) "entity")
(list
(emit-convenience-entity-field % entity application)
(str (safe-name entity) "." (field-name %)))
(str (safe-name entity) "." (field-name %)))
(filter
#(not (= (:type (:attrs %)) "link"))
(all-properties entity) )))))
(str
"FROM " (s/join ", " (set (compose-convenience-view-select-list entity application true))))
(if
(not (empty? entity-fields))
(str
"WHERE "
(s/join
"\n\tAND "
(map
(fn [f]
(let
[farside (child
application
#(and
(entity? %)
(= (:name (:attrs %)) (:entity (:attrs f)))))]
(str
(safe-name (:table (:attrs entity)) :sql)
"."
(field-name f)
" = "
(safe-name (:table (:attrs farside)) :sql)
"."
(safe-name (first (key-names farside)) :sql))))
entity-fields))))
";"
(emit-permissions-grant view-name :SELECT (find-permissions entity application))))))))
(defn emit-referential-integrity-link
[property nearside application]
(let
[farside (entity-for-property property application)]
(s/join
" "
(list
"ALTER TABLE"
(safe-name (:name (:attrs nearside)) :sql)
"ADD CONSTRAINT"
(safe-name (str "ri_" (:name (:attrs nearside)) "_" (:name (:attrs farside)) "_" (:name (:attrs property))) :sql)
"\n\tFOREIGN KEY("
(field-name property)
") \n\tREFERENCES"
(str
(safe-name (:table (:attrs farside)) :sql)
"(" (field-name (first (key-properties farside))) ")")
;; TODO: ought to handle the `cascade` attribute, even though it's rarely used
"\n\tON DELETE"
(case
(:cascade (:attrs property))
"orphan" "SET NULL"
"delete" "CASCADE"
"NO ACTION")
";"))))
(defn emit-referential-integrity-links
([entity application]
(map
#(emit-referential-integrity-link % entity application)
(sort-by-name
(filter
#(= (:type (:attrs %)) "entity")
(properties entity)))))
([application]
(flatten
(list
(emit-header
"--"
"referential integrity links for primary tables")
(map
#(emit-referential-integrity-links % application)
(sort-by-name (children-with-tag application :entity)))))))
(defn emit-table
([entity application doc-comment]
(let [table-name (safe-name (:table (:attrs entity)) :sql)
permissions (children-with-tag entity :permission)]
(s/join
"\n"
(flatten
(list
(emit-header
"--"
(list
doc-comment
(map
#(:content %)
(children-with-tag entity :documentation))))
(s/join
" "
(list "CREATE TABLE" table-name))
"("
(str
(s/join
",\n"
(flatten
(remove
nil?
(list
(map
#(emit-property % entity application true)
(children-with-tag (child-with-tag entity :key) :property))
(map
#(emit-property % entity application false)
(filter
#(not (= (:type (:attrs %)) "link"))
(children-with-tag entity :property)))))))
"\n);")
(map
#(emit-permissions-grant table-name % permissions)
'(:SELECT :INSERT :UPDATE :DELETE)))))))
([entity application]
(emit-table
entity
application
(str
"primary table "
(:table (:attrs entity))
" for entity "
(:name (:attrs entity))))))
(defn construct-link-property
[entity]
{:tag :property
:attrs {:name (safe-name (str (singularise (:name (:attrs entity))) "_id") :sql)
:column (safe-name (str (singularise (:name (:attrs entity))) "_id") :sql)
:type "entity"
:entity (:name (:attrs entity))
:farkey (safe-name (first (key-names entity)) :sql)}})
(defn emit-link-table
[property e1 application emitted-link-tables]
(let [e2 (child
application
#(and
(entity? %)
(= (:name (:attrs %)) (:entity (:attrs property)))))
link-table-name (link-table-name property e1 e2)]
(if
;; we haven't already emitted this one...
(not (@emitted-link-tables link-table-name))
(let [permissions (flatten
(list
(children-with-tag e1 :permission)
(children-with-tag e1 :permission)))
;; construct a dummy entity
link-entity {:tag :entity
:attrs {:name link-table-name
:table link-table-name}
:content
(apply vector
(flatten
(list
[(construct-link-property e1)
(construct-link-property e2)]
permissions)))}]
;; mark it as emitted
(swap! emitted-link-tables conj link-table-name)
;; emit it
(flatten
(list
(emit-table
link-entity
application
(str
"link table joining "
(:name (:attrs e1))
" with "
(:name (:attrs e2))))
;; and immediately emit its referential integrity links
(emit-referential-integrity-links link-entity application)))))))
(defn emit-link-tables
([entity application emitted-link-tables]
(map
#(emit-link-table % entity application emitted-link-tables)
(sort-by-name
(filter
#(= (:type (:attrs %)) "link")
(properties entity)))))
([application emitted-link-tables]
(map
#(emit-link-tables % application emitted-link-tables)
(sort-by-name (children-with-tag application :entity)))))
(defn emit-group-declaration
[group application]
(list
(emit-header
"--"
(str "security group " (:name (:attrs group))))
(str "CREATE GROUP " (safe-name (:name (:attrs group)) :sql) ";")))
(defn emit-file-header
[application]
(emit-header
"--"
"Database definition for application "
(str (:name (:attrs application))
" version "
(:version (:attrs application)))
"auto-generated by [Application Description Language framework]"
(str "(https://github.com/simon-brooke/adl) at "
(f/unparse (f/formatters :basic-date-time) (t/now)))
(map
#(:content %)
(children-with-tag application :documentation))))
(defn emit-application
[application]
(let [emitted-link-tables (atom #{})]
(s/join
"\n\n"
(flatten
(list
(emit-file-header application)
(map
#(emit-group-declaration % application)
(sort-by-name
(children-with-tag application :group)))
(map
#(emit-table % application)
(sort-by-name
(children-with-tag application :entity)))
(map
#(emit-convenience-view % application)
(sort-by-name
(children-with-tag application :entity)))
(emit-referential-integrity-links application)
(emit-link-tables application emitted-link-tables))))))
(defn to-psql
[application]
(let [filepath (str
*output-path*
"resources/sql/"
(:name (:attrs application))
".postgres.sql")]
(make-parents filepath)
(try
(spit filepath (emit-application application))
(if (> *verbosity* 0)
(println (str "\tGenerated " filepath)))
(catch
Exception any
(println
(str
"ERROR: Exception "
(.getName (.getClass any))
(.getMessage any)
" while printing "
filepath))))))

90
src/adl/to_reframe.clj Normal file
View file

@ -0,0 +1,90 @@
(ns adl.to-reframe
(:require [adl-support.utils :refer :all]
[clojure.string :as s]
[clj-time.core :as t]
[clj-time.format :as f]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; adl.to-hugsql-queries: generate re-frame/re-com views.
;;;;
;;;; 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
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; TODO: not anywhere near finished.
(defn file-header
([parent-name this-name extra-requires]
(list 'ns (symbol (str parent-name ".views." this-name))
(str "Re-frame views for " parent-name
" auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at "
(f/unparse (f/formatters :basic-date-time) (t/now)))
(concat
(list :require
'[re-frame.core :refer [reg-sub subscribe dispatch]])
extra-requires)))
([parent-name this-name]
(file-header parent-name this-name '())))
(defn generate-form
"Generate as re-frame this `form` taken from this `entity` of this `document`."
[form entity application]
(let [record @(subscribe [:record])
errors @(subscribe [:errors])
messages @(subscribe [:messages])
properties (required-properties entity form)]
(list
'defn
(symbol
(s/join
"-"
(:name (:attrs entity))
(:name (:attrs form))
"-form-panel"))
[]
(apply
vector
(remove
nil?
(list
:div
(or
(:top (:content form))
(:top (:content application)))
(map #(list 'ui/error-panel %) errors)
(map #(list 'ui/message-panel %) messages)
[:h1 (:name (:attrs form))]
[:div.container {:id "main-container"}
(apply
vector
(list
:div
{}
(map
#(generate-widget % form entity)
properties)))]
(or
(:foot (:content form))
(:foot (:content application))))))
)))

408
src/adl/to_selmer_routes.clj Normal file
View file

@ -0,0 +1,408 @@
(ns ^{:doc "Application Description Language: generate routes for user interface requests."
:author "Simon Brooke"}
adl.to-selmer-routes
(:require [adl-support.utils :refer :all]
[clj-time.core :as t]
[clj-time.format :as f]
[clojure.java.io :refer [file make-parents writer]]
[clojure.pprint :refer [pprint]]
[clojure.string :as s]
[clojure.xml :as x]
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; adl.to-selmer-routes: generate routes for user interface requests.
;;;;
;;;; 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
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Generally. there's one route in the generated file for each Selmer
;;; template which has been generated.
;;; TODO: there must be some more idiomatic way of generating all these
;;; functions.
(defn file-header
[application]
(list
'ns
(symbol (str (:name (:attrs application)) ".routes.auto"))
(str "User interface routes for " (pretty-name application)
" auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at "
(f/unparse (f/formatters :basic-date-time) (t/now)))
(list
:require
'[adl-support.core :as support]
'[clojure.java.io :as io]
'[clojure.set :refer [subset?]]
'[clojure.tools.logging :as log]
'[clojure.walk :refer [keywordize-keys]]
'[compojure.core :refer [defroutes GET POST]]
'[hugsql.core :as hugsql]
'[noir.response :as nresponse]
'[noir.util.route :as route]
'[ring.util.http-response :as response]
(vector (symbol (str (:name (:attrs application)) ".layout")) :as 'l)
(vector (symbol (str (:name (:attrs application)) ".db.core")) :as 'db)
(vector (symbol (str (:name (:attrs application)) ".routes.manual")) :as 'm))))
(defn make-form-handler-content
[f e a n]
(let [warning (list 'str (str "Error while fetching " (singularise (:name (:attrs e))) " record ") 'params)]
;; TODO: as yet makes no attempt to save the record
(list 'let
(vector
'record (list
'support/do-or-log-error
;;(list 'if (list 'subset? (key-names e) (list 'set (list 'keys 'params)))
(list
(symbol
(str "db/get-" (singularise (:name (:attrs e)))))
(symbol "db/*db*")
'params)
;;)
:message warning
:error-return {:warnings [warning]}))
(reduce
merge
{:error (list :warnings 'record)
:record (list 'dissoc 'record :warnings)}
(map
(fn [property]
(hash-map
(keyword (-> property :attrs :name))
(list
'flatten
(list
'remove
'nil?
(list
'list
;; Get the current value of the property, if it's an entity
(if (= (-> property :attrs :type) "entity")
(list 'support/do-or-log-error
(list
(symbol
(str "db/get-" (singularise (:entity (:attrs property)))))
(symbol "db/*db*")
(hash-map (keyword (-> property :attrs :farkey))
(list (keyword (-> property :attrs :name)) 'record)))
:message (str "Error while fetching "
(singularise (:entity (:attrs property)))
" record " (hash-map (keyword (-> property :attrs :farkey))
(list (keyword (-> property :attrs :name)) 'record)))))
;;; and the potential values of the property
(list 'support/do-or-log-error
(list (symbol (str "db/list-" (:entity (:attrs property)))) (symbol "db/*db*"))
:message (str "Error while fetching "
(singularise (:entity (:attrs property)))
" list")))))))
(filter #(:entity (:attrs %))
(descendants-with-tag e :property)))))))
(defn make-page-handler-content
[f e a n]
(let [warning (str "Error while fetching " (singularise (:name (:attrs e))) " record")]
(list 'let
(vector 'record (list
'support/handler-content-log-error
(list 'if (list 'subset? (list 'keys 'p) (key-names e)) []
(list
(symbol
(str "db/get-" (singularise (:name (:attrs e)))))
(symbol "db/*db*")
'params))
:message warning
:error-return {:warnings [warning]}))
{:warnings (list :warnings 'record)
:record (list 'assoc 'record :warnings nil)})))
(defn make-list-handler-content
[f e a n]
(list
'let
(vector
'records
(list
'if
(list
'some
(set (map #(keyword (-> % :attrs :name)) (all-properties e)))
(list 'keys 'params))
(list 'do
(list (symbol "log/debug") (list (symbol (str "db/search-strings-" (:name (:attrs e)) "-sqlvec")) 'params))
(list
'support/do-or-log-error
(list
(symbol (str "db/search-strings-" (:name (:attrs e))))
(symbol "db/*db*")
'params)
:message (str
"Error while searching "
(singularise (:name (:attrs e)))
" records")
:error-return {:warnings [(str
"Error while searching "
(singularise (:name (:attrs e)))
" records")]}))
(list 'do
(list (symbol "log/debug") (list (symbol (str "db/list-" (:name (:attrs e)) "-sqlvec")) 'params))
(list
'support/do-or-log-error
(list
(symbol
(str
"db/list-"
(:name (:attrs e))))
(symbol "db/*db*") {})
:message (str
"Error while fetching "
(singularise (:name (:attrs e)))
" records")
:error-return {:warnings [(str
"Error while fetching "
(singularise (:name (:attrs e)))
" records")]}))))
(list 'if
(list :warnings 'records)
'records
{:records 'records})))
(defn make-handler
[f e a]
(let [n (path-part f e a)]
(list
'defn
(symbol n)
(vector 'request)
(list 'let (vector
'params
(list 'support/massage-params
(list 'keywordize-keys (list :params 'request))
(list 'keywordize-keys (list :form-params 'request))
(key-names e true)))
;; TODO: we must take key params out of just params,
;; but we should take all other params out of form-params - because we need the key to
;; load the form in the first place, but just accepting values of other params would
;; allow spoofing.
(list
'l/render
(list 'support/resolve-template (str n ".html"))
(list :session 'request)
(list 'merge
{:title (capitalise (:name (:attrs f)))
:params 'params}
(case (:tag f)
:form (make-form-handler-content f e a n)
:page (make-page-handler-content f e a n)
:list (make-list-handler-content f e a n))))))))
;; (:form :page)
;; (list
;; 'reduce
;; 'merge
;; (list 'merge
;; (list 'cond (list :save-button 'p)
;; (list 'try
;; (list 'if
;; (list 'some (key-names e) (list 'map 'name (list 'keys 'p)))
;; (list 'do
;; (list (symbol
;; (str "db/update-" (singularise (-> e :attrs :name)) "!"))
;; 'db/*db*
;; 'p)
;; {:message "Updated record"})
;; (list 'do
;; (list (symbol
;; (str "db/create-" (singularise (-> e :attrs :name)) "!"))
;; 'db/*db*
;; 'p)
;; {:message "Saved record"}))
;; `(catch Exception any#
;; {:error (.getMessage any#)})))
;; {:record
;; (list 'if (list 'empty? (list 'remove 'nil? (list 'vals 'p))) []
;; (list
;; (symbol
;; (str "db/get-" (singularise (:name (:attrs e)))))
;; (symbol "db/*db*")
;; 'p))})
;; (cons 'list
;; (map
;; (fn [p]
;; (hash-map
;; (keyword (-> p :attrs :entity))
;; (list (symbol (str "db/list-" (:entity (:attrs p)))) (symbol "db/*db*"))))
;; (filter #(#{"entity" "link"} (:type (:attrs %)))
;; (descendants-with-tag e :property)))))
;; :list
;; {:records
;; (list
;; 'if
;; (list
;; 'not
;; (list
;; 'empty?
;; (list 'remove 'nil? (list 'vals 'p))))
;; (list
;; (symbol
;; (str
;; "db/search-strings-"
;; (:name (:attrs e))))
;; (symbol "db/*db*")
;; 'p)
;; (list
;; (symbol
;; (str
;; "db/list-"
;; (:name (:attrs e))))
;; (symbol "db/*db*") {}))})))))))
;; (def a (x/parse "../youyesyet/youyesyet.canonical.adl.xml"))
;; (def e (child-with-tag a :entity))
;; (def f (child-with-tag e :form))
;; (def n (path-part f e a))
;; (make-handler f e a)
;; (vector
;; 'p
;; (list 'merge
;; {:offset 0 :limit 25}
;; (list 'support/massage-params (list :params 'r))))
;; (make-handler f e a)
(defn make-route
"Make a route for method `m` to request the resource with name `n`."
[m n]
(list
m
(str "/" n)
'request
(list
'route/restricted
(list
'apply
(list 'resolve-handler n)
(list 'list 'request)))))
(defn make-defroutes
[application]
(let [routes (flatten
(map
(fn [e]
(map
(fn [c]
(path-part c e application))
(filter (fn [c] (#{:form :list :page} (:tag c))) (children e))))
(children-with-tag application :entity)))]
(cons
'defroutes
(cons
'auto-selmer-routes
(cons
'(GET
"/admin"
request
(route/restricted
(apply (resolve-handler "index") (list request))))
(interleave
(map
(fn [r] (make-route 'GET r))
(sort routes))
(map
(fn [r] (make-route 'POST r))
(sort routes))))))))
(defn generate-handler-resolver
"Dodgy, dodgy, dodgy. Generate code which will look up functions in the
manual and in this namespace. I'm sure someone who really knew what they
were doing could write this more elegantly."
[application]
(list
'defn
'raw-resolve-handler
"Prefer the manually-written version of the handler with name `n`, if it exists, to the automatically generated one"
(vector 'n)
(list 'try
(list 'eval (list 'symbol (list 'str (:name (:attrs application)) ".routes.manual/" 'n)))
(list 'catch
'Exception '_
(list 'eval
(list 'symbol
(list 'str (:name (:attrs application)) ".routes.auto/" 'n)))))))
(defn make-handlers
[e application]
(doall
(map
(fn [c]
(pprint (make-handler c e application))
(println))
(filter (fn [c] (#{:form :list :page} (:tag c))) (children e)))))
(defn to-selmer-routes
[application]
(let [filepath (str *output-path* "src/clj/" (:name (:attrs application)) "/routes/auto.clj")]
(make-parents filepath)
(try
(with-open [output (writer filepath)]
(binding [*out* output]
(pprint (file-header application))
(println)
(pprint '(defn index
[r]
(l/render
(support/resolve-template
"application-index.html")
(:session r)
{:title "Administrative menu"})))
(println)
(doall
(map
#(make-handlers % application)
(sort
#(compare (:name (:attrs %1))(:name (:attrs %2)))
(children-with-tag application :entity))))
(pprint
(generate-handler-resolver application))
(println)
(pprint '(def resolve-handler
(memoize raw-resolve-handler)))
(println)
(pprint (make-defroutes application))
(println)))
(if (> *verbosity* 0)
(println (str "\tGenerated " filepath)))
(catch
Exception any
(println
(str
"ERROR: Exception "
(.getName (.getClass any))
(.getMessage any)
" while printing "
filepath))))))

975
src/adl/to_selmer_templates.clj Normal file
View file

@ -0,0 +1,975 @@
(ns ^{:doc "Application Description Language - generate Selmer templates for the HTML pages implied by an ADL file."
:author "Simon Brooke"}
adl.to-selmer-templates
(:require [adl.to-hugsql-queries :refer [expanded-token]]
[adl-support.utils :refer :all]
[clojure.java.io :refer [file make-parents]]
[clojure.pprint :as p]
[clojure.string :as s]
[clojure.xml :as x]
[clj-time.core :as t]
[clj-time.format :as f]
[hiccup.core :as h]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; adl.to-selmer-templates. Generate Web 1.0 style user interface.
;;;;
;;;; 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
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn big-link
[content url]
{:tag :div
:attrs {:class "big-link-container"}
:content
[{:tag :a :attrs {:href (str "{{servlet-context}}/" url) :class "big-link"}
:content (if
(vector? content)
content
[content])}]})
(defn back-link
[content url]
{:tag :div
:attrs {:class "back-link-container"}
:content
[{:tag :a :attrs {:href (str "{{servlet-context}}/" url)}
:content (if
(vector? content)
content
[content])}]})
(defn emit-content
([content]
(try
(cond
(nil? content)
nil
(string? content)
content
(and (map? content) (:tag content))
(with-out-str
(x/emit-element content))
(seq? content)
(map emit-content (remove nil? content))
true
(str "<!-- don't know what to do with '" content "' -->"))
(catch Exception any
(str
"<!-- failed while trying to emit \n'"
(with-out-str (p/pprint content))
"';\n"
(-> any .getClass .getName)
": "
(-> any .getMessage)
" -->"))))
([filename application k]
(emit-content filename nil nil application k))
([filename spec entity application k]
(let [content
(:content
(first
(or (children-with-tag spec k)
(children-with-tag entity k)
(children-with-tag
(child-with-tag application :content)
k))))]
(if
content
(flatten
(list
(str "{% block " (name k) " %}")
(doall
(map
emit-content
content))
"{% endblock %}"))))))
(defn file-header
"Generate a header for a template file with this `filename` for this `spec`
of this `entity` within this `application`."
([filename application]
(file-header filename nil nil application))
([filename spec entity application]
(s/join
"\n"
(flatten
(list
"{% extends \"base.html\" %}"
(str "<!-- File "
filename
" generated "
(t/now)
" by adl.to-selmer-templates.\n"
"See [Application Description Language](https://github.com/simon-brooke/adl)."
"-->")
(emit-content filename spec entity application :head)
(emit-content filename spec entity application :top))))))
(defn file-footer
"Generate a footer for a template file with this `filename` for this `spec`
of this `entity` within this `application`."
([filename application]
(file-footer filename nil nil application))
([filename spec entity application]
(s/join
"\n"
(flatten
(list
(emit-content filename spec entity application :foot))))))
(defn csrf-widget
"For the present, just return the standard cross site scripting protection field statement"
[]
"{% csrf-field %}")
(defn compose-if-member-of-tag
[privilege & elts]
(let
[all-permissions (distinct (apply find-permissions elts))
permissions (map
s/lower-case
(case privilege
:writeable (writeable-by all-permissions)
:editable (writeable-by all-permissions true)
:readable (visible-to all-permissions)))]
(s/join
" "
(flatten
(list
"{% ifmemberof"
permissions
"%}")))))
(defn wrap-in-if-member-of
"Wrap this `content` in an if-member-of tag; if `writeable?` is true,
allow those groups by whom it is writeable, else those by whom it is
readable. `context` should be a sequence of adl elements from which
permissions may be obtained."
[content privilege & context]
[(apply compose-if-member-of-tag (cons privilege context))
content
"{% endifmemberof %}"])
(defn save-widget
"Return an appropriate 'save' widget for this `form` operating on this `entity` taken
from this `application`.
TODO: should be suppressed unless a member of a group which can insert or edit."
[form entity application]
(wrap-in-if-member-of
{:tag :p
:attrs {:class "widget action-safe"}
:content [{:tag :label
:attrs {:for "save-button" :class "action-safe"}
:content [(str "To save this " (:name (:attrs entity)) " record")]}
{:tag :input
:attrs {:id "save-button"
:name "save-button"
:class "action-safe"
:type "submit"
:value (str "Save!")}}]}
:editable
entity
application))
(defn delete-widget
"Return an appropriate 'save' widget for this `form` operating on this `entity` taken
from this `application`.
TODO: should be suppressed unless member of a group which can delete."
[form entity application]
(wrap-in-if-member-of
{:tag :p
:attrs {:class "widget action-dangerous"}
:content [{:tag :label
:attrs {:for "delete-button" :class "action-dangerous"}
:content [(str "To delete this " (:name (:attrs entity)) " record")]}
{:tag :input
:attrs {:id "delete-button"
:name "delete-button"
:class "action-dangerous"
:type "submit"
:value (str "Delete!")}}]}
:editable
entity
application))
(defn select-property
"Return the property on which we will by default do a user search on this `entity`."
[entity]
(descendant-with-tag
entity
:property
#(#{"user" "all"} (-> % :attrs :distinct))))
(defn select-field-name
[entity]
(let [p (select-property entity)]
(if
(-> p :attrs :entity)
(str (safe-name p :sql) expanded-token)
(-> p :attrs :name))))
(defn get-options
"Produce template code to get options for this `property` of this `entity` taken from
this `application`."
[property form entity application]
(let
[type (:type (:attrs property))
farname (:entity (:attrs property))
farside (first
(children
application
#(and
(= (:tag %) :entity)
(= (:name (:attrs %)) farname))))
fs-distinct (user-distinct-properties farside)
farkey (or
(:farkey (:attrs property))
(first (key-names farside))
"id")]
;; Yes, I know it looks BONKERS generating this as an HTML string. But there is a
;; reason. We don't know whether the `selected` attribute should be present or
;; absent until rendering.
[(str "{% for option in " (-> property :attrs :name)
" %}<option value='{{option."
farkey
"}}' {% ifequal record."
(-> property :attrs :name)
" option." farkey "%}selected='selected'{% endifequal %}>"
"{{option." (select-field-name farside)
"}}</option>{% endfor %}")]))
(defn widget-type
"Return an appropriate HTML5 input type for this property."
([property application]
(widget-type property application (typedef property application)))
([property application typedef]
(let [t (if
typedef
(:type (:attrs typedef))
(:type (:attrs property)))]
(if
(and (= (-> property :attrs :distinct) "system") (= (-> property :attrs :immutable) "true"))
"hidden"
(case t
("integer" "real" "money") "number"
("uploadable" "image") "file"
("entity" "link") "select"
"boolean" "checkbox"
"date" "date"
"time" "time"
"text" "text-area"
;; default
"string")))))
(defn select-widget
[property form entity application]
(let [farname (:entity (:attrs property))
farside (first (children application #(= (:name (:attrs %)) farname)))
magnitude (try (read-string (:magnitude (:attrs farside))) (catch Exception _ 7))
async? (and (number? magnitude) (> magnitude 1))
widget-name (safe-name (:name (:attrs property)) :sql)]
{:tag :select
:attrs (merge
{:id widget-name
:name widget-name}
(if
(= (:type (:attrs property)) "link")
{:multiple "multiple"}))
:content (apply vector (get-options property form entity application))}))
(defn compose-readable-or-not-authorised
[p f e a w]
(list
(compose-if-member-of-tag :readable p e a)
{:tag :span
:attrs {:id w
:name w
:class "pseudo-widget disabled"}
:content [(str "{{record." w "}}")]}
"{% else %}"
{:tag :span
:attrs {:id w
:name w
:class "pseudo-widget not-authorised"}
:content [(str "You are not permitted to view " w " of " (:name (:attrs e)))]}
"{% endifmemberof %}"))
(defn compose-widget-para
[p f e a w content]
{:tag :p
:attrs {:class "widget"}
:content (apply
vector
(flatten
(list
{:tag :label
:attrs {:for w}
:content [(prompt p f e a)]}
(str "{% if {{record." (-> p :attrs :name) "}} %}")
(compose-if-member-of-tag :editable p e a)
content
"{% else %}"
(compose-readable-or-not-authorised p f e a w)
"{% endifmemberof %}"
"{% else %}"
(compose-if-member-of-tag :writeable p e a)
content
"{% else %}"
(compose-readable-or-not-authorised p f e a w)
"{% endifmemberof %}"
"{% endif %}")))})
(defn widget
"Generate a widget for this `field-or-property` of this `form` for this `entity`
taken from within this `application`."
[field-or-property form entity application]
(let
[widget-name (safe-name
(if (= (:tag field-or-property) :property)
(:name (:attrs field-or-property))
(:property (:attrs field-or-property))) :sql)
property (case
(:tag field-or-property)
:property field-or-property
:field (property-for-field field-or-property entity)
;; default
nil)
permissions (find-permissions field-or-property property form entity application)
typedef (typedef property application)
w-type (widget-type property application typedef)
visible-to (visible-to permissions)
;; if the form isn't actually a form, no widget is writeable.
writeable-by (if (= (:tag form) :form) (writeable-by permissions))]
(if
property
(case w-type
"hidden"
{:tag :input
:attrs {:id widget-name
:name widget-name
:type "hidden"
:value (str "{{record." widget-name "}}")}}
"select"
(compose-widget-para property form entity application widget-name
(select-widget property form entity application))
"text-area"
(compose-widget-para
property form entity application widget-name
{:tag :textarea
:attrs {:rows "8" :cols "60" :id widget-name :name widget-name}
:content [(str "{{record." widget-name "}}")]})
;; all others
(compose-widget-para
property form entity application widget-name
{:tag :input
:attrs (merge
{:id widget-name
:name widget-name
:type w-type
:value (str "{{record." widget-name "}}")
:maxlength (:size (:attrs property))
:size (cond
(nil? (:size (:attrs property)))
"16"
(try
(> (read-string
(:size (:attrs property))) 60)
(catch Exception _ false))
"60"
true
(:size (:attrs property)))}
(if
(:minimum (:attrs typedef))
{:min (:minimum (:attrs typedef))})
(if
(:maximum (:attrs typedef))
{:max (:maximum (:attrs typedef))}))})))))
(defn embed-script-fragment
"Return the content of the file at `filepath`, with these `substitutions`
made into it in order. Substitutions should be pairss [`pattern` `value`],
where `pattern` is a string, a char, or a regular expression."
([filepath substitutions]
(let [v (slurp filepath)]
(reduce
(fn [s [pattern value]]
(if (and pattern value)
(s/replace s pattern value)
s))
v
substitutions)))
([filepath]
(embed-script-fragment filepath [])))
(defn edit-link
[entity application parameters]
(str
"{{servlet-context}}/"
(editor-name entity application)
"?"
(s/join
"&amp;"
(map
#(str %1 "={{ record." %2 " }}")
(key-names entity)
parameters))))
(defn list-tbody
"Return a table body element for the list view for this `list-spec` of this `entity` within
this `application`, using data from this source."
[source list-spec entity application]
{:tag :tbody
:content
[(str "{% for record in " source " %}")
{:tag :tr
:content
(apply
vector
(concat
(map
(fn [field]
{:tag :td :content
(let
[p (first (filter #(= (:name (:attrs %)) (:property (:attrs field))) (all-properties entity)))
s (safe-name (:name (:attrs p)) :sql)
e (first
(filter
#(= (:name (:attrs %)) (:entity (:attrs p)))
(children-with-tag application :entity)))
c (str "{{ record." s " }}")]
(if
(= (:type (:attrs p)) "entity")
[{:tag :a
:attrs {:href (edit-link e application (list (:name (:attrs p))))}
:content [(str "{{ record." s "_expanded }}")]}]
[c]))})
(children-with-tag list-spec :field))
[{:tag :td
:content
[{:tag :a
:attrs
{:href (edit-link entity application (key-names entity))}
:content ["View"]}]}]))}
"{% endfor %}"]})
(defn compose-form-auxlist
[auxlist form entity application]
(let [property (child-with-tag
entity
:property
#(= (-> % :attrs :name) (-> auxlist :attrs :property)))
farside (child-with-tag
application
:entity
#(= (-> % :attrs :name)(-> property :attrs :entity)))]
(if
(and property farside)
{:tag :div
:attrs {:class "auxlist"}
:content
[{:tag :h2
:content [(prompt auxlist form entity application)]}
{:tag :table
:content
[{:tag :thead
:content
[{:tag :tr
:content
(apply
vector
(flatten
(list
(map
#(hash-map
:tag :th
:content [(prompt % form entity application)])
(children-with-tag auxlist :field))
{:tag :th :content ["&nbsp;"]})))}]}
(list-tbody (-> property :attrs :name) auxlist farside application)]}]})))
(defn compose-form-auxlists
[form entity application]
(remove
nil?
(map
#(compose-form-auxlist % form entity application)
(children-with-tag form :auxlist))))
(defn compose-form-content
[form entity application]
{:content
{:tag :div
:attrs {:id "content" :class "edit"}
:content
(apply
vector
(cons
{:tag :form
:attrs {:action (str "{{servlet-context}}/" (editor-name entity application))
:method "POST"}
:content (apply
vector
(remove
nil?
(flatten
(list
(csrf-widget)
(map
#(widget % form entity application)
(children-with-tag (child-with-tag entity :key) :property))
(map
#(widget % form entity application)
(remove
#(let
[property (filter
(fn [p] (= (:name (:attrs p)) (:property (:attrs %))))
(descendants-with-tag entity :property))]
(= (:distict (:attrs property)) :system))
(children-with-tag form :field)))
(save-widget form entity application)
(delete-widget form entity application)))))}
(compose-form-auxlists form entity application)))}})
(defn compose-form-extra-head
[form entity application]
{:extra-head
(apply
str
(remove
nil?
(list
(if
(child-with-tag
form
:field
#(= "text-area" (widget-type (property-for-field % entity) application)))
"
{% script \"/js/lib/node_modules/simplemde/dist/simplemde.min.js\" %}
{% style \"/js/lib/node_modules/simplemde/dist/simplemde.min.css\" %}")
(if
(child-with-tag
form
:field
#(= "select" (widget-type (property-for-field % entity) application)))
"
{% script \"/js/lib/node_modules/selectize/dist/js/standalone/selectize.min.js\" %}
{% style \"/js/lib/node_modules/selectize/dist/css/selectize.css\" %}"))))})
(defn compose-form-extra-tail
[form entity application]
{:extra-tail
{:tag :script :attrs {:type "text/javascript"}
:content
(apply
vector
(remove
nil?
(flatten
(list
(map
(fn [field]
(let
[property (child-with-tag entity :property #(=
(-> field :attrs :property)
(-> % :attrs :name)))
farname (:entity (:attrs property))
farside (first (children application #(= (:name (:attrs %)) farname)))
magnitude (try (read-string (:magnitude (:attrs farside))) (catch Exception _ 7))]
(if
(> magnitude 2)
(embed-script-fragment
"resources/js/selectize-one.js"
[["{{widget_id}}" (-> property :attrs :name)]
["{{widget_value}}" (str "{{record." (-> property :attrs :name) "}}")]
["{{entity}}" farname]
["{{field}}" (select-field-name farside)]
["{{key}}" (first (key-names farside))]]))))
(children-with-tag
form :field
#(= "select" (widget-type (property-for-field % entity) application))))
(if
(child-with-tag
form :field
#(= "text-area" (widget-type (property-for-field % entity) application)))
(embed-script-fragment "resources/js/text-area-md-support.js"
[["{{page}}" (-> form :attrs :name)]]))))))}})
(defn form-to-template
"Generate a template as specified by this `form` element for this `entity`,
taken from this `application`. If `form` is nill, generate a default form
template for the entity."
[form entity application]
(merge
(compose-form-extra-head form entity application)
(compose-form-content form entity application)
(compose-form-extra-tail form entity application)))
(defn page-to-template
"Generate a template as specified by this `page` element for this `entity`,
taken from this `application`. If `page` is nil, generate a default page
template for the entity."
[page entity application]
;; TODO
)
(defn compose-list-search-widget
[field entity]
(let [property (first
(children
entity
(fn [p] (and (= (:tag p) :property)
(= (:name (:attrs p)) (:property (:attrs field)))))))
input-type (case (:type (:attrs property))
("integer" "real" "money") "number"
("date" "timestamp") "date"
"time" "time"
"text")
base-name (:property (:attrs field))
search-name (safe-name base-name :sql)]
(hash-map
:tag :th
:content
[{:tag :input
:attrs {:id search-name
:type input-type
:name search-name
:value (str "{{ params." search-name " }}")}}])))
(defn- list-thead
"Return a table head element for the list view for this `list-spec` of this `entity` within
this `application`."
[list-spec entity application]
{:tag :thead
:content
[{:tag :tr
:content
(conj
(apply
vector
(map
#(hash-map
:content [(prompt % list-spec entity application)]
:tag :th)
(children-with-tag list-spec :field)))
{:tag :th :content ["&nbsp;"]})}
{:tag :tr
:content
(apply
vector
(concat
(map
#(compose-list-search-widget % entity)
(children-with-tag list-spec :field))
'({:tag :th
:content
[{:tag :input
:attrs {:type "submit"
:id "search-widget"
:value "Search"}}]})))}]})
(defn list-to-template
"Generate a template as specified by this `list` element for this `entity`,
taken from this `application`. If `list` is nill, generate a default list
template for the entity."
[list-spec entity application]
(let [form-name
(str
"list-"
(:name (:attrs entity))
"-"
(:name (:attrs list-spec)))]
{:back-links
{:tag :div
:content
[{:tag :div :attrs {:class "back-link-container"}
:content
[{:tag :a :attrs {:id "prev-selector" :class "back-link"}
:content ["Previous"]}]}]}
:big-links
{:tag :div
:content
(apply
vector
(remove
nil?
(flatten
(list
{:tag :div :attrs {:class "big-link-container"}
:content
[{:tag :a :attrs {:id "next-selector" :role "button" :class "big-link"}
:content ["Next"]}]}
(wrap-in-if-member-of
(big-link (str "Add a new " (pretty-name entity)) (editor-name entity application))
:writeable
entity
application)))))}
:content
{:tag :form
:attrs {:id form-name :class "list"
:action (str "{{servlet-context}}/" form-name)
:method "POST"}
:content
[(csrf-widget)
{:tag :input :attrs {:id "offset" :name "offset" :type "hidden" :value "{{params.offset|default:0}}"}}
{:tag :input :attrs {:id "limit" :name "limit" :type "hidden" :value "{{params.limit|default:50}}"}}
{:tag :table
:attrs {:caption (:name (:attrs entity))}
:content
[(list-thead list-spec entity application)
(list-tbody "records" list-spec entity application)
]}]}
:extra-script
(str "
var form = document.getElementById('" form-name "');
var ow = document.getElementById('offset');
var lw = document.getElementById('limit');
form.addEventListener('submit', function() {
ow.value='0';
});
var prevSelector = document.getElementById('prev-selector');
if (prevSelector != null) {
prevSelector.addEventListener('click', function () {
if (parseInt(ow.value)===0) {
window.location = '{{servlet-context}}/admin';
} else {
ow.value=(parseInt(ow.value)-parseInt(lw.value));
console.log('Updated offset to ' + ow.value);
form.submit();
}
});
}
document.getElementById('next-selector').addEventListener('click', function () {
ow.value=(parseInt(ow.value)+parseInt(lw.value));
console.log('Updated offset to ' + ow.value);
form.submit();
});")}))
(defn entity-to-templates
"Generate one or more templates for editing instances of this
`entity` in this `application`"
[entity application]
(let
[forms (children-with-tag entity :form)
pages (children-with-tag entity :page)
lists (children-with-tag entity :list)]
(if
(and
(= (:tag entity) :entity) ;; it seems to be an ADL entity
(not (link-table? entity)))
(merge
(if
forms
(apply merge (map #(assoc {} (keyword (path-part % entity application))
(form-to-template % entity application))
forms))
{(keyword (str "form-" (:name (:attrs entity))))
(form-to-template nil entity application)})
(if
pages
(apply merge (map #(assoc {} (keyword (path-part % entity application))
(page-to-template % entity application))
pages))
{(keyword (str "page-" (:name (:attrs entity))))
(page-to-template nil entity application)})
(if
lists
(apply merge (map #(assoc {} (keyword (path-part % entity application))
(list-to-template % entity application))
lists))
{(keyword (str "list-" (:name (:attrs entity))))
(form-to-template nil entity application)})))))
(defn emit-entity-dt
[entity application]
(wrap-in-if-member-of
{:tag :dt
:content
[{:tag :a
:attrs {:href (str "{{servlet-context}}/" (path-part :list entity application))}
:content [(pretty-name entity)]}]}
:readable
entity
application))
(defn emit-entity-dd
[entity application]
(wrap-in-if-member-of
{:tag :dd
:content
(apply
vector
(map
(fn [d]
(hash-map
:tag :p
:content (:content d)))
(children-with-tag entity :documentation)))}
:readable
entity
application))
(defn application-to-template
[application]
(let
[first-class-entities
(sort-by
#(:name (:attrs %))
(filter
#(children-with-tag % :list)
(children-with-tag application :entity)))]
{:application-index
{:content
{:tag :dl
:attrs {:class "index"}
:content
(apply
vector
(remove
nil?
(flatten
(interleave
(map
#(emit-entity-dt % application)
first-class-entities)
(map
#(emit-entity-dd % application)
first-class-entities)))))}}}))
(defn write-template-file
[filename template application]
(let [filepath (str *output-path* "resources/templates/auto/" filename)]
(if
template
(try
(do
(spit
filepath
(s/join
"\n"
(flatten
(list
(file-header filename application)
(doall
(map
#(let [content (template %)]
(list
(str "{% block " (name %) " %}")
(emit-content content)
"{% endblock %}"))
(keys template)))
(file-footer filename application)))))
(if (> *verbosity* 0) (println "\tGenerated " filepath)))
(catch Exception any
(let [report (str
"ERROR: Exception "
(.getName (.getClass any))
(.getMessage any)
" while printing "
filepath)]
(try
(spit
filepath
(with-out-str
(println (str "<!-- " report "-->"))
(p/pprint template)))
(catch Exception _ nil))
(println report)
(throw any)))))
(str filepath)))
;; (def a (x/parse "../youyesyet/youyesyet.canonical.adl.xml"))
;; (def e (child-with-tag a :entity))
;; (def f (child-with-tag e :form))
;; (write-template-file "froboz" (form-to-template f e a) a)
;; (def t (form-to-template f e a))
;; (map type t)
;; t
(defn to-selmer-templates
"Generate all [Selmer](https://github.com/yogthos/Selmer) templates implied by this ADL `application` spec."
[application]
(let
[templates-map (reduce
merge
(application-to-template application)
(map
#(entity-to-templates % application)
(children application #(= (:tag %) :entity))))]
(doall
(map
#(if
(templates-map %)
(let [filename (str (name %) ".html")]
(try
(write-template-file filename (templates-map %) application)
(catch Exception any
(println
(str
"ERROR: Exception "
(.getName (.getClass any))
(.getMessage any)
" while writing "
filename))))))
(keys templates-map)))))

61
src/adl/to_swagger.clj Normal file
View file

@ -0,0 +1,61 @@
(ns ^{:doc "Application Description Language: generate swagger routes."
:author "Simon Brooke"}
adl.to-swagger
(:require [adl-support.utils :refer :all]
[adl.to-hugsql-queries :refer [queries]]
[clj-time.core :as t]
[clj-time.format :as f]
[clojure.java.io :refer [file make-parents writer]]
[clojure.pprint :refer [pprint]]
[clojure.string :as s]
[clojure.xml :as x]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; adl.to-swagger: generate swagger routes.
;;;;
;;;; 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
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The overall structure of this has quite closely to follow the structure of
;;; to-hugsql-queries, because essentially we need one JSON entry point to wrap
;;; each query.
(defn file-header [application]
(list
'ns
(symbol (str (safe-name (:name (:attrs application))) ".routes.auto-api"))
(str "API routes for " (:name (:attrs application))
" auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at "
(f/unparse (f/formatters :basic-date-time) (t/now)))
(list
:require
'[adl-support.core :as support]
'[clj-http.client :as client]
'[clojure.tools.logging :as log]
'[compojure.api.sweet :refer :all]
'[hugsql.core :as hugsql]
'[ring.util.http-response :refer :all]
'[noir.response :as nresponse]
'[noir.util.route :as route]
'[ring.util.http-response :as response]
'[schema.core :as s]
(vector (symbol (str (safe-name (:name (:attrs application))) ".db.core")) :as 'db))))

678
src/adl/validator.clj Normal file
View file

@ -0,0 +1,678 @@
(ns ^{:doc "Application Description Language: validator for ADL structure."
:author "Simon Brooke"}
adl.validator
(:require [adl-support.utils :refer :all]
[clojure.set :refer [union]]
[clojure.xml :refer [parse]]
[bouncer.core :as b]
[bouncer.validators :as v]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; squirrel-parse.to-adl: validate Application Description Language.
;;;;
;;;; 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
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; TODO: more work needed; I *think* this is finding spurious errors, and in any
;;; case it is failing to usefully locate the errors it is finding, so its
;;; diagnostic usefulness is small.
(defn try-validate
[o validation]
(if
(symbol? validation)
(try
(b/validate o validation)
(catch java.lang.ClassCastException c
;; The validator regularly barfs on strings, which are perfectly
;; valid content of some elements. I need a way to validate
;; elements where they're not tolerated!
(if (string? o) [nil o]))
(catch Exception e
[{:error (.getName (.getClass e))
:message (.getMessage e)
:validation validation
:context o} o]))
[(str "Error: not a symbol" validation) o]))
(defmacro disjunct-valid?
;; Yes, this is a horrible hack. I should be returning the error structure
;; not printing it. But I can't see how to make that work with `bouncer`.
;; OK, so: most of the validators will (usually) fail, and that's OK. How
;; do we identify the one which ought not to have failed?
[o & validations]
`(println
(str
(if (:tag ~o) (str "Tag: " (:tag ~o) "; "))
(if (:name (:attrs ~o)) (str "Name: " (:name (:attrs ~o)) ";"))
(if-not (or (:tag ~o) (:name (:attrs ~o))) (str "Context: " ~o))))
`(empty?
(remove :tag (remove nil? (map first (map
#(try-validate ~o '%)
~validations))))))
;; ]
;; ;; if *any* succeeded, we succeeded
;; ;; otherwise, one of these is the valid error - but which? The answer, in my case
;; ;; is that if there is any which did not fail on the :tag check, then that is the
;; ;; interesting one. But generally?
;; (try
;; (doall (map #(println (str "ERROR: " %)) suspicious))
;; (empty? suspicious)
;; (catch Exception _ (println "ERROR while trying to print errors")
;; true))))
;;; the remainder of this file is a fairly straight translation of the ADL 1.4 DTD into Clojure
(declare documentation-validations fieldgroup-validations )
(def permissions
"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
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
* `noedit`: select, insert
* `edit`: select, insert, update
* `all`: select, insert, update, delete"
#{"none", "read", "insert", "noedit", "edit", "all"})
(def cascade-actions
"actions which should be cascaded to dependent objects. All these values except
'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
* `manual`: cascading will be handled in manually managed code, code to
handle cascading should not be generated
* `save-update`: cascade save and update actions, but not delete."
#{"all", "all-delete-orphan", "delete", "manual", "save-update"})
(def defineable-data-types
"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
* `money`: money java.sql.Types.INTEGER
* `date`: date java.sql.Types.DATE
* `time`: time java.sql.Types.TIME
* `timestamp`: timestamp java.sql.Types.TIMESTAMP
* `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."
#{"string", "integer", "real", "money", "date", "time", "timestamp", "uploadable"})
(def simple-data-types
"data types which are fairly straightforward translations of JDBC data types
* `boolean`: boolean java.sql.Types.BIT or char(1) java.sql.Types.CHAR
* `text`: text or java.sql.Types.LONGVARCHAR
memo java.sql.Types.CLOB"
(union
defineable-data-types
#{"boolean" "text"}))
(def complex-data-types
"data types which are more complex than SimpleDataTypes...
* `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);
* `link` : a many to many link (via a link table);
* `defined` : a type defined by a typedef."
#{"entity", "link", "list", "defined"})
(def special-data-types
"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, or png format (experimental, not yet implemented)
* `message` : an internationalised message, having different translations for different locales"
#{"geopos", "image", "message"})
(def all-data-types (union
simple-data-types
complex-data-types
special-data-types))
(def content
"content, for things like pages (i.e. forms, lists, pages)"
#{"head", "top", "foot"})
(def field-stuff #{"field", "fieldgroup", "auxlist", "verb"})
(def page-content (union content field-stuff))
(def page-stuff (union page-content #{"permission", "pragma"}))
(def generator-actions #{"assigned", "guid", "manual", "native"})
(def sequences #{"canonical", "reverse-canonical"})
(def reference-validations
"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.
* `abbr`: The abbreviated name of the specification to which this
reference refers
* `section`: The 'anchor part' (part following a hash character) which,
when appended to the URL, will locate the exact section
referenced.
* `entity`: A reference to another entity within this ADL document
* `property`: A reference to another property within this ADL document;
if entity is also specified then of that entity, else of
the ancestor entity if any"
{:tag [v/required [#(= % :reference)]]
[:attrs :abbr] v/string
[:attrs :section] v/string
[:attrs :entity] v/string ;; and should be the name of an entity within this document
[:attrs :property] v/string ;; and should be the name of a property in that entity
:content [[v/every documentation-validations]]})
(def specification-validations
"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.
* `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."
{:tag [v/required [#(= % :specification)]]
[:attrs :url] v/string
[:attrs :name] [v/string v/required]
[:attrs :abbr] [v/string v/required]
:content [[v/every #(disjunct-valid?
documentation-validations
reference-validations)]]})
(def documentation-validations
"contains documentation on the element which immediately contains it. TODO:
should HTML markup within a documentation element be allowed? If so, are
there restrictions?"
{:tag [v/required [#(= % :documentation)]]
:content [[v/every #(disjunct-valid?
%
v/string
reference-validations)]]
})
(def content-validations
{:tag [v/required [#(= % :content)]]})
(def help-validations
"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"
{:tag [v/required [#(= % :help)]]
[:attrs :locale] [v/string v/required [v/matches #"[a-z]{2}-[A-Z]{2}"]]})
(def ifmissing-validations
"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
behaviour here.
* `locale`: the locale in which to prefer this prompt"
{:tag [v/required [#(= % :if-missing)]]
[:attrs :locale] [v/string v/required [v/matches #"[a-z]{2}-[A-Z]{2}"]]})
(def param-validations
"A parameter passed to the generator. Again, based on the Hibernate
implementation.
* `name`: the name of this parameter."
{:tag [v/required [#(= % :param)]]
[:attrs :name] [v/string v/required]})
(def permission-validations
"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."
{:tag [v/required [#(= % :permission)]]
[:attrs :group] [v/string v/required] ;; TODO: and it must be the name of a group that has already been defined.
[:attrs :permission] [v/required [v/matches permissions]]})
(def prompt-validations
"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."
{:tag [v/required [#(= % :prompt)]]
[:attrs :prompt] [v/string v/required]
[:attrs :locale] [v/string v/required [v/matches #"[a-z]{2}-[A-Z]{2}"]]})
(def option-validations
"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."
{:tag [v/required [#(= % :option)]]
[:attrs :value] [v/required]
:content [[v/every #(or
(b/valid? % documentation-validations)
(b/valid? % prompt-validations))]]})
(def pragma-validations
"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."
{:tag [v/required [#(= % :pragma)]]
[:attrs :name] [v/string v/required]
[:attrs :value] [v/string v/required]})
(def generator-validations
"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
'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
interface, or its equivalent in other languages."
{:tag [v/required [#(= % :generator)]]
[:attrs :action] [v/string v/required [v/member generator-actions]]
[:attrs :class] v/string
:content [[v/every #(disjunct-valid? %
documentation-validations
param-validations)]]})
(def in-implementation-validations
"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
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... "
{:tag [v/required [#(= % :in-implementation)]]
[:attrs :target] [v/string v/required]
[:attrs :value] [v/string v/required]
[:attrs :kind] v/string
:content [[v/every documentation-validations]]})
(def typedef-validations
"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
pattern must be a regular expression as interpreted by org.apache.regexp.RE
minimum and maximum must be of appropriate format for the datatype specified.
Validation may be done client-side and/or server-side at application layer
and/or server side at database layer.
* `name`: the name of this typedef
* `type`: the simple type on which this defined type is based; must be
present unless in-implementation children are supplied
* `size`: the data size of this defined type
* `pattern`: a regular expression which values for this type must match
* `minimum`: the minimum value for this type (if base type is scalar)
* `maximum`: the maximum value for this type (if base type is scalar)"
{:tag [v/required [#(= % :typedef)]]
[:attrs :name] [v/required v/string]
[:attrs :type] [[v/member defineable-data-types]]
[:attrs :size] [[#(if
(string? %)
(integer? (read-string %))
(integer? %))]]
[:attrs :pattern] v/string
[:attrs :minimum] [[#(if
(string? %)
(integer? (read-string %))
(integer? %))]]
[:attrs :maximum] [[#(if
(string? %)
(integer? (read-string %))
(integer? %))]]
:content [[v/every #(or
(b/valid? % documentation-validations)
(b/valid? % in-implementation-validations)
(b/valid? % help-validations))]]})
(def group-validations
"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"
{:tag [v/required [#(= % :group)]]
[:attrs :name] [v/string v/required]
[:attrs :parent] v/string
:content [[v/every documentation-validations]]})
(def property-validations
"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
magic values of this!
* `typedef`: name of the typedef to use, it type = 'defined'.
* `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
/and/ are user friendly (NOTE: not implemented).
* `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
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
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
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
entitie(s) linked on this property. Valid only if type='entity',
type='link' or type='list'.
* `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
committed to persistent store, the value which it holds before
it has been committed"
{:tag [v/required [#(= % :property)]]
[:attrs :name] [v/required v/string]
[:attrs :type] [v/required [v/member all-data-types]]
;; [:attrs :default] [] ;; it's allowed, but I don't have anything particular to say about it
[:attrs :typedef] v/string
[:attrs :distinct] [v/string [v/member #{"none", "all", "user", "system"}]]
[:attrs :entity] v/string
[:attrs :farkey] v/string
[:attrs :required] [[v/member #{"true", "false"}]]
[:attrs :immutable] [[v/member #{"true", "false"}]]
[:attrs :size] [[#(cond
(empty? %) ;; it's allowed to be missing
true
(string? %)
(integer? (read-string %))
true
(integer? %))]]
[:attrs :column] v/string
[:attrs :concrete] [[v/member #{"true", "false"}]]
[:attrs :cascade] [[v/member cascade-actions]]
;; :content [[v/every #(disjunct-valid? %
;; documentation-validations
;; generator-validations
;; permission-validations
;; option-validations
;; prompt-validations
;; help-validations
;; ifmissing-validations)]]
})
(def permission-validations
"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"
{:tag [v/required [#(= % :permission)]]
[:attrs :group] [v/required v/string] ;; and it also needs to be the name of a pre-declared group
[:attrs :permission] [[v/member permissions]]
:content [[v/every documentation-validations]]})
(def head-validations
"content to place in the head of the generated document; normally HTML."
{:tag [v/required [#(= % :head)]]})
(def top-validations
"content to place in the top of the body of the generated document;
this is any HTML block or inline level element."
{:tag [v/required [#(= % :top)]]})
(def foot-validations
"content to place in the bottom of the body of the generated document;
this is any HTML block or inline level element."
{:tag [v/required [#(= % :foot)]]})
(def field-validations
"a field in a form or page
* `property`: the property which this field displays/edits."
{:tag [v/required [#(= % :field)]]
[:attrs :property] [v/string v/required] ;; and it must also be the name of a property in the current entity
:content [[v/every #(or
(b/valid? % documentation-validations)
(b/valid? % prompt-validations)
(b/valid? % permission-validations)
(b/valid? % help-validations))]]})
(def verb-validations
"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
* `verb` what gets returned to the controller when this verb is selected
* `dangerous` true if this verb causes a destructive change."
{:tag [v/required [#(= % :verb)]]
[:attrs :verb] [v/string v/required]
[:attrs :dangerous] [[v/member #{"true", "false"}] v/required]})
(def order-validations
"an ordering or records in a list
* `property`: the property on which to order
* `sequence`: the sequence in which to order"
{:tag [v/required [#(= % :order)]]
[:attrs :property] [v/string v/required] ;; and it must also be the name of a property in the current entity
[:attrs :sequence] [[v/member sequences]]
:content [[v/every documentation-validations]]})
(def auxlist-validations
"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
when an item from the list is selected
* `canadd`: true if the user should be able to add records
to this list"
{:tag [v/required [#(= % :auxlist)]]
[:attrs :property] [v/string v/required] ;; and it must also be the name of a property of type `list` in the current entity
[:attrs :onselect] v/string
[:attrs :canadd] v/boolean
:content [[v/every #(or
(b/valid? % documentation-validations)
(b/valid? % prompt-validations)
(b/valid? % field-validations)
(b/valid? % fieldgroup-validations)
(b/valid? % auxlist-validations)
(b/valid? % verb-validations))]]})
(def fieldgroup-validations
"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."
{:tag [v/required [#(= % :fieldgroup)]]
[:attrs :name] [v/string v/required]
:content [[v/every #(or
(b/valid? % documentation-validations)
(b/valid? % prompt-validations)
(b/valid? % permission-validations)
(b/valid? % help-validations)
(b/valid? % field-validations)
(b/valid? % fieldgroup-validations)
(b/valid? % auxlist-validations)
(b/valid? % verb-validations))]]})
(def form-validations
"a form through which an entity may be added or edited"
{:tag [v/required [#(= % :form)]]
[:attrs :name] [v/required v/string]
[:attrs :properties] [v/required [v/member #{"all", "user-distinct", "listed"}]]
[:attrs :canadd] [[v/member #{"true", "false"}]]
:content [[v/every #(disjunct-valid? %
documentation-validations
head-validations
top-validations
foot-validations
field-validations
fieldgroup-validations
auxlist-validations
verb-validations
permission-validations
pragma-validations)]]})
(def page-validations
"a page on which an entity may be displayed"
{:tag [v/required [#(= % :page)]]
[:attrs :name] [v/required v/string]
[:attrs :properties] [v/required [v/member #{"all", "user-distinct", "listed"}]]
:content [[v/every #(disjunct-valid? %
documentation-validations
head-validations
top-validations
foot-validations
field-validations
fieldgroup-validations
auxlist-validations
verb-validations
permission-validations
pragma-validations)]]})
(def list-validations
"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"
{:tag [v/required [#(= % :list)]]
[:attrs :name] [v/required v/string]
[:attrs :properties] [v/required [v/member #{"all", "user-distinct", "listed"}]]
[:attrs :onselect] v/string
:content [[v/every #(disjunct-valid? %
documentation-validations
head-validations
top-validations
foot-validations
field-validations
fieldgroup-validations
auxlist-validations
verb-validations
permission-validations
pragma-validations
order-validations)]]})
(def key-validations
{:tag [v/required [#(= % :key)]]
:content [[v/every property-validations]]})
(def entity-validations
"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
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
as name of entity. Strongly recommend this is not used unless it needs
to be different from the name of the entity
* `foreign`: this entity is part of some other system; no code will be generated
for it, although code which links to it will be generated"
{:tag [v/required [#(= % :entity)]]
[:attrs :name] [v/required v/string]
[:attrs :natural-key] v/string
[:attrs :table] v/string
[:attrs :foreign] [[v/member #{"true", "false"}]]
:content [[v/every #(disjunct-valid? %
documentation-validations
prompt-validations
content-validations
key-validations
property-validations
permission-validations
form-validations
page-validations
list-validations)]]})
(def application-validations
{:tag [v/required [#(= % :application)]]
[:attrs :name] [v/required v/string]
[:attrs :version] v/string
[:attrs :revision] v/string
[:attrs :currency] v/string
:content [[v/every #(disjunct-valid? %
specification-validations
documentation-validations
content-validations
typedef-validations
group-validations
entity-validations)]]})
(defn valid-adl? [src]
(b/valid? src application-validations))
(defn validate-adl [src]
(b/validate src application-validations))
(defn validate-adl-file [filepath]
(validate-adl (parse filepath)))

246
test/adl/to_hugsql_queries_test.clj Normal file
View file

@ -0,0 +1,246 @@
(ns adl.to-hugsql-queries-test
(: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,
: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
{:distinct "user", :size "128", :type "string", :name "street"},
:content nil}
{:tag :property,
:attrs {:size "64", :type "string", :name "town"},
:content nil}
{:tag :property,
:attrs
{:distinct "user", :size "12", :type "string", :name "postcode"},
:content nil}]}]
(testing "user distinct properties should provide the default ordering"
(let [expected
"ORDER BY address.street,
address.postcode,
address.id"
actual (order-by-clause xml)]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "keys name extraction"
(let [expected '("id")
actual (key-names xml)]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "primary key test"
(let [expected true
actual (has-primary-key? xml)]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "non-key properties test"
(let [expected true
actual (has-non-key-properties? xml)]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "insert query generation"
(let [expected "-- :name create-addres! :! :n
-- :doc creates a new addres record
INSERT INTO address (street,
town,
postcode)
VALUES (':street',
':town',
':postcode')
returning id\n\n"
actual (:query (first (vals (insert-query xml))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "insert query signature"
(let [expected ":! :n"
actual (:signature (first (vals (insert-query xml))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "update query generation"
(let [expected "-- :name update-addres! :! :n
-- :doc updates an existing addres record
UPDATE address
SET street = :street,
town = :town,
postcode = :postcode
WHERE address.id = :id\n\n"
actual (:query (first (vals (update-query xml))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "update query signature"
(let [expected ":! :n"
actual (:signature (first (vals (update-query xml))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "search query generation"
(let [expected "-- :name search-strings-addres :? :1
-- :doc selects existing address records having any string field matching `:pattern` by substring match
SELECT * FROM address
WHERE street LIKE '%:pattern%'
OR town LIKE '%:pattern%'
OR postcode LIKE '%:pattern%'
ORDER BY address.street,
address.postcode,
address.id
--~ (if (:offset params) \"OFFSET :offset \")
--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
actual (:query (first (vals (search-query xml))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "search query signature"
(let [expected ":? :1"
actual (:signature (first (vals (search-query xml))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "select query generation"
(let [expected "-- :name get-addres :? :1
-- :doc selects an existing addres record
SELECT * FROM address
WHERE address.id = :id\n\n"
actual (:query (first (vals (select-query xml))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "select query signature"
(let [expected ":? :1"
actual (:signature (first (vals (select-query xml))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "list query generation"
(let [expected "-- :name list-address :? :*
-- :doc lists all existing addres records
SELECT * FROM address
ORDER BY address.street,
address.postcode,
address.id
--~ (if (:offset params) \"OFFSET :offset \")
--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
actual (:query (first (vals (list-query xml))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "list query signature"
(let [expected ":? :*"
actual (:signature (first (vals (list-query xml))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "delete query generation"
(let [expected "-- :name delete-addres! :! :n
-- :doc updates an existing addres record
DELETE FROM address
WHERE address.id = :id\n\n"
actual (:query (first (vals (delete-query xml))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "delete query signature"
(let [expected ":! :n"
actual (:signature (first (vals (delete-query xml))))]
(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 "user distinct properties should provide the default ordering"
(let [expected "ORDER BY address.street,
address.postcode,
address.id"
actual (order-by-clause xml)]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "keys name extraction"
(let [expected '("id" "postcode")
actual (key-names xml)]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "insert query generation - compound key, non system generated field in key"
(let [expected "-- :name create-addres! :! :n
-- :doc creates a new addres record
INSERT INTO address (street,
town,
postcode)
VALUES (':street',
':town',
':postcode')
returning id,
postcode\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
-- :doc updates an existing addres record
UPDATE address
SET street = :street,
town = :town
WHERE address.id = :id
AND address.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
-- :doc selects existing address records having any string field matching `:pattern` by substring match
SELECT * FROM address
WHERE street LIKE '%:pattern%'
OR town LIKE '%:pattern%'
OR postcode LIKE '%:pattern%'
ORDER BY address.street,
address.postcode,
address.id
--~ (if (:offset params) \"OFFSET :offset \")
--~ (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
-- :doc updates an existing addres record
DELETE FROM address
WHERE address.id = :id
AND address.postcode = ':postcode'\n\n"
actual (:query (first (vals (delete-query xml))))]
(is (string-equal-ignore-whitespace? actual expected))))))

10
test/adl/utils_test.clj Normal file
View file

@ -0,0 +1,10 @@
(ns adl.utils-test
(:require [clojure.string :as s]
[clojure.test :refer :all]
[adl.utils :refer :all]))
(deftest singularise-tests
(testing "Singularise"
(is (= "address" (singularise "addresses")))
(is (= "address" (singularise "address")))
(is (= "expertise" (singularise "expertise")))))

435
test/adl/validator_test.clj Normal file
View file

@ -0,0 +1,435 @@
(ns adl.validator-test
(:require [clojure.java.io :refer [writer]]
[clojure.test :refer :all]
[clojure.xml :refer [parse]]
[adl.validator :refer :all]
[bouncer.core :refer [valid?]]))
;; OK, so where we're up to: documentation breaks validation of the
;; element that contains it if the documentation is non-empty.
(deftest validator-documentation-only
(testing "validation of a bare documentation element"
(let [xml {:tag :documentation,
:content ["This is a very simple test document just to exercise validator and generators."]}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml documentation-validations))]
(is (= actual expected))))
(testing "validation of empty documentation within application element"
(let [xml {:tag
:application,
:attrs {:version "0.0.1",
:name "test1"},
:content [{:tag :documentation,
:attrs nil,
:content []}]}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml application-validations))]
(is (= actual expected))))
(testing "validation of non-empty documentation within application element"
(let [xml {:tag :application,
:attrs {:version "0.0.1",
:name "test1"},
:content [{:tag :documentation,
:attrs nil,
:content ["This is a very simple test document just to exercise validator and generators."]}]}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml application-validations))]
(is (= actual expected))))
(testing "validation of file `documentation-only.adl.xml`."
(let [xml (parse "resources/test/documentation-only.adl.xml")
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml application-validations))]
(is (= actual expected)))))
(deftest validator-content
(testing "Validation of content element (has text in PCDATA positions)"
(let [xml {:tag :content,
:attrs nil,
:content
[{:tag :head,
:attrs nil,
:content
[{:tag :h:meta,
:attrs
{:content "Application Description Language framework",
:name "generator",
:xmlns "http://www.w3.org/1999/xhtml"},
:content nil}]}
{:tag :top,
:attrs nil,
:content
[{:tag :h:h1,
:attrs {:xmlns "http://www.w3.org/1999/xhtml"},
:content ["Test 1"]}]}
{:tag :foot,
:attrs nil,
:content
[{:tag :h:p,
:attrs {:class "footer", :xmlns "http://www.w3.org/1999/xhtml"},
:content ["That's all folks!"]}]}]}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml content-validations))]
(is (= actual expected)))))
(deftest validator-head
(testing "Validation of head element"
(let [xml {:tag :head,
:attrs nil,
:content
[{:tag :h:meta,
:attrs
{:content "Application Description Language framework",
:name "generator",
:xmlns "http://www.w3.org/1999/xhtml"},
:content nil}]}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml head-validations))]
(is (= actual expected)))))
(deftest validator-top
(testing "Validation of top element (has markup in content)"
(let [xml {:tag :top,
:attrs nil,
:content
[{:tag :h:h1,
:attrs {:xmlns "http://www.w3.org/1999/xhtml"},
:content ["Test 1"]}]}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml top-validations))]
(is (= actual expected)))))
(deftest validator-foot
(testing "Validation of foot element (has text in content)"
(let [xml {:tag :foot,
:attrs nil,
:content
[{:tag :h:p,
:attrs {:class "footer", :xmlns "http://www.w3.org/1999/xhtml"},
:content ["That's all folks!"]}]}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml foot-validations))]
(is (= actual expected)))))
(deftest validator-group
(testing "Validation of group element (has documentation)"
(let [xml {:tag :group,
:attrs {:name "public"},
:content
[{:tag :documentation, :attrs nil, :content ["All users"]}]}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml group-validations))]
(is (= actual expected)))))
(deftest validator-entity
(testing "Validation of entity element"
(let [xml {:tag :entity,
:attrs {:name "person"},
:content
[{:tag :documentation, :attrs nil, :content ["A person"]}
{:tag :prompt,
:attrs {:locale "en-GB", :prompt "Person"},
:content nil}
{: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
{:required "true",
:distinct "user",
:size "32",
:type "string",
:name "name"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "Name"},
:content nil}
{:tag :prompt,
:attrs {:locale "fr-FR", :prompt "Nomme"},
:content nil}]}
{:tag :property,
:attrs
{:default "Unknown", :size "8", :type "string", :name "gender"},
:content
[{:tag :option,
:attrs {:value "Female"},
:content
[{:tag :prompt,
:attrs {:locale "fr-FR", :prompt "Femme"},
:content nil}
{:tag :prompt,
:attrs {:locale "en-GB", :prompt "Female"},
:content nil}]}
{:tag :option,
:attrs {:value "Male"},
:content
[{:tag :prompt,
:attrs {:locale "fr-FR", :prompt "Homme"},
:content nil}
{:tag :prompt,
:attrs {:locale "en-GB", :prompt "Male"},
:content nil}]}
{:tag :option,
:attrs {:value "Non-bin"},
:content
[{:tag :prompt,
:attrs {:locale "fr-FR", :prompt "Non binaire"},
:content nil}
{:tag :prompt,
:attrs {:locale "en-GB", :prompt "Non-binary"},
:content nil}]}
{:tag :option,
:attrs {:value "Unknown"},
:content
[{:tag :prompt,
:attrs {:locale "fr-FR", :prompt "Inconnu"},
:content nil}
{:tag :prompt,
:attrs {:locale "en-GB", :prompt "Unknown"},
:content nil}]}]}
{:tag :property,
:attrs {:type "integer", :name "age"},
:content nil}
{:tag :property,
:attrs {:entity "address", :type "entity", :name "address"},
:content nil}
{:tag :form,
:attrs {:properties "listed", :name "edit-person"},
:content
[{:tag :field, :attrs {:property "name"}, :content nil}
{:tag :field, :attrs {:property "gender"}, :content nil}
{:tag :field, :attrs {:property "age"}, :content nil}
{:tag :field, :attrs {:property "address"}, :content nil}
{:tag :permission,
:attrs {:permission "all", :group "admin"},
:content nil}
{:tag :permission,
:attrs {:permission "insert", :group "public"},
:content nil}]}
{:tag :page,
:attrs {:properties "all", :name "inspect-person"},
:content nil}
{:tag :list,
:attrs
{:on-select "edit-person",
:properties "all",
:name "list-people"},
:content nil}]}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml entity-validations))]
(is (= actual expected)))))
(deftest validator-prompt
(testing "Validation of prompt element"
(let [xml {:tag :prompt,
:attrs {:locale "en-GB", :prompt "Person"},
:content nil}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml prompt-validations))]
(is (= actual expected)))))
(deftest validator-key
(testing "Validation of key element"
(let [xml {: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}]}]}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml key-validations))]
(is (= actual expected)))))
(deftest validator-property
(testing "Validation of property element"
(let [xml {:tag :property,
:attrs
{:required "true",
:distinct "user",
:size "32",
:type "string",
:name "name"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "Name"},
:content nil}
{:tag :prompt,
:attrs {:locale "fr-FR", :prompt "Nomme"},
:content nil}]}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml property-validations))]
(is (= actual expected)))))
(deftest validator-property-with-options
(testing "Validation of property element with options"
(let [xml {:tag :property,
:attrs
{:default "Unknown", :size "8", :type "string", :name "gender"},
:content
[{:tag :option,
:attrs {:value "Female"},
:content
[{:tag :prompt,
:attrs {:locale "fr-FR", :prompt "Femme"},
:content nil}
{:tag :prompt,
:attrs {:locale "en-GB", :prompt "Female"},
:content nil}]}
{:tag :option,
:attrs {:value "Male"},
:content
[{:tag :prompt,
:attrs {:locale "fr-FR", :prompt "Homme"},
:content nil}
{:tag :prompt,
:attrs {:locale "en-GB", :prompt "Male"},
:content nil}]}
{:tag :option,
:attrs {:value "Non-bin"},
:content
[{:tag :prompt,
:attrs {:locale "fr-FR", :prompt "Non binaire"},
:content nil}
{:tag :prompt,
:attrs {:locale "en-GB", :prompt "Non-binary"},
:content nil}]}
{:tag :option,
:attrs {:value "Unknown"},
:content
[{:tag :prompt,
:attrs {:locale "fr-FR", :prompt "Inconnu"},
:content nil}
{:tag :prompt,
:attrs {:locale "en-GB", :prompt "Unknown"},
:content nil}]}]}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml entity-validations))]
(is (= actual expected)))))
(deftest validator-option
(testing "Validation of option element"
(let [xml {:tag :option,
:attrs {:value "Female"},
:content
[{:tag :prompt,
:attrs {:locale "fr-FR", :prompt "Femme"},
:content nil}
{:tag :prompt,
:attrs {:locale "en-GB", :prompt "Female"},
:content nil}]}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml option-validations))]
(is (= actual expected)))))
(deftest validator-form
(testing "Validation of form element"
(let [xml {:tag :form,
:attrs {:properties "listed", :name "edit-person"},
:content
[{:tag :field, :attrs {:property "name"}, :content nil}
{:tag :field, :attrs {:property "gender"}, :content nil}
{:tag :field, :attrs {:property "age"}, :content nil}
{:tag :field, :attrs {:property "address"}, :content nil}
{:tag :permission,
:attrs {:permission "all", :group "admin"},
:content nil}
{:tag :permission,
:attrs {:permission "insert", :group "public"},
:content nil}]}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml form-validations))]
(is (= actual expected)))))
(deftest validator-page
(testing "Validation of page element"
(let [xml {:tag :page,
:attrs {:properties "all", :name "inspect-person"},
:content nil}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml page-validations))]
(is (= actual expected)))))
(deftest validator-list
(testing "Validation of list element"
(let [xml {:tag :list,
:attrs
{:on-select "edit-person",
:properties "all",
:name "list-people"},
:content nil}
expected true
actual (binding [*out* (writer "/dev/null")]
(valid? xml list-validations))]
(is (= actual expected)))))
;; (deftest validator-xxx
;; (testing "Validation of xxx element"
;; (let [xml
;; expected true
;; actual (binding [*out* (writer "/dev/null")]
;; (valid? xml xxx-validations))]
;; (is (= actual expected)))))
;; (deftest validator-xxx
;; (testing "Validation of xxx element"
;; (let [xml
;; expected true
;; actual (binding [*out* (writer "/dev/null")]
;; (valid? xml xxx-validations))]
;; (is (= actual expected)))))
;; (deftest validator-xxx
;; (testing "Validation of xxx element"
;; (let [xml
;; expected true
;; actual (binding [*out* (writer "/dev/null")]
;; (valid? xml xxx-validations))]
;; (is (= actual expected)))))
(deftest validator-test-1
(testing "validation of `testl.adl.xml`."
(let [xml (parse "resources/test/test1.adl.xml")
expected true
actual (valid? xml application-validations)]
(is (= actual expected)))))

630
yyy.adl.clj Normal file
View file

@ -0,0 +1,630 @@
{:tag :application,
:attrs {:version "0.1.1", :name "youyesyet"},
:content
[{:tag :entity,
:attrs {:name "electors"},
:content
[{:tag :property,
:attrs
{:column "id", :name "id", :type "integer", :required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "id"},
:content ["\nid\n"]}]}
{:tag :property,
:attrs
{:column "name", :name "name", :type "string", :required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "name"},
:content ["\nname\n"]}]}
{:tag :property,
:attrs
{:farkey "id",
:entity "addresses",
:column "address_id",
:name "address_id",
:type "entity",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "address_id"},
:content ["\naddress_id\n"]}]}
{:tag :property,
:attrs {:column "phone", :name "phone", :type "string"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "phone"},
:content ["\nphone\n"]}]}
{:tag :property,
:attrs {:column "email", :name "email", :type "string"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "email"},
:content ["\nemail\n"]}]}]}
{:tag :entity,
:attrs {:name "addresses"},
:content
[{:tag :property,
:attrs
{:column "id", :name "id", :type "integer", :required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "id"},
:content ["\nid\n"]}]}
{:tag :property,
:attrs
{:column "address",
:name "address",
:type "string",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "address"},
:content ["\naddress\n"]}]}
{:tag :property,
:attrs {:column "postcode", :name "postcode", :type "string"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "postcode"},
:content ["\npostcode\n"]}]}
{:tag :property,
:attrs {:column "phone", :name "phone", :type "string"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "phone"},
:content ["\nphone\n"]}]}
{:tag :property,
:attrs
{:farkey "id",
:entity "districts",
:column "district_id",
:name "district_id",
:type "entity"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "district_id"},
:content ["\ndistrict_id\n"]}]}
{:tag :property,
:attrs {:column "latitude", :name "latitude", :type "real"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "latitude"},
:content ["\nlatitude\n"]}]}
{:tag :property,
:attrs {:column "longitude", :name "longitude", :type "real"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "longitude"},
:content ["\nlongitude\n"]}]}]}
{:tag :entity,
:attrs {:name "visits"},
:content
[{:tag :property,
:attrs
{:column "id", :name "id", :type "integer", :required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "id"},
:content ["\nid\n"]}]}
{:tag :property,
:attrs
{:farkey "id",
:entity "addresses",
:column "address_id",
:name "address_id",
:type "integer",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "address_id"},
:content ["\naddress_id\n"]}]}
{:tag :property,
:attrs
{:farkey "id",
:entity "canvassers",
:column "canvasser_id",
:name "canvasser_id",
:type "entity",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "canvasser_id"},
:content ["\ncanvasser_id\n"]}]}
{:tag :property,
:attrs
{:column "date",
:name "date",
:type "timestamp",
:default "",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "date"},
:content ["\ndate\n"]}]}]}
{:tag :entity,
:attrs {:name "authorities"},
:content
[{:tag :property,
:attrs
{:column "id", :name "id", :type "string", :required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "id"},
:content ["\nid\n"]}]}]}
{:tag :entity,
:attrs {:name "issues"},
:content
[{:tag :property,
:attrs
{:column "id", :name "id", :type "string", :required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "id"},
:content ["\nid\n"]}]}
{:tag :property,
:attrs {:column "url", :name "url", :type "string"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "url"},
:content ["\nurl\n"]}]}]}
{:tag :entity,
:attrs {:name "schema_migrations"},
:content
[{:tag :property,
:attrs
{:column "id", :name "id", :type "integer", :required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "id"},
:content ["\nid\n"]}]}]}
{:tag :entity,
:attrs {:name "intentions"},
:content
[{:tag :property,
:attrs
{:column "visit_id",
:name "visit_id",
:farkey "id",
:entity "visits",
:type "entity",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "visit_id"},
:content ["\nvisit_id\n"]}]}
{:tag :property,
:attrs
{:column "elector_id",
:name "elector_id",
:farkey "id",
:entity "electors",
:type "entity",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "elector_id"},
:content ["\nelector_id\n"]}]}
{:tag :property,
:attrs
{:column "option_id",
:name "option_id",
:farkey "id",
:entity "options",
:type "entity",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "option_id"},
:content ["\noption_id\n"]}]}]}
{:tag :entity,
:attrs {:name "canvassers"},
:content
[{:tag :property,
:attrs {:column "id", :name "id", :type "integer"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "id"},
:content ["\nid\n"]}]}
{:tag :property,
:attrs
{:column "username",
:name "username",
:type "string",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "username"},
:content ["\nusername\n"]}]}
{:tag :property,
:attrs
{:column "fullname",
:name "fullname",
:type "string",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "fullname"},
:content ["\nfullname\n"]}]}
{:tag :property,
:attrs
{:farkey "id",
:entity "electors",
:column "elector_id",
:name "elector_id",
:type "entity"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "elector_id"},
:content ["\nelector_id\n"]}]}
{:tag :property,
:attrs
{:farkey "id",
:entity "addresses",
:column "address_id",
:name "address_id",
:type "integer",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "address_id"},
:content ["\naddress_id\n"]}]}
{:tag :property,
:attrs {:column "phone", :name "phone", :type "string"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "phone"},
:content ["\nphone\n"]}]}
{:tag :property,
:attrs {:column "email", :name "email", :type "string"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "email"},
:content ["\nemail\n"]}]}
{:tag :property,
:attrs
{:farkey "id",
:entity "authorities",
:column "authority_id",
:name "authority_id",
:type "string",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "authority_id"},
:content ["\nauthority_id\n"]}]}
{:tag :property,
:attrs
{:column "authorised", :name "authorised", :type "boolean"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "authorised"},
:content ["\nauthorised\n"]}]}]}
{:tag :entity,
:attrs {:name "followuprequests"},
:content
[{:tag :property,
:attrs
{:column "id", :name "id", :type "integer", :required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "id"},
:content ["\nid\n"]}]}
{:tag :property,
:attrs
{:farkey "id",
:entity "electors",
:column "elector_id",
:name "elector_id",
:type "integer",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "elector_id"},
:content ["\nelector_id\n"]}]}
{:tag :property,
:attrs
{:farkey "id",
:entity "visits",
:column "visit_id",
:name "visit_id",
:type "entity",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "visit_id"},
:content ["\nvisit_id\n"]}]}
{:tag :property,
:attrs
{:farkey "id",
:entity "issues",
:column "issue_id",
:name "issue_id",
:type "string",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "issue_id"},
:content ["\nissue_id\n"]}]}
{:tag :property,
:attrs
{:farkey "id",
:entity "followupmethods",
:column "method_id",
:name "method_id",
:type "string",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "method_id"},
:content ["\nmethod_id\n"]}]}]}
{:tag :entity,
:attrs {:name "rolememberships"},
:content
[{:tag :property,
:attrs
{:column "role_id",
:name "role_id",
:farkey "id",
:entity "roles",
:type "entity",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "role_id"},
:content ["\nrole_id\n"]}]}
{:tag :property,
:attrs
{:column "canvasser_id",
:name "canvasser_id",
:farkey "id",
:entity "canvassers",
:type "entity",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "canvasser_id"},
:content ["\ncanvasser_id\n"]}]}]}
{:tag :entity,
:attrs {:name "roles"},
:content
[{:tag :property,
:attrs {:column "id", :name "id", :type "integer"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "id"},
:content ["\nid\n"]}]}
{:tag :property,
:attrs
{:column "name", :name "name", :type "string", :required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "name"},
:content ["\nname\n"]}]}]}
{:tag :entity,
:attrs {:name "teams"},
:content
[{:tag :property,
:attrs {:column "id", :name "id", :type "integer"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "id"},
:content ["\nid\n"]}]}
{:tag :property,
:attrs
{:column "name", :name "name", :type "string", :required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "name"},
:content ["\nname\n"]}]}
{:tag :property,
:attrs
{:column "district_id",
:name "district_id",
:farkey "id",
:entity "districts",
:type "entity",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "district_id"},
:content ["\ndistrict_id\n"]}]}
{:tag :property,
:attrs {:column "latitude", :name "latitude", :type "real"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "latitude"},
:content ["\nlatitude\n"]}]}
{:tag :property,
:attrs {:column "longitude", :name "longitude", :type "real"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "longitude"},
:content ["\nlongitude\n"]}]}]}
{:tag :entity,
:attrs {:name "districts"},
:content
[{:tag :property,
:attrs
{:column "id", :name "id", :type "integer", :required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "id"},
:content ["\nid\n"]}]}
{:tag :property,
:attrs
{:column "name", :name "name", :type "string", :required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "name"},
:content ["\nname\n"]}]}]}
{:tag :entity,
:attrs {:name "teamorganiserships"},
:content
[{:tag :property,
:attrs
{:column "team_id",
:name "team_id",
:farkey "id",
:entity "teams",
:type "entity",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "team_id"},
:content ["\nteam_id\n"]}]}
{:tag :property,
:attrs
{:column "canvasser_id",
:name "canvasser_id",
:farkey "id",
:entity "canvassers",
:type "entity",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "canvasser_id"},
:content ["\ncanvasser_id\n"]}]}]}
{:tag :entity,
:attrs {:name "followupactions"},
:content
[{:tag :property,
:attrs
{:column "id", :name "id", :type "integer", :required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "id"},
:content ["\nid\n"]}]}
{:tag :property,
:attrs
{:farkey "id",
:entity "followuprequests",
:column "request_id",
:name "request_id",
:type "entity",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "request_id"},
:content ["\nrequest_id\n"]}]}
{:tag :property,
:attrs
{:farkey "id",
:entity "canvassers",
:column "actor",
:name "actor",
:type "integer",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "actor"},
:content ["\nactor\n"]}]}
{:tag :property,
:attrs
{:column "date",
:name "date",
:type "timestamp",
:default "",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "date"},
:content ["\ndate\n"]}]}
{:tag :property,
:attrs {:column "notes", :name "notes", :type "text"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "notes"},
:content ["\nnotes\n"]}]}
{:tag :property,
:attrs {:column "closed", :name "closed", :type "boolean"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "closed"},
:content ["\nclosed\n"]}]}]}
{:tag :entity,
:attrs {:name "issueexpertise"},
:content
[{:tag :property,
:attrs
{:farkey "id",
:entity "canvassers",
:column "canvasser_id",
:name "canvasser_id",
:type "integer",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "canvasser_id"},
:content ["\ncanvasser_id\n"]}]}
{:tag :property,
:attrs
{:farkey "id",
:entity "issues",
:column "issue_id",
:name "issue_id",
:type "string",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "issue_id"},
:content ["\nissue_id\n"]}]}
{:tag :property,
:attrs
{:farkey "id",
:entity "followupmethods",
:column "method_id",
:name "method_id",
:type "entity",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "method_id"},
:content ["\nmethod_id\n"]}]}]}
{:tag :entity,
:attrs {:name "options"},
:content
[{:tag :property,
:attrs
{:column "id", :name "id", :type "string", :required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "id"},
:content ["\nid\n"]}]}]}
{:tag :entity,
:attrs {:name "teammemberships"},
:content
[{:tag :property,
:attrs
{:column "team_id",
:name "team_id",
:farkey "id",
:entity "teams",
:type "entity",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "team_id"},
:content ["\nteam_id\n"]}]}
{:tag :property,
:attrs
{:column "canvasser_id",
:name "canvasser_id",
:farkey "id",
:entity "canvassers",
:type "entity",
:required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "canvasser_id"},
:content ["\ncanvasser_id\n"]}]}]}
{:tag :entity,
:attrs {:name "followupmethods"},
:content
[{:tag :property,
:attrs
{:column "id", :name "id", :type "string", :required "true"},
:content
[{:tag :prompt,
:attrs {:locale "en-GB", :prompt "id"},
:content ["\nid\n"]}]}]}]}