base.cljs

(ns ucv.mobile-apps.base
  (:refer-clojure :exclude [list])
  (:require
    [clojure.spec.alpha :as s]
    ["native-base" :as nb :refer [Container Header Footer FooterTab Item Input Icon Button Content
                                  List ListItem CheckBox Left Body Right Label Card CardItem Segment
                                  H1 H2 H3 Form Spinner Separator Picker Text Title Subtitle TextArea]]
    ["react-native-modal-datetime-picker" :default DateTimePicker]
    ["react-native" :as rn]
    [clojure.string :as str]
    [com.fulcrologic.fulcro.components :as comp]
    [goog.object :as gobj]
    [taoensso.timbre :as log]
    [com.fulcrologic.fulcro.algorithms.do-not-use :as futil]
    [com.fulcrologic.fulcro-native.alpha.components :as c]))

(def ios? (= "ios" rn/Platform.OS))

(defn- remove-separators [s]
  (when s
    (str/replace s #"^[.#]" "")))

(defn- get-tokens [k]
  (re-seq #"[#.]?[^#.]+" (name k)))

(defn- parse
  "Parse CSS shorthand keyword and return vector of prop strings.

  (parse :.klass3.klass1.klass2)
  => [\"klass1\"
      \"klass2\"
      \"klass3\"]"
  [k]
  (if k
    (let [tokens  (get-tokens k)
          classes (->> tokens (clojure.core/filter #(re-matches #"^\..*" %)))]
      (when-not (re-matches #"^(\.[^.#]+|#[^.#]+)+$" (name k))
        (throw (ex-info "Invalid style keyword. It contains something other than classnames and IDs." {:item k})))
      (keep remove-separators classes))
    []))

(defn add-kwprops-to-props
  [props kw]
  (let [kw-strings (parse kw)]
    (let [props (reduce #(assoc %1 %2 true)
                  props
                  kw-strings)]
      (clj->js props))))

(declare container header item input icon button content
  list list-item checkbox left body right label card card-item
  form spinner separator picker text textarea title subtitle
  date-time-picker)

(defn text
  ([str] (text nil str))
  ([props str]
   (c/create-element Text (clj->js props) str)))

(defn b
  "Emits a Text element with font weight set to bold."
  [txt]
  (text {:style {:fontWeight "bold"}} txt))

(defn title
  ([str] (title nil str))
  ([props str]
   (c/create-element Title (clj->js props) str)))

(defn subtitle
  ([str] (subtitle nil str))
  ([props str]
   (c/create-element Subtitle (clj->js props) str)))

(defn react-factory [js-class]
  (c/react-factory js-class
    {:ui-text (fn [child]
                (text nil child))}))

(def ^{:private true} element-marker
  (-> (js/React.createElement Text nil)
    (gobj/get "$$typeof")))

(defn element? "Returns true if the given arg is a react element."
  [x]
  (and (object? x) (= element-marker (gobj/get x "$$typeof"))))

(s/def ::base-element-args
  (s/cat
    :css (s/? keyword?)
    :attrs (s/? (s/or
                  :nil nil?
                  :map #(and (map? %) (not (element? %)))
                  :js-object #(and (object? %) (not (element? %)))))
    :children (s/* (s/or
                     :string string?
                     :number number?
                     :collection #(or (vector? %) (seq? %) (array? %))
                     :nil nil?
                     :element element?))))

;; react v16 is really picky, the old direct .children prop trick no longer works
(defn macro-create-element*
  "Used internally by the DOM element generation."
  [arr]
  {:pre [(array? arr)]}
  (.apply js/React.createElement nil arr))

(defonce form-elements? #{"input" "select" "option" "textarea"})

(defn is-form-element? [element]
  (let [tag (.-tagName element)]
    (and tag (form-elements? (str/lower-case tag)))))

(defn- arr-append* [arr x]
  (.push arr x)
  arr)

(defn- arr-append [arr tail]
  (if (and (= 1 (count tail)) (string? (first tail)))
    (arr-append* arr (text (first tail)))
    (reduce arr-append* arr tail)))

(defn create-element-impl
  "Runtime interpretation of props. Used internally by element generation when the macro cannot expand the element at compile time."
  ([type args] (create-element-impl type args nil))
  ([type args csskw]
   (let [[head & tail] (mapv comp/force-children args)
         f macro-create-element*]
     (cond
       (nil? head)
       (f (doto #js [type (add-kwprops-to-props {} csskw)]
            (arr-append tail)))

       (element? head)
       (f (doto #js [type (add-kwprops-to-props {} csskw)]
            (arr-append args)))

       (object? head)
       (f (doto #js [type (add-kwprops-to-props (js->clj head) csskw)]
            (arr-append tail)))

       (map? head)
       (f (doto #js [type (add-kwprops-to-props head csskw)]
            (arr-append tail)))

       :else
       (f (doto #js [type (add-kwprops-to-props {} csskw)]
            (arr-append args)))))))

(defn factory
  ([class default-attrs]
   (fn [& args]
     (let [conformed-args (futil/conform! ::base-element-args args)
           {attrs    :attrs
            children :children
            css      :css} conformed-args
           children       (mapv second children)
           attrs-value    (merge default-attrs (or (second attrs) {}))]
       (create-element-impl class (into [attrs-value] children) css))))
  ([class]
   (fn [& args]
     (let [conformed-args (futil/conform! ::base-element-args args)
           {attrs    :attrs
            children :children
            css      :css} conformed-args
           children       (mapv second children)
           attrs-value    (or (second attrs) {})]
       (create-element-impl class (into [attrs-value] children) css)))))

(def body (factory Body))
(def button (factory Button))
(def card (factory Card))
(def card-item (factory CardItem))
(def checkbox (factory CheckBox))
(def container (factory Container))
(def content (factory Content))
(def footer (factory Footer))
(def footer-tab (factory FooterTab))
(def form (factory Form))
(def header (factory Header))
(def icon (factory Icon))
(def input (c/wrap-text-input (factory Input)))
(def item (factory Item))
(def label (factory Label))
(def left (factory Left))
(def list
  ":dataArray - Array of things to render
   :renderRow - (fn [element] )
   :keyExtractor (fn [element] string)"
  (factory List))
(def list-item
  ":button - boolean (false). To navigate on click of a list item.
   :selected - boolean (true). Highlight the selected item.
   :noIndent - boolean (true). Remove margin from left.
   :itemDivider - boolean (false). Show divider.
   :icon - boolean. Format to allow for icon on left.
   :avatar - boolean. Format for an avatar on the item.
   :thumbnail - boolean. Format for an image on the item.
   "
  (factory ListItem))
(def picker (factory Picker))
(def picker-item (factory (.-Item Picker)))
(def right (factory Right))
(def separator (factory Separator))
(def spinner (factory Spinner))
(def segment (factory Segment))

;;; These should not have strings wrapped by base/text
(defn h1
  ([str] (h1 nil str))
  ([props str]
   (c/create-element H1 (clj->js props) str)))
(defn h2
  ([str] (h2 nil str))
  ([props str]
   (c/create-element H2 (clj->js props) str)))
(defn h3
  ([str] (h3 nil str))
  ([props str]
   (c/create-element H3 (clj->js props) str)))

(defn heading
  "A header with the specified string as the single body element"
  [title]
  (header {} (body {} title)))

(defn warning-message
  "Creates a red message as the body of a Card."
  [txt]
  (card {}
    (card-item {}
      (body {}
        (text {:style {:color    "red"
                       :fontSize 20}} txt)))))

(defn confirm!
  "Pop a confirm dialog.

  onCancel - optional fn to call on cancel
  onOK - fn to call on OK"
  [{:keys [onCancel onOK title message]}]
  (let [buttons (clj->js
                  [(cond-> {:text "Cancel"}
                     onCancel (assoc :onPress onCancel))
                   (cond-> {:text "OK"}
                     onOK (assoc :onPress onOK))])]
    (rn/Alert.alert (or title "Confirm") (or message "") buttons)))

(defn back-button
  "Renders a back button."
  [props]
  (button (merge {:transparent true} props)
    (icon {:name "arrow-back"})))

(defn add-button
  "Renders an add button."
  [props]
  (button (merge {:transparent true} props)
    (icon {:name "add"})))

(def datetime-picker
  "Create a datetime picker.

  :isVisible - Show the picker
  :onConfirm - (fn [inst])
  :onCancel - (fn [inst])
  "
  (factory DateTimePicker {:timePickerModeAndroid "spinner"
                           :is24Hour              false}))

(def theme
  {:brandPrimary     (if ios? "#007aff" "#3F51B5")
   :brandInfo        (if ios? "#62B1F6" "#62B1F6")
   :brandSuccess     (if ios? "#5cb85c" "#5cb85c")
   :brandDanger      (if ios? "#d9534f" "#d9534f")
   :brandWarning     (if ios? "#f0ad4e" "#f0ad4e")
   :brandDark        (if ios? "#000" "#000")
   :brandLight       (if ios? "#f4f4f4" "#f4f4f4")
   :inverseTextColor "#fff"
   :fontFamily       (if ios? "System" "Roboto_medium")})

(defn message [& args]
  (let [{attrs    :attrs
         children :children
         css      :css} (futil/conform! ::base-element-args args)
        attrs (some-> attrs second)
        msg   (some-> children first second)]
    (card attrs
      (card-item {:style {:backgroundColor (theme (case css
                                                    :.danger :brandDanger
                                                    :.info :brandInfo
                                                    :.success :brandSuccess
                                                    :.warning :brandWarning
                                                    :brandPrimary))}}
        (text {:style {:color      (theme :inverseTextColor)
                       :fontFamily (theme :fontFamily)}}
          msg)))))