bacwn.cljs.hl

(page "index.html"
  (:require-macros [fogus.datalog.bacwn.macros :refer (facts <- ?- make-database)])
  (:require [fogus.datalog.bacwn               :as    bacwn]
            [fogus.datalog.bacwn.impl.rules    :refer [rules-set]]
            [fogus.datalog.bacwn.impl.database :refer [add-tuples]]
            [fogus.datalog.bacwn.impl.syntax   :refer [explode]]
            [tailrecursion.hoplon              :refer [do!]]))

;;; Schema & initial data

(def mst3k-schema
  (make-database
   (relation :character [:db.id :name :human?])
   (index :character :name)
   (relation :location [:db.id :character :name])
   (index :location :name)))

(defc db
  (-> mst3k-schema
      (facts {:character/db.id 0 :character/name "Joel" :character/human? true}
             {:character/db.id 1 :character/name "Crow" :character/human? false}
             {:character/db.id 2 :character/name "TV's Frank" :character/human? true}
             {:location/db.id  0 :location/character 0 :location/name "SoL"}
             {:location/db.id  0 :location/character 1 :location/name "SoL"}
             {:location/db.id  1 :location/character 2 :location/name "Gizmonics"})))

(defn add-facts [d & facts]
  (apply add-tuples d (map explode facts)))

(let [counter (atom 10)]
  (defn next-id [] (swap! counter inc)))

(defc rules
  (rules-set
   (<- (:characters :character/name ?char-name :character/db.id ?id)
       (:character :name ?char-name :db.id ?id))
   (<- (:locations :location/name ?loc-name :location/db.id ?id)
       (:location :name ?loc-name :db.id ?id))
   (<- (:stationed-at :location/db.id ?loc-id :character/name ?char-name :character/human? ?human)
       (:location  :db.id ?loc-id :character ?char)
       (:character :db.id ?char :name ?char-name :human? ?human))))

(defn q [database ruleset query & [bindings]]
  (bacwn/run-work-plan (bacwn/build-work-plan ruleset query) database bindings))

;;; Reactive queries

(defc= locations      (q db rules (?- :locations :location/name ?loc-name)))
(defc= location-names (map :location/name locations))
(defc view-location   (first @locations))

(defc= stationed-at
  (q db rules
     (?- :stationed-at :location/db.id '??id :character/name ?char-name)
     {'??id (:location/db.id view-location)}))

;;; Custom elements & HTML extensions

(let [msg (cell nil)]
  (defn flash! [new-msg]
    (reset! msg new-msg)
    (timeout #(reset! msg nil) 1000))
  (defelem flash-message
    [{:keys [toggle-method]
      :or   {toggle-method :do-slide-toggle}}
     [elem]]
    (elem toggle-method msg (text "~{msg}"))))

(defelem choose-location
  [{:keys [to]}]
  (select
   :on-change
   #(reset! to (first (q @db @rules
                         (?- :locations :location/db.id '??id)
                         {'??id (js/parseInt (-> % .-target js/jQuery .val))})))
    (loop-tpl :bindings [{id :location/db.id name :location/name} locations]
      (option :do-attr (cell= {:value id}) (text "~{name}")))))

(defmethod do! :enabled-toggle
  [elem _ v]
  (.prop (js/jQuery elem) "disabled" (not (boolean v))))

(html
 (head
  (title "Hoplon • Reactive Datalog with Bacwn"))
 (body :style "font-family: sans-serif; color: #333;"

  (flash-message (h2 :style "float:right; color:green;"))

  (h1 "Bacwn + Hoplon = ♡")

  (div
   :style "background-color: #eee;
           padding: 10px;
           border-radius: 15px;"
   (p "This proof-of-concept demonstrates the use of " (a :href "http://hoplon.io/" "Hoplon")
    " and " (a :href "https://github.com/tailrecursion/bacwn" "bacwn") " together to create a
   ClojureScript web application.  A small bacwn database of application state is queried
   using Datalog, reactively, to render the page content.")

   (p "Source: " (a :href "https://gist.github.com/alandipert/8732704" "https://gist.github.com/alandipert/8732704"))

   (p :style "font-style:italic;"
      "Note: Once this prototype is cleaned up a bit, you'll be able to find it in the "
      (a :href "https://github.com/tailrecursion/hoplon-demos" "Hoplon Demos Repository.")))

  (h3 "Location")
  (choose-location :to view-location)

  (h3 (text "Characters at ~{(:location/name view-location)}"))
  (ul
   (loop-tpl :bindings [{human? :character/human? name :character/name} stationed-at]
     (li (span (text "~{name}"))
         (span (text "\u00A0(~{(if-not human? \"not \")}human)")))))

  (h3 "Add Character")
  (let [character-location (cell @view-location)
        character-name     (cell "")
        character-human?   (cell false)
        name-taken?        (cell= (seq (q db rules
                                          (?- :characters :character/name '??name)
                                          {'??name character-name})))
        form-complete?     (cell= (and (seq character-name) (not name-taken?)))
        name-id            (str (gensym))]
    (form
     :on-submit #(when @form-complete?
                   (let [character-id (next-id)]
                     (swap! db add-facts
                            {:character/db.id  character-id
                             :character/name   @character-name
                             :character/human? @character-human?}
                            (merge @character-location
                                   {:location/character character-id}))
                     (reset! character-name "")
                     (set! (.-value (by-id name-id)) "")
                     (flash! "Character added.")))
     (fieldset
      (legend "Character details")
      (ol
       (li
        (label :for "location" "Location")
        ((choose-location :to character-location) :name "location"))
       (li
        (input :type "checkbox"
               :name "human"
               :on-change #(swap! character-human? not))
        "Human")
       (li
        (label :for "name" "Name")
        (input :id name-id
               :name "name"
               :on-input #(reset! character-name (val-id name-id))
               :type "text")
        (span :style "color:red;"
              :do-toggle name-taken?
              "Sorry, this name is already taken.")))
      (button :type "submit"
              :do-enabled-toggle form-complete?
              "Add"))))))