routing.clj

(ns routing
  (:require [goog.History :as h]
            [om.next :as om]
            [taoensso.timbre :as log]
            [fulcro.client.mutations :as m]
            [goog.events :as e]
            [fulcro.client.core :refer [FulcroApplication]]
            [clojure.string :as s])
  (:import [goog History]))

;;=================
;; Routing protocol
;;=================

(defprotocol Routing
  (-state->url [this props] "Given props, return a valid URL for use with url->state")
  (-url->state [this split-url] "Given a url split at /, return props for use with state->url"))

(defn state->url [this props]
  (-state->url this props))

(defn url->state [this split-url]
  (-url->state this split-url))

(defn children-state->url
  "Takes a parent component's props and a list of [key component]
  pairs. Calls `state->url` on each child component implementing `Routing`
  to derive a URL from props. Asserts that there are no discrepancies between
  child component routes."
  [props pairs]
  (let [routes (into #{}
                     (comp
                      (filter (fn [[k c]]
                                (satisfies? Routing c)))
                      (map (fn [[k c]]
                             (state->url c (get props k))))
                      (filter identity))
                     pairs)]
    (assert (or (= (count routes) 1)
                (empty? routes)) (str "Multiple routes found! " routes))
    (first routes)))

(defn serialize-tempid [tid]
  (when (om/tempid? tid)
    (str "tempid-" (.-id tid))))

(defn deserialize-tempid [str]
  (when (s/starts-with? str "tempid-")
    (om/tempid (uuid (last (s/split str #"tempid-"))))))

;;=================
;; Pushstate Router
;;=================

(defprotocol Router
  (set-location! [_ state])
  (replace-location! [_ state]))

(defonce router (atom nil))

(defn setup-history
  [x]
  {:pre [(om/reconciler? x)]}
  (let [history (History.)
        root (om/app-root x)
        state-atom (om/app-state x)]
    (.setEnabled history true)
    (letfn [(set-route! [token]
              (om/transact! x `[(routing/set-route! ~{:token token})]))]

      (e/listen history h/EventType.NAVIGATE (fn [e] (set-route! (.-token e))))
      (let [initial-token
            (let [token (.getToken history)]
              (if-not (s/blank? token)
                token
                (or (state->url root (om/db->tree (om/get-query root)
                                                  @state-atom
                                                  @state-atom)) "/")))]
        (log/info "Initial url: " initial-token)
        (.replaceToken history initial-token)
        (set-route! initial-token)))
    (reset!
     router
     (reify Router
       (set-location! [_ state]
         (let [new-route
               (state->url root
                           (om/db->tree (om/get-query root) state state))]
           (log/info "Setting new route: " new-route)
           (.setToken history new-route)
           new-route))

       (replace-location! [_ state]
         (let [new-route
               (state->url root (om/db->tree (om/get-query root)
                                             state state))]
           (log/info "Replacing new route: " new-route)
           (.replaceToken history new-route)
           new-route))))))

(defmethod m/mutate 'routing/set-route!
  [{:keys [state reconciler ref] :as env} k {:keys [token]}]
  {:action
   (fn []
     (let [root (om/app-root reconciler)
           state-transition (url->state root (s/split token #"/"))
           state-transition-db (om/tree->db root state-transition true)]
       (log/info  "Routing State Transition: " state-transition-db)
       (om/merge! reconciler state-transition (om/get-query root))))})

(defn ensure-url!
  ([state] (ensure-url! state nil))
  ([state action]
   (when-let [router @router]
     (case action
       :replace (replace-location! router @state)
       (set-location! router @state)))))

(defmethod m/mutate 'routing/ensure-url!
  [{:keys [state reconciler ref] :as env} k action]
  {:action
   (fn []
     (ensure-url! state action))})