From 1d5525ceaa4bfdb43f2aef24b6b99bd713e3262d Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 20 Jul 2018 00:00:47 +0100 Subject: [PATCH] Built the canonicalisation stage into the ADL processor Unit tests do not all pass. --- .gitignore | 2 + resources/transforms/adl2canonical.xslt | 2 +- src/adl/main.clj | 85 +++++++++++++++++-------- test/adl/to_hugsql_queries_test.clj | 2 +- test/adl/utils_test.clj | 10 --- 5 files changed, 63 insertions(+), 38 deletions(-) delete mode 100644 test/adl/utils_test.clj diff --git a/.gitignore b/.gitignore index d388cc3..0303f5a 100644 --- a/.gitignore +++ b/.gitignore @@ -23,3 +23,5 @@ generated/src/clj/youyesyet/routes/ node_modules/ + +generated/ diff --git a/resources/transforms/adl2canonical.xslt b/resources/transforms/adl2canonical.xslt index 30a6b58..4b56ff9 100755 --- a/resources/transforms/adl2canonical.xslt +++ b/resources/transforms/adl2canonical.xslt @@ -3,7 +3,7 @@ Application Description Language framework adl2canonical.xsl - (c) 2007 Cygnet Solutions Ltd + (c) 2007 Simon Brooke Transform ADL into a canonical form, expanding and making explicit things left implicit in the manually maintained form. Specifically, diff --git a/src/adl/main.clj b/src/adl/main.clj index 6423236..6e362aa 100644 --- a/src/adl/main.clj +++ b/src/adl/main.clj @@ -1,18 +1,19 @@ (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.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 +63,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)) + (println (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 +130,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/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")))))