├── .clj-kondo
├── config.edn
├── babashka
│ └── sci
│ │ ├── config.edn
│ │ └── sci
│ │ └── core.clj
├── taoensso
│ └── encore
│ │ ├── config.edn
│ │ └── taoensso
│ │ └── encore.clj
├── com.fulcrologic
│ ├── guardrails
│ │ ├── config.edn
│ │ └── com
│ │ │ └── fulcrologic
│ │ │ └── guardrails
│ │ │ └── clj_kondo_hooks.clj
│ └── fulcro
│ │ ├── config.edn
│ │ └── com
│ │ └── fulcrologic
│ │ └── fulcro
│ │ └── clj_kondo_hooks.clj
├── funcool
│ └── promesa
│ │ └── config.edn
└── hoplon
│ └── hoplon
│ ├── config.edn
│ └── clj_kondo
│ └── hoplon.clj
├── CHANGELOG.md
├── playground
├── .gitignore
├── bb.edn
├── deps.edn
├── shadow-cljs.edn
├── package.json
├── www
│ └── index.html
└── src
│ └── playground.cljs
├── package.json
├── .gitignore
├── src
├── sci
│ └── configs
│ │ ├── cjohansen
│ │ ├── portfolio
│ │ │ ├── ui.cljs
│ │ │ ├── data.cljc
│ │ │ ├── replicant.cljs
│ │ │ └── core.cljc
│ │ ├── dataspex.cljs
│ │ └── replicant.cljs
│ │ ├── fulcro
│ │ ├── application.cljs
│ │ ├── algorithms
│ │ │ ├── merge.cljs
│ │ │ ├── lookup.cljs
│ │ │ ├── tempid.cljs
│ │ │ ├── normalize.cljs
│ │ │ ├── denormalize.cljs
│ │ │ ├── form_state.cljs
│ │ │ ├── react_interop.cljs
│ │ │ ├── data_targeting.cljs
│ │ │ └── tx_processing
│ │ │ │ └── synchronous_tx_processing.cljs
│ │ ├── react
│ │ │ ├── version18.cljs
│ │ │ └── hooks.cljs
│ │ ├── data_fetch.cljs
│ │ ├── fulcro_sci_helpers.cljs
│ │ ├── networking
│ │ │ └── http_remote.cljs
│ │ ├── dom.cljs
│ │ ├── ui_state_machines.cljs
│ │ ├── raw
│ │ │ └── component.cljs
│ │ ├── fulcro.cljs
│ │ ├── mutations.cljs
│ │ ├── routing
│ │ │ └── dynamic_routing.cljs
│ │ └── component.cljs
│ │ ├── hoplon
│ │ ├── javelin.clj
│ │ ├── hoplon.cljs
│ │ └── javelin.cljs
│ │ ├── re_frame
│ │ ├── re_frame_alpha.cljs
│ │ └── re_frame.cljs
│ │ ├── reagent
│ │ ├── reagent_dom_client.cljs
│ │ ├── reagent_dom_server.cljs
│ │ └── reagent.cljs
│ │ ├── mfikes
│ │ └── cljs_bean.cljs
│ │ ├── metosin
│ │ └── reitit.cljs
│ │ ├── macros.clj
│ │ ├── clojure_1_11.cljc
│ │ ├── cljs
│ │ ├── pprint.cljs
│ │ └── spec
│ │ │ └── alpha.cljs
│ │ ├── tonsky
│ │ └── datascript.cljs
│ │ ├── applied_science
│ │ └── js_interop.cljs
│ │ └── funcool
│ │ └── promesa.cljs
└── scratch.cljs
├── bb.edn
├── www
└── index.html
├── shadow-cljs.edn
├── LICENSE
├── test
├── re_frame
│ └── re_frame_test.cljs
├── reagent
│ └── reagent_test.cljs
├── fulcro
│ └── fulcro_test.cljs
├── funcool
│ └── promesa_test.cljc
├── clojure
│ └── clojure_1_11_test.cljc
└── cljs
│ └── test_test.cljs
├── deps.edn
├── test-deps
└── deps.edn
├── .github
└── workflows
│ ├── deploy-site.yml
│ └── ci.yml
├── dev
└── development.cljs
└── README.md
/.clj-kondo/config.edn:
--------------------------------------------------------------------------------
1 | {:lint-as {sci.configs.macros/defmacro clojure.core/defmacro}}
2 |
--------------------------------------------------------------------------------
/.clj-kondo/babashka/sci/config.edn:
--------------------------------------------------------------------------------
1 | {:hooks {:macroexpand {sci.core/copy-ns sci.core/copy-ns}}}
2 |
--------------------------------------------------------------------------------
/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Breaking changes
2 |
3 | - Renamed `sci-configs.*` namespaces to `sci.configs.*`
4 |
--------------------------------------------------------------------------------
/playground/.gitignore:
--------------------------------------------------------------------------------
1 | www/js/
2 | node_modules/
3 | package-lock.json
4 | yarn.lock
5 | .shadow-cljs
6 |
--------------------------------------------------------------------------------
/.clj-kondo/taoensso/encore/config.edn:
--------------------------------------------------------------------------------
1 | {:hooks {:analyze-call {taoensso.encore/defalias taoensso.encore/defalias}}}
2 |
--------------------------------------------------------------------------------
/package.json:
--------------------------------------------------------------------------------
1 | {
2 | "devDependencies": {
3 | "react": "^18.2.0",
4 | "react-dom": "^18.2.0"
5 | }
6 | }
7 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | .cache
2 | .DS_Store
3 | .cpcache
4 | cljs-test-runner-out
5 | node_modules
6 | www/js/
7 | .calva/
8 | .portal/
9 | .nrepl-port
10 | .shadow-cljs
11 |
--------------------------------------------------------------------------------
/.clj-kondo/babashka/sci/sci/core.clj:
--------------------------------------------------------------------------------
1 | (ns sci.core)
2 |
3 | (defmacro copy-ns
4 | ([ns-sym sci-ns]
5 | `(copy-ns ~ns-sym ~sci-ns nil))
6 | ([ns-sym sci-ns opts]
7 | `[(quote ~ns-sym)
8 | ~sci-ns
9 | (quote ~opts)]))
10 |
--------------------------------------------------------------------------------
/src/sci/configs/cjohansen/portfolio/ui.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.cjohansen.portfolio.ui
2 | (:require [portfolio.ui :as rd]
3 | [sci.core :as sci]))
4 |
5 | (def rdns (sci/create-ns 'portfolio.ui nil))
6 |
7 | (def portfolio-ui-namespace
8 | {'start! (sci/copy-var rd/start! rdns)})
9 |
--------------------------------------------------------------------------------
/src/sci/configs/cjohansen/portfolio/data.cljc:
--------------------------------------------------------------------------------
1 | (ns sci.configs.cjohansen.portfolio.data
2 | (:require [portfolio.data]
3 | [sci.core :as sci]))
4 |
5 | (def pdns (sci/create-ns 'portfolio.data nil))
6 |
7 | (def portfolio-data-namespace
8 | {'register-scene! (sci/copy-var portfolio.data/register-scene! pdns)})
9 |
--------------------------------------------------------------------------------
/playground/bb.edn:
--------------------------------------------------------------------------------
1 | {:tasks
2 | {build {:doc "Build the static 'SCI Playground' site with sci and an editor"
3 | :task (do (shell "yarn install")
4 | (clojure "-M:dev:shadow-cli release playground")
5 | (println "Built www"))}
6 | watch (clojure "-M:dev:shadow-cli watch playground")}}
7 |
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/application.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.application
2 | (:require
3 | [sci.core :as sci]
4 | [com.fulcrologic.fulcro.application]))
5 |
6 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.application))
7 | (def ns-def (sci/copy-ns com.fulcrologic.fulcro.application sci-ns))
8 |
9 | (def namespaces {'com.fulcrologic.fulcro.application ns-def})
--------------------------------------------------------------------------------
/src/sci/configs/hoplon/javelin.clj:
--------------------------------------------------------------------------------
1 | (ns sci.configs.hoplon.javelin)
2 |
3 | (defmacro ^:private with-let*
4 | "Binds resource to binding and evaluates body. Then, returns
5 | resource. It's a cross between doto and with-open."
6 | [[binding resource] & body]
7 | `(let [~binding ~resource] ~@body ~binding))
8 |
9 | (defmacro foo [] (prn (:locals &env))
10 | (list 'quote 1))
11 |
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/algorithms/merge.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.algorithms.merge
2 | (:require
3 | [sci.core :as sci]
4 | com.fulcrologic.fulcro.algorithms.merge))
5 |
6 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.merge))
7 | (def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.merge sci-ns))
8 |
9 | (def namespaces {'com.fulcrologic.fulcro.algorithms.merge ns-def})
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/react/version18.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.react.version18
2 | (:require [sci.core :as sci]
3 | com.fulcrologic.fulcro.react.version18))
4 |
5 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.react.version18))
6 | (def ns-def (sci/copy-ns com.fulcrologic.fulcro.react.version18 sci-ns))
7 |
8 | (def namespaces {'com.fulcrologic.fulcro.react.version18 ns-def})
--------------------------------------------------------------------------------
/bb.edn:
--------------------------------------------------------------------------------
1 | {:tasks
2 | {cljs-repl (shell "clj -M:test -m cljs.main -re node")
3 | test (clojure "-M:test:cljs-test-runner")
4 | test:advanced (clojure "-M:test:cljs-test-runner:cljs-test-runner-advanced")
5 | dev (clojure "-M:test:dev:shadow-cli watch dev")
6 | dev:release (clojure "-M:test:dev:shadow-cli release dev")
7 | dev:release:debug (clojure "-M:test:dev:shadow-cli release dev --debug")}}
8 |
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/data_fetch.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.data-fetch
2 | (:require
3 | [sci.core :as sci]
4 | com.fulcrologic.fulcro.data-fetch))
5 |
6 |
7 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.data-fetch))
8 | (def ns-def (sci/copy-ns com.fulcrologic.fulcro.data-fetch sci-ns {:exclude ['render-to-str]}))
9 |
10 | (def namespaces {'com.fulcrologic.fulcro.data-fetch ns-def})
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/algorithms/lookup.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.algorithms.lookup
2 | (:require [sci.core :as sci]
3 | com.fulcrologic.fulcro.algorithms.lookup))
4 |
5 |
6 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.lookup))
7 | (def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.lookup sci-ns))
8 |
9 | (def namespaces {'com.fulcrologic.fulcro.algorithms.lookup ns-def})
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/algorithms/tempid.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.algorithms.tempid
2 | (:require [sci.core :as sci]
3 | com.fulcrologic.fulcro.algorithms.tempid))
4 |
5 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.tempid))
6 | (def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.tempid sci-ns))
7 |
8 | (def namespaces {'com.fulcrologic.fulcro.algorithms.tempid ns-def})
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/algorithms/normalize.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.algorithms.normalize
2 | (:require [sci.core :as sci]
3 | com.fulcrologic.fulcro.algorithms.normalize))
4 |
5 |
6 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.normalize))
7 | (def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.normalize sci-ns))
8 |
9 | (def namespaces {'com.fulcrologic.fulcro.algorithms.normalize ns-def})
--------------------------------------------------------------------------------
/src/sci/configs/re_frame/re_frame_alpha.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.re-frame.re-frame-alpha
2 | (:require
3 | [re-frame.alpha]
4 | [sci.core :as sci]))
5 |
6 | (def rfa (sci/create-ns 're-frame.alpha nil))
7 |
8 | (def re-frame-alpha-namespace
9 | (sci/copy-ns re-frame.alpha rfa))
10 |
11 | (def namespaces
12 | {'re-frame.alpha re-frame-alpha-namespace})
13 |
14 | (def config
15 | {:namespaces namespaces})
16 |
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/algorithms/denormalize.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.algorithms.denormalize
2 | (:require
3 | [sci.core :as sci]
4 | com.fulcrologic.fulcro.algorithms.denormalize))
5 |
6 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.denormalize))
7 | (def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.denormalize sci-ns))
8 |
9 | (def namespaces {'com.fulcrologic.fulcro.algorithms.denormalize ns-def})
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/algorithms/form_state.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.algorithms.form-state
2 | (:require [sci.core :as sci]
3 | com.fulcrologic.fulcro.algorithms.form-state))
4 |
5 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.form-state))
6 | (def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.form-state sci-ns))
7 |
8 | (def namespaces {'com.fulcrologic.fulcro.algorithms.form-state ns-def})
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/fulcro_sci_helpers.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.fulcro-sci-helpers)
2 |
3 | (defn error
4 | "Replace cljs.analyzer/error so that we don't to pull in this huge dependency"
5 | ([env msg] (error env msg nil))
6 | ([{:keys [line file] :as env} msg cause]
7 | (ex-info (cond-> msg
8 | line (str " at line " line)
9 | file (str " in " file))
10 | env
11 | cause)))
--------------------------------------------------------------------------------
/www/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | SCI dev
5 |
6 |
7 |
8 | SCI dev playground for shadow-cljs
9 | Run shadow and connect to its nrepl at port 9000. Then eval code in development.cljs.
10 |
11 |
12 |
13 |
14 |
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/algorithms/react_interop.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.algorithms.react-interop
2 | (:require [sci.core :as sci]
3 | com.fulcrologic.fulcro.algorithms.react-interop))
4 |
5 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.react-interop))
6 | (def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.react-interop sci-ns))
7 |
8 | (def namespaces {'com.fulcrologic.fulcro.algorithms.react-interop ns-def})
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/networking/http_remote.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.networking.http-remote
2 | (:require [sci.core :as sci]
3 | com.fulcrologic.fulcro.networking.http-remote))
4 |
5 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.networking.http-remote))
6 | (def ns-def (sci/copy-ns com.fulcrologic.fulcro.networking.http-remote sci-ns))
7 |
8 | (def namespaces {'com.fulcrologic.fulcro.networking.http-remote ns-def})
--------------------------------------------------------------------------------
/playground/deps.edn:
--------------------------------------------------------------------------------
1 | {:deps {; SCI
2 | org.babashka/sci.configs {:local/root ".."}
3 | ;; Editor
4 | io.github.nextjournal/clojure-mode {:git/sha "7b911bf6feab0f67b60236036d124997627cbe5e"}
5 | ;; Included libs
6 | sci.configs/test-deps {:local/root "../test-deps"}}
7 | :aliases {:dev {:extra-deps {thheller/shadow-cljs {:mvn/version "2.25.9"}}}
8 | :shadow-cli {:main-opts ["-m" "shadow.cljs.devtools.cli"]}}}
9 |
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/algorithms/data_targeting.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.algorithms.data-targeting
2 | (:require [sci.core :as sci]
3 | [com.fulcrologic.fulcro.algorithms.data-targeting]))
4 |
5 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.data-targeting))
6 | (def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.data-targeting sci-ns))
7 |
8 | (def namespaces {'com.fulcrologic.fulcro.algorithms.data-targeting ns-def})
--------------------------------------------------------------------------------
/.clj-kondo/com.fulcrologic/guardrails/config.edn:
--------------------------------------------------------------------------------
1 | {:hooks {:analyze-call {com.fulcrologic.guardrails.core/>defn
2 | com.fulcrologic.guardrails.clj-kondo-hooks/>defn
3 | com.fulcrologic.guardrails.core/>defn-
4 | com.fulcrologic.guardrails.clj-kondo-hooks/>defn}}
5 | :linters {:clj-kondo.fulcro.>defn/invalid-gspec {:level :error}}
6 | :lint-as {com.fulcrologic.guardrails.core/>def clojure.spec.alpha/def}}
7 |
--------------------------------------------------------------------------------
/src/sci/configs/cjohansen/dataspex.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.cjohansen.dataspex
2 | (:require [dataspex.core]
3 | [sci.core :as sci]))
4 |
5 | (def dcns (sci/create-ns 'dataspex.core nil))
6 |
7 | (def dataspex-core-namespace (sci/copy-ns dataspex.core
8 | dcns
9 | {:exclude [persist! store]}))
10 |
11 | (def namespaces {'dataspex.core dataspex-core-namespace})
12 |
13 | (def config {:namespaces namespaces})
14 |
--------------------------------------------------------------------------------
/src/sci/configs/reagent/reagent_dom_client.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.reagent.reagent-dom-client
2 | (:require [reagent.dom.client :as rdc]
3 | [sci.core :as sci]))
4 |
5 | (def rdcns (sci/create-ns 'reagent.dom.client nil))
6 |
7 | (def reagent-dom-client-namespace
8 | {'render (sci/copy-var rdc/render rdcns)
9 | 'create-root (sci/copy-var rdc/create-root rdcns)})
10 |
11 | (def namespaces {'reagent.dom.client reagent-dom-client-namespace})
12 |
13 | (def config {:namespaces namespaces})
14 |
--------------------------------------------------------------------------------
/src/sci/configs/reagent/reagent_dom_server.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.reagent.reagent-dom-server
2 | (:require [reagent.dom.server :as srv]
3 | [sci.core :as sci]))
4 |
5 | (def rdns (sci/create-ns 'reagent.dom.server nil))
6 |
7 | (def reagent-dom-server-namespace
8 | {'render-to-string (sci/copy-var srv/render-to-string rdns)
9 | 'render-to-static-markup (sci/copy-var srv/render-to-static-markup rdns)})
10 |
11 | (def namespaces {'reagent.dom.server reagent-dom-server-namespace})
12 |
13 | (def config {:namespaces namespaces})
14 |
--------------------------------------------------------------------------------
/.clj-kondo/funcool/promesa/config.edn:
--------------------------------------------------------------------------------
1 | {:lint-as {promesa.core/-> clojure.core/->
2 | promesa.core/->> clojure.core/->>
3 | promesa.core/as-> clojure.core/as->
4 | promesa.core/let clojure.core/let
5 | promesa.core/plet clojure.core/let
6 | promesa.core/loop clojure.core/loop
7 | promesa.core/recur clojure.core/recur
8 | promesa.core/with-redefs clojure.core/with-redefs
9 | promesa.core/doseq clojure.core/doseq}}
10 |
--------------------------------------------------------------------------------
/src/sci/configs/mfikes/cljs_bean.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.mfikes.cljs-bean
2 | (:require
3 | [cljs-bean.core :as bean]
4 | [sci.core :as sci]))
5 |
6 | (def bns (sci/create-ns 'cljs-bean.core nil))
7 |
8 | (def cljs-bean-namespace
9 | {'bean (sci/copy-var bean/bean bns)
10 | 'bean? (sci/copy-var bean/bean? bns)
11 | 'object (sci/copy-var bean/object bns)
12 | '->js (sci/copy-var bean/->js bns)
13 | '->clj (sci/copy-var bean/->clj bns)})
14 |
15 | (def namespaces {'cljs-bean.core cljs-bean-namespace})
16 | (def config {:namespaces namespaces})
17 |
--------------------------------------------------------------------------------
/src/scratch.cljs:
--------------------------------------------------------------------------------
1 | (ns scratch
2 | (:require [sci.core :as sci]
3 | [sci.configs.hoplon.javelin]
4 | [sci.ctx-store]))
5 |
6 | (def ctx (sci/init {:namespaces {'javelin.core sci.configs.hoplon.javelin/javelin-core-ns} :classes {'js js/globalThis :allow :all}}))
7 | (sci.ctx-store/reset-ctx! ctx) nil
8 | (sci/eval-string* ctx "(require '[javelin.core :as j])")
9 | (sci/eval-string* ctx "(js/console.log \"test\")")
10 | (prn (sci/eval-string* ctx "(let [a (j/cell 0) b (j/cell= (inc a)) c (j/cell= (js/console.log \"yoooo\" b))] (swap! a inc))"))
11 |
--------------------------------------------------------------------------------
/src/sci/configs/re_frame/re_frame.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.re-frame.re-frame
2 | (:require
3 | [re-frame.core]
4 | [re-frame.db]
5 | [sci.core :as sci]))
6 |
7 | (def rfns (sci/create-ns 're-frame.core nil))
8 | (def rfdbns (sci/create-ns 're-frame.db nil))
9 |
10 | (def re-frame-namespace
11 | (sci/copy-ns re-frame.core rfns))
12 |
13 | (def re-frame-db-namespace
14 | (sci/copy-ns re-frame.db rfdbns))
15 |
16 | (def namespaces
17 | {'re-frame.core re-frame-namespace
18 | 're-frame.db re-frame-db-namespace})
19 |
20 | (def config
21 | {:namespaces namespaces})
22 |
--------------------------------------------------------------------------------
/src/sci/configs/metosin/reitit.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.metosin.reitit
2 | (:require [reitit.frontend]
3 | [reitit.frontend.easy]
4 | [sci.core :as sci]))
5 |
6 | (def frontend-namespace
7 | (sci/copy-ns reitit.frontend (sci/create-ns 'reitit.frontend nil)))
8 |
9 | (def frontend-easy-namespace
10 | (sci/copy-ns reitit.frontend.easy (sci/create-ns 'reitit.frontend.easy nil)))
11 |
12 | (def namespaces {'reitit.frontend frontend-namespace
13 | 'reitit.frontend.easy frontend-easy-namespace})
14 |
15 | (def config {:namespaces namespaces})
16 |
17 |
--------------------------------------------------------------------------------
/.clj-kondo/taoensso/encore/taoensso/encore.clj:
--------------------------------------------------------------------------------
1 | (ns taoensso.encore
2 | (:require
3 | [clj-kondo.hooks-api :as hooks]))
4 |
5 | (defn defalias [{:keys [node]}]
6 | (let [[sym-raw src-raw] (rest (:children node))
7 | src (if src-raw src-raw sym-raw)
8 | sym (if src-raw
9 | sym-raw
10 | (symbol (name (hooks/sexpr src))))]
11 | {:node (with-meta
12 | (hooks/list-node
13 | [(hooks/token-node 'def)
14 | (hooks/token-node (hooks/sexpr sym))
15 | (hooks/token-node (hooks/sexpr src))])
16 | (meta src))}))
17 |
--------------------------------------------------------------------------------
/playground/shadow-cljs.edn:
--------------------------------------------------------------------------------
1 | {:deps {:aliases [:dev]}
2 | :nrepl {:port 9000}
3 | :dev-http {8081 "www"}
4 | :builds {:playground {:compiler-options {:output-feature-set :es8
5 | :optimizations :advanced
6 | :source-map true
7 | :output-wrapper false}
8 | :target :browser
9 | :output-dir "www/js"
10 | :modules {:playground {:init-fn playground/init}}
11 | :devtools {:after-load playground/reload}}}}
12 |
--------------------------------------------------------------------------------
/shadow-cljs.edn:
--------------------------------------------------------------------------------
1 | {:deps {:aliases [:test :dev]}
2 | :nrepl {:port 9000}
3 | :dev-http {8081 "www"}
4 | :builds {:dev {:compiler-options {:output-feature-set :es8
5 | :optimizations :advanced
6 | :source-map true
7 | :output-wrapper false}
8 | :target :browser
9 | :output-dir "www/js/dev"
10 | :asset-path "/js/dev"
11 | :modules {:dev {:init-fn development/init}}
12 | :devtools {:after-load development/reload}}}}
13 |
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/dom.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.dom
2 | (:require
3 | [sci.core :as sci]
4 | com.fulcrologic.fulcro.dom
5 | ["react-dom/server" :as react-dom-server]))
6 |
7 | (defn render-to-str [e]
8 | ;; Re-write to use react-dom-server instead of relying on js/ReactDOMServer,
9 | ;; which I don't know how to get hold of in the SCI context.
10 | (react-dom-server/renderToString e))
11 |
12 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.dom))
13 | (def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.dom sci-ns {:exclude ['render-to-str]})
14 | 'render-to-str (sci/copy-var render-to-str sci-ns)))
15 |
16 | (def namespaces {'com.fulcrologic.fulcro.dom ns-def})
17 |
--------------------------------------------------------------------------------
/.clj-kondo/hoplon/hoplon/config.edn:
--------------------------------------------------------------------------------
1 | {:lint-as {castra.core/defrpc clojure.core/defn
2 | hoplon.core/for-tpl clojure.core/for
3 | javelin.core/cell-let clojure.core/let
4 | javelin.core/cell-doseq clojure.core/doseq
5 | javelin.core/defc clojure.core/def
6 | javelin.core/defc= clojure.core/def
7 | javelin.core/formulet clojure.core/let
8 | javelin.core/with-let clojure.core/let}
9 | :hooks {:analyze-call {hoplon.core/elem clj-kondo.hoplon/hoplon-core-elem
10 | hoplon.core/defelem clj-kondo.hoplon/hoplon-core-defelem
11 | hoplon.core/loop-tpl clj-kondo.hoplon/hoplon-core-loop-tpl}}}
12 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | Copyright 2022 Michiel Borkent and contributors.
2 |
3 | The configurations are licensed under the same licenses as the libraries they
4 | target. You are free to take the configs from this repository and adapt them as
5 | necessary for your projects.
6 |
7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
8 | REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
9 | FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
10 | INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
11 | OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
12 | TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
13 | THIS SOFTWARE.
14 |
--------------------------------------------------------------------------------
/test/re_frame/re_frame_test.cljs:
--------------------------------------------------------------------------------
1 | (ns re-frame.re-frame-test
2 | (:require
3 | [cljs.test :refer [deftest is]]
4 | [sci.configs.re-frame.re-frame :as re-frame-config]
5 | [sci.core :as sci]))
6 |
7 | (defn ctx-fn [] (sci/init {:namespaces re-frame-config/namespaces}))
8 |
9 | (deftest dispatch-test
10 | (let [ctx (ctx-fn)]
11 | (is (= 1
12 | (sci/eval-string* ctx "(ns example
13 | (:require
14 | [re-frame.core :as rf]))
15 |
16 | (rf/reg-event-db
17 | :initialize
18 | (fn [db _]
19 | {:count 0}))
20 |
21 | (rf/reg-sub
22 | :count
23 | (fn [db]
24 | (:count db)))
25 |
26 | (rf/reg-event-db
27 | :inc
28 | (fn [db _]
29 | (update db :count inc)))
30 |
31 | (rf/dispatch-sync [:initialize])
32 |
33 | (rf/dispatch-sync [:inc])
34 |
35 | @(rf/subscribe [:count])
36 | ")))))
37 |
--------------------------------------------------------------------------------
/playground/package.json:
--------------------------------------------------------------------------------
1 | {
2 | "name": "sci_playground",
3 | "version": "1.0.0",
4 | "devDependencies": {
5 | "@codemirror/autocomplete": "^6.0.2",
6 | "@codemirror/commands": "^6.0.0",
7 | "@codemirror/lang-markdown": "6.0.0",
8 | "@codemirror/language": "^6.1.0",
9 | "@codemirror/lint": "^6.0.0",
10 | "@codemirror/search": "^6.0.0",
11 | "@codemirror/state": "^6.0.1",
12 | "@codemirror/view": "^6.0.2",
13 | "@lezer/common": "^1.0.0",
14 | "@lezer/generator": "^1.0.0",
15 | "@lezer/highlight": "^1.0.0",
16 | "@lezer/lr": "^1.0.0",
17 | "@nextjournal/lezer-clojure": "1.0.0",
18 | "react": "18.2.0",
19 | "react-dom": "18.2.0",
20 | "shadow-cljs": "^2.25.7"
21 | },
22 | "dependencies": {
23 | "snabbdom": "3.5.1",
24 | "w3c-keyname": "^2.2.4"
25 | }
26 | }
27 |
--------------------------------------------------------------------------------
/test/reagent/reagent_test.cljs:
--------------------------------------------------------------------------------
1 | (ns reagent.reagent-test
2 | (:require
3 | [cljs.test :refer [deftest is]]
4 | [sci.configs.reagent.reagent :as reagent-config]
5 | [sci.configs.reagent.reagent-dom-server :as dom-server-config]
6 | [sci.core :as sci]))
7 |
8 | (defn ctx-fn [] (sci/init {:namespaces (into reagent-config/namespaces
9 | dom-server-config/namespaces)}))
10 |
11 | (deftest function?-test
12 | (let [ctx (ctx-fn)]
13 | (is (= "1
"
14 | (sci/eval-string* ctx "
15 | (ns example
16 | (:require
17 | [reagent.core :as r]
18 | [reagent.dom.server :as rdom]))
19 | (def click-count (r/atom 0))
20 |
21 | (defn counting-component []
22 | [:div @click-count])
23 |
24 | (swap! click-count inc)
25 |
26 | (rdom/render-to-string [counting-component])")))))
27 |
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/ui_state_machines.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.ui-state-machines
2 | (:require [sci.core :as sci]
3 | [com.fulcrologic.fulcro.ui-state-machines :as uism]))
4 |
5 | (defn ^:sci/macro defstatemachine [_&form _&env name body]
6 | (let [nmspc (str (deref sci.core/ns) #_(ns-name *ns*))
7 | storage-sym (symbol nmspc (str name))]
8 | `(do
9 | (def ~name (assoc ~body ::uism/state-machine-id '~storage-sym))
10 | (uism/register-state-machine! '~storage-sym ~body))))
11 |
12 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.ui-state-machines))
13 | (def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.ui-state-machines sci-ns
14 | {:exclude [defstatemachine]})
15 | 'defstatemachine (sci/copy-var defstatemachine sci-ns)))
16 |
17 | (def namespaces {'com.fulcrologic.fulcro.ui-state-machines ns-def})
--------------------------------------------------------------------------------
/deps.edn:
--------------------------------------------------------------------------------
1 | {:aliases {:dev {:extra-paths ["dev"]
2 | :extra-deps {thheller/shadow-cljs {:mvn/version "2.25.7"}}}
3 | :shadow-cli {:main-opts ["-m" "shadow.cljs.devtools.cli"]}
4 | :test {:extra-paths ["test"]
5 | :extra-deps {sci.configs/test-deps {:local/root "test-deps"}}}
6 | :cljs-test-runner
7 | {:extra-deps {olical/cljs-test-runner {:mvn/version "3.8.0"}}
8 | :extra-paths ["test" "cljs-test-runner-out/gen"]
9 | :main-opts ["-m" "cljs-test-runner.main" "-d" "test"]}
10 | :cljs-test-runner-advanced
11 | {:main-opts ["-m" "cljs-test-runner.main" "-d" "test" "-c" "{:optimizations :advanced :language-in :ecmascript-next}"]}}
12 | :deps {org.babashka/sci {:mvn/version "0.10.46"} #_{:git/url "https://github.com/babashka/sci"
13 | :git/sha "7854f77ea5ff9cde2aeec06ff189b04316be9a92"}}}
14 |
--------------------------------------------------------------------------------
/test-deps/deps.edn:
--------------------------------------------------------------------------------
1 | {:deps
2 | {org.clojure/clojurescript {:mvn/version "1.11.51"}
3 | applied-science/js-interop {:mvn/version "0.3.3"}
4 | com.fulcrologic/fulcro {:mvn/version "3.6.10"}
5 | funcool/promesa {:git/url "https://github.com/funcool/promesa"
6 | :git/sha "e503874b154224ce85b223144e80b697df91d18e"}
7 | no.cjohansen/dataspex {:git/url "https://github.com/cjohansen/dataspex"
8 | :git/sha "02112200651c2bd932907bb69fba1ff50b881741"}
9 | no.cjohansen/replicant {:mvn/version "2025.03.27"}
10 | no.cjohansen/portfolio {:mvn/version "2025.01.28"}
11 | reagent/reagent {:mvn/version "1.2.0"}
12 | metosin/reitit {:mvn/version "0.9.1"}
13 | re-frame/re-frame {:mvn/version "1.4.0"}
14 | hoplon/javelin {:mvn/version "3.9.3"}
15 | hoplon/hoplon {:mvn/version "7.5.0"}
16 | datascript/datascript {:mvn/version "1.5.3"}
17 | cljs-bean/cljs-bean {:mvn/version "1.9.0"}}}
18 |
--------------------------------------------------------------------------------
/src/sci/configs/macros.clj:
--------------------------------------------------------------------------------
1 | (ns sci.configs.macros
2 | (:refer-clojure :exclude [defmacro]))
3 |
4 | (def ^:dynamic *debug* false)
5 |
6 | (defn add-macro-args [[args & body]]
7 | (list* (into '[&form &env] args) body))
8 |
9 | (clojure.core/defmacro defmacro [name & body]
10 | (let [[?doc body] (if (and (string? (first body))
11 | (> (count body) 2))
12 | [(first body) (rest body)]
13 | [nil body])
14 | bodies (if (vector? (first body))
15 | (list body)
16 | body)]
17 | #_(when *debug* (.println System/err (with-out-str (clojure.pprint/pprint bodies))))
18 | `(defn ~(vary-meta name assoc :sci/macro true)
19 | ~@(when ?doc [?doc])
20 | ~@(map add-macro-args bodies))))
21 |
22 | #_(binding [*debug* true]
23 | (.println System/err (str (macroexpand '(defmacro my-stuff "docstring" [& args] x y z)))))
24 |
--------------------------------------------------------------------------------
/src/sci/configs/clojure_1_11.cljc:
--------------------------------------------------------------------------------
1 | (ns sci.configs.clojure-1-11
2 | (:require [sci.core :as sci]
3 | [sci.impl.utils :refer [clojure-core-ns]]
4 | [clojure.core :as c]))
5 |
6 | (def ^:private clojure-core-namespace-extras-1-11
7 | {'abs (sci/copy-var c/abs clojure-core-ns)
8 | 'NaN? (sci/copy-var c/NaN? clojure-core-ns)
9 | 'infinite? (sci/copy-var c/infinite? clojure-core-ns)
10 | 'parse-double (sci/copy-var c/parse-double clojure-core-ns)
11 | 'parse-long (sci/copy-var c/parse-long clojure-core-ns)
12 | 'parse-boolean (sci/copy-var c/parse-boolean clojure-core-ns)
13 | 'parse-uuid (sci/copy-var c/parse-uuid clojure-core-ns)
14 | 'random-uuid (sci/copy-var c/random-uuid clojure-core-ns)
15 | 'update-keys (sci/copy-var c/update-keys clojure-core-ns)
16 | 'update-vals (sci/copy-var c/update-vals clojure-core-ns)
17 | 'iteration (sci/copy-var c/iteration clojure-core-ns)})
18 |
19 |
20 | (def namespaces
21 | {'clojure.core clojure-core-namespace-extras-1-11})
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/algorithms/tx_processing/synchronous_tx_processing.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.algorithms.tx-processing.synchronous-tx-processing
2 | (:require [sci.core :as sci]
3 | [com.fulcrologic.fulcro.algorithms.tx-processing.synchronous-tx-processing :as stx]))
4 |
5 | (defn ^:sci/macro in-transaction [_&form _&env app-sym & body]
6 | `(let [id# (:com.fulcrologic.fulcro.application/id ~app-sym)]
7 | (swap! stx/apps-in-tx update id# conj (stx/current-thread-id))
8 | (try
9 | ~@body
10 | (finally
11 | (swap! apps-in-tx update id# pop)))))
12 |
13 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.tx-processing.synchronous-tx-processing))
14 | (def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.algorithms.tx-processing.synchronous-tx-processing sci-ns
15 | {:exclude [in-transaction]})
16 | 'in-transaction (sci/copy-var in-transaction sci-ns)))
17 |
18 | (def namespaces {'com.fulcrologic.fulcro.algorithms.tx-processing.synchronous-tx-processing ns-def})
--------------------------------------------------------------------------------
/test/fulcro/fulcro_test.cljs:
--------------------------------------------------------------------------------
1 | (ns fulcro.fulcro-test
2 | (:require
3 | [cljs.test :refer [deftest is]]
4 | [sci.configs.fulcro.fulcro :as fulcro-config]
5 | [sci.core :as sci]))
6 |
7 | (defn ctx-fn [] (sci/init fulcro-config/config))
8 |
9 | (deftest simple-component-test
10 | (let [ctx (ctx-fn)]
11 | (is (= "Hello from Fulcro!
"
12 | (sci/eval-string* ctx "
13 | (ns test1
14 | (:require
15 | [com.fulcrologic.fulcro.algorithms.denormalize :as fdn]
16 | [com.fulcrologic.fulcro.application :as app]
17 | [com.fulcrologic.fulcro.components :as comp :refer [defsc]]
18 | [com.fulcrologic.fulcro.react.version18 :refer [with-react18]]
19 | [com.fulcrologic.fulcro.dom :as dom]))
20 |
21 | (defsc Root [this props] (dom/h3 \"Hello from Fulcro!\"))
22 | (defn build-ui-tree []
23 | (let [client-db (comp/get-initial-state Root {})]
24 | (fdn/db->tree (comp/get-query Root client-db) client-db client-db)))
25 | (comp/with-parent-context (-> (app/fulcro-app) with-react18)
26 | (dom/render-to-str ((comp/factory Root) (build-ui-tree))))")))))
27 |
--------------------------------------------------------------------------------
/.clj-kondo/hoplon/hoplon/clj_kondo/hoplon.clj:
--------------------------------------------------------------------------------
1 | (ns clj-kondo.hoplon
2 | (:require [clj-kondo.hooks-api :as api]))
3 |
4 | (defn hoplon-core-defelem
5 | [{:keys [node]}]
6 | (let [[_defelem name & forms] (:children node)
7 | [docstr & [args & body]] (if (api/string-node? (first forms))
8 | forms
9 | (concat [""] forms))]
10 | {:node (api/list-node
11 | (list*
12 | (api/token-node 'defn)
13 | name
14 | docstr
15 | (api/vector-node
16 | [(api/token-node '&) args])
17 | body))}))
18 |
19 | (defn hoplon-core-elem
20 | [{:keys [node]}]
21 | (let [[_elem & [args & body]] (:children node)]
22 | {:node (api/list-node
23 | (list*
24 | (api/token-node 'fn)
25 | (api/vector-node
26 | [(api/token-node '&) args])
27 | body))}))
28 |
29 | (defn hoplon-core-loop-tpl
30 | [{:keys [node]}]
31 | (let [[_loop-tpl _bindings-kw bind & body] (:children node)]
32 | {:node (api/list-node
33 | (list*
34 | (api/token-node 'for)
35 | bind
36 | body))}))
37 |
--------------------------------------------------------------------------------
/test/funcool/promesa_test.cljc:
--------------------------------------------------------------------------------
1 | (ns funcool.promesa-test
2 | (:require
3 | [cljs.test :refer [deftest is async]]
4 | [sci.configs.funcool.promesa :as promesa-config]
5 | [sci.core :as sci]))
6 |
7 | (defn ctx-fn [] (sci/init {:namespaces promesa-config/namespaces}))
8 |
9 | (deftest future-test
10 | (let [ctx (ctx-fn)
11 | [p f] (sci/eval-string* ctx "
12 | (ns example
13 | (:require
14 | [promesa.core :as p]))
15 |
16 | (def p
17 | (p/do
18 | 1 2 3
19 | (p/let [x (p/resolved (inc 2))
20 | y (inc x)]
21 | (inc y))))
22 |
23 | [p (fn [] @p)]")]
24 | (async done
25 | (-> p
26 | (.then (fn [v]
27 | (is (= 5 v))))
28 | (.catch (fn [_] (is false)))
29 | (.then (fn [_]
30 | (is (= 5 (f)))))
31 | (.finally done)))))
32 |
33 | (deftest do-exception-safe-test
34 | (let [ctx (ctx-fn)
35 | p (sci/eval-string* ctx "
36 | (ns example
37 | (:require
38 | [promesa.core :as p]))
39 |
40 | (p/do (throw (ex-info \"an error\" {:info :test})))")]
41 | (async done
42 | (-> p
43 | (.then (fn [_] (is false)))
44 | (.catch (fn [err]
45 | (is (= "an error" (ex-message err)))
46 | (is (= {:info :test} (-> err ex-cause ex-data)))))
47 | (.finally done)))))
48 |
--------------------------------------------------------------------------------
/src/sci/configs/cjohansen/portfolio/replicant.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.cjohansen.portfolio.replicant
2 | (:require [sci.configs.cjohansen.portfolio.core :refer [portfolio-core-namespace] :as portfolio]
3 | [sci.configs.cjohansen.portfolio.data :refer [portfolio-data-namespace]]
4 | [sci.configs.cjohansen.portfolio.ui :refer [portfolio-ui-namespace]]
5 | [portfolio.replicant]
6 | [sci.core :as sci]))
7 |
8 | (def prns (sci/create-ns 'portfolio.replicant nil))
9 |
10 | (defn ^:sci/macro defscene
11 | "Execute body with the pretty print dispatch function bound to function."
12 | [_&form &env id & opts]
13 | `(portfolio.data/register-scene!
14 | (portfolio.replicant/create-scene
15 | ~(portfolio/get-options-map id (:line &env) opts))))
16 |
17 | #_(defn ^:sci/macro configure-scenes [_ _ & opts]
18 | `(portfolio.data/register-collection!
19 | ~@(portfolio/get-collection-options opts)))
20 |
21 | (def portfolio-replicant-namespace
22 | {'create-scene (sci/copy-var portfolio.replicant/create-scene prns)
23 | 'defscene (sci/copy-var defscene prns)})
24 |
25 | (def namespaces {'portfolio.core portfolio-core-namespace
26 | 'portfolio.data portfolio-data-namespace
27 | 'portfolio.replicant portfolio-replicant-namespace
28 | 'portfolio.ui portfolio-ui-namespace})
29 |
30 | (def config {:namespaces namespaces})
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/raw/component.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.raw.component
2 | (:require
3 | [sci.core :as sci]
4 | [com.fulcrologic.fulcro.raw.components :as rc]
5 | [taoensso.timbre :as log]))
6 |
7 | (defn ^:sci/macro defnc
8 | ([_&form _&env sym query] (defnc _&form _&env sym query {}))
9 | ([_&form _&env sym query options]
10 | (let [nspc (some-> sci.core/ns deref str)
11 | fqkw (keyword (str nspc) (name sym))
12 | ]
13 | `(let [o# (dissoc (merge ~options {:componentName ~fqkw}) :ident :query)
14 | ident# (:ident o#)
15 | ident# (cond
16 | (= :constant ident#) (fn [~'_ ~'_] [:Constant/id ~fqkw])
17 | (keyword? ident#) (fn [~'_ props#] [ident# (get props# ident#)])
18 | (or (nil? ident#) (fn? ident#)) ident#
19 | :else (do
20 | (log/error "corrupt ident on component " ~fqkw)
21 | nil))
22 | o# (cond-> o#
23 | ident# (assoc :ident ident#))]
24 | (def ~sym (rc/nc ~query o#))))))
25 |
26 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.raw.components))
27 | (def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.raw.components sci-ns {:exclude [defnc]})
28 | 'defnc (sci/copy-var defnc sci-ns)))
29 |
30 | (def namespaces {'com.fulcrologic.fulcro.raw.components ns-def})
31 |
--------------------------------------------------------------------------------
/.github/workflows/deploy-site.yml:
--------------------------------------------------------------------------------
1 | name: Build and Deploy
2 | on:
3 | push:
4 | branches:
5 | - main
6 | permissions:
7 | contents: read
8 | pages: write
9 | id-token: write
10 | jobs:
11 | build-and-deploy:
12 | concurrency: ci-${{ github.ref }} # Recommended if you intend to make multiple deployments in quick succession.
13 | runs-on: ubuntu-latest
14 | steps:
15 |
16 | - name: Checkout 🛎️
17 | uses: actions/checkout@v3
18 |
19 | - name: Prepare java
20 | uses: actions/setup-java@v3
21 | with:
22 | distribution: 'zulu'
23 | java-version: '11'
24 |
25 | - name: Install clojure tools
26 | uses: DeLaGuardo/setup-clojure@12.1
27 | with:
28 | # Install just one or all simultaneously
29 | # The value must indicate a particular version of the tool, or use 'latest'
30 | # to always provision the latest version
31 | cli: latest
32 | bb: latest
33 |
34 | - name: Install and Build 🔧
35 | run: |
36 | cd playground && bb build
37 |
38 | - name: Setup Pages
39 | uses: actions/configure-pages@v3
40 |
41 | - name: Upload artifact
42 | uses: actions/upload-pages-artifact@v3.0.1
43 | with:
44 | path: 'playground/www'
45 |
46 | - name: Deploy to GitHub Pages
47 | id: deployment
48 | uses: actions/deploy-pages@v4.0.5
49 |
--------------------------------------------------------------------------------
/dev/development.cljs:
--------------------------------------------------------------------------------
1 | (ns development
2 | "Entry point for code loaded by shadow-cljs"
3 | (:require
4 | [sci.core :as sci]
5 | [sci.configs.fulcro.fulcro :as fulcro-config]))
6 |
7 | ;; Necessary to avoid the error 'Attempting to call unbound fn: #'clojure.core/*print-fn*'
8 | ;; when calling `println` inside the evaluated code
9 | (enable-console-print!)
10 | (sci/alter-var-root sci/print-fn (constantly *print-fn*))
11 | (sci/alter-var-root sci/print-err-fn (constantly *print-err-fn*))
12 |
13 | (def full-ctx (doto (sci/init {})
14 | (sci/merge-opts fulcro-config/config)))
15 |
16 | (defn init []
17 | (println "Init run"))
18 |
19 | (defn reload []
20 | (println "Reload run"))
21 |
22 | (comment
23 | (sci/eval-string* (sci/init {}) "(+ 1 2)")
24 |
25 | (sci/eval-string* full-ctx "
26 | (ns test1
27 | (:require
28 | [com.fulcrologic.fulcro.algorithms.denormalize :as fdn]
29 | [com.fulcrologic.fulcro.application :as app]
30 | [com.fulcrologic.fulcro.components :as comp :refer [defsc]]
31 | [com.fulcrologic.fulcro.dom :as dom]))
32 |
33 | (defsc Root [this props] (dom/h3 \"Hello from Fulcro!\"))
34 | (defn build-ui-tree []
35 | (let [client-db (comp/get-initial-state Root {})]
36 | (fdn/db->tree (comp/get-query Root client-db) client-db client-db)))
37 | (comp/with-parent-context (app/fulcro-app)
38 | (dom/render-to-str ((comp/factory Root) (build-ui-tree))))
39 | ")
40 | ,)
41 |
--------------------------------------------------------------------------------
/.github/workflows/ci.yml:
--------------------------------------------------------------------------------
1 | name: ci
2 |
3 | on: [push, pull_request]
4 |
5 | jobs:
6 |
7 | clojure:
8 |
9 | strategy:
10 | matrix:
11 | os: [ubuntu-latest, macOS-latest, windows-latest]
12 |
13 | runs-on: ${{ matrix.os }}
14 |
15 | steps:
16 | - name: Checkout
17 | uses: actions/checkout@v3
18 |
19 | # It is important to install java before installing clojure tools which needs java
20 | # exclusions: babashka, clj-kondo and cljstyle
21 | - name: Prepare java
22 | uses: actions/setup-java@v3
23 | with:
24 | distribution: 'zulu'
25 | java-version: '11'
26 |
27 | - name: Install clojure tools
28 | uses: DeLaGuardo/setup-clojure@10.0
29 | with:
30 | bb: latest
31 |
32 | # Optional step:
33 | - name: Cache clojure dependencies
34 | uses: actions/cache@v3
35 | with:
36 | path: |
37 | ~/.m2/repository
38 | ~/.gitlibs
39 | ~/.deps.clj
40 | # List all files containing dependencies:
41 | key: cljdeps-${{ hashFiles('deps.edn') }}
42 | # key: cljdeps-${{ hashFiles('deps.edn', 'bb.edn') }}
43 | # key: cljdeps-${{ hashFiles('project.clj') }}
44 | # key: cljdeps-${{ hashFiles('build.boot') }}
45 | restore-keys: cljdeps-
46 |
47 | - name: npm install
48 | run: npm install
49 |
50 | - name: Run tests
51 | run: bb test
52 |
--------------------------------------------------------------------------------
/src/sci/configs/cljs/pprint.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.cljs.pprint
2 | (:require [cljs.pprint :as pp]
3 | [sci.core :as sci]))
4 |
5 | (def pns (sci/create-ns 'cljs.pprint nil))
6 |
7 | (defn ^:sci/macro with-pprint-dispatch
8 | "Execute body with the pretty print dispatch function bound to function."
9 | [_ _ function & body]
10 | `(cljs.core/binding [cljs.pprint/*print-pprint-dispatch* ~function]
11 | ~@body))
12 |
13 | (def print-pprint-dispatch (sci/new-dynamic-var '*print-pprint-dispatch*
14 | cljs.pprint/*print-pprint-dispatch* {:ns pns}))
15 |
16 | (defn pprint [& args]
17 | (binding [*print-fn* @sci/print-fn
18 | *print-newline* @sci/print-newline
19 | pp/*print-pprint-dispatch* @print-pprint-dispatch]
20 | (apply pp/pprint args)))
21 |
22 | (defn print-table [& args]
23 | (binding [*print-fn* @sci/print-fn
24 | *print-newline* @sci/print-newline]
25 | (apply pp/print-table args)))
26 |
27 | (defn cl-format [& args]
28 | (binding [*print-fn* @sci/print-fn
29 | *print-newline* @sci/print-newline]
30 | (apply pp/cl-format args)))
31 |
32 | (def cljs-pprint-namespace
33 | {'pprint (sci/copy-var pprint pns)
34 | '*print-pprint-dispatch* print-pprint-dispatch
35 | 'print-table (sci/copy-var print-table pns)
36 | 'cl-format (sci/copy-var cl-format pns)
37 | 'code-dispatch (sci/copy-var pp/code-dispatch pns)
38 | 'with-pprint-dispatch (sci/copy-var with-pprint-dispatch pns)})
39 |
40 | (def namespaces {'cljs.pprint cljs-pprint-namespace})
41 |
42 | (def config {:namespaces namespaces})
43 |
--------------------------------------------------------------------------------
/test/clojure/clojure_1_11_test.cljc:
--------------------------------------------------------------------------------
1 | (ns clojure.clojure-1-11-test
2 | (:require
3 | [clojure.test :refer [deftest is]]
4 | [sci.configs.clojure-1-11 :as core-namespace]
5 | [sci.core :as sci]))
6 |
7 | (defn ctx-fn [] (sci/init {:namespaces core-namespace/namespaces}))
8 |
9 | (deftest parse-functions-test
10 | (let [ctx (ctx-fn)]
11 | (is (= 1 (sci/eval-string* ctx "(parse-long \"1\")")))
12 | (is (= 1.5 (sci/eval-string* ctx "(parse-double \"1.5\")")))
13 | (is (= true (sci/eval-string* ctx "(parse-boolean \"true\")")))
14 | (is (= "00000000-0000-0000-0000-000000000000" (sci/eval-string* ctx "(str (parse-uuid \"00000000-0000-0000-0000-000000000000\"))")))))
15 |
16 | (deftest random-uuid-test
17 | (let [ctx (ctx-fn)]
18 | (is (= true (sci/eval-string* ctx "(uuid? (random-uuid \"00000000-0000-0000-0000-000000000000\"))")))))
19 |
20 | (deftest update-keys-test
21 | (let [ctx (ctx-fn)]
22 | (is (= {:a "1"} (sci/eval-string* ctx "(update-keys {\"a\" \"1\"} keyword)")))))
23 | (deftest update-vals-test
24 | (let [ctx (ctx-fn)]
25 | (is (= {"a" :1} (sci/eval-string* ctx "(update-vals {\"a\" \"1\"} keyword)")))))
26 |
27 | (deftest abs-test
28 | (let [ctx (ctx-fn)]
29 | (is (= 1 (sci/eval-string* ctx "(abs -1)")))))
30 |
31 | (deftest infinite?-test
32 | (let [ctx (ctx-fn)]
33 | (is (= true (sci/eval-string* ctx "(infinite? (/ 1.0 0))")))))
34 |
35 | (deftest NaN?-test
36 | (let [ctx (ctx-fn)]
37 | (is (= true (sci/eval-string* ctx "(NaN? (/ 0.0 0))")))))
38 |
39 | (deftest iteration-test
40 | (let [ctx (ctx-fn)]
41 | (is (= [1 2 3 4 5] (sci/eval-string* ctx "(vec (iteration identity {:somef #(< % 6) :kf inc :initk 1}))")))))
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/react/hooks.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.react.hooks
2 | (:require [sci.core :as sci]
3 | [com.fulcrologic.fulcro.react.hooks :as hooks])
4 | #_(:import (cljs.tagged_literals JSValue))) ; not avail. in cljs
5 |
6 | (defn ^:sci/macro use-effect
7 | ([_&form _&env f] `(hooks/useEffect ~f))
8 | ([_&form _&env f dependencies]
9 | (if true #_(enc/compiling-cljs?)
10 | (let [deps (cond
11 | (nil? dependencies) nil
12 | ; JH: Not sure how to translate this to a sci/macro...
13 | ;(instance? JSValue dependencies) dependencies
14 | ;:else (JSValue. dependencies)
15 | (instance? js/Array dependencies) dependencies
16 | (sequential? dependencies) (into-array dependencies)
17 |
18 | :else dependencies)]
19 | `(hooks/useEffect ~f ~deps))
20 | `(hooks/useEffect ~f ~dependencies))))
21 |
22 | (defn ^:sci/macro use-lifecycle
23 | ([_&form _&env setup] `(hooks/use-lifecycle &form &env ~setup nil))
24 | ([_&form _&env setup teardown]
25 | (cond
26 | (and setup teardown) `(hooks/use-effect (fn [] (~setup) ~teardown) [])
27 | setup `(hooks/use-effect (fn [] (~setup) ~(when true #_(enc/compiling-cljs?) 'js/undefined)) [])
28 | teardown `(hooks/use-effect (fn [] ~teardown) []))))
29 |
30 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.react.hooks))
31 | (def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.react.hooks sci-ns
32 | {:exclude [use-effect use-lifecycle]})
33 | 'use-effect (sci/copy-var use-effect sci-ns)
34 | 'use-lifecycle (sci/copy-var use-lifecycle sci-ns)))
35 |
36 | (def namespaces {'com.fulcrologic.fulcro.react.hooks ns-def})
--------------------------------------------------------------------------------
/.clj-kondo/com.fulcrologic/fulcro/config.edn:
--------------------------------------------------------------------------------
1 | {:hooks {:analyze-call {com.fulcrologic.fulcro.mutations/defmutation com.fulcrologic.fulcro.clj-kondo-hooks/defmutation
2 | com.fulcrologic.guardrails.core/>defn com.fulcrologic.fulcro.clj-kondo-hooks/>defn}}
3 | :linters {:clj-kondo.fulcro.defmutation/handler-arity {:level :error}
4 | :clj-kondo.fulcro.>defn/signature-mismatch {:level :error}}
5 | :lint-as {com.fulcrologic.fulcro.algorithms.normalized-state/swap!-> clojure.core/->
6 | com.fulcrologic.fulcro.components/defsc clojure.core/defn
7 | com.fulcrologic.fulcro.inspect.inspect-client/ido clojure.core/do
8 | com.fulcrologic.fulcro.inspect.inspect-client/ilet clojure.core/let
9 | com.fulcrologic.fulcro.mutations/declare-mutation clojure.core/def
10 | com.fulcrologic.fulcro.raw.components/defnc clojure.core/def
11 | com.fulcrologic.fulcro.routing.dynamic-routing/defrouter clojure.core/defn
12 | com.fulcrologic.fulcro.routing.legacy-ui-routers/defsc-router clojure.core/defn
13 | com.fulcrologic.fulcro.ui-state-machines/defstatemachine clojure.core/def
14 | com.fulcrologic.guardrails.core/>def clojure.core/def
15 | com.fulcrologic.guardrails.core/>defn clojure.core/defn
16 | com.fulcrologic.guardrails.core/>defn- clojure.core/defn-
17 | com.fulcrologic.rad.attributes/defattr clojure.core/def
18 | com.fulcrologic.rad.authorization/defauthenticator clojure.core/def
19 | com.fulcrologic.rad.form/defsc-form clojure.core/defn
20 | com.fulcrologic.rad.report/defsc-report clojure.core/defn}}
21 |
--------------------------------------------------------------------------------
/src/sci/configs/tonsky/datascript.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.tonsky.datascript
2 | (:require [datascript.core :as d]
3 | [datascript.db :as db]
4 | [sci.core :as sci :refer [copy-var]]))
5 |
6 | (def core-ns (sci/create-ns 'datascript.core nil))
7 | (def db-ns (sci/create-ns 'datascript.db nil))
8 |
9 | (def core-namespace
10 | {'q (copy-var d/q core-ns)
11 | 'empty-db (copy-var d/empty-db core-ns)
12 | 'db-with (copy-var d/db-with core-ns)
13 | 'filter (copy-var d/filter core-ns)
14 | 'init-db (copy-var d/init-db core-ns)
15 | 'datom (copy-var d/datom core-ns)
16 | 'datoms (copy-var d/datoms core-ns)
17 | 'pull (copy-var d/pull core-ns)
18 | 'pull-many (copy-var d/pull-many core-ns)
19 | 'entity (copy-var d/entity core-ns)
20 | 'tx0 (copy-var d/tx0 core-ns)
21 | 'db (copy-var d/db core-ns)
22 | 'squuid (copy-var d/squuid core-ns)
23 | 'with (copy-var d/with core-ns)
24 | 'touch (copy-var d/touch core-ns)
25 | 'index-range (copy-var d/index-range core-ns)
26 | 'listen! (copy-var d/listen! core-ns)
27 | 'conn-from-db (copy-var d/conn-from-db core-ns)
28 | 'conn-from-datoms (copy-var d/conn-from-datoms core-ns)
29 | 'transact! (copy-var d/transact! core-ns)
30 | 'create-conn (copy-var d/create-conn core-ns)
31 | 'reset-conn! (copy-var d/reset-conn! core-ns)
32 | 'from-serializable (copy-var d/from-serializable core-ns)
33 | 'serializable (copy-var d/serializable core-ns)})
34 |
35 | (def db-namespace
36 | {'db-from-reader (copy-var db/db-from-reader db-ns)
37 | 'datom-from-reader (copy-var db/datom-from-reader db-ns)
38 | 'datom-added (copy-var db/datom-added db-ns)
39 | 'datom-tx (copy-var db/datom-tx db-ns)
40 | 'datom (copy-var db/datom db-ns)
41 | 'DB (copy-var db/DB db-ns)
42 | 'Datom (copy-var db/Datom db-ns)})
43 |
44 | (def namespaces
45 | {'datascript.core core-namespace
46 | 'datascript.db db-namespace})
47 |
48 | (def config {:namespaces namespaces})
49 |
50 |
--------------------------------------------------------------------------------
/src/sci/configs/cjohansen/portfolio/core.cljc:
--------------------------------------------------------------------------------
1 | (ns sci.configs.cjohansen.portfolio.core
2 | (:require [sci.core :as sci]
3 | [clojure.pprint]
4 | [clojure.string :as str]))
5 |
6 | (def pcns (sci/create-ns 'portfolio.core nil))
7 |
8 | (defn portfolio-active? [] true)
9 |
10 | (defn function-like? [f]
11 | (or (symbol? f)
12 | (and (list? f) (= 'var (first f)))))
13 |
14 | (defn get-code-str [syms]
15 | (-> (for [sym syms]
16 | (with-out-str (clojure.pprint/pprint sym)))
17 | str/join
18 | str/trim
19 | (str/replace #"let\n\s+" "let ")
20 | (str/replace #"if\n\s+" "if ")
21 | (str/replace #"when\n\s+" "when ")))
22 |
23 | (defn get-options-map [id line syms]
24 | (let [docs (when (string? (first syms)) (first syms))
25 | pairs (partition-all 2 (drop (if docs 1 0) syms))
26 | rest (apply concat (drop-while (comp keyword? first) pairs))
27 | fn-like? (function-like? (first rest))]
28 | (->> pairs
29 | (take-while (comp keyword? first))
30 | (map vec)
31 | (into (cond
32 | (and (= 1 (count rest)) fn-like?)
33 | {:component-fn (first rest)}
34 |
35 | (and (not fn-like?)
36 | (or (not (vector? (first rest)))
37 | (= 1 (count rest))))
38 | {:component-fn `(fn [& _#]
39 | ~@rest)
40 | :code (get-code-str rest)}
41 |
42 | (< 1 (count rest))
43 | {:component-fn `(fn ~(cond-> (first rest)
44 | (< (count (first rest)) 2)
45 | (into ['& 'args]))
46 | ~@(drop 1 rest))
47 | :code (get-code-str (next rest))}))
48 | (into {:id (keyword (str *ns*) (str id))
49 | :line line
50 | :docs docs}))))
51 |
52 | (def portfolio-core-namespace
53 | {'portfolio-active? (sci/copy-var portfolio-active? pcns)
54 | 'get-options-map (sci/copy-var get-options-map pcns)})
55 |
56 |
--------------------------------------------------------------------------------
/test/cljs/test_test.cljs:
--------------------------------------------------------------------------------
1 | (ns cljs.test-test
2 | (:require
3 | [cljs.test :refer [deftest is]]
4 | [clojure.string :as str]
5 | [sci.configs.cljs.test :as t]
6 | [sci.core :as sci]
7 | [sci.ctx-store :as store]))
8 |
9 | (defn ctx-fn [] (sci/init {:namespaces {'cljs.test t/cljs-test-namespace}}))
10 |
11 |
12 | (deftest function?-test
13 | (let [ctx (ctx-fn)]
14 | (store/reset-ctx! ctx)
15 | (is (true? (sci/eval-string* ctx "
16 | (require '[cljs.test :as t])
17 | (t/function? 'inc)")))))
18 |
19 | (deftest deftest-test
20 | (let [output (atom "")
21 | ctx (ctx-fn)]
22 | (store/reset-ctx! ctx)
23 | (sci/binding [sci/print-fn (fn [s]
24 | (swap! output str s))]
25 | (sci/eval-string* ctx "
26 | (ns foo)
27 | (require '[cljs.test :as t :refer [deftest is testing]])
28 | (deftest foo
29 | (is (= 1 1)))
30 | (cljs.test/run-tests 'foo)"))
31 | (is (str/includes? @output "1 assertions"))
32 | (is (str/includes? @output "0 failures"))
33 | (is (str/includes? @output "0 errors"))))
34 |
35 | (deftest test-vars-test
36 | (let [output (atom "")
37 | ctx (ctx-fn)]
38 | (store/reset-ctx! ctx)
39 | (sci/binding [sci/print-fn (fn [s]
40 | (swap! output str s))]
41 | (is (= [:each-before :each-after]
42 | (sci/eval-string* ctx "
43 | (ns foo)
44 | (require '[cljs.test :as t :refer [deftest is testing]])
45 |
46 | (def state (atom []))
47 |
48 | (t/use-fixtures :each
49 | {:before
50 | (fn []
51 | (swap! state conj :each-before))
52 | :after
53 | (fn []
54 | (swap! state conj :each-after))})
55 |
56 | (deftest foo
57 | (is (= 1 1)))
58 |
59 | (t/test-vars [#'foo])
60 |
61 | @state"))))))
62 |
63 | (deftest run-all-tests-test
64 | (let [output (atom "")
65 | ctx (ctx-fn)]
66 | (store/reset-ctx! ctx)
67 | (sci/binding [sci/print-fn (fn [s]
68 | (swap! output str s))]
69 | (sci/eval-string* ctx "
70 | (ns foo)
71 | (require '[cljs.test :as t :refer [deftest is testing]])
72 | (deftest foo
73 | (is (= 1 1)))
74 |
75 | (ns bar)
76 | (require '[cljs.test :as t :refer [deftest is testing]])
77 | (deftest foo
78 | (is (= 1 1)))
79 |
80 | (t/run-all-tests)"))
81 | (is (str/includes? @output "Testing cljs.test"))
82 | (is (str/includes? @output "2 tests"))
83 | (is (str/includes? @output "2 assertions"))
84 | (is (str/includes? @output "0 failures"))
85 | (is (str/includes? @output "0 errors"))))
86 |
87 | (defn run-tests []
88 | (cljs.test/run-tests 'cljs.test-test))
89 |
--------------------------------------------------------------------------------
/.clj-kondo/com.fulcrologic/fulcro/com/fulcrologic/fulcro/clj_kondo_hooks.clj:
--------------------------------------------------------------------------------
1 | (ns com.fulcrologic.fulcro.clj-kondo-hooks
2 | (:require [clj-kondo.hooks-api :as api]))
3 |
4 | (defn defmutation
5 | [{:keys [node]}]
6 | (let [args (rest (:children node))
7 | mutation-name (first args)
8 | ?docstring (when (string? (api/sexpr (second args)))
9 | (second args))
10 | args (if ?docstring
11 | (nnext args)
12 | (next args))
13 | params (first args)
14 | handlers (rest args)
15 | handler-syms (map (comp first :children) handlers)
16 | bogus-usage (api/vector-node (vec handler-syms))
17 | letfn-node (api/list-node
18 | (list
19 | (api/token-node 'letfn)
20 | (api/vector-node (vec handlers))
21 | bogus-usage))
22 | new-node (api/list-node
23 | (list
24 | (api/token-node 'defn)
25 | mutation-name
26 | params
27 | letfn-node))]
28 | (doseq [handler handlers]
29 | (let [hname (some-> handler :children first api/sexpr str)
30 | argv (some-> handler :children second)]
31 | (when-not (= 1 (count (api/sexpr argv)))
32 | (api/reg-finding! (merge
33 | (meta argv)
34 | {:message (format "defmutation handler '%s' should be a fn of 1 arg" hname)
35 | :type :clj-kondo.fulcro.defmutation/handler-arity})))))
36 | {:node new-node}))
37 |
38 | (defn >defn
39 | [{:keys [node]}]
40 | (let [args (rest (:children node))
41 | fn-name (first args)
42 | ?docstring (when (string? (api/sexpr (second args)))
43 | (second args))
44 | args (if ?docstring
45 | (nnext args)
46 | (next args))
47 | argv (first args)
48 | gspec (second args)
49 | body (nnext args)
50 | new-node (api/list-node
51 | (list*
52 | (api/token-node 'defn)
53 | fn-name
54 | argv
55 | gspec
56 | body))]
57 | (when (not= (count (api/sexpr argv))
58 | (count (take-while #(not= '=> %) (api/sexpr gspec))))
59 | (api/reg-finding! (merge (meta gspec)
60 | {:message "Guardrail spec does not match function signature"
61 | :type :clj-kondo.fulcro.>defn/signature-mismatch})))
62 | {:node new-node}))
--------------------------------------------------------------------------------
/playground/www/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 | SCI Playground
7 |
8 |
9 |
10 | SCI Playground
11 | Write and evaluate SCI Clojure using any of the libraries in sci.configs
12 | in the editor below. Use Cmd / Ctr - Enter to evaluate.
13 | Supported libraries: todo.
14 |
15 | (ns test1
16 | (:require
17 | [applied-science.js-interop :as j]
18 | [promesa.core :as p]
19 | [cljs-bean.core :refer [bean ->clj ->js]]
20 | [re-frame.core :as rf]
21 | [re-frame.db :as rf.db]
22 | [re-frame.alpha :as rf.a]
23 | [reagent.core :as r]
24 | [reagent.dom.server :as rds]
25 | [reagent.dom.client :as rdc]
26 | [reagent.debug]
27 | [replicant.dom :as replicant]
28 | [portfolio.replicant :refer-macros [defscene]]
29 | [portfolio.ui :as portfolio]
30 | [reagent.ratom :as ratom]
31 | [reitit.frontend :as reitit]
32 | [datascript.core :as d]
33 | [datascript.db :as d.db]
34 | [dataspex.core :as dataspex]
35 | [com.fulcrologic.fulcro.application :as app]
36 | [com.fulcrologic.fulcro.components :as comp :refer [defsc]]
37 | [com.fulcrologic.fulcro.dom :as dom]
38 | [javelin.core :as jc]))
39 |
40 | (def router
41 | (reitit/router
42 | [["/api/ping" ::ping]
43 | ["/api/orders/:id" ::order]]))
44 | (reitit/match-by-path router "/api/ping")
45 |
46 | (defscene hello
47 | [:h1 "hello Portfolio"])
48 |
49 | (defsc Root [this props]
50 | (dom/div (dom/h3 "Hello from SCI!")
51 | (dom/p "Here you can play with Fulcro and Reagent apps and much more!")))
52 |
53 | (def my-fulcro-app (app/fulcro-app))
54 | (app/mount! my-fulcro-app Root "app")
55 |
56 | ;; Inspect anything with dataspex (make sure to install the browser extension https://github.com/cjohansen/dataspex/tree/main?tab=readme-ov-file#chrome-extension)
57 | (dataspex/inspect "My fulcro app" my-fulcro-app)
58 |
59 | (replicant/render (.getElementById js/document "app") [:h1 "Hello Replicant!"])
60 |
61 |
62 | You can use this <div id="app"> to render DOM.
63 |
64 |
65 | Auto-evaluation GitHub gists
66 | You can automatically load and evaluate a gist
67 | by appending ?gist=GIST-ID to the URL. All clj* files from the gist are loaded
68 | into the editor in the order of their names and evaluated automatically. You can
69 | try our test gist (by clicking here).
70 |
71 | Playground source code
72 |
73 |
74 |
75 |
76 |
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/fulcro.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.fulcro
2 | "The root of all SCI configuration for Fulcro.
3 |
4 | == Example
5 |
6 | ```clj
7 | (ns demo
8 | (:require [sci.core :as sci]
9 | [sci.configs.fulcro.fulcro :as fulcro]))
10 | (def sci-ctx (doto (sci/init {}) (sci/merge-opts fulcro/config)))
11 | (sci/eval-string* sci-ctx
12 | \"(ns page
13 | (:require
14 | [com.fulcrologic.fulcro.application :as app]
15 | [com.fulcrologic.fulcro.components :as comp :refer [defsc]]
16 | [com.fulcrologic.fulcro.dom :as dom]))
17 | (defsc Root [this props] (dom/h3 \\\"Hello from Fulcro!\\\"))
18 | (let [app (app/fulcro-app {})]
19 | (app/mount! app Root \\\"sciapp\\\"))\")
20 | ```
21 |
22 | == Status
23 |
24 | Early alpha. Many namespaces aren't exposed yet, and there are certainly
25 | bugs in how macros were ported to SCI."
26 | (:require [sci.configs.fulcro.algorithms.data-targeting :as dt]
27 | [sci.configs.fulcro.algorithms.denormalize :as fdn]
28 | [sci.configs.fulcro.algorithms.form-state :as fs]
29 | [sci.configs.fulcro.algorithms.lookup :as ah]
30 | [sci.configs.fulcro.algorithms.merge :as merge]
31 | [sci.configs.fulcro.algorithms.normalize :as fnorm]
32 | [sci.configs.fulcro.algorithms.react-interop :as interop]
33 | [sci.configs.fulcro.algorithms.tempid :as tempid]
34 | [sci.configs.fulcro.algorithms.tx-processing.synchronous-tx-processing :as stx]
35 | [sci.configs.fulcro.application :as app]
36 | [sci.configs.fulcro.component :as comp]
37 | [sci.configs.fulcro.data-fetch :as df]
38 | [sci.configs.fulcro.dom :as dom]
39 | [sci.configs.fulcro.mutations :as m]
40 | [sci.configs.fulcro.networking.http-remote :as http-remote]
41 | [sci.configs.fulcro.raw.component :as rc]
42 | [sci.configs.fulcro.react.hooks :as hooks]
43 | [sci.configs.fulcro.react.version18 :as version18]
44 | [sci.configs.fulcro.routing.dynamic-routing :as dr]
45 | [sci.configs.fulcro.ui-state-machines :as uism]
46 | [sci.core :as sci]
47 | [edn-query-language.core]))
48 |
49 | (def eql-sci-ns (sci/create-ns 'edn-query-language.core))
50 | (def eql-ns-def (sci/copy-ns edn-query-language.core eql-sci-ns {}))
51 |
52 | (def namespaces
53 | (merge
54 | {'edn-query-language.core eql-ns-def}
55 | ah/namespaces
56 | app/namespaces
57 | comp/namespaces
58 | df/namespaces
59 | dom/namespaces
60 | dr/namespaces
61 | dt/namespaces
62 | fdn/namespaces
63 | fnorm/namespaces
64 | fs/namespaces
65 | http-remote/namespaces
66 | interop/namespaces
67 | merge/namespaces
68 | m/namespaces
69 | rc/namespaces
70 | hooks/namespaces
71 | stx/namespaces
72 | tempid/namespaces
73 | uism/namespaces
74 | version18/namespaces))
75 |
76 | (def config {:namespaces namespaces})
77 |
--------------------------------------------------------------------------------
/src/sci/configs/cjohansen/replicant.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.cjohansen.replicant
2 | (:require [replicant.alias :as ra]
3 | [replicant.dom :as rd]
4 | [replicant.string :as rs]
5 | [sci.core :as sci]
6 | [replicant.assert :as assert]))
7 |
8 | (def rdns (sci/create-ns 'replicant.dom nil))
9 |
10 | (def replicant-dom-namespace
11 | {'render (sci/copy-var rd/render rdns)
12 | 'unmount (sci/copy-var rd/unmount rdns)
13 | 'set-dispatch! (sci/copy-var rd/set-dispatch! rdns)})
14 |
15 | (def rsns (sci/create-ns 'replicant.string nil))
16 |
17 | (def replicant-string-namespace
18 | {'create-renderer (sci/copy-var rs/create-renderer rsns)
19 | 'render (sci/copy-var rs/render rsns)})
20 |
21 | (def rans (sci/create-ns 'replicant.alias nil))
22 |
23 | (defn ^:sci/macro aliasfn
24 | "Define a function to use as an alias function. Creates a function that wraps
25 | returned hiccup with debugging meta data when Replicant asserts are
26 | enabled (e.g. during development). When asserts are not enabled (default for
27 | production builds), creates a regular function with no added overhead.
28 |
29 | `aliasfn` is most commonly used through `defalias`"
30 | [_ _ alias & forms]
31 | (let [[_docstring [attr-map & body]]
32 | (if (string? (first forms))
33 | [(first forms) (next forms)]
34 | ["" forms])
35 | n-args (count attr-map)
36 | attr-map (cond
37 | (= 0 n-args)
38 | '[_ _]
39 |
40 | (= 1 n-args)
41 | (conj attr-map '_)
42 |
43 | :else
44 | attr-map)]
45 | (if (assert/assert?)
46 | `(with-meta
47 | (fn [& args#]
48 | (let [~attr-map args#
49 | res# (do ~@body)]
50 | (cond-> res#
51 | (vector? res#)
52 | (with-meta
53 | {:replicant/context
54 | {:alias ~alias
55 | :data (first args#)}}))))
56 | {:replicant/alias ~alias})
57 | `(with-meta (fn ~attr-map ~@body) {:replicant/alias ~alias}))))
58 |
59 | (defn ^:sci/macro defalias
60 | "Creates a function to render `alias` (a namespaced keyword), and registers
61 | it in the global registry. See `aliasfn` for details about the created function.
62 | The global registry is available through `replicant.alias/get-registered-aliases`."
63 | [_ _ alias & forms]
64 | (let [alias-kw (keyword (deref sci/ns) #_(str *ns*) (name alias))
65 | alias-f `(replicant.alias/aliasfn ~alias-kw ~@forms)]
66 | `(let [f# ~alias-f
67 | alias# ~alias-kw]
68 | (replicant.alias/register! alias# f#)
69 | (def ~alias alias#))))
70 |
71 | (def replicant-alias-namespace
72 | {'register! (sci/copy-var ra/register! rsns)
73 | 'aliasfn (sci/copy-var aliasfn rsns)
74 | 'defalias (sci/copy-var defalias rsns)})
75 |
76 | (def replicant-assert-namespace
77 | (sci/copy-ns replicant.assert (sci/create-ns 'replicant.assert nil)))
78 |
79 | (def namespaces {'replicant.dom replicant-dom-namespace
80 | 'replicant.string replicant-string-namespace
81 | 'replicant.alias replicant-alias-namespace
82 | 'replicant.assert replicant-assert-namespace})
83 |
84 | (def config {:namespaces namespaces})
85 |
--------------------------------------------------------------------------------
/.clj-kondo/com.fulcrologic/guardrails/com/fulcrologic/guardrails/clj_kondo_hooks.clj:
--------------------------------------------------------------------------------
1 | (ns com.fulcrologic.guardrails.clj-kondo-hooks
2 | (:require [clj-kondo.hooks-api :as api]))
3 |
4 | (def =>? #{'=> :ret})
5 | (def |? #{'| :st})
6 | (def known-sym? #{'=> '| '<-})
7 |
8 | (defn args+gspec+body [nodes]
9 | (let [argv (first nodes)
10 | gspec (second nodes)
11 | body (nnext nodes)
12 | gspec' (->> gspec
13 | (:children)
14 | (filterv #(-> % :value known-sym? not))
15 | (api/vector-node))
16 | new-nodes (list* argv gspec' body)]
17 | ;; gspec: [arg-specs* (| arg-preds+)? => ret-spec (| fn-preds+)? (<- generator-fn)?]
18 | (if (not= 1 (count (filter =>? (api/sexpr gspec))))
19 | (api/reg-finding! (merge (meta gspec)
20 | {:message (str "Gspec requires exactly one `=>` or `:ret`")
21 | :type :clj-kondo.fulcro.>defn/invalid-gspec}))
22 | (let [p (partition-by (comp not =>? api/sexpr) (:children gspec))
23 | [arg [=>] [ret-spec & _output]] (if (-> p ffirst api/sexpr =>?)
24 | (cons [] p) ; arg-specs might be empty
25 | p)
26 | [arg-specs [| & arg-preds]] (split-with (comp not |? api/sexpr) arg)]
27 |
28 | (when-not ret-spec
29 | (println =>)
30 | (api/reg-finding! (merge (meta =>)
31 | {:message "Missing return spec."
32 | :type :clj-kondo.fulcro.>defn/invalid-gspec})))
33 |
34 | ;; (| arg-preds+)?
35 | (when (and | (empty? arg-preds))
36 | (api/reg-finding! (merge (meta |)
37 | {:message "Missing argument predicates after |."
38 | :type :clj-kondo.fulcro.>defn/invalid-gspec})))
39 |
40 |
41 | (let [len-argv (count (remove #{'&} (api/sexpr argv))) ; [a & more] => 2 arguments
42 | arg-difference (- (count arg-specs) len-argv)]
43 | (when (not (zero? arg-difference))
44 | (let [too-many-specs? (pos? arg-difference)]
45 | (api/reg-finding! (merge
46 | (meta (if too-many-specs?
47 | (nth arg-specs (+ len-argv arg-difference -1)) ; first excess spec
48 | gspec)) ; The gspec is wrong, not the surplus argument.
49 | {:message (str "Guardrail spec does not match function signature. "
50 | "Too " (if too-many-specs? "many" "few") " specs.")
51 | :type :clj-kondo.fulcro.>defn/invalid-gspec})))))))
52 | new-nodes))
53 |
54 | (defn >defn
55 | [{:keys [node]}]
56 | (let [args (rest (:children node))
57 | fn-name (first args)
58 | ?docstring (when (some-> (second args) api/sexpr string?)
59 | (second args))
60 | args (if ?docstring
61 | (nnext args)
62 | (next args))
63 | post-docs (if (every? #(-> % api/sexpr list?) args)
64 | (mapv #(-> % :children args+gspec+body api/list-node) args)
65 | (args+gspec+body args))
66 | post-name (if ?docstring
67 | (list* ?docstring post-docs)
68 | post-docs)
69 | new-node (api/list-node
70 | (list*
71 | (api/token-node 'defn)
72 | fn-name
73 | post-name))]
74 | {:node new-node}))
75 |
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/mutations.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.mutations
2 | (:require [sci.configs.fulcro.fulcro-sci-helpers :as ana]
3 | [cljs.spec.alpha :as s]
4 | [clojure.string :as str]
5 | [sci.core :as sci]
6 | [com.fulcrologic.fulcro.algorithms.lookup :as ah]
7 | com.fulcrologic.fulcro.mutations))
8 |
9 | (defn ^:sci/macro declare-mutation [_&form _&env name target-symbol]
10 | `(def ~name (m/->Mutation '~target-symbol)))
11 |
12 | (s/def ::handler (s/cat
13 | :handler-name symbol?
14 | :handler-args (fn [a] (and (vector? a) (= 1 (count a))))
15 | :handler-body (s/+ (constantly true))))
16 |
17 | (s/def ::mutation-args (s/cat
18 | :sym symbol?
19 | :doc (s/? string?)
20 | :arglist (fn [a] (and (vector? a) (= 1 (count a))))
21 | :sections (s/* (s/or :handler ::handler))))
22 |
23 | (defn ^:sci/macro defmutation [_&form macro-env args]
24 | ;; Body of defmutation*
25 | (let [conform! (fn [element spec value]
26 | (when-not (s/valid? spec value)
27 | (throw (ana/error macro-env (str "Syntax error in " element ": " (s/explain-str spec value)))))
28 | (s/conform spec value))
29 | {:keys [sym doc arglist sections]} (conform! "defmutation" ::mutation-args args)
30 | fqsym (if (namespace sym)
31 | sym
32 | (symbol (str (deref sci.core/ns)) #_(name (ns-name *ns*)) (name sym)))
33 | handlers (reduce (fn [acc [_ {:keys [handler-name handler-args handler-body]}]]
34 | (let [action? (str/ends-with? (str handler-name) "action")]
35 | (into acc
36 | (if action?
37 | [(keyword (name handler-name)) `(fn ~handler-name ~handler-args
38 | (binding [com.fulcrologic.fulcro.raw.components/*after-render* true]
39 | ~@handler-body)
40 | nil)]
41 | [(keyword (name handler-name)) `(fn ~handler-name ~handler-args ~@handler-body)]))))
42 | []
43 | sections)
44 | ks (into #{} (filter keyword?) handlers)
45 | result-action? (contains? ks :result-action)
46 | env-symbol 'fulcro-mutation-env-symbol
47 | method-map (if result-action?
48 | `{~(first handlers) ~@(rest handlers)}
49 | `{~(first handlers) ~@(rest handlers)
50 | :result-action (fn [~'env]
51 | (binding [com.fulcrologic.fulcro.raw.components/*after-render* true]
52 | (when-let [~'default-action (ah/app-algorithm (:app ~'env) :default-result-action!)]
53 | (~'default-action ~'env))))})
54 | doc (or doc "")
55 | multimethod `(defmethod com.fulcrologic.fulcro.mutations/mutate '~fqsym [~env-symbol]
56 | (let [~(first arglist) (-> ~env-symbol :ast :params)]
57 | ~method-map))]
58 | (if (= fqsym sym)
59 | multimethod
60 | `(do
61 | (def ~(with-meta sym {:doc doc}) (com.fulcrologic.fulcro.mutations/->Mutation '~fqsym))
62 | ~multimethod))))
63 |
64 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.mutations))
65 | (def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.mutations sci-ns
66 | {:exclude [declare-mutation defmutation]})
67 | 'declare-mutation (sci/copy-var declare-mutation sci-ns)
68 | 'defmutation (sci/copy-var defmutation sci-ns)))
69 |
70 | (def namespaces {'com.fulcrologic.fulcro.mutations ns-def})
--------------------------------------------------------------------------------
/src/sci/configs/applied_science/js_interop.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.applied-science.js-interop
2 | (:refer-clojure :exclude [let fn defn spread])
3 | (:require
4 | [applied-science.js-interop :as j]
5 | [applied-science.js-interop.destructure :as d]
6 | [clojure.core :as c]
7 | [sci.core :as sci]))
8 |
9 | (def jns (sci/create-ns 'applied-science.js-interop nil))
10 |
11 | (c/defn ^:macro let
12 | "`let` with destructuring that supports js property and array access.
13 | Use ^:js metadata on the binding form to invoke. Eg/
14 | (let [^:js {:keys [a]} obj] …)"
15 | [_ _ bindings & body]
16 | (if (empty? bindings)
17 | `(do ~@body)
18 | `(~'clojure.core/let ~(vec (d/destructure (take 2 bindings)))
19 | (~'applied-science.js-interop/let
20 | ~(vec (drop 2 bindings))
21 | ~@body))))
22 |
23 | (c/defn ^:macro fn
24 | "`fn` with argument destructuring that supports js property and array access.
25 | Use ^:js metadata on binding forms to invoke. Eg/
26 | (fn [^:js {:keys [a]}] …)"
27 | [_ _ & args]
28 | (cons 'clojure.core/fn (d/destructure-fn-args args)))
29 |
30 | (c/defn ^:macro defn
31 | "`defn` with argument destructuring that supports js property and array access.
32 | Use ^:js metadata on binding forms to invoke."
33 | [_ _ & args]
34 | (cons 'clojure.core/defn (d/destructure-fn-args args)))
35 |
36 | (c/defn litval* [v]
37 | (if (keyword? v)
38 | (cond->> (name v)
39 | (namespace v)
40 | (str (namespace v) "/"))
41 | v))
42 |
43 | (declare lit*)
44 |
45 | (defn- spread
46 | "For ~@spread values, returns the unwrapped value,
47 | otherwise returns nil."
48 | [x]
49 | (when (and (seq? x)
50 | (= 'clojure.core/unquote-splicing (first x)))
51 | (second x)))
52 |
53 | (defn- tagged-sym [tag] (with-meta (gensym (name tag)) {:tag tag}))
54 |
55 | (c/defn lit*
56 | "Recursively converts literal Clojure maps/vectors into JavaScript object/array expressions
57 | Options map accepts a :keyfn for custom key conversions."
58 | ([x]
59 | (lit* nil x))
60 | ([{:as opts
61 | :keys [keyfn valfn env]
62 | :or {keyfn identity
63 | valfn litval*}} x]
64 | (cond (map? x)
65 | (list* 'applied-science.js-interop/obj
66 | (reduce-kv #(conj %1 (keyfn %2) (lit* opts %3)) [] x))
67 | (vector? x)
68 | (if (some spread x)
69 | (c/let [sym (tagged-sym 'js/Array)]
70 | `(c/let [~sym (~'cljs.core/array)]
71 | ;; handling the spread operator
72 | ~@(for [x'
73 | ;; chunk array members into spreads & non-spreads,
74 | ;; so that sequential non-spreads can be lumped into
75 | ;; a single .push
76 | (->> (partition-by spread x)
77 | (mapcat (clojure.core/fn [x]
78 | (if (spread (first x))
79 | x
80 | (list x)))))]
81 | (if-let [x' (spread x')]
82 | (if false
83 | ;; for now disable this optimization
84 | #_(and env (inf/tag-in? env '#{array} x'))
85 | `(.forEach ~x' (c/fn [x#] (.push ~sym x#)))
86 | `(doseq [x# ~(lit* x')] (.push ~sym x#)))
87 | `(.push ~sym ~@(map lit* x'))))
88 | ~sym))
89 | (list* 'cljs.core/array (mapv lit* x)))
90 | :else (valfn x))))
91 |
92 | (c/defn ^:macro lit
93 | "Recursively converts literal Clojure maps/vectors into JavaScript object/array expressions
94 | (using j/obj and cljs.core/array)"
95 | [_ &env form]
96 | (lit* {:env &env} form))
97 |
98 | (def js-interop-namespace
99 | {'get (sci/copy-var j/get jns)
100 | 'get-in (sci/copy-var j/get-in jns)
101 | 'contains? (sci/copy-var j/contains? jns)
102 | 'select-keys (sci/copy-var j/select-keys jns)
103 | 'lookup (sci/copy-var j/lookup jns)
104 | 'assoc! (sci/copy-var j/assoc! jns)
105 | 'assoc-in! (sci/copy-var j/assoc-in! jns)
106 | 'update! (sci/copy-var j/update! jns)
107 | 'update-in! (sci/copy-var j/update-in! jns)
108 | 'extend! (sci/copy-var j/extend! jns)
109 | 'push! (sci/copy-var j/push! jns)
110 | 'unshift! (sci/copy-var j/unshift! jns)
111 | 'call (sci/copy-var j/call jns)
112 | 'apply (sci/copy-var j/apply jns)
113 | 'call-in (sci/copy-var j/call-in jns)
114 | 'apply-in (sci/copy-var j/apply-in jns)
115 | 'obj (sci/copy-var j/obj jns)
116 | 'let (sci/copy-var let jns)
117 | 'fn (sci/copy-var fn jns)
118 | 'defn (sci/copy-var defn jns)
119 | 'lit (sci/copy-var lit jns)})
120 |
121 | (def namespaces
122 | {'applied-science.js-interop js-interop-namespace})
123 |
124 | (def config
125 | {:namespaces namespaces})
126 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # SCI configs
2 |
3 | A collection of ready to be used SCI configs.
4 |
5 | This repository provides SCI configurations on the classpath. See the `:dev`
6 | alias to check against which version of the libraries the configurations are
7 | tested. You should bring in the dependency of targeted libraries yourself.
8 |
9 | In general, a configuration can be enabled as in the following example for `applied-science.js-interop`:
10 |
11 | ``` clojure
12 | (ns example
13 | (:require [sci.configs.applied-science.js-interop :as j]
14 | [sci.core :as sci]))
15 |
16 | (def sci-ctx (doto (sci/init {}) ;; your initial config here
17 | (sci/merge-opts j/config)))
18 |
19 | (sci/eval-string* sci-ctx
20 | "(require '[applied-science.js-interop :as j]) (j/assoc! #js {} :foo 1)")
21 | ;;=> #js {:foo 1}
22 | ```
23 |
24 | or if you like to include the config without calling `sci/merge-opts` (e.g. for
25 | performance reasons), use the per-namespace values directly:
26 |
27 | ``` clojure
28 | (ns example
29 | (:require [sci.configs.applied-science.js-interop :as j]
30 | [sci.core :as sci]))
31 |
32 | (def sci-ctx (sci/init {:namespaces {'applied-science.js-interop j/js-interop-namespace}}))
33 | ```
34 |
35 | ## API
36 |
37 | In general, only `library/*-namespace` and `library/config` vars are intented as the
38 | public API. The rest is subject to breakage, even when vars are public. For
39 | convenience, we list the public API for each library here.
40 |
41 | ## Libraries
42 |
43 | ### [applied-science/js-interop](https://github.com/applied-science/js-interop)
44 |
45 | Namespace: `sci.configs.applied-science.js-interop`
46 |
47 | Public API:
48 |
49 | - `config`
50 | - `js-interop-namespace`
51 | - `namespaces`
52 |
53 | ### [com.fulcrologic/fulcro](https://github.com/fulcro/fulcro)
54 |
55 | Namespace: `sci.configs.fulcro.fulcro`
56 |
57 | Public API:
58 |
59 | - `config`
60 | - `namespaces`
61 |
62 | ### [cjohansen/dataspex](https://github.com/cjohansen/dataspex)
63 |
64 | Namespace: `sci.configs.cjohansen.dataspex`
65 |
66 | Public API:
67 |
68 | - `config`
69 | - `dataspex-core-namespace`
70 | - `namespaces`
71 |
72 |
73 | ### [cjohansen/replicant](https://github.com/cjohansen/replicant)
74 |
75 | Namespace: `sci.configs.cjohansen.replicant`
76 |
77 | Public API:
78 |
79 | - `config`
80 | - `replicant-dom-namespace`
81 | - `replicant-string-namespace`
82 | - `replicant-alias-namespace`
83 | - `namespaces`
84 |
85 | ### [funcool/promesa](https://github.com/funcool/promesa)
86 |
87 | Namespace: `sci.configs.funcool.promesa`
88 |
89 | Public API:
90 |
91 | - `config`
92 | - `promesa-namespace`
93 | - `promesa-protocols-namespace`
94 | - `namespaces`
95 |
96 | ### [metosin/reitit](https://github.com/metosin/reitit)
97 |
98 | Namespace: `sci.configs.metosin.reitit`
99 |
100 | Public API:
101 |
102 | - `config`
103 | - `frontend-namespace`
104 | - `frontend-easy-namespace`
105 | - `namespaces`
106 |
107 | ### [reagent/reagent](https://github.com/reagent-project/reagent)
108 |
109 | Namespace: `sci.configs.reagent.reagent`
110 |
111 | Public API:
112 |
113 | - `config`
114 | - `reagent-namespace`
115 | - `reagent-ratom-namespace`
116 | - `reagent-debug-namespace`
117 | - `namespaces`
118 |
119 | Configurations for `reagent.dom.server` and `reagent.dom.client` are available seperately via:
120 |
121 | Namespace: `sci.configs.reagent.reagent-dom-server`
122 |
123 | Public API:
124 |
125 | - `config`
126 | - `reagent-dom-server-namespace`
127 |
128 | Namespace: `sci.configs.reagent.reagent-dom-client`
129 |
130 | Public API:
131 |
132 | - `config`
133 | - `reagent-dom-server-namespace`
134 |
135 | ### [re-frame/re-frame](https://github.com/day8/re-frame)
136 |
137 | Namespace: `sci.configs.re-frame.re-frame`
138 |
139 | Public API:
140 |
141 | - `config`
142 | - `re-frame-namespace`
143 | - `re-frame-db-namespace`
144 | - `namespaces`
145 |
146 | The configuration for `re-frame.alpha` is available seperately via:
147 |
148 | Namespace: `sci.configs.re-frame.re-frame-alpha`
149 |
150 | Public API:
151 |
152 | - `config`
153 | - `re-frame-alpha-namespace`
154 |
155 | ### [mfikes/cljs-bean](https://github.com/mfikes/cljs-bean)
156 |
157 | Namespace: `sci.configs.mfikes.cljs-bean`
158 |
159 | Public API:
160 |
161 | - `config`
162 | - `namespaces`
163 | - `cljs-bean-namespace`
164 |
165 | ### [cljs.test](https://cljs.github.io/api/cljs.test/)
166 |
167 | Namespace `sci.configs.cljs.test`
168 |
169 | Public API:
170 |
171 | - `config`
172 | - `namespaces`
173 | - `cljs-test-namespace`
174 |
175 | ### [cljs.pprint](https://cljs.github.io/api/cljs.pprint/)
176 |
177 | Public API:
178 |
179 | - `config`
180 | - `namespaces`
181 | - `cljs-pprint-namespace`
182 |
183 | ### [tonsky/datascript](https://github.com/tonsky/datascript)
184 |
185 | Public API:
186 |
187 | - `config`
188 | - `namespaces`
189 | - `core-namespace`
190 | - `db-namespace`
191 |
192 | ### clojure-1-11
193 |
194 | Namespace: `clojure.core`
195 |
196 | New functions added to clojure.core in version 1.11
197 |
198 | - `namespaces`
199 |
200 | ### cljs.spec.alpha
201 |
202 | Namespaces: `cljs.spec.alpha`, `cljs.spec.gen.alpha`, `cljs.spec.test.alpha`
203 |
204 | Public API:
205 |
206 | - `config`
207 | - `namespaces`
208 |
209 | ## Contributing
210 |
211 | `npm install` and `bb test`
212 |
213 | ### Development
214 |
215 | 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`.
216 |
217 | ## License
218 |
219 | The configurations are licensed under the same licenses as the libraries they
220 | target. You are free to take the configs from this repository and adapt them as
221 | necessary for your projects. See LICENSE for additional info.
222 |
--------------------------------------------------------------------------------
/src/sci/configs/reagent/reagent.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.reagent.reagent
2 | (:require
3 | [reagent.core :as r]
4 | [reagent.debug :as d :refer-macros [dev?]]
5 | [reagent.ratom :as ratom]
6 | [sci.core :as sci]))
7 |
8 | ;; The with-let macro from reagent.core. The only change is that the
9 | ;; interop/unchecked-aget+set were replaced by aget and aset.
10 | (defn ^:macro with-let [_ _ bindings & body]
11 | (assert (vector? bindings)
12 | (str "with-let bindings must be a vector, not "
13 | (pr-str bindings)))
14 | (let [v (gensym "with-let")
15 | k (keyword v)
16 | init (gensym "init")
17 | ;; V is a reaction, which holds a JS array.
18 | ;; If the array is empty, initialize values and store to the
19 | ;; array, using binding index % 2 to access the array.
20 | ;; After init, the bindings are just bound to the values in the array.
21 | bs (into [init `(zero? (alength ~v))]
22 | (map-indexed (fn [i x]
23 | (if (even? i)
24 | x
25 | (let [j (quot i 2)]
26 | ;; Issue 525
27 | ;; If binding value is not yet set,
28 | ;; try setting it again. This should
29 | ;; also throw errors for each render
30 | ;; and prevent the body being called
31 | ;; if bindings throw errors.
32 | `(if (or ~init
33 | (not (.hasOwnProperty ~v ~j)))
34 | (aset ~v ~j ~x)
35 | (aget ~v ~j)))))
36 | bindings))
37 | [forms destroy] (let [fin (last body)]
38 | (if (and (seq? fin)
39 | (= 'finally (first fin)))
40 | [(butlast body) `(fn [] ~@(rest fin))]
41 | [body nil]))
42 | add-destroy (when destroy
43 | (list
44 | `(let [destroy# ~destroy]
45 | (if (reagent.ratom/reactive?)
46 | (when (nil? (reagent.ratom/-destroy ~v))
47 | (reagent.ratom/-destroy! ~v destroy#))
48 | (destroy#)))))
49 | asserting (dev?) #_(if *assert* true false)
50 | res (gensym "res")]
51 | `(let [~v (reagent.ratom/with-let-values ~k)]
52 | ~(when asserting
53 | `(when-some [c# (reagent.ratom/-ratom-context)]
54 | (when (== (reagent.ratom/-generation ~v) (reagent.ratom/-ratom-generation c#))
55 | (d/error "Warning: The same with-let is being used more "
56 | "than once in the same reactive context."))
57 | (reagent.ratom/-set-ratom-generation! ~v c#)))
58 | (let ~(into bs [res `(do ~@forms)])
59 | ~@add-destroy
60 | ~res))))
61 |
62 | (defn ^:macro reaction [& body]
63 | `(reagent.ratom/make-reaction (fn [] ~@body)))
64 |
65 | (def rns (sci/create-ns 'reagent.core nil))
66 |
67 | (def reagent-namespace
68 | {'atom (sci/copy-var r/atom rns)
69 | 'create-element (sci/copy-var r/create-element rns)
70 | 'adapt-react-class (sci/copy-var r/adapt-react-class rns)
71 | 'as-element (sci/copy-var r/as-element rns)
72 | 'with-let (sci/copy-var with-let rns)
73 | 'reaction (sci/copy-var reaction rns)
74 | 'class-names (sci/copy-var r/class-names rns)
75 | 'cursor (sci/copy-var r/cursor rns)
76 | 'create-class (sci/copy-var r/create-class rns)
77 | 'create-compiler (sci/copy-var r/create-compiler rns)
78 | 'reactify-component (sci/copy-var r/reactify-component rns)
79 | 'track (sci/copy-var r/track rns)
80 | 'track! (sci/copy-var r/track! rns)
81 | 'dispose! (sci/copy-var r/dispose! rns)})
82 |
83 | (def rtmns (sci/create-ns 'reagent.ratom nil))
84 |
85 | (defn -ratom-context
86 | "Read-only access to the ratom context."
87 | []
88 | ratom/*ratom-context*)
89 |
90 | (defn -generation
91 | [^js x]
92 | (.-generation x))
93 |
94 | (defn -ratom-generation
95 | [^js x]
96 | (.-ratomGeneration x))
97 |
98 | (defn -set-ratom-generation!
99 | [^js v ^js c]
100 | (set! (.-generation v) (.-ratomGeneration c)))
101 |
102 | (defn -destroy!
103 | [^js v destroy]
104 | (set! (.-destroy v) destroy))
105 |
106 | (defn -destroy
107 | [^js v]
108 | (.-destroy v))
109 |
110 | (def reagent-ratom-namespace
111 | {'with-let-values (sci/copy-var ratom/with-let-values rtmns)
112 | 'reactive? (sci/copy-var ratom/reactive? rtmns)
113 | '-ratom-context (sci/copy-var -ratom-context rtmns)
114 | '-generation (sci/copy-var -generation rtmns)
115 | '-ratom-generation (sci/copy-var -ratom-generation rtmns)
116 | '-set-ratom-generation! (sci/copy-var -set-ratom-generation! rtmns)
117 | '-destroy! (sci/copy-var -destroy! rtmns)
118 | '-destroy (sci/copy-var -destroy rtmns)
119 | 'atom (sci/copy-var reagent.ratom/atom
120 | rns)
121 | 'make-reaction (sci/copy-var reagent.ratom/make-reaction
122 | rns)
123 | 'make-track (sci/copy-var reagent.ratom/make-track
124 | rns)
125 | 'track! (sci/copy-var reagent.ratom/track! rns)})
126 |
127 | (def rdbgns (sci/create-ns 'reagent.debug nil))
128 |
129 | (defn -tracking? []
130 | reagent.debug/tracking)
131 |
132 | (defn ^:macro error
133 | "Print with console.error."
134 | [_ _ & forms]
135 | (when *assert*
136 | `(when (some? js/console)
137 | (.error (if (reagent.debug/-tracking?)
138 | reagent.debug/track-console
139 | js/console)
140 | (str ~@forms)))))
141 |
142 | (def reagent-debug-namespace
143 | {'error (sci/copy-var error rdbgns)
144 | '-tracking? (sci/copy-var -tracking? rdbgns)
145 | 'track-console (sci/copy-var d/track-console rdbgns)})
146 |
147 | (def namespaces
148 | {'reagent.core reagent-namespace
149 | 'reagent.ratom reagent-ratom-namespace
150 | 'reagent.debug reagent-debug-namespace})
151 |
152 | (def config
153 | {:namespaces namespaces})
154 |
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/routing/dynamic_routing.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.routing.dynamic-routing
2 | (:require [sci.configs.fulcro.fulcro-sci-helpers :as ana]
3 | [com.fulcrologic.fulcro.raw.components :as rc]
4 | [com.fulcrologic.fulcro.routing.dynamic-routing :as dr]
5 | [com.fulcrologic.fulcro.ui-state-machines :as uism]
6 | [sci.core :as sci]))
7 |
8 | (defn compile-error [env form message]
9 | (throw (ana/error (merge env (some-> form meta)) message)))
10 |
11 | (defn ^:sci/macro defrouter [_&form env router-sym arglist options & body]
12 | (let [router-ns (str (deref sci.core/ns) #_(ns-name *ns*))]
13 | ;; copied body of defrouter*
14 | (when-not (and (vector? arglist) (= 2 (count arglist)))
15 | (compile-error env options "defrouter argument list must have an entry for this and props."))
16 | (when-not (map? options)
17 | (compile-error env options "defrouter requires a literal map of options."))
18 | #_(when-not (s/valid? ::defrouter-options options) ; JH - disabled spec check
19 | (compile-error env options (str "defrouter options are invalid: " (s/explain-str ::defrouter-options options))))
20 | (let [{:keys [router-targets]} options
21 | _ (when (empty? router-targets)
22 | (compile-error env options "defrouter requires a vector of :router-targets with at least one target"))
23 | id (keyword router-ns (name router-sym))
24 | getq (fn [s] `(or (rc/get-query ~s)
25 | (throw (ex-info (str "Route target has no query! "
26 | (rc/component-name ~s)) {}))))
27 | query (into [::dr/id
28 | [::uism/asm-id id]
29 | ::dr/dynamic-router-targets
30 | {::dr/current-route (getq (first router-targets))}]
31 | (map-indexed
32 | (fn [idx s]
33 | (when (nil? s)
34 | (compile-error env options "defrouter :target contains nil!"))
35 | {(keyword (str "alt" idx)) (getq s)})
36 | (rest router-targets)))
37 | initial-state-map (into {::dr/id id
38 | ::dr/current-route `(rc/get-initial-state ~(first router-targets) ~'params)}
39 | (map-indexed
40 | (fn [idx s] [(keyword (str "alt" idx)) `(rc/get-initial-state ~s {})])
41 | (rest router-targets)))
42 | ident-method (apply list `(fn [] [::dr/id ~id]))
43 | initial-state-lambda (apply list `(fn [~'params] ~initial-state-map))
44 | states-to-render-route (if (seq body)
45 | #{:routed :deferred}
46 | `(constantly true))
47 | always-render-body? (and (map? options) (:always-render-body? options))
48 | render-cases (if always-render-body?
49 | (apply list `(let [~'class (dr/current-route-class ~'this)]
50 | (let [~(first arglist) ~'this
51 | ~(second arglist) {:pending-path-segment ~'pending-path-segment
52 | :route-props ~'current-route
53 | :route-factory (when ~'class (comp/factory ~'class))
54 | :current-state ~'current-state
55 | :router-state (get-in ~'props [[::uism/asm-id ~id] ::uism/local-storage])}]
56 | ~@body)))
57 | (apply list `(let [~'class (dr/current-route-class ~'this)]
58 | (if (~states-to-render-route ~'current-state)
59 | (when ~'class
60 | (let [~'factory (comp/factory ~'class)]
61 | (~'factory (rc/computed ~'current-route (rc/get-computed ~'this)))))
62 | (let [~(first arglist) ~'this
63 | ~(second arglist) {:pending-path-segment ~'pending-path-segment
64 | :route-props ~'current-route
65 | :route-factory (when ~'class (comp/factory ~'class))
66 | :current-state ~'current-state}]
67 | ~@body)))))
68 | options (merge
69 | `{:componentDidMount (fn [this#] (dr/validate-route-targets this#))}
70 | options
71 | `{:query ~query
72 | :ident ~ident-method
73 | :use-hooks? false
74 | :initial-state ~initial-state-lambda
75 | :preserve-dynamic-query? true})]
76 | `(comp/defsc ~router-sym [~'this {::dr/keys [~'id ~'current-route] :as ~'props}]
77 | ~options
78 | (let [~'current-state (uism/get-active-state ~'this ~id)
79 | ~'state-map (comp/component->state-map ~'this)
80 | ~'sm-env (uism/state-machine-env ~'state-map nil ~id :fake {})
81 | ~'pending-path-segment (when (uism/asm-active? ~'this ~id) (uism/retrieve ~'sm-env :pending-path-segment))]
82 | ~render-cases)))))
83 |
84 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.routing.dynamic-routing))
85 | (def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.routing.dynamic-routing sci-ns
86 | {:exclude [defrouter]})
87 | 'defrouter (sci/copy-var defrouter sci-ns) ))
88 |
89 | (def namespaces {'com.fulcrologic.fulcro.routing.dynamic-routing ns-def})
--------------------------------------------------------------------------------
/playground/src/playground.cljs:
--------------------------------------------------------------------------------
1 | (ns playground
2 | "Build CodeMirror editor with SCI evaluation for the SCI Playground."
3 | (:require
4 | ;; Code editor
5 | ;; Inspiration: https://github.com/nextjournal/clojure-mode/blob/main/demo/src/nextjournal/clojure_mode/demo.cljs
6 | ["@codemirror/commands" :refer [history historyKeymap]]
7 | ["@codemirror/language" :refer [#_foldGutter
8 | syntaxHighlighting
9 | defaultHighlightStyle]]
10 |
11 | ["@codemirror/state" :refer [EditorState]]
12 | ["@codemirror/view" :as view :refer [EditorView lineNumbers showPanel]]
13 | ;; JS deps for re-export to sci
14 | ["react" :as react]
15 | ["react-dom" :as react-dom]
16 | [clojure.string :as str]
17 | [nextjournal.clojure-mode :as cm-clj]
18 | ;; Used libs
19 | [promesa.core :as p]
20 | ;; All the configs
21 | sci.configs.applied-science.js-interop
22 | sci.configs.cjohansen.dataspex
23 | sci.configs.cjohansen.replicant
24 | sci.configs.cjohansen.portfolio.replicant
25 | sci.configs.cljs.pprint
26 | sci.configs.cljs.test
27 | ; sci.configs.clojure-1-11
28 |
29 | ;sci.configs.clojure.test
30 | sci.configs.fulcro.fulcro
31 | sci.configs.funcool.promesa
32 | sci.configs.metosin.reitit
33 | sci.configs.mfikes.cljs-bean
34 | sci.configs.re-frame.re-frame
35 | sci.configs.re-frame.re-frame-alpha
36 |
37 | sci.configs.reagent.reagent
38 | sci.configs.reagent.reagent-dom-server
39 | sci.configs.reagent.reagent-dom-client
40 |
41 | sci.configs.tonsky.datascript
42 | sci.configs.hoplon.javelin
43 | sci.configs.hoplon.hoplon
44 | hoplon.dom
45 |
46 | sci.configs.cljs.spec.alpha
47 |
48 | [sci.core :as sci]
49 | [sci.ctx-store :as store]))
50 |
51 | ;; Necessary to avoid the error 'Attempting to call unbound fn: #'clojure.core/*print-fn*'
52 | ;; when calling `println` inside the evaluated code
53 | (enable-console-print!)
54 | (sci/alter-var-root sci/print-fn (constantly *print-fn*))
55 | (sci/alter-var-root sci/print-err-fn (constantly *print-err-fn*))
56 | (sci/enable-unrestricted-access!)
57 | ;; ------------------------------------------------------------ SCI eval
58 |
59 | (def all-configs ; vars so that we can extract ns info
60 | [#'sci.configs.applied-science.js-interop/config
61 | #'sci.configs.cjohansen.dataspex/config
62 | #'sci.configs.cjohansen.replicant/config
63 | #'sci.configs.cjohansen.portfolio.replicant/config
64 | #'sci.configs.cljs.pprint/config
65 | #'sci.configs.cljs.test/config
66 | ;#'sci.configs.clojure.test/config
67 | #'sci.configs.fulcro.fulcro/config
68 | #'sci.configs.funcool.promesa/config
69 | #'sci.configs.metosin.reitit/config
70 | #'sci.configs.mfikes.cljs-bean/config
71 | #'sci.configs.re-frame.re-frame/config
72 | #'sci.configs.re-frame.re-frame-alpha/config
73 | #'sci.configs.reagent.reagent/config
74 | #'sci.configs.reagent.reagent-dom-server/config
75 | #'sci.configs.reagent.reagent-dom-client/config
76 | #'sci.configs.tonsky.datascript/config
77 | #'sci.configs.hoplon.javelin/config
78 | #'sci.configs.hoplon.hoplon/config
79 | #'sci.configs.cljs.spec.alpha/config])
80 |
81 | (prn :hello2)
82 |
83 | (def sci-ctx
84 | (->> all-configs
85 | (map deref)
86 | (reduce
87 | sci/merge-opts
88 | (sci/init {:classes {'js js/globalThis :allow :all}
89 | :js-libs {"react" react
90 | "react-dom" react-dom}}))
91 | ;; in .cljc, take the :cljs branch; here b/c of the bug babashka/sci#906
92 | (#(assoc % :features #{:cljs}))))
93 |
94 | (store/reset-ctx! sci-ctx)
95 |
96 | (defn eval-code
97 | ([code]
98 | (try (sci/eval-string* sci-ctx code)
99 | (catch :default e
100 | (try (js/console.log "Evaluation failed:" (ex-message e)
101 | (some-> e ex-data clj->js))
102 | (catch :default _))
103 | {::error (str (.-message e)) :data (ex-data e)}))))
104 |
105 | (defn eval-all [on-result x]
106 | (on-result (some->> (.-doc (.-state x)) str eval-code))
107 | true)
108 |
109 | (defn sci-extension [on-result]
110 | (.of view/keymap
111 | #js [#js {:key "Mod-Enter" ; Cmd or Ctrl
112 | :run (partial eval-all on-result)}]))
113 |
114 | ;; ------------------------------------------------------------ Code editor
115 |
116 | (defn mac? []
117 | (some? (re-find #"(Mac)|(iPhone)|(iPad)|(iPod)" js/navigator.platform)))
118 |
119 | (defn output-panel-extension
120 | "Display a panel below the editor with the output of the
121 | last evaluation (read from the passed-in `result-atom`)"
122 | [result-atom]
123 | (let [dom (js/document.createElement "div")]
124 | (add-watch result-atom :output-panel
125 | (fn [_ _ _ new]
126 | (if (::error new)
127 | (do
128 | (.add (.-classList dom) "error")
129 | (set! (.-textContent dom) (str "ERROR: " (::error new)
130 | (some->> new :data pr-str (str " ")))))
131 | (do
132 | (.remove (.-classList dom) "error")
133 | (set! (.-textContent dom) (str ";; => " (pr-str new)))))))
134 | (set! (.-className dom) "cm-output-panel")
135 | (set! (.-textContent dom)
136 | (str "Press "
137 | (if (mac?) "Cmd" "Ctrl")
138 | "-Enter in the editor to evaluate it. Return value will show up here."))
139 | (.of showPanel
140 | (fn [_view] #js {:dom dom}))))
141 |
142 | (def theme
143 | (.theme
144 | EditorView
145 | #js {".cm-output-panel.error" #js {:color "red"}}))
146 |
147 | (defonce extensions
148 | #js[theme
149 | (history)
150 | (syntaxHighlighting defaultHighlightStyle)
151 | (view/drawSelection)
152 | (lineNumbers)
153 | (.. EditorState -allowMultipleSelections (of true))
154 | cm-clj/default-extensions
155 | (.of view/keymap cm-clj/complete-keymap)
156 | (.of view/keymap historyKeymap)])
157 |
158 | (defn bind-editor! [el code]
159 | {:pre [el code]}
160 | (let [target-el (js/document.createElement "div")
161 | last-result (atom nil)
162 | exts (.concat extensions
163 | #js [(sci-extension (partial reset! last-result))
164 | (output-panel-extension last-result)])]
165 | (.replaceWith el target-el)
166 | (new EditorView
167 | #js {:parent target-el
168 | :state (.create EditorState #js {:doc code
169 | :extensions exts})})))
170 |
171 | (defn list-libraries [all-config-vars]
172 | (->> all-config-vars
173 | (map (comp name :ns meta))
174 | (map #(clojure.string/replace % #"^sci\.configs\.[\w-]+\." ""))
175 | (remove #{"pprint" "test"})
176 | sort
177 | (str/join ", ")))
178 |
179 | (defn gist-json->code [json]
180 | (->> json
181 | .-files
182 | js/Object.values
183 | seq
184 | (map (fn [o] (js->clj o :keywordize-keys true)))
185 | (filter (comp #{"Clojure"} :language)) ; incl. clj, cljs, cljc
186 | (sort-by :filename) ; we started with a map, which has no natural order
187 | (map #(do (assert (not (:truncated %)) "Can't handle truncated files")
188 | (str ";; " (:filename %) "\n" (:content %))))
189 | (str/join "\n;;---\n")))
190 |
191 | (defn async-fetch-gist [gist-id]
192 | (p/let [resp (js/fetch (str "https://api.github.com/gists/" gist-id)
193 | {:headers {"Accept" "application/vnd.github+json"
194 | "X-GitHub-Api-Version" "2022-11-28"}})
195 | _ (when-not (.-ok resp) (throw (ex-info (str "Bad HTTP status "
196 | (.-status resp) " "
197 | (.-statusText resp))
198 | {})))
199 | json (.json resp)
200 | code (gist-json->code json)]
201 | (if (seq code)
202 | code
203 | "; No Clojure code found in the gist.")))
204 |
205 | (defn ^:export init []
206 | (let [code-el (js/document.getElementById "code")
207 | code (.-textContent code-el)
208 | libs-el (js/document.getElementById "libs")]
209 | (set! (.-textContent libs-el) (list-libraries all-configs))
210 | (if-let [gist-id
211 | (->> js/document .-location .-search
212 | (re-find #"[?&]gist=(\w+)")
213 | second)]
214 | (do
215 | (set! (.-textContent code-el) "Loading gist...")
216 | (-> (async-fetch-gist gist-id)
217 | (p/then #(let [res (eval-code %)]
218 | (println "Initial evaluation => " res)
219 | (when (::error res)
220 | (set! (.-textContent (js/document.getElementById "app"))
221 | (str "Auto-evaluating the gist failed. Cause: " (::error res))))
222 | (bind-editor! code-el %)))
223 | (p/catch #(set! (.-textContent code-el) (str "Loading gist FAILED: " %)))))
224 | (bind-editor! code-el code)))
225 | (println "Init run"))
226 |
227 | (defn ^:export reload []
228 | (println "Reload run (noop)"))
229 |
--------------------------------------------------------------------------------
/src/sci/configs/funcool/promesa.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.funcool.promesa
2 | (:refer-clojure :exclude [delay spread promise
3 | await map mapcat run!
4 | future let loop recur -> ->>
5 | with-redefs
6 | doseq])
7 | (:require [clojure.core :as c]
8 | [promesa.core :as p]
9 | [promesa.exec :as exec]
10 | [sci.core :as sci]))
11 |
12 | (def pns (sci/create-ns 'promesa.core nil))
13 | (def ptns (sci/create-ns 'promesa.protocols nil))
14 |
15 |
16 | (defn ^:macro do*
17 | "An exception unsafe do-like macro. Supposes that we are already
18 | wrapped in promise context so avoids defensive wrapping."
19 | [_ _ & exprs]
20 | (condp = (count exprs)
21 | 0 `(p/resolved nil)
22 | 1 `(p/promise ~(first exprs))
23 | (reduce (fn [acc e]
24 | `(p/bind (p/promise ~e) (fn [_#] ~acc)))
25 | `(p/promise ~(last exprs))
26 | (reverse (butlast exprs)))))
27 |
28 | (defn ^:macro do
29 | "Execute potentially side effectful code and return a promise resolved
30 | to the last expression after awaiting the result of each
31 | expression."
32 | [_ _ & exprs]
33 | `(p/bind
34 | (p/promise nil)
35 | (fn [_#]
36 | (promesa.core/do* ~@exprs))))
37 |
38 | (defn ^:macro let*
39 | "An exception unsafe let-like macro. Supposes that we are already
40 | wrapped in promise context so avoids defensive wrapping."
41 | [_ _ bindings & body]
42 | (assert (even? (count bindings)) (str "Uneven binding vector: " bindings))
43 | (c/->> (reverse (partition 2 bindings))
44 | (reduce (fn [acc [l r]]
45 | `(p/bind (p/promise ~r) (fn [~l] ~acc)))
46 | `(promesa.core/do ~@body))))
47 |
48 | (defn ^:macro let
49 | "A `let` alternative that always returns promise and waits for all the
50 | promises on the bindings."
51 | [_ _ bindings & body]
52 | (if (seq bindings)
53 | `(p/bind
54 | (p/promise nil)
55 | (fn [_#] (promesa.core/let* ~bindings ~@body)))
56 | `(promesa.core/do ~@body)))
57 |
58 | (defn ^:macro ->
59 | "Like the clojure.core/->, but it will handle promises in values
60 | and make sure the next form gets the value realized instead of
61 | the promise. Example using to fetch data in the browser with CLJS:
62 | Example:
63 | (p/-> (js/fetch #js {...}) ; returns a promise
64 | .-body)
65 | The result of a thread is a promise that will resolve to the
66 | end of the thread chain."
67 | [_ _ x & forms]
68 | (c/let [fns (mapv (fn [arg]
69 | (c/let [[f & args] (if (sequential? arg)
70 | arg
71 | (list arg))]
72 | `(fn [p#] (~f p# ~@args)))) forms)]
73 | `(p/chain (p/promise ~x) ~@fns)))
74 |
75 | (defn ^:macro ->>
76 | "Like the clojure.core/->>, but it will handle promises in values
77 | and make sure the next form gets the value realized instead of
78 | the promise. Example using to fetch data in the browser with CLJS:
79 | Example:
80 | (p/->> (js/fetch #js {...}) ; returns a promise
81 | .-body
82 | read-string
83 | (mapv inc)
84 | The result of a thread is a promise that will resolve to the
85 | end of the thread chain."
86 | [_ _ x & forms]
87 | (c/let [fns (mapv (fn [arg]
88 | (c/let [[f & args] (if (sequential? arg)
89 | arg
90 | (list arg))]
91 | `(fn [p#] (~f ~@args p#)))) forms)]
92 | `(p/chain (p/promise ~x) ~@fns)))
93 |
94 | (defn ^:macro with-redefs
95 | "Like clojure.core/with-redefs, but it will handle promises in
96 | body and wait until they resolve or reject before restoring the
97 | bindings. Useful for mocking async APIs.
98 | Example:
99 | (defn async-func [] (p/delay 1000 :slow-original))
100 | (p/with-redefs [async-func (fn [] (p/resolved :fast-mock))]
101 | (async-func))
102 | The result is a promise that will resolve to the last body form and
103 | upon resolving restores the bindings to their original values."
104 | [_ _ bindings & body]
105 | (c/let [names (take-nth 2 bindings)
106 | vals (take-nth 2 (drop 1 bindings))
107 | orig-val-syms (c/map (comp gensym #(str % "-orig-val__") name) names)
108 | temp-val-syms (c/map (comp gensym #(str % "-temp-val__") name) names)
109 | binds (c/map vector names temp-val-syms)
110 | resets (reverse (c/map vector names orig-val-syms))
111 | bind-value (fn [[k v]]
112 | (list 'clojure.core/alter-var-root (list 'var k)
113 | (list 'clojure.core/constantly v)))]
114 | `(c/let [~@(c/interleave orig-val-syms names)
115 | ~@(c/interleave temp-val-syms vals)]
116 | ~@(c/map bind-value binds)
117 | (p/-> (p/do! ~@body)
118 | (p/finally
119 | (fn []
120 | ~@(c/map bind-value resets)))))))
121 |
122 | (def ^:private
123 | loop-run-fn (sci/new-dynamic-var '*loop-run-fn* exec/run! {:ns pns}))
124 |
125 | (defn ^:macro loop
126 | [_ _ bindings & body]
127 | (c/let [bindings (partition 2 2 bindings)
128 | names (mapv first bindings)
129 | fvals (mapv second bindings)
130 | tsym (gensym "loop")
131 | dsym (gensym "deferred")
132 | rsym (gensym "run")]
133 | `(c/let [~rsym promesa.core/*loop-run-fn*
134 | ~dsym (promesa.core/deferred)
135 | ~tsym (fn ~tsym [params#]
136 | (c/-> (promesa.core/all params#)
137 | (promesa.core/then (fn [[~@names]]
138 | ;; (prn "exec" ~@names)
139 | (promesa.core/do! ~@body)))
140 | (promesa.core/handle
141 | (fn [res# err#]
142 | ;; (prn "result" res# err#)
143 | (cond
144 | (not (nil? err#))
145 | (promesa.core/reject! ~dsym err#)
146 |
147 | (and (map? res#) (= (:type res#) :promesa.core/recur))
148 | (do (~rsym (fn [] (~tsym (:args res#))))
149 | nil)
150 |
151 | :else
152 | (promesa.core/resolve! ~dsym res#))))))]
153 | (~rsym (fn [] (~tsym ~fvals)))
154 | ~dsym)))
155 |
156 | (defn ^:macro recur
157 | [_ _ & args]
158 | `(array-map :type :promesa.core/recur :args [~@args]))
159 |
160 | (defn ^:macro doseq
161 | "Simplified version of `doseq` which takes one binding and a seq, and
162 | runs over it using `promesa.core/run!`"
163 | [_ _ [binding xs] & body]
164 | `(p/run!
165 | (fn [~binding]
166 | (p/do ~@body))
167 | ~xs))
168 |
169 | (defn ^:macro future
170 | "Analogous macro to `clojure.core/future` that returns promise
171 | instance instead of the `Future`. Exposed just for convenience and
172 | works as an alias to `thread`."
173 | [_ _ & body]
174 | `(p/thread-call :default (^:once fn [] ~@body)))
175 |
176 | (def promesa-namespace
177 | {'*loop-run-fn* loop-run-fn
178 | '-> (sci/copy-var -> pns)
179 | '->> (sci/copy-var ->> pns)
180 | 'all (sci/copy-var p/all pns)
181 | 'any (sci/copy-var p/any pns)
182 | 'bind (sci/copy-var p/bind pns)
183 | 'catch (sci/copy-var p/catch pns)
184 | 'chain (sci/copy-var p/chain pns)
185 | 'create (sci/copy-var p/create pns)
186 | 'deferred (sci/copy-var p/deferred pns)
187 | 'delay (sci/copy-var p/delay pns)
188 | 'do (sci/copy-var do pns)
189 | 'do* (sci/copy-var do* pns)
190 | 'do! (sci/copy-var do pns)
191 | 'done? (sci/copy-var p/done? pns)
192 | 'error (sci/copy-var p/error pns)
193 | 'extract (sci/copy-var p/extract pns)
194 | 'finally (sci/copy-var p/finally pns)
195 | 'future (sci/copy-var future pns)
196 | 'thread-call (sci/copy-var p/thread-call pns)
197 | 'handle (sci/copy-var p/handle pns)
198 | 'let (sci/copy-var let pns)
199 | 'let* (sci/copy-var let* pns)
200 | 'loop (sci/copy-var loop pns)
201 | 'map (sci/copy-var p/map pns)
202 | 'mapcat (sci/copy-var p/mapcat pns)
203 | 'pending? (sci/copy-var p/pending? pns)
204 | 'promise (sci/copy-var p/promise pns)
205 | 'promise? (sci/copy-var p/promise? pns)
206 | 'promisify (sci/copy-var p/promisify pns)
207 | 'race (sci/copy-var p/race pns)
208 | 'recur (sci/copy-var recur pns)
209 | 'reject! (sci/copy-var p/reject! pns)
210 | 'rejected (sci/copy-var p/rejected pns)
211 | 'rejected? (sci/copy-var p/rejected? pns)
212 | 'resolve! (sci/copy-var p/resolve! pns)
213 | 'resolved (sci/copy-var p/resolved pns)
214 | 'resolved? (sci/copy-var p/resolved? pns)
215 | 'run! (sci/copy-var p/run! pns)
216 | 'then (sci/copy-var p/then pns)
217 | 'thenable? (sci/copy-var p/thenable? pns)
218 | 'timeout (sci/copy-var p/timeout pns)
219 | 'with-redefs (sci/copy-var with-redefs pns)
220 | 'wrap (sci/copy-var p/wrap pns)
221 | 'doseq (sci/copy-var doseq pns)
222 | 'wait-all (sci/copy-var p/wait-all pns)
223 | 'wait-all* (sci/copy-var p/wait-all* pns)})
224 |
225 | (def pims (sci/create-ns 'promesa.impl nil))
226 |
227 | (def namespaces {'promesa.core promesa-namespace})
228 |
229 | (def config {:namespaces namespaces})
230 |
--------------------------------------------------------------------------------
/src/sci/configs/hoplon/hoplon.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.hoplon.hoplon
2 | (:refer-clojure :exclude [dosync defmacro])
3 | (:require [sci.core :as sci]
4 | [sci.ctx-store :as ctx-store]
5 | [clojure.set]
6 | [javelin.core :as j]
7 | [hoplon.core]
8 | [edamame.core :as e]
9 | [clojure.string :as str])
10 | (:require-macros [sci.configs.macros :as m]))
11 |
12 | (def Exception js/Error)
13 |
14 | ;; Hoplon Interpolation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15 | (defn- ^{:from 'org.clojure/core.incubator} silent-read
16 | "Attempts to clojure.core/read a single form from the provided String, returning
17 | a vector containing the read form and a String containing the unread remainder
18 | of the provided String. Returns nil if no valid form can be read from the
19 | head of the String."
20 | [s]
21 | (try
22 | (let [r (-> s (e/source-reader))
23 | [v vs] (e/parse-next+string r)
24 | remainder (subs s (+ (str/index-of s vs) (count vs)))]
25 | [v remainder])
26 | (catch Exception e
27 | (js/console.error e)))) ; this indicates an invalid form -- the head of s is just string data
28 |
29 | (defn- ^{:from 'org.clojure/core.incubator} terpol8*
30 | "Yields a seq of Strings and read forms."
31 | ([s atom?]
32 | (lazy-seq
33 | (if-let [[form rest] (silent-read (subs s (if atom? 2 1)))]
34 | (cons form (terpol8* (if atom? (subs rest 1) rest)))
35 | (cons (subs s 0 2) (terpol8* (subs s 2))))))
36 | ([^String s]
37 | (if-let [start (->> ["~{" "~("]
38 | (map #(.indexOf s ^String %))
39 | (remove #(== -1 %))
40 | sort
41 | first)]
42 | (lazy-seq (cons
43 | (subs s 0 start)
44 | (terpol8* (subs s start) (= \{ (.charAt s (inc start))))))
45 | [s])))
46 |
47 |
48 | (defn terpol8 [s]
49 | (let [parts (remove #(= "" %) (terpol8* s))]
50 | (if (every? string? parts) s `(str ~@parts))))
51 |
52 | (m/defmacro elem
53 | "Create an anonymous custom element."
54 | [bind & body]
55 | (let [[prepost & body] (if (map? (first body)) body (conj body nil))]
56 | `(fn [& args#] ~(or prepost {}) (let [~bind (hoplon.core/parse-args args#)] ~@body))))
57 |
58 | (def sci-macroexpand-1 (delay (sci/eval-string* (ctx-store/get-ctx) "macroexpand-1")))
59 | (defn macroexpand-1*
60 | ([expr] (macroexpand-1* {} expr))
61 | ([_env expr] (@sci-macroexpand-1 expr)))
62 |
63 | (m/defmacro defelem
64 | "Defines an element function.
65 |
66 | An element function creates a DOM Element (parent) given two arguments:
67 |
68 | * `attrs` - a number of key-value pairs for attributes and their values
69 | * `kids` - a sequence of DOM Elements to be appended/used inside
70 |
71 | The returned DOM Element is itself a function which can accept more
72 | attributes and child elements."
73 | [name & forms]
74 | (let [[_ name [_ & [fdecl]]] (macroexpand-1* `(defn ~name ~@forms))
75 | [docstr & [bind & body]] (if (string? (first fdecl)) fdecl (conj fdecl nil))]
76 | `(def ^{:doc ~docstr} ~name (hoplon.core/elem ~bind ~@body))))
77 |
78 | (m/defmacro defattr
79 | "Defines an attribute function.
80 |
81 | An element attribute is a function given three arguments:
82 |
83 | * `elem` - the target DOM Element containing the attribute
84 | * `key` - the attribute keyword or symbol
85 | * `value` - the attribute value
86 |
87 | The attribute function is called whenever the value argument changes."
88 | [name & forms]
89 | `(defmethod hoplon.core/do! ~name ~@forms))
90 |
91 | (m/defmacro ^:private safe-deref [expr] `(deref (or ~expr (atom nil))))
92 |
93 | (defn- parse-e [[tag & [head & tail :as args]]]
94 | (let [kw1? (comp keyword? first)
95 | mkkw #(->> (partition 2 %) (take-while kw1?) (map vec))
96 | drkw #(->> (partition 2 2 [] %) (drop-while kw1?) (mapcat identity))]
97 | (cond (map? head) [tag head tail]
98 | (keyword? head) [tag (into {} (mkkw args)) (drkw args)]
99 | :else [tag nil args])))
100 |
101 | (m/defmacro loop-tpl
102 | "Template. Works identically to `for-tpl`, only expects a `:bindings`
103 | attribute to accomodate the HTML HLisp representation:
104 |
105 | (loop-tpl :bindings [x xs] ...)
106 | "
107 | [& args]
108 | (let [[_ {[bindings items] :bindings} [body]] (parse-e (cons '_ args))]
109 | `(hoplon.core/loop-tpl* ~items
110 | (fn [item#] (j/cell-let [~bindings item#] ~body)))))
111 |
112 | (m/defmacro for-tpl
113 | "Template. Accepts a cell-binding and returns a cell containing a sequence of
114 | elements:
115 |
116 | (for-tpl [x xs] (span x))
117 | "
118 | [[bindings items] body]
119 | `(hoplon.core/loop-tpl* ~items (fn [item#] (j/cell-let [~bindings item#] ~body))))
120 |
121 | (m/defmacro if-tpl
122 | "Template. Accepts a `predicate` cell and returns a cell containing either
123 | the element produced by `consequent` or `alternative`, depending on the value
124 | of the predicate:
125 |
126 | (if-tpl predicate (span \"True\") (span \"False\"))
127 | "
128 | [predicate consequent & [alternative]]
129 | `(let [con# (delay ~consequent)
130 | alt# (delay ~alternative)
131 | tpl# (fn [p#] (hoplon.core/safe-deref (if p# con# alt#)))]
132 | ((j/formula tpl#) ~predicate)))
133 |
134 | (m/defmacro when-tpl
135 | "Template. Accepts a `predicate` cell and returns a cell containing either
136 | the element produced by `consequent` or nothing, depending on the value of
137 | the predicate:
138 |
139 | (when-tpl predicate (span \"Value\"))
140 | "
141 | [predicate & body]
142 | `(hoplon.core/if-tpl ~predicate (do ~@body)))
143 |
144 | (m/defmacro cond-tpl
145 | "Template. Accepts a number of `clauses` cell-template pairs and returns a
146 | cell with the value produced by the matching clause:
147 |
148 | (cond-tpl
149 | clause-a (span \"A\")
150 | clause-b (span \"B\")
151 | :else (span \"Default\"))
152 | "
153 | [& clauses]
154 | (assert (even? (count clauses)))
155 | (let [[conds tpls] (apply map vector (partition 2 clauses))
156 | syms1 (repeatedly (count conds) gensym)
157 | syms2 (repeatedly (count conds) gensym)]
158 | `(let [~@(interleave syms1 (map (fn [x] `(delay ~x)) tpls))
159 | tpl# (fn [~@syms2] (hoplon.core/safe-deref (cond ~@(interleave syms2 syms1))))]
160 | ((j/formula tpl#) ~@conds))))
161 |
162 | (m/defmacro case-tpl
163 | "Template. Accepts an `expr` cell and a number of `clauses` and returns a
164 | cell with the value produced by the matching clause:
165 |
166 | (case-tpl expr
167 | :a (span \"A\")
168 | :b (span \"B\")
169 | (span \"Default\"))
170 |
171 | "
172 | [expr & clauses]
173 | (let [[cases tpls] (apply map vector (partition 2 clauses))
174 | default (when (odd? (count clauses)) (last clauses))
175 | syms (repeatedly (inc (count cases)) gensym)]
176 | `(let [~@(interleave syms (map (fn [x] `(delay ~x)) (conj tpls default)))
177 | tpl# (fn [expr#] (hoplon.core/safe-deref (case expr# ~@(interleave cases syms) ~(last syms))))]
178 | ((j/formula tpl#) ~expr))))
179 |
180 | ;; DOM Macros ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
181 | (m/defmacro with-dom
182 | "Evaluates the body after elem has been inserted into the DOM."
183 | [elem & body]
184 | `(hoplon.core/when-dom ~elem (fn [] ~@body)))
185 |
186 | (m/defmacro with-timeout
187 | "Evaluates the body after msec milliseconds, asynchronously. Returns the
188 | timeout ID which can be used to cancel the operation (see js/clearTimeout)."
189 | [msec & body]
190 | `(js/setTimeout (fn [] ~@body) ~msec))
191 |
192 | (m/defmacro with-interval
193 | "Evaluates the body every msec milliseconds, asynchronously. Returns the
194 | interval ID which can be used to cancel the operation (see js/clearInterval)."
195 | [msec & body]
196 | `(js/setInterval (fn [] ~@body) ~msec))
197 |
198 | (m/defmacro with-animation-frame
199 | "Evaluates the body before the next browser repaint as requestAnimationFrame."
200 | [& body]
201 | `(.requestAnimationFrame js/window (fn [] ~@body)))
202 |
203 | (m/defmacro with-init!
204 | "Evaluates the body after Hoplon has completed constructing the page."
205 | [& body]
206 | `(hoplon.core/add-initfn! (fn [] ~@body)))
207 |
208 | (m/defmacro text
209 | "Creates a DOM Text node and binds its text content to a formula created via
210 | string interpolation, so the Text node updates with the formula."
211 | [form]
212 | (let [i (if-not (string? form) form (terpol8 form))]
213 | (if (string? i)
214 | `(.createTextNode js/document ~i)
215 | `(j/with-let [t# (.createTextNode js/document "")]
216 | (j/cell= (set! (.-nodeValue t#) ~i))))))
217 |
218 | (def hns (sci/create-ns 'hoplon.core nil))
219 |
220 | (def hoplon-core-namespace (assoc (sci/copy-ns hoplon.core hns)
221 | 'text (sci/copy-var text hns)
222 | 'elem (sci/copy-var elem hns)
223 | 'defelem (sci/copy-var defelem hns)
224 | 'defattr (sci/copy-var defattr hns)
225 | 'safe-deref (sci/copy-var safe-deref hns)
226 | 'loop-tpl (sci/copy-var loop-tpl hns)
227 | 'for-tpl (sci/copy-var for-tpl hns)
228 | 'if-tpl (sci/copy-var if-tpl hns)
229 | 'when-tpl (sci/copy-var when-tpl hns)
230 | 'cond-tpl (sci/copy-var cond-tpl hns)
231 | 'case-tpl (sci/copy-var case-tpl hns)
232 | 'with-dom (sci/copy-var with-dom hns)
233 | 'with-timeout (sci/copy-var with-timeout hns)
234 | 'with-interval (sci/copy-var with-interval hns)
235 | 'with-animation-frame (sci/copy-var with-animation-frame hns)
236 | 'with-init! (sci/copy-var with-init! hns)))
237 |
238 | (def config {:namespaces {'hoplon.core hoplon-core-namespace}})
239 |
--------------------------------------------------------------------------------
/src/sci/configs/hoplon/javelin.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.hoplon.javelin
2 | (:refer-clojure :exclude [dosync defmacro])
3 | (:require [sci.core :as sci]
4 | [clojure.set]
5 | [sci.ctx-store :as ctx-store]
6 | [clojure.walk :refer [prewalk]]
7 | [cljs.pprint :as p]
8 | [clojure.string :as str]
9 | [javelin.core])
10 | (:require-macros [sci.configs.macros :as m]
11 | [sci.configs.hoplon.javelin :refer [with-let*]]))
12 |
13 | (def Exception js/Error)
14 |
15 | (declare walk)
16 |
17 | (def jns (sci/create-ns 'javelin.core nil))
18 |
19 | (def destructure*
20 | "Select a version of #'destructure that works with the version of the CLJS
21 | compiler that is provided. Older versions of CLJS do not provide destructure
22 | so we fall back to using Clojure's destructure function in that case."
23 | #_(if-not (resolve 'cljs.core/destructure)
24 | destructure
25 | cljs.core/destructure)
26 | (delay (sci/eval-string* (ctx-store/get-ctx) "destructure")))
27 |
28 | (defn extract-syms
29 | "Extract symbols that will be bound by bindings, including autogenerated
30 | symbols produced for destructuring."
31 | [bindings]
32 | (map first (partition 2 (@destructure* bindings))))
33 |
34 | (defn extract-syms-without-autogen
35 | "Extract only the symbols that the user is binding from bindings, omitting
36 | any intermediate autogenerated bindings used for destructuring. A trick is
37 | used here taking advantage of the fact that gensym names are produced as a
38 | side effect -- successive calls to extract-syms are not redundant."
39 | [bindings]
40 | (let [syms1 (set (extract-syms bindings))
41 | syms2 (set (extract-syms bindings))]
42 | (seq (clojure.set/intersection syms1 syms2))))
43 |
44 | (defn bind-syms
45 | "Given a binding form, returns a seq of the symbols that will be bound.
46 |
47 | (bind-syms '[{:keys [foo some.ns/bar] :as baz} baf & quux])
48 | ;=> (foo bar baz baf quux)"
49 | [form]
50 | (extract-syms-without-autogen [form nil]))
51 |
52 | (def sci-macroexpand-1 (delay (sci/eval-string* (ctx-store/get-ctx) "macroexpand-1")))
53 | (defn macroexpand-1*
54 | ([expr] (macroexpand-1* {} expr))
55 | ([_env expr] (@sci-macroexpand-1 expr)))
56 |
57 | (defn macroexpand*
58 | "Expand form if it is a CLJS macro, otherwise just return form."
59 | [env form]
60 | (if (seq? form)
61 | (let [ex (macroexpand-1* env form)]
62 | (if (identical? ex form)
63 | form
64 | (macroexpand* env ex)))
65 | form))
66 |
67 | (defn macroexpand-all*
68 | "Fully expand all CLJS macros contained in form."
69 | [env form]
70 | (prewalk (partial macroexpand* env) form))
71 |
72 | (m/defmacro macroexpand-all
73 | "Fully expand all CLJS macros contained in form."
74 | [form]
75 | (macroexpand-all* &env form))
76 |
77 | (m/defmacro mx
78 | "Expand all macros in form and pretty-print them (as code)."
79 | [form]
80 | `(println
81 | ~(with-out-str
82 | (p/write (macroexpand-all* &env form) :dispatch p/code-dispatch))))
83 |
84 | (m/defmacro mx2
85 | "Expand all macros in form and pretty-print them (as data)."
86 | [form]
87 | `(println
88 | ~(with-out-str
89 | (p/write (macroexpand-all* &env form)))))
90 |
91 | ;; javelin cells ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
92 |
93 | (def ^:dynamic *env* nil)
94 | (def ^:dynamic *hoist* nil)
95 | (def ^:dynamic *pass* nil)
96 |
97 | (let [to-list #(into '() (reverse %))
98 | special #_a/specials '#{& case* defrecord* try ns* loop* do letfn* if new ns deftype* let* js* fn* recur set! . var quote throw def}
99 | special? #(contains? special %)
100 | unsupp?* #(contains? '#{def ns deftype* defrecord*} %)
101 | core? #(contains? #{"clojure.core" "cljs.core" "js"} (namespace %))
102 | empty?* #(= 0 (count %))
103 | dot? #(= '. (first %))
104 | try? #(= 'try (first %))
105 | _catch? #(= 'catch (first %))
106 | finally? #(= 'finally (first %))
107 | binding1? #(contains? '#{let* loop*} (first %))
108 | binding2? #(= 'letfn* (first %))
109 | binding3? #(= 'fn* (first %))
110 | catch? #(= 'catch (first %))
111 | quoted? #(= 'quote (first %))
112 | unwrap1? #(= 'clojure.core/unquote (first %))
113 | unwrap2? #(= 'clojure.core/unquote-splicing (first %))
114 | err1 #(str/replace "formula expansion contains unsupported %s form" "%s" %)]
115 |
116 | (defn unsupp? [x local]
117 | (let [op (first x)]
118 | (and (not (*env* op)) (not (local op)) (unsupp?* op))))
119 |
120 | (defn hoist? [x local]
121 | (and (not (or (local x) (core? x))) (or (*env* x) (not (special? x)))))
122 |
123 | (defn walk-sym [x local]
124 | (if-not (hoist? x local)
125 | x
126 | (let [h (@*hoist* x)]
127 | (when-not h (swap! *hoist* conj (with-meta x {::h (gensym)})))
128 | (::h (meta (@*hoist* x))))))
129 |
130 | (defn walk-map [x local]
131 | (into (empty x) (map #(mapv (fn [x] (walk x local)) %) x)))
132 |
133 | (defn walk-seq [x local]
134 | (into (empty x) (map #(walk % local) x)))
135 |
136 | (defn walk-bind1 [[sym bindings & body] local]
137 | (let [local (atom local)
138 | bind1 (fn [[k v]]
139 | (with-let* [x [k (walk v @local)]]
140 | (swap! local conj k)))
141 | bindings (mapcat bind1 (partition 2 bindings))]
142 | (to-list `(~sym [~@bindings] ~@(map #(walk % @local) body)))))
143 |
144 | (defn walk-catch [[sym etype bind & body] local]
145 | (to-list `(~sym ~etype ~bind ~@(map #(walk % (conj local bind)) body))))
146 |
147 | (defn walk-finally [[sym & body] local]
148 | (to-list `(~sym ~@(map #(walk % local) body))))
149 |
150 | (defn walk-try [[sym & body] local]
151 | (to-list `(~sym ~@(map #((cond (not (seq? %)) walk
152 | (catch? %) walk-catch
153 | (finally? %) walk-finally
154 | :else walk)
155 | % local)
156 | body))))
157 |
158 | (defn walk-bind2 [[sym bindings & body] local]
159 | (let [local (reduce conj local (map first (partition 2 bindings)))
160 | bindings (map #(%1 %2) (cycle [identity #(walk % local)]) bindings)]
161 | (to-list `(~sym [~@bindings] ~@(map #(walk % local) body)))))
162 |
163 | (defn walk-bind3 [[sym & arities] local]
164 | (let [fname (when (symbol? (first arities)) [(first arities)])
165 | arities (if fname (rest arities) arities)
166 | arities (if (vector? (first arities)) [arities] arities)
167 | local (if fname (conj local (first fname)) local)]
168 | (let [mkarity (fn [[bindings & body]]
169 | (let [local (into local (remove #(= '& %) bindings))]
170 | (to-list `([~@bindings] ~@(map #(walk % local) body)))))
171 | arities (map mkarity arities)]
172 | (to-list `(~sym ~@fname ~@arities)))))
173 |
174 | (defn walk-passthru [x local]
175 | (with-let* [s (gensym)] (swap! *pass* assoc s x)))
176 |
177 | (defn walk-dot [[sym obj meth & more] local]
178 | (let [obj (walk obj local)
179 | more (map #(walk % local) more)
180 | walk-meth (fn [m] (list (first m) (map #(walk % local) (rest m))))]
181 | (to-list `(~sym ~obj ~@(if-not (seq? meth) `[~meth ~@more] [(walk-meth meth)])))))
182 |
183 | (defn walk-list [x local]
184 | (let [unsupp? #(unsupp? % local)]
185 | (cond (empty?* x) x
186 | (dot? x) (walk-dot x local)
187 | (try? x) (walk-try x local)
188 | (binding1? x) (walk-bind1 x local)
189 | (binding2? x) (walk-bind2 x local)
190 | (binding3? x) (walk-bind3 x local)
191 | (quoted? x) (walk-passthru x local)
192 | (unwrap1? x) (walk-passthru (second x) local)
193 | (unwrap2? x) (walk-passthru (list 'deref (second x)) local)
194 | (unsupp? x) (throw (Exception. (err1 (first x))))
195 | :else (to-list (map #(walk % local) x)))))
196 |
197 | (defn walk [x local]
198 | (cond (symbol? x) (walk-sym x local)
199 | (map? x) (walk-map x local)
200 | (set? x) (walk-seq x local)
201 | (vector? x) (walk-seq x local)
202 | (seq? x) (walk-list x local)
203 | :else x))
204 |
205 | (defn hoist [x env]
206 | (binding [*env* env, *hoist* (atom #{}), *pass* (atom {})]
207 | (let [body (walk (macroexpand-all* env x) #{})
208 | [params args] (if (empty? @*pass*) [[] []] (apply map vector @*pass*))
209 | params (into params (map #(::h (meta %)) @*hoist*))
210 | args (into args @*hoist*)]
211 | [(list 'fn params body) args])))
212 |
213 | (defn cell* [x env]
214 | (let [[f args] (hoist x env)]
215 | (to-list `((javelin.core/formula ~f) ~@args)))))
216 |
217 | ;; javelin CLJS macros ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
218 |
219 | (m/defmacro with-let
220 | "Binds resource to binding and evaluates body. Then, returns
221 | resource. It's a cross between doto and with-open."
222 | [[binding resource] & body]
223 | `(let [~binding ~resource] ~@body ~binding))
224 |
225 | (m/defmacro cell=
226 | ([expr]
227 | (cell* expr &env))
228 | ([expr f]
229 | `(javelin.core/with-let [c# (javelin.core/cell= ~expr)]
230 | (set! (.-update c#) ~f))))
231 |
232 | (m/defmacro set-cell!=
233 | ([c expr]
234 | `(javelin.core/set-cell!= ~c ~expr nil))
235 | ([c expr updatefn]
236 | (let [[f args] (hoist expr &env)]
237 | `(javelin.core/set-formula! ~c ~f [~@args] ~updatefn))))
238 |
239 | (m/defmacro defc
240 | ([sym expr] `(def ~sym (javelin.core/cell ~expr)))
241 | ([sym doc expr] `(def ~sym ~doc (javelin.core/cell ~expr))))
242 |
243 | (m/defmacro defc=
244 | ([sym expr] `(def ~sym (javelin.core/cell= ~expr)))
245 | ([sym doc & [expr f]]
246 | (let [doc? (string? doc)
247 | f (when-let [f' (if doc? f expr)] [f'])
248 | expr (if doc? expr doc)
249 | doc (when doc? [doc])]
250 | `(def ~sym ~@doc (javelin.core/cell= ~expr ~@f)))))
251 |
252 | (m/defmacro formula-of
253 | "ALPHA: this macro may change.
254 |
255 | Given a vector of dependencies and one or more body expressions, emits a
256 | form that will produce a formula cell. The dependencies must be names that
257 | will be re-bound to their values within the body. No code walking is done.
258 | The value of the formula cell is computed by evaluating the body expressions
259 | whenever any of the dependencies change.
260 |
261 | Note: the dependencies need not be cells.
262 |
263 | E.g.
264 | (def x 100)
265 | (def y (cell 200))
266 | (def z (cell= (inc y)))
267 |
268 | (def c (formula-of [x y z] (+ x y z)))
269 |
270 | (deref c) ;=> 501
271 |
272 | (swap! y inc)
273 | (deref c) ;=> 503
274 | "
275 | [deps & body]
276 | (assert (and (vector? deps) (every? symbol? deps))
277 | "first argument must be a vector of symbols")
278 | `((javelin.core/formula (fn [~@deps] ~@body)) ~@deps))
279 |
280 | (m/defmacro formulet
281 | "ALPHA: this macro may change.
282 |
283 | Given a vector of binding-form/dependency pairs and one or more body
284 | expressions, emits a form that will produce a formula cell. Each binding
285 | form is bound to the value of the corresponding dependency within the body.
286 | No code walking is done. The value of the formula cell is computed by
287 | evaluating the body expressions whenever any of the dependencies change.
288 |
289 | Note: the depdendency expressions are evaluated only once, when the formula
290 | cell is created, and they need not evaluate to javelin cells.
291 |
292 | E.g.
293 | (def a (cell 42))
294 | (def b (cell {:x 100 :y 200}))
295 |
296 | (def c (formulet [v (cell= (inc a))
297 | w (+ 1 2)
298 | {:keys [x y]} b]
299 | (+ v w x y)))
300 |
301 | (deref c) ;=> 346
302 |
303 | (swap! a inc)
304 | (deref c) ;=> 347
305 | "
306 | [bindings & body]
307 | (assert (and (vector? bindings) (even? (count bindings)))
308 | "first argument must be a vector of binding pairs")
309 | (let [binding-pairs (partition 2 bindings)]
310 | `((javelin.core/formula (fn [~@(map first binding-pairs)] ~@body))
311 | ~@(map second binding-pairs))))
312 |
313 | (m/defmacro ^:private cell-let-1 [[bindings c] & body]
314 | (let [syms (bind-syms bindings)
315 | dcell `((javelin.core/formula (fn [~bindings] [~@syms])) ~c)]
316 | `(let [[~@syms] (javelin.core/cell-map identity ~dcell)] ~@body)))
317 |
318 | (m/defmacro cell-let
319 | [[bindings c & more] & body]
320 | (if-not (seq more)
321 | `(javelin.core/cell-let-1 [~bindings ~c] ~@body)
322 | `(javelin.core/cell-let-1 [~bindings ~c]
323 | (javelin.core/cell-let ~(vec more) ~@body))))
324 |
325 | (m/defmacro dosync
326 | "Evaluates the body within a Javelin transaction. Propagation of updates
327 | to formula cells is deferred until the transaction is complete. Input
328 | cells *will* update during the transaction. Transactions may be nested."
329 | [& body]
330 | `(dosync* (fn [] ~@body)))
331 |
332 | (m/defmacro cell-doseq
333 | "Takes a vector of binding-form/collection-cell pairs and one or more body
334 | expressions, similar to clojure.core/doseq. Iterating over the collection
335 | cells produces a sequence of items that may grow, shrink, or update over
336 | time. Whenever this sequence grows the body expressions are evaluated (for
337 | side effects) exactly once for each new location in the sequence. Bindings
338 | are bound to cells that refer to the item at that location.
339 |
340 | Consider:
341 |
342 | (def things (cell [{:x :a} {:x :b} {:x :c}]))
343 |
344 | (cell-doseq [{:keys [x]} things]
345 | (prn :creating @x)
346 | (add-watch x nil #(prn :updating %3 %4)))
347 |
348 | ;; the following is printed -- note that x is a cell:
349 |
350 | :creating :a
351 | :creating :b
352 | :creating :c
353 |
354 | Shrink things by removing the last item:
355 |
356 | (swap! things pop)
357 |
358 | ;; the following is printed (because the 3rd item in things is now nil,
359 | ;; since things only contains 2 items) -- note that the doit function is
360 | ;; not called (or we would see a :creating message):
361 |
362 | :updating :c nil
363 |
364 | Grow things such that it is one item larger than it ever was:
365 |
366 | (swap! things into [{:x :u} {:x :v}])
367 |
368 | ;; the following is printed (because things now has 4 items, so the 3rd
369 | ;; item is now {:x :u} and the max size increases by one with the new
370 | ;; item {:x :v}):
371 |
372 | :updating nil :u
373 | :creating :v
374 |
375 | A weird imagination is most useful to gain full advantage of all the features."
376 | [bindings & body]
377 | (if (= 2 (count bindings))
378 | `(javelin.core/cell-doseq*
379 | ((javelin.core/formula seq) ~(second bindings))
380 | (fn [item#] (javelin.core/cell-let [~(first bindings) item#] ~@body)))
381 | (let [pairs (partition 2 bindings)
382 | lets (->> pairs (filter (comp (partial = :let) first)) (mapcat second))
383 | binds* (->> pairs (take-while (complement (comp keyword? first))))
384 | mods* (->> pairs (drop-while (complement (comp keyword? first))) (mapcat identity))
385 | syms (->> binds* (mapcat (comp bind-syms first)))
386 | exprs (->> binds* (map second))
387 | gens (take (count exprs) (repeatedly gensym))
388 | fors (-> (->> binds* (map first)) (interleave gens) (concat mods*))]
389 | `(javelin.core/cell-doseq*
390 | ((javelin.core/formula (fn [~@gens] (for [~@fors] [~@syms]))) ~@exprs)
391 | (fn [item#] (javelin.core/cell-let [[~@syms] item#, ~@lets] ~@body))))))
392 |
393 | ;; FIXME: this macro doesn't work correctly, maybe mutation observers?
394 | (m/defmacro prop-cell
395 | ([prop]
396 | `(let [ret# (cell ~prop)]
397 | (js/setInterval #(reset! ret# ~prop) 100)
398 | (javelin.core/cell= ret#)))
399 | ([prop setter & [callback]]
400 | `(let [setter# ~setter
401 | callback# (or ~callback identity)]
402 | (javelin.core/cell= (set! ~prop setter#))
403 | (js/setInterval
404 | #(when (not= @setter# ~prop)
405 | (callback# ~prop)
406 | (set! ~prop @setter#))
407 | 100)
408 | setter#)))
409 |
410 | (def javelin-core-ns
411 | (assoc (sci/copy-ns javelin.core jns)
412 | 'foo 'bar
413 | 'dosync (sci/copy-var sci.configs.hoplon.javelin/dosync jns)
414 | 'with-let (sci/copy-var sci.configs.hoplon.javelin/with-let jns)
415 | 'cell= (sci/copy-var cell= jns)
416 | 'defc (sci/copy-var defc jns)
417 | 'cell-let-1 (sci/copy-var cell-let-1 jns)
418 | 'cell-let (sci/copy-var cell-let jns)
419 | 'defc= (sci/copy-var defc= jns)
420 | 'set-cell!= (sci/copy-var set-cell!= jns)
421 | 'formula-of (sci/copy-var formula-of jns)
422 | 'formulet (sci/copy-var formulet jns)
423 | 'cell-doseq (sci/copy-var cell-doseq jns)))
424 |
425 | (def config {:namespaces {'javelin.core javelin-core-ns}})
426 |
427 | #_
428 | (do
429 | (require '[sci.core :as sci])
430 | (require '[sci.configs.hoplon.javelin] :reload)
431 | (def ctx (sci/init {:namespaces {'javelin.core sci.configs.hoplon.javelin/javelin-core-ns} :classes {'js js/globalThis :allow :all}}))
432 | (do (sci.ctx-store/reset-ctx! ctx) nil)
433 | (sci/eval-string* ctx "(require '[javelin.core :as j])")
434 | (sci/eval-string* ctx "(let [a (j/cell 0) b (j/cell= (inc a)) c (j/cell= (js/console.log b))] (swap! a inc))")
435 | )
436 |
--------------------------------------------------------------------------------
/src/sci/configs/fulcro/component.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.fulcro.component
2 | (:require
3 | [cljs.spec.alpha :as s]
4 | [clojure.set :as set]
5 | [clojure.walk :refer [prewalk]]
6 | [edn-query-language.core :as eql]
7 | [sci.core :as sci]
8 | [com.fulcrologic.fulcro.components :as comp]
9 | [com.fulcrologic.fulcro.algorithms.do-not-use :as util]
10 | [sci.configs.fulcro.fulcro-sci-helpers :as ana]))
11 |
12 | (def cljs? (constantly true)) ; was `(:ns &env)` but sci's &env lacks :ns
13 |
14 | (defn with-parent-context-fn
15 | [parent body-fn]
16 | (let [app (or comp/*app* (comp/any->app parent))
17 | s (comp/shared app)
18 | p (or comp/*parent* parent)]
19 | (binding [comp/*app* app
20 | comp/*shared* s
21 | comp/*parent* p]
22 | (body-fn))))
23 |
24 | (defn ^:sci/macro with-parent-context
25 | [_&form &env outer-parent & body]
26 | (if-not (cljs? &env) ; was (:ns &env)
27 | `(do ~@body)
28 | ;; Re-written to move the core into a separate fn, so that `binding` happens
29 | ;; there and not in code that SCI needs to evaluate, which has its complexities
30 | `(with-parent-context-fn ~outer-parent (fn [] ~@body))))
31 |
32 | (defn- is-link?
33 | "Returns true if the given query element is a link query like [:x '_]."
34 | [query-element] (and (vector? query-element)
35 | (keyword? (first query-element))
36 | ; need the double-quote because when in a macro we'll get the literal quote. ; TODO is this true for SCI ?!
37 | (#{''_ '_} (second query-element))))
38 |
39 | (defn- children-by-prop ; TODO clj-only in Fulcro proper, but could be for cljs too?!
40 | "Part of Defsc macro implementation. Calculates a map from join key to class (symbol)."
41 | [query]
42 | (into {}
43 | (keep #(if (and (map? %) (or (is-link? (ffirst %)) (keyword? (ffirst %))))
44 | (let [k (if (vector? (ffirst %))
45 | (first (ffirst %))
46 | (ffirst %))
47 | cls (-> % first second second)]
48 | [k cls])
49 | nil) query)))
50 |
51 | (defn- replace-and-validate-fn ; TODO clj-only in Fulcro proper, but could be for cljs too?!
52 | "Replace the first sym in a list (the function name) with the given symbol.
53 |
54 | env - the macro &env
55 | sym - The symbol that the lambda should have
56 | 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.
57 | user-arity - The number of external-args the user should supply (resulting user-arity is (count external-args) + user-arity).
58 | fn-form - The form to rewrite
59 | sym - The symbol to report in the error message (in case the rewrite uses a different target that the user knows)."
60 | ([env sym external-args user-arity fn-form] (replace-and-validate-fn env sym external-args user-arity fn-form sym))
61 | ([env sym external-args user-arity fn-form user-known-sym]
62 | (when-not (<= user-arity (count (second fn-form)))
63 | (throw (ana/error (merge env (meta fn-form)) (str "Invalid arity for " user-known-sym ". Expected " user-arity " or more."))))
64 | (let [user-args (second fn-form)
65 | updated-args (into (vec (or external-args [])) user-args)
66 | body-forms (drop 2 fn-form)]
67 | (->> body-forms
68 | (cons updated-args)
69 | (cons sym)
70 | (cons 'fn)))))
71 |
72 | (defn- build-ident ; TODO clj-only in Fulcro proper, but could be for cljs too?!
73 | "Builds the ident form. If ident is a vector, then it generates the function and validates that the ID is
74 | in the query. Otherwise, if ident is of the form (ident [this props] ...) it simply generates the correct
75 | entry in defsc without error checking."
76 | [env thissym propsarg {:keys [method template keyword]} is-legal-key?]
77 | (cond
78 | keyword (if (is-legal-key? keyword)
79 | `(~'fn ~'ident* [~'_ ~'props] [~keyword (~keyword ~'props)])
80 | (throw (ana/error (merge env (meta template)) (str "The table/id " keyword " of :ident does not appear in your :query"))))
81 | method (replace-and-validate-fn env 'ident* [thissym propsarg] 0 method)
82 | template (let [table (first template)
83 | id-prop (or (second template) :db/id)]
84 | (cond
85 | (nil? table) (throw (ana/error (merge env (meta template)) "TABLE part of ident template was nil" {}))
86 | (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")))
87 | :otherwise `(~'fn ~'ident* [~'this ~'props] [~table (~id-prop ~'props)])))))
88 |
89 | (defn- build-render [classsym thissym propsym compsym extended-args-sym body] ; TODO clj-only in Fulcro proper, but could be for cljs too?!
90 | (let [computed-bindings (when compsym `[~compsym (com.fulcrologic.fulcro.components/get-computed ~thissym)])
91 | extended-bindings (when extended-args-sym `[~extended-args-sym (com.fulcrologic.fulcro.components/get-extra-props ~thissym)])
92 | render-fn (symbol (str "render-" (name classsym)))]
93 | `(~'fn ~render-fn [~thissym]
94 | (com.fulcrologic.fulcro.components/wrapped-render ~thissym
95 | (fn []
96 | (let [~propsym (com.fulcrologic.fulcro.components/props ~thissym)
97 | ~@computed-bindings
98 | ~@extended-bindings]
99 | ~@body))))))
100 |
101 | (defn- build-hooks-render [classsym thissym propsym compsym extended-args-sym body] ; TODO clj-only in Fulcro proper, but could be for cljs too?!
102 | (let [computed-bindings (when compsym `[~compsym (com.fulcrologic.fulcro.components/get-computed ~thissym)])
103 | extended-bindings (when extended-args-sym `[~extended-args-sym (com.fulcrologic.fulcro.components/get-extra-props ~thissym)])
104 | render-fn (symbol (str "render-" (name classsym)))]
105 | `(~'fn ~render-fn [~thissym ~propsym]
106 | (com.fulcrologic.fulcro.components/wrapped-render ~thissym
107 | (fn []
108 | (binding [comp/*app* (or comp/*app* (comp/isoget-in ~thissym ["props" "fulcro$app"]))
109 | comp/*shared* (comp/shared (or comp/*app* (comp/isoget-in ~thissym ["props" "fulcro$app"])))
110 | comp/*parent* ~thissym]
111 | (let [~@computed-bindings
112 | ~@extended-bindings]
113 | ~@body)))))))
114 |
115 | (defn- build-and-validate-initial-state-map [env sym initial-state legal-keys children-by-query-key]
116 | (let [env (merge env (meta initial-state))
117 | join-keys (set (keys children-by-query-key))
118 | init-keys (set (keys initial-state))
119 | illegal-keys (if (set? legal-keys) (set/difference init-keys legal-keys) #{})
120 | is-child? (fn [k] (contains? join-keys k))
121 | param-expr (fn [v]
122 | (if-let [kw (and (keyword? v) (= "param" (namespace v))
123 | (keyword (name v)))]
124 | `(~kw ~'params)
125 | v))
126 | parameterized (fn [init-map] (into {} (map (fn [[k v]] (if-let [expr (param-expr v)] [k expr] [k v])) init-map)))
127 | child-state (fn [k]
128 | (let [state-params (get initial-state k)
129 | to-one? (map? state-params)
130 | to-many? (and (vector? state-params) (every? map? state-params))
131 | code? (list? state-params)
132 | from-parameter? (and (keyword? state-params) (= "param" (namespace state-params)))
133 | child-class (get children-by-query-key k)]
134 | (when code?
135 | (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."))))
136 | (cond
137 | (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!")))
138 | to-one? `(com.fulcrologic.fulcro.components/get-initial-state ~child-class ~(parameterized state-params))
139 | to-many? (mapv (fn [params]
140 | `(com.fulcrologic.fulcro.components/get-initial-state ~child-class ~(parameterized params)))
141 | state-params)
142 | from-parameter? `(com.fulcrologic.fulcro.components/get-initial-state ~child-class ~(param-expr state-params))
143 | :otherwise nil)))
144 | kv-pairs (map (fn [k]
145 | [k (if (is-child? k)
146 | (child-state k)
147 | (param-expr (get initial-state k)))]) init-keys)
148 | state-map (into {} kv-pairs)]
149 | (when (seq illegal-keys)
150 | (throw (ana/error env (str "Initial state includes keys " illegal-keys ", but they are not in your query."))))
151 | `(~'fn ~'build-initial-state* [~'params] (com.fulcrologic.fulcro.components/make-state-map ~initial-state ~children-by-query-key ~'params))))
152 |
153 | (defn- build-raw-initial-state ; TODO clj-only in Fulcro proper, but could be for cljs too?!
154 | "Given an initial state form that is a list (function-form), simple copy it into the form needed by defsc."
155 | [env method]
156 | (replace-and-validate-fn env 'build-raw-initial-state* [] 1 method))
157 |
158 | (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?!
159 | (when (and template (contains? query-template-or-method :method))
160 | (throw (ana/error (merge env (meta template)) (str "When query is a method, initial state MUST be as well."))))
161 | (cond
162 | method (build-raw-initial-state env method)
163 | template (let [query (:template query-template-or-method)
164 | children (or (children-by-prop query) {})]
165 | (build-and-validate-initial-state-map env sym template legal-keys children))))
166 |
167 | (defn -legal-keys ; TODO clj-only in Fulcro proper, but could be for cljs too?!
168 | "PRIVATE. Find the legal keys in a query. NOTE: This is at compile time, so the get-query calls are still embedded (thus cannot
169 | use the AST)"
170 | [query]
171 | (letfn [(keeper [ele]
172 | (cond
173 | (list? ele) (recur (first ele))
174 | (keyword? ele) ele
175 | (is-link? ele) (first ele)
176 | (and (map? ele) (keyword? (ffirst ele))) (ffirst ele)
177 | (and (map? ele) (is-link? (ffirst ele))) (first (ffirst ele))
178 | :else nil))]
179 | (set (keep keeper query))))
180 |
181 | (defn- component-query [query-part] ; TODO clj-only in Fulcro proper, but could be for cljs too?!
182 | (and (list? query-part)
183 | (symbol? (first query-part))
184 | (= "get-query" (name (first query-part)))
185 | query-part))
186 |
187 | (defn- compile-time-query->checkable ; TODO clj-only in Fulcro proper, but could be for cljs too?! (only Throwable <> :default)
188 | "Try to simplify the compile-time query (as seen by the macro)
189 | to something that EQL can check (`(get-query ..)` => a made-up vector).
190 | Returns nil if this is not possible."
191 | [query]
192 | (try
193 | (prewalk
194 | (fn [form]
195 | (cond
196 | (component-query form)
197 | [(keyword (str "subquery-of-" (some-> form second name)))]
198 |
199 | ;; Replace idents with idents that contain only keywords, so syms don't trip us up
200 | (and (vector? form) (= 2 (count form)))
201 | (mapv #(if (symbol? %) :placeholder %) form)
202 |
203 | (symbol? form)
204 | (throw (ex-info "Cannot proceed, the query contains a symbol" {:sym form}))
205 |
206 | :else
207 | form))
208 | query)
209 | (catch :default _ ; Changed - was Throwable
210 | nil)))
211 |
212 | (defn- check-query-looks-valid [err-env comp-class compile-time-query] ; TODO clj-only in Fulcro proper, but could be for cljs too?!
213 | (let [checkable-query (compile-time-query->checkable compile-time-query)]
214 | (when (false? (some->> checkable-query (s/valid? ::eql/query)))
215 | (let [{:clojure.spec.alpha/keys [problems]} (s/explain-data ::eql/query checkable-query)
216 | {:keys [in]} (first problems)]
217 | (when (vector? in)
218 | (throw (ana/error err-env (str "The element '" (get-in compile-time-query in) "' of the query of " comp-class " is not valid EQL"))))))))
219 |
220 |
221 | (defn- build-query-forms ; TODO clj-only in Fulcro proper, but could be for cljs too?!
222 | "Validate that the property destructuring and query make sense with each other."
223 | [env class thissym propargs {:keys [template method]}]
224 | (cond
225 | template
226 | (do
227 | (assert (or (symbol? propargs) (map? propargs)) "Property args must be a symbol or destructuring expression.")
228 | (let [to-keyword (fn [s] (cond
229 | (nil? s) nil
230 | (keyword? s) s
231 | :otherwise (let [nspc (namespace s)
232 | nm (name s)]
233 | (keyword nspc nm))))
234 | destructured-keywords (when (map? propargs) (util/destructured-keys propargs))
235 | queried-keywords (-legal-keys template)
236 | has-wildcard? (some #{'*} template)
237 | to-sym (fn [k] (symbol (namespace k) (name k)))
238 | illegal-syms (mapv to-sym (set/difference destructured-keywords queried-keywords))
239 | err-env (merge env (meta template))]
240 | (when-let [child-query (some component-query template)]
241 | (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 "}`"))))
242 | (when (and (not has-wildcard?) (seq illegal-syms))
243 | (throw (ana/error err-env (str "defsc " class ": " illegal-syms " was destructured in props, but does not appear in the :query!"))))
244 | `(~'fn ~'query* [~thissym] ~template)))
245 | method
246 | (replace-and-validate-fn env 'query* [thissym] 0 method)))
247 |
248 | ;; Copied b/c they are :clj only in the orig ns
249 | (s/def ::ident (s/or :template (s/and vector? #(= 2 (count %))) :method list? :keyword keyword?))
250 | (s/def ::query (s/or :template vector? :method list?))
251 | (s/def ::initial-state (s/or :template map? :method list?))
252 | (s/def ::options (s/keys :opt-un [::query ::ident ::initial-state]))
253 | (s/def ::args (s/cat
254 | :sym symbol?
255 | :doc (s/? string?)
256 | :arglist (s/and vector? #(<= 2 (count %) 5))
257 | :options (s/? map?)
258 | :body (s/* any?)))
259 |
260 | (defn defsc*
261 | [env args]
262 | (when-not (s/valid? ::args args)
263 | (throw (ana/error env (str "Invalid arguments. " (-> (s/explain-data ::args args)
264 | ::s/problems
265 | first
266 | :path) " is invalid."))))
267 | (let [{:keys [sym doc arglist options body]} (s/conform ::args args)
268 | [thissym propsym computedsym extra-args] arglist
269 | _ (when (and options (not (s/valid? ::options options)))
270 | (let [path (-> (s/explain-data ::options options) ::s/problems first :path)
271 | message (cond
272 | (= path [:query :template]) "The query template only supports vectors as queries. Unions or expression require the lambda form."
273 | (= :ident (first path)) "The ident must be a keyword, 2-vector, or lambda of no arguments."
274 | :else "Invalid component options. Please check to make\nsure your query, ident, and initial state are correct.")]
275 | (throw (ana/error env message))))
276 | {:keys [ident query initial-state]} (s/conform ::options options)
277 | body (or body ['nil])
278 | ident-template-or-method (into {} [ident]) ;clojure spec returns a map entry as a vector
279 | initial-state-template-or-method (into {} [initial-state])
280 | query-template-or-method (into {} [query])
281 | validate-query? (and (:template query-template-or-method) (not (some #{'*} (:template query-template-or-method))))
282 | legal-key-checker (if validate-query?
283 | (or (-legal-keys (:template query-template-or-method)) #{})
284 | (complement #{}))
285 | ident-form (build-ident env thissym propsym ident-template-or-method legal-key-checker)
286 | state-form (build-initial-state env sym initial-state-template-or-method legal-key-checker query-template-or-method)
287 | query-form (build-query-forms env sym thissym propsym query-template-or-method)
288 | _ (when validate-query?
289 | ;; after build-query-forms as it also does some useful checks
290 | (check-query-looks-valid env sym (:template query-template-or-method)))
291 | hooks? (and (cljs? env) (:use-hooks? options))
292 | render-form (if hooks?
293 | (build-hooks-render sym thissym propsym computedsym extra-args body)
294 | (build-render sym thissym propsym computedsym extra-args body))
295 | nspc (if (cljs? env) (-> env :ns :name str) (name (ns-name *ns*)))
296 | fqkw (keyword (str nspc) (name sym))
297 | options-map (cond-> options
298 | state-form (assoc :initial-state state-form)
299 | ident-form (assoc :ident ident-form)
300 | query-form (assoc :query query-form)
301 | hooks? (assoc :componentName fqkw)
302 | render-form (assoc :render render-form))]
303 | (cond
304 | hooks?
305 | `(do
306 | (defonce ~sym
307 | (fn [js-props#]
308 | (let [render# (:render (comp/component-options ~sym))
309 | [this# props#] (comp/use-fulcro js-props# ~sym)]
310 | (render# this# props#))))
311 | (comp/add-hook-options! ~sym ~options-map))
312 |
313 | (cljs? env)
314 | `(do
315 | (declare ~sym)
316 | (let [options# ~options-map]
317 | (def ~(vary-meta sym assoc :doc doc :jsdoc ["@constructor"]) ; JH: BEWARE `defonce` will prevent changes in :advanced optimiz.
318 | (comp/react-constructor (get options# :initLocalState)))
319 | (com.fulcrologic.fulcro.components/configure-component! ~sym ~fqkw options#)))
320 |
321 | :else
322 | `(do
323 | (declare ~sym)
324 | (let [options# ~options-map]
325 | (def ~(vary-meta sym assoc :doc doc :once true)
326 | (com.fulcrologic.fulcro.components/configure-component! ~(str sym) ~fqkw options#)))))))
327 |
328 | (defn ^:sci/macro defsc [_&form &env & args]
329 | (try
330 | ;; Note: In cljs, env would have `:ns` but not so in SCI, yet Fulcro looks at it => add
331 | (let [ns-name (some->> sci.core/ns deref str)
332 | fake-ns (when (seq ns-name) {:name ns-name})]
333 | (defsc* (assoc &env :ns fake-ns) args))
334 | (catch :default e
335 | (if (contains? (ex-data e) :tag)
336 | (throw e)
337 | (throw (ex-info "Unexpected internal error while processing defsc. Please check your syntax." {} e))))))
338 |
339 | (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.components))
340 | (def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.components sci-ns {:exclude [with-parent-context defsc defsc*]})
341 | 'with-parent-context (sci/copy-var with-parent-context sci-ns)
342 | 'defsc* (sci/copy-var defsc* sci-ns)
343 | 'defsc (sci/copy-var defsc sci-ns)))
344 |
345 | (def sci-ns2 (sci/create-ns 'sci.configs.fulcro.component))
346 | (def ns-def2 {'with-parent-context-fn (sci/copy-var with-parent-context-fn sci-ns2)})
347 |
348 | (def namespaces {'com.fulcrologic.fulcro.components ns-def
349 | 'sci.configs.fulcro.component ns-def2})
350 |
--------------------------------------------------------------------------------
/src/sci/configs/cljs/spec/alpha.cljs:
--------------------------------------------------------------------------------
1 | (ns sci.configs.cljs.spec.alpha
2 | (:refer-clojure :exclude [and or keys merge every cat + ? * assert])
3 | (:require [clojure.spec.alpha :as s]
4 | [cljs.spec.gen.alpha :as gen]
5 | [cljs.spec.test.alpha :as stest]
6 | [sci.core :as sci]
7 | [sci.ctx-store :as ctx]
8 | [clojure.walk :as walk]
9 | [clojure.core :as c]
10 | [clojure.string :as str]
11 | [sci.lang])
12 | (:require-macros [sci.configs.macros :as macros]))
13 |
14 | (def sns (sci/create-ns 'cljs.spec.alpha nil))
15 |
16 | (defonce ^:private registry-ref (atom {}))
17 | (defonce ^:private _speced_vars (atom #{}))
18 |
19 | (defn speced-vars []
20 | @_speced_vars)
21 |
22 | (defn- unfn [expr]
23 | (if (clojure.core/and (seq? expr)
24 | (symbol? (first expr))
25 | (= "fn*" (name (first expr))))
26 | (let [[[s] & form] (rest expr)]
27 | (conj (walk/postwalk-replace {s '%} form) '[%] 'cljs.core/fn))
28 | expr))
29 |
30 | (def sci-sym (delay (sci/eval-form (ctx/get-ctx) 'cljs.core/symbol)))
31 |
32 | (defn- ->sym
33 | "Returns a symbol from a symbol or var"
34 | [x]
35 | (if (instance? sci.lang.Var x)
36 | (@sci-sym x)
37 | x))
38 |
39 | (defn- res [env form]
40 | (cond
41 | (keyword? form) form
42 | (symbol? form) (clojure.core/or (->> form (sci/resolve env) ->sym) form)
43 | (sequential? form) (walk/postwalk #(if (symbol? %) (res env %) %) (unfn form))
44 | :else form))
45 |
46 | (defn- ns-qualify
47 | "Qualify symbol s by resolving it or using the current *ns*."
48 | [_env s]
49 | (if (namespace s)
50 | (->sym (sci/resolve (ctx/get-ctx) s))
51 | (symbol (str @sci/ns) (str s))))
52 |
53 | (macros/defmacro def*
54 | "Given a namespace-qualified keyword or resolveable symbol k, and a
55 | spec, spec-name, predicate or regex-op makes an entry in the
56 | registry mapping k to the spec. Use nil to remove an entry in
57 | the registry for k."
58 | [k spec-form]
59 | (let [&env (ctx/get-ctx)
60 | k (if (symbol? k)
61 | (let [sym (ns-qualify &env k)]
62 | (swap! _speced_vars conj
63 | (vary-meta sym assoc :fdef-ns (-> &env :ns :name)))
64 | sym)
65 | k)
66 | form (res &env spec-form)]
67 | (swap! registry-ref (fn [r]
68 | (if (nil? form)
69 | (dissoc r k)
70 | (assoc r k form))))
71 | `(s/def-impl '~k '~form ~spec-form)))
72 |
73 | (macros/defmacro and
74 | "Takes predicate/spec-forms, e.g.
75 |
76 | (s/and even? #(< % 42))
77 |
78 | Returns a spec that returns the conformed value. Successive
79 | conformed values propagate through rest of predicates."
80 | [& pred-forms]
81 | (let [&env (ctx/get-ctx)]
82 | `(s/and-spec-impl '~(mapv #(res &env %) pred-forms) ~(vec pred-forms) nil)))
83 |
84 | (macros/defmacro or
85 | "Takes key+pred pairs, e.g.
86 |
87 | (s/or :even even? :small #(< % 42))
88 |
89 | Returns a destructuring spec that returns a map entry containing the
90 | key of the first matching pred and the corresponding value. Thus the
91 | 'key' and 'val' functions can be used to refer generically to the
92 | components of the tagged return."
93 | [& key-pred-forms]
94 | (let [&env (ctx/get-ctx)
95 | pairs (partition 2 key-pred-forms)
96 | keys (mapv first pairs)
97 | pred-forms (mapv second pairs)
98 | pf (mapv #(res &env %) pred-forms)]
99 | (clojure.core/assert (clojure.core/and (even? (count key-pred-forms)) (every? keyword? keys)) "spec/or expects k1 p1 k2 p2..., where ks are keywords")
100 | `(s/or-spec-impl ~keys '~pf ~pred-forms nil)))
101 |
102 | (macros/defmacro nilable
103 | "returns a spec that accepts nil and values satisfiying pred"
104 | [pred]
105 | (let [&env (ctx/get-ctx)
106 | pf (res &env pred)]
107 | `(s/nilable-impl '~pf ~pred nil)))
108 |
109 | (macros/defmacro keys
110 | "Creates and returns a map validating spec. :req and :opt are both
111 | vectors of namespaced-qualified keywords. The validator will ensure
112 | the :req keys are present. The :opt keys serve as documentation and
113 | may be used by the generator.
114 |
115 | The :req key vector supports 'and' and 'or' for key groups:
116 |
117 | (s/keys :req [::x ::y (or ::secret (and ::user ::pwd))] :opt [::z])
118 |
119 | There are also -un versions of :req and :opt. These allow
120 | you to connect unqualified keys to specs. In each case, fully
121 | qualfied keywords are passed, which name the specs, but unqualified
122 | keys (with the same name component) are expected and checked at
123 | conform-time, and generated during gen:
124 |
125 | (s/keys :req-un [:my.ns/x :my.ns/y])
126 |
127 | The above says keys :x and :y are required, and will be validated
128 | and generated by specs (if they exist) named :my.ns/x :my.ns/y
129 | respectively.
130 |
131 | In addition, the values of *all* namespace-qualified keys will be validated
132 | (and possibly destructured) by any registered specs. Note: there is
133 | no support for inline value specification, by design.
134 |
135 | Optionally takes :gen generator-fn, which must be a fn of no args that
136 | returns a test.check generator."
137 | [& {:keys [req req-un opt opt-un gen]}]
138 | (let [&env (ctx/get-ctx)
139 | unk #(-> % name keyword)
140 | req-keys (filterv keyword? (flatten req))
141 | req-un-specs (filterv keyword? (flatten req-un))
142 | _ (clojure.core/assert (every? #(clojure.core/and (keyword? %) (namespace %)) (concat req-keys req-un-specs opt opt-un))
143 | "all keys must be namespace-qualified keywords")
144 | req-specs (into req-keys req-un-specs)
145 | req-keys (into req-keys (map unk req-un-specs))
146 | opt-keys (into (vec opt) (map unk opt-un))
147 | opt-specs (into (vec opt) opt-un)
148 | gx (gensym)
149 | parse-req (fn [rk f]
150 | (map (fn [x]
151 | (if (keyword? x)
152 | `(contains? ~gx ~(f x))
153 | (walk/postwalk
154 | (fn [y] (if (keyword? y) `(contains? ~gx ~(f y)) y))
155 | x)))
156 | rk))
157 | pred-exprs [`(map? ~gx)]
158 | pred-exprs (into pred-exprs (parse-req req identity))
159 | pred-exprs (into pred-exprs (parse-req req-un unk))
160 | keys-pred `(fn* [~gx] (cljs.core/and ~@pred-exprs))
161 | pred-exprs (mapv (fn [e] `(fn* [~gx] ~e)) pred-exprs)
162 | pred-forms (walk/postwalk #(res &env %) pred-exprs)]
163 | ;; `(map-spec-impl ~req-keys '~req ~opt '~pred-forms ~pred-exprs ~gen)
164 | `(s/map-spec-impl {:req '~req :opt '~opt :req-un '~req-un :opt-un '~opt-un
165 | :req-keys '~req-keys :req-specs '~req-specs
166 | :opt-keys '~opt-keys :opt-specs '~opt-specs
167 | :pred-forms '~pred-forms
168 | :pred-exprs ~pred-exprs
169 | :keys-pred ~keys-pred
170 | :gfn ~gen})))
171 |
172 | (macros/defmacro keys*
173 | "takes the same arguments as spec/keys and returns a regex op that matches sequences of key/values,
174 | converts them into a map, and conforms that map with a corresponding
175 | spec/keys call:
176 |
177 | user=> (s/conform (s/keys :req-un [::a ::c]) {:a 1 :c 2})
178 | {:a 1, :c 2}
179 | user=> (s/conform (s/keys* :req-un [::a ::c]) [:a 1 :c 2])
180 | {:a 1, :c 2}
181 |
182 | the resulting regex op can be composed into a larger regex:
183 |
184 | user=> (s/conform (s/cat :i1 integer? :m (s/keys* :req-un [::a ::c]) :i2 integer?) [42 :a 1 :c 2 :d 4 99])
185 | {:i1 42, :m {:a 1, :c 2, :d 4}, :i2 99}"
186 | [& kspecs]
187 | `(let [mspec# (s/keys ~@kspecs)]
188 | (s/with-gen (s/& (s/* (s/cat ::s/k keyword? ::s/v cljs.core/any?)) ::s/kvs->map mspec#)
189 | (fn [] (gen/fmap (fn [m#] (apply concat m#)) (s/gen mspec#))))))
190 |
191 | (macros/defmacro &
192 | "takes a regex op re, and predicates. Returns a regex-op that consumes
193 | input as per re but subjects the resulting value to the
194 | conjunction of the predicates, and any conforming they might perform."
195 | [re & preds]
196 | (let [&env (ctx/get-ctx)
197 | pv (vec preds)]
198 | `(s/amp-impl ~re '~(res &env re) ~pv '~(mapv #(res &env %) pv))))
199 |
200 | (def gns (sci/create-ns 'cljs.spec.gen.alpha))
201 |
202 | (macros/defmacro merge
203 | "Takes map-validating specs (e.g. 'keys' specs) and
204 | returns a spec that returns a conformed map satisfying all of the
205 | specs. Successive conformed values propagate through rest of
206 | predicates. Unlike 'and', merge can generate maps satisfying the
207 | union of the predicates."
208 | [& pred-forms]
209 | (let [&env (ctx/get-ctx)]
210 | `(s/merge-spec-impl '~(mapv #(res &env %) pred-forms) ~(vec pred-forms) nil)))
211 |
212 | (defn- res-kind
213 | [env opts]
214 | (let [{kind :kind :as mopts} opts]
215 | (->>
216 | (if kind
217 | (assoc mopts :kind `~(res env kind))
218 | mopts)
219 | (mapcat identity))))
220 |
221 | (macros/defmacro coll-of
222 | "Returns a spec for a collection of items satisfying pred. Unlike
223 | generator will fill an empty init-coll.
224 |
225 | Same options as 'every'. conform will produce a collection
226 | corresponding to :into if supplied, else will match the input collection,
227 | avoiding rebuilding when possible.
228 |
229 | Same options as 'every'.
230 |
231 | See also - every, map-of"
232 | [pred & opts]
233 | (let [&env (ctx/get-ctx)
234 | desc `(coll-of ~(res &env pred) ~@(res-kind &env opts))]
235 | `(s/every ~pred ::s/conform-all true ::s/describe '~desc ~@opts)))
236 |
237 | (macros/defmacro every
238 | "takes a pred and validates collection elements against that pred.
239 |
240 | Note that 'every' does not do exhaustive checking, rather it samples
241 | *coll-check-limit* elements. Nor (as a result) does it do any
242 | conforming of elements. 'explain' will report at most *coll-error-limit*
243 | problems. Thus 'every' should be suitable for potentially large
244 | collections.
245 |
246 | Takes several kwargs options that further constrain the collection:
247 |
248 | :kind - a pred that the collection type must satisfy, e.g. vector?
249 | (default nil) Note that if :kind is specified and :into is
250 | not, this pred must generate in order for every to generate.
251 | :count - specifies coll has exactly this count (default nil)
252 | :min-count, :max-count - coll has count (<= min-count count max-count) (defaults nil)
253 | :distinct - all the elements are distinct (default nil)
254 |
255 | And additional args that control gen
256 |
257 | :gen-max - the maximum coll size to generate (default 20)
258 | :into - one of [], (), {}, #{} - the default collection to generate into
259 | (default same as :kind if supplied, else []
260 |
261 | Optionally takes :gen generator-fn, which must be a fn of no args that
262 | returns a test.check generator
263 |
264 | See also - coll-of, every-kv
265 | "
266 | [pred & {:keys [into kind count max-count min-count distinct gen-max gen-into gen] :as opts}]
267 | (let [&env (ctx/get-ctx)
268 | desc (::s/describe opts)
269 | nopts (-> opts
270 | (dissoc :gen ::s/describe)
271 | (assoc ::s/kind-form `'~(res &env (:kind opts))
272 | ::s/describe (clojure.core/or desc `'(every ~(res &env pred) ~@(res-kind &env opts)))))
273 | gx (gensym)
274 | cpreds (cond-> [(list (clojure.core/or kind `coll?) gx)]
275 | count (conj `(= ~count (c/bounded-count ~count ~gx)))
276 |
277 | (clojure.core/or min-count max-count)
278 | (conj `(<= (c/or ~min-count 0)
279 | (c/bounded-count (if ~max-count (inc ~max-count) ~min-count) ~gx)
280 | (c/or ~max-count s/MAX_INT)))
281 |
282 | distinct
283 | (conj `(c/or (empty? ~gx) (apply distinct? ~gx))))]
284 | `(s/every-impl '~pred ~pred ~(assoc nopts ::s/cpred `(fn* [~gx] (c/and ~@cpreds))) ~gen)))
285 |
286 | (macros/defmacro tuple
287 | "takes one or more preds and returns a spec for a tuple, a vector
288 | where each element conforms to the corresponding pred. Each element
289 | will be referred to in paths using its ordinal."
290 | [& preds]
291 | (let [&env (ctx/get-ctx)]
292 | (clojure.core/assert (not (empty? preds)))
293 | `(s/tuple-impl '~(mapv #(res &env %) preds) ~(vec preds))))
294 |
295 | (macros/defmacro map-of
296 | "Returns a spec for a map whose keys satisfy kpred and vals satisfy
297 | vpred. Unlike 'every-kv', map-of will exhaustively conform every
298 | value.
299 |
300 | Same options as 'every', :kind defaults to map?, with the addition of:
301 |
302 | :conform-keys - conform keys as well as values (default false)
303 |
304 | See also - every-kv"
305 | [kpred vpred & opts]
306 | (let [&env (ctx/get-ctx)
307 | desc `(map-of ~(res &env kpred) ~(res &env vpred) ~@(res-kind &env opts))]
308 | `(s/every-kv ~kpred ~vpred ::s/conform-all true :kind map? ::s/describe '~desc ~@opts)))
309 |
310 | (macros/defmacro every-kv
311 | "like 'every' but takes separate key and val preds and works on associative collections.
312 |
313 | Same options as 'every', :into defaults to {}
314 |
315 | See also - map-of"
316 |
317 | [kpred vpred & opts]
318 | (let [&env (ctx/get-ctx)
319 | desc `(every-kv ~(res &env kpred) ~(res &env vpred) ~@(res-kind &env opts))]
320 | `(s/every (s/tuple ~kpred ~vpred) ::s/kfn (fn [i# v#] (nth v# 0)) :into {} ::s/describe '~desc ~@opts)))
321 |
322 | (macros/defmacro cat
323 | "Takes key+pred pairs, e.g.
324 |
325 | (s/cat :e even? :o odd?)
326 |
327 | Returns a regex op that matches (all) values in sequence, returning a map
328 | containing the keys of each pred and the corresponding value."
329 | [& key-pred-forms]
330 | (let [&env (ctx/get-ctx)
331 | pairs (partition 2 key-pred-forms)
332 | keys (mapv first pairs)
333 | pred-forms (mapv second pairs)
334 | pf (mapv #(res &env %) pred-forms)]
335 | ;;(prn key-pred-forms)
336 | (clojure.core/assert (clojure.core/and (even? (count key-pred-forms)) (every? keyword? keys)) "cat expects k1 p1 k2 p2..., where ks are keywords")
337 | `(s/cat-impl ~keys ~pred-forms '~pf)))
338 |
339 | (macros/defmacro *
340 | "Returns a regex op that matches zero or more values matching
341 | pred. Produces a vector of matches iff there is at least one match"
342 | [pred-form]
343 | (let [&env (ctx/get-ctx)]
344 | `(s/rep-impl '~(res &env pred-form) ~pred-form)))
345 |
346 | (macros/defmacro +
347 | "Returns a regex op that matches one or more values matching
348 | pred. Produces a vector of matches"
349 | [pred-form]
350 | (let [&env (ctx/get-ctx)]
351 | `(s/rep+impl '~(res &env pred-form) ~pred-form)))
352 |
353 | (macros/defmacro ?
354 | "Returns a regex op that matches zero or one value matching
355 | pred. Produces a single value (not a collection) if matched."
356 | [pred-form]
357 | (let [&env (ctx/get-ctx)]
358 | `(s/maybe-impl ~pred-form '~(res &env pred-form))))
359 |
360 | (macros/defmacro alt
361 | "Takes key+pred pairs, e.g.
362 |
363 | (s/alt :even even? :small #(< % 42))
364 |
365 | Returns a regex op that returns a map entry containing the key of the
366 | first matching pred and the corresponding value. Thus the
367 | 'key' and 'val' functions can be used to refer generically to the
368 | components of the tagged return."
369 | [& key-pred-forms]
370 | (let [&env (ctx/get-ctx)
371 | pairs (partition 2 key-pred-forms)
372 | keys (mapv first pairs)
373 | pred-forms (mapv second pairs)
374 | pf (mapv #(res &env %) pred-forms)]
375 | (clojure.core/assert (clojure.core/and (even? (count key-pred-forms)) (every? keyword? keys)) "alt expects k1 p1 k2 p2..., where ks are keywords")
376 | `(s/alt-impl ~keys ~pred-forms '~pf)))
377 |
378 | (macros/defmacro spec
379 | "Takes a single predicate form, e.g. can be the name of a predicate,
380 | like even?, or a fn literal like #(< % 42). Note that it is not
381 | generally necessary to wrap predicates in spec when using the rest
382 | of the spec macros, only to attach a unique generator
383 |
384 | Can also be passed the result of one of the regex ops -
385 | cat, alt, *, +, ?, in which case it will return a regex-conforming
386 | spec, useful when nesting an independent regex.
387 | ---
388 |
389 | Optionally takes :gen generator-fn, which must be a fn of no args that
390 | returns a test.check generator.
391 |
392 | Returns a spec."
393 | [form & {:keys [gen]}]
394 | (let [&env (ctx/get-ctx)]
395 | (when form
396 | `(s/spec-impl '~(res &env form) ~form ~gen nil))))
397 |
398 | (macros/defmacro assert
399 | "spec-checking assert expression. Returns x if x is valid? according
400 | to spec, else throws an error with explain-data plus ::failure of
401 | :assertion-failed.
402 | Can be disabled at either compile time or runtime:
403 | If *compile-asserts* is false at compile time, compiles to x. Defaults
404 | to the negation value of the ':elide-asserts' compiler option, or true if
405 | not set.
406 | If (check-asserts?) is false at runtime, always returns x. Defaults to
407 | value of 'cljs.spec.alpha/*runtime-asserts*', or false if not set. You can
408 | toggle check-asserts? with (check-asserts bool)."
409 | [spec x]
410 | `(if @#'s/*runtime-asserts*
411 | (s/assert* ~spec ~x)
412 | ~x))
413 |
414 | (def runtime-asserts
415 | (sci/copy-var s/*runtime-asserts* sns))
416 |
417 | (defn check-asserts [v]
418 | (sci/set! runtime-asserts v))
419 |
420 | #_(extend-protocol s/Specize
421 | default
422 | (specize*
423 | ([o]
424 | (prn :oo o)
425 | (if-let [f-n (c/and (fn? o)
426 | (do
427 | (prn :o o)
428 | (#'s/fn-sym (.-name o))))]
429 | (s/spec-impl f-n o nil nil)
430 | (s/spec-impl ::unknown o nil nil)))
431 | ([o form] (s/spec-impl form o nil nil))))
432 |
433 | (macros/defmacro fdef
434 | "Takes a symbol naming a function, and one or more of the following:
435 |
436 | :args A regex spec for the function arguments as they were a list to be
437 | passed to apply - in this way, a single spec can handle functions with
438 | multiple arities
439 | :ret A spec for the function's return value
440 | :fn A spec of the relationship between args and ret - the
441 | value passed is {:args conformed-args :ret conformed-ret} and is
442 | expected to contain predicates that relate those values
443 |
444 | Qualifies fn-sym with resolve, or using *ns* if no resolution found.
445 | Registers an fspec in the global registry, where it can be retrieved
446 | by calling get-spec with the var or fully-qualified symbol.
447 |
448 | Once registered, function specs are included in doc, checked by
449 | instrument, tested by the runner cljs.spec.test.alpha/check, and (if
450 | a macro) used to explain errors during macroexpansion.
451 |
452 | Note that :fn specs require the presence of :args and :ret specs to
453 | conform values, and so :fn specs will be ignored if :args or :ret
454 | are missing.
455 |
456 | Returns the qualified fn-sym.
457 |
458 | For example, to register function specs for the symbol function:
459 |
460 | (s/fdef cljs.core/symbol
461 | :args (s/alt :separate (s/cat :ns string? :n string?)
462 | :str string?
463 | :sym symbol?)
464 | :ret symbol?)"
465 | [fn-sym & specs]
466 | `(cljs.spec.alpha/def ~fn-sym (s/fspec ~@specs)))
467 |
468 | (macros/defmacro fspec
469 | "takes :args :ret and (optional) :fn kwargs whose values are preds
470 | and returns a spec whose conform/explain take a fn and validates it
471 | using generative testing. The conformed value is always the fn itself.
472 |
473 | See 'fdef' for a single operation that creates an fspec and
474 | registers it, as well as a full description of :args, :ret and :fn
475 |
476 | fspecs can generate functions that validate the arguments and
477 | fabricate a return value compliant with the :ret spec, ignoring
478 | the :fn spec if present.
479 |
480 | Optionally takes :gen generator-fn, which must be a fn of no args
481 | that returns a test.check generator."
482 | [& {:keys [args ret fn gen] :or {ret `cljs.core/any?}}]
483 | (let [&env (ctx/get-ctx)
484 | env &env]
485 | `(s/fspec-impl (s/spec ~args) '~(res env args)
486 | (s/spec ~ret) '~(res env ret)
487 | (s/spec ~fn) '~(res env fn) ~gen)))
488 |
489 | (macros/defmacro int-in
490 | "Returns a spec that validates fixed precision integers in the
491 | range from start (inclusive) to end (exclusive)."
492 | [start end]
493 | `(s/spec (s/and c/int? #(s/int-in-range? ~start ~end %))
494 | :gen #(gen/large-integer* {:min ~start :max (dec ~end)})))
495 |
496 | (def tns (sci/create-ns 'cljs.spec.test.alpha))
497 |
498 | (defn- collectionize
499 | [x]
500 | (if (symbol? x)
501 | (list x)
502 | x))
503 |
504 | (defn- sym-or-syms->syms [sym-or-syms]
505 | (into []
506 | (mapcat
507 | (fn [sym]
508 | (if (c/and (str/includes? (str sym) ".")
509 | (sci/find-ns (ctx/get-ctx) sym))
510 | (let [ni (sci/eval-form (ctx/get-ctx) `(ns-interns '~sym))]
511 | (->> (vals ni)
512 | (map meta)
513 | (filter #(not (:macro %)))
514 | (map :name)
515 | (map
516 | (fn [name-sym]
517 | (symbol (name sym) (name name-sym))))))
518 | [sym])))
519 | (collectionize sym-or-syms)))
520 |
521 | (defn- form->sym-or-syms
522 | "Helper for extracting a symbol or symbols from a (potentially
523 | user-supplied) quoted form. In the case that the form has ::no-eval meta, we
524 | know it was generated by us and we directly extract the result, assuming the
525 | shape of the form. This avoids applying eval to extremely large forms in the
526 | latter case."
527 | [sym-or-syms]
528 | (if (::no-eval (meta sym-or-syms))
529 | (second sym-or-syms)
530 | (eval sym-or-syms)))
531 |
532 |
533 | (macros/defmacro instrument
534 | "Instruments the vars named by sym-or-syms, a symbol or collection
535 | of symbols, or all instrumentable vars if sym-or-syms is not
536 | specified. If a symbol identifies a namespace then all symbols in that
537 | namespace will be enumerated.
538 |
539 | If a var has an :args fn-spec, sets the var's root binding to a
540 | fn that checks arg conformance (throwing an exception on failure)
541 | before delegating to the original fn.
542 |
543 | The opts map can be used to override registered specs, and/or to
544 | replace fn implementations entirely. Opts for symbols not included
545 | in sym-or-syms are ignored. This facilitates sharing a common
546 | options map across many different calls to instrument.
547 |
548 | The opts map may have the following keys:
549 |
550 | :spec a map from var-name symbols to override specs
551 | :stub a set of var-name symbols to be replaced by stubs
552 | :gen a map from spec names to generator overrides
553 | :replace a map from var-name symbols to replacement fns
554 |
555 | :spec overrides registered fn-specs with specs your provide. Use
556 | :spec overrides to provide specs for libraries that do not have
557 | them, or to constrain your own use of a fn to a subset of its
558 | spec'ed contract.
559 |
560 | :stub replaces a fn with a stub that checks :args, then uses the
561 | :ret spec to generate a return value.
562 |
563 | :gen overrides are used only for :stub generation.
564 |
565 | :replace replaces a fn with a fn that checks args conformance, then
566 | invokes the fn you provide, enabling arbitrary stubbing and mocking.
567 |
568 | :spec can be used in combination with :stub or :replace.
569 |
570 | Returns a collection of syms naming the vars instrumented."
571 | ([]
572 | (let [s (speced-vars)]
573 | `(stest/instrument ~(with-meta (list 'quote s)
574 | {::no-eval true}))))
575 | ([xs]
576 | `(stest/instrument ~xs nil))
577 | ([sym-or-syms opts]
578 | (let [syms (sym-or-syms->syms (form->sym-or-syms sym-or-syms))
579 | opts-sym (gensym "opts")]
580 | `(let [~opts-sym ~opts]
581 | (reduce
582 | (fn [ret# [_# f#]]
583 | (let [sym# (f#)]
584 | (cond-> ret# sym# (conj sym#))))
585 | []
586 | (->> (zipmap '~syms
587 | [~@(map
588 | (fn [sym]
589 | `(fn [] (stest/instrument-1 '~sym ~opts-sym)))
590 | syms)])
591 | (filter #((stest/instrumentable-syms ~opts-sym) (first %)))
592 | (stest/distinct-by first)))))))
593 |
594 | (defonce ^:private instrumented-vars (atom {}))
595 |
596 | (defn- no-fspec
597 | [v spec]
598 | (ex-info (str "Fn at " v " is not spec'ed.")
599 | {:var v :spec spec ::s/failure :no-fspec}))
600 |
601 | (defn- instrument-choose-fn
602 | "Helper for instrument."
603 | [f spec sym {over :gen :keys [stub replace]}]
604 | (if (some #{sym} stub)
605 | (-> spec (s/gen over) gen/generate)
606 | (get replace sym f)))
607 |
608 | (defn- instrument-choose-spec
609 | "Helper for instrument"
610 | [spec sym {overrides :spec}]
611 | (get overrides sym spec))
612 |
613 | (defn- instrument-1*
614 | [s v opts]
615 | (let [spec (s/get-spec s)
616 | {:keys [raw wrapped]} (get @instrumented-vars v)
617 | current @v
618 | to-wrap (if (= wrapped current) raw current)
619 | ospec (c/or (instrument-choose-spec spec s opts)
620 | (throw (no-fspec v spec)))
621 | ofn (instrument-choose-fn to-wrap ospec s opts)
622 | checked (@#'stest/spec-checking-fn v ofn ospec)]
623 | (swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked})
624 | checked))
625 |
626 | (macros/defmacro instrument-1
627 | [[_quote s] opts]
628 | (let [&env (ctx/get-ctx)]
629 | (when-let [vr (sci/resolve &env s)]
630 | (let [v (meta vr)
631 | var-name (->sym vr)]
632 | (when (and (nil? (:const v))
633 | (nil? (:macro v))
634 | (contains? (speced-vars)
635 | var-name))
636 | `(let [the-var# (resolve '~s)
637 | checked# (#'stest/instrument-1* '~s the-var# ~opts)]
638 | (when checked# (set! ~s checked#))
639 | '~var-name))))))
640 |
641 | (macros/defmacro unstrument
642 | "Undoes instrument on the vars named by sym-or-syms, specified
643 | as in instrument. With no args, unstruments all instrumented vars.
644 | Returns a collection of syms naming the vars unstrumented."
645 | ([]
646 | `(stest/unstrument ^::no-eval '[~@(map ->sym (c/keys (deref instrumented-vars)))]))
647 | ([sym-or-syms]
648 | (let [syms (sym-or-syms->syms (form->sym-or-syms sym-or-syms))]
649 | `(reduce
650 | (fn [ret# f#]
651 | (let [sym# (f#)]
652 | (cond-> ret# sym# (conj sym#))))
653 | []
654 | [~@(->> syms
655 | (map
656 | (fn [sym]
657 | (when (symbol? sym)
658 | `(fn []
659 | (stest/unstrument-1 '~sym)))))
660 | (remove nil?))]))))
661 |
662 | (macros/defmacro unstrument-1
663 | [[_quote s]]
664 | (let [&env (ctx/get-ctx)]
665 | (when-let [v (sci/resolve &env s)]
666 | (when (@instrumented-vars v)
667 | `(let [raw# (#'stest/unstrument-1* '~s (var ~s))]
668 | (when raw# (set! ~s raw#))
669 | '~s)))))
670 |
671 | (defn- unstrument-1*
672 | [_s v]
673 | (when v
674 | (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)]
675 | (swap! instrumented-vars dissoc v)
676 | (let [current @v]
677 | (when (= wrapped current)
678 | raw)))))
679 |
680 | (def namespaces {'cljs.spec.alpha {'def (sci/copy-var def* sns)
681 | 'def-impl (sci/copy-var s/def-impl sns)
682 | 'and (sci/copy-var and sns)
683 | 'and-spec-impl (sci/copy-var s/and-spec-impl sns)
684 | 'or (sci/copy-var or sns)
685 | 'or-spec-impl (sci/copy-var s/or-spec-impl sns)
686 | 'valid? (sci/copy-var s/valid? sns)
687 | 'conform (sci/copy-var s/conform sns)
688 | 'nilable (sci/copy-var nilable sns)
689 | 'nilable-impl (sci/copy-var s/nilable-impl sns)
690 | 'explain (sci/copy-var s/explain sns)
691 | 'explain-data (sci/copy-var s/explain-data sns)
692 | 'keys (sci/copy-var keys sns)
693 | 'map-spec-impl (sci/copy-var s/map-spec-impl sns)
694 | 'keys* (sci/copy-var keys* sns)
695 | 'with-gen (sci/copy-var s/with-gen sns)
696 | '& (sci/copy-var & sns)
697 | 'amp-impl (sci/copy-var s/amp-impl sns)
698 | 'gen (sci/copy-var s/gen sns)
699 | 'merge (sci/copy-var merge sns)
700 | 'merge-spec-impl (sci/copy-var s/merge-spec-impl sns)
701 | 'coll-of (sci/copy-var coll-of sns)
702 | 'every (sci/copy-var every sns)
703 | 'every-impl (sci/copy-var s/every-impl sns)
704 | 'tuple (sci/copy-var tuple sns)
705 | 'tuple-impl (sci/copy-var s/tuple-impl sns)
706 | 'map-of (sci/copy-var map-of sns)
707 | 'every-kv (sci/copy-var every-kv sns)
708 | 'cat (sci/copy-var cat sns)
709 | 'cat-impl (sci/copy-var s/cat-impl sns)
710 | '* (sci/copy-var * sns)
711 | 'rep-impl (sci/copy-var s/rep-impl sns)
712 | '+ (sci/copy-var + sns)
713 | 'rep+impl (sci/copy-var s/rep+impl sns)
714 | '? (sci/copy-var ? sns)
715 | 'maybe-impl (sci/copy-var s/maybe-impl sns)
716 | 'alt (sci/copy-var alt sns)
717 | 'alt-impl (sci/copy-var s/alt-impl sns)
718 | 'describe (sci/copy-var s/describe sns)
719 | 'spec (sci/copy-var spec sns)
720 | 'spec-impl (sci/copy-var s/spec-impl sns)
721 | 'assert (sci/copy-var assert sns)
722 | 'assert* (sci/copy-var s/assert* sns)
723 | 'check-asserts (sci/copy-var check-asserts sns)
724 | '*runtime-asserts* runtime-asserts
725 | 'invalid? (sci/copy-var s/invalid? sns)
726 | 'fdef (sci/copy-var fdef sns)
727 | 'fspec (sci/copy-var fspec sns)
728 | 'fspec-impl (sci/copy-var s/fspec-impl sns)
729 | 'registry (sci/copy-var s/registry sns)
730 | 'int-in (sci/copy-var int-in sns)
731 | 'MAX_INT s/MAX_INT
732 | 'int-in-range? (sci/copy-var s/int-in-range? sns)
733 | 'nonconforming (sci/copy-var s/nonconforming sns)
734 | 'speced-vars (sci/copy-var speced-vars sns)}
735 | 'cljs.spec.gen.alpha {'fmap (sci/copy-var gen/fmap gns)
736 | 'elements (sci/copy-var gen/elements gns)
737 | 'large-integer* (sci/copy-var gen/large-integer* gns)
738 | 'shuffle (sci/copy-var gen/shuffle gns)
739 | 'generate (sci/copy-var gen/generate gns)
740 | 'map (sci/copy-var gen/map gns)
741 | 'simple-type (sci/copy-var gen/simple-type gns)}
742 | 'cljs.spec.test.alpha {'instrument (sci/copy-var instrument tns)
743 | 'distinct-by (sci/copy-var stest/distinct-by tns)
744 | 'instrumentable-syms (sci/copy-var stest/instrumentable-syms tns)
745 | 'instrument-1 (sci/copy-var instrument-1 tns)
746 | 'instrument-1* (sci/copy-var instrument-1* tns)
747 | 'unstrument (sci/copy-var unstrument tns)
748 | 'unstrument-1 (sci/copy-var unstrument-1 tns)
749 | 'unstrument-1* (sci/copy-var unstrument-1* tns)}})
750 |
751 | (def config {:namespaces namespaces})
752 |
753 | ;; TODO: multi-spec
754 |
--------------------------------------------------------------------------------