Very close to good on templates.

src/adl/to_selmer_templates.clj

@@ -125,32 +125,45 @@
   (let
     [type (:type (:attrs property))
      farname (:entity (:attrs property))
-     farside (application farname)
+     farside (first
+               (children
+                 application
+                 #(and
+                    (= (:tag %) :entity)
+                    (= (:name (:attrs %)) farname))))
+     fs-distinct (flatten
+                   (list
+                     (children farside #(#{"user" "all"} (:distinct (:attrs %))))
+                     (children
+                       (first
+                         (children farside #(= (:tag %) :key)))
+                       #(#{"user" "all"} (:distinct (:attrs %))))))
      farkey (or
               (:farkey (:attrs property))
               (:name (:attrs (first (children (children farside #(= (:tag %) :key))))))
               "id")]
-    (str "{% for record in " farname " %}<option value='record." farkey "'>"
+    [(str "{% for record in " farname " %}<option value='{{record." farkey "}}'>"
-         (s/join
+         (s/join " " (map #(str "{{record." (:name (:attrs %)) "}}") fs-distinct))
-           " "
+         "</option>{% endfor %}")]))
-           (map
-             #(str "{{record." (:name (:attrs %)) "}}")
-             (children farside #(some #{"user" "all"} (:distinct %))))))
-    "</option>%{ endfor %}"))
 
 
-(defn typedef
+(defn widget-type
-  "If this `property` is of type `defined`, return its type definition from
+  "Return an appropriate HTML5 input type for this property."
-  this `application`, else nil."
+  ([property application]
-  [property application]
+   (widget-type property application (typedef property application)))
-  (if
+  ([property application typedef]
-    (= (:type (:attrs property)) "defined")
+   (let [t (if
-    (first
+             typedef
-      (children
+             (:type (:attrs typedef))
-        application
+             (:type (:attrs property)))]
-        #(and
+     (case t
-           (= (:tag %) :typedef)
+       ("integer" "real" "money") "number"
-           (= (:name (:attrs %)) (:typedef (:attrs property))))))))
+       ("uploadable" "image") "file"
+       "boolean" "checkbox"
+       "date" "date"
+       "time" "time"
+       "text" ;; default
+       ))))
 
 
 (defn widget
@@ -158,7 +171,7 @@
   taken from within this `application`."
   [field-or-property form entity application]
   (let
-    [name (:name (:attrs field-or-property))
+    [widget-name (:name (:attrs field-or-property))
      property (if
                 (= (:tag field-or-property) :property)
                 field-or-property
@@ -168,36 +181,52 @@
                     #(and
                        (= (:tag %) :property)
                        (= (:name (:attrs %)) (:property (:attrs field-or-property)))))))
-     permissions (permissions property entity application)
+     permissions (permissions property form entity application)
-     typedef
+     typedef (typedef property application)
-     show? true ;;(visible? property permissions)
+     visible-to (visible-to permissions)
-     select? (some #{"entity" "list" "link"} (:type (:attrs property)))]
+     ;; if the form isn't actually a form, no widget is writable.
-    ;; TODO: deal with disabling/hiding if no permission
+     writable-by (if (= (:tag form) :form) (writable-by permissions))
-    (println "Property:")
+     select? (#{"entity" "list" "link"} (:type (:attrs property)))]
-    (p/pprint property)
     (if
-      show?
+      (formal-primary-key? property entity)
+      {:tag :input
+       :attrs {:id widget-name
+               :name widget-name
+               :type "hidden"
+               :value (str "{{record." widget-name "}}")}}
       {:tag :p
        :attrs {:class "widget"}
        :content [{:tag :label
-                  :attrs {:for name}
+                  :attrs {:for widget-name}
                   :content [(prompt field-or-property form entity application)]}
+                 "TODO: selmer command to hide for all groups except for those for which it is writable"
                  (if
                    select?
                    {:tag :select
-                    :attrs {:id name
+                    :attrs {:id widget-name
-                            :name name}
+                            :name widget-name}
                     :content (get-options property form entity application)}
                    {:tag :input
-                    :attrs {:id name
+                    :attrs (merge
-                            :name name
+                             {:id widget-name
-                            :type "text" ;; TODO - or other things
+                              :name widget-name
-                            :value (str "{{record." name "}}")}})]}
+                              :type (widget-type property application typedef)
-      {:tag :input
+                              :value (str "{{record." widget-name "}}")}
-       :attrs {:id name
+                             (if
-               :name name
+                               (:minimum (:attrs typedef))
-               :type :hidden
+                               {:min (:minimum (:attrs typedef))})
-               :value (str "{{record." name "}}")}})))
+                             (if
+                               (:maximum (:attrs typedef))
+                               {:max (:maximum (:attrs typedef))}))})
+                 "{% else %}"
+                 "TODO: selmer if command to hide for all groups except to those for which it is readable"
+                 {:tag :span
+                  :attrs {:id widget-name
+                          :name widget-name
+                          :class "pseudo-widget disabled"}
+                  :content [(str "{{record." widget-name "}}")]}
+                 "{% endif %}"
+                 "{% endif %}"]})))
 
 
 (defn form-to-template
@@ -214,7 +243,7 @@
               (and form (= "listed" (:properties (:attrs form))))
               ;; if we've got a form, collect its fields, fieldgroups and verbs
               (flatten
-                (map #(if (some #{:field :fieldgroup :verb} (:tag %)) %)
+                (map #(if (#{:field :fieldgroup :verb} (:tag %)) %)
                      (children form)))
               (children entity #(= (:tag %) :property)))]
     {:tag :div

src/adl/utils.clj

@@ -58,35 +58,82 @@
          (:attrs element)))))
 
 
+(defn typedef
+  "If this `property` is of type `defined`, return its type definition from
+  this `application`, else nil."
+  [property application]
+  (if
+    (= (:type (:attrs property)) "defined")
+    (first
+      (children
+        application
+        #(and
+           (= (:tag %) :typedef)
+           (= (:name (:attrs %)) (:typedef (:attrs property))))))))
+
+
 (defn permissions
   "Return appropriate permissions of this `property`, taken from this `entity` of this
-  `application`."
+  `application`, in the context of this `page`."
-  [property entity application]
+  [property page entity application]
-  (or
+  (first
-    (children property #(= (:tag %) :permission))
+    (remove
-    (children entity :permission)))
+      empty?
+      (list
+        (children page #(= (:tag %) :permission))
+        (children property #(= (:tag %) :permission))
+        (children entity #(= (:tag %) :permission))
+        (children application #(= (:tag %) :permission))))))
 
 
-(defn visible?
+(defn permission-groups
-  "Return `true` if this property is not `system`-distinct, and is readable
+  "Return a list of names of groups to which this `predicate` is true of
-  to the `public` group; else return a list of groups to which it is readable,
+  some permission taken from these `permissions`, else nil."
-  given these `permissions`."
+  [permissions predicate]
-  [property permissions]
+  (let [groups (remove
-  (let [attributes (attributes property)]
+                 nil?
-    (if
+                 (map
-      (not
+                   #(if
-        (and
+                      (apply predicate (list %))
-          ;; if it's immutable and system distinct, the user should not need to see it.
+                      (:group (:attrs %)))
-          (= (:immutable attributes) "true")
+                   permissions))]
-          (= (:distinct attributes) "system")))
+    (if groups groups)))
-      (map
-        #(if
-           (some #{"read" "insert" "noedit" "edit" "all"} (:permission (:attrs %)))
-           (:group (:attrs %)))
-        permissions))))
 
 
-(defn singularise [string]
+(defn formal-primary-key?
+  "Does this `prop-or-name` appear to be a property (or the name of a property)
+  which is a formal primary key of this entity?"
+  [prop-or-name entity]
+  (if
+    (map? prop-or-name)
+    (formal-primary-key? (:name (:attrs prop-or-name)) entity)
+    (let [primary-key (first (children entity #(= (:tag %) :key)))
+          property (first
+                     (children
+                       primary-key
+                       #(and
+                          (= (:tag %) :property)
+                          (= (:name (:attrs %)) prop-or-name))))]
+      (= (:distinct (:attrs property)) "system"))))
+
+
+(defn visible-to
+  "Return a list of names of groups to which are granted read access,
+  given these `permissions`, else nil."
+  [permissions]
+  (permission-groups permissions #(#{"read" "insert" "noedit" "edit" "all"} (:permission (:attrs %)))))
+
+
+(defn writable-by
+  "Return a list of names of groups to which are granted read access,
+  given these `permissions`, else nil."
+  [permissions]
+  (permission-groups permissions #(#{"edit" "all"} (:permission (:attrs %)))))
+
+
+(defn singularise
+  "Attempt to construct an idiomatic English-language singular of this string."
+  [string]
   (s/replace (s/replace (s/replace string #"_" "-") #"s$" "") #"ie$" "y"))