Merge tag 'adl-support-0.1.6'

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"

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

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

src/adl_support/rest_support.clj

@@ -46,10 +46,10 @@
   ;; TODO: candidate for moving to adl-support.core
   [form request]
   `(if-valid-user
-    ~form
+     ~form
-    ~request
+     ~request
-    {:status 403
+     {:status 403
-     :body (json/write-str "You must be logged in to do that")}))
+      :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#})))
-
 

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

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

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

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