(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)) (match (type-of node) ("symbol" (let ((name (symbol-name node))) (when (starts-with? name "~") (when (not (contains? refs name)) (append! refs name))))) ("list" (for-each (fn (child) (scan-refs-walk child refs)) node)) ("dict" (for-each (fn (key) (scan-refs-walk (dict-get node key) refs)) (keys node))) (_ 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)) (match (type-of node) ("symbol" (let ((name (symbol-name node))) (when (contains? io-names name) (when (not (contains? refs name)) (append! refs name))))) ("list" (for-each (fn (item) (scan-io-refs-walk item io-names refs)) node)) ("dict" (for-each (fn (key) (scan-io-refs-walk (dict-get node key) io-names refs)) (keys node))) (_ 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))