3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-10 14:46:38 +02:00
Code Issues Projects Releases Packages Wiki Activity

♻️ Refactor file persistence layer.

Browse source
This commit is contained in:
Andrey Antukh 2020-09-07 10:56:42 +02:00 • committed by Alonso Torres
parent 182afedc54
commit 4e694ff194
86 changed files with 3205 additions and 3313 deletions
Download patch file Download diff file Expand all files Collapse all files

48
backend/resources/migrations/0022-page-file-refactor.sql Normal file
View file

@ -0,0 +1,48 @@
ALTER TABLE file
ADD COLUMN revn bigint NOT NULL DEFAULT 0,
ADD COLUMN data bytea NULL;
CREATE TABLE file_change (
id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
file_id uuid NOT NULL REFERENCES file(id) ON DELETE CASCADE,
created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
session_id uuid NULL DEFAULT NULL,
revn bigint NOT NULL DEFAULT 0,
data bytea NOT NULL,
changes bytea NULL DEFAULT NULL
);
CREATE TABLE file_share_token (
file_id uuid NOT NULL REFERENCES file(id) ON DELETE CASCADE,
page_id uuid NOT NULL,
token text NOT NULL,
created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
PRIMARY KEY (file_id, token)
);
CREATE INDEX page_change_file_id_idx
ON file_change(file_id);
CREATE FUNCTION handle_file_update()
RETURNS TRIGGER AS $pagechange$
DECLARE
current_dt timestamptz := clock_timestamp();
BEGIN
NEW.modified_at := current_dt;
--- Update projects modified_at attribute when a
--- page of that project is modified.
UPDATE project
SET modified_at = current_dt
WHERE id = OLD.project_id;
RETURN NEW;
END;
$pagechange$ LANGUAGE plpgsql;
CREATE TRIGGER file_on_update_tgr
BEFORE UPDATE ON file
FOR EACH ROW EXECUTE PROCEDURE handle_file_update();

2
backend/scripts/psql.sh
View file

@ -1,2 +1,2 @@
#!/usr/bin/env bash
PGPASSWORD=$app_DATABASE_PASSWORD psql $app_DATABASE_URI -U $app_DATABASE_USERNAME
PGPASSWORD=$APP_DATABASE_PASSWORD psql $APP_DATABASE_URI -U $APP_DATABASE_USERNAME

288
backend/src/app/cli/fixtures.clj
View file

@ -36,9 +36,7 @@
:num-profiles-per-team 5
:num-projects-per-team 5
:num-files-per-project 5
:num-pages-per-file 3
:num-draft-files-per-profile 10
:num-draft-pages-per-file 3})
:num-draft-files-per-profile 10})
(defn- rng-ids
[rng n max]
@ -75,179 +73,145 @@
(defn impl-run
[opts]
(let [rng (java.util.Random. 1)
(let [rng (java.util.Random. 1)]
(letfn [(create-profile [conn index]
(let [id (mk-uuid "profile" index)
_ (log/info "create profile" id)
create-profile
(fn [conn index]
(let [id (mk-uuid "profile" index)]
(log/info "create profile" id)
(register-profile conn
{:id id
:fullname (str "Profile " index)
:password "123123"
:demo? true
:email (str "profile" index ".test@uxbox.io")})))
prof (register-profile conn
{:id id
:fullname (str "Profile " index)
:password "123123"
:demo? true
:email (str "profile" index ".test@uxbox.io")})
team-id (:default-team-id prof)
owner-id id]
(let [project-ids (collect (partial create-project conn team-id owner-id)
(range (:num-projects-per-team opts)))]
(run! (partial create-files conn owner-id) project-ids))
prof))
create-profiles
(fn [conn]
(log/info "create profiles")
(collect (partial create-profile conn)
(range (:num-profiles opts))))
(create-profiles [conn]
(log/info "create profiles")
(collect (partial create-profile conn)
(range (:num-profiles opts))))
create-team
(fn [conn index]
(let [id (mk-uuid "team" index)
name (str "Team" index)]
(log/info "create team" id)
(db/insert! conn :team {:id id
:name name
:photo ""})
id))
(create-team [conn index]
(let [id (mk-uuid "team" index)
name (str "Team" index)]
(log/info "create team" id)
(db/insert! conn :team {:id id
:name name
:photo ""})
id))
create-teams
(fn [conn]
(log/info "create teams")
(collect (partial create-team conn)
(range (:num-teams opts))))
(create-teams [conn]
(log/info "create teams")
(collect (partial create-team conn)
(range (:num-teams opts))))
create-page
(fn [conn owner-id project-id file-id index]
(let [id (mk-uuid "page" project-id file-id index)
data cp/default-page-data
name (str "page " index)
version 0
ordering index
data (blob/encode data)]
(log/info "create page" id)
(db/insert! conn :page
{:id id
:file-id file-id
:name name
:ordering ordering
:data data})))
(create-file [conn owner-id project-id index]
(let [id (mk-uuid "file" project-id index)
name (str "file" index)
data (cp/make-file-data)]
(log/info "create file" id)
(db/insert! conn :file
{:id id
:data (blob/encode data)
:project-id project-id
:name name})
(db/insert! conn :file-profile-rel
{:file-id id
:profile-id owner-id
:is-owner true
:is-admin true
:can-edit true})
id))
create-pages
(fn [conn owner-id project-id file-id]
(log/info "create pages")
(run! (partial create-page conn owner-id project-id file-id)
(range (:num-pages-per-file opts))))
(create-files [conn owner-id project-id]
(log/info "create files")
(run! (partial create-file conn owner-id project-id)
(range (:num-files-per-project opts))))
create-file
(fn [conn owner-id project-id index]
(let [id (mk-uuid "file" project-id index)
name (str "file" index)]
(log/info "create file" id)
(db/insert! conn :file
{:id id
:project-id project-id
:name name})
(db/insert! conn :file-profile-rel
{:file-id id
:profile-id owner-id
:is-owner true
:is-admin true
:can-edit true})
id))
(create-project [conn team-id owner-id index]
(let [id (mk-uuid "project" team-id index)
name (str "project " index)]
(log/info "create project" id)
(db/insert! conn :project
{:id id
:team-id team-id
:name name})
(db/insert! conn :project-profile-rel
{:project-id id
:profile-id owner-id
:is-owner true
:is-admin true
:can-edit true})
id))
create-files
(fn [conn owner-id project-id]
(log/info "create files")
(let [file-ids (collect (partial create-file conn owner-id project-id)
(range (:num-files-per-project opts)))]
(run! (partial create-pages conn owner-id project-id) file-ids)))
(create-projects [conn team-id profile-ids]
(log/info "create projects")
(let [owner-id (rng-nth rng profile-ids)
project-ids (collect (partial create-project conn team-id owner-id)
(range (:num-projects-per-team opts)))]
(run! (partial create-files conn owner-id) project-ids)))
create-project
(fn [conn team-id owner-id index]
(let [id (mk-uuid "project" team-id index)
name (str "project " index)]
(log/info "create project" id)
(db/insert! conn :project
{:id id
:team-id team-id
:name name})
(db/insert! conn :project-profile-rel
{:project-id id
:profile-id owner-id
:is-owner true
:is-admin true
:can-edit true})
id))
(assign-profile-to-team [conn team-id owner? profile-id]
(db/insert! conn :team-profile-rel
{:team-id team-id
:profile-id profile-id
:is-owner owner?
:is-admin true
:can-edit true}))
create-projects
(fn [conn team-id profile-ids]
(log/info "create projects")
(let [owner-id (rng-nth rng profile-ids)
project-ids (collect (partial create-project conn team-id owner-id)
(range (:num-projects-per-team opts)))]
(run! (partial create-files conn owner-id) project-ids)))
(setup-team [conn team-id profile-ids]
(log/info "setup team" team-id profile-ids)
(assign-profile-to-team conn team-id true (first profile-ids))
(run! (partial assign-profile-to-team conn team-id false)
(rest profile-ids))
(create-projects conn team-id profile-ids))
assign-profile-to-team
(fn [conn team-id owner? profile-id]
(db/insert! conn :team-profile-rel
{:team-id team-id
:profile-id profile-id
:is-owner owner?
:is-admin true
:can-edit true}))
(assign-teams-and-profiles [conn teams profiles]
(log/info "assign teams and profiles")
(loop [team-id (first teams)
teams (rest teams)]
(when-not (nil? team-id)
(let [n-profiles-team (:num-profiles-per-team opts)
selected-profiles (rng-vec rng profiles n-profiles-team)]
(setup-team conn team-id selected-profiles)
(recur (first teams)
(rest teams))))))
setup-team
(fn [conn team-id profile-ids]
(log/info "setup team" team-id profile-ids)
(assign-profile-to-team conn team-id true (first profile-ids))
(run! (partial assign-profile-to-team conn team-id false)
(rest profile-ids))
(create-projects conn team-id profile-ids))
(create-draft-file [conn owner index]
(let [owner-id (:id owner)
id (mk-uuid "file" "draft" owner-id index)
name (str "file" index)
project-id (:default-project-id owner)
data (cp/make-file-data)]
assign-teams-and-profiles
(fn [conn teams profiles]
(log/info "assign teams and profiles")
(loop [team-id (first teams)
teams (rest teams)]
(when-not (nil? team-id)
(let [n-profiles-team (:num-profiles-per-team opts)
selected-profiles (rng-vec rng profiles n-profiles-team)]
(setup-team conn team-id selected-profiles)
(recur (first teams)
(rest teams))))))
(log/info "create draft file" id)
(db/insert! conn :file
{:id id
:data (blob/encode data)
:project-id project-id
:name name})
(db/insert! conn :file-profile-rel
{:file-id id
:profile-id owner-id
:is-owner true
:is-admin true
:can-edit true})
id))
create-draft-pages
(fn [conn owner-id file-id]
(log/info "create draft pages")
(run! (partial create-page conn owner-id nil file-id)
(range (:num-draft-pages-per-file opts))))
create-draft-file
(fn [conn owner index]
(let [owner-id (:id owner)
id (mk-uuid "file" "draft" owner-id index)
name (str "file" index)
project-id (:default-project-id owner)]
(log/info "create draft file" id)
(db/insert! conn :file
{:id id
:project-id project-id
:name name})
(db/insert! conn :file-profile-rel
{:file-id id
:profile-id owner-id
:is-owner true
:is-admin true
:can-edit true})
id))
create-draft-files
(fn [conn profile]
(let [file-ids (collect (partial create-draft-file conn profile)
(range (:num-draft-files-per-profile opts)))]
(run! (partial create-draft-pages conn (:id profile)) file-ids)))
]
(db/with-atomic [conn db/pool]
(let [profiles (create-profiles conn)
teams (create-teams conn)]
(assign-teams-and-profiles conn teams (map :id profiles))
(run! (partial create-draft-files conn) profiles)))))
(create-draft-files [conn profile]
(run! (partial create-draft-file conn profile)
(range (:num-draft-files-per-profile opts))))
]
(db/with-atomic [conn db/pool]
(let [profiles (create-profiles conn)
teams (create-teams conn)]
(assign-teams-and-profiles conn teams (map :id profiles))
(run! (partial create-draft-files conn) profiles))))))
(defn run*
[preset]

342
backend/src/app/cli/media_loader.clj
View file

@ -31,203 +31,203 @@
;; --- Constants & Helpers
(def ^:const +graphics-uuid-ns+ #uuid "3642a582-565f-4070-beba-af797ab27a6a")
(def ^:const +colors-uuid-ns+ #uuid "3642a582-565f-4070-beba-af797ab27a6c")
;; (def ^:const +graphics-uuid-ns+ #uuid "3642a582-565f-4070-beba-af797ab27a6a")
;; (def ^:const +colors-uuid-ns+ #uuid "3642a582-565f-4070-beba-af797ab27a6c")
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::path ::us/string)
(s/def ::regex #(instance? java.util.regex.Pattern %))
;; (s/def ::id ::us/uuid)
;; (s/def ::name ::us/string)
;; (s/def ::path ::us/string)
;; (s/def ::regex #(instance? java.util.regex.Pattern %))
(s/def ::import-graphics
(s/keys :req-un [::path ::regex]))
;; (s/def ::import-graphics
;; (s/keys :req-un [::path ::regex]))
(s/def ::import-color
(s/* (s/cat :name ::us/string :color ::us/color)))
;; (s/def ::import-color
;; (s/* (s/cat :name ::us/string :color ::us/color)))
(s/def ::import-colors (s/coll-of ::import-color))
;; (s/def ::import-colors (s/coll-of ::import-color))
(s/def ::import-library
(s/keys :req-un [::name]
:opt-un [::import-graphics ::import-colors]))
;; (s/def ::import-library
;; (s/keys :req-un [::name]
;; :opt-un [::import-graphics ::import-colors]))
(defn exit!
([] (exit! 0))
([code]
(System/exit code)))
;; (defn exit!
;; ([] (exit! 0))
;; ([code]
;; (System/exit code)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Graphics Importer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;; Graphics Importer
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- create-media-object
[conn file-id media-object-id localpath]
(s/assert fs/path? localpath)
(s/assert ::us/uuid file-id)
(s/assert ::us/uuid media-object-id)
(let [filename (fs/name localpath)
extension (second (fs/split-ext filename))
file (io/as-file localpath)
mtype (case extension
".jpg" "image/jpeg"
".png" "image/png"
".webp" "image/webp"
".svg" "image/svg+xml")]
(log/info "Creating image" filename media-object-id)
(media/create-media-object conn {:content {:tempfile localpath
:filename filename
:content-type mtype
:size (.length file)}
:id media-object-id
:file-id file-id
:name filename
:is-local false})))
;; (defn- create-media-object
;; [conn file-id media-object-id localpath]
;; (s/assert fs/path? localpath)
;; (s/assert ::us/uuid file-id)
;; (s/assert ::us/uuid media-object-id)
;; (let [filename (fs/name localpath)
;; extension (second (fs/split-ext filename))
;; file (io/as-file localpath)
;; mtype (case extension
;; ".jpg" "image/jpeg"
;; ".png" "image/png"
;; ".webp" "image/webp"
;; ".svg" "image/svg+xml")]
;; (log/info "Creating image" filename media-object-id)
;; (media/create-media-object conn {:content {:tempfile localpath
;; :filename filename
;; :content-type mtype
;; :size (.length file)}
;; :id media-object-id
;; :file-id file-id
;; :name filename
;; :is-local false})))
(defn- media-object-exists?
[conn id]
(s/assert ::us/uuid id)
(let [row (db/get-by-id conn :media-object id)]
(if row true false)))
;; (defn- media-object-exists?
;; [conn id]
;; (s/assert ::us/uuid id)
;; (let [row (db/get-by-id conn :media-object id)]
;; (if row true false)))
(defn- import-media-object-if-not-exists
[conn file-id fpath]
(s/assert ::us/uuid file-id)
(s/assert fs/path? fpath)
(let [media-object-id (uuid/namespaced +graphics-uuid-ns+ (str file-id (fs/name fpath)))]
(when-not (media-object-exists? conn media-object-id)
(create-media-object conn file-id media-object-id fpath))
media-object-id))
;; (defn- import-media-object-if-not-exists
;; [conn file-id fpath]
;; (s/assert ::us/uuid file-id)
;; (s/assert fs/path? fpath)
;; (let [media-object-id (uuid/namespaced +graphics-uuid-ns+ (str file-id (fs/name fpath)))]
;; (when-not (media-object-exists? conn media-object-id)
;; (create-media-object conn file-id media-object-id fpath))
;; media-object-id))
(defn- import-graphics
[conn file-id {:keys [path regex]}]
(run! (fn [fpath]
(when (re-matches regex (str fpath))
(import-media-object-if-not-exists conn file-id fpath)))
(->> (fs/list-dir path)
(filter fs/regular-file?))))
;; (defn- import-graphics
;; [conn file-id {:keys [path regex]}]
;; (run! (fn [fpath]
;; (when (re-matches regex (str fpath))
;; (import-media-object-if-not-exists conn file-id fpath)))
;; (->> (fs/list-dir path)
;; (filter fs/regular-file?))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Colors Importer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;; Colors Importer
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- create-color
[conn file-id name content]
(s/assert ::us/uuid file-id)
(s/assert ::us/color content)
(let [color-id (uuid/namespaced +colors-uuid-ns+ (str file-id content))]
(log/info "Creating color" color-id "-" name content)
(colors/create-color conn {:id color-id
:file-id file-id
:name name
:content content})
color-id))
;; (defn- create-color
;; [conn file-id name content]
;; (s/assert ::us/uuid file-id)
;; (s/assert ::us/color content)
;; (let [color-id (uuid/namespaced +colors-uuid-ns+ (str file-id content))]
;; (log/info "Creating color" color-id "-" name content)
;; (colors/create-color conn {:id color-id
;; :file-id file-id
;; :name name
;; :content content})
;; color-id))
(defn- import-colors
[conn file-id colors]
(db/delete! conn :color {:file-id file-id})
(run! (fn [[name content]]
(create-color conn file-id name content))
(partition-all 2 colors)))
;; (defn- import-colors
;; [conn file-id colors]
;; (db/delete! conn :color {:file-id file-id})
;; (run! (fn [[name content]]
;; (create-color conn file-id name content))
;; (partition-all 2 colors)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Library files Importer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;; Library files Importer
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- library-file-exists?
[conn id]
(s/assert ::us/uuid id)
(let [row (db/get-by-id conn :file id)]
(if row true false)))
;; (defn- library-file-exists?
;; [conn id]
;; (s/assert ::us/uuid id)
;; (let [row (db/get-by-id conn :file id)]
;; (if row true false)))
(defn- create-library-file-if-not-exists
[conn project-id {:keys [name]}]
(let [id (uuid/namespaced +colors-uuid-ns+ name)]
(when-not (library-file-exists? conn id)
(log/info "Creating library-file:" name)
(files/create-file conn {:id id
:profile-id uuid/zero
:project-id project-id
:name name
:is-shared true})
(files/create-page conn {:file-id id}))
id))
;; (defn- create-library-file-if-not-exists
;; [conn project-id {:keys [name]}]
;; (let [id (uuid/namespaced +colors-uuid-ns+ name)]
;; (when-not (library-file-exists? conn id)
;; (log/info "Creating library-file:" name)
;; (files/create-file conn {:id id
;; :profile-id uuid/zero
;; :project-id project-id
;; :name name
;; :is-shared true})
;; (files/create-page conn {:file-id id}))
;; id))
(defn- process-library
[conn basedir project-id {:keys [graphics colors] :as library}]
(us/verify ::import-library library)
(let [library-file-id (create-library-file-if-not-exists conn project-id library)]
(when graphics
(->> (assoc graphics :path (fs/join basedir (:path graphics)))
(import-graphics conn library-file-id)))
(when colors
(import-colors conn library-file-id colors))))
;; (defn- process-library
;; [conn basedir project-id {:keys [graphics colors] :as library}]
;; (us/verify ::import-library library)
;; (let [library-file-id (create-library-file-if-not-exists conn project-id library)]
;; (when graphics
;; (->> (assoc graphics :path (fs/join basedir (:path graphics)))
;; (import-graphics conn library-file-id)))
;; (when colors
;; (import-colors conn library-file-id colors))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Entry Point
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;; Entry Point
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- project-exists?
[conn id]
(s/assert ::us/uuid id)
(let [row (db/get-by-id conn :project id)]
(if row true false)))
;; (defn- project-exists?
;; [conn id]
;; (s/assert ::us/uuid id)
;; (let [row (db/get-by-id conn :project id)]
;; (if row true false)))
(defn- create-project-if-not-exists
[conn {:keys [name] :as project}]
(let [id (uuid/namespaced +colors-uuid-ns+ name)]
(when-not (project-exists? conn id)
(log/info "Creating project" name)
(projects/create-project conn {:id id
:team-id uuid/zero
:name name
:default? false}))
id))
;; (defn- create-project-if-not-exists
;; [conn {:keys [name] :as project}]
;; (let [id (uuid/namespaced +colors-uuid-ns+ name)]
;; (when-not (project-exists? conn id)
;; (log/info "Creating project" name)
;; (projects/create-project conn {:id id
;; :team-id uuid/zero
;; :name name
;; :default? false}))
;; id))
(defn- validate-path
[path]
(let [path (if (symbol? path) (str path) path)]
(log/infof "Trying to load config from '%s'." path)
(when-not path
(log/error "No path is provided")
(exit! -1))
(when-not (fs/exists? path)
(log/error "Path does not exists.")
(exit! -1))
(when (fs/directory? path)
(log/error "The provided path is a directory.")
(exit! -1))
(fs/path path)))
;; (defn- validate-path
;; [path]
;; (let [path (if (symbol? path) (str path) path)]
;; (log/infof "Trying to load config from '%s'." path)
;; (when-not path
;; (log/error "No path is provided")
;; (exit! -1))
;; (when-not (fs/exists? path)
;; (log/error "Path does not exists.")
;; (exit! -1))
;; (when (fs/directory? path)
;; (log/error "The provided path is a directory.")
;; (exit! -1))
;; (fs/path path)))
(defn- read-file
[path]
(let [reader (PushbackReader. (io/reader path))]
[(fs/parent path)
(read reader)]))
;; (defn- read-file
;; [path]
;; (let [reader (PushbackReader. (io/reader path))]
;; [(fs/parent path)
;; (read reader)]))
(defn run*
[path]
(let [[basedir libraries] (read-file path)]
(db/with-atomic [conn db/pool]
(let [project-id (create-project-if-not-exists conn {:name "System libraries"})]
(run! #(process-library conn basedir project-id %) libraries)))))
;; (defn run*
;; [path]
;; (let [[basedir libraries] (read-file path)]
;; (db/with-atomic [conn db/pool]
;; (let [project-id (create-project-if-not-exists conn {:name "System libraries"})]
;; (run! #(process-library conn basedir project-id %) libraries)))))
(defn run
[{:keys [path] :as params}]
(log/infof "Starting media loader.")
(let [path (validate-path path)]
;; (defn run
;; [{:keys [path] :as params}]
;; (log/infof "Starting media loader.")
;; (let [path (validate-path path)]
(try
(-> (mount/only #{#'app.config/config
#'app.db/pool
#'app.migrations/migrations
#'app.media/semaphore
#'app.media-storage/media-storage})
(mount/start))
(run* path)
(catch Exception e
(log/errorf e "Unhandled exception."))
(finally
(mount/stop)))))
;; (try
;; (-> (mount/only #{#'app.config/config
;; #'app.db/pool
;; #'app.migrations/migrations
;; #'app.media/semaphore
;; #'app.media-storage/media-storage})
;; (mount/start))
;; (run* path)
;; (catch Exception e
;; (log/errorf e "Unhandled exception."))
;; (finally
;; (mount/stop)))))

10
backend/src/app/migrations.clj
View file

@ -12,6 +12,7 @@
[mount.core :as mount :refer [defstate]]
[app.db :as db]
[app.config :as cfg]
[app.migrations.migration-0023 :as mg0023]
[app.util.migrations :as mg]))
(def +migrations+
@ -100,6 +101,15 @@
{:desc "Improve http session tables"
:name "0021-http-session-improvements"
:fn (mg/resource "migrations/0021-http-session-improvements.sql")}
{:desc "Refactor pages and files"
:name "0022-page-file-refactor"
:fn (mg/resource "migrations/0022-page-file-refactor.sql")}
{:desc "Adapt old pages and files to new format"
:name "0023-adapt-old-pages-and-files"
:fn mg0023/migrate}
]})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

64
backend/src/app/migrations/migration_0023.clj Normal file
View file

@ -0,0 +1,64 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.migrations.migration-0023
(:require
[app.db :as db]
[app.util.blob :as blob]))
(defn decode-row
[{:keys [data] :as row}]
(when row
(cond-> row
data (assoc :data (blob/decode data)))))
(defn retrieve-files
[conn]
(->> (db/exec! conn ["select * from file;"])
(map decode-row)))
(defn retrieve-pages
[conn file-id]
(->> (db/query conn :page {:file-id file-id})
(map decode-row)
(sort-by :ordering)))
(def empty-file-data
{:version 1
:pages []
:pages-index {}})
(defn pages->data
[pages]
(reduce (fn [acc {:keys [id data name] :as page}]
(let [data (-> data
(dissoc :version)
(assoc :id id :name name))]
(-> acc
(update :pages (fnil conj []) id)
(update :pages-index assoc id data))))
empty-file-data
pages))
(defn migrate-file
[conn {:keys [id] :as file}]
(let [pages (retrieve-pages conn (:id file))
data (pages->data pages)]
(db/update! conn :file
{:data (blob/encode data)}
{:id id})))
(defn migrate
[conn]
(let [files (retrieve-files conn)]
(doseq [file files]
(when (nil? (:data file))
(migrate-file conn file)))
(db/exec-one! conn ["drop table page cascade;"])))

4
backend/src/app/services/init.clj
View file

@ -5,7 +5,7 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.init
"A initialization of services."
@ -18,7 +18,6 @@
(require 'app.services.queries.colors)
(require 'app.services.queries.projects)
(require 'app.services.queries.files)
(require 'app.services.queries.pages)
(require 'app.services.queries.profile)
(require 'app.services.queries.recent-files)
(require 'app.services.queries.viewer))
@ -30,7 +29,6 @@
(require 'app.services.mutations.colors)
(require 'app.services.mutations.projects)
(require 'app.services.mutations.files)
(require 'app.services.mutations.pages)
(require 'app.services.mutations.profile))
(defstate query-services

2
backend/src/app/services/mutations/colors.clj
View file

@ -5,7 +5,7 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.mutations.colors
(:require

2
backend/src/app/services/mutations/demo.clj
View file

@ -5,7 +5,7 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2016-2020 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.mutations.demo
"A demo specific mutations."

118
backend/src/app/services/mutations/files.clj
View file

@ -5,7 +5,7 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.mutations.files
(:require
@ -14,16 +14,19 @@
[promesa.core :as p]
[app.common.exceptions :as ex]
[app.common.pages :as cp]
[app.common.pages-migrations :as pmg]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
[app.redis :as redis]
[app.services.mutations :as sm]
[app.services.mutations.projects :as proj]
[app.services.queries.files :as files]
[app.tasks :as tasks]
[app.util.blob :as blob]
[app.util.storage :as ust]
[app.util.transit :as t]
[app.util.time :as dt]))
;; --- Helpers & Specs
@ -37,7 +40,6 @@
;; --- Mutation: Create File
(declare create-file)
(declare create-page)
(s/def ::is-shared ::us/boolean)
(s/def ::create-file
@ -47,9 +49,7 @@
(sm/defmutation ::create-file
[{:keys [profile-id project-id] :as params}]
(db/with-atomic [conn db/pool]
(let [file (create-file conn params)
page (create-page conn (assoc params :file-id (:id file)))]
(assoc file :pages [(:id page)]))))
(create-file conn params)))
(defn- create-file-profile
[conn {:keys [profile-id file-id] :as params}]
@ -64,25 +64,17 @@
[conn {:keys [id profile-id name project-id is-shared]
:or {is-shared false}
:as params}]
(let [id (or id (uuid/next))
(let [id (or id (uuid/next))
data (cp/make-file-data)
file (db/insert! conn :file
{:id id
:project-id project-id
:name name
:is-shared is-shared})]
:is-shared is-shared
:data (blob/encode data)})]
(->> (assoc params :file-id id)
(create-file-profile conn))
file))
(defn create-page
[conn {:keys [file-id] :as params}]
(let [id (uuid/next)]
(db/insert! conn :page
{:id id
:file-id file-id
:name "Page 1"
:ordering 1
:data (blob/encode cp/default-page-data)})))
(assoc file :data data)))
;; --- Mutation: Rename File
@ -195,3 +187,93 @@
{:file-id file-id
:library-file-id library-id}))
;; A generic, Changes based (granular) file update method.
(s/def ::changes
(s/coll-of map? :kind vector?))
(s/def ::session-id ::us/uuid)
(s/def ::revn ::us/integer)
(s/def ::update-file
(s/keys :req-un [::id ::session-id ::profile-id ::revn ::changes]))
(declare update-file)
(declare retrieve-lagged-changes)
(declare insert-change)
(sm/defmutation ::update-file
[{:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(let [{:keys [id] :as file} (db/get-by-id conn :file id {:for-update true})]
(files/check-edition-permissions! conn profile-id id)
(update-file conn file params))))
(defn- update-file
[conn file params]
(when (> (:revn params)
(:revn file))
(ex/raise :type :validation
:code :revn-conflict
:hint "The incoming revision number is greater that stored version."
:context {:incoming-revn (:revn params)
:stored-revn (:revn file)}))
(let [sid (:session-id params)
changes (:changes params)
file (-> file
(update :data blob/decode)
(update :data pmg/migrate-data)
(update :data cp/process-changes changes)
(update :data blob/encode)
(update :revn inc)
(assoc :changes (blob/encode changes)
:session-id sid))
chng (insert-change conn file)
msg {:type :file-change
:profile-id (:profile-id params)
:file-id (:id file)
:session-id sid
:revn (:revn file)
:changes changes}]
@(redis/run! :publish {:channel (str (:id file))
:message (t/encode-str msg)})
(db/update! conn :file
{:revn (:revn file)
:data (:data file)}
{:id (:id file)})
(retrieve-lagged-changes conn chng params)))
(defn- insert-change
[conn {:keys [revn data changes session-id] :as file}]
(let [id (uuid/next)
file-id (:id file)]
(db/insert! conn :file-change
{:id id
:session-id session-id
:file-id file-id
:revn revn
:data data
:changes changes})))
(def ^:private
sql:lagged-changes
"select s.id, s.revn, s.file_id,
s.session_id, s.changes
from file_change as s
where s.file_id = ?
and s.revn > ?
order by s.created_at asc")
(defn- retrieve-lagged-changes
[conn snapshot params]
(->> (db/exec! conn [sql:lagged-changes (:id params) (:revn params)])
(mapv files/decode-row)))

255
backend/src/app/services/mutations/pages.clj
View file

@ -1,255 +0,0 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz>
(ns app.services.mutations.pages
(:require
[clojure.spec.alpha :as s]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.pages :as cp]
[app.common.pages-migrations :as pmg]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
[app.services.mutations :as sm]
[app.services.queries.files :as files]
[app.services.queries.pages :refer [decode-row]]
[app.tasks :as tasks]
[app.redis :as redis]
[app.util.blob :as blob]
[app.util.time :as dt]
[app.util.transit :as t]))
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::data ::cp/data)
(s/def ::profile-id ::us/uuid)
(s/def ::project-id ::us/uuid)
(s/def ::ordering ::us/number)
(s/def ::file-id ::us/uuid)
;; --- Mutation: Create Page
(declare create-page)
(s/def ::create-page
(s/keys :req-un [::profile-id ::file-id ::name ::ordering ::data]
:opt-un [::id]))
(sm/defmutation ::create-page
[{:keys [profile-id file-id] :as params}]
(db/with-atomic [conn db/pool]
(files/check-edition-permissions! conn profile-id file-id)
(create-page conn params)))
(defn- create-page
[conn {:keys [id file-id name ordering data] :as params}]
(let [id (or id (uuid/next))
data (blob/encode data)]
(-> (db/insert! conn :page
{:id id
:file-id file-id
:name name
:ordering ordering
:data data})
(decode-row))))
;; --- Mutation: Rename Page
(declare rename-page)
(declare select-page-for-update)
(s/def ::rename-page
(s/keys :req-un [::id ::name ::profile-id]))
(sm/defmutation ::rename-page
[{:keys [id name profile-id]}]
(db/with-atomic [conn db/pool]
(let [page (select-page-for-update conn id)]
(files/check-edition-permissions! conn profile-id (:file-id page))
(rename-page conn (assoc page :name name)))))
(defn- select-page-for-update
[conn id]
(db/get-by-id conn :page id {:for-update true}))
(defn- rename-page
[conn {:keys [id name] :as params}]
(db/update! conn :page
{:name name}
{:id id}))
;; --- Mutation: Sort Pages
(s/def ::page-ids (s/every ::us/uuid :kind vector?))
(s/def ::reorder-pages
(s/keys :req-un [::profile-id ::file-id ::page-ids]))
(declare update-page-ordering)
(sm/defmutation ::reorder-pages
[{:keys [profile-id file-id page-ids]}]
(db/with-atomic [conn db/pool]
(run! #(update-page-ordering conn file-id %)
(d/enumerate page-ids))
nil))
(defn- update-page-ordering
[conn file-id [ordering page-id]]
(db/update! conn :page
{:ordering ordering}
{:file-id file-id
:id page-id}))
;; --- Mutation: Generate Share Token
(declare assign-page-share-token)
(s/def ::generate-page-share-token
(s/keys :req-un [::id]))
(sm/defmutation ::generate-page-share-token
[{:keys [id] :as params}]
(let [token (-> (sodi.prng/random-bytes 16)
(sodi.util/bytes->b64s))]
(db/with-atomic [conn db/pool]
(db/update! conn :page
{:share-token token}
{:id id}))))
;; --- Mutation: Clear Share Token
(s/def ::clear-page-share-token
(s/keys :req-un [::id]))
(sm/defmutation ::clear-page-share-token
[{:keys [id] :as params}]
(db/with-atomic [conn db/pool]
(db/update! conn :page
{:share-token nil}
{:id id})))
;; --- Mutation: Update Page
;; A generic, Changes based (granular) page update method.
(s/def ::changes
(s/coll-of map? :kind vector?))
(s/def ::session-id ::us/uuid)
(s/def ::revn ::us/integer)
(s/def ::update-page
(s/keys :req-un [::id ::session-id ::profile-id ::revn ::changes]))
(declare update-page)
(declare retrieve-lagged-changes)
(declare insert-page-change!)
(sm/defmutation ::update-page
[{:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(let [{:keys [file-id] :as page} (select-page-for-update conn id)]
(files/check-edition-permissions! conn profile-id file-id)
(update-page conn page params))))
(defn- update-page
[conn page params]
(when (> (:revn params)
(:revn page))
(ex/raise :type :validation
:code :revn-conflict
:hint "The incoming revision number is greater that stored version."
:context {:incoming-revn (:revn params)
:stored-revn (:revn page)}))
(let [sid (:session-id params)
changes (:changes params)
page (-> page
(update :data blob/decode)
(update :data pmg/migrate-data)
(update :data cp/process-changes changes)
(update :data blob/encode)
(update :revn inc)
(assoc :changes (blob/encode changes)
:session-id sid))
chng (insert-page-change! conn page)
msg {:type :page-change
:profile-id (:profile-id params)
:page-id (:id page)
:session-id sid
:revn (:revn page)
:changes changes}]
@(redis/run! :publish {:channel (str (:file-id page))
:message (t/encode-str msg)})
(db/update! conn :page
{:revn (:revn page)
:data (:data page)}
{:id (:id page)})
(retrieve-lagged-changes conn chng params)))
(defn- insert-page-change!
[conn {:keys [revn data changes session-id] :as page}]
(let [id (uuid/next)
page-id (:id page)]
(db/insert! conn :page-change
{:id id
:session-id session-id
:page-id page-id
:revn revn
:data data
:changes changes})))
(def ^:private
sql:lagged-changes
"select s.id, s.revn, s.page_id,
s.session_id, s.changes
from page_change as s
where s.page_id = ?
and s.revn > ?
order by s.created_at asc")
(defn- retrieve-lagged-changes
[conn snapshot params]
(->> (db/exec! conn [sql:lagged-changes (:id params) (:revn params)])
(mapv decode-row)))
;; --- Mutation: Delete Page
(declare mark-page-deleted)
(s/def ::delete-page
(s/keys :req-un [::profile-id ::id]))
(sm/defmutation ::delete-page
[{:keys [id profile-id]}]
(db/with-atomic [conn db/pool]
(let [page (select-page-for-update conn id)]
(files/check-edition-permissions! conn profile-id (:file-id page))
;; Schedule object deletion
(tasks/submit! conn {:name "delete-object"
:delay cfg/default-deletion-delay
:props {:id id :type :page}})
(db/update! conn :page
{:deleted-at (dt/now)}
{:id id})
nil)))

22
backend/src/app/services/mutations/teams.clj
View file

@ -5,7 +5,7 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.mutations.teams
(:require
@ -57,23 +57,3 @@
:is-owner true
:is-admin true
:can-edit true}))
;; --- Mutation: Team Edition Permissions
(def ^:private sql:team-permissions
"select tpr.is_owner,
tpr.is_admin,
tpr.can_edit
from team_profile_rel as tpr
where tpr.profile_id = ?
and tpr.team_id = ?")
(defn check-edition-permissions!
[conn profile-id team-id]
(let [row (db/exec-one! conn [sql:team-permissions profile-id team-id])]
(when-not (or (= team-id uuid/zero)
(:can-edit row)
(:is-admin row)
(:is-owner row))
(ex/raise :type :validation
:code :not-authorized))))

65
backend/src/app/services/mutations/viewer.clj Normal file
View file

@ -0,0 +1,65 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz>
(ns app.services.mutations.viewer
(:require
[app.common.exceptions :as ex]
[app.common.pages :as cp]
[app.common.pages-migrations :as pmg]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
[app.redis :as redis]
[app.services.mutations :as sm]
[app.services.mutations.projects :as proj]
[app.services.queries.files :as files]
[app.tasks :as tasks]
[app.util.blob :as blob]
[app.util.storage :as ust]
[app.util.time :as dt]
[app.util.transit :as t]
[clojure.spec.alpha :as s]
[datoteka.core :as fs]
[promesa.core :as p]
[sodi.prng]
[sodi.util]))
(s/def ::profile-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::page-id ::us/uuid)
(s/def ::create-file-share-token
(s/keys :req-un [::profile-id ::file-id ::page-id]))
(sm/defmutation ::create-file-share-token
[{:keys [profile-id file-id page-id] :as params}]
(db/with-atomic [conn db/pool]
(files/check-edition-permissions! conn profile-id file-id)
(let [token (-> (sodi.prng/random-bytes 16)
(sodi.util/bytes->b64s))]
(db/insert! conn :file-share-token
{:file-id file-id
:page-id page-id
:token token})
{:token token})))
(s/def ::token ::us/not-empty-string)
(s/def ::delete-file-share-token
(s/keys :req-un [::profile-id ::file-id ::token]))
(sm/defmutation ::delete-file-share-token
[{:keys [profile-id file-id token]}]
(db/with-atomic [conn db/pool]
(files/check-edition-permissions! conn profile-id file-id)
(db/delete! conn :file-share-token
{:file-id file-id
:token token})
nil))

76
backend/src/app/services/notifications.clj
View file

@ -10,17 +10,17 @@
(ns app.services.notifications
"A websocket based notifications mechanism."
(:require
[clojure.core.async :as a :refer [>! <!]]
[clojure.tools.logging :as log]
[promesa.core :as p]
[ring.adapter.jetty9 :as jetty]
[app.common.exceptions :as ex]
[app.common.uuid :as uuid]
[app.db :as db]
[app.redis :as redis]
[app.metrics :as mtx]
[app.redis :as redis]
[app.util.time :as dt]
[app.util.transit :as t]))
[app.util.transit :as t]
[clojure.core.async :as a :refer [>! <!]]
[clojure.tools.logging :as log]
[promesa.core :as p]
[ring.adapter.jetty9 :as jetty]))
(defmacro go-try
[& body]
@ -44,8 +44,6 @@
(catch Throwable e#
e#))))
;; --- Redis Interactions
(defn- publish
[channel message]
(go-try
@ -187,14 +185,6 @@
(defrecord WebSocket [conn in out sub])
(defn- start-rcv-loop!
[{:keys [conn out] :as ws}]
(a/go-loop []
(let [val (a/<! out)]
(when-not (nil? val)
(jetty/send! conn (t/encode-str val))
(recur)))))
(defonce metrics-active-connections
(mtx/gauge {:id "notificatons__active_connections"
:help "Active connections to the notifications service."}))
@ -207,30 +197,42 @@
[{:keys [file-id profile-id] :as params}]
(let [in (a/chan 32)
out (a/chan 32)]
{:on-connect (fn [conn]
(metrics-active-connections :inc)
(let [xf (map t/decode-str)
sub (redis/subscribe (str file-id) xf)
ws (WebSocket. conn in out sub nil params)]
(start-rcv-loop! ws)
(a/go
(a/<! (on-subscribed ws))
(a/close! sub))))
{:on-connect
(fn [conn]
(metrics-active-connections :inc)
(let [xf (map t/decode-str)
sub (redis/subscribe (str file-id) xf)
ws (WebSocket. conn in out sub nil params)]
:on-error (fn [conn e]
(a/close! out)
(a/close! in))
;; RCV LOOP
(a/go-loop []
(let [val (a/<! out)]
(when-not (nil? val)
(jetty/send! conn (t/encode-str val))
(recur))))
:on-close (fn [conn status-code reason]
(metrics-active-connections :dec)
(a/close! out)
(a/close! in))
(a/go
(a/<! (on-subscribed ws))
(a/close! sub))))
:on-text (fn [ws message]
(metrics-message-counter :inc)
(let [message (t/decode-str message)]
(a/>!! in message)))
:on-error
(fn [conn e]
(a/close! out)
(a/close! in))
:on-bytes (constantly nil)}))
:on-close
(fn [conn status-code reason]
(metrics-active-connections :dec)
(a/close! out)
(a/close! in))
:on-text
(fn [ws message]
(metrics-message-counter :inc)
(let [message (t/decode-str message)]
(a/>!! in message)))
:on-bytes
(constantly nil)}))

139
backend/src/app/services/queries/files.clj
View file

@ -11,14 +11,17 @@
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[app.common.pages-migrations :as pmg]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.db :as db]
[app.media :as media]
[app.services.queries :as sq]
[app.services.queries.projects :as projects]
[app.util.blob :as blob]))
(declare decode-row)
(declare decode-row-xf)
;; --- Helpers & Specs
@ -32,6 +35,8 @@
;; --- Query: Files search
;; TODO: this query need to a good refactor
(def ^:private sql:search-files
"with projects as (
select p.*
@ -82,58 +87,16 @@
profile-id team-id
profile-id team-id
search-term])]
(mapv decode-row rows)))
(into [] decode-row-xf rows)))
;; --- Query: Project Files
(def ^:private sql:files
"with projects as (
select p.*
from project as p
inner join team_profile_rel as tpr on (tpr.team_id = p.team_id)
where tpr.profile_id = ?
and p.deleted_at is null
and (tpr.is_admin = true or
tpr.is_owner = true or
tpr.can_edit = true)
union
select p.*
from project as p
inner join project_profile_rel as ppr on (ppr.project_id = p.id)
where ppr.profile_id = ?
and p.deleted_at is null
and (ppr.is_admin = true or
ppr.is_owner = true or
ppr.can_edit = true)
union
select p.*
from project as p
where p.team_id = uuid_nil()
and p.deleted_at is null
)
select distinct
f.*,
array_agg(pg.id) over pages_w as pages,
first_value(pg.data) over pages_w as data
"select f.*
from file as f
left join page as pg on (f.id = pg.file_id)
where f.project_id = ?
and (exists (select *
from file_profile_rel as fp_r
where fp_r.profile_id = ?
and fp_r.file_id = f.id
and (fp_r.is_admin = true or
fp_r.is_owner = true or
fp_r.can_edit = true))
or exists (select *
from projects as p
where p.id = f.project_id))
and f.deleted_at is null
and pg.deleted_at is null
window pages_w as (partition by f.id order by pg.ordering
range between unbounded preceding
and unbounded following)
order by f.modified_at desc")
(s/def ::project-id ::us/uuid)
@ -142,10 +105,10 @@
(sq/defquery ::files
[{:keys [profile-id project-id] :as params}]
(->> (db/exec! db/pool [sql:files
profile-id profile-id
project-id profile-id])
(mapv decode-row)))
(with-open [conn (db/open)]
(let [project (db/get-by-id conn :project project-id)]
(projects/check-edition-permissions! conn profile-id project)
(into [] decode-row-xf (db/exec! conn [sql:files project-id])))))
;; --- Query: File Permissions
@ -173,12 +136,7 @@
from project_profile_rel as ppr
inner join file as f on (f.project_id = ppr.project_id)
where f.id = ?
and ppr.profile_id = ?
union all
select true, true, true
from file as f
inner join project as p on (f.project_id = p.id)
and p.team_id = uuid_nil();")
and ppr.profile_id = ?")
(defn check-edition-permissions!
[conn profile-id file-id]
@ -198,24 +156,11 @@
;; --- Query: File (By ID)
(def ^:private sql:file
"select f.*,
array_agg(pg.id) over pages_w as pages
from file as f
left join page as pg on (f.id = pg.file_id)
where f.id = ?
and f.deleted_at is null
and pg.deleted_at is null
window pages_w as (partition by f.id order by pg.ordering
range between unbounded preceding
and unbounded following)")
(defn retrieve-file
[conn id]
(let [row (db/exec-one! conn [sql:file id])]
(when-not row
(ex/raise :type :not-found))
(decode-row row)))
(let [file (db/get-by-id conn :file id)]
(-> (decode-row file)
(pmg/migrate-file))))
(s/def ::file
(s/keys :req-un [::profile-id ::id]))
@ -226,6 +171,15 @@
(check-edition-permissions! conn profile-id id)
(retrieve-file conn id)))
(s/def ::page
(s/keys :req-un [::profile-id ::id ::file-id]))
(sq/defquery ::page
[{:keys [profile-id file-id id]}]
(db/with-atomic [conn db/pool]
(check-edition-permissions! conn profile-id file-id)
(let [file (retrieve-file conn file-id)]
(get-in file [:data :pages-index id]))))
;; --- Query: File users
@ -256,14 +210,12 @@
(check-edition-permissions! conn profile-id id)
(retrieve-file-users conn id)))
;; --- Query: Shared Library Files
;; TODO: remove the counts, because they are no longer needed.
(def ^:private sql:shared-files
"select distinct
f.*,
array_agg(pg.id) over pages_w as pages,
first_value(pg.data) over pages_w as data,
"select f.*,
(select count(*) from color as c
where c.file_id = f.id
and c.deleted_at is null) as colors_count,
@ -272,16 +224,11 @@
and m.is_local = false
and m.deleted_at is null) as graphics_count
from file as f
left join page as pg on (f.id = pg.file_id)
inner join project as p on (p.id = f.project_id)
where f.is_shared = true
and f.deleted_at is null
and pg.deleted_at is null
and p.deleted_at is null
and p.team_id = ?
window pages_w as (partition by f.id order by pg.ordering
range between unbounded preceding
and unbounded following)
order by f.modified_at desc")
(s/def ::shared-files
@ -289,30 +236,21 @@
(sq/defquery ::shared-files
[{:keys [profile-id team-id] :as params}]
(->> (db/exec! db/pool [sql:shared-files team-id])
(mapv decode-row)))
(into [] decode-row-xf (db/exec! db/pool [sql:shared-files team-id])))
;; --- Query: File Libraries used by a File
(def ^:private sql:file-libraries
"select fl.*,
array_agg(pg.id) over pages_w as pages,
first_value(pg.data) over pages_w as data
"select fl.*
from file as fl
left join page as pg on (fl.id = pg.file_id)
inner join file_library_rel as flr on (flr.library_file_id = fl.id)
where flr.file_id = ?
and fl.deleted_at is null
and pg.deleted_at is null
window pages_w as (partition by fl.id order by pg.ordering
range between unbounded preceding
and unbounded following)")
and fl.deleted_at is null")
(defn retrieve-file-libraries
[conn file-id]
(->> (db/exec! conn [sql:file-libraries file-id])
(mapv decode-row)))
(into [] decode-row-xf (db/exec! conn [sql:file-libraries file-id])))
(s/def ::file-libraries
(s/keys :req-un [::profile-id ::file-id]))
@ -326,6 +264,8 @@
;; --- Query: Single File Library
;; TODO: this looks like is duplicate of `::file`
(def ^:private sql:file-library
"select fl.*
from file as fl
@ -333,10 +273,10 @@
(defn retrieve-file-library
[conn file-id]
(let [row (db/exec-one! conn [sql:file-library file-id])]
(when-not row
(let [rows (db/exec! conn [sql:file-library file-id])]
(when-not (seq rows)
(ex/raise :type :not-found))
row))
(first (sequence decode-row-xf rows))))
(s/def ::file-library
(s/keys :req-un [::profile-id ::file-id]))
@ -351,8 +291,13 @@
;; --- Helpers
(defn decode-row
[{:keys [pages data] :as row}]
[{:keys [pages data changes] :as row}]
(when row
(cond-> row
changes (assoc :changes (blob/decode changes))
data (assoc :data (blob/decode data))
pages (assoc :pages (vec (.getArray pages))))))
(def decode-row-xf
(comp (map decode-row)
(map pmg/migrate-file)))

122
backend/src/app/services/queries/pages.clj
View file

@ -1,122 +0,0 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz>
(ns app.services.queries.pages
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[app.common.spec :as us]
[app.common.exceptions :as ex]
[app.common.pages-migrations :as pmg]
[app.db :as db]
[app.services.queries :as sq]
[app.services.queries.files :as files]
[app.util.blob :as blob]))
;; --- Helpers & Specs
(declare decode-row)
(s/def ::id ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::project-id ::us/uuid)
(s/def ::file-id ::us/uuid)
;; --- Query: Pages (By File ID)
(declare retrieve-pages)
(s/def ::pages
(s/keys :req-un [::profile-id ::file-id]))
(sq/defquery ::pages
[{:keys [profile-id file-id] :as params}]
(db/with-atomic [conn db/pool]
(files/check-edition-permissions! conn profile-id file-id)
(->> (retrieve-pages conn params)
(mapv #(update % :data pmg/migrate-data)))))
(def ^:private sql:pages
"select p.*
from page as p
where p.file_id = ?
and p.deleted_at is null
order by p.created_at asc")
(defn- retrieve-pages
[conn {:keys [profile-id file-id] :as params}]
(->> (db/exec! conn [sql:pages file-id])
(mapv decode-row)))
;; --- Query: Single Page (By ID)
(declare retrieve-page)
(s/def ::page
(s/keys :req-un [::profile-id ::id]))
(sq/defquery ::page
[{:keys [profile-id id] :as params}]
(with-open [conn (db/open)]
(let [page (retrieve-page conn id)]
(files/check-edition-permissions! conn profile-id (:file-id page))
(-> page
(update :data pmg/migrate-data)))))
(def ^:private sql:page
"select p.* from page as p where id=?")
(defn retrieve-page
[conn id]
(let [row (db/exec-one! conn [sql:page id])]
(when-not row
(ex/raise :type :not-found))
(decode-row row)))
;; --- Query: Page Changes
(def ^:private
sql:page-changes
"select pc.id,
pc.created_at,
pc.changes,
pc.revn
from page_change as pc
where pc.page_id=?
order by pc.revn asc
limit ?
offset ?")
(s/def ::skip ::us/integer)
(s/def ::limit ::us/integer)
(s/def ::page-changes
(s/keys :req-un [::profile-id ::id ::skip ::limit]))
(defn retrieve-page-changes
[conn id skip limit]
(->> (db/exec! conn [sql:page-changes id limit skip])
(mapv decode-row)))
(sq/defquery ::page-changes
[{:keys [profile-id id skip limit]}]
(when *assert*
(-> (db/exec! db/pool [sql:page-changes id limit skip])
(mapv decode-row))))
;; --- Helpers
(defn decode-row
[{:keys [data metadata changes] :as row}]
(when row
(cond-> row
data (assoc :data (blob/decode data))
changes (assoc :changes (blob/decode changes)))))

5
backend/src/app/services/queries/projects.clj
View file

@ -76,8 +76,9 @@
where f.project_id = p.id
and deleted_at is null)
from project as p
where team_id = ?
order by modified_at desc")
where p.team_id = ?
and p.deleted_at is null
order by p.modified_at desc")
(defn retrieve-projects
[conn team-id]

15
backend/src/app/services/queries/recent_files.clj
View file

@ -16,21 +16,13 @@
[app.services.queries :as sq]
[app.services.queries.teams :as teams]
[app.services.queries.projects :as projects :refer [retrieve-projects]]
[app.services.queries.files :refer [decode-row]]))
[app.services.queries.files :refer [decode-row-xf]]))
(def sql:project-recent-files
"select distinct
f.*,
array_agg(pg.id) over pages_w as pages,
first_value(pg.data) over pages_w as data
"select f.*
from file as f
left join page as pg on (f.id = pg.file_id)
where f.project_id = ?
and f.deleted_at is null
and pg.deleted_at is null
window pages_w as (partition by f.id order by pg.ordering
range between unbounded preceding
and unbounded following)
order by f.modified_at desc
limit 5")
@ -38,8 +30,7 @@
[conn profile-id project]
(let [project-id (:id project)]
(projects/check-edition-permissions! conn profile-id project)
(->> (db/exec! conn [sql:project-recent-files project-id])
(map decode-row))))
(into [] decode-row-xf (db/exec! conn [sql:project-recent-files project-id]))))
(s/def ::team-id ::us/uuid)
(s/def ::profile-id ::us/uuid)

66
backend/src/app/services/queries/viewer.clj
View file

@ -9,27 +9,18 @@
(ns app.services.queries.viewer
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[promesa.exec :as px]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db]
[app.services.queries :as sq]
[app.services.queries.files :as files]
[app.services.queries.media :as media-queries]
[app.services.queries.pages :as pages]
[app.util.blob :as blob]
[app.util.data :as data]))
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::page-id ::us/uuid)
[clojure.spec.alpha :as s]))
;; --- Query: Viewer Bundle (by Page ID)
(declare check-shared-token!)
(declare retrieve-shared-token)
(def ^:private
sql:project
"select p.id, p.name
@ -41,24 +32,45 @@
[conn id]
(db/exec-one! conn [sql:project id]))
(s/def ::id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::page-id ::us/uuid)
(s/def ::share-token ::us/string)
(s/def ::viewer-bundle
(s/keys :req-un [::page-id]
(s/keys :req-un [::file-id ::page-id]
:opt-un [::profile-id ::share-token]))
(sq/defquery ::viewer-bundle
[{:keys [profile-id page-id share-token] :as params}]
[{:keys [profile-id file-id page-id share-token] :as params}]
(db/with-atomic [conn db/pool]
(let [page (pages/retrieve-page conn page-id)
file (files/retrieve-file conn (:file-id page))
images (media-queries/retrieve-media-objects conn (:file-id page) true)
project (retrieve-project conn (:project-id file))]
(let [file (files/retrieve-file conn file-id)
project (retrieve-project conn (:project-id file))
page (get-in file [:data :pages-index page-id])
bundle {:file (dissoc file :data)
:page (get-in file [:data :pages-index page-id])
:project project}]
(if (string? share-token)
(when (not= share-token (:share-token page))
(ex/raise :type :validation
:code :not-authorized))
(files/check-edition-permissions! conn profile-id (:file-id page)))
{:page page
:file file
:images images
:project project})))
(do
(check-shared-token! conn file-id page-id share-token)
(assoc bundle :share-token share-token))
(let [token (retrieve-shared-token conn file-id page-id)]
(files/check-edition-permissions! conn profile-id file-id)
(assoc bundle :share-token token))))))
(defn check-shared-token!
[conn file-id page-id token]
(let [sql "select exists(select 1 from file_share_token where file_id=? and page_id=? and token=?) as exists"]
(when-not (:exists (db/exec-one! conn [sql file-id page-id token]))
(ex/raise :type :validation
:code :not-authorized))))
(defn retrieve-shared-token
[conn file-id page-id]
(let [sql "select * from file_share_token where file_id=? and page_id=?"]
(db/exec-one! conn [sql file-id page-id])))

33
backend/tests/app/tests/helpers.clj
View file

@ -1,3 +1,12 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.tests.helpers
(:require
[clojure.java.io :as io]
@ -13,7 +22,6 @@
[app.services.mutations.projects :as projects]
[app.services.mutations.teams :as teams]
[app.services.mutations.files :as files]
[app.services.mutations.pages :as pages]
[app.services.mutations.colors :as colors]
[app.migrations]
[app.media]
@ -90,9 +98,17 @@
(defn create-team
[conn profile-id i]
(#'teams/create-team conn {:id (mk-uuid "team" i)
:profile-id profile-id
:name (str "team" i)}))
(let [id (mk-uuid "team" i)
team (#'teams/create-team conn {:id id
:profile-id profile-id
:name (str "team" i)})]
(#'teams/create-team-profile conn
{:team-id id
:profile-id profile-id
:is-owner true
:is-admin true
:can-edit true})
team))
(defn create-project
[conn profile-id team-id i]
@ -109,15 +125,6 @@
:is-shared is-shared
:name (str "file" i)}))
(defn create-page
[conn profile-id file-id i]
(#'pages/create-page conn {:id (mk-uuid "page" i)
:profile-id profile-id
:file-id file-id
:name (str "page" i)
:ordering i
:data cp/default-page-data}))
(defn handle-error
[^Throwable err]
(if (instance? java.util.concurrent.ExecutionException err)

593
backend/tests/app/tests/test_common_pages.clj
View file

@ -5,7 +5,7 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 app Labs SL
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.tests.test-common-pages
(:require
@ -18,64 +18,80 @@
[app.tests.helpers :as th]))
(t/deftest process-change-set-option
(let [data cp/default-page-data]
(let [page-id (uuid/custom 1 1)
data (cp/make-file-data page-id)]
(t/testing "Sets option single"
(let [chg {:type :set-option
:page-id page-id
:option :test
:value "test"}
res (cp/process-changes data [chg])]
(t/is (= "test" (get-in res [:options :test])))))
(t/is (= "test" (get-in res [:pages-index page-id :options :test])))))
(t/testing "Sets option nested"
(let [chgs [{:type :set-option
:page-id page-id
:option [:values :test :a]
:value "a"}
{:type :set-option
:page-id page-id
:option [:values :test :b]
:value "b"}]
res (cp/process-changes data chgs)]
(t/is (= {:a "a" :b "b"} (get-in res [:options :values :test])))))
(t/is (= {:a "a" :b "b"}
(get-in res [:pages-index page-id :options :values :test])))))
(t/testing "Remove option single"
(let [chg {:type :set-option
:page-id page-id
:option :test
:value nil}
res (cp/process-changes data [chg])]
(t/is (empty? (keys (get res :options))))))
(t/is (empty? (keys (get-in res [:pages-index page-id :options]))))))
(t/testing "Remove option nested 1"
(let [chgs [{:type :set-option
:page-id page-id
:option [:values :test :a]
:value "a"}
{:type :set-option
:page-id page-id
:option [:values :test :b]
:value "b"}
{:type :set-option
:page-id page-id
:option [:values :test]
:value nil}]
res (cp/process-changes data chgs)]
(t/is (empty? (keys (get res :options))))))
(t/is (empty? (keys (get-in res [:pages-index page-id :options]))))))
(t/testing "Remove option nested 2"
(let [chgs [{:type :set-option
:option [:values :test1 :a]
:page-id page-id
:value "a"}
{:type :set-option
:option [:values :test2 :b]
:page-id page-id
:value "b"}
{:type :set-option
:page-id page-id
:option [:values :test2]
:value nil}]
res (cp/process-changes data chgs)]
(t/is (= [:test1] (keys (get-in res [:options :values]))))))))
(t/is (= [:test1] (keys (get-in res [:pages-index page-id :options :values]))))))
))
(t/deftest process-change-add-obj
(let [data cp/default-page-data
id-a (uuid/next)
id-b (uuid/next)
id-c (uuid/next)]
(let [page-id (uuid/custom 1 1)
data (cp/make-file-data page-id)
id-a (uuid/custom 2 1)
id-b (uuid/custom 2 2)
id-c (uuid/custom 2 3)]
(t/testing "Adds single object"
(let [chg {:type :add-obj
:page-id page-id
:id id-a
:parent-id uuid/zero
:frame-id uuid/zero
@ -88,168 +104,185 @@
;; (clojure.pprint/pprint data)
;; (clojure.pprint/pprint res)
(t/is (= 2 (count (:objects res))))
(t/is (= (:obj chg) (get-in res [:objects id-a])))
(t/is (= [id-a] (get-in res [:objects uuid/zero :shapes])))))
(let [objects (get-in res [:pages-index page-id :objects])]
(t/is (= 2 (count objects)))
(t/is (= (:obj chg) (get objects id-a)))
(t/is (= [id-a] (get-in objects [uuid/zero :shapes]))))))
(t/testing "Adds several objects with different indexes"
(let [data cp/default-page-data
chg (fn [id index] {:type :add-obj
:id id
:frame-id uuid/zero
:index index
:obj {:id id
:frame-id uuid/zero
:type :rect
:name (str id)}})
(let [chg (fn [id index]
{:type :add-obj
:page-id page-id
:id id
:frame-id uuid/zero
:index index
:obj {:id id
:frame-id uuid/zero
:type :rect
:name (str id)}})
res (cp/process-changes data [(chg id-a 0)
(chg id-b 0)
(chg id-c 1)])]
(t/is (= 4 (count (:objects res))))
(t/is (not (nil? (get-in res [:objects id-a]))))
(t/is (not (nil? (get-in res [:objects id-b]))))
(t/is (not (nil? (get-in res [:objects id-c]))))
(t/is (= [id-b id-c id-a] (get-in res [:objects uuid/zero :shapes])))))))
;; (clojure.pprint/pprint data)
;; (clojure.pprint/pprint res)
(let [objects (get-in res [:pages-index page-id :objects])]
(t/is (= 4 (count objects)))
(t/is (not (nil? (get objects id-a))))
(t/is (not (nil? (get objects id-b))))
(t/is (not (nil? (get objects id-c))))
(t/is (= [id-b id-c id-a] (get-in objects [uuid/zero :shapes]))))))
))
(t/deftest process-change-mod-obj
(t/testing "simple mod-obj"
(let [data cp/default-page-data
chg {:type :mod-obj
:id uuid/zero
:operations [{:type :set
:attr :name
:val "foobar"}]}
res (cp/process-changes data [chg])]
(t/is (= "foobar" (get-in res [:objects uuid/zero :name])))))
(let [page-id (uuid/custom 1 1)
data (cp/make-file-data page-id)]
(t/testing "simple mod-obj"
(let [chg {:type :mod-obj
:page-id page-id
:id uuid/zero
:operations [{:type :set
:attr :name
:val "foobar"}]}
res (cp/process-changes data [chg])]
(let [objects (get-in res [:pages-index page-id :objects])]
(t/is (= "foobar" (get-in objects [uuid/zero :name]))))))
(t/testing "mod-obj for not existing shape"
(let [data cp/default-page-data
chg {:type :mod-obj
:id (uuid/next)
:operations [{:type :set
:attr :name
:val "foobar"}]}
res (cp/process-changes data [chg])]
(t/is (= res cp/default-page-data)))))
(t/testing "mod-obj for not existing shape"
(let [chg {:type :mod-obj
:page-id page-id
:id (uuid/next)
:operations [{:type :set
:attr :name
:val "foobar"}]}
res (cp/process-changes data [chg])]
(t/is (= res data))))))
(t/deftest process-change-del-obj-1
(let [id (uuid/next)
data (-> cp/default-page-data
(assoc-in [:objects uuid/zero :shapes] [id])
(assoc-in [:objects id] {:id id
:frame-id uuid/zero
:type :rect
:name "rect"}))
chg {:type :del-obj
:id id}
res (cp/process-changes data [chg])]
(t/deftest process-change-del-obj
(let [page-id (uuid/custom 1 1)
id (uuid/custom 2 1)
data (cp/make-file-data page-id)
data (-> data
(assoc-in [:pages-index page-id :objects uuid/zero :shapes] [id])
(assoc-in [:pages-index page-id :objects id]
{:id id
:frame-id uuid/zero
:type :rect
:name "rect"}))]
(t/testing "delete"
(let [chg {:type :del-obj
:page-id page-id
:id id}
res (cp/process-changes data [chg])]
(t/is (= 1 (count (:objects res))))
(t/is (= [] (get-in res [:objects uuid/zero :shapes])))))
(let [objects (get-in res [:pages-index page-id :objects])]
(t/is (= 1 (count objects)))
(t/is (= [] (get-in objects [uuid/zero :shapes]))))))
(t/testing "delete idempotency"
(let [chg {:type :del-obj
:page-id page-id
:id id}
res1 (cp/process-changes data [chg])
res2 (cp/process-changes res1 [chg])]
(t/is (= res1 res2))
(let [objects (get-in res1 [:pages-index page-id :objects])]
(t/is (= 1 (count objects)))
(t/is (= [] (get-in objects [uuid/zero :shapes]))))))))
(t/deftest process-change-del-obj-2
(let [id (uuid/next)
data (-> cp/default-page-data
(assoc-in [:objects uuid/zero :shapes] [id])
(assoc-in [:objects id] {:id id
:frame-id uuid/zero
:type :rect
:name "rect"}))
chg {:type :del-obj
:id uuid/zero}
res (cp/process-changes data [chg])]
(t/is (= 0 (count (:objects res))))))
(t/deftest process-change-move-objects
(let [frame-a-id (uuid/custom 1)
frame-b-id (uuid/custom 2)
group-a-id (uuid/custom 3)
group-b-id (uuid/custom 4)
rect-a-id (uuid/custom 5)
rect-b-id (uuid/custom 6)
rect-c-id (uuid/custom 7)
rect-d-id (uuid/custom 8)
rect-e-id (uuid/custom 9)
(let [frame-a-id (uuid/custom 0 1)
frame-b-id (uuid/custom 0 2)
group-a-id (uuid/custom 0 3)
group-b-id (uuid/custom 0 4)
rect-a-id (uuid/custom 0 5)
rect-b-id (uuid/custom 0 6)
rect-c-id (uuid/custom 0 7)
rect-d-id (uuid/custom 0 8)
rect-e-id (uuid/custom 0 9)
data
(-> cp/default-page-data
(assoc-in [:objects uuid/zero :shapes] [frame-a-id frame-b-id])
(assoc-in [:objects frame-a-id]
{:id frame-a-id
:parent-id uuid/zero
:frame-id uuid/zero
:name "Frame a"
:shapes [group-a-id group-b-id rect-e-id]
:type :frame})
page-id (uuid/custom 1 1)
data (cp/make-file-data page-id)
(assoc-in [:objects frame-b-id]
{:id frame-b-id
:parent-id uuid/zero
:frame-id uuid/zero
:name "Frame b"
:shapes []
:type :frame})
data (update-in data [:pages-index page-id :objects]
#(-> %
(assoc-in [uuid/zero :shapes] [frame-a-id frame-b-id])
(assoc-in [frame-a-id]
{:id frame-a-id
:parent-id uuid/zero
:frame-id uuid/zero
:name "Frame a"
:shapes [group-a-id group-b-id rect-e-id]
:type :frame})
;; Groups
(assoc-in [:objects group-a-id]
{:id group-a-id
:name "Group A"
:type :group
:parent-id frame-a-id
:frame-id frame-a-id
:shapes [rect-a-id rect-b-id rect-c-id]})
(assoc-in [:objects group-b-id]
{:id group-b-id
:name "Group B"
:type :group
:parent-id frame-a-id
:frame-id frame-a-id
:shapes [rect-d-id]})
(assoc-in [frame-b-id]
{:id frame-b-id
:parent-id uuid/zero
:frame-id uuid/zero
:name "Frame b"
:shapes []
:type :frame})
;; Shapes
(assoc-in [:objects rect-a-id]
{:id rect-a-id
:name "Rect A"
:type :rect
:parent-id group-a-id
:frame-id frame-a-id})
;; Groups
(assoc-in [group-a-id]
{:id group-a-id
:name "Group A"
:type :group
:parent-id frame-a-id
:frame-id frame-a-id
:shapes [rect-a-id rect-b-id rect-c-id]})
(assoc-in [group-b-id]
{:id group-b-id
:name "Group B"
:type :group
:parent-id frame-a-id
:frame-id frame-a-id
:shapes [rect-d-id]})
(assoc-in [:objects rect-b-id]
{:id rect-b-id
:name "Rect B"
:type :rect
:parent-id group-a-id
:frame-id frame-a-id})
;; Shapes
(assoc-in [rect-a-id]
{:id rect-a-id
:name "Rect A"
:type :rect
:parent-id group-a-id
:frame-id frame-a-id})
(assoc-in [:objects rect-c-id]
{:id rect-c-id
:name "Rect C"
:type :rect
:parent-id group-a-id
:frame-id frame-a-id})
(assoc-in [rect-b-id]
{:id rect-b-id
:name "Rect B"
:type :rect
:parent-id group-a-id
:frame-id frame-a-id})
(assoc-in [:objects rect-d-id]
{:id rect-d-id
:name "Rect D"
:parent-id group-b-id
:type :rect
:frame-id frame-a-id})
(assoc-in [rect-c-id]
{:id rect-c-id
:name "Rect C"
:type :rect
:parent-id group-a-id
:frame-id frame-a-id})
(assoc-in [:objects rect-e-id]
{:id rect-e-id
:name "Rect E"
:type :rect
:parent-id frame-a-id
:frame-id frame-a-id}))]
(assoc-in [rect-d-id]
{:id rect-d-id
:name "Rect D"
:parent-id group-b-id
:type :rect
:frame-id frame-a-id})
(assoc-in [rect-e-id]
{:id rect-e-id
:name "Rect E"
:type :rect
:parent-id frame-a-id
:frame-id frame-a-id})))]
(t/testing "Create new group an add objects from the same group"
(let [new-group-id (uuid/next)
changes [{:type :add-obj
:page-id page-id
:id new-group-id
:frame-id frame-a-id
:obj {:id new-group-id
@ -257,6 +290,7 @@
:frame-id frame-a-id
:name "Group C"}}
{:type :mov-objects
:page-id page-id
:parent-id new-group-id
:shapes [rect-b-id rect-c-id]}]
res (cp/process-changes data changes)]
@ -265,94 +299,112 @@
;; (println "===============")
;; (clojure.pprint/pprint res)
(t/is (= [group-a-id group-b-id rect-e-id new-group-id]
(get-in res [:objects frame-a-id :shapes])))
(t/is (= [rect-b-id rect-c-id]
(get-in res [:objects new-group-id :shapes])))
(t/is (= [rect-a-id]
(get-in res [:objects group-a-id :shapes])))))
(let [objects (get-in res [:pages-index page-id :objects])]
(t/is (= [group-a-id group-b-id rect-e-id new-group-id]
(get-in objects [frame-a-id :shapes])))
(t/is (= [rect-b-id rect-c-id]
(get-in objects [new-group-id :shapes])))
(t/is (= [rect-a-id]
(get-in objects [group-a-id :shapes]))))))
(t/testing "Move elements to an existing group at index"
(let [changes [{:type :mov-objects
:page-id page-id
:parent-id group-b-id
:index 0
:shapes [rect-a-id rect-c-id]}]
res (cp/process-changes data changes)]
(t/is (= [group-a-id group-b-id rect-e-id]
(get-in res [:objects frame-a-id :shapes])))
(t/is (= [rect-b-id]
(get-in res [:objects group-a-id :shapes])))
(t/is (= [rect-a-id rect-c-id rect-d-id]
(get-in res [:objects group-b-id :shapes])))))
(let [objects (get-in res [:pages-index page-id :objects])]
(t/is (= [group-a-id group-b-id rect-e-id]
(get-in objects [frame-a-id :shapes])))
(t/is (= [rect-b-id]
(get-in objects [group-a-id :shapes])))
(t/is (= [rect-a-id rect-c-id rect-d-id]
(get-in objects [group-b-id :shapes]))))))
(t/testing "Move elements from group and frame to an existing group at index"
(let [changes [{:type :mov-objects
:page-id page-id
:parent-id group-b-id
:index 0
:shapes [rect-a-id rect-e-id]}]
res (cp/process-changes data changes)]
(t/is (= [group-a-id group-b-id]
(get-in res [:objects frame-a-id :shapes])))
(t/is (= [rect-b-id rect-c-id]
(get-in res [:objects group-a-id :shapes])))
(t/is (= [rect-a-id rect-e-id rect-d-id]
(get-in res [:objects group-b-id :shapes])))))
(let [objects (get-in res [:pages-index page-id :objects])]
(t/is (= [group-a-id group-b-id]
(get-in objects [frame-a-id :shapes])))
(t/is (= [rect-b-id rect-c-id]
(get-in objects [group-a-id :shapes])))
(t/is (= [rect-a-id rect-e-id rect-d-id]
(get-in objects [group-b-id :shapes]))))))
(t/testing "Move elements from several groups"
(let [changes [{:type :mov-objects
:page-id page-id
:parent-id group-b-id
:index 0
:shapes [rect-a-id rect-e-id]}]
res (cp/process-changes data changes)]
(t/is (= [group-a-id group-b-id]
(get-in res [:objects frame-a-id :shapes])))
(t/is (= [rect-b-id rect-c-id]
(get-in res [:objects group-a-id :shapes])))
(t/is (= [rect-a-id rect-e-id rect-d-id]
(get-in res [:objects group-b-id :shapes])))))
(let [objects (get-in res [:pages-index page-id :objects])]
(t/is (= [group-a-id group-b-id]
(get-in objects [frame-a-id :shapes])))
(t/is (= [rect-b-id rect-c-id]
(get-in objects [group-a-id :shapes])))
(t/is (= [rect-a-id rect-e-id rect-d-id]
(get-in objects [group-b-id :shapes]))))))
(t/testing "Move elements and delete the empty group"
(let [changes [{:type :mov-objects
:page-id page-id
:parent-id group-a-id
:shapes [rect-d-id]}]
res (cp/process-changes data changes)]
(t/is (= [group-a-id rect-e-id]
(get-in res [:objects frame-a-id :shapes])))
(t/is (nil? (get-in res [:objects group-b-id])))))
(let [objects (get-in res [:pages-index page-id :objects])]
(t/is (= [group-a-id rect-e-id]
(get-in objects [frame-a-id :shapes])))
(t/is (nil? (get-in objects [group-b-id]))))))
(t/testing "Move elements to a group with different frame"
(let [changes [{:type :mov-objects
:page-id page-id
:parent-id frame-b-id
:shapes [group-a-id]}]
res (cp/process-changes data changes)]
(t/is (= [group-b-id rect-e-id] (get-in res [:objects frame-a-id :shapes])))
(t/is (= [group-a-id] (get-in res [:objects frame-b-id :shapes])))
(t/is (= frame-b-id (get-in res [:objects group-a-id :frame-id])))
(t/is (= frame-b-id (get-in res [:objects rect-a-id :frame-id])))
(t/is (= frame-b-id (get-in res [:objects rect-b-id :frame-id])))
(t/is (= frame-b-id (get-in res [:objects rect-c-id :frame-id])))))
;; (pprint (get-in data [:pages-index page-id :objects]))
;; (println "==========")
;; (pprint (get-in res [:pages-index page-id :objects]))
(let [objects (get-in res [:pages-index page-id :objects])]
(t/is (= [group-b-id rect-e-id] (get-in objects [frame-a-id :shapes])))
(t/is (= [group-a-id] (get-in objects [frame-b-id :shapes])))
(t/is (= frame-b-id (get-in objects [group-a-id :frame-id])))
(t/is (= frame-b-id (get-in objects [rect-a-id :frame-id])))
(t/is (= frame-b-id (get-in objects [rect-b-id :frame-id])))
(t/is (= frame-b-id (get-in objects [rect-c-id :frame-id]))))))
(t/testing "Move elements to frame zero"
(let [changes [{:type :mov-objects
:page-id page-id
:parent-id uuid/zero
:shapes [group-a-id]
:index 0}]
res (cp/process-changes data changes)]
;; (pprint (get-in data [:objects uuid/zero]))
;; (println "==========")
;; (pprint (get-in res [:objects uuid/zero]))
(let [objects (get-in res [:pages-index page-id :objects])]
;; (pprint (get-in data [:objects uuid/zero]))
;; (println "==========")
;; (pprint (get-in objects [uuid/zero]))
(t/is (= [group-a-id frame-a-id frame-b-id]
(get-in res [:objects cp/root :shapes])))))
(t/is (= [group-a-id frame-a-id frame-b-id]
(get-in objects [cp/root :shapes]))))))
(t/testing "Don't allow to move inside self"
(let [changes [{:type :mov-objects
:page-id page-id
:parent-id group-a-id
:shapes [group-a-id]}]
res (cp/process-changes data changes)]
@ -365,19 +417,24 @@
shape-2-id (uuid/custom 2 2)
shape-3-id (uuid/custom 2 3)
frame-id (uuid/custom 1 1)
page-id (uuid/custom 0 1)
changes [{:type :add-obj
:id frame-id
:page-id page-id
:parent-id uuid/zero
:frame-id uuid/zero
:obj {:type :frame
:name "Frame"}}
{:type :add-obj
:page-id page-id
:frame-id frame-id
:parent-id frame-id
:id shape-1-id
:obj {:type :shape
:name "Shape 1"}}
{:type :add-obj
:page-id page-id
:id shape-2-id
:parent-id uuid/zero
:frame-id uuid/zero
@ -385,16 +442,19 @@
:name "Shape 2"}}
{:type :add-obj
:page-id page-id
:id shape-3-id
:parent-id uuid/zero
:frame-id uuid/zero
:obj {:type :rect
:name "Shape 3"}}
]
data (cp/process-changes cp/default-page-data changes)]
data (cp/make-file-data page-id)
data (cp/process-changes data changes)]
(t/testing "preserve order on multiple shape mov 1"
(let [changes [{:type :mov-objects
:page-id page-id
:shapes [shape-2-id shape-3-id]
:parent-id uuid/zero
:index 0}]
@ -406,12 +466,13 @@
;; (pprint (get-in res [:objects]))
(t/is (= [frame-id shape-2-id shape-3-id]
(get-in data [:objects uuid/zero :shapes])))
(get-in data [:pages-index page-id :objects uuid/zero :shapes])))
(t/is (= [shape-2-id shape-3-id frame-id]
(get-in res [:objects uuid/zero :shapes])))))
(get-in res [:pages-index page-id :objects uuid/zero :shapes])))))
(t/testing "preserve order on multiple shape mov 1"
(let [changes [{:type :mov-objects
:page-id page-id
:shapes [shape-3-id shape-2-id]
:parent-id uuid/zero
:index 0}]
@ -423,23 +484,25 @@
;; (pprint (get-in res [:objects]))
(t/is (= [frame-id shape-2-id shape-3-id]
(get-in data [:objects uuid/zero :shapes])))
(get-in data [:pages-index page-id :objects uuid/zero :shapes])))
(t/is (= [shape-3-id shape-2-id frame-id]
(get-in res [:objects uuid/zero :shapes])))))
(get-in res [:pages-index page-id :objects uuid/zero :shapes])))))
(t/testing "move inside->outside-inside"
(let [changes [{:type :mov-objects
:page-id page-id
:shapes [shape-2-id]
:parent-id frame-id}
{:type :mov-objects
:page-id page-id
:shapes [shape-2-id]
:parent-id uuid/zero}]
res (cp/process-changes data changes)]
(t/is (= (get-in res [:objects shape-1-id :frame-id])
(get-in data [:objects shape-1-id :frame-id])))
(t/is (= (get-in res [:objects shape-2-id :frame-id])
(get-in data [:objects shape-2-id :frame-id])))))
(t/is (= (get-in res [:pages-index page-id :objects shape-1-id :frame-id])
(get-in data [:pages-index page-id :objects shape-1-id :frame-id])))
(t/is (= (get-in res [:pages-index page-id :objects shape-2-id :frame-id])
(get-in data [:pages-index page-id :objects shape-2-id :frame-id])))))
))
@ -450,43 +513,54 @@
shape-3-id (uuid/custom 1 3)
shape-4-id (uuid/custom 1 4)
group-1-id (uuid/custom 1 5)
page-id (uuid/custom 0 1)
changes [{:type :add-obj
:page-id page-id
:id shape-1-id
:frame-id cp/root
:obj {:id shape-1-id
:type :rect
:name "Shape a"}}
{:type :add-obj
:page-id page-id
:id shape-2-id
:frame-id cp/root
:obj {:id shape-2-id
:type :rect
:name "Shape b"}}
{:type :add-obj
:page-id page-id
:id shape-3-id
:frame-id cp/root
:obj {:id shape-3-id
:type :rect
:name "Shape c"}}
{:type :add-obj
:page-id page-id
:id shape-4-id
:frame-id cp/root
:obj {:id shape-4-id
:type :rect
:name "Shape d"}}
{:type :add-obj
:page-id page-id
:id group-1-id
:frame-id cp/root
:obj {:id group-1-id
:type :group
:name "Group"}}
{:type :mov-objects
:page-id page-id
:parent-id group-1-id
:shapes [shape-1-id shape-2-id]}]
data (cp/process-changes cp/default-page-data changes)]
data (cp/make-file-data page-id)
data (cp/process-changes data changes)]
(t/testing "case 1"
(let [changes [{:type :mov-objects
:page-id page-id
:parent-id cp/root
:index 2
:shapes [shape-3-id]}]
@ -495,19 +569,20 @@
;; Before
(t/is (= [shape-3-id shape-4-id group-1-id]
(get-in data [:objects cp/root :shapes])))
(get-in data [:pages-index page-id :objects cp/root :shapes])))
;; After
(t/is (= [shape-4-id shape-3-id group-1-id]
(get-in res [:objects cp/root :shapes])))
(get-in res [:pages-index page-id :objects cp/root :shapes])))
;; (pprint (get-in data [:objects cp/root]))
;; (pprint (get-in res [:objects cp/root]))
;; (pprint (get-in data [:pages-index page-id :objects cp/root]))
;; (pprint (get-in res [:pages-index page-id :objects cp/root]))
))
(t/testing "case 2"
(let [changes [{:type :mov-objects
:page-id page-id
:parent-id group-1-id
:index 2
:shapes [shape-3-id]}]
@ -516,25 +591,26 @@
;; Before
(t/is (= [shape-3-id shape-4-id group-1-id]
(get-in data [:objects cp/root :shapes])))
(get-in data [:pages-index page-id :objects cp/root :shapes])))
(t/is (= [shape-1-id shape-2-id]
(get-in data [:objects group-1-id :shapes])))
(get-in data [:pages-index page-id :objects group-1-id :shapes])))
;; After:
(t/is (= [shape-4-id group-1-id]
(get-in res [:objects cp/root :shapes])))
(get-in res [:pages-index page-id :objects cp/root :shapes])))
(t/is (= [shape-1-id shape-2-id shape-3-id]
(get-in res [:objects group-1-id :shapes])))
(get-in res [:pages-index page-id :objects group-1-id :shapes])))
;; (pprint (get-in data [:objects group-1-id]))
;; (pprint (get-in res [:objects group-1-id]))
;; (pprint (get-in data [:pages-index page-id :objects group-1-id]))
;; (pprint (get-in res [:pages-index page-id :objects group-1-id]))
))
(t/testing "case 3"
(let [changes [{:type :mov-objects
:page-id page-id
:parent-id group-1-id
:index 1
:shapes [shape-3-id]}]
@ -543,25 +619,26 @@
;; Before
(t/is (= [shape-3-id shape-4-id group-1-id]
(get-in data [:objects cp/root :shapes])))
(get-in data [:pages-index page-id :objects cp/root :shapes])))
(t/is (= [shape-1-id shape-2-id]
(get-in data [:objects group-1-id :shapes])))
(get-in data [:pages-index page-id :objects group-1-id :shapes])))
;; After
(t/is (= [shape-4-id group-1-id]
(get-in res [:objects cp/root :shapes])))
(get-in res [:pages-index page-id :objects cp/root :shapes])))
(t/is (= [shape-1-id shape-3-id shape-2-id]
(get-in res [:objects group-1-id :shapes])))
(get-in res [:pages-index page-id :objects group-1-id :shapes])))
;; (pprint (get-in data [:objects group-1-id]))
;; (pprint (get-in res [:objects group-1-id]))
;; (pprint (get-in data [:pages-index page-id :objects group-1-id]))
;; (pprint (get-in res [:pages-index page-id :objects group-1-id]))
))
(t/testing "case 4"
(let [changes [{:type :mov-objects
:page-id page-id
:parent-id group-1-id
:index 0
:shapes [shape-3-id]}]
@ -570,135 +647,85 @@
;; Before
(t/is (= [shape-3-id shape-4-id group-1-id]
(get-in data [:objects cp/root :shapes])))
(get-in data [:pages-index page-id :objects cp/root :shapes])))
(t/is (= [shape-1-id shape-2-id]
(get-in data [:objects group-1-id :shapes])))
(get-in data [:pages-index page-id :objects group-1-id :shapes])))
;; After
(t/is (= [shape-4-id group-1-id]
(get-in res [:objects cp/root :shapes])))
(get-in res [:pages-index page-id :objects cp/root :shapes])))
(t/is (= [shape-3-id shape-1-id shape-2-id]
(get-in res [:objects group-1-id :shapes])))
(get-in res [:pages-index page-id :objects group-1-id :shapes])))
;; (pprint (get-in data [:objects group-1-id]))
;; (pprint (get-in res [:objects group-1-id]))
;; (pprint (get-in data [:pages-index page-id :objects group-1-id]))
;; (pprint (get-in res [:pages-index page-id :objects group-1-id]))
))
(t/testing "case 5"
(let [changes [{:type :mov-objects
:page-id page-id
:parent-id cp/root
:index 0
:shapes [shape-2-id]}]
res (cp/process-changes data changes)]
;; (pprint (get-in data [:objects cp/root]))
;; (pprint (get-in res [:objects cp/root]))
;; (pprint (get-in data [:pages-index page-id :objects cp/root]))
;; (pprint (get-in res [:pages-index page-id :objects cp/root]))
;; (pprint (get-in data [:objects group-1-id]))
;; (pprint (get-in res [:objects group-1-id]))
;; (pprint (get-in data [:pages-index page-id :objects group-1-id]))
;; (pprint (get-in res [:pages-index page-id :objects group-1-id]))
;; Before
(t/is (= [shape-3-id shape-4-id group-1-id]
(get-in data [:objects cp/root :shapes])))
(get-in data [:pages-index page-id :objects cp/root :shapes])))
(t/is (= [shape-1-id shape-2-id]
(get-in data [:objects group-1-id :shapes])))
(get-in data [:pages-index page-id :objects group-1-id :shapes])))
;; After
(t/is (= [shape-2-id shape-3-id shape-4-id group-1-id]
(get-in res [:objects cp/root :shapes])))
(get-in res [:pages-index page-id :objects cp/root :shapes])))
(t/is (= [shape-1-id]
(get-in res [:objects group-1-id :shapes])))
(get-in res [:pages-index page-id :objects group-1-id :shapes])))
))
(t/testing "case 6"
(let [changes [{:type :mov-objects
:page-id page-id
:parent-id cp/root
:index 0
:shapes [shape-2-id shape-1-id]}]
res (cp/process-changes data changes)]
;; (pprint (get-in data [:objects cp/root]))
;; (pprint (get-in res [:objects cp/root]))
;; (pprint (get-in data [:pages-index page-id :objects cp/root]))
;; (pprint (get-in res [:pages-index page-id :objects cp/root]))
;; (pprint (get-in data [:objects group-1-id]))
;; (pprint (get-in res [:objects group-1-id]))
;; (pprint (get-in data [:pages-index page-id :objects group-1-id]))
;; (pprint (get-in res [:pages-index page-id :objects group-1-id]))
;; Before
(t/is (= [shape-3-id shape-4-id group-1-id]
(get-in data [:objects cp/root :shapes])))
(get-in data [:pages-index page-id :objects cp/root :shapes])))
(t/is (= [shape-1-id shape-2-id]
(get-in data [:objects group-1-id :shapes])))
(get-in data [:pages-index page-id :objects group-1-id :shapes])))
;; After
(t/is (= [shape-2-id shape-1-id shape-3-id shape-4-id]
(get-in res [:objects cp/root :shapes])))
(get-in res [:pages-index page-id :objects cp/root :shapes])))
(t/is (= nil
(get-in res [:objects group-1-id])))
(get-in res [:pages-index page-id :objects group-1-id])))
))
))
(t/deftest idenpotency-regression-1
(let [data {:version 5
:objects
{#uuid "00000000-0000-0000-0000-000000000000"
{:id #uuid "00000000-0000-0000-0000-000000000000",
:type :frame,
:name "root",
:shapes
[#uuid "f5d51910-ab23-11ea-ac38-e1abed64181a"
#uuid "f6a36590-ab23-11ea-ac38-e1abed64181a"]},
#uuid "f5d51910-ab23-11ea-ac38-e1abed64181a"
{:name "Rect-1",
:type :rect,
:id #uuid "f5d51910-ab23-11ea-ac38-e1abed64181a",
:parent-id #uuid "00000000-0000-0000-0000-000000000000",
:frame-id #uuid "00000000-0000-0000-0000-000000000000"}
#uuid "f6a36590-ab23-11ea-ac38-e1abed64181a"
{:name "Rect-2",
:type :rect,
:id #uuid "f6a36590-ab23-11ea-ac38-e1abed64181a",
:parent-id #uuid "00000000-0000-0000-0000-000000000000",
:frame-id #uuid "00000000-0000-0000-0000-000000000000"}}}
chgs [{:type :add-obj,
:id #uuid "3375ec40-ab24-11ea-b512-b945e8edccf5",
:frame-id #uuid "00000000-0000-0000-0000-000000000000",
:index 0
:obj {:name "Group-1",
:type :group,
:id #uuid "3375ec40-ab24-11ea-b512-b945e8edccf5",
:frame-id #uuid "00000000-0000-0000-0000-000000000000"}}
{:type :mov-objects,
:parent-id #uuid "3375ec40-ab24-11ea-b512-b945e8edccf5",
:shapes
[#uuid "f5d51910-ab23-11ea-ac38-e1abed64181a"
#uuid "f6a36590-ab23-11ea-ac38-e1abed64181a"]}]
res1 (cp/process-changes data chgs)
res2 (cp/process-changes res1 chgs)]
;; (clojure.pprint/pprint data)
;; (println "==============")
;; (clojure.pprint/pprint res2)
(t/is (= [#uuid "f5d51910-ab23-11ea-ac38-e1abed64181a"
#uuid "f6a36590-ab23-11ea-ac38-e1abed64181a"]
(get-in data [:objects uuid/zero :shapes])))
(t/is (= [#uuid "3375ec40-ab24-11ea-b512-b945e8edccf5"]
(get-in res2 [:objects uuid/zero :shapes])))
(t/is (= [#uuid "3375ec40-ab24-11ea-b512-b945e8edccf5"]
(get-in res1 [:objects uuid/zero :shapes])))
))

5
backend/tests/app/tests/test_emails.clj
View file

@ -2,7 +2,10 @@
;; 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) 2019 Andrey Antukh <niwi@niwi.nz>
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.tests.test-emails
(:require

102
backend/tests/app/tests/test_services_colors.clj
View file

@ -1,102 +0,0 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 app Labs SL
(ns app.tests.test-services-colors
(:require
[clojure.test :as t]
[datoteka.core :as fs]
[clojure.java.io :as io]
[app.db :as db]
[app.services.mutations :as sm]
[app.services.queries :as sq]
[app.util.storage :as ust]
[app.common.uuid :as uuid]
[app.tests.helpers :as th]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest colors-crud
(let [prof (th/create-profile db/pool 1)
team-id (:default-team-id prof)
proj (th/create-project db/pool (:id prof) team-id 1)
file (th/create-file db/pool (:id prof) (:id proj) true 1)
color-id (uuid/next)]
(t/testing "upload color to library file"
(let [data {::sm/type :create-color
:id color-id
:profile-id (:id prof)
:file-id (:id file)
:name "testfile"
:content "#222222"}
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= (:id data) (:id result)))
(t/is (= (:name data) (:name result)))
(t/is (= (:content data) (:content result))))))
(t/testing "list colors by library file"
(let [data {::sq/type :colors
:profile-id (:id prof)
:file-id (:id file)}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(t/is (= color-id (get-in out [:result 0 :id])))
(t/is (= "testfile" (get-in out [:result 0 :name])))))
(t/testing "get single color"
(let [data {::sq/type :color
:profile-id (:id prof)
:id color-id}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(t/is (= color-id (get-in out [:result :id])))
(t/is (= "testfile" (get-in out [:result :name])))))
(t/testing "delete colors"
(let [data {::sm/type :delete-color
:profile-id (:id prof)
:id color-id}
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (get-in out [:result])))))
(t/testing "query color after delete"
(let [data {::sq/type :color
:profile-id (:id prof)
:id color-id}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(let [error (:error out)]
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :service-error)))
(let [error (ex-cause (:error out))]
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :not-found)))))
(t/testing "query colors after delete"
(let [data {::sq/type :colors
:profile-id (:id prof)
:file-id (:id file)}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(let [result (:result out)]
(t/is (= 0 (count result))))))
))

9
backend/tests/app/tests/test_services_files.clj
View file

@ -5,7 +5,7 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 app Labs SL
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.tests.test-services-files
(:require
@ -70,7 +70,7 @@
(t/is (= 1 (count result)))
(t/is (= file-id (get-in result [0 :id])))
(t/is (= "new name" (get-in result [0 :name])))
(t/is (= 1 (count (get-in result [0 :pages])))))))
(t/is (= 1 (count (get-in result [0 :data :pages])))))))
(t/testing "query single file without users"
(let [data {::sq/type :file
@ -84,8 +84,7 @@
(let [result (:result out)]
(t/is (= file-id (:id result)))
(t/is (= "new name" (:name result)))
(t/is (vector? (:pages result)))
(t/is (= 1 (count (:pages result))))
(t/is (= 1 (count (get-in result [:data :pages]))))
(t/is (nil? (:users result))))))
(t/testing "delete file"
@ -128,5 +127,3 @@
(let [result (:result out)]
(t/is (= 0 (count result))))))
))
;; TODO: delete file image

21
backend/tests/app/tests/test_services_media.clj
View file

@ -5,7 +5,7 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 app Labs SL
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.tests.test-services-media
(:require
@ -30,7 +30,7 @@
object-id-2 (uuid/next)]
(t/testing "create media object from url to file"
(let [url "https://raw.githubusercontent.com/app/app/develop/frontend/resources/images/penpot-login.jpg"
(let [url "https://raw.githubusercontent.com/uxbox/uxbox/develop/sample_media/images/unsplash/anna-pelzer.jpg"
data {::sm/type :add-media-object-from-url
:id object-id-1
:profile-id (:id prof)
@ -45,12 +45,12 @@
(t/is (= object-id-1 (get-in out [:result :id])))
(t/is (not (nil? (get-in out [:result :name]))))
(t/is (= "image/jpeg" (get-in out [:result :mtype])))
(t/is (= 787 (get-in out [:result :width])))
(t/is (= 2000 (get-in out [:result :height])))
(t/is (= 1024 (get-in out [:result :width])))
(t/is (= 683 (get-in out [:result :height])))
(t/is (string? (get-in out [:result :path])))
(t/is (string? (get-in out [:result :uri])))
(t/is (string? (get-in out [:result :thumb-uri])))))
(t/is (string? (get-in out [:result :thumb-path])))
))
(t/testing "upload media object to file"
(let [content {:filename "sample.jpg"
@ -76,8 +76,7 @@
(t/is (= 800 (get-in out [:result :height])))
(t/is (string? (get-in out [:result :path])))
(t/is (string? (get-in out [:result :uri])))
(t/is (string? (get-in out [:result :thumb-uri])))))
(t/is (string? (get-in out [:result :thumb-path])))))
(t/testing "list media objects by file"
(let [data {::sq/type :media-objects
@ -95,8 +94,7 @@
(t/is (= 800 (get-in out [:result 0 :height])))
(t/is (string? (get-in out [:result 0 :path])))
(t/is (string? (get-in out [:result 0 :uri])))
(t/is (string? (get-in out [:result 0 :thumb-uri])))))
(t/is (string? (get-in out [:result 0 :thumb-path])))))
(t/testing "single media object"
(let [data {::sq/type :media-object
@ -111,8 +109,7 @@
(t/is (= 800 (get-in out [:result :width])))
(t/is (= 800 (get-in out [:result :height])))
(t/is (string? (get-in out [:result :path])))
(t/is (string? (get-in out [:result :uri])))))
(t/is (string? (get-in out [:result :path])))))
(t/testing "delete media objects"
(let [data {::sm/type :delete-media-object

221
backend/tests/app/tests/test_services_pages.clj
View file

@ -1,221 +0,0 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 app Labs SL
(ns app.tests.test-services-pages
(:require
[clojure.spec.alpha :as s]
[clojure.test :as t]
[promesa.core :as p]
[app.common.pages :as cp]
[app.db :as db]
[app.http :as http]
[app.services.mutations :as sm]
[app.services.queries :as sq]
[app.common.uuid :as uuid]
[app.tests.helpers :as th]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest pages-crud
(let [prof (th/create-profile db/pool 1)
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
file (th/create-file db/pool (:id prof) proj-id false 1)
page-id (uuid/next)]
(t/testing "create page"
(let [data {::sm/type :create-page
:data cp/default-page-data
:file-id (:id file)
:id page-id
:ordering 1
:name "test page"
:profile-id (:id prof)}
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (uuid? (:id result)))
(t/is (= (:id data) (:id result)))
(t/is (= (:name data) (:name result)))
(t/is (= (:data data) (:data result)))
(t/is (nil? (:share-token result)))
(t/is (= 0 (:revn result))))))
(t/testing "generate share token"
(let [data {::sm/type :generate-page-share-token
:id page-id}
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (string? (:share-token result))))))
(t/testing "query pages"
(let [data {::sq/type :pages
:file-id (:id file)
:profile-id (:id prof)}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (vector? result))
(t/is (= 1 (count result)))
(t/is (= page-id (get-in result [0 :id])))
(t/is (= "test page" (get-in result [0 :name])))
(t/is (string? (get-in result [0 :share-token])))
(t/is (:id file) (get-in result [0 :file-id])))))
(t/testing "delete page"
(let [data {::sm/type :delete-page
:id page-id
:profile-id (:id prof)}
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))))
(t/testing "query pages after delete"
(let [data {::sq/type :pages
:file-id (:id file)
:profile-id (:id prof)}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (vector? result))
(t/is (= 0 (count result))))))
))
(t/deftest update-page-data
(let [prof (th/create-profile db/pool 1)
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
file (th/create-file db/pool (:id prof) proj-id false 1)
page-id (uuid/next)]
(t/testing "create empty page"
(let [data {::sm/type :create-page
:data cp/default-page-data
:file-id (:id file)
:id page-id
:ordering 1
:name "test page"
:profile-id (:id prof)}
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (uuid? (:id result)))
(t/is (= (:id data) (:id result))))))
(t/testing "successfully update data"
(let [sid (uuid/next)
data {::sm/type :update-page
:id page-id
:revn 0
:session-id uuid/zero
:profile-id (:id prof)
:changes [{:type :add-obj
:frame-id uuid/zero
:id sid
:obj {:id sid
:name "Rect"
:frame-id uuid/zero
:type :rect}}]}
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)
result1 (first result)]
(t/is (= 1 (count result)))
(t/is (= 1 (:revn result1)))
(t/is (= (:id data) (:page-id result1)))
(t/is (vector (:changes result1)))
(t/is (= 1 (count (:changes result1))))
(t/is (= :add-obj (get-in result1 [:changes 0 :type]))))))
(t/testing "conflict error"
(let [data {::sm/type :update-page
:session-id uuid/zero
:id page-id
:revn 99
:profile-id (:id prof)
:changes []}
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(let [error (:error out)
error-data (ex-data error)]
(t/is (th/ex-info? error))
(t/is (= (:type error-data) :service-error))
(t/is (= (:name error-data) :app.services.mutations.pages/update-page)))
(let [error (ex-cause (:error out))
error-data (ex-data error)]
(t/is (th/ex-info? error))
(t/is (= (:type error-data) :validation))
(t/is (= (:code error-data) :revn-conflict)))))
))
(t/deftest update-page-data-2
(let [prof (th/create-profile db/pool 1)
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
file (th/create-file db/pool (:id prof) proj-id false 1)
page (th/create-page db/pool (:id prof) (:id file) 1)]
(t/testing "lagging changes"
(let [sid (uuid/next)
data {::sm/type :update-page
:id (:id page)
:revn 0
:session-id uuid/zero
:profile-id (:id prof)
:changes [{:type :add-obj
:id sid
:frame-id uuid/zero
:obj {:id sid
:name "Rect"
:frame-id uuid/zero
:type :rect}}]}
out1 (th/try-on! (sm/handle data))
out2 (th/try-on! (sm/handle data))
]
;; (th/print-result! out1)
;; (th/print-result! out2)
(t/is (nil? (:error out1)))
(t/is (nil? (:error out2)))
(t/is (= 1 (count (get-in out1 [:result 0 :changes]))))
(t/is (= 1 (count (get-in out2 [:result 0 :changes]))))
(t/is (= 2 (count (:result out2))))
(t/is (= (:id data) (get-in out1 [:result 0 :page-id])))
(t/is (= (:id data) (get-in out2 [:result 0 :page-id])))
))))

2
backend/tests/app/tests/test_services_profile.clj
View file

@ -5,7 +5,7 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.tests.test-services-profile
(:require

9
backend/tests/app/tests/test_services_projects.clj
View file

@ -1,3 +1,12 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.tests.test-services-projects
(:require
[clojure.test :as t]

65
backend/tests/app/tests/test_services_user_attrs.clj
View file

@ -1,65 +0,0 @@
(ns app.tests.test-services-user-attrs
(:require
[clojure.spec.alpha :as s]
[clojure.test :as t]
[promesa.core :as p]
[app.db :as db]
[app.http :as http]
[app.services.mutations :as sm]
[app.services.queries :as sq]
[app.tests.helpers :as th]))
;; (t/use-fixtures :once th/state-init)
;; (t/use-fixtures :each th/database-reset)
;; (t/deftest test-user-attrs
;; (let [{:keys [id] :as user} @(th/create-user db/pool 1)]
;; (let [out (th/try-on! (sq/handle {::sq/type :user-attr
;; :key "foobar"
;; :user id}))]
;; (t/is (nil? (:result out)))
;; (let [error (:error out)]
;; (t/is (th/ex-info? error))
;; (t/is (th/ex-of-type? error :service-error)))
;; (let [error (ex-cause (:error out))]
;; (t/is (th/ex-info? error))
;; (t/is (th/ex-of-type? error :not-found))))
;; (let [out (th/try-on! (sm/handle {::sm/type :upsert-user-attr
;; :user id
;; :key "foobar"
;; :val {:some #{:value}}}))]
;; ;; (th/print-result! out)
;; (t/is (nil? (:error out)))
;; (t/is (nil? (:result out))))
;; (let [out (th/try-on! (sq/handle {::sq/type :user-attr
;; :key "foobar"
;; :user id}))]
;; ;; (th/print-result! out)
;; (t/is (nil? (:error out)))
;; (t/is (= {:some #{:value}} (get-in out [:result :val])))
;; (t/is (= "foobar" (get-in out [:result :key]))))
;; (let [out (th/try-on! (sm/handle {::sm/type :delete-user-attr
;; :user id
;; :key "foobar"}))]
;; ;; (th/print-result! out)
;; (t/is (nil? (:error out)))
;; (t/is (nil? (:result out))))
;; (let [out (th/try-on! (sq/handle {::sq/type :user-attr
;; :key "foobar"
;; :user id}))]
;; ;; (th/print-result! out)
;; (t/is (nil? (:result out)))
;; (let [error (:error out)]
;; (t/is (th/ex-info? error))
;; (t/is (th/ex-of-type? error :service-error)))
;; (let [error (ex-cause (:error out))]
;; (t/is (th/ex-info? error))
;; (t/is (th/ex-of-type? error :not-found))))))

42
backend/tests/app/tests/test_services_viewer.clj
View file

@ -5,7 +5,7 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 app Labs SL
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.tests.test-services-viewer
(:require
@ -28,15 +28,14 @@
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
file (th/create-file db/pool (:id prof) proj-id false 1)
page (th/create-page db/pool (:id prof) (:id file) 1)
token (atom nil)]
file (th/create-file db/pool (:id prof) proj-id false 1)
token (atom nil)]
(t/testing "authenticated with page-id"
(let [data {::sq/type :viewer-bundle
:profile-id (:id prof)
:page-id (:id page)}
:file-id (:id file)
:page-id (get-in file [:data :pages 0])}
out (th/try-on! (sq/handle data))]
@ -44,29 +43,32 @@
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (contains? result :share-token))
(t/is (contains? result :page))
(t/is (contains? result :file))
(t/is (contains? result :project)))))
(t/testing "generate share token"
(let [data {::sm/type :generate-page-share-token
:id (:id page)}
(let [data {::sm/type :create-file-share-token
:profile-id (:id prof)
:file-id (:id file)
:page-id (get-in file [:data :pages 0])}
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (string? (:share-token result)))
(reset! token (:share-token result)))))
(t/is (string? (:token result)))
(reset! token (:token result)))))
(t/testing "authenticated with page-id"
(t/testing "not authenticated with page-id"
(let [data {::sq/type :viewer-bundle
:profile-id (:id prof2)
:page-id (:id page)}
:file-id (:id file)
:page-id (get-in file [:data :pages 0])}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(let [error (:error out)
error-data (ex-data error)]
(t/is (th/ex-info? error))
@ -78,11 +80,12 @@
(t/is (th/ex-info? error))
(t/is (= (:type error-data) :not-found)))))
(t/testing "authenticated with page-id and token"
(t/testing "authenticated with token & profile"
(let [data {::sq/type :viewer-bundle
:profile-id (:id prof2)
:page-id (:id page)
:share-token @token}
:share-token @token
:file-id (:id file)
:page-id (get-in file [:data :pages 0])}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
@ -92,10 +95,11 @@
(t/is (contains? result :file))
(t/is (contains? result :project)))))
(t/testing "not authenticated with page-id and token"
(t/testing "authenticated with token"
(let [data {::sq/type :viewer-bundle
:page-id (:id page)
:share-token @token}
:share-token @token
:file-id (:id file)
:page-id (get-in file [:data :pages 0])}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)

9
backend/tests/app/tests/test_util_svg.clj
View file

@ -1,3 +1,12 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.tests.test-util-svg
(:require
[clojure.test :as t]

19
common/app/common/data.cljc
View file

@ -163,6 +163,25 @@
:else (recur (rest col1) col2 join-fn
(core/concat acc (map (partial join-fn (first col1)) col2))))))
(def sentinel
#?(:clj (Object.)
:cljs (js/Object.)))
(defn update-in-when
[m key-seq f & args]
(let [found (get-in m key-seq sentinel)]
(if-not (identical? sentinel found)
(assoc-in m key-seq (apply f found args))
m)))
(defn update-when
[m key f & args]
(let [found (get m key sentinel)]
(if-not (identical? sentinel found)
(assoc m key (apply f found args))
m)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Parsing / Conversion
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

737
common/app/common/pages.cljc
View file

@ -21,6 +21,7 @@
[app.common.uuid :as uuid]))
(def page-version 5)
(def file-version 1)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Page Transformation Changes
@ -28,123 +29,139 @@
;; --- Specs
(s/def ::frame-id uuid?)
(s/def ::id uuid?)
(s/def ::shape-id uuid?)
(s/def ::session-id uuid?)
(s/def ::integer integer?)
(s/def ::name string?)
(s/def ::page-id uuid?)
(s/def ::parent-id uuid?)
(s/def ::string string?)
(s/def ::type keyword?)
(s/def ::uuid uuid?)
;; Page Options
(s/def ::grid-x number?)
(s/def ::grid-y number?)
(s/def ::grid-color string?)
(s/def ::options
(s/keys :opt-un [::grid-y
::grid-x
::grid-color]))
;; TODO: missing specs for :saved-grids
(s/def :internal.page.options/background string?)
(s/def :internal.page/options
(s/keys :opt-un [:internal.page.options/background]))
;; Interactions
(s/def ::event-type #{:click}) ; In the future we will have more options
(s/def ::action-type #{:navigate})
(s/def ::destination uuid?)
(s/def :internal.shape.interaction/event-type #{:click}) ; In the future we will have more options
(s/def :internal.shape.interaction/action-type #{:navigate})
(s/def :internal.shape.interaction/destination ::uuid)
(s/def ::interaction
(s/keys :req-un [::event-type
::action-type
::destination]))
(s/def :internal.shape/interaction
(s/keys :req-un [:internal.shape.interaction/event-type
:internal.shape.interaction/action-type
:internal.shape.interaction/destination]))
(s/def ::interactions (s/coll-of ::interaction :kind vector?))
(s/def :internal.shape/interactions
(s/coll-of :internal.shape/interaction :kind vector?))
;; Page Data related
(s/def ::blocked boolean?)
(s/def ::collapsed boolean?)
(s/def ::content any?)
(s/def ::fill-color string?)
(s/def ::fill-opacity number?)
(s/def ::font-family string?)
(s/def ::font-size number?)
(s/def ::font-style string?)
(s/def ::font-weight string?)
(s/def ::hidden boolean?)
(s/def ::letter-spacing number?)
(s/def ::line-height number?)
(s/def ::locked boolean?)
(s/def ::page-id uuid?)
(s/def ::proportion number?)
(s/def ::proportion-lock boolean?)
(s/def ::rx number?)
(s/def ::ry number?)
(s/def ::stroke-color string?)
(s/def ::stroke-opacity number?)
(s/def ::stroke-style #{:solid :dotted :dashed :mixed :none})
(s/def ::stroke-width number?)
(s/def ::stroke-alignment #{:center :inner :outer})
(s/def ::text-align #{"left" "right" "center" "justify"})
(s/def ::type keyword?)
(s/def ::x number?)
(s/def ::y number?)
(s/def ::cx number?)
(s/def ::cy number?)
(s/def ::width number?)
(s/def ::height number?)
(s/def ::index integer?)
(s/def ::x1 number?)
(s/def ::y1 number?)
(s/def ::x2 number?)
(s/def ::y2 number?)
(s/def :internal.shape/blocked boolean?)
(s/def :internal.shape/collapsed boolean?)
(s/def :internal.shape/content any?)
(s/def :internal.shape/fill-color string?)
(s/def :internal.shape/fill-opacity number?)
(s/def :internal.shape/font-family string?)
(s/def :internal.shape/font-size number?)
(s/def :internal.shape/font-style string?)
(s/def :internal.shape/font-weight string?)
(s/def :internal.shape/hidden boolean?)
(s/def :internal.shape/letter-spacing number?)
(s/def :internal.shape/line-height number?)
(s/def :internal.shape/locked boolean?)
(s/def :internal.shape/page-id uuid?)
(s/def :internal.shape/proportion number?)
(s/def :internal.shape/proportion-lock boolean?)
(s/def :internal.shape/rx number?)
(s/def :internal.shape/ry number?)
(s/def :internal.shape/stroke-color string?)
(s/def :internal.shape/stroke-opacity number?)
(s/def :internal.shape/stroke-style #{:solid :dotted :dashed :mixed :none})
(s/def :internal.shape/stroke-width number?)
(s/def :internal.shape/stroke-alignment #{:center :inner :outer})
(s/def :internal.shape/text-align #{"left" "right" "center" "justify"})
(s/def :internal.shape/x number?)
(s/def :internal.shape/y number?)
(s/def :internal.shape/cx number?)
(s/def :internal.shape/cy number?)
(s/def :internal.shape/width number?)
(s/def :internal.shape/height number?)
(s/def :internal.shape/index integer?)
(s/def ::suffix string?)
(s/def ::scale number?)
(s/def ::export
(s/keys :req-un [::type ::suffix ::scale]))
(s/def :internal.shape/x1 number?)
(s/def :internal.shape/y1 number?)
(s/def :internal.shape/x2 number?)
(s/def :internal.shape/y2 number?)
(s/def ::exports (s/coll-of ::export :kind vector?))
(s/def :internal.shape.export/suffix string?)
(s/def :internal.shape.export/scale number?)
(s/def :internal.shape/export
(s/keys :req-un [::type
:internal.shape.export/suffix
:internal.shape.export/scale]))
(s/def :internal.shape/exports
(s/coll-of :internal.shape/export :kind vector?))
(s/def ::selrect (s/keys :req-un [::x
::y
::x1
::y1
::x2
::y2
::width
::height]))
(s/def :internal.shape/selrect
(s/keys :req-un [:internal.shape/x
:internal.shape/y
:internal.shape/x1
:internal.shape/y1
:internal.shape/x2
:internal.shape/y2
:internal.shape/width
:internal.shape/height]))
(s/def ::point (s/keys :req-un [::x ::y]))
(s/def ::points (s/coll-of ::point :kind vector?))
(s/def :internal.shape/point
(s/keys :req-un [:internal.shape/x :internal.shape/y]))
(s/def :internal.shape/points
(s/coll-of :internal.shape/point :kind vector?))
(s/def ::shape-attrs
(s/keys :opt-un [::blocked
::collapsed
::content
::fill-color
::fill-opacity
::font-family
::font-size
::font-style
::font-weight
::hidden
::letter-spacing
::line-height
::locked
::proportion
::proportion-lock
::rx ::ry
::cx ::cy
::x ::y
::exports
::stroke-color
::stroke-opacity
::stroke-style
::stroke-width
::stroke-alignment
::text-align
::width ::height
::interactions
::selrect
::points]))
(s/keys :opt-un [:internal.shape/blocked
:internal.shape/collapsed
:internal.shape/content
:internal.shape/fill-color
:internal.shape/fill-opacity
:internal.shape/font-family
:internal.shape/font-size
:internal.shape/font-style
:internal.shape/font-weight
:internal.shape/hidden
:internal.shape/letter-spacing
:internal.shape/line-height
:internal.shape/locked
:internal.shape/proportion
:internal.shape/proportion-lock
:internal.shape/rx
:internal.shape/ry
:internal.shape/cx
:internal.shape/cy
:internal.shape/x
:internal.shape/y
:internal.shape/exports
:internal.shape/stroke-color
:internal.shape/stroke-opacity
:internal.shape/stroke-style
:internal.shape/stroke-width
:internal.shape/stroke-alignment
:internal.shape/text-align
:internal.shape/width
:internal.shape/height
:internal.shape/interactions
:internal.shape/selrect
:internal.shape/points]))
(s/def ::minimal-shape
(s/keys :req-un [::type ::name]
@ -154,73 +171,157 @@
(s/and ::minimal-shape ::shape-attrs
(s/keys :opt-un [::id])))
(s/def ::shapes (s/coll-of uuid? :kind vector?))
(s/def ::canvas (s/coll-of uuid? :kind vector?))
(s/def :internal.page/objects (s/map-of uuid? ::shape))
(s/def ::objects
(s/map-of uuid? ::shape))
(s/def ::page
(s/keys :req-un [::id
::name
:internal.page/options
:internal.page/objects]))
(s/def :internal.color/name ::string)
(s/def :internal.color/value ::string)
(s/def ::color
(s/keys :req-un [::id
:internal.color/name
:internal.color/value]))
(s/def :internal.media-object/name ::string)
(s/def :internal.media-object/path ::string)
(s/def :internal.media-object/width ::integer)
(s/def :internal.media-object/height ::integer)
(s/def :internal.media-object/mtype ::string)
(s/def :internal.media-object/thumb-path ::string)
(s/def :internal.media-object/thumb-width ::integer)
(s/def :internal.media-object/thumb-height ::integer)
(s/def :internal.media-object/thumb-mtype ::string)
(s/def ::media-object
(s/keys :req-un [::id ::name
:internal.media-object/name
:internal.media-object/path
:internal.media-object/width
:internal.media-object/height
:internal.media-object/mtype
:internal.media-object/thumb-path]))
(s/def :internal.file/colors
(s/map-of ::uuid ::color))
(s/def :internal.file/pages
(s/coll-of ::uuid :kind vector?))
(s/def :internal.file/media
(s/map-of ::uuid ::media-object))
(s/def :internal.file/pages-index
(s/map-of ::uuid ::page))
(s/def ::data
(s/keys :req-un [::version
::options
::objects]))
(s/keys :req-un [:internal.file/pages-index
:internal.file/pages]
:opt-un [:internal.file/colors
:internal.file/media]))
(s/def ::ids (s/coll-of ::us/uuid))
(s/def ::attr keyword?)
(s/def ::val any?)
(s/def ::frame-id uuid?)
(defmulti operation-spec :type)
(defmulti operation-spec-impl :type)
(s/def :internal.operations.set/attr keyword?)
(s/def :internal.operations.set/val any?)
(defmethod operation-spec-impl :set [_]
(s/keys :req-un [::attr ::val]))
(defmethod operation-spec :set [_]
(s/keys :req-un [:internal.operations.set/attr
:internal.operations.set/val]))
(s/def ::operation (s/multi-spec operation-spec-impl :type))
(s/def ::operations (s/coll-of ::operation))
(defmulti change-spec :type)
(defmulti change-spec-impl :type)
(s/def :internal.changes.set-option/option any?)
(s/def :internal.changes.set-option/value any?)
(s/def :set-option/option any? #_(s/or keyword? (s/coll-of keyword?)))
(s/def :set-option/value any?)
(defmethod change-spec :set-option [_]
(s/keys :req-un [:internal.changes.set-option/option
:internal.changes.set-option/value]))
(defmethod change-spec-impl :set-option [_]
(s/keys :req-un [:set-option/option :set-option/value]))
(s/def :internal.changes.add-obj/obj ::shape)
(defmethod change-spec-impl :add-obj [_]
(s/keys :req-un [::id ::frame-id ::obj]
(defmethod change-spec :add-obj [_]
(s/keys :req-un [::id ::page-id ::frame-id
:internal.changes.add-obj/obj]
:opt-un [::parent-id]))
(defmethod change-spec-impl :mod-obj [_]
(s/keys :req-un [::id ::operations]))
(s/def ::operation (s/multi-spec operation-spec :type))
(s/def ::operations (s/coll-of ::operation))
(defmethod change-spec-impl :del-obj [_]
(s/keys :req-un [::id]))
(defmethod change-spec :mod-obj [_]
(s/keys :req-un [::id ::page-id ::operations]))
(defmethod change-spec-impl :reg-objects [_]
(s/keys :req-un [::shapes]))
(defmethod change-spec :del-obj [_]
(s/keys :req-un [::id ::page-id]))
(defmethod change-spec-impl :mov-objects [_]
(s/keys :req-un [::parent-id ::shapes]
(s/def :internal.changes.reg-objects/shapes
(s/coll-of uuid? :kind vector?))
(defmethod change-spec :reg-objects [_]
(s/keys :req-un [::page-id :internal.changes.reg-objects/shapes]))
(defmethod change-spec :mov-objects [_]
(s/keys :req-un [::page-id ::parent-id ::shapes]
:opt-un [::index]))
(s/def ::change (s/multi-spec change-spec-impl :type))
(defmethod change-spec :add-page [_]
(s/or :empty (s/keys :req-un [::id ::name])
:complete (s/keys :req-un [::page])))
(defmethod change-spec :mod-page [_]
(s/keys :req-un [::id ::name]))
(defmethod change-spec :del-page [_]
(s/keys :req-un [::id]))
(defmethod change-spec :mov-page [_]
(s/keys :req-un [::id ::index]))
(defmethod change-spec :add-color [_]
(s/keys :req-un [::color]))
(defmethod change-spec :mod-color [_]
(s/keys :req-un [::color]))
(defmethod change-spec :del-color [_]
(s/keys :req-un [::id]))
(s/def :internal.changes.media/object ::media-object)
(defmethod change-spec :add-media [_]
(s/keys :req-un [:internal.changes.media/object]))
(defmethod change-spec :mod-media [_]
(s/keys :req-un [:internal.changes.media/object]))
(defmethod change-spec :del-media [_]
(s/keys :req-un [::id]))
(s/def ::change (s/multi-spec change-spec :type))
(s/def ::changes (s/coll-of ::change))
(def root uuid/zero)
(def default-page-data
"A reference value of the empty page data."
{:version page-version
:options {}
(def empty-page-data
{:options {}
:name "Page"
:objects
{root
{:id root
:type :frame
:name "root"
:shapes []}}})
:name "Root Frame"}}})
(def empty-file-data
{:version file-version
:pages []
:pages-index {}})
(def default-color "#b1b2b5") ;; $color-gray-20
(def default-shape-attrs
{:fill-color default-color
:fill-opacity 1})
@ -297,7 +398,10 @@
(defn make-minimal-shape
[type]
(let [shape (d/seek #(= type (:type %)) minimal-shapes)]
(assert shape "unexpected shape type")
(when-not shape
(ex/raise :type :assertion
:code :shape-type-not-implemented
:context {:type type}))
(assoc shape
:id (uuid/next)
:x 0
@ -315,13 +419,21 @@
:points []
:segments [])))
(defn make-file-data
([] (make-file-data (uuid/next)))
([id]
(let [
pd (assoc empty-page-data
:id id
:name "Page-1")]
(-> empty-file-data
(update :pages conj id)
(update :pages-index assoc id pd)))))
;; --- Changes Processing Impl
(defmulti process-change
(fn [data change] (:type change)))
(defmulti process-operation
(fn [_ op] (:type op)))
(defmulti process-change (fn [data change] (:type change)))
(defmulti process-operation (fn [_ op] (:type op)))
(defn process-changes
[data items]
@ -332,58 +444,65 @@
data)))
(defmethod process-change :set-option
[data {:keys [option value]}]
(let [path (if (seqable? option) option [option])]
(if value
(assoc-in data (into [:options] path) value)
(assoc data :options (d/dissoc-in (:options data) path)))))
[data {:keys [page-id option value]}]
(d/update-in-when data [:pages-index page-id]
(fn [data]
(let [path (if (seqable? option) option [option])]
(if value
(assoc-in data (into [:options] path) value)
(assoc data :options (d/dissoc-in (:options data) path)))))))
(defmethod process-change :add-obj
[data {:keys [id obj frame-id parent-id index] :as change}]
(let [parent-id (or parent-id frame-id)
objects (:objects data)]
(when (and (contains? objects parent-id)
(contains? objects frame-id))
(let [obj (assoc obj
:frame-id frame-id
:parent-id parent-id
:id id)]
(-> data
(update :objects assoc id obj)
(update-in [:objects parent-id :shapes]
(fn [shapes]
(let [shapes (or shapes [])]
(cond
(some #{id} shapes) shapes
(nil? index) (conj shapes id)
:else (cph/insert-at-index shapes index [id]))))))))))
[data {:keys [id obj page-id frame-id parent-id index] :as change}]
(d/update-in-when data [:pages-index page-id]
(fn [data]
(let [parent-id (or parent-id frame-id)
objects (:objects data)]
(when (and (contains? objects parent-id)
(contains? objects frame-id))
(let [obj (assoc obj
:frame-id frame-id
:parent-id parent-id
:id id)]
(-> data
(update :objects assoc id obj)
(update-in [:objects parent-id :shapes]
(fn [shapes]
(let [shapes (or shapes [])]
(cond
(some #{id} shapes) shapes
(nil? index) (conj shapes id)
:else (cph/insert-at-index shapes index [id]))))))))))))
(defmethod process-change :mod-obj
[data {:keys [id operations] :as change}]
(update data :objects
(fn [objects]
(if-let [obj (get objects id)]
(assoc objects id (reduce process-operation obj operations))
objects))))
[data {:keys [id page-id operations] :as change}]
(d/update-in-when data [:pages-index page-id :objects]
(fn [objects]
(if-let [obj (get objects id)]
(assoc objects id (reduce process-operation obj operations))
objects))))
(defmethod process-change :del-obj
[data {:keys [id] :as change}]
(when-let [{:keys [frame-id shapes] :as obj} (get-in data [:objects id])]
(let [objects (:objects data)
parent-id (cph/get-parent id objects)
parent (get objects parent-id)
data (update data :objects dissoc id)]
(cond-> data
(and (not= parent-id frame-id)
(= :group (:type parent)))
(update-in [:objects parent-id :shapes] (fn [s] (filterv #(not= % id) s)))
[data {:keys [page-id id] :as change}]
(letfn [(delete-object [objects id]
(if-let [target (get objects id)]
(let [parent-id (cph/get-parent id objects)
frame-id (:frame-id target)
parent (get objects parent-id)
objects (dissoc objects id)]
(cond-> objects
(and (not= parent-id frame-id)
(= :group (:type parent)))
(update-in [parent-id :shapes] (fn [s] (filterv #(not= % id) s)))
(contains? objects frame-id)
(update-in [:objects frame-id :shapes] (fn [s] (filterv #(not= % id) s)))
(seq shapes) ; Recursive delete all dependend objects
(as-> $ (reduce #(or (process-change %1 {:type :del-obj :id %2}) %1) $ shapes))))))
(contains? objects frame-id)
(update-in [frame-id :shapes] (fn [s] (filterv #(not= % id) s)))
(seq (:shapes target)) ; Recursive delete all
; dependend objects
(as-> $ (reduce delete-object $ (:shapes target)))))
objects))]
(d/update-in-when data [:pages-index page-id :objects] delete-object id)))
(defn rotation-modifiers
[center shape angle]
@ -395,126 +514,173 @@
:displacement displacement}))
(defmethod process-change :reg-objects
[data {:keys [shapes]}]
(let [objects (:objects data)
xfm (comp
(mapcat #(cons % (cph/get-parents % objects)))
(map #(get objects %))
(filter #(= (:type %) :group))
(map :id)
(distinct))
[data {:keys [page-id shapes]}]
(letfn [(reg-objects [objects]
(reduce #(update %1 %2 update-group %1) objects
(sequence (comp
(mapcat #(cons % (cph/get-parents % objects)))
(map #(get objects %))
(filter #(= (:type %) :group))
(map :id)
(distinct))
shapes)))
(update-group [group objects]
(let [gcenter (geom/center group)
gxfm (comp
(map #(get objects %))
(map #(-> %
(assoc :modifiers
(rotation-modifiers gcenter % (- (:rotation group 0))))
(geom/transform-shape))))
selrect (-> (into [] gxfm (:shapes group))
(geom/selection-rect))]
ids (into [] xfm shapes)
;; Rotate the group shape change the data and rotate back again
(-> group
(assoc-in [:modifiers :rotation] (- (:rotation group)))
(geom/transform-shape)
(merge (select-keys selrect [:x :y :width :height]))
(assoc-in [:modifiers :rotation] (:rotation group))
(geom/transform-shape))))]
update-group
(fn [group data]
(let [objects (:objects data)
gcenter (geom/center group)
gxfm (comp
(map #(get objects %))
(map #(-> %
(assoc :modifiers
(rotation-modifiers gcenter % (- (:rotation group 0))))
(geom/transform-shape))))
selrect (-> (into [] gxfm (:shapes group))
(geom/selection-rect))]
;; Rotate the group shape change the data and rotate back again
(-> group
(assoc-in [:modifiers :rotation] (- (:rotation group)))
(geom/transform-shape)
(merge (select-keys selrect [:x :y :width :height]))
(assoc-in [:modifiers :rotation] (:rotation group))
(geom/transform-shape))))]
(reduce #(update-in %1 [:objects %2] update-group %1) data ids)))
(d/update-in-when data [:pages-index page-id :objects] reg-objects)))
(defmethod process-change :mov-objects
[data {:keys [parent-id shapes index] :as change}]
(let [
;; Check if the move from shape-id -> parent-id is valid
[data {:keys [parent-id shapes index page-id] :as change}]
(letfn [(is-valid-move? [objects shape-id]
(let [invalid-targets (cph/calculate-invalid-targets shape-id objects)]
(and (not (invalid-targets parent-id))
(cph/valid-frame-target shape-id parent-id objects))))
is-valid-move
(fn [shape-id]
(let [invalid-targets (cph/calculate-invalid-targets shape-id (:objects data))]
(and (not (invalid-targets parent-id))
(cph/valid-frame-target shape-id parent-id (:objects data)))))
(insert-items [prev-shapes index shapes]
(let [prev-shapes (or prev-shapes [])]
(if index
(cph/insert-at-index prev-shapes index shapes)
(reduce (fn [acc id]
(if (some #{id} acc)
acc
(conj acc id)))
prev-shapes
shapes))))
valid? (every? is-valid-move shapes)
(strip-id [coll id]
(filterv #(not= % id) coll))
;; Add items into the :shapes property of the target parent-id
insert-items
(fn [prev-shapes]
(let [prev-shapes (or prev-shapes [])]
(if index
(cph/insert-at-index prev-shapes index shapes)
(reduce (fn [acc id]
(if (some #{id} acc)
acc
(conj acc id)))
prev-shapes
shapes))))
strip-id
(fn [id]
(fn [coll] (filterv #(not= % id) coll)))
cpindex
(reduce
(fn [index id]
(let [obj (get-in data [:objects id])]
(assoc index id (:parent-id obj))))
{} (keys (:objects data)))
remove-from-old-parent
(fn remove-from-old-parent [data shape-id]
(remove-from-old-parent [cpindex objects shape-id]
(let [prev-parent-id (get cpindex shape-id)]
;; Do nothing if the parent id of the shape is the same as
;; the new destination target parent id.
(if (= prev-parent-id parent-id)
data
(loop [sid shape-id
pid prev-parent-id
data data]
(let [obj (get-in data [:objects pid])]
objects
(loop [sid shape-id
pid prev-parent-id
objects objects]
(let [obj (get objects pid)]
(if (and (= 1 (count (:shapes obj)))
(= sid (first (:shapes obj)))
(= :group (:type obj)))
(recur pid
(:parent-id obj)
(update data :objects dissoc pid))
(update-in data [:objects pid :shapes] (strip-id sid))))))))
(dissoc objects pid))
(update-in objects [pid :shapes] strip-id sid)))))))
parent (get-in data [:objects parent-id])
frame (if (= :frame (:type parent))
parent
(get-in data [:objects (:frame-id parent)]))
frame-id (:id frame)
(update-parent-id [objects id]
(update objects id assoc :parent-id parent-id))
;; Update parent-id references.
update-parent-id
(fn [data id]
(update-in data [:objects id] assoc :parent-id parent-id))
;; Updates the frame-id references that might be outdated
(update-frame-ids [frame-id objects id]
(let [objects (assoc-in objects [id :frame-id] frame-id)
obj (get objects id)]
(cond-> objects
(not= :frame (:type obj))
(as-> $$ (reduce (partial update-frame-ids frame-id) $$ (:shapes obj))))))
;; Updates the frame-id references that might be outdated
update-frame-ids
(fn update-frame-ids [data id]
(let [data (assoc-in data [:objects id :frame-id] frame-id)
obj (get-in data [:objects id])]
(cond-> data
(not= :frame (:type obj))
(as-> $$ (reduce update-frame-ids $$ (:shapes obj))))))]
(move-objects [objects]
(let [valid? (every? (partial is-valid-move? objects) shapes)
cpindex (reduce (fn [index id]
(let [obj (get objects id)]
(assoc! index id (:parent-id obj))))
(transient {})
(keys objects))
cpindex (persistent! cpindex)
(when valid?
(as-> data $
(update-in $ [:objects parent-id :shapes] insert-items)
(reduce update-parent-id $ shapes)
(reduce remove-from-old-parent $ shapes)
(reduce update-frame-ids $ (get-in $ [:objects parent-id :shapes]))))))
parent (get-in data [:objects parent-id])
parent (get objects parent-id)
frame (if (= :frame (:type parent))
parent
(get objects (:frame-id parent)))
frm-id (:id frame)]
(if valid?
(as-> objects $
(update-in $ [parent-id :shapes] insert-items index shapes)
(reduce update-parent-id $ shapes)
(reduce (partial remove-from-old-parent cpindex) $ shapes)
(reduce (partial update-frame-ids frm-id) $ (get-in $ [parent-id :shapes])))
objects)))]
(d/update-in-when data [:pages-index page-id :objects] move-objects)))
(defmethod process-change :add-page
[data {:keys [id name page]}]
(cond
(and (string? name) (uuid? id))
(let [page (assoc empty-page-data
:id id
:name name)]
(-> data
(update :pages conj id)
(update :pages-index assoc id page)))
(map? page)
(->> data
(update :pages conj (:id page)
(update :pages-index assoc (:id page) page)))
:else
(ex/raise :type :conflict
:hint "name or page should be provided, never both")))
(defmethod process-change :mod-page
[data {:keys [id name]}]
(d/update-in-when data [:pages-index id] assoc :name name))
(defmethod process-change :del-page
[data {:keys [id]}]
(-> data
(update :pages (fn [pages] (filterv #(not= % id) pages)))
(update :pages-index dissoc id)))
(defmethod process-change :mov-page
[data {:keys [id index]}]
(update data :pages cph/insert-at-index index [id]))
(defmethod process-change :add-color
[data {:keys [color]}]
(update data :colors assoc (:id color) color))
(defmethod process-change :mod-color
[data {:keys [color]}]
(d/update-in-when data [:colors (:id color)] merge color))
(defmethod process-change :del-color
[data {:keys [id]}]
(update data :colors dissoc id))
(defmethod process-change :add-media
[data {:keys [object]}]
(update data :media assoc (:id object) object))
(defmethod process-change :mod-media
[data {:keys [object]}]
(d/update-in-when data [:media (:id object)] merge object))
(defmethod process-change :del-media
[data {:keys [id]}]
(update data :media dissoc id))
(defmethod process-operation :set
[shape op]
@ -526,5 +692,6 @@
(defmethod process-operation :default
[shape op]
(ex/raise :type :operation-not-implemented
(ex/raise :type :not-implemented
:code :operation-not-implemented
:context {:type (:type op)}))

4
common/app/common/pages_helpers.cljc
View file

@ -68,8 +68,8 @@
(d/index-of (:shapes prt) id)))
(defn insert-at-index
[shapes index ids]
(let [[before after] (split-at index shapes)
[objects index ids]
(let [[before after] (split-at index objects)
p? (set ids)]
(d/concat []
(remove p? before)

64
common/app/common/pages_migrations.cljc
View file

@ -8,23 +8,27 @@
[app.common.uuid :as uuid]
[app.common.data :as d]))
;; TODO: revisit this
;; TODO: revisit this and rename to file-migrations
(defmulti migrate :version)
(defn migrate-data
([data]
(if (= (:version data) cp/page-version)
(if (= (:version data) cp/file-version)
data
(reduce #(migrate-data %1 %2 (inc %2))
data
(range (:version data 0) cp/page-version))))
(range (:version data 0) cp/file-version))))
([data from-version to-version]
(-> data
(assoc :version to-version)
(migrate))))
(defn migrate-file
[file]
(update file :data migrate-data))
;; Default handler, noop
(defmethod migrate :default [data] data)
@ -37,49 +41,15 @@
(into index (map #(vector % id) (:shapes obj []))))
{} objects))
(defmethod migrate 5
[data]
(update data :objects
(fn [objects]
(let [index (generate-child-parent-index objects)]
(d/mapm
(fn [id obj]
(let [parent-id (get index id)]
(assoc obj :parent-id parent-id)))
objects)))))
;; We changed the internal model of the shapes so they have their
;; selection rect and the vertices
(defmethod migrate 4
[data]
(letfn [;; Creates a new property `points` that stores the
;; transformed points inside the shape this will be used for
;; the snaps and the selection rect
(calculate-shape-points [objects]
(->> objects
(d/mapm
(fn [id shape]
(if (= (:id shape) uuid/zero)
shape
(assoc shape :points (gsh/shape->points shape)))))))
;; Creates a new property `selrect` that stores the
;; selection rect for the shape
(calculate-shape-selrects [objects]
(->> objects
(d/mapm
(fn [id shape]
(if (= (:id shape) uuid/zero)
shape
(assoc shape :selrect (gsh/points->selrect (:points shape))))))))]
(-> data
;; Adds vertices to shapes
(update :objects calculate-shape-points)
;; Creates selection rects for shapes
(update :objects calculate-shape-selrects))))
;; (defmethod migrate 5
;; [data]
;; (update data :objects
;; (fn [objects]
;; (let [index (generate-child-parent-index objects)]
;; (d/mapm
;; (fn [id obj]
;; (let [parent-id (get index id)]
;; (assoc obj :parent-id parent-id)))
;; objects)))))

11
common/app/common/spec.cljc
View file

@ -2,7 +2,10 @@
;; 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-2019 Andrey Antukh <niwi@niwi.nz>
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.common.spec
"Data manipulation and query helper functions."
@ -103,7 +106,11 @@
(defn spec-assert
[spec x]
(s/assert* spec x))
(if (s/valid? spec x)
x
(ex/raise :type :assertion
:data (s/explain-data spec x)
#?@(:cljs [:stack (.-stack (ex-info "assertion" {}))]))))
(defmacro assert
"Development only assertion macro."

4
docker/devenv/docker-compose.yaml
View file

@ -49,7 +49,7 @@ services:
smtp:
container_name: "uxbox-devenv-smtp"
image: mwader/postfix-relay
image: mwader/postfix-relay:latest
restart: always
environment:
- POSTFIX_myhostname=smtp.uxbox.io
@ -75,7 +75,7 @@ services:
- postgres_data:/var/lib/postgresql/data
redis:
image: redis:6.0.6
image: redis:6
hostname: "uxbox-devenv-redis"
container_name: "uxbox-devenv-redis"
restart: always

9
docker/devenv/files/nginx.conf
View file

@ -62,14 +62,7 @@ http {
location / {
root /home/uxbox/uxbox/frontend/resources/public;
try_files $uri /index.html;
location ~* \.(js|css).*$ {
add_header Cache-Control "max-age=86400" always; # 24 hours
}
location = /index.html {
add_header Cache-Control "no-cache, max-age=0";
}
add_header Cache-Control "no-cache, max-age=0";
}
location /api {

4
exporter/src/app/http.cljs
View file

@ -1,13 +1,15 @@
(ns app.http
(:require
[app.http.export :refer [export-handler]]
[app.http.thumbnail :refer [thumbnail-handler]]
[app.http.impl :as impl]
[lambdaisland.glogi :as log]
[promesa.core :as p]
[reitit.core :as r]))
(def routes
[["/export" {:handler export-handler}]])
[["/export/thumbnail" {:handler thumbnail-handler}]
["/export" {:handler export-handler}]])
(defn start!
[extra]

16
exporter/src/app/http/export.cljs
View file

@ -1,3 +1,12 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.http.export
(:require
[app.http.export-bitmap :as bitmap]
@ -12,6 +21,7 @@
(s/def ::name ::us/string)
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::suffix ::us/string)
@ -23,7 +33,7 @@
(s/def ::exports (s/coll-of ::export :kind vector?))
(s/def ::handler-params
(s/keys :req-un [::page-id ::object-id ::name ::exports]))
(s/keys :req-un [::page-id ::file-id ::object-id ::name ::exports]))
(declare handle-single-export)
(declare handle-multiple-export)
@ -32,7 +42,7 @@
(defn export-handler
[{:keys [params browser cookies] :as request}]
(let [{:keys [exports page-id object-id name]} (us/conform ::handler-params params)
(let [{:keys [exports page-id file-id object-id name]} (us/conform ::handler-params params)
token (.get ^js cookies "auth-token")]
(case (count exports)
0 (exc/raise :type :validation :code :missing-exports)
@ -41,6 +51,7 @@
(assoc (first exports)
:name name
:token token
:file-id file-id
:page-id page-id
:object-id object-id))
(handle-multiple-export
@ -49,6 +60,7 @@
(assoc item
:name name
:token token
:file-id file-id
:page-id page-id
:object-id object-id)) exports)))))

9
exporter/src/app/http/export_bitmap.cljs
View file

@ -13,10 +13,10 @@
(:import
goog.Uri))
(defn- screenshot-object
[browser {:keys [page-id object-id token scale suffix type]}]
(defn screenshot-object
[browser {:keys [file-id page-id object-id token scale type]}]
(letfn [(handle [page]
(let [path (str "/render-object/" page-id "/" object-id)
(let [path (str "/render-object/" file-id "/" page-id "/" object-id)
uri (doto (Uri. (:public-uri cfg/config))
(.setPath "/")
(.setFragment path))
@ -46,13 +46,14 @@
(s/def ::suffix ::us/string)
(s/def ::type #{:jpeg :png})
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::token ::us/string)
(s/def ::filename ::us/string)
(s/def ::export-params
(s/keys :req-un [::name ::suffix ::type ::object-id ::page-id ::scale ::token]
(s/keys :req-un [::name ::suffix ::type ::object-id ::page-id ::scale ::token ::file-id]
:opt-un [::filename]))
(defn export

3
exporter/src/app/http/export_svg.cljs
View file

@ -249,13 +249,14 @@
(s/def ::suffix ::us/string)
(s/def ::type #{:svg})
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::token ::us/string)
(s/def ::filename ::us/string)
(s/def ::export-params
(s/keys :req-un [::name ::suffix ::type ::object-id ::page-id ::scale ::token]
(s/keys :req-un [::name ::suffix ::type ::object-id ::page-id ::file-id ::scale ::token]
:opt-un [::filename]))
(defn export

46
exporter/src/app/http/thumbnail.cljs Normal file
View file

@ -0,0 +1,46 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.http.thumbnail
(:require
[app.common.exceptions :as exc :include-macros true]
[app.common.spec :as us]
[app.http.export-bitmap :as bitmap]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[lambdaisland.glogi :as log]
[promesa.core :as p]))
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::handler-params
(s/keys :req-un [::page-id ::file-id ::object-id]))
(declare handle-single-export)
(declare handle-multiple-export)
(declare perform-export)
(declare attach-filename)
(defn thumbnail-handler
[{:keys [params browser cookies] :as request}]
(let [{:keys [page-id file-id object-id]} (us/conform ::handler-params params)
params {:token (.get ^js cookies "auth-token")
:file-id file-id
:page-id page-id
:object-id object-id
:scale 0.3
:type :jpeg}]
(p/let [content (bitmap/screenshot-object browser params)]
{:status 200
:body content
:headers {"content-type" "image/jpeg"
"content-length" (alength content)}})))

56
exporter/yarn.lock
View file

@ -59,14 +59,15 @@ argparse@^1.0.7:
dependencies:
sprintf-js "~1.0.2"
asn1.js@^4.0.0:
version "4.10.1"
resolved "https://registry.yarnpkg.com/asn1.js/-/asn1.js-4.10.1.tgz#b9c2bf5805f1e64aadeed6df3a2bfafb5a73f5a0"
integrity sha512-p32cOF5q0Zqs9uBiONKYLm6BClCoBCM5O9JfeUSlnQLBTxYdTK+pW+nXflm8UkKd2UYlEbYz5qEi0JuZR9ckSw==
asn1.js@^5.2.0:
version "5.4.1"
resolved "https://registry.yarnpkg.com/asn1.js/-/asn1.js-5.4.1.tgz#11a980b84ebb91781ce35b0fdc2ee294e3783f07"
integrity sha512-+I//4cYPccV8LdmBLiX8CYvf9Sp3vQsrqu2QNXRcrbiWvcx/UdlFiqUJJzxRQxgsZmvhXhn4cSKeSmoFjVdupA==
dependencies:
bn.js "^4.0.0"
inherits "^2.0.1"
minimalistic-assert "^1.0.0"
safer-buffer "^2.1.0"
assert@^1.1.1:
version "1.5.0"
@ -106,9 +107,9 @@ bn.js@^4.0.0, bn.js@^4.1.0, bn.js@^4.4.0:
integrity sha512-E6QoYqCKZfgatHTdHzs1RRKP7ip4vvm+EyRUeE2RF0NblwVvb0p6jSVeNTOFxPn26QXN2o6SMfNxKp6kU8zQaw==
bn.js@^5.1.1:
version "5.1.2"
resolved "https://registry.yarnpkg.com/bn.js/-/bn.js-5.1.2.tgz#c9686902d3c9a27729f43ab10f9d79c2004da7b0"
integrity sha512-40rZaf3bUNKTVYu9sIeeEGOg7g14Yvnj9kH7b50EiwX0Q7A6umbvfI5tvHaOERH0XigqKkfLkFQxzb4e6CIXnA==
version "5.1.3"
resolved "https://registry.yarnpkg.com/bn.js/-/bn.js-5.1.3.tgz#beca005408f642ebebea80b042b4d18d2ac0ee6b"
integrity sha512-GkTiFpjFtUzU9CbMeJ5iazkCzGL3jrhzerzZIuqLABjbwRaFt33I9tUdSNryIptM+RxDet6OKm2WnLXzW51KsQ==
boolbase@^1.0.0, boolbase@~1.0.0:
version "1.0.0"
@ -168,15 +169,15 @@ browserify-rsa@^4.0.0, browserify-rsa@^4.0.1:
randombytes "^2.0.1"
browserify-sign@^4.0.0:
version "4.2.0"
resolved "https://registry.yarnpkg.com/browserify-sign/-/browserify-sign-4.2.0.tgz#545d0b1b07e6b2c99211082bf1b12cce7a0b0e11"
integrity sha512-hEZC1KEeYuoHRqhGhTy6gWrpJA3ZDjFWv0DE61643ZnOXAKJb3u7yWcrU0mMc9SwAqK1n7myPGndkp0dFG7NFA==
version "4.2.1"
resolved "https://registry.yarnpkg.com/browserify-sign/-/browserify-sign-4.2.1.tgz#eaf4add46dd54be3bb3b36c0cf15abbeba7956c3"
integrity sha512-/vrA5fguVAKKAVTNJjgSm1tRQDHUU6DbwO9IROu/0WAzC8PKhucDSh18J0RMvVeHAn5puMd+QHC2erPRNf8lmg==
dependencies:
bn.js "^5.1.1"
browserify-rsa "^4.0.1"
create-hash "^1.2.0"
create-hmac "^1.1.7"
elliptic "^6.5.2"
elliptic "^6.5.3"
inherits "^2.0.4"
parse-asn1 "^5.1.5"
readable-stream "^3.6.0"
@ -333,12 +334,12 @@ core-util-is@~1.0.0:
integrity sha1-tf1UIgqivFq1eqtxQMlAdUUDwac=
create-ecdh@^4.0.0:
version "4.0.3"
resolved "https://registry.yarnpkg.com/create-ecdh/-/create-ecdh-4.0.3.tgz#c9111b6f33045c4697f144787f9254cdc77c45ff"
integrity sha512-GbEHQPMOswGpKXM9kCWVrremUcBmjteUaQ01T9rkKCPDXfUHX0IoP9LpHYo2NPFampa4e+/pFDc3jQdxrxQLaw==
version "4.0.4"
resolved "https://registry.yarnpkg.com/create-ecdh/-/create-ecdh-4.0.4.tgz#d6e7f4bffa66736085a0762fd3a632684dabcc4e"
integrity sha512-mf+TCx8wWc9VpuxfP2ht0iSISLZnt0JgWlrOKZiNqyUZWnjIaCIVNQArMHnCZKfEYRg6IM7A+NeJoN8gf/Ws0A==
dependencies:
bn.js "^4.1.0"
elliptic "^6.0.0"
elliptic "^6.5.3"
create-hash@^1.1.0, create-hash@^1.1.2, create-hash@^1.2.0:
version "1.2.0"
@ -522,7 +523,7 @@ ee-first@1.1.1:
resolved "https://registry.yarnpkg.com/ee-first/-/ee-first-1.1.1.tgz#590c61156b0ae2f4f0255732a158b266bc56b21d"
integrity sha1-WQxhFWsK4vTwJVcyoViyZrxWsh0=
elliptic@^6.0.0, elliptic@^6.5.2:
elliptic@^6.5.3:
version "6.5.3"
resolved "https://registry.yarnpkg.com/elliptic/-/elliptic-6.5.3.tgz#cb59eb2efdaf73a0bd78ccd7015a62ad6e0f93d6"
integrity sha512-IMqzv5wNQf+E6aHeIqATs0tOLeOTwj1QKbRcS3jBbYkl5oLAserA8yJTT7/VyHUYG91PRmPyeQDObKLPpeS4dw==
@ -594,9 +595,9 @@ esprima@^4.0.0:
integrity sha512-eGuFFw7Upda+g4p+QHvnW0RyTX/SVeJBDM/gCtMARO0cLuT2HcEKnTPvhjV6aGeqrCB/sbNop0Kszm0jsaWU4A==
events@^3.0.0:
version "3.1.0"
resolved "https://registry.yarnpkg.com/events/-/events-3.1.0.tgz#84279af1b34cb75aa88bf5ff291f6d0bd9b31a59"
integrity sha512-Rv+u8MLHNOdMjTAFeT3nCjHn2aGlx435FP/sDHNaRhDEMwyI/aB22Kj2qIN8R0cw3z28psEQLYwxVKLsKrMgWg==
version "3.2.0"
resolved "https://registry.yarnpkg.com/events/-/events-3.2.0.tgz#93b87c18f8efcd4202a461aec4dfc0556b639379"
integrity sha512-/46HWwbfCX2xTawVfkKLGxMifJYQBWMwY1mjywRtb4c9x8l5NP3KoJtnIOiL1hfdRkIuYhETxQlo62IF8tcnlg==
evp_bytestokey@^1.0.0, evp_bytestokey@^1.0.3:
version "1.0.3"
@ -1126,13 +1127,12 @@ pako@~1.0.2, pako@~1.0.5:
integrity sha512-4hLB8Py4zZce5s4yd9XzopqwVv/yGNhV1Bl8NTmCq1763HeK2+EwVTv+leGeL13Dnh2wfbqowVPXCIO0z4taYw==
parse-asn1@^5.0.0, parse-asn1@^5.1.5:
version "5.1.5"
resolved "https://registry.yarnpkg.com/parse-asn1/-/parse-asn1-5.1.5.tgz#003271343da58dc94cace494faef3d2147ecea0e"
integrity sha512-jkMYn1dcJqF6d5CpU689bq7w/b5ALS9ROVSpQDPrZsqqesUJii9qutvoT5ltGedNXMO2e16YUWIghG9KxaViTQ==
version "5.1.6"
resolved "https://registry.yarnpkg.com/parse-asn1/-/parse-asn1-5.1.6.tgz#385080a3ec13cb62a62d39409cb3e88844cdaed4"
integrity sha512-RnZRo1EPU6JBnra2vGHj0yhp6ebyjBZpmUCLHWiFhxlzvBCCpAuZ7elsBp1PVAbQN0/04VD/19rfzlBSwLstMw==
dependencies:
asn1.js "^4.0.0"
asn1.js "^5.2.0"
browserify-aes "^1.0.0"
create-hash "^1.1.0"
evp_bytestokey "^1.0.0"
pbkdf2 "^3.0.3"
safe-buffer "^5.1.1"
@ -1339,7 +1339,7 @@ safe-buffer@^5.0.1, safe-buffer@^5.1.0, safe-buffer@^5.1.1, safe-buffer@^5.1.2,
resolved "https://registry.yarnpkg.com/safe-buffer/-/safe-buffer-5.2.1.tgz#1eaf9fa9bdb1fdd4ec75f58f9cdb4e6b7827eec6"
integrity sha512-rp3So07KcdmmKbGvgaNxQSJr7bGVSVk5S9Eq1F+ppbRo70+YeaDxkw5Dd8NPN+GD6bjnYm2VuPuCXmpuYvmCXQ==
"safer-buffer@>= 2.1.2 < 3":
"safer-buffer@>= 2.1.2 < 3", safer-buffer@^2.1.0:
version "2.1.2"
resolved "https://registry.yarnpkg.com/safer-buffer/-/safer-buffer-2.1.2.tgz#44fa161b0187b9549dd84bb91802f9bd8385cd6a"
integrity sha512-YZo3K82SD7Riyi0E1EQPojLz7kpepnSQI9IyPbHHg1XXXevb5dJI7tpyN2ADxGcQbHG7vcyRHk0cbwqcQriUtg==
@ -1383,9 +1383,9 @@ shadow-cljs-jar@1.3.2:
integrity sha512-XmeffAZHv8z7451kzeq9oKh8fh278Ak+UIOGGrapyqrFBB773xN8vMQ3O7J7TYLnb9BUwcqadKkmgaq7q6fhZg==
shadow-cljs@^2.10.19:
version "2.10.19"
resolved "https://registry.yarnpkg.com/shadow-cljs/-/shadow-cljs-2.10.19.tgz#907bbad10bb3af38f6a728452e3cd9c34f1166d1"
integrity sha512-Dzzn+Ll5okjFze5x1AYqO2qNJOalA1/NBu5pehfyO75HqYzsTK+C4+xufKto6qaMb52iM94p2sbzP+Oh8M3VIw==
version "2.11.1"
resolved "https://registry.yarnpkg.com/shadow-cljs/-/shadow-cljs-2.11.1.tgz#1658278e2fdc7e0239f9573c505d3fbcfd741a31"
integrity sha512-3V+mtrGQwFJcb7DIreKwmCtwLKi/a7r8++mdmSTq2z1HRmcQV9DqIY4y+TLS6HkF/GNSIH7+hyHSH8uLdvsPlQ==
dependencies:
node-libs-browser "^2.0.0"
readline-sync "^1.4.7"

2
frontend/deps.edn
View file

@ -37,7 +37,7 @@
funcool/datoteka {:mvn/version "1.2.0"}
binaryage/devtools {:mvn/version "RELEASE"}
thheller/shadow-cljs {:mvn/version "2.10.19"}
thheller/shadow-cljs {:mvn/version "2.11.0"}
;; i18n parsing
carocad/parcera {:mvn/version "0.11.0"}

2
frontend/package.json
View file

@ -25,7 +25,7 @@
"postcss": "^7.0.32",
"rimraf": "^3.0.0",
"sass": "^1.26.10",
"shadow-cljs": "^2.10.19"
"shadow-cljs": "^2.11.0"
},
"dependencies": {
"date-fns": "^2.15.0",

39
frontend/src/app/main/data/dashboard.cljs
View file

@ -201,26 +201,17 @@
;; --- Fetch Files
(declare files-fetched)
(defn fetch-files
[project-id]
(ptk/reify ::fetch-files
ptk/WatchEvent
(watch [_ state stream]
(let [params {:project-id project-id}]
(->> (rp/query :files params)
(rx/map files-fetched))))))
(defn files-fetched
[files]
(us/verify (s/every ::file) files)
(ptk/reify ::files-fetched
ptk/UpdateEvent
(update [_ state]
(let [state (dissoc state :files)
files (d/index-by :id files)]
(assoc state :files files)))))
(us/assert ::us/uuid project-id)
(letfn [(on-fetched [files state]
(assoc state :files (d/index-by :id files)))]
(ptk/reify ::fetch-files
ptk/WatchEvent
(watch [_ state stream]
(let [params {:project-id project-id}]
(->> (rp/query :files params)
(rx/map #(partial on-fetched %))))))))
;; --- Fetch Shared Files
@ -241,14 +232,13 @@
(defn fetch-recent-files
[team-id]
(us/assert ::us/uuid team-id)
(ptk/reify ::fetch-recent-files
ptk/WatchEvent
(watch [_ state stream]
(let [params {:team-id team-id}]
(->> (rp/query :recent-files params)
(rx/map recent-files-fetched)
(rx/catch (fn [e]
(rx/of (rt/nav' :auth-login)))))))))
(rx/map recent-files-fetched))))))
(defn recent-files-fetched
[recent-files]
@ -415,9 +405,10 @@
ptk/WatchEvent
(watch [_ state stream]
(rx/of (rt/nav :workspace {:project-id (:project-id data)
:file-id (:id data)}
{:page-id (first (:pages data))})))))
(let [pparams {:project-id (:project-id data)
:file-id (:id data)}
qparams {:page-id (get-in data [:data :pages 0])}]
(rx/of (rt/nav :workspace pparams qparams))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

56
frontend/src/app/main/data/viewer.cljs
View file

@ -29,7 +29,7 @@
(s/def ::project (s/keys ::req-un [::id ::name]))
(s/def ::file (s/keys :req-un [::id ::name]))
(s/def ::page (s/keys :req-un [::id ::name ::cp/data]))
(s/def ::page ::cp/page)
(s/def ::interactions-mode #{:hide :show :show-on-click})
@ -43,37 +43,38 @@
(declare bundle-fetched)
(defn initialize
[page-id share-token]
[{:keys [page-id file-id] :as params}]
(ptk/reify ::initialize
ptk/UpdateEvent
(update [_ state]
(assoc state :viewer-local {:zoom 1
:page-id page-id
:file-id file-id
:interactions-mode :hide
:show-interactions? false}))
ptk/WatchEvent
(watch [_ state stream]
(rx/of (fetch-bundle page-id share-token)))))
(rx/of (fetch-bundle params)))))
;; --- Data Fetching
(defn fetch-bundle
[page-id share-token]
[{:keys [page-id file-id token]}]
(ptk/reify ::fetch-file
ptk/WatchEvent
(watch [_ state stream]
(let [params (cond-> {:page-id page-id}
(string? share-token) (assoc :share-token share-token))]
(let [params (cond-> {:page-id page-id
:file-id file-id}
(string? token) (assoc :share-token token))]
(->> (rp/query :viewer-bundle params)
(rx/map bundle-fetched)
(rx/catch (fn [error-data]
#_(rx/catch (fn [error-data]
(rx/of (rt/nav :not-found)))))))))
(defn- extract-frames
[page]
(let [objects (get-in page [:data :objects])
root (get objects uuid/zero)]
[objects]
(let [root (get objects uuid/zero)]
(->> (:shapes root)
(map #(get objects %))
(filter #(= :frame (:type %)))
@ -81,37 +82,41 @@
(vec))))
(defn bundle-fetched
[{:keys [project file page images] :as bundle}]
[{:keys [project file page] :as bundle}]
(us/verify ::bundle bundle)
(ptk/reify ::file-fetched
ptk/UpdateEvent
(update [_ state]
(let [frames (extract-frames page)
objects (get-in page [:data :objects])]
(let [objects (:objects page)
frames (extract-frames objects)]
(assoc state :viewer-data {:project project
:objects objects
:file file
:page page
:images images
:frames frames})))))
(def create-share-link
(ptk/reify ::create-share-link
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-in state [:viewer-local :page-id])]
(->> (rp/mutation :generate-page-share-token {:id id})
(rx/map (fn [{:keys [share-token]}]
#(assoc-in % [:viewer-data :page :share-token] share-token))))))))
(let [file-id (get-in state [:viewer-local :file-id])
page-id (get-in state [:viewer-local :page-id])]
(->> (rp/mutation :create-file-share-token {:file-id file-id
:page-id page-id})
(rx/map (fn [{:keys [token]}]
#(assoc-in % [:viewer-data :share-token] token))))))))
(def delete-share-link
(ptk/reify ::delete-share-link
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-in state [:viewer-local :page-id])]
(->> (rp/mutation :clear-page-share-token {:id id})
(rx/map (fn [_]
#(assoc-in % [:viewer-data :page :share-token] nil))))))))
(let [file-id (get-in state [:viewer-local :file-id])
page-id (get-in state [:viewer-local :page-id])
token (get-in state [:viewer-data :share-token])]
(->> (rp/mutation :delete-file-share-token {:file-id file-id
:page-id page-id
:token token})
(rx/map (fn [_] #(update % :viewer-data dissoc :share-token))))))))
;; --- Zoom Management
@ -226,9 +231,10 @@
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (get-in state [:viewer-local :page-id])
frames (get-in state [:viewer-data :frames])
index (d/index-of-pred frames #(= (:id %) frame-id))]
(rx/of (rt/nav :viewer {:page-id page-id} {:index index}))))))
file-id (get-in state [:viewer-local :file-id])
frames (get-in state [:viewer-data :frames])
index (d/index-of-pred frames #(= (:id %) frame-id))]
(rx/of (rt/nav :viewer {:page-id page-id :file-id file-id} {:index index}))))))
;; --- Shortcuts

373
frontend/src/app/main/data/workspace.cljs
View file

@ -9,12 +9,12 @@
(ns app.main.data.workspace
(:require
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[clojure.set :as set]
[potok.core :as ptk]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as geom]
[app.common.math :as mth]
[app.common.pages :as cp]
[app.common.pages-helpers :as cph]
[app.common.spec :as us]
@ -24,21 +24,21 @@
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.notifications :as dwn]
[app.main.data.workspace.persistence :as dwp]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.texts :as dwtxt]
[app.main.data.workspace.transforms :as dwt]
[app.main.data.workspace.selection :as dws]
[app.main.repo :as rp]
[app.main.store :as st]
[app.main.streams :as ms]
[app.main.worker :as uw]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as geom]
[app.common.math :as mth]
[app.util.timers :as ts]
[app.util.router :as rt]
[app.util.timers :as ts]
[app.util.transit :as t]
[app.util.webapi :as wapi]))
[app.util.webapi :as wapi]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[clojure.set :as set]
[potok.core :as ptk]))
;; --- Specs
@ -85,13 +85,16 @@
(s/def ::options-mode #{:design :prototype})
(def workspace-file-local-default
{:left-sidebar? true
:right-sidebar? true
:color-for-rename nil})
(def workspace-local-default
{:zoom 1
:flags #{}
:selected (d/ordered-set)
:expanded {}
:drawing nil
:drawing-tool nil
:tooltip nil
:options-mode :design
:draw-interaction-to nil
@ -113,32 +116,41 @@
(ptk/reify ::initialize-file
ptk/UpdateEvent
(update [_ state]
(assoc state :workspace-presence {}))
(assoc state
:workspace-presence {}
:workspace-file-local workspace-file-local-default))
ptk/WatchEvent
(watch [_ state stream]
(rx/merge
(rx/of (dwp/fetch-bundle project-id file-id))
;; Initialize notifications (websocket connection) and the file persistence
(->> stream
(rx/filter (ptk/type? ::dwp/bundle-fetched))
(rx/mapcat (fn [_] (rx/of (dwn/initialize file-id))))
(rx/first))
(rx/first)
(rx/mapcat #(rx/of (dwn/initialize file-id)
(dwp/initialize-file-persistence file-id))))
;; Initialize Indexes (webworker)
(->> stream
(rx/filter (ptk/type? ::dwp/bundle-fetched))
(rx/map deref)
(rx/map dwc/setup-selection-index)
(rx/map dwc/initialize-indices)
(rx/first))
;; Mark file initialized when indexes are ready
(->> stream
(rx/filter #(= ::dwc/index-initialized %))
(rx/map (constantly
(file-initialized project-id file-id))))))))
(file-initialized project-id file-id))))
))))
(defn- file-initialized
[project-id file-id]
(ptk/reify ::initialized
(ptk/reify ::file-initialized
ptk/UpdateEvent
(update [_ state]
(update state :workspace-file
@ -152,11 +164,12 @@
(ptk/reify ::finalize
ptk/UpdateEvent
(update [_ state]
(dissoc state :workspace-file :workspace-project))
(dissoc state :workspace-file :workspace-project :workspace-media-objects :workspace-users))
ptk/WatchEvent
(watch [_ state stream]
(rx/of (dwn/finalize file-id)))))
(rx/of (dwn/finalize file-id)
::dwp/finalize))))
(defn initialize-page
@ -164,17 +177,14 @@
(ptk/reify ::initialize-page
ptk/UpdateEvent
(update [_ state]
(let [page (get-in state [:workspace-pages page-id])
;; TODO: looks workspace-page is unused
(let [page (get-in state [:workspace-data :pages-index page-id])
local (get-in state [:workspace-cache page-id] workspace-local-default)]
(-> state
(assoc :current-page-id page-id ; mainly used by events
:workspace-local local
:workspace-page (dissoc page :data))
(assoc-in [:workspace-data page-id] (:data page)))))
ptk/WatchEvent
(watch [_ state stream]
(rx/of (dwp/initialize-page-persistence page-id)))))
(assoc state
:current-page-id page-id ; mainly used by events
:workspace-page page
:workspace-local local
)))))
(defn finalize-page
[page-id]
@ -185,11 +195,67 @@
(let [local (:workspace-local state)]
(-> state
(assoc-in [:workspace-cache page-id] local)
(update :workspace-data dissoc page-id))))
(dissoc :current-page-id :workspace-page))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Workspace Page CRUD
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def create-empty-page
(ptk/reify ::create-empty-page
ptk/WatchEvent
(watch [this state stream]
(let [id (uuid/next)
pages (get-in state [:workspace-data :pages-index])
unames (dwc/retrieve-used-names pages)
name (dwc/generate-unique-name unames "Page")
rchange {:type :add-page
:id id
:name name}
uchange {:type :del-page
:id id}]
(rx/of (dwc/commit-changes [rchange] [uchange] {:commit-local? true}))))))
(s/def ::rename-page
(s/keys :req-un [::id ::name]))
(defn rename-page
[id name]
(us/verify ::us/uuid id)
(us/verify string? name)
(ptk/reify ::rename-page
ptk/WatchEvent
(watch [_ state stream]
(rx/of ::dwp/finalize))))
(let [page (get-in state [:workspace-data :pages-index id])
rchg {:type :mod-page
:id id
:name name}
uchg {:type :mod-page
:id id
:name (:name page)}]
(rx/of (dwc/commit-changes [rchg] [uchg] {:commit-local? true}))))))
(declare purge-page)
(declare go-to-file)
;; TODO: properly handle positioning on undo.
(defn delete-page
[id]
(ptk/reify ::delete-page
ptk/WatchEvent
(watch [_ state s]
(let [page (get-in state [:workspace-data :pages-index id])
rchg {:type :del-page
:id id}
uchg {:type :add-page
:page page}]
(rx/of (dwc/commit-changes [rchg] [uchg] {:commit-local? true})
(when (= id (:current-page-id state))
go-to-file))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Workspace State Manipulation
@ -212,8 +278,8 @@
(update :height #(/ % hprop))))))))
(initialize [state local]
(let [page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data page-id :objects])
(let [page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id)
shapes (cph/select-toplevel-shapes objects {:include-frames? true})
srect (geom/selection-rect shapes)
local (assoc local :vport size)]
@ -397,8 +463,8 @@
(ptk/reify ::zoom-to-fit-all
ptk/UpdateEvent
(update [_ state]
(let [page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data page-id :objects])
(let [page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id)
shapes (cph/select-toplevel-shapes objects {:include-frames? true})
srect (geom/selection-rect shapes)]
@ -420,11 +486,11 @@
(let [selected (get-in state [:workspace-local :selected])]
(if (empty? selected)
state
(let [page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data page-id :objects])
srect (->> selected
(map #(get objects %))
(geom/selection-rect))]
(let [page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id)
srect (->> selected
(map #(get objects %))
(geom/selection-rect))]
(update state :workspace-local
(fn [{:keys [vbox vport] :as local}]
(let [srect (geom/adjust-to-viewport vport srect {:padding 40})
@ -433,31 +499,8 @@
(assoc :zoom zoom)
(update :vbox merge srect)))))))))))
;; --- Add shape to Workspace
(defn- retrieve-used-names
[objects]
(into #{} (map :name) (vals objects)))
(defn- extract-numeric-suffix
[basename]
(if-let [[match p1 p2] (re-find #"(.*)-([0-9]+)$" basename)]
[p1 (+ 1 (d/parse-integer p2))]
[basename 1]))
(defn- generate-unique-name
"A unique name generator"
[used basename]
(s/assert ::set-of-string used)
(s/assert ::us/string basename)
(let [[prefix initial] (extract-numeric-suffix basename)]
(loop [counter initial]
(let [candidate (str prefix "-" counter)]
(if (contains? used candidate)
(recur (inc counter))
candidate)))))
(declare start-edition-mode)
(defn add-shape
@ -466,14 +509,14 @@
(ptk/reify ::add-shape
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
(let [page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id)
id (uuid/next)
shape (geom/setup-proportions attrs)
unames (retrieve-used-names objects)
name (generate-unique-name unames (:name shape))
unames (dwc/retrieve-used-names objects)
name (dwc/generate-unique-name unames (:name shape))
frames (cph/select-frames objects)
@ -492,9 +535,11 @@
rchange {:type :add-obj
:id id
:page-id page-id
:frame-id frame-id
:obj shape}
uchange {:type :del-obj
:page-id page-id
:id id}]
(rx/concat
@ -614,9 +659,9 @@
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
objects (dwc/lookup-page-objects state page-id)
del-change #(array-map :type :del-obj :id %)
del-change #(array-map :type :del-obj :page-id page-id :id %)
get-empty-parents
(fn get-empty-parents [parents]
@ -637,7 +682,9 @@
(map del-change (reverse children))
[(del-change id)]
(map del-change (get-empty-parents parents))
[{:type :reg-objects :shapes (vec parents)}])))
[{:type :reg-objects
:page-id page-id
:shapes (vec parents)}])))
[]
ids)
@ -649,6 +696,7 @@
(let [item (get objects id)]
{:type :add-obj
:id (:id item)
:page-id page-id
:index (cph/position-on-parent id objects)
:frame-id (:frame-id item)
:parent-id (:parent-id item)
@ -657,7 +705,9 @@
(map add-chg (reverse (get-empty-parents parents)))
[(add-chg id)]
(map add-chg children)
[{:type :reg-objects :shapes (vec parents)}])))
[{:type :reg-objects
:page-id page-id
:shapes (vec parents)}])))
[]
ids)
]
@ -673,16 +723,10 @@
(ptk/reify ::delete-selected
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
lookup #(get-in state [:workspace-data page-id :objects %])
selected (get-in state [:workspace-local :selected])
shapes (map lookup selected)
shape? #(not= (:type %) :frame)]
(let [selected (get-in state [:workspace-local :selected])]
(rx/of (delete-shapes selected)
dws/deselect-all)))))
;; --- Shape Vertical Ordering
(s/def ::loc #{:up :down :bottom :top})
@ -694,7 +738,7 @@
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
objects (dwc/lookup-page-objects state page-id)
selected (get-in state [:workspace-local :selected])
rchanges (mapv (fn [id]
(let [obj (get objects id)
@ -709,6 +753,7 @@
{:type :mov-objects
:parent-id (:parent-id obj)
:frame-id (:frame-id obj)
:page-id page-id
:index nindex
:shapes [id]}))
selected)
@ -718,9 +763,11 @@
{:type :mov-objects
:parent-id (:parent-id obj)
:frame-id (:frame-id obj)
:page-id page-id
:shapes [id]
:index (cph/position-on-parent id objects)}))
selected)]
selected)]
;; TODO: maybe missing the :reg-objects event?
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}))))))
@ -736,8 +783,7 @@
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
objects (dwc/lookup-page-objects state page-id)
parents (loop [res #{parent-id}
ids (seq ids)]
(if (nil? ids)
@ -748,9 +794,11 @@
rchanges [{:type :mov-objects
:parent-id parent-id
:page-id page-id
:index to-index
:shapes (vec (reverse ids))}
{:type :reg-objects
:page-id page-id
:shapes parents}]
uchanges
@ -759,11 +807,13 @@
(conj res
{:type :mov-objects
:parent-id (:parent-id obj)
:page-id page-id
:index (cph/position-on-parent id objects)
:shapes [id]})))
[] (reverse ids))
uchanges (conj uchanges
{:type :reg-objects
:page-id page-id
:shapes parents})]
;; (println "================ rchanges")
@ -787,23 +837,17 @@
(defn relocate-page
[id index]
(ptk/reify ::relocate-pages
ptk/UpdateEvent
(update [_ state]
(let [pages (get-in state [:workspace-file :pages])
[before after] (split-at index pages)
p? (partial = id)
pages' (d/concat []
(remove p? before)
[id]
(remove p? after))]
(assoc-in state [:workspace-file :pages] pages')))
ptk/WatchEvent
(watch [_ state stream]
(let [file (:workspace-file state)]
(->> (rp/mutation! :reorder-pages {:page-ids (:pages file)
:file-id (:id file)})
(rx/ignore))))))
(let [cidx (-> (get-in state [:workspace-data :pages])
(d/index-of id))
rchg {:type :mov-page
:id id
:index index}
uchg {:type :mov-page
:id id
:index cidx}]
(rx/of (dwc/commit-changes [rchg] [uchg] {:commit-local? true}))))))
;; --- Shape / Selection Alignment and Distribution
@ -817,7 +861,7 @@
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
objects (dwc/lookup-page-objects state page-id)
selected (get-in state [:workspace-local :selected])
moved (if (= 1 (count selected))
(align-object-to-frame objects (first selected) axis)
@ -838,9 +882,11 @@
ops2 (dwc/generate-operations curr prev)]
(recur (next moved)
(conj rchanges {:type :mod-obj
:page-id page-id
:operations ops1
:id (:id curr)})
(conj uchanges {:type :mod-obj
:page-id page-id
:operations ops2
:id (:id curr)})))))))))
@ -863,9 +909,8 @@
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
objects (dwc/lookup-page-objects state page-id)
selected (get-in state [:workspace-local :selected])
moved (-> (map #(get objects %) selected)
(geom/distribute-space axis objects))]
(loop [moved (seq moved)
@ -884,9 +929,11 @@
ops2 (dwc/generate-operations curr prev)]
(recur (next moved)
(conj rchanges {:type :mod-obj
:page-id page-id
:operations ops1
:id (:id curr)})
(conj uchanges {:type :mod-obj
:page-id page-id
:operations ops2
:id (:id curr)})))))))))
@ -921,7 +968,7 @@
(ptk/reify ::clear-drawing
ptk/UpdateEvent
(update [_ state]
(update state :workspace-local dissoc :drawing-tool :drawing))))
(update state :workspace-drawing dissoc :tool :object))))
(defn select-for-drawing
([tool] (select-for-drawing tool nil))
@ -929,7 +976,7 @@
(ptk/reify ::select-for-drawing
ptk/UpdateEvent
(update [_ state]
(update state :workspace-local assoc :drawing-tool tool :drawing data))
(update state :workspace-drawing assoc :tool tool :object data))
ptk/WatchEvent
(watch [_ state stream]
@ -963,7 +1010,8 @@
(defn set-shape-proportion-lock
[id lock]
(ptk/reify ::set-shape-proportion-lock
(js/alert "TODO: broken")
#_(ptk/reify ::set-shape-proportion-lock
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)
@ -988,11 +1036,13 @@
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
shape (get-in state [:workspace-data page-id :objects id])
current-position (gpt/point (:x shape) (:y shape))
position (gpt/point (or (:x position) (:x shape)) (or (:y position) (:y shape)))
displacement (gmt/translate-matrix (gpt/subtract position current-position))]
(rx/of (dwt/set-modifiers [id] {:displacement displacement})
objects (dwc/lookup-page-objects state page-id)
shape (get objects id)
cpos (gpt/point (:x shape) (:y shape))
pos (gpt/point (or (:x position) (:x shape))
(or (:y position) (:y shape)))
displ (gmt/translate-matrix (gpt/subtract pos cpos))]
(rx/of (dwt/set-modifiers [id] {:displacement displ})
(dwt/apply-modifiers [id]))))))
;; --- Path Modifications
@ -1003,7 +1053,8 @@
(us/verify ::us/uuid id)
(us/verify ::us/integer index)
(us/verify gpt/point? delta)
(ptk/reify ::update-path
(js/alert "TODO: broken")
#_(ptk/reify ::update-path
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)]
@ -1047,24 +1098,21 @@
ptk/WatchEvent
(watch [_ state stream]
(let [project-id (get-in state [:workspace-project :id])
file-id (get-in state [:workspace-page :file-id])
path-params {:file-id file-id :project-id project-id}
query-params {:page-id page-id}]
(rx/of (rt/nav :workspace path-params query-params))))))
file-id (get-in state [:workspace-file :id])
pparams {:file-id file-id :project-id project-id}
qparams {:page-id page-id}]
(rx/of (rt/nav :workspace pparams qparams))))))
(def go-to-file
(ptk/reify ::go-to-file
ptk/WatchEvent
(watch [_ state stream]
(let [file (:workspace-file state)
file-id (:id file)
project-id (:project-id file)
page-ids (:pages file)
path-params {:project-id project-id :file-id file-id}
query-params {:page-id (first page-ids)}]
(rx/of (rt/nav :workspace path-params query-params))))))
(let [{:keys [id project-id data] :as file} (:workspace-file state)
page-id (get-in data [:pages 0])
pparams {:project-id project-id :file-id id}
qparams {:page-id page-id}]
(rx/of (rt/nav :workspace pparams qparams))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Context Menu
@ -1128,8 +1176,7 @@
(ptk/reify ::copy-selected
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
(let [objects (dwc/lookup-page-objects state)
selected (get-in state [:workspace-local :selected])
cdata (prepare-selected objects selected)]
(->> (t/encode cdata)
@ -1144,18 +1191,18 @@
ptk/WatchEvent
(watch [_ state stream]
(let [selected-objs (map #(get objects %) selected)
wrapper (geom/selection-rect selected-objs)
orig-pos (gpt/point (:x1 wrapper) (:y1 wrapper))
wrapper (geom/selection-rect selected-objs)
orig-pos (gpt/point (:x1 wrapper) (:y1 wrapper))
mouse-pos @ms/mouse-position
delta (gpt/subtract mouse-pos orig-pos)
delta (gpt/subtract mouse-pos orig-pos)
page-id (:current-page-id state)
unames (-> (get-in state [:workspace-data page-id :objects])
(retrieve-used-names))
page-id (:current-page-id state)
unames (-> (dwc/lookup-page-objects state page-id)
(dwc/retrieve-used-names))
rchanges (dws/prepare-duplicate-changes objects unames selected delta)
uchanges (mapv #(array-map :type :del-obj :id (:id %))
(reverse rchanges))
rchanges (dws/prepare-duplicate-changes objects page-id unames selected delta)
uchanges (mapv #(array-map :type :del-obj :page-id page-id :id (:id %))
(reverse rchanges))
selected (->> rchanges
(filter #(selected (:old-id %)))
@ -1203,22 +1250,6 @@
(js/console.error "Clipboard error:" err)
(rx/empty)))))))
;; --- Change Page Order (D&D Ordering)
(defn change-page-order
[{:keys [id index] :as params}]
{:pre [(uuid? id) (number? index)]}
(ptk/reify ::change-page-order
ptk/UpdateEvent
(update [_ state]
(let [page (get-in state [:pages id])
pages (get-in state [:projects (:project-id page) :pages])
pages (into [] (remove #(= % id)) pages)
[before after] (split-at index pages)
pages (vec (concat before [id] after))]
(assoc-in state [:projects (:project-id page) :pages] pages)))))
(defn update-shape-flags
[id {:keys [blocked hidden] :as flags}]
(s/assert ::us/uuid id)
@ -1252,10 +1283,10 @@
(ptk/reify ::group-selected
ptk/WatchEvent
(watch [_ state stream]
(let [id (uuid/next)
page-id (get-in state [:workspace-page :id])
(let [id (uuid/next)
page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id)
selected (get-in state [:workspace-local :selected])
objects (get-in state [:workspace-data page-id :objects])
items (->> selected
(map #(get objects %))
(filter #(not= :frame (:type %)))
@ -1273,11 +1304,13 @@
rchanges [{:type :add-obj
:id id
:page-id page-id
:frame-id frame-id
:parent-id parent-id
:obj group
:index index}
{:type :mov-objects
:page-id page-id
:parent-id id
:shapes (->> items
(map :id)
@ -1287,13 +1320,14 @@
uchanges
(reduce (fn [res obj]
(conj res {:type :mov-objects
:page-id page-id
:parent-id (:parent-id obj)
:index (::index obj)
:shapes [(:id obj)]}))
[]
items)
uchanges (conj uchanges {:type :del-obj :id id})]
uchanges (conj uchanges {:type :del-obj :id id :page-id page-id})]
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
(dws/select-shapes (d/ordered-set id)))))))))
@ -1303,7 +1337,7 @@
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
objects (dwc/lookup-page-objects state page-id)
selected (get-in state [:workspace-local :selected])
group-id (first selected)
group (get objects group-id)]
@ -1317,17 +1351,21 @@
(filter #(#{group-id} (second %)))
(ffirst))
rchanges [{:type :mov-objects
:page-id page-id
:parent-id parent-id
:shapes shapes
:index index-in-parent}]
uchanges [{:type :add-obj
:page-id page-id
:id group-id
:frame-id (:frame-id group)
:obj (assoc group :shapes [])}
{:type :mov-objects
:page-id page-id
:parent-id group-id
:shapes shapes}
{:type :mov-objects
:page-id page-id
:parent-id parent-id
:shapes [group-id]
:index index-in-parent}]]
@ -1361,12 +1399,12 @@
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
objects (dwc/lookup-page-objects state page-id)
selected-shape-id (-> state (get-in [:workspace-local :selected]) first)
selected-shape (get objects selected-shape-id)
selected-shape-frame-id (:frame-id selected-shape)
start-frame (get objects selected-shape-frame-id)
end-frame (dwc/get-frame-at-point objects position)]
end-frame (dwc/get-frame-at-point objects position)]
(cond-> state
(not= position initial-pos) (assoc-in [:workspace-local :draw-interaction-to] position)
(not= start-frame end-frame) (assoc-in [:workspace-local :draw-interaction-to-frame] end-frame))))))
@ -1383,12 +1421,12 @@
ptk/WatchEvent
(watch [_ state stream]
(let [position @ms/mouse-position
page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
frame (dwc/get-frame-at-point objects position)
page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id)
frame (dwc/get-frame-at-point objects position)
shape-id (first (get-in state [:workspace-local :selected]))
shape (get objects shape-id)]
shape (get objects shape-id)]
(when-not (= position initial-pos)
(if (and frame shape-id
@ -1410,15 +1448,17 @@
(ptk/reify ::change-canvas-color
ptk/WatchEvent
(watch [_ state stream]
(let [pid (get state :current-page-id)
current-color (get-in state [:workspace-data pid :options :background])]
(let [page-id (get state :current-page-id)
options (dwc/lookup-page-options state page-id)
ccolor (:background options)]
(rx/of (dwc/commit-changes
[{:type :set-option
:page-id page-id
:option :background
:value color}]
[{:type :set-option
:option :background
:value current-color}]
:value ccolor}]
{:commit-local? true}))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1444,9 +1484,6 @@
(def unlink-file-from-library dwp/unlink-file-from-library)
(def upload-media-objects dwp/upload-media-objects)
(def delete-media-object dwp/delete-media-object)
(def rename-page dwp/rename-page)
(def delete-page dwp/delete-page)
(def create-empty-page dwp/create-empty-page)
;; Selection

154
frontend/src/app/main/data/workspace/common.cljs
View file

@ -25,10 +25,27 @@
;; --- Protocols
(declare setup-selection-index)
(declare update-page-indices)
(declare update-indices)
(declare reset-undo)
(declare append-undo)
;; --- Helpers
(defn lookup-page-objects
([state]
(lookup-page-objects state (:current-page-id state)))
([state page-id]
(get-in state [:workspace-data :pages-index page-id :objects])))
(defn lookup-page-options
([state]
(lookup-page-options state (:current-page-id state)))
([state page-id]
(get-in state [:workspace-data :pages-index page-id :options])))
;; --- Changes Handling
(defn commit-changes
@ -41,24 +58,23 @@
:as opts}]
(us/verify ::cp/changes changes)
(us/verify ::cp/changes undo-changes)
(ptk/reify ::commit-changes
cljs.core/IDeref
(-deref [_] changes)
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)
state (update-in state [:workspace-pages page-id :data] cp/process-changes changes)]
(let [state (update-in state [:workspace-file :data] cp/process-changes changes)]
(cond-> state
commit-local? (update-in [:workspace-data page-id] cp/process-changes changes))))
commit-local? (update :workspace-data cp/process-changes changes))))
ptk/WatchEvent
(watch [_ state stream]
(let [page (:workspace-page state)
uidx (get-in state [:workspace-local :undo-index] ::not-found)]
(let [page-id (:current-page-id state)
uidx (get-in state [:workspace-undo :index] ::not-found)]
(rx/concat
(rx/of (update-page-indices (:id page)))
(when (some :page-id changes)
(rx/of (update-indices page-id)))
(when (and save-undo? (not= uidx ::not-found))
(rx/of (reset-undo uidx)))
@ -93,7 +109,7 @@
result)))))
(defn generate-changes
[objects1 objects2]
[page-id objects1 objects2]
(letfn [(impl-diff [res id]
(let [obj1 (get objects1 id)
obj2 (get objects2 id)
@ -102,6 +118,7 @@
(if (empty? ops)
res
(conj res {:type :mod-obj
:page-id page-id
:operations ops
:id id}))))]
(reduce impl-diff [] (set/union (set (keys objects1))
@ -109,25 +126,23 @@
;; --- Selection Index Handling
(defn- setup-selection-index
[{:keys [file pages] :as bundle}]
(defn initialize-indices
[{:keys [file] :as bundle}]
(ptk/reify ::setup-selection-index
ptk/WatchEvent
(watch [_ state stream]
(let [msg {:cmd :create-page-indices
(let [msg {:cmd :initialize-indices
:file-id (:id file)
:pages pages}]
:data (:data file)}]
(->> (uw/ask! msg)
(rx/map (constantly ::index-initialized)))))))
(defn update-page-indices
(defn update-indices
[page-id]
(ptk/reify ::update-page-indices
(ptk/reify ::update-indices
ptk/EffectEvent
(effect [_ state stream]
(let [objects (get-in state [:workspace-pages page-id :data :objects])
lookup #(get objects %)]
(let [objects (lookup-page-objects state page-id)]
(uw/ask! {:cmd :update-page-indices
:page-id page-id
:objects objects})))))
@ -143,7 +158,7 @@
(or (:id frame) uuid/zero)))
(defn- calculate-shape-to-frame-relationship-changes
[frames shapes]
[page-id frames shapes]
(loop [shape (first shapes)
shapes (rest shapes)
rch []
@ -155,9 +170,11 @@
(recur (first shapes)
(rest shapes)
(conj rch {:type :mov-objects
:page-id page-id
:parent-id fid
:shapes [(:id shape)]})
(conj uch {:type :mov-objects
:page-id page-id
:parent-id (:frame-id shape)
:shapes [(:id shape)]}))
(recur (first shapes)
@ -171,12 +188,12 @@
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data page-id :objects])
objects (lookup-page-objects state page-id)
shapes (cph/select-toplevel-shapes objects)
frames (cph/select-frames objects)
[rch uch] (calculate-shape-to-frame-relationship-changes frames shapes)]
[rch uch] (calculate-shape-to-frame-relationship-changes page-id frames shapes)]
(when-not (empty? rch)
(rx/of (commit-changes rch uch {:commit-local? true})))))))
@ -184,11 +201,34 @@
(defn get-frame-at-point
[objects point]
(let [frames (cph/select-frames objects)]
(loop [frame (first frames)
rest (rest frames)]
(d/seek #(geom/has-point? % point) frames))))
(d/seek #(geom/has-point? % point) frames)))
(defn- extract-numeric-suffix
[basename]
(if-let [[match p1 p2] (re-find #"(.*)-([0-9]+)$" basename)]
[p1 (+ 1 (d/parse-integer p2))]
[basename 1]))
(defn retrieve-used-names
[objects]
(into #{} (map :name) (vals objects)))
(s/def ::set-of-string
(s/every string? :kind set?))
(defn generate-unique-name
"A unique name generator"
[used basename]
(s/assert ::set-of-string used)
(s/assert ::us/string basename)
(let [[prefix initial] (extract-numeric-suffix basename)]
(loop [counter initial]
(let [candidate (str prefix "-" counter)]
(if (contains? used candidate)
(recur (inc counter))
candidate)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Undo / Redo
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -212,10 +252,9 @@
(ptk/reify ::materialize-undo
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)]
(-> state
(update-in [:workspace-data page-id] cp/process-changes changes)
(assoc-in [:workspace-local :undo-index] index))))))
(-> state
(update :workspace-data cp/process-changes changes)
(assoc-in [:workspace-undo :index] index)))))
(defn- reset-undo
[index]
@ -223,10 +262,8 @@
ptk/UpdateEvent
(update [_ state]
(-> state
(update :workspace-local dissoc :undo-index)
(update-in [:workspace-local :undo]
(fn [queue]
(into [] (take (inc index) queue))))))))
(update :workspace-undo dissoc :undo-index)
(update-in [:workspace-undo :items] (fn [queue] (into [] (take (inc index) queue))))))))
(defn- append-undo
[entry]
@ -234,18 +271,17 @@
(ptk/reify ::append-undo
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace-local :undo] (fnil conj-undo-entry []) entry))))
(update-in state [:workspace-undo :items] (fnil conj-undo-entry []) entry))))
(def undo
(ptk/reify ::undo
ptk/WatchEvent
(watch [_ state stream]
(let [local (:workspace-local state)
undo (:undo local [])
index (or (:undo-index local)
(dec (count undo)))]
(when-not (or (empty? undo) (= index -1))
(let [changes (get-in undo [index :undo-changes])]
(let [undo (:workspace-undo state)
items (:items undo)
index (or (:index undo) (dec (count items)))]
(when-not (or (empty? items) (= index -1))
(let [changes (get-in items [index :undo-changes])]
(rx/of (materialize-undo changes (dec index))
(commit-changes changes [] {:save-undo? false}))))))))
@ -253,12 +289,11 @@
(ptk/reify ::redo
ptk/WatchEvent
(watch [_ state stream]
(let [local (:workspace-local state)
undo (:undo local [])
index (or (:undo-index local)
(dec (count undo)))]
(when-not (or (empty? undo) (= index (dec (count undo))))
(let [changes (get-in undo [(inc index) :redo-changes])]
(let [undo (:workspace-undo state)
items (:items undo)
index (or (:index undo) (dec (count items)))]
(when-not (or (empty? items) (= index (dec items)))
(let [changes (get-in items [(inc index) :redo-changes])]
(rx/of (materialize-undo changes (inc index))
(commit-changes changes [] {:save-undo? false}))))))))
@ -266,7 +301,13 @@
(ptk/reify ::reset-undo
ptk/UpdateEvent
(update [_ state]
(update state :workspace-local dissoc :undo-index :undo))))
(assoc state :workspace-undo {}))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Shapes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn expand-all-parents
@ -301,23 +342,25 @@
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])]
objects (lookup-page-objects state page-id)]
(loop [ids (seq ids)
rch []
uch []]
(if (nil? ids)
(rx/of (commit-changes
(cond-> rch reg-objects? (conj {:type :reg-objects :shapes (vec ids)}))
(cond-> uch reg-objects? (conj {:type :reg-objects :shapes (vec ids)}))
(cond-> rch reg-objects? (conj {:type :reg-objects :page-id page-id :shapes (vec ids)}))
(cond-> uch reg-objects? (conj {:type :reg-objects :page-id page-id :shapes (vec ids)}))
{:commit-local? true}))
(let [id (first ids)
obj1 (get objects id)
obj2 (f obj1)
rchg {:type :mod-obj
:page-id page-id
:operations (generate-operations obj1 obj2)
:id id}
uchg {:type :mod-obj
:page-id page-id
:operations (generate-operations obj2 obj1)
:id id}]
(recur (next ids)
@ -332,7 +375,7 @@
(letfn [(impl-get-children [objects id]
(cons id (cph/get-children id objects)))
(impl-gen-changes [objects ids]
(impl-gen-changes [objects page-id ids]
(loop [sids (seq ids)
cids (seq (impl-get-children objects (first sids)))
rchanges []
@ -354,9 +397,11 @@
rops (generate-operations obj1 obj2)
uops (generate-operations obj2 obj1)
rchg {:type :mod-obj
:page-id page-id
:operations rops
:id id}
uchg {:type :mod-obj
:page-id page-id
:operations uops
:id id}]
(recur sids
@ -366,10 +411,7 @@
(ptk/reify ::update-shapes-recursive
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data page-id :objects])
[rchanges uchanges] (impl-gen-changes objects (seq ids))]
(let [page-id (:current-page-id state)
objects (lookup-page-objects state page-id)
[rchanges uchanges] (impl-gen-changes objects page-id (seq ids))]
(rx/of (commit-changes rchanges uchanges {:commit-local? true})))))))

61
frontend/src/app/main/data/workspace/drawing.cljs
View file

@ -15,9 +15,11 @@
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as geom]
[app.common.pages :as cp]
[app.common.uuid :as uuid]
[app.common.pages-helpers :as cph]
[app.common.uuid :as uuid]
[app.main.data.workspace :as dw]
[app.main.data.workspace.common :as dwc]
[app.main.snap :as snap]
[app.main.streams :as ms]
[app.util.geom.path :as path]))
@ -29,25 +31,27 @@
(declare handle-finish-drawing)
(declare conditional-align)
;; NOTE/TODO: when an exception is raised in some point of drawing the
;; draw lock is not released so the user need to refresh in order to
;; be able draw again. THIS NEED TO BE REVISITED
(defn start-drawing
[type]
{:pre [(keyword? type)]}
(let [id (gensym "drawing")]
(let [id (uuid/next)]
(ptk/reify ::start-drawing
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace-local :drawing-lock] #(if (nil? %) id %)))
(update-in state [:workspace-drawing :lock] #(if (nil? %) id %)))
ptk/WatchEvent
(watch [_ state stream]
(let [lock (get-in state [:workspace-local :drawing-lock])]
(if (= lock id)
(rx/merge
(->> (rx/filter #(= % handle-finish-drawing) stream)
(rx/take 1)
(rx/map (fn [_] #(update % :workspace-local dissoc :drawing-lock))))
(rx/of (handle-drawing type)))
(rx/empty)))))))
(let [lock (get-in state [:workspace-drawing :lock])]
(when (= lock id)
(rx/merge (->> (rx/filter #(= % handle-finish-drawing) stream)
(rx/take 1)
(rx/map (fn [_] #(update % :workspace-drawing dissoc :lock))))
(rx/of (handle-drawing type)))))))))
(defn handle-drawing
[type]
@ -55,7 +59,7 @@
ptk/UpdateEvent
(update [_ state]
(let [data (cp/make-minimal-shape type)]
(update-in state [:workspace-local :drawing] merge data)))
(update-in state [:workspace-drawing :object] merge data)))
ptk/WatchEvent
(watch [_ state stream]
@ -81,7 +85,7 @@
(assoc-in [:modifiers :resize-rotation] 0))))
(update-drawing [state point lock? point-snap]
(update-in state [:workspace-local :drawing] resize-shape point lock? point-snap))]
(update-in state [:workspace-drawing :object] resize-shape point lock? point-snap))]
(ptk/reify ::handle-drawing-generic
ptk/WatchEvent
@ -92,8 +96,9 @@
stoper (rx/filter stoper? stream)
initial @ms/mouse-position
page-id (get state :current-page-id)
objects (get-in state [:workspace-data page-id :objects])
page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id)
layout (get state :workspace-layout)
frames (cph/select-frames objects)
@ -104,18 +109,18 @@
uuid/zero)
shape (-> state
(get-in [:workspace-local :drawing])
(get-in [:workspace-drawing :object])
(geom/setup {:x (:x initial) :y (:y initial) :width 1 :height 1})
(assoc :frame-id fid)
(assoc ::initialized? true))]
(rx/concat
;; Add shape to drawing state
(rx/of #(assoc-in state [:workspace-local :drawing] shape))
(rx/of #(assoc-in state [:workspace-drawing :object] shape))
;; Initial SNAP
(->> (snap/closest-snap-point page-id [shape] layout initial)
(rx/map (fn [{:keys [x y]}]
#(update-in % [:workspace-local :drawing] assoc :x x :y y))))
#(update-in % [:workspace-drawing :object] assoc :x x :y y))))
(->> ms/mouse-position
(rx/with-latest vector ms/mouse-position-ctrl)
@ -143,22 +148,22 @@
(initialize-drawing [state point]
(-> state
(assoc-in [:workspace-local :drawing :segments] [point point])
(assoc-in [:workspace-local :drawing ::initialized?] true)))
(assoc-in [:workspace-drawing :object :segments] [point point])
(assoc-in [:workspace-drawing :object ::initialized?] true)))
(insert-point-segment [state point]
(-> state
(update-in [:workspace-local :drawing :segments] (fnil conj []) point)))
(update-in [:workspace-drawing :object :segments] (fnil conj []) point)))
(update-point-segment [state index point]
(let [segments (count (get-in state [:workspace-local :drawing :segments]))
(let [segments (count (get-in state [:workspace-drawing :object :segments]))
exists? (< -1 index segments)]
(cond-> state
exists? (assoc-in [:workspace-local :drawing :segments index] point))))
exists? (assoc-in [:workspace-drawing :object :segments index] point))))
(finish-drawing-path [state]
(update-in
state [:workspace-local :drawing]
state [:workspace-drawing :object]
(fn [shape] (-> shape
(update :segments #(vec (butlast %)))
(geom/update-path-selrect)))))]
@ -229,14 +234,14 @@
(ms/mouse-event? event) (= type :up))
(initialize-drawing [state]
(assoc-in state [:workspace-local :drawing ::initialized?] true))
(assoc-in state [:workspace-drawing :object ::initialized?] true))
(insert-point-segment [state point]
(update-in state [:workspace-local :drawing :segments] (fnil conj []) point))
(update-in state [:workspace-drawing :object :segments] (fnil conj []) point))
(finish-drawing-curve [state]
(update-in
state [:workspace-local :drawing]
state [:workspace-drawing :object]
(fn [shape]
(-> shape
(update :segments #(path/simplify % simplify-tolerance))
@ -260,7 +265,7 @@
(ptk/reify ::handle-finish-drawing
ptk/WatchEvent
(watch [_ state stream]
(let [shape (get-in state [:workspace-local :drawing])]
(let [shape (get-in state [:workspace-drawing :object])]
(rx/concat
(rx/of dw/clear-drawing)
(when (::initialized? shape)
@ -281,5 +286,5 @@
(ptk/reify ::close-drawing-path
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :drawing :close?] true))))
(assoc-in state [:workspace-drawing :object :close?] true))))

99
frontend/src/app/main/data/workspace/libraries.cljs Normal file
View file

@ -0,0 +1,99 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.main.data.workspace.libraries
(:require
[app.common.data :as d]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.main.data.workspace.common :as dwc]
[app.common.pages :as cp]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.color :as color]
[app.util.i18n :refer [tr]]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
(defn add-color
[color]
(us/assert ::us/string color)
(ptk/reify ::add-color
ptk/WatchEvent
(watch [_ state s]
(let [id (uuid/next)
rchg {:type :add-color
:color {:id id
:name color
:value color}}
uchg {:type :del-color
:id id}]
(rx/of #(assoc-in % [:workspace-local :color-for-rename] id)
(dwc/commit-changes [rchg] [uchg] {:commit-local? true}))))))
(def clear-color-for-rename
(ptk/reify ::clear-color-for-rename
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :color-for-rename] nil))))
(defn update-color
[{:keys [id] :as color}]
(us/assert ::cp/color color)
(ptk/reify ::update-color
ptk/WatchEvent
(watch [_ state stream]
(let [prev (get-in state [:workspace-data :colors id])
rchg {:type :mod-color
:color color}
uchg {:type :mod-color
:color prev}]
(rx/of (dwc/commit-changes [rchg] [uchg] {:commit-local? true}))))))
(defn delete-color
[{:keys [id] :as color}]
(us/assert ::us/uuid id)
(ptk/reify ::delete-color
ptk/WatchEvent
(watch [_ state stream]
(let [prev (get-in state [:workspace-data :colors id])
rchg {:type :del-color
:id id}
uchg {:type :add-color
:color prev}]
(rx/of (dwc/commit-changes [rchg] [uchg] {:commit-local? true}))))))
(defn add-media
[{:keys [id] :as media}]
(us/assert ::cp/media-object media)
(ptk/reify ::add-media
ptk/WatchEvent
(watch [_ state stream]
(let [rchg {:type :add-media
:object media}
uchg {:type :del-media
:id id}]
(rx/of (dwc/commit-changes [rchg] [uchg] {:commit-local? true}))))))
(defn delete-media
[{:keys [id] :as media}]
(us/assert ::us/uuid id)
(ptk/reify ::delete-media
ptk/WatchEvent
(watch [_ state stream]
(let [prev (get-in state [:workspace-data :media id])
rchg {:type :del-media
:id id}
uchg {:type :add-media
:object prev}]
(rx/of (dwc/commit-changes [rchg] [uchg] {:commit-local? true}))))))

85
frontend/src/app/main/data/workspace/notifications.cljs
View file

@ -9,26 +9,28 @@
(ns app.main.data.workspace.notifications
(:require
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[clojure.set :as set]
[potok.core :as ptk]
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.spec :as us]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.persistence :as dwp]
[app.main.repo :as rp]
[app.main.store :as st]
[app.main.streams :as ms]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.persistence :as dwp]
[app.util.avatars :as avatars]
[app.common.geom.point :as gpt]
[app.util.time :as dt]
[app.util.transit :as t]
[app.util.websockets :as ws]))
[app.util.websockets :as ws]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[clojure.set :as set]
[potok.core :as ptk]))
;; TODO: this module need to be revisited.
(declare handle-presence)
(declare handle-pointer-update)
(declare handle-page-change)
(declare handle-file-change)
(declare handle-pointer-send)
(declare send-keepalive)
@ -62,7 +64,7 @@
(case type
:presence (handle-presence msg)
:pointer-update (handle-pointer-update msg)
:page-change (handle-page-change msg)
:file-change (handle-file-change msg)
::unknown))))
(->> stream
@ -120,22 +122,29 @@
avail (set/difference presence-palette used)
color (or (first avail) "#000000")]
(assoc session :color color))))
(assign-session [sessions {:keys [id profile]}]
(let [session {:id id
:fullname (:fullname profile)
:updated-at (dt/now)
:photo-uri (or (:photo-uri profile)
(avatars/generate {:name (:fullname profile)}))}
session (assign-color sessions session)]
(assoc sessions id session)))
(update-sessions [previous profiles]
(reduce (fn [current [session-id profile-id]]
(let [profile (get profiles profile-id)
session {:id session-id
:fullname (:fullname profile)
:photo-uri (or (:photo-uri profile)
(avatars/generate {:name (:fullname profile)}))}
session (assign-color current session)]
(assoc current session-id session)))
(select-keys previous (map first sessions))
(filter (fn [[sid]] (not (contains? previous sid))) sessions)))]
(let [previous (select-keys previous (map first sessions)) ; Initial clearing
pending (->> sessions
(filter #(not (contains? previous (first %))))
(map (fn [[session-id profile-id]]
{:id session-id
:profile (get profiles profile-id)})))]
(reduce assign-session previous pending)))]
(ptk/reify ::handle-presence
ptk/UpdateEvent
(update [_ state]
(let [profiles (:workspace-users state)]
(let [profiles (:workspace-users state)]
(update state :workspace-presence update-sessions profiles))))))
(defn handle-pointer-update
@ -143,13 +152,12 @@
(ptk/reify ::handle-pointer-update
ptk/UpdateEvent
(update [_ state]
(let [profile (get-in state [:workspace-users profile-id])]
(update-in state [:workspace-presence session-id]
(fn [session]
(assoc session
:point (gpt/point x y)
:updated-at (dt/now)
:page-id page-id)))))))
(update-in state [:workspace-presence session-id]
(fn [session]
(assoc session
:point (gpt/point x y)
:updated-at (dt/now)
:page-id page-id))))))
(defn handle-pointer-send
[file-id point]
@ -158,19 +166,24 @@
(effect [_ state stream]
(let [ws (get-in state [:ws file-id])
sid (:session-id state)
pid (get-in state [:workspace-page :id])
pid (:current-page-id state)
msg {:type :pointer-update
:page-id pid
:x (:x point)
:y (:y point)}]
(ws/-send ws (t/encode msg))))))
(defn handle-page-change
[msg]
(ptk/reify ::handle-page-change
;; TODO: add specs
(defn handle-file-change
[{:keys [file-id changes] :as msg}]
(ptk/reify ::handle-file-change
ptk/WatchEvent
(watch [_ state stream]
(rx/of (dwp/shapes-changes-persisted msg)
(dwc/update-page-indices (:page-id msg))))))
(let [page-ids (into #{} (comp (map :page-id)
(filter identity))
changes)]
(rx/merge
(rx/of (dwp/shapes-changes-persisted file-id msg))
(when (seq page-ids)
(rx/from (map dwc/update-indices page-ids))))))))

252
frontend/src/app/main/data/workspace/persistence.cljs
View file

@ -9,17 +9,15 @@
(ns app.main.data.workspace.persistence
(:require
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]
[app.common.data :as d]
[app.common.media :as cm]
[app.common.geom.point :as gpt]
[app.common.media :as cm]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.main.data.dashboard :as dd]
[app.main.data.messages :as dm]
[app.main.data.media :as di]
[app.main.data.messages :as dm]
[app.main.data.workspace.common :as dwc]
[app.main.repo :as rp]
[app.main.store :as st]
@ -27,25 +25,23 @@
[app.util.object :as obj]
[app.util.router :as rt]
[app.util.time :as dt]
[app.util.transit :as t]))
[app.util.transit :as t]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
(declare persist-changes)
(declare update-selection-index)
(declare shapes-changes-persisted)
;; --- Persistence
(defn initialize-page-persistence
[page-id]
(defn initialize-file-persistence
[file-id]
(letfn [(enable-reload-stoper []
(obj/set! js/window "onbeforeunload" (constantly false)))
(disable-reload-stoper []
(obj/set! js/window "onbeforeunload" nil))]
(ptk/reify ::initialize-persistence
ptk/UpdateEvent
(update [_ state]
(assoc state :current-page-id page-id))
ptk/WatchEvent
(watch [_ state stream]
(let [stoper (rx/filter #(= ::finalize %) stream)
@ -61,7 +57,7 @@
(rx/buffer-until notifier)
(rx/map vec)
(rx/filter (complement empty?))
(rx/map #(persist-changes page-id %))
(rx/map #(persist-changes file-id %))
(rx/take-until (rx/delay 100 stoper)))
(->> stream
(rx/filter (ptk/type? ::changes-persisted))
@ -70,40 +66,44 @@
(rx/take-until stoper))))))))
(defn persist-changes
[page-id changes]
[file-id changes]
(ptk/reify ::persist-changes
ptk/WatchEvent
(watch [_ state stream]
(let [sid (:session-id state)
page (get-in state [:workspace-pages page-id])
changes (into [] (mapcat identity) changes)
params {:id (:id page)
:revn (:revn page)
:session-id sid
:changes changes}]
(->> (rp/mutation :update-page params)
(rx/map (fn [lagged]
(if (= #{sid} (into #{} (map :session-id) lagged))
(map #(assoc % :changes []) lagged)
lagged)))
(rx/mapcat seq)
(rx/map shapes-changes-persisted))))))
file (:workspace-file state)]
(when (= (:id file) file-id)
(let [changes (into [] (mapcat identity) changes)
params {:id (:id file)
:revn (:revn file)
:session-id sid
:changes changes}]
(->> (rp/mutation :update-file params)
(rx/map (fn [lagged]
(if (= #{sid} (into #{} (map :session-id) lagged))
(map #(assoc % :changes []) lagged)
lagged)))
(rx/mapcat seq)
(rx/map #(shapes-changes-persisted file-id %)))))))))
(s/def ::shapes-changes-persisted
(s/keys :req-un [::page-id ::revn ::cp/changes]))
(s/keys :req-un [::revn ::cp/changes]))
(defn shapes-changes-persisted
[{:keys [page-id revn changes] :as params}]
[file-id {:keys [revn changes] :as params}]
(us/verify ::us/uuid file-id)
(us/verify ::shapes-changes-persisted params)
(ptk/reify ::changes-persisted
ptk/UpdateEvent
(update [_ state]
(let [sid (:session-id state)
page (get-in state [:workspace-pages page-id])
state (update-in state [:workspace-pages page-id :revn] #(max % revn))]
(-> state
(update-in [:workspace-data page-id] cp/process-changes changes)
(update-in [:workspace-pages page-id :data] cp/process-changes changes))))))
file (:workspace-file state)]
(if (= file-id (:id file))
(let [state (update-in state [:workspace-file :revn] #(max % revn))]
(-> state
(update :workspace-data cp/process-changes changes)
(update-in [:workspace-file :data] cp/process-changes changes)))
state)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -148,18 +148,9 @@
(->> (rx/zip (rp/query :file {:id file-id})
(rp/query :file-users {:id file-id})
(rp/query :project-by-id {:project-id project-id})
(rp/query :pages {:file-id file-id})
(rp/query :media-objects {:file-id file-id :is-local false})
(rp/query :colors {:file-id file-id})
(rp/query :file-libraries {:file-id file-id}))
(rx/first)
(rx/mapcat
(fn [bundle]
(->> (fetch-libraries-content (get bundle 6))
(rx/map (fn [[lib-media-objects lib-colors]]
(conj bundle lib-media-objects lib-colors))))))
(rx/map (fn [bundle]
(apply bundle-fetched bundle)))
(rx/map (fn [bundle] (apply bundle-fetched bundle)))
(rx/catch (fn [{:keys [type code] :as error}]
(cond
(= :not-found type)
@ -172,76 +163,25 @@
:else
(throw error))))))))
(defn- fetch-libraries-content
[libraries]
(if (empty? libraries)
(rx/of [{} {}])
(rx/zip
(->> ;; fetch media-objects list of each library, and concatenate in a sequence
(apply rx/zip (for [library libraries]
(->> (rp/query :media-objects {:file-id (:id library)
:is-local false})
(rx/map (fn [media-objects]
[(:id library) media-objects])))))
;; reorganize the sequence as a map {library-id -> media-objects}
(rx/map (fn [media-list]
(reduce (fn [result, [library-id media-objects]]
(assoc result library-id media-objects))
{}
media-list))))
(->> ;; fetch colorss list of each library, and concatenate in a vector
(apply rx/zip (for [library libraries]
(->> (rp/query :colors {:file-id (:id library)})
(rx/map (fn [colors]
[(:id library) colors])))))
;; reorganize the sequence as a map {library-id -> colors}
(rx/map (fn [colors-list]
(reduce (fn [result, [library-id colors]]
(assoc result library-id colors))
{}
colors-list)))))))
(defn- bundle-fetched
[file users project pages media-objects colors libraries lib-media-objects lib-colors]
[file users project libraries]
(ptk/reify ::bundle-fetched
IDeref
(-deref [_]
{:file file
:users users
:project project
:pages pages
:media-objects media-objects
:colors colors
:libraries libraries})
ptk/UpdateEvent
(update [_ state]
(let [assoc-page
#(assoc-in %1 [:workspace-pages (:id %2)] %2)
assoc-media-objects
#(assoc-in %1 [:workspace-libraries %2 :media-objects]
(get lib-media-objects %2))
assoc-colors
#(assoc-in %1 [:workspace-libraries %2 :colors]
(get lib-colors %2))]
(as-> state $$
(assoc $$
:workspace-file (assoc file
:media-objects media-objects
:colors colors)
:workspace-users (d/index-by :id users)
:workspace-pages {}
:workspace-project project
:workspace-libraries (d/index-by :id libraries))
(reduce assoc-media-objects $$ (keys lib-media-objects))
(reduce assoc-colors $$ (keys lib-colors))
(reduce assoc-page $$ pages))))))
(assoc state
:workspace-undo {}
:workspace-project project
:workspace-file file
:workspace-data (:data file)
:workspace-users (d/index-by :id users)
:workspace-libraries (d/index-by :id libraries)))))
;; --- Set File shared
@ -358,80 +298,6 @@
(assoc-in state [:workspace-pages id] page))))
;; --- Page Crud
(declare page-created)
(def create-empty-page
(ptk/reify ::create-empty-page
ptk/WatchEvent
(watch [this state stream]
(let [file-id (get-in state [:workspace-file :id])
name (name (gensym "Page "))
ordering (count (get-in state [:workspace-file :pages]))
params {:name name
:file-id file-id
:ordering ordering
:data cp/default-page-data}]
(->> (rp/mutation :create-page params)
(rx/map page-created))))))
(defn page-created
[{:keys [id file-id] :as page}]
(us/verify ::page page)
(ptk/reify ::page-created
cljs.core/IDeref
(-deref [_] page)
ptk/UpdateEvent
(update [_ state]
(-> state
(update-in [:workspace-file :pages] (fnil conj []) id)
(assoc-in [:workspace-pages id] page)))))
(s/def ::rename-page
(s/keys :req-un [::id ::name]))
(defn rename-page
[id name]
(us/verify ::us/uuid id)
(us/verify string? name)
(ptk/reify ::rename-page
ptk/UpdateEvent
(update [_ state]
(let [pid (get-in state [:workspace-page :id])
state (assoc-in state [:workspace-pages id :name] name)]
(cond-> state
(= pid id) (assoc-in [:workspace-page :name] name))))
ptk/WatchEvent
(watch [_ state stream]
(let [params {:id id :name name}]
(->> (rp/mutation :rename-page params)
(rx/map #(ptk/data-event ::page-renamed params)))))))
(declare purge-page)
(declare go-to-file)
(defn delete-page
[id]
{:pre [(uuid? id)]}
(reify
ptk/UpdateEvent
(update [_ state]
(purge-page state id))
ptk/WatchEvent
(watch [_ state s]
(let [page (:workspace-page state)]
(rx/merge
(->> (rp/mutation :delete-page {:id id})
(rx/flat-map (fn [_]
(if (= id (:id page))
(rx/of go-to-file)
(rx/empty))))))))))
;; --- Upload local media objects
(s/def ::local? ::us/boolean)
@ -462,23 +328,7 @@
(fn [uri]
{:file-id file-id
:is-local local?
:url uri})
assoc-to-library
(fn [media-object state]
(cond
(true? local?)
state
(true? is-library)
(update-in state
[:workspace-libraries file-id :media-objects]
#(conj % media-object))
:else
(update-in state
[:workspace-file :media-objects]
#(conj % media-object))))]
:url uri})]
(rx/concat
(rx/of (dm/show {:content (tr "media.loading")
@ -493,7 +343,6 @@
(rx/map prepare-js-file)
(rx/mapcat #(rp/mutation! :upload-media-object %))))
(rx/do on-success)
(rx/map (fn [mobj] (partial assoc-to-library mobj)))
(rx/catch (fn [error]
(cond
(= (:code error) :media-type-not-allowed)
@ -518,17 +367,6 @@
(defn delete-media-object
[file-id id]
(ptk/reify ::delete-media-object
ptk/UpdateEvent
(update [_ state]
(let [is-library (not= file-id (:id (:workspace-file state)))]
(if is-library
(update-in state
[:workspace-libraries file-id :media-objects]
(fn [media-objects] (filter #(not= (:id %) id) media-objects)))
(update-in state
[:workspace-file :media-objects]
(fn [media-objects] (filter #(not= (:id %) id) media-objects))))))
ptk/WatchEvent
(watch [_ state stream]
(let [params {:id id}]

80
frontend/src/app/main/data/workspace/selection.cljs
View file

@ -125,8 +125,8 @@
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data page-id :objects])]
(let [page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id)]
(rx/of (dwc/expand-all-parents [id] objects)))))))
(defn select-shapes
@ -139,8 +139,8 @@
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data page-id :objects])]
(let [page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id)]
(rx/of (dwc/expand-all-parents ids objects))))))
(def deselect-all
@ -159,7 +159,7 @@
(ptk/reify ::select-shapes-by-current-selrect
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (get-in state [:workspace-page :id])
(let [page-id (:current-page-id state)
selrect (get-in state [:workspace-local :selrect])]
(rx/merge
(rx/of (update-selrect nil))
@ -174,17 +174,19 @@
(ptk/reify ::select-inside-group
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
group (get objects group-id)
(let [page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id)
group (get objects group-id)
children (map #(get objects %) (:shapes group))
;; TODO: consider using d/seek instead of filter+first
selected (->> children (filter #(geom/has-point? % position)) first)]
(when selected
(rx/of deselect-all (select-shape (:id selected))))))))
;; --- Duplicate Shapes
(declare prepare-duplicate-changes)
;; (declare prepare-duplicate-changes)
(declare prepare-duplicate-change)
(declare prepare-duplicate-frame-change)
(declare prepare-duplicate-shape-change)
@ -195,13 +197,13 @@
"Prepare objects to paste: generate new id, give them unique names,
move to the position of mouse pointer, and find in what frame they
fit."
[objects names ids delta]
[objects page-id names ids delta]
(loop [names names
ids (seq ids)
chgs []]
(if ids
(let [id (first ids)
result (prepare-duplicate-change objects names id delta)
result (prepare-duplicate-change objects page-id names id delta)
result (if (vector? result) result [result])]
(recur
(into names (map change->name) result)
@ -210,24 +212,24 @@
chgs)))
(defn- prepare-duplicate-change
[objects names id delta]
[objects page-id names id delta]
(let [obj (get objects id)]
(if (= :frame (:type obj))
(prepare-duplicate-frame-change objects names obj delta)
(prepare-duplicate-shape-change objects names obj delta (:frame-id obj) (:parent-id obj)))))
(prepare-duplicate-frame-change objects page-id names obj delta)
(prepare-duplicate-shape-change objects page-id names obj delta (:frame-id obj) (:parent-id obj)))))
(defn- prepare-duplicate-shape-change
[objects names obj delta frame-id parent-id]
(let [id (uuid/next)
name (generate-unique-name names (:name obj))
[objects page-id names obj delta frame-id parent-id]
(let [id (uuid/next)
name (generate-unique-name names (:name obj))
renamed-obj (assoc obj :id id :name name)
moved-obj (geom/move renamed-obj delta)
frames (cph/select-frames objects)
frame-id (if frame-id
frame-id
(dwc/calculate-frame-overlap frames moved-obj))
moved-obj (geom/move renamed-obj delta)
frames (cph/select-frames objects)
frame-id (if frame-id
frame-id
(dwc/calculate-frame-overlap frames moved-obj))
parent-id (or parent-id frame-id)
parent-id (or parent-id frame-id)
children-changes
(loop [names names
@ -237,7 +239,7 @@
(if (nil? cid)
result
(let [obj (get objects cid)
changes (prepare-duplicate-shape-change objects names obj delta frame-id id)]
changes (prepare-duplicate-shape-change objects page-id names obj delta frame-id id)]
(recur
(into names (map change->name changes))
(into result changes)
@ -249,6 +251,7 @@
(dissoc :shapes))]
(into [{:type :add-obj
:id id
:page-id page-id
:old-id (:id obj)
:frame-id frame-id
:parent-id parent-id
@ -256,25 +259,25 @@
children-changes)))
(defn- prepare-duplicate-frame-change
[objects names obj delta]
[objects page-id names obj delta]
(let [frame-id (uuid/next)
frame-name (generate-unique-name names (:name obj))
sch (->> (map #(get objects %) (:shapes obj))
(mapcat #(prepare-duplicate-shape-change objects names % delta frame-id frame-id)))
sch (->> (map #(get objects %) (:shapes obj))
(mapcat #(prepare-duplicate-shape-change objects page-id names % delta frame-id frame-id)))
renamed-frame (-> obj
(assoc :id frame-id)
(assoc :name frame-name)
(assoc :frame-id uuid/zero)
(dissoc :shapes))
moved-frame (geom/move renamed-frame delta)
frame (-> obj
(assoc :id frame-id)
(assoc :name frame-name)
(assoc :frame-id uuid/zero)
(dissoc :shapes)
(geom/move delta))
fch {:type :add-obj
:old-id (:id obj)
:page-id page-id
:id frame-id
:frame-id uuid/zero
:obj moved-frame}]
:obj frame}]
(into [fch] sch)))
@ -283,13 +286,14 @@
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id)
selected (get-in state [:workspace-local :selected])
objects (get-in state [:workspace-data page-id :objects])
delta (gpt/point 0 0)
unames (retrieve-used-names objects)
rchanges (prepare-duplicate-changes objects unames selected delta)
uchanges (mapv #(array-map :type :del-obj :id (:id %))
rchanges (prepare-duplicate-changes objects page-id unames selected delta)
uchanges (mapv #(array-map :type :del-obj :page-id page-id :id (:id %))
(reverse rchanges))
selected (->> rchanges

124
frontend/src/app/main/data/workspace/transforms.cljs
View file

@ -10,23 +10,23 @@
(ns app.main.data.workspace.transforms
"Events related with shapes transformations"
(:require
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[beicon.core :as rx]
[potok.core :as ptk]
[app.common.data :as d]
[app.common.spec :as us]
[app.common.pages :as cp]
[app.common.pages-helpers :as cph]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.selection :as dws]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.streams :as ms]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.main.snap :as snap]))
[app.common.pages :as cp]
[app.common.pages-helpers :as cph]
[app.common.spec :as us]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.selection :as dws]
[app.main.refs :as refs]
[app.main.snap :as snap]
[app.main.store :as st]
[app.main.streams :as ms]
[beicon.core :as rx]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
;; -- Declarations
@ -135,10 +135,11 @@
(watch [_ state stream]
(let [current-pointer @ms/mouse-position
initial-position (merge current-pointer initial)
stoper (rx/filter ms/mouse-up? stream)
page-id (get state :current-page-id)
resizing-shapes (map #(get-in state [:workspace-data page-id :objects %]) ids)
layout (get state :workspace-layout)]
stoper (rx/filter ms/mouse-up? stream)
layout (:workspace-layout state)
page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id)
resizing-shapes (map #(get objects %) ids)]
(rx/concat
(->> ms/mouse-position
(rx/with-latest vector ms/mouse-position-shift)
@ -148,12 +149,10 @@
(rx/map #(conj current %)))))
(rx/mapcat (partial resize shape initial-position resizing-shapes))
(rx/take-until stoper))
#_(rx/empty)
(rx/of (apply-modifiers ids)
finish-transform)))))))
;; -- ROTATE
(defn start-rotate
[shapes]
(ptk/reify ::start-rotate
@ -164,10 +163,10 @@
ptk/WatchEvent
(watch [_ state stream]
(let [stoper (rx/filter ms/mouse-up? stream)
group (gsh/selection-rect shapes)
group-center (gsh/center group)
initial-angle (gpt/angle @ms/mouse-position group-center)
(let [stoper (rx/filter ms/mouse-up? stream)
group (gsh/selection-rect shapes)
group-center (gsh/center group)
initial-angle (gpt/angle @ms/mouse-position group-center)
calculate-angle (fn [pos ctrl?]
(let [angle (- (gpt/angle pos group-center) initial-angle)
angle (if (neg? angle) (+ 360 angle) angle)
@ -201,9 +200,9 @@
(ptk/reify ::start-move-selected
ptk/WatchEvent
(watch [_ state stream]
(let [initial @ms/mouse-position
(let [initial (deref ms/mouse-position)
selected (get-in state [:workspace-local :selected])
stopper (rx/filter ms/mouse-up? stream)]
stopper (rx/filter ms/mouse-up? stream)]
(->> ms/mouse-position
(rx/take-until stopper)
(rx/map #(gpt/to-vec initial %))
@ -240,8 +239,8 @@
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (get state :current-page-id)
objects (get-in state [:workspace-data page-id :objects])
(let [page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id)
ids (if (nil? ids) (get-in state [:workspace-local :selected]) ids)
shapes (mapv #(get objects %) ids)
stopper (rx/filter ms/mouse-up? stream)
@ -342,22 +341,24 @@
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data page-id :objects])
not-frame-id? (fn [shape-id]
(let [shape (get objects shape-id)]
(or recurse-frames? (not (= :frame (:type shape))))))
objects (dwc/lookup-page-objects state page-id)
not-frame-id?
(fn [shape-id]
(let [shape (get objects shape-id)]
(or recurse-frames? (not (= :frame (:type shape))))))
;; For each shape updates the modifiers given as arguments
update-shape
(fn [objects shape-id]
(update-in objects [shape-id :modifiers] #(merge % modifiers)))
;; ID's + Children but remove frame children if the flag is set to false
ids-with-children (concat ids (mapcat #(cph/get-children % objects)
(filter not-frame-id? ids)))
(filter not-frame-id? ids)))]
;; For each shape updates the modifiers given as arguments
update-shape (fn [state shape-id]
(update-in
state
[:workspace-data page-id :objects shape-id :modifiers]
#(merge % modifiers)))]
(reduce update-shape state ids-with-children))))))
(d/update-in-when state [:workspace-data :pages-index page-id :objects]
#(reduce update-shape % ids-with-children)))))))
(defn rotation-modifiers [center shape angle]
(let [displacement (let [shape-center (gsh/center shape)]
@ -376,25 +377,23 @@
(set-rotation delta-rotation shapes (-> shapes gsh/selection-rect gsh/center)))
([delta-rotation shapes center]
(ptk/reify ::set-rotation
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)]
(letfn [(rotate-shape [state angle shape center]
(let [objects (get-in state [:workspace-data page-id :objects])
path [:workspace-data page-id :objects (:id shape) :modifiers]
modifiers (rotation-modifiers center shape angle)]
(-> state
(update-in path merge modifiers))))
(letfn [(rotate-shape [objects angle shape center]
(update-in objects [(:id shape) :modifiers] merge (rotation-modifiers center shape angle)))
(rotate-around-center [state angle center shapes]
(reduce #(rotate-shape %1 angle %2 center) state shapes))]
(rotate-around-center [objects angle center shapes]
(reduce #(rotate-shape %1 angle %2 center) objects shapes))
(let [objects (get-in state [:workspace-data page-id :objects])
id->obj #(get objects %)
get-children (fn [shape] (map id->obj (cph/get-children (:id shape) objects)))
shapes (concat shapes (mapcat get-children shapes))]
(rotate-around-center state delta-rotation center shapes))))))))
(set-rotation [objects]
(let [id->obj #(get objects %)
get-children (fn [shape] (map id->obj (cph/get-children (:id shape) objects)))
shapes (concat shapes (mapcat get-children shapes))]
(rotate-around-center objects delta-rotation center shapes)))]
(ptk/reify ::set-rotation
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)]
(d/update-in-when state [:workspace-data :pages-index page-id :objects] set-rotation)))))))
(defn apply-modifiers
[ids]
@ -403,8 +402,9 @@
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects0 (get-in state [:workspace-pages page-id :data :objects])
objects1 (get-in state [:workspace-data page-id :objects])
objects0 (get-in state [:workspace-file :data :pages-index page-id :objects])
objects1 (get-in state [:workspace-data :pages-index page-id :objects])
;; ID's + Children ID's
ids-with-children (d/concat [] (mapcat #(cph/get-children % objects1) ids) ids)
@ -413,7 +413,9 @@
update-shape #(update %1 %2 gsh/transform-shape)
objects2 (reduce update-shape objects1 ids-with-children)
regchg {:type :reg-objects :shapes (vec ids)}
regchg {:type :reg-objects
:page-id page-id
:shapes (vec ids)}
;; we need to generate redo chages from current
;; state (with current temporal values) to new state but
@ -421,8 +423,8 @@
;; state (without temporal values in it, for this reason
;; we have 3 different objects references).
rchanges (conj (dwc/generate-changes objects1 objects2) regchg)
uchanges (conj (dwc/generate-changes objects2 objects0) regchg)
rchanges (conj (dwc/generate-changes page-id objects1 objects2) regchg)
uchanges (conj (dwc/generate-changes page-id objects2 objects0) regchg)
]
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})

4
frontend/src/app/main/exports.cljs
View file

@ -73,7 +73,8 @@
[objects]
(mf/fnc shape-wrapper
[{:keys [frame shape] :as props}]
(let [group-wrapper (mf/use-memo (mf/deps objects) #(group-wrapper-factory objects))]
(let [group-wrapper (mf/use-memo (mf/deps objects) #(group-wrapper-factory objects))
frame-wrapper (mf/use-memo (mf/deps objects) #(frame-wrapper-factory objects))]
(when (and shape (not (:hidden shape)))
(let [shape (geom/transform-shape frame shape)
opts #js {:shape shape}]
@ -85,6 +86,7 @@
:path [:> path/path-shape opts]
:image [:> image/image-shape opts]
:circle [:> circle/circle-shape opts]
:frame [:> frame-wrapper {:shape shape}]
:group [:> group-wrapper {:shape shape :frame frame}]
nil))))))

162
frontend/src/app/main/refs.cljs
View file

@ -39,20 +39,65 @@
;; ---- Workspace refs
;; (def workspace-local
;; (l/derived :workspace-local st/state))
(def workspace-drawing
(l/derived :workspace-drawing st/state))
(def workspace-local
(l/derived :workspace-local st/state))
(l/derived (fn [state]
(merge (:workspace-local state)
(:workspace-file-local state)))
st/state =))
(def selected-shapes
(l/derived :selected workspace-local))
(def selected-zoom
(l/derived :zoom workspace-local))
(def selected-drawing-tool
(l/derived :tool workspace-drawing))
(def current-drawing-shape
(l/derived :object workspace-drawing))
(def selected-edition
(l/derived :edition workspace-local))
(def current-transform
(l/derived :transform workspace-local))
(def options-mode
(l/derived :options-mode workspace-local))
(def vbox
(l/derived :vbox workspace-local))
(def current-hover
(l/derived :hover workspace-local))
(def workspace-layout
(l/derived :workspace-layout st/state))
(def workspace-page
(l/derived :workspace-page st/state))
(def workspace-page-id
(l/derived :id workspace-page))
(def workspace-file
(l/derived :workspace-file st/state))
(l/derived (fn [state]
(when-let [file (:workspace-file state)]
(-> file
(dissoc :data)
(assoc :pages (get-in file [:data :pages])))))
st/state =))
(def workspace-file-colors
(l/derived (fn [state]
(when-let [file (:workspace-file state)]
(get-in file [:data :colors])))
st/state))
(def workspace-project
(l/derived :workspace-project st/state))
@ -72,110 +117,85 @@
(def workspace-snap-data
(l/derived :workspace-snap-data st/state))
;; TODO: BROKEN & TO BE REMOVED
(def workspace-data
(-> #(let [page-id (get-in % [:workspace-page :id])]
(get-in % [:workspace-data page-id]))
(l/derived st/state)))
(def workspace-page-options
(l/derived :options workspace-data))
(def workspace-page
(l/derived (fn [state]
(let [page-id (:current-page-id state)
data (:workspace-data state)]
(get-in data [:pages-index page-id])))
st/state))
(def workspace-page-objects
(l/derived :objects workspace-page))
(def workspace-page-options
(l/derived :options workspace-page))
;; TODO: revisit
(def workspace-saved-grids
(l/derived :saved-grids workspace-page-options))
(def workspace-objects
(l/derived :objects workspace-data))
(def workspace-frames
(l/derived cph/select-frames workspace-objects))
(l/derived cph/select-frames workspace-page-objects))
(defn object-by-id
[id]
(letfn [(selector [state]
(let [page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data page-id :objects])]
(get objects id)))]
(l/derived selector st/state =)))
(l/derived #(get % id) workspace-page-objects))
(defn objects-by-id
[ids]
(letfn [(selector [state]
(let [page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data page-id :objects])]
(->> (set ids)
(map #(get objects %))
(filter identity)
(vec))))]
(l/derived selector st/state =)))
(l/derived (fn [objects]
(into [] (comp (map #(get objects %))
(filter identity))
(set ids)))
workspace-page-objects =))
(defn is-child-selected?
[id]
(letfn [(selector [state]
(let [page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data page-id :objects])
(let [page-id :current-page-id
objects (get-in state [:workspace-data :pages-index page-id :objects])
selected (get-in state [:workspace-local :selected])
shape (get objects id)
children (cph/get-children id objects)]
(some selected children)))]
(l/derived selector st/state)))
(def selected-shapes
(l/derived :selected workspace-local))
;; TODO: can be replaced by objects-by-id
(def selected-objects
(letfn [(selector [state]
(let [selected (get-in state [:workspace-local :selected])
page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data page-id :objects])]
(mapv #(get objects %) selected)))]
(let [selected (get-in state [:workspace-local :selected])
page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data :pages-index page-id :objects])]
(mapv #(get objects %) selected)))]
(l/derived selector st/state =)))
(def selected-shapes-with-children
(letfn [(selector [state]
(let [selected (get-in state [:workspace-local :selected])
page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data page-id :objects])
page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data :pages-index page-id :objects])
children (mapcat #(cph/get-children % objects) selected)]
(into selected children)))]
(l/derived selector st/state)))
(l/derived selector st/state =)))
;; TODO: looks very inneficient access method, revisit the usage of this ref
(def selected-objects-with-children
(letfn [(selector [state]
(let [selected (get-in state [:workspace-local :selected])
page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data page-id :objects])
page-id (get-in state [:workspace-page :id])
objects (get-in state [:workspace-data :pages-index page-id :objects])
children (mapcat #(cph/get-children % objects) selected)
accumulated (into selected children)]
(mapv #(get objects %) accumulated)))]
(l/derived selector st/state)))
(defn make-selected
[id]
(l/derived #(contains? % id) selected-shapes))
(def selected-zoom
(l/derived :zoom workspace-local))
(def selected-drawing-tool
(l/derived :drawing-tool workspace-local))
(def current-drawing-shape
(l/derived :drawing workspace-local))
(def selected-edition
(l/derived :edition workspace-local))
(def current-transform
(l/derived :transform workspace-local))
(def options-mode
(l/derived :options-mode workspace-local))
(def vbox
(l/derived :vbox workspace-local))
(def current-hover
(l/derived :hover workspace-local))
shapes (into selected children)]
(mapv #(get objects %) shapes)))]
(l/derived selector st/state =)))
;; ---- Viewer refs

32
frontend/src/app/main/ui.cljs
View file

@ -9,6 +9,7 @@
(ns app.main.ui
(:require
[expound.alpha :as expound]
[beicon.core :as rx]
[cuerdas.core :as str]
[potok.core :as ptk]
@ -49,7 +50,7 @@
["/password" :settings-password]
["/options" :settings-options]]
["/view/:page-id" :viewer]
["/view/:file-id/:page-id" :viewer]
["/not-found" :not-found]
["/not-authorized" :not-authorized]
@ -57,7 +58,7 @@
["/debug/icons-preview" :debug-icons-preview])
;; Used for export
["/render-object/:page-id/:object-id" :render-object]
["/render-object/:file-id/:page-id/:object-id" :render-object]
["/dashboard"
["/team/:team-id"
@ -112,16 +113,20 @@
:viewer
(let [index (d/parse-integer (get-in route [:params :query :index]))
token (get-in route [:params :query :token])
file-id (uuid (get-in route [:params :path :file-id]))
page-id (uuid (get-in route [:params :path :page-id]))]
[:& viewer-page {:page-id page-id
:file-id file-id
:index index
:token token}])
:render-object
(do
(let [page-id (uuid (get-in route [:params :path :page-id]))
object-id (uuid (get-in route [:params :path :object-id]))]
[:& render/render-object {:page-id page-id
(let [file-id (uuid (get-in route [:params :path :file-id]))
page-id (uuid (get-in route [:params :path :page-id]))
object-id (uuid (get-in route [:params :path :object-id]))]
[:& render/render-object {:file-id file-id
:page-id page-id
:object-id object-id}]))
:workspace
@ -163,9 +168,18 @@
[error]
(ts/schedule 0 #(st/emit! logout)))
(defmethod ptk/handle-error :assertion
[{:keys [data stack] :as error}]
(js/console.error stack)
(js/console.error (with-out-str
(expound/printer data))))
(defmethod ptk/handle-error :default
[error]
(js/console.error (if (map? error) (pr-str error) error))
(ts/schedule 100 #(st/emit! (dm/show {:content "Something wrong has happened."
:type :error
:timeout 5000}))))
(if (instance? ExceptionInfo error)
(ptk/handle-error (ex-data error))
(do
(js/console.error (if (map? error) (pr-str error) error))
(ts/schedule 100 #(st/emit! (dm/show {:content "Something wrong has happened."
:type :error
:timeout 5000}))))))

198
frontend/src/app/main/ui/dashboard/grid.cljs
View file

@ -1,22 +1,34 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.main.ui.dashboard.grid
(:require
[cuerdas.core :as str]
[beicon.core :as rx]
[rumext.alpha :as mf]
[app.main.ui.icons :as i]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.main.data.dashboard :as dsh]
[app.main.store :as st]
[app.main.ui.modal :as modal]
[app.main.ui.keyboard :as kbd]
[app.main.ui.confirm :refer [confirm-dialog]]
[app.main.ui.components.context-menu :refer [context-menu]]
[app.main.worker :as wrk]
[app.main.fonts :as fonts]
[app.main.store :as st]
[app.main.ui.components.context-menu :refer [context-menu]]
[app.main.ui.confirm :refer [confirm-dialog]]
[app.main.ui.icons :as i]
[app.main.ui.keyboard :as kbd]
[app.main.ui.modal :as modal]
[app.main.worker :as wrk]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [t tr]]
[app.util.router :as rt]
[app.util.time :as dt]
[app.util.timers :as ts]
[app.util.time :as dt]))
[beicon.core :as rx]
[cuerdas.core :as str]
[lambdaisland.uri :as uri]
[rumext.alpha :as mf]))
;; --- Grid Item Thumbnail
@ -25,15 +37,15 @@
[{:keys [file] :as props}]
(let [container (mf/use-ref)]
(mf/use-effect
(mf/deps file)
(mf/deps (:id file))
(fn []
(-> (wrk/ask! {:cmd :thumbnails/generate
:id (first (:pages file))
})
(rx/subscribe (fn [{:keys [svg fonts]}]
(run! fonts/ensure-loaded! fonts)
(when-let [node (mf/ref-val container)]
(set! (.-innerHTML ^js node) svg)))))))
(->> (wrk/ask! {:cmd :thumbnails/generate
:file-id (:id file)
:page-id (get-in file [:data :pages 0])})
(rx/subs (fn [{:keys [svg fonts]}]
(run! fonts/ensure-loaded! fonts)
(when-let [node (mf/ref-val container)]
(set! (.-innerHTML ^js node) svg)))))))
[:div.grid-item-th {:style {:background-color (get-in file [:data :options :background])}
:ref container}]))
@ -41,61 +53,90 @@
(mf/defc grid-item-metadata
[{:keys [modified-at]}]
(let [locale (i18n/use-locale)
time (dt/timeago modified-at {:locale locale})]
(let [locale (mf/deref i18n/locale)
time (dt/timeago modified-at {:locale locale})]
(str (t locale "ds.updated-at" time))))
(mf/defc grid-item
{:wrap [mf/memo]}
[{:keys [file] :as props}]
(let [local (mf/use-state {:menu-open false
:edition false})
locale (i18n/use-locale)
on-navigate #(st/emit! (rt/nav :workspace
{:project-id (:project-id file)
:file-id (:id file)}
{:page-id (first (:pages file))}))
delete-fn #(st/emit! nil (dsh/delete-file (:id file)))
on-delete #(do
(dom/stop-propagation %)
(modal/show! confirm-dialog {:on-accept delete-fn}))
[{:keys [id file] :as props}]
(let [local (mf/use-state {:menu-open false :edition false})
locale (mf/deref i18n/locale)
delete (mf/use-callback (mf/deps id) #(st/emit! nil (dsh/delete-file id)))
add-shared (mf/use-callback (mf/deps id) #(st/emit! (dsh/set-file-shared id true)))
del-shared (mf/use-callback (mf/deps id) #(st/emit! (dsh/set-file-shared id false)))
on-close (mf/use-callback #(swap! local assoc :menu-open false))
on-delete
(mf/use-callback
(mf/deps id)
(fn [event]
(dom/stop-propagation event)
(modal/show! confirm-dialog {:on-accept delete})))
on-navigate
(mf/use-callback
(mf/deps id)
(fn []
(let [pparams {:project-id (:project-id file)
:file-id (:id file)}
qparams {:page-id (first (get-in file [:data :pages]))}]
(st/emit! (rt/nav :workspace pparams qparams)))))
add-shared-fn #(st/emit! nil (dsh/set-file-shared (:id file) true))
on-add-shared
#(do
(dom/stop-propagation %)
(mf/use-callback
(mf/deps id)
(fn [event]
(dom/stop-propagation event)
(modal/show! confirm-dialog
{:message (t locale "dashboard.grid.add-shared-message" (:name file))
:hint (t locale "dashboard.grid.add-shared-hint")
:accept-text (t locale "dashboard.grid.add-shared-accept")
:not-danger? true
:on-accept add-shared-fn}))
:on-accept add-shared})))
remove-shared-fn #(st/emit! nil (dsh/set-file-shared (:id file) false))
on-remove-shared
#(do
(dom/stop-propagation %)
on-edit
(mf/use-callback
(mf/deps id)
(fn [event]
(dom/stop-propagation event)
(swap! local assoc :edition true)))
on-del-shared
(mf/use-callback
(mf/deps id)
(fn [event]
(dom/stop-propagation event)
(modal/show! confirm-dialog
{:message (t locale "dashboard.grid.remove-shared-message" (:name file))
:hint (t locale "dashboard.grid.remove-shared-hint")
:accept-text (t locale "dashboard.grid.remove-shared-accept")
:not-danger? false
:on-accept remove-shared-fn}))
:on-accept del-shared})))
on-blur #(let [name (-> % dom/get-target dom/get-value)]
(st/emit! (dsh/rename-file (:id file) name))
(swap! local assoc :edition false))
on-menu-click
(mf/use-callback
(mf/deps id)
(fn [event]
(dom/stop-propagation event)
(swap! local assoc :menu-open true)))
on-key-down #(cond
(kbd/enter? %) (on-blur %)
(kbd/esc? %) (swap! local assoc :edition false))
on-menu-click #(do
(dom/stop-propagation %)
(swap! local assoc :menu-open true))
on-menu-close #(swap! local assoc :menu-open false)
on-edit #(do
(dom/stop-propagation %)
(swap! local assoc :edition true))]
on-blur
(mf/use-callback
(mf/deps id)
(fn [event]
(let [name (-> event dom/get-target dom/get-value)]
(st/emit! (dsh/rename-file id name))
(swap! local assoc :edition false))))
on-key-down
(mf/use-callback
#(cond
(kbd/enter? %) (on-blur %)
(kbd/esc? %) (swap! local assoc :edition false)))
]
[:div.grid-item.project-th {:on-click on-navigate}
[:div.overlay]
[:& grid-item-thumbnail {:file file}]
@ -113,42 +154,39 @@
[:& grid-item-metadata {:modified-at (:modified-at file)}]]
[:div.project-th-actions {:class (dom/classnames
:force-display (:menu-open @local))}
;; [:div.project-th-icon.pages
;; i/page
;; #_[:span (:total-pages project)]]
;; [:div.project-th-icon.comments
;; i/chat
;; [:span "0"]]
[:div.project-th-icon.menu
{:on-click on-menu-click}
i/actions]
[:& context-menu {:on-close on-menu-close
[:& context-menu {:on-close on-close
:show (:menu-open @local)
:options [[(t locale "dashboard.grid.rename") on-edit]
[(t locale "dashboard.grid.delete") on-delete]
(if (:is-shared file)
[(t locale "dashboard.grid.remove-shared") on-remove-shared]
[(t locale "dashboard.grid.remove-shared") on-del-shared]
[(t locale "dashboard.grid.add-shared") on-add-shared])]}]]]))
;; --- Grid
(mf/defc grid
[{:keys [id opts files hide-new?] :as props}]
(let [locale (i18n/use-locale)
order (:order opts :modified)
filter (:filter opts "")
on-click #(do
(dom/prevent-default %)
(st/emit! (dsh/create-file id)))]
(let [locale (mf/deref i18n/locale)
click #(st/emit! (dsh/create-file id))]
[:section.dashboard-grid
(if (> (count files) 0)
[:div.dashboard-grid-row
(when (not hide-new?)
[:div.grid-item.add-file {:on-click on-click}
[:span (tr "ds.new-file")]])
(for [item files]
[:& grid-item {:file item :key (:id item)}])]
[:div.grid-files-empty
[:div.grid-files-desc (t locale "dashboard.grid.empty-files")]
[:div.grid-files-link
[:a.btn-secondary.btn-small {:on-click on-click} (t locale "ds.new-file")]]])]))
(cond
(pos? (count files))
[:div.dashboard-grid-row
(when (not hide-new?)
[:div.grid-item.add-file {:on-click click}
[:span (t locale "ds.new-file")]])
(for [item files]
[:& grid-item
{:id (:id item)
:file item
:key (:id item)}])]
(zero? (count files))
[:div.grid-files-empty
[:div.grid-files-desc (t locale "dashboard.grid.empty-files")]
[:div.grid-files-link
[:a.btn-secondary.btn-small {:on-click click} (t locale "ds.new-file")]]])]))

37
frontend/src/app/main/ui/render.cljs
View file

@ -65,6 +65,7 @@
(mf/deps objects)
#(exports/shape-wrapper-factory objects))
]
[:svg {:id "screenshot"
:view-box vbox
:width width
@ -77,17 +78,35 @@
:group [:& group-wrapper {:shape object}]
[:& shape-wrapper {:shape object}])]))
(defn- adapt-root-frame
[objects object-id]
(if (uuid/zero? object-id)
(let [object (get objects object-id)
shapes (cph/select-toplevel-shapes objects {:include-frames? true})
srect (geom/selection-rect shapes)
object (merge object (select-keys srect [:x :y :width :height]))
object (geom/transform-shape object)
object (assoc object :fill-color "#f0f0f0")]
(assoc objects (:id object) object))
objects))
;; NOTE: for now, it is ok download the entire file for render only
;; single page but in a future we need consider to add a specific
;; backend entry point for download only the data of single page.
(mf/defc render-object
[{:keys [page-id object-id] :as props}]
(let [data (mf/use-state nil)]
[{:keys [file-id page-id object-id] :as props}]
(let [objects (mf/use-state nil)]
(mf/use-effect
(fn []
(let [subs (->> (repo/query! :page {:id page-id})
(rx/subs (fn [result]
(reset! data (:data result)))))]
#(rx/dispose! subs))))
(when @data
[:& object-svg {:objects (:objects @data)
#(let [subs (->> (repo/query! :file {:id file-id})
(rx/subs (fn [{:keys [data]}]
(let [objs (get-in data [:pages-index page-id :objects])
objs (adapt-root-frame objs object-id)]
(reset! objects objs)))))]
(fn [] (rx/dispose! subs))))
(when @objects
[:& object-svg {:objects @objects
:object-id object-id
:zoom 1}])))

10
frontend/src/app/main/ui/shapes/frame.cljs
View file

@ -9,11 +9,11 @@
(ns app.main.ui.shapes.frame
(:require
[rumext.alpha :as mf]
[app.common.data :as d]
[app.main.ui.shapes.attrs :as attrs]
[app.common.geom.shapes :as geom]
[app.util.object :as obj]))
[app.main.ui.shapes.attrs :as attrs]
[app.util.object :as obj]
[rumext.alpha :as mf]))
(def frame-default-props {:fill-color "#ffffff"})
@ -22,8 +22,8 @@
(mf/fnc frame-shape
{::mf/wrap-props false}
[props]
(let [childs (unchecked-get props "childs")
shape (unchecked-get props "shape")
(let [childs (unchecked-get props "childs")
shape (unchecked-get props "shape")
{:keys [id x y width height]} shape
props (-> (merge frame-default-props shape)

22
frontend/src/app/main/ui/viewer.cljs
View file

@ -9,25 +9,24 @@
(ns app.main.ui.viewer
(:require
[beicon.core :as rx]
[goog.events :as events]
[goog.object :as gobj]
[okulary.core :as l]
[rumext.alpha :as mf]
[app.main.ui.icons :as i]
[app.common.exceptions :as ex]
[app.main.data.viewer :as dv]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.components.dropdown :refer [dropdown]]
[app.main.ui.hooks :as hooks]
[app.main.ui.icons :as i]
[app.main.ui.keyboard :as kbd]
[app.main.ui.viewer.header :refer [header]]
[app.main.ui.viewer.thumbnails :refer [thumbnails-panel]]
[app.main.ui.viewer.shapes :refer [frame-svg]]
[app.main.ui.viewer.thumbnails :refer [thumbnails-panel]]
[app.util.data :refer [classnames]]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [t tr]])
[app.util.i18n :as i18n :refer [t tr]]
[beicon.core :as rx]
[goog.events :as events]
[okulary.core :as l]
[rumext.alpha :as mf])
(:import goog.events.EventType))
(mf/defc main-panel
@ -106,10 +105,11 @@
;; --- Component: Viewer Page
(mf/defc viewer-page
[{:keys [page-id index token] :as props}]
[{:keys [file-id page-id index token] :as props}]
(mf/use-effect
(mf/deps page-id token)
#(st/emit! (dv/initialize page-id token)))
(mf/deps file-id page-id token)
(fn []
(st/emit! (dv/initialize props))))
(let [data (mf/deref refs/viewer-data)
local (mf/deref refs/viewer-local)]

13
frontend/src/app/main/ui/viewer/header.cljs
View file

@ -75,12 +75,10 @@
(t locale "viewer.header.show-interactions-on-click")]]]]]))
(mf/defc share-link
[{:keys [page] :as props}]
[{:keys [page token] :as props}]
(let [show-dropdown? (mf/use-state false)
dropdown-ref (mf/use-ref)
token (:share-token page)
locale (i18n/use-locale)
dropdown-ref (mf/use-ref)
locale (mf/deref i18n/locale)
create #(st/emit! dv/create-share-link)
delete #(st/emit! dv/delete-share-link)
@ -158,8 +156,11 @@
[:div.options-zone
[:& interactions-menu {:interactions-mode interactions-mode}]
(when-not anonymous?
[:& share-link {:page (:page data)}])
[:& share-link {:token (:share-token data)
:page (:page data)}])
(when-not anonymous?
[:a.btn-text-basic.btn-small {:on-click on-edit}
(t locale "viewer.header.edit-page")])

88
frontend/src/app/main/ui/workspace.cljs
View file

@ -9,44 +9,44 @@
(ns app.main.ui.workspace
(:require
[beicon.core :as rx]
[rumext.alpha :as mf]
[app.main.ui.icons :as i]
[app.common.geom.point :as gpt]
[app.main.constants :as c]
[app.main.data.history :as udh]
[app.main.data.workspace :as dw]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.streams :as ms]
[app.main.ui.keyboard :as kbd]
[app.main.ui.hooks :as hooks]
[app.main.ui.workspace.viewport :refer [viewport coordinates]]
[app.main.ui.icons :as i]
[app.main.ui.keyboard :as kbd]
[app.main.ui.workspace.colorpalette :refer [colorpalette]]
[app.main.ui.workspace.context-menu :refer [context-menu]]
[app.main.ui.workspace.header :refer [header]]
[app.main.ui.workspace.left-toolbar :refer [left-toolbar]]
[app.main.ui.workspace.rules :refer [horizontal-rule vertical-rule]]
[app.main.ui.workspace.scroll :as scroll]
[app.main.ui.workspace.sidebar :refer [left-sidebar right-sidebar]]
[app.main.ui.workspace.sidebar.history :refer [history-dialog]]
[app.main.ui.workspace.left-toolbar :refer [left-toolbar]]
[app.util.data :refer [classnames]]
[app.main.ui.workspace.viewport :refer [viewport coordinates]]
[app.util.dom :as dom]
[app.common.geom.point :as gpt]))
[beicon.core :as rx]
[okulary.core :as l]
[rumext.alpha :as mf]))
;; --- Workspace
(mf/defc workspace-content
[{:keys [page file layout project] :as params}]
(let [local (mf/deref refs/workspace-local)
left-sidebar? (:left-sidebar? local)
[{:keys [page-id file layout project] :as params}]
(let [local (mf/deref refs/workspace-local)
left-sidebar? (:left-sidebar? local)
right-sidebar? (:right-sidebar? local)
classes (classnames
:no-tool-bar-right (not right-sidebar?)
:no-tool-bar-left (not left-sidebar?))]
classes (dom/classnames
:no-tool-bar-right (not right-sidebar?)
:no-tool-bar-left (not left-sidebar?))]
[:*
(when (:colorpalette layout)
[:& colorpalette {:left-sidebar? left-sidebar?
:project project}])
:team-id (:team-id project)}])
[:section.workspace-content {:class classes}
[:& history-dialog]
@ -63,36 +63,52 @@
:vport (:vport local)}]
[:& coordinates]])
[:& viewport {:page page
:key (:id page)
[:& viewport {:page-id page-id
:key (str page-id)
:file file
:local local
:layout layout}]]]
[:& left-toolbar {:page page :layout layout}]
[:& left-toolbar {:layout layout}]
;; Aside
(when left-sidebar?
[:& left-sidebar {:file file :page page :layout layout}])
[:& left-sidebar
{:file file
:page-id page-id
:project project
:layout layout}])
(when right-sidebar?
[:& right-sidebar {:page page
:local local
:layout layout}])]))
[:& right-sidebar
{:page-id page-id
:file-id (:id file)
:local local
:layout layout}])]))
(defn trimmed-page-ref
[id]
(l/derived (fn [state]
(let [page-id (:current-page-id state)
data (:workspace-data state)]
(select-keys (get-in data [:pages-index page-id]) [:id :name])))
st/state =))
(mf/defc workspace-page
[{:keys [project file layout page-id] :as props}]
(mf/use-effect
(mf/deps page-id)
(fn []
(st/emit! (dw/initialize-page page-id))
#(st/emit! (dw/finalize-page page-id))))
(when-let [page (mf/deref refs/workspace-page)]
[:& workspace-content {:page page
:project project
:file file
:layout layout}]))
(let [page-ref (mf/use-memo (mf/deps page-id) #(trimmed-page-ref page-id))
page (mf/deref page-ref)]
(when page
[:& workspace-content {:page page
:page-id (:id page)
:project project
:file file
:layout layout}])))
(mf/defc workspace-loader
[]
@ -102,6 +118,7 @@
(mf/defc workspace
[{:keys [project-id file-id page-id] :as props}]
(mf/use-effect #(st/emit! dw/initialize-layout))
(mf/use-effect
(mf/deps project-id file-id)
(fn []
@ -110,11 +127,13 @@
(hooks/use-shortcuts dw/shortcuts)
(let [file (mf/deref refs/workspace-file)
(let [file (mf/deref refs/workspace-file)
project (mf/deref refs/workspace-project)
layout (mf/deref refs/workspace-layout)]
layout (mf/deref refs/workspace-layout)]
[:section#workspace
[:& header {:file file
:page-id page-id
:project project
:layout layout}]
@ -122,8 +141,9 @@
(if (and (and file project)
(:initialized file))
[:& workspace-page {:file file
[:& workspace-page {:page-id page-id
:project project
:layout layout
:page-id page-id}]
:file file
:layout layout}]
[:& workspace-loader])]))

5
frontend/src/app/main/ui/workspace/colorpalette.cljs
View file

@ -155,9 +155,8 @@
[:span.right-arrow {:on-click on-right-arrow-click} i/arrow-slide]]))
(mf/defc colorpalette
[{:keys [left-sidebar? project] :as props}]
(let [team-id (:team-id project)
palettes (->> (mf/deref palettes-ref)
[{:keys [left-sidebar? team-id] :as props}]
(let [palettes (->> (mf/deref palettes-ref)
(vals)
(mapcat identity))
selected (or (mf/deref selected-palette-ref)

8
frontend/src/app/main/ui/workspace/header.cljs
View file

@ -5,8 +5,7 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2015-2017 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2015-2017 Juan de la Cruz <delacruzgarciajuan@gmail.com>
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.main.ui.workspace.header
(:require
@ -150,15 +149,14 @@
;; --- Header Component
(mf/defc header
[{:keys [file layout project] :as props}]
[{:keys [file layout project page-id] :as props}]
(let [locale (i18n/use-locale)
team-id (:team-id project)
go-back #(st/emit! (rt/nav :dashboard-team {:team-id team-id}))
zoom (mf/deref refs/selected-zoom)
page (mf/deref refs/workspace-page)
locale (i18n/use-locale)
router (mf/deref refs/router)
view-url (rt/resolve router :viewer {:page-id (:id page)} {:index 0})]
view-url (rt/resolve router :viewer {:page-id page-id :file-id (:id file)} {:index 0})]
[:header.workspace-header
[:div.main-icon
[:a {:on-click go-back} i/logo-icon]]

5
frontend/src/app/main/ui/workspace/left_toolbar.cljs
View file

@ -5,8 +5,7 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2015-2020 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2015-2020 Juan de la Cruz <delacruzgarciajuan@gmail.com>
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.main.ui.workspace.left-toolbar
(:require
@ -23,7 +22,7 @@
;; --- Component: Left toolbar
(mf/defc left-toolbar
[{:keys [page layout] :as props}]
[{:keys [layout] :as props}]
(let [file-input (mf/use-ref nil)
selected-drawtool (mf/deref refs/selected-drawing-tool)
select-drawtool #(st/emit! :interrupt

27
frontend/src/app/main/ui/workspace/presence.cljs
View file

@ -10,8 +10,11 @@
(ns app.main.ui.workspace.presence
(:require
[rumext.alpha :as mf]
[beicon.core :as rx]
[app.main.refs :as refs]
[app.main.store :as st]
[app.util.time :as dt]
[app.util.timers :as tm]
[app.util.router :as rt]))
(def pointer-icon-path
@ -52,12 +55,21 @@
(mf/defc active-cursors
{::mf/wrap [mf/memo]}
[{:keys [page] :as props}]
(let [sessions (mf/deref refs/workspace-presence)
[{:keys [page-id] :as props}]
(let [counter (mf/use-state 0)
sessions (mf/deref refs/workspace-presence)
sessions (->> (vals sessions)
(filter #(= (:id page) (:page-id %))))]
(filter #(= page-id (:page-id %)))
(filter #(>= 3000 (- (inst-ms (dt/now)) (inst-ms (:updated-at %))))))]
(mf/use-effect
nil
(fn []
(let [sem (tm/schedule 1000 #(swap! counter inc))]
(fn [] (rx/dispose! sem)))))
(for [session sessions]
[:& session-cursor {:session session :key (:id session)}])))
(when (:point session)
[:& session-cursor {:session session :key (:id session)}]))))
(mf/defc session-widget
[{:keys [session self?] :as props}]
@ -72,10 +84,13 @@
(mf/defc active-sessions
{::mf/wrap [mf/memo]}
[]
(let [profile (mf/deref refs/profile)
(let [profile (mf/deref refs/profile)
sessions (mf/deref refs/workspace-presence)]
[:ul.active-users
(for [session (vals sessions)]
[:& session-widget {:session session :key (:id session)}])]))
[:& session-widget
{:session session
:self? (= (:id session) (:id profile))
:key (:id session)}])]))

7
frontend/src/app/main/ui/workspace/shapes/frame.cljs
View file

@ -9,6 +9,7 @@
(ns app.main.ui.workspace.shapes.frame
(:require
[okulary.core :as l]
[rumext.alpha :as mf]
[app.common.data :as d]
[app.main.constants :as c]
@ -43,6 +44,10 @@
(recur (first ids) (rest ids))
false))))))
(defn make-selected-ref
[id]
(l/derived #(contains? % id) refs/selected-shapes))
(defn frame-wrapper-factory
[shape-wrapper]
(let [frame-shape (frame/frame-shape shape-wrapper)]
@ -55,7 +60,7 @@
objects (unchecked-get props "objects")
selected-iref (mf/use-memo (mf/deps (:id shape))
#(refs/make-selected (:id shape)))
#(make-selected-ref (:id shape)))
selected? (mf/deref selected-iref)
zoom (mf/deref refs/selected-zoom)

28
frontend/src/app/main/ui/workspace/sidebar.cljs
View file

@ -14,34 +14,38 @@
[app.main.ui.workspace.sidebar.history :refer [history-toolbox]]
[app.main.ui.workspace.sidebar.layers :refer [layers-toolbox]]
[app.main.ui.workspace.sidebar.options :refer [options-toolbox]]
[app.main.ui.workspace.sidebar.sitemap :refer [sitemap-toolbox]]
[app.main.ui.workspace.sidebar.sitemap :refer [sitemap]]
[app.main.ui.workspace.sidebar.assets :refer [assets-toolbox]]))
;; --- Left Sidebar (Component)
(mf/defc left-sidebar
{:wrap [mf/memo]}
[{:keys [layout page file] :as props}]
[{:keys [layout page-id file project] :as props}]
[:aside.settings-bar.settings-bar-left
[:div.settings-bar-inside
{:data-layout (str/join "," layout)}
(when (contains? layout :sitemap)
[:& sitemap-toolbox {:file file
:page page
:layout layout}])
(when (contains? layout :document-history)
[:& history-toolbox])
[:& sitemap {:file file
:page-id page-id
:layout layout}])
#_(when (contains? layout :document-history)
[:& history-toolbox])
(when (contains? layout :layers)
[:& layers-toolbox {:page page}])
[:& layers-toolbox])
(when (contains? layout :assets)
[:& assets-toolbox])]])
[:& assets-toolbox {:team-id (:team-id project)
:file file}])]])
;; --- Right Sidebar (Component)
;; TODO: revisit page prop
(mf/defc right-sidebar
[{:keys [layout page local] :as props}]
[{:keys [layout page-id file-id local] :as props}]
[:aside#settings-bar.settings-bar
[:div.settings-bar-inside
(when (contains? layout :element-options)
[:& options-toolbox {:page page
:local local}])]])
[:& options-toolbox {:page-id page-id
:file-id file-id
:local local}])]])

419
frontend/src/app/main/ui/workspace/sidebar/assets.cljs
View file

@ -9,35 +9,35 @@
(ns app.main.ui.workspace.sidebar.assets
(:require
[okulary.core :as l]
[cuerdas.core :as str]
[rumext.alpha :as mf]
[app.config :as cfg]
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as geom]
[app.common.media :as cm]
[app.common.pages :as cp]
[app.common.geom.shapes :as geom]
[app.common.geom.point :as gpt]
[app.main.ui.icons :as i]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.main.data.workspace :as dw]
[app.main.data.colors :as dcol]
[app.main.data.workspace.libraries :as dwl]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.colorpicker :refer [colorpicker most-used-colors]]
[app.main.ui.components.context-menu :refer [context-menu]]
[app.main.ui.components.file-uploader :refer [file-uploader]]
[app.main.ui.components.tab-container :refer [tab-container tab-element]]
[app.main.ui.icons :as i]
[app.main.ui.keyboard :as kbd]
[app.main.ui.modal :as modal]
[app.main.ui.shapes.icon :as icon]
[app.main.ui.workspace.libraries :refer [libraries-dialog]]
[app.util.data :refer [matches-search]]
[app.util.dom :as dom]
[app.util.dom.dnd :as dnd]
[app.util.timers :as timers]
[app.common.uuid :as uuid]
[app.util.i18n :as i18n :refer [tr]]
[app.util.data :refer [classnames matches-search]]
[app.util.i18n :as i18n :refer [tr t]]
[app.util.router :as rt]
[app.main.ui.modal :as modal]
[app.main.ui.colorpicker :refer [colorpicker most-used-colors]]
[app.main.ui.components.tab-container :refer [tab-container tab-element]]
[app.main.ui.components.file-uploader :refer [file-uploader]]
[app.main.ui.components.context-menu :refer [context-menu]]
[app.main.ui.workspace.libraries :refer [libraries-dialog]]))
[app.util.timers :as timers]
[cuerdas.core :as str]
[okulary.core :as l]
[rumext.alpha :as mf]))
(mf/defc modal-edit-color
[{:keys [color-value on-accept on-cancel] :as ctx}]
@ -67,58 +67,73 @@
[:a.close {:href "#" :on-click cancel} i/close]]])))
(mf/defc graphics-box
[{:keys [file-id local-library? media-objects] :as props}]
(let [state (mf/use-state {:menu-open false
:top nil
:left nil
:object-id nil})
file-input (mf/use-ref nil)
[{:keys [file-id local? objects] :as props}]
(let [input-ref (mf/use-ref nil)
state (mf/use-state {:menu-open false
:top nil
:left nil
:object-id nil})
add-graphic
#(dom/click (mf/ref-val file-input))
(mf/use-callback
(fn [] (dom/click (mf/ref-val input-ref))))
delete-graphic
#(st/emit! (dw/delete-media-object file-id (:object-id @state)))
on-media-uploaded
(mf/use-callback
(mf/deps file-id)
(fn [data]
(st/emit! (dwl/add-media data))))
on-files-selected
(fn [js-files]
(let [params {:file-id file-id
:local? false
:js-files js-files}]
(st/emit! (dw/upload-media-objects params))))
on-selected
(mf/use-callback
(mf/deps file-id)
(fn [js-files]
(let [params (with-meta {:file-id file-id
:local? false
:js-files js-files}
{:on-success on-media-uploaded})]
(st/emit! (dw/upload-media-objects params)))))
on-delete
(mf/use-callback
(mf/deps state)
(fn []
(let [params {:id (:object-id @state)}]
(st/emit! (dwl/delete-media params)))))
on-context-menu
(fn [object-id]
(fn [event]
(when local-library?
(let [pos (dom/get-client-position event)
top (:y pos)
left (- (:x pos) 20)]
(dom/prevent-default event)
(swap! state assoc :menu-open true
:top top
:left left
:object-id object-id)))))
(mf/use-callback
(fn [object-id]
(fn [event]
(when local?
(let [pos (dom/get-client-position event)
top (:y pos)
left (- (:x pos) 20)]
(dom/prevent-default event)
(swap! state assoc :menu-open true
:top top
:left left
:object-id object-id))))))
on-drag-start
(fn [path event]
(dnd/set-data! event "text/uri-list" (cfg/resolve-media-path path))
(dnd/set-allowed-effect! event "move"))]
(mf/use-callback
(fn [path event]
(dnd/set-data! event "text/uri-list" (cfg/resolve-media-path path))
(dnd/set-allowed-effect! event "move")))]
[:div.asset-group
[:div.group-title
(tr "workspace.assets.graphics")
[:span (str "\u00A0(") (count media-objects) ")"] ;; Unicode 00A0 is non-breaking space
(when local-library?
[:span (str "\u00A0(") (count objects) ")"] ;; Unicode 00A0 is non-breaking space
(when local?
[:div.group-button {:on-click add-graphic}
i/plus
[:& file-uploader {:accept cm/str-media-types
:multi true
:input-ref file-input
:on-selected on-files-selected}]])]
:input-ref input-ref
:on-selected on-selected}]])]
[:div.group-grid
(for [object media-objects]
(for [object objects]
[:div.grid-cell {:key (:id object)
:draggable true
:on-context-menu (on-context-menu (:id object))
@ -127,39 +142,37 @@
:draggable false}] ;; Also need to add css pointer-events: none
[:div.cell-name (:name object)]])
(when local-library?
(when local?
[:& context-menu
{:selectable false
:show (:menu-open @state)
:on-close #(swap! state assoc :menu-open false)
:top (:top @state)
:left (:left @state)
:options [[(tr "workspace.assets.delete") delete-graphic]]}])]]))
:options [[(tr "workspace.assets.delete") on-delete]]}])]]))
(mf/defc color-item
[{:keys [color file-id local-library?] :as props}]
(let [workspace-local @refs/workspace-local
color-for-rename (:color-for-rename workspace-local)
edit-input-ref (mf/use-ref)
state (mf/use-state {:menu-open false
:top nil
:left nil
:editing (= color-for-rename (:id color))})
[{:keys [color local? locale] :as props}]
(let [rename? (= (:color-for-rename @refs/workspace-local) (:id color))
id (:id color)
input-ref (mf/use-ref)
state (mf/use-state {:menu-open false
:top nil
:left nil
:editing rename?})
rename-color
(fn [name]
(st/emit! (dcol/rename-color file-id (:id color) name)))
(st/emit! (dwl/update-color (assoc color :name name))))
edit-color
(fn [value opacity]
(st/emit! (dcol/update-color file-id (:id color) value)))
(st/emit! (dwl/update-color (assoc color :value name))))
delete-color
(fn []
(st/emit! (dcol/delete-color file-id (:id color))))
(st/emit! (dwl/delete-color color)))
rename-color-clicked
(fn [event]
@ -171,13 +184,13 @@
(let [target (dom/event->target event)
name (dom/get-value target)]
(rename-color name)
(st/emit! dcol/clear-color-for-rename)
(st/emit! dwl/clear-color-for-rename)
(swap! state assoc :editing false)))
input-key-down
(fn [event]
(when (kbd/esc? event)
(st/emit! dcol/clear-color-for-rename)
(st/emit! dwl/clear-color-for-rename)
(swap! state assoc :editing false))
(when (kbd/enter? event)
(input-blur event)))
@ -185,12 +198,12 @@
edit-color-clicked
(fn [event]
(modal/show! modal-edit-color
{:color-value (:content color)
{:color-value (:value color)
:on-accept edit-color}))
on-context-menu
(fn [event]
(when local-library?
(when local?
(let [pos (dom/get-client-position event)
top (:y pos)
left (- (:x pos) 20)]
@ -203,16 +216,16 @@
(mf/use-effect
(mf/deps (:editing @state))
#(when (:editing @state)
(let [edit-input (mf/ref-val edit-input-ref)]
(dom/select-text! edit-input))
(let [input (mf/ref-val input-ref)]
(dom/select-text! input))
nil))
[:div.group-list-item {:on-context-menu on-context-menu}
[:div.color-block {:style {:background-color (:content color)}}]
[:div.color-block {:style {:background-color (:value color)}}]
(if (:editing @state)
[:input.element-name
{:type "text"
:ref edit-input-ref
:ref input-ref
:on-blur input-blur
:on-key-down input-key-down
:auto-focus true
@ -220,179 +233,201 @@
[:div.name-block
{:on-double-click rename-color-clicked}
(:name color)
(when-not (= (:name color) (:content color))
[:span (:content color)])])
(when local-library?
(when-not (= (:name color) (:value color))
[:span (:value color)])])
(when local?
[:& context-menu
{:selectable false
:show (:menu-open @state)
:on-close #(swap! state assoc :menu-open false)
:top (:top @state)
:left (:left @state)
:options [[(tr "workspace.assets.rename") rename-color-clicked]
[(tr "workspace.assets.edit") edit-color-clicked]
[(tr "workspace.assets.delete") delete-color]]}])]))
:options [[(t locale "workspace.assets.rename") rename-color-clicked]
[(t locale "workspace.assets.edit") edit-color-clicked]
[(t locale "workspace.assets.delete") delete-color]]}])]))
(mf/defc colors-box
[{:keys [file-id local-library? colors] :as props}]
[{:keys [file-id local? colors locale] :as props}]
(let [add-color
(fn [value opacity]
(st/emit! (dcol/create-color file-id value)))
(mf/use-callback
(mf/deps file-id)
(fn [value opacity]
(st/emit! (dwl/add-color value))))
add-color-clicked
(fn [event]
(modal/show! modal-edit-color
{:color-value "#406280"
:on-accept add-color}))]
(mf/use-callback
(mf/deps file-id)
(fn [event]
(modal/show! modal-edit-color
{:color-value "#406280"
:on-accept add-color})))]
[:div.asset-group
[:div.group-title
(tr "workspace.assets.colors")
[:span (str "\u00A0(") (count colors) ")"] ;; Unicode 00A0 is non-breaking space
(when local-library?
[:div.group-button {:on-click add-color-clicked} i/plus])]
(t locale "workspace.assets.colors")
[:span (str "\u00A0(") (count colors) ")"] ;; Unicode 00A0 is non-breaking space
(when local?
[:div.group-button {:on-click add-color-clicked} i/plus])]
[:div.group-list
(for [color colors]
[:& color-item {:key (:id color)
:color color
:file-id file-id
:local-library? local-library?}])]]))
:local? local?}])]]))
(mf/defc file-library-toolbox
[{:keys [library
local-library?
shared?
media-objects
colors
initial-open?
search-term
box-filter] :as props}]
(let [open? (mf/use-state initial-open?)
(defn file-colors-ref
[id]
(l/derived (fn [state]
(let [wfile (:workspace-file state)]
(if (= (:id wfile) id)
(vals (get-in wfile [:data :colors]))
(vals (get-in state [:workspace-libraries id :data :colors])))))
st/state =))
(defn file-media-ref
[id]
(l/derived (fn [state]
(let [wfile (:workspace-file state)]
(if (= (:id wfile) id)
(vals (get-in wfile [:data :media]))
(vals (get-in state [:workspace-libraries id :data :media])))))
st/state =))
(defn apply-filters
[coll filters]
(filter (fn [item]
(or (matches-search (:name item "!$!") (:term filters))
(matches-search (:value item "!$!") (:term filters))))
coll))
(mf/defc file-library
[{:keys [file local? open? filters locale] :as props}]
(let [open? (mf/use-state open?)
shared? (:is-shared file)
router (mf/deref refs/router)
toggle-open #(swap! open? not)
router (mf/deref refs/router)
library-url (rt/resolve router :workspace
{:project-id (:project-id library)
:file-id (:id library)}
{:page-id (first (:pages library))})]
url (rt/resolve router :workspace
{:project-id (:project-id file)
:file-id (:id file)}
{:page-id (get-in file [:data :pages 0])})
colors-ref (mf/use-memo (mf/deps (:id file)) #(file-colors-ref (:id file)))
colors (apply-filters (mf/deref colors-ref) filters)
media-ref (mf/use-memo (mf/deps (:id file)) #(file-media-ref (:id file)))
media (apply-filters (mf/deref media-ref) filters)]
[:div.tool-window
[:div.tool-window-bar
[:div.collapse-library
{:class (classnames :open @open?)
{:class (dom/classnames :open @open?)
:on-click toggle-open}
i/arrow-slide]
(if local-library?
(if local?
[:*
[:span (tr "workspace.assets.file-library")]
[:span (t locale "workspace.assets.file-library")]
(when shared?
[:span.tool-badge (tr "workspace.assets.shared")])]
[:span.tool-badge (t locale "workspace.assets.shared")])]
[:*
[:span (:name library)]
[:span (:name file)]
[:span.tool-link
[:a {:href (str "#" library-url) :target "_blank"} i/chain]]])]
[:a {:href (str "#" url) :target "_blank"} i/chain]]])]
(when @open?
(let [show-graphics (and (or (= box-filter :all) (= box-filter :graphics))
(or (> (count media-objects) 0) (str/empty? search-term)))
show-colors (and (or (= box-filter :all) (= box-filter :colors))
(or (> (count colors) 0) (str/empty? search-term)))]
(let [show-graphics? (and (or (= (:box filters) :all)
(= (:box filters) :graphics))
(or (> (count media) 0)
(str/empty? (:term filters))))
show-colors? (and (or (= (:box filters) :all)
(= (:box filters) :colors))
(or (> (count colors) 0)
(str/empty? (:term filters))))]
[:div.tool-window-content
(when show-graphics
[:& graphics-box {:file-id (:id library)
:local-library? local-library?
:media-objects media-objects}])
(when show-colors
[:& colors-box {:file-id (:id library)
:local-library? local-library?
(when show-graphics?
[:& graphics-box {:file-id (:id file)
:local? local?
:objects media}])
(when show-colors?
[:& colors-box {:file-id (:id file)
:local? local?
:locale locale
:colors colors}])
(when (and (not show-graphics) (not show-colors))
(when (and (not show-graphics?) (not show-colors?))
[:div.asset-group
[:div.group-title (tr "workspace.assets.not-found")]])]))]))
[:div.group-title (t locale "workspace.assets.not-found")]])]))]))
(mf/defc assets-toolbox
[]
(let [team-id (-> refs/workspace-project mf/deref :team-id)
file (mf/deref refs/workspace-file)
libraries (mf/deref refs/workspace-libraries)
sorted-libraries (->> (vals libraries)
(sort-by #(str/lower (:name %))))
[{:keys [team-id file] :as props}]
(let [libraries (mf/deref refs/workspace-libraries)
locale (mf/deref i18n/locale)
filters (mf/use-state {:term "" :box :all})
state (mf/use-state {:search-term ""
:box-filter :all})
on-search-term-change
(mf/use-callback
(mf/deps team-id)
(fn [event]
(let [value (-> (dom/get-target event)
(dom/get-value))]
(swap! filters assoc :term value))))
filtered-media-objects (fn [library-id]
(as-> libraries $$
(assoc $$ (:id file) file)
(get-in $$ [library-id :media-objects])
(filter #(matches-search (:name %) (:search-term @state)) $$)
(sort-by #(str/lower (:name %)) $$)))
on-search-clear-click
(mf/use-callback
(mf/deps team-id)
(fn [event]
(swap! filters assoc :term "")))
filtered-colors (fn [library-id]
(as-> libraries $$
(assoc $$ (:id file) file)
(get-in $$ [library-id :colors])
(filter #(or (matches-search (:name %) (:search-term @state))
(matches-search (:content %) (:search-term @state))) $$)
(sort-by #(str/lower (:name %)) $$)))
on-search-term-change (fn [event]
(let [value (-> (dom/get-target event)
(dom/get-value))]
(swap! state assoc :search-term value)))
on-search-clear-click (fn [event]
(swap! state assoc :search-term ""))
on-box-filter-change (fn [event]
(let [value (-> (dom/get-target event)
(dom/get-value)
(d/read-string))]
(swap! state assoc :box-filter value)))]
on-box-filter-change
(mf/use-callback
(mf/deps team-id)
(fn [event]
(let [value (-> (dom/get-target event)
(dom/get-value)
(d/read-string))]
(swap! filters assoc :box value))))]
[:div.assets-bar
[:div.tool-window
[:div.tool-window-content
[:div.assets-bar-title
(tr "workspace.assets.assets")
(t locale "workspace.assets.assets")
[:div.libraries-button {:on-click #(modal/show! libraries-dialog {})}
i/libraries
(tr "workspace.assets.libraries")]]
(t locale "workspace.assets.libraries")]]
[:div.search-block
[:input.search-input
{:placeholder (tr "workspace.assets.search")
:type "text"
:value (:search-term @state)
:value (:term @filters)
:on-change on-search-term-change}]
(if (str/empty? (:search-term @state))
(if (str/empty? (:term @filters))
[:div.search-icon
i/search]
[:div.search-icon.close
{:on-click on-search-clear-click}
i/close])]
[:select.input-select {:value (:box-filter @state)
[:select.input-select {:value (:box @filters)
:on-change on-box-filter-change}
[:option {:value ":all"} (tr "workspace.assets.box-filter-all")]
[:option {:value ":graphics"} (tr "workspace.assets.box-filter-graphics")]
[:option {:value ":colors"} (tr "workspace.assets.box-filter-colors")]]]]
[:option {:value ":all"} (t locale "workspace.assets.box-filter-all")]
[:option {:value ":graphics"} (t locale "workspace.assets.box-filter-graphics")]
[:option {:value ":colors"} (t locale "workspace.assets.box-filter-colors")]]]]
[:& file-library-toolbox {:key (:id file)
:library file
:local-library? true
:shared? (:is-shared file)
:media-objects (filtered-media-objects (:id file))
:colors (filtered-colors (:id file))
:initial-open? true
:search-term (:search-term @state)
:box-filter (:box-filter @state)}]
(for [library sorted-libraries]
[:& file-library-toolbox {:key (:id library)
:library library
:local-library? false
:shared? (:is-shared library)
:media-objects (filtered-media-objects (:id library))
:colors (filtered-colors (:id library))
:initial-open? false
:search-term (:search-term @state)
:box-filter (:box-filter @state)}])]))
[:& file-library
{:file file
:locale locale
:local? true
:open? true
:filters @filters}]
(for [file (->> (vals libraries)
(sort-by #(str/lower (:name %))))]
[:& file-library
{:key (:id file)
:file file
:local? false
:open? false
:filters @filters}])]))

29
frontend/src/app/main/ui/workspace/sidebar/layers.cljs
View file

@ -5,30 +5,29 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2015-2016 Juan de la Cruz <delacruzgarciajuan@gmail.com>
;; Copyright (c) 2015-2020 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.main.ui.workspace.sidebar.layers
(:require
[okulary.core :as l]
[rumext.alpha :as mf]
[beicon.core :as rx]
[app.main.ui.icons :as i]
[app.common.data :as d]
[app.common.uuid :as uuid]
[app.common.pages :as cp]
[app.common.pages-helpers :as cph]
[app.common.uuid :as uuid]
[app.main.data.workspace :as dw]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.hooks :as hooks]
[app.main.ui.icons :as i]
[app.main.ui.keyboard :as kbd]
[app.main.ui.shapes.icon :as icon]
[app.util.object :as obj]
[app.util.dom :as dom]
[app.util.timers :as ts]
[app.util.i18n :as i18n :refer [t]]
[app.util.perf :as perf]))
[app.util.object :as obj]
[app.util.perf :as perf]
[app.util.timers :as ts]
[beicon.core :as rx]
[okulary.core :as l]
[rumext.alpha :as mf]))
;; --- Helpers
@ -305,15 +304,13 @@
(mf/defc layers-toolbox
{:wrap [mf/memo]}
[{:keys [page] :as props}]
[]
(let [locale (mf/deref i18n/locale)
data (mf/deref refs/workspace-data)
on-click #(st/emit! (dw/toggle-layout-flags :layers))]
page (mf/deref refs/workspace-page)]
[:div#layers.tool-window
[:div.tool-window-bar
[:div.tool-window-icon i/layers]
[:span (:name page)]
#_[:div.tool-window-close {:on-click on-click} i/close]]
[:span (:name page)]]
[:div.tool-window-content
[:& layers-tree-wrapper {:key (:id page)
:objects (:objects data)}]]]))
:objects (:objects page)}]]]))

26
frontend/src/app/main/ui/workspace/sidebar/options.cljs
View file

@ -37,7 +37,7 @@
(mf/defc shape-options
{::mf/wrap [#(mf/throttle % 60)]}
[{:keys [shape shapes-with-children page] :as props}]
[{:keys [shape shapes-with-children page-id file-id]}]
[:*
(case (:type shape)
:frame [:& frame/options {:shape shape}]
@ -50,12 +50,15 @@
:curve [:& path/options {:shape shape}]
:image [:& image/options {:shape shape}]
nil)
[:& exports-menu {:shape shape :page page}]])
[:& exports-menu
{:shape shape
:page-id page-id
:file-id file-id}]])
(mf/defc options-content
{::mf/wrap [mf/memo]}
[{:keys [section shapes shapes-with-children page] :as props}]
[{:keys [selected section shapes shapes-with-children page-id file-id]}]
(let [locale (mf/deref i18n/locale)]
[:div.tool-window
[:div.tool-window-content
@ -65,10 +68,11 @@
:title (t locale "workspace.options.design")}
[:div.element-options
[:& align-options]
(case (count shapes)
0 [:& page/options {:page page}]
(case (count selected)
0 [:& page/options {:page-id page-id}]
1 [:& shape-options {:shape (first shapes)
:page page
:page-id page-id
:file-id file-id
:shapes-with-children shapes-with-children}]
[:& multiple/options {:shapes shapes-with-children}])]]
@ -78,14 +82,20 @@
[:& interactions-menu {:shape (first shapes)}]]]]]]))
;; TODO: this need optimizations, selected-objects and
;; selected-objects-with-children are derefed always but they only
;; need on multiple selection in majority of cases
(mf/defc options-toolbox
{::mf/wrap [mf/memo]}
[{:keys [page local] :as props}]
[{:keys [page-id file-id local] :as props}]
(let [section (:options-mode local)
shapes (mf/deref refs/selected-objects)
shapes-with-children (mf/deref refs/selected-objects-with-children)]
[:& options-content {:shapes shapes
:selected (:selected local)
:shapes-with-children shapes-with-children
:page page
:file-id file-id
:page-id page-id
:section section}]))

5
frontend/src/app/main/ui/workspace/sidebar/options/exports.cljs
View file

@ -29,6 +29,7 @@
:response-type :blob
:auth true
:body {:page-id (:page-id shape)
:file-id (:file-id shape)
:object-id (:id shape)
:name (:name shape)
:exports exports}}))
@ -45,7 +46,7 @@
(.remove link)))
(mf/defc exports-menu
[{:keys [shape page] :as props}]
[{:keys [shape page-id file-id] :as props}]
(let [locale (mf/deref i18n/locale)
exports (:exports shape [])
loading? (mf/use-state false)
@ -56,7 +57,7 @@
(fn [event]
(dom/prevent-default event)
(swap! loading? not)
(->> (request-export (assoc shape :page-id (:id page)) exports)
(->> (request-export (assoc shape :page-id page-id :file-id file-id) exports)
(rx/subs
(fn [{:keys [status body] :as response}]
(js/console.log status body)

2
frontend/src/app/main/ui/workspace/sidebar/options/interactions.cljs
View file

@ -23,7 +23,7 @@
(mf/defc interactions-menu
[{:keys [shape] :as props}]
(let [locale (mf/deref i18n/locale)
objects (deref refs/workspace-objects)
objects (deref refs/workspace-page-objects)
interaction (first (:interactions shape)) ; TODO: in the
; future we may
; have several

9
frontend/src/app/main/ui/workspace/sidebar/options/page.cljs
View file

@ -21,18 +21,17 @@
(def options-iref
(l/derived :options refs/workspace-data))
(defn use-change-color [page]
(defn use-change-color [page-id]
(mf/use-callback
(mf/deps page)
(mf/deps page-id)
(fn [value]
(st/emit! (dw/change-canvas-color value)))))
(mf/defc options
[{:keys [page] :as props}]
[{:keys [page-id] :as props}]
(let [locale (i18n/use-locale)
options (mf/deref refs/workspace-page-options)
handle-change-color (use-change-color page)]
handle-change-color (use-change-color page-id)]
[:div.element-set
[:div.element-set-title (t locale "workspace.options.canvas-background")]
[:div.element-set-content

169
frontend/src/app/main/ui/workspace/sidebar/sitemap.cljs
View file

@ -2,96 +2,104 @@
;; 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-2019 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2015-2016 Juan de la Cruz <delacruzgarciajuan@gmail.com>
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.main.ui.workspace.sidebar.sitemap
(:require
[cuerdas.core :as str]
[okulary.core :as l]
[rumext.alpha :as mf]
[app.common.data :as d]
[app.main.ui.icons :as i]
[app.main.data.workspace :as dw]
[app.main.store :as st]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.confirm :refer [confirm-dialog]]
[app.main.ui.hooks :as hooks]
[app.main.ui.icons :as i]
[app.main.ui.keyboard :as kbd]
[app.main.ui.modal :as modal]
[app.main.ui.hooks :as hooks]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [t]]
[app.util.router :as rt]))
[app.util.router :as rt]
[cuerdas.core :as str]
[okulary.core :as l]
[rumext.alpha :as mf]))
;; --- Page Item
(mf/defc page-item
[{:keys [page index deletable? selected?] :as props}]
(let [local (mf/use-state {})
edit-input-ref (mf/use-ref)
(let [local (mf/use-state {})
input-ref (mf/use-ref)
id (:id page)
delete-fn (mf/use-callback (mf/deps id) #(st/emit! (dw/delete-page id)))
on-delete (mf/use-callback (mf/deps id) #(modal/show! confirm-dialog {:on-accept delete-fn}))
navigate-fn (mf/use-callback (mf/deps id) #(st/emit! (dw/go-to-page id)))
on-double-click
(fn [event]
(dom/prevent-default event)
(dom/stop-propagation event)
(swap! local assoc :edition true))
(mf/use-callback
(fn [event]
(dom/prevent-default event)
(dom/stop-propagation event)
(swap! local assoc :edition true)))
on-blur
(mf/use-callback
(fn [event]
(let [target (dom/event->target event)
name (dom/get-value target)]
(st/emit! (dw/rename-page id name))
(swap! local assoc :edition false))))
on-key-down
(mf/use-callback
(fn [event]
(let [target (dom/event->target event)
name (dom/get-value target)]
(st/emit! (dw/rename-page (:id page) name))
(swap! local assoc :edition false)))
(cond
(kbd/enter? event)
(on-blur event)
on-key-down (fn [event]
(cond
(kbd/enter? event)
(on-blur event)
(kbd/esc? event)
(swap! local assoc :edition false)))
delete-fn #(st/emit! (dw/delete-page (:id page)))
on-delete #(do
(dom/prevent-default %)
(dom/stop-propagation %)
(modal/show! confirm-dialog {:on-accept delete-fn}))
navigate-fn #(st/emit! (dw/go-to-page (:id page)))
(kbd/esc? event)
(swap! local assoc :edition false))))
on-drop
(fn [side {:keys [id name] :as data}]
(let [index (if (= :bot side) (inc index) index)]
(st/emit! (dw/relocate-page id index))))
(mf/use-callback
(mf/deps id)
(fn [side {:keys [id name] :as data}]
(let [index (if (= :bot side) (inc index) index)]
(st/emit! (dw/relocate-page id index)))))
[dprops dref] (hooks/use-sortable
:data-type "app/page"
:on-drop on-drop
:data {:id (:id page)
:index index
:name (:name page)})]
[dprops dref]
(hooks/use-sortable
:data-type "app/page"
:on-drop on-drop
:data {:id id
:index index
:name (:name page)})]
(mf/use-effect
(mf/deps (:edition @local))
#(when (:edition @local)
(let [edit-input (mf/ref-val edit-input-ref)]
(mf/use-layout-effect
(mf/deps (:edition @local))
(fn []
(when (:edition @local)
(let [edit-input (mf/ref-val input-ref)]
(dom/select-text! edit-input))
nil))
nil)))
[:li {:class (dom/classnames
:selected selected?
:dnd-over-top (= (:over dprops) :top)
:dnd-over-bot (= (:over dprops) :bot))
:ref dref}
[:div.element-list-body {:class (dom/classnames
:selected selected?)
:on-click navigate-fn
:on-double-click on-double-click}
[:div.element-list-body
{:class (dom/classnames
:selected selected?)
:on-click navigate-fn
:on-double-click on-double-click}
[:div.page-icon i/file-html]
(if (:edition @local)
[:*
[:input.element-name {:type "text"
:ref edit-input-ref
:ref input-ref
:on-blur on-blur
:on-key-down on-key-down
:auto-focus true
@ -105,18 +113,17 @@
;; --- Page Item Wrapper
(defn- make-page-iref
[id]
#(l/derived (fn [state]
(let [page (get-in state [:workspace-pages id])]
(select-keys page [:id :name :ordering])))
(defn- make-page-ref
[page-id]
(l/derived (fn [state]
(let [page (get-in state [:workspace-file :data :pages-index page-id])]
(select-keys page [:id :name])))
st/state =))
(mf/defc page-item-wrapper
[{:keys [page-id index deletable? selected?] :as props}]
(let [page-iref (mf/use-memo (mf/deps page-id)
(make-page-iref page-id))
page (mf/deref page-iref)]
[{:keys [file-id page-id index deletable? selected?] :as props}]
(let [page-ref (mf/use-memo (mf/deps page-id) #(make-page-ref page-id))
page (mf/deref page-ref)]
[:& page-item {:page page
:index index
:deletable? deletable?
@ -125,33 +132,35 @@
;; --- Pages List
(mf/defc pages-list
[{:keys [file current-page] :as props}]
(let [pages (d/enumerate (:pages file))
[{:keys [file current-page-id] :as props}]
(let [pages (:pages file)
deletable? (> (count pages) 1)]
[:ul.element-list
[:& hooks/sortable-container {}
(for [[index page-id] pages]
[:& page-item-wrapper
{:page-id page-id
:index index
:deletable? deletable?
:selected? (= page-id (:id current-page))
:key page-id}])]]))
(for [[index page-id] (d/enumerate pages)]
[:& page-item-wrapper
{:page-id page-id
:index index
:deletable? deletable?
:selected? (= page-id current-page-id)
:key page-id}])]]))
;; --- Sitemap Toolbox
(mf/defc sitemap-toolbox
[{:keys [file page layout] :as props}]
(let [on-create-click #(st/emit! dw/create-empty-page)
toggle-layout #(st/emit! (dw/toggle-layout-flags %))
locale (i18n/use-locale)]
(mf/defc sitemap
[{:keys [file page-id layout] :as props}]
(let [create (mf/use-callback #(st/emit! dw/create-empty-page))
collapse (mf/use-callback #(st/emit! (dw/toggle-layout-flags :sitemap-pages)))
locale (mf/deref i18n/locale)]
[:div.sitemap.tool-window
[:div.tool-window-bar
[:span (t locale "workspace.sidebar.sitemap")]
[:div.add-page {:on-click on-create-click} i/close]
[:div.collapse-pages {:on-click #(st/emit! (dw/toggle-layout-flags :sitemap-pages))}
i/arrow-slide]]
[:div.add-page {:on-click create} i/close]
[:div.collapse-pages {:on-click collapse} i/arrow-slide]]
(when (contains? layout :sitemap-pages)
[:div.tool-window-content
[:& pages-list {:file file :current-page page}]])]))
[:& pages-list
{:file file
:key (:id file)
:current-page-id page-id}]])]))

50
frontend/src/app/main/ui/workspace/snap_distances.cljs
View file

@ -132,7 +132,7 @@
:frame-id (:id frame)
:rect (gsh/pad-selrec (areas side))})
(rx/map #(set/difference % selected))
(rx/map #(->> % (map (partial get @refs/workspace-objects))))))]
(rx/map #(->> % (map (partial get @refs/workspace-page-objects))))))]
(->> (query-side lt-side)
(rx/combine-latest vector (query-side gt-side)))))
@ -213,29 +213,25 @@
:coord coord
:zoom zoom}])))
(mf/defc snap-distances [{:keys [layout]}]
(let [page-id (mf/deref refs/workspace-page-id)
selected (mf/deref refs/selected-shapes)
shapes (->> (refs/objects-by-id selected)
(mf/deref)
(map gsh/transform-shape))
selrect (gsh/selection-rect shapes)
frame-id (-> shapes first :frame-id)
frame (mf/deref (refs/object-by-id frame-id))
zoom (mf/deref refs/selected-zoom)
current-transform (mf/deref refs/current-transform)
key (->> selected (map str) (str/join "-"))]
(when (and (contains? layout :dynamic-alignment)
(= current-transform :move)
(not (empty? selected)))
[:g.distance
(for [coord [:x :y]]
[:& shape-distance
{:key (str key (name coord))
:selrect selrect
:page-id page-id
:frame frame
:zoom zoom
:coord coord
:selected selected}])])))
(mf/defc snap-distances
[{:keys [layout page-id zoom selected transform]}]
(when (and (contains? layout :dynamic-alignment)
(= transform :move)
(not (empty? selected)))
(let [shapes (->> (refs/objects-by-id selected)
(mf/deref)
(map gsh/transform-shape))
selrect (gsh/selection-rect shapes)
frame-id (-> shapes first :frame-id)
frame (mf/deref (refs/object-by-id frame-id))
key (->> selected (map str) (str/join "-"))]
[:g.distance
(for [coord [:x :y]]
[:& shape-distance
{:key (str key (name coord))
:selrect selrect
:page-id page-id
:frame frame
:zoom zoom
:coord coord
:selected selected}])])))

42
frontend/src/app/main/ui/workspace/viewport.cljs
View file

@ -116,6 +116,8 @@
(declare remote-user-cursors)
;; TODO: revisit the refs usage (vs props)
(mf/defc shape-outlines
{::mf/wrap-props false}
[props]
@ -135,13 +137,13 @@
{::mf/wrap [mf/memo]
::mf/wrap-props false}
[props]
(let [data (mf/deref refs/workspace-data)
(let [data (mf/deref refs/workspace-page)
hover (unchecked-get props "hover")
selected (unchecked-get props "selected")
objects (:objects data)
root (get objects uuid/zero)
shapes (->> (:shapes root)
(map #(get objects %)))]
objects (:objects data)
root (get objects uuid/zero)
shapes (->> (:shapes root)
(map #(get objects %)))]
[:*
[:g.shapes
(for [item shapes]
@ -157,9 +159,8 @@
:hover hover}]]))
(mf/defc viewport
[{:keys [page local layout] :as props}]
(let [{:keys [drawing-tool
options-mode
[{:keys [page-id page local layout] :as props}]
(let [{:keys [options-mode
zoom
flags
vport
@ -169,9 +170,12 @@
selected
panning]} local
file (mf/deref refs/workspace-file)
viewport-ref (mf/use-ref nil)
file (mf/deref refs/workspace-file)
viewport-ref (mf/use-ref nil)
last-position (mf/use-var nil)
drawing (mf/deref refs/workspace-drawing)
drawing-tool (:tool drawing)
drawing-obj (:object drawing)
zoom (or zoom 1)
@ -462,7 +466,7 @@
:on-drop on-drop}
[:g
[:& frames {:key (:id page)
[:& frames {:key page-id
:hover (:hover local)
:selected (:selected selected)}]
@ -471,8 +475,8 @@
:zoom zoom
:edition edition}])
(when-let [drawing-shape (:drawing local)]
[:& draw-area {:shape drawing-shape
(when drawing-obj
[:& draw-area {:shape drawing-obj
:zoom zoom
:modifiers (:modifiers local)}])
@ -481,17 +485,21 @@
[:& snap-points {:layout layout
:transform (:transform local)
:drawing (:drawing local)
:drawing drawing-obj
:zoom zoom
:page-id (:id page)
:page-id page-id
:selected selected}]
[:& snap-distances {:layout layout}]
[:& snap-distances {:layout layout
:zoom zoom
:transform (:transform local)
:selected selected
:page-id page-id}]
(when tooltip
[:& cursor-tooltip {:zoom zoom :tooltip tooltip}])]
[:& presence/active-cursors {:page page}]
[:& presence/active-cursors {:page-id page-id}]
[:& selection-rect {:data (:selrect local)}]
(when (= options-mode :prototype)
[:& interactions {:selected selected}])]))

3
frontend/src/app/util/object.cljs
View file

@ -20,7 +20,8 @@
(when-not (nil? obj)
(unchecked-get obj k)))
([obj k default]
(or (get obj k) default)))
(let [result (get obj k)]
(if (undefined? result) default result))))
(defn get-in
[obj keys]

6
frontend/src/app/worker/impl.cljs
View file

@ -23,12 +23,12 @@
[message]
message)
(defmethod handler :create-page-indices
(defmethod handler :initialize-indices
[message]
(handler (-> message
(assoc :cmd :selection/create-index)))
(assoc :cmd :selection/initialize-index)))
(handler (-> message
(assoc :cmd :snaps/create-index))))
(assoc :cmd :snaps/initialize-index))))
(defmethod handler :update-page-indices
[message]

11
frontend/src/app/worker/selection.cljs
View file

@ -26,16 +26,15 @@
(declare index-object)
(declare create-index)
(defmethod impl/handler :selection/create-index
[{:keys [file-id pages] :as message}]
(defmethod impl/handler :selection/initialize-index
[{:keys [file-id data] :as message}]
(letfn [(index-page [state page]
(let [id (:id page)
objects (get-in page [:data :objects])]
(let [id (:id page)
objects (:objects page)]
(assoc state id (create-index objects))))
(update-state [state]
(reduce index-page state pages))]
(reduce index-page state (vals (:pages-index data))))]
(swap! state update-state)
nil))

18
frontend/src/app/worker/snaps.cljs
View file

@ -65,19 +65,17 @@
(assoc state page-id snap-data)))
;; Public API
(defmethod impl/handler :snaps/create-index
[{:keys [file-id pages] :as message}]
(defmethod impl/handler :snaps/initialize-index
[{:keys [file-id data] :as message}]
;; Create the index
(letfn [(process-page [state page]
(let [id (:id page)
objects (get-in page [:data :objects])]
(let [id (:id page)
objects (:objects page)]
(index-page state id objects)))]
(swap! state #(reduce process-page % pages)))
;; (log-state)
;; Return nil so the worker will not answer anything back
nil)
(swap! state #(reduce process-page % (vals (:pages-index data))))
;; (log-state)
;; Return nil so the worker will not answer anything back
nil))
(defmethod impl/handler :snaps/update-index
[{:keys [page-id objects] :as message}]

10
frontend/src/app/worker/thumbnails.cljs
View file

@ -32,23 +32,23 @@
:code (:error response)})))
(defn- request-page
[id]
[file-id page-id]
(let [uri "/api/w/query/page"]
(p/create
(fn [resolve reject]
(->> (http/send! {:uri uri
:query {:id id}
:query {:file-id file-id :id page-id}
:method :get})
(rx/mapcat handle-response)
(rx/subs (fn [body]
(resolve (:data body)))
(resolve body))
(fn [error]
(reject error))))))))
(defmethod impl/handler :thumbnails/generate
[{:keys [id] :as message}]
[{:keys [file-id page-id] :as message}]
(p/then
(request-page id)
(request-page file-id page-id)
(fn [data]
(let [elem (mf/element exports/page-svg #js {:data data
:width "290"

8
frontend/yarn.lock
View file

@ -3768,10 +3768,10 @@ shadow-cljs-jar@1.3.2:
resolved "https://registry.yarnpkg.com/shadow-cljs-jar/-/shadow-cljs-jar-1.3.2.tgz#97273afe1747b6a2311917c1c88d9e243c81957b"
integrity sha512-XmeffAZHv8z7451kzeq9oKh8fh278Ak+UIOGGrapyqrFBB773xN8vMQ3O7J7TYLnb9BUwcqadKkmgaq7q6fhZg==
shadow-cljs@^2.10.19:
version "2.10.19"
resolved "https://registry.yarnpkg.com/shadow-cljs/-/shadow-cljs-2.10.19.tgz#907bbad10bb3af38f6a728452e3cd9c34f1166d1"
integrity sha512-Dzzn+Ll5okjFze5x1AYqO2qNJOalA1/NBu5pehfyO75HqYzsTK+C4+xufKto6qaMb52iM94p2sbzP+Oh8M3VIw==
shadow-cljs@^2.11.0:
version "2.11.0"
resolved "https://registry.yarnpkg.com/shadow-cljs/-/shadow-cljs-2.11.0.tgz#6ffdfaad420b4444ba4bf8f6f21a88efe709d75f"
integrity sha512-Cu05hL632tQ6UrpTwglIOHm3E/X5Fu8UXnTDUX9nEadcAc608Ojwk1YoVFM4f0Slt8oFZPUNjKQBgy2Sr/r6qw==
dependencies:
node-libs-browser "^2.0.0"
readline-sync "^1.4.7"