;; 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 Sucursal en España SL

(ns app.main.fonts
  "Fonts management and loading logic."
  (:require
   [app.common.data :as d]
   [app.common.data.macros :as dm]
   [app.common.fonts :as cfnt]
   [app.common.logging :as log]
   [app.common.types.text :as txt]
   [app.common.uri :as u]
   [app.config :as cf]
   [app.util.dom :as dom]
   [app.util.globals :as globals]
   [app.util.http :as http]
   [app.util.object :as obj]
   [app.util.timers :as tm]
   [beicon.v2.core :as rx]
   [cuerdas.core :as str]
   [okulary.core :as l]
   [promesa.core :as p]))

(log/set-level! :warn)

(defonce fontsdb (l/atom {}))
(defonce fonts (l/atom []))

(add-watch fontsdb "main"
           (fn [_ _ _ db]
             (->> (vals db)
                  (sort-by :name)
                  (map-indexed #(assoc %2 :index %1))
                  (vec)
                  (reset! fonts))))

(defn register!
  [backend fonts]
  (swap! fontsdb
         (fn [db]
           (let [db    (reduce-kv #(cond-> %1 (= backend (:backend %3)) (dissoc %2)) db db)
                 fonts (map #(assoc % :backend backend) fonts)]
             (merge db (d/index-by :id fonts))))))

(register! :builtin cfnt/local-fonts)

(when (contains? cf/flags :google-fonts-provider)
  (register! :google cfnt/catalog))

(defn get-font-data [id]
  (get @fontsdb id))

(defn installed?
  "True when a font with `font-id` is currently registered in `fontsdb`."
  [font-id]
  (contains? @fontsdb font-id))

(defn valid-default-font
  "Return the remembered default-font attrs only when its font is still
  installed in `fontsdb`; otherwise nil, so callers fall back to the built-in
  default text attrs (Source Sans Pro).

  A new text shape inherits the last-used font (`[:workspace-global
  :default-font]`). If that font is gone (deleted, unavailable in the current
  team, or never resolved), its attrs carry a missing/nil font-family, which
  produces content that fails the backend `validate-shape` schema."
  [default-font]
  (when (and (some? default-font)
             (installed? (:font-id default-font)))
    default-font))

(defn find-font-data [data]
  (d/seek
   (fn [font]
     (= (select-keys font (keys data))
        data))
   (vals @fontsdb)))

(defn find-font-family
  "Case insensitive lookup of font-family."
  [family]
  (let [family' (str/lower family)]
    (d/seek
     (fn [{:keys [family]}]
       (= family' (str/lower family)))
     (vals @fontsdb))))

(defn resolve-variants
  [id]
  (get-in @fontsdb [id :variants]))

(defn resolve-fonts
  [backend]
  (get @fonts backend))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FONTS LOADING
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defonce ^:dynamic loaded (l/atom #{}))
(defonce ^:dynamic loading (l/atom {}))

;; NOTE: mainly used on worker, when you don't really need load font
;; only know if the font is needed or not
(defonce ^:dynamic loaded-hints (l/atom #{}))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PREVIEW SPRITE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; A prebuilt SVG sprite (generated by scripts/build-fonts-preview.js) holds every
;; built-in + Google font name outlined in its own typeface, so the picker can
;; preview the whole catalog with no per-font requests. Fonts not in it (custom
;; uploads, ones that fail to bake) use the runtime fallback.
;;
;; The sprite is heavy (~2000 nodes), so we DON'T keep it in the DOM: the fetched
;; markup is cached here as a string (`:svg`) and the nodes are materialized only
;; while the picker is open (attach/detach below). `:ids` are the font ids it
;; covers, so the UI can pick sprite vs fallback.
(defonce preview-sprite (l/atom {:status :idle :ids #{} :svg nil}))

;; Id prefix shared with the generator and the UI's `<use href>`; referenced here
;; rather than re-declared so the contract stays in one place.
(def preview-sprite-prefix "font-preview-")

(defn- collect-preview-ids
  "Set of font ids present in the sprite, read from the injected `container`
  element's `<g id=\"font-preview-…\">` groups (prefix stripped)."
  [^js container]
  (let [nodes (dom/query-all container (dm/str "g[id^=\"" preview-sprite-prefix "\"]"))
        plen  (count preview-sprite-prefix)]
    (persistent!
     (reduce (fn [acc node]
               (conj! acc (subs (dom/get-attribute node "id") plen)))
             (transient #{})
             (array-seq nodes)))))

(defn- reset-preview-sprite-error!
  []
  ;; :error → the UI shows plain names (no previews, no per-font load storm); a
  ;; later `prefetch-preview-sprite!` call can retry.
  (reset! preview-sprite {:status :error :ids #{} :svg nil}))

(defn- parse-sprite-svg
  "Parse the cached sprite markup as SVG (not HTML, so no innerHTML injection
  surface). Returns the root `<svg>` element, or nil if it isn't valid SVG."
  [text]
  (let [doc  (.parseFromString (js/DOMParser.) text "image/svg+xml")
        root (.-documentElement doc)]
    ;; A malformed document yields a <parsererror> root instead of <svg>.
    (when (and (= "svg" (.-tagName ^js root))
               (nil? (dom/query doc "parsererror")))
      root)))

(defn prefetch-preview-sprite!
  "Fetch the font-preview sprite markup and cache it in memory (no DOM yet — see
  `attach-preview-sprite!`). Idempotent: fetches only when nothing is cached yet
  (`:idle`) or a previous attempt failed (`:error`); no-op while `:loading` or
  `:ready`."
  []
  (when (and (globals/browser?)
             (contains? #{:idle :error} (:status @preview-sprite)))
    (swap! preview-sprite assoc :status :loading)
    (->> (http/send! {:method :get
                      :uri cf/fonts-preview-sprite-uri
                      :response-type :text
                      :mode :cors})
         (rx/subs!
          (fn [response]
            ;; http/send! doesn't reject on non-2xx; guard so an error body isn't
            ;; cached as the sprite.
            (if (http/success? response)
              (swap! preview-sprite assoc :status :ready :svg (:body response))
              (do
                (log/wrn :hint "cannot load font preview sprite" :status (:status response))
                (reset-preview-sprite-error!))))
          (fn [cause]
            (log/wrn :hint "cannot load font preview sprite" :cause cause)
            (reset-preview-sprite-error!))))))

(defn attach-preview-sprite!
  "Materialize the cached sprite into the DOM (hidden) so rows can reference its
  glyph groups via `<use>`, and record the covered font ids. Returns the injected
  node (pass it to `detach-preview-sprite!` on close), or nil if not ready / the
  markup is invalid. Parsing happens here, not on prefetch, so the cost is paid
  only while the picker is open."
  []
  (let [{:keys [status svg]} @preview-sprite]
    (when (and (globals/browser?) (= :ready status) (some? svg))
      (if-let [node (some-> (parse-sprite-svg svg) (dom/import-node))]
        ;; The node already carries display:none + aria-hidden from the generator.
        (do
          (dom/set-attribute! node "id" "font-preview-sprite")
          (when-let [body-el (unchecked-get globals/document "body")]
            (dom/append-child! body-el node))
          (swap! preview-sprite assoc :ids (collect-preview-ids node))
          node)
        (do
          (log/wrn :hint "cannot parse font preview sprite")
          (reset-preview-sprite-error!)
          nil)))))

(defn detach-preview-sprite!
  "Remove the sprite node injected by `attach-preview-sprite!` from the DOM. The
  cached markup and `:ids` stay, so reopening re-attaches without a refetch."
  [node]
  (dom/remove! node))

(defn- add-font-css!
  "Creates a style element and attaches it to the dom."
  [id css]
  (let [node (dom/create-element "style")]
    (dom/set-attribute! node "id" id)
    (dom/set-html! node css)
    (when-let [head (unchecked-get globals/document "head")]
      (dom/append-child! head node))))

;; --- LOADER: BUILTIN

(defmulti ^:private load-font :backend)

(defmethod load-font :default
  [{:keys [backend ::on-failed] :as font}]
  (log/wrn :msg "no implementation found for" :backend backend)
  (when (fn? on-failed)
    (on-failed (ex-info "unsupported font backend" {:backend backend}))))

(defmethod load-font :builtin
  [{:keys [id ::on-loaded] :as font}]
  (log/dbg :hint "load-font" :font-id id :backend "builtin")
  (when (fn? on-loaded)
    (on-loaded id)))

;; --- LOADER: GOOGLE

(defn- generate-gfonts-url
  [{:keys [family variants]}]
  (let [query (dm/str "family=" family ":"
                      (str/join "," (map :id variants))
                      "&display=block")]
    (dm/str
     (-> cf/public-uri
         (u/join "internal/gfonts/css")
         (assoc :query query)))))

(defn- process-gfont-css
  [css]
  (cfnt/gstatic->proxy-url css (u/join cf/public-uri "internal/gfonts/font")))

(defn- request-gfont-css
  [url]
  (->> (http/send! {:method :get :uri url :mode :cors :response-type :text})
       (rx/map :body)))

(defn- fetch-gfont-css
  [url]
  (->> (request-gfont-css url)
       (rx/catch (fn [cause]
                   ;; Keep CSS streams alive when a font cannot load.
                   (log/wrn :hint "cannot find the font" :cause cause)
                   (rx/empty)))))

(defmethod load-font :google
  [{:keys [id ::on-loaded ::on-failed] :as font}]
  (when (globals/browser?)
    (log/dbg :hint "load-font" :font-id id :backend "google")
    (let [url (generate-gfonts-url font)]
      ;; Keep raw errors so the loader can use its fallback.
      (->> (request-gfont-css url)
           (rx/map process-gfont-css)
           (rx/tap #(on-loaded id))
           (rx/subs! (partial add-font-css! id)
                     #(when (fn? on-failed) (on-failed %))))
      nil)))

;; --- LOADER: CUSTOM

(def font-face-template
  "@font-face {
    font-family: '%(family)s';
    font-style: %(style)s;
    font-weight: %(weight)s;
    font-display: block;
    src: url(%(uri)s) format('woff');
  }")

(defn- asset-id->uri
  [asset-id]
  (-> cf/public-uri
      (u/join "assets/by-id/" asset-id)
      (str)))

(defn generate-custom-font-variant-css
  [family variant]
  (str/fmt font-face-template
           {:family family
            :style (:style variant)
            :weight (:weight variant)
            :uri (asset-id->uri (::woff1-file-id variant))}))

(defn- generate-custom-font-css
  [{:keys [family variants] :as font}]
  (->> variants
       (map #(generate-custom-font-variant-css family %))
       (str/join "\n")))

(defmethod load-font :custom
  [{:keys [id ::on-loaded] :as font}]
  (when (globals/browser?)
    (log/dbg :hint "load-font" :font-id id :backend "custom")
    (let [css (generate-custom-font-css font)]
      (add-font-css! id css)
      (when (fn? on-loaded)
        (on-loaded)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LOAD API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn ensure-loaded!
  ([font-id] (ensure-loaded! font-id nil))
  ([font-id variant-id]
   (log/dbg :action "try-ensure-loaded!" :font-id font-id :variant-id variant-id)
   (if-not (globals/browser?)
     ;; If we are in the worker environment, we just mark it as loaded
     ;; without really loading it.
     (do
       (swap! loaded-hints conj {:font-id font-id :font-variant-id variant-id})
       (p/resolved font-id))

     (let [font (get @fontsdb font-id)]
       (cond
         (nil? font)
         (p/resolved font-id)

         ;; Font already loaded, we just continue
         (contains? @loaded font-id)
         (p/resolved font-id)

         ;; Font is currently downloading. We attach the caller to the promise
         (contains? @loading font-id)
         (get @loading font-id)

         ;; First caller, we create the promise and then wait
         :else
         (let [settle! (fn [resolve loaded?]
                         ;; Defer cleanup until a synchronous load is cached.
                         (tm/schedule
                          #(do
                             (when loaded?
                               (swap! loaded conj font-id))
                             (swap! loading dissoc font-id)
                             (resolve font-id))))

               on-load (fn [resolve]
                         (settle! resolve true))

               on-failed
               (fn [resolve cause]
                 (log/wrn :hint "font load failed; using fallback"
                          :font-id font-id
                          :cause cause)
                 (settle! resolve false))

               load-p (-> (p/create
                           (fn [resolve _]
                             (-> font
                                 (assoc ::on-loaded (partial on-load resolve))
                                 (assoc ::on-failed (partial on-failed resolve))
                                 (load-font))))
                          ;; We need to wait for the font to be loaded
                          (p/then (partial p/delay 120)))]

           (swap! loading assoc font-id load-p)
           load-p))))))

(defn ready
  [cb]
  (let [fonts (obj/get js/document "fonts")]
    (p/then (obj/get fonts "ready") cb)))

(defn get-default-variant
  [{:keys [variants]}]
  (or (d/seek #(or (= (:id %) "regular")
                   (= (:name %) "regular")) variants)
      (first variants)))

(defn get-variant
  [{:keys [variants] :as font} font-variant-id]
  (or (d/seek #(= (:id %) font-variant-id) variants)
      (get-default-variant font)))

(defn find-variant
  [{:keys [variants] :as font} variant-data]
  (let [props (keys variant-data)]
    (d/seek #(= (select-keys % props) variant-data) variants)))

(defn find-closest-variant
  "Find the closest font weight variant in `font` for `target-weight` with optional `target-style` match.
  When exactly between two weights, choose the higher one.

  The algorithm lives in `app.common.fonts` so the headless exporter resolves the
  same variant for the same text."
  [font target-weight target-style]
  (cfnt/closest-variant (:variants font []) target-weight target-style))

;; Font embedding functions
(defn get-node-fonts
  "Extracts the fonts used by some node"
  [node]
  (let [nodes  (.from js/Array (dom/query-all node "[style*=font]"))
        result (.reduce nodes (fn [obj node]
                                (let [style (.-style node)
                                      font-family (.-fontFamily style)
                                      [_ font] (first
                                                (filter (fn [[_ {:keys [id family]}]]
                                                          (or (= family font-family)
                                                              (= id font-family)))
                                                        @fontsdb))
                                      font-id (:id font)
                                      font-variant (get-variant font (.-fontVariant style))
                                      font-variant-id (:id font-variant)]
                                  (obj/set!
                                   obj
                                   (dm/str font-id ":" font-variant-id)
                                   {:font-id font-id
                                    :font-variant-id font-variant-id})))
                        #js {})]
    (.values js/Object result)))

(defn get-content-fonts
  "Extracts the fonts used by the content of a text shape"
  [content]
  (->> (txt/node-seq content)
       (filter txt/is-text-node?)
       (reduce
        (fn [result {:keys [font-id] :as node}]
          (let [current-font
                (if (some? font-id)
                  (select-keys node [:font-id :font-variant-id :font-weight :font-style])
                  (select-keys txt/default-typography [:font-id :font-variant-id :font-weight :font-style]))]
            (conj result current-font)))
        #{})))

(defn fetch-font-css
  "Given a font and the variant-id, retrieves the fontface CSS"
  [{:keys [font-id font-variant-id]
    :or   {font-variant-id "regular"}}]
  (let [{:keys [backend family] :as font} (get @fontsdb font-id)]
    (cond
      (nil? font)
      (rx/empty)

      (= :google backend)
      (let [variant (get-variant font font-variant-id)]
        (->> (rx/of (generate-gfonts-url {:family family :variants [variant]}))
             (rx/mapcat fetch-gfont-css)
             (rx/map process-gfont-css)))

      (= :custom backend)
      (let [variant (get-variant font font-variant-id)
            result  (generate-custom-font-variant-css family variant)]
        (rx/of result))

      :else
      (let [{:keys [weight style suffix]} (get-variant font font-variant-id)
            suffix (or suffix font-variant-id)
            params {:uri (str (u/join cf/public-uri (str "fonts/" family "-" suffix ".woff")))
                    :family family
                    :style style
                    :weight weight}]
        (rx/of (str/fmt font-face-template params))))))

(defn extract-fontface-urls
  "Parses the CSS and retrieves the font urls"
  [^string css]
  (->> (re-seq #"url\(([^)]+)\)" css)
       (mapv second)))

(defn render-font-styles
  [font-refs]
  (->> (rx/from font-refs)
       (rx/mapcat fetch-font-css)
       (rx/reduce (fn [acc css] (dm/str acc "\n" css)) "")))

(defonce font-styles (js/Map.))

(defn get-font-style-id
  [{:keys [font-id font-variant-id]
    :or   {font-variant-id "regular"}}]
  (dm/fmt "%:%" font-id font-variant-id))

(defn get-font-styles-by-font-ref
  [font-ref]
  (let [id (get-font-style-id font-ref)]
    (if (.has font-styles id)
      (rx/of (.get font-styles id))
      (->> (rx/of font-ref)
           (rx/mapcat fetch-font-css)
           (rx/tap (fn [css] (.set font-styles id css)))))))

(defn render-font-styles-cached
  [font-refs]
  (->> (rx/from font-refs)
       (rx/merge-map get-font-styles-by-font-ref)
       (rx/reduce (fn [acc css] (dm/str acc "\n" css)) "")))