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