From bf9769c7b9797ac764f4f2fb48fbf342f78c0477 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakub=20Hol=C3=BD?= Date: Fri, 29 Sep 2023 21:08:31 +0200 Subject: [PATCH] Add Fulcro config (#30) * Initial support for Fulcro Only few namespaces are exposed so far, but it is already possible to render a trivial defsc component to a dom element. FIXME: Tests currently don't run due to problems with accessing `js/ReactDOMServer` * Dev support - shadow-powered dev repl Add :dev profile to deps, and shadow-cljs config to build the code and serve a page with it. The entrypoint is `dev/development.cljs`. See Readme. This makes it easy to interactively develop and test SCI configs. * Replace ana/error with a fn, not to bloat output size --- .gitignore | 3 + README.md | 13 + bb.edn | 5 +- deps.edn | 6 +- dev/development.cljs | 40 ++ shadow-cljs.edn | 12 + .../fulcro/algorithms/data_targeting.cljs | 8 + .../fulcro/algorithms/denormalize.cljs | 9 + .../configs/fulcro/algorithms/form_state.cljs | 8 + src/sci/configs/fulcro/algorithms/lookup.cljs | 9 + src/sci/configs/fulcro/algorithms/merge.cljs | 9 + .../configs/fulcro/algorithms/normalize.cljs | 9 + .../fulcro/algorithms/react_interop.cljs | 8 + src/sci/configs/fulcro/algorithms/tempid.cljs | 8 + .../synchronous_tx_processing.cljs | 18 + src/sci/configs/fulcro/application.cljs | 9 + src/sci/configs/fulcro/component.cljs | 349 ++++++++++++++++++ src/sci/configs/fulcro/data_fetch.cljs | 10 + src/sci/configs/fulcro/dom.cljs | 16 + src/sci/configs/fulcro/fulcro.cljs | 76 ++++ .../configs/fulcro/fulcro_sci_helpers.cljs | 11 + src/sci/configs/fulcro/mutations.cljs | 70 ++++ .../fulcro/networking/http_remote.cljs | 8 + src/sci/configs/fulcro/raw/component.cljs | 30 ++ src/sci/configs/fulcro/react/hooks.cljs | 36 ++ src/sci/configs/fulcro/react/version18.cljs | 8 + .../fulcro/routing/dynamic_routing.cljs | 89 +++++ src/sci/configs/fulcro/ui_state_machines.cljs | 17 + test/fulcro/fulcro_test.cljs | 26 ++ www/index.html | 13 + 30 files changed, 931 insertions(+), 2 deletions(-) create mode 100644 dev/development.cljs create mode 100644 shadow-cljs.edn create mode 100644 src/sci/configs/fulcro/algorithms/data_targeting.cljs create mode 100644 src/sci/configs/fulcro/algorithms/denormalize.cljs create mode 100644 src/sci/configs/fulcro/algorithms/form_state.cljs create mode 100644 src/sci/configs/fulcro/algorithms/lookup.cljs create mode 100644 src/sci/configs/fulcro/algorithms/merge.cljs create mode 100644 src/sci/configs/fulcro/algorithms/normalize.cljs create mode 100644 src/sci/configs/fulcro/algorithms/react_interop.cljs create mode 100644 src/sci/configs/fulcro/algorithms/tempid.cljs create mode 100644 src/sci/configs/fulcro/algorithms/tx_processing/synchronous_tx_processing.cljs create mode 100644 src/sci/configs/fulcro/application.cljs create mode 100644 src/sci/configs/fulcro/component.cljs create mode 100644 src/sci/configs/fulcro/data_fetch.cljs create mode 100644 src/sci/configs/fulcro/dom.cljs create mode 100644 src/sci/configs/fulcro/fulcro.cljs create mode 100644 src/sci/configs/fulcro/fulcro_sci_helpers.cljs create mode 100644 src/sci/configs/fulcro/mutations.cljs create mode 100644 src/sci/configs/fulcro/networking/http_remote.cljs create mode 100644 src/sci/configs/fulcro/raw/component.cljs create mode 100644 src/sci/configs/fulcro/react/hooks.cljs create mode 100644 src/sci/configs/fulcro/react/version18.cljs create mode 100644 src/sci/configs/fulcro/routing/dynamic_routing.cljs create mode 100644 src/sci/configs/fulcro/ui_state_machines.cljs create mode 100644 test/fulcro/fulcro_test.cljs create mode 100644 www/index.html diff --git a/.gitignore b/.gitignore index d71cf99..0fb37fc 100644 --- a/.gitignore +++ b/.gitignore @@ -5,3 +5,6 @@ .cpcache cljs-test-runner-out node_modules +www/js/ +.calva/ +.portal/ diff --git a/README.md b/README.md index 78bde73..ded851f 100644 --- a/README.md +++ b/README.md @@ -50,6 +50,15 @@ Public API: - `js-interop-namespace` - `namespaces` +### [com.fulcrologic/fulcro](https://github.com/fulcro/fulcro) + +Namespace: `sci.configs.fulcro.fulcro` + +Public API: + +- `config` +- `namespaces` + ### [funcool/promesa](https://github.com/funcool/promesa) Namespace: `sci.configs.funcool.promesa` @@ -141,6 +150,10 @@ New functions added to clojure.core in version 1.11 `npm install` and `bb test` +### Development + +You can play with your SCI code and configs in a cljs REPL. In Calva, run Jack-in to a shadow-cljs repl and choose the `:dev` build. Elsewhere, run `bb dev` and then connect to its nrepl at port 9000. Access the web page that Shadow serves at http://localhost:8081/ and then eval your code using `development.cljs`. + ## License The configurations are licensed under the same licenses as the libraries they diff --git a/bb.edn b/bb.edn index 4cc233e..71899f0 100644 --- a/bb.edn +++ b/bb.edn @@ -1,4 +1,7 @@ {:tasks {cljs-repl (shell "clj -M:test -m cljs.main -re node") test (clojure "-M:test:cljs-test-runner") - test:advanced (clojure "-M:test:cljs-test-runner:cljs-test-runner-advanced")}} + test:advanced (clojure "-M:test:cljs-test-runner:cljs-test-runner-advanced") + dev (clojure "-M:test:dev:shadow-cli watch dev") + dev:release (clojure "-M:test:dev:shadow-cli release dev") + dev:release:debug (clojure "-M:test:dev:shadow-cli release dev --debug")}} diff --git a/deps.edn b/deps.edn index 58e6f2a..b0879cd 100644 --- a/deps.edn +++ b/deps.edn @@ -1,8 +1,12 @@ -{:aliases {:test {:extra-paths ["test"] +{:aliases {:dev {:extra-paths ["dev"] + :extra-deps {thheller/shadow-cljs {:mvn/version "2.25.7"}}} + :shadow-cli {:main-opts ["-m" "shadow.cljs.devtools.cli"]} + :test {:extra-paths ["test"] :extra-deps {org.babashka/sci {:git/url "https://github.com/babashka/sci" :git/sha "987910fb38fdd166865458c3fd4b468a22fb9992"} org.clojure/clojurescript {:mvn/version "1.11.51"} applied-science/js-interop {:mvn/version "0.3.3"} + com.fulcrologic/fulcro {:mvn/version "3.6.10"} funcool/promesa {:git/url "https://github.com/funcool/promesa" :git/sha "e503874b154224ce85b223144e80b697df91d18e"} reagent/reagent {:mvn/version "1.1.0"} diff --git a/dev/development.cljs b/dev/development.cljs new file mode 100644 index 0000000..3fbc6d2 --- /dev/null +++ b/dev/development.cljs @@ -0,0 +1,40 @@ +(ns development + "Entry point for code loaded by shadow-cljs" + (:require + [sci.core :as sci] + [sci.configs.fulcro.fulcro :as fulcro-config])) + +;; Necessary to avoid the error 'Attempting to call unbound fn: #'clojure.core/*print-fn*' +;; when calling `println` inside the evaluated code +(enable-console-print!) +(sci/alter-var-root sci/print-fn (constantly *print-fn*)) +(sci/alter-var-root sci/print-err-fn (constantly *print-err-fn*)) + +(def full-ctx (doto (sci/init {}) + (sci/merge-opts fulcro-config/config))) + +(defn init [] + (println "Init run")) + +(defn reload [] + (println "Reload run")) + +(comment + (sci/eval-string* (sci/init {}) "(+ 1 2)") + + (sci/eval-string* full-ctx " +(ns test1 + (:require + [com.fulcrologic.fulcro.algorithms.denormalize :as fdn] + [com.fulcrologic.fulcro.application :as app] + [com.fulcrologic.fulcro.components :as comp :refer [defsc]] + [com.fulcrologic.fulcro.dom :as dom])) + +(defsc Root [this props] (dom/h3 \"Hello from Fulcro!\")) +(defn build-ui-tree [] + (let [client-db (comp/get-initial-state Root {})] + (fdn/db->tree (comp/get-query Root client-db) client-db client-db))) +(comp/with-parent-context (app/fulcro-app) + (dom/render-to-str ((comp/factory Root) (build-ui-tree)))) +") + ,) diff --git a/shadow-cljs.edn b/shadow-cljs.edn new file mode 100644 index 0000000..675345e --- /dev/null +++ b/shadow-cljs.edn @@ -0,0 +1,12 @@ +{:deps {:aliases [:test :dev]} + :nrepl {:port 9000} + :dev-http {8081 "www"} + :builds {:dev {:compiler-options {:output-feature-set :es8 + :optimizations :advanced + :source-map true + :output-wrapper false} + :target :browser + :output-dir "www/js/dev" + :asset-path "/js/dev" + :modules {:dev {:init-fn development/init}} + :devtools {:after-load development/reload}}}} diff --git a/src/sci/configs/fulcro/algorithms/data_targeting.cljs b/src/sci/configs/fulcro/algorithms/data_targeting.cljs new file mode 100644 index 0000000..50edaf1 --- /dev/null +++ b/src/sci/configs/fulcro/algorithms/data_targeting.cljs @@ -0,0 +1,8 @@ +(ns sci.configs.fulcro.algorithms.data-targeting + (:require [sci.core :as sci] + [com.fulcrologic.fulcro.algorithms.data-targeting])) + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.data-targeting)) +(def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.data-targeting sci-ns)) + +(def namespaces {'com.fulcrologic.fulcro.algorithms.data-targeting ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/algorithms/denormalize.cljs b/src/sci/configs/fulcro/algorithms/denormalize.cljs new file mode 100644 index 0000000..9afd502 --- /dev/null +++ b/src/sci/configs/fulcro/algorithms/denormalize.cljs @@ -0,0 +1,9 @@ +(ns sci.configs.fulcro.algorithms.denormalize + (:require + [sci.core :as sci] + com.fulcrologic.fulcro.algorithms.denormalize)) + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.denormalize)) +(def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.denormalize sci-ns)) + +(def namespaces {'com.fulcrologic.fulcro.algorithms.denormalize ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/algorithms/form_state.cljs b/src/sci/configs/fulcro/algorithms/form_state.cljs new file mode 100644 index 0000000..34db1bc --- /dev/null +++ b/src/sci/configs/fulcro/algorithms/form_state.cljs @@ -0,0 +1,8 @@ +(ns sci.configs.fulcro.algorithms.form-state + (:require [sci.core :as sci] + com.fulcrologic.fulcro.algorithms.form-state)) + + (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.form-state)) + (def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.form-state sci-ns)) + + (def namespaces {'com.fulcrologic.fulcro.algorithms.form-state ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/algorithms/lookup.cljs b/src/sci/configs/fulcro/algorithms/lookup.cljs new file mode 100644 index 0000000..4882de8 --- /dev/null +++ b/src/sci/configs/fulcro/algorithms/lookup.cljs @@ -0,0 +1,9 @@ +(ns sci.configs.fulcro.algorithms.lookup + (:require [sci.core :as sci] + com.fulcrologic.fulcro.algorithms.lookup)) + + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.lookup)) +(def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.lookup sci-ns)) + +(def namespaces {'com.fulcrologic.fulcro.algorithms.lookup ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/algorithms/merge.cljs b/src/sci/configs/fulcro/algorithms/merge.cljs new file mode 100644 index 0000000..d95ba10 --- /dev/null +++ b/src/sci/configs/fulcro/algorithms/merge.cljs @@ -0,0 +1,9 @@ +(ns sci.configs.fulcro.algorithms.merge + (:require + [sci.core :as sci] + com.fulcrologic.fulcro.algorithms.merge)) + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.merge)) +(def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.merge sci-ns)) + +(def namespaces {'com.fulcrologic.fulcro.algorithms.merge ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/algorithms/normalize.cljs b/src/sci/configs/fulcro/algorithms/normalize.cljs new file mode 100644 index 0000000..552086c --- /dev/null +++ b/src/sci/configs/fulcro/algorithms/normalize.cljs @@ -0,0 +1,9 @@ +(ns sci.configs.fulcro.algorithms.normalize + (:require [sci.core :as sci] + com.fulcrologic.fulcro.algorithms.normalize)) + + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.normalize)) +(def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.normalize sci-ns)) + +(def namespaces {'com.fulcrologic.fulcro.algorithms.normalize ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/algorithms/react_interop.cljs b/src/sci/configs/fulcro/algorithms/react_interop.cljs new file mode 100644 index 0000000..f375886 --- /dev/null +++ b/src/sci/configs/fulcro/algorithms/react_interop.cljs @@ -0,0 +1,8 @@ +(ns sci.configs.fulcro.algorithms.react-interop + (:require [sci.core :as sci] + com.fulcrologic.fulcro.algorithms.react-interop)) + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.react-interop)) +(def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.react-interop sci-ns)) + +(def namespaces {'com.fulcrologic.fulcro.algorithms.react-interop ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/algorithms/tempid.cljs b/src/sci/configs/fulcro/algorithms/tempid.cljs new file mode 100644 index 0000000..3fc7b08 --- /dev/null +++ b/src/sci/configs/fulcro/algorithms/tempid.cljs @@ -0,0 +1,8 @@ +(ns sci.configs.fulcro.algorithms.tempid + (:require [sci.core :as sci] + com.fulcrologic.fulcro.algorithms.tempid)) + + (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.tempid)) + (def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.tempid sci-ns)) + + (def namespaces {'com.fulcrologic.fulcro.algorithms.tempid ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/algorithms/tx_processing/synchronous_tx_processing.cljs b/src/sci/configs/fulcro/algorithms/tx_processing/synchronous_tx_processing.cljs new file mode 100644 index 0000000..2ac2893 --- /dev/null +++ b/src/sci/configs/fulcro/algorithms/tx_processing/synchronous_tx_processing.cljs @@ -0,0 +1,18 @@ +(ns sci.configs.fulcro.algorithms.tx-processing.synchronous-tx-processing + (:require [sci.core :as sci] + [com.fulcrologic.fulcro.algorithms.tx-processing.synchronous-tx-processing :as stx])) + + (defn ^:sci/macro in-transaction [_&form _&env app-sym & body] + `(let [id# (:com.fulcrologic.fulcro.application/id ~app-sym)] + (swap! stx/apps-in-tx update id# conj (stx/current-thread-id)) + (try + ~@body + (finally + (swap! apps-in-tx update id# pop))))) + + (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.tx-processing.synchronous-tx-processing)) + (def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.algorithms.tx-processing.synchronous-tx-processing sci-ns + {:exclude [in-transaction]}) + 'in-transaction (sci/copy-var in-transaction sci-ns))) + + (def namespaces {'com.fulcrologic.fulcro.algorithms.tx-processing.synchronous-tx-processing ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/application.cljs b/src/sci/configs/fulcro/application.cljs new file mode 100644 index 0000000..7da3cc8 --- /dev/null +++ b/src/sci/configs/fulcro/application.cljs @@ -0,0 +1,9 @@ +(ns sci.configs.fulcro.application + (:require + [sci.core :as sci] + [com.fulcrologic.fulcro.application])) + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.application)) +(def ns-def (sci/copy-ns com.fulcrologic.fulcro.application sci-ns)) + +(def namespaces {'com.fulcrologic.fulcro.application ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/component.cljs b/src/sci/configs/fulcro/component.cljs new file mode 100644 index 0000000..9b026e0 --- /dev/null +++ b/src/sci/configs/fulcro/component.cljs @@ -0,0 +1,349 @@ +(ns sci.configs.fulcro.component + (:require + [cljs.spec.alpha :as s] + [clojure.set :as set] + [clojure.walk :refer [prewalk]] + [edn-query-language.core :as eql] + [sci.core :as sci] + [com.fulcrologic.fulcro.components :as comp] + [com.fulcrologic.fulcro.algorithms.do-not-use :as util] + [sci.configs.fulcro.fulcro-sci-helpers :as ana])) + +(def cljs? (constantly true)) ; was `(:ns &env)` but sci's &env lacks :ns + +(defn with-parent-context-fn + [parent body-fn] + (let [app (or comp/*app* (comp/any->app parent)) + s (comp/shared app) + p (or comp/*parent* parent)] + (binding [comp/*app* app + comp/*shared* s + comp/*parent* p] + (body-fn)))) + +(defn ^:sci/macro with-parent-context + [_&form &env outer-parent & body] + (if-not (cljs? &env) ; was (:ns &env) + `(do ~@body) + ;; Re-written to move the core into a separate fn, so that `binding` happens + ;; there and not in code that SCI needs to evaluate, which has its complexities + `(with-parent-context-fn ~outer-parent (fn [] ~@body)))) + +(defn- is-link? + "Returns true if the given query element is a link query like [:x '_]." + [query-element] (and (vector? query-element) + (keyword? (first query-element)) + ; need the double-quote because when in a macro we'll get the literal quote. ; TODO is this true for SCI ?! + (#{''_ '_} (second query-element)))) + +(defn- children-by-prop ; TODO clj-only in Fulcro proper, but could be for cljs too?! + "Part of Defsc macro implementation. Calculates a map from join key to class (symbol)." + [query] + (into {} + (keep #(if (and (map? %) (or (is-link? (ffirst %)) (keyword? (ffirst %)))) + (let [k (if (vector? (ffirst %)) + (first (ffirst %)) + (ffirst %)) + cls (-> % first second second)] + [k cls]) + nil) query))) + +(defn- replace-and-validate-fn ; TODO clj-only in Fulcro proper, but could be for cljs too?! + "Replace the first sym in a list (the function name) with the given symbol. + + env - the macro &env + sym - The symbol that the lambda should have + external-args - A sequence of arguments that the user should not include, but that you want to be inserted in the external-args by this function. + user-arity - The number of external-args the user should supply (resulting user-arity is (count external-args) + user-arity). + fn-form - The form to rewrite + sym - The symbol to report in the error message (in case the rewrite uses a different target that the user knows)." + ([env sym external-args user-arity fn-form] (replace-and-validate-fn env sym external-args user-arity fn-form sym)) + ([env sym external-args user-arity fn-form user-known-sym] + (when-not (<= user-arity (count (second fn-form))) + (throw (ana/error (merge env (meta fn-form)) (str "Invalid arity for " user-known-sym ". Expected " user-arity " or more.")))) + (let [user-args (second fn-form) + updated-args (into (vec (or external-args [])) user-args) + body-forms (drop 2 fn-form)] + (->> body-forms + (cons updated-args) + (cons sym) + (cons 'fn))))) + +(defn- build-ident ; TODO clj-only in Fulcro proper, but could be for cljs too?! + "Builds the ident form. If ident is a vector, then it generates the function and validates that the ID is + in the query. Otherwise, if ident is of the form (ident [this props] ...) it simply generates the correct + entry in defsc without error checking." + [env thissym propsarg {:keys [method template keyword]} is-legal-key?] + (cond + keyword (if (is-legal-key? keyword) + `(~'fn ~'ident* [~'_ ~'props] [~keyword (~keyword ~'props)]) + (throw (ana/error (merge env (meta template)) (str "The table/id " keyword " of :ident does not appear in your :query")))) + method (replace-and-validate-fn env 'ident* [thissym propsarg] 0 method) + template (let [table (first template) + id-prop (or (second template) :db/id)] + (cond + (nil? table) (throw (ana/error (merge env (meta template)) "TABLE part of ident template was nil" {})) + (not (is-legal-key? id-prop)) (throw (ana/error (merge env (meta template)) (str "The ID property " id-prop " of :ident does not appear in your :query"))) + :otherwise `(~'fn ~'ident* [~'this ~'props] [~table (~id-prop ~'props)]))))) + +(defn- build-render [classsym thissym propsym compsym extended-args-sym body] ; TODO clj-only in Fulcro proper, but could be for cljs too?! + (let [computed-bindings (when compsym `[~compsym (com.fulcrologic.fulcro.components/get-computed ~thissym)]) + extended-bindings (when extended-args-sym `[~extended-args-sym (com.fulcrologic.fulcro.components/get-extra-props ~thissym)]) + render-fn (symbol (str "render-" (name classsym)))] + `(~'fn ~render-fn [~thissym] + (com.fulcrologic.fulcro.components/wrapped-render ~thissym + (fn [] + (let [~propsym (com.fulcrologic.fulcro.components/props ~thissym) + ~@computed-bindings + ~@extended-bindings] + ~@body)))))) + +(defn- build-hooks-render [classsym thissym propsym compsym extended-args-sym body] ; TODO clj-only in Fulcro proper, but could be for cljs too?! + (let [computed-bindings (when compsym `[~compsym (com.fulcrologic.fulcro.components/get-computed ~thissym)]) + extended-bindings (when extended-args-sym `[~extended-args-sym (com.fulcrologic.fulcro.components/get-extra-props ~thissym)]) + render-fn (symbol (str "render-" (name classsym)))] + `(~'fn ~render-fn [~thissym ~propsym] + (com.fulcrologic.fulcro.components/wrapped-render ~thissym + (fn [] + (binding [comp/*app* (or comp/*app* (comp/isoget-in ~thissym ["props" "fulcro$app"])) + comp/*shared* (comp/shared (or comp/*app* (comp/isoget-in ~thissym ["props" "fulcro$app"]))) + comp/*parent* ~thissym] + (let [~@computed-bindings + ~@extended-bindings] + ~@body))))))) + +(defn- build-and-validate-initial-state-map [env sym initial-state legal-keys children-by-query-key] + (let [env (merge env (meta initial-state)) + join-keys (set (keys children-by-query-key)) + init-keys (set (keys initial-state)) + illegal-keys (if (set? legal-keys) (set/difference init-keys legal-keys) #{}) + is-child? (fn [k] (contains? join-keys k)) + param-expr (fn [v] + (if-let [kw (and (keyword? v) (= "param" (namespace v)) + (keyword (name v)))] + `(~kw ~'params) + v)) + parameterized (fn [init-map] (into {} (map (fn [[k v]] (if-let [expr (param-expr v)] [k expr] [k v])) init-map))) + child-state (fn [k] + (let [state-params (get initial-state k) + to-one? (map? state-params) + to-many? (and (vector? state-params) (every? map? state-params)) + code? (list? state-params) + from-parameter? (and (keyword? state-params) (= "param" (namespace state-params))) + child-class (get children-by-query-key k)] + (when code? + (throw (ana/error env (str "defsc " sym ": Illegal parameters to :initial-state " state-params ". Use a lambda if you want to write code for initial state. Template mode for initial state requires simple maps (or vectors of maps) as parameters to children. See Developer's Guide.")))) + (cond + (not (or from-parameter? to-many? to-one?)) (throw (ana/error env (str "Initial value for a child (" k ") must be a map or vector of maps!"))) + to-one? `(com.fulcrologic.fulcro.components/get-initial-state ~child-class ~(parameterized state-params)) + to-many? (mapv (fn [params] + `(com.fulcrologic.fulcro.components/get-initial-state ~child-class ~(parameterized params))) + state-params) + from-parameter? `(com.fulcrologic.fulcro.components/get-initial-state ~child-class ~(param-expr state-params)) + :otherwise nil))) + kv-pairs (map (fn [k] + [k (if (is-child? k) + (child-state k) + (param-expr (get initial-state k)))]) init-keys) + state-map (into {} kv-pairs)] + (when (seq illegal-keys) + (throw (ana/error env (str "Initial state includes keys " illegal-keys ", but they are not in your query.")))) + `(~'fn ~'build-initial-state* [~'params] (com.fulcrologic.fulcro.components/make-state-map ~initial-state ~children-by-query-key ~'params)))) + +(defn- build-raw-initial-state ; TODO clj-only in Fulcro proper, but could be for cljs too?! + "Given an initial state form that is a list (function-form), simple copy it into the form needed by defsc." + [env method] + (replace-and-validate-fn env 'build-raw-initial-state* [] 1 method)) + +(defn- build-initial-state [env sym {:keys [template method]} legal-keys query-template-or-method] ; TODO clj-only in Fulcro proper, but could be for cljs too?! + (when (and template (contains? query-template-or-method :method)) + (throw (ana/error (merge env (meta template)) (str "When query is a method, initial state MUST be as well.")))) + (cond + method (build-raw-initial-state env method) + template (let [query (:template query-template-or-method) + children (or (children-by-prop query) {})] + (build-and-validate-initial-state-map env sym template legal-keys children)))) + +(defn -legal-keys ; TODO clj-only in Fulcro proper, but could be for cljs too?! + "PRIVATE. Find the legal keys in a query. NOTE: This is at compile time, so the get-query calls are still embedded (thus cannot + use the AST)" + [query] + (letfn [(keeper [ele] + (cond + (list? ele) (recur (first ele)) + (keyword? ele) ele + (is-link? ele) (first ele) + (and (map? ele) (keyword? (ffirst ele))) (ffirst ele) + (and (map? ele) (is-link? (ffirst ele))) (first (ffirst ele)) + :else nil))] + (set (keep keeper query)))) + +(defn- component-query [query-part] ; TODO clj-only in Fulcro proper, but could be for cljs too?! + (and (list? query-part) + (symbol? (first query-part)) + (= "get-query" (name (first query-part))) + query-part)) + +(defn- compile-time-query->checkable ; TODO clj-only in Fulcro proper, but could be for cljs too?! (only Throwable <> :default) + "Try to simplify the compile-time query (as seen by the macro) + to something that EQL can check (`(get-query ..)` => a made-up vector). + Returns nil if this is not possible." + [query] + (try + (prewalk + (fn [form] + (cond + (component-query form) + [(keyword (str "subquery-of-" (some-> form second name)))] + + ;; Replace idents with idents that contain only keywords, so syms don't trip us up + (and (vector? form) (= 2 (count form))) + (mapv #(if (symbol? %) :placeholder %) form) + + (symbol? form) + (throw (ex-info "Cannot proceed, the query contains a symbol" {:sym form})) + + :else + form)) + query) + (catch :default _ ; Changed - was Throwable + nil))) + +(defn- check-query-looks-valid [err-env comp-class compile-time-query] ; TODO clj-only in Fulcro proper, but could be for cljs too?! + (let [checkable-query (compile-time-query->checkable compile-time-query)] + (when (false? (some->> checkable-query (s/valid? ::eql/query))) + (let [{:clojure.spec.alpha/keys [problems]} (s/explain-data ::eql/query checkable-query) + {:keys [in]} (first problems)] + (when (vector? in) + (throw (ana/error err-env (str "The element '" (get-in compile-time-query in) "' of the query of " comp-class " is not valid EQL")))))))) + + +(defn- build-query-forms ; TODO clj-only in Fulcro proper, but could be for cljs too?! + "Validate that the property destructuring and query make sense with each other." + [env class thissym propargs {:keys [template method]}] + (cond + template + (do + (assert (or (symbol? propargs) (map? propargs)) "Property args must be a symbol or destructuring expression.") + (let [to-keyword (fn [s] (cond + (nil? s) nil + (keyword? s) s + :otherwise (let [nspc (namespace s) + nm (name s)] + (keyword nspc nm)))) + destructured-keywords (when (map? propargs) (util/destructured-keys propargs)) + queried-keywords (-legal-keys template) + has-wildcard? (some #{'*} template) + to-sym (fn [k] (symbol (namespace k) (name k))) + illegal-syms (mapv to-sym (set/difference destructured-keywords queried-keywords)) + err-env (merge env (meta template))] + (when-let [child-query (some component-query template)] + (throw (ana/error err-env (str "defsc " class ": `get-query` calls in :query can only be inside a join value, i.e. `{:some/key " child-query "}`")))) + (when (and (not has-wildcard?) (seq illegal-syms)) + (throw (ana/error err-env (str "defsc " class ": " illegal-syms " was destructured in props, but does not appear in the :query!")))) + `(~'fn ~'query* [~thissym] ~template))) + method + (replace-and-validate-fn env 'query* [thissym] 0 method))) + +;; Copied b/c they are :clj only in the orig ns +(s/def ::ident (s/or :template (s/and vector? #(= 2 (count %))) :method list? :keyword keyword?)) +(s/def ::query (s/or :template vector? :method list?)) +(s/def ::initial-state (s/or :template map? :method list?)) +(s/def ::options (s/keys :opt-un [::query ::ident ::initial-state])) +(s/def ::args (s/cat + :sym symbol? + :doc (s/? string?) + :arglist (s/and vector? #(<= 2 (count %) 5)) + :options (s/? map?) + :body (s/* any?))) + +(defn defsc* + [env args] + (when-not (s/valid? ::args args) + (throw (ana/error env (str "Invalid arguments. " (-> (s/explain-data ::args args) + ::s/problems + first + :path) " is invalid.")))) + (let [{:keys [sym doc arglist options body]} (s/conform ::args args) + [thissym propsym computedsym extra-args] arglist + _ (when (and options (not (s/valid? ::options options))) + (let [path (-> (s/explain-data ::options options) ::s/problems first :path) + message (cond + (= path [:query :template]) "The query template only supports vectors as queries. Unions or expression require the lambda form." + (= :ident (first path)) "The ident must be a keyword, 2-vector, or lambda of no arguments." + :else "Invalid component options. Please check to make\nsure your query, ident, and initial state are correct.")] + (throw (ana/error env message)))) + {:keys [ident query initial-state]} (s/conform ::options options) + body (or body ['nil]) + ident-template-or-method (into {} [ident]) ;clojure spec returns a map entry as a vector + initial-state-template-or-method (into {} [initial-state]) + query-template-or-method (into {} [query]) + validate-query? (and (:template query-template-or-method) (not (some #{'*} (:template query-template-or-method)))) + legal-key-checker (if validate-query? + (or (-legal-keys (:template query-template-or-method)) #{}) + (complement #{})) + ident-form (build-ident env thissym propsym ident-template-or-method legal-key-checker) + state-form (build-initial-state env sym initial-state-template-or-method legal-key-checker query-template-or-method) + query-form (build-query-forms env sym thissym propsym query-template-or-method) + _ (when validate-query? + ;; after build-query-forms as it also does some useful checks + (check-query-looks-valid env sym (:template query-template-or-method))) + hooks? (and (cljs? env) (:use-hooks? options)) + render-form (if hooks? + (build-hooks-render sym thissym propsym computedsym extra-args body) + (build-render sym thissym propsym computedsym extra-args body)) + nspc (if (cljs? env) (-> env :ns :name str) (name (ns-name *ns*))) + fqkw (keyword (str nspc) (name sym)) + options-map (cond-> options + state-form (assoc :initial-state state-form) + ident-form (assoc :ident ident-form) + query-form (assoc :query query-form) + hooks? (assoc :componentName fqkw) + render-form (assoc :render render-form))] + (cond + hooks? + `(do + (defonce ~sym + (fn [js-props#] + (let [render# (:render (comp/component-options ~sym)) + [this# props#] (comp/use-fulcro js-props# ~sym)] + (render# this# props#)))) + (comp/add-hook-options! ~sym ~options-map)) + + (cljs? env) + `(do + (declare ~sym) + (let [options# ~options-map] + (def ~(vary-meta sym assoc :doc doc :jsdoc ["@constructor"]) ; JH: BEWARE `defonce` will prevent changes in :advanced optimiz. + (comp/react-constructor (get options# :initLocalState))) + (com.fulcrologic.fulcro.components/configure-component! ~sym ~fqkw options#))) + + :else + `(do + (declare ~sym) + (let [options# ~options-map] + (def ~(vary-meta sym assoc :doc doc :once true) + (com.fulcrologic.fulcro.components/configure-component! ~(str sym) ~fqkw options#))))))) + +(defn ^:sci/macro defsc [_&form &env & args] + (try + ;; Note: In cljs, env would have `:ns` but not so in SCI, yet Fulcro looks at it => add + (let [ns-name (some->> sci.core/ns deref str) + fake-ns (when (seq ns-name) {:name ns-name})] + (defsc* (assoc &env :ns fake-ns) args)) + (catch :default e + (if (contains? (ex-data e) :tag) + (throw e) + (throw (ex-info "Unexpected internal error while processing defsc. Please check your syntax." {} e)))))) + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.components)) +(def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.components sci-ns {:exclude [with-parent-context defsc defsc*]}) + 'with-parent-context (sci/copy-var with-parent-context sci-ns) + 'defsc* (sci/copy-var defsc* sci-ns) + 'defsc (sci/copy-var defsc sci-ns))) + +(def sci-ns2 (sci/create-ns 'sci.configs.fulcro.component)) +(def ns-def2 {'with-parent-context-fn (sci/copy-var with-parent-context-fn sci-ns2)}) + +(def namespaces {'com.fulcrologic.fulcro.components ns-def + 'sci.configs.fulcro.component ns-def2}) diff --git a/src/sci/configs/fulcro/data_fetch.cljs b/src/sci/configs/fulcro/data_fetch.cljs new file mode 100644 index 0000000..3778a91 --- /dev/null +++ b/src/sci/configs/fulcro/data_fetch.cljs @@ -0,0 +1,10 @@ +(ns sci.configs.fulcro.data-fetch + (:require + [sci.core :as sci] + com.fulcrologic.fulcro.data-fetch)) + + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.data-fetch)) +(def ns-def (sci/copy-ns com.fulcrologic.fulcro.data-fetch sci-ns {:exclude ['render-to-str]})) + +(def namespaces {'com.fulcrologic.fulcro.data-fetch ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/dom.cljs b/src/sci/configs/fulcro/dom.cljs new file mode 100644 index 0000000..018ce32 --- /dev/null +++ b/src/sci/configs/fulcro/dom.cljs @@ -0,0 +1,16 @@ +(ns sci.configs.fulcro.dom + (:require + [sci.core :as sci] + com.fulcrologic.fulcro.dom + ["react-dom/server" :as react-dom-server])) + +(defn render-to-str [e] + ;; Re-write to use react-dom-server instead of relying on js/ReactDOMServer, + ;; which I don't know how to get hold of in the SCI context. + (react-dom-server/renderToString e)) + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.dom)) +(def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.dom sci-ns {:exclude ['render-to-str]}) + 'render-to-str (sci/copy-var render-to-str sci-ns))) + +(def namespaces {'com.fulcrologic.fulcro.dom ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/fulcro.cljs b/src/sci/configs/fulcro/fulcro.cljs new file mode 100644 index 0000000..aecbf38 --- /dev/null +++ b/src/sci/configs/fulcro/fulcro.cljs @@ -0,0 +1,76 @@ +(ns sci.configs.fulcro.fulcro + "The root of all SCI configuration for Fulcro. + + == Example + + ```clj + (ns demo + (:require [sci.core :as sci] + [sci.configs.fulcro.fulcro :as fulcro])) + (def sci-ctx (doto (sci/init {}) (sci/merge-opts fulcro/config))) + (sci/eval-string* sci-ctx + \"(ns page + (:require + [com.fulcrologic.fulcro.application :as app] + [com.fulcrologic.fulcro.components :as comp :refer [defsc]] + [com.fulcrologic.fulcro.dom :as dom])) + (defsc Root [this props] (dom/h3 \\\"Hello from Fulcro!\\\")) + (let [app (app/fulcro-app {})] + (app/mount! app Root \\\"sciapp\\\"))\") + ``` + + == Status + + Early alpha. Many namespaces aren't exposed yet, and there are certainly + bugs in how macros were ported to SCI." + (:require [sci.configs.fulcro.algorithms.data-targeting :as dt] + [sci.configs.fulcro.algorithms.denormalize :as fdn] + [sci.configs.fulcro.algorithms.form-state :as fs] + [sci.configs.fulcro.algorithms.lookup :as ah] + [sci.configs.fulcro.algorithms.merge :as merge] + [sci.configs.fulcro.algorithms.normalize :as fnorm] + [sci.configs.fulcro.algorithms.react-interop :as interop] + [sci.configs.fulcro.algorithms.tempid :as tempid] + [sci.configs.fulcro.algorithms.tx-processing.synchronous-tx-processing :as stx] + [sci.configs.fulcro.application :as app] + [sci.configs.fulcro.component :as comp] + [sci.configs.fulcro.data-fetch :as df] + [sci.configs.fulcro.dom :as dom] + [sci.configs.fulcro.mutations :as m] + [sci.configs.fulcro.networking.http-remote :as http-remote] + [sci.configs.fulcro.raw.component :as rc] + [sci.configs.fulcro.react.hooks :as hooks] + [sci.configs.fulcro.react.version18 :as version18] + [sci.configs.fulcro.routing.dynamic-routing :as dr] + [sci.configs.fulcro.ui-state-machines :as uism] + [sci.core :as sci] + [edn-query-language.core])) + +(def eql-sci-ns (sci/create-ns 'edn-query-language.core)) +(def eql-ns-def (sci/copy-ns edn-query-language.core eql-sci-ns {})) + +(def namespaces + (merge + {'edn-query-language.core eql-ns-def} + ah/namespaces + app/namespaces + comp/namespaces + df/namespaces + dom/namespaces + dr/namespaces + dt/namespaces + fdn/namespaces + fnorm/namespaces + fs/namespaces + http-remote/namespaces + interop/namespaces + merge/namespaces + m/namespaces + rc/namespaces + hooks/namespaces + stx/namespaces + tempid/namespaces + uism/namespaces + version18/namespaces)) + +(def config {:namespaces namespaces}) diff --git a/src/sci/configs/fulcro/fulcro_sci_helpers.cljs b/src/sci/configs/fulcro/fulcro_sci_helpers.cljs new file mode 100644 index 0000000..e93af55 --- /dev/null +++ b/src/sci/configs/fulcro/fulcro_sci_helpers.cljs @@ -0,0 +1,11 @@ +(ns sci.configs.fulcro.fulcro-sci-helpers) + +(defn error + "Replace cljs.analyzer/error so that we don't to pull in this huge dependency" + ([env msg] (error env msg nil)) + ([{:keys [line file] :as env} msg cause] + (ex-info (cond-> msg + line (str " at line " line) + file (str " in " file)) + env + cause))) \ No newline at end of file diff --git a/src/sci/configs/fulcro/mutations.cljs b/src/sci/configs/fulcro/mutations.cljs new file mode 100644 index 0000000..3d8a17b --- /dev/null +++ b/src/sci/configs/fulcro/mutations.cljs @@ -0,0 +1,70 @@ +(ns sci.configs.fulcro.mutations + (:require [sci.configs.fulcro.fulcro-sci-helpers :as ana] + [cljs.spec.alpha :as s] + [clojure.string :as str] + [sci.core :as sci] + [com.fulcrologic.fulcro.algorithms.lookup :as ah] + com.fulcrologic.fulcro.mutations)) + +(defn ^:sci/macro declare-mutation [_&form _&env name target-symbol] + `(def ~name (m/->Mutation '~target-symbol))) + +(s/def ::handler (s/cat + :handler-name symbol? + :handler-args (fn [a] (and (vector? a) (= 1 (count a)))) + :handler-body (s/+ (constantly true)))) + +(s/def ::mutation-args (s/cat + :sym symbol? + :doc (s/? string?) + :arglist (fn [a] (and (vector? a) (= 1 (count a)))) + :sections (s/* (s/or :handler ::handler)))) + +(defn ^:sci/macro defmutation [_&form macro-env args] + ;; Body of defmutation* + (let [conform! (fn [element spec value] + (when-not (s/valid? spec value) + (throw (ana/error macro-env (str "Syntax error in " element ": " (s/explain-str spec value))))) + (s/conform spec value)) + {:keys [sym doc arglist sections]} (conform! "defmutation" ::mutation-args args) + fqsym (if (namespace sym) + sym + (symbol (str (deref sci.core/ns)) #_(name (ns-name *ns*)) (name sym))) + handlers (reduce (fn [acc [_ {:keys [handler-name handler-args handler-body]}]] + (let [action? (str/ends-with? (str handler-name) "action")] + (into acc + (if action? + [(keyword (name handler-name)) `(fn ~handler-name ~handler-args + (binding [com.fulcrologic.fulcro.raw.components/*after-render* true] + ~@handler-body) + nil)] + [(keyword (name handler-name)) `(fn ~handler-name ~handler-args ~@handler-body)])))) + [] + sections) + ks (into #{} (filter keyword?) handlers) + result-action? (contains? ks :result-action) + env-symbol 'fulcro-mutation-env-symbol + method-map (if result-action? + `{~(first handlers) ~@(rest handlers)} + `{~(first handlers) ~@(rest handlers) + :result-action (fn [~'env] + (binding [com.fulcrologic.fulcro.raw.components/*after-render* true] + (when-let [~'default-action (ah/app-algorithm (:app ~'env) :default-result-action!)] + (~'default-action ~'env))))}) + doc (or doc "") + multimethod `(defmethod com.fulcrologic.fulcro.mutations/mutate '~fqsym [~env-symbol] + (let [~(first arglist) (-> ~env-symbol :ast :params)] + ~method-map))] + (if (= fqsym sym) + multimethod + `(do + (def ~(with-meta sym {:doc doc}) (com.fulcrologic.fulcro.mutations/->Mutation '~fqsym)) + ~multimethod)))) + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.mutations)) +(def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.mutations sci-ns + {:exclude [declare-mutation defmutation]}) + 'declare-mutation (sci/copy-var declare-mutation sci-ns) + 'defmutation (sci/copy-var defmutation sci-ns))) + +(def namespaces {'com.fulcrologic.fulcro.mutations ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/networking/http_remote.cljs b/src/sci/configs/fulcro/networking/http_remote.cljs new file mode 100644 index 0000000..4fe0134 --- /dev/null +++ b/src/sci/configs/fulcro/networking/http_remote.cljs @@ -0,0 +1,8 @@ +(ns sci.configs.fulcro.networking.http-remote + (:require [sci.core :as sci] + com.fulcrologic.fulcro.networking.http-remote)) + + (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.networking.http-remote)) + (def ns-def (sci/copy-ns com.fulcrologic.fulcro.networking.http-remote sci-ns)) + + (def namespaces {'com.fulcrologic.fulcro.networking.http-remote ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/raw/component.cljs b/src/sci/configs/fulcro/raw/component.cljs new file mode 100644 index 0000000..3325e57 --- /dev/null +++ b/src/sci/configs/fulcro/raw/component.cljs @@ -0,0 +1,30 @@ +(ns sci.configs.fulcro.raw.component + (:require + [sci.core :as sci] + [com.fulcrologic.fulcro.raw.components :as rc] + [taoensso.timbre :as log])) + +(defn ^:sci/macro defnc + ([_&form _&env sym query] (defnc _&form _&env sym query {})) + ([_&form _&env sym query options] + (let [nspc (some-> sci.core/ns deref str) + fqkw (keyword (str nspc) (name sym)) + ] + `(let [o# (dissoc (merge ~options {:componentName ~fqkw}) :ident :query) + ident# (:ident o#) + ident# (cond + (= :constant ident#) (fn [~'_ ~'_] [:Constant/id ~fqkw]) + (keyword? ident#) (fn [~'_ props#] [ident# (get props# ident#)]) + (or (nil? ident#) (fn? ident#)) ident# + :else (do + (log/error "corrupt ident on component " ~fqkw) + nil)) + o# (cond-> o# + ident# (assoc :ident ident#))] + (def ~sym (rc/nc ~query o#)))))) + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.raw.components)) +(def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.raw.components sci-ns {:exclude [defnc]}) + 'defnc (sci/copy-var defnc sci-ns))) + +(def namespaces {'com.fulcrologic.fulcro.raw.components ns-def}) diff --git a/src/sci/configs/fulcro/react/hooks.cljs b/src/sci/configs/fulcro/react/hooks.cljs new file mode 100644 index 0000000..6dc3625 --- /dev/null +++ b/src/sci/configs/fulcro/react/hooks.cljs @@ -0,0 +1,36 @@ +(ns sci.configs.fulcro.react.hooks + (:require [sci.core :as sci] + [com.fulcrologic.fulcro.react.hooks :as hooks]) + #_(:import (cljs.tagged_literals JSValue))) ; not avail. in cljs + +(defn ^:sci/macro use-effect + ([_&form _&env f] `(hooks/useEffect ~f)) + ([_&form _&env f dependencies] + (if true #_(enc/compiling-cljs?) + (let [deps (cond + (nil? dependencies) nil + ; JH: Not sure how to translate this to a sci/macro... + ;(instance? JSValue dependencies) dependencies + ;:else (JSValue. dependencies) + (instance? js/Array dependencies) dependencies + (sequential? dependencies) (into-array dependencies) + + :else dependencies)] + `(hooks/useEffect ~f ~deps)) + `(hooks/useEffect ~f ~dependencies)))) + +(defn ^:sci/macro use-lifecycle + ([_&form _&env setup] `(hooks/use-lifecycle &form &env ~setup nil)) + ([_&form _&env setup teardown] + (cond + (and setup teardown) `(hooks/use-effect (fn [] (~setup) ~teardown) []) + setup `(hooks/use-effect (fn [] (~setup) ~(when true #_(enc/compiling-cljs?) 'js/undefined)) []) + teardown `(hooks/use-effect (fn [] ~teardown) [])))) + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.react.hooks)) +(def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.react.hooks sci-ns + {:exclude [use-effect use-lifecycle]}) + 'use-effect (sci/copy-var use-effect sci-ns) + 'use-lifecycle (sci/copy-var use-lifecycle sci-ns))) + +(def namespaces {'com.fulcrologic.fulcro.react.hooks ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/react/version18.cljs b/src/sci/configs/fulcro/react/version18.cljs new file mode 100644 index 0000000..5491c9d --- /dev/null +++ b/src/sci/configs/fulcro/react/version18.cljs @@ -0,0 +1,8 @@ +(ns sci.configs.fulcro.react.version18 + (:require [sci.core :as sci] + com.fulcrologic.fulcro.react.version18)) + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.react.version18)) +(def ns-def (sci/copy-ns com.fulcrologic.fulcro.react.version18 sci-ns)) + +(def namespaces {'com.fulcrologic.fulcro.react.version18 ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/routing/dynamic_routing.cljs b/src/sci/configs/fulcro/routing/dynamic_routing.cljs new file mode 100644 index 0000000..8a3205a --- /dev/null +++ b/src/sci/configs/fulcro/routing/dynamic_routing.cljs @@ -0,0 +1,89 @@ +(ns sci.configs.fulcro.routing.dynamic-routing + (:require [sci.configs.fulcro.fulcro-sci-helpers :as ana] + [com.fulcrologic.fulcro.raw.components :as rc] + [com.fulcrologic.fulcro.routing.dynamic-routing :as dr] + [com.fulcrologic.fulcro.ui-state-machines :as uism] + [sci.core :as sci])) + +(defn compile-error [env form message] + (throw (ana/error (merge env (some-> form meta)) message))) + +(defn ^:sci/macro defrouter [_&form env router-sym arglist options & body] + (let [router-ns (str (deref sci.core/ns) #_(ns-name *ns*))] + ;; copied body of defrouter* + (when-not (and (vector? arglist) (= 2 (count arglist))) + (compile-error env options "defrouter argument list must have an entry for this and props.")) + (when-not (map? options) + (compile-error env options "defrouter requires a literal map of options.")) + #_(when-not (s/valid? ::defrouter-options options) ; JH - disabled spec check + (compile-error env options (str "defrouter options are invalid: " (s/explain-str ::defrouter-options options)))) + (let [{:keys [router-targets]} options + _ (when (empty? router-targets) + (compile-error env options "defrouter requires a vector of :router-targets with at least one target")) + id (keyword router-ns (name router-sym)) + getq (fn [s] `(or (rc/get-query ~s) + (throw (ex-info (str "Route target has no query! " + (rc/component-name ~s)) {})))) + query (into [::dr/id + [::uism/asm-id id] + ::dr/dynamic-router-targets + {::dr/current-route (getq (first router-targets))}] + (map-indexed + (fn [idx s] + (when (nil? s) + (compile-error env options "defrouter :target contains nil!")) + {(keyword (str "alt" idx)) (getq s)}) + (rest router-targets))) + initial-state-map (into {::dr/id id + ::dr/current-route `(rc/get-initial-state ~(first router-targets) ~'params)} + (map-indexed + (fn [idx s] [(keyword (str "alt" idx)) `(rc/get-initial-state ~s {})]) + (rest router-targets))) + ident-method (apply list `(fn [] [::dr/id ~id])) + initial-state-lambda (apply list `(fn [~'params] ~initial-state-map)) + states-to-render-route (if (seq body) + #{:routed :deferred} + `(constantly true)) + always-render-body? (and (map? options) (:always-render-body? options)) + render-cases (if always-render-body? + (apply list `(let [~'class (dr/current-route-class ~'this)] + (let [~(first arglist) ~'this + ~(second arglist) {:pending-path-segment ~'pending-path-segment + :route-props ~'current-route + :route-factory (when ~'class (comp/factory ~'class)) + :current-state ~'current-state + :router-state (get-in ~'props [[::uism/asm-id ~id] ::uism/local-storage])}] + ~@body))) + (apply list `(let [~'class (dr/current-route-class ~'this)] + (if (~states-to-render-route ~'current-state) + (when ~'class + (let [~'factory (comp/factory ~'class)] + (~'factory (rc/computed ~'current-route (rc/get-computed ~'this))))) + (let [~(first arglist) ~'this + ~(second arglist) {:pending-path-segment ~'pending-path-segment + :route-props ~'current-route + :route-factory (when ~'class (comp/factory ~'class)) + :current-state ~'current-state}] + ~@body))))) + options (merge + `{:componentDidMount (fn [this#] (dr/validate-route-targets this#))} + options + `{:query ~query + :ident ~ident-method + :use-hooks? false + :initial-state ~initial-state-lambda + :preserve-dynamic-query? true})] + `(comp/defsc ~router-sym [~'this {::dr/keys [~'id ~'current-route] :as ~'props}] + ~options + (let [~'current-state (uism/get-active-state ~'this ~id) + ~'state-map (comp/component->state-map ~'this) + ~'sm-env (uism/state-machine-env ~'state-map nil ~id :fake {}) + ~'pending-path-segment (when (uism/asm-active? ~'this ~id) (uism/retrieve ~'sm-env :pending-path-segment))] + ~render-cases))))) + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.routing.dynamic-routing)) +(def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.routing.dynamic-routing sci-ns + {:exclude [defrouter]}) + 'defrouter (sci/copy-var defrouter sci-ns) )) + +(def namespaces {'com.fulcrologic.fulcro.routing.dynamic-routing ns-def}) \ No newline at end of file diff --git a/src/sci/configs/fulcro/ui_state_machines.cljs b/src/sci/configs/fulcro/ui_state_machines.cljs new file mode 100644 index 0000000..db898f7 --- /dev/null +++ b/src/sci/configs/fulcro/ui_state_machines.cljs @@ -0,0 +1,17 @@ +(ns sci.configs.fulcro.ui-state-machines + (:require [sci.core :as sci] + [com.fulcrologic.fulcro.ui-state-machines :as uism])) + +(defn ^:sci/macro defstatemachine [_&form _&env name body] + (let [nmspc (str (deref sci.core/ns) #_(ns-name *ns*)) + storage-sym (symbol nmspc (str name))] + `(do + (def ~name (assoc ~body ::uism/state-machine-id '~storage-sym)) + (uism/register-state-machine! '~storage-sym ~body)))) + +(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.ui-state-machines)) +(def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.ui-state-machines sci-ns + {:exclude [defstatemachine]}) + 'defstatemachine (sci/copy-var defstatemachine sci-ns))) + +(def namespaces {'com.fulcrologic.fulcro.ui-state-machines ns-def}) \ No newline at end of file diff --git a/test/fulcro/fulcro_test.cljs b/test/fulcro/fulcro_test.cljs new file mode 100644 index 0000000..3e48f4e --- /dev/null +++ b/test/fulcro/fulcro_test.cljs @@ -0,0 +1,26 @@ +(ns fulcro.fulcro-test + (:require + [cljs.test :refer [deftest is]] + [sci.configs.fulcro.fulcro :as fulcro-config] + [sci.core :as sci])) + +(defn ctx-fn [] (sci/init fulcro-config/config)) + +(deftest simple-component-test + (let [ctx (ctx-fn)] + (is (= "

Hello from Fulcro!

" + (sci/eval-string* ctx " +(ns test1 + (:require + [com.fulcrologic.fulcro.algorithms.denormalize :as fdn] + [com.fulcrologic.fulcro.application :as app] + [com.fulcrologic.fulcro.components :as comp :refer [defsc]] + [com.fulcrologic.fulcro.react.version18 :refer [with-react18]] + [com.fulcrologic.fulcro.dom :as dom])) + +(defsc Root [this props] (dom/h3 \"Hello from Fulcro!\")) +(defn build-ui-tree [] + (let [client-db (comp/get-initial-state Root {})] + (fdn/db->tree (comp/get-query Root client-db) client-db client-db))) +(comp/with-parent-context (-> (app/fulcro-app) with-react18) + (dom/render-to-str ((comp/factory Root) (build-ui-tree))))"))))) diff --git a/www/index.html b/www/index.html new file mode 100644 index 0000000..6bce29d --- /dev/null +++ b/www/index.html @@ -0,0 +1,13 @@ + + + + SCI dev + + + +

SCI dev playground for shadow-cljs

+

Run shadow and connect to its nrepl at port 9000. Then eval code in development.cljs.

+
+ + +