Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
375 lines (347 sloc) 12.2 KB
(ns omelette.route
(:require [clojure.string :as str]
[taoensso.encore :as encore]
[taoensso.sente :as sente]
#+clj [clojure.core.match :refer [match]]
#+clj [com.stuartsierra.component :as component]
#+clj [compojure.core :as compojure]
#+clj [compojure.route]
#+clj [ :as data]
#+clj [omelette.render :as render]
#+cljs [cljs.core.async :as csp]
#+cljs [cljs.core.match]
#+cljs []
#+cljs [om.core :as om :include-macros true])
(:require-macros [cljs.core.async.macros :as csp]
[cljs.core.match.macros :refer [match]])
(:import goog.history.EventType
(defn- encode-search-options
"Takes an options set.
Returns a path-segment string."
(->> [:prefix :infix :postfix]
(map options)
(remove nil?)
(map name)
(str/join "-")))
(defn- decode-search-options
"Takes a path-segment string.
Returns an options set."
(->> (str/split string #"-")
(map keyword)
(def ^:private valid-options-str?
(defn- search-path->state
"Takes query and options path-segments.
Returns corresponding app state."
[query options]
(if (valid-options-str? options)
[ {:query query
:options (decode-search-options options)}]
[ {}]))
(defn path->state
"Converts a path to an app state.
(path->state \"/search/prefix/omelette\")
=> [ {:query \"omelette\" :options #{:prefix}}]"
(let [default-search (search-path->state "omelette" "prefix-infix-postfix")
path-segments (->> (-> path str/lower-case (str/split #"/"))
(remove str/blank?)
[] default-search
["search"] default-search
["search" options query] (search-path->state query options)
["about"] [ {}]
:else [ {}])))
(defn state->path
"Converts an app state to a path.
(state->path [ {:query \"omelette\" :options #{:prefix}}])
=> \"/search/prefix/omelette\""
[[k data]]
(let [page (name k)]
(if (= page "search")
(str "/search/"
(-> data :options encode-search-options)
(:query data))
(str "/" page))))
(defn- search-state->title
"Takes search page data map.
Returns a string describing the search."
[{:keys [query options]}]
(let [opt-pairs {:prefix "start with"
:infix "include"
:postfix "end with"}
[a b c :as opts] (->> (keys opt-pairs)
(map (comp opt-pairs options))
(remove nil?))
opts-str (condp = (count opts)
1 a
2 (encore/format "%s or %s" a b)
3 (encore/format "%s, %s, or %s" a b c))]
(encore/format "words that %s \"%s\""
(defn state->title
"Converts an app state to a title.
(state->title [ {:query \"omelette\" :options #{:prefix}}])
=> \"words that begin with \"omelette\"\""
[[k data]]
(let [page (name k)]
(if (= page "search")
(search-state->title data)
(->> (str/split page #"-")
(map str/capitalize)
(str/join " ")))))
(defn- handler-fn
"Takes a Sente channel socket map.
Returns an event handler function."
[{:keys [send-fn]}]
(fn handler
[{{{uid :uid, :as session} :session, :as ring-req} :ring-req,
[page data :as event] :event,
?reply-fn :?reply-fn}
& [?recv]]
(let [; Sente passes a dummy reply function if one is not provided.
; This usage of Sente is probably unusual since the handler is
; directly invoked below. Check if it's a dummy reply function and,
; if it is, reply by sending the new state back to the client.
reply (if (-> ?reply-fn meta :dummy-reply-fn?)
#(send-fn uid %)
(condp = (name page)
"search" (->> data
((juxt :query :options))
(apply data/search)
(assoc data :results)
(vector page)
"about" (->> (data/about)
(hash-map :markdown)
(vector page)
"not-found" (reply event)
(prn "Unmatched event: " event)))))
(defn- wildcard-ring-route
"Takes an event handler function.
Returns a wildcard Ring route for server-side rendering."
(let [render (render/render-fn)]
{{uid :uid, :as session} :session, uri :uri, :as req}
(let [state (handler {:?reply-fn identity ; `identity` returns the new state.
:event (path->state uri)
:ring-req req})]
(assoc req
; Render HTML with title and state EDN.
:body (render (state->title state) (pr-str state))
; Clients must have a UID in order to receive messages.
:session (assoc session :uid (or uid (java.util.UUID/randomUUID)))
; Use the state to determine the status.
:status (if (-> state first name (= "not-found"))
(defn- ring-routes
"Takes an event handler function and Sente channel socket map.
Returns Ring routes for Sente, static resources, and GET requests."
[handler {:keys [ajax-post-fn ajax-get-or-ws-handshake-fn]}]
(compojure/POST "/chsk" req (ajax-post-fn req)) ; /chsk routes for Sente.
(compojure/GET "/chsk" req (ajax-get-or-ws-handshake-fn req))
(compojure.route/resources "/") ; Serve static resources.
(wildcard-ring-route handler)))
(defrecord Router []
(if (:stop! component)
(let [chsk (sente/make-channel-socket! {})
handler (handler-fn chsk)
routes (ring-routes handler chsk)
stop! (sente/start-chsk-router-loop! handler (:ch-recv chsk))]
(assoc component
:stop! stop!
:ring-routes routes))))
(when-let [stop! (:stop! component)]
(dissoc component :stop! :ring-routes)))
(defn router
"Creates a router component.
Key :ring-routes should be used by an http-kit server."
(map->Router {}))
(defn- start-history!
"Takes an Om component.
Initializes an Html5History object and adds it to the component local state."
(let [history (doto (Html5History.)
(.setUseFragment false)
(.setPathPrefix "")
(.setEnabled true))]
; Listen for navigation events that originate from the browser
; and update the app state based on the new path.
(fn [event]
(when (.-isNavigation event)
(csp/put! (om/get-shared owner :nav-tokens) (.-token event)))))
; Add history to local state.
(om/set-state! owner :history history)))
(defn- stop-history!
"Takes an Om component with a history object.
Disables the history object."
(let [history (om/get-state owner :history)]
; Remove listeners from history object.
( history)
; Disable history object.
(.setEnabled history false)))
(defn- start-nav-loop!
"Takes a cursor and an Om component.
Listens to shared :nav-tokens channel and updates cursor."
[data owner]
; Update app state with state derived from navigation tokens.
(->> (om/get-shared owner :nav-tokens)
(csp/map< path->state )
(csp/reduce #(om/update! data [] %2 :nav) nil)))
(defn- handler-fn
"Takes a cursor.
Returns an event handler function that will update the cursor."
(fn handler [event _]
[:chsk/state {:first-open? true}] (println "Channel socket successfully established!")
[:chsk/state chsk-state] (println "Chsk state change: " chsk-state)
; Events sent from the server have an ID of `:chsk/recv`.
; Update app state with the new state.
; This is a potential bug since events are not guaranteed to be sequential.
[:chsk/recv state] (when (= (first state)
(first @data))
(om/update! data state))
:else (prn "Unmatched event: " event))))
(defn- start-router-loop!
"Takes a cursor, an Om component, and a Sente channel socket map.
Starts the channel socket router loop and adds `:stop!`,
a function to stop the loop, to the component local state."
[data owner {:keys [ch-recv]}]
(->> ch-recv
(sente/start-chsk-router-loop! (handler-fn data))
(om/set-state! owner :stop!)))
(defn- stop-router-loop!
"Takes an Om component with a running router loop.
Stops the router loop."
((om/get-state owner :stop!)))
(defn- update-history!
"Takes an Om component with an Html5History object and a transaction.
Updates history with the new state."
[owner {:keys [new-state old-state]}]
(let [history (om/get-state owner :history)
new-path (state->path new-state)]
(if-not (= (first old-state)
(first new-state))
(.setToken history new-path) ; Set when page changes;
(.replaceToken history new-path)))) ; replace otherwise.
(defn- update-title!
"Takes a transaction.
Updates `document` title with new state."
[{:keys [new-state]}]
(set! js/document.title
(-> new-state state->title (str " | Omelette"))))
(defn- send-state!
"Takes a timeout ID, a Sente channel socket map, and a transaction.
Cancels the timeout and schedules a new app state request.
Returns a new timeout ID."
[timeout {:keys [send-fn]} {:keys [new-state]}]
(js/clearTimeout timeout)
(js/setTimeout #(send-fn new-state) 250))
(defn- start-tx-loop!
"Takes a cursor, Om component, and a Sente channel socket map.
Starts a loop that uses transactions tagged `:nav` to:
* update `document.title`
* update `window.history`
* schedule a request for a new app state"
[data owner chsk]
(let [txs (csp/sub (om/get-shared owner :transactions-pub) :nav (csp/chan))]
[timeout nil
tx (csp/<! txs)]
(csp/go (update-title! tx)
(update-history! owner tx))
(recur (send-state! timeout chsk tx)
(csp/<! txs)))))
(defn- start-router!
"Takes a cursor and an Om component.
Uses cursor and component to start router.
Requires global `window` and `document` objects
so should not be called when running in Nashorn."
[data owner]
(start-history! owner)
(start-nav-loop! data owner)
(let [chsk (sente/make-channel-socket! "/chsk" {})]
(start-router-loop! data owner chsk)
(start-tx-loop! data owner chsk)))
(defn- stop-router!
"Takes an Om component with an enabled history object and running router loop.
Disables the history object and stops the router loop."
(stop-history! owner)
(stop-router-loop! owner))
(defn- build-page
"Takes a cursor and opts with a `:page-views` key.
Builds the page view associated with the active page."
[[page data] {views :page-views}]
(om/build (-> page name views) data))
(defn router
"Creates a router component.
:page-views key in opts should be a map of page name to page views:
{:page-views {\"about\" about-view
\"not-found\" not-found-view}}
Shared :nav-tokens should be a channel onto which other components should put relative paths when links are clicked.
Shared :transactions-pub should be publication of transactions with :tag as the topic-fn."
[data owner opts]
(render [_] (build-page data opts))
(did-mount [_] (start-router! data owner))
(will-unmount [_] (stop-router! owner))))