.gitignore

@@ -10,11 +10,3 @@ target/
 \.lein-failures
 
 *.dump
-
-queries\.auto\.sql
-
-auto_json_routes\.clj
-
-\.idea/
-
-*.iml

project.clj

@@ -1,10 +1,9 @@
-(defproject squirrel-parse "0.1.1-SNAPSHOT"
+(defproject squirrel-parse "0.1.1"
   :description "A library for parsing SQL"
   ;; :url "http://example.com/FIXME"
   :license {:name "GNU General Public License,version 2.0 or (at your option) any later version"
             :url "https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html"}
   :dependencies [[org.clojure/clojure "1.8.0"]
                  [org.clojure/math.combinatorics "0.1.4"]
-                 [bouncer "1.0.1"]
                  [clj-time "0.14.2"]
                  [instaparse "1.4.8"]])

src/squirrel_parse/to_adl.clj

@@ -115,7 +115,7 @@
           {:tag :prompt
            :attrs
            {:prompt name
-            :locale "en-GB"}}}}}})))
+            :local "en-GB"}}}}}})))
 
 
 (defn make-entity-map [table-decl]

src/squirrel_parse/to_hugsql_queries.clj

@@ -4,8 +4,6 @@
   (:require [clojure.java.io :refer [file]]
             [clojure.math.combinatorics :refer [combinations]]
             [clojure.string :as s]
-            [clj-time.core :as t]
-            [clj-time.format :as f]
             [squirrel-parse.to-adl :refer [migrations-to-xml]]
             [squirrel-parse.utils :refer [is-link-table? singularise]]))
 
@@ -54,18 +52,10 @@
 
 (defn insert-query [entity-map]
   (let [entity-name (:name (:attrs entity-map))
-        pretty-name (singularise entity-name)
+        pretty-name (s/replace (s/replace entity-name #"_" "-") #"s$" "")
         all-property-names (map #(:name (:attrs %)) (vals (:properties (:content entity-map))))
-        query-name (str "create-" pretty-name "!")
+        ]
-        signature " :! :n"]
+    (str "-- :name create-" pretty-name "! :<!\n"
-    (hash-map
-      (keyword query-name)
-      {:name query-name
-       :signature signature
-       :entity entity-map
-       :type :insert-1
-       :query
-       (str "-- :name " query-name " " signature "\n"
          "-- :doc creates a new " pretty-name " record\n"
          "INSERT INTO " entity-name " ("
          (s/join ",\n\t" all-property-names)
@@ -75,7 +65,7 @@
          (if
            (has-primary-key? entity-map)
            (str "\nreturning " (s/join ",\n\t" (key-names entity-map))))
-            "\n\n")})))
+         "\n\n")))
 
 
 (defn update-query [entity-map]
@@ -84,144 +74,64 @@
       (has-primary-key? entity-map)
       (has-non-key-properties? entity-map))
     (let [entity-name (:name (:attrs entity-map))
-          pretty-name (singularise entity-name)
+          pretty-name (s/replace (s/replace entity-name #"_" "-") #"s$" "")
           property-names (remove
                            nil?
                            (map
                              #(if (= (:tag %) :property) (:name (:attrs %)))
-                             (vals (:properties (:content entity-map)))))
+                             (vals (:properties (:content entity-map)))))]
-          query-name (str "update-" pretty-name "!")
+      (str "-- :name update-" pretty-name "! :! :n\n"
-          signature ":! :n"]
-      (hash-map
-        (keyword query-name)
-        {:name query-name
-         :signature signature
-         :entity entity-map
-         :type :update-1
-         :query
-         (str "-- :name " query-name " " signature "\n"
            "-- :doc updates an existing " pretty-name " record\n"
            "UPDATE " entity-name "\n"
            "SET "
            (s/join ",\n\t" (map #(str % " = " (keyword %)) property-names))
            "\n"
            (where-clause entity-map)
-              "\n\n")}))
+           "\n\n"))))
-    {}))
-
-
-(defn search-query [entity-map]
-  (let [entity-name (:name (:attrs entity-map))
-        pretty-name (singularise entity-name)
-        query-name (str "search-strings-" pretty-name)
-        signature ":? :1"
-        string-fields (filter
-                       #(= (-> % :attrs :type) "string")
-                       (-> entity-map :content :properties vals))]
-    (if
-      (empty? string-fields)
-      {}
-      (hash-map
-       (keyword query-name)
-       {:name query-name
-        :signature signature
-        :entity entity-map
-        :type :text-search
-        :query
-        (str "-- :name " query-name " " signature "\n"
-             "-- :doc selects existing " entity-name " records having any string field matching `:pattern` by substring match\n"
-             "SELECT * FROM " entity-name "\n"
-             "WHERE "
-             (s/join
-              "\n\tOR "
-              (map
-               #(str (-> % :attrs :name) " LIKE '%:pattern%'")
-               string-fields))
-             "\n"
-             (order-by-clause entity-map)
-             "\n"
-            "--~ (if (:offset params) \"OFFSET :offset \") \n"
-            "--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
-             "\n\n")}))))
 
 
 (defn select-query [entity-map]
   (if
     (has-primary-key? entity-map)
     (let [entity-name (:name (:attrs entity-map))
-          pretty-name (singularise entity-name)
+          pretty-name (s/replace (s/replace entity-name #"_" "-") #"s$" "")]
-          query-name (str "get-" pretty-name)
+      (str "-- :name get-" pretty-name " :? :1\n"
-          signature ":? :1"]
-      (hash-map
-        (keyword query-name)
-        {:name query-name
-         :signature signature
-         :entity entity-map
-         :type :select-1
-         :query
-         (str "-- :name " query-name " " signature "\n"
            "-- :doc selects an existing " pretty-name " record\n"
            "SELECT * FROM " entity-name "\n"
            (where-clause entity-map)
            "\n"
            (order-by-clause entity-map)
-              "\n\n")}))
+           "\n\n"))))
-    {}))
 
 
-(defn list-query
+(defn list-query [entity-map]
-  "Generate a query to list records in the table represented by this `entity-map`.
-  Parameters `:limit` and `:offset` may be supplied. If not present limit defaults
-  to 100 and offset to 0."
-  [entity-map]
   (let [entity-name (:name (:attrs entity-map))
-        pretty-name (singularise entity-name)
+        pretty-name (s/replace (s/replace entity-name #"_" "-") #"s$" "")]
-        query-name (str "list-" entity-name)
+    (str "-- :name list-" pretty-name " :? :*\n"
-        signature ":? :*"]
-    (hash-map
-      (keyword query-name)
-      {:name query-name
-       :signature signature
-       :entity entity-map
-       :type :select-many
-       :query
-       (str "-- :name " query-name " " signature "\n"
          "-- :doc lists all existing " pretty-name " records\n"
          "SELECT * FROM " entity-name "\n"
-            (order-by-clause entity-map) "\n"
+         (order-by-clause entity-map)
-            "--~ (if (:offset params) \"OFFSET :offset \") \n"
+         "\n\n")))
-            "--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
-            "\n\n")})))
 
 
 (defn foreign-queries [entity-map entities-map]
   (let [entity-name (:name (:attrs entity-map))
-        pretty-name (singularise entity-name)
+        pretty-name (s/replace (s/replace entity-name #"_" "-") #"s$" "")
         links (filter #(-> % :attrs :entity) (-> entity-map :content :properties vals))]
     (apply
-      merge
+      str
       (map
         #(let [far-name (-> % :attrs :entity)
                far-entity ((keyword far-name) entities-map)
                pretty-far (s/replace (s/replace far-name #"_" "-") #"s$" "")
                farkey (-> % :attrs :farkey)
-               link-field (-> % :attrs :name)
+               link-field (-> % :attrs :name)]
-               query-name (str "list-" entity-name "-by-" pretty-far)
+           (str "-- :name list-" entity-name "-by-" pretty-far " :? :*\n"
-               signature ":? :*"]
-           (hash-map
-             (keyword query-name)
-             {:name query-name
-              :signature signature
-              :entity entity-map
-              :type :select-one-to-many
-              :far-entity far-entity
-              :query
-              (str "-- :name " query-name " " signature "\n"
                 "-- :doc lists all existing " pretty-name " records related to a given " pretty-far "\n"
                 "SELECT * \nFROM " entity-name "\n"
                 "WHERE " entity-name "." link-field " = :id\n"
                 (order-by-clause entity-map)
-                   "\n\n")}))
+                "\n\n"))
         links))))
 
 
@@ -235,26 +145,16 @@
         near-name (-> near :attrs :name)
         link-name (-> link :attrs :name)
         far-name (-> far :attrs :name)
-        pretty-far (singularise far-name)
+        pretty-far (singularise far-name)]
-        query-name (str "list-" link-name "-" near-name "-by-" pretty-far)
+    (println links)
-        signature ":? :*"]
+    (str "-- :name list-" link-name "-" near-name "-by-" pretty-far " :? :*\n"
-    (hash-map
-      (keyword query-name)
-      {:name query-name
-       :signature signature
-       :entity link
-       :type :select-many-to-many
-       :near-entity near
-       :far-entity far
-       :query
-       (str "-- :name " query-name " " signature " \n"
          "-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far "\n"
          "SELECT "near-name ".*\n"
          "FROM " near-name ", " link-name "\n"
          "WHERE " near-name "." (first (key-names near)) " = " link-name "." (-> (links (keyword near-name)) :attrs :name) "\n\t"
          "AND " link-name "." (-> (links (keyword far-name)) :attrs :name) " = :id\n"
          (order-by-clause near)
-            "\n\n")})))
+         "\n\n")))
 
 
 (defn link-table-queries [entity-map entities-map]
@@ -264,9 +164,9 @@
                 (remove nil? (map #(-> % :attrs :entity) (-> entity-map :content :properties vals))))
      pairs (combinations entities 2)]
     (apply
-      merge
+      str
       (map
-        #(merge
+        #(str
            (link-table-query (nth % 0) entity-map (nth % 1))
            (link-table-query (nth % 1) entity-map (nth % 0)))
         pairs))))
@@ -277,37 +177,26 @@
   (if
     (has-primary-key? entity-map)
     (let [entity-name (:name (:attrs entity-map))
-          pretty-name (singularise entity-name)
+          pretty-name (s/replace (s/replace entity-name #"_" "-") #"s$" "")]
-          query-name (str "delete-" pretty-name "!")
+      (str "-- :name delete-" pretty-name "! :! :n\n"
-          signature ":! :n"]
-      (hash-map
-        (keyword query-name)
-        {:name query-name
-         :signature signature
-         :entity entity-map
-         :type :delete-1
-         :query
-         (str "-- :name " query-name " " signature "\n"
            "-- :doc updates an existing " pretty-name " record\n"
            "DELETE FROM " entity-name "\n"
            (where-clause entity-map)
-              "\n\n")}))))
+           "\n\n"))))
 
 
 (defn queries
   [entity-map entities-map]
-  (merge
+  (str
-    {}
     (insert-query entity-map)
     (update-query entity-map)
     (delete-query entity-map)
     (if
       (is-link-table? entity-map)
       (link-table-queries entity-map entities-map)
-      (merge
+      (str
         (select-query entity-map)
         (list-query entity-map)
-        (search-query entity-map)
         (foreign-queries entity-map entities-map)))))
 
 
@@ -317,24 +206,6 @@
   ([migrations-path output]
    (let
      [adl-struct (migrations-to-xml migrations-path "Ignored")
-      file-content (apply
+      file-content (apply str (map #(queries % adl-struct) (vals adl-struct)))]
-                    str
-                    (cons
-                     (str "-- "
-                          output
-                          " autogenerated by \n-- [squirrel-parse](https://github.com/simon-brooke/squirrel-parse)\n-- at "
-                          (f/unparse (f/formatters :basic-date-time) (t/now))
-                          "\n\n")
-                     (doall
-                      (map
-                       #(:query %)
-                       (sort
-                        #(compare (:name %1) (:name %2))
-                        (vals
-                         (apply
-                          merge
-                          (map
-                           #(queries % adl-struct)
-                           (vals adl-struct)))))))))]
      (spit output file-content)
      file-content)))

src/squirrel_parse/to_json_routes.clj

@@ -1,242 +0,0 @@
-(ns ^{:doc "A parser for SQL: generate JSON routes."
-      :author "Simon Brooke"}
-  squirrel-parse.to-json-routes
-  (:require [clojure.java.io :refer [file]]
-            [clojure.math.combinatorics :refer [combinations]]
-            [clojure.pprint :refer [pprint write]]
-            [clojure.string :as s]
-            [clj-time.core :as t]
-            [clj-time.format :as f]
-            [squirrel-parse.to-adl :refer [migrations-to-xml]]
-            [squirrel-parse.to-hugsql-queries :refer [queries]]
-            [squirrel-parse.utils :refer [is-link-table? singularise]]))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; squirrel-parse.to-json-routes: generate JSON routes.
-;;;;
-;;;; This program is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU General Public License
-;;;; as published by the Free Software Foundation; either version 2
-;;;; of the License, or (at your option) any later version.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this program; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
-;;;; USA.
-;;;;
-;;;; Copyright (C) 2018 Simon Brooke
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; The overall structure of this has quite closely to follow the structure of
-;;; to-hugsql-queries, because essentially we need one JSON entry point to wrap
-;;; each query.
-
-(defn file-header [parent-name this-name]
-  (list
-    'ns
-    (symbol (str parent-name ".routes." this-name))
-    (str "JSON routes for " parent-name
-         " auto-generated by [squirrel-parse](https://github.com/simon-brooke/squirrel-parse) at "
-         (f/unparse (f/formatters :basic-date-time) (t/now)))
-    (list
-      'require
-      '[noir.response :as nresponse]
-      '[noir.util.route :as route]
-      '[compojure.core :refer [defroutes GET POST]]
-      '[ring.util.http-response :as response]
-      '[clojure.java.io :as io]
-      '[hugsql.core :as hugsql]
-      (vector (symbol (str parent-name ".db.core")) :as 'db))))
-
-
-(defn make-safe-name [string]
-  (s/replace string #"[^a-zA-Z0-9-]" ""))
-
-
-(defn declarations [handlers-map]
-  (cons 'declare (sort (map #(symbol (make-safe-name (name %))) (keys handlers-map)))))
-
-
-(defn generate-handler-src
-  [handler-name query-map method doc]
-  (hash-map
-    :method method
-    :src
-    (remove
-    nil?
-    (list
-      'defn
-      handler-name
-      (str "Auto-generated method to " doc)
-      [{:keys ['params]}]
-      (list 'do (list (symbol (str "db/" (:name query-map))) 'params))
-      (case
-        (:type query-map)
-        (:delete-1 :update-1)
-        '(response/found "/")
-        nil)))))
-
-
-(defn handler
-  "Generate declarations for handlers from query with this `query-key` in this `queries-map` taken from within
-  this `entities-map`. This method must follow the structure of
-  `to-hugsql-queries/queries` quite closely, because we must generate the same names."
-  [query-key queries-map entities-map]
-  (let [query (query-key queries-map)
-        handler-name (symbol (make-safe-name (name query-key)))]
-    (hash-map
-      (keyword handler-name)
-      (merge
-        {:name handler-name
-         :route (str "/json/" handler-name)}
-        (case
-          (:type query)
-          :delete-1
-          (generate-handler-src
-            handler-name query :post
-            (str "delete one record from the `"
-                 (-> query :entity :attrs :name)
-                 "` table. Expects the following key(s) to be present in `params`: `"
-                 (doall (-> query :entity :content :key :content keys))
-                 "`."))
-          :insert-1
-          (generate-handler-src
-            handler-name query :post
-            (str "insert one record to the `"
-                 (-> query :entity :attrs :name)
-                 "` table. Expects the following key(s) to be present in `params`: `"
-                 (pr-str (-> query :entity :content :properties keys))
-                 "`. Returns a map containing the keys `"
-                 (pr-str (-> query :entity :content :key :content keys))
-                 "` identifying the record created."))
-          :update-1
-          (generate-handler-src
-            handler-name query :post
-            (str "update one record in the `"
-                 (-> query :entity :attrs :name)
-                 "` table. Expects the following key(s) to be present in `params`: `"
-                 (pr-str
-                   (distinct
-                     (sort
-                       (flatten
-                         (cons
-                           (-> query :entity :content :properties keys)
-                           (-> query :entity :content :key :content keys))))))
-                 "`."))
-          :select-1
-          (generate-handler-src
-            handler-name query :post
-            (str "select one record from the `"
-                 (-> query :entity :attrs :name)
-                 "` table. Expects the following key(s) to be present in `params`: `"
-                 (pr-str (-> query :entity :content :key :content keys))
-                 "`. Returns a map containing the following keys: `"
-                 (pr-str
-                   (distinct
-                     (sort
-                       (flatten
-                         (cons
-                           (-> query :entity :content :properties keys)
-                           (-> query :entity :content :key :content keys))))))
-                 "`."))
-          :select-many
-          (generate-handler-src
-            handler-name query :get
-            (str "select all records from the `"
-                 (-> query :entity :attrs :name)
-                 "` table. If the keys `(:limit :offset)` are present in the request then they will be used to page through the data. Returns a sequence of maps each containing the following keys: `"
-                 (pr-str
-                   (distinct
-                     (sort
-                       (flatten
-                         (cons
-                           (-> query :entity :content :properties keys)
-                           (-> query :entity :content :key :content keys))))))
-                 "`."))
-          :text-search
-          (generate-handler-src
-            handler-name query :get
-            (str "select all records from the `"
-                 (-> query :entity :attrs :name)
-                 "` table with any text field matching the value of the key `:pattern` which should be in the request. If the keys `(:limit :offset)` are present in the request then they will be used to page through the data. Returns a sequence of maps each containing the following keys: `"
-                 (pr-str
-                   (distinct
-                     (sort
-                       (flatten
-                         (cons
-                           (-> query :entity :content :properties keys)
-                           (-> query :entity :content :key :content keys))))))
-                 "`."))
-          (:select-many-to-many
-           :select-one-to-many)
-          (hash-map :method :get
-                    :src (list 'defn handler-name [{:keys ['params]}]
-                               (list 'do (list (symbol (str "db/" (:name query))) 'params))))
-          ;; default
-          (hash-map
-            :src
-            (str ";; don't know what to do with query `" :key "` of type `" (:type query) "`.")))))))
-
-
-(defn defroutes [handlers-map]
-  (cons
-    'defroutes
-    (cons
-      'auto-rest-routes
-      (map
-        #(let [handler (handlers-map %)]
-           (list
-             (symbol (s/upper-case (name (:method handler))))
-             (str "/json/auto/" (:name handler))
-             'request
-              (list
-                'route/restricted
-               (list (:name handler) 'request))))
-        (sort
-          (keys handlers-map))))))
-
-
-(defn migrations-to-json-routes
-  ([migrations-path parent-namespace-name]
-   (migrations-to-json-routes migrations-path parent-namespace-name "auto-json-routes"))
-  ([migrations-path parent-namespace-name namespace-name]
-   (let [output (str (s/replace namespace-name #"-" "_") ".clj")
-         adl-struct (migrations-to-xml migrations-path "Ignored")
-         q (reduce
-             merge
-             {}
-             (map
-               #(queries % adl-struct)
-               (vals adl-struct)))
-         h (reduce
-             merge
-             {}
-             (map
-               #(handler % q adl-struct)
-               (keys q)))
-         f (cons
-             (file-header parent-namespace-name namespace-name)
-             ;;                          (pre-declare
-             (cons
-               (declarations h)
-               (cons
-                 (defroutes h)
-                 (map #(:src (h %)) (sort (keys h))))))]
-     (spit
-       output
-       (with-out-str
-         (doall
-           (for [expr f]
-             (do
-               (pprint expr)
-               (print "\n\n"))))))
-     f
-     )))

src/squirrel_parse/utils.clj

@@ -213,5 +213,5 @@
 
 
 (defn singularise [string]
-  (s/replace (s/replace (s/replace string #"_" "-") #"s$" "") #"ie$" "y"))
+  (s/replace (s/replace string #"_" "-") #"s$" ""))
 

src/squirrel_parse/validator.clj

@@ -1,663 +0,0 @@
-(ns ^{:doc "A parser for SQL: validator for ADL structure."
-      :author "Simon Brooke"}
-  squirrel-parse.validator
-  (:require [clojure.set :refer [union]]
-            [bouncer.core :as b]
-            [bouncer.validators :as v]))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; squirrel-parse.to-adl: validate Application Description Language.
-;;;;
-;;;; This program is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU General Public License
-;;;; as published by the Free Software Foundation; either version 2
-;;;; of the License, or (at your option) any later version.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this program; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
-;;;; USA.
-;;;;
-;;;; Copyright (C) 2018 Simon Brooke
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(defn disjunct-validate
-  ;; 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 "Tag: " (:tag o) "; name: " (:name (:attrs o))))
-  (let
-    [rs (map
-         #(b/validate o %)
-         validations)
-     all-candidates (remove nil? (map first rs))
-     suspicious (remove :tag all-candidates)]
-    ;; if *any* succeeded, we succeeded
-    ;; otherwise, one of these is the valid error - but which? The answer, in my case
-    ;; is that if there is any which did not fail on the :tag check, then that is the
-    ;; interesting one. But generally?
-    (doall (map #(println (str "\tError: " %)) suspicious))
-    (empty? suspicious)))
-
-(v/defvalidator disjunct-validator
-  ;; 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?
-  {:optional false}
-  [value & validations]
-  (let
-    [rs (map
-         #(b/validate value %)
-         validations)]
-    ;; if *any* succeeded, we succeeded
-    ;; otherwise, one of these is the valid error - but which? The answer, in my case
-    ;; is that if there is any which did not fail on the :tag check, then that is the
-    ;; interesting one. But generally?
-    (empty? (remove :tag (map first rs)))))
-
-;;; the remainder of this file is a fairly straight translation of the ADL 1.4 DTD into Clojure
-
-
-(declare fieldgroup-validations)
-
-(def permissions
-  "permissions a group may have on an entity, list, page, form or field
-	permissions are deemed to increase as you go right. A group cannot
-	have greater permission on a field than on the form it is in, or
-	greater permission on form than the entity it belongs to
-
-	* `none`:			none
-	* `read`:			select
-	* `insert`:			insert
-	* `noedit`:			select, insert
-	* `edit`:			select, insert, update
-	* `all`:			select, insert, update, delete"
-  #{"none", "read", "insert", "noedit", "edit", "all"})
-
-(def cascade-actions
-  "actions which should be cascaded to dependent objects. All these values except
-  'manual' are taken from Hibernate and should be passed through the adl2hibernate
-  mapping transparently. Relevent only for properties with type='entity', type='link'
-  and type='list'
-
-  * `all`:       cascade delete, save and update
-  * `all-delete-orphan`: see hibernate documentation; relates to transient objects only
-  * `delete`:    cascade delete actions, but not save and update
-  * `manual`:    cascading will be handled in manually managed code, code to
-              handle cascading should not be generated
-  * `save-update`: cascade save and update actions, but not delete."
-  #{"all", "all-delete-orphan", "delete", "manual", "save-update"})
-
-(def defineable-data-types
-	"data types which can be used in a typedef to provide validation -
-	e.g. a string can be used with a regexp or a scalar can be used with
-	min and max values
-	* `string`: 		varchar		java.sql.Types.VARCHAR
-	* `integer`:		int			java.sql.Types.INTEGER
-	* `real`:			double		java.sql.Types.DOUBLE
-	* `money`:			money		java.sql.Types.INTEGER
-	* `date`:			date		java.sql.Types.DATE
-	* `time`:			time		java.sql.Types.TIME
-	* `timestamp`:		timestamp	java.sql.Types.TIMESTAMP
-	* `uploadable`:		varchar		java.sql.Types.VARCHAR
-	* `image`:			varchar		java.sql.Types.VARCHAR
-
-	uploadable is as string but points to an uploaded file; image is as
-	uploadable but points to an uploadable graphical image file."
-  #{"string", "integer", "real", "money", "date", "time", "timestamp", "uploadable"})
-
-(def simple-data-types
-  "data types which are fairly straightforward translations of JDBC data types
-  * `boolean`:		boolean 	java.sql.Types.BIT or char(1)		  java.sql.Types.CHAR
-  * `text`:			  text or		  java.sql.Types.LONGVARCHAR
-  memo		    java.sql.Types.CLOB"
-  (union
-    defineable-data-types
-    #{"boolean" "text"}))
-
-(def complex-data-types
-  "data types which are more complex than SimpleDataTypes...
-	* `entity` : 		a foreign key link to another entity (i.e. the 'many' end of a
-					    one-to-many link);
-	* `list` :			a list of some other entity that links to me (i.e. the 'one' end of
-					    a one-to-many link);
-	* `link` : 			a many to many link (via a link table);
-	* `defined` : 	a type defined by a typedef."
-  #{"entity", "link", "list", "defined"})
-
-(def special-data-types
-  "data types which require special handling - which don't simply map onto
-  common SQL data types
-  * `geopos` :    a latitude/longitude pair (experimental and not yet implemented)
-  * `image` :     a raster image file, in jpeg, gif, or png format (experimental, not yet implemented)
-  * `message` :   an internationalised message, having different translations for different locales"
-  #{"geopos", "image", "message"})
-
-(def all-data-types (union
-                     simple-data-types
-                     complex-data-types
-                     special-data-types))
-
-(def content
-  "content, for things like pages (i.e. forms, lists, pages)"
-  #{"head", "top", "foot"})
-
-(def field-stuff #{"field", "fieldgroup", "auxlist", "verb"})
-
-(def page-content (union content field-stuff))
-
-(def page-stuff (union page-content #{"permission", "pragma"}))
-
-(def generator-actions #{"assigned", "guid", "manual", "native"})
-
-(def sequences #{"canonical", "reverse-canonical"})
-
-(def specification-validations
-  {:tag [v/required [#(= % :specification)]]})
-
-(def documentation-validations
-  "contains documentation on the element which immediately contains it. TODO:
-  should HTML markup within a documentation element be allowed? If so, are
-  there restrictions?"
-  {:tag [v/required [#(= % :documentation)]]})
-
-(def content-validations
-  {:tag [v/required [#(= % :content)]]})
-
-(def help-validations
-	"helptext about a property of an entity, or a field of a page, form or
-	list, or a typedef. Typically there will be only one of these per property
-  per locale; if there are more than one all those matching the locale may
-  be concatenated, or just one may be used.
-
-	* `locale`:			the locale in which to prefer this prompt"
-  {:tag [v/required [#(= % :help)]]
-   [:attrs :locale] [v/string v/required [v/matches #"[a-z]{2}-[A-Z]{2}"]]})
-
-(def ifmissing-validations
-  "helpful text to be shown if a property value is missing, typically when
-  a form is submitted. Typically there will be only one of these per property
-  per locale; if there are more than one all those matching the locale may
-  be concatenated, or just one may be used. Later there may be more sophisticated
-  behaviour here.
-
-	* `locale`:			the locale in which to prefer this prompt"
-  {:tag [v/required [#(= % :if-missing)]]
-   [:attrs :locale] [v/string v/required [v/matches #"[a-z]{2}-[A-Z]{2}"]]})
-
-(def param-validations
-  "A parameter passed to the generator. Again, based on the Hibernate
-  implementation.
-
-  * `name`:   the name of this parameter."
-  {:tag [v/required [#(= % :param)]]
-   [:attrs :name] [v/string v/required]})
-
-
-(def permission-validations
-  "permissions policy on an entity, a page, form, list or field
-
-	* `group`: 			the group to which permission is granted
-	* `permission`:		the permission which is granted to that group."
-  {:tag [v/required [#(= % :permission)]]
-   [:attrs :group] [v/string v/required] ;; TODO: and it must be the name of a group that has already been defined.
-   [:attrs :permission] [v/required [v/matches permissions]]})
-
-
-(def prompt-validations
-	"a prompt for a property or field; used as the prompt text for a widget
-	which edits it. Typically there will be only one of these per property
-  per locale; if there are more than one all those matching the locale may
-  be concatenated, or just one may be used.
-
-	* `prompt`:			the prompt to use
-	* `locale`:			the locale in which to prefer this prompt."
-  {:tag [v/required [#(= % :prompt)]]
-   [:attrs :prompt] [v/string v/required]
-   [:attrs :locale] [v/string v/required [v/matches #"[a-z]{2}-[A-Z]{2}"]]})
-
-(def ifmissing-validations
-	"helpful text to be shown if a property value is missing, typically when
-  a form is submitted. Typically there will be only one of these per property
-  per locale; if there are more than one all those matching the locale may
-  be concatenated, or just one may be used. Later there may be more sophisticated
-  behaviour here.
-
-	* `locale`:			the locale in which to prefer this prompt."
-  {:tag [v/required [#(= % :ifmissing)]]
-   [:attrs :locale] [v/string v/required [v/matches #"[a-z]{2}-[A-Z]{2}"]]})
-
-(def option-validations
-  "one of an explicit list of optional values a property may have
-  NOTE: whether options get encoded at application layer or at database layer
-  is UNDEFINED; either behaviour is correct. If at database layer it's also
-  UNDEFINED whether they're encoded as a single reference data table or as
-  separate reference data tables for each property.
-
-  * `value`:	the value of this option."
-  {:tag [v/required [#(= % :option)]]
-   [:attrs :value] [v/required]
-   :content [[v/every #(or
-                        (b/valid? % documentation-validations)
-                        (b/valid? % prompt-validations))]]})
-
-(def pragma-validations
-  "pragmatic advice to generators of lists and forms, in the form of
-  name/value pairs which may contain anything. Over time some pragmas
-  will become 'well known', but the whole point of having a pragma
-  architecture is that it is extensible."
-  {:tag [v/required [#(= % :pragma)]]
-   [:attrs :name] [v/string v/required]
-   [:attrs :value] [v/string v/required]})
-
-
-
-(def generator-validations
-  "marks a property which is auto-generated by some part of the system.
-  This is based on the Hibernate construct, except that the Hibernate
-  implementation folds both its internal generators and custom generators
-  onto the same attribute. This separates them onto two attributes so we
-  can police values for Hibernate's 'builtin' generators.
-
-  * `action`:       one of the supported Hibernate builtin generators, or
-                'manual'. 'native' is strongly recommended in most instances
-  * `class`:        if action is 'manual', the name of a manually maintained
-                class conforming to the Hibernate IdentifierGenerator
-                interface, or its equivalent in other languages."
-  {:tag [v/required [#(= % :generator)]]
-   [:attrs :action] [v/string v/required [v/member generator-actions]]
-   [:attrs :class] v/string
-   :content [[v/every #(disjunct-validate %
-                         documentation-validations
-                         param-validations)]]})
-
-
-(def in-implementation-validations
-  "information about how to translate a type into types known to different target
-  languages. TODO: Once again I'm not wholly comfortable with the name; I'm not
-  really comfortable that this belongs in ADL at all.
-
-  * `target`:     the target language
-  * `value`:      the type to use in that target language
-  * `kind`:       OK, I confess I don't understand this, but Andrew needs it... "
-
-  {:tag [v/required [#(= % :in-implementation)]]
-   [:attrs :target] [v/string v/required]
-   [:attrs :value] [v/string v/required]
-   [:attrs :kind] v/string
-   :content [[v/every documentation-validations]]})
-
-(def typedef-validations
-  "the definition of a defined type. At this stage a defined type is either
-	* a string		in which case it must have size and pattern, or
-	* a scalar		in which case it must have minimum and/or maximum
-	pattern must be a regular expression as interpreted by org.apache.regexp.RE
-	minimum and maximum must be of appropriate format for the datatype specified.
-	Validation may be done client-side and/or server-side at application layer
-	and/or server side at database layer.
-
-  * `name`:     the name of this typedef
-  * `type`:     the simple type on which this defined type is based; must be
-            present unless in-implementation children are supplied
-  * `size`:     the data size of this defined type
-  * `pattern`:  a regular expression which values for this type must match
-  * `minimum`:  the minimum value for this type (if base type is scalar)
-  * `maximum`:  the maximum value for this type (if base type is scalar)"
-  {:tag [v/required [#(= % :typedef)]]
-   [:attrs :name] [v/required v/string]
-   [:attrs :type] [[v/member defineable-data-types]]
-   [:attrs :size] [[#(if
-                       (string? %)
-                       (integer? (read-string %))
-                       (integer? %))]]
-   [:attrs :pattern] v/string
-   [:attrs :minimum] [[#(if
-                          (string? %)
-                          (integer? (read-string %))
-                          (integer? %))]]
-   [:attrs :maximum] [[#(if
-                          (string? %)
-                          (integer? (read-string %))
-                          (integer? %))]]
-   :content [[v/every #(or
-                         (b/valid? % documentation-validations)
-                         (b/valid? % in-implementation-validations)
-                         (b/valid? % help-validations))]]})
-
-(def group-validations
-  "a group of people with similar permissions to one another
-
-  * `name`: the name of this group
-  * `parent`: the name of a group of which this group is subset"
-  {:tag [v/required [#(= % :group)]]
-   [:attrs :name] [v/string v/required]
-   [:attrs :parent] v/string
-   :content [[v/every documentation-validations]]})
-
-(def property-validations
-	"a property (field) of an entity (table)
-
-	* `name`:			  the name of this property.
-	* `type`:			  the type of this property.
-	* `default`:		the default value of this property. There will probably be
-					    magic values of this!
-	* `typedef`:	  name of the typedef to use, it type = 'defined'.
-	* `distinct`:		distinct='system' required that every value in the system
-					    will be distinct (i.e. natural primary key);
-					    distinct='user' implies that the value may be used by users
-					    in distinguishing entities even if values are not formally
-					    unique;
-					    distinct='all' implies that the values are formally unique
-					    /and/ are user friendly (NOTE: not implemented).
-	* `entity`:	if type='entity', the name of the entity this property is
-					    a foreign key link to.
-              if type='list', the name of the entity that has a foreign
-              key link to this entity
-	* `farkey`:   if type='list', the name of farside key in the listed
-              entity; if type='entity' and the farside field to join to
-              is not the farside primary key, then the name of that
-              farside field
-	* `required`:		whether this propery is required (i.e. 'not null').
-	* `immutable`:		if true, once a value has been set it cannot be changed.
-	* `size`: 			fieldwidth of the property if specified.
-	* `concrete`: if set to 'false', this property is not stored in the
-              database but must be computed (manually written code must
-              be provided to support this)
-	* `cascade`:  what action(s) on the parent entity should be cascaded to
-              entitie(s) linked on this property. Valid only if type='entity',
-              type='link' or type='list'.
-	* `column`:   name of the column in a SQL database table in which this property
-              is stored. TODO: Think about this.
-	* `unsaved-value`:
-              of a property whose persistent value is set on first being
-              committed to persistent store, the value which it holds before
-              it has been committed"
-  {:tag [v/required [#(= % :property)]]
-   [:attrs :name] [v/required v/string]
-   [:attrs :type] [v/required [v/member all-data-types]]
-   ;; [:attrs :default] [] ;; it's allowed, but I don't have anything particular to say about it
-   [:attrs :typedef] v/string
-   [:attrs :distinct] [v/string [v/member #{"none", "all", "user", "system"}]]
-   [:attrs :entity] v/string
-   [:attrs :farkey] v/string
-   [:attrs :required] [[v/member #{"true", "false"}]]
-   [:attrs :immutable] [[v/member #{"true", "false"}]]
-   [:attrs :size] [[#(cond
-                      (empty? %) ;; it's allowed to be missing
-                      true
-                       (string? %)
-                       (integer? (read-string %))
-                      true
-                       (integer? %))]]
-   [:attrs :column] v/string
-   [:attrs :concrete] [[v/member #{"true", "false"}]]
-   [:attrs :cascade] [[v/member cascade-actions]]
-   :content [[v/every #(disjunct-validate %
-                         documentation-validations
-                         generator-validations
-                         permission-validations
-                         option-validations
-                         prompt-validations
-                         help-validations
-                         ifmissing-validations)]]})
-
-
-(def permission-validations
-  "permissions policy on an entity, a page, form, list or field
-
-  * `group`: 			the group to which permission is granted
-  * `permission`:		the permission which is granted to that group"
-  {:tag [v/required [#(= % :permission)]]
-   [:attrs :group] [v/required v/string] ;; and it also needs to be the name of a pre-declared group
-   [:attrs :permission] [[v/member permissions]]
-   :content [[v/every documentation-validations]]})
-
-(def head-validations
-  "content to place in the head of the generated document; normally HTML."
-  {:tag [v/required [#(= % :head)]]})
-
-(def top-validations
-  "content to place in the top of the body of the generated document;
-	this is any HTML block or inline level element."
-  {:tag [v/required [#(= % :top)]]})
-
-(def foot-validations
-  "content to place in the bottom of the body of the generated document;
-	this is any HTML block or inline level element."
-  {:tag [v/required [#(= % :foot)]]})
-
-(def field-validations
-  "a field in a form or page
-
-  * `property`:   the property which this field displays/edits."
-  {:tag [v/required [#(= % :field)]]
-   [:attrs :property] [v/string v/required] ;; and it must also be the name of a property in the current entity
-   :content [[v/every #(or
-                         (b/valid? % documentation-validations)
-                         (b/valid? % prompt-validations)
-                         (b/valid? % permission-validations)
-                         (b/valid? % help-validations))]]})
-
-(def verb-validations
-  "a verb is something that may be done through a form. Probably the verbs 'store'
-  and 'delete' are implied, but maybe they need to be explicitly declared. The 'verb'
-  attribute of the verb is what gets returned to the controller
-
-  * `verb`  what gets returned to the controller when this verb is selected
-  * `dangerous`  true if this verb causes a destructive change."
-  {:tag [v/required [#(= % :verb)]]
-   [:attrs :verb] [v/string v/required]
-   [:attrs :dangerous] [[v/member #{"true", "false"}] v/required]})
-
-(def order-validations
-  "an ordering or records in a list
-	* `property`:	the property on which to order
-	* `sequence`:	the sequence in which to order"
-  {:tag [v/required [#(= % :order)]]
-   [:attrs :property] [v/string v/required] ;; and it must also be the name of a property in the current entity
-   [:attrs :sequence] [[v/member sequences]]
-   :content [[v/every documentation-validations]]})
-
-(def auxlist-validations
-  "a subsidiary list, on which entities related to primary
-  entities in the enclosing page or list are listed
-
-  * `property`:   the property of the enclosing entity that this
-              list displays (obviously, must be of type='list')
-  * `onselect`:   the form or page of the listed entity to call
-              when an item from the list is selected
-  * `canadd`:     true if the user should be able to add records
-              to this list"
-  {:tag [v/required [#(= % :auxlist)]]
-   [:attrs :property] [v/string v/required] ;; and it must also be the name of a property of type `list` in the current entity
-   [:attrs :onselect] v/string
-   [:attrs :canadd] v/boolean
-   :content [[v/every #(or
-                         (b/valid? % documentation-validations)
-                         (b/valid? % prompt-validations)
-                         (b/valid? % field-validations)
-                         (b/valid? % fieldgroup-validations)
-                         (b/valid? % auxlist-validations)
-                         (b/valid? % verb-validations))]]})
-
-(def fieldgroup-validations
-  "a group of fields and other controls within a form or list, which the
-  renderer might render as a single pane in a tabbed display, for example."
-  {:tag [v/required [#(= % :fieldgroup)]]
-   [:attrs :name] [v/string v/required]
-   :content [[v/every #(or
-                         (b/valid? % documentation-validations)
-                         (b/valid? % prompt-validations)
-                         (b/valid? % permission-validations)
-                         (b/valid? % help-validations)
-                         (b/valid? % field-validations)
-                         (b/valid? % fieldgroup-validations)
-                         (b/valid? % auxlist-validations)
-                         (b/valid? % verb-validations))]]})
-
-
-(def form-validations
-  "a form through which an entity may be added or edited"
-  {:tag [v/required [#(= % :form)]]
-   [:attrs :name] [v/required v/string]
-   [:attrs :properties] [v/required [v/member #{"all", "user-distinct", "listed"}]]
-   [:attrs :canadd] [[v/member #{"true", "false"}]]
-   :content [[v/every #(disjunct-validate %
-                          documentation-validations
-                          head-validations
-                          top-validations
-                          foot-validations
-                          field-validations
-                          fieldgroup-validations
-                          auxlist-validations
-                          verb-validations
-                          permission-validations
-                          pragma-validations)]]})
-
-(def page-validations
-  "a page on which an entity may be displayed"
-  {:tag [v/required [#(= % :page)]]
-   [:attrs :name] [v/required v/string]
-   [:attrs :properties] [v/required [v/member #{"all", "user-distinct", "listed"}]]
-   :content [[v/every #(disjunct-validate %
-                          documentation-validations
-                          head-validations
-                          top-validations
-                          foot-validations
-                          field-validations
-                          fieldgroup-validations
-                          auxlist-validations
-                          verb-validations
-                          permission-validations
-                          pragma-validations)]]})
-
-(def list-validations
-  "a list on which entities of a given type are listed
-
-	* `onselect`:		name of form/page/list to go to when
-					    a selection is made from the list"
-  {:tag [v/required [#(= % :list)]]
-   [:attrs :name] [v/required v/string]
-   [:attrs :properties] [v/required [v/member #{"all", "user-distinct", "listed"}]]
-   [:attrs :onselect] v/string
-   :content [[v/every #(disjunct-validate %
-                          documentation-validations
-                          head-validations
-                          top-validations
-                          foot-validations
-                          field-validations
-                          fieldgroup-validations
-                          auxlist-validations
-                          verb-validations
-                          permission-validations
-                          pragma-validations
-                          order-validations)]]})
-
-(def key-validations
-  {:tag [v/required [#(= % :key)]]
-   :content [[v/every property-validations]]})
-
-
-(def entity-validations
-  "an entity which has properties and relationships; maps onto a database
-	table or a Java serialisable class - or, of course, various other things
-
-  * `name`:         obviously, the name of this entity
-  * `natural-key`:  if present, the name of a property of this entity which forms
-                a natural primary key [NOTE: Only partly implemented. NOTE: much of
-                the present implementation assumes all primary keys will be
-                integers. This needs to be fixed!] DEPRECATED: remove; replace with the
-                'key' element, below.
-  * `table`:        the name of the table in which this entity is stored. Defaults to same
-                as name of entity. Strongly recommend this is not used unless it needs
-                to be different from the name of the entity
-  * `foreign`:      this entity is part of some other system; no code will be generated
-                for it, although code which links to it will be generated"
-  {:tag [v/required [#(= % :entity)]]
-   [:attrs :name] [v/required v/string]
-   [:attrs :natural-key] v/string
-   [:attrs :table] v/string
-   [:attrs :foreign] [[v/member #{"true", "false"}]]
-   :content [[v/every #(disjunct-validate %
-                         documentation-validations
-                         prompt-validations
-                         content-validations
-                         key-validations
-                         property-validations
-                         permission-validations
-                         form-validations
-                         page-validations
-                         list-validations)]]})
-
-(def application-validations
-  {:tag [v/required [#(= % :application)]]
-   [:attrs :name] [v/required v/string]
-   [:attrs :version] v/string
-   [:attrs :revision] v/string
-   [:attrs :currency] v/string
-   :content [[v/every #(disjunct-validate %
-                         specification-validations
-                         documentation-validations
-                         content-validations
-                         typedef-validations
-                         group-validations
-                         entity-validations)]]})
-
-;; the good news: it's complete.
-;; the bad news: it doesn't yet work.
-;; TODO: write a function which takes the output of bouncer.core.validate and filters out the paths to those bits which failed.
-
-(defn find-keys
-  [o p]
-  (cond
-   (map? o)
-   (reduce
-    merge
-    {}
-    (map
-     (fn [k]
-       (let [tail (find-keys (o k) p)] ;; error is here
-        (cond
-         (not (empty? tail))
-         {k tail}
-         (p k)
-         {k (o k)}
-         true
-         {})))
-     (keys o)))
-   (coll? o)
-   (remove empty? (map #(find-keys % p) o))))
-
-(defn walk-find-keys
-  [o p]
-  (walk
-   #(do %)
-   #(cond
-     (map? %)
-     (reduce
-      {}
-      (remove
-        empty?
-       (map
-        (fn [k]
-          (cond
-           (p k)
-           {k (% k)}
-           (walk-find-keys (% k) p)
-           {k (walk-find-keys (% k) p)}))
-        (keys %))))
-     (coll? %)
-     (remove
-      empty?
-      (map
-       (fn [e]
-         (walk-find-keys e p))
-       %)))
-   o))