diff --git a/src/adl/to_selmer_templates.clj b/src/adl/to_selmer_templates.clj
index ad3e9c0..266589e 100644
--- a/src/adl/to_selmer_templates.clj
+++ b/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 " %}%{ endfor %}"))
+ [(str "{% for record in " farname " %}{% endfor %}")]))
-(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 widget-type
+ "Return an appropriate HTML5 input type for this property."
+ ([property application]
+ (widget-type property application (typedef property application)))
+ ([property application typedef]
+ (let [t (if
+ typedef
+ (:type (:attrs typedef))
+ (:type (:attrs property)))]
+ (case t
+ ("integer" "real" "money") "number"
+ ("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)
- typedef
- show? true ;;(visible? property permissions)
- select? (some #{"entity" "list" "link"} (:type (:attrs property)))]
- ;; TODO: deal with disabling/hiding if no permission
- (println "Property:")
- (p/pprint property)
+ permissions (permissions property form entity application)
+ typedef (typedef property application)
+ visible-to (visible-to permissions)
+ ;; if the form isn't actually a form, no widget is writable.
+ writable-by (if (= (:tag form) :form) (writable-by permissions))
+ select? (#{"entity" "list" "link"} (:type (:attrs 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
- :name name}
+ :attrs {:id widget-name
+ :name widget-name}
:content (get-options property form entity application)}
{:tag :input
- :attrs {:id name
- :name name
- :type "text" ;; TODO - or other things
- :value (str "{{record." name "}}")}})]}
- {:tag :input
- :attrs {:id name
- :name name
- :type :hidden
- :value (str "{{record." name "}}")}})))
+ :attrs (merge
+ {:id widget-name
+ :name widget-name
+ :type (widget-type property application typedef)
+ :value (str "{{record." widget-name "}}")}
+ (if
+ (:minimum (:attrs typedef))
+ {:min (:minimum (:attrs typedef))})
+ (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
diff --git a/src/adl/utils.clj b/src/adl/utils.clj
index 198e345..ca30560 100644
--- a/src/adl/utils.clj
+++ b/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`."
- [property entity application]
- (or
- (children property #(= (:tag %) :permission))
- (children entity :permission)))
+ `application`, in the context of this `page`."
+ [property page entity application]
+ (first
+ (remove
+ empty?
+ (list
+ (children page #(= (:tag %) :permission))
+ (children property #(= (:tag %) :permission))
+ (children entity #(= (:tag %) :permission))
+ (children application #(= (:tag %) :permission))))))
-(defn visible?
- "Return `true` if this property is not `system`-distinct, and is readable
- to the `public` group; else return a list of groups to which it is readable,
- given these `permissions`."
- [property permissions]
- (let [attributes (attributes property)]
- (if
- (not
- (and
- ;; if it's immutable and system distinct, the user should not need to see it.
- (= (:immutable attributes) "true")
- (= (:distinct attributes) "system")))
- (map
- #(if
- (some #{"read" "insert" "noedit" "edit" "all"} (:permission (:attrs %)))
- (:group (:attrs %)))
- permissions))))
+(defn permission-groups
+ "Return a list of names of groups to which this `predicate` is true of
+ some permission taken from these `permissions`, else nil."
+ [permissions predicate]
+ (let [groups (remove
+ nil?
+ (map
+ #(if
+ (apply predicate (list %))
+ (:group (:attrs %)))
+ permissions))]
+ (if groups groups)))
-(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"))