Documentation
This commit is contained in:
parent
e24523a00e
commit
5c4c215de7
2
.gitignore
vendored
2
.gitignore
vendored
|
|
@ -25,3 +25,5 @@ node_modules/
|
|||
|
||||
|
||||
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)
|
||||
|
||||
## 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. 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
|
||||
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)
|
||||
-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
|
||||
|
||||
|
|
@ -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).
|
||||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -24,8 +24,8 @@
|
|||
;; [uncomplexor "0.1.0-SNAPSHOT"]
|
||||
]
|
||||
|
||||
;; :lein-release {:scm :git
|
||||
;; :deploy-via :clojars} ;; :deploy-via :clojars fails - with an scp error.
|
||||
:codox {:metadata {:doc "FIXME: write docs"}
|
||||
:output-path "docs"}
|
||||
|
||||
;; `lein release` doesn't work with `git flow release`. To use
|
||||
;; `lein release`, first merge `develop` into `master`, and then, in branch
|
||||
|
|
|
|||
|
|
@ -41,6 +41,7 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(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"
|
||||
|
|
@ -55,9 +56,10 @@
|
|||
])
|
||||
|
||||
|
||||
(defn usage [parsed-options]
|
||||
(defn usage
|
||||
"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
|
||||
|
|
|
|||
|
|
@ -287,6 +287,7 @@
|
|||
|
||||
|
||||
(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)
|
||||
|
|
@ -351,8 +352,9 @@
|
|||
links))))
|
||||
|
||||
|
||||
(defn delete-query [entity]
|
||||
(defn delete-query
|
||||
"Generate an appropriate `delete` query for this `entity`"
|
||||
[entity]
|
||||
(if
|
||||
(has-primary-key? entity)
|
||||
(let [entity-name (safe-name entity :sql)
|
||||
|
|
|
|||
|
|
@ -44,7 +44,9 @@
|
|||
;;; So the solution may be to an intervening namespace 'cache', which has one
|
||||
;;; 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
|
||||
'ns
|
||||
(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))))
|
||||
|
||||
|
||||
(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)))))
|
||||
|
||||
|
||||
|
|
@ -244,8 +249,9 @@
|
|||
(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."
|
||||
[handlers-map]
|
||||
(cons
|
||||
'defroutes
|
||||
(cons
|
||||
|
|
@ -264,6 +270,7 @@
|
|||
|
||||
|
||||
(defn make-handlers-map
|
||||
"Analyse this `application` and generate from it a map of the handlers to be output."
|
||||
[application]
|
||||
(reduce
|
||||
merge
|
||||
|
|
@ -282,6 +289,7 @@
|
|||
|
||||
|
||||
(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")]
|
||||
|
|
|
|||
|
|
@ -41,6 +41,8 @@
|
|||
|
||||
|
||||
(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
|
||||
|
|
@ -90,6 +92,7 @@
|
|||
|
||||
|
||||
(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 (child
|
||||
application
|
||||
|
|
@ -109,6 +112,8 @@
|
|||
|
||||
|
||||
(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
|
||||
|
|
@ -128,6 +133,8 @@
|
|||
|
||||
|
||||
(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
|
||||
|
|
@ -140,6 +147,10 @@
|
|||
|
||||
|
||||
(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
|
||||
|
|
@ -172,6 +183,8 @@
|
|||
|
||||
|
||||
(defn field-name
|
||||
"Return the appropriate field name for this `property`.
|
||||
TODO: really belongs in `adl-support.utils`."
|
||||
[property]
|
||||
(safe-name
|
||||
(or
|
||||
|
|
@ -181,6 +194,7 @@
|
|||
|
||||
|
||||
(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?]
|
||||
|
|
@ -231,6 +245,9 @@
|
|||
|
||||
|
||||
(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?
|
||||
|
|
@ -252,8 +269,10 @@
|
|||
|
||||
|
||||
(defn compose-convenience-where-clause
|
||||
;; TODO: does not correctly compose links at one stage down the tree.
|
||||
;; See lv_electors, lv_followuprequests for examples of the problem.
|
||||
"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."
|
||||
[entity application top-level?]
|
||||
(remove
|
||||
nil?
|
||||
|
|
@ -355,6 +374,8 @@
|
|||
|
||||
|
||||
(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)]
|
||||
|
|
@ -382,6 +403,8 @@
|
|||
|
||||
|
||||
(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)
|
||||
|
|
@ -401,6 +424,8 @@
|
|||
|
||||
|
||||
(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)]
|
||||
|
|
@ -450,6 +475,8 @@
|
|||
|
||||
|
||||
(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)
|
||||
|
|
@ -460,6 +487,11 @@
|
|||
|
||||
|
||||
(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
|
||||
|
|
@ -511,6 +543,8 @@
|
|||
|
||||
|
||||
(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)
|
||||
|
|
@ -525,6 +559,7 @@
|
|||
|
||||
|
||||
(defn emit-group-declaration
|
||||
"Emit a declaration for this authorisation `group` within this `application`."
|
||||
[group application]
|
||||
(list
|
||||
(emit-header
|
||||
|
|
@ -534,6 +569,8 @@
|
|||
|
||||
|
||||
(defn emit-file-header
|
||||
"Generate an appropriate file header for the Postgres initialisation script
|
||||
for this `application`."
|
||||
[application]
|
||||
(emit-header
|
||||
"--"
|
||||
|
|
@ -550,6 +587,8 @@
|
|||
|
||||
|
||||
(defn emit-application
|
||||
"Emit all SQL declarations required to initialise a Postgres database for
|
||||
this `application`."
|
||||
[application]
|
||||
(let [emitted-link-tables (atom #{})]
|
||||
(s/join
|
||||
|
|
@ -574,6 +613,7 @@
|
|||
|
||||
|
||||
(defn to-psql
|
||||
"Generate a complete Postgres database initialisation script for this `application`."
|
||||
[application]
|
||||
(let [filepath (str
|
||||
*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]
|
||||
[clojure.string :as s]
|
||||
[clj-time.core :as t]
|
||||
|
|
@ -31,6 +33,7 @@
|
|||
|
||||
|
||||
(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
|
||||
|
|
@ -47,44 +50,46 @@
|
|||
|
||||
|
||||
(defn generate-form
|
||||
"Generate as re-frame this `form` taken from this `entity` of this `document`."
|
||||
[form entity application]
|
||||
(let [record @(subscribe [:record])
|
||||
errors @(subscribe [:errors])
|
||||
messages @(subscribe [:messages])
|
||||
properties (required-properties entity form)]
|
||||
(list
|
||||
'defn
|
||||
(symbol
|
||||
(s/join
|
||||
"-"
|
||||
(:name (:attrs entity))
|
||||
(:name (:attrs form))
|
||||
"-form-panel"))
|
||||
[]
|
||||
(apply
|
||||
vector
|
||||
(remove
|
||||
nil?
|
||||
(list
|
||||
:div
|
||||
(or
|
||||
(:top (:content form))
|
||||
(:top (:content application)))
|
||||
(map #(list 'ui/error-panel %) errors)
|
||||
(map #(list 'ui/message-panel %) messages)
|
||||
[:h1 (:name (:attrs form))]
|
||||
[:div.container {:id "main-container"}
|
||||
(apply
|
||||
vector
|
||||
(list
|
||||
:div
|
||||
{}
|
||||
(map
|
||||
#(generate-widget % form entity)
|
||||
properties)))]
|
||||
(or
|
||||
(:foot (:content form))
|
||||
(:foot (:content application))))))
|
||||
)))
|
||||
"Generate as re-frame this `form` taken from this `entity` of this `application`.
|
||||
|
||||
TODO: write it!"
|
||||
[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))))))))
|
||||
)
|
||||
|
||||
|
|
|
|||
|
|
@ -66,6 +66,7 @@
|
|||
|
||||
|
||||
(defn compose-fetch-record
|
||||
"Compose Clojure code to retrieve a single record of entity `e`."
|
||||
[e]
|
||||
(let
|
||||
[entity-name (singularise (:name (:attrs e)))
|
||||
|
|
@ -90,6 +91,8 @@
|
|||
|
||||
|
||||
(defn compose-get-menu-options
|
||||
"Compose Clojure code to fetch from the database menu options for this
|
||||
`property` within this `application`."
|
||||
[property application]
|
||||
;; TODO: doesn't handle the case of type="link"
|
||||
(case (-> property :attrs :type)
|
||||
|
|
@ -129,6 +132,8 @@
|
|||
|
||||
|
||||
(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
|
||||
|
|
@ -171,6 +176,9 @@
|
|||
|
||||
|
||||
(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
|
||||
|
|
@ -199,6 +207,8 @@
|
|||
|
||||
|
||||
(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]
|
||||
(list
|
||||
'let
|
||||
|
|
@ -209,6 +219,8 @@
|
|||
|
||||
|
||||
(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
|
||||
|
|
@ -280,6 +292,8 @@
|
|||
|
||||
|
||||
(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
|
||||
|
|
@ -307,10 +321,11 @@
|
|||
(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
|
||||
;; generate the database store operation. Then it can hand off
|
||||
;; to the get handler.
|
||||
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."
|
||||
[f e a n]
|
||||
(let
|
||||
[create-name (query-name e :create)
|
||||
|
|
@ -381,6 +396,8 @@
|
|||
|
||||
|
||||
(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
|
||||
|
|
@ -427,6 +444,8 @@
|
|||
|
||||
|
||||
(defn make-defroutes
|
||||
"Generate a `defroutes` declaration for all routes of all forms, pages and
|
||||
lists within this `application`."
|
||||
[application]
|
||||
(let [routes (flatten
|
||||
(map
|
||||
|
|
@ -475,6 +494,8 @@
|
|||
|
||||
|
||||
(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
|
||||
|
|
@ -489,6 +510,7 @@
|
|||
|
||||
|
||||
(defn to-selmer-routes
|
||||
"Generate a `/routes/auto.clj` file for this `application`."
|
||||
[application]
|
||||
(let [filepath (str
|
||||
*output-path*
|
||||
|
|
|
|||
|
|
@ -39,6 +39,8 @@
|
|||
|
||||
|
||||
(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"}
|
||||
|
|
@ -53,6 +55,8 @@
|
|||
|
||||
|
||||
(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"}
|
||||
|
|
@ -144,6 +148,9 @@
|
|||
|
||||
|
||||
(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))
|
||||
|
|
@ -308,6 +315,11 @@
|
|||
|
||||
|
||||
(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 (first
|
||||
|
|
@ -332,6 +344,10 @@
|
|||
|
||||
|
||||
(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)
|
||||
|
|
@ -354,6 +370,8 @@
|
|||
|
||||
|
||||
(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"}
|
||||
|
|
@ -568,6 +586,10 @@
|
|||
|
||||
|
||||
(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
|
||||
|
|
@ -640,6 +662,8 @@
|
|||
|
||||
|
||||
(defn compose-form-auxlists
|
||||
"Generate all auxiliary lists required for this `form` of this `entity`
|
||||
within this `application`."
|
||||
[form entity application]
|
||||
(remove
|
||||
nil?
|
||||
|
|
@ -649,6 +673,7 @@
|
|||
|
||||
|
||||
(defn compose-form-content
|
||||
"Compose the content for this `form` of this `entity` within this `application`."
|
||||
[form entity application]
|
||||
{:content
|
||||
{:tag :div
|
||||
|
|
@ -692,6 +717,8 @@
|
|||
|
||||
|
||||
(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
|
||||
|
|
@ -722,6 +749,8 @@
|
|||
|
||||
|
||||
(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"}
|
||||
|
|
@ -791,13 +820,17 @@
|
|||
(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."
|
||||
template for the entity.
|
||||
|
||||
TODO: not yet written."
|
||||
[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
|
||||
|
|
@ -1057,6 +1090,8 @@
|
|||
|
||||
|
||||
(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*
|
||||
|
|
|
|||
|
|
@ -37,7 +37,9 @@
|
|||
;;; to-hugsql-queries, because essentially we need one JSON entry point to wrap
|
||||
;;; each query.
|
||||
|
||||
(defn file-header [application]
|
||||
(defn file-header
|
||||
"TODO: Nothing here works yet."
|
||||
[application]
|
||||
(list
|
||||
'ns
|
||||
(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"}
|
||||
adl.validator
|
||||
(:require [adl-support.utils :refer :all]
|
||||
|
|
@ -36,6 +37,7 @@
|
|||
|
||||
|
||||
(defn try-validate
|
||||
"Pass this `validation` and the object `o` to bouncer"
|
||||
[o validation]
|
||||
(if
|
||||
(symbol? validation)
|
||||
|
|
@ -54,10 +56,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
|
||||
|
|
@ -655,7 +657,9 @@
|
|||
entity-validations)]]})
|
||||
|
||||
|
||||
(defn valid-adl? [src]
|
||||
(defn valid-adl?
|
||||
"Return `true` if `src` is syntactically valid ADL."
|
||||
[src]
|
||||
(b/valid? src application-validations))
|
||||
|
||||
(defn validate-adl [src]
|
||||
|
|
|
|||
Loading…
Reference in a new issue