;; 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) 2015-2017 Andrey Antukh (ns uxbox.main.data.pages (:require [beicon.core :as rx] [cuerdas.core :as str] [potok.core :as ptk] [struct.alpha :as st] [uxbox.main.repo :as rp] [uxbox.util.data :refer [index-by-id]] [uxbox.util.spec :as us] [uxbox.util.timers :as ts] [uxbox.util.uuid :as uuid])) ;; --- Struct (st/defs ::inst inst?) (st/defs ::width (st/&& ::st/number ::st/positive)) (st/defs ::height (st/&& ::st/number ::st/positive)) (st/defs ::metadata (st/dict :width ::width :height ::height :grid-y-axis (st/opt ::st/number) :grid-x-axis (st/opt ::st/number) :grid-color (st/opt ::st/string) :order (st/opt ::st/number) :background (st/opt ::st/string) :background-opacity (st/opt ::st/number))) (st/defs ::shapes-list (st/coll-of ::st/uuid)) (st/defs ::page-entity (st/dict :id ::st/uuid :name ::st/string :project ::st/uuid :created-at ::inst :modified-at ::inst :user ::st/uuid :metadata ::metadata :shapes ::shapes-list)) (st/defs ::minimal-shape (st/dict :id ::st/uuid :type ::st/keyword :name ::st/string)) (st/defs ::server-page-data-sapes (st/coll-of ::minimal-shape)) (st/defs ::server-page-data (st/dict :shapes ::server-page-data-sapes)) (st/defs ::server-page (st/dict :id ::st/uuid :name ::st/string :project ::st/uuid :version ::st/integer :created-at ::inst :modified-at ::inst :user ::st/uuid :metadata ::metadata :data ::server-page-data)) ;; --- Protocols (defprotocol IPageUpdate "A marker protocol for mark events that alters the page and is subject to perform a backend synchronization.") (defprotocol IMetadataUpdate "A marker protocol for mark events that alters the page and is subject to perform a backend synchronization.") ;; --- Helpers (defn pack-page "Return a packed version of page object ready for send to remore storage service." [state id] (letfn [(pack-shapes [ids] (mapv #(get-in state [:shapes %]) ids))] (let [page (get-in state [:pages id]) data {:shapes (pack-shapes (:shapes page))}] (-> page (assoc :data data) (dissoc :shapes))))) (defn unpack-page "Unpacks packed page object and assocs it to the provided state." [state {:keys [id data] :as page}] (let [shapes-data (:shapes data []) shapes (mapv :id shapes-data) shapes-map (index-by-id shapes-data) page (-> page (dissoc :data) (assoc :shapes shapes))] (-> state (update :shapes merge shapes-map) (update :pages assoc id page)))) (defn purge-page "Remove page and all related stuff from the state." [state id] (let [pid (get-in state [:pages id :project])] (-> state (update-in [:projects pid :pages] #(filterv (partial not= id) %)) (update :pages dissoc id) (update :packed-pages dissoc id) (update :shapes (fn [shapes] (->> shapes (map second) (filter #(= (:page %) id)) (map :id) (apply dissoc shapes))))))) (defn assoc-packed-page [state {:keys [id] :as page}] (assoc-in state [:packed-pages id] page)) (defn dissoc-packed-page [state id] (update state :packed-pages dissoc id)) ;; --- Pages Fetched (deftype PagesFetched [id pages] IDeref (-deref [_] (list id pages)) ptk/UpdateEvent (update [_ state] (let [get-order #(get-in % [:metadata :order]) pages (sort-by get-order pages) page-ids (into [] (map :id) pages)] (as-> state $ (assoc-in $ [:projects id :pages] page-ids) (reduce unpack-page $ pages) (reduce assoc-packed-page $ pages))))) (defn pages-fetched [id pages] {:pre [(uuid? id) (coll? pages)]} (PagesFetched. id pages)) (defn pages-fetched? [v] (instance? PagesFetched v)) ;; --- Fetch Pages (by project id) (deftype FetchPages [id] ptk/WatchEvent (watch [_ state s] (->> (rp/req :fetch/pages-by-project {:project id}) (rx/map :payload) (rx/map #(pages-fetched id %))))) (defn fetch-pages [id] {:pre [(uuid? id)]} (FetchPages. id)) ;; --- Page Created (declare rehash-pages) (st/defs ::page-created (st/dict :id ::st/uuid :name ::st/string :project ::st/uuid :metadata ::metadata)) (defn page-created [data] (assert (st/valid? ::page-created data) "invalid parameters") (reify ptk/UpdateEvent (update [_ state] (let [pid (:project data)] (-> state (update-in [:projects pid :pages] (fnil conj []) (:id data)) (unpack-page data) (assoc-packed-page data)))) ptk/WatchEvent (watch [_ state stream] (rx/of (rehash-pages (:project data)))))) ;; --- Create Page (st/defs ::create-page (st/dict :name ::st/string :project ::st/uuid :width ::width :height ::height)) (defn create-page [{:keys [name project width height layout] :as data}] (assert (st/valid? ::create-page data)) (reify ptk/WatchEvent (watch [this state s] (let [canvas {:id (uuid/random) :name "Canvas 1" :type :canvas :x1 200 :y1 200 :x2 (+ 200 width) :y2 (+ 200 height)} metadata {:width width :height height :order -100} params {:name name :project project :data {:shapes [canvas]} :metadata metadata}] (->> (rp/req :create/page params) (rx/map :payload) (rx/map page-created)))))) ;; --- Page Persisted (defn page-persisted [data] (assert (st/valid? ::server-page data)) (reify cljs.core/IDeref (-deref [_] data) ptk/EventType (type [_] ::page-persisted) ptk/UpdateEvent (update [_ state] (let [{:keys [id version]} data] (-> state (assoc-in [:pages id :version] version) (assoc-packed-page data)))))) (defn- page-persisted? [event] (= (ptk/type event) ::page-persisted)) ;; --- Persist Page (defn persist-page ([id] (persist-page id identity)) ([id on-success] (assert (uuid? id)) (reify ptk/EventType (type [_] ::persist-page) ptk/WatchEvent (watch [this state s] (let [page (get-in state [:pages id])] (if (:history page) (rx/empty) (let [page (pack-page state id)] (->> (rp/req :update/page page) (rx/map :payload) (rx/do #(when (fn? on-success) (ts/schedule-on-idle on-success))) (rx/map page-persisted))))))))) (defn persist-page? [v] (= ::persist-page (ptk/type v))) ;; --- Page Metadata Persisted (deftype MetadataPersisted [id data] ptk/UpdateEvent (update [_ state] (assoc-in state [:pages id :version] (:version data)))) (st/defs ::version integer?) (st/defs ::metadata-persisted-event (st/dict :id ::st/uuid :version ::version)) (defn metadata-persisted? [v] (instance? MetadataPersisted v)) (defn metadata-persisted [{:keys [id] :as data}] {:pre [(st/valid? ::metadata-persisted-event data)]} (MetadataPersisted. id data)) ;; --- Persist Page Metadata ;; This is a simplified version of `PersistPage` event ;; that does not sends the heavyweiht `:data` attribute ;; and only serves for update other page data. (defn persist-metadata [id] {:pre [(uuid? id)]} (reify ptk/WatchEvent (watch [_ state stream] (let [page (get-in state [:pages id])] (->> (rp/req :update/page-metadata page) (rx/map :payload) (rx/map metadata-persisted)))))) ;; --- Update Page (deftype UpdatePage [id data] IPageUpdate ptk/UpdateEvent (update [_ state] (update-in state [:pages id] merge (dissoc data :id :version)))) (defn update-page [id data] {:pre [(uuid? id) (st/valid? ::page-entity data)]} (UpdatePage. id data)) ;; --- Update Page Metadata (deftype UpdateMetadata [id metadata] IMetadataUpdate ptk/UpdateEvent (update [this state] (assoc-in state [:pages id :metadata] metadata))) (defn update-metadata [id metadata] {:pre [(uuid? id) (st/valid? ::metadata metadata)]} (UpdateMetadata. id metadata)) ;; --- Rehash Pages ;; ;; A post processing event that normalizes the ;; page order numbers after a user sorting ;; operation for a concrete project. (defn rehash-pages [id] {:pre [(uuid? id)]} (reify ptk/UpdateEvent (update [this state] (let [page-ids (get-in state [:projects id :pages])] (reduce (fn [state [index id]] (assoc-in state [:pages id :metadata :order] index)) state (map-indexed vector page-ids)))) ptk/WatchEvent (watch [_ state stream] (let [page-ids (get-in state [:projects id :pages])] (->> (rx/from-coll page-ids) (rx/map persist-metadata)))))) ;; --- Move Page (Ordering) (defn move-page [{:keys [page-id project-id index] :as params}] (reify ptk/UpdateEvent (update [_ state] (let [pages (get-in state [:projects project-id :pages]) pages (into [] (remove #(= % page-id)) pages) [before after] (split-at index pages) pages (vec (concat before [page-id] after))] (assoc-in state [:projects project-id :pages] pages))))) ;; --- Persist Page Form ;; ;; A specialized event for persist data ;; from the update page form. (st/defs ::persist-page-update-form (st/dict :id ::st/uuid :name ::st/string :width ::width :height ::height)) (defn persist-page-update-form [{:keys [id name width height] :as data}] (assert (st/valid? ::persist-page-update-form data)) (reify ptk/WatchEvent (watch [_ state stream] (let [page (-> (get-in state [:pages id]) (assoc-in [:name] name) (assoc-in [:metadata :width] width) (assoc-in [:metadata :height] height))] (rx/of (update-page id page)))))) ;; --- Delete Page (by id) (defn delete-page [id] {:pre [(uuid? id)]} (reify ptk/UpdateEvent (update [_ state] (purge-page state id)) ptk/WatchEvent (watch [_ state s] (->> (rp/req :delete/page id) (rx/map (constantly ::delete-completed)))))) ;; --- Watch Page Changes (deftype WatchPageChanges [id] ptk/WatchEvent (watch [_ state stream] (let [stopper (->> stream (rx/filter #(= % ::stop-page-watcher)) (rx/take 1))] (rx/merge (->> stream (rx/filter #(or (satisfies? IPageUpdate %) (= ::page-update %))) (rx/take-until stopper) (rx/debounce 1000) (rx/mapcat #(rx/merge (rx/of (persist-page id)) (->> (rx/filter page-persisted? stream) (rx/take 1) (rx/ignore))))) (->> stream (rx/filter #(satisfies? IMetadataUpdate %)) (rx/take-until stopper) (rx/debounce 1000) (rx/mapcat #(rx/merge (rx/of (persist-metadata id)) (->> (rx/filter metadata-persisted? stream) (rx/take 1) (rx/ignore))))))))) (defn watch-page-changes [id] (WatchPageChanges. id))