Improvements to historoy management.

src/uxbox/data/history.cljs

@@ -0,0 +1,200 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.data.history
+  (:require [cuerdas.core :as str]
+            [promesa.core :as p]
+            [beicon.core :as rx]
+            [lentes.core :as l]
+            [uxbox.rstore :as rs]
+            [uxbox.router :as r]
+            [uxbox.repo :as rp]
+            [uxbox.locales :refer (tr)]
+            [uxbox.schema :as sc]
+            [uxbox.data.pages :as udp]
+            [uxbox.state :as st]
+            [uxbox.state.project :as stpr]
+            [uxbox.ui.messages :as uum]
+            [uxbox.util.datetime :as dt]
+            [uxbox.util.data :refer (without-keys replace-by-id)]))
+
+;; --- Pinned Page History Fetched
+
+(defrecord PinnedPageHistoryFetched [history]
+  rs/UpdateEvent
+  (-apply-update [_ state]
+    (assoc-in state [:workspace :history :pinned-items] history)))
+
+;; --- Fetch Pinned Page History
+
+(defrecord FetchPinnedPageHistory [id]
+  rs/WatchEvent
+  (-apply-watch [_ state s]
+    (letfn [(on-success [{history :payload}]
+              (->PinnedPageHistoryFetched (into [] history)))
+            (on-failure [e]
+              (uum/error (tr "errors.fetch-page-history"))
+              (rx/empty))]
+      (let [params {:page id :pinned true}]
+        (->> (rp/do :fetch/page-history params)
+             (rx/map on-success)
+             (rx/catch on-failure))))))
+
+(defn fetch-pinned-page-history
+  [id]
+  (->FetchPinnedPageHistory id))
+
+;; --- Page History Fetched
+
+(defrecord PageHistoryFetched [history append?]
+  rs/UpdateEvent
+  (-apply-update [_ state]
+    (let [items (into [] history)
+          minv (apply min (map :version history))
+          state (assoc-in state [:workspace :history :min-version] minv)]
+      (if-not append?
+        (assoc-in state [:workspace :history :items] items)
+        (update-in state [:workspace :history :items] #(reduce conj % items))))))
+
+;; --- Fetch Page History
+
+(defrecord FetchPageHistory [id since max]
+  rs/WatchEvent
+  (-apply-watch [this state s]
+    (println "FetchPageHistory" this)
+    (letfn [(on-success [{history :payload}]
+              (let [history (into [] history)]
+                (->PageHistoryFetched history (not (nil? since)))))
+            (on-failure [e]
+              (uum/error (tr "errors.fetch-page-history"))
+              (rx/empty))]
+      (let [params (merge
+                    {:page id :max (or max 15)}
+                    (when since {:since since}))]
+        (->> (rp/do :fetch/page-history params)
+             (rx/map on-success)
+             (rx/catch on-failure))))))
+
+(defn fetch-page-history
+  ([id]
+   (fetch-page-history id nil))
+  ([id params]
+   (map->FetchPageHistory (assoc params :id id))))
+
+;; --- Clean Page History
+
+(defrecord CleanPageHistory []
+  rs/UpdateEvent
+  (-apply-update [_ state]
+    (-> state
+        (assoc-in [:workspace :history :items] nil)
+        (assoc-in [:workspace :history :selected] nil))))
+
+(defn clean-page-history
+  []
+  (CleanPageHistory.))
+
+;; --- Select Page History
+
+(defrecord SelectPageHistory [item]
+  rs/UpdateEvent
+  (-apply-update [_ state]
+    (let [page (get-in state [:pages-by-id (:page item)])
+          page' (assoc page
+                       :history true
+                       :data (:data item))]
+      (-> state
+          (stpr/unpack-page page')
+          (assoc-in [:workspace :history :selected] (:id item))))))
+
+(defn select-page-history
+  [item]
+  (SelectPageHistory. item))
+
+;; --- Apply selected history
+
+(defrecord ApplySelectedHistory [id]
+  rs/UpdateEvent
+  (-apply-update [_ state]
+    (println "ApplySelectedHistory" id)
+    (-> state
+        (update-in [:pages-by-id id] dissoc :history)
+        (assoc-in [:workspace :history :selected] nil)))
+
+  rs/WatchEvent
+  (-apply-watch [_ state s]
+    (rx/of (udp/update-page id))))
+
+(defn apply-selected-history
+  [id]
+  (ApplySelectedHistory. id))
+
+;; --- Discard Selected History
+
+(defrecord DiscardSelectedHistory [id]
+  rs/UpdateEvent
+  (-apply-update [_ state]
+    (let [packed (get-in state [:pagedata-by-id id])]
+      (-> state
+          (stpr/unpack-page packed)
+          (assoc-in [:workspace :history :selected] nil)))))
+
+(defn discard-selected-history
+  [id]
+  (DiscardSelectedHistory. id))
+
+;; --- History Item Updated
+
+(defrecord HistoryItemUpdated [item]
+  rs/UpdateEvent
+  (-apply-update [_ state]
+    (-> state
+        (update-in [:workspace :history :items] replace-by-id item)
+        (update-in [:workspace :history :pinned-items] replace-by-id item))))
+
+(defn history-updated?
+  [item]
+  (instance? HistoryItemUpdated item))
+
+(defn history-updated
+  [item]
+  (HistoryItemUpdated. item))
+
+;; --- Refresh Page History
+
+(defrecord RefreshPageHistory [id]
+  rs/WatchEvent
+  (-apply-watch [_ state s]
+    (let [history (get-in state [:workspace :history])
+          maxitems (count (:items history))]
+      (rx/of (fetch-page-history id {:max maxitems})
+             (fetch-pinned-page-history id)))))
+
+(defn refres-page-history
+  [id]
+  (RefreshPageHistory. id))
+
+;; --- Update History Item
+
+(defrecord UpdateHistoryItem [item]
+  rs/WatchEvent
+  (-apply-watch [_ state s]
+    (letfn [(on-success [{item :payload}]
+              (->HistoryItemUpdated item))
+            (on-failure [e]
+              (uum/error (tr "errors.page-history-update"))
+              (rx/empty))]
+      (rx/merge
+       (->> (rp/do :update/page-history item)
+            (rx/map on-success)
+            (rx/catch on-failure))
+       (->> (rx/filter history-updated? s)
+            (rx/take 1)
+            (rx/map #(refres-page-history (:page item))))))))
+
+(defn update-history-item
+  [item]
+  (UpdateHistoryItem. item))

src/uxbox/data/pages.cljs

@@ -19,7 +19,7 @@
             [uxbox.state.project :as stpr]
             [uxbox.ui.messages :as uum]
             [uxbox.util.datetime :as dt]
-            [uxbox.util.data :refer (without-keys)]))
+            [uxbox.util.data :refer (without-keys replace-by-id)]))
 
 (defprotocol IPageUpdate
   "A marker protocol for mark events that alters the
@@ -206,129 +206,3 @@
 (defn delete-page
   ([id] (DeletePage. id (constantly nil)))
   ([id callback] (DeletePage. id callback)))
-
-;; --- Pinned Page History Fetched
-
-(defrecord PinnedPageHistoryFetched [history]
-  rs/UpdateEvent
-  (-apply-update [_ state]
-    (assoc-in state [:workspace :history :pinned-items] history)))
-
-;; --- Fetch Pinned Page History
-
-(defrecord FetchPinnedPageHistory [id]
-  rs/WatchEvent
-  (-apply-watch [_ state s]
-    (letfn [(on-success [{history :payload}]
-              (->PinnedPageHistoryFetched history))
-            (on-failure [e]
-              (uum/error (tr "errors.fetch-page-history"))
-              (rx/empty))]
-      (let [params {:page id :pinned true}]
-        (->> (rp/do :fetch/page-history params)
-             (rx/map on-success)
-             (rx/catch on-failure))))))
-
-(defn fetch-pinned-page-history
-  [id]
-  (->FetchPinnedPageHistory id))
-
-;; --- Page History Fetched
-
-(defrecord PageHistoryFetched [history append?]
-  rs/UpdateEvent
-  (-apply-update [_ state]
-    (let [items (into [] history)
-          minv (apply min (map :version history))
-          state (assoc-in state [:workspace :history :min-version] minv)]
-      (if-not append?
-        (assoc-in state [:workspace :history :items] items)
-        (update-in state [:workspace :history :items] #(reduce conj % items))))))
-
-;; --- Fetch Page History
-
-(defrecord FetchPageHistory [id since max]
-  rs/WatchEvent
-  (-apply-watch [_ state s]
-    (letfn [(on-success [{history :payload}]
-              (->PageHistoryFetched history (not (nil? since))))
-            (on-failure [e]
-              (uum/error (tr "errors.fetch-page-history"))
-              (rx/empty))]
-      (let [params {:page id  :max (or max 15)}]
-        (->> (rp/do :fetch/page-history params)
-             (rx/map on-success)
-             (rx/catch on-failure))))))
-
-(defn fetch-page-history
-  ([id]
-   (fetch-page-history id nil))
-  ([id params]
-   (map->FetchPageHistory (assoc params :id id))))
-
-;; --- Clean Page History
-
-(defrecord CleanPageHistory []
-  rs/UpdateEvent
-  (-apply-update [_ state]
-    (-> state
-        (assoc-in [:workspace :history :items] nil)
-        (assoc-in [:workspace :history :selected] nil))))
-
-(defn clean-page-history
-  []
-  (CleanPageHistory.))
-
-;; --- Select Page History
-
-(defrecord SelectPageHistory [id history]
-  rs/UpdateEvent
-  (-apply-update [_ state]
-    (if (nil? history)
-      (let [packed (get-in state [:pagedata-by-id id])]
-        (-> state
-            (stpr/unpack-page packed)
-            (assoc-in [:workspace :history :selected] nil)))
-      (let [page (get-in state [:pages-by-id id])
-            page' (assoc page
-                         :history true
-                         :data (:data history))]
-        (-> state
-            (stpr/unpack-page page')
-            (assoc-in [:workspace :history :selected] (:id history)))))))
-
-(defn select-page-history
-  [id history]
-  (SelectPageHistory. id history))
-
-;; --- Apply selected history
-
-(defrecord ApplySelectedHistory [id]
-  rs/UpdateEvent
-  (-apply-update [_ state]
-    (println "ApplySelectedHistory" id)
-    (-> state
-        (update-in [:pages-by-id id] dissoc :history)
-        (assoc-in [:workspace :history :selected] nil)))
-
-  rs/WatchEvent
-  (-apply-watch [_ state s]
-    (rx/of (update-page id))))
-
-(defn apply-selected-history
-  [id]
-  (ApplySelectedHistory. id))
-
-;; --- Discard Selected History
-
-(defrecord DiscardSelectedHistory [id]
-  rs/UpdateEvent
-  (-apply-update [_ state]
-    (let [packed (get-in state [:pagedata-by-id id])]
-      (-> state
-          (stpr/unpack-page packed)
-          (assoc-in [:workspace :history :selected] nil)))))
-
-(defn discard-selected-history
-  [id]
-  (DiscardSelectedHistory. id))

src/uxbox/repo/pages.cljs

@@ -48,6 +48,13 @@
                 :body data}]
     (send! params)))
 
+(defmethod -do :update/page-history
+  [type {:keys [id page] :as data}]
+  (let [params {:url (str url "/pages/" page "/history/" id)
+                :method :put
+                :body data}]
+    (send! params)))
+
 (defmethod -do :update/page-metadata
   [type {:keys [id] :as data}]
   (let [params {:url (str url "/pages/" id "/metadata")

src/uxbox/ui/workspace.cljs

@@ -10,6 +10,7 @@
             [uxbox.data.workspace :as dw]
             [uxbox.data.projects :as dp]
             [uxbox.data.pages :as udp]
+            [uxbox.data.history :as udh]
             [uxbox.util.lens :as ul]
             [uxbox.util.geom.point :as gpt]
             [uxbox.util.data :refer (classnames)]
@@ -35,8 +36,8 @@
     (rs/emit! (dw/initialize projectid pageid)
               (dp/fetch-projects)
               (udp/fetch-pages projectid)
-              (udp/fetch-page-history pageid)
-              (udp/fetch-pinned-page-history pageid))
+              (udh/fetch-page-history pageid)
+              (udh/fetch-pinned-page-history pageid))
 
     own))
 

src/uxbox/ui/workspace/sidebar/history.cljs

@@ -17,6 +17,7 @@
             [uxbox.library :as library]
             [uxbox.data.workspace :as dw]
             [uxbox.data.pages :as udp]
+            [uxbox.data.history :as udh]
             [uxbox.ui.workspace.base :as wb]
             [uxbox.ui.messages :as msg]
             [uxbox.ui.icons :as i]
@@ -25,39 +26,68 @@
             [uxbox.util.data :refer (read-string)]
             [uxbox.util.dom :as dom]))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Lenses
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; --- Lenses
 
 (def ^:const history-l
   (as-> (l/in [:workspace :history]) $
     (l/focus-atom $ st/state)))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Component
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; --- Components
+
+(defn history-item-render
+  [own item selected]
+  (letfn [(on-select [event]
+            (dom/prevent-default event)
+            (rs/emit! (udh/select-page-history item)))
+          (on-pinned [event]
+            (dom/prevent-default event)
+            (dom/stop-propagation event)
+            (let [item (assoc item
+                              :label "no label"
+                              :pinned (not (:pinned item)))]
+              (rs/emit! (udh/update-history-item item))))]
+    (let [selected? (= (:id item) selected)]
+      (html
+       [:li {:class (when selected? "current") :on-click on-select}
+        [:div.pin-icon {:on-click on-pinned
+                        :class (when (:pinned item) "selected")}
+         i/pin]
+        [:span (str "Version " (:version item)
+                    " (" (dt/timeago (:created-at item)) ")")]]))))
+
+(def history-item
+  (mx/component
+   {:render history-item-render
+    :name "history-item"
+    :mixins [mx/static]}))
 
 (defn history-list-render
   [own page history]
-  (let [select #(rs/emit! (udp/select-page-history (:id page) %))
-        min-version (apply min (map :version (:items history)))
-        show-more? (pos? min-version)]
-    (html
-     [:ul.history-content
-      [:li {:class (when-not (:selected history) "current")
-            :on-click (partial select nil)}
-       [:div.pin-icon i/pin]
-       [:span (str "Version " (:version page) " (current)")]]
-      (for [item (:items history)]
-        [:li {:key (str (:id item))
-              :class (when (= (:id item) (:selected history)) "current")
-              :on-click (partial select item)}
+  (letfn [(on-select [event]
+            (dom/prevent-default event)
+            (rs/emit! (udh/discard-selected-history (:id page))))
+
+          (on-load-more [event]
+            (dom/prevent-default event)
+            (println "kaka")
+            (let [since (:min-version history)
+                  params {:since since}]
+              (rs/emit! (udh/fetch-page-history (:id page) params))))]
+
+    (let [selected (:selected history)
+          show-more? (pos? (:min-version history))]
+      (html
+       [:ul.history-content
+        [:li {:class (when-not selected "current")
+              :on-click on-select}
          [:div.pin-icon i/pin]
-         [:span (str "Version " (:version item)
-                     " (" (dt/timeago (:created-at item)) ")")]])
-      (if show-more?
-        [:li
-         [:a.btn-primary.btn-small "view more"]])])))
+         [:span (str "Version " (:version page) " (current)")]]
+        (for [item (:items history)]
+          (-> (history-item item selected)
+              (rum/with-key (str (:id item)))))
+        (if show-more?
+          [:li {:on-click on-load-more}
+           [:a.btn-primary.btn-small "view more"]])]))))
 
 (defn history-list-will-update
   [own]
@@ -68,8 +98,8 @@
                           (first))]
         (msg/dialog
          :message (tr "history.alert-message" (:version selected))
-         :on-accept #(rs/emit! (udp/apply-selected-history (:id page)))
-         :on-cancel #(rs/emit! (udp/discard-selected-history (:id page)))))
+         :on-accept #(rs/emit! (udh/apply-selected-history (:id page)))
+         :on-cancel #(rs/emit! (udh/discard-selected-history (:id page)))))
       (msg/close))
     own))
 
@@ -84,13 +114,15 @@
   [own history]
   (html
    [:ul.history-content
-    [:li.current
-     [:span "Current version"]]
-    [:li
-     [:span "Version 02/02/2016 12:33h"]
-     [:div.page-actions
-      [:a i/pencil]
-      [:a i/trash]]]]))
+    (for [item (:pinned-items history)]
+      (-> (history-item item (:selected history))
+          (rum/with-key (str (:id item)))))]))
+
+    ;; [:li
+    ;;  [:span "Version 02/02/2016 12:33h"]
+    ;;  [:div.page-actions
+    ;;   [:a i/pencil]
+    ;;   [:a i/trash]]]]))
 
 (def history-pinned-list
   (mx/component

src/uxbox/util/data.cljs

@@ -45,6 +45,14 @@
                          (when (= v x) idx))
                        coll)))
 
+(defn replace-by-id
+  [coll value]
+  {:pre [(vector? coll)]}
+  (mapv (fn [item]
+          (if (= (:id item) (:id value))
+            value
+            item)) coll))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Numbers Parsing
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;