Hoplon example: simple survey using Twitter Bootstrap

index.cljs.clj

(page "index.html"
  (:refer-hoplon :exclude [form])
  (:require
   [clojure.string :as string]
   [tailrecursion.hoplon.reload :refer [reload-all]]))

;; auto-reload the page when you modify this file
(reload-all)

;; UTILITY FUNCTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def indexed (partial map-indexed vector))

;; TWITTER BOOTSTRAP API ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod do! :col [_ elem [size num]]
  (elem :class (string/join "-" ["col" (name size) num])))

(defn load-bootstrap-cdn [version]
  (let [proto  "//"
        domain "netdna.bootstrapcdn.com"
        path   (str "/bootstrap/" version)
        css    (str proto domain path "/css/")
        js     (str proto domain path "/js/")
        link   #(link :rel "stylesheet" :type "text/css" :href (str css %))
        script #(script :type "text/javascript" :src (str js %))]
    [(link "bootstrap.min.css")
     (link "bootstrap-theme.min.css")
     (script "bootstrap.min.js")]))

(defn opts-classes
  [prefix opts]
  (->> opts (map #(str prefix "-" (name %)))))

(defn sr-only       [elem] (elem :class "sr-only"))
(defn icon-bar      [elem] (elem :class "icon-bar"))
(defn navbar-toggle [elem] (elem :class "navbar-toggle"))
(defn navbar-brand  [elem] (elem :class "navbar-brand"))
(defn well          [elem] (elem :class "well"))

(defelem container       [attr kids] ((div :class "container") attr kids))
(defelem navbar-header   [attr kids] ((div :class "navbar-header") attr kids))
(defelem navbar-collapse [attr kids] ((div :class "collapse navbar-collapse") attr kids))
(defelem navbar-nav      [attr kids] ((ul :class "nav navbar-nav") attr (map li kids)))
(defelem form-group      [attr kids] ((div :class "form-group") attr kids))
(defelem control-label   [attr kids] ((label :class "control-label") attr kids))
(defelem btn-group       [attr kids] ((div :class "btn-group") attr kids))

(defelem form
  [{:keys [opts] :as attr} kids]
  (let [classes (->> opts (opts-classes "form") (string/join " "))]
    ((tailrecursion.hoplon/form :class classes :role "form") (dissoc attr :opts) kids)))

(defelem navbar
  [{:keys [opts] :as attr} kids]
  (let [classes (->> opts (opts-classes "navbar") (cons "navbar") (string/join " "))]
    ((div :class classes :role "navigation") (dissoc attr :opts) kids)))

(defelem bootstrap-page
  [{:keys [version title] :as attr} kids]
  (html
    (head
      (load-bootstrap-cdn version)
      (tailrecursion.hoplon/title :text title))
    (body (dissoc attr :version :title) kids)))

;; QUESTION AND ANSWER COMPONENTS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defelem yes-or-no-button
  [{:keys [type index questions] :as attr} kids]
  (let [classes (cell= (let [a (second (safe-nth questions index))]
                         {:btn         true
                          :btn-default (nil? a)
                          :btn-success (and (= type :yes) (true? a))
                          :btn-danger  (and (not= type :yes) (false? a))}))
        onclick #(swap! questions assoc-in [@index 1] (= type :yes))]
    ((a :class classes :click onclick) (dissoc attr :type :index :questions) kids)))

(def yes-button (partial yes-or-no-button :type :yes))
(def no-button  (partial yes-or-no-button :type :no))

(defelem yes-or-no-question
  [{:keys [questions index]} _]
  (form-group
    (control-label :col [:sm 7] (text "~(first (safe-nth questions index))"))
    (div :col [:sm 5]
      (btn-group
        (yes-button :questions questions :index index "Yes")
        (no-button :questions questions :index index "No")))))

(defelem survey
  [{:keys [questions] :as attr} _]
  (form (dissoc attr :questions)
    (loop-tpl :bindings [[index _] (cell= (indexed questions))]
      (yes-or-no-question :questions questions :index index))))

;; QUESTION AND ANSWER DATA API ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defc questions
  "The questions for the survey."
  [["Do you want to go for a walk?"   nil]
   ["Do you like sushi?"              nil]
   ["Are you confused by aeroplanes?" nil]])

(defc= answered
  "The list of answered question/answer pairs."
  (->> questions (remove (comp nil? second))))

;; DEBUG STUFF FOR THE DEMO ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(with-init!
  ;; print the survey results to the JS console
  (cell= (print :the-survey-says questions))
  ;; Just showing off a little :P
  (with-timeout 3000 (swap! questions conj ["Hi! I'm new. Can we be friends?" nil])))

;; PAGE MARKUP STARTS HERE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(bootstrap-page
  :class   "page4"
  :version "3.1.1"
  :title   "survey | testing"
  (navbar :opts [:inverse :fixed-top]
    (container
      (navbar-header
        (navbar-toggle (button :type "button"))
        (span "Toggle Navigation")
        (icon-bar (span))
        (icon-bar (span))
        (icon-bar (span))
        (navbar-brand (a :href "demo2.html" "Question Test")))))
  (navbar-collapse
    (navbar-nav
      (a :href "demo2.html" "Home")))
  (well
    (div
      (p "The questions")
      (survey :opts [:horizontal] :questions questions)
      (p (text "Answered ~(count answered) of ~(count questions) questions")))))