rose-ash/shared/static/wasm/sx/deps.sx

(define-library (web deps)
  (export
    scan-refs
    scan-refs-walk
    transitive-deps-walk
    transitive-deps
    compute-all-deps
    scan-components-from-source
    components-needed
    page-component-bundle
    page-css-classes
    scan-io-refs-walk
    scan-io-refs
    transitive-io-refs-walk
    transitive-io-refs
    compute-all-io-refs
    component-io-refs-cached
    component-pure?
    render-target
    page-render-plan
    env-components)
  (begin

(define
  scan-refs
  :effects ()
  (fn (node) (let ((refs (list))) (scan-refs-walk node refs) refs)))

(define
  scan-refs-walk
  :effects ()
  (fn
    (node (refs :as list))
    (cond
      (= (type-of node) "symbol")
      (let
        ((name (symbol-name node)))
        (when
          (starts-with? name "~")
          (when (not (contains? refs name)) (append! refs name))))
      (= (type-of node) "list")
      (for-each (fn (item) (scan-refs-walk item refs)) node)
      (= (type-of node) "dict")
      (for-each
        (fn (key) (scan-refs-walk (dict-get node key) refs))
        (keys node))
      :else nil)))

(define
  transitive-deps-walk
  :effects ()
  (fn
    ((n :as string) (seen :as list) (env :as dict))
    (when
      (not (contains? seen n))
      (append! seen n)
      (let
        ((val (env-get env n)))
        (cond
          (or (= (type-of val) "component") (= (type-of val) "island"))
          (for-each
            (fn ((ref :as string)) (transitive-deps-walk ref seen env))
            (scan-refs (component-body val)))
          (= (type-of val) "macro")
          (for-each
            (fn ((ref :as string)) (transitive-deps-walk ref seen env))
            (scan-refs (macro-body val)))
          :else nil)))))

(define
  transitive-deps
  :effects ()
  (fn
    ((name :as string) (env :as dict))
    (let
      ((seen (list))
        (key (if (starts-with? name "~") name (str "~" name))))
      (transitive-deps-walk key seen env)
      (filter (fn ((x :as string)) (not (= x key))) seen))))

(define
  compute-all-deps
  :effects (mutation)
  (fn
    ((env :as dict))
    (for-each
      (fn
        ((name :as string))
        (let
          ((val (env-get env name)))
          (when
            (or (= (type-of val) "component") (= (type-of val) "island"))
            (component-set-deps! val (transitive-deps name env)))))
      (env-components env))))

(define
  scan-components-from-source
  :effects ()
  (fn
    ((source :as string))
    (let
      ((matches (regex-find-all "\\(~([a-zA-Z_][a-zA-Z0-9_\\-:/]*)" source)))
      (map (fn ((m :as string)) (str "~" m)) matches))))

(define
  components-needed
  :effects ()
  (fn
    ((page-source :as string) (env :as dict))
    (let
      ((direct (scan-components-from-source page-source))
        (all-needed (list)))
      (for-each
        (fn
          ((name :as string))
          (when (not (contains? all-needed name)) (append! all-needed name))
          (let
            ((val (env-get env name)))
            (let
              ((deps (if (and (= (type-of val) "component") (not (empty? (component-deps val)))) (component-deps val) (transitive-deps name env))))
              (for-each
                (fn
                  ((dep :as string))
                  (when
                    (not (contains? all-needed dep))
                    (append! all-needed dep)))
                deps))))
        direct)
      all-needed)))

(define
  page-component-bundle
  :effects ()
  (fn
    ((page-source :as string) (env :as dict))
    (components-needed page-source env)))

(define
  page-css-classes
  :effects ()
  (fn
    ((page-source :as string) (env :as dict))
    (let
      ((needed (components-needed page-source env)) (classes (list)))
      (for-each
        (fn
          ((name :as string))
          (let
            ((val (env-get env name)))
            (when
              (= (type-of val) "component")
              (for-each
                (fn
                  ((cls :as string))
                  (when (not (contains? classes cls)) (append! classes cls)))
                (component-css-classes val)))))
        needed)
      (for-each
        (fn
          ((cls :as string))
          (when (not (contains? classes cls)) (append! classes cls)))
        (scan-css-classes page-source))
      classes)))

(define
  scan-io-refs-walk
  :effects ()
  (fn
    (node (io-names :as list) (refs :as list))
    (cond
      (= (type-of node) "symbol")
      (let
        ((name (symbol-name node)))
        (when
          (contains? io-names name)
          (when (not (contains? refs name)) (append! refs name))))
      (= (type-of node) "list")
      (for-each (fn (item) (scan-io-refs-walk item io-names refs)) node)
      (= (type-of node) "dict")
      (for-each
        (fn (key) (scan-io-refs-walk (dict-get node key) io-names refs))
        (keys node))
      :else nil)))

(define
  scan-io-refs
  :effects ()
  (fn
    (node (io-names :as list))
    (let ((refs (list))) (scan-io-refs-walk node io-names refs) refs)))

(define
  transitive-io-refs-walk
  :effects ()
  (fn
    ((n :as string)
      (seen :as list)
      (all-refs :as list)
      (env :as dict)
      (io-names :as list))
    (when
      (not (contains? seen n))
      (append! seen n)
      (let
        ((val (env-get env n)))
        (cond
          (= (type-of val) "component")
          (do
            (for-each
              (fn
                ((ref :as string))
                (when (not (contains? all-refs ref)) (append! all-refs ref)))
              (scan-io-refs (component-body val) io-names))
            (for-each
              (fn
                ((dep :as string))
                (transitive-io-refs-walk dep seen all-refs env io-names))
              (scan-refs (component-body val))))
          (= (type-of val) "macro")
          (do
            (for-each
              (fn
                ((ref :as string))
                (when (not (contains? all-refs ref)) (append! all-refs ref)))
              (scan-io-refs (macro-body val) io-names))
            (for-each
              (fn
                ((dep :as string))
                (transitive-io-refs-walk dep seen all-refs env io-names))
              (scan-refs (macro-body val))))
          :else nil)))))

(define
  transitive-io-refs
  :effects ()
  (fn
    ((name :as string) (env :as dict) (io-names :as list))
    (let
      ((all-refs (list))
        (seen (list))
        (key (if (starts-with? name "~") name (str "~" name))))
      (transitive-io-refs-walk key seen all-refs env io-names)
      all-refs)))

(define
  compute-all-io-refs
  :effects (mutation)
  (fn
    ((env :as dict) (io-names :as list))
    (for-each
      (fn
        ((name :as string))
        (let
          ((val (env-get env name)))
          (when
            (= (type-of val) "component")
            (component-set-io-refs!
              val
              (transitive-io-refs name env io-names)))))
      (env-components env))))

(define
  component-io-refs-cached
  :effects ()
  (fn
    ((name :as string) (env :as dict) (io-names :as list))
    (let
      ((key (if (starts-with? name "~") name (str "~" name))))
      (let
        ((val (env-get env key)))
        (if
          (and
            (= (type-of val) "component")
            (not (nil? (component-io-refs val)))
            (not (empty? (component-io-refs val))))
          (component-io-refs val)
          (transitive-io-refs name env io-names))))))

(define
  component-pure?
  :effects ()
  (fn
    (name (env :as dict) (io-names :as list))
    (let
      ((key (if (starts-with? name "~") name (str "~" name))))
      (let
        ((val (if (env-has? env key) (env-get env key) nil)))
        (if
          (and
            (= (type-of val) "component")
            (not (nil? (component-io-refs val)))
            (not (empty? (component-io-refs val))))
          false
          (empty? (transitive-io-refs name env io-names)))))))

(define
  render-target
  :effects ()
  (fn
    (name (env :as dict) (io-names :as list))
    (let
      ((key (if (starts-with? name "~") name (str "~" name))))
      (let
        ((val (if (env-has? env key) (env-get env key) nil)))
        (if
          (not (= (type-of val) "component"))
          "server"
          (let
            ((affinity (component-affinity val)))
            (cond
              (= affinity "server")
              "server"
              (= affinity "client")
              "client"
              (not (component-pure? name env io-names))
              "server"
              :else "client")))))))

(define
  page-render-plan
  :effects ()
  (fn
    ((page-source :as string) (env :as dict) (io-names :as list))
    (let
      ((needed (components-needed page-source env))
        (comp-targets (dict))
        (server-list (list))
        (client-list (list))
        (io-deps (list)))
      (for-each
        (fn
          ((name :as string))
          (let
            ((target (render-target name env io-names)))
            (dict-set! comp-targets name target)
            (if
              (= target "server")
              (do
                (append! server-list name)
                (for-each
                  (fn
                    ((io-ref :as string))
                    (when
                      (not (contains? io-deps io-ref))
                      (append! io-deps io-ref)))
                  (component-io-refs-cached name env io-names)))
              (append! client-list name))))
        needed)
      {:io-deps io-deps :server server-list :components comp-targets :client client-list})))

(define
  env-components
  :effects ()
  (fn
    ((env :as dict))
    (filter
      (fn
        ((k :as string))
        (let ((v (env-get env k))) (or (component? v) (macro? v))))
      (keys env))))


)) ;; end define-library

;; Re-export to global namespace for backward compatibility
(import (web deps))