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

Merge tag 'adl-support-0.1.6'

Browse source
This commit is contained in:
Simon Brooke 2019-05-02 15:43:58 +01:00
parent 3f5927847f aa62040555
commit aa835405cd
8 changed files with 231 additions and 60 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
project.clj
View file

@ -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"

24
src/adl_support/filters.clj
View file

@ -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 value='{{option.id}}' {% if record.roles|contains:option.id %}selected='selected'{% endif %}>{{option.name}}</option>"
;; {:option {:id 2 :name "Fred"} :record {:roles [2 6]}})

24
src/adl_support/forms_support.clj
View file

@ -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)))))

14
src/adl_support/rest_support.clj
View file

@ -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#})))

40
src/adl_support/tags.clj
View file

@ -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)

107
src/adl_support/utils.clj
View file

@ -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)))

74
test/adl_support/tags_test.clj
View file

@ -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"))))

6
test/adl_support/utils_test.clj
View file

@ -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))))))