Skip to content

Instantly share code, notes, and snippets.

@pbzdyl
Forked from micha/form.cljs.hl
Created May 8, 2017 06:21
Show Gist options
  • Save pbzdyl/df09d50bf129ebdb34059bcd30aca72d to your computer and use it in GitHub Desktop.
Save pbzdyl/df09d50bf129ebdb34059bcd30aca72d to your computer and use it in GitHub Desktop.
(ns ui.form
(:refer-hoplon :exclude [select input textarea label form])
(:require [ui.form.input :as input]
[ui.button :as button]
[ui.modal :as modal]
[ui.grid :as grid]
[ui.filters :as filters]
[ui.link :as link]
[ui.util :as util]
[ui.icon :as icon]
[ui.typeahead :as typeahead]
[ui.drilldown :as drilldown]
[workflow.form :as workflow]
[ui.paging :as p]
[ui.form.tokenfield-impl :as tokenfield]
[ui.form.datepicker-impl :as datepicker]
[ui.screen :as screen :include-macros true])
(:require-macros [ui.form :refer [definput with-form]]))
(def ^:dynamic *form-machine* nil)
(def ^:dynamic *form-state* nil)
(def ^:dynamic *form-loading* nil)
(def ^:dynamic *form-errors* nil)
(def ^:dynamic *form-inputs* nil)
(def ^:dynamic *form-exception* nil)
(def ^:dynamic *input-error* nil)
(def ^:dynamic *input-data* nil)
(def ^:dynamic *input-name* nil)
(defn upsert-machine
[& {:keys [action schema current success page callback]}]
(let [page (or page screen/*page*)
upsert screen/*upsert*
action (or action #(upsert % (p/page-opts page)))
schema (or schema screen/*schema*)
current (or current screen/*current*)
success (or success #(reset! current nil))]
(workflow/form-machine
:action action
:schema schema
:current current
:success success
:callback callback)))
(defelem label
[{:keys [for] :as attr} kids]
(let [for (or for *input-name*)
attr (assoc attr :for for)]
(hoplon.core/label attr kids)))
(definput select
[attr kids]
(div :class "select"
(input/select :class "form-control" attr kids)))
(definput text-input
[attr _]
(input/input :type "text" :class "form-control" attr))
(definput number-input
[attr _]
(input/input :type "number" :class "form-control" attr))
(definput textarea
[attr _]
(input/textarea :class "form-control" attr))
(definput password-input
[attr _]
(input/input :type "password" :class "form-control" attr))
(definput date-input
[attr _]
((datepicker/datepicker attr) :class "form-control"))
(definput datetime-input
[attr _]
((datepicker/datetimepicker attr) :class "form-control"))
(definput hidden-input
[attr _]
(input/input :type "hidden" attr))
(definput file-input
[{:keys [state] :as attr} _]
(hoplon.core/input :type "file"
:autocomplete false
:change #(try (reset! state (aget % "target" "files" 0))
(catch js/Error _))
attr))
(definput typeahead-and-manager
[{:keys [state] :as attr} _]
(let [opts (merge {:display-fn :__title__ :value-key :id} attr)
manager (typeahead/typeahead-manager opts)]
[(typeahead/input* opts manager) manager]))
(definput typeahead
[{:keys [state] :as attr} _]
(first (typeahead-and-manager attr)))
(definput drilldown
[attr _]
(drilldown/input attr))
(definput tokenfield
[attr _]
(tokenfield/tokenfield attr))
(definput binary-checkbox
[{:keys [pos state] :as attr} kids]
(div :class "checkbox"
:style "vertical-align: bottom;"
(hoplon.core/label (dissoc attr :state)
:style "margin-left: .2em; padding: 0 .3em; background: #f6f6f6"
(span :class "switch"
(hoplon.core/input
:type "checkbox"
:prop (cell= {:checked (not= 0 (bit-and state (.pow js/Math 2 pos)))})
:click (fn [_] (swap! state #(bit-flip % pos))))
(i))
kids)))
(definput inline-checkbox
[{:keys [label] :as attr} _]
(hoplon.core/label
(span :class "switch"
(input/checkbox attr)
(i))
label))
(definput checkbox
[attr _]
(div :class "checkbox"
(inline-checkbox attr)))
(defelem checkbox-block
[{:keys [state disabled] :as attr} kids]
(let [state (or state *input-data*)]
(div :class "checkbox"
(hoplon.core/label (dissoc attr :state)
(span :class "switch"
(input/checkbox :state state :disabled disabled)
(i))
kids))))
(defelem radio-block
[{:keys [state value disabled] :as attr} kids]
(let [state (or state *input-data*)]
(div :class "checkbox"
(hoplon.core/label (dissoc attr :state :value)
(span :class "switch"
(input/radio :state state :value value :disabled disabled)
(i))
kids))))
(defelem options
[attr kids]
((div :class "options options-large") attr kids))
(defelem checkset-block
[{:keys [state value] :as attr} kids]
(let [state (or state *input-data*)]
(div :class "checkbox"
(hoplon.core/label (dissoc attr :state :value)
(span :class "switch"
(input/checkset :state state :value value)
(i))
kids))))
(defelem panel
[{:keys [heading] :as attr} kids]
((div :class "panel panel-default") (dissoc attr :heading)
(div :class "panel-heading"
(h5 heading))
(div :class "panel-body" kids)))
(defelem form-table-panel
[{:keys [heading] :as attr} & [kids]]
(let [body [(butlast kids)]
table [(last kids)]]
((div :class "panel panel-default") (dissoc attr :heading)
(div :class "panel-heading"
(h5 heading))
(div :class "collapse-in"
(div :class "panel-body" body)
table))))
(defelem validation-item
[{:keys [error state] :as attr} kids]
(let [attr (dissoc attr :error :state)
state (or state *form-state*)
error (or error *input-error*)]
((grid/item :class (cell= {:has-error (and error (not= "" error))
:has-success (or (= "" error) (= :no-error state))}))
attr kids)))
(defelem validation-field
[{:keys [error state] :as attr} kids]
(let [attr (dissoc attr :error :state)
state (or state *form-state*)
error (or error *input-error*)]
(grid/grid
attr
(grid/row
(grid/item
:class (cell= {:has-error (and error (not= "" error))
:has-success (or (= "" error) (= :no-error state))})
kids)))))
(defelem validation-message
[{:keys [state] :as attr} _]
(let [state (or state *input-error*)]
((p :class "text-danger"
:toggle state
:text state)
(dissoc attr :state))))
(defelem validation-alert
[{:keys [state] :as attr} _]
(let [state (or state *form-exception*)]
((div :class "alert alert-danger" :toggle state)
(dissoc attr :state) (span :text state))))
(defelem submit-primary
[{:keys [state text active-text] :or {text "Save" active-text "Working..."} :as attr} kids]
(let [state (or state *form-loading*)
attr (dissoc attr :state :text :active-text)]
[(button/primary
(merge {:type "submit" :toggle (cell= (= 0 state))} attr)
(or (seq kids) text))
(button/primary
attr
(merge {:disabled true :toggle (cell= (not= 0 state))} attr)
(or (seq kids) active-text))]))
(defelem cancel-link
[{:keys [click] :as attr} kids]
(let [current screen/*current*
click (or click #(reset! current nil))]
((button/link :click click (or (seq kids) "Cancel")) (dissoc attr :click))))
(defelem edit-icon
[{:keys [click item current] :as attr} _]
(let [current (or current screen/*current*)
click (or click #(reset! current @item))]
((link/button-link :click click (icon/edit))
(dissoc attr :click :item :current))))
(defelem delete-icon
[{:keys [click item deleting] :as attr} _]
(let [deleting (or deleting screen/*deleting*)
click (or click #(reset! deleting @item))]
((link/button-link :click click (icon/remove))
(dissoc attr :click :item :deleting))))
(defelem alert
[attr kids]
((div :class "alert") attr kids))
(defelem alert-warning
[attr kids]
((alert :class "alert-warning") attr kids))
(defelem help-block
[attr kids]
((p :class "help-block") attr kids))
(defn close-when-unchanged
[form-machine current-item]
#(if-not @(:dirty? form-machine)
(reset! current-item nil)))
(defn computed-title
[& {:keys [zone entity-type current-entity current deleting type]}]
(let [form-machine *form-machine*
zone (or zone screen/*zone*)
current (or current screen/*current*)
deleting (or deleting screen/*deleting*)
current-title (cell= (:__title__ current))
deleting-title (cell= (:__title__ deleting))
entity-type (or entity-type screen/*entity-type*)
current-entity (or current-entity screen/*current-entity*)
entity-title (cell= (or (:__title__ current-entity) "..."))
zone-name (cell= (util/singularize zone))
new? (cell= (zero? ~(:__row__ (:data form-machine))))
type (or type (cell= (if new? :insert :update)))]
(cell= (util/title-case
(case type
:insert (if-not entity-type
(str "new " zone-name)
(str "add a " zone-name " to " entity-type " " entity-title))
:update (str "edit " zone-name " " current-title)
:delete (if-not entity-type
(str zone-name " " deleting-title)
(str zone-name " " deleting-title " from " entity-type " " entity-title))
:zone-title (if-not entity-type
(str "all " zone)
(str zone " for " entity-type " " entity-title))
:edit-region (str zone " " entity-type)
:edit-title entity-title
:new-button (if-not entity-type
(str "new " zone-name)
(str "add a " zone-name " to this " entity-type))
:delete-button (if-not entity-type "Delete" "Remove"))))))
(defelem modal-form
[{:keys [current-item
form-machine
open
overlay-click
title
name
insert-title
update-title
pages] :as attr}
kids]
(let [form-machine *form-machine*
current-item (or current-item screen/*current*)
open (or open current-item (cell nil))
form-machine (or form-machine *form-machine*)
id (get-in form-machine [:data :id])
overlay-click (or overlay-click (close-when-unchanged form-machine current-item))
title (or title (computed-title))
pages (or pages [])
attr (dissoc attr :current-item :form-machine :open :overlay-click :title :name)]
;; TODO check this still works
(util/on-change open (fn [x] (if x (doseq [page pages]
(when (not (:active @(:params page)))
(p/activate! page))))))
(modal/modal-form
(merge {:open open :title title :overlay-click overlay-click} attr) kids)))
(defelem form
[{:keys [submit] :as attr} kids]
(let [form-machine *form-machine*
submit (or submit #(do (.preventDefault %)
(workflow/submit form-machine)))]
((hoplon.core/form
:novalidate true
:submit submit)
(dissoc attr :submit) kids)))
(defelem upsert-form
[attr kids]
(form attr
kids
(validation-alert)
(submit-primary)
(cancel-link)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment