diff --git a/src/adl/to_psql.clj b/src/adl/to_psql.clj index f12eda1..64d6826 100644 --- a/src/adl/to_psql.clj +++ b/src/adl/to_psql.clj @@ -1,13 +1,20 @@ (ns ^{:doc "Application Description Language: generate Postgres database definition." :author "Simon Brooke"} adl.to-psql - (:require [adl-support.core :refer :all] - [adl-support.utils :refer :all] - ;; [adl.to-hugsql-queries :refer [queries]] - [clojure.java.io :refer [make-parents]] - [clojure.string :as s] - [clj-time.core :as t] - [clj-time.format :as f])) + (:require + [adl-support.core :refer [*warn* do-or-warn]] + [adl-support.utils :refer [*output-path* *verbosity* all-properties child + child-with-tag children-with-tag emit-header + entity-for-property entity? find-permissions + is-quotable-type? key-names key-properties + link-table-name properties property-for-field + safe-name singularise sort-by-name + system-generated? typedef unique-link? + user-distinct-properties]] ;; [adl.to-hugsql-queries :refer [queries]] + [clj-time.core :as t] + [clj-time.format :as f] + [clojure.java.io :refer [make-parents]] + [clojure.string :as s])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -161,7 +168,7 @@ #(if (selector (:permission (:attrs %))) (safe-name (:group (:attrs %)) :sql)) permissions)))] - (if-not + (when-not (empty? group-names) (s/join " " @@ -195,10 +202,10 @@ ([property entity application key?] (let [default (:default (:attrs property)) type (-> property :attrs :type)] - (if + (when (and (= (:tag property) :property) - (not (#{"link" "list"} (:type (:attrs property))))) + (not (#{"link" "list"} type))) (s/join " " (remove @@ -208,14 +215,14 @@ "\t" (field-name property) (emit-field-type property entity application key?) - (if + (when 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. + ;; it's quite common for `now()` to be the default for a date, time or timestamp field. default))) (if key? @@ -237,7 +244,7 @@ (if (= (:type (:attrs p)) "entity") (compose-convenience-entity-field p farside application (field-name property)) - (str (or table-alias (safe-name (:table (:attrs farside)))) "." (field-name p)))) + (str (or table-alias (safe-name farside :sql)) "." (field-name p)))) (user-distinct-properties farside)))))) @@ -250,13 +257,13 @@ nil? (flatten (cons - (safe-name (:table (:attrs entity)) :sql) + (safe-name entity :sql) (map (fn [f] - (if + (when (= (:type (:attrs f)) "entity") (let [farside (child application #(and (entity? %) (= (:name (:attrs %))(:entity (:attrs f))))) - tablename (safe-name (-> farside :attrs :table) :sql) + tablename (safe-name farside :sql) fieldname (field-name f)] (if (= tablename fieldname) tablename @@ -279,19 +286,19 @@ (flatten (map (fn [f] - (if + (when (= (:type (:attrs f)) "entity") (let [farside (entity-for-property f application)] (cons (str - (safe-name (:table (:attrs entity)) :sql) + (safe-name entity :sql) "." (field-name f) " = " - (safe-name (:table (:attrs farside)) :sql) + (safe-name farside :sql) "." (safe-name (first (key-names farside)) :sql)) - #(compose-convenience-where-clause farside application false))))) + (compose-convenience-where-clause farside application false))))) (if top-level? (all-properties entity) @@ -302,7 +309,7 @@ ([property entity application] (emit-convenience-entity-field property entity application (field-name property))) ([property entity application table-alias] - (if + (when (= "entity" (-> property :attrs :type)) (str (s/join @@ -317,11 +324,11 @@ "Emit a convenience view of this `entity` of this `application` for use in generating lists, menus, et cetera." [entity application] - (let [view-name (safe-name (str "lv_" (:table (:attrs entity))) :sql) + (let [table-name (safe-name entity :sql) + view-name (safe-name (str "lv_" table-name) :sql) entity-properties (filter #(= (:type (:attrs %)) "entity") - (properties entity)) - tn (safe-name (-> entity :attrs :table) :sql)] + (properties entity))] (s/join "\n" (remove @@ -346,14 +353,14 @@ (= (:type (:attrs %)) "entity") (list (emit-convenience-entity-field % entity application (field-name %)) - (str tn "." (field-name %))) - (str tn "." (field-name %))) + (str table-name "." (field-name %))) + (str table-name "." (field-name %))) (remove #(#{"link" "list"} (:type (:attrs %))) (all-properties entity) )))))) (str "FROM " (s/join ", " (set (compose-convenience-view-from-list entity application true)))) - (if-not + (when-not (empty? entity-properties) (str "WHERE " @@ -364,11 +371,11 @@ (let [farside (entity-for-property f application)] (str - (safe-name (:table (:attrs entity)) :sql) + (safe-name entity :sql) "." (field-name f) " = " - (safe-name (:table (:attrs farside)) :sql) + (safe-name farside :sql) "." (safe-name (first (key-names farside)) :sql)))) entity-properties)))) @@ -393,8 +400,8 @@ (field-name property) ") \n\tREFERENCES" (str - (safe-name (:table (:attrs farside)) :sql) - "(" (field-name (first (key-properties farside))) ")") + (safe-name farside :sql) + "( " (field-name (first (key-properties farside))) " )") ;; TODO: ought to handle the `cascade` attribute, even though it's rarely used "\n\tON DELETE" (case @@ -430,7 +437,7 @@ "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) + (let [table-name (safe-name entity :sql) permissions (children-with-tag entity :permission)] (s/join "\n" @@ -472,7 +479,7 @@ application (str "primary table " - (:table (:attrs entity)) + (safe-name entity :sql) " for entity " (:name (:attrs entity)))))) @@ -503,7 +510,7 @@ (= (:name (:attrs %)) (:entity (:attrs property))))) unique? (unique-link? e1 e2) link-table-name (link-table-name property e1 e2)] - (if + (when ;; we haven't already emitted this one... (not (@emitted-link-tables link-table-name)) (let [permissions (flatten @@ -521,7 +528,7 @@ [(construct-link-property e1) (construct-link-property e2)] permissions)))}] - (if-not unique? + (when-not unique? (*warn* (str "WARNING: Manually check link tables between " (-> e1 :attrs :name) @@ -562,8 +569,8 @@ (defn emit-group-declaration - "Emit a declaration for this authorisation `group` within this `application`." - [group application] + "Emit a declaration for this authorisation `group`." + [group] (list (emit-header "--" @@ -600,7 +607,7 @@ (list (emit-file-header application) (map - #(emit-group-declaration % application) + #(emit-group-declaration %) (sort-by-name (children-with-tag application :group))) (map @@ -626,7 +633,7 @@ (make-parents filepath) (do-or-warn (spit filepath (emit-application application)) - (if + (when (pos? *verbosity*) (*warn* (str "\tGenerated " filepath)))))) diff --git a/test/adl/to_psql_test.clj b/test/adl/to_psql_test.clj index 1f41c81..dd705df 100644 --- a/test/adl/to_psql_test.clj +++ b/test/adl/to_psql_test.clj @@ -1,8 +1,9 @@ (ns adl.to-psql-test - (:require [clojure.string :as s] - [clojure.test :refer :all] - [adl.to-psql :refer :all] - [adl-support.utils :refer :all])) + (:require + [adl-support.utils :refer [child child-with-tag]] + [adl.to-psql :refer [emit-convenience-entity-field emit-convenience-view + emit-property emit-table]] + [clojure.test :refer [deftest is testing]])) ;; (deftest link-property-test ;; (testing "No field generated for link property" @@ -12,9 +13,9 @@ (let [application {:tag :application, :attrs {:version "0.1.1", :name "youyesyet", - :xmlns:adl "http://bowyer.journeyman.cc/adl/1.4.1/", + :xmlns:adl "http://www.journeyman.cc/adl/1.4.7/", :xmlns:html "http://www.w3.org/1999/xhtml", - :xmlns "http://bowyer.journeyman.cc/adl/1.4.1/"} + :xmlns "http://www.journeyman.cc/adl/1.4.7/"} :content [{:tag :typedef, :attrs @@ -443,9 +444,9 @@ {:tag :application, :attrs {:version "0.0.1", :name "pastoralist", - :xmlns:adl "http://bowyer.journeyman.cc/adl/1.4.1/", + :xmlns:adl "http://www.journeyman.cc/adl/1.4.7/", :xmlns:html "http://www.w3.org/1999/xhtml", - :xmlns "http://bowyer.journeyman.cc/adl/1.4.1/"}, + :xmlns "http://www.journeyman.cc/adl/1.4.7/"}, :content [{:tag :documentation, :attrs nil, :content ["A web-app intended to be used by pastoralists in managing @@ -502,9 +503,9 @@ {:tag :application, :attrs {:version "0.0.1", :name "pastoralist", - :xmlns:adl "http://bowyer.journeyman.cc/adl/1.4.1/", + :xmlns:adl "http://www.journeyman.cc/adl/1.4.7/", :xmlns:html "http://www.w3.org/1999/xhtml", - :xmlns "http://bowyer.journeyman.cc/adl/1.4.1/"}, + :xmlns "http://www.journeyman.cc/adl/1.4.7/"}, :content [{:tag :documentation, :attrs nil, :content ["A web-app intended to be used by pastoralists in managing