@@ -729,7 +729,7 @@
-
+
diff --git a/src/adl/main.clj b/src/adl/main.clj
index 6423236..c5ceba3 100644
--- a/src/adl/main.clj
+++ b/src/adl/main.clj
@@ -1,18 +1,20 @@
(ns ^{:doc "Application Description Language - command line invocation."
:author "Simon Brooke"}
adl.main
- (:require [adl-support.utils :refer :all]
- [adl-support.print-usage :refer [print-usage]]
- [adl.to-hugsql-queries :as h]
+ (:require [adl.to-hugsql-queries :as h]
[adl.to-json-routes :as j]
[adl.to-psql :as p]
[adl.to-selmer-routes :as s]
[adl.to-selmer-templates :as t]
- [clojure.java.io :refer [make-parents]]
- [clojure.string :refer [join]]
+ [adl-support.core :refer [*warn*]]
+ [adl-support.print-usage :refer [print-usage]]
+ [adl-support.utils :refer :all]
+ [clojure.java.io :refer [as-file file make-parents resource]]
+ [clojure.string :refer [includes? join split]]
[clojure.tools.cli :refer [parse-opts]]
[clojure.xml :as x]
- [environ.core :refer [env]])
+ [environ.core :refer [env]]
+ [saxon :as sax])
(:gen-class))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -62,8 +64,58 @@
{"adl-file" "An XML file conforming to the ADL DTD"}))
+(def adl->canonical
+ "A function which takes ADL text as its single argument and returns
+ canonicalised ADL text as its result."
+ (sax/compile-xslt (resource "transforms/adl2canonical.xslt")))
+
+
+(defn canonicalise
+ "Canonicalise the ADL document indicated by this `filepath` (if it is not
+ already canonical) and return a path to the canonical version."
+ [filepath]
+ (if
+ ;; if it says it's canonical, we'll just believe it.
+ (includes? filepath ".canonical.")
+ filepath
+ (let
+ [parts (split (.getName (as-file filepath)) #"\.")
+ outpath (file
+ *output-path*
+ (join
+ "."
+ (cons (first parts) (cons "canonical" (rest parts)))))]
+ (spit outpath (adl->canonical (sax/compile-xml (slurp filepath))))
+ (.getAbsolutePath outpath))))
+
+
+(defn process
+ "Process these parsed `options`."
+ [options]
+ (do
+ (let [p (:path (:options options))
+ op (if (.endsWith p "/") p (str p "/"))]
+ (binding [*output-path* op
+ *locale* (-> options :options :locale)
+ *verbosity* (-> options :options :verbosity)]
+ (make-parents *output-path*)
+ (doall
+ (map
+ #(if
+ (.exists (java.io.File. %))
+ (let [application (x/parse (canonicalise %))]
+ (h/to-hugsql-queries application)
+ (j/to-json-routes application)
+ (p/to-psql application)
+ (s/to-selmer-routes application)
+ (t/to-selmer-templates application))
+ (*warn* (str "ERROR: File not found: " %)))
+ (-> options :arguments)))))))
+
+
(defn -main
- "Expects as arg the path-name of an ADL file."
+ "Parses options and arguments. Expects as args the path-name of one or
+ more ADL files."
[& args]
(let [options (parse-opts args cli-options)]
(cond
@@ -79,25 +131,7 @@
(-> options :options :help)
(usage options)
true
- (do
- (let [p (:path (:options options))
- op (if (.endsWith p "/") p (str p "/"))]
- (binding [*output-path* op
- *locale* (-> options :options :locale)
- *verbosity* (-> options :options :verbosity)]
- (make-parents *output-path*)
- (doall
- (map
- #(if
- (.exists (java.io.File. %))
- (let [application (x/parse %)]
- (h/to-hugsql-queries application)
- (j/to-json-routes application)
- (p/to-psql application)
- (s/to-selmer-routes application)
- (t/to-selmer-templates application))
- (println (str "ERROR: File not found: " %)))
- (-> options :arguments)))))))))
+ (process options))))
diff --git a/src/adl/to_hugsql_queries.clj b/src/adl/to_hugsql_queries.clj
index fe9e6d8..d2e5104 100644
--- a/src/adl/to_hugsql_queries.clj
+++ b/src/adl/to_hugsql_queries.clj
@@ -1,13 +1,14 @@
(ns ^{:doc "Application Description Language - generate HUGSQL queries file."
:author "Simon Brooke"}
adl.to-hugsql-queries
- (:require [clojure.java.io :refer [file make-parents]]
+ (:require [adl-support.core :refer [*warn*]]
+ [adl-support.utils :refer :all]
+ [clojure.java.io :refer [file make-parents]]
[clojure.math.combinatorics :refer [combinations]]
[clojure.string :as s]
[clojure.xml :as x]
[clj-time.core :as t]
- [clj-time.format :as f]
- [adl-support.utils :refer :all]))
+ [clj-time.format :as f]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@@ -398,10 +399,10 @@
(vals
(queries application)))))))
(if (> *verbosity* 0)
- (println (str "\tGenerated " filepath)))
+ (*warn* (str "\tGenerated " filepath)))
(catch
Exception any
- (println
+ (*warn*
(str
"ERROR: Exception "
(.getName (.getClass any))
diff --git a/src/adl/to_json_routes.clj b/src/adl/to_json_routes.clj
index 0c3dee8..e3b904d 100644
--- a/src/adl/to_json_routes.clj
+++ b/src/adl/to_json_routes.clj
@@ -1,7 +1,8 @@
(ns ^{:doc "Application Description Language: generate RING routes for REST requests."
:author "Simon Brooke"}
adl.to-json-routes
- (:require [adl-support.utils :refer :all]
+ (:require [adl-support.core :refer [*warn*]]
+ [adl-support.utils :refer :all]
[adl.to-hugsql-queries :refer [queries]]
[clj-time.core :as t]
[clj-time.format :as f]
@@ -274,10 +275,10 @@
(sort (keys handlers-map))))
(pprint (defroutes handlers-map))))
(if (> *verbosity* 0)
- (println (str "\tGenerated " filepath)))
+ (*warn* (str "\tGenerated " filepath)))
(catch
Exception any
- (println
+ (*warn*
(str
"ERROR: Exception "
(.getName (.getClass any))
diff --git a/src/adl/to_psql.clj b/src/adl/to_psql.clj
index 2734198..c4a5c08 100644
--- a/src/adl/to_psql.clj
+++ b/src/adl/to_psql.clj
@@ -1,14 +1,14 @@
(ns ^{:doc "Application Description Language: generate Postgres database definition."
:author "Simon Brooke"}
adl.to-psql
- (:require [clojure.java.io :refer [file make-parents writer]]
- [clojure.pprint :refer [pprint]]
+ (:require [adl-support.core :refer [*warn*]]
+ [adl-support.utils :refer :all]
+ [adl.to-hugsql-queries :refer [queries]]
+ [clojure.java.io :refer [file make-parents writer]]
[clojure.string :as s]
[clojure.xml :as x]
[clj-time.core :as t]
- [clj-time.format :as f]
- [adl-support.utils :refer :all]
- [adl.to-hugsql-queries :refer [queries]]))
+ [clj-time.format :as f]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@@ -571,10 +571,10 @@
(try
(spit filepath (emit-application application))
(if (> *verbosity* 0)
- (println (str "\tGenerated " filepath)))
+ (*warn* (str "\tGenerated " filepath)))
(catch
Exception any
- (println
+ (*warn*
(str
"ERROR: Exception "
(.getName (.getClass any))
diff --git a/src/adl/to_selmer_routes.clj b/src/adl/to_selmer_routes.clj
index 6f7b5e7..d1e5e86 100644
--- a/src/adl/to_selmer_routes.clj
+++ b/src/adl/to_selmer_routes.clj
@@ -1,7 +1,8 @@
(ns ^{:doc "Application Description Language: generate routes for user interface requests."
:author "Simon Brooke"}
adl.to-selmer-routes
- (:require [adl-support.utils :refer :all]
+ (:require [adl-support.core :refer [*warn*]]
+ [adl-support.utils :refer :all]
[clj-time.core :as t]
[clj-time.format :as f]
[clojure.java.io :refer [file make-parents writer]]
@@ -395,10 +396,10 @@
(pprint (make-defroutes application))
(println)))
(if (> *verbosity* 0)
- (println (str "\tGenerated " filepath)))
+ (*warn* (str "\tGenerated " filepath)))
(catch
Exception any
- (println
+ (*warn*
(str
"ERROR: Exception "
(.getName (.getClass any))
diff --git a/src/adl/to_selmer_templates.clj b/src/adl/to_selmer_templates.clj
index 548ddf5..c4475f3 100644
--- a/src/adl/to_selmer_templates.clj
+++ b/src/adl/to_selmer_templates.clj
@@ -1,9 +1,10 @@
(ns ^{:doc "Application Description Language - generate Selmer templates for the HTML pages implied by an ADL file."
:author "Simon Brooke"}
adl.to-selmer-templates
- (:require [adl.to-hugsql-queries :refer [expanded-token]]
+ (:require [adl-support.core :refer [*warn*]]
+ [adl.to-hugsql-queries :refer [expanded-token]]
[adl-support.utils :refer :all]
- [clojure.java.io :refer [file make-parents]]
+ [clojure.java.io :refer [file make-parents resource]]
[clojure.pprint :as p]
[clojure.string :as s]
[clojure.xml :as x]
@@ -423,11 +424,11 @@
(defn embed-script-fragment
- "Return the content of the file at `filepath`, with these `substitutions`
+ "Return the content of the file at `resource-path`, with these `substitutions`
made into it in order. Substitutions should be pairss [`pattern` `value`],
where `pattern` is a string, a char, or a regular expression."
- ([filepath substitutions]
- (let [v (slurp filepath)]
+ ([resource-path substitutions]
+ (let [v (slurp (resource resource-path))]
(reduce
(fn [s [pattern value]]
(if (and pattern value)
@@ -435,8 +436,8 @@
s))
v
substitutions)))
- ([filepath]
- (embed-script-fragment filepath [])))
+ ([resource-path]
+ (embed-script-fragment resource-path [])))
(defn edit-link
@@ -622,7 +623,7 @@
(if
(> magnitude 2)
(embed-script-fragment
- "resources/js/selectize-one.js"
+ "js/selectize-one.js"
[["{{widget_id}}" (-> property :attrs :name)]
["{{widget_value}}" (str "{{record." (-> property :attrs :name) "}}")]
["{{entity}}" farname]
@@ -635,7 +636,7 @@
(child-with-tag
form :field
#(= "text-area" (widget-type (property-for-field % entity) application)))
- (embed-script-fragment "resources/js/text-area-md-support.js"
+ (embed-script-fragment "js/text-area-md-support.js"
[["{{page}}" (-> form :attrs :name)]]))))))}})
@@ -899,6 +900,7 @@
template
(try
(do
+ (make-parents filepath)
(spit
filepath
(s/join
@@ -915,7 +917,7 @@
"{% endblock %}"))
(keys template)))
(file-footer filename application)))))
- (if (> *verbosity* 0) (println "\tGenerated " filepath)))
+ (if (> *verbosity* 0) (*warn* "\tGenerated " filepath)))
(catch Exception any
(let [report (str
"ERROR: Exception "
@@ -927,10 +929,10 @@
(spit
filepath
(with-out-str
- (println (str ""))
+ (*warn* (str ""))
(p/pprint template)))
(catch Exception _ nil))
- (println report)
+ (*warn* report)
(throw any)))))
(str filepath)))
@@ -963,10 +965,11 @@
(try
(write-template-file filename (templates-map %) application)
(catch Exception any
- (println
+ (*warn*
(str
"ERROR: Exception "
(.getName (.getClass any))
+ " "
(.getMessage any)
" while writing "
filename))))))
diff --git a/src/adl/validator.clj b/src/adl/validator.clj
index 8602f90..17f6945 100644
--- a/src/adl/validator.clj
+++ b/src/adl/validator.clj
@@ -69,17 +69,6 @@
(remove :tag (remove nil? (map first (map
#(try-validate ~o '%)
~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?
-;; (try
-;; (doall (map #(println (str "ERROR: " %)) suspicious))
-;; (empty? suspicious)
-;; (catch Exception _ (println "ERROR while trying to print errors")
-;; true))))
-
;;; the remainder of this file is a fairly straight translation of the ADL 1.4 DTD into Clojure
diff --git a/test/adl/to_hugsql_queries_test.clj b/test/adl/to_hugsql_queries_test.clj
index 8b4c449..ab4c257 100644
--- a/test/adl/to_hugsql_queries_test.clj
+++ b/test/adl/to_hugsql_queries_test.clj
@@ -2,7 +2,7 @@
(:require [clojure.string :as s]
[clojure.test :refer :all]
[adl.to-hugsql-queries :refer :all]
- [adl.utils :refer :all]))
+ [adl-support.utils :refer :all]))
(defn string-equal-ignore-whitespace?
"I don't want unit tests to fail just because emitted whitespace changes."
diff --git a/test/adl/utils_test.clj b/test/adl/utils_test.clj
deleted file mode 100644
index cd9c083..0000000
--- a/test/adl/utils_test.clj
+++ /dev/null
@@ -1,10 +0,0 @@
-(ns adl.utils-test
- (:require [clojure.string :as s]
- [clojure.test :refer :all]
- [adl.utils :refer :all]))
-
-(deftest singularise-tests
- (testing "Singularise"
- (is (= "address" (singularise "addresses")))
- (is (= "address" (singularise "address")))
- (is (= "expertise" (singularise "expertise")))))
|