diff --git a/project.clj b/project.clj index 118b206..9a33b0a 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject adl-support "0.1.5" +(defproject adl-support "0.1.6" :description "A small library of functions called by generated ADL code." :url "https://github.com/simon-brooke/adl-support" :license {:name "MIT License" diff --git a/src/adl_support/filters.clj b/src/adl_support/filters.clj index 7c31b55..262aefb 100644 --- a/src/adl_support/filters.clj +++ b/src/adl_support/filters.clj @@ -4,7 +4,8 @@ adl-support.filters (:require [clojure.string :as s] [selmer.filters :as f] - [selmer.parser :as p])) + [selmer.parser :as p] + [selmer.tags :as t])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -64,3 +65,24 @@ (f/add-filter! :email email) ;; (p/render "{{p|telephone}}" {:p "07768 130255"}) + +(defn contains + [collection value] + (first + (filter + #(= % value) + collection))) + +;; (contains '(:a :b :c) :a) + +(f/add-filter! :contains contains) + +;; (p/render "{{l|contains:\"foo\"}}" {:l ["froboz" "bar"]}) + +;; (p/render "{% if l|contains:\"foo\" %}I see ya!{% else %}I don't{% endif %}" {:l ["foo" "bar"]}) +;; (p/render "{% if l|contains:\"foo\" %}I see ya!{% else %}I don't{% endif %}" {:l ["froboz" "bar"]}) + +;; (p/render +;; "" +;; {:option {:id 2 :name "Fred"} :record {:roles [2 6]}}) + diff --git a/src/adl_support/forms_support.clj b/src/adl_support/forms_support.clj index 101f577..7ff50c6 100644 --- a/src/adl_support/forms_support.clj +++ b/src/adl_support/forms_support.clj @@ -3,11 +3,11 @@ :author "Simon Brooke"} adl-support.forms-support (:require [adl-support.core :refer :all] - [adl-support.utils :refer [descendants-with-tag safe-name singularise]] + [adl-support.utils :refer [capitalise descendants-with-tag safe-name singularise]] [clojure.core.memoize :as memo] [clojure.data.json :as json] [clojure.java.io :as io] - [clojure.string :refer [lower-case]])) + [clojure.string :refer [join lower-case]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -92,7 +92,7 @@ "The name to which data for this `auxlist` will be bound in the Selmer params." [auxlist] - `(safe-name (str "auxlist-" (-> ~auxlist :attrs :property)) :clojure)) + `(safe-name (-> ~auxlist :attrs :property) :clojure)) (defmacro all-keys-present? @@ -122,3 +122,21 @@ (map #(hash-map (keyword (-> % :attrs :name)) (-> % :attrs :default)) (descendants-with-tag entity :property #(-> % :attrs :default))))) + + +(defn form-title + "Construct an appropriate title for a form having this `form-name`, for an + entity having these `user-distinct-property-keys`, given this `record`." + [record form-name user-distinct-property-keys] + (str + form-name + ": " + (join + ", " + (remove + nil? + (map + record + user-distinct-property-keys))))) + + diff --git a/src/adl_support/rest_support.clj b/src/adl_support/rest_support.clj index 56c1ade..8f6cafa 100644 --- a/src/adl_support/rest_support.clj +++ b/src/adl_support/rest_support.clj @@ -46,10 +46,10 @@ ;; TODO: candidate for moving to adl-support.core [form request] `(if-valid-user - ~form - ~request - {:status 403 - :body (json/write-str "You must be logged in to do that")})) + ~form + ~request + {:status 403 + :body (json/write-str "You must be logged in to do that")})) (defmacro with-params-or-error @@ -64,9 +64,6 @@ :body (json/write-str (str "The following params are required: " ~required))})) -;; (with-params-or-error (/ 1 0) {:a 1 :b 2} #{:a :b :c}) -;; (with-params-or-error "hello" {:a 1 :b 2} #{:a :b }) - (defmacro do-or-server-fail "Evaluate this `form`; if it succeeds, return an HTTP response with this status code and the JSON-formatted result as body; if it fails, return an @@ -78,6 +75,5 @@ {:status ~status :body (:result r#)} {:status 500 - :body r#}))) - + :body r#}))) diff --git a/src/adl_support/tags.clj b/src/adl_support/tags.clj index c808500..d592937 100644 --- a/src/adl_support/tags.clj +++ b/src/adl_support/tags.clj @@ -2,7 +2,9 @@ in generated templates." :author "Simon Brooke"} adl-support.tags - (:require [selmer.parser :as p])) + (:require [clojure.string :refer [split]] + [selmer.parser :as p] + [selmer.tags :as t])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -32,6 +34,22 @@ success failure)) + +(defn parse-arg + [arg context] + (cond + (number? arg) + arg + (number? (read-string arg)) + (read-string arg) + (= \" (first arg)) + (.substring arg 1 (dec (.length arg))) + (and (= \: (first arg)) (> (count arg) 1)) + (keyword (subs arg 1)) + :else + (get-in context (map keyword (split arg #"\."))))) + + (defn add-tags [] "Add custom tags required by ADL-generated code to the parser's tags." (p/add-tag! :ifmemberof @@ -43,6 +61,24 @@ :else (fn [args context content] "") - :endifmemberof)) + :endifmemberof) + (p/add-tag! :ifcontains + (fn [[c v] context content] + (let [value (parse-arg v context) + collection (parse-arg c context)] + (if + (some + #(= % value) + collection) + (get-in content [:ifcontains :content]) + (get-in content [:else :content])))) + :else + (fn [args context content] + "") + :endifcontains)) + (add-tags) + + + diff --git a/src/adl_support/utils.clj b/src/adl_support/utils.clj index b22cbf1..e840e1a 100644 --- a/src/adl_support/utils.clj +++ b/src/adl_support/utils.clj @@ -322,22 +322,6 @@ (= (max n1 n2) 1))) -(defn link-related-query-name - "link is tricky. If there's exactly than one link between the two - entities, we need to generate the same name from both - ends of the link" - [property nearside farside] - (if (unique-link? nearside farside) - (let [ordered (sort-by #(-> % :attrs :name) (list nearside farside))] - (str "list-" - (safe-name (first ordered) :sql) - "-by-" - (safe-name (nth ordered 1) :sql))) - (str "list-" - (safe-name property :sql) "-by-" - (singularise (safe-name nearside :sql))))) - - (defn link-table-name "Canonical name of a link table between entity `e1` and entity `e2`. However, there may be different links between the same two tables with different semantics; if @@ -358,33 +342,6 @@ "_" (cons "ln" (map #(:name (:attrs %)) (list property e1))))))) -(defn list-related-query-name - "Return the canonical name of the HugSQL query to return all records on - `farside` which match a given record on `nearside`, where `nearide` and - `farside` are both entities." - [property nearside farside] - (if - (and - (property? property) - (entity? nearside) - (entity? farside)) - (case (-> property :attrs :type) - "link" (link-related-query-name property nearside farside) - "list" (str "list-" - (safe-name farside :sql) "-by-" - (singularise (safe-name nearside :sql))) - "entity" (str "list-" - (safe-name nearside :sql) "-by-" - (singularise (safe-name farside :sql))) - ;; default - (str "ERROR-bad-property-type-" - (-> ~property :attrs :type) "-of-" - (-> ~property :attrs :name))) - (do - (*warn* "Argument passed to `list-related-query-name` was a non-entity") - nil))) - - (defn property-for-field "Return the property within this `entity` which matches this `field`." [field entity] @@ -618,6 +575,45 @@ #(#{"system" "all"} (:distinct (:attrs %))) (properties entity))) + +(defn list-related-query-name + "Return the canonical name of the HugSQL query to return all records on + `farside` which match a given record on `nearside`, where `nearide` and + `farside` are both entities." + ([property nearside farside as-symbol?] + (let [unique? (= + (count + (filter + #(= (-> % :attrs :entity)(-> property :attrs :entity)) + (descendants-with-tag nearside :property))) + 1) + farname (if unique? (safe-name farside :sql) (safe-name property :sql)) + nearname (singularise (safe-name nearside :sql)) + n (case (-> property :attrs :type) + ;; TODO: I am deeply susicious of this. It's just improbable that + ;; the same recipe should work for all three cases. + ("link" "list") (str "list-" farname "-by-" nearname) + "entity" (str "list-" farname "-by-" nearname) + ;; default + (str "ERROR-bad-property-type-" + (-> ~property :attrs :type) "-of-" + (-> ~property :attrs :name)))] + (if + (and + (property? property) + (entity? nearside) + (entity? farside)) + (if + as-symbol? + (symbol (str "db/" n)) + n) + (do + (*warn* "Argument passed to `list-related-query-name` was a non-entity") + nil)))) + ([property nearside farside] + (list-related-query-name property nearside farside false))) + + (defn path-part "Return the URL path part for this `form` of this `entity` within this `application`. Note that `form` may be a Clojure XML representation of a `form`, `list` or `page` @@ -658,3 +654,28 @@ 0 (expt 10 v))) (catch Exception _ 0))) + + +(defn order-preserving-set + "The Clojure `set` function does not preserve the order in which elements are + passed to it. This function is like `set`, except + 1. It returns a list, not a hashset, and + 2. It is order-preserving." + [collection] + (loop [lhs (list (first collection)) + rhs (rest collection)] + (cond + (empty? rhs) (reverse lhs) + (some #(= (first rhs) %) lhs) (recur lhs (rest rhs)) + true (recur (cons (first rhs) lhs) (rest rhs))))) + + +(defmacro entity-by-name + "Return the entity with this `entity-name` in this `application`. + TODO: Candidate for move to adl-support.utils." + [entity-name application] + `(child-with-tag + ~application + :entity + #(= (:name (:attrs %)) ~entity-name))) + diff --git a/test/adl_support/tags_test.clj b/test/adl_support/tags_test.clj index 578deed..356d2a3 100644 --- a/test/adl_support/tags_test.clj +++ b/test/adl_support/tags_test.clj @@ -6,7 +6,7 @@ (add-tags) (deftest if-member-of-tests - (testing "testing the if-member-of tag" + (testing "the `ifmemberof` tag" (let [expected "boo" actual (if-member-of-permitted nil nil "caramba" "boo")] (is (= expected actual) "Nil args, nil ")) @@ -48,3 +48,75 @@ +(deftest if-contains-tests + (testing "the `ifcontains` tag" + (let [expected "Hello!" + actual (parser/render "{% ifcontains record.roles option.id %}Hello!{% else %}Goodbye!{% endifcontains %}" + {:option {:id 2 :name "Fred"} :record {:roles [2 6]}})] + (is (= expected actual) + "Both args are paths which exist in the context; + the value of the first contains the value of the second; + values are numbers")) + (let [expected "Goodbye!" + actual (parser/render "{% ifcontains record.roles option.id %}Hello!{% else %}Goodbye!{% endifcontains %}" + {:option {:id 3 :name "Ginny"} :record {:roles [2 6]}})] + (is (= expected actual) + "Both args are paths which exist in the context; + the value of the first does not contain the value of the second; + values are numbers")) + (let [expected "Hello!" + actual (parser/render "{% ifcontains record.roles option.id %}Hello!{% else %}Goodbye!{% endifcontains %}" + {:option {:id :two :name "Fred"} :record {:roles [:two :six]}})] + (is (= expected actual) + "Both args are paths which exist in the context; + the value of the first contains the value of the second; + values are keywords")) + (let [expected "Goodbye!" + actual (parser/render "{% ifcontains record.roles option.id %}Hello!{% else %}Goodbye!{% endifcontains %}" + {:option {:id :three :name "Ginny"} :record {:roles [:two :six]}})] + (is (= expected actual) + "Both args are paths which exist in the context; + the value of the first does not contain the value of the second; + values are keywords")) + (let [expected "Hello!" + actual (parser/render "{% ifcontains record.roles option.id %}Hello!{% else %}Goodbye!{% endifcontains %}" + {:option {:id "two" :name "Fred"} :record {:roles ["two" "six"]}})] + (is (= expected actual) + "Both args are paths which exist in the context; + the value of the first contains the value of the second; + values are strings")) + (let [expected "Goodbye!" + actual (parser/render "{% ifcontains record.roles option.id %}Hello!{% else %}Goodbye!{% endifcontains %}" + {:option {:id "three" :name "Ginny"} :record {:roles ["two" "six"]}})] + (is (= expected actual) + "Both args are paths which exist in the context; + the value of the first does not contain the value of the second; + values are strings")) + (let [expected "Hello!" + actual (parser/render "{% ifcontains record.roles 2 %}Hello!{% else %}Goodbye!{% endifcontains %}" + {:option {:id 4 :name "Henry"} :record {:roles [2 6]}})] + (is (= expected actual) + "First arg is a path which exists in the context, second is a literal number; + the value of the first contains the value of the second; + values are numbers")) + (let [expected "Goodbye!" + actual (parser/render "{% ifcontains record.roles 3 %}Hello!{% else %}Goodbye!{% endifcontains %}" + {:option {:id 3 :name "Ginny"} :record {:roles [2 6]}})] + (is (= expected actual) + "First arg is a path which exists in the context, second is a literal number; + the value of the first does not contain the value of the second; + values are numbers")) + (let [expected "Hello!" + actual (parser/render "{% ifcontains record.roles :two %}Hello!{% else %}Goodbye!{% endifcontains %}" + {:option {:id 4 :name "Henry"} :record {:roles [:two :six]}})] + (is (= expected actual) + "First arg is a path which exists in the context, second is a literal keyword; + the value of the first contains the value of the second; + values are numbers")) + (let [expected "Goodbye!" + actual (parser/render "{% ifcontains record.roles :three %}Hello!{% else %}Goodbye!{% endifcontains %}" + {:option {:id 3 :name "Ginny"} :record {:roles [:two :six]}})] + (is (= expected actual) + "First arg is a path which exists in the context, second is a literal keyword; + the value of the first does not contain the value of the second; + values are numbers")))) diff --git a/test/adl_support/utils_test.clj b/test/adl_support/utils_test.clj index 4499eb7..5132672 100644 --- a/test/adl_support/utils_test.clj +++ b/test/adl_support/utils_test.clj @@ -598,3 +598,9 @@ (is (= (key-names e2) #{"id" "shard"})) (is (= (key-names e2 true) #{:id :shard}))))) + +(deftest order-preserving-set-tests + (testing "order-preserving-set" + (is (= '(:a) (order-preserving-set '(:a :a :a :a)))) + (is (= '(:a) (order-preserving-set [:a :a :a :a]))) + (is (= '(:a :b :c :d :e) (order-preserving-set '(:a :a :b :c :a :b :d :c :e))))))