Merge remote-tracking branch 'origin/staging' into develop

common/src/app/common/schema.cljc

@@ -316,6 +316,22 @@
                     (let [v (if (string? v) (str/split v #"[\s,]+") v)]
                       (into #{} non-empty-strings-xf v)))}})
 
+(def! ::set-of-keywords
+  {:type ::set-of-keywords
+   :pred #(and (set? %) (every? keyword? %))
+   :type-properties
+   {:title "set[string]"
+    :description "Set of Strings"
+    :error/message "should be a set of strings"
+    :gen/gen (-> :keyword sg/generator sg/set)
+    ::oapi/type "array"
+    ::oapi/format "set"
+    ::oapi/items {:type "string" :format "keyword"}
+    ::oapi/unique-items true
+    ::oapi/decode (fn [v]
+                    (let [v (if (string? v) (str/split v #"[\s,]+") v)]
+                      (into #{} (comp non-empty-strings-xf (map keyword)) v)))}})
+
 (def! ::set-of-emails
   {:type ::set-of-emails
    :pred #(and (set? %) (every? string? %))

common/src/app/common/svg.cljc

@@ -0,0 +1,16 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.common.svg
+  #?(:cljs
+     (:require
+      ["./svg_optimizer.js" :as svgo])))
+
+#?(:cljs
+   (defn optimize
+     ([input] (optimize input nil))
+     ([input options]
+      (svgo/optimize input (clj->js options)))))

exporter/src/app/config.cljs

@@ -9,14 +9,15 @@
   (:require
    ["process" :as process]
    [app.common.data :as d]
+   [app.common.flags :as flags]
+   [app.common.pprint :as pp]
+   [app.common.schema :as sm]
    [app.common.spec :as us]
    [app.common.version :as v]
    [cljs.core :as c]
-   [cljs.pprint]
-   [cljs.spec.alpha :as s]
    [cuerdas.core :as str]))
 
-(def defaults
+(def ^:private defaults
   {:public-uri "http://localhost:3449"
    :tenant "default"
    :host "localhost"
@@ -24,22 +25,19 @@
    :http-server-host "0.0.0.0"
    :redis-uri "redis://redis/0"})
 
-(s/def ::http-server-port ::us/integer)
-(s/def ::http-server-host ::us/string)
-(s/def ::public-uri ::us/uri)
-(s/def ::tenant ::us/string)
-(s/def ::host ::us/string)
-(s/def ::browser-pool-max ::us/integer)
-(s/def ::browser-pool-min ::us/integer)
+(def ^:private schema:config
+  [:map {:title "config"}
+   [:public-uri {:optional true} ::sm/uri]
+   [:host {:optional true} :string]
+   [:tenant {:optional true} :string]
+   [:flags {:optional true} ::sm/set-of-keywords]
+   [:redis-uri {:optional true} :string]
+   [:browser-pool-max {:optional true} :int]
+   [:browser-pool-min {:optional true} :int]])
 
-(s/def ::config
-  (s/keys :opt-un [::public-uri
-                   ::host
-                   ::tenant
-                   ::http-server-port
-                   ::http-server-host
-                   ::browser-pool-max
-                   ::browser-pool-min]))
+(defn- parse-flags
+  [config]
+  (flags/parse (:flags config)))
 
 (defn- read-env
   [prefix]
@@ -58,24 +56,30 @@
 
 (defn- prepare-config
   []
-  (try
-    (let [env  (read-env "penpot")
-          env  (d/without-nils env)
-          data (merge defaults env)]
-      (us/conform ::config data))
-    (catch :default cause
-      (js/console.log (us/pretty-explain (ex-data cause)))
-      (throw cause))))
+  (let [env  (read-env "penpot")
+        env  (d/without-nils env)
+        data (merge defaults env)
+        data (sm/decode schema:config data sm/default-transformer)]
+
+    (when-not (sm/validate schema:config data)
+      (pp/pprint (-> (sm/explain-data schema:config data)
+                     (sm/humanize)))
+      (process/exit -1))
+
+    data))
 
 (def config
-  (atom (prepare-config)))
+  (prepare-config))
 
 (def version
-  (atom (v/parse "%version%")))
+  (v/parse "%version%"))
+
+(def flags
+  (parse-flags config))
 
 (defn get
   "A configuration getter."
   ([key]
-   (c/get @config key))
+   (c/get config key))
   ([key default]
-   (c/get @config key default)))
+   (c/get config key default)))

exporter/src/app/core.cljs

@@ -21,7 +21,7 @@
   [& _]
   (l/info :msg "initializing"
           :public-uri (str (cf/get :public-uri))
-          :version (:full @cf/version))
+          :version (:full cf/version))
   (p/do!
    (bwr/init)
    (redis/init)

exporter/src/app/http.cljs

@@ -172,7 +172,8 @@
     (.listen server port)
     (l/info :hint "welcome to penpot"
             :module "exporter"
-            :version (:full @cf/version))
+            :flags cf/flags
+            :version (:full cf/version))
     (l/info :hint "starting http server" :port port)
     (reset! instance server)))
 

exporter/src/app/renderer/svg.cljs

@@ -10,6 +10,7 @@
    [app.browser :as bw]
    [app.common.data :as d]
    [app.common.logging :as l]
+   [app.common.svg :as svg]
    [app.common.uri :as u]
    [app.config :as cf]
    [app.util.mime :as mime]
@@ -316,7 +317,11 @@
                       ;; SVG standard don't allow the entity
                       ;; nbsp.   is equivalent but compatible
                       ;; with SVG.
-                      result  (str/replace result " " " ")]
+                      result  (str/replace result " " " ")
+
+                      result  (if (contains? cf/flags :exporter-svgo)
+                                (svg/optimize result)
+                                result)]
 
                 ;; (println "------- ORIGIN:")
                 ;; (cljs.pprint/pprint (xml->clj xmldata))

frontend/src/app/main/data/workspace/media.cljs

@@ -12,11 +12,12 @@
    [app.common.math :as mth]
    [app.common.pages.changes-builder :as pcb]
    [app.common.schema :as sm]
+   [app.common.svg :refer [optimize]]
    [app.common.types.container :as ctn]
    [app.common.types.shape :as cts]
    [app.common.types.shape-tree :as ctst]
    [app.common.uuid :as uuid]
-   [app.config :as cfg]
+   [app.config :as cf]
    [app.main.data.media :as dmm]
    [app.main.data.messages :as msg]
    [app.main.data.workspace.changes :as dch]
@@ -34,14 +35,34 @@
    [promesa.core :as p]
    [tubax.core :as tubax]))
 
+(def ^:private svgo-config
+  {:multipass false
+   :plugins
+   [{:name "safePreset"
+     :params {:overrides
+              {:convertColors
+               {:names2hex true
+                :shorthex false
+                :shortname false}
+               :convertTransform
+               {:matrixToTransform false
+                :convertToShorts false
+                :transformPrecision 4
+                :leadingZero false}}}}]})
+
 (defn svg->clj
   [[name text]]
   (try
-    (->> (rx/of (-> (tubax/xml->clj text)
-                    (assoc :name name))))
-
-    (catch :default _err
-      (rx/throw {:type :svg-parser}))))
+    (let [text (if (contains? cf/flags :frontend-svgo)
+                 (optimize text svgo-config)
+                 text)
+          data (-> (tubax/xml->clj text)
+                   (assoc :name name))]
+      (rx/of data))
+    (catch :default cause
+      (js/console.error cause)
+      (rx/throw (ex/error :type :svg-parser
+                          :hint (ex-message cause))))))
 
 ;; TODO: rename to bitmap-image-uploaded
 (defn image-uploaded
@@ -231,7 +252,7 @@
   "Load the contents of a media-obj of type svg, and parse it
   into a clojure structure."
   [media-obj]
-  (let [path (cfg/resolve-file-media media-obj)]
+  (let [path (cf/resolve-file-media media-obj)]
     (->> (http/send! {:method :get :uri path :mode :no-cors})
          (rx/map :body)
          (rx/map #(vector (:name media-obj) %))