Compare commits

..

No commits in common. "develop" and "feature/5" have entirely different histories.

34 changed files with 1430 additions and 2482 deletions

2
.gitignore vendored
View file

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

View file

@ -1,22 +0,0 @@
# 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/).
## Release 1.4.6, 2018-09-22
Beta release; improved documentation.
## 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.
## Release 1.4.1
Release 1.4.1 adds a 'magnitude' element to entities, in order to provide a pragma for when
to switch to asynchronous select widgets.
It also provides a family of transforms, written in Clojure, to generate a skeleton Clojure
web app from an ADL specification.
## Release 1.4
Release 1.4 adds an 'order' element as a possible child of the 'list' element, in order to specify the default order of lists. Otherwise unchanged from 1.3.

View file

@ -4,23 +4,9 @@ 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)
## 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
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:
A document describing the proposed application should be written in XML using the DTD `resources/schemas/adl-1.4.1.dtd`. It may then be transformed into a C# or Java application using the XSL transforms, see **History** below, but this code is very out of date and the resulting application is unlikely to be very usable. Alternatively, it can be transformed into a Clojure [Luminus](http://www.luminusweb.net/) application using the Clojure transformation, as follows:
simon@fletcher:~/workspace/adl$ java -jar target/adl-[VERSION]-standalone.jar --help
Usage: java -jar adl-[VERSION]-standalone.jar -options [adl-file]
@ -31,61 +17,7 @@ Alternatively, it can be transformed into a Clojure [Luminus](http://www.luminus
-p, --path [PATH]: The path under which generated files should be written; (default: generated)
-v, --verbosity [LEVEL], : Verbosity level - integer value required; (default: 0)
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.
This is not yet complete but it is at an advanced stage and already produces code which is useful.
## History
@ -141,8 +73,6 @@ 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).
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.
## Contributing

12
RELEASENOTES.md Normal file
View file

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

765
doc/intro.md Normal file
View file

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

View file

@ -1,10 +0,0 @@
<!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</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">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-cache.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-cache</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>

View file

@ -1,7 +0,0 @@
<!DOCTYPE html PUBLIC ""
"">
<html><head><meta charset="UTF-8" /><title>adl.to-cache 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</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">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 current"><a href="adl.to-cache.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-cache</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.to-cache.html#var-file-header"><div class="inner"><span>file-header</span></div></a></li><li class="depth-1"><a href="adl.to-cache.html#var-handler"><div class="inner"><span>handler</span></div></a></li><li class="depth-1"><a href="adl.to-cache.html#var-to-cache"><div class="inner"><span>to-cache</span></div></a></li></ul></div><div class="namespace-docs" id="content"><h1 class="anchor" id="top">adl.to-cache</h1><div class="doc"><pre class="plaintext">Application Description Language: generate caching layer for database requests.
</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">Generate an appropriate file header for JSON routes for this `application`.
</pre></div></div><div class="public anchor" id="var-handler"><h3>handler</h3><div class="usage"><code>(handler query)</code></div><div class="doc"><pre class="plaintext">Generate declarations for handlers for this `query`. Cache handlers are needed only for select queries.
</pre></div></div><div class="public anchor" id="var-to-cache"><h3>to-cache</h3><div class="usage"><code>(to-cache application)</code></div><div class="doc"><pre class="plaintext">Generate a `/cache.clj` file for this `application`.
</pre></div></div></div></body></html>

File diff suppressed because one or more lines are too long

View file

@ -1,13 +0,0 @@
<!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</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">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-cache.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-cache</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)</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>

File diff suppressed because one or more lines are too long

View file

@ -1,7 +0,0 @@
<!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</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">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-cache.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-cache</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>

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View file

@ -1,5 +0,0 @@
<!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</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">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-cache.html"><div class="inner"><span class="tree"><span class="top"></span><span class="bottom"></span></span><span>to-cache</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>

File diff suppressed because one or more lines are too long

View file

@ -1,551 +0,0 @@
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;
}

View file

@ -1,97 +0,0 @@
/*
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;
}

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View file

@ -1,112 +0,0 @@
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)
})

View file

@ -1,11 +1,11 @@
(defproject adl "1.4.7-SNAPSHOT"
(defproject adl "1.4.4-SNAPSHOT"
:description "An application to transform an ADL application specification
document into skeleton code for a Clojure web-app"
:url "https://github.com/simon-brooke/adl"
: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"}
:dependencies [[adl-support "0.1.6"]
:dependencies [[adl-support "0.1.4-SNAPSHOT"]
[bouncer "1.0.1"]
[clojure-saxon "0.9.4"]
[environ "1.1.0"]
@ -20,17 +20,19 @@
:plugins [[lein-codox "0.10.3"]
[lein-kibit "0.1.6"]
[lein-release "1.0.5"]]
[lein-release "1.0.5"]
;; [uncomplexor "0.1.0-SNAPSHOT"]
]
:codox {:metadata {:doc "**TODO*: write docs"
:doc/format :markdown}
:output-path "docs"}
;; :lein-release {:scm :git
;; :deploy-via :clojars} ;; :deploy-via :clojars fails - with an scp error.
:deploy-repositories [["releases" :clojars]
["snapshots" :clojars]]
;; `lein release` doesn't work with `git flow release`. To use
;; `lein release`, first merge `develop` into `master`, and then, in branch
;; `master`, run `lein release`
;; `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.
:deploy-repositories [["clojars" {:url "https://clojars.org/repo"
:sign-releases true}]]
:release-tasks [["vcs" "assert-committed"]
["clean"]
@ -38,7 +40,9 @@
["codox"]
["change" "version" "leiningen.release/bump-version" "release"]
["vcs" "commit"]
;; ["vcs" "tag"] -- not working, problems with secret key
["uberjar"]
["install"]
;; ["deploy" "clojars"] -- also not working
["change" "version" "leiningen.release/bump-version"]
["vcs" "commit"]])

View file

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

View file

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

View file

@ -1,124 +0,0 @@
(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)))))

View file

@ -44,16 +44,14 @@
(where-clause entity (key-properties entity)))
([entity properties]
(let
[entity-name (safe-name entity :sql)
[entity-name (:name (:attrs entity))
property-names (map #(:name (:attrs %)) properties)]
(if-not (empty? property-names)
(str
"WHERE "
(s/join
"\n\tAND"
(map
#(str entity-name "." (safe-name % :sql) " = :" %)
property-names)))))))
(map #(str entity-name "." % " = :" %) property-names)))))))
(defn order-by-clause
@ -64,9 +62,9 @@
(order-by-clause entity prefix false))
([entity prefix expanded?]
(let
[entity-name (safe-name entity :sql)
[entity-name (safe-name (:name (:attrs entity)) :sql)
preferred (filter #(#{"user" "all"} (-> % :attrs :distinct))
(descendants-with-tag entity :property))]
(children entity #(= (:tag %) :property)))]
(if
(empty? preferred)
""
@ -79,10 +77,7 @@
(and expanded? (= "entity" (-> % :attrs :type)))
(str (safe-name % :sql) expanded-token)
(safe-name % :sql))
(order-preserving-set
(concat
preferred
(key-properties entity))))))))))
(flatten (cons preferred (key-properties entity))))))))))
;; (def a (x/parse "../youyesyet/youyesyet.adl.xml"))
;; (def e (child-with-tag a :entity #(= "dwellings" (-> % :attrs :name))))
@ -94,10 +89,10 @@
TODO: this depends on the idea that system-unique properties
are not insertable, which is... dodgy."
[entity]
(let [entity-name (safe-name entity :sql)
(let [entity-name (safe-name (:name (:attrs entity)) :sql)
pretty-name (singularise entity-name)
insertable-property-names (map
#(safe-name % :sql)
#(safe-name (:name (:attrs %)) :sql)
(insertable-properties entity))
query-name (str "create-" pretty-name "!")
signature (if (has-primary-key? entity)
@ -131,11 +126,9 @@
(defn update-query
"Generate an appropriate `update` query for this `entity`"
[entity]
(let [entity-name (safe-name entity :sql)
(let [entity-name (safe-name (:name (:attrs entity)) :sql)
pretty-name (singularise entity-name)
property-names (map
#(-> % :attrs :name)
(insertable-properties entity))
property-names (map #(:name (:attrs %)) (insertable-properties entity))
query-name (str "update-" pretty-name "!")
signature ":! :n"]
(hash-map
@ -149,22 +142,18 @@
"-- :doc updates an existing " pretty-name " record\n"
"UPDATE " entity-name "\n"
"SET "
(s/join
",\n\t"
(map
#(str (safe-name % :sql) " = " (keyword %))
property-names))
(s/join ",\n\t" (map #(str (safe-name % :sql) " = " (keyword %)) property-names))
"\n"
(where-clause entity))})))
(defn search-query [entity application]
"Generate an appropriate search query for string fields of this `entity`"
(let [entity-name (safe-name entity :sql)
(let [entity-name (safe-name (:name (:attrs entity)) :sql)
pretty-name (singularise entity-name)
query-name (str "search-strings-" entity-name)
signature ":? :*"
properties (remove #(#{"(safe-name entity :sql)"}(:type (:attrs %))) (all-properties entity))]
properties (remove #(#{"link"}(:type (:attrs %))) (all-properties entity))]
(hash-map
(keyword query-name)
{:name query-name
@ -191,7 +180,7 @@
string?
(map
#(let
[sn (safe-name % :sql)]
[sn (safe-name (-> % :attrs :name) :sql)]
(str
"(if (:" (-> % :attrs :name) " params) (str \"AND "
(case (-> % :attrs :type)
@ -225,7 +214,7 @@
([entity properties]
(if-not
(empty? properties)
(let [entity-name (safe-name entity :sql)
(let [entity-name (safe-name (:name (:attrs entity)) :sql)
pretty-name (singularise entity-name)
query-name (if (= properties (key-properties entity))
(str "get-" pretty-name)
@ -265,7 +254,7 @@
Parameters `:limit` and `:offset` may be supplied. If not present limit defaults
to 100 and offset to 0."
[entity]
(let [entity-name (safe-name entity :sql)
(let [entity-name (safe-name (:name (:attrs entity)) :sql)
pretty-name (singularise entity-name)
query-name (str "list-" entity-name)
signature ":? :*"]
@ -290,12 +279,10 @@
(defn foreign-queries
"Generate any foreign entity queries for this `entity` of this `application`."
[entity application]
(let [entity-name (:name (:attrs entity))
pretty-name (singularise entity-name)
entity-safe (safe-name entity :sql)
links (filter #(:entity (:attrs %)) (children-with-tag entity :property))]
links (filter #(#{"link" "entity"} (:type (:attrs %))) (children-with-tag entity :property))]
(apply
merge
(map
@ -308,11 +295,10 @@
(= (:tag x) :entity)
(= (:name (:attrs x)) far-name)))))
pretty-far (singularise far-name)
safe-far (safe-name far-entity :sql)
farkey (-> % :attrs :farkey)
link-type (-> % :attrs :type)
link-field (-> % :attrs :name)
query-name (list-related-query-name % entity far-entity false)
query-name (str "list-" entity-name "-by-" pretty-far)
signature ":? :*"]
(hash-map
(keyword query-name)
@ -329,38 +315,33 @@
(case link-type
"entity" (list
(str "-- :name " query-name " " signature)
(str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name)
(str "SELECT DISTINCT lv_" entity-safe ".* \nFROM lv_" entity-safe)
(str "WHERE lv_" entity-safe "." (safe-name % :sql) " = :id")
(str "-- :doc lists all existing " pretty-name " records related to a given " pretty-far)
(str "SELECT lv_" entity-name ".* \nFROM lv_" entity-name ", " entity-name)
(str "WHERE lv_" entity-name "." (first (key-names entity)) " = "
entity-name "." (first (key-names entity))
"\n\tAND " entity-name "." link-field " = :id")
(order-by-clause entity "lv_" false))
"link" (let [ltn
"link" (let [link-table-name
(link-table-name % entity far-entity)]
(list
(str "-- :name " query-name " " signature)
(str "-- :doc links all existing " pretty-far " records related to a given " pretty-name)
(str "SELECT DISTINCT lv_" safe-far ".* \nFROM lv_" safe-far ", " ltn)
(str "WHERE lv_" safe-far "."
(safe-name (first (key-names far-entity)) :sql)
" = " ltn "." (singularise safe-far) "_id")
(str "\tAND " ltn "." (singularise entity-safe) "_id = :id")
(order-by-clause far-entity "lv_" false)))
"list" (list
(str "-- :name " query-name " " signature)
(str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name)
(str "SELECT DISTINCT lv_" safe-far ".* \nFROM lv_" safe-far)
(str "WHERE lv_" safe-far "." (safe-name (first (key-names far-entity)) :sql) " = :id")
(order-by-clause far-entity "lv_" false))
(str "-- :doc links all existing " pretty-name " records related to a given " pretty-far)
(str "SELECT * \nFROM " entity-name ", " link-table-name)
(str "WHERE " entity-name "."
(first (key-names entity))
" = " link-table-name "." (singularise entity-name) "_id")
(str "\tAND " link-table-name "." (singularise far-name) "_id = :id")
(order-by-clause entity)))
(list (str "ERROR: unexpected type " link-type " of property " %)))))
}))
links))))
(defn delete-query
(defn delete-query [entity]
"Generate an appropriate `delete` query for this `entity`"
[entity]
(if
(has-primary-key? entity)
(let [entity-name (safe-name entity :sql)
(let [entity-name (:name (:attrs entity))
pretty-name (singularise entity-name)
query-name (str "delete-" pretty-name "!")
signature ":! :n"]
@ -372,7 +353,7 @@
:type :delete-1
:query
(str "-- :name " query-name " " signature "\n"
"-- :doc deletes an existing " pretty-name " record\n"
"-- :doc updates an existing " pretty-name " record\n"
"DELETE FROM " entity-name "\n"
(where-clause entity))}))))
@ -423,74 +404,3 @@
(if (pos? *verbosity*)
(*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."))))))

View file

@ -3,7 +3,7 @@
adl.to-json-routes
(:require [adl-support.core :refer :all]
[adl-support.utils :refer :all]
[adl.to-hugsql-queries :refer [generate-documentation queries]]
[adl.to-hugsql-queries :refer [queries]]
[clj-time.core :as t]
[clj-time.format :as f]
[clojure.java.io :refer [file make-parents writer]]
@ -44,9 +44,7 @@
;;; 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]
(defn file-header [application]
(list
'ns
(symbol (str (safe-name (:name (:attrs application))) ".routes.auto-json"))
@ -65,14 +63,10 @@
'[noir.response :as nresponse]
'[noir.util.route :as route]
'[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))))
(defn declarations
"Generate a forward declaration of all JSON route handlers we're going to
generate for this `application`."
[handlers-map]
(defn declarations [handlers-map]
(cons 'declare (sort (map #(symbol (name %)) (keys handlers-map)))))
@ -81,33 +75,9 @@
[query]
(list
['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
'let
['params (list
'merge
(apply hash-map
(interleave
(map
#(keyword (column-name %))
(descendants-with-tag
(:entity query)
:property
#(not (= (-> % :attrs :required) "true"))))
(repeat nil)))
'(massage-params request))]
['params '(massage-params request)]
(list
'valid-user-or-forbid
(list
@ -115,8 +85,9 @@
(list
'do-or-server-fail
(list
function
'db/*db* 'params)
(symbol (str "db/" (:name query)))
'db/*db*
'params)
(case (:type query)
:insert-1 201 ;; created
:delete-1 204 ;; no content
@ -125,37 +96,44 @@
'params
(set
(map
#(keyword (column-name %))
#(keyword (:name (:attrs %)))
(case (:type query)
:insert-1
(-> query :entity required-properties)
:update-1 (concat
(-> query :entity key-properties)
(-> query :entity required-properties))
(:insert-1 :update-1)
(-> query :entity insertable-properties)
(:select-1 :delete-1)
(-> query :entity key-properties)
;; default
nil))))
'request)))))
'request))))
(defn generate-handler-src
"Generate and return the handler for this `query`."
[handler-name query-map method]
(let [doc (str
"Auto-generated function to "
(generate-documentation query-map))
v (volatility (:entity query-map))]
[handler-name query-map method doc]
(hash-map
:method method
:src (remove
nil?
(if
(or
(zero? (volatility (:entity query-map)))
(#{:delete-1 :insert-1 :update-1} (:type query-map)))
(concat
(list
'defn
handler-name
doc
(generate-handler-body query-map)))))))
(str "Auto-generated method to " doc))
(generate-handler-body query-map))
(concat
(list
'def
handler-name
(list
'memo/ttl
(cons 'fn (generate-handler-body query-map))
{}
:ttl/threshold
(* (volatility (:entity query-map)) 1000))))))))
(defn handler
@ -172,12 +150,76 @@
:route (str "/json/" handler-name)}
(case
(:type query)
(:delete-1 :insert-1 :update-1)
:delete-1
(generate-handler-src
handler-name query :post)
(:select-1 :select-many :text-search)
handler-name query :post
(str "delete one record from the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(-> query :entity key-names)
"`."))
:insert-1
(generate-handler-src
handler-name query :get)
handler-name query :post
(str "insert one record to the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(pr-str
(map
#(keyword (:name (:attrs %)))
(-> query :entity insertable-properties )))
"`. Returns a map containing the keys `"
(-> query :entity key-names)
"` identifying the record created."))
:update-1
(generate-handler-src
handler-name query :post
(str "update one record in the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(pr-str
(distinct
(sort
(map
#(keyword (:name (:attrs %)))
(flatten
(cons
(-> query :entity key-properties)
(-> query :entity insertable-properties)))))))
"`."))
:select-1
(generate-handler-src
handler-name query :get
(str "select one record from the `"
(-> query :entity :attrs :name)
"` table. Expects the following key(s) to be present in `params`: `"
(-> query :entity key-names)
"`. Returns a map containing the following keys: `"
(map #(keyword (:name (:attrs %))) (-> query :entity all-properties))
"`."))
:select-many
(generate-handler-src
handler-name query :get
(str "select all records from the `"
(-> query :entity :attrs :name)
"` table. If the keys `(:limit :offset)` are present in the request then they will be used to page through the data. Returns a sequence of maps each containing the following keys: `"
(pr-str
(map
#(keyword (:name (:attrs %)))
(-> query :entity all-properties)))
"`."))
:text-search
(generate-handler-src
handler-name query :get
(str "select all records from the `"
(-> query :entity :attrs :name)
;; TODO: this doc-string is out of date
"` table with any text field matching the value of the key `:pattern` which should be in the request. If the keys `(:limit :offset)` are present in the request then they will be used to page through the data. Returns a sequence of maps each containing the following keys: `"
(pr-str
(map
#(keyword (:name (:attrs %)))
(-> query :entity all-properties)))
"`."))
(:select-many-to-many
:select-one-to-many)
(hash-map :method :get
@ -189,28 +231,8 @@
(str ";; don't know what to do with query `" :key "` of type `" (:type query) "`.")))))))
(defn make-handlers-map
"Analyse this `application` and generate from it a map of the handlers to be output."
[application]
(reduce
merge
{}
(map
(fn [e]
(let [qmap (queries application e)]
(reduce
merge
{}
(map
(fn [k]
(handler k qmap application))
(keys qmap)))))
(children-with-tag application :entity))))
(defn defroutes
(defn defroutes [handlers-map]
"Generate JSON routes for all queries implied by this ADL `application` spec."
[handlers-map]
(cons
'defroutes
(cons
@ -228,8 +250,25 @@
(keys handlers-map))))))
(defn make-handlers-map
[application]
(reduce
merge
{}
(map
(fn [e]
(let [qmap (queries application e)]
(reduce
merge
{}
(map
(fn [k]
(handler k qmap application))
(keys qmap)))))
(children-with-tag application :entity))))
(defn to-json-routes
"Generate a `/routes/auto-json.clj` file for this `application`."
[application]
(let [handlers-map (make-handlers-map application)
filepath (str *output-path* "src/clj/" (:name (:attrs application)) "/routes/auto_json.clj")]
@ -246,8 +285,8 @@
(println)
h)
(sort (keys handlers-map))))
(pprint (defroutes handlers-map)))))
(pprint (defroutes handlers-map))))
(if (pos? *verbosity*)
(*warn* (str "\tGenerated " filepath)))))
(*warn* (str "\tGenerated " filepath))))))

View file

@ -41,8 +41,6 @@
(defn emit-defined-field-type
"Generate appropriate field type and constraints for this `property`
given this `typedef`."
[property application]
(let [typedef (typedef property application)]
;; this is a hack based on the fact that emit-field-type doesn't check
@ -92,9 +90,12 @@
(defn emit-entity-field-type
"Emit an appropriate field type for this `property`, expected to reference an entity, in this `application`."
[property application]
(let [farside (entity-for-property property application)
(let [farside (child
application
#(and
(entity? %)
(= (:name (:attrs %)) (:entity (:attrs property)))))
key-properties (children-with-tag
(first (children-with-tag farside :key))
:property)]
@ -108,8 +109,6 @@
(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?]
(case (:type (:attrs property))
"integer" (if
@ -129,8 +128,6 @@
(defn emit-link-field
"Emit an appropriate link field for this `property` of this `entity`
within this `application`."
[property entity application]
(emit-property
{:tag :property
@ -143,10 +140,6 @@
(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]
(let [selector
(case privilege
@ -179,8 +172,6 @@
(defn field-name
"Return the appropriate field name for this `property`.
TODO: really belongs in `adl-support.utils`."
[property]
(safe-name
(or
@ -190,7 +181,6 @@
(defn emit-property
"Emit a field declaration representing this `property` of this `entity` within this `application`."
([property entity application]
(emit-property property entity application false))
([property entity application key?]
@ -225,7 +215,11 @@
(defn compose-convenience-entity-field
[field entity application]
(let [farside (entity-for-property (property-for-field field entity) application)]
(let [farside (child
application
#(and
(entity? %)
(= (:name (:attrs %)) (:entity (:attrs field)))))]
(flatten
(map
(fn [f]
@ -237,9 +231,6 @@
(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?]
(remove
nil?
@ -261,10 +252,8 @@
(defn compose-convenience-where-clause
"Compose an SQL `WHERE` clause for a convenience view of this
`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."
;; TODO: does not correctly compose links at one stage down the tree.
;; See lv_electors, lv_followuprequests for examples of the problem.
[entity application top-level?]
(remove
nil?
@ -347,7 +336,11 @@
(map
(fn [f]
(let
[farside (entity-for-property f application)]
[farside (child
application
#(and
(entity? %)
(= (:name (:attrs %)) (:entity (:attrs f)))))]
(str
(safe-name (:table (:attrs entity)) :sql)
"."
@ -362,8 +355,6 @@
(defn emit-referential-integrity-link
"Emit a referential integrity link for this `property` of the entity
`nearside` within this `application`."
[property nearside application]
(let
[farside (entity-for-property property application)]
@ -391,8 +382,6 @@
(defn emit-referential-integrity-links
"Emit all appropriate referential integrity links for this `entity`
within this `application`."
([entity application]
(map
#(emit-referential-integrity-link % entity application)
@ -412,8 +401,6 @@
(defn emit-table
"Emit a table declaration for this `entity` of this `application`,
documented with this `doc-comment` if specified."
([entity application doc-comment]
(let [table-name (safe-name (:table (:attrs entity)) :sql)
permissions (children-with-tag entity :permission)]
@ -463,8 +450,6 @@
(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]
{:tag :property
:attrs {:name (safe-name (str (singularise (:name (:attrs entity))) "_id") :sql)
@ -475,18 +460,12 @@
(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]
(let [e2 (child
application
#(and
(entity? %)
(= (:name (:attrs %)) (:entity (:attrs property)))))
unique? (unique-link? e1 e2)
link-table-name (link-table-name property e1 e2)]
(if
;; we haven't already emitted this one...
@ -506,13 +485,6 @@
[(construct-link-property e1)
(construct-link-property e2)]
permissions)))}]
(if-not unique?
(*warn*
(str "WARNING: Manually check link tables between "
(-> e1 :attrs :name)
" and "
(-> e2 :attrs :name)
" for redundancy")))
;; mark it as emitted
(swap! emitted-link-tables conj link-table-name)
;; emit it
@ -531,8 +503,6 @@
(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]
(map
#(emit-link-table % entity application emitted-link-tables)
@ -547,7 +517,6 @@
(defn emit-group-declaration
"Emit a declaration for this authorisation `group` within this `application`."
[group application]
(list
(emit-header
@ -557,8 +526,6 @@
(defn emit-file-header
"Generate an appropriate file header for the Postgres initialisation script
for this `application`."
[application]
(emit-header
"--"
@ -575,8 +542,6 @@
(defn emit-application
"Emit all SQL declarations required to initialise a Postgres database for
this `application`."
[application]
(let [emitted-link-tables (atom #{})]
(s/join
@ -601,7 +566,6 @@
(defn to-psql
"Generate a complete Postgres database initialisation script for this `application`."
[application]
(let [filepath (str
*output-path*

View file

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

View file

@ -65,187 +65,61 @@
(vector (symbol (str (:name (:attrs application)) ".routes.manual")) :as 'm))))
(defn compose-fetch-record
"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
[entity-name (singularise (:name (:attrs e)))
warning (str
"Error while fetching "
entity-name
" record")]
(list
'if
(list
'all-keys-present?
'params (set (map #(keyword (safe-name % :sql)) (key-names e))))
(list
'support/do-or-log-error
(cons
'merge
(cons
(list
(query-name e :get)
(symbol "db/*db*")
'params)
(defn make-form-get-handler-content
[f e a n]
(let [entity-name (singularise (:name (:attrs e)))]
;; TODO: as yet makes no attempt to save the record
(list 'let
(vector
'record (list
'get-current-value
(symbol (str "db/get-" entity-name))
'params
entity-name))
(reduce
merge
{:error (list :warnings 'record)
:record (list 'dissoc 'record :warnings)}
(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
:error-return {:warnings [warning]})
'params)))
(defn compose-get-menu-options
"Compose Clojure code to fetch from the database menu options for this
`property` within this `application`."
[property nearside application]
(if-let [farside (entity-for-property property application)]
(fn [property]
(hash-map
(keyword (-> property :attrs :name))
(list
'sort-by
(keyword (first (user-distinct-property-names farside)))
'flatten
(list
'set
'remove
'nil?
(list
'get-menu-options
(singularise (-> farside :attrs :name))
(case
(-> property :attrs :type)
("list" "link")
(list-related-query-name property nearside farside true)
"entity"
(query-name farside :get))
(query-name farside :search-strings)
(keyword (or (-> property :attrs :farkey)
(first (key-names farside))))
(list
(keyword
(case
(-> property :attrs :type)
("link" "list")
(first (key-names nearside))
"entity"
(-> property :attrs :name)))
'record)))))
(throw (Exception. (str "Unexpected type " (-> property :atts :type))))))
(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]
(let [p-name (-> auxlist :attrs :property)
property (child-with-tag entity
:property
#(= (-> % :attrs :name) p-name))
f-name (-> property :attrs :entity)
farside (entity-for-property property application)]
(if (and (entity? entity) (entity? farside))
(list 'if (list 'all-keys-present? 'params (key-names entity true))
(hash-map
(keyword (auxlist-data-name auxlist))
(list
(list-related-query-name property entity farside true)
'db/*db*
{:id
(list
(case (-> property :attrs :type)
"link" :id
"list" (keyword (-> property :attrs :name)))
'params)})))
(do
(if-not
(entity? entity)
(*warn*
(str
"Entity '"
(-> entity :attrs :name)
"' passed to compose-fetch-auxlist-data is a non-entity")))
(if-not
(entity? farside)
(*warn*
(str
"Entity '"
f-name
"' (" farside ")
found in compose-fetch-auxlist-data is a non-entity")))
nil))))
(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]
(list
'let
(vector
'record (compose-fetch-record e a))
(list
'reduce
'merge
{: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)}
(cons
'list
(concat
(map
#(compose-get-menu-options % e a)
(descendants-with-tag
e
:property
#(#{"link" "list" "entity"} (-> % :attrs :type))))
(map
#(compose-fetch-auxlist-data % e a)
(descendants-with-tag f :auxlist))
(list
(list 'if (list :error 'request)
{:error (list :error 'request)})
(list 'if (list :message 'request)
{:message (list :message 'request)})))))))
;; Get the current value of the property, if it's an entity
(if (= (-> property :attrs :type) "entity")
(list 'get-menu-options
(-> e :attrs :name)
(-> property :attrs :farkey)
(list (keyword (-> property :attrs :name)) 'params))))))))
(filter #(:entity (:attrs %))
(descendants-with-tag e :property)))))))
(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]
(let [warning (str "Error while fetching " (singularise (:name (:attrs e))) " record")]
(list 'let
(vector 'record (list
'support/handler-content-log-error
(list 'if (list 'subset? (list 'keys 'p) (key-names e)) []
(list
'let
(vector
'record (compose-fetch-record e a))
(symbol
(str "db/get-" (singularise (:name (:attrs e)))))
(symbol "db/*db*")
'params))
:message warning
:error-return {:warnings [warning]}))
{:warnings (list :warnings 'record)
:record (list 'assoc 'record :warnings nil)}))
:record (list 'assoc 'record :warnings nil)})))
(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]
(list
'let
@ -256,15 +130,9 @@
(list
'some
(set (map #(keyword (-> % :attrs :name)) (all-properties e)))
(list
'keys 'params))
(list
'do
(list
(symbol "log/debug")
(list
(symbol
(str "db/search-strings-" (:name (:attrs e)) "-sqlvec")) 'params))
(list 'keys 'params))
(list 'do
(list (symbol "log/debug") (list (symbol (str "db/search-strings-" (:name (:attrs e)) "-sqlvec")) 'params))
(list
'support/do-or-log-error
(list
@ -279,11 +147,8 @@
"Error while searching "
(singularise (:name (:attrs e)))
" records")]}))
(list
'do
(list
(symbol "log/debug")
(list (symbol (str "db/list-" (:name (:attrs e)) "-sqlvec")) 'params))
(list 'do
(list (symbol "log/debug") (list (symbol (str "db/list-" (:name (:attrs e)) "-sqlvec")) 'params))
(list
'support/do-or-log-error
(list
@ -291,7 +156,7 @@
(str
"db/list-"
(:name (:attrs e))))
(symbol "db/*db*") 'params)
(symbol "db/*db*") {})
:message (str
"Error while fetching "
(singularise (:name (:attrs e)))
@ -300,8 +165,7 @@
"Error while fetching "
(singularise (:name (:attrs e)))
" records")]}))))
(list
'if
(list 'if
(list :warnings 'records)
'records
{:records 'records})))
@ -317,8 +181,6 @@
(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]
(let [n (handler-name f e a :get)]
(list
@ -332,13 +194,7 @@
'l/render
(list 'support/resolve-template (str (path-part f e a) ".html"))
(list 'merge
{:title (case (:tag f)
:list
(str "List " (pretty-name e))
:form
(str "Add a " (singularise (pretty-name e)))
:page
(singularise (pretty-name e)))
{:title (capitalise (:name (:attrs f)))
:params 'params}
(case (:tag f)
:form (make-form-get-handler-content f e a n)
@ -347,60 +203,48 @@
(defn make-form-post-handler-content
"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
of the function, but is not currently used.
Literally the only thing the post handler has to do is to
execute the database store operation. Then it can hand off
to the get handler."
;; Literally the only thing the post handler has to do is to
;; generate the database store operation. Then it can hand off
;; to the get handler.
[f e a n]
(let
[create-name (query-name e :create)
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
'let
(vector
'insert-params (list
'prepare-insertion-params
'params
(set
(map
#(safe-name (-> % :attrs :name) :sql)
(insertable-properties e))))
'result
(list
'valid-user-or-forbid
(list
'with-params-or-error
(list
'do-or-server-fail
(list
'if
(list 'all-keys-present? 'params (key-names e true))
(list
'do-or-server-fail
(list
update-name
'db/*db*
'insert-params)
200)
(list
'do-or-server-fail
'params)
(list
create-name
'db/*db*
'insert-params)
201))
'params))
200) ;; OK
'params
(set
(map
#(keyword (:name (:attrs %)))
(required-properties e))))
(insertable-properties e))))
'request))
(list
'if
(list
(set [200 400])
(list :status 'result))
(list
(symbol (handler-name f e a :get))
(list 'merge
(list
'assoc
'request
@ -408,27 +252,11 @@
(list
'merge
'params
'result))
(list 'case (list :status 'result)
200 {:message "Record stored"}
201 (list 'try
(list 'hash-map
:params
(list 'merge 'params
(list :body 'result))
:message
(list 'str "Record created")
(list :body 'result))
(list
'catch 'Exception 'x
{:message "Record created"
:error "Exception while reading returned key"}))
{:error (list :body 'result)}))))))
'result)))
'result))))
(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]
(let [n (handler-name f e a :post)]
(list
@ -475,8 +303,6 @@
(defn make-defroutes
"Generate a `defroutes` declaration for all routes of all forms, pages and
lists within this `application`."
[application]
(let [routes (flatten
(map
@ -525,8 +351,6 @@
(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]
(doall
(map
@ -541,7 +365,6 @@
(defn to-selmer-routes
"Generate a `/routes/auto.clj` file for this `application`."
[application]
(let [filepath (str
*output-path*

View file

@ -3,7 +3,6 @@
:author "Simon Brooke"}
adl.to-selmer-templates
(:require [adl-support.core :refer :all]
[adl-support.forms-support :refer :all]
[adl.to-hugsql-queries :refer [expanded-token]]
[adl-support.utils :refer :all]
[clojure.java.io :refer [file make-parents resource]]
@ -39,8 +38,6 @@
(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]
{:tag :div
:attrs {:class "big-link-container"}
@ -55,8 +52,6 @@
(defn back-link
"Generate a retrograde primary navigation link with this `content` to this
`url`, indicating a backward move through the appliication."
[content url]
{:tag :div
:attrs {:class "back-link-container"}
@ -70,6 +65,7 @@
(defn emit-content
([content]
(do-or-warn
(cond
(nil? content)
nil
@ -81,7 +77,8 @@
(seq? content)
(map emit-content (remove nil? content))
true
(str "<!-- don't know what to do with '" content "' -->")))
(str "<!-- don't know what to do with '" content "' -->"))
(str "Failed while writing " content)))
([filename application k]
(emit-content filename nil nil application k))
([filename spec entity application k]
@ -148,9 +145,6 @@
(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]
(let
[all-permissions (distinct (apply find-permissions elts))
@ -208,14 +202,9 @@
(defn delete-widget
"Return an appropriate 'save' widget for this `form` operating on this
`entity` taken from this `application`."
`entity` taken from this `application`.
TODO: should be suppressed unless member of a group which can delete."
[form entity application]
(flatten
(list
(str "{% if all "
(s/join " " (map #(str "params." %) (key-names entity)))
" %}")
(wrap-in-if-member-of
{:tag :p
:attrs {:class "widget action-dangerous"}
@ -234,8 +223,7 @@
:value (str "Delete!")}}]}
:editable
entity
application)
"{% endif %}")))
application))
(defn select-property
@ -264,7 +252,12 @@
(let
[type (:type (:attrs property))
farname (:entity (:attrs property))
farside (entity-for-property property application)
farside (first
(children
application
#(and
(= (:tag %) :entity)
(= (:name (:attrs %)) farname))))
fs-distinct (user-distinct-properties farside)
farkey (or
(:farkey (:attrs property))
@ -273,8 +266,6 @@
;; Yes, I know it looks BONKERS generating this as an HTML string. But
;; there is a reason. We don't know whether the `selected` attribute
;; should be present or absent until rendering.
(case (-> property :attrs :type)
"entity"
[(str "{% for option in " (-> property :attrs :name)
" %}<option value='{{option."
farkey
@ -282,16 +273,7 @@
(-> property :attrs :name)
" option." farkey "%}selected='selected'{% endifequal %}>"
"{{option." (select-field-name farside)
"}}</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 %}")])))
"}}</option>{% endfor %}")]))
(defn widget-type
@ -321,14 +303,12 @@
(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]
(let [farname (:entity (:attrs property))
farside (entity-for-property property application)
farside (first
(children
application
#(= (:name (:attrs %)) farname)))
magnitude (try
(read-string (:magnitude (:attrs farside)))
(catch Exception _ 7))
@ -347,10 +327,6 @@
(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]
(list
(compose-if-member-of-tag :readable p e a)
@ -373,8 +349,6 @@
(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]
{:tag :p
:attrs {:class "widget"}
@ -400,20 +374,6 @@
"{% endif %}")))})
(defn get-size-for-widget
"Return, as an integer, the fieldwidth for the input widget for this
`property`."
[property]
(let [s (try
(read-string
(:size (:attrs property)))
(catch Exception _ 16))]
(if
(not (integer? s))
16
s)))
(defn compose-input-widget-para
"Generate an input widget for this `field-or-property` of this `form` for
this `entity` taken from within this `application`, in context of a para
@ -430,14 +390,17 @@
:name widget-name
:type w-type
:value (str "{{record." widget-name "}}")
:maxlength (str (max (get-size-for-widget property) 16))
:size (str (min (get-size-for-widget property) 60))}
(case (-> property :attrs :type)
"real"
{:step 0.000001} ;; this is a bit arbitrary!
"integer"
{:step 1}
nil)
:maxlength (:size (:attrs property))
:size (cond
(nil? (:size (:attrs property)))
"16"
(try
(> (read-string
(:size (:attrs property))) 60)
(catch Exception _ false))
"60"
true
(:size (:attrs property)))}
;; TODO: should match pattern from typedef
(if
(:minimum (:attrs typedef))
@ -516,12 +479,10 @@
(defn edit-link
[source entity application parameters]
[entity application parameters]
(str
"{{servlet-context}}/"
(or
(-> source :attrs :onselect)
(editor-name entity application))
(editor-name entity application)
"?"
(s/join
"&amp;"
@ -533,7 +494,7 @@
(defn list-tbody
"Return a table body element for the list view for this `list-spec` of
this `entity` within this `application`, using data from this `source`."
this `entity` within this `application`, using data from this source."
[source list-spec entity application]
{:tag :tbody
:content
@ -542,8 +503,6 @@
:content
(apply
vector
(remove
nil?
(concat
(map
(fn [field]
@ -565,11 +524,7 @@
(= (:type (:attrs p)) "entity")
[{:tag :a
:attrs {:href (edit-link
source
(child-with-tag
application
:entity
#(= (-> % :attrs :name)(-> p :attrs :entity)))
e
application
(list (:name (:attrs p))))}
:content [(str "{{ record." s "_expanded }}")]}]
@ -577,22 +532,14 @@
(children-with-tag list-spec :field))
[{:tag :td
:content
[(if
(or (= (:tag list-spec) :list)
(-> list-spec :attrs :onselect))
{:tag :a
[{:tag :a
:attrs
{:href (edit-link source entity application (key-names entity))}
:content ["View"]}
"&nbsp;")]}])))}
{:href (edit-link entity application (key-names entity))}
:content ["View"]}]}]))}
"{% endfor %}"]})
(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]
(let [property (child-with-tag
entity
@ -600,26 +547,18 @@
#(=
(-> % :attrs :name)
(-> auxlist :attrs :property)))
farside (entity-for-property property application)]
farside (child-with-tag
application
:entity
#(=
(-> % :attrs :name)
(-> property :attrs :entity)))]
(if
(and property farside)
{:tag :div
:attrs {:class "auxlist"}
:content
(apply
vector
(remove
nil?
(flatten
(list
;; only show auxlists if we've got keys
(str "{% if all "
(s/join " " (map #(str "params." %) (key-names entity)))
" %}")
;; only show the body of auxlists if the list is non-empty
(str "{% if " (auxlist-data-name auxlist) "|not-empty %}")
{:tag :h2
[{:tag :h2
:content [(prompt auxlist form entity application)]}
{:tag :table
:content
@ -629,8 +568,6 @@
:content
(apply
vector
(remove
nil?
(flatten
(list
(map
@ -638,30 +575,15 @@
:tag :th
:content [(prompt % form entity application)])
(children-with-tag auxlist :field))
{:tag :th :content ["&nbsp;"]}))))}]}
{:tag :th :content ["&nbsp;"]})))}]}
(list-tbody
(auxlist-data-name auxlist)
(-> property :attrs :name)
auxlist
farside
application)]}
"{% endif %}"
(if
(= (-> auxlist :attrs :canadd) "true")
(wrap-in-if-member-of
(big-link (str
"Add a new "
(pretty-name property))
(editor-name farside application))
:writeable
farside
application)
)
"{% endif %}"))))})))
application)]}]})))
(defn compose-form-auxlists
"Generate all auxiliary lists required for this `form` of this `entity`
within this `application`."
[form entity application]
(remove
nil?
@ -671,7 +593,6 @@
(defn compose-form-content
"Compose the content for this `form` of this `entity` within this `application`."
[form entity application]
{:content
{:tag :div
@ -715,8 +636,6 @@
(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]
{:extra-head
(apply
@ -747,8 +666,6 @@
(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]
{:extra-tail
{:tag :script :attrs {:type "text/javascript"}
@ -769,7 +686,10 @@
(-> field :attrs :property)
(-> % :attrs :name)))
farname (:entity (:attrs property))
farside (entity-for-property property application)
farside (first
(children
application
#(= (:name (:attrs %)) farname)))
magnitude (try
(read-string
(:magnitude
@ -815,17 +735,13 @@
(defn page-to-template
"Generate a template as specified by this `page` element for this `entity`,
taken from this `application`. If `page` is nil, generate a default page
template for the entity.
TODO: not yet written."
template for the entity."
[page entity application]
;; TODO
)
(defn compose-list-search-widget
"Compose a list search widget for this `field` referencing a property within
this `entity`."
[field entity]
(let [property (first
(children
@ -1085,8 +1001,6 @@
(defn write-template-file
"Write a template file with this `filename` from this `template` in the
context of this `application`."
[filename template application]
(let [filepath (str
*output-path*
@ -1116,8 +1030,17 @@
(if
(pos? *verbosity*)
(*warn* "\tGenerated " filepath))
(str filepath))
(str "While generating " filepath)))))
(str filepath))))))
;; (def a (x/parse "../youyesyet/youyesyet.canonical.adl.xml"))
;; (def e (child-with-tag a :entity))
;; (def f (child-with-tag e :form))
;; (write-template-file "froboz" (form-to-template f e a) a)
;; (def t (form-to-template f e a))
;; (map type t)
;; t
(defn to-selmer-templates

View file

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

View file

@ -1,5 +1,4 @@
(ns ^{:doc "Application Description Language: validator for ADL structure.
TODO: this is at present largely a failed experiment."
(ns ^{:doc "Application Description Language: validator for ADL structure."
:author "Simon Brooke"}
adl.validator
(:require [adl-support.utils :refer :all]
@ -37,7 +36,6 @@
(defn try-validate
"Pass this `validation` and the object `o` to bouncer"
[o validation]
(if
(symbol? validation)
@ -56,10 +54,10 @@
[(str "Error: not a symbol" validation) o]))
(defmacro disjunct-valid?
"Yes, this is a horrible hack. I should be returning the error structure
not printing it. But I can't see how to make that work with `bouncer`.
OK, so: most of the validators will (usually) fail, and that's OK. How
do we identify the one which ought not to have failed?"
;; Yes, this is a horrible hack. I should be returning the error structure
;; not printing it. But I can't see how to make that work with `bouncer`.
;; OK, so: most of the validators will (usually) fail, and that's OK. How
;; do we identify the one which ought not to have failed?
[o & validations]
`(println
(str
@ -657,9 +655,7 @@
entity-validations)]]})
(defn valid-adl?
"Return `true` if `src` is syntactically valid ADL."
[src]
(defn valid-adl? [src]
(b/valid? src application-validations))
(defn validate-adl [src]

View file

@ -18,99 +18,6 @@
(= aa bb))
(= a b)))
(deftest order-by-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 "user distinct properties should provide the default ordering"
(let [expected
"ORDER BY address.street, address.postcode, address.id"
actual (order-by-clause entity)]
(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"},
@ -151,6 +58,13 @@
:content nil}
]}]}
entity (child-with-tag application :entity)]
(testing "user distinct properties should provide the default ordering"
(let [expected
"ORDER BY address.street,
address.postcode,
address.id"
actual (order-by-clause entity)]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "keys name extraction"
(let [expected #{"id"}
actual (key-names entity)]
@ -238,11 +152,10 @@
actual (:signature (first (vals (list-query entity))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "delete query generation"
(let [expected "-- :name delete-address! :! :n
-- :doc deletes an existing address record
(let [expected "-- :name delete-addres! :! :n
-- :doc updates an existing addres record
DELETE FROM address
WHERE address.id = :id
ANDaddress.postcode = :postcode"
WHERE address.id = :id\n\n"
actual (:query (first (vals (delete-query entity))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "delete query signature"
@ -311,9 +224,8 @@
VALUES (':street',
':town',
':postcode')
returning
postcode,
id"
returning id,
postcode\n\n"
actual (:query (first (vals (insert-query entity))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "update query generation - compound key"
@ -327,27 +239,25 @@
actual (:query (first (vals (update-query entity))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "search query generation - user-distinct field in key"
(let [expected "-- :name search-strings-address :? :*
-- :doc selects existing address records having any string field matching the parameter of the same name by substring match
SELECT DISTINCT * FROM lv_address\nWHERE true
--~ (if (:street params) (str \"AND street LIKE '%\" (:street params) \"%' \"))
--~ (if (:town params) (str \"AND town LIKE '%\" (:town params) \"%' \"))
--~ (if (:id params) (str \"AND id = :id\"))
--~ (if (:postcode params) (str \"AND postcode LIKE '%\" (:postcode params) \"%' \"))
ORDER BY lv_address.street,
lv_address.postcode,
lv_address.id
(let [expected "-- :name search-strings-addres :? :1
-- :doc selects existing address records having any string field matching `:pattern` by substring match
SELECT * FROM address
WHERE street LIKE '%:pattern%'
OR town LIKE '%:pattern%'
OR postcode LIKE '%:pattern%'
ORDER BY address.street,
address.postcode,
address.id
--~ (if (:offset params) \"OFFSET :offset \")
--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
actual (:query (first (vals (search-query entity application))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "delete query generation - compound key"
(let [expected "-- :name delete-address! :! :n
-- :doc deletes an existing address record
DELETE FROM address\nWHERE address.id = :id
AND address.postcode = :postcode"
(let [expected "-- :name delete-addres! :! :n
-- :doc updates an existing addres record
DELETE FROM address
WHERE address.id = :id
AND address.postcode = ':postcode'\n\n"
actual (:query (first (vals (delete-query entity))))]
(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"))