zilti
/
fulcro-rad-carbon
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

In the beginning there was darkness

This commit is contained in:
Daniel Ziltener 2020-06-01 06:01:59 +02:00
commit c614cdbff3
26 changed files with 2182 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
.gitignore vendored Normal file
View File

@ -0,0 +1,26 @@
*~
*.iml
*.log
*.sw?
*.swp
*jar
.DS_Store
.cljs_rhino_repl
.idea
.nrepl*
.nrepl-port
.repl
checkouts
classes
compiled
datahub.log*
node_modules
out
resources/public/js
target
.cpcache
.shadow-cljs
.clj-kondo/.cache
DevelopersGuide.html
docs/assets
docs/.asciidoctor

15
LICENSE Normal file
View File

@ -0,0 +1,15 @@
The MIT License (MIT)
Copyright (c) 2017-2019, Fulcrologic, LLC
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated
documentation files (the "Software"), to deal in the Software without restriction, including without limitation the
rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit
persons to whom the Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all copies or substantial portions of the
Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

37
README.adoc Normal file
View File

@ -0,0 +1,37 @@
= Fulcro RAD Carbon Rendering Plugin
WARNING: This library is alpha.
== Usage
image:https://img.shields.io/clojars/v/ch.lyrion/fulcro-rad-carbon.svg[link=https://clojars.org/ch.lyrion/fulcro-rad-carbon]
To use this library simply install the controls on your RAD application:
[source]
-----
(ns com.example.main
(:require
[com.fulcrologic.rad.application :as rad-app]))
(defonce app (-> (rad-app/fulcro-rad-app)
(rad-app/install-ui-controls! sui/all-controls)))
-----
== LICENSE
The MIT License (MIT)
Copyright (c), Fulcrologic, LLC
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated
documentation files (the "Software"), to deal in the Software without restriction, including without limitation the
rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit
persons to whom the Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all copies or substantial portions of the
Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

9
deps.edn Normal file
View File

@ -0,0 +1,9 @@
{:paths ["src/main"]
:deps {com.fulcrologic/fulcro-rad {:mvn/version "0.0.9-alpha"}
com.fulcrologic/fulcro-i18n {:mvn/version "0.0.3-alpha"}
ch.lyrion/carbon-wrapper {:mvn/version "1.0.3-SNAPSHOT"}
com.fulcrologic/semantic-ui-wrapper {:mvn/version "1.0.1"}
org.clojure/clojure {:mvn/version "1.10.1" :scope "provided"}
org.clojure/clojurescript {:mvn/version "1.10.764" :scope "provided"}}}

92
pom.xml Normal file
View File

@ -0,0 +1,92 @@
<?xml version="1.0" encoding="UTF-8"?>
<project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
<modelVersion>4.0.0</modelVersion>
<groupId>com.fulcrologic</groupId>
<artifactId>fulcro-rad-semantic-ui</artifactId>
<packaging>jar</packaging>
<version>0.0.10-alpha-SNAPSHOT</version>
<properties>
<project.build.sourceEncoding>UTF-8</project.build.sourceEncoding>
<maven.compiler.source>1.8</maven.compiler.source>
<maven.compiler.target>1.8</maven.compiler.target>
</properties>
<name>Fulcro RAD Semantic UI</name>
<description>A UI plugin for Fulcro RAD that renders to web/electron using Semantic UI CSS</description>
<url>https://github.com/fulcrologic/fulcro-rad-semantic-ui</url>
<licenses>
<license>
<name>MIT</name>
<url>https://opensource.org/licenses/MIT</url>
</license>
</licenses>
<scm>
<url>https://github.com/fulcrologic/fulcro-rad-semantic-ui</url>
<connection>scm:git:git://github.com/fulcrologic/fulcro-rad-semantic-ui.git</connection>
<developerConnection>scm:git:ssh://git@github.com/fulcrologic/fulcro-rad-semantic-ui.git</developerConnection>
<tag>HEAD</tag>
</scm>
<distributionManagement>
<repository>
<id>clojars</id>
<name>Clojars repository</name>
<url>https://clojars.org/repo</url>
</repository>
</distributionManagement>
<build>
<sourceDirectory>src/main</sourceDirectory>
<resources>
<resource>
<directory>src/main</directory>
</resource>
</resources>
<plugins>
<plugin>
<groupId>org.apache.maven.plugins</groupId>
<artifactId>maven-gpg-plugin</artifactId>
<version>1.6</version>
<executions>
<execution>
<id>sign-artifacts</id>
<phase>verify</phase>
<goals>
<goal>sign</goal>
</goals>
</execution>
</executions>
</plugin>
</plugins>
</build>
<repositories>
<repository>
<id>clojars</id>
<url>https://repo.clojars.org/</url>
</repository>
</repositories>
<dependencies>
<dependency>
<groupId>org.clojure</groupId>
<artifactId>clojure</artifactId>
<version>1.10.1</version>
</dependency>
<dependency>
<groupId>com.fulcrologic</groupId>
<artifactId>fulcro-rad</artifactId>
<version>0.0.9-alpha</version>
</dependency>
<dependency>
<groupId>com.fulcrologic</groupId>
<artifactId>fulcro-i18n</artifactId>
<version>0.0.3-alpha</version>
</dependency>
<dependency>
<groupId>org.clojure</groupId>
<artifactId>clojurescript</artifactId>
<version>1.10.764</version>
</dependency>
<dependency>
<groupId>com.fulcrologic</groupId>
<artifactId>semantic-ui-wrapper</artifactId>
<version>1.0.1</version>
</dependency>
</dependencies>
</project>

154
src/main/com/fulcrologic/rad/rendering/semantic_ui/autocomplete.cljc Normal file
View File

@ -0,0 +1,154 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.autocomplete
(:require
#?@(:cljs
[[com.fulcrologic.fulcro.dom :as dom :refer [div label input]]
[goog.object :as gobj]
[cljs.reader :refer [read-string]]
[com.fulcrologic.semantic-ui.modules.dropdown.ui-dropdown :refer [ui-dropdown]]]
:clj
[[com.fulcrologic.fulcro.dom-server :as dom :refer [div label input]]])
[com.fulcrologic.rad.ids :as ids]
[com.fulcrologic.rad.ui-validation :as validation]
[com.fulcrologic.fulcro.rendering.multiple-roots-renderer :as mroot]
[com.fulcrologic.fulcro.components :as comp :refer [defsc]]
[com.fulcrologic.fulcro.data-fetch :as df]
[com.fulcrologic.fulcro.mutations :as m :refer [defmutation]]
[com.fulcrologic.fulcro.algorithms.merge :as merge]
[com.fulcrologic.rad.options-util :as opts]
[com.fulcrologic.rad.rendering.semantic-ui.components :refer [ui-wrapped-dropdown]]
[com.fulcrologic.rad.attributes :as attr]
[clojure.string :as str]
[taoensso.timbre :as log]
[com.fulcrologic.rad.form :as form]
[com.fulcrologic.fulcro.algorithms.normalized-state :as fns]))
(defsc AutocompleteQuery [_ _] {:query [:text :value]})
(defn to-js [v]
#?(:clj v
:cljs (clj->js v)))
(defmutation normalize-options [{:keys [source target]}]
(action [{:keys [state]}]
#?(:clj true
:cljs
(let [options (get @state source)
normalized-options (apply array
(map (fn [{:keys [text value]}]
#js {:text text :value (pr-str value)}) options))]
(fns/swap!-> state
(dissoc source)
(assoc-in target normalized-options))))))
(defsc AutocompleteField [this {:ui/keys [search-string options] :as props} {:keys [value label onChange
invalid? validation-message
read-only?]}]
{:initLocalState (fn [this]
;; TASK: props not making it...fix that, or debounce isn't configurable.
(let [{:autocomplete/keys [debounce-ms]} (comp/props this)]
{:load! (opts/debounce
(fn [s]
(let [{id ::autocomplete-id
:autocomplete/keys [search-key]} (comp/props this)]
(df/load! this search-key AutocompleteQuery
{:params {:search-string s}
:post-mutation `normalize-options
:post-mutation-params {:source search-key
:target [::autocomplete-id id :ui/options]}})))
(or debounce-ms 200))}))
:componentDidMount (fn [this]
(let [{id ::autocomplete-id
:autocomplete/keys [search-key]} (comp/props this)
value (comp/get-computed this :value)]
(when (and search-key value)
(df/load! this search-key AutocompleteQuery
{:params {:only value}
:post-mutation `normalize-options
:post-mutation-params {:source search-key
:target [::autocomplete-id id :ui/options]}}))))
:query [::autocomplete-id :ui/search-string :ui/options :autocomplete/search-key
:autocomplete/debounce-ms :autocomplete/minimum-input]
:ident ::autocomplete-id}
(let [load! (comp/get-state this :load!)]
#?(:clj
(dom/div "")
:cljs
(dom/div :.field {:classes [(when invalid? "error")]}
(dom/label label (when invalid? (str " " validation-message)))
(if read-only?
(gobj/getValueByKeys options 0 "text")
(ui-dropdown #js {:search true
:options (if options options #js [])
:value (pr-str value)
:selection true
:closeOnBlur true
:openOnFocus true
:selectOnBlur true
:selectOnNavigation true
:onSearchChange (fn [_ v]
(let [query (comp/isoget v "searchQuery")]
(load! query)))
:onChange (fn [_ v]
(when onChange
(onChange (some-> (comp/isoget v "value")
read-string))))}))))))
(def ui-autocomplete-field (comp/computed-factory AutocompleteField {:keyfn ::autocomplete-id}))
(defmutation gc-autocomplete [{:keys [id]}]
(action [{:keys [state]}]
(when id
(swap! state fns/remove-entity [::autocomplete-id id]))))
(defsc AutocompleteFieldRoot [this props {:keys [env attribute]}]
{:initLocalState (fn [this] {:field-id (ids/new-uuid)})
:componentDidMount (fn [this]
(let [id (comp/get-state this :field-id)
{:keys [attribute]} (comp/get-computed this)
{:autocomplete/keys [search-key debounce-ms minimum-input]} (::form/field-options attribute)]
(merge/merge-component! this AutocompleteField {::autocomplete-id id
:autocomplete/search-key search-key
:autocomplete/debounce-ms debounce-ms
:autocomplete/minimum-input minimum-input
:ui/search-string ""
:ui/options #js []}))
(mroot/register-root! this {:initialize? true}))
:shouldComponentUpdate (fn [_ _] true)
:initial-state {::autocomplete-id {}}
:componentWillUnmount (fn [this]
(comp/transact! this [(gc-autocomplete {:id (comp/get-state this :field-id)})])
(mroot/deregister-root! this))
:query [::autocomplete-id]}
(let [{:autocomplete/keys [debounce-ms search-key]} (::form/field-options attribute)
k (::attr/qualified-key attribute)
{::form/keys [form-instance]} env
value (-> (comp/props form-instance) (get k))
id (comp/get-state this :field-id)
label (form/field-label env attribute)
read-only? (form/read-only? form-instance attribute)
invalid? (validation/invalid-attribute-value? env attribute)
validation-message (when invalid? (validation/validation-error-message env attribute))
field (get-in props [::autocomplete-id id])]
;; Have to pass the id and debounce early since the merge in mount won't happen until after, which is too late for initial
;; state
(ui-autocomplete-field (assoc field
::autocomplete-id id
:autocomplete/search-key search-key
:autocomplete/debounce-ms debounce-ms)
{:value value
:invalid? invalid?
:validation-message validation-message
:label label
:read-only? read-only?
:onChange (fn [normalized-value]
#?(:cljs
(when normalized-value (form/input-changed! env k normalized-value))))})))
(def ui-autocomplete-field-root (mroot/floating-root-factory AutocompleteFieldRoot
{:keyfn (fn [props] (-> props :attribute ::attr/qualified-key))}))
(defn render-autocomplete-field [env {::attr/keys [cardinality] :or {cardinality :one} :as attribute}]
(if (= :many cardinality)
(log/error "Cannot autocomplete to-many attributes with renderer" `render-autocomplete-field)
(ui-autocomplete-field-root {:env env :attribute attribute})))

121
src/main/com/fulcrologic/rad/rendering/semantic_ui/blob_field.cljc Normal file
View File

@ -0,0 +1,121 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.blob-field
(:require
[com.fulcrologic.fulcro.components :as comp :refer [defsc]]
#?@(:cljs [[com.fulcrologic.fulcro.dom :as dom :refer [div input]]
[goog.object :as gobj]
[com.fulcrologic.fulcro.networking.file-upload :as file-upload]]
:clj [[com.fulcrologic.fulcro.dom-server :as dom :refer [div input]]])
[com.fulcrologic.rad.form :as form]
[com.fulcrologic.rad.attributes :as attr]
[taoensso.timbre :as log]
[com.fulcrologic.rad.ui-validation :as validation]
[com.fulcrologic.rad.blob :as blob]
[com.fulcrologic.rad.options-util :refer [?! narrow-keyword]]
[com.fulcrologic.rad.rendering.semantic-ui.components :refer [ui-wrapped-dropdown]]
[com.fulcrologic.rad.rendering.semantic-ui.field :refer [render-field-factory]]
[com.fulcrologic.fulcro.algorithms.form-state :as fs]))
(defn evt->js-files [evt]
#?(:cljs
(let [js-file-list (.. evt -target -files)]
(map (fn [file-idx]
(let [js-file (.item js-file-list file-idx)
name (.-name js-file)]
js-file))
(range (.-length js-file-list))))))
#_(defsc ImageUploadField [this
{::form/keys [form-instance] :as env}
{::blob/keys [accept-file-types]
::attr/keys [qualified-key] :as attribute}]
{:initLocalState (fn [this]
#?(:cljs
{:save-ref (fn [r] (gobj/set this "fileinput" r))
:on-click (fn [evt] (when-let [i (gobj/get this "fileinput")]
(.click i)))
:on-change (fn [evt]
(let [env (comp/props this)
attribute (comp/get-computed this)
file (-> evt evt->js-files first)]
(blob/upload-file! env attribute file)))}))}
(let [props (comp/props form-instance)
url-key (narrow-keyword qualified-key "url")
current-sha (get props qualified-key)
url (get props url-key)
has-current-value? (seq current-sha)
{:keys [save-ref on-change on-click]} (comp/get-state this)
upload-complete? false
label (form/field-label env attribute)
valid? (and upload-complete? has-current-value?)]
(div :.field {:key (str qualified-key)}
(dom/label label)
(div :.ui.tiny.image
(dom/img {:src url :width "100"
:onClick on-click})
(dom/input (cond-> {:id (str qualified-key)
:ref save-ref
:style {:position "absolute"
:opacity 0
:top 0
:right 0}
:onChange on-change
:type "file"}
accept-file-types (assoc :allow (?! accept-file-types))))))))
#_(def ui-image-upload-field (comp/computed-factory ImageUploadField
{:keyfn (fn [props] (some-> props comp/get-computed ::attr/qualified-key))}))
#_(defn render-image-upload [env attribute]
(ui-image-upload-field env attribute))
(defsc FileUploadField [this
{::form/keys [form-instance master-form] :as env}
{::blob/keys [accept-file-types can-change?]
::attr/keys [qualified-key] :as attribute}]
{:componentDidMount (fn [this]
(comment "TRIGGER UPLOAD IF CONFIG SAYS TO?"))
:initLocalState (fn [this]
#?(:cljs
{:save-ref (fn [r] (gobj/set this "fileinput" r))
:on-click (fn [evt] (when-let [i (gobj/get this "fileinput")]
(.click i)))
:on-change (fn [evt]
(let [env (comp/props this)
attribute (comp/get-computed this)
file (-> evt evt->js-files first)]
(blob/upload-file! this attribute file {:file-ident []})))}))}
(let [props (comp/props form-instance)
read-only? (or
(form/read-only? master-form attribute)
(form/read-only? form-instance attribute))
can-change? (if read-only? false (?! can-change? env attribute))
url-key (blob/url-key qualified-key)
name-key (blob/filename-key qualified-key)
current-sha (get props qualified-key)
url (get props url-key)
filename (get props name-key)
pct (blob/upload-percentage props qualified-key)
has-current-value? (seq current-sha)
{:keys [save-ref on-change on-click]} (comp/get-state this)
dirty? (if read-only? false (fs/dirty? props qualified-key))
label (form/field-label env attribute)
invalid? (if read-only? false (validation/invalid-attribute-value? env attribute))
validation-message (when invalid? (validation/validation-error-message env attribute))]
(div :.field {:key (str qualified-key)}
(dom/label label)
(cond
(blob/blob-downloadable? props qualified-key)
(dom/a {:href (str url "?filename=" filename)} "Download")
(blob/uploading? props qualified-key)
(dom/div :.ui.small.blue.progress
(div :.bar {:style {:transitionDuration "300ms"
:display "block"
:width pct}}
(div :.progress pct)))))))
(def ui-file-upload-field (comp/computed-factory FileUploadField
{:keyfn (fn [props] (some-> props comp/get-computed ::attr/qualified-key))}))
(defn render-file-upload [env attribute]
(ui-file-upload-field env attribute))

34
src/main/com/fulcrologic/rad/rendering/semantic_ui/boolean_field.cljc Normal file
View File

@ -0,0 +1,34 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.boolean-field
(:require
#?(:cljs
[com.fulcrologic.fulcro.dom :as dom :refer [div label input]]
:clj
[com.fulcrologic.fulcro.dom-server :as dom :refer [div label input]])
[com.fulcrologic.rad.attributes :as attr]
[com.fulcrologic.fulcro.components :as comp]
[clojure.string :as str]
[com.fulcrologic.rad.form :as form]
[com.fulcrologic.fulcro.dom.events :as evt]))
(defn render-field [{::form/keys [form-instance] :as env} attribute]
(let [k (::attr/qualified-key attribute)
props (comp/props form-instance)
user-props (form/field-style-config env attribute :input/props)
field-label (form/field-label env attribute)
read-only? (form/read-only? form-instance attribute)
value (get props k false)]
(div :.ui.field {:key (str k)}
(if read-only?
(label field-label " " (if value "Yes" "No"))
(div :.ui.checkbox
(input (merge
{:checked value
:type "checkbox"
:disabled (boolean read-only?)
:onChange (fn [evt]
(let [v (not value)]
(form/input-blur! env k v)
(form/input-changed! env k v)))}
user-props))
(label field-label))))))

92
src/main/com/fulcrologic/rad/rendering/semantic_ui/components.cljc Normal file
View File

@ -0,0 +1,92 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.components
(:require
#?@(:cljs
[[com.fulcrologic.fulcro.dom :as dom :refer [div label input]]
[com.fulcrologic.semantic-ui.modules.dropdown.ui-dropdown :refer [ui-dropdown]]]
:clj
[[com.fulcrologic.fulcro.dom-server :as dom :refer [div label input]]])
[com.fulcrologic.fulcro.components :as comp :refer [defsc]]
[com.fulcrologic.fulcro.algorithms.transit :as ftransit]
[taoensso.timbre :as log]))
(defn sui-format->user-format
"Converts transit encoded value(s), used by Semantic UI, into CLJS datastructure."
[{:keys [multiple]} value]
(if multiple
(into [] (map ftransit/transit-str->clj value))
(ftransit/transit-str->clj value)))
(defn user-format->sui-format [{:keys [multiple]} value]
"Converts CLJS datastructure into transit encoded string(s), usable by Semantic UI."
(if multiple
(if value
(to-array (map ftransit/transit-clj->str value))
#js [])
(if (or value (boolean? value))
(ftransit/transit-clj->str value)
"")))
(defn wrapped-onChange
"Wraps userOnChange fn with try/catch and sui-form->user-format conversion."
[props userOnChange]
(fn [_ v]
#?(:cljs
(try
(if (and (.-value v) (seq (.-value v)))
(let [value (sui-format->user-format props (.-value v))]
(when (and value userOnChange) (userOnChange value)))
(userOnChange nil))
(catch :default e
(log/error e "Unable to read dropdown value " (when v (.-value v))))))))
(defsc WrappedDropdown [this {:keys [onChange value multiple] :as props}]
{:initLocalState (fn [this]
#?(:cljs
(let [xform-options (memoize (fn [options]
(clj->js (mapv (fn [{:keys [text value]}]
#js {:text text :value (some-> value (ftransit/transit-clj->str))})
options))))
xform-value (fn [multiple? value]
(user-format->sui-format {:multiple multiple?} value))]
{:get-options (fn [props] (xform-options (:options props)))
:format-value (fn [props value] (xform-value (:multiple props) value))})))}
#?(:cljs
(let [{:keys [get-options format-value]} (comp/get-state this)
userOnChange onChange
options (get-options props)
value (format-value props value)
props (merge
{:search true
:selection true
:closeOnBlur true
:openOnFocus true
:selectOnBlur true
:selectOnNavigation true
:multiple (boolean multiple)}
props
{:value value
:options options
:onChange (fn [e v]
(try
(let [string-value (.-value v)
value (if multiple
(mapv #(when (seq %) (ftransit/transit-str->clj %)) string-value)
(when (seq string-value) (ftransit/transit-str->clj string-value)))]
(when userOnChange
(userOnChange value)))
(catch :default e
(log/error "Unable to read dropdown value " e (when v (.-value v))))))})]
(ui-dropdown props))
:clj
(dom/div :.ui.selection.dropdown
(dom/input {:type "hidden"})
(dom/i :.dropdown.icon)
(dom/div :.default.text "")
(dom/div :.menu))))
(def ui-wrapped-dropdown
"Draw a SUI dropdown with the given props. The arguments are identical to sui/ui-dropdown, but options and onChange
are auto-wrapped so that clojure data (e.g. keywords) can be used for the option :value fields. It also defaults
a number of things (:search, :closeOnBlue, openOnFocus, selectOnBlue, and :selectOnNavigation) to true, but you can"
(comp/factory WrappedDropdown))

85
src/main/com/fulcrologic/rad/rendering/semantic_ui/container.cljc Normal file
View File

@ -0,0 +1,85 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.container
(:require
#?@(:cljs
[[com.fulcrologic.fulcro.dom :as dom :refer [div]]]
:clj
[[com.fulcrologic.fulcro.dom-server :as dom :refer [div]]])
[com.fulcrologic.fulcro.components :as comp]
[com.fulcrologic.rad.container :as container]
[com.fulcrologic.rad.control :as control]
[com.fulcrologic.rad.options-util :refer [?!]]
[com.fulcrologic.rad.rendering.semantic-ui.form :as sui-form]
[taoensso.timbre :as log]))
(comp/defsc StandardContainerControls [_ {:keys [instance]}]
{:shouldComponentUpdate (fn [_ _ _] true)}
(let [controls (control/component-controls instance)
{:keys [input-layout action-layout]} (control/standard-control-layout instance)]
(div :.ui.top.attached.compact.basic.segment
(dom/h3 :.ui.header
(or (some-> instance comp/component-options ::container/title (?! instance)) "")
(div :.ui.right.floated.buttons
(keep (fn [k] (control/render-control instance k (get controls k))) action-layout)))
(div :.ui.form
(map-indexed
(fn [idx row]
(div {:key idx :className (sui-form/n-fields-string (count row))}
(map #(if-let [c (get controls %)]
(control/render-control instance % c)
(dom/div :.ui.field {:key (str %)} "")) row)))
input-layout)))))
(let [ui-standard-container-controls (comp/factory StandardContainerControls)]
(defn render-standard-controls [instance]
(ui-standard-container-controls {:instance instance})))
(def n-string {0 "zero"
1 "one"
2 "two"
3 "three"
4 "four"
5 "five"
6 "six"
7 "seven"
8 "eight"
9 "nine"
10 "ten"
11 "eleven"
12 "twelve"
13 "thirteen"
14 "fourteen"
15 "fifteen"
16 "sixteen"})
(defn render-container-layout [container-instance]
(let [{::container/keys [children layout]} (comp/component-options container-instance)]
;; TODO: Custom controls rendering as a separate config?
(let [container-props (comp/props container-instance)
render-cls (fn [id cls]
(let [factory (comp/computed-factory cls)
props (get container-props id {})]
(factory props {::container/controlled? true})))]
(dom/div :.ui.basic.segments
(render-standard-controls container-instance)
(dom/div :.ui.basic.segment
(if layout
(dom/div :.ui.container.centered.grid
(map-indexed
(fn *render-row [idx row]
(let [cols (count row)]
(dom/div :.row {:key idx}
(map
(fn *render-col [entry]
(let [id (if (keyword? entry) entry (:id entry))
width (or
(and (map? entry) (:width entry))
(int (/ 16 cols)))
cls (get children id)]
(dom/div {:key id :classes [(when width (str (n-string width) " wide")) "column"]}
(render-cls id cls))))
row))))
layout))
(map
(fn [[id cls]]
(dom/div {:key id}
(render-cls id cls))) (container/id-child-pairs children))))))))

40
src/main/com/fulcrologic/rad/rendering/semantic_ui/controls/action_button.cljc Normal file
View File

@ -0,0 +1,40 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.controls.action-button
(:require
[com.fulcrologic.rad.report :as report]
[com.fulcrologic.rad.options-util :refer [?!]]
[com.fulcrologic.fulcro.data-fetch :as df]
[com.fulcrologic.rad.control :as control]
#?(:cljs [com.fulcrologic.fulcro.dom :as dom]
:clj [com.fulcrologic.fulcro.dom-server :as dom])
[com.fulcrologic.fulcro.components :as comp :refer [defsc]]
#?@(:cljs [[ch.lyrion.carbon.button.ui-button :refer [ui-button]]])))
(defsc ActionButton [_ {:keys [instance control-key]}]
{:shouldComponentUpdate (fn [_ _ _] true)}
#?(:cljs
(let [controls (control/component-controls instance)
props (comp/props instance)
{:keys [label icon class action disabled? visible?] :as control} (get controls control-key)]
(when control
(let [label (?! label instance)
class (?! class instance)
loading? (df/loading? (get-in props [df/marker-table (comp/get-ident instance)]))
disabled? (or loading? (?! disabled? instance))
visible? (or (nil? visible?) (?! visible? instance))]
(when visible?
(ui-button
{:id (str control-key)
:className (when loading? "bx--skeleton")
:disabled (boolean disabled?)
:onClick (fn [] (when action (action instance control-key)))}
(when icon (dom/i {:className (str icon " icon")}))
(when label label))
#_(dom/button :.bx--btn.bx--btn--sm.bx--skeleton
{:key (str control-key)
:classes [(when class class)]
:disabled (boolean disabled?)
:onClick (fn [] (when action (action instance control-key)))}
(when icon (dom/i {:className (str icon " icon")}))
(when label label))))))))
(def render-control (comp/factory ActionButton {:keyfn :control-key}))

35
src/main/com/fulcrologic/rad/rendering/semantic_ui/controls/boolean_control.cljc Normal file
View File

@ -0,0 +1,35 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.controls.boolean-control
(:require
[com.fulcrologic.fulcro.components :as comp :refer [defsc]]
[com.fulcrologic.fulcro.ui-state-machines :as uism]
[com.fulcrologic.rad.options-util :refer [?!]]
[com.fulcrologic.rad.report :as report]
[taoensso.timbre :as log]
#?(:cljs [com.fulcrologic.fulcro.dom :as dom]
:clj [com.fulcrologic.fulcro.dom-server :as dom])
[com.fulcrologic.rad.control :as control]
#?@(:cljs [[ch.lyrion.carbon.toggle.ui-toggle :refer [ui-toggle]]])))
(defsc BooleanControl [_ {:keys [instance control-key]}]
{:shouldComponentUpdate (fn [_ _ _] true)}
(let [controls (control/component-controls instance)
{:keys [label onChange disabled? visible?] :as control} (get controls control-key)]
(if control
(let [label (or (?! label instance))
disabled? (?! disabled? instance)
visible? (or (nil? visible?) (?! visible? instance))
value (control/current-value instance control-key)]
(when visible?
#?(:cljs
(ui-toggle
{:id (str (hash control))
:defaultToggled (boolean value)
:labelA label
:labelB label
:onToggle (fn [_]
(control/set-parameter! instance control-key (not value))
(when onChange
(onChange instance (not value))))}))))
(log/error "Could not find control definition for " control-key))))
(def render-control (comp/factory BooleanControl {:keyfn :control-key}))

35
src/main/com/fulcrologic/rad/rendering/semantic_ui/controls/control.cljc Normal file
View File

@ -0,0 +1,35 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.controls.control
(:require
[com.fulcrologic.fulcro.components :as comp :refer [defsc]]
[com.fulcrologic.fulcro.ui-state-machines :as uism]
[com.fulcrologic.rad.options-util :refer [?!]]
[com.fulcrologic.guardrails.core :refer [>defn =>]]
[com.fulcrologic.rad.report :as report]
[com.fulcrologic.rad.control :as control]
#?(:cljs [com.fulcrologic.fulcro.dom :as dom]
:clj [com.fulcrologic.fulcro.dom-server :as dom])
[taoensso.timbre :as log]))
(defsc Control [_ {:keys [instance control control-key input-factory] :as report-env}]
{:shouldComponentUpdate (fn [_ _ _] true)}
(let [controls (control/component-controls instance)
{:keys [label onChange disabled? visible? user-props] :as control} (get controls control-key control)]
(if (and input-factory control)
(let [label (or (?! label instance))
disabled? (?! disabled? instance)
visible? (or (nil? visible?) (?! visible? instance))
value (control/current-value instance control-key)
onChange (fn [new-value]
(control/set-parameter! instance control-key new-value)
(when onChange
(onChange instance new-value)))]
(when visible?
(dom/div :.ui.field {:key (str control-key)}
(dom/label label)
(input-factory report-env (merge user-props
{:disabled? disabled?
:value value
:onChange onChange})))))
(log/error "Cannot render control. Missing input factory or control definition."))))
(def ui-control (comp/factory Control {:keyfn :control-key}))

87
src/main/com/fulcrologic/rad/rendering/semantic_ui/controls/instant_inputs.cljc Normal file
View File

@ -0,0 +1,87 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.controls.instant-inputs
(:require
[clojure.string :as str]
[com.fulcrologic.guardrails.core :refer [>defn => ?]]
[com.fulcrologic.rad.type-support.date-time :as dt]
[com.fulcrologic.rad.rendering.semantic-ui.controls.control :as control]
[cljc.java-time.local-time :as lt]
[com.fulcrologic.fulcro.dom.events :as evt]
#?(:clj [com.fulcrologic.fulcro.dom-server :as dom]
:cljs [com.fulcrologic.fulcro.dom :as dom])
[cljc.java-time.local-date-time :as ldt]
[cljc.java-time.local-date :as ld]
#?@(:cljs [[ch.lyrion.carbon.date-picker.ui-date-picker :refer [ui-date-picker]]
[ch.lyrion.carbon.date-picker-input.ui-date-picker-input :refer [ui-date-picker-input]]])))
(defn ui-date-instant-input [{::keys [default-local-time]} {:keys [value onChange local-time] :as props}]
#?(:cljs
(let [value (dt/inst->html-date (or value (dt/now)))
local-time (or local-time default-local-time)]
(ui-date-picker
{:id (str (hash props) "-picker")
:datePickerType "single"
:dateFormat "Y-m-d"
:value value
:onChange (fn [evt]
(when onChange
(let [date (.toJSON (first evt))
date-string (first (str/split date "T"))
instant (dt/html-date->inst date-string local-time)]
(onChange instant))))}
(ui-date-picker-input
{:id (str (dt/now) "ui-date-instant-input")})))))
(defn ui-ending-date-instant-input
"Display the date the user selects, but control a value that is midnight on the next date. Used for generating ending
instants that can be used for a proper non-inclusive end date."
[_ {:keys [value onChange] :as props}]
#?(:cljs
(let [today (dt/inst->local-datetime (or value (dt/now)))
display-date (ldt/to-local-date (ldt/minus-days today 1))
value (dt/local-date->html-date-string display-date)]
(ui-date-picker
{:id (str (hash props) "-picker")
:datePickerType "single"
:dateFormat "Y-m-d"
:value value
:onChange (fn [evt]
(when onChange
(let [date (.toJSON (first evt))
date-string (first (str/split date "T"))
tomorrow (ld/at-time (ld/plus-days (dt/html-date-string->local-date date-string) 1)
lt/midnight)
instant (dt/local-datetime->inst tomorrow)]
(onChange instant))))}
(ui-date-picker-input
{:id (str (hash props) "-picker-input")})))))
(defn ui-date-time-instant-input [_ {:keys [disabled? value onChange] :as props}]
(let [value (dt/inst->html-datetime-string (or value (dt/now)))]
(dom/input
(merge props
(cond->
{:value value
:type "date"
:onChange (fn [evt]
(when onChange
(let [date-time-string (evt/target-value evt)
instant (dt/html-datetime-string->inst date-time-string)]
(onChange instant))))}
disabled? (assoc :readOnly true))))))
(defn date-time-control [render-env]
(control/ui-control (assoc render-env :input-factory ui-date-time-instant-input)))
(defn midnight-on-date-control [render-env]
(control/ui-control (assoc render-env
:input-factory ui-date-instant-input
::default-local-time lt/midnight)))
(defn midnight-next-date-control [render-env]
(control/ui-control (assoc render-env
:input-factory ui-ending-date-instant-input)))
(defn date-at-noon-control [render-env]
(control/ui-control (assoc render-env
::default-local-time lt/noon
:input-factory ui-date-instant-input)))

72
src/main/com/fulcrologic/rad/rendering/semantic_ui/controls/pickers.cljc Normal file
View File

@ -0,0 +1,72 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.controls.pickers
(:require
[com.fulcrologic.fulcro.components :as comp :refer [defsc]]
[com.fulcrologic.rad.picker-options :as po]
[com.fulcrologic.rad.control :as control]
[com.fulcrologic.rad.rendering.semantic-ui.components :refer [ui-wrapped-dropdown]]
#?(:cljs [ch.lyrion.carbon.combo-box.ui-combo-box :refer [ui-combo-box]])
[com.fulcrologic.rad.options-util :refer [?!]]
[taoensso.timbre :as log]
#?(:cljs [com.fulcrologic.fulcro.dom :as dom]
:clj [com.fulcrologic.fulcro.dom-server :as dom])))
(defsc SimplePicker [_ {:keys [instance control-key]}]
{:shouldComponentUpdate (fn [_ _ _] true)
:componentDidMount (fn [this]
(let [{:keys [instance control-key] :as props} (comp/props this)
controls (control/component-controls instance)
{::po/keys [query-key] :as picker-options} (get controls control-key)]
(when query-key
(po/load-picker-options! instance (comp/react-type instance) props picker-options))))}
#?(:cljs
(let [controls (control/component-controls instance)
props (comp/props instance)
{::po/keys [query-key cache-key]
:keys [label onChange disabled? visible? action placeholder options user-props] :as control} (get controls control-key)
options (or options (get-in props [::po/options-cache (or cache-key query-key) :options]))]
(when control
(let [label (or (?! label instance))
disabled? (?! disabled? instance)
placeholder (?! placeholder instance)
visible? (or (nil? visible?) (?! visible? instance))
value (control/current-value instance control-key)]
(when visible?
(dom/div
(ui-combo-box
{:id (or (str control-key) (str (hash options)))
;;:titleText label
:disabled (or disabled? false)
:placeholder (str placeholder)
:items (or options [])
:itemToString (fn [item] (.-text item))
:initialSelectedItem (or value "")
:onChange (fn [v]
(let [selectedItem (.-selectedItem v)
selected-item (if (nil? selectedItem)
(or (first (filter #(= "" (:value %)) options))
{:text "" :value ""})
{:text (.-text selectedItem) :value (.-value selectedItem)})]
(js/console.log "Event:" v)
(control/set-parameter! instance control-key (:value selected-item))
(binding [comp/*after-render* true]
(when onChange
(onChange instance v))
(when action
(action instance)))))}))
#_(dom/div :.ui.field {:key (str control-key)}
(dom/label label)
(ui-wrapped-dropdown (merge
user-props
{:disabled disabled?
:placeholder (str placeholder)
:options options
:value value
:onChange (fn [v]
(control/set-parameter! instance control-key v)
(binding [comp/*after-render* true]
(when onChange
(onChange instance v))
(when action
(action instance))))})))))))))
(def render-control (comp/factory SimplePicker {:keyfn :control-key}))

59
src/main/com/fulcrologic/rad/rendering/semantic_ui/controls/text_input.cljc Normal file
View File

@ -0,0 +1,59 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.controls.text-input
(:require
[com.fulcrologic.fulcro.components :as comp :refer [defsc]]
[com.fulcrologic.fulcro.ui-state-machines :as uism]
[com.fulcrologic.fulcro.dom.events :as evt]
[com.fulcrologic.rad.control :as control]
[com.fulcrologic.rad.options-util :refer [?! debounce]]
[taoensso.timbre :as log]
#?(:cljs [com.fulcrologic.fulcro.dom :as dom]
:clj [com.fulcrologic.fulcro.dom-server :as dom])
#?@(:cljs [[ch.lyrion.carbon.text-input.ui-text-input :refer [ui-text-input]]])))
(defsc TextControl [this {:keys [instance control-key]}]
{:shouldComponentUpdate (fn [_ _ _] true)}
#?(:cljs
(let [controls (control/component-controls instance)
props (comp/props instance)
{:keys [label onChange icon placeholder disabled? visible?] :as control} (get controls control-key)]
(when control
(let [label (?! label instance)
disabled? (?! disabled? instance)
placeholder (?! placeholder)
visible? (or (nil? visible?) (?! visible? instance))
chg! #(control/set-parameter! instance control-key (evt/target-value %))
run! (fn [evt] (let [v (evt/target-value evt)]
(when onChange (onChange instance v))))
value (control/current-value instance control-key)]
(when visible?
(dom/div
(when icon
(dom/i {:className (str icon " icon")}))
(ui-text-input
{:id (str control-key)
:disabled (boolean disabled?)
:labelText label
:placeholder (str placeholder)
:onChange chg!
:onBlur run!
:onKeyDown (fn [evt] (when (evt/enter? evt) (run! evt)))
:value (str value)}))
#_(dom/div :.ui.field {:key (str control-key)}
(dom/label label)
(if icon
(dom/div :.ui.icon.input
(dom/i {:className (str icon " icon")})
(dom/input {:readOnly (boolean disabled?)
:placeholder (str placeholder)
:onChange chg!
:onBlur run!
:onKeyDown (fn [evt] (when (evt/enter? evt) (run! evt)))
:value (str value)}))
(dom/input {:readOnly (boolean disabled?)
:placeholder (str placeholder)
:onChange chg!
:onBlur run!
:onKeyDown (fn [evt] (when (evt/enter? evt) (run! evt)))
:value (str value)})))))))))
(def render-control (comp/factory TextControl {:keyfn :control-key}))

15
src/main/com/fulcrologic/rad/rendering/semantic_ui/decimal_field.cljc Normal file
View File

@ -0,0 +1,15 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.decimal-field
(:require
[com.fulcrologic.fulcro.components :as comp]
[com.fulcrologic.fulcro.dom.inputs :as inputs]
[clojure.string :as str]
[com.fulcrologic.rad.rendering.semantic-ui.field :refer [render-field-factory]]
[com.fulcrologic.rad.type-support.decimal :as math]))
(def ui-decimal-input
(comp/factory (inputs/StringBufferedInput ::DecimalInput
{:model->string (fn [n] (if (math/numeric? n) (math/numeric->str n) ""))
:string->model (fn [s] (math/numeric s))
:string-filter (fn [s] (str/replace s #"[^\d.]" ""))})))
(def render-field (render-field-factory {} ui-decimal-input))

115
src/main/com/fulcrologic/rad/rendering/semantic_ui/entity_picker.cljc Normal file
View File

@ -0,0 +1,115 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.entity-picker
(:require
#?(:cljs [com.fulcrologic.fulcro.dom :as dom :refer [div h3 button i span]]
:clj [com.fulcrologic.fulcro.dom-server :as dom :refer [div h3 button i span]])
[com.fulcrologic.rad.rendering.semantic-ui.components :refer [ui-wrapped-dropdown]]
[com.fulcrologic.fulcro.components :as comp :refer [defsc]]
[com.fulcrologic.rad.form :as form]
[com.fulcrologic.rad.attributes :as attr]
[com.fulcrologic.rad.picker-options :as picker-options]
[com.fulcrologic.rad.ui-validation :as validation]
[com.fulcrologic.rad.options-util :refer [?!]]
[taoensso.timbre :as log]))
(defsc ToOnePicker [this {:keys [env attr]}]
{:componentDidMount (fn [this]
(let [{:keys [env attr]} (comp/props this)
form-instance (::form/form-instance env)
props (comp/props form-instance)
form-class (comp/react-type form-instance)]
(picker-options/load-options! form-instance form-class props attr)))}
(let [{::form/keys [master-form form-instance]} env
{::form/keys [attributes field-options]} (comp/component-options form-instance)
{::attr/keys [qualified-key required?]} attr
field-options (get field-options qualified-key)
target-id-key (first (keep (fn [{k ::attr/qualified-key ::attr/keys [target]}]
(when (= k qualified-key) target)) attributes))
{::picker-options/keys [cache-key query-key]} (merge attr field-options)
cache-key (or (?! cache-key (comp/react-type form-instance) (comp/props form-instance)) query-key)
cache-key (or cache-key query-key (log/error "Ref field MUST have either a ::picker-options/cache-key or ::picker-options/query-key in attribute " qualified-key))
props (comp/props form-instance)
options (get-in props [::picker-options/options-cache cache-key :options])
value [target-id-key (get-in props [qualified-key target-id-key])]
field-label (form/field-label env attr)
read-only? (or (form/read-only? master-form attr) (form/read-only? form-instance attr))
invalid? (and (not read-only?) (validation/invalid-attribute-value? env attr))
onSelect (fn [v]
(form/input-changed! env qualified-key v))]
(div :.ui.field {:classes [(when invalid? "error")]}
(dom/label field-label (when invalid? " (Required)"))
(if read-only?
(let [value (first (filter #(= value (:value %)) options))]
(:text value))
(ui-wrapped-dropdown (cond->
{:onChange (fn [v] (onSelect v))
:value value
:clearable (not required?)
:disabled read-only?
:options options}))))))
(let [ui-to-one-picker (comp/factory ToOnePicker {:keyfn (fn [{:keys [attr]}] (::attr/qualified-key attr))})]
(defn to-one-picker [env attribute]
(ui-to-one-picker {:env env
:attr attribute})))
(defsc ToManyPicker [this {:keys [env attr]}]
{:componentDidMount (fn [this]
(let [{:keys [env attr]} (comp/props this)
form-instance (::form/form-instance env)
props (comp/props form-instance)
form-class (comp/react-type form-instance)]
(picker-options/load-options! form-instance form-class props attr)))}
(let [{::form/keys [form-instance]} env
visible? (form/field-visible? form-instance attr)]
(when visible?
(let [{::form/keys [attributes field-options]} (comp/component-options form-instance)
{attr-field-options ::form/field-options
::attr/keys [qualified-key]} attr
field-options (get field-options qualified-key)
target-id-key (first (keep (fn [{k ::attr/qualified-key ::attr/keys [target]}]
(when (= k qualified-key) target)) attributes))
{:keys [style]
::picker-options/keys [cache-key query-key]} (merge attr-field-options field-options)
cache-key (or (?! cache-key (comp/react-type form-instance) (comp/props form-instance)) query-key)
cache-key (or cache-key query-key (log/error "Ref field MUST have either a ::picker-options/cache-key or ::picker-options/query-key in attribute " qualified-key))
props (comp/props form-instance)
options (get-in props [::picker-options/options-cache cache-key :options])
current-selection (into #{}
(keep (fn [entity]
(when-let [id (get entity target-id-key)]
[target-id-key id])))
(get props qualified-key))
field-label (form/field-label env attr)
invalid? (validation/invalid-attribute-value? env attr)
read-only? (form/read-only? form-instance attr)
validation-message (when invalid? (validation/validation-error-message env attr))]
(div :.ui.field {:classes [(when invalid? "error")]}
(dom/label field-label " " (when invalid? validation-message))
(div :.ui.middle.aligned.celled.list.big
{:style {:marginTop "0"}}
(if (= style :dropdown)
(ui-wrapped-dropdown
{:value current-selection
:multiple true
:disabled read-only?
:options options
:onChange (fn [v] (form/input-changed! env qualified-key v))})
(map (fn [{:keys [text value]}]
(let [checked? (contains? current-selection value)]
(div :.item {:key value}
(div :.content {}
(div :.ui.toggle.checkbox {:style {:marginTop "0"}}
(dom/input
{:type "checkbox"
:checked checked?
:onChange #(if-not checked?
(form/input-changed! env qualified-key (vec (conj current-selection value)))
(form/input-changed! env qualified-key (vec (disj current-selection value))))})
(dom/label text))))))
options))))))))
(def ui-to-many-picker (comp/factory ToManyPicker {:keyfn :id}))
(let [ui-to-many-picker (comp/factory ToManyPicker {:keyfn (fn [{:keys [attr]}] (::attr/qualified-key attr))})]
(defn to-many-picker [env attribute]
(ui-to-many-picker {:env env
:attr attribute})))

79
src/main/com/fulcrologic/rad/rendering/semantic_ui/enumerated_field.cljc Normal file
View File

@ -0,0 +1,79 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.enumerated-field
(:require
#?@(:cljs
[[com.fulcrologic.fulcro.dom :as dom :refer [div label input]]
[cljs.reader :refer [read-string]]
[com.fulcrologic.semantic-ui.modules.dropdown.ui-dropdown :refer [ui-dropdown]]]
:clj
[[com.fulcrologic.fulcro.dom-server :as dom :refer [div label input]]])
[com.fulcrologic.rad.ui-validation :as validation]
[com.fulcrologic.fulcro.components :as comp :refer [defsc]]
[com.fulcrologic.rad.options-util :refer [?!]]
[com.fulcrologic.rad.rendering.semantic-ui.components :refer [ui-wrapped-dropdown]]
[com.fulcrologic.rad.attributes :as attr]
[clojure.string :as str]
[com.fulcrologic.rad.form :as form]))
(defn enumerated-options [{::form/keys [form-instance] :as env} {::attr/keys [qualified-key] :as attribute}]
(let [{::attr/keys [enumerated-values]} attribute
enumeration-labels (merge
(::attr/enumerated-labels attribute)
(comp/component-options form-instance ::form/enumerated-labels qualified-key))]
;; TODO: Sorting should be something users control
(sort-by :text
(mapv (fn [k]
{:text (?! (get enumeration-labels k (name k)))
:value k}) enumerated-values))))
(defn- render-to-many [{::form/keys [form-instance] :as env} {::form/keys [field-label]
::attr/keys [qualified-key] :as attribute}]
(when (form/field-visible? form-instance attribute)
(let [props (comp/props form-instance)
read-only? (form/read-only? form-instance attribute)
options (enumerated-options env attribute)
selected-ids (set (get props qualified-key))]
(div :.ui.field {:key (str qualified-key)}
(label (or field-label (some-> qualified-key name str/capitalize)))
(div :.ui.middle.aligned.celled.list.big {:style {:marginTop "0"}}
(map (fn [{:keys [text value]}]
(let [checked? (contains? selected-ids value)]
(div :.item {:key value}
(div :.content {}
(div :.ui.toggle.checkbox {:style {:marginTop "0"}}
(dom/input
{:type "checkbox"
:checked checked?
:disabled read-only?
:onChange #(let [selection (if-not checked?
(conj (set (or selected-ids #{})) value)
(disj selected-ids value))]
(form/input-changed! env qualified-key selection))})
(dom/label text))))))
options))))))
(defn- render-to-one [{::form/keys [form-instance] :as env} {::form/keys [field-label]
::attr/keys [qualified-key] :as attribute}]
(when (form/field-visible? form-instance attribute)
(let [props (comp/props form-instance)
read-only? (form/read-only? form-instance attribute)
invalid? (validation/invalid-attribute-value? env attribute)
user-props (form/field-style-config env attribute :input/props)
options (enumerated-options env attribute)
value (get props qualified-key)]
(div :.ui.field {:key (str qualified-key) :classes [(when invalid? "error")]}
(label (str (or field-label (some-> qualified-key name str/capitalize))
(when invalid? " (Required)")))
(if read-only?
(let [value (first (filter #(= value (:value %)) options))]
(:text value))
(ui-wrapped-dropdown (merge
{:disabled read-only?
:options options
:value value
:onChange (fn [v] (form/input-changed! env qualified-key v))}
user-props)))))))
(defn render-field [env {::attr/keys [cardinality] :or {cardinality :one} :as attribute}]
(if (= :many cardinality)
(render-to-many env attribute)
(render-to-one env attribute)))

44
src/main/com/fulcrologic/rad/rendering/semantic_ui/field.cljc Normal file
View File

@ -0,0 +1,44 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.field
(:require
[clojure.string :as str]
[com.fulcrologic.fulcro.components :as comp]
[com.fulcrologic.guardrails.core :refer [>defn =>]]
#?(:cljs [com.fulcrologic.fulcro.dom :refer [div label input span]]
:clj [com.fulcrologic.fulcro.dom-server :refer [div label input span]])
[com.fulcrologic.rad.attributes :as attr]
[com.fulcrologic.fulcro.dom.html-entities :as ent]
[com.fulcrologic.rad.form :as form]
[com.fulcrologic.rad.ui-validation :as validation]
[taoensso.timbre :as log]))
(defn render-field-factory
"Create a general field factory using the given input factory as the function to call to draw an input."
([input-factory]
(render-field-factory {} input-factory))
([addl-props input-factory]
(fn [{::form/keys [form-instance] :as env} {::attr/keys [type qualified-key] :as attribute}]
(let [props (comp/props form-instance)
value (or (form/computed-value env attribute)
(and attribute (get props qualified-key)))
invalid? (validation/invalid-attribute-value? env attribute)
validation-message (when invalid? (validation/validation-error-message env attribute))
user-props (form/field-style-config env attribute :input/props)
field-label (form/field-label env attribute)
visible? (form/field-visible? form-instance attribute)
read-only? (form/read-only? form-instance attribute)
addl-props (if read-only? (assoc addl-props :readOnly "readonly") addl-props)]
(when visible?
(div :.ui.field {:key (str qualified-key)
:classes [(when invalid? "error")]}
(label
(or field-label (some-> qualified-key name str/capitalize))
(when validation-message (str ent/nbsp "(" validation-message ")")))
(div :.ui.input {:classes [(when read-only? "transparent")]}
(input-factory (merge addl-props
{:value value
:onBlur (fn [v] (form/input-blur! env qualified-key v))
:onChange (fn [v] (form/input-changed! env qualified-key v))}
user-props)))
#_(when validation-message
(div :.ui.error.message
(str validation-message)))))))))

391
src/main/com/fulcrologic/rad/rendering/semantic_ui/form.cljc Normal file
View File

@ -0,0 +1,391 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.form
(:require
[com.fulcrologic.rad.attributes :as attr]
[com.fulcrologic.rad.options-util :refer [?! narrow-keyword]]
[com.fulcrologic.rad.ui-validation :as validation]
[com.fulcrologic.rad.form :as form]
[com.fulcrologic.rad.control :as control]
[com.fulcrologic.rad.blob :as blob]
[com.fulcrologic.fulcro.dom.events :as evt]
[com.fulcrologic.fulcro-i18n.i18n :refer [tr]]
[com.fulcrologic.fulcro.components :as comp :refer [defsc]]
[com.fulcrologic.fulcro.application :as app]
#?(:cljs [com.fulcrologic.fulcro.dom :as dom :refer [div h3 button i span]]
:clj [com.fulcrologic.fulcro.dom-server :as dom :refer [div h3 button i span]])
[com.fulcrologic.fulcro.dom.html-entities :as ent]
[com.fulcrologic.fulcro.algorithms.form-state :as fs]
[com.fulcrologic.fulcro.algorithms.tempid :as tempid]
[com.fulcrologic.fulcro.algorithms.merge :as merge]
[taoensso.encore :as enc]
[taoensso.timbre :as log]))
(defn render-to-many [{::form/keys [form-instance] :as env} {k ::attr/qualified-key :as attr} {::form/keys [subforms] :as options}]
(let [{:semantic-ui/keys [add-position]
::form/keys [ui title can-delete? can-add? added-via-upload?]} (get subforms k)
form-instance-props (comp/props form-instance)
read-only? (form/read-only? form-instance attr)
add? (if read-only? false (?! can-add? form-instance attr))
delete? (fn [item] (and (not read-only?) (?! can-delete? form-instance item)))
items (get form-instance-props k)
title (?! (or title (some-> ui (comp/component-options ::form/title)) "") form-instance form-instance-props)
invalid? (validation/invalid-attribute-value? env attr)
validation-message (validation/validation-error-message env attr)
add (when (or (nil? add?) add?)
(let [order (if (keyword? add?) add? :append)]
(if (?! added-via-upload? env)
(dom/input {:type "file"
:onChange (fn [evt]
(log/info "UPLOAD FILE!!!")
(let [new-id (tempid/tempid)
js-file (-> evt blob/evt->js-files first)
attributes (comp/component-options ui ::form/attributes)
id-attr (comp/component-options ui ::form/id)
id-key (::attr/qualified-key id-attr)
{::attr/keys [qualified-key] :as sha-attr} (first (filter ::blob/store
attributes))
target (conj (comp/get-ident form-instance) k)
new-entity (fs/add-form-config ui
{id-key new-id
qualified-key ""})]
(merge/merge-component! form-instance ui new-entity order target)
(blob/upload-file! form-instance sha-attr js-file {:file-ident [id-key new-id]})))})
(button :.ui.tiny.icon.button
{:onClick (fn [_]
(form/add-child! (assoc env
::form/order order
::form/parent-relation k
::form/parent form-instance
::form/child-class ui)))}
(i :.plus.icon)))))
ui-factory (comp/computed-factory ui {:keyfn (fn [item] (-> ui (comp/get-ident item) second str))})]
(div :.ui.container {:key (str k)}
(h3 title (span ent/nbsp ent/nbsp) (when (or (nil? add-position) (= :top add-position)) add))
(when invalid?
(div :.ui.error.message
validation-message))
(if (seq items)
(div :.ui.segments
(mapv
(fn [props]
(ui-factory props
(merge
env
{::form/parent form-instance
::form/parent-relation k
::form/can-delete? (if delete? (delete? props) false)})))
items))
(div :.ui.message "None."))
(when (= :bottom add-position) add))))
(defn render-to-one [{::form/keys [form-instance] :as env} {k ::attr/qualified-key :as attr} {::form/keys [subforms] :as options}]
(let [{::form/keys [ui can-delete? title]} (get subforms k)
form-props (comp/props form-instance)
props (get form-props k)
title (?! (or title (some-> ui (comp/component-options ::form/title)) "") form-instance form-props)
ui-factory (comp/computed-factory ui)
invalid? (validation/invalid-attribute-value? env attr)
validation-message (validation/validation-error-message env attr)
std-props {::form/nested? true
::form/parent form-instance
::form/parent-relation k
::form/can-delete? (or
(?! can-delete? form-instance form-props)
false)}]
(cond
props
(div {:key (str k)}
(h3 :.ui.header title)
(when invalid?
(div :.ui.error.message validation-message))
(ui-factory props (merge env std-props)))
:else
(div {:key (str k)}
(h3 :.ui.header title)
(button {:onClick (fn [] (form/add-child! (assoc env
::form/parent-relation k
::form/parent form-instance
::form/child-class ui)))} "Create")))))
(defn standard-ref-container [env {::attr/keys [cardinality] :as attr} options]
(if (= :many cardinality)
(render-to-many env attr options)
(render-to-one env attr options)))
(defn render-single-file [{::form/keys [form-instance] :as env} {k ::attr/qualified-key :as attr} {::form/keys [subforms] :as options}]
(let [{::form/keys [ui can-delete?]} (get subforms k)
parent (comp/props form-instance)
form-props (comp/props form-instance)
props (get form-props k)
ui-factory (comp/computed-factory ui)
label (form/field-label env attr)
std-props {::form/nested? true
::form/parent form-instance
::form/parent-relation k
::form/can-delete? (if can-delete?
(can-delete? parent props)
false)}]
(if props
(div :.field {:key (str k)}
(dom/label label)
(ui-factory props (merge env std-props)))
(div {:key (str k)}
(div "Upload??? (TODO)")))))
(defsc ManyFiles [this {{::form/keys [form-instance master-form] :as env} :env
{k ::attr/qualified-key :as attr} :attribute
{::form/keys [subforms] :as options} :options}]
{:initLocalState (fn [this] {:input-key (str (rand-int 1000000))})}
(let [{:semantic-ui/keys [add-position]
::form/keys [ui title can-delete? can-add? sort-children]} (get subforms k)
form-instance-props (comp/props form-instance)
read-only? (or
(form/read-only? master-form attr)
(form/read-only? form-instance attr))
add? (if read-only? false (?! can-add? form-instance attr))
delete? (if read-only? false (fn [item] (?! can-delete? form-instance item)))
items (-> form-instance comp/props k
(cond->
sort-children sort-children))
title (?! (or title (some-> ui (comp/component-options ::form/title)) "") form-instance form-instance-props)
upload-id (str k "-file-upload")
add (when (or (nil? add?) add?)
(dom/div
(dom/label :.ui.green.button {:htmlFor upload-id}
(dom/i :.ui.plus.icon)
"Add File")
(dom/input {:type "file"
;; trick: changing the key on change clears the input, so a failed upload can be retried
:key (comp/get-state this :input-key)
:id upload-id
:style {:zIndex -1
:width "1px"
:height "1px"
:opacity 0}
:onChange (fn [evt]
(let [new-id (tempid/tempid)
js-file (-> evt blob/evt->js-files first)
attributes (comp/component-options ui ::form/attributes)
id-attr (comp/component-options ui ::form/id)
id-key (::attr/qualified-key id-attr)
{::attr/keys [qualified-key] :as sha-attr} (first (filter ::blob/store
attributes))
target (conj (comp/get-ident form-instance) k)
new-entity (fs/add-form-config ui
{id-key new-id
qualified-key ""})]
(merge/merge-component! form-instance ui new-entity :append target)
(blob/upload-file! form-instance sha-attr js-file {:file-ident [id-key new-id]})
(comp/set-state! this {:input-key (str (rand-int 1000000))})))})))
ui-factory (comp/computed-factory ui {:keyfn (fn [item] (-> ui (comp/get-ident item) second str))})]
(div :.ui.basic.segment {:key (str k)}
(dom/h2 :.ui.header title)
(when (or (nil? add-position) (= :top add-position)) add)
(if (seq items)
(div :.ui.very.relaxed.items
(mapv
(fn [props]
(ui-factory props
(merge
env
{::form/parent form-instance
::form/parent-relation k
::form/can-delete? (if delete? (?! delete? props) false)})))
items))
(div :.ui.message
"None"))
(when (= :bottom add-position) add))))
(def ui-many-files (comp/factory ManyFiles {:keyfn (fn [{:keys [attribute]}] (::attr/qualified-key attribute))}))
(defn file-ref-container
[env {::attr/keys [cardinality] :as attr} options]
(if (= :many cardinality)
(ui-many-files {:env env :attribute attr :options options})
(render-single-file env attr options)))
(defn render-attribute [env attr {::form/keys [subforms] :as options}]
(let [{k ::attr/qualified-key} attr]
(if (contains? subforms k)
(let [render-ref (or (form/ref-container-renderer env attr) standard-ref-container)]
(render-ref env attr options))
(form/render-field env attr))))
(def n-fields-string {1 "one field"
2 "two fields"
3 "three fields"
4 "four fields"
5 "five fields"
6 "six fields"
7 "seven fields"})
(def attribute-map (memoize
(fn [attributes]
(reduce
(fn [m {::attr/keys [qualified-key] :as attr}]
(assoc m qualified-key attr))
{}
attributes))))
(defn- render-layout* [env options k->attribute layout]
(when #?(:clj true :cljs goog.DEBUG)
(when-not (and (vector? layout) (every? vector? layout))
(log/error "::form/layout must be a vector of vectors!")))
(try
(into []
(map-indexed
(fn [idx row]
(div {:key idx :className (n-fields-string (count row))}
(mapv (fn [col]
(enc/if-let [_ k->attribute
attr (k->attribute col)]
(render-attribute env attr options)
(if (some-> options ::control/controls (get col))
(control/render-control (::form/form-instance env) col)
(log/error "Missing attribute (or lookup) for" col))))
row)))
layout))
(catch #?(:clj Exception :cljs :default) _)))
(defn render-layout [env {::form/keys [attributes layout] :as options}]
(let [k->attribute (attribute-map attributes)]
(render-layout* env options k->attribute layout)))
(defsc TabbedLayout [this env {::form/keys [attributes tabbed-layout] :as options}]
{:initLocalState (fn [this]
(try
{:current-tab 0
:tab-details (memoize
(fn [attributes tabbed-layout]
(let [k->attr (attribute-map attributes)
tab-labels (filterv string? tabbed-layout)
tab-label->layout (into {}
(map vec)
(partition 2 (mapv first (partition-by string? tabbed-layout))))]
{:k->attr k->attr
:tab-labels tab-labels
:tab-label->layout tab-label->layout})))}
(catch #?(:clj Exception :cljs :default) _
(log/error "Cannot build tabs for tabbed layout. Check your tabbed-layout options for" (comp/component-name this)))))}
(let [{:keys [tab-details current-tab]} (comp/get-state this)
{:keys [k->attr tab-labels tab-label->layout]} (tab-details attributes tabbed-layout)
active-layout (some->> current-tab
(get tab-labels)
(get tab-label->layout))]
(div {:key (str current-tab)}
(div :.ui.pointing.menu {}
(map-indexed
(fn [idx title]
(dom/a :.item
{:key (str idx)
:onClick #(comp/set-state! this {:current-tab idx})
:classes [(when (= current-tab idx) "active")]}
title)) tab-labels))
(div :.ui.segment
(render-layout* env options k->attr active-layout)))))
(def ui-tabbed-layout (comp/computed-factory TabbedLayout))
(declare standard-form-layout-renderer)
(defsc StandardFormContainer [this {::form/keys [props computed-props form-instance master-form] :as env}]
{:shouldComponentUpdate (fn [_ _ _] true)}
(let [{::form/keys [can-delete?]} computed-props
nested? (not= master-form form-instance)
read-only-form? (or
(?! (comp/component-options form-instance ::form/read-only?) form-instance)
(?! (comp/component-options master-form ::form/read-only?) master-form))
invalid? (if read-only-form? false (form/invalid? env))
render-fields (or (form/form-layout-renderer env) standard-form-layout-renderer)]
(when #?(:cljs goog.DEBUG :clj true)
(let [valid? (if read-only-form? true (form/valid? env))
dirty? (if read-only-form? false (or (:ui/new? props) (fs/dirty? props)))]
(log/debug "Form " (comp/component-name form-instance) " valid? " valid?)
(log/debug "Form " (comp/component-name form-instance) " dirty? " dirty?)))
(if nested?
(div :.ui.segment
(div :.ui.form {:classes [(when invalid? "error")]
:key (str (comp/get-ident form-instance))}
(when can-delete?
(button :.ui.icon.primary.right.floated.button {:disabled (not can-delete?)
:onClick (fn []
(form/delete-child! env))}
(i :.times.icon)))
(render-fields env)))
(let [{::form/keys [title action-buttons controls]} (comp/component-options form-instance)
title (?! title form-instance props)
action-buttons (if action-buttons action-buttons form/standard-action-buttons)]
(div :.ui.container {:key (str (comp/get-ident form-instance))}
(div :.ui.top.attached.segment
(dom/h3 :.ui.header
title
(div :.ui.right.floated.buttons
(keep #(control/render-control master-form %) action-buttons))))
(div :.ui.attached.form {:classes [(when invalid? "error")]}
(div :.ui.error.message (tr "The form has errors and cannot be saved."))
(div :.ui.attached.segment
(render-fields env))))))))
(def standard-form-container (comp/factory StandardFormContainer))
(defn standard-form-layout-renderer [{::form/keys [form-instance] :as env}]
(let [{::form/keys [attributes layout tabbed-layout] :as options} (comp/component-options form-instance)]
(cond
(vector? layout) (render-layout env options)
(vector? tabbed-layout) (ui-tabbed-layout env options)
:else (mapv (fn [attr] (render-attribute env attr options)) attributes))))
(defn- file-icon-renderer* [{::form/keys [form-instance] :as env}]
(let [{::form/keys [attributes] :as options} (comp/component-options form-instance)
attribute (first (filter ::blob/store attributes))
sha-key (::attr/qualified-key attribute)
file-key (blob/filename-key sha-key)
url-key (blob/url-key sha-key)
props (comp/props form-instance)
filename (get props file-key "File")
dirty? (fs/dirty? props sha-key)
failed? (blob/failed-upload? props sha-key)
invalid? (validation/invalid-attribute-value? env attribute)
pct (blob/upload-percentage props sha-key)
sha (get props sha-key)
url (get props url-key)]
(if (blob/uploading? props sha-key)
(dom/span :.item {:key (str sha)}
(dom/div :.ui.tiny.image
(dom/i :.huge.file.icon)
(dom/div :.ui.active.red.loader {:style {:marginLeft "-10px"}})
(dom/div :.ui.bottom.attached.blue.progress {:data-percent pct}
(div :.bar {:style {:transitionDuration "300ms"
:width pct}}
(div :.progress ""))))
(div :.middle.aligned.content
filename)
(dom/button :.ui.red.icon.button {:onClick (fn []
(app/abort! form-instance sha)
(form/delete-child! env))}
(dom/i :.times.icon)))
((if dirty? dom/span dom/a) :.item
{:target "_blank"
:key (str sha)
:href (str url "?filename=" filename)
:onClick (fn [evt]
#?(:cljs (when-not (or (not (blob/blob-downloadable? props sha-key))
(js/confirm "View/download?"))
(evt/stop-propagation! evt)
(evt/prevent-default! evt))))}
(dom/div :.ui.tiny.image
(if failed?
(dom/i :.huge.skull.crossbones.icon)
(dom/i :.huge.file.icon)))
(div :.middle.aligned.content
(str filename (cond failed? " (Upload failed. Delete and try again.)"
dirty? " (unsaved)")))
(dom/button :.ui.red.icon.button {:onClick (fn [evt]
(evt/stop-propagation! evt)
(evt/prevent-default! evt)
(when #?(:clj true :cljs (js/confirm "Permanently Delete File?"))
(form/delete-child! env)))}
(dom/i :.times.icon))))))
(defn file-icon-renderer [env] (file-icon-renderer* env))

34
src/main/com/fulcrologic/rad/rendering/semantic_ui/instant_field.cljc Normal file
View File

@ -0,0 +1,34 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.instant-field
(:require
[clojure.string :as str]
[com.fulcrologic.fulcro.components :as comp]
#?(:cljs [com.fulcrologic.fulcro.dom :refer [div label input]]
:clj [com.fulcrologic.fulcro.dom-server :refer [div label input]])
[com.fulcrologic.fulcro.dom.inputs :as inputs]
[taoensso.timbre :as log]
[com.fulcrologic.rad.type-support.date-time :as datetime]
[com.fulcrologic.rad.rendering.semantic-ui.field :refer [render-field-factory]]))
(def ui-datetime-input
(comp/factory (inputs/StringBufferedInput ::DateTimeInput
{:model->string (fn [tm]
(if tm
(datetime/inst->html-datetime-string tm)
""))
:string->model (fn [s] (some-> s (datetime/html-datetime-string->inst)))})))
(def ui-date-noon-input
(comp/factory (inputs/StringBufferedInput ::DateTimeInput
{:model->string (fn [tm]
(if tm
(str/replace (datetime/inst->html-datetime-string tm) #"T.*$" "")
""))
:string->model (fn [s] (some-> s (str "T12:00") (datetime/html-datetime-string->inst)))})))
(def render-field
"Uses current timezone and gathers date/time."
(render-field-factory {:type "datetime-local"} ui-datetime-input))
(def render-date-at-noon-field
"Uses current timezone and gathers a local date but saves it as an instant at noon on that date."
(render-field-factory {:type "date"} ui-date-noon-input))

6
src/main/com/fulcrologic/rad/rendering/semantic_ui/int_field.cljc Normal file
View File

@ -0,0 +1,6 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.int-field
(:require
[com.fulcrologic.fulcro.dom.inputs :as inputs]
[com.fulcrologic.rad.rendering.semantic-ui.field :refer [render-field-factory]]))
(def render-field (render-field-factory inputs/ui-int-input))

360
src/main/com/fulcrologic/rad/rendering/semantic_ui/report.cljc Normal file
View File

@ -0,0 +1,360 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.report
(:require
[clojure.string :as str]
[com.fulcrologic.rad.attributes :as attr]
[com.fulcrologic.rad.report :as report]
[com.fulcrologic.rad.control :as control]
[com.fulcrologic.fulcro.components :as comp]
#?@(:cljs
[[com.fulcrologic.fulcro.dom :as dom :refer [div]]
[com.fulcrologic.semantic-ui.addons.pagination.ui-pagination :as sui-pagination]
[ch.lyrion.carbon.data-table-skeleton.ui-data-table-skeleton :refer [ui-data-table-skeleton]]
[ch.lyrion.carbon.data-table.ui-data-table :refer [ui-data-table]]
[ch.lyrion.carbon.data-table.ui-table :refer [ui-table]]
[ch.lyrion.carbon.data-table.ui-table-container :refer [ui-table-container]]
[ch.lyrion.carbon.data-table.ui-table-head :refer [ui-table-head]]
[ch.lyrion.carbon.data-table.ui-table-header :refer [ui-table-header]]
[ch.lyrion.carbon.data-table.ui-table-body :refer [ui-table-body]]
[ch.lyrion.carbon.data-table.ui-table-row :refer [ui-table-row]]
[ch.lyrion.carbon.data-table.ui-table-cell :refer [ui-table-cell]]
[ch.lyrion.carbon.data-table.ui-table-toolbar :refer [ui-table-toolbar]]
[ch.lyrion.carbon.data-table.ui-table-toolbar-action :refer [ui-table-toolbar-action]]
[ch.lyrion.carbon.data-table.ui-table-toolbar-content :refer [ui-table-toolbar-content]]
[ch.lyrion.carbon.link.ui-link :refer [ui-link]]
[ch.lyrion.carbon.overflow-menu.ui-overflow-menu :refer [ui-overflow-menu]]
[ch.lyrion.carbon.overflow-menu-item.ui-overflow-menu-item :refer [ui-overflow-menu-item]]]
:clj
[[com.fulcrologic.fulcro.dom-server :as dom :refer [div]]])
[com.fulcrologic.fulcro.data-fetch :as df]
[com.fulcrologic.rad.rendering.semantic-ui.form :as sui-form]
[taoensso.timbre :as log]
[com.fulcrologic.rad.options-util :refer [?!]]
[com.fulcrologic.rad.form :as form]
[com.fulcrologic.fulcro.dom.events :as evt]))
(defn row-action-buttons [report-instance row-props]
(let [{::report/keys [row-actions]} (comp/component-options report-instance)]
(when (seq row-actions)
#?(:cljs
(ui-overflow-menu
{}
(map-indexed
(fn [idx {:keys [label reload? visible? disabled? action]}]
(when (or (nil? visible?) (?! visible? report-instance row-props))
(ui-overflow-menu-item
{:key idx
:disabled (boolean (?! disabled? report-instance row-props))
:itemText (?! label report-instance row-props)
:onClick (fn [evt]
(evt/stop-propagation! evt)
(when action
(action report-instance row-props)
(when reload?
(control/run! report-instance))))})))
row-actions))))))
(comp/defsc TableRowLayout [_ {:keys [report-instance props] :as rp}]
{}
#?(:cljs
(let [{::report/keys [columns link links]} (comp/component-options report-instance)
links (or links link)
action-buttons (row-action-buttons report-instance props)
{:keys [highlighted?]
::report/keys [idx]} (comp/get-computed props)]
(ui-table-row
{:isSelected highlighted?
:onClick (fn [evt]
(evt/stop-propagation! evt)
(report/select-row! report-instance idx))}
(let [trow (mapv
(fn [{::attr/keys [qualified-key] :as column}]
(let [column-classes (report/column-classes report-instance column)
{:keys [edit-form entity-id]} (report/form-link report-instance props qualified-key)
link-fn (get links qualified-key)
label (report/formatted-column-value report-instance props column)]
(ui-table-cell
{:key (str "col-" qualified-key)
:classes [column-classes]}
(cond
edit-form (ui-link {:href "#"
:onClick (fn [evt]
(evt/stop-propagation! evt)
(form/edit! report-instance edit-form entity-id))}
label)
(fn? link-fn) (ui-link {:href "#"
:onClick (fn [evt]
(evt/stop-propagation! evt)
(link-fn report-instance props))}
label)
:else label))))
columns)]
(if action-buttons
(conj trow
(ui-table-cell {:key "menu"
:width "5em"
:className "bx--table-column-menu"}
action-buttons))
trow))))))
(let [ui-table-row-layout (comp/factory TableRowLayout)]
(defn render-table-row [report-instance row-class row-props]
(ui-table-row-layout {:report-instance report-instance
:row-class row-class
:props row-props})))
(comp/defsc ListRowLayout [this {:keys [report-instance props]}]
{}
(let [{::report/keys [columns]} (comp/component-options report-instance)]
(let [header-column (first columns)
description-column (second columns)
{:keys [edit-form entity-id]} (some->> header-column (::attr/qualified-key) (report/form-link report-instance props))
header-label (some->> header-column (report/formatted-column-value report-instance props))
description-label (some->> description-column (report/formatted-column-value report-instance props))
action-buttons (row-action-buttons report-instance props)]
(div :.item
(div :.content
(when action-buttons
(div :.right.floated.content
action-buttons))
(when header-label
(if edit-form
(dom/a :.header {:onClick (fn [evt]
(evt/stop-propagation! evt)
(form/edit! report-instance edit-form entity-id))} header-label)
(div :.header header-label)))
(when description-label
(div :.description description-label)))))))
(let [ui-list-row-layout (comp/factory ListRowLayout {:keyfn ::report/idx})]
(defn render-list-row [report-instance row-class row-props]
(ui-list-row-layout {:report-instance report-instance
:row-class row-class
:props row-props})))
(comp/defsc StandardReportControls [this {:keys [report-instance] :as env}]
{:shouldComponentUpdate (fn [_ _ _] true)}
#?(:cljs
(let [controls (control/component-controls report-instance)
{:keys [::report/paginate?]} (comp/component-options report-instance)
{:keys [input-layout action-layout]} (control/standard-control-layout report-instance)
{:com.fulcrologic.rad.container/keys [controlled?]} (comp/get-computed report-instance)]
(comp/fragment
(ui-table-toolbar
{}
(flatten [(map-indexed
(fn [idx row]
(div {:key idx :className (sui-form/n-fields-string (count row))}
(keep #(let [control (get controls %)]
(when (or (not controlled?) (:local? control))
(ui-table-toolbar-content {:key (str (hash %))} (control/render-control report-instance % control))))
row)))
input-layout)
(ui-table-toolbar-content
{:key (str (hash env) "-toolbar-content")}
(dom/div :.bx--btn-set
(keep (fn [k]
(let [control (get controls k)]
(when (or (not controlled?) (:local? control))
(control/render-control report-instance k control))))
action-layout)))]))))))
(let [ui-standard-report-controls (comp/factory StandardReportControls)]
(defn render-standard-controls [report-instance]
(ui-standard-report-controls {:report-instance report-instance})))
(comp/defsc ListReportLayout [this {:keys [report-instance] :as env}]
{:shouldComponentUpdate (fn [_ _ _] true)
:initLocalState (fn [_] {:row-factory (memoize
(fn [cls]
(comp/computed-factory cls
{:keyfn (fn [props] (some-> props (comp/get-computed ::report/idx)))})))})}
(let [{::report/keys [BodyItem]} (comp/component-options report-instance)
render-row ((comp/get-state this :row-factory) BodyItem)
render-controls (report/control-renderer this)
rows (report/current-rows report-instance)
loading? (report/loading? report-instance)]
(div
(when render-controls
(render-controls report-instance))
(div :.ui.attached.segment
(div :.ui.loader {:classes [(when loading? "active")]})
(when (seq rows)
(div :.ui.relaxed.divided.list
(map-indexed (fn [idx row] (render-row row {:report-instance report-instance
:row-class BodyItem
::report/idx idx})) rows)))))))
(let [ui-list-report-layout (comp/factory ListReportLayout {:keyfn ::report/idx})]
(defn render-list-report-layout [report-instance]
(ui-list-report-layout {:report-instance report-instance})))
(defn get-id-key [mapkeys wanted]
;;(first)
(first
(filter #(= (name wanted) (name %))
mapkeys)))
(defn render-standard-table [this {:keys [report-instance]}]
(let [{report-column-headings ::report/column-headings
::report/keys [columns row-actions BodyItem compare-rows table-class]} (comp/component-options report-instance)
render-row ((comp/get-state this :row-factory) BodyItem)
column-headings (mapv (fn [{::report/keys [column-heading]
::attr/keys [qualified-key] :as attr}]
{:column attr
:label (or
(?! (get report-column-headings qualified-key) report-instance)
(?! column-heading report-instance)
(some-> qualified-key name str/capitalize)
"")})
columns)
clj-rows (report/current-rows report-instance)
id-key (get-id-key (keys (first clj-rows)) :id)
props (comp/props report-instance)
sort-params (-> props :ui/parameters ::report/sort)
sortable? (if-not (boolean compare-rows)
(constantly false)
(if-let [sortable-columns (some-> sort-params :sortable-columns set)]
(fn [{::attr/keys [qualified-key]}] (contains? sortable-columns qualified-key))
(constantly true)))
ascending? (and sortable? (:ascending? sort-params))
sorting-by (and sortable? (:sort-by sort-params))
has-row-actions? (seq row-actions)]
#?(:cljs
(ui-table
{:className table-class}
(ui-table-head
{}
(ui-table-row
{}
(let [trow
(into []
(map-indexed (fn [idx {:keys [label column]}]
(let [sorting (atom (if (= sorting-by (::attr/qualified-key column))
(if ascending? "ASC" "DESC")
"NONE"))]
(ui-table-header {:key idx
:sortDirection @sorting #_(when (= sorting-by (::attr/qualified-key column))
(if ascending? "ASC" "DESC"))
:isSortHeader (not= "NONE" @sorting)
:isSortable (sortable? column)
:onClick (fn [evt]
(js/console.log (::attr/qualified-key column))
(js/console.log "Ascending?" ascending?)
(evt/stop-propagation! evt)
(report/sort-rows! report-instance column)
(reset! sorting (if ascending? "ASC" "DESC")))}
label)))
column-headings))]
(if has-row-actions?
(conj trow (ui-table-header {:key "menu"}))
trow))))
(when (seq clj-rows)
(ui-table-body
{} (map-indexed
(fn [idx row]
(let [highlighted-row-idx (report/currently-selected-row report-instance)]
(render-row row {:report-instance report-instance
:row-class BodyItem
:highlighted? (= idx highlighted-row-idx)
::report/idx idx})))
clj-rows)))))))
(defn render-rotated-table [_ {:keys [report-instance] :as env}]
(let [{report-column-headings ::report/column-headings
::report/keys [columns row-actions compare-rows table-class]} (comp/component-options report-instance)
props (comp/props report-instance)
sort-params (-> props :ui/parameters ::report/sort)
sortable? (if-not (boolean compare-rows)
(constantly false)
(if-let [sortable-columns (some-> sort-params :sortable-columns set)]
(fn [{::attr/keys [qualified-key]}] (contains? sortable-columns qualified-key))
(constantly true)))
ascending? (and sortable? (:ascending? sort-params))
sorting-by (and sortable? (:sort-by sort-params))
row-headings (mapv (fn [{::report/keys [column-heading]
::attr/keys [qualified-key] :as attr}]
(let [label (or
(?! (get report-column-headings qualified-key) report-instance)
(?! column-heading report-instance)
(some-> qualified-key name str/capitalize)
"")]
(if (sortable? attr)
(dom/a {:onClick (fn [evt]
(evt/stop-propagation! evt)
(report/sort-rows! report-instance attr))}
label
(when (= sorting-by (::attr/qualified-key attr))
(if ascending?
(dom/i :.angle.down.icon)
(dom/i :.angle.up.icon))))
label)))
columns)
rows (report/current-rows report-instance)
has-row-actions? (seq row-actions)]
(dom/table :.ui.compact.collapsing.definition.selectable.table {:classes [table-class]}
(when (seq rows)
(comp/fragment
(dom/thead
(let [col (first columns)]
(dom/tr {:key "hrow"}
(dom/th
(get row-headings 0))
(map-indexed
(fn [idx row]
(dom/th {:key idx}
(report/formatted-column-value report-instance row col))) rows)
(when has-row-actions?
(dom/td {:key "actions"}
(row-action-buttons report-instance col))))))
(dom/tbody
(map-indexed
(fn [idx col]
(dom/tr {:key idx}
(dom/td (get row-headings (inc idx)))
(map-indexed
(fn [idx row]
(dom/td {:key idx :className "right aligned"}
(report/formatted-column-value report-instance row col))) rows)
(when has-row-actions?
(dom/td {:key "actions"}
(row-action-buttons report-instance col)))))
(rest columns))))))))
(comp/defsc TableReportLayout [this {:keys [report-instance] :as env}]
{:initLocalState (fn [this] {:row-factory (memoize (fn [cls] (comp/computed-factory cls
{:keyfn (fn [props]
(some-> props (comp/get-computed ::report/idx)))})))})
:shouldComponentUpdate (fn [_ _ _] true)}
#?(:cljs
(let [{::report/keys [rotate?]} (comp/component-options report-instance)
rotate? (?! rotate? report-instance)
render-controls (report/control-renderer report-instance)
loading? (report/loading? report-instance)
controlled? (comp/get-computed report-instance :com.fulcrologic.rad.container/controlled?)
props (comp/props report-instance)
busy? (:ui/busy? props)]
(div
(ui-data-table-skeleton
{:style {:width "100%"
:position "absolute"
:opacity (if (or busy? loading?) 1.0 0.0)
:top 0
:left 0}})
(ui-table-container
{:key (str (hash report-instance))
:className (if (or busy? loading?) "bx--skeleton")
:style {:width "100%"
:position "absolute"
:top 0
:left 0
:zIndex 10}
:title (or (some-> report-instance comp/component-options ::report/title (?! report-instance)) "Report")}
(when render-controls
(render-controls report-instance))
(if rotate?
(render-rotated-table this env)
(render-standard-table this env)))))))
(let [ui-table-report-layout (comp/factory TableReportLayout {:keyfn ::report/idx})]
(defn render-table-report-layout [this]
(ui-table-report-layout {:report-instance this})))

78
src/main/com/fulcrologic/rad/rendering/semantic_ui/semantic_ui_controls.cljc Normal file
View File

@ -0,0 +1,78 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.semantic-ui-controls
"This ns requires all semantic UI renderers for form controls and includes a map that can be installed to
set SUI as the default control set."
(:require
[com.fulcrologic.rad.rendering.semantic-ui.form :as sui-form]
[com.fulcrologic.rad.rendering.semantic-ui.container :as sui-container]
[com.fulcrologic.rad.rendering.semantic-ui.entity-picker :as entity-picker]
[com.fulcrologic.rad.rendering.semantic-ui.report :as sui-report]
[com.fulcrologic.rad.rendering.semantic-ui.boolean-field :as boolean-field]
[com.fulcrologic.rad.rendering.semantic-ui.decimal-field :as decimal-field]
[com.fulcrologic.rad.rendering.semantic-ui.int-field :as int-field]
[com.fulcrologic.rad.rendering.semantic-ui.controls.boolean-control :as boolean-input]
[com.fulcrologic.rad.rendering.semantic-ui.controls.action-button :as action-button]
[com.fulcrologic.rad.rendering.semantic-ui.controls.text-input :as text-input]
[com.fulcrologic.rad.rendering.semantic-ui.controls.instant-inputs :as instant-input]
[com.fulcrologic.rad.rendering.semantic-ui.controls.pickers :as picker-controls]
[com.fulcrologic.rad.rendering.semantic-ui.instant-field :as instant]
[com.fulcrologic.rad.rendering.semantic-ui.enumerated-field :as enumerated-field]
[com.fulcrologic.rad.rendering.semantic-ui.blob-field :as blob-field]
[com.fulcrologic.rad.rendering.semantic-ui.autocomplete :as autocomplete]
[com.fulcrologic.rad.rendering.semantic-ui.text-field :as text-field]))
(def all-controls
{;; Form-related UI
;; completely configurable map...element types are malleable as are the styles. Plugins will need to doc where
;; they vary from the "standard" set.
:com.fulcrologic.rad.form/element->style->layout
{:form-container {:default sui-form/standard-form-container
:file-as-icon sui-form/file-icon-renderer}
:form-body-container {:default sui-form/standard-form-layout-renderer}
:ref-container {:default sui-form/standard-ref-container
:file sui-form/file-ref-container}}
:com.fulcrologic.rad.form/type->style->control
{:text {:default text-field/render-field}
:enum {:default enumerated-field/render-field
:autocomplete autocomplete/render-autocomplete-field}
:string {:default text-field/render-field
:autocomplete autocomplete/render-autocomplete-field
:viewable-password text-field/render-viewable-password
:password text-field/render-password
:sorted-set text-field/render-dropdown
:com.fulcrologic.rad.blob/file-upload blob-field/render-file-upload}
:int {:default int-field/render-field}
:long {:default int-field/render-field}
:decimal {:default decimal-field/render-field}
:boolean {:default boolean-field/render-field}
:instant {:default instant/render-field
:date-at-noon instant/render-date-at-noon-field}
:ref {:pick-one entity-picker/to-one-picker
:pick-many entity-picker/to-many-picker}}
;; Report-related controls
:com.fulcrologic.rad.report/style->layout
{:default sui-report/render-table-report-layout
:list sui-report/render-list-report-layout}
:com.fulcrologic.rad.report/control-style->control
{:default sui-report/render-standard-controls}
:com.fulcrologic.rad.report/row-style->row-layout
{:default sui-report/render-table-row
:list sui-report/render-list-row}
:com.fulcrologic.rad.container/style->layout
{:default sui-container/render-container-layout}
:com.fulcrologic.rad.control/type->style->control
{:boolean {:toggle boolean-input/render-control
:default boolean-input/render-control}
:string {:default text-input/render-control
:search text-input/render-control}
:instant {:default instant-input/date-time-control
:starting-date instant-input/midnight-on-date-control
:ending-date instant-input/midnight-next-date-control
:date-at-noon instant-input/date-at-noon-control}
:picker {:default picker-controls/render-control}
:button {:default action-button/render-control}}})

67
src/main/com/fulcrologic/rad/rendering/semantic_ui/text_field.cljc Normal file
View File

@ -0,0 +1,67 @@
(ns com.fulcrologic.rad.rendering.semantic-ui.text-field
(:require
[com.fulcrologic.fulcro.components :as comp :refer [defsc]]
#?(:cljs [com.fulcrologic.fulcro.dom :refer [div label input]]
:clj [com.fulcrologic.fulcro.dom-server :refer [div label input]])
[com.fulcrologic.fulcro.dom.events :as evt]
[com.fulcrologic.rad.form :as form]
[com.fulcrologic.rad.attributes :as attr]
[com.fulcrologic.rad.ui-validation :as validation]
[com.fulcrologic.rad.rendering.semantic-ui.components :refer [ui-wrapped-dropdown]]
[com.fulcrologic.rad.rendering.semantic-ui.field :refer [render-field-factory]]))
(defn- with-handlers [type {:keys [value onChange onBlur] :as props}]
(assoc props
:value (or value "")
:type type
:onBlur (fn [evt]
(when onBlur
(onBlur (evt/target-value evt))))
:onChange (fn [evt]
(when onChange
(onChange (evt/target-value evt))))))
(defn- text-input [props] (input (with-handlers "text" props)))
(defn- password-input [{:keys [value onChange onBlur] :as props}] (input (with-handlers "password" props)))
(defsc ViewablePasswordField [this {:keys [value onChange onBlur] :as props}]
{:initLocalState (fn [_] {:hidden? true})}
(let [hidden? (comp/get-state this :hidden?)]
(input (assoc props
:value (if hidden? "*******" (or value ""))
:type "text"
:onBlur (fn [evt]
(comp/set-state! this {:hidden? true})
(when onBlur
(onBlur (evt/target-value evt))))
:onFocus (fn [_] (comp/set-state! this {:hidden? false}))
:onChange (fn [evt]
(when onChange
(onChange (evt/target-value evt))))))))
(def render-field (render-field-factory text-input))
(def render-password (render-field-factory password-input))
(def render-viewable-password (render-field-factory (comp/factory ViewablePasswordField)))
(defn render-dropdown [{::form/keys [form-instance] :as env} attribute]
(let [{k ::attr/qualified-key
::attr/keys [required?]} attribute
values (form/field-style-config env attribute :sorted-set/valid-values)
input-props (form/field-style-config env attribute :input/props)
options (mapv (fn [v] {:text v :value v}) values)
props (comp/props form-instance)
value (and attribute (get props k))
invalid? (not (contains? values value))
validation-message (when invalid? (validation/validation-error-message env attribute))
field-label (form/field-label env attribute)
read-only? (form/read-only? form-instance attribute)]
(div :.ui.field {:key (str k)}
(label field-label (when invalid? (str " (" validation-message ")")))
(ui-wrapped-dropdown
(merge
{:disabled read-only?
:options options
:clearable (not required?)
:value value
:onChange (fn [v] (form/input-changed! env k v))}
input-props)))))