Documentation
This commit is contained in:
parent
e24523a00e
commit
5c4c215de7
2
.gitignore
vendored
2
.gitignore
vendored
|
@ -25,3 +25,5 @@ node_modules/
|
||||||
|
|
||||||
|
|
||||||
generated/
|
generated/
|
||||||
|
|
||||||
|
docs/
|
||||||
|
|
74
README.md
74
README.md
|
@ -4,9 +4,23 @@ A language for describing applications, from which code can be automatically gen
|
||||||
|
|
||||||
[](https://clojars.org/adl)
|
[](https://clojars.org/adl)
|
||||||
|
|
||||||
|
## Contents
|
||||||
|
|
||||||
|
1. [Usage](#user-content-usage)
|
||||||
|
2. [History](#user-content-history)
|
||||||
|
3. [Why this is a good idea](#user-content-why-this-is-a-good-idea)
|
||||||
|
4. [What exists](#user-content-what-exists)
|
||||||
|
5. [Future direction](#user-content-future-direction)
|
||||||
|
6. [Contributing](#user-content-contributing)
|
||||||
|
|
||||||
|
|
||||||
## Usage
|
## Usage
|
||||||
|
|
||||||
A document describing the proposed application should be written in XML using the DTD `resources/schemas/adl-1.4.1.dtd`. It may then be transformed into a C# or Java application using the XSL transforms, see **History** below, but this code is very out of date and the resulting application is unlikely to be very usable. Alternatively, it can be transformed into a Clojure [Luminus](http://www.luminusweb.net/) application using the Clojure transformation, as follows:
|
A document describing the proposed application should be written in XML using the DTD `resources/schemas/adl-1.4.1.dtd`. It may then be transformed into a C# or Java application using the XSL transforms, see **History** below, but this code is very out of date and the resulting application is unlikely to be very usable.
|
||||||
|
|
||||||
|
### Clojure
|
||||||
|
|
||||||
|
Alternatively, it can be transformed into a Clojure [Luminus](http://www.luminusweb.net/) application using the Clojure transformation, as follows:
|
||||||
|
|
||||||
simon@fletcher:~/workspace/adl$ java -jar target/adl-[VERSION]-standalone.jar --help
|
simon@fletcher:~/workspace/adl$ java -jar target/adl-[VERSION]-standalone.jar --help
|
||||||
Usage: java -jar adl-[VERSION]-standalone.jar -options [adl-file]
|
Usage: java -jar adl-[VERSION]-standalone.jar -options [adl-file]
|
||||||
|
@ -17,7 +31,61 @@ A document describing the proposed application should be written in XML using th
|
||||||
-p, --path [PATH]: The path under which generated files should be written; (default: generated)
|
-p, --path [PATH]: The path under which generated files should be written; (default: generated)
|
||||||
-v, --verbosity [LEVEL], : Verbosity level - integer value required; (default: 0)
|
-v, --verbosity [LEVEL], : Verbosity level - integer value required; (default: 0)
|
||||||
|
|
||||||
This is not yet complete but it is at an advanced stage and already produces code which is useful.
|
Of more simply using the [leiningen](https://leiningen.org/) plugin, see [lein-adl](https://github.com/simon-brooke/lein-adl).
|
||||||
|
|
||||||
|
#### What is generated for Clojure
|
||||||
|
|
||||||
|
The following files are generated:
|
||||||
|
|
||||||
|
* `resources/sql/queries.auto.sql` - [HugSQL](https://www.hugsql.org/) queries for selection, insertion, modification and deletion of records of all entities described in the ADL file.
|
||||||
|
* `resources/sql/[application-name].postgres.sql` - [Postgres](https://www.postgresql.org/) database initialisation script including tables for all entities, convenience views for all entities, all necessary link tables and referential integrity constraints.
|
||||||
|
* `resources/templates/auto/*.html` - [Selmer](https://github.com/yogthos/Selmer) templates for each form or list list specified in the ADL file (pages are not yet handled).
|
||||||
|
* `src/clj/[application-name]/routes/auto.clj` - [Compojure]() routes for each form or list list specified in the ADL file (pages are not yet handled).
|
||||||
|
* `src/clj/[application-name]/routes/auto-json.clj` - [Compojure]() routes returning JSON responses for each query generated in `resources/sql/queries.auto.sql`.
|
||||||
|
|
||||||
|
*You are strongly advised never to edit any of these files*.
|
||||||
|
|
||||||
|
* To override any query, add that query to a file `resources/sql/queries.sql`
|
||||||
|
* To add additional material (for example reference data) to the database initialisation, add it to a separate file or a family of separate files.
|
||||||
|
* To override any template, copy the template file from `resources/templates/auto/` to `resources/templates/` and edit it there.
|
||||||
|
* To override any route, write a function of the same name in the namespace `[application-name].routes.manual`.
|
||||||
|
|
||||||
|
#### Some assembly required
|
||||||
|
|
||||||
|
It would be very nice to be able to type
|
||||||
|
|
||||||
|
lein new luminus froboz +adl
|
||||||
|
|
||||||
|
and have a new Luminus project initialised with a skeleton ADL file, and all the glue needed to make it work, already in place. [This is planned](https://github.com/simon-brooke/adl/issues/6), but just at present it isn't there and you will have to do some work yourself.
|
||||||
|
|
||||||
|
Where, in `src/clj/[application-name]/db/core.clj` [Luminus]() would autogenerate
|
||||||
|
|
||||||
|
(conman/bind-connection *db* "sql/queries.sql")
|
||||||
|
|
||||||
|
You should substitute
|
||||||
|
|
||||||
|
(conman/bind-connection *db* "sql/queries.auto.sql" "sql/queries.sql")
|
||||||
|
(hugsql/def-sqlvec-fns "sql/queries.auto.sql")
|
||||||
|
|
||||||
|
You should add the following two stanzas to the `app-routes` definition in `src/clj/[project-name]/handler.clj`.
|
||||||
|
|
||||||
|
(-> #'auto-rest-routes
|
||||||
|
(wrap-routes middleware/wrap-csrf)
|
||||||
|
(wrap-routes middleware/wrap-formats))
|
||||||
|
(-> #'auto-selmer-routes
|
||||||
|
(wrap-routes middleware/wrap-csrf)
|
||||||
|
(wrap-routes middleware/wrap-formats))
|
||||||
|
|
||||||
|
Finally, you should prepend `"adl"` to the vector of `prep-tasks` in the `uberjar` profile of you `project.clj` file, thus:
|
||||||
|
|
||||||
|
:profiles {:uberjar {:omit-source true
|
||||||
|
:prep-tasks ["adl"
|
||||||
|
"compile"
|
||||||
|
["npm" "install"]
|
||||||
|
["cljsbuild" "once" "min"]]
|
||||||
|
...
|
||||||
|
|
||||||
|
The above assumes you are using Luminus to initialise your project; if you are not, then I expect that you are confident enough using Clojure that you can work out where these changes should be made in your own code.
|
||||||
|
|
||||||
## History
|
## History
|
||||||
|
|
||||||
|
@ -73,6 +141,8 @@ Back in 2007, XSLT seemed a really good technology for doing this sort of thing.
|
||||||
|
|
||||||
Ultimately ADL will probably transition from XML to [EDN](https://github.com/edn-format/edn).
|
Ultimately ADL will probably transition from XML to [EDN](https://github.com/edn-format/edn).
|
||||||
|
|
||||||
|
I plan to generate a [re-frame](https://github.com/Day8/re-frame) skeleton, to support client side and [React Native](https://facebook.github.io/react-native/) applications, but this is not yet in place.
|
||||||
|
|
||||||
This doesn't mean you can't pick up the framework and write transforms in other languages and/or to other language ecosystems. In fact, I'd encourage you to do so.
|
This doesn't mean you can't pick up the framework and write transforms in other languages and/or to other language ecosystems. In fact, I'd encourage you to do so.
|
||||||
|
|
||||||
## Contributing
|
## Contributing
|
||||||
|
|
|
@ -24,8 +24,8 @@
|
||||||
;; [uncomplexor "0.1.0-SNAPSHOT"]
|
;; [uncomplexor "0.1.0-SNAPSHOT"]
|
||||||
]
|
]
|
||||||
|
|
||||||
;; :lein-release {:scm :git
|
:codox {:metadata {:doc "FIXME: write docs"}
|
||||||
;; :deploy-via :clojars} ;; :deploy-via :clojars fails - with an scp error.
|
:output-path "docs"}
|
||||||
|
|
||||||
;; `lein release` doesn't work with `git flow release`. To use
|
;; `lein release` doesn't work with `git flow release`. To use
|
||||||
;; `lein release`, first merge `develop` into `master`, and then, in branch
|
;; `lein release`, first merge `develop` into `master`, and then, in branch
|
||||||
|
|
|
@ -41,6 +41,7 @@
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(def cli-options
|
(def cli-options
|
||||||
|
"Command-line interface options"
|
||||||
[["-a" "--abstract-key-name-convention [string]" "the abstract key name convention to use for generated key fields (TODO: not yet implemented)"
|
[["-a" "--abstract-key-name-convention [string]" "the abstract key name convention to use for generated key fields (TODO: not yet implemented)"
|
||||||
:default "id"]
|
:default "id"]
|
||||||
["-h" "--help" "Show this message"
|
["-h" "--help" "Show this message"
|
||||||
|
@ -55,9 +56,10 @@
|
||||||
])
|
])
|
||||||
|
|
||||||
|
|
||||||
(defn usage [parsed-options]
|
(defn usage
|
||||||
"Show a usage message. `parsed-options` should be options as
|
"Show a usage message. `parsed-options` should be options as
|
||||||
parsed by [clojure.tools.cli](https://github.com/clojure/tools.cli)"
|
parsed by [clojure.tools.cli](https://github.com/clojure/tools.cli)"
|
||||||
|
[parsed-options]
|
||||||
(print-usage
|
(print-usage
|
||||||
"adl"
|
"adl"
|
||||||
parsed-options
|
parsed-options
|
||||||
|
|
|
@ -287,6 +287,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn foreign-queries
|
(defn foreign-queries
|
||||||
|
"Generate any foreign entity queries for this `entity` of this `application`."
|
||||||
[entity application]
|
[entity application]
|
||||||
(let [entity-name (:name (:attrs entity))
|
(let [entity-name (:name (:attrs entity))
|
||||||
pretty-name (singularise entity-name)
|
pretty-name (singularise entity-name)
|
||||||
|
@ -351,8 +352,9 @@
|
||||||
links))))
|
links))))
|
||||||
|
|
||||||
|
|
||||||
(defn delete-query [entity]
|
(defn delete-query
|
||||||
"Generate an appropriate `delete` query for this `entity`"
|
"Generate an appropriate `delete` query for this `entity`"
|
||||||
|
[entity]
|
||||||
(if
|
(if
|
||||||
(has-primary-key? entity)
|
(has-primary-key? entity)
|
||||||
(let [entity-name (safe-name entity :sql)
|
(let [entity-name (safe-name entity :sql)
|
||||||
|
|
|
@ -44,7 +44,9 @@
|
||||||
;;; So the solution may be to an intervening namespace 'cache', which has one
|
;;; So the solution may be to an intervening namespace 'cache', which has one
|
||||||
;;; memoised function for each hugsql query.
|
;;; memoised function for each hugsql query.
|
||||||
|
|
||||||
(defn file-header [application]
|
(defn file-header
|
||||||
|
"Generate an appropriate file header for JSON routes for this `application`."
|
||||||
|
[application]
|
||||||
(list
|
(list
|
||||||
'ns
|
'ns
|
||||||
(symbol (str (safe-name (:name (:attrs application))) ".routes.auto-json"))
|
(symbol (str (safe-name (:name (:attrs application))) ".routes.auto-json"))
|
||||||
|
@ -66,7 +68,10 @@
|
||||||
(vector (symbol (str (safe-name (:name (:attrs application))) ".db.core")) :as 'db))))
|
(vector (symbol (str (safe-name (:name (:attrs application))) ".db.core")) :as 'db))))
|
||||||
|
|
||||||
|
|
||||||
(defn declarations [handlers-map]
|
(defn declarations
|
||||||
|
"Generate a forward declaration of all JSON route handlers we're going to
|
||||||
|
generate for this `application`."
|
||||||
|
[handlers-map]
|
||||||
(cons 'declare (sort (map #(symbol (name %)) (keys handlers-map)))))
|
(cons 'declare (sort (map #(symbol (name %)) (keys handlers-map)))))
|
||||||
|
|
||||||
|
|
||||||
|
@ -244,8 +249,9 @@
|
||||||
(str ";; don't know what to do with query `" :key "` of type `" (:type query) "`.")))))))
|
(str ";; don't know what to do with query `" :key "` of type `" (:type query) "`.")))))))
|
||||||
|
|
||||||
|
|
||||||
(defn defroutes [handlers-map]
|
(defn defroutes
|
||||||
"Generate JSON routes for all queries implied by this ADL `application` spec."
|
"Generate JSON routes for all queries implied by this ADL `application` spec."
|
||||||
|
[handlers-map]
|
||||||
(cons
|
(cons
|
||||||
'defroutes
|
'defroutes
|
||||||
(cons
|
(cons
|
||||||
|
@ -264,6 +270,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn make-handlers-map
|
(defn make-handlers-map
|
||||||
|
"Analyse this `application` and generate from it a map of the handlers to be output."
|
||||||
[application]
|
[application]
|
||||||
(reduce
|
(reduce
|
||||||
merge
|
merge
|
||||||
|
@ -282,6 +289,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn to-json-routes
|
(defn to-json-routes
|
||||||
|
"Generate a `/routes/auto-json.clj` file for this `application`."
|
||||||
[application]
|
[application]
|
||||||
(let [handlers-map (make-handlers-map application)
|
(let [handlers-map (make-handlers-map application)
|
||||||
filepath (str *output-path* "src/clj/" (:name (:attrs application)) "/routes/auto_json.clj")]
|
filepath (str *output-path* "src/clj/" (:name (:attrs application)) "/routes/auto_json.clj")]
|
||||||
|
|
|
@ -41,6 +41,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn emit-defined-field-type
|
(defn emit-defined-field-type
|
||||||
|
"Generate appropriate field type and constraints for this `property`
|
||||||
|
given this `typedef`."
|
||||||
[property application]
|
[property application]
|
||||||
(let [typedef (typedef property application)]
|
(let [typedef (typedef property application)]
|
||||||
;; this is a hack based on the fact that emit-field-type doesn't check
|
;; this is a hack based on the fact that emit-field-type doesn't check
|
||||||
|
@ -90,6 +92,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn emit-entity-field-type
|
(defn emit-entity-field-type
|
||||||
|
"Emit an appropriate field type for this `property`, expected to reference an entity, in this `application`."
|
||||||
[property application]
|
[property application]
|
||||||
(let [farside (child
|
(let [farside (child
|
||||||
application
|
application
|
||||||
|
@ -109,6 +112,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn emit-field-type
|
(defn emit-field-type
|
||||||
|
"Emit an appropriate field type for this `property`, expected to belong to
|
||||||
|
this `entity` within this `application`."
|
||||||
[property entity application key?]
|
[property entity application key?]
|
||||||
(case (:type (:attrs property))
|
(case (:type (:attrs property))
|
||||||
"integer" (if
|
"integer" (if
|
||||||
|
@ -128,6 +133,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn emit-link-field
|
(defn emit-link-field
|
||||||
|
"Emit an appropriate link field for this `property` of this `entity`
|
||||||
|
within this `application`."
|
||||||
[property entity application]
|
[property entity application]
|
||||||
(emit-property
|
(emit-property
|
||||||
{:tag :property
|
{:tag :property
|
||||||
|
@ -140,6 +147,10 @@
|
||||||
|
|
||||||
|
|
||||||
(defn emit-permissions-grant
|
(defn emit-permissions-grant
|
||||||
|
"Emit an appropriate grant of permissions on this `table-name` at this
|
||||||
|
`privilege` level given these `permissions`. `privilege` is expected
|
||||||
|
to be one of #{:SELECT :INSERT :UPDATE :DELETE}.
|
||||||
|
TODO: more thought needed here."
|
||||||
[table-name privilege permissions]
|
[table-name privilege permissions]
|
||||||
(let [selector
|
(let [selector
|
||||||
(case privilege
|
(case privilege
|
||||||
|
@ -172,6 +183,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn field-name
|
(defn field-name
|
||||||
|
"Return the appropriate field name for this `property`.
|
||||||
|
TODO: really belongs in `adl-support.utils`."
|
||||||
[property]
|
[property]
|
||||||
(safe-name
|
(safe-name
|
||||||
(or
|
(or
|
||||||
|
@ -181,6 +194,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn emit-property
|
(defn emit-property
|
||||||
|
"Emit a field declaration representing this `property` of this `entity` within this `application`."
|
||||||
([property entity application]
|
([property entity application]
|
||||||
(emit-property property entity application false))
|
(emit-property property entity application false))
|
||||||
([property entity application key?]
|
([property entity application key?]
|
||||||
|
@ -231,6 +245,9 @@
|
||||||
|
|
||||||
|
|
||||||
(defn compose-convenience-view-select-list
|
(defn compose-convenience-view-select-list
|
||||||
|
"Compose the body of an SQL `SELECT` statement for a convenience view of this
|
||||||
|
`entity` within this `application`, recursively. `top-level?` should be set
|
||||||
|
only on first invocation."
|
||||||
[entity application top-level?]
|
[entity application top-level?]
|
||||||
(remove
|
(remove
|
||||||
nil?
|
nil?
|
||||||
|
@ -252,8 +269,10 @@
|
||||||
|
|
||||||
|
|
||||||
(defn compose-convenience-where-clause
|
(defn compose-convenience-where-clause
|
||||||
;; TODO: does not correctly compose links at one stage down the tree.
|
"Compose an SQL `WHERE` clause for a convenience view of this
|
||||||
;; See lv_electors, lv_followuprequests for examples of the problem.
|
`entity` within this `application`.
|
||||||
|
TODO: does not correctly compose links at one stage down the tree.
|
||||||
|
See `lv_electors`, `lv_followuprequests` for examples of the problem."
|
||||||
[entity application top-level?]
|
[entity application top-level?]
|
||||||
(remove
|
(remove
|
||||||
nil?
|
nil?
|
||||||
|
@ -355,6 +374,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn emit-referential-integrity-link
|
(defn emit-referential-integrity-link
|
||||||
|
"Emit a referential integrity link for this `property` of the entity
|
||||||
|
`nearside` within this `application`."
|
||||||
[property nearside application]
|
[property nearside application]
|
||||||
(let
|
(let
|
||||||
[farside (entity-for-property property application)]
|
[farside (entity-for-property property application)]
|
||||||
|
@ -382,6 +403,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn emit-referential-integrity-links
|
(defn emit-referential-integrity-links
|
||||||
|
"Emit all appropriate referential integrity links for this `entity`
|
||||||
|
within this `application`."
|
||||||
([entity application]
|
([entity application]
|
||||||
(map
|
(map
|
||||||
#(emit-referential-integrity-link % entity application)
|
#(emit-referential-integrity-link % entity application)
|
||||||
|
@ -401,6 +424,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn emit-table
|
(defn emit-table
|
||||||
|
"Emit a table declaration for this `entity` of this `application`,
|
||||||
|
documented with this `doc-comment` if specified."
|
||||||
([entity application doc-comment]
|
([entity application doc-comment]
|
||||||
(let [table-name (safe-name (:table (:attrs entity)) :sql)
|
(let [table-name (safe-name (:table (:attrs entity)) :sql)
|
||||||
permissions (children-with-tag entity :permission)]
|
permissions (children-with-tag entity :permission)]
|
||||||
|
@ -450,6 +475,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn construct-link-property
|
(defn construct-link-property
|
||||||
|
"Create a dummy property for a link-table referencing this `entity`, in order
|
||||||
|
that the field generation functions already defined may be applied to it."
|
||||||
[entity]
|
[entity]
|
||||||
{:tag :property
|
{:tag :property
|
||||||
:attrs {:name (safe-name (str (singularise (:name (:attrs entity))) "_id") :sql)
|
:attrs {:name (safe-name (str (singularise (:name (:attrs entity))) "_id") :sql)
|
||||||
|
@ -460,6 +487,11 @@
|
||||||
|
|
||||||
|
|
||||||
(defn emit-link-table
|
(defn emit-link-table
|
||||||
|
"Emit a link table for the specified `property` of the entity `e1` within
|
||||||
|
this `application`, provided that such a table has not already been emitted
|
||||||
|
from the other end. The argument `emitted-link-tables` contains an atom
|
||||||
|
which references a set of the names of all those link tables which have
|
||||||
|
already been emitted, and this is modified in the execution of this function."
|
||||||
[property e1 application emitted-link-tables]
|
[property e1 application emitted-link-tables]
|
||||||
(let [e2 (child
|
(let [e2 (child
|
||||||
application
|
application
|
||||||
|
@ -511,6 +543,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn emit-link-tables
|
(defn emit-link-tables
|
||||||
|
"Emit all required link tables for this `entity` within this `application`,
|
||||||
|
given these `emitted-link-tables` which have already been emitted."
|
||||||
([entity application emitted-link-tables]
|
([entity application emitted-link-tables]
|
||||||
(map
|
(map
|
||||||
#(emit-link-table % entity application emitted-link-tables)
|
#(emit-link-table % entity application emitted-link-tables)
|
||||||
|
@ -525,6 +559,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn emit-group-declaration
|
(defn emit-group-declaration
|
||||||
|
"Emit a declaration for this authorisation `group` within this `application`."
|
||||||
[group application]
|
[group application]
|
||||||
(list
|
(list
|
||||||
(emit-header
|
(emit-header
|
||||||
|
@ -534,6 +569,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn emit-file-header
|
(defn emit-file-header
|
||||||
|
"Generate an appropriate file header for the Postgres initialisation script
|
||||||
|
for this `application`."
|
||||||
[application]
|
[application]
|
||||||
(emit-header
|
(emit-header
|
||||||
"--"
|
"--"
|
||||||
|
@ -550,6 +587,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn emit-application
|
(defn emit-application
|
||||||
|
"Emit all SQL declarations required to initialise a Postgres database for
|
||||||
|
this `application`."
|
||||||
[application]
|
[application]
|
||||||
(let [emitted-link-tables (atom #{})]
|
(let [emitted-link-tables (atom #{})]
|
||||||
(s/join
|
(s/join
|
||||||
|
@ -574,6 +613,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn to-psql
|
(defn to-psql
|
||||||
|
"Generate a complete Postgres database initialisation script for this `application`."
|
||||||
[application]
|
[application]
|
||||||
(let [filepath (str
|
(let [filepath (str
|
||||||
*output-path*
|
*output-path*
|
||||||
|
|
|
@ -1,4 +1,6 @@
|
||||||
(ns adl.to-reframe
|
(ns ^{:doc "Application Description Language: generate re-frame UI. TODO: doesn't even nearly work yet."
|
||||||
|
:author "Simon Brooke"}
|
||||||
|
adl.to-reframe
|
||||||
(:require [adl-support.utils :refer :all]
|
(:require [adl-support.utils :refer :all]
|
||||||
[clojure.string :as s]
|
[clojure.string :as s]
|
||||||
[clj-time.core :as t]
|
[clj-time.core :as t]
|
||||||
|
@ -31,6 +33,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn file-header
|
(defn file-header
|
||||||
|
"Generate an appropriate file header for a re-frame view."
|
||||||
([parent-name this-name extra-requires]
|
([parent-name this-name extra-requires]
|
||||||
(list 'ns (symbol (str parent-name ".views." this-name))
|
(list 'ns (symbol (str parent-name ".views." this-name))
|
||||||
(str "Re-frame views for " parent-name
|
(str "Re-frame views for " parent-name
|
||||||
|
@ -47,44 +50,46 @@
|
||||||
|
|
||||||
|
|
||||||
(defn generate-form
|
(defn generate-form
|
||||||
"Generate as re-frame this `form` taken from this `entity` of this `document`."
|
"Generate as re-frame this `form` taken from this `entity` of this `application`.
|
||||||
[form entity application]
|
|
||||||
(let [record @(subscribe [:record])
|
TODO: write it!"
|
||||||
errors @(subscribe [:errors])
|
[form entity application]
|
||||||
messages @(subscribe [:messages])
|
;; (let [record @(subscribe [:record])
|
||||||
properties (required-properties entity form)]
|
;; errors @(subscribe [:errors])
|
||||||
(list
|
;; messages @(subscribe [:messages])
|
||||||
'defn
|
;; properties (required-properties entity form)]
|
||||||
(symbol
|
;; (list
|
||||||
(s/join
|
;; 'defn
|
||||||
"-"
|
;; (symbol
|
||||||
(:name (:attrs entity))
|
;; (s/join
|
||||||
(:name (:attrs form))
|
;; "-"
|
||||||
"-form-panel"))
|
;; (:name (:attrs entity))
|
||||||
[]
|
;; (:name (:attrs form))
|
||||||
(apply
|
;; "-form-panel"))
|
||||||
vector
|
;; []
|
||||||
(remove
|
;; (apply
|
||||||
nil?
|
;; vector
|
||||||
(list
|
;; (remove
|
||||||
:div
|
;; nil?
|
||||||
(or
|
;; (list
|
||||||
(:top (:content form))
|
;; :div
|
||||||
(:top (:content application)))
|
;; (or
|
||||||
(map #(list 'ui/error-panel %) errors)
|
;; (:top (:content form))
|
||||||
(map #(list 'ui/message-panel %) messages)
|
;; (:top (:content application)))
|
||||||
[:h1 (:name (:attrs form))]
|
;; (map #(list 'ui/error-panel %) errors)
|
||||||
[:div.container {:id "main-container"}
|
;; (map #(list 'ui/message-panel %) messages)
|
||||||
(apply
|
;; [:h1 (:name (:attrs form))]
|
||||||
vector
|
;; [:div.container {:id "main-container"}
|
||||||
(list
|
;; (apply
|
||||||
:div
|
;; vector
|
||||||
{}
|
;; (list
|
||||||
(map
|
;; :div
|
||||||
#(generate-widget % form entity)
|
;; {}
|
||||||
properties)))]
|
;; (map
|
||||||
(or
|
;; #(generate-widget % form entity)
|
||||||
(:foot (:content form))
|
;; properties)))]
|
||||||
(:foot (:content application))))))
|
;; (or
|
||||||
)))
|
;; (:foot (:content form))
|
||||||
|
;; (:foot (:content application))))))))
|
||||||
|
)
|
||||||
|
|
||||||
|
|
|
@ -66,6 +66,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn compose-fetch-record
|
(defn compose-fetch-record
|
||||||
|
"Compose Clojure code to retrieve a single record of entity `e`."
|
||||||
[e]
|
[e]
|
||||||
(let
|
(let
|
||||||
[entity-name (singularise (:name (:attrs e)))
|
[entity-name (singularise (:name (:attrs e)))
|
||||||
|
@ -90,6 +91,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn compose-get-menu-options
|
(defn compose-get-menu-options
|
||||||
|
"Compose Clojure code to fetch from the database menu options for this
|
||||||
|
`property` within this `application`."
|
||||||
[property application]
|
[property application]
|
||||||
;; TODO: doesn't handle the case of type="link"
|
;; TODO: doesn't handle the case of type="link"
|
||||||
(case (-> property :attrs :type)
|
(case (-> property :attrs :type)
|
||||||
|
@ -129,6 +132,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn compose-fetch-auxlist-data
|
(defn compose-fetch-auxlist-data
|
||||||
|
"Compose Clojure code to fetch data to populate this `auxlist` of a form
|
||||||
|
editing a record of this `entity` within this `application`."
|
||||||
[auxlist entity application]
|
[auxlist entity application]
|
||||||
(let [p-name (-> auxlist :attrs :property)
|
(let [p-name (-> auxlist :attrs :property)
|
||||||
property (child-with-tag entity
|
property (child-with-tag entity
|
||||||
|
@ -171,6 +176,9 @@
|
||||||
|
|
||||||
|
|
||||||
(defn make-form-get-handler-content
|
(defn make-form-get-handler-content
|
||||||
|
"Compose Clojure code to form body of an HTTP `GET` handler for the form
|
||||||
|
`f` of the entity `e` within application `a`. The argument `n`
|
||||||
|
is not used."
|
||||||
[f e a n]
|
[f e a n]
|
||||||
(list
|
(list
|
||||||
'let
|
'let
|
||||||
|
@ -199,6 +207,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn make-page-get-handler-content
|
(defn make-page-get-handler-content
|
||||||
|
"Compose Clojure code to form body of an HTTP `GET` handler for the page
|
||||||
|
`f` of the entity `e` within application `a`. The argument `n` is ignored."
|
||||||
[f e a n]
|
[f e a n]
|
||||||
(list
|
(list
|
||||||
'let
|
'let
|
||||||
|
@ -209,6 +219,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn make-list-get-handler-content
|
(defn make-list-get-handler-content
|
||||||
|
"Compose Clojure code to form body of an HTTP `GET` handler for the list
|
||||||
|
`f` of the entity `e` within application `a`. The argument `n` is ignored."
|
||||||
[f e a n]
|
[f e a n]
|
||||||
(list
|
(list
|
||||||
'let
|
'let
|
||||||
|
@ -280,6 +292,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn make-get-handler
|
(defn make-get-handler
|
||||||
|
"Generate a Clojure function to handle HTTP `GET` requests for form, list or
|
||||||
|
page `f` of entity `e` within application `a`."
|
||||||
[f e a]
|
[f e a]
|
||||||
(let [n (handler-name f e a :get)]
|
(let [n (handler-name f e a :get)]
|
||||||
(list
|
(list
|
||||||
|
@ -307,10 +321,11 @@
|
||||||
(defn make-form-post-handler-content
|
(defn make-form-post-handler-content
|
||||||
"Generate the body of the post handler for the form `f` of
|
"Generate the body of the post handler for the form `f` of
|
||||||
entity `e` in application `a`. The argument `n` is bound to the name
|
entity `e` in application `a`. The argument `n` is bound to the name
|
||||||
of the function, but is not currently used."
|
of the function, but is not currently used.
|
||||||
;; Literally the only thing the post handler has to do is to
|
|
||||||
;; generate the database store operation. Then it can hand off
|
Literally the only thing the post handler has to do is to
|
||||||
;; to the get handler.
|
execute the database store operation. Then it can hand off
|
||||||
|
to the get handler."
|
||||||
[f e a n]
|
[f e a n]
|
||||||
(let
|
(let
|
||||||
[create-name (query-name e :create)
|
[create-name (query-name e :create)
|
||||||
|
@ -381,6 +396,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn make-post-handler
|
(defn make-post-handler
|
||||||
|
"Generate an HTTP `POST` handler for the page, form or list `f` of the
|
||||||
|
entity `e` of application `a`."
|
||||||
[f e a]
|
[f e a]
|
||||||
(let [n (handler-name f e a :post)]
|
(let [n (handler-name f e a :post)]
|
||||||
(list
|
(list
|
||||||
|
@ -427,6 +444,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn make-defroutes
|
(defn make-defroutes
|
||||||
|
"Generate a `defroutes` declaration for all routes of all forms, pages and
|
||||||
|
lists within this `application`."
|
||||||
[application]
|
[application]
|
||||||
(let [routes (flatten
|
(let [routes (flatten
|
||||||
(map
|
(map
|
||||||
|
@ -475,6 +494,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn make-handlers
|
(defn make-handlers
|
||||||
|
"Generate all the Selmer route handlers for all the forms, lists and pages
|
||||||
|
of the entity `e` within this `application`."
|
||||||
[e application]
|
[e application]
|
||||||
(doall
|
(doall
|
||||||
(map
|
(map
|
||||||
|
@ -489,6 +510,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn to-selmer-routes
|
(defn to-selmer-routes
|
||||||
|
"Generate a `/routes/auto.clj` file for this `application`."
|
||||||
[application]
|
[application]
|
||||||
(let [filepath (str
|
(let [filepath (str
|
||||||
*output-path*
|
*output-path*
|
||||||
|
|
|
@ -39,6 +39,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn big-link
|
(defn big-link
|
||||||
|
"Generate a primary navigation link with this `content` to this `url`.
|
||||||
|
TODO: should be renamed. `primary-link` would be better."
|
||||||
[content url]
|
[content url]
|
||||||
{:tag :div
|
{:tag :div
|
||||||
:attrs {:class "big-link-container"}
|
:attrs {:class "big-link-container"}
|
||||||
|
@ -53,6 +55,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn back-link
|
(defn back-link
|
||||||
|
"Generate a retrograde primary navigation link with this `content` to this
|
||||||
|
`url`, indicating a backward move through the appliication."
|
||||||
[content url]
|
[content url]
|
||||||
{:tag :div
|
{:tag :div
|
||||||
:attrs {:class "back-link-container"}
|
:attrs {:class "back-link-container"}
|
||||||
|
@ -144,6 +148,9 @@
|
||||||
|
|
||||||
|
|
||||||
(defn compose-if-member-of-tag
|
(defn compose-if-member-of-tag
|
||||||
|
"Generate an appropriate `ifmemberof` tag (see `adl-support.tags`) given this
|
||||||
|
`privilege` for the ADL elements listed in `elts`, which may be fields,
|
||||||
|
properties, list, forms, pages or entities."
|
||||||
[privilege & elts]
|
[privilege & elts]
|
||||||
(let
|
(let
|
||||||
[all-permissions (distinct (apply find-permissions elts))
|
[all-permissions (distinct (apply find-permissions elts))
|
||||||
|
@ -308,6 +315,11 @@
|
||||||
|
|
||||||
|
|
||||||
(defn select-widget
|
(defn select-widget
|
||||||
|
"Generate an HTML `SELECT` widget for this `property` of this `entity` within
|
||||||
|
this `application`, to be used in this `form`. TODO: Many selectable things
|
||||||
|
are potentially too numerous to be simply represented in a simple static
|
||||||
|
SELECT, it needs some asynchronous fetching. See
|
||||||
|
[issue 47](https://github.com/simon-brooke/youyesyet/issues/47)."
|
||||||
[property form entity application]
|
[property form entity application]
|
||||||
(let [farname (:entity (:attrs property))
|
(let [farname (:entity (:attrs property))
|
||||||
farside (first
|
farside (first
|
||||||
|
@ -332,6 +344,10 @@
|
||||||
|
|
||||||
|
|
||||||
(defn compose-readable-or-not-authorised
|
(defn compose-readable-or-not-authorised
|
||||||
|
"Compose content to emit if the user is not authorised to write, or
|
||||||
|
not authorised to read, property `p` in form, list or page `f` of
|
||||||
|
entity `e` within application `a`, while generating a widget with id
|
||||||
|
`w`."
|
||||||
[p f e a w]
|
[p f e a w]
|
||||||
(list
|
(list
|
||||||
(compose-if-member-of-tag :readable p e a)
|
(compose-if-member-of-tag :readable p e a)
|
||||||
|
@ -354,6 +370,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn compose-widget-para
|
(defn compose-widget-para
|
||||||
|
"Compose a widget paragraph for property `p` in form, list or page `f` of
|
||||||
|
entity `e` within application `a`, with id `w` and this `content`."
|
||||||
[p f e a w content]
|
[p f e a w content]
|
||||||
{:tag :p
|
{:tag :p
|
||||||
:attrs {:class "widget"}
|
:attrs {:class "widget"}
|
||||||
|
@ -568,6 +586,10 @@
|
||||||
|
|
||||||
|
|
||||||
(defn compose-form-auxlist
|
(defn compose-form-auxlist
|
||||||
|
"Compose an auxiliary list from this `auxlist` specification of dependent
|
||||||
|
records (i.e. the far side of a
|
||||||
|
one-to-many link) of the record of this `entity` within this `application`
|
||||||
|
being edited in this `form` "
|
||||||
[auxlist form entity application]
|
[auxlist form entity application]
|
||||||
(let [property (child-with-tag
|
(let [property (child-with-tag
|
||||||
entity
|
entity
|
||||||
|
@ -640,6 +662,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn compose-form-auxlists
|
(defn compose-form-auxlists
|
||||||
|
"Generate all auxiliary lists required for this `form` of this `entity`
|
||||||
|
within this `application`."
|
||||||
[form entity application]
|
[form entity application]
|
||||||
(remove
|
(remove
|
||||||
nil?
|
nil?
|
||||||
|
@ -649,6 +673,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn compose-form-content
|
(defn compose-form-content
|
||||||
|
"Compose the content for this `form` of this `entity` within this `application`."
|
||||||
[form entity application]
|
[form entity application]
|
||||||
{:content
|
{:content
|
||||||
{:tag :div
|
{:tag :div
|
||||||
|
@ -692,6 +717,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn compose-form-extra-head
|
(defn compose-form-extra-head
|
||||||
|
"Compose any extra-head declarations (i.e. special Javascript tags) required
|
||||||
|
for this `form` of this `entity` within this `application`."
|
||||||
[form entity application]
|
[form entity application]
|
||||||
{:extra-head
|
{:extra-head
|
||||||
(apply
|
(apply
|
||||||
|
@ -722,6 +749,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn compose-form-extra-tail
|
(defn compose-form-extra-tail
|
||||||
|
"Compose any extra-tail declarations (i.e. special Javascript tags) required
|
||||||
|
for this `form` of this `entity` within this `application`."
|
||||||
[form entity application]
|
[form entity application]
|
||||||
{:extra-tail
|
{:extra-tail
|
||||||
{:tag :script :attrs {:type "text/javascript"}
|
{:tag :script :attrs {:type "text/javascript"}
|
||||||
|
@ -791,13 +820,17 @@
|
||||||
(defn page-to-template
|
(defn page-to-template
|
||||||
"Generate a template as specified by this `page` element for this `entity`,
|
"Generate a template as specified by this `page` element for this `entity`,
|
||||||
taken from this `application`. If `page` is nil, generate a default page
|
taken from this `application`. If `page` is nil, generate a default page
|
||||||
template for the entity."
|
template for the entity.
|
||||||
|
|
||||||
|
TODO: not yet written."
|
||||||
[page entity application]
|
[page entity application]
|
||||||
;; TODO
|
;; TODO
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
(defn compose-list-search-widget
|
(defn compose-list-search-widget
|
||||||
|
"Compose a list search widget for this `field` referencing a property within
|
||||||
|
this `entity`."
|
||||||
[field entity]
|
[field entity]
|
||||||
(let [property (first
|
(let [property (first
|
||||||
(children
|
(children
|
||||||
|
@ -1057,6 +1090,8 @@
|
||||||
|
|
||||||
|
|
||||||
(defn write-template-file
|
(defn write-template-file
|
||||||
|
"Write a template file with this `filename` from this `template` in the
|
||||||
|
context of this `application`."
|
||||||
[filename template application]
|
[filename template application]
|
||||||
(let [filepath (str
|
(let [filepath (str
|
||||||
*output-path*
|
*output-path*
|
||||||
|
|
|
@ -37,7 +37,9 @@
|
||||||
;;; to-hugsql-queries, because essentially we need one JSON entry point to wrap
|
;;; to-hugsql-queries, because essentially we need one JSON entry point to wrap
|
||||||
;;; each query.
|
;;; each query.
|
||||||
|
|
||||||
(defn file-header [application]
|
(defn file-header
|
||||||
|
"TODO: Nothing here works yet."
|
||||||
|
[application]
|
||||||
(list
|
(list
|
||||||
'ns
|
'ns
|
||||||
(symbol (str (safe-name (:name (:attrs application))) ".routes.auto-api"))
|
(symbol (str (safe-name (:name (:attrs application))) ".routes.auto-api"))
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
(ns ^{:doc "Application Description Language: validator for ADL structure."
|
(ns ^{:doc "Application Description Language: validator for ADL structure.
|
||||||
|
TODO: this is at present largely a failed experiment."
|
||||||
:author "Simon Brooke"}
|
:author "Simon Brooke"}
|
||||||
adl.validator
|
adl.validator
|
||||||
(:require [adl-support.utils :refer :all]
|
(:require [adl-support.utils :refer :all]
|
||||||
|
@ -36,6 +37,7 @@
|
||||||
|
|
||||||
|
|
||||||
(defn try-validate
|
(defn try-validate
|
||||||
|
"Pass this `validation` and the object `o` to bouncer"
|
||||||
[o validation]
|
[o validation]
|
||||||
(if
|
(if
|
||||||
(symbol? validation)
|
(symbol? validation)
|
||||||
|
@ -54,10 +56,10 @@
|
||||||
[(str "Error: not a symbol" validation) o]))
|
[(str "Error: not a symbol" validation) o]))
|
||||||
|
|
||||||
(defmacro disjunct-valid?
|
(defmacro disjunct-valid?
|
||||||
;; Yes, this is a horrible hack. I should be returning the error structure
|
"Yes, this is a horrible hack. I should be returning the error structure
|
||||||
;; not printing it. But I can't see how to make that work with `bouncer`.
|
not printing it. But I can't see how to make that work with `bouncer`.
|
||||||
;; OK, so: most of the validators will (usually) fail, and that's OK. How
|
OK, so: most of the validators will (usually) fail, and that's OK. How
|
||||||
;; do we identify the one which ought not to have failed?
|
do we identify the one which ought not to have failed?"
|
||||||
[o & validations]
|
[o & validations]
|
||||||
`(println
|
`(println
|
||||||
(str
|
(str
|
||||||
|
@ -655,7 +657,9 @@
|
||||||
entity-validations)]]})
|
entity-validations)]]})
|
||||||
|
|
||||||
|
|
||||||
(defn valid-adl? [src]
|
(defn valid-adl?
|
||||||
|
"Return `true` if `src` is syntactically valid ADL."
|
||||||
|
[src]
|
||||||
(b/valid? src application-validations))
|
(b/valid? src application-validations))
|
||||||
|
|
||||||
(defn validate-adl [src]
|
(defn validate-adl [src]
|
||||||
|
|
Loading…
Reference in a new issue