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

Merge remote-tracking branch 'origin/develop' into develop

Browse source
This commit is contained in:
Simon Brooke 2018-10-04 21:09:42 +01:00
parent 55be4a2786 a7934d70b9
commit 8de6c31507
33 changed files with 2579 additions and 501 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -25,3 +25,5 @@ node_modules/
generated/ generated/

4
CHANGELOG.md
View file

@ -1,6 +1,10 @@
# Change Log # Change Log
All notable changes to this project will be documented in this file. This change log is intended to follow the conventions of [keepachangelog.com](http://keepachangelog.com/). All notable changes to this project will be documented in this file. This change log is intended to follow the conventions of [keepachangelog.com](http://keepachangelog.com/).
## Release 1.4.6, 2018-09-22
Beta release; improved documentation.
## Release 1.4.5, 2018-09-20 ## Release 1.4.5, 2018-09-20
Generation of skeleton Clojure webapp is now largely complete; this release is not the final 'beta' release of this functionality, but is a dummy run towards that release. Generation of skeleton Clojure webapp is now largely complete; this release is not the final 'beta' release of this functionality, but is a dummy run towards that release.

74
README.md
View file

@ -4,9 +4,23 @@ A language for describing applications, from which code can be automatically gen
[![Clojars Project](https://img.shields.io/clojars/v/adl.svg)](https://clojars.org/adl) [![Clojars Project](https://img.shields.io/clojars/v/adl.svg)](https://clojars.org/adl)
## Contents
1. [Usage](#user-content-usage)
2. [History](#user-content-history)
3. [Why this is a good idea](#user-content-why-this-is-a-good-idea)
4. [What exists](#user-content-what-exists)
5. [Future direction](#user-content-future-direction)
6. [Contributing](#user-content-contributing)
## Usage ## Usage
A document describing the proposed application should be written in XML using the DTD `resources/schemas/adl-1.4.1.dtd`. It may then be transformed into a C# or Java application using the XSL transforms, see **History** below, but this code is very out of date and the resulting application is unlikely to be very usable. Alternatively, it can be transformed into a Clojure [Luminus](http://www.luminusweb.net/) application using the Clojure transformation, as follows: A document describing the proposed application should be written in XML using the DTD `resources/schemas/adl-1.4.1.dtd`. It may then be transformed into a C# or Java application using the XSL transforms, see **History** below, but this code is very out of date and the resulting application is unlikely to be very usable.
### Clojure
Alternatively, it can be transformed into a Clojure [Luminus](http://www.luminusweb.net/) application using the Clojure transformation, as follows:
simon@fletcher:~/workspace/adl$ java -jar target/adl-[VERSION]-standalone.jar --help simon@fletcher:~/workspace/adl$ java -jar target/adl-[VERSION]-standalone.jar --help
Usage: java -jar adl-[VERSION]-standalone.jar -options [adl-file] Usage: java -jar adl-[VERSION]-standalone.jar -options [adl-file]
@ -17,7 +31,61 @@ A document describing the proposed application should be written in XML using th
-p, --path [PATH]: The path under which generated files should be written; (default: generated) -p, --path [PATH]: The path under which generated files should be written; (default: generated)
-v, --verbosity [LEVEL], : Verbosity level - integer value required; (default: 0) -v, --verbosity [LEVEL], : Verbosity level - integer value required; (default: 0)
This is not yet complete but it is at an advanced stage and already produces code which is useful. Of more simply using the [leiningen](https://leiningen.org/) plugin, see [lein-adl](https://github.com/simon-brooke/lein-adl).
#### What is generated for Clojure
The following files are generated:
* `resources/sql/queries.auto.sql` - [HugSQL](https://www.hugsql.org/) queries for selection, insertion, modification and deletion of records of all entities described in the ADL file.
* `resources/sql/[application-name].postgres.sql` - [Postgres](https://www.postgresql.org/) database initialisation script including tables for all entities, convenience views for all entities, all necessary link tables and referential integrity constraints.
* `resources/templates/auto/*.html` - [Selmer](https://github.com/yogthos/Selmer) templates for each form or list list specified in the ADL file (pages are not yet handled).
* `src/clj/[application-name]/routes/auto.clj` - [Compojure]() routes for each form or list list specified in the ADL file (pages are not yet handled).
* `src/clj/[application-name]/routes/auto-json.clj` - [Compojure]() routes returning JSON responses for each query generated in `resources/sql/queries.auto.sql`.
*You are strongly advised never to edit any of these files*.
* To override any query, add that query to a file `resources/sql/queries.sql`
* To add additional material (for example reference data) to the database initialisation, add it to a separate file or a family of separate files.
* To override any template, copy the template file from `resources/templates/auto/` to `resources/templates/` and edit it there.
* To override any route, write a function of the same name in the namespace `[application-name].routes.manual`.
#### Some assembly required
It would be very nice to be able to type
lein new luminus froboz +adl
and have a new Luminus project initialised with a skeleton ADL file, and all the glue needed to make it work, already in place. [This is planned](https://github.com/simon-brooke/adl/issues/6), but just at present it isn't there and you will have to do some work yourself.
Where, in `src/clj/[application-name]/db/core.clj` [Luminus]() would autogenerate
(conman/bind-connection *db* "sql/queries.sql")
You should substitute
(conman/bind-connection *db* "sql/queries.auto.sql" "sql/queries.sql")
(hugsql/def-sqlvec-fns "sql/queries.auto.sql")
You should add the following two stanzas to the `app-routes` definition in `src/clj/[project-name]/handler.clj`.
(-> #'auto-rest-routes
(wrap-routes middleware/wrap-csrf)
(wrap-routes middleware/wrap-formats))
(-> #'auto-selmer-routes
(wrap-routes middleware/wrap-csrf)
(wrap-routes middleware/wrap-formats))
Finally, you should prepend `"adl"` to the vector of `prep-tasks` in the `uberjar` profile of you `project.clj` file, thus:
:profiles {:uberjar {:omit-source true
:prep-tasks ["adl"
"compile"
["npm" "install"]
["cljsbuild" "once" "min"]]
...
The above assumes you are using Luminus to initialise your project; if you are not, then I expect that you are confident enough using Clojure that you can work out where these changes should be made in your own code.
## History ## History
@ -73,6 +141,8 @@ Back in 2007, XSLT seemed a really good technology for doing this sort of thing.
Ultimately ADL will probably transition from XML to [EDN](https://github.com/edn-format/edn). Ultimately ADL will probably transition from XML to [EDN](https://github.com/edn-format/edn).
I plan to generate a [re-frame](https://github.com/Day8/re-frame) skeleton, to support client side and [React Native](https://facebook.github.io/react-native/) applications, but this is not yet in place.
This doesn't mean you can't pick up the framework and write transforms in other languages and/or to other language ecosystems. In fact, I'd encourage you to do so. This doesn't mean you can't pick up the framework and write transforms in other languages and/or to other language ecosystems. In fact, I'd encourage you to do so.
## Contributing ## Contributing

10
doc/adl.main.html Normal file
View file

@ -0,0 +1,10 @@
<!DOCTYPE html PUBLIC ""
"">
<html><head><meta charset="UTF-8" /><title>adl.main documentation</title><link rel="stylesheet" type="text/css" href="css/default.css" /><link rel="stylesheet" type="text/css" href="css/highlight.css" /><script type="text/javascript" src="js/highlight.min.js"></script><script type="text/javascript" src="js/jquery.min.js"></script><script type="text/javascript" src="js/page_effects.js"></script><script>hljs.initHighlightingOnLoad();</script></head><body><div id="header"><h2>Generated by <a href="https://github.com/weavejester/codox">Codox</a></h2><h1><a href="index.html"><span class="project-title"><span class="project-name">Adl</span> <span class="project-version">1.4.6-SNAPSHOT</span></span></a></h1></div><div class="sidebar primary"><h3 class="no-link"><span class="inner">Project</span></h3><ul class="index-link"><li class="depth-1 "><a href="index.html"><div class="inner">Index</div></a></li></ul><h3 class="no-link"><span class="inner">Topics</span></h3><ul><li class="depth-1 "><a href="intro.html"><div class="inner"><span>Introduction</span></div></a></li></ul><h3 class="no-link"><span class="inner">Namespaces</span></h3><ul><li class="depth-1"><div class="no-link"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>adl</span></div></div></li><li class="depth-2 branch current"><a href="adl.main.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>main</span></div></a></li><li class="depth-2 branch"><a href="adl.to-hugsql-queries.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-hugsql-queries</span></div></a></li><li class="depth-2 branch"><a href="adl.to-json-routes.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-json-routes</span></div></a></li><li class="depth-2 branch"><a href="adl.to-psql.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-psql</span></div></a></li><li class="depth-2 branch"><a href="adl.to-reframe.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-reframe</span></div></a></li><li class="depth-2 branch"><a href="adl.to-selmer-routes.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-selmer-routes</span></div></a></li><li class="depth-2 branch"><a href="adl.to-selmer-templates.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-selmer-templates</span></div></a></li><li class="depth-2 branch"><a href="adl.to-swagger.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-swagger</span></div></a></li><li class="depth-2"><a href="adl.validator.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>validator</span></div></a></li></ul></div><div class="sidebar secondary"><h3><a href="#top"><span class="inner">Public Vars</span></a></h3><ul><li class="depth-1"><a href="adl.main.html#var--main"><div class="inner"><span>-main</span></div></a></li><li class="depth-1"><a href="adl.main.html#var-adl-.3Ecanonical"><div class="inner"><span>adl-&gt;canonical</span></div></a></li><li class="depth-1"><a href="adl.main.html#var-canonicalise"><div class="inner"><span>canonicalise</span></div></a></li><li class="depth-1"><a href="adl.main.html#var-cli-options"><div class="inner"><span>cli-options</span></div></a></li><li class="depth-1"><a href="adl.main.html#var-process"><div class="inner"><span>process</span></div></a></li><li class="depth-1"><a href="adl.main.html#var-usage"><div class="inner"><span>usage</span></div></a></li></ul></div><div class="namespace-docs" id="content"><h1 class="anchor" id="top">adl.main</h1><div class="doc"><pre class="plaintext">Application Description Language - command line invocation.
</pre></div><div class="public anchor" id="var--main"><h3>-main</h3><div class="usage"><code>(-main &amp; args)</code></div><div class="doc"><pre class="plaintext">Parses options and arguments. Expects as args the path-name of one or
more ADL files.</pre></div></div><div class="public anchor" id="var-adl-.3Ecanonical"><h3>adl-&gt;canonical</h3><div class="usage"></div><div class="doc"><pre class="plaintext">A function which takes ADL text as its single argument and returns
canonicalised ADL text as its result.</pre></div></div><div class="public anchor" id="var-canonicalise"><h3>canonicalise</h3><div class="usage"><code>(canonicalise filepath)</code></div><div class="doc"><pre class="plaintext">Canonicalise the ADL document indicated by this `filepath` (if it is not
already canonical) and return a path to the canonical version.</pre></div></div><div class="public anchor" id="var-cli-options"><h3>cli-options</h3><div class="usage"></div><div class="doc"><pre class="plaintext">Command-line interface options
</pre></div></div><div class="public anchor" id="var-process"><h3>process</h3><div class="usage"><code>(process options)</code></div><div class="doc"><pre class="plaintext">Process these parsed `options`.
</pre></div></div><div class="public anchor" id="var-usage"><h3>usage</h3><div class="usage"><code>(usage parsed-options)</code></div><div class="doc"><pre class="plaintext">Show a usage message. `parsed-options` should be options as
parsed by [clojure.tools.cli](<a href="https://github.com/clojure/tools.cli)">https://github.com/clojure/tools.cli)</a></pre></div></div></div></body></html>

17
doc/adl.to-hugsql-queries.html Normal file
View file

File diff suppressed because one or more lines are too long

13
doc/adl.to-json-routes.html Normal file
View file

@ -0,0 +1,13 @@
<!DOCTYPE html PUBLIC ""
"">
<html><head><meta charset="UTF-8" /><title>adl.to-json-routes documentation</title><link rel="stylesheet" type="text/css" href="css/default.css" /><link rel="stylesheet" type="text/css" href="css/highlight.css" /><script type="text/javascript" src="js/highlight.min.js"></script><script type="text/javascript" src="js/jquery.min.js"></script><script type="text/javascript" src="js/page_effects.js"></script><script>hljs.initHighlightingOnLoad();</script></head><body><div id="header"><h2>Generated by <a href="https://github.com/weavejester/codox">Codox</a></h2><h1><a href="index.html"><span class="project-title"><span class="project-name">Adl</span> <span class="project-version">1.4.6-SNAPSHOT</span></span></a></h1></div><div class="sidebar primary"><h3 class="no-link"><span class="inner">Project</span></h3><ul class="index-link"><li class="depth-1 "><a href="index.html"><div class="inner">Index</div></a></li></ul><h3 class="no-link"><span class="inner">Topics</span></h3><ul><li class="depth-1 "><a href="intro.html"><div class="inner"><span>Introduction</span></div></a></li></ul><h3 class="no-link"><span class="inner">Namespaces</span></h3><ul><li class="depth-1"><div class="no-link"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>adl</span></div></div></li><li class="depth-2 branch"><a href="adl.main.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>main</span></div></a></li><li class="depth-2 branch"><a href="adl.to-hugsql-queries.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-hugsql-queries</span></div></a></li><li class="depth-2 branch current"><a href="adl.to-json-routes.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-json-routes</span></div></a></li><li class="depth-2 branch"><a href="adl.to-psql.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-psql</span></div></a></li><li class="depth-2 branch"><a href="adl.to-reframe.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-reframe</span></div></a></li><li class="depth-2 branch"><a href="adl.to-selmer-routes.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-selmer-routes</span></div></a></li><li class="depth-2 branch"><a href="adl.to-selmer-templates.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-selmer-templates</span></div></a></li><li class="depth-2 branch"><a href="adl.to-swagger.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-swagger</span></div></a></li><li class="depth-2"><a href="adl.validator.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>validator</span></div></a></li></ul></div><div class="sidebar secondary"><h3><a href="#top"><span class="inner">Public Vars</span></a></h3><ul><li class="depth-1"><a href="adl.to-json-routes.html#var-declarations"><div class="inner"><span>declarations</span></div></a></li><li class="depth-1"><a href="adl.to-json-routes.html#var-defroutes"><div class="inner"><span>defroutes</span></div></a></li><li class="depth-1"><a href="adl.to-json-routes.html#var-file-header"><div class="inner"><span>file-header</span></div></a></li><li class="depth-1"><a href="adl.to-json-routes.html#var-generate-handler-body"><div class="inner"><span>generate-handler-body</span></div></a></li><li class="depth-1"><a href="adl.to-json-routes.html#var-generate-handler-src"><div class="inner"><span>generate-handler-src</span></div></a></li><li class="depth-1"><a href="adl.to-json-routes.html#var-handler"><div class="inner"><span>handler</span></div></a></li><li class="depth-1"><a href="adl.to-json-routes.html#var-make-handlers-map"><div class="inner"><span>make-handlers-map</span></div></a></li><li class="depth-1"><a href="adl.to-json-routes.html#var-to-json-routes"><div class="inner"><span>to-json-routes</span></div></a></li></ul></div><div class="namespace-docs" id="content"><h1 class="anchor" id="top">adl.to-json-routes</h1><div class="doc"><pre class="plaintext">Application Description Language: generate RING routes for REST requests.
</pre></div><div class="public anchor" id="var-declarations"><h3>declarations</h3><div class="usage"><code>(declarations handlers-map)</code></div><div class="doc"><pre class="plaintext">Generate a forward declaration of all JSON route handlers we're going to
generate for this `application`.</pre></div></div><div class="public anchor" id="var-defroutes"><h3>defroutes</h3><div class="usage"><code>(defroutes handlers-map)</code></div><div class="doc"><pre class="plaintext">Generate JSON routes for all queries implied by this ADL `application` spec.
</pre></div></div><div class="public anchor" id="var-file-header"><h3>file-header</h3><div class="usage"><code>(file-header application)</code></div><div class="doc"><pre class="plaintext">Generate an appropriate file header for JSON routes for this `application`.
</pre></div></div><div class="public anchor" id="var-generate-handler-body"><h3>generate-handler-body</h3><div class="usage"><code>(generate-handler-body query)</code></div><div class="doc"><pre class="plaintext">Generate and return the function body for the handler for this `query`.
</pre></div></div><div class="public anchor" id="var-generate-handler-src"><h3>generate-handler-src</h3><div class="usage"><code>(generate-handler-src handler-name query-map method doc)</code></div><div class="doc"><pre class="plaintext">Generate and return the handler for this `query`.
</pre></div></div><div class="public anchor" id="var-handler"><h3>handler</h3><div class="usage"><code>(handler query-key queries-map application)</code></div><div class="doc"><pre class="plaintext">Generate declarations for handlers from query with this `query-key` in this `queries-map`
taken from within this `application`. This method must follow the structure of
`to-hugsql-queries/queries` quite closely, because we must generate the same names.</pre></div></div><div class="public anchor" id="var-make-handlers-map"><h3>make-handlers-map</h3><div class="usage"><code>(make-handlers-map application)</code></div><div class="doc"><pre class="plaintext">Analyse this `application` and generate from it a map of the handlers to be output.
</pre></div></div><div class="public anchor" id="var-to-json-routes"><h3>to-json-routes</h3><div class="usage"><code>(to-json-routes application)</code></div><div class="doc"><pre class="plaintext">Generate a `/routes/auto-json.clj` file for this `application`.
</pre></div></div></div></body></html>

32
doc/adl.to-psql.html Normal file
View file

File diff suppressed because one or more lines are too long

7
doc/adl.to-reframe.html Normal file
View file

@ -0,0 +1,7 @@
<!DOCTYPE html PUBLIC ""
"">
<html><head><meta charset="UTF-8" /><title>adl.to-reframe documentation</title><link rel="stylesheet" type="text/css" href="css/default.css" /><link rel="stylesheet" type="text/css" href="css/highlight.css" /><script type="text/javascript" src="js/highlight.min.js"></script><script type="text/javascript" src="js/jquery.min.js"></script><script type="text/javascript" src="js/page_effects.js"></script><script>hljs.initHighlightingOnLoad();</script></head><body><div id="header"><h2>Generated by <a href="https://github.com/weavejester/codox">Codox</a></h2><h1><a href="index.html"><span class="project-title"><span class="project-name">Adl</span> <span class="project-version">1.4.6-SNAPSHOT</span></span></a></h1></div><div class="sidebar primary"><h3 class="no-link"><span class="inner">Project</span></h3><ul class="index-link"><li class="depth-1 "><a href="index.html"><div class="inner">Index</div></a></li></ul><h3 class="no-link"><span class="inner">Topics</span></h3><ul><li class="depth-1 "><a href="intro.html"><div class="inner"><span>Introduction</span></div></a></li></ul><h3 class="no-link"><span class="inner">Namespaces</span></h3><ul><li class="depth-1"><div class="no-link"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>adl</span></div></div></li><li class="depth-2 branch"><a href="adl.main.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>main</span></div></a></li><li class="depth-2 branch"><a href="adl.to-hugsql-queries.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-hugsql-queries</span></div></a></li><li class="depth-2 branch"><a href="adl.to-json-routes.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-json-routes</span></div></a></li><li class="depth-2 branch"><a href="adl.to-psql.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-psql</span></div></a></li><li class="depth-2 branch current"><a href="adl.to-reframe.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-reframe</span></div></a></li><li class="depth-2 branch"><a href="adl.to-selmer-routes.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-selmer-routes</span></div></a></li><li class="depth-2 branch"><a href="adl.to-selmer-templates.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-selmer-templates</span></div></a></li><li class="depth-2 branch"><a href="adl.to-swagger.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-swagger</span></div></a></li><li class="depth-2"><a href="adl.validator.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>validator</span></div></a></li></ul></div><div class="sidebar secondary"><h3><a href="#top"><span class="inner">Public Vars</span></a></h3><ul><li class="depth-1"><a href="adl.to-reframe.html#var-file-header"><div class="inner"><span>file-header</span></div></a></li><li class="depth-1"><a href="adl.to-reframe.html#var-generate-form"><div class="inner"><span>generate-form</span></div></a></li></ul></div><div class="namespace-docs" id="content"><h1 class="anchor" id="top">adl.to-reframe</h1><div class="doc"><pre class="plaintext">Application Description Language: generate re-frame UI. TODO: doesn't even nearly work yet.
</pre></div><div class="public anchor" id="var-file-header"><h3>file-header</h3><div class="usage"><code>(file-header parent-name this-name extra-requires)</code><code>(file-header parent-name this-name)</code></div><div class="doc"><pre class="plaintext">Generate an appropriate file header for a re-frame view.
</pre></div></div><div class="public anchor" id="var-generate-form"><h3>generate-form</h3><div class="usage"><code>(generate-form form entity application)</code></div><div class="doc"><pre class="plaintext">Generate as re-frame this `form` taken from this `entity` of this `application`.
TODO: write it!</pre></div></div></div></body></html>

28
doc/adl.to-selmer-routes.html Normal file
View file

File diff suppressed because one or more lines are too long

57
doc/adl.to-selmer-templates.html Normal file
View file

File diff suppressed because one or more lines are too long

5
doc/adl.to-swagger.html Normal file
View file

@ -0,0 +1,5 @@
<!DOCTYPE html PUBLIC ""
"">
<html><head><meta charset="UTF-8" /><title>adl.to-swagger documentation</title><link rel="stylesheet" type="text/css" href="css/default.css" /><link rel="stylesheet" type="text/css" href="css/highlight.css" /><script type="text/javascript" src="js/highlight.min.js"></script><script type="text/javascript" src="js/jquery.min.js"></script><script type="text/javascript" src="js/page_effects.js"></script><script>hljs.initHighlightingOnLoad();</script></head><body><div id="header"><h2>Generated by <a href="https://github.com/weavejester/codox">Codox</a></h2><h1><a href="index.html"><span class="project-title"><span class="project-name">Adl</span> <span class="project-version">1.4.6-SNAPSHOT</span></span></a></h1></div><div class="sidebar primary"><h3 class="no-link"><span class="inner">Project</span></h3><ul class="index-link"><li class="depth-1 "><a href="index.html"><div class="inner">Index</div></a></li></ul><h3 class="no-link"><span class="inner">Topics</span></h3><ul><li class="depth-1 "><a href="intro.html"><div class="inner"><span>Introduction</span></div></a></li></ul><h3 class="no-link"><span class="inner">Namespaces</span></h3><ul><li class="depth-1"><div class="no-link"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>adl</span></div></div></li><li class="depth-2 branch"><a href="adl.main.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>main</span></div></a></li><li class="depth-2 branch"><a href="adl.to-hugsql-queries.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-hugsql-queries</span></div></a></li><li class="depth-2 branch"><a href="adl.to-json-routes.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-json-routes</span></div></a></li><li class="depth-2 branch"><a href="adl.to-psql.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-psql</span></div></a></li><li class="depth-2 branch"><a href="adl.to-reframe.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-reframe</span></div></a></li><li class="depth-2 branch"><a href="adl.to-selmer-routes.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-selmer-routes</span></div></a></li><li class="depth-2 branch"><a href="adl.to-selmer-templates.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-selmer-templates</span></div></a></li><li class="depth-2 branch current"><a href="adl.to-swagger.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-swagger</span></div></a></li><li class="depth-2"><a href="adl.validator.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>validator</span></div></a></li></ul></div><div class="sidebar secondary"><h3><a href="#top"><span class="inner">Public Vars</span></a></h3><ul><li class="depth-1"><a href="adl.to-swagger.html#var-file-header"><div class="inner"><span>file-header</span></div></a></li></ul></div><div class="namespace-docs" id="content"><h1 class="anchor" id="top">adl.to-swagger</h1><div class="doc"><pre class="plaintext">Application Description Language: generate swagger routes.
</pre></div><div class="public anchor" id="var-file-header"><h3>file-header</h3><div class="usage"><code>(file-header application)</code></div><div class="doc"><pre class="plaintext">TODO: Nothing here works yet.
</pre></div></div></div></body></html>

221
doc/adl.validator.html Normal file
View file

File diff suppressed because one or more lines are too long

551
doc/css/default.css Normal file
View file

@ -0,0 +1,551 @@
body {
font-family: Helvetica, Arial, sans-serif;
font-size: 15px;
}
pre, code {
font-family: Monaco, DejaVu Sans Mono, Consolas, monospace;
font-size: 9pt;
margin: 15px 0;
}
h1 {
font-weight: normal;
font-size: 29px;
margin: 10px 0 2px 0;
padding: 0;
}
h2 {
font-weight: normal;
font-size: 25px;
}
h5.license {
margin: 9px 0 22px 0;
color: #555;
font-weight: normal;
font-size: 12px;
font-style: italic;
}
.document h1, .namespace-index h1 {
font-size: 32px;
margin-top: 12px;
}
#header, #content, .sidebar {
position: fixed;
}
#header {
top: 0;
left: 0;
right: 0;
height: 22px;
color: #f5f5f5;
padding: 5px 7px;
}
#content {
top: 32px;
right: 0;
bottom: 0;
overflow: auto;
background: #fff;
color: #333;
padding: 0 18px;
}
.sidebar {
position: fixed;
top: 32px;
bottom: 0;
overflow: auto;
}
.sidebar.primary {
background: #e2e2e2;
border-right: solid 1px #cccccc;
left: 0;
width: 250px;
}
.sidebar.secondary {
background: #f2f2f2;
border-right: solid 1px #d7d7d7;
left: 251px;
width: 200px;
}
#content.namespace-index, #content.document {
left: 251px;
}
#content.namespace-docs {
left: 452px;
}
#content.document {
padding-bottom: 10%;
}
#header {
background: #3f3f3f;
box-shadow: 0 0 8px rgba(0, 0, 0, 0.4);
z-index: 100;
}
#header h1 {
margin: 0;
padding: 0;
font-size: 18px;
font-weight: lighter;
text-shadow: -1px -1px 0px #333;
}
#header h1 .project-version {
font-weight: normal;
}
.project-version {
padding-left: 0.15em;
}
#header a, .sidebar a {
display: block;
text-decoration: none;
}
#header a {
color: #f5f5f5;
}
.sidebar a {
color: #333;
}
#header h2 {
float: right;
font-size: 9pt;
font-weight: normal;
margin: 4px 3px;
padding: 0;
color: #bbb;
}
#header h2 a {
display: inline;
}
.sidebar h3 {
margin: 0;
padding: 10px 13px 0 13px;
font-size: 19px;
font-weight: lighter;
}
.sidebar h3 a {
color: #444;
}
.sidebar h3.no-link {
color: #636363;
}
.sidebar ul {
padding: 7px 0 6px 0;
margin: 0;
}
.sidebar ul.index-link {
padding-bottom: 4px;
}
.sidebar li {
display: block;
vertical-align: middle;
}
.sidebar li a, .sidebar li .no-link {
border-left: 3px solid transparent;
padding: 0 10px;
white-space: nowrap;
}
.sidebar li .no-link {
display: block;
color: #777;
font-style: italic;
}
.sidebar li .inner {
display: inline-block;
padding-top: 7px;
height: 24px;
}
.sidebar li a, .sidebar li .tree {
height: 31px;
}
.depth-1 .inner { padding-left: 2px; }
.depth-2 .inner { padding-left: 6px; }
.depth-3 .inner { padding-left: 20px; }
.depth-4 .inner { padding-left: 34px; }
.depth-5 .inner { padding-left: 48px; }
.depth-6 .inner { padding-left: 62px; }
.sidebar li .tree {
display: block;
float: left;
position: relative;
top: -10px;
margin: 0 4px 0 0;
padding: 0;
}
.sidebar li.depth-1 .tree {
display: none;
}
.sidebar li .tree .top, .sidebar li .tree .bottom {
display: block;
margin: 0;
padding: 0;
width: 7px;
}
.sidebar li .tree .top {
border-left: 1px solid #aaa;
border-bottom: 1px solid #aaa;
height: 19px;
}
.sidebar li .tree .bottom {
height: 22px;
}
.sidebar li.branch .tree .bottom {
border-left: 1px solid #aaa;
}
.sidebar.primary li.current a {
border-left: 3px solid #a33;
color: #a33;
}
.sidebar.secondary li.current a {
border-left: 3px solid #33a;
color: #33a;
}
.namespace-index h2 {
margin: 30px 0 0 0;
}
.namespace-index h3 {
font-size: 16px;
font-weight: bold;
margin-bottom: 0;
}
.namespace-index .topics {
padding-left: 30px;
margin: 11px 0 0 0;
}
.namespace-index .topics li {
padding: 5px 0;
}
.namespace-docs h3 {
font-size: 18px;
font-weight: bold;
}
.public h3 {
margin: 0;
float: left;
}
.usage {
clear: both;
}
.public {
margin: 0;
border-top: 1px solid #e0e0e0;
padding-top: 14px;
padding-bottom: 6px;
}
.public:last-child {
margin-bottom: 20%;
}
.members .public:last-child {
margin-bottom: 0;
}
.members {
margin: 15px 0;
}
.members h4 {
color: #555;
font-weight: normal;
font-variant: small-caps;
margin: 0 0 5px 0;
}
.members .inner {
padding-top: 5px;
padding-left: 12px;
margin-top: 2px;
margin-left: 7px;
border-left: 1px solid #bbb;
}
#content .members .inner h3 {
font-size: 12pt;
}
.members .public {
border-top: none;
margin-top: 0;
padding-top: 6px;
padding-bottom: 0;
}
.members .public:first-child {
padding-top: 0;
}
h4.type,
h4.dynamic,
h4.added,
h4.deprecated {
float: left;
margin: 3px 10px 15px 0;
font-size: 15px;
font-weight: bold;
font-variant: small-caps;
}
.public h4.type,
.public h4.dynamic,
.public h4.added,
.public h4.deprecated {
font-size: 13px;
font-weight: bold;
margin: 3px 0 0 10px;
}
.members h4.type,
.members h4.added,
.members h4.deprecated {
margin-top: 1px;
}
h4.type {
color: #717171;
}
h4.dynamic {
color: #9933aa;
}
h4.added {
color: #508820;
}
h4.deprecated {
color: #880000;
}
.namespace {
margin-bottom: 30px;
}
.namespace:last-child {
margin-bottom: 10%;
}
.index {
padding: 0;
font-size: 80%;
margin: 15px 0;
line-height: 16px;
}
.index * {
display: inline;
}
.index p {
padding-right: 3px;
}
.index li {
padding-right: 5px;
}
.index ul {
padding-left: 0;
}
.type-sig {
clear: both;
color: #088;
}
.type-sig pre {
padding-top: 10px;
margin: 0;
}
.usage code {
display: block;
color: #008;
margin: 2px 0;
}
.usage code:first-child {
padding-top: 10px;
}
p {
margin: 15px 0;
}
.public p:first-child, .public pre.plaintext {
margin-top: 12px;
}
.doc {
margin: 0 0 26px 0;
clear: both;
}
.public .doc {
margin: 0;
}
.namespace-index .doc {
margin-bottom: 20px;
}
.namespace-index .namespace .doc {
margin-bottom: 10px;
}
.markdown p, .markdown li, .markdown dt, .markdown dd, .markdown td {
line-height: 22px;
}
.markdown li {
padding: 2px 0;
}
.markdown h2 {
font-weight: normal;
font-size: 25px;
margin: 30px 0 10px 0;
}
.markdown h3 {
font-weight: normal;
font-size: 20px;
margin: 30px 0 0 0;
}
.markdown h4 {
font-size: 15px;
margin: 22px 0 -4px 0;
}
.doc, .public, .namespace .index {
max-width: 680px;
overflow-x: visible;
}
.markdown pre > code {
display: block;
padding: 10px;
}
.markdown pre > code, .src-link a {
border: 1px solid #e4e4e4;
border-radius: 2px;
}
.markdown code:not(.hljs), .src-link a {
background: #f6f6f6;
}
pre.deps {
display: inline-block;
margin: 0 10px;
border: 1px solid #e4e4e4;
border-radius: 2px;
padding: 10px;
background-color: #f6f6f6;
}
.markdown hr {
border-style: solid;
border-top: none;
color: #ccc;
}
.doc ul, .doc ol {
padding-left: 30px;
}
.doc table {
border-collapse: collapse;
margin: 0 10px;
}
.doc table td, .doc table th {
border: 1px solid #dddddd;
padding: 4px 6px;
}
.doc table th {
background: #f2f2f2;
}
.doc dl {
margin: 0 10px 20px 10px;
}
.doc dl dt {
font-weight: bold;
margin: 0;
padding: 3px 0;
border-bottom: 1px solid #ddd;
}
.doc dl dd {
padding: 5px 0;
margin: 0 0 5px 10px;
}
.doc abbr {
border-bottom: 1px dotted #333;
font-variant: none;
cursor: help;
}
.src-link {
margin-bottom: 15px;
}
.src-link a {
font-size: 70%;
padding: 1px 4px;
text-decoration: none;
color: #5555bb;
}

97
doc/css/highlight.css Normal file
View file

@ -0,0 +1,97 @@
/*
github.com style (c) Vasily Polovnyov <vast@whiteants.net>
*/
.hljs {
display: block;
overflow-x: auto;
padding: 0.5em;
color: #333;
background: #f8f8f8;
}
.hljs-comment,
.hljs-quote {
color: #998;
font-style: italic;
}
.hljs-keyword,
.hljs-selector-tag,
.hljs-subst {
color: #333;
font-weight: bold;
}
.hljs-number,
.hljs-literal,
.hljs-variable,
.hljs-template-variable,
.hljs-tag .hljs-attr {
color: #008080;
}
.hljs-string,
.hljs-doctag {
color: #d14;
}
.hljs-title,
.hljs-section,
.hljs-selector-id {
color: #900;
font-weight: bold;
}
.hljs-subst {
font-weight: normal;
}
.hljs-type,
.hljs-class .hljs-title {
color: #458;
font-weight: bold;
}
.hljs-tag,
.hljs-name,
.hljs-attribute {
color: #000080;
font-weight: normal;
}
.hljs-regexp,
.hljs-link {
color: #009926;
}
.hljs-symbol,
.hljs-bullet {
color: #990073;
}
.hljs-built_in,
.hljs-builtin-name {
color: #0086b3;
}
.hljs-meta {
color: #999;
font-weight: bold;
}
.hljs-deletion {
background: #fdd;
}
.hljs-addition {
background: #dfd;
}
.hljs-emphasis {
font-style: italic;
}
.hljs-strong {
font-weight: bold;
}

6
doc/index.html Normal file
View file

File diff suppressed because one or more lines are too long

480
doc/intro.html Normal file
View file

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

12
doc/intro.md
View file

@ -1,6 +1,6 @@
# Introduction # Introduction
**NOTE**: *this markdown was automatically generated from `adl_user_doc.html`, which in turn was taken from the Wiki page on which this documentation was originally written.* **NOTE**: *this markdown was automatically generated from `adl_user_doc.html`, which in turn was taken from the Wiki page on which this documentation was originally written.* **It is substantially out of date.**
Application Description Language framework Application Description Language framework
========================================== ==========================================
@ -8,21 +8,21 @@ Application Description Language framework
## Contents ## Contents
-------- --------
* [1 What is Application Description Language?](#What_is_Application_Description_Language.3F) * [1 What is Application Description Language?](#What_is_Application_Description_Language)
* [2 Current versions](#Current_versions) * [2 Current versions](#Current_versions)
* [3 What is the Application Description Language Framework?](#What_is_the_Application_Description_Language_Framework.3F) * [3 What is the Application Description Language Framework?](#What_is_the_Application_Description_Language_Framework)
* [4 Why does it matter?](#Why_does_it_matter.3F) * [4 Why does it matter?](#Why_does_it_matter)
* [4.1 Automated Application Generation](#Automated_Application_Generation) * [4.1 Automated Application Generation](#Automated_Application_Generation)
* [4.2 Integration with hand-written code](#Integration_with_hand-written_code) * [4.2 Integration with hand-written code](#Integration_with_hand-written_code)
* [4.3 High quality auto-generated code](#High_quality_auto-generated_code) * [4.3 High quality auto-generated code](#High_quality_auto-generated_code)
* [5 What can the Application Description Language framework now do?](#What_can_the_Application_Description_Language_framework_now_do.3F) * [5 What can the Application Description Language framework now do?](#What_can_the_Application_Description_Language_framework_now_do)
* [5.1 adl2entityclass.xsl](#adl2entityclass.xsl) * [5.1 adl2entityclass.xsl](#adl2entityclass.xsl)
* [5.2 adl2mssql.xsl](#adl2mssql.xsl) * [5.2 adl2mssql.xsl](#adl2mssql.xsl)
* [5.3 adl2views.xsl](#adl2views.xsl) * [5.3 adl2views.xsl](#adl2views.xsl)
* [5.4 adl2controllerclasses.xsl](#adl2controllerclasses.xsl) * [5.4 adl2controllerclasses.xsl](#adl2controllerclasses.xsl)
* [5.5 adl2hibernate.xsl](#adl2hibernate.xsl) * [5.5 adl2hibernate.xsl](#adl2hibernate.xsl)
* [5.6 adl2pgsql.xsl](#adl2pgsql.xsl) * [5.6 adl2pgsql.xsl](#adl2pgsql.xsl)
* [6 So is ADL a quick way to build Monorail applications?](#So_is_ADL_a_quick_way_to_build_Monorail_applications.3F) * [6 So is ADL a quick way to build Monorail applications?](#So_is_ADL_a_quick_way_to_build_Monorail_applications)
* [7 Limitations on ADL](#Limitations_on_ADL) * [7 Limitations on ADL](#Limitations_on_ADL)
* [7.1 Current limitations](#Current_limitations) * [7.1 Current limitations](#Current_limitations)
* [7.1.1 Authentication model](#Authentication_model) * [7.1.1 Authentication model](#Authentication_model)

2
doc/js/highlight.min.js vendored Normal file
View file

File diff suppressed because one or more lines are too long

4
doc/js/jquery.min.js vendored Normal file
View file

File diff suppressed because one or more lines are too long

112
doc/js/page_effects.js Normal file
View file

@ -0,0 +1,112 @@
function visibleInParent(element) {
var position = $(element).position().top
return position > -50 && position < ($(element).offsetParent().height() - 50)
}
function hasFragment(link, fragment) {
return $(link).attr("href").indexOf("#" + fragment) != -1
}
function findLinkByFragment(elements, fragment) {
return $(elements).filter(function(i, e) { return hasFragment(e, fragment)}).first()
}
function scrollToCurrentVarLink(elements) {
var elements = $(elements);
var parent = elements.offsetParent();
if (elements.length == 0) return;
var top = elements.first().position().top;
var bottom = elements.last().position().top + elements.last().height();
if (top >= 0 && bottom <= parent.height()) return;
if (top < 0) {
parent.scrollTop(parent.scrollTop() + top);
}
else if (bottom > parent.height()) {
parent.scrollTop(parent.scrollTop() + bottom - parent.height());
}
}
function setCurrentVarLink() {
$('.secondary a').parent().removeClass('current')
$('.anchor').
filter(function(index) { return visibleInParent(this) }).
each(function(index, element) {
findLinkByFragment(".secondary a", element.id).
parent().
addClass('current')
});
scrollToCurrentVarLink('.secondary .current');
}
var hasStorage = (function() { try { return localStorage.getItem } catch(e) {} }())
function scrollPositionId(element) {
var directory = window.location.href.replace(/[^\/]+\.html$/, '')
return 'scroll::' + $(element).attr('id') + '::' + directory
}
function storeScrollPosition(element) {
if (!hasStorage) return;
localStorage.setItem(scrollPositionId(element) + "::x", $(element).scrollLeft())
localStorage.setItem(scrollPositionId(element) + "::y", $(element).scrollTop())
}
function recallScrollPosition(element) {
if (!hasStorage) return;
$(element).scrollLeft(localStorage.getItem(scrollPositionId(element) + "::x"))
$(element).scrollTop(localStorage.getItem(scrollPositionId(element) + "::y"))
}
function persistScrollPosition(element) {
recallScrollPosition(element)
$(element).scroll(function() { storeScrollPosition(element) })
}
function sidebarContentWidth(element) {
var widths = $(element).find('.inner').map(function() { return $(this).innerWidth() })
return Math.max.apply(Math, widths)
}
function calculateSize(width, snap, margin, minimum) {
if (width == 0) {
return 0
}
else {
return Math.max(minimum, (Math.ceil(width / snap) * snap) + (margin * 2))
}
}
function resizeSidebars() {
var primaryWidth = sidebarContentWidth('.primary')
var secondaryWidth = 0
if ($('.secondary').length != 0) {
secondaryWidth = sidebarContentWidth('.secondary')
}
// snap to grid
primaryWidth = calculateSize(primaryWidth, 32, 13, 160)
secondaryWidth = calculateSize(secondaryWidth, 32, 13, 160)
$('.primary').css('width', primaryWidth)
$('.secondary').css('width', secondaryWidth).css('left', primaryWidth + 1)
if (secondaryWidth > 0) {
$('#content').css('left', primaryWidth + secondaryWidth + 2)
}
else {
$('#content').css('left', primaryWidth + 1)
}
}
$(window).ready(resizeSidebars)
$(window).ready(setCurrentVarLink)
$(window).ready(function() { persistScrollPosition('.primary')})
$(window).ready(function() {
$('#content').scroll(setCurrentVarLink)
$(window).resize(setCurrentVarLink)
})

15
project.clj
View file

@ -5,7 +5,7 @@
:license {:name "GNU Lesser General Public License, version 3.0 or (at your option) any later version" :license {:name "GNU Lesser General Public License, version 3.0 or (at your option) any later version"
:url "https://www.gnu.org/licenses/lgpl-3.0.en.html"} :url "https://www.gnu.org/licenses/lgpl-3.0.en.html"}
:dependencies [[adl-support "0.1.4"] :dependencies [[adl-support "0.1.6-SNAPSHOT"]
[bouncer "1.0.1"] [bouncer "1.0.1"]
[clojure-saxon "0.9.4"] [clojure-saxon "0.9.4"]
[environ "1.1.0"] [environ "1.1.0"]
@ -20,25 +20,24 @@
:plugins [[lein-codox "0.10.3"] :plugins [[lein-codox "0.10.3"]
[lein-kibit "0.1.6"] [lein-kibit "0.1.6"]
[lein-release "1.0.5"] [lein-release "1.0.5"]]
;; [uncomplexor "0.1.0-SNAPSHOT"]
]
;; `lein release` doesn't play nice with `git flow release`. Run `lein release` in the :codox {:metadata {:doc "FIXME: write docs"}
;; `develop` branch, then merge the the release tag into the `master` branch. :output-path "doc"}
:deploy-repositories [["releases" :clojars] :deploy-repositories [["releases" :clojars]
["snapshots" :clojars]] ["snapshots" :clojars]]
;; `lein release` doesn't play nice with `git flow release`. Run `lein release` in the
;; `develop` branch, then merge the release tag into the `master` branch.
:release-tasks [["vcs" "assert-committed"] :release-tasks [["vcs" "assert-committed"]
["clean"] ["clean"]
["test"] ["test"]
["codox"] ["codox"]
["change" "version" "leiningen.release/bump-version" "release"] ["change" "version" "leiningen.release/bump-version" "release"]
["vcs" "commit"] ["vcs" "commit"]
;; ["vcs" "tag"] -- not working, problems with secret key
["uberjar"] ["uberjar"]
["install"] ["install"]
;; ["deploy" "clojars"] -- also not working
["change" "version" "leiningen.release/bump-version"] ["change" "version" "leiningen.release/bump-version"]
["vcs" "commit"]]) ["vcs" "commit"]])

12
resources/js/selectize-one.js
View file

@ -10,18 +10,16 @@ $('#{{widget_id}}').selectize({
create: false, create: false,
load: function(query, callback) { load: function(query, callback) {
console.log('Desperately seeking ' + query); if (query === null || !query.length || query.length < 5) return callback();
if (query === null || !query.length) return callback();
$.ajax({ $.ajax({
url: '/json/auto/search-strings-{{entity}}?{{field}}=' + query, url: '/json/auto/search-strings-{{entity}}?{{field}}=' + query,
type: 'GET', type: 'GET',
dataType: 'jsonp', dataType: 'json',
error: function() { error: function(xhr, status, error) {
console.log( 'Query ' + query + ' failed.'); console.log( 'Query `' + query + '` failed with status: `' + status + '`; error: `' + error +'`');
callback(); console.dir(xhr);
}, },
success: function(res) { success: function(res) {
console.log('Received ' + res + ' records for ' + query);
callback(res); callback(res);
} }
}); });

11
src/adl/main.clj
View file

@ -1,7 +1,8 @@
(ns ^{:doc "Application Description Language - command line invocation." (ns ^{:doc "Application Description Language - command line invocation."
:author "Simon Brooke"} :author "Simon Brooke"}
adl.main adl.main
(:require [adl.to-hugsql-queries :as h] (:require [adl.to-cache :as c]
[adl.to-hugsql-queries :as h]
[adl.to-json-routes :as j] [adl.to-json-routes :as j]
[adl.to-psql :as p] [adl.to-psql :as p]
[adl.to-selmer-routes :as s] [adl.to-selmer-routes :as s]
@ -41,6 +42,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def cli-options (def cli-options
"Command-line interface options"
[["-a" "--abstract-key-name-convention [string]" "the abstract key name convention to use for generated key fields (TODO: not yet implemented)" [["-a" "--abstract-key-name-convention [string]" "the abstract key name convention to use for generated key fields (TODO: not yet implemented)"
:default "id"] :default "id"]
["-h" "--help" "Show this message" ["-h" "--help" "Show this message"
@ -51,13 +53,13 @@
:default "generated"] :default "generated"]
["-v" "--verbosity [LEVEL]" nil "Verbosity level - integer value required" ["-v" "--verbosity [LEVEL]" nil "Verbosity level - integer value required"
:parse-fn #(Integer/parseInt %) :parse-fn #(Integer/parseInt %)
:default 0] :default 0]])
])
(defn usage [parsed-options] (defn usage
"Show a usage message. `parsed-options` should be options as "Show a usage message. `parsed-options` should be options as
parsed by [clojure.tools.cli](https://github.com/clojure/tools.cli)" parsed by [clojure.tools.cli](https://github.com/clojure/tools.cli)"
[parsed-options]
(print-usage (print-usage
"adl" "adl"
parsed-options parsed-options
@ -103,6 +105,7 @@
#(if #(if
(.exists (java.io.File. %)) (.exists (java.io.File. %))
(let [application (x/parse (canonicalise %))] (let [application (x/parse (canonicalise %))]
(c/to-cache application)
(h/to-hugsql-queries application) (h/to-hugsql-queries application)
(j/to-json-routes application) (j/to-json-routes application)
(p/to-psql application) (p/to-psql application)

124
src/adl/to_cache.clj Normal file
View file

@ -0,0 +1,124 @@
(ns ^{:doc "Application Description Language: generate caching layer for database requests."
:author "Simon Brooke"}
adl.to-cache
(:require [adl-support.core :refer :all]
[adl-support.utils :refer :all]
[adl.to-hugsql-queries :refer [generate-documentation queries]]
[clj-time.core :as t]
[clj-time.format :as f]
[clojure.java.io :refer [file make-parents writer]]
[clojure.pprint :refer [pprint]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; adl.to-cache: generate caching layer for database 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
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; You can't cache the actual HugSQL functions (or at least, I don't know how
;;; you would); there's no point caching JSON requests because the request data
;;; will be different every time.
;;; The overall structure of this has quite closely to follow the structure of
;;; to-hugsql-queries, because essentially we need one JSON entry point to wrap
;;; each query.
;;; TODO: memoisation of handlers probably doesn't make sense, because every request
;;; will be different. I don't think we can memoise HugSQL, at least not without
;;; hacking the library (might be worth doing that and contributing a patch).
;;; So the solution may be to an intervening namespace 'cache', which has one
;;; memoised function for each hugsql query.
(defn file-header
"Generate an appropriate file header for JSON routes for this `application`."
[application]
(list
'ns
(symbol (str (safe-name (:name (:attrs application))) ".cache"))
(str "Caching wrappers for queries for " (:name (:attrs application))
" auto-generated by [Application Description Language framework](https://github.com/simon-brooke/adl) at "
(f/unparse (f/formatters :basic-date-time) (t/now)))
(list
:require
'[adl-support.core :refer :all]
'[adl-support.rest-support :refer :all]
'[clojure.core.memoize :as memo]
'[clojure.java.io :as io]
'[clojure.tools.logging :as log]
'[compojure.core :refer [defroutes GET POST]]
'[hugsql.core :as hugsql]
'[noir.response :as nresponse]
'[noir.util.route :as route]
'[ring.util.http-response :as response]
(vector (symbol (str (safe-name (:name (:attrs application))) ".db.core")) :as 'db))))
(defn handler
"Generate declarations for handlers for this `query`. Cache handlers are needed only for select queries."
[query]
(let [handler-name (symbol (:name query))
v (volatility (:entity query))]
(if (and
(number? v)
(> v 0)
(#{:select-1 :select-many :text-search}(:type query)))
(list
'def
handler-name
(str
"Auto-generated function to "
(generate-documentation query))
(list
'memo/ttl
(list
'fn
['connection 'params]
(list
(symbol (str "db/" (:name query)))
'connection 'params))
{}
:ttl/threshold
(* v 1000))))))
(defn to-cache
"Generate a `/cache.clj` file for this `application`."
[application]
(let [queries-map (queries application)
filepath (str *output-path* "src/clj/" (:name (:attrs application)) "/cache.clj")]
(make-parents filepath)
(do-or-warn
(with-open [output (writer filepath)]
(binding [*out* output]
(pprint (file-header application))
(println)
(doall
(map
(fn [k]
(let [k (handler (queries-map k))]
(if k
(do
(pprint k)
(println)))
k))
(sort (keys queries-map)))))))
(if (pos? *verbosity*)
(*warn* (str "\tGenerated " filepath)))))

102
src/adl/to_hugsql_queries.clj
View file

@ -50,7 +50,7 @@
(str (str
"WHERE " "WHERE "
(s/join (s/join
"\n\tAND" "\n\tAND "
(map (map
#(str entity-name "." (safe-name % :sql) " = :" %) #(str entity-name "." (safe-name % :sql) " = :" %)
property-names))))))) property-names)))))))
@ -66,7 +66,7 @@
(let (let
[entity-name (safe-name entity :sql) [entity-name (safe-name entity :sql)
preferred (filter #(#{"user" "all"} (-> % :attrs :distinct)) preferred (filter #(#{"user" "all"} (-> % :attrs :distinct))
(children entity #(= (:tag %) :property)))] (descendants-with-tag entity :property))]
(if (if
(empty? preferred) (empty? preferred)
"" ""
@ -79,7 +79,10 @@
(and expanded? (= "entity" (-> % :attrs :type))) (and expanded? (= "entity" (-> % :attrs :type)))
(str (safe-name % :sql) expanded-token) (str (safe-name % :sql) expanded-token)
(safe-name % :sql)) (safe-name % :sql))
(flatten (cons preferred (key-properties entity)))))))))) (order-preserving-set
(concat
preferred
(key-properties entity))))))))))
;; (def a (x/parse "../youyesyet/youyesyet.adl.xml")) ;; (def a (x/parse "../youyesyet/youyesyet.adl.xml"))
;; (def e (child-with-tag a :entity #(= "dwellings" (-> % :attrs :name)))) ;; (def e (child-with-tag a :entity #(= "dwellings" (-> % :attrs :name))))
@ -287,11 +290,12 @@
(defn foreign-queries (defn foreign-queries
"Generate any foreign entity queries for this `entity` of this `application`."
[entity application] [entity application]
(let [entity-name (:name (:attrs entity)) (let [entity-name (:name (:attrs entity))
pretty-name (singularise entity-name) pretty-name (singularise entity-name)
entity-safe (safe-name entity :sql) entity-safe (safe-name entity :sql)
links (filter #(#{"list" "link" "entity"} (:type (:attrs %))) (children-with-tag entity :property))] links (filter #(:entity (:attrs %)) (children-with-tag entity :property))]
(apply (apply
merge merge
(map (map
@ -308,7 +312,7 @@
farkey (-> % :attrs :farkey) farkey (-> % :attrs :farkey)
link-type (-> % :attrs :type) link-type (-> % :attrs :type)
link-field (-> % :attrs :name) link-field (-> % :attrs :name)
query-name (list-related-query-name % entity far-entity) query-name (list-related-query-name % entity far-entity false)
signature ":? :*"] signature ":? :*"]
(hash-map (hash-map
(keyword query-name) (keyword query-name)
@ -326,24 +330,24 @@
"entity" (list "entity" (list
(str "-- :name " query-name " " signature) (str "-- :name " query-name " " signature)
(str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name) (str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name)
(str "SELECT lv_" entity-safe ".* \nFROM lv_" entity-safe) (str "SELECT DISTINCT lv_" entity-safe ".* \nFROM lv_" entity-safe)
(str "WHERE lv_" entity-safe "." (safe-name % :sql) " = :id") (str "WHERE lv_" entity-safe "." (safe-name % :sql) " = :id")
(order-by-clause entity "lv_" false)) (order-by-clause entity "lv_" false))
"link" (let [link-table-name "link" (let [ltn
(link-table-name % entity far-entity)] (link-table-name % entity far-entity)]
(list (list
(str "-- :name " query-name " " signature) (str "-- :name " query-name " " signature)
(str "-- :doc links all existing " pretty-far " records related to a given " pretty-name) (str "-- :doc links all existing " pretty-far " records related to a given " pretty-name)
(str "SELECT lv_" safe-far ".* \nFROM lv_" safe-far ", " link-table-name) (str "SELECT DISTINCT lv_" safe-far ".* \nFROM lv_" safe-far ", " ltn)
(str "WHERE lv_" safe-far "." (str "WHERE lv_" safe-far "."
(safe-name (first (key-names far-entity)) :sql) (safe-name (first (key-names far-entity)) :sql)
" = " link-table-name "." (singularise safe-far) "_id") " = " ltn "." (singularise safe-far) "_id")
(str "\tAND " link-table-name "." (singularise entity-safe) "_id = :id") (str "\tAND " ltn "." (singularise entity-safe) "_id = :id")
(order-by-clause far-entity "lv_" false))) (order-by-clause far-entity "lv_" false)))
"list" (list "list" (list
(str "-- :name " query-name " " signature) (str "-- :name " query-name " " signature)
(str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name) (str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name)
(str "SELECT lv_" safe-far ".* \nFROM lv_" safe-far) (str "SELECT DISTINCT lv_" safe-far ".* \nFROM lv_" safe-far)
(str "WHERE lv_" safe-far "." (safe-name (first (key-names far-entity)) :sql) " = :id") (str "WHERE lv_" safe-far "." (safe-name (first (key-names far-entity)) :sql) " = :id")
(order-by-clause far-entity "lv_" false)) (order-by-clause far-entity "lv_" false))
(list (str "ERROR: unexpected type " link-type " of property " %))))) (list (str "ERROR: unexpected type " link-type " of property " %)))))
@ -351,8 +355,9 @@
links)))) links))))
(defn delete-query [entity] (defn delete-query
"Generate an appropriate `delete` query for this `entity`" "Generate an appropriate `delete` query for this `entity`"
[entity]
(if (if
(has-primary-key? entity) (has-primary-key? entity)
(let [entity-name (safe-name entity :sql) (let [entity-name (safe-name entity :sql)
@ -367,7 +372,7 @@
:type :delete-1 :type :delete-1
:query :query
(str "-- :name " query-name " " signature "\n" (str "-- :name " query-name " " signature "\n"
"-- :doc updates an existing " pretty-name " record\n" "-- :doc deletes an existing " pretty-name " record\n"
"DELETE FROM " entity-name "\n" "DELETE FROM " entity-name "\n"
(where-clause entity))})))) (where-clause entity))}))))
@ -418,3 +423,74 @@
(if (pos? *verbosity*) (if (pos? *verbosity*)
(*warn* (str "\tGenerated " filepath))))))) (*warn* (str "\tGenerated " filepath)))))))
(defn generate-documentation
"Generate, as a string, appropriate documentation for a function wrapping this `query` map."
[query]
(let [v (volatility (:entity query))]
(s/join
" "
(list
(case
(:type query)
:delete-1
(str "delete one record from the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(-> query :entity key-names)
"`.")
:insert-1
(str "insert one record to the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(pr-str
(map
#(keyword (:name (:attrs %)))
(-> query :entity insertable-properties )))
"`. Returns a map containing the keys `"
(-> query :entity key-names)
"` identifying the record created.")
:select-1
(str "select one record from the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(-> query :entity key-names)
"`. Returns a map containing the following keys: `"
(map #(keyword (:name (:attrs %))) (-> query :entity all-properties))
"`.")
:select-many
(str "select all records from the `"
(-> query :entity :attrs :name)
"` table. If the keys `(:limit :offset)` are present in the request then they will be used to page through the data. Returns a sequence of maps each containing the following keys: `"
(pr-str
(map
#(keyword (:name (:attrs %)))
(-> query :entity all-properties)))
"`.")
:text-search
(str "select all records from the `"
(-> query :entity :attrs :name)
;; TODO: this doc-string is out of date
"` table with any text field matching the value of the key `:pattern` which should be in the request. If the keys `(:limit :offset)` are present in the request then they will be used to page through the data. Returns a sequence of maps each containing the following keys: `"
(pr-str
(map
#(keyword (:name (:attrs %)))
(-> query :entity all-properties)))
"`.")
:update-1
(str "update one record in the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(pr-str
(distinct
(sort
(map
#(keyword (:name (:attrs %)))
(flatten
(cons
(-> query :entity key-properties)
(-> query :entity insertable-properties)))))))
"`."))
(if-not
(zero? v)
(str "Results will be held in cache for " v " seconds."))))))

170
src/adl/to_json_routes.clj
View file

@ -3,7 +3,7 @@
adl.to-json-routes adl.to-json-routes
(:require [adl-support.core :refer :all] (:require [adl-support.core :refer :all]
[adl-support.utils :refer :all] [adl-support.utils :refer :all]
[adl.to-hugsql-queries :refer [queries]] [adl.to-hugsql-queries :refer [generate-documentation queries]]
[clj-time.core :as t] [clj-time.core :as t]
[clj-time.format :as f] [clj-time.format :as f]
[clojure.java.io :refer [file make-parents writer]] [clojure.java.io :refer [file make-parents writer]]
@ -44,7 +44,9 @@
;;; So the solution may be to an intervening namespace 'cache', which has one ;;; So the solution may be to an intervening namespace 'cache', which has one
;;; memoised function for each hugsql query. ;;; memoised function for each hugsql query.
(defn file-header [application] (defn file-header
"Generate an appropriate file header for JSON routes for this `application`."
[application]
(list (list
'ns 'ns
(symbol (str (safe-name (:name (:attrs application))) ".routes.auto-json")) (symbol (str (safe-name (:name (:attrs application))) ".routes.auto-json"))
@ -63,10 +65,14 @@
'[noir.response :as nresponse] '[noir.response :as nresponse]
'[noir.util.route :as route] '[noir.util.route :as route]
'[ring.util.http-response :as response] '[ring.util.http-response :as response]
(vector (symbol (str (safe-name (:name (:attrs application))) ".cache")) :as 'cache)
(vector (symbol (str (safe-name (:name (:attrs application))) ".db.core")) :as 'db)))) (vector (symbol (str (safe-name (:name (:attrs application))) ".db.core")) :as 'db))))
(defn declarations [handlers-map] (defn declarations
"Generate a forward declaration of all JSON route handlers we're going to
generate for this `application`."
[handlers-map]
(cons 'declare (sort (map #(symbol (name %)) (keys handlers-map))))) (cons 'declare (sort (map #(symbol (name %)) (keys handlers-map)))))
@ -75,6 +81,19 @@
[query] [query]
(list (list
['request] ['request]
(let
[v (volatility (:entity query))
function (symbol (str
(if
(and
(number? v)
(> v 0)
(#{:select-1 :select-many :text-search} (:type query)))
"cache"
"db")
"/"
(:name query)))]
(list (list
'let 'let
['params (list ['params (list
@ -96,7 +115,7 @@
(list (list
'do-or-server-fail 'do-or-server-fail
(list (list
(symbol (str "db/" (:name query))) function
'db/*db* 'params) 'db/*db* 'params)
(case (:type query) (case (:type query)
:insert-1 201 ;; created :insert-1 201 ;; created
@ -117,36 +136,26 @@
(-> query :entity key-properties) (-> query :entity key-properties)
;; default ;; default
nil)))) nil))))
'request)))) 'request)))))
(defn generate-handler-src (defn generate-handler-src
"Generate and return the handler for this `query`." "Generate and return the handler for this `query`."
[handler-name query-map method doc] [handler-name query-map method]
(let [doc (str
"Auto-generated function to "
(generate-documentation query-map))
v (volatility (:entity query-map))]
(hash-map (hash-map
:method method :method method
:src (remove :src (remove
nil? nil?
(if
(or
(zero? (volatility (:entity query-map)))
(#{:delete-1 :insert-1 :update-1} (:type query-map)))
(concat (concat
(list (list
'defn 'defn
handler-name handler-name
(str "Auto-generated method to " doc)) doc
(generate-handler-body query-map)) (generate-handler-body query-map)))))))
(concat
(list
'def
handler-name
(list
'memo/ttl
(cons 'fn (generate-handler-body query-map))
{}
:ttl/threshold
(* (volatility (:entity query-map)) 1000))))))))
(defn handler (defn handler
@ -163,76 +172,12 @@
:route (str "/json/" handler-name)} :route (str "/json/" handler-name)}
(case (case
(:type query) (:type query)
:delete-1 (:delete-1 :insert-1 :update-1)
(generate-handler-src (generate-handler-src
handler-name query :post handler-name query :post)
(str "delete one record from the `" (:select-1 :select-many :text-search)
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(-> query :entity key-names)
"`."))
:insert-1
(generate-handler-src (generate-handler-src
handler-name query :post handler-name query :get)
(str "insert one record to the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(pr-str
(map
#(keyword (:name (:attrs %)))
(-> query :entity insertable-properties )))
"`. Returns a map containing the keys `"
(-> query :entity key-names)
"` identifying the record created."))
:update-1
(generate-handler-src
handler-name query :post
(str "update one record in the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(pr-str
(distinct
(sort
(map
#(keyword (:name (:attrs %)))
(flatten
(cons
(-> query :entity key-properties)
(-> query :entity insertable-properties)))))))
"`."))
:select-1
(generate-handler-src
handler-name query :get
(str "select one record from the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(-> query :entity key-names)
"`. Returns a map containing the following keys: `"
(map #(keyword (:name (:attrs %))) (-> query :entity all-properties))
"`."))
:select-many
(generate-handler-src
handler-name query :get
(str "select all records from the `"
(-> query :entity :attrs :name)
"` table. If the keys `(:limit :offset)` are present in the request then they will be used to page through the data. Returns a sequence of maps each containing the following keys: `"
(pr-str
(map
#(keyword (:name (:attrs %)))
(-> query :entity all-properties)))
"`."))
:text-search
(generate-handler-src
handler-name query :get
(str "select all records from the `"
(-> query :entity :attrs :name)
;; TODO: this doc-string is out of date
"` table with any text field matching the value of the key `:pattern` which should be in the request. If the keys `(:limit :offset)` are present in the request then they will be used to page through the data. Returns a sequence of maps each containing the following keys: `"
(pr-str
(map
#(keyword (:name (:attrs %)))
(-> query :entity all-properties)))
"`."))
(:select-many-to-many (:select-many-to-many
:select-one-to-many) :select-one-to-many)
(hash-map :method :get (hash-map :method :get
@ -244,26 +189,8 @@
(str ";; don't know what to do with query `" :key "` of type `" (:type query) "`."))))))) (str ";; don't know what to do with query `" :key "` of type `" (:type query) "`.")))))))
(defn defroutes [handlers-map]
"Generate JSON routes for all queries implied by this ADL `application` spec."
(cons
'defroutes
(cons
'auto-rest-routes
(map
#(let [handler (handlers-map %)]
(list
(symbol (s/upper-case (name (:method handler))))
(str "/json/auto/" (safe-name (:name handler)))
'request
(list
'route/restricted
(list (:name handler) 'request))))
(sort
(keys handlers-map))))))
(defn make-handlers-map (defn make-handlers-map
"Analyse this `application` and generate from it a map of the handlers to be output."
[application] [application]
(reduce (reduce
merge merge
@ -281,7 +208,28 @@
(children-with-tag application :entity)))) (children-with-tag application :entity))))
(defn defroutes
"Generate JSON routes for all queries implied by this ADL `application` spec."
[handlers-map]
(cons
'defroutes
(cons
'auto-rest-routes
(map
#(let [handler (handlers-map %)]
(list
(symbol (s/upper-case (name (:method handler))))
(str "/json/auto/" (safe-name (:name handler)))
'request
(list
'route/restricted
(list (:name handler) 'request))))
(sort
(keys handlers-map))))))
(defn to-json-routes (defn to-json-routes
"Generate a `/routes/auto-json.clj` file for this `application`."
[application] [application]
(let [handlers-map (make-handlers-map application) (let [handlers-map (make-handlers-map application)
filepath (str *output-path* "src/clj/" (:name (:attrs application)) "/routes/auto_json.clj")] filepath (str *output-path* "src/clj/" (:name (:attrs application)) "/routes/auto_json.clj")]
@ -298,8 +246,8 @@
(println) (println)
h) h)
(sort (keys handlers-map)))) (sort (keys handlers-map))))
(pprint (defroutes handlers-map)))) (pprint (defroutes handlers-map)))))
(if (pos? *verbosity*) (if (pos? *verbosity*)
(*warn* (str "\tGenerated " filepath)))))) (*warn* (str "\tGenerated " filepath)))))

62
src/adl/to_psql.clj
View file

@ -41,6 +41,8 @@
(defn emit-defined-field-type (defn emit-defined-field-type
"Generate appropriate field type and constraints for this `property`
given this `typedef`."
[property application] [property application]
(let [typedef (typedef property application)] (let [typedef (typedef property application)]
;; this is a hack based on the fact that emit-field-type doesn't check ;; this is a hack based on the fact that emit-field-type doesn't check
@ -90,12 +92,9 @@
(defn emit-entity-field-type (defn emit-entity-field-type
"Emit an appropriate field type for this `property`, expected to reference an entity, in this `application`."
[property application] [property application]
(let [farside (child (let [farside (entity-for-property property application)
application
#(and
(entity? %)
(= (:name (:attrs %)) (:entity (:attrs property)))))
key-properties (children-with-tag key-properties (children-with-tag
(first (children-with-tag farside :key)) (first (children-with-tag farside :key))
:property)] :property)]
@ -109,6 +108,8 @@
(defn emit-field-type (defn emit-field-type
"Emit an appropriate field type for this `property`, expected to belong to
this `entity` within this `application`."
[property entity application key?] [property entity application key?]
(case (:type (:attrs property)) (case (:type (:attrs property))
"integer" (if "integer" (if
@ -128,6 +129,8 @@
(defn emit-link-field (defn emit-link-field
"Emit an appropriate link field for this `property` of this `entity`
within this `application`."
[property entity application] [property entity application]
(emit-property (emit-property
{:tag :property {:tag :property
@ -140,6 +143,10 @@
(defn emit-permissions-grant (defn emit-permissions-grant
"Emit an appropriate grant of permissions on this `table-name` at this
`privilege` level given these `permissions`. `privilege` is expected
to be one of #{:SELECT :INSERT :UPDATE :DELETE}.
TODO: more thought needed here."
[table-name privilege permissions] [table-name privilege permissions]
(let [selector (let [selector
(case privilege (case privilege
@ -172,6 +179,8 @@
(defn field-name (defn field-name
"Return the appropriate field name for this `property`.
TODO: really belongs in `adl-support.utils`."
[property] [property]
(safe-name (safe-name
(or (or
@ -181,6 +190,7 @@
(defn emit-property (defn emit-property
"Emit a field declaration representing this `property` of this `entity` within this `application`."
([property entity application] ([property entity application]
(emit-property property entity application false)) (emit-property property entity application false))
([property entity application key?] ([property entity application key?]
@ -215,11 +225,7 @@
(defn compose-convenience-entity-field (defn compose-convenience-entity-field
[field entity application] [field entity application]
(let [farside (child (let [farside (entity-for-property (property-for-field field entity) application)]
application
#(and
(entity? %)
(= (:name (:attrs %)) (:entity (:attrs field)))))]
(flatten (flatten
(map (map
(fn [f] (fn [f]
@ -231,6 +237,9 @@
(defn compose-convenience-view-select-list (defn compose-convenience-view-select-list
"Compose the body of an SQL `SELECT` statement for a convenience view of this
`entity` within this `application`, recursively. `top-level?` should be set
only on first invocation."
[entity application top-level?] [entity application top-level?]
(remove (remove
nil? nil?
@ -252,8 +261,10 @@
(defn compose-convenience-where-clause (defn compose-convenience-where-clause
;; TODO: does not correctly compose links at one stage down the tree. "Compose an SQL `WHERE` clause for a convenience view of this
;; See lv_electors, lv_followuprequests for examples of the problem. `entity` within this `application`.
TODO: does not correctly compose links at one stage down the tree.
See `lv_electors`, `lv_followuprequests` for examples of the problem."
[entity application top-level?] [entity application top-level?]
(remove (remove
nil? nil?
@ -336,11 +347,7 @@
(map (map
(fn [f] (fn [f]
(let (let
[farside (child [farside (entity-for-property f application)]
application
#(and
(entity? %)
(= (:name (:attrs %)) (:entity (:attrs f)))))]
(str (str
(safe-name (:table (:attrs entity)) :sql) (safe-name (:table (:attrs entity)) :sql)
"." "."
@ -355,6 +362,8 @@
(defn emit-referential-integrity-link (defn emit-referential-integrity-link
"Emit a referential integrity link for this `property` of the entity
`nearside` within this `application`."
[property nearside application] [property nearside application]
(let (let
[farside (entity-for-property property application)] [farside (entity-for-property property application)]
@ -382,6 +391,8 @@
(defn emit-referential-integrity-links (defn emit-referential-integrity-links
"Emit all appropriate referential integrity links for this `entity`
within this `application`."
([entity application] ([entity application]
(map (map
#(emit-referential-integrity-link % entity application) #(emit-referential-integrity-link % entity application)
@ -401,6 +412,8 @@
(defn emit-table (defn emit-table
"Emit a table declaration for this `entity` of this `application`,
documented with this `doc-comment` if specified."
([entity application doc-comment] ([entity application doc-comment]
(let [table-name (safe-name (:table (:attrs entity)) :sql) (let [table-name (safe-name (:table (:attrs entity)) :sql)
permissions (children-with-tag entity :permission)] permissions (children-with-tag entity :permission)]
@ -450,6 +463,8 @@
(defn construct-link-property (defn construct-link-property
"Create a dummy property for a link-table referencing this `entity`, in order
that the field generation functions already defined may be applied to it."
[entity] [entity]
{:tag :property {:tag :property
:attrs {:name (safe-name (str (singularise (:name (:attrs entity))) "_id") :sql) :attrs {:name (safe-name (str (singularise (:name (:attrs entity))) "_id") :sql)
@ -460,6 +475,11 @@
(defn emit-link-table (defn emit-link-table
"Emit a link table for the specified `property` of the entity `e1` within
this `application`, provided that such a table has not already been emitted
from the other end. The argument `emitted-link-tables` contains an atom
which references a set of the names of all those link tables which have
already been emitted, and this is modified in the execution of this function."
[property e1 application emitted-link-tables] [property e1 application emitted-link-tables]
(let [e2 (child (let [e2 (child
application application
@ -511,6 +531,8 @@
(defn emit-link-tables (defn emit-link-tables
"Emit all required link tables for this `entity` within this `application`,
given these `emitted-link-tables` which have already been emitted."
([entity application emitted-link-tables] ([entity application emitted-link-tables]
(map (map
#(emit-link-table % entity application emitted-link-tables) #(emit-link-table % entity application emitted-link-tables)
@ -525,6 +547,7 @@
(defn emit-group-declaration (defn emit-group-declaration
"Emit a declaration for this authorisation `group` within this `application`."
[group application] [group application]
(list (list
(emit-header (emit-header
@ -534,6 +557,8 @@
(defn emit-file-header (defn emit-file-header
"Generate an appropriate file header for the Postgres initialisation script
for this `application`."
[application] [application]
(emit-header (emit-header
"--" "--"
@ -550,6 +575,8 @@
(defn emit-application (defn emit-application
"Emit all SQL declarations required to initialise a Postgres database for
this `application`."
[application] [application]
(let [emitted-link-tables (atom #{})] (let [emitted-link-tables (atom #{})]
(s/join (s/join
@ -574,6 +601,7 @@
(defn to-psql (defn to-psql
"Generate a complete Postgres database initialisation script for this `application`."
[application] [application]
(let [filepath (str (let [filepath (str
*output-path* *output-path*

87
src/adl/to_reframe.clj
View file

@ -1,4 +1,6 @@
(ns adl.to-reframe (ns ^{:doc "Application Description Language: generate re-frame UI. TODO: doesn't even nearly work yet."
:author "Simon Brooke"}
adl.to-reframe
(:require [adl-support.utils :refer :all] (:require [adl-support.utils :refer :all]
[clojure.string :as s] [clojure.string :as s]
[clj-time.core :as t] [clj-time.core :as t]
@ -31,6 +33,7 @@
(defn file-header (defn file-header
"Generate an appropriate file header for a re-frame view."
([parent-name this-name extra-requires] ([parent-name this-name extra-requires]
(list 'ns (symbol (str parent-name ".views." this-name)) (list 'ns (symbol (str parent-name ".views." this-name))
(str "Re-frame views for " parent-name (str "Re-frame views for " parent-name
@ -47,44 +50,46 @@
(defn generate-form (defn generate-form
"Generate as re-frame this `form` taken from this `entity` of this `document`." "Generate as re-frame this `form` taken from this `entity` of this `application`.
[form entity application]
(let [record @(subscribe [:record]) TODO: write it!"
errors @(subscribe [:errors]) [form entity application]
messages @(subscribe [:messages]) ;; (let [record @(subscribe [:record])
properties (required-properties entity form)] ;; errors @(subscribe [:errors])
(list ;; messages @(subscribe [:messages])
'defn ;; properties (required-properties entity form)]
(symbol ;; (list
(s/join ;; 'defn
"-" ;; (symbol
(:name (:attrs entity)) ;; (s/join
(:name (:attrs form)) ;; "-"
"-form-panel")) ;; (:name (:attrs entity))
[] ;; (:name (:attrs form))
(apply ;; "-form-panel"))
vector ;; []
(remove ;; (apply
nil? ;; vector
(list ;; (remove
:div ;; nil?
(or ;; (list
(:top (:content form)) ;; :div
(:top (:content application))) ;; (or
(map #(list 'ui/error-panel %) errors) ;; (:top (:content form))
(map #(list 'ui/message-panel %) messages) ;; (:top (:content application)))
[:h1 (:name (:attrs form))] ;; (map #(list 'ui/error-panel %) errors)
[:div.container {:id "main-container"} ;; (map #(list 'ui/message-panel %) messages)
(apply ;; [:h1 (:name (:attrs form))]
vector ;; [:div.container {:id "main-container"}
(list ;; (apply
:div ;; vector
{} ;; (list
(map ;; :div
#(generate-widget % form entity) ;; {}
properties)))] ;; (map
(or ;; #(generate-widget % form entity)
(:foot (:content form)) ;; properties)))]
(:foot (:content application)))))) ;; (or
))) ;; (:foot (:content form))
;; (:foot (:content application))))))))
)

157
src/adl/to_selmer_routes.clj
View file

@ -66,7 +66,11 @@
(defn compose-fetch-record (defn compose-fetch-record
[e] "Compose Clojure code to retrieve a single record of entity `e` in application `a`; in addition
to the fields of the record in the database, the record should also contain the values of
the `link` and `list` properties of the entity, retrieved from their tables.
TODO: what about `entity` properties?."
[e a]
(let (let
[entity-name (singularise (:name (:attrs e))) [entity-name (singularise (:name (:attrs e)))
warning (str warning (str
@ -80,70 +84,85 @@
'params (set (map #(keyword (safe-name % :sql)) (key-names e)))) 'params (set (map #(keyword (safe-name % :sql)) (key-names e))))
(list (list
'support/do-or-log-error 'support/do-or-log-error
(cons
'merge
(cons
(list (list
(query-name e :get) (query-name e :get)
(symbol "db/*db*") (symbol "db/*db*")
'params) 'params)
(map
#(let [farside (entity-for-property % a)
farkey (keyword (or (:farkey %) (first (key-names farside))))]
{(keyword (-> % :attrs :name))
(list
'map
(keyword (first (key-names farside)))
(list
(symbol
(str "db/" (list-related-query-name % e farside)))
'db/*db*
{farkey (list (keyword (first (key-names e))) 'params)}))})
(filter
#(#{"link" "list"} (-> % :attrs :type))
(properties e)))))
:message warning :message warning
:error-return {:warnings [warning]}) :error-return {:warnings [warning]})
'params))) 'params)))
(defn compose-get-menu-options (defn compose-get-menu-options
[property application] "Compose Clojure code to fetch from the database menu options for this
;; TODO: doesn't handle the case of type="link" `property` within this `application`."
(case (-> property :attrs :type) [property nearside application]
"entity" (if-let [e (child-with-tag (if-let [farside (entity-for-property property application)]
application
:entity
#(= (-> % :attrs :name)
(-> property :attrs :entity)))]
(hash-map (hash-map
(keyword (-> property :attrs :name)) (keyword (-> property :attrs :name))
(list
'sort-by
(keyword (first (user-distinct-property-names farside)))
(list
'set
(list (list
'get-menu-options 'get-menu-options
(singularise (-> e :attrs :name)) (singularise (-> farside :attrs :name))
(query-name e :search-strings) (case
(query-name e :search-strings) (-> property :attrs :type)
(keyword (-> property :attrs :farkey)) ("list" "link")
(list (keyword (-> property :attrs :name)) 'params))) (list-related-query-name property nearside farside true)
{}) "entity"
"link" (list (query-name farside :get))
'do (query-name farside :search-strings)
(keyword (or (-> property :attrs :farkey)
(first (key-names farside))))
(list (list
'comment (keyword
"Can't yet handle link properties") (case
{}) (-> property :attrs :type)
"list" (list ("link" "list")
'do (first (key-names nearside))
(list "entity"
'comment (-> property :attrs :name)))
"Can't yet handle link properties") 'record)))))
{}) (throw (Exception. (str "Unexpected type " (-> property :atts :type))))))
(list
'do
(list
'comment
(str "Unexpected type " (-> property :atts :type)))
{})))
(defn compose-fetch-auxlist-data (defn compose-fetch-auxlist-data
"Compose Clojure code to fetch data to populate this `auxlist` of a form
editing a record of this `entity` within this `application`."
[auxlist entity application] [auxlist entity application]
(let [p-name (-> auxlist :attrs :property) (let [p-name (-> auxlist :attrs :property)
property (child-with-tag entity property (child-with-tag entity
:property :property
#(= (-> % :attrs :name) p-name)) #(= (-> % :attrs :name) p-name))
f-name (-> property :attrs :entity) f-name (-> property :attrs :entity)
farside (child-with-tag application farside (entity-for-property property application)]
:entity
#(= (-> % :attrs :name) f-name))]
(if (and (entity? entity) (entity? farside)) (if (and (entity? entity) (entity? farside))
(list 'if (list 'all-keys-present? 'params (key-names entity true)) (list 'if (list 'all-keys-present? 'params (key-names entity true))
(hash-map (hash-map
(keyword (auxlist-data-name auxlist)) (keyword (auxlist-data-name auxlist))
(list (list
(symbol (str "db/" (list-related-query-name property entity farside))) (list-related-query-name property entity farside true)
'db/*db* 'db/*db*
{:id {:id
(list (list
@ -171,23 +190,37 @@
(defn make-form-get-handler-content (defn make-form-get-handler-content
"Compose Clojure code to form body of an HTTP `GET` handler for the form
`f` of the entity `e` within application `a`. The argument `n`
is not used."
[f e a n] [f e a n]
(list (list
'let 'let
(vector (vector
'record (compose-fetch-record e)) 'record (compose-fetch-record e a))
(list (list
'reduce 'reduce
'merge 'merge
{:error (list :warnings 'record) {:title (list
'form-title
'record
(capitalise (:name (:attrs f)))
(apply
vector
(map
#(keyword (safe-name %))
(user-distinct-properties e))))
:error (list :warnings 'record)
:record (list 'dissoc 'record :warnings)} :record (list 'dissoc 'record :warnings)}
(cons (cons
'list 'list
(concat (concat
(map (map
#(compose-get-menu-options % a) #(compose-get-menu-options % e a)
(filter #(:entity (:attrs %)) (descendants-with-tag
(descendants-with-tag e :property))) e
:property
#(#{"link" "list" "entity"} (-> % :attrs :type))))
(map (map
#(compose-fetch-auxlist-data % e a) #(compose-fetch-auxlist-data % e a)
(descendants-with-tag f :auxlist)) (descendants-with-tag f :auxlist))
@ -199,16 +232,20 @@
(defn make-page-get-handler-content (defn make-page-get-handler-content
"Compose Clojure code to form body of an HTTP `GET` handler for the page
`f` of the entity `e` within application `a`. The argument `n` is ignored."
[f e a n] [f e a n]
(list (list
'let 'let
(vector (vector
'record (compose-fetch-record e)) 'record (compose-fetch-record e a))
{:warnings (list :warnings 'record) {:warnings (list :warnings 'record)
:record (list 'assoc 'record :warnings nil)})) :record (list 'assoc 'record :warnings nil)}))
(defn make-list-get-handler-content (defn make-list-get-handler-content
"Compose Clojure code to form body of an HTTP `GET` handler for the list
`f` of the entity `e` within application `a`. The argument `n` is ignored."
[f e a n] [f e a n]
(list (list
'let 'let
@ -280,6 +317,8 @@
(defn make-get-handler (defn make-get-handler
"Generate a Clojure function to handle HTTP `GET` requests for form, list or
page `f` of entity `e` within application `a`."
[f e a] [f e a]
(let [n (handler-name f e a :get)] (let [n (handler-name f e a :get)]
(list (list
@ -288,15 +327,18 @@
(vector 'request) (vector 'request)
(list 'let (vector (list 'let (vector
'params 'params
(list (list 'support/massage-params 'request))
'merge
(property-defaults e)
(list 'support/massage-params 'request)))
(list (list
'l/render 'l/render
(list 'support/resolve-template (str (path-part f e a) ".html")) (list 'support/resolve-template (str (path-part f e a) ".html"))
(list 'merge (list 'merge
{:title (capitalise (:name (:attrs f))) {:title (case (:tag f)
:list
(str "List " (pretty-name e))
:form
(str "Add a " (singularise (pretty-name e)))
:page
(singularise (pretty-name e)))
:params 'params} :params 'params}
(case (:tag f) (case (:tag f)
:form (make-form-get-handler-content f e a n) :form (make-form-get-handler-content f e a n)
@ -307,14 +349,17 @@
(defn make-form-post-handler-content (defn make-form-post-handler-content
"Generate the body of the post handler for the form `f` of "Generate the body of the post handler for the form `f` of
entity `e` in application `a`. The argument `n` is bound to the name entity `e` in application `a`. The argument `n` is bound to the name
of the function, but is not currently used." of the function, but is not currently used.
;; Literally the only thing the post handler has to do is to
;; generate the database store operation. Then it can hand off Literally the only thing the post handler has to do is to
;; to the get handler. execute the database store operation. Then it can hand off
to the get handler."
[f e a n] [f e a n]
(let (let
[create-name (query-name e :create) [create-name (query-name e :create)
update-name (query-name e :update)] update-name (query-name e :update)]
;; NOTE! Default values should be specified on database fields. They
;; should NOT be inserted by application layer code.
(list (list
'let 'let
(vector (vector
@ -372,7 +417,8 @@
(list 'merge 'params (list 'merge 'params
(list :body 'result)) (list :body 'result))
:message :message
(list 'str "Record created")(list :body 'result)) (list 'str "Record created")
(list :body 'result))
(list (list
'catch 'Exception 'x 'catch 'Exception 'x
{:message "Record created" {:message "Record created"
@ -381,6 +427,8 @@
(defn make-post-handler (defn make-post-handler
"Generate an HTTP `POST` handler for the page, form or list `f` of the
entity `e` of application `a`."
[f e a] [f e a]
(let [n (handler-name f e a :post)] (let [n (handler-name f e a :post)]
(list (list
@ -427,6 +475,8 @@
(defn make-defroutes (defn make-defroutes
"Generate a `defroutes` declaration for all routes of all forms, pages and
lists within this `application`."
[application] [application]
(let [routes (flatten (let [routes (flatten
(map (map
@ -475,6 +525,8 @@
(defn make-handlers (defn make-handlers
"Generate all the Selmer route handlers for all the forms, lists and pages
of the entity `e` within this `application`."
[e application] [e application]
(doall (doall
(map (map
@ -489,6 +541,7 @@
(defn to-selmer-routes (defn to-selmer-routes
"Generate a `/routes/auto.clj` file for this `application`."
[application] [application]
(let [filepath (str (let [filepath (str
*output-path* *output-path*

74
src/adl/to_selmer_templates.clj
View file

@ -39,6 +39,8 @@
(defn big-link (defn big-link
"Generate a primary navigation link with this `content` to this `url`.
TODO: should be renamed. `primary-link` would be better."
[content url] [content url]
{:tag :div {:tag :div
:attrs {:class "big-link-container"} :attrs {:class "big-link-container"}
@ -53,6 +55,8 @@
(defn back-link (defn back-link
"Generate a retrograde primary navigation link with this `content` to this
`url`, indicating a backward move through the appliication."
[content url] [content url]
{:tag :div {:tag :div
:attrs {:class "back-link-container"} :attrs {:class "back-link-container"}
@ -144,6 +148,9 @@
(defn compose-if-member-of-tag (defn compose-if-member-of-tag
"Generate an appropriate `ifmemberof` tag (see `adl-support.tags`) given this
`privilege` for the ADL elements listed in `elts`, which may be fields,
properties, list, forms, pages or entities."
[privilege & elts] [privilege & elts]
(let (let
[all-permissions (distinct (apply find-permissions elts)) [all-permissions (distinct (apply find-permissions elts))
@ -257,12 +264,7 @@
(let (let
[type (:type (:attrs property)) [type (:type (:attrs property))
farname (:entity (:attrs property)) farname (:entity (:attrs property))
farside (first farside (entity-for-property property application)
(children
application
#(and
(= (:tag %) :entity)
(= (:name (:attrs %)) farname))))
fs-distinct (user-distinct-properties farside) fs-distinct (user-distinct-properties farside)
farkey (or farkey (or
(:farkey (:attrs property)) (:farkey (:attrs property))
@ -271,6 +273,8 @@
;; Yes, I know it looks BONKERS generating this as an HTML string. But ;; Yes, I know it looks BONKERS generating this as an HTML string. But
;; there is a reason. We don't know whether the `selected` attribute ;; there is a reason. We don't know whether the `selected` attribute
;; should be present or absent until rendering. ;; should be present or absent until rendering.
(case (-> property :attrs :type)
"entity"
[(str "{% for option in " (-> property :attrs :name) [(str "{% for option in " (-> property :attrs :name)
" %}<option value='{{option." " %}<option value='{{option."
farkey farkey
@ -278,7 +282,16 @@
(-> property :attrs :name) (-> property :attrs :name)
" option." farkey "%}selected='selected'{% endifequal %}>" " option." farkey "%}selected='selected'{% endifequal %}>"
"{{option." (select-field-name farside) "{{option." (select-field-name farside)
"}}</option>{% endfor %}")])) "}}</option>{% endfor %}")]
("list" "link")
[(str "{% for option in " (-> property :attrs :name)
" %}<option value='{{option."
farkey
"}}' {% ifcontains record."
(-> property :attrs :name)
" option." farkey " %}selected='selected'{% endifcontains %}>"
"{{option." (select-field-name farside)
"}}</option>{% endfor %}")])))
(defn widget-type (defn widget-type
@ -308,12 +321,14 @@
(defn select-widget (defn select-widget
"Generate an HTML `SELECT` widget for this `property` of this `entity` within
this `application`, to be used in this `form`. TODO: Many selectable things
are potentially too numerous to be simply represented in a simple static
SELECT, it needs some asynchronous fetching. See
[issue 47](https://github.com/simon-brooke/youyesyet/issues/47)."
[property form entity application] [property form entity application]
(let [farname (:entity (:attrs property)) (let [farname (:entity (:attrs property))
farside (first farside (entity-for-property property application)
(children
application
#(= (:name (:attrs %)) farname)))
magnitude (try magnitude (try
(read-string (:magnitude (:attrs farside))) (read-string (:magnitude (:attrs farside)))
(catch Exception _ 7)) (catch Exception _ 7))
@ -332,6 +347,10 @@
(defn compose-readable-or-not-authorised (defn compose-readable-or-not-authorised
"Compose content to emit if the user is not authorised to write, or
not authorised to read, property `p` in form, list or page `f` of
entity `e` within application `a`, while generating a widget with id
`w`."
[p f e a w] [p f e a w]
(list (list
(compose-if-member-of-tag :readable p e a) (compose-if-member-of-tag :readable p e a)
@ -354,6 +373,8 @@
(defn compose-widget-para (defn compose-widget-para
"Compose a widget paragraph for property `p` in form, list or page `f` of
entity `e` within application `a`, with id `w` and this `content`."
[p f e a w content] [p f e a w content]
{:tag :p {:tag :p
:attrs {:class "widget"} :attrs {:class "widget"}
@ -568,6 +589,10 @@
(defn compose-form-auxlist (defn compose-form-auxlist
"Compose an auxiliary list from this `auxlist` specification of dependent
records (i.e. the far side of a
one-to-many link) of the record of this `entity` within this `application`
being edited in this `form` "
[auxlist form entity application] [auxlist form entity application]
(let [property (child-with-tag (let [property (child-with-tag
entity entity
@ -575,12 +600,7 @@
#(= #(=
(-> % :attrs :name) (-> % :attrs :name)
(-> auxlist :attrs :property))) (-> auxlist :attrs :property)))
farside (child-with-tag farside (entity-for-property property application)]
application
:entity
#(=
(-> % :attrs :name)
(-> property :attrs :entity)))]
(if (if
(and property farside) (and property farside)
{:tag :div {:tag :div
@ -640,6 +660,8 @@
(defn compose-form-auxlists (defn compose-form-auxlists
"Generate all auxiliary lists required for this `form` of this `entity`
within this `application`."
[form entity application] [form entity application]
(remove (remove
nil? nil?
@ -649,6 +671,7 @@
(defn compose-form-content (defn compose-form-content
"Compose the content for this `form` of this `entity` within this `application`."
[form entity application] [form entity application]
{:content {:content
{:tag :div {:tag :div
@ -692,6 +715,8 @@
(defn compose-form-extra-head (defn compose-form-extra-head
"Compose any extra-head declarations (i.e. special Javascript tags) required
for this `form` of this `entity` within this `application`."
[form entity application] [form entity application]
{:extra-head {:extra-head
(apply (apply
@ -722,6 +747,8 @@
(defn compose-form-extra-tail (defn compose-form-extra-tail
"Compose any extra-tail declarations (i.e. special Javascript tags) required
for this `form` of this `entity` within this `application`."
[form entity application] [form entity application]
{:extra-tail {:extra-tail
{:tag :script :attrs {:type "text/javascript"} {:tag :script :attrs {:type "text/javascript"}
@ -742,10 +769,7 @@
(-> field :attrs :property) (-> field :attrs :property)
(-> % :attrs :name))) (-> % :attrs :name)))
farname (:entity (:attrs property)) farname (:entity (:attrs property))
farside (first farside (entity-for-property property application)
(children
application
#(= (:name (:attrs %)) farname)))
magnitude (try magnitude (try
(read-string (read-string
(:magnitude (:magnitude
@ -791,13 +815,17 @@
(defn page-to-template (defn page-to-template
"Generate a template as specified by this `page` element for this `entity`, "Generate a template as specified by this `page` element for this `entity`,
taken from this `application`. If `page` is nil, generate a default page taken from this `application`. If `page` is nil, generate a default page
template for the entity." template for the entity.
TODO: not yet written."
[page entity application] [page entity application]
;; TODO ;; TODO
) )
(defn compose-list-search-widget (defn compose-list-search-widget
"Compose a list search widget for this `field` referencing a property within
this `entity`."
[field entity] [field entity]
(let [property (first (let [property (first
(children (children
@ -1057,6 +1085,8 @@
(defn write-template-file (defn write-template-file
"Write a template file with this `filename` from this `template` in the
context of this `application`."
[filename template application] [filename template application]
(let [filepath (str (let [filepath (str
*output-path* *output-path*

4
src/adl/to_swagger.clj
View file

@ -37,7 +37,9 @@
;;; to-hugsql-queries, because essentially we need one JSON entry point to wrap ;;; to-hugsql-queries, because essentially we need one JSON entry point to wrap
;;; each query. ;;; each query.
(defn file-header [application] (defn file-header
"TODO: Nothing here works yet."
[application]
(list (list
'ns 'ns
(symbol (str (safe-name (:name (:attrs application))) ".routes.auto-api")) (symbol (str (safe-name (:name (:attrs application))) ".routes.auto-api"))

16
src/adl/validator.clj
View file

@ -1,4 +1,5 @@
(ns ^{:doc "Application Description Language: validator for ADL structure." (ns ^{:doc "Application Description Language: validator for ADL structure.
TODO: this is at present largely a failed experiment."
:author "Simon Brooke"} :author "Simon Brooke"}
adl.validator adl.validator
(:require [adl-support.utils :refer :all] (:require [adl-support.utils :refer :all]
@ -36,6 +37,7 @@
(defn try-validate (defn try-validate
"Pass this `validation` and the object `o` to bouncer"
[o validation] [o validation]
(if (if
(symbol? validation) (symbol? validation)
@ -54,10 +56,10 @@
[(str "Error: not a symbol" validation) o])) [(str "Error: not a symbol" validation) o]))
(defmacro disjunct-valid? (defmacro disjunct-valid?
;; Yes, this is a horrible hack. I should be returning the error structure "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`. 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 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? do we identify the one which ought not to have failed?"
[o & validations] [o & validations]
`(println `(println
(str (str
@ -655,7 +657,9 @@
entity-validations)]]}) entity-validations)]]})
(defn valid-adl? [src] (defn valid-adl?
"Return `true` if `src` is syntactically valid ADL."
[src]
(b/valid? src application-validations)) (b/valid? src application-validations))
(defn validate-adl [src] (defn validate-adl [src]

140
test/adl/to_hugsql_queries_test.clj
View file

@ -18,7 +18,7 @@
(= aa bb)) (= aa bb))
(= a b))) (= a b)))
(deftest entity-tests (deftest order-by-tests
(let [application {:tag :application, (let [application {:tag :application,
:attrs {:version "0.1.1", :name "test-app"}, :attrs {:version "0.1.1", :name "test-app"},
:content :content
@ -60,11 +60,97 @@
entity (child-with-tag application :entity)] entity (child-with-tag application :entity)]
(testing "user distinct properties should provide the default ordering" (testing "user distinct properties should provide the default ordering"
(let [expected (let [expected
"ORDER BY address.street, "ORDER BY address.street, address.postcode, address.id"
address.postcode,
address.id"
actual (order-by-clause entity)] actual (order-by-clause entity)]
(is (string-equal-ignore-whitespace? actual expected)))) (is (string-equal-ignore-whitespace? actual expected))))))
(deftest keys-name-extraction-tests
(let [application {:tag :application,
:attrs {:version "0.1.1", :name "test-app"},
:content
[{:tag :entity,
:attrs {:name "address"},
:content
[{:tag :key,
:attrs nil,
:content
[{:tag :property,
:attrs
{:immutable "true",
:required "true",
:distinct "system",
:type "integer",
:name "id"},
:content
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
{:tag :property,
:attrs
{:immutable "true",
:required "true",
:distinct "all",
:generator "assigned"
:type "string",
:size "12"
:name "postcode"},
:content
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
]}
{:tag :property,
:attrs
{:distinct "user", :size "128", :type "string", :name "street"},
:content nil}
{:tag :property,
:attrs {:size "64", :type "string", :name "town"},
:content nil}
]}]}
entity (child-with-tag application :entity)]
(testing "keys name extraction"
(let [expected #{"id" "postcode"}
actual (key-names entity)]
(is (= actual expected))))))
(deftest entity-tests
(let [application {:tag :application,
:attrs {:version "0.1.1", :name "test-app"},
:content
[{:tag :entity,
:attrs {:name "address"},
:content
[{:tag :key,
:attrs nil,
:content
[{:tag :property,
:attrs
{:immutable "true",
:required "true",
:distinct "system",
:type "integer",
:name "id"},
:content
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
{:tag :property,
:attrs
{:immutable "true",
:required "true",
:distinct "all",
:generator "assigned"
:type "string",
:size "12"
:name "postcode"},
:content
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
]}
{:tag :property,
:attrs
{:distinct "user", :size "128", :type "string", :name "street"},
:content nil}
{:tag :property,
:attrs {:size "64", :type "string", :name "town"},
:content nil}
]}]}
entity (child-with-tag application :entity)]
(testing "keys name extraction" (testing "keys name extraction"
(let [expected #{"id"} (let [expected #{"id"}
actual (key-names entity)] actual (key-names entity)]
@ -152,10 +238,11 @@
actual (:signature (first (vals (list-query entity))))] actual (:signature (first (vals (list-query entity))))]
(is (string-equal-ignore-whitespace? actual expected)))) (is (string-equal-ignore-whitespace? actual expected))))
(testing "delete query generation" (testing "delete query generation"
(let [expected "-- :name delete-addres! :! :n (let [expected "-- :name delete-address! :! :n
-- :doc updates an existing addres record -- :doc deletes an existing address record
DELETE FROM address DELETE FROM address
WHERE address.id = :id\n\n" WHERE address.id = :id
ANDaddress.postcode = :postcode"
actual (:query (first (vals (delete-query entity))))] actual (:query (first (vals (delete-query entity))))]
(is (string-equal-ignore-whitespace? actual expected)))) (is (string-equal-ignore-whitespace? actual expected))))
(testing "delete query signature" (testing "delete query signature"
@ -224,8 +311,9 @@
VALUES (':street', VALUES (':street',
':town', ':town',
':postcode') ':postcode')
returning id, returning
postcode\n\n" postcode,
id"
actual (:query (first (vals (insert-query entity))))] actual (:query (first (vals (insert-query entity))))]
(is (string-equal-ignore-whitespace? actual expected)))) (is (string-equal-ignore-whitespace? actual expected))))
(testing "update query generation - compound key" (testing "update query generation - compound key"
@ -239,25 +327,27 @@
actual (:query (first (vals (update-query entity))))] actual (:query (first (vals (update-query entity))))]
(is (string-equal-ignore-whitespace? actual expected)))) (is (string-equal-ignore-whitespace? actual expected))))
(testing "search query generation - user-distinct field in key" (testing "search query generation - user-distinct field in key"
(let [expected "-- :name search-strings-addres :? :1 (let [expected "-- :name search-strings-address :? :*
-- :doc selects existing address records having any string field matching `:pattern` by substring match -- :doc selects existing address records having any string field matching the parameter of the same name by substring match
SELECT * FROM address SELECT DISTINCT * FROM lv_address\nWHERE true
WHERE street LIKE '%:pattern%' --~ (if (:street params) (str \"AND street LIKE '%\" (:street params) \"%' \"))
OR town LIKE '%:pattern%' --~ (if (:town params) (str \"AND town LIKE '%\" (:town params) \"%' \"))
OR postcode LIKE '%:pattern%' --~ (if (:id params) (str \"AND id = :id\"))
ORDER BY address.street, --~ (if (:postcode params) (str \"AND postcode LIKE '%\" (:postcode params) \"%' \"))
address.postcode, ORDER BY lv_address.street,
address.id lv_address.postcode,
lv_address.id
--~ (if (:offset params) \"OFFSET :offset \") --~ (if (:offset params) \"OFFSET :offset \")
--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n" --~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
actual (:query (first (vals (search-query entity application))))] actual (:query (first (vals (search-query entity application))))]
(is (string-equal-ignore-whitespace? actual expected)))) (is (string-equal-ignore-whitespace? actual expected))))
(testing "delete query generation - compound key" (testing "delete query generation - compound key"
(let [expected "-- :name delete-addres! :! :n (let [expected "-- :name delete-address! :! :n
-- :doc updates an existing addres record -- :doc deletes an existing address record
DELETE FROM address DELETE FROM address\nWHERE address.id = :id
WHERE address.id = :id AND address.postcode = :postcode"
AND address.postcode = ':postcode'\n\n"
actual (:query (first (vals (delete-query entity))))] actual (:query (first (vals (delete-query entity))))]
(is (string-equal-ignore-whitespace? actual expected)))))) (is (string-equal-ignore-whitespace? actual expected))))))
;; "-- :name delete-address! :! :n\n-- :doc deletes an existing address record\nDELETE FROM address\nWHERE address.id = :id\n\tAND address.postcode = :postcode"
;; "-- :name delete-address! :! :n\n-- :doc deletes an existing address record\nDELETE FROM address\nWHERE address.id = :id\n AND address.postcode = :postcode\n\n"))