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

Making a commit now to mark a point in development. Many tests fail

Browse source 
Failures are to do with XML elements with (legitimate) text content. My validator - specifically I think the function adl.validator/disjunct-valid? - is causing spurious validation fails. But just having a battery of unit tests is progress.
This commit is contained in:
Simon Brooke 2018-03-20 22:52:04 +00:00
parent 38bcacc376
commit 4d6bad7c2a
15 changed files with 2179 additions and 195 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

222
LICENSE
View file

@ -1,214 +1,86 @@
THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC GNU GENERAL PUBLIC LICENSE
LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM
CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.
1. DEFINITIONS Version 2, June 1991
"Contribution" means: Copyright (C) 1989, 1991 Free Software Foundation, Inc.
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
a) in the case of the initial Contributor, the initial code and Everyone is permitted to copy and distribute verbatim copies
documentation distributed under this Agreement, and of this license document, but changing it is not allowed.
Preamble
b) in the case of each subsequent Contributor: 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.
i) changes to the Program, and 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.
ii) additions to the Program; 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.
where such changes and/or additions to the Program originate from and are 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.
distributed by that particular Contributor. A Contribution 'originates' from
a Contributor if it was added to the Program by such Contributor itself or
anyone acting on such Contributor's behalf. Contributions do not include
additions to the Program which: (i) are separate modules of software
distributed in conjunction with the Program under their own license
agreement, and (ii) are not derivative works of the Program.
"Contributor" means any person or entity that distributes the Program. 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.
"Licensed Patents" mean patent claims licensable by a Contributor which are 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.
necessarily infringed by the use or sale of its Contribution alone or when
combined with the Program.
"Program" means the Contributions distributed in accordance with this 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.
Agreement.
"Recipient" means anyone who receives the Program under this Agreement, The precise terms and conditions for copying, distribution and modification follow.
including all Contributors.
2. GRANT OF RIGHTS TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
a) Subject to the terms of this Agreement, each Contributor hereby grants 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".
Recipient a non-exclusive, worldwide, royalty-free copyright license to
reproduce, prepare derivative works of, publicly display, publicly perform,
distribute and sublicense the Contribution of such Contributor, if any, and
such derivative works, in source code and object code form.
b) Subject to the terms of this Agreement, each Contributor hereby grants 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.
Recipient a non-exclusive, worldwide, royalty-free patent license under
Licensed Patents to make, use, sell, offer to sell, import and otherwise
transfer the Contribution of such Contributor, if any, in source code and
object code form. This patent license shall apply to the combination of the
Contribution and the Program if, at the time the Contribution is added by the
Contributor, such addition of the Contribution causes such combination to be
covered by the Licensed Patents. The patent license shall not apply to any
other combinations which include the Contribution. No hardware per se is
licensed hereunder.
c) Recipient understands that although each Contributor grants the licenses 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.
to its Contributions set forth herein, no assurances are provided by any
Contributor that the Program does not infringe the patent or other
intellectual property rights of any other entity. Each Contributor disclaims
any liability to Recipient for claims brought by any other entity based on
infringement of intellectual property rights or otherwise. As a condition to
exercising the rights and licenses granted hereunder, each Recipient hereby
assumes sole responsibility to secure any other intellectual property rights
needed, if any. For example, if a third party patent license is required to
allow Recipient to distribute the Program, it is Recipient's responsibility
to acquire that license before distributing the Program.
d) Each Contributor represents that to its knowledge it has sufficient 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.
copyright rights in its Contribution, if any, to grant the copyright license
set forth in this Agreement.
3. REQUIREMENTS 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 Contributor may choose to distribute the Program in object code form under a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change.
its own license agreement, provided that: 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.
a) it complies with the terms and conditions of this Agreement; and 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.
b) its license agreement: 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.
i) effectively disclaims on behalf of all Contributors all warranties and 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:
conditions, express and implied, including warranties or conditions of title
and non-infringement, and implied warranties or conditions of merchantability
and fitness for a particular purpose;
ii) effectively excludes on behalf of all Contributors all liability for 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,
damages, including direct, indirect, special, incidental and consequential 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,
damages, such as lost profits; 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.
iii) states that any provisions which differ from this Agreement are offered 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.
by that Contributor alone and not by any other party; and
iv) states that source code for the Program is available from such 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.
Contributor, and informs licensees how to obtain it in a reasonable manner on
or through a medium customarily used for software exchange.
When the Program is made available in source code form: 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.
a) it must be made available under this Agreement; and 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.
b) a copy of this Agreement must be included with each copy of the Program. 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.
Contributors may not remove or alter any copyright notices contained within 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.
the Program.
Each Contributor must identify itself as the originator of its Contribution, 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.
if any, in a manner that reasonably allows subsequent Recipients to identify
the originator of the Contribution.
4. COMMERCIAL DISTRIBUTION This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License.
Commercial distributors of software may accept certain responsibilities with 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.
respect to end users, business partners and the like. While this license is
intended to facilitate the commercial use of the Program, the Contributor who
includes the Program in a commercial product offering should do so in a
manner which does not create potential liability for other Contributors.
Therefore, if a Contributor includes the Program in a commercial product
offering, such Contributor ("Commercial Contributor") hereby agrees to defend
and indemnify every other Contributor ("Indemnified Contributor") against any
losses, damages and costs (collectively "Losses") arising from claims,
lawsuits and other legal actions brought by a third party against the
Indemnified Contributor to the extent caused by the acts or omissions of such
Commercial Contributor in connection with its distribution of the Program in
a commercial product offering. The obligations in this section do not apply
to any claims or Losses relating to any actual or alleged intellectual
property infringement. In order to qualify, an Indemnified Contributor must:
a) promptly notify the Commercial Contributor in writing of such claim, and
b) allow the Commercial Contributor to control, and cooperate with the
Commercial Contributor in, the defense and any related settlement
negotiations. The Indemnified Contributor may participate in any such claim
at its own expense.
For example, a Contributor might include the Program in a commercial product 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.
offering, Product X. That Contributor is then a Commercial Contributor. If
that Commercial Contributor then makes performance claims, or offers
warranties related to Product X, those performance claims and warranties are
such Commercial Contributor's responsibility alone. Under this section, the
Commercial Contributor would have to defend claims against the other
Contributors related to those performance claims and warranties, and if a
court requires any other Contributor to pay any damages as a result, the
Commercial Contributor must pay those damages.
5. NO WARRANTY 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.
EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 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.
AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER
EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR
CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A
PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the
appropriateness of using and distributing the Program and assumes all risks
associated with its exercise of rights under this Agreement , including but
not limited to the risks and costs of program errors, compliance with
applicable laws, damage to or loss of data, programs or equipment, and
unavailability or interruption of operations.
6. DISCLAIMER OF LIABILITY NO WARRANTY
EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 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.
CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION
LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE
EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY
OF SUCH DAMAGES.
7. GENERAL 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.
If any provision of this Agreement is invalid or unenforceable under
applicable law, it shall not affect the validity or enforceability of the
remainder of the terms of this Agreement, and without further action by the
parties hereto, such provision shall be reformed to the minimum extent
necessary to make such provision valid and enforceable.
If Recipient institutes patent litigation against any entity (including a
cross-claim or counterclaim in a lawsuit) alleging that the Program itself
(excluding combinations of the Program with other software or hardware)
infringes such Recipient's patent(s), then such Recipient's rights granted
under Section 2(b) shall terminate as of the date such litigation is filed.
All Recipient's rights under this Agreement shall terminate if it fails to
comply with any of the material terms or conditions of this Agreement and
does not cure such failure in a reasonable period of time after becoming
aware of such noncompliance. If all Recipient's rights under this Agreement
terminate, Recipient agrees to cease use and distribution of the Program as
soon as reasonably practicable. However, Recipient's obligations under this
Agreement and any licenses granted by Recipient relating to the Program shall
continue and survive.
Everyone is permitted to copy and distribute copies of this Agreement, but in
order to avoid inconsistency the Agreement is copyrighted and may only be
modified in the following manner. The Agreement Steward reserves the right to
publish new versions (including revisions) of this Agreement from time to
time. No one other than the Agreement Steward has the right to modify this
Agreement. The Eclipse Foundation is the initial Agreement Steward. The
Eclipse Foundation may assign the responsibility to serve as the Agreement
Steward to a suitable separate entity. Each new version of the Agreement will
be given a distinguishing version number. The Program (including
Contributions) may always be distributed subject to the version of the
Agreement under which it was received. In addition, after a new version of
the Agreement is published, Contributor may elect to distribute the Program
(including its Contributions) under the new version. Except as expressly
stated in Sections 2(a) and 2(b) above, Recipient receives no rights or
licenses to the intellectual property of any Contributor under this
Agreement, whether expressly, by implication, estoppel or otherwise. All
rights in the Program not expressly granted under this Agreement are
reserved.
This Agreement is governed by the laws of the State of New York and the
intellectual property laws of the United States of America. No party to this
Agreement will bring a legal action under this Agreement more than one year
after the cause of action arose. Each party waives its rights to a jury trial
in any resulting litigation.

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.

5
README.md
View file

@ -56,7 +56,4 @@ I will happily accept pull requests for new XSL transforms (although I'd like so
Copyright © Simon Brooke 2007-2018 Copyright © Simon Brooke 2007-2018
Distributed under the Eclipse Public License either version 1.0 or (at Distributed under the Gnu GPL version 2 or any later version; I am open to licensing this project under additional licences if required.
your option) any later version.
Note that you are also entitled to use this project under the terms of the Gnu GPL version 2 or any later version; I generally prefer GPL, but I know that if this project is to be useful to folk it has to be relatively uncomplicated to use in commercial projects.

4
RELEASENOTES.md Normal file
View file

@ -0,0 +1,4 @@
# 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.

4
project.clj
View file

@ -3,4 +3,6 @@
:url "http://example.com/FIXME" :url "http://example.com/FIXME"
:license {:name "Eclipse Public License" :license {:name "Eclipse Public License"
:url "http://www.eclipse.org/legal/epl-v10.html"} :url "http://www.eclipse.org/legal/epl-v10.html"}
:dependencies [[org.clojure/clojure "1.8.0"]]) :dependencies [[org.clojure/clojure "1.8.0"]
[org.clojure/math.combinatorics "0.1.4"]
[bouncer "1.0.1"]])

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>

6
src/adl/core.clj
View file

@ -1,6 +0,0 @@
(ns adl.core)
(defn foo
"I don't do a whole lot."
[x]
(println x "Hello, World!"))

361
src/adl/to_hugsql_queries.clj
View file

@ -0,0 +1,361 @@
(ns ^{:doc "Application Description Language: generate HUGSQL queries file."
:author "Simon Brooke"}
adl.to-hugsql-queries
(:require [clojure.java.io :refer [file]]
[clojure.math.combinatorics :refer [combinations]]
[clojure.string :as s]
[clj-time.core :as t]
[clj-time.format :as f]
[adl.utils :refer [singularise is-link-table?]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; 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
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn key-names [entity-map]
(remove
nil?
(map
#(:name (:attrs %))
(vals (:content (:key (:content entity-map)))))))
(defn has-primary-key? [entity-map]
(> (count (key-names entity-map)) 0))
(defn has-non-key-properties? [entity-map]
(>
(count (vals (:properties (:content entity-map))))
(count (key-names entity-map))))
(defn where-clause [entity-map]
(let
[entity-name (:name (:attrs entity-map))]
(str
"WHERE " entity-name "."
(s/join
(str " AND\n\t" entity-name ".")
(map #(str % " = " (keyword %)) (key-names entity-map))))))
(defn order-by-clause [entity-map]
(let
[entity-name (:name (:attrs entity-map))
preferred (map
#(:name (:attrs %))
(filter #(= (-> % :attrs :distinct) "user")
(-> entity-map :content :properties vals)))]
(str
"ORDER BY " entity-name "."
(s/join
(str ",\n\t" entity-name ".")
(doall (flatten (cons preferred (key-names entity-map))))))))
(defn insert-query [entity-map]
(let [entity-name (:name (:attrs entity-map))
pretty-name (singularise entity-name)
all-property-names (map #(:name (:attrs %)) (vals (:properties (:content entity-map))))
query-name (str "create-" pretty-name "!")
signature " :! :n"]
(hash-map
(keyword query-name)
{:name query-name
:signature signature
:entity entity-map
:type :insert-1
:query
(str "-- :name " query-name " " signature "\n"
"-- :doc creates a new " pretty-name " record\n"
"INSERT INTO " entity-name " ("
(s/join ",\n\t" all-property-names)
")\nVALUES ("
(s/join ",\n\t" (map keyword all-property-names))
")"
(if
(has-primary-key? entity-map)
(str "\nreturning " (s/join ",\n\t" (key-names entity-map))))
"\n\n")})))
(defn update-query [entity-map]
(if
(and
(has-primary-key? entity-map)
(has-non-key-properties? entity-map))
(let [entity-name (:name (:attrs entity-map))
pretty-name (singularise entity-name)
property-names (remove
nil?
(map
#(if (= (:tag %) :property) (:name (:attrs %)))
(vals (:properties (:content entity-map)))))
query-name (str "update-" pretty-name "!")
signature ":! :n"]
(hash-map
(keyword query-name)
{:name query-name
:signature signature
:entity entity-map
:type :update-1
:query
(str "-- :name " query-name " " signature "\n"
"-- :doc updates an existing " pretty-name " record\n"
"UPDATE " entity-name "\n"
"SET "
(s/join ",\n\t" (map #(str % " = " (keyword %)) property-names))
"\n"
(where-clause entity-map)
"\n\n")}))
{}))
(defn search-query [entity-map]
(let [entity-name (:name (:attrs entity-map))
pretty-name (singularise entity-name)
query-name (str "search-strings-" pretty-name)
signature ":? :1"
string-fields (filter
#(= (-> % :attrs :type) "string")
(-> entity-map :content :properties vals))]
(if
(empty? string-fields)
{}
(hash-map
(keyword query-name)
{:name query-name
:signature signature
:entity entity-map
:type :text-search
:query
(str "-- :name " query-name " " signature "\n"
"-- :doc selects existing " entity-name " records having any string field matching `:pattern` by substring match\n"
"SELECT * FROM " entity-name "\n"
"WHERE "
(s/join
"\n\tOR "
(map
#(str (-> % :attrs :name) " LIKE '%:pattern%'")
string-fields))
"\n"
(order-by-clause entity-map)
"\n"
"--~ (if (:offset params) \"OFFSET :offset \") \n"
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
"\n\n")}))))
(defn select-query [entity-map]
(if
(has-primary-key? entity-map)
(let [entity-name (:name (:attrs entity-map))
pretty-name (singularise entity-name)
query-name (str "get-" pretty-name)
signature ":? :1"]
(hash-map
(keyword query-name)
{:name query-name
:signature signature
:entity entity-map
:type :select-1
:query
(str "-- :name " query-name " " signature "\n"
"-- :doc selects an existing " pretty-name " record\n"
"SELECT * FROM " entity-name "\n"
(where-clause entity-map)
"\n"
(order-by-clause entity-map)
"\n\n")}))
{}))
(defn list-query
"Generate a query to list records in the table represented by this `entity-map`.
Parameters `:limit` and `:offset` may be supplied. If not present limit defaults
to 100 and offset to 0."
[entity-map]
(let [entity-name (:name (:attrs entity-map))
pretty-name (singularise entity-name)
query-name (str "list-" entity-name)
signature ":? :*"]
(hash-map
(keyword query-name)
{:name query-name
:signature signature
:entity entity-map
:type :select-many
:query
(str "-- :name " query-name " " signature "\n"
"-- :doc lists all existing " pretty-name " records\n"
"SELECT * FROM " entity-name "\n"
(order-by-clause entity-map) "\n"
"--~ (if (:offset params) \"OFFSET :offset \") \n"
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
"\n\n")})))
(defn foreign-queries [entity-map entities-map]
(let [entity-name (:name (:attrs entity-map))
pretty-name (singularise entity-name)
links (filter #(-> % :attrs :entity) (-> entity-map :content :properties vals))]
(apply
merge
(map
#(let [far-name (-> % :attrs :entity)
far-entity ((keyword far-name) entities-map)
pretty-far (s/replace (s/replace far-name #"_" "-") #"s$" "")
farkey (-> % :attrs :farkey)
link-field (-> % :attrs :name)
query-name (str "list-" entity-name "-by-" pretty-far)
signature ":? :*"]
(hash-map
(keyword query-name)
{:name query-name
:signature signature
:entity entity-map
:type :select-one-to-many
:far-entity far-entity
:query
(str "-- :name " query-name " " signature "\n"
"-- :doc lists all existing " pretty-name " records related to a given " pretty-far "\n"
"SELECT * \nFROM " entity-name "\n"
"WHERE " entity-name "." link-field " = :id\n"
(order-by-clause entity-map)
"\n\n")}))
links))))
(defn link-table-query [near link far]
(let [properties (-> link :content :properties vals)
links (apply
merge
(map
#(hash-map (keyword (-> % :attrs :entity)) %)
(filter #(-> % :attrs :entity) properties)))
near-name (-> near :attrs :name)
link-name (-> link :attrs :name)
far-name (-> far :attrs :name)
pretty-far (singularise far-name)
query-name (str "list-" link-name "-" near-name "-by-" pretty-far)
signature ":? :*"]
(hash-map
(keyword query-name)
{:name query-name
:signature signature
:entity link
:type :select-many-to-many
:near-entity near
:far-entity far
:query
(str "-- :name " query-name " " signature " \n"
"-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far "\n"
"SELECT "near-name ".*\n"
"FROM " near-name ", " link-name "\n"
"WHERE " near-name "." (first (key-names near)) " = " link-name "." (-> (links (keyword near-name)) :attrs :name) "\n\t"
"AND " link-name "." (-> (links (keyword far-name)) :attrs :name) " = :id\n"
(order-by-clause near)
"\n\n")})))
(defn link-table-queries [entity-map entities-map]
(let
[entities (map
#((keyword %) entities-map)
(remove nil? (map #(-> % :attrs :entity) (-> entity-map :content :properties vals))))
pairs (combinations entities 2)]
(apply
merge
(map
#(merge
(link-table-query (nth % 0) entity-map (nth % 1))
(link-table-query (nth % 1) entity-map (nth % 0)))
pairs))))
(defn delete-query [entity-map]
(if
(has-primary-key? entity-map)
(let [entity-name (:name (:attrs entity-map))
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-map
:type :delete-1
:query
(str "-- :name " query-name " " signature "\n"
"-- :doc updates an existing " pretty-name " record\n"
"DELETE FROM " entity-name "\n"
(where-clause entity-map)
"\n\n")}))))
(defn queries
[entity-map entities-map]
(merge
{}
(insert-query entity-map)
(update-query entity-map)
(delete-query entity-map)
(if
(is-link-table? entity-map)
(link-table-queries entity-map entities-map)
(merge
(select-query entity-map)
(list-query entity-map)
(search-query entity-map)
(foreign-queries entity-map entities-map)))))
;; (defn migrations-to-queries-sql
;; ([migrations-path]
;; (migrations-to-queries-sql migrations-path "queries.auto.sql"))
;; ([migrations-path output]
;; (let
;; [adl-struct (migrations-to-xml migrations-path "Ignored")
;; file-content (apply
;; str
;; (cons
;; (str "-- "
;; output
;; " autogenerated by \n-- [squirrel-parse](https://github.com/simon-brooke/squirrel-parse)\n-- at "
;; (f/unparse (f/formatters :basic-date-time) (t/now))
;; "\n\n")
;; (doall
;; (map
;; #(:query %)
;; (sort
;; #(compare (:name %1) (:name %2))
;; (vals
;; (apply
;; merge
;; (map
;; #(queries % adl-struct)
;; (vals adl-struct)))))))))]
;; (spit output file-content)
;; file-content)))

237
src/adl/to_json_routes.clj
View file

@ -0,0 +1,237 @@
(ns ^{:doc "Application Description Language: generate RING routes for REST requests."
:author "Simon Brooke"}
adl.to-json-routes
(:require [clojure.java.io :refer [file]]
[clojure.math.combinatorics :refer [combinations]]
[clojure.string :as s]
[clj-time.core :as t]
[clj-time.format :as f]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; 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.
(defn file-header [parent-name this-name]
(list
'ns
(symbol (str parent-name ".routes." this-name))
(str "JSON routes for " parent-name
" auto-generated by [squirrel-parse](https://github.com/simon-brooke/squirrel-parse) at "
(f/unparse (f/formatters :basic-date-time) (t/now)))
(list
'require
'[noir.response :as nresponse]
'[noir.util.route :as route]
'[compojure.core :refer [defroutes GET POST]]
'[ring.util.http-response :as response]
'[clojure.java.io :as io]
'[hugsql.core :as hugsql]
(vector (symbol (str parent-name ".db.core")) :as 'db))))
(defn make-safe-name [string]
(s/replace string #"[^a-zA-Z0-9-]" ""))
(defn declarations [handlers-map]
(cons 'declare (sort (map #(symbol (make-safe-name (name %))) (keys handlers-map)))))
(defn generate-handler-src
[handler-name query-map method doc]
(hash-map
:method method
:src
(remove
nil?
(list
'defn
handler-name
(str "Auto-generated method to " doc)
[{:keys ['params]}]
(list 'do (list (symbol (str "db/" (:name query-map))) 'params))
(case
(:type query-map)
(:delete-1 :update-1)
'(response/found "/")
nil)))))
(defn handler
"Generate declarations for handlers from query with this `query-key` in this `queries-map` taken from within
this `entities-map`. This method must follow the structure of
`to-hugsql-queries/queries` quite closely, because we must generate the same names."
[query-key queries-map entities-map]
(let [query (query-key queries-map)
handler-name (symbol (make-safe-name (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`: `"
(doall (-> query :entity :content :key :content keys))
"`."))
: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 (-> query :entity :content :properties keys))
"`. Returns a map containing the keys `"
(pr-str (-> query :entity :content :key :content keys))
"` 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
(flatten
(cons
(-> query :entity :content :properties keys)
(-> query :entity :content :key :content keys))))))
"`."))
:select-1
(generate-handler-src
handler-name query :post
(str "select one record from the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(pr-str (-> query :entity :content :key :content keys))
"`. Returns a map containing the following keys: `"
(pr-str
(distinct
(sort
(flatten
(cons
(-> query :entity :content :properties keys)
(-> query :entity :content :key :content keys))))))
"`."))
: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
(distinct
(sort
(flatten
(cons
(-> query :entity :content :properties keys)
(-> query :entity :content :key :content keys))))))
"`."))
:text-search
(generate-handler-src
handler-name query :get
(str "select all records from the `"
(-> query :entity :attrs :name)
"` 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
(distinct
(sort
(flatten
(cons
(-> query :entity :content :properties keys)
(-> query :entity :content :key :content keys))))))
"`."))
(: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]
(cons
'defroutes
(cons
'auto-rest-routes
(map
#(let [handler (handlers-map %)]
(list
(symbol (s/upper-case (name (:method handler))))
(str "/json/auto/" (:name handler))
'request
(list
'route/restricted
(list (:name handler) 'request))))
(sort
(keys handlers-map))))))
;; (defn migrations-to-json-routes
;; ([migrations-path parent-namespace-name]
;; (migrations-to-json-routes migrations-path parent-namespace-name "auto-json-routes"))
;; ([migrations-path parent-namespace-name namespace-name]
;; (let [output (str (s/replace namespace-name #"-" "_") ".clj")
;; adl-struct (migrations-to-xml migrations-path "Ignored")
;; q (reduce
;; merge
;; {}
;; (map
;; #(queries % adl-struct)
;; (vals adl-struct)))
;; h (reduce
;; merge
;; {}
;; (map
;; #(handler % q adl-struct)
;; (keys q)))
;; f (cons
;; (file-header parent-namespace-name namespace-name)
;; ;; (pre-declare
;; (cons
;; (declarations h)
;; (cons
;; (defroutes h)
;; (map #(:src (h %)) (sort (keys h))))))]
;; (spit
;; output
;; (with-out-str
;; (doall
;; (for [expr f]
;; (do
;; (pprint expr)
;; (print "\n\n"))))))
;; f
;; )))

11
src/adl/utils.clj Normal file
View file

@ -0,0 +1,11 @@
(ns adl.utils
(:require [clojure.string :as s]))
(defn singularise [string]
(s/replace (s/replace (s/replace string #"_" "-") #"s$" "") #"ie$" "y"))
(defn is-link-table?
[entity-map]
(let [properties (-> entity-map :content :properties vals)
links (filter #(-> % :attrs :entity) properties)]
(= (count properties) (count links))))

654
src/adl/validator.clj
View file

@ -0,0 +1,654 @@
(ns ^{:doc "Application Description Language: validator for ADL structure."
:author "Simon Brooke"}
adl.validator
(:require [clojure.set :refer [union]]
[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
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn 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))))
(let
[rs (map
#(try
(b/validate o %)
(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!
[nil o])
(catch Exception e
[{:exception (.getMessage e)
:class (type e)
:context o} o]))
validations)
all-candidates (remove nil? (map first rs))
suspicious (remove :tag all-candidates)]
;; 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 "\tError: " %)) 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)]]})

7
test/adl/core_test.clj
View file

@ -1,7 +0,0 @@
(ns adl.core-test
(:require [clojure.test :refer :all]
[adl.core :refer :all]))
(deftest a-test
(testing "FIXME, I fail."
(is (= 0 1))))

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)))))