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

Prefer safe-name

Browse source
This commit is contained in:
Simon Brooke 2018-06-15 15:37:21 +01:00
parent f0ddceb19c e879b8b628
commit 8dae86ec79
6 changed files with 217 additions and 138 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

89
src/adl/to_hugsql_queries.clj
View file

@ -1,7 +1,7 @@
(ns ^{:doc "Application Description Language - generate HUGSQL queries file." (ns ^{:doc "Application Description Language - generate HUGSQL queries file."
:author "Simon Brooke"} :author "Simon Brooke"}
adl.to-hugsql-queries adl.to-hugsql-queries
(:require [clojure.java.io :refer [file]] (:require [clojure.java.io :refer [file make-parents]]
[clojure.math.combinatorics :refer [combinations]] [clojure.math.combinatorics :refer [combinations]]
[clojure.string :as s] [clojure.string :as s]
[clojure.xml :as x] [clojure.xml :as x]
@ -54,7 +54,9 @@
(defn order-by-clause (defn order-by-clause
"Generate an appropriate `order by` clause for queries on this `entity`" "Generate an appropriate `order by` clause for queries on this `entity`"
[entity] ([entity]
(order-by-clause entity ""))
([entity prefix]
(let (let
[entity-name (:name (:attrs entity)) [entity-name (:name (:attrs entity))
preferred (map preferred (map
@ -65,10 +67,10 @@
(empty? preferred) (empty? preferred)
"" ""
(str (str
"ORDER BY " entity-name "." "ORDER BY " prefix entity-name "."
(s/join (s/join
(str ",\n\t" entity-name ".") (str ",\n\t" prefix entity-name ".")
(flatten (cons preferred (key-names entity)))))))) (flatten (cons preferred (key-names entity)))))))))
(defn insert-query (defn insert-query
@ -152,8 +154,8 @@
(str (str
"-- :doc selects existing " "-- :doc selects existing "
pretty-name pretty-name
" records having any string field matching `:pattern` by substring match") " records having any string field matching the parameter of the same name by substring match")
(str "SELECT * FROM " entity-name) (str "SELECT * FROM lv_" entity-name)
"WHERE " "WHERE "
(s/join (s/join
"\n\tOR " "\n\tOR "
@ -162,9 +164,9 @@
(map (map
#(if #(if
(#{"string" "date" "text"} (:type (:attrs %))) (#{"string" "date" "text"} (:type (:attrs %)))
(str (-> % :attrs :name) " LIKE '%:pattern%'")) (str (-> % :attrs :name) " LIKE '%params." (-> % :attrs :name) "%'"))
properties))) properties)))
(order-by-clause entity) (order-by-clause entity "lv_")
"--~ (if (:offset params) \"OFFSET :offset \")" "--~ (if (:offset params) \"OFFSET :offset \")"
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")")))}))) "--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")")))})))
@ -232,8 +234,8 @@
(list (list
(str "-- :name " query-name " " signature) (str "-- :name " query-name " " signature)
(str "-- :doc lists all existing " pretty-name " records") (str "-- :doc lists all existing " pretty-name " records")
(str "SELECT * FROM " entity-name) (str "SELECT * FROM lv_" entity-name)
(order-by-clause entity) (order-by-clause entity "lv_")
"--~ (if (:offset params) \"OFFSET :offset \")" "--~ (if (:offset params) \"OFFSET :offset \")"
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")")))}))) "--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")")))})))
@ -276,9 +278,11 @@
"entity" (list "entity" (list
(str "-- :name " query-name " " signature) (str "-- :name " query-name " " signature)
(str "-- :doc lists all existing " pretty-name " records related to a given " pretty-far) (str "-- :doc lists all existing " pretty-name " records related to a given " pretty-far)
(str "SELECT * \nFROM " entity-name) (str "SELECT * \nFROM lv_" entity-name ", " entity-name)
(str "WHERE " entity-name "." link-field " = :id") (str "WHERE lv_" entity-name "." (first (key-names entity)) " = "
(order-by-clause entity)) entity-name "." (first (key-names entity))
"\n\tAND " entity-name "." link-field " = :id")
(order-by-clause entity "lv_"))
"link" (let [link-table-name "link" (let [link-table-name
(link-table-name entity far-entity)] (link-table-name entity far-entity)]
(list (list
@ -325,18 +329,18 @@
:near-entity near :near-entity near
:far-entity far :far-entity far
:query :query
(s/join (s/join
"\n" "\n"
(remove (remove
empty? empty?
(list (list
(str "-- :name " query-name " " signature) (str "-- :name " query-name " " signature)
(str "-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far ) (str "-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far )
(str "SELECT "near-name ".*") (str "SELECT "near-name ".*")
(str "FROM " near-name ", " link-name ) (str "FROM " near-name ", " link-name )
(str "WHERE " near-name "." (first (key-names near)) " = " link-name "." (singularise near-name) "_id" ) (str "WHERE " near-name "." (first (key-names near)) " = " link-name "." (singularise near-name) "_id" )
("\tAND " link-name "." (singularise far-name) "_id = :id") ("\tAND " link-name "." (singularise far-name) "_id = :id")
(order-by-clause near))))})))) (order-by-clause near))))}))))
(defn link-table-queries [entity application] (defn link-table-queries [entity application]
@ -392,13 +396,10 @@
(defn queries (defn queries
"Generate all standard queries for this `entity` in this `application`; if "Generate all standard queries for this `entity` in this `application`; if
no entity is specified, generate all queris for the application." no entity is specified, generate all queries for the application."
([application entity] ([application entity]
(merge (merge
(if ;; TODO: queries that look through link tables
(link-table? entity)
(link-table-queries entity application)
{})
(insert-query entity) (insert-query entity)
(update-query entity) (update-query entity)
(delete-query entity) (delete-query entity)
@ -416,22 +417,22 @@
(defn to-hugsql-queries (defn to-hugsql-queries
"Generate all [HugSQL](https://www.hugsql.org/) queries implied by this ADL `application` spec." "Generate all [HugSQL](https://www.hugsql.org/) queries implied by this ADL `application` spec."
[application] [application]
(spit (let [file-path (str *output-path* "resources/sql/queries.sql")]
(str *output-path* "queries.sql") (make-parents file-path)
(s/join (spit
"\n\n" file-path
(cons (s/join
(s/join "\n\n"
"\n-- " (cons
(list (emit-header
"-- File queries.sql" "--"
"autogenerated by adl.to-hugsql-queries at" "File queries.sql"
(t/now) (str "autogenerated by adl.to-hugsql-queries at " (t/now))
"See [Application Description Language](https://github.com/simon-brooke/adl).\n\n")) "See [Application Description Language](https://github.com/simon-brooke/adl).")
(map (map
#(:query %) #(:query %)
(sort (sort
#(compare (:name %1) (:name %2)) #(compare (:name %1) (:name %2))
(vals (vals
(queries application)))))))) (queries application)))))))))

6
src/adl/to_json_routes.clj
View file

@ -47,12 +47,12 @@
(f/unparse (f/formatters :basic-date-time) (t/now))) (f/unparse (f/formatters :basic-date-time) (t/now)))
(list (list
:require :require
'[clojure.java.io :as io]
'[compojure.core :refer [defroutes GET POST]]
'[hugsql.core :as hugsql]
'[noir.response :as nresponse] '[noir.response :as nresponse]
'[noir.util.route :as route] '[noir.util.route :as route]
'[compojure.core :refer [defroutes GET POST]]
'[ring.util.http-response :as response] '[ring.util.http-response :as response]
'[clojure.java.io :as io]
'[hugsql.core :as hugsql]
(vector (symbol (str (safe-name (:name (:attrs application))) ".db.core")) :as 'db)))) (vector (symbol (str (safe-name (:name (:attrs application))) ".db.core")) :as 'db))))

132
src/adl/to_psql.clj
View file

@ -37,16 +37,6 @@
;;; this is a pretty straight translation of adl2psql.xslt, and was written because ;;; this is a pretty straight translation of adl2psql.xslt, and was written because
;;; Clojure is easier to debug. ;;; Clojure is easier to debug.
;;; TODO: the order in which we generate tables is critical, because tables
;;; can only reference other tables which already exist. We could get around
;;; this by generating referential integrity constraints post-hoc, which is
;;; what the xslt version did.
(defn sort-by-name
[elements]
(sort #(.compareTo (:name (:attrs %1)) (:name (:attrs %2))) elements))
(declare emit-field-type emit-property) (declare emit-field-type emit-property)
@ -60,7 +50,7 @@
(:pattern (:attrs typedef)) (:pattern (:attrs typedef))
(str (str
" CONSTRAINT " " CONSTRAINT "
(gensym "c-") (gensym "pattern_")
" CHECK (" " CHECK ("
(:name (:attrs property)) (:name (:attrs property))
" ~* '" " ~* '"
@ -70,7 +60,7 @@
;; TODO: if base type is date, time or timestamp, values should be quoted. ;; TODO: if base type is date, time or timestamp, values should be quoted.
(str (str
" CONSTRAINT " " CONSTRAINT "
(gensym "c-") (gensym "minmax_")
" CHECK (" " CHECK ("
(:minimum (:attrs typedef)) (:minimum (:attrs typedef))
" < " " < "
@ -83,7 +73,7 @@
(:maximum (:attrs typedef)) (:maximum (:attrs typedef))
(str (str
" CONSTRAINT " " CONSTRAINT "
(gensym "c-") (gensym "max_")
" CHECK (" " CHECK ("
(:name (:attrs property)) (:name (:attrs property))
" < " " < "
@ -92,7 +82,7 @@
(:minimum (:attrs typedef)) (:minimum (:attrs typedef))
(str (str
" CONSTRAINT " " CONSTRAINT "
(gensym "c-") (gensym "min_")
" CHECK (" " CHECK ("
(:minimum (:attrs typedef)) (:minimum (:attrs typedef))
" < " " < "
@ -154,15 +144,35 @@
(:DELETE :ALL) #{"all"}) (:DELETE :ALL) #{"all"})
group-names group-names
(set (set
(remove (remove
nil? nil?
(map (map
#(if (selector (:permission (:attrs %))) #(if (selector (:permission (:attrs %)))
(:group (:attrs %))) (safe-name (:group (:attrs %)) :sql))
permissions)))] permissions)))]
(if (if
(not (empty? group-names)) (not (empty? group-names))
(s/join " " (list "GRANT" (name privilege) "ON" table-name "TO" (s/join ",\n\t" (sort group-names)) ";"))))) (s/join
" "
(list
"GRANT"
(name privilege)
"ON"
(safe-name table-name :sql)
"TO"
(s/join
",\n\t"
(sort group-names))
";")))))
(defn field-name
[property]
(safe-name
(or
(:column (:attrs property))
(:name (:attrs property)))
:sql))
(defn emit-property (defn emit-property
@ -181,9 +191,17 @@
(flatten (flatten
(list (list
"\t" "\t"
(:name (:attrs property)) (field-name property)
(emit-field-type property entity application key?) (emit-field-type property entity application key?)
(if default (list "DEFAULT" default)) (if
default
(list
"DEFAULT"
(if
(is-quotable-type? property application)
(str "'" default "'") ;; TODO: but if the default value seems to be a function invocation, should it be quoted?
;; it's quite common for 'now()' to be the default for a date, time or timestamp field.
default)))
(if (if
key? key?
"NOT NULL PRIMARY KEY" "NOT NULL PRIMARY KEY"
@ -203,7 +221,7 @@
(if (if
(= (:type (:attrs f)) "entity") (= (:type (:attrs f)) "entity")
(compose-convenience-entity-field f farside application) (compose-convenience-entity-field f farside application)
(str (:table (:attrs farside)) "." (:name (:attrs f))))) (str (safe-name (:table (:attrs farside))) "." (field-name f))))
(user-distinct-properties farside))))) (user-distinct-properties farside)))))
@ -213,7 +231,7 @@
nil? nil?
(flatten (flatten
(cons (cons
(:name (:attrs entity)) (safe-name (:table (:attrs entity)) :sql)
(map (map
(fn [f] (fn [f]
(if (if
@ -242,13 +260,13 @@
(let [farside (entity-for-property f application)] (let [farside (entity-for-property f application)]
(cons (cons
(str (str
(:table (:attrs entity)) (safe-name (:table (:attrs entity)) :sql)
"." "."
(:name (:attrs f)) (field-name f)
" = " " = "
(:table (:attrs farside)) (safe-name (:table (:attrs farside)) :sql)
"." "."
(first (key-names farside))) (safe-name (first (key-names farside)) :sql))
#(compose-convenience-where-clause farside application false))))) #(compose-convenience-where-clause farside application false)))))
(if (if
top-level? top-level?
@ -260,17 +278,17 @@
[field entity application] [field entity application]
(str (str
(s/join (s/join
" |', '| " " ||', '|| "
(compose-convenience-entity-field field entity application)) (compose-convenience-entity-field field entity application))
" AS " " AS "
(:name (:attrs field)))) (field-name field)))
(defn emit-convenience-view (defn emit-convenience-view
"Emit a convenience view of this `entity` of this `application` for use in generating lists, "Emit a convenience view of this `entity` of this `application` for use in generating lists,
menus, et cetera." menus, et cetera."
[entity application] [entity application]
(let [view-name (str "lv_" (:table (:attrs entity))) (let [view-name (safe-name (str "lv_" (:table (:attrs entity))) :sql)
entity-fields (filter entity-fields (filter
#(= (:type (:attrs %)) "entity") #(= (:type (:attrs %)) "entity")
(properties entity))] (properties entity))]
@ -294,12 +312,12 @@
#(if #(if
(= (:type (:attrs %)) "entity") (= (:type (:attrs %)) "entity")
(emit-convenience-entity-field % entity application) (emit-convenience-entity-field % entity application)
(:name (:attrs %))) (str (safe-name entity) "." (field-name %)))
(filter (filter
#(and (= (:tag %) :property) (not (= (:type (:attrs %)) "link"))) #(not (= (:type (:attrs %)) "link"))
(all-properties entity) )))) (all-properties entity) ))))
(str (str
"FROM " (s/join ", " (compose-convenience-view-select-list entity application true))) "FROM " (s/join ", " (set (compose-convenience-view-select-list entity application true))))
(if (if
(not (empty? entity-fields)) (not (empty? entity-fields))
(str (str
@ -315,13 +333,13 @@
(entity? %) (entity? %)
(= (:name (:attrs %)) (:entity (:attrs f)))))] (= (:name (:attrs %)) (:entity (:attrs f)))))]
(str (str
(:table (:attrs entity)) (safe-name (:table (:attrs entity)) :sql)
"." "."
(:name (:attrs f)) (field-name f)
" = " " = "
(:table (:attrs farside)) (safe-name (:table (:attrs farside)) :sql)
"." "."
(first (key-names farside))))) (safe-name (first (key-names farside)) :sql))))
entity-fields)))) entity-fields))))
";" ";"
(emit-permissions-grant view-name :SELECT (permissions entity application)))))))) (emit-permissions-grant view-name :SELECT (permissions entity application))))))))
@ -335,14 +353,15 @@
" " " "
(list (list
"ALTER TABLE" "ALTER TABLE"
(:name (:attrs nearside)) (safe-name (:name (:attrs nearside)) :sql)
"ADD CONSTRAINT" "ADD CONSTRAINT"
(str "ri_" (:name (:attrs nearside)) "_" (:name (:attrs property))) (safe-name (str "ri_" (:name (:attrs nearside)) "_" (:name (:attrs farside)) "_" (:name (:attrs property))) :sql)
"\n\tFOREIGN KEY(" "\n\tFOREIGN KEY("
(:name (:attrs property)) (field-name property)
") \n\tREFERENCES" ") \n\tREFERENCES"
(str (str
(:table (:attrs farside)) "(" (:name (:attrs (first (key-properties farside)))) ")") (safe-name (:table (:attrs farside)) :sql)
"(" (field-name (first (key-properties farside))) ")")
;; TODO: ought to handle the `cascade` attribute, even though it's rarely used ;; TODO: ought to handle the `cascade` attribute, even though it's rarely used
"\n\tON DELETE" "\n\tON DELETE"
(case (case
@ -366,7 +385,7 @@
(list (list
(emit-header (emit-header
"--" "--"
(str "--\treferential integrity links for first-class tables")) "referential integrity links for primary tables")
(map (map
#(emit-referential-integrity-links % application) #(emit-referential-integrity-links % application)
(sort-by-name (children-with-tag application :entity))))))) (sort-by-name (children-with-tag application :entity)))))))
@ -374,7 +393,7 @@
(defn emit-table (defn emit-table
([entity application doc-comment] ([entity application doc-comment]
(let [table-name (:table (:attrs entity)) (let [table-name (safe-name (:table (:attrs entity)) :sql)
permissions (children-with-tag entity :permission)] permissions (children-with-tag entity :permission)]
(s/join (s/join
"\n" "\n"
@ -424,12 +443,11 @@
(defn construct-link-property (defn construct-link-property
[entity] [entity]
{:tag :property {:tag :property
:attrs {:name (str (:name (:attrs entity)) "_id") :attrs {:name (safe-name (str (:name (:attrs entity)) "_id") :sql)
:column (str (:name (:attrs entity)) "_id") :column (safe-name (str (:name (:attrs entity)) "_id") :sql)
:type "entity" :type "entity"
:entity (:name (:attrs entity)) :entity (:name (:attrs entity))
:farkey (first (key-names entity))} :farkey (safe-name (first (key-names entity)) :sql)}})
:content nil})
(defn emit-link-table (defn emit-link-table
@ -489,21 +507,13 @@
(sort-by-name (children-with-tag application :entity))))) (sort-by-name (children-with-tag application :entity)))))
(defn emit-entity
[entity application]
(doall
(list
(emit-table entity application)
(emit-convenience-view entity application))))
(defn emit-group-declaration (defn emit-group-declaration
[group application] [group application]
(list (list
(emit-header (emit-header
"--" "--"
(str "security group " (:name (:attrs group)))) (str "security group " (:name (:attrs group))))
(str "CREATE GROUP " (:name (:attrs group)) ";"))) (str "CREATE GROUP " (safe-name (:name (:attrs group)) :sql) ";")))
(defn emit-file-header (defn emit-file-header
@ -535,7 +545,11 @@
(sort-by-name (sort-by-name
(children-with-tag application :group))) (children-with-tag application :group)))
(map (map
#(emit-entity % application) #(emit-table % application)
(sort-by-name
(children-with-tag application :entity)))
(map
#(emit-convenience-view % application)
(sort-by-name (sort-by-name
(children-with-tag application :entity))) (children-with-tag application :entity)))
(emit-referential-integrity-links application) (emit-referential-integrity-links application)

30
src/adl/to_selmer_routes.clj
View file

@ -44,12 +44,12 @@
(f/unparse (f/formatters :basic-date-time) (t/now))) (f/unparse (f/formatters :basic-date-time) (t/now)))
(list (list
:require :require
'[clojure.java.io :as io]
'[compojure.core :refer [defroutes GET POST]]
'[hugsql.core :as hugsql]
'[noir.response :as nresponse] '[noir.response :as nresponse]
'[noir.util.route :as route] '[noir.util.route :as route]
'[compojure.core :refer [defroutes GET POST]]
'[ring.util.http-response :as response] '[ring.util.http-response :as response]
'[clojure.java.io :as io]
'[hugsql.core :as hugsql]
(vector (symbol (str (:name (:attrs application)) ".layout")) :as 'l) (vector (symbol (str (:name (:attrs application)) ".layout")) :as 'l)
(vector (symbol (str (:name (:attrs application)) ".db.core")) :as 'db) (vector (symbol (str (:name (:attrs application)) ".db.core")) :as 'db)
(vector (symbol (str (:name (:attrs application)) ".routes.manual")) :as 'm)))) (vector (symbol (str (:name (:attrs application)) ".routes.manual")) :as 'm))))
@ -78,11 +78,25 @@
:list :list
{:records {:records
(list (list
(symbol 'if
(str (list
"db/search-strings-" 'not
(singularise (:name (:attrs e))))) (list
'p)}))))))) 'empty?
(list 'remove 'nil? (list 'vals 'p))))
(list
(symbol
(str
"db/search-strings-"
(singularise (:name (:attrs e)))))
(symbol "db/*db*")
'p)
(list
(symbol
(str
"db/list-"
(:name (:attrs e))))
(symbol "db/*db*") {}))})))))))
(defn make-route (defn make-route
"Make a route for method `m` to request the resource with name `n`." "Make a route for method `m` to request the resource with name `n`."

11
src/adl/to_selmer_templates.clj
View file

@ -422,7 +422,7 @@
[list-spec entity application] [list-spec entity application]
{:tag :tbody {:tag :tbody
:content :content
["{% for record in %records% %}" ["{% for record in records %}"
{:tag :tr {:tag :tr
:content :content
(apply (apply
@ -438,7 +438,6 @@
:attrs :attrs
{:href {:href
(str (str
"{{servlet-context}}/"
(editor-name entity application) (editor-name entity application)
"?" "?"
(s/join (s/join
@ -480,7 +479,7 @@
(list-page-control true)]}) (list-page-control true)]})
(defn- list-to-template (defn list-to-template
"Generate a template as specified by this `list` element for this `entity`, "Generate a template as specified by this `list` element for this `entity`,
taken from this `application`. If `list` is nill, generate a default list taken from this `application`. If `list` is nill, generate a default list
template for the entity." template for the entity."
@ -502,9 +501,9 @@
`entity` in this `application`" `entity` in this `application`"
[entity application] [entity application]
(let (let
[forms (children entity #(= (:tag %) :form)) [forms (children-with-tag entity :form)
pages (children entity #(= (:tag %) :page)) pages (children-with-tag entity :page)
lists (children entity #(= (:tag %) :list))] lists (children-with-tag entity :list)]
(if (if
(and (and
(= (:tag entity) :entity) ;; it seems to be an ADL entity (= (:tag entity) :entity) ;; it seems to be an ADL entity

87
src/adl/utils.clj
View file

@ -39,6 +39,12 @@
"resources/auto/") "resources/auto/")
(defn element?
"True if `o` is a Clojure representation of an XML element."
[o]
(and (map? o) (:tag o) (:attrs o)))
(defn wrap-lines (defn wrap-lines
"Wrap lines in this `text` to this `width`; return a list of lines." "Wrap lines in this `text` to this `width`; return a list of lines."
;; Shamelessly adapted from https://www.rosettacode.org/wiki/Word_wrap#Clojure ;; Shamelessly adapted from https://www.rosettacode.org/wiki/Word_wrap#Clojure
@ -73,6 +79,11 @@
comment-rule))) comment-rule)))
(defn sort-by-name
[elements]
(sort #(compare (:name (:attrs %1)) (:name (:attrs %2))) elements))
(defn link-table-name (defn link-table-name
"Canonical name of a link table between entity `e1` and entity `e2`." "Canonical name of a link table between entity `e1` and entity `e2`."
[e1 e2] [e1 e2]
@ -249,24 +260,25 @@
(defn safe-name (defn safe-name
([string] "Return a safe name for the object `o`, given the specified `convention`.
(s/replace string #"[^a-zA-Z0-9-]" "")) `o` is expected to be either a string or an entity."
([string convention] ([o]
(case convention (if
(:sql :c) (s/replace string #"[^a-zA-Z0-9_]" "_") (element? o)
:c-sharp (s/replace (capitalise string) #"[^a-zA-Z0-9]" "") (safe-name (:name (:attrs o)))
:java (let (s/replace (str o) #"[^a-zA-Z0-9-]" "")))
[camel (s/replace (capitalise string) #"[^a-zA-Z0-9]" "")] ([o convention]
(apply str (cons (Character/toUpperCase (first camel)) (rest camel)))) (if
(safe-name string)))) (element? o)
(safe-name (:name (:attrs o)) convention)
(let [string (str o)]
(defn link-table? (case convention
"Return true if this `entity` represents a link table." (:sql :c) (s/replace string #"[^a-zA-Z0-9_]" "_")
[entity] :c-sharp (s/replace (capitalise string) #"[^a-zA-Z0-9]" "")
(let [properties (children entity #(= (:tag %) :property)) :java (let
links (filter #(-> % :attrs :entity) properties)] [camel (s/replace (capitalise string) #"[^a-zA-Z0-9]" "")]
(= (count properties) (count links)))) (apply str (cons (Character/toLowerCase (first camel)) (rest camel))))
(safe-name string))))))
(defn read-adl [url] (defn read-adl [url]
@ -351,6 +363,14 @@
`(filter insertable? (key-properties entity))) `(filter insertable? (key-properties entity)))
(defn link-table?
"Return true if this `entity` represents a link table."
[entity]
(let [properties (all-properties entity)
links (filter #(-> % :attrs :entity) properties)]
(= (count properties) (count links))))
(defn key-names [entity] (defn key-names [entity]
(remove (remove
nil? nil?
@ -359,6 +379,37 @@
(key-properties entity)))) (key-properties entity))))
(defn base-type
[property application]
(cond
(:typedef (:attrs property))
(:type
(:attrs
(child
application
#(and
(= (:tag %) :typedef)
(= (:name (:attrs %)) (:typedef (:attrs property)))))))
(:entity (:attrs property))
(:type
(:attrs
(first
(key-properties
(child
application
#(and
(= (:tag %) :entity)
(= (:name (:attrs %)) (:entity (:attrs property)))))))))
true
(:type (:attrs property))))
(defn is-quotable-type?
"True if the value for this field should be quoted."
[property application]
(#{"date" "image" "string" "text" "time" "timestamp" "uploadable"} (base-type property application)))
(defn has-primary-key? [entity] (defn has-primary-key? [entity]
(> (count (key-names entity)) 0)) (> (count (key-names entity)) 0))