penpot/frontend/src/uxbox/main/data/pages.cljs

;; 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 <niwi@niwi.nz>

(ns uxbox.main.data.pages
  (:require [cljs.spec :as s]
            [cuerdas.core :as str]
            [beicon.core :as rx]
            [lentes.core :as l]
            [potok.core :as ptk]
            [uxbox.main.store :as st]
            [uxbox.main.repo :as rp]
            [uxbox.main.lenses :as ul]
            [uxbox.util.spec :as us]
            [uxbox.util.router :as r]
            [uxbox.util.time :as dt]))

;; --- Specs

(s/def ::grid-x-axis number?)
(s/def ::grid-y-axis number?)
(s/def ::grid-color us/color?)
(s/def ::background us/color?)
(s/def ::background-opacity number?)
(s/def ::grid-alignment boolean?)
(s/def ::width number?)
(s/def ::height number?)
(s/def ::layout string?)

(s/def ::metadata
  (s/keys :req-un [::width ::height]
          :opt-un [::grid-y-axis
                   ::grid-x-axis
                   ::grid-color
                   ::grid-alignment
                   ::order
                   ::background
                   ::background-opacity
                   ::layout]))

(s/def ::id uuid?)
(s/def ::name string?)
(s/def ::version integer?)
(s/def ::project uuid?)
(s/def ::user uuid?)
(s/def ::created-at inst?)
(s/def ::modified-at inst?)
(s/def ::shapes
  (-> (s/coll-of uuid? :kind vector?)
      (s/nilable)))

(s/def ::page-entity
  (s/keys :req-un [::id
                   ::name
                   ::project
                   ::version
                   ::created-at
                   ::modified-at
                   ::user
                   ::metadata
                   ::shapes]))

;; TODO: add interactions to spec

;; --- 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

;; TODO: make sure remove all :tmp-* related attrs from shape

(defn pack-page-shapes
  "Create a hash-map of shapes indexed by their id that belongs
  to the provided page."
  [state page]
  (let [lookup-shape-xf (map #(get-in state [:shapes %]))]
    (reduce (fn reducer [acc {:keys [id type items] :as shape}]
              (let [shape (assoc shape :page (:id page))]
                (cond
                  (= type :group)
                  (reduce reducer
                          (assoc acc id shape)
                          (sequence lookup-shape-xf items))

                  (uuid? id)
                  (assoc acc id shape)

                  :else acc)))
            {}
            (sequence lookup-shape-xf (:shapes page)))))

(defn pack-page
  "Return a packed version of page object ready
  for send to remore storage service."
  [state id]
  (let [page (get-in state [:pages id])
        shapes (pack-page-shapes state page)]
    (-> page
        (assoc-in [:data :shapes] (vec (:shapes page)))
        (assoc-in [:data :shapes-map] shapes)
        (dissoc :shapes))))

(defn assoc-page
  "Unpacks packed page object and assocs it to the
  provided state."
  [state {:keys [id data] :as page}]
  (let [shapes (:shapes data)
        shapes-map (:shapes-map 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 [shapes (get state :shapes)]
    (-> state
        (update :pages dissoc id)
        (update :packed-pages dissoc id)
        (assoc :shapes (reduce-kv (fn [acc k v]
                                    (if (= (:page v) id)
                                      (dissoc acc k)
                                      acc))
                                  shapes
                                  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))

;; --- Update Project main page
;;
;; A event that handles the project main page
;; update based on the user selected page ordering.

(deftype UpdateProjectMainPage [id]
  ptk/UpdateEvent
  (update [_ state]
    (let [get-order #(get-in % [:metadata :order])
          page-id (->> (vals (:pages state))
                       (filter #(= id (:project %)))
                       (sort-by get-order)
                       (map :id)
                       (first))]
      (assoc-in state [:projects id :page-id] page-id))))

(defn update-project-main-page
  [id]
  {:pre [(uuid? id)]}
  (UpdateProjectMainPage. id))

;; --- Pages Fetched

(deftype PagesFetched [id pages]
  IDeref
  (-deref [_] (list id pages))

  ptk/UpdateEvent
  (update [_ state]
    (as-> state $
      (reduce assoc-page $ pages)
      (reduce assoc-packed-page $ pages)))

  ptk/WatchEvent
  (watch [_ state stream]
    (rx/of (update-project-main-page id))))

(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 reorder-pages)

(deftype PageCreated [data]
  ptk/UpdateEvent
  (update [_ state]
    (-> state
        (assoc-page data)
        (assoc-packed-page data)))

  ptk/WatchEvent
  (watch [_ state stream]
    (rx/of (reorder-pages (:id data)))))

(s/def ::page-created
  (s/keys :req-un [::id
                   ::name
                   ::project
                   ::metadata]))

(defn page-created
  [data]
  {:pre [(us/valid? ::page-created data)]}
  (PageCreated. data))

;; --- Create Page

(deftype CreatePage [name project width height layout]
  ptk/WatchEvent
  (watch [this state s]
    (let [params {:name name
                  :project project
                  :data {}
                  :metadata {:width width
                             :height height
                             :layout layout
                             :order -100}}]
      (->> (rp/req :create/page params)
           (rx/map :payload)
           (rx/map page-created)))))

(s/def ::create-page
  (s/keys :req-un [::name
                   ::project
                   ::width
                   ::height
                   ::layout]))

(defn create-page
  [{:keys [name project width height layout] :as data}]
  {:pre [(us/valid? ::create-page data)]}
  (CreatePage. name project width height layout))

;; --- Page Persisted

(deftype PagePersisted [data]
  ptk/UpdateEvent
  (update [_ state]
    (let [{:keys [id version]} data]
      (-> state
          (assoc-in [:pages id :version] version)
          (assoc-packed-page data)))))

(defn- page-persisted?
  [event]
  (instance? PagePersisted event))

;; TODO: add page spec

(defn page-persisted
  [data]
  {:pre [(map? data)]}
  (PagePersisted. data))

;; --- Persist Page

(deftype PersistPage [id]
  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/map page-persisted)))))))

(defn persist-page?
  [v]
  (instance? PersistPage v))

(defn persist-page
  [id]
  (PersistPage. id))

;; --- Page Metadata Persisted

(deftype MetadataPersisted [id data]
  ptk/UpdateEvent
  (update [_ state]
    ;; TODO: page-data update
    (assoc-in state [:pages id :version] (:version data))))

(s/def ::metadata-persisted-event
  (s/keys :req-un [::id ::version]))

(defn metadata-persisted?
  [v]
  (instance? MetadataPersisted. v))

(defn metadata-persisted
  [{:keys [id] :as data}]
  {:pre [(us/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.

(deftype PersistMetadata [id]
  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)))))

(defn persist-metadata
  [id]
  {:pre [(uuid? id)]}
  (PersistMetadata. id))

(deftype PersistPagesMetadata [project-id]
  ptk/WatchEvent
  (watch [_ state stream]
    (let [xform (comp
                 (map second)
                 (filter #(= project-id (:project %)))
                 (map :id))]
      (->> (sequence xform (:pages state))
           (rx/from-coll)
           (rx/map persist-metadata)))))

(defn persist-pages-metadata
  [project-id]
  {:pre [(uuid? project-id)]}
  (PersistPagesMetadata. project-id))

;; --- 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) (us/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) (us/valid? ::metadata metadata)]}
  (UpdateMetadata. id metadata))

;; --- Reorder Pages
;;
;; A post processing event that normalizes the
;; page order numbers after a user sorting
;; operation for a concrete project.

(deftype ReorderPages [project-id]
  ptk/UpdateEvent
  (update [this state]
    (let [get-order #(get-in % [:metadata :order])
          pages (->> (vals (:pages state))
                     (filter #(= project-id (:project %)))
                     (sort-by get-order)
                     (map :id)
                     (map-indexed vector))]
      (reduce (fn [state [order id]]
                (assoc-in state [:pages id :metadata :order] (* order 10)))
              state
              pages)))

  ptk/WatchEvent
  (watch [_ state stream]
    (rx/of (update-project-main-page project-id)
           (persist-pages-metadata project-id))))

(defn reorder-pages
  [id]
  {:pre [(uuid? id)]}
  (ReorderPages. id))

;; --- Update Order
;;
;; A specialized event for update order
;; attribute on the page metadata

(deftype UpdateOrder [id order]
  ptk/UpdateEvent
  (update [this state]
    (assoc-in state [:pages id :metadata :order] order))

  ptk/WatchEvent
  (watch [_ state stream]
    (let [project (get-in state [:pages id :project])]
      (rx/of (reorder-pages project)))))

(defn update-order
  [id order]
  {:pre [(uuid? id) (number? order)]}
  (UpdateOrder. id order))

;; --- Persist Page Form
;;
;; A specialized event for persist data
;; from the update page form.

(deftype PersistPageUpdateForm [id name width height layout]
  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)
                   (assoc-in [:metadata :layout] layout))]
      (rx/of (update-page id page)))))

(s/def ::persist-page-update-form
  (s/keys :req-un [::name ::width ::height ::layout]))

(defn persist-page-update-form
  [id {:keys [name width height layout] :as data}]
  {:pre [(uuid? id) (us/valid? ::persist-page-update-form data)]}
  (PersistPageUpdateForm. id name width height layout))

;; --- Delete Page (by id)

(deftype DeletePage [id callback]
  ptk/WatchEvent
  (watch [_ state s]
    (letfn [(on-success [_]
              #(purge-page % id))]
      (->> (rp/req :delete/page id)
           (rx/map on-success)
           (rx/tap callback)
           (rx/filter identity)))))

(defn delete-page
  ([id] (DeletePage. id (constantly nil)))
  ([id callback] (DeletePage. id callback)))

;; --- 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))