├── .clj-kondo
├── config.edn
└── hyperfiddle
│ └── electric
│ └── config.edn
├── .cljfmt.edn
├── .cljstyle
├── .githooks
├── Readme.md
└── pre-commit
├── .github
└── workflows
│ └── test_and_deploy.yml
├── .gitignore
├── .node-version
├── .projectile
├── .vscode
└── settings.json
├── CHANGELOG.md
├── Readme.md
├── ci
├── run_tests_all.sh
├── run_tests_browser.sh
├── run_tests_jvm.sh
├── run_tests_node.sh
└── running_dom_tests.md
├── deps.edn
├── docs
├── electric-protocol.md
├── electric3-explainer.png
└── lightning_talk_cover.png
├── karma.conf.js
├── package-lock.json
├── package.json
├── resources
└── public
│ ├── hyperfiddle-electric-ui.css
│ ├── hyperfiddle-forms.css
│ └── hyperfiddle-popover.css
├── shadow-cljs.edn
├── src-build
├── build.clj
└── build.md
├── src-dev
└── toxiproxy.sh
├── src
├── clj-kondo.exports
│ └── hyperfiddle
│ │ └── electric
│ │ └── config.edn
├── contrib
│ ├── electric_codemirror.cljc
│ ├── missionary_contrib.cljc
│ ├── missionary_core_async.cljc
│ ├── stacktrace.cljs
│ ├── test_match.clj
│ ├── trace3.cljc
│ ├── triple_store.cljc
│ └── walk.cljc
└── hyperfiddle
│ ├── detest.cljc
│ ├── domlike.cljc
│ ├── electric
│ ├── debug3.cljc
│ └── impl
│ │ ├── array_fields.cljc
│ │ ├── cljs_analyzer2.clj
│ │ ├── destructure.cljc
│ │ ├── event_store.cljc
│ │ ├── jetty9_ring_websocket_adapter.clj
│ │ ├── lang3.clj
│ │ ├── lang3.cljs
│ │ ├── lang_3_walkthrough.md
│ │ ├── missionary_util.cljc
│ │ ├── mount_point.cljc
│ │ ├── pures_fns.clj
│ │ ├── runtime3.cljc
│ │ └── sunng87_ring_jetty9_ws_adapter.clj
│ ├── electric3.cljc
│ ├── electric3_contrib.cljc
│ ├── electric_client3.cljs
│ ├── electric_css3.cljc
│ ├── electric_dom3.cljc
│ ├── electric_dom3_events.cljc
│ ├── electric_dom3_props.cljc
│ ├── electric_forms3.cljc
│ ├── electric_forms5.cljc
│ ├── electric_fulcro_dom_adapter.cljc
│ ├── electric_httpkit_adapter3.clj
│ ├── electric_jetty9_ring_adapter3.clj
│ ├── electric_local_def3.cljc
│ ├── electric_ring_adapter3.clj
│ ├── electric_scroll0.cljc
│ ├── electric_svg3.cljc
│ ├── electric_tokens.cljc
│ ├── incseq.cljc
│ ├── incseq
│ ├── arrays_impl.cljc
│ ├── diff_impl.cljc
│ ├── fixed_impl.cljc
│ ├── flow_protocol_enforcer.cljc
│ ├── items_eager_impl.cljc
│ ├── items_impl.cljc
│ ├── latest_concat_impl.cljc
│ ├── latest_product_impl.cljc
│ ├── mount_impl.cljc
│ └── perm_impl.cljc
│ ├── input_zoo0.cljc
│ ├── kvs.cljc
│ └── token_zoo0.cljc
└── test
├── cljs
└── analyzer_testing_auto_alias.cljc
├── contrib
├── missionary_contrib_test.edn
└── triple_store_test.cljc
└── hyperfiddle
├── browser_test_setup.clj
├── detest
└── incseq_test.cljc
├── electric
└── impl
│ ├── cljs_analyzer2_test.clj
│ ├── cljs_file_to_analyze.cljs
│ ├── cljs_file_to_analyze
│ ├── include.cljc
│ ├── macro_ns.clj
│ ├── refer_macros.cljc
│ ├── require.cljc
│ ├── runtime.clj
│ ├── runtime.cljs
│ ├── use.cljc
│ └── use_macros.cljc
│ ├── compiler_test.cljc
│ ├── compiler_test_clj.clj
│ ├── compiler_test_cljs.cljs
│ ├── expand3_test.cljc
│ ├── expand_macro.clj
│ ├── expand_require_referred.cljc
│ ├── expand_unloaded.cljc
│ ├── mount_point_test.cljc
│ └── runtime3_test.cljc
├── electric3_exceptions_test.edn
├── electric3_network_test.cljc
├── electric3_test.cljc
├── goog_calls_test3.cljc
├── incseq
├── diff_impl_test.cljc
├── fixed_impl_test.cljc
├── items_eager_impl_test.cljc
├── items_impl_test.cljc
├── latest_concat_impl_test.cljc
├── latest_product_impl_test.cljc
├── mount_impl_test.cljc
└── perm_impl_test.cljc
├── js_calls_test3.cljs
├── js_calls_test3.js
├── missionary_test.cljc
└── transaction_test.clj
/.clj-kondo/config.edn:
--------------------------------------------------------------------------------
1 | {:lint-as {hyperfiddle.electric3/defn clojure.core/defn
2 | hyperfiddle.electric3/for clojure.core/for
3 | hyperfiddle.electric3/cursor clojure.core/let
4 | hyperfiddle.electric3/with-cycle clojure.core/let
5 | hyperfiddle.electric3/fn clojure.core/fn
6 | hyperfiddle.electric3/declare clojure.core/declare
7 | hyperfiddle.electric.impl.array-fields/deffields clojure.core/declare}
8 | :linters {:redundant-expression {:level :off}}}
9 |
--------------------------------------------------------------------------------
/.clj-kondo/hyperfiddle/electric/config.edn:
--------------------------------------------------------------------------------
1 | {:lint-as {hyperfiddle.electric/def clojure.core/def
2 | hyperfiddle.electric/defn clojure.core/defn
3 | hyperfiddle.electric3/defn clojure.core/defn
4 | hyperfiddle.electric3/declare clojure.core/declare
5 | hyperfiddle.electric3/cursor clojure.core/for
6 | hyperfiddle.electric3/for clojure.core/for
7 | hyperfiddle.electric/for clojure.core/for
8 | hyperfiddle.electric/with-cycle clojure.core/let
9 | hyperfiddle.electric/fn clojure.core/fn}
10 | :linters {:redundant-expression {:level :off}}}
11 |
--------------------------------------------------------------------------------
/.cljfmt.edn:
--------------------------------------------------------------------------------
1 | {:indents ^:replace {#"^." [[:inner 0]]}
2 | :test-code [(sui/ui-grid {:columns 2}
3 | (sui/ui-grid-row {}
4 | (sui/ui-grid-column {:width 12}
5 | ...)))
6 | (let [foo bar]
7 | (str "foo"
8 | "bar"))]}
--------------------------------------------------------------------------------
/.cljstyle:
--------------------------------------------------------------------------------
1 | {:files
2 | {:extensions #{"cljc" "cljs" "clj" "cljx"},
3 | :ignore #{".hg" ".git", "target", "scratch"}},
4 | :rules
5 | {:namespaces
6 | {:enabled? false,
7 | :indent-size 2,
8 | :break-libs? true,
9 | :import-break-width 60},
10 | :whitespace
11 | {:enabled? true,
12 | :remove-surrounding? true,
13 | :remove-trailing? true,
14 | :insert-missing? true},
15 | :comments {:enabled? true, :inline-prefix " ", :leading-prefix "; "},
16 | :functions {:enabled? false},
17 | :eof-newline {:enabled? true},
18 | :types
19 | {:enabled? true,
20 | :types? true,
21 | :protocols? true,
22 | :reifies? true,
23 | :proxies? true},
24 | :blank-lines
25 | {:enabled? true,
26 | :trim-consecutive? true,
27 | :max-consecutive 2,
28 | :insert-padding? true,
29 | :padding-lines 1},
30 | :indentation
31 | {:enabled? true,
32 | :list-indent 2,
33 | :indents
34 | {are [[:block 2]],
35 | when-first [[:block 1]],
36 | cond->> [[:block 1]],
37 | while [[:block 1]],
38 | try [[:block 0]],
39 | bound-fn [[:inner 0]],
40 | thrown-with-msg? [[:block 2]],
41 | match [[:block 1]],
42 | testing [[:block 1]],
43 | if-not [[:block 1]],
44 | doseq [[:block 1]],
45 | finally [[:block 0]],
46 | deftype [[:block 1] [:inner 1]],
47 | when-let [[:block 1]],
48 | go [[:block 0]],
49 | if-some [[:block 1]],
50 | with-precision [[:block 1]],
51 | let [[:block 1]],
52 | defstruct [[:block 1]],
53 | doto [[:block 1]],
54 | future [[:block 0]],
55 | fn [[:inner 0]],
56 | alt! [[:block 0]],
57 | as-> [[:block 1]],
58 | do [[:block 0]],
59 | when-not [[:block 1]],
60 | when [[:block 1]],
61 | #"^def" [[:inner 0]],
62 | #"^with-" [[:inner 0]],
63 | extend [[:block 1]],
64 | go-loop [[:block 1]],
65 | defn [[:inner 0]],
66 | if [[:block 1]],
67 | ns [[:block 1]],
68 | deftest [[:inner 0]],
69 | extend-type [[:block 1] [:inner 1]],
70 | defmethod [[:inner 0]],
71 | struct-map [[:block 1]],
72 | extend-protocol [[:block 1] [:inner 1]],
73 | cond-> [[:block 1]],
74 | dotimes [[:block 1]],
75 | reify [[:inner 0] [:inner 1]],
76 | with-open [[:block 1]],
77 | defonce [[:inner 0]],
78 | defn- [[:inner 0]],
79 | alt!! [[:block 0]],
80 | defprotocol [[:block 1] [:inner 1]],
81 | letfn [[:block 1] [:inner 2 0]],
82 | use-fixtures [[:inner 0]],
83 | loop [[:block 1]],
84 | with-out-str [[:block 0]],
85 | condp [[:block 2]],
86 | cond [[:block 0]],
87 | for [[:block 1]],
88 | binding [[:block 1]],
89 | with-local-vars [[:block 1]],
90 | defmacro [[:inner 0]],
91 | proxy [[:block 2] [:inner 1]],
92 | with-redefs [[:block 1]],
93 | locking [[:block 1]],
94 | defmulti [[:inner 0]],
95 | if-let [[:block 1]],
96 | case [[:block 1]],
97 | catch [[:block 2]],
98 | thread [[:block 0]],
99 | comment [[:block 0]],
100 | defrecord [[:block 1] [:inner 1]],
101 | thrown? [[:block 1]],
102 | when-some [[:block 1]],
103 | def [[:inner 0]]
104 |
105 | tests [[:inner 0]],
106 | with [[:inner 0]],
107 | }},
108 | :vars {:enabled? true}}}
109 |
--------------------------------------------------------------------------------
/.githooks/Readme.md:
--------------------------------------------------------------------------------
1 | Register this folder with:
2 |
3 | ```shell
4 | git config core.hooksPath .githooks
5 | ```
6 |
--------------------------------------------------------------------------------
/.githooks/pre-commit:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 | #
3 | # An example hook script to verify what is about to be committed.
4 | # Called by "git commit" with no arguments. The hook should
5 | # exit with non-zero status after issuing an appropriate message if
6 | # it wants to stop the commit.
7 |
8 | if git rev-parse --verify HEAD >/dev/null 2>&1
9 | then
10 | against=HEAD
11 | else
12 | # Initial commit: diff against an empty tree object
13 | against=$(git hash-object -t tree /dev/null)
14 | fi
15 |
16 | if command -v cljstyle &> /dev/null
17 | then
18 | echo "Running cljstyle on pre-commit hook"
19 | echo "Will check files $(git diff --name-only --cached)"
20 | echo "$(cljstyle version)"
21 | cljstyle fix `git diff --name-only --cached`
22 | git add `git diff --name-only --cached`
23 | exit 0
24 | fi
25 |
26 |
--------------------------------------------------------------------------------
/.github/workflows/test_and_deploy.yml:
--------------------------------------------------------------------------------
1 | name: hyperfiddle/electric
2 | on:
3 | push:
4 | branches:
5 | - "**"
6 | pull_request:
7 | jobs:
8 | jvm:
9 | name: Run JVM tests
10 | runs-on: [ubuntu-latest]
11 | timeout-minutes: 5
12 | steps:
13 | - uses: actions/checkout@v4.1.1
14 |
15 | - run: git status
16 |
17 | - uses: actions/setup-java@v4
18 | with:
19 | distribution: 'temurin'
20 | java-version: '11'
21 |
22 | - name: Cache local Maven repository
23 | uses: actions/cache@v3
24 | with:
25 | path: ~/.m2/repository
26 | key: ${{ runner.os }}-maven-${{ hashFiles('**/deps.edn') }}
27 | restore-keys: |
28 | ${{ runner.os }}-maven-
29 |
30 | - name: Install clojure tools
31 | uses: DeLaGuardo/setup-clojure@12.1
32 | with:
33 | cli: 1.11.1.1113
34 |
35 | - name: Run tests
36 | run: ./ci/run_tests_jvm.sh
37 |
38 | browser:
39 | name: Run browser tests
40 | runs-on: [ubuntu-latest]
41 | timeout-minutes: 5
42 | steps:
43 |
44 | - uses: actions/checkout@v4.1.1
45 |
46 | - run: git status
47 |
48 | - uses: actions/setup-java@v4
49 | with:
50 | distribution: 'temurin'
51 | java-version: '11'
52 |
53 | - name: Cache local Maven repository
54 | uses: actions/cache@v3
55 | with:
56 | path: ~/.m2/repository
57 | key: ${{ runner.os }}-maven-${{ hashFiles('**/deps.edn') }}
58 | restore-keys: |
59 | ${{ runner.os }}-maven-
60 |
61 | - name: Install clojure tools
62 | uses: DeLaGuardo/setup-clojure@12.1
63 | with:
64 | cli: 1.11.1.1113
65 |
66 | - name: Use Node.js
67 | uses: actions/setup-node@v4.0.1
68 | with:
69 | node-version: 18.x
70 |
71 | - name: NPM install
72 | run: npm install --include=dev
73 |
74 | # Install chrome and dependencies, puppeteer fails otherwise
75 | - run: sudo apt-get update && sudo apt-get install -y wget gnupg
76 | - run: wget -q -O - https://dl-ssl.google.com/linux/linux_signing_key.pub | sudo apt-key add -
77 | - run: sudo sh -c 'echo "deb [arch=amd64] http://dl.google.com/linux/chrome/deb/ stable main" >> /etc/apt/sources.list.d/google.list'
78 | - run: sudo apt-get update && sudo apt-get install -y google-chrome-stable fonts-ipafont-gothic fonts-wqy-zenhei fonts-thai-tlwg fonts-kacst fonts-freefont-ttf libxss1 --no-install-recommends
79 | # - run: rm -rf /var/lib/apt/lists/*
80 |
81 |
82 | - name: Run Tests
83 | run: ./ci/run_tests_browser.sh
84 |
85 | nodejs:
86 | name: Run NodeJS tests
87 | runs-on: [ubuntu-latest]
88 | timeout-minutes: 5
89 | steps:
90 | - uses: actions/checkout@v4.1.1
91 |
92 | - run: git status
93 |
94 | - uses: actions/setup-java@v4
95 | with:
96 | distribution: 'temurin'
97 | java-version: '11'
98 |
99 | - name: Cache local Maven repository
100 | uses: actions/cache@v3
101 | with:
102 | path: ~/.m2/repository
103 | key: ${{ runner.os }}-maven-${{ hashFiles('**/deps.edn') }}
104 | restore-keys: |
105 | ${{ runner.os }}-maven-
106 |
107 | - name: Install clojure tools
108 | uses: DeLaGuardo/setup-clojure@12.1
109 | with:
110 | cli: 1.11.1.1113
111 |
112 | - name: Use Node.js
113 | uses: actions/setup-node@v4.0.1
114 | with:
115 | node-version: 18.x
116 |
117 | - name: NPM install
118 | run: npm install
119 |
120 | - name: Run Tests
121 | run: ./ci/run_tests_node.sh
122 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | # Please add user editor configs to system gitignore:
2 | # git config --global core.excludesfile
3 | # git config --global core.excludesfile ~/.gitignore
4 | # see also: https://gist.github.com/subfuzion/db7f57fff2fb6998a16c
5 | .clj-kondo/.cache
6 | .cpcache
7 | .env
8 | .idea
9 | .lsp
10 | .nrepl-port
11 | .shadow-cljs
12 | *.~undo-tree~
13 | /pom.xml
14 | node_modules
15 | target
16 | tsconfig.tsbuildinfo
17 | .DS_Store
18 | /out/
19 | /.dir-locals.el
20 |
21 |
--------------------------------------------------------------------------------
/.node-version:
--------------------------------------------------------------------------------
1 | v16.1.0
--------------------------------------------------------------------------------
/.projectile:
--------------------------------------------------------------------------------
1 | -/.shadow-cljs
2 | -/node_modules
3 | -/package-lock.json
--------------------------------------------------------------------------------
/.vscode/settings.json:
--------------------------------------------------------------------------------
1 | {
2 | "files.exclude": {
3 | "/scratch": true
4 | }
5 | }
--------------------------------------------------------------------------------
/Readme.md:
--------------------------------------------------------------------------------
1 | # Electric Clojure – full-stack differential dataflow for UI
2 |
3 | `com.hyperfiddle/electric {:mvn/version "v3-alpha-SNAPSHOT"}`
4 |
5 | > [!NOTE]
6 | > Electric v3 is now in private beta! Request beta access here: https://www.hyperfiddle.net/early-access.html
7 |
8 |
9 | Electric is a new way to build rich, interactive web products that simply have too much interactivity, realtime streaming, and too rich network connections to be able to write all the frontend/backend network plumbing by hand. With Electric, you can compose your client and server expressions directly (i.e. in the same function), and the Electric compiler macros will **infer at compile time the implied frontend/backend boundary** and generate the corresponding full-stack app.
10 |
11 | 
12 |
13 | *Figure: In Electric, client and server expressions compose directly, and the Electric compiler transparently solves the network boundary through a straightforward dataflow graph analysis.*
14 |
15 | **How it works:** Unlike request/response frameworks, frontend ORMs, and client-side databases that suffer from request waterfalls, over/under fetching, large payload deserialization and other performance issues that get worse as your codebase and database grows, Electric uses a **custom Clojure/Script compiler to perform deep graph analysis** of your unified frontend/backend program and automatically determine the implied network cut, and then compile your program into separate reactive client and server target programs that cooperate and anticipate each other's needs. See [UIs are streaming DAGs (Getz 2022)](https://hyperfiddle.notion.site/UIs-are-streaming-DAGs-e181461681a8452bb9c7a9f10f507991) for a quick 10 minute video explainer of how this works and why it **actually doesn't result in the request waterfalls you might expect,** even in the presence of deep nesting, loops and control flow.
16 |
17 | - **Fully reactive:** unlike javascript frameworks, in Electric, reactivity is built directly into the programming language itself. Reactive-if, reactive-for, reactive lambda. When everything is reactive, it feels like nothing is reactive. No observables! No async types! De-load your mind and relax.
18 |
19 |
20 | - **Multi-tier**: frontend and backend are defined in the same expression, same function, same file. It's not code sharing, it's code *splitting*. Let the compiler infer the boundary from your code, instead of contorting your code — nay, your entire architecture — to fit the boundary.
21 |
22 |
23 | - **Network-transparent**: Electric closures close over server and client scope bindings, all in the same expression. The Electric compiler uses compile-time static knowledge of your source code to slice your expressions into client and server portions. Right through closures, loops and deeply nested function calls.
24 |
25 |
26 | - **Strong composition:** Network-transparent Electric functions are true functions. You have lambda, recursion, HOFs, closures, dynamic scope, macros, etc: the full undamaged composition power of Lisp. Goodbye "functional core imperative shell"; with Electric the **entire system is a function**.
27 |
28 | Our mission is to raise the abstraction ceiling in web development in the same way that managed memory did in the 90s, paving the way for something new.
29 |
30 |
31 | # Lightning talk – 5 minutes
32 |
33 |
38 |
39 | # Tutorial and live examples
40 |
41 | - v3 live tutorial: https://electric.hyperfiddle.net/
42 | - v3 starter app: not yet generally available, [request early access here](https://www.hyperfiddle.net/early-access.html)
43 |
44 | # Talks and essays
45 | - [Talk: Electric Clojure v3: Differential Dataflow for UI (Getz 2024)](https://hyperfiddle-docs.notion.site/Talk-Electric-Clojure-v3-Differential-Dataflow-for-UI-Getz-2024-2e611cebd73f45dc8cc97c499b3aa8b8)
46 | - [Talk: Electric Clojure: compiler managed datasync for rich web apps (Getz 2023)](https://hyperfiddle-docs.notion.site/Talk-Electric-Clojure-compiler-managed-datasync-for-rich-web-apps-Getz-2023-e089a8c0caeb456daaf2f9675e3ac4e7)
47 | - [Talk: UIs are streaming DAGs (Getz 2022)](https://hyperfiddle.notion.site/UIs-are-streaming-DAGs-e181461681a8452bb9c7a9f10f507991)
48 | - [Talk: Missionary: a functional approach to massively concurrent application design (Noel 2023)](https://hyperfiddle-docs.notion.site/Talk-Missionary-a-functional-approach-to-massively-concurrent-application-design-Noel-2023-a74748f610c044328d19d038a6daffa1)
49 | - [You don't need a web framework, you need a web language (Getz 2021)](https://hyperfiddle.notion.site/Reactive-Clojure-You-don-t-need-a-web-framework-you-need-a-web-language-44b5bfa526be4af282863f34fa1cfffc)
50 | - [Talk: Functional effects and streaming systems in Clojure (Noel 2021)](https://hyperfiddle-docs.notion.site/Talk-Functional-effects-and-streaming-systems-in-Clojure-Noel-2021-f3f907e5e9b04d08a3be33d53a3cd18e)
51 | - https://clojureverse.org/t/electric-clojure-a-signals-dsl-for-fullstack-web-ui/9788
52 | - https://clojureverse.org/t/signals-vs-streams/9840/1
53 |
54 | # Community
55 |
56 | * slack support chatroom: #hyperfiddle @ [clojurians.net](https://clojurians.net/)
57 | * follow https://twitter.com/dustingetz for progress updates
58 | * **Contributing:** we do not currently accept PRs against Electric itself as this has historically not been productive for us. However, **we'd love for you to contribute demos!** Many of our coolest demos were started by early users, this is an amazing and productive way for you to get involved and collaborate with us. This will require a signed contributors agreement (like Clojure), DM dustingetz on slack.
59 |
60 | # License
61 |
62 | Electric v3 is free for bootstrappers and non-commercial use, but is otherwise a commercial project, which helps us continue to invest and maintain payroll for a team of 4. See [license change announcement](https://tana.pub/lQwRvGRaQ7hM/electric-v3-license-change).
63 |
--------------------------------------------------------------------------------
/ci/run_tests_all.sh:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 |
3 | ./ci/run_tests_jvm.sh; jvm_code=$?
4 | ./ci/run_tests_node.sh; node_code=$?
5 | ./ci/run_tests_browser.sh "$@"; browser_code=$?
6 |
7 | RED=$(tput setaf 1)
8 | GREEN=$(tput setaf 2)
9 | RESET=$(tput sgr0)
10 |
11 | reportResult() {
12 | if [ "$1" -eq 0 ]; then echo "${GREEN}ok${RESET}"; else echo "${RED}failed${RESET}"; fi
13 | }
14 |
15 | printf "\n --results--\n"
16 | printf "JVM %s\n" "$(reportResult $jvm_code)"
17 | printf "node %s\n" "$(reportResult $node_code)"
18 | printf "browser %s\n" "$(reportResult $browser_code)"
19 |
20 | [ $jvm_code -eq 0 ] && [ $node_code -eq 0 ] && [ $browser_code -eq 0 ]
21 |
--------------------------------------------------------------------------------
/ci/run_tests_browser.sh:
--------------------------------------------------------------------------------
1 | #!/bin/sh -x
2 |
3 | echo "Running Browser tests"
4 | clojure -M:test:shadow-cljs compile :browser-test --force-spawn && \
5 | ./node_modules/.bin/karma start --single-run $@ # --browsers Chrome
6 |
--------------------------------------------------------------------------------
/ci/run_tests_jvm.sh:
--------------------------------------------------------------------------------
1 | #!/bin/bash
2 |
3 | echo "Running JVM tests"
4 |
5 | # All namespaces are tested by default to encourage tested code.
6 | # Use :ns-regexp to blacklist specific namespaces.
7 | # ^(?!foo.(bar|baz)).* : includes everything except foo.bar or foo.baz
8 |
9 | clojure -X:test \
10 | :dirs "[\"src\" \"test\"]" \
11 | :patterns "[\"^(?!hyperfiddle.(api|popover|txn|electric-fulcro|electric-httpkit|electric-jetty|spool|spec|impl.jetty|electric.impl.sunng|electric.impl.jetty9)|contrib.(datomic|test.datomic)).*\"]"
12 |
--------------------------------------------------------------------------------
/ci/run_tests_node.sh:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 |
3 | echo "Running NodeJS tests"
4 | clojure -M:test:shadow-cljs compile :test --force-spawn "$@" \
5 | && node out/node-tests.js
6 |
--------------------------------------------------------------------------------
/ci/running_dom_tests.md:
--------------------------------------------------------------------------------
1 | # How to run tests in a browser
2 |
3 | ## Running once
4 | Run `./ci/run_tests_browser.sh`.
5 |
6 | ## Live reloading
7 | ```
8 | clojure -M:test:shadow-cljs watch :browser-test
9 | # in another shell:
10 | ./node_modules/.bin/karma start
11 | ```
12 |
13 | Karma will:
14 | - use Chrome if installed
15 | - fallback to Chromium if installed
16 | - download and install Chromium for you otherwise
17 |
--------------------------------------------------------------------------------
/deps.edn:
--------------------------------------------------------------------------------
1 | {:hyperfiddle.build/name com.hyperfiddle/electric
2 | :hyperfiddle.build/description "A reactive Clojure dialect for web development that uses a compiler to infer the frontend/backend boundary"
3 | :hyperfiddle.build/version "v3-alpha-SNAPSHOT"
4 | :hyperfiddle.build/pom-data [[:licenses
5 | [:license
6 | [:name "Hyperfiddle Business Source License"]
7 | [:url "http://hyperfiddle.net"]]]
8 | [:developers
9 | [:developer
10 | [:organization "Hyperfiddle, Inc."]
11 | [:organizationUrl "http://www.hyperfiddle.net"]]]]
12 | :hyperfiddle.build/pom-scm {:url "https://github.com/hyperfiddle/electric"
13 | :connection "scm:git:git://github.com/hyperfiddle/electric.git"
14 | :developerConnection "scm:git:ssh://git@github.com/hyperfiddle/electric.git"}
15 | :paths ["src"]
16 | :deps {
17 | com.cognitect/transit-clj {:mvn/version "1.0.333"}
18 | com.cognitect/transit-cljs {:mvn/version "0.8.280"}
19 | com.hyperfiddle/rcf {:mvn/version "20220926-202227"}
20 | missionary/missionary {:mvn/version "b.44"}
21 | fipp/fipp {:mvn/version "0.6.26"}
22 | org.clojure/clojure {:mvn/version "1.12.0-alpha11"}
23 | org.clojure/clojurescript {:mvn/version "1.11.121"}
24 | org.clojure/tools.logging {:mvn/version "1.2.4"}
25 | borkdude/edamame {:mvn/version "1.4.25"}
26 |
27 | ;; prevents building from source, use maven release
28 | com.hyperfiddle/hyperfiddle-contrib {:local/root "../hyperfiddle-contrib"}
29 | com.hyperfiddle/electric-secret {:local/root "../electric-secret"}
30 | }
31 |
32 | :aliases {:shadow-cljs {:extra-deps {thheller/shadow-cljs {:mvn/version "2.26.2"}}
33 | :main-opts ["-m" "shadow.cljs.devtools.cli"]}
34 |
35 | :test {:extra-paths ["test"]
36 | :exec-fn cognitect.test-runner.api/test
37 | :jvm-opts ["-Dhyperfiddle.rcf.generate-tests=true"
38 | "-Dhyperfiddle.electric.impl.missionary-util.wrap=true"
39 | "-XX:-OmitStackTraceInFastThrow"] ;; https://archive.md/NNt9r
40 | :extra-deps {org.clojure/core.async {:mvn/version "1.6.681"} ; for interop helpers only
41 | ch.qos.logback/logback-classic {:mvn/version "1.4.14"}
42 | io.github.cognitect-labs/test-runner {:git/url "https://github.com/cognitect-labs/test-runner.git" :sha "cc75980b43011773162b485f46f939dc5fba91e4"}
43 | org.clojure/test.check {:mvn/version "1.1.1"}
44 | com.datomic/local {:mvn/version "1.0.285"} ; for hyperfiddle.transaction-test
45 | com.datomic/client-cloud {:mvn/version "1.0.130"} ; for hyperfiddle.transaction-test
46 | thheller/shadow-cljs {:mvn/version "2.26.2"} ; for hooks tests
47 | ring/ring-core {:mvn/version "1.11.0"}
48 | }}
49 | :build {:extra-paths ["src-build"]
50 | :ns-default build
51 | :extra-deps {com.hyperfiddle/build {:local/root "../build"}}}
52 | :release {:override-deps {com.hyperfiddle/hyperfiddle-contrib {:mvn/version "v0-alpha-SNAPSHOT"}}}}
53 | }
54 |
--------------------------------------------------------------------------------
/docs/electric-protocol.md:
--------------------------------------------------------------------------------
1 | STATUS : draft
2 |
3 | # The electric protocol
4 |
5 | ## Purpose and goals
6 |
7 | The electric protocol allows two processes called *peers*, typically running on two different physical machines (e.g.
8 | a server and a client) on two different host plaforms (e.g. a JVM and a browser), to run an electric program and
9 | synchronize their states in reaction to local events. The program being run is the only knowledge initially shared by
10 | the two peers.
11 |
12 | TODO: what is an electric program ? what is the entrypoint ? is it a zero-argument e/defn ?
13 |
14 | The electric protocol allows for :
15 | * maintaining the set of currently active transfer sessions, according to the active branches of the program
16 | * multiplexing the successive changes for these transfer sessions, according to the state of each expression
17 |
18 | An explicit goal of the protocol design is to allow for optimistic transfers, i.e. allow a given peer to anticipate
19 | transfer of a local expression state when it's able to infer (from shared program knowledge) that a local event
20 | requires a remote program section having this local expression as a dependency. This optimization helps reduce latency
21 | by avoiding unnecessary round-trips.
22 |
23 | As a consequence of this optimization, both peers can concurrently decide to start or stop a transfer session for the
24 | same expression, and thus need to reach consensus about its lifecycle. This problem is exacerbated by the fact that
25 | differential state propagation relies on sequential delivery - if one peer resets a session while the other one doesn't,
26 | the latter will observe permanent state corruption.
27 |
28 | TODO: example
29 |
30 | ## Channel
31 |
32 | The protocol relies on a persistent connection, established beforehand, able to transport messages in both directions
33 | with reliable delivery and ordering. The channel must support flow control in the writing direction, i.e. expose a
34 | means to limit the rate of messages sent by a given peer when the underlying network layers can't keep up. Support for
35 | flow control in the reading direction is not a requirement, because a peer is always able to accept new messages.
36 |
37 | In the current implementation, websockets are used as the channel implementation. Alternative implementations could be
38 | considered in the future.
39 |
40 | TODO: is channel reconnection logic part of this document ?
41 |
42 | ## Serialization
43 |
44 | The protocol assumes each expression being evaluated is identifiable by a serializable value called a *slot*, and the
45 | differential states of any given expression are serializable.
46 |
47 | TODO: is the expression identification scheme part of this document ?
48 | TODO: is the serialization method is part of the protocol ? currently, transit is not an option
49 |
50 | ## Message structure
51 | All messages are the serialization of a 4-tuple `[acks request change freeze]`, where :
52 | * `acks` is a non-negative integer
53 | * `request` is a map associating slots to non-zero integers
54 | * `change` is a map associating slots to diffs
55 | * `freeze` is a set of slots
56 |
57 | The message structure is a natural monoid because all of its 4 components are monoids, as explained further.
58 |
59 | ### `acks` - Changeset acknowledgement
60 | The `acks` number represents the count of non-*pure-ack* messages received by the sender since the previous message
61 | was sent. A *pure-ack* is a message with an empty `request`, an empty `change`, and an empty `freeze`, i.e. a message
62 | describing an empty changeset.
63 |
64 | The *empty message* is a *pure-ack* with zero `acks`. The *empty message* has no effect and should not be sent. Any
65 | other message MUST be sent as soon as the channel is ready to write.
66 |
67 | The `acks` number is a monoid. The identity element is `0`, the binary operation is addition.
68 |
69 | TODO: example
70 |
71 | ### `request` - Local request propagation
72 | An electric program can reify the differential state of an expression as an effect. A peer with access to this effect
73 | can decide to perform it, typically as part of an effect composition managed by another part of the same electric
74 | program. For each remote expression that is a dependency of the local expression wrapped by this effect, the effect
75 | lifecycle must be propagated via the `request` map by the association of the dependency slot with the number `1` (if
76 | the process was spawned) or `-1` (if the process was terminated). The `request` map being sent on the wire is the
77 | aggregation of all `request` maps generated by each local event since the last message was sent.
78 |
79 | The `request` map is a monoid. The identity element is `{}`, the binary operation is map merging with value addition
80 | and elision of zero values.
81 |
82 | ```clojure
83 | (def merge-request
84 | (partial reduce-kv
85 | (fn [r k n]
86 | (let [n (+ n (r k 0))]
87 | (if (zero? n)
88 | (dissoc r k)
89 | (assoc r k n))))))
90 | ```
91 |
92 | TODO: example
93 |
94 | ### `change` and `freeze` - Differential state propagation
95 | The `request` map transfers, in combination with message `acks`, are used by both peers to reach consensus about the
96 | transfer session lifecycle. When a given expression is part of the active session set, a half-port is instanciated on
97 | each side of the channel - an output on the local peer, an input on the remote peer. The output is a subscription to
98 | the expression's differential signal, the input is an object exposing the current state as a differential signal
99 | according to incoming changes. The `change` map being sent on the wire is the aggregation of slot-diff pairs generated
100 | by all local changes, the `freeze` set is the union of slots generated by local freezes (i.e. spontaneous termination
101 | of the signal subscription), since the last message was sent.
102 |
103 | The `change` map and `freeze` set form a monoid. The identity element is `{} #{}`, the binary operation is map merging
104 | and set union. Diff sequences must be semigroups to resolve collisions on the change map (i.e. diff squashing).
105 |
106 | TODO: example
107 |
108 | ## Session lifecycle consensus
109 | The essence of the algorithm is to delay session teardown on local events, to give the remote peer a grace period. The
110 | grace period is defined by the remote peer via message acknowledgement, therefore we know it's always long enough to
111 | reach consensus but never longer than round-trip latency.
112 |
113 | Let's consider the state of the half-port of a single expression on a given peer. The state machine is the same for
114 | inputs and outputs, therefore it doesn't matter if the expression is local or remote.
115 |
116 | The state of the half-port is defined by :
117 | * the *remote request* flag : if some dependent local expression has a positive request count.
118 | * the *local request* flag : if some dependent remote expression is required by a local effect.
119 | * the *pending toggle* count : the messages sent but not yet acknowledged that will change the remote request flag on
120 | the remote half-port.
121 |
122 | Then we can derive the *inferred request* flag as the xor of the local request and the *pending toggle* odd parity.
123 | This flag reflects the state of the local request before the oldest unacknowledged message was sent, i.e. the state
124 | known to the remote peer when its messages are processed.
125 |
126 | The half-port is considered idle when the *remote request* flag is disabled, the *inferred request* flag is disabled,
127 | and the *pending toggle* count is zero. A new session starts on leaving the idle state and stops on entering it again.
128 |
129 | TODO: example
130 |
--------------------------------------------------------------------------------
/docs/electric3-explainer.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/hyperfiddle/electric/695e0f2e3c2298d3afb7d0c6e308dfb949dd7c14/docs/electric3-explainer.png
--------------------------------------------------------------------------------
/docs/lightning_talk_cover.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/hyperfiddle/electric/695e0f2e3c2298d3afb7d0c6e308dfb949dd7c14/docs/lightning_talk_cover.png
--------------------------------------------------------------------------------
/karma.conf.js:
--------------------------------------------------------------------------------
1 | process.env.CHROME_BIN = require('puppeteer').executablePath()
2 | module.exports = function (config) {
3 | config.set({
4 | browsers: ['Chrome_CI'],
5 | // The directory where the output file lives
6 | basePath: 'out',
7 | // The file itself
8 | files: ['karma-tests.js'],
9 | frameworks: ['cljs-test'],
10 | plugins: ['karma-cljs-test', 'karma-chrome-launcher'],
11 | colors: true,
12 | logLevel: config.LOG_INFO,
13 | client: {
14 | args: ["shadow.test.karma.init"],
15 | singleRun: true
16 | },
17 | customLaunchers: {
18 | Chrome_CI: {
19 | base: 'ChromeHeadless',
20 | flags: ['--no-sandbox']
21 | }
22 | }
23 | });
24 | };
25 |
--------------------------------------------------------------------------------
/package.json:
--------------------------------------------------------------------------------
1 | {
2 | "devDependencies": {
3 | "karma": "6.4.0",
4 | "karma-chrome-launcher": "3.1.1",
5 | "karma-cljs-test": "0.1.0",
6 | "puppeteer": "15.2.0"
7 | }
8 | }
9 |
--------------------------------------------------------------------------------
/resources/public/hyperfiddle-electric-ui.css:
--------------------------------------------------------------------------------
1 | .hyperfiddle button[aria-disabled=true], input[type="button"][aria-disabled="true"]{
2 | color: GrayText;
3 | }
4 |
5 | .hyperfiddle button[aria-busy=true]
6 | , input[type=checkbox][aria-busy=true]
7 | {
8 | cursor:wait;
9 | position: relative;
10 | }
11 |
12 | /* Button spinner */
13 | .hyperfiddle button[aria-busy=true]::before
14 | , .hyperfiddle input[type=checkbox][aria-busy=true]::after
15 | , .hyperfiddle .input-load-mask[aria-busy=true]::after
16 | {
17 | content:"";
18 | position:absolute;
19 | z-index: 1;
20 | width: 0.9em;
21 | height: 0.9em;
22 | margin: auto;
23 | top:0;
24 | bottom:0;
25 | left:0;
26 | right:0;
27 | animation: hyperfiddle-spinner-spin 1s linear infinite;
28 | border-width: 2px;
29 | border-style: solid;
30 | border-left-color: transparent;
31 | border-radius: 50%;
32 | }
33 |
34 | .hyperfiddle .input-load-mask[aria-busy=true] {
35 | position: relative;
36 | }
37 | .hyperfiddle .input-load-mask[aria-busy=true]::after{
38 | left: auto;
39 | right: 1rem;
40 | }
41 |
42 | /* Button spinner color */
43 | .hyperfiddle button[aria-busy=true]::before{
44 | border-color: initial;
45 | border-left-color: transparent;
46 | }
47 |
48 | @keyframes hyperfiddle-spinner-spin{
49 | from { transform: rotate(0deg); }
50 | to { transform: rotate(360deg); }
51 | }
52 |
--------------------------------------------------------------------------------
/resources/public/hyperfiddle-forms.css:
--------------------------------------------------------------------------------
1 | .hyperfiddle input:not([type="radio"]):not([type="checkbox"]), select {
2 | box-sizing: border-box;
3 | /* width:100%; */
4 | border-width: 1px;
5 | /*border-left-width: 0.2rem;*/
6 | border-style:solid;
7 | border-radius: 2px;
8 | /* padding: 0.5rem 0.5rem; */
9 | width: 100%;
10 | }
11 |
12 | .hyperfiddle input[type="checkbox"]{
13 | margin:0;
14 | width: 1rem;
15 | height: 1rem;
16 | }
17 |
18 | .hyperfiddle table {
19 | table-layout: fixed;
20 | border-collapse: collapse;
21 | }
22 |
23 |
24 | .hyperfiddle .hyperfiddle-select
25 | , .hyperfiddle .hyperfiddle-typeahead
26 | , .hyperfiddle .hyperfiddle-tag-picker
27 | {
28 | /* background-color: red; */
29 | position: relative;
30 | }
31 |
32 | .hyperfiddle .hyperfiddle-select input,
33 | .hyperfiddle .hyperfiddle-typeahead input
34 | {
35 | border: none;
36 | border-style: none !important;
37 | }
38 |
39 | .hyperfiddle .hyperfiddle-select > ul
40 | , .hyperfiddle .hyperfiddle-typeahead > ul
41 | , .hyperfiddle .hyperfiddle-tag-picker-input-container > ul
42 | {
43 | margin: 0;
44 | padding: 0.25rem 0;
45 | position:absolute;
46 | width: 100%;
47 | z-index: 2;
48 | list-style-type: none;
49 | background-color: white;
50 | box-shadow: 0 0.5rem 1rem gray;
51 |
52 | display: grid;
53 | grid-gap: var(--hf-grid-gap);
54 | }
55 |
56 | .hyperfiddle .hyperfiddle-select > ul > li
57 | , .hyperfiddle .hyperfiddle-typeahead > ul > li
58 | , .hyperfiddle .hyperfiddle-tag-picker-input-container > ul > li
59 | {
60 | height: var(--hf-grid-row-height);
61 | padding: 0 0.5rem;
62 |
63 | }
64 |
65 | .hyperfiddle .hyperfiddle-select > ul > li:hover
66 | , .hyperfiddle .hyperfiddle-typeahead > ul > li:hover
67 | , .hyperfiddle .hyperfiddle-tag-picker-input-container > ul > li:hover
68 | {
69 | cursor: pointer;
70 | }
71 |
72 | .hyperfiddle .hyperfiddle-tag-picker
73 | , .hyperfiddle .hyperfiddle-tag-picker-input-container
74 | , .hyperfiddle .hyperfiddle-tag-picker-items
75 | , .hyperfiddle .hyperfiddle-tag-picker-items > li
76 | {
77 | display: inline-block;
78 | }
79 |
80 | .hyperfiddle .hyperfiddle-tag-picker-items
81 | {
82 | list-style-type: none;
83 | }
84 |
85 | .hyperfiddle .hyperfiddle-tag-picker{
86 | display: inline-flex;
87 | flex-direction: row;
88 | flex-wrap: wrap;
89 | gap: 0.25rem 0.5rem;
90 | align-items:center;
91 | padding: 0.25rem;
92 | background: white;
93 | }
94 |
95 | .hyperfiddle .hyperfiddle-tag-picker:focus-within{
96 | box-shadow: inset 0 2px 4px 0 rgb(0 0 0 / 0.05);
97 | }
98 |
99 | .hyperfiddle .hyperfiddle-tag-picker-items{
100 | display:contents;
101 | }
102 |
103 | .hyperfiddle .hyperfiddle-tag-picker-items > li
104 | {
105 | border: 1px solid;
106 | box-shadow: 0 1px 2px 0 rgb(0 0 0 / 0.05);
107 | white-space: nowrap;
108 | }
109 |
110 | .hyperfiddle .hyperfiddle-tag-picker-input-container{
111 | position: relative;
112 | height: 100%;
113 | max-height: 100%;
114 | padding:0;
115 |
116 | }
117 |
118 | .hyperfiddle .hyperfiddle-tag-picker-input-container > input{
119 | height: 100%;
120 | border-width:0!important; /* TODO drop the !important once we have a clean CSS system (tailwind) */
121 | outline: none;
122 | }
123 | .hyperfiddle .hyperfiddle-tag-picker-input-container > ul{
124 | position: absolute;
125 | width: max-content;
126 | margin-top: 0.25rem;
127 | border-radius: 0 0 0.25rem 0.25rem;
128 | box-shadow: none;
129 | box-shadow: 0 10px 15px -3px rgb(0 0 0 / 0.1), 0 4px 6px -4px rgb(0 0 0 / 0.1);
130 | }
131 |
132 | .hyperfiddle .hyperfiddle-tag-picker-items > li {
133 | border-radius: 0.25rem;
134 | padding: 0 0 0 0.5rem;
135 | }
136 |
137 | .hyperfiddle .hyperfiddle-tag-picker-items > li > span {
138 | margin: 0.25rem;
139 | color: rgb(55 65 81);
140 | cursor:pointer;
141 | }
142 |
143 | .hyperfiddle .hyperfiddle-selected
144 | {
145 | background-color: orange;
146 | }
147 |
148 | .hyperfiddle .hyperfiddle-modal-backdrop
149 | {
150 | display: block;
151 | /* background-color: pink; */
152 | /* opacity: 0.1; */
153 | position: fixed;
154 | top:0;
155 | bottom:0;
156 | left:0;
157 | right:0;
158 | z-index:1;
159 | }
160 |
161 | .hyperfiddle table td{
162 | vertical-align: top;
163 | padding: 0.3rem;
164 | border-width: 1px;
165 | border-style: solid;
166 | }
167 |
168 | .hyperfiddle table thead td:empty{
169 | visibility:hidden;
170 | border: none;
171 | }
172 |
--------------------------------------------------------------------------------
/resources/public/hyperfiddle-popover.css:
--------------------------------------------------------------------------------
1 | .hyperfiddle.popover-wrapper{
2 | display: inline-block;
3 | position: relative;
4 | }
5 |
6 | .hyperfiddle.popover-body{
7 | position: absolute;
8 | z-index: 2;
9 | width: max-content;
10 |
11 | border: 1px pink solid;
12 | padding: 0.5rem;
13 | background-color: rgb(248 250 252);
14 | box-shadow: 0 0 1rem lightgray;
15 | }
16 |
17 | .hyperfiddle.popover-body:focus-within{
18 | /* NOTE popover is itself focusable so a click brings it to the top */
19 | z-index:3;
20 | }
21 |
--------------------------------------------------------------------------------
/shadow-cljs.edn:
--------------------------------------------------------------------------------
1 | ;; All namespaces are tested by default to encourage tested code.
2 | ;; Use :ns-regexp to blacklist specific namespaces.
3 | ;; ^(?!foo.(bar|baz)).* : includes everything except foo.bar or foo.baz
4 |
5 | {:builds {:test {:target :node-test
6 | :output-to "out/node-tests.js"
7 | :ns-regexp "^(?!contrib.(electric-codemirror|datomic)|hyperfiddle.(api|popover|spool|spec|electric-fulcro|electric.impl.compiler-test|electric.impl.cljs-file-to-analyze)).*"
8 | :build-options {:cache-level :off}
9 | :compiler-options {:closure-defines {hyperfiddle.electric.impl.missionary-util/wrap true}
10 | :reader-features #{:node} ; allow #?(:node …, :cljs …), falls back to :cljs.
11 | :warnings {:redef-in-file false}}}
12 | :browser-test {:target :karma
13 | :output-to "out/karma-tests.js"
14 | :ns-regexp "^(?!contrib.(electric-codemirror|datomic)|hyperfiddle.(api|popover|spool|spec|electric-fulcro|electric.impl.compiler-test|electric.impl.cljs-file-to-analyze)).*"
15 | :build-options {:cache-level :off}
16 | :build-hooks [(hyperfiddle.browser-test-setup/blow-up-tests-on-warnings)]
17 | :compiler-options {:closure-defines {hyperfiddle.electric.impl.missionary-util/wrap true}
18 | :warnings-as-errors {:warning-types #{:infer-warning}}}}}}
19 |
--------------------------------------------------------------------------------
/src-build/build.clj:
--------------------------------------------------------------------------------
1 | (ns build
2 | (:require [clojure.tools.build.api :as tools.build]
3 | [hyperfiddle.build :as build]))
4 |
5 | ;; Expose generic tasks
6 | (def clean #'build/clean)
7 | (def install #'build/install)
8 | (def deploy #'build/deploy)
9 |
10 | (defn build [opts] ; custom build task because of AOT
11 | (build/clean opts)
12 | (let [basis (partial build/create-basis :project "deps.edn", :extra "../electric-secret/deps.edn")
13 | {:keys [class-dir src-dirs] :as opts} (build/defaults (basis :aliases [:release]) opts)]
14 | (tools.build/write-pom opts)
15 | (tools.build/copy-dir {:src-dirs src-dirs, :target-dir class-dir})
16 | (tools.build/compile-clj {:basis (basis :aliases [:release :build-deps])
17 | :class-dir class-dir
18 | :ns-compile '[hyperfiddle.electric.impl.entrypoint hyperfiddle.electric.impl.auth hyperfiddle.electric.impl.jwt hyperfiddle.electric.impl.auth0 hyperfiddle.electric.shadow-cljs.hooks3]
19 | :filter-nses '[hyperfiddle.electric.impl.entrypoint hyperfiddle.electric.impl.auth hyperfiddle.electric.impl.jwt hyperfiddle.electric.impl.auth0 hyperfiddle.electric.shadow-cljs.hooks3]})
20 | (tools.build/jar opts)))
21 |
22 |
--------------------------------------------------------------------------------
/src-build/build.md:
--------------------------------------------------------------------------------
1 | # Build clojars maven artifact — Electric
2 |
3 | Build version is to be set under `deps.edn` > `:hyperfiddle.build/version`.
4 |
5 | ```shell
6 | clojure -T:build build
7 | clojure -T:build install
8 | # To test in electric-starter-app:
9 | clj -A:dev -X dev/-main -Sdeps '{:deps {com.hyperfiddle/electric {:mvn/version ""}}}'
10 | # No way to test remote clojars version without rm in .m2/repositories/com/hyperfiddle
11 | # Optional: test electric-starter-app with local maven install
12 | env $(cat .env | xargs) clojure -T:build deploy
13 | ```
14 |
15 | - `CLOJARS_USERNAME` is your clojars username.
16 | - `CLOJARS_PASSWORD` is not your account password, but rather a genareted token granting
17 | deploy rights to the target coordinates.
18 | - idea: how to run tests cli? (No need, deployed artifacts already passed CI)
19 |
--------------------------------------------------------------------------------
/src-dev/toxiproxy.sh:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 |
3 | ### INSTALLATION
4 |
5 | # https://github.com/Shopify/toxiproxy
6 | # brew tap shopify/shopify
7 | # brew install toxiproxy
8 |
9 | ### RUNNING
10 |
11 | # src-dev/toxiproxy.sh 7080 8080 200
12 | # toxiproxy-cli list
13 | # killall toxiproxy-server
14 | # toxiproxy-cli toxic help
15 | # toxiproxy-cli toxic update --toxicName hf_latency_toxic --attribute latency=500 hf_dev_proxy
16 |
17 |
18 | log_level=fatal # even 'error' is too spammy
19 |
20 | LOG_LEVEL=${log_level} toxiproxy-server &
21 | echo "waiting for server to come up:"
22 | while ! nc -z localhost 8474; do
23 | printf .
24 | sleep 1
25 | done
26 | echo " server up"
27 | toxiproxy-cli create --listen 0.0.0.0:$1 --upstream localhost:$2 hf_dev_proxy && \
28 | toxiproxy-cli toxic add --toxicName hf_latency_toxic --type latency --attribute latency=$3 hf_dev_proxy
--------------------------------------------------------------------------------
/src/clj-kondo.exports/hyperfiddle/electric/config.edn:
--------------------------------------------------------------------------------
1 | {:lint-as {hyperfiddle.electric/def clojure.core/def
2 | hyperfiddle.electric/defn clojure.core/defn
3 | hyperfiddle.electric3/defn clojure.core/defn
4 | hyperfiddle.electric3/fn clojure.core/fn
5 | hyperfiddle.electric3/declare clojure.core/declare
6 | hyperfiddle.electric3/cursor clojure.core/for
7 | hyperfiddle.electric3/for clojure.core/for
8 | hyperfiddle.electric/for clojure.core/for
9 | hyperfiddle.electric/with-cycle clojure.core/let
10 | hyperfiddle.electric/fn clojure.core/fn}
11 | :linters {:redundant-expression {:level :off}}}
12 |
--------------------------------------------------------------------------------
/src/contrib/electric_codemirror.cljc:
--------------------------------------------------------------------------------
1 | (ns contrib.electric-codemirror
2 | ;; #?(:cljs (:require-macros contrib.electric-codemirror))
3 | (:require
4 | [clojure.edn :as edn]
5 | [clojure.pprint :as pprint]
6 | #?(:clj clojure.tools.logging)
7 | [hyperfiddle.electric3 :as e :refer [$]]
8 | [hyperfiddle.electric-dom3 :as dom]
9 | [missionary.core :as m]
10 | [hyperfiddle.rcf :as rcf :refer [% tap tests with]]
11 | #?@(:cljs [["@codemirror/language" :as language]
12 | ["@codemirror/state" :refer [EditorState]]
13 | ["@codemirror/commands" :refer [history historyKeymap]]
14 | ["@codemirror/view" :as view :refer [EditorView lineNumbers]]
15 | [nextjournal.clojure-mode :as cm-clj]])))
16 |
17 | #?(:cljs
18 | (def theme
19 | (.theme EditorView (clj->js {#_#_".cm-content" {:white-space "pre-wrap"
20 | :padding "10px 0"}
21 | "&.cm-focused" {:outline "none"}
22 | #_#_".cm-line" {:padding "0 0.5rem"
23 | :line-height "1.6"
24 | :font-size "16px"
25 | :font-family "var(--code-font)"}
26 | ".cm-matchingBracket" {:border-bottom "1px solid var(--teal-color)"
27 | :color "inherit"}
28 | ".cm-gutters" {:background "transparent"
29 | :border "none"}
30 | ".cm-gutterElement" {:margin-left "5px"}
31 | ;; only show cursor when focused
32 | ".cm-cursor" {:visibility "hidden"}
33 | "&.cm-focused .cm-cursor" {:visibility "visible"}}))))
34 |
35 | #?(:cljs
36 | (defonce inline-extensions
37 | (list
38 | theme
39 | (history)
40 | (language/syntaxHighlighting language/defaultHighlightStyle)
41 | (view/drawSelection #js{:cursorBlinkRate 0})
42 | ;; cm-clj/default-extensions
43 | ;; (.of view/keymap cm-clj/complete-keymap)
44 | (cm-clj/syntax)
45 | (.of view/keymap historyKeymap)
46 | )))
47 |
48 | #?(:cljs
49 | (defn make-state [props ^string doc, on-update]
50 | (.create EditorState
51 | #js{:doc doc
52 | :extensions (into-array
53 | (cond->> inline-extensions
54 | (:theme props) (cons (.theme EditorView (clj->js (:theme props))))
55 | (:readonly props) (cons (.. EditorState -readOnly (of true)))
56 | (not (:inline props)) (into (list (lineNumbers) (language/foldGutter)))
57 | true (cons (.. EditorView -updateListener (of (fn [^js view-update]
58 | (on-update view-update)
59 | true))))))})))
60 |
61 | #?(:cljs
62 | (defn make-cm! [props on-change]
63 | (new EditorView #js{:parent (:parent props) :state (make-state props "nil" on-change)})))
64 |
65 | #?(:cljs
66 | (defn cm-set! [^js !cm v]
67 | (.dispatch !cm #js {:changes #js {:insert (str v)
68 | :from 0 :to (.. !cm -state -doc -length)}})))
69 |
70 | #?(:cljs
71 | (defn codemirror [props]
72 | (let [!hook (atom nil)
73 | >cm-v (m/observe
74 | (fn [!]
75 | #_(println 'cm-mount)
76 | (let [^js !cm (make-cm! props (fn [^js cm-view-update]
77 | (when (and (.. cm-view-update -view -hasFocus) ;; user manual action
78 | (.-docChanged cm-view-update))
79 | (let [v (.. cm-view-update -state -doc (toString))]
80 | (assert (some? v))
81 | (! v)))))]
82 | (reset! !hook !cm) ; ref escapes
83 | #(do #_(println 'cm-unmount) (.destroy !cm)))))]
84 | (m/cp [(m/?< (m/watch !hook)) ; cm ref escapes
85 | >cm-v])))) ; this is discrete. Don't accidentally damage this by giving it a nil initial value
86 |
87 | (e/defn CodeMirror [props readf writef controlled-value]
88 | (e/client
89 | (when-some [[!cm >cm-v] (e/input (codemirror props))] ; stable through cv changes
90 | (some-> !cm (cm-set! (writef controlled-value))) ; guard "when true" bug causing NPE in certain tutorials
91 | (doto (e/input (m/relieve {} (m/reductions #(readf %2) controlled-value >cm-v))) ; reduction rebuilt if cv changes, which is fine
92 | #_(as-> $ (println 'cm-v (hash $)))))))
93 |
94 | (defn read-edn [edn-str]
95 | (try (edn/read-string edn-str)
96 | (catch #?(:clj Throwable :cljs :default) t
97 | #?(:clj (clojure.tools.logging/error t)
98 | :cljs (js/console.warn t)) nil)))
99 |
100 | (defn write-edn [edn] (with-out-str (pprint/pprint edn)))
101 |
102 | (e/defn Edn [v] ($ CodeMirror {:parent dom/node} read-edn write-edn v))
103 | (e/defn String_ [v] ($ CodeMirror {:parent dom/node} identity identity v))
104 |
105 | #_
106 | (tests "cm/string"
107 | (def discard (e/run (binding [dom/node js/document.body]
108 | (tap (String_ "hi")))))
109 | ;; (def line (.querySelector js/document ".cm-line"))
110 | ;; (def content (.querySelector js/document ".cm-line"))
111 | ;; (.dispatchEvent line (js/Event. "mousedown"))
112 | ;; (.dispatchEvent content (js/Event. "mousedown"))
113 | ;; (uit/focus line)
114 | ;; (uit/focus content)
115 | ;; (set! (.-innerText line) "there")
116 |
117 | % := "hi"
118 | ;; TODO I see this works when trying out in the REPL and interacting with the browser manually
119 | ;; but I can't seem to trigger the user-like typing behavior from the test.
120 | ;; Exposing the EditorView doesn't help because the `on-change` handler
121 | ;; checks if the action was a user action.
122 | ;; % := "there"
123 | ;; % := "buddy"
124 | (discard)
125 | )
126 |
--------------------------------------------------------------------------------
/src/contrib/missionary_contrib.cljc:
--------------------------------------------------------------------------------
1 | (ns contrib.missionary-contrib
2 | "staging area, to be considered for missionary inclusion?"
3 | (:require [missionary.core :as m]
4 | [hyperfiddle.rcf :refer [tests]]))
5 |
6 | (defn mix [& flows] (m/ap (m/?> (m/?> (count flows) (m/seed flows)))))
7 |
8 | #?(:clj (defn iterator-consumer "blocking iterable pattern"
9 | [^java.util.Iterator it]
10 | ; why not one thread tied to the iterator extent?
11 | ; (future (while (.hasNext it) (! (.next it))))
12 | (m/ap
13 | (loop []
14 | (if (m/? (m/via m/blk (.hasNext it)))
15 | (m/amb (m/? (m/via m/blk (.next it))) (recur))
16 | (m/amb))))))
17 |
18 | #?(:clj (defn seq-consumer [xs] ; xs is iterable
19 | (m/ap
20 | (loop [xs xs]
21 | (if (m/? (m/via m/blk (seq xs)))
22 | (m/amb (m/? (m/via m/blk (first xs))) (recur (rest xs)))
23 | (m/amb))))))
24 |
25 | #?(:clj
26 | (tests
27 | (def !it (.iterator (.keySet {:a 1, :b 2, :c 3, :d 4})))
28 | (->> (iterator-consumer !it)
29 | (m/eduction (take 3))
30 | (m/reduce conj []) m/?)
31 | := [:a :b :c]
32 |
33 | ; careful, Java iterator is stateful
34 |
35 | (def xs (iterator-seq (.iterator (.keySet {:a 1, :b 2, :c 3, :d 4}))))
36 | (take 3 xs) := [:a :b :c]
37 |
38 | (->> (seq-consumer xs)
39 | (m/eduction (take 3))
40 | (m/reduce conj []) m/?)
41 | := [:a :b :c]))
42 |
43 | (defn poll-task
44 | "derive discrete flow from succession of polled values from a task (or mbox)"
45 | [task]
46 | #_(m/ap (m/? (m/?> (m/seed (repeat mbox)))))
47 | (m/ap
48 | (loop [v (m/? task)]
49 | (m/amb v (recur (m/? task))))))
50 |
51 | (defn document
52 | "compare (document log) to (d/entity db eid). if a datomic txn is [op eid a v],
53 | log here is [op a v], or in other words, there is only one entity (the `eid` is
54 | constant) so we are left with not an entity but a document."
55 | [>txs]
56 | (m/reductions (fn [m [op a v]] ; or is the a actually e?
57 | (case op
58 | ::add (assoc m a v)
59 | ::retract (dissoc m a))) {} >txs))
60 |
61 | (defn throttle [dur >in]
62 | (m/ap
63 | (let [x (m/?> (m/relieve {} >in))]
64 | (m/amb x (do (m/? (m/sleep dur)) (m/amb))))))
65 |
66 | (defn delay-flow [>x]
67 | (->> (m/reductions (fn [[_ b] nx] [b nx]) [] >x)
68 | (m/eduction (map second))))
69 |
70 | ; When waiting for multiple tasks there is m/join and m/race which in terminology
71 | ; of JS Promises are like Promise.all and Promise.race respectively. Is there an
72 | ; equivalent to Promise.allSettled which would wait for all tasks to complete
73 | ; (either success or failure) and does not cancel other tasks when some task fails?
74 | (defn all "
75 | the task result will be a vector of zero-argument functions that you can call
76 | with try/catch to check status"
77 | [& tasks] (apply m/join vector (map m/attempt tasks)))
--------------------------------------------------------------------------------
/src/contrib/missionary_core_async.cljc:
--------------------------------------------------------------------------------
1 | (ns ^:no-doc ; quick band-aid fix for clj-build needing core-async provided for dynamic analysis
2 | contrib.missionary-core-async
3 | "Missionary adapters for core.async. Isolated so as to not create a hard
4 | library dependency on core.async."
5 | (:import (missionary Cancelled))
6 | (:require [clojure.core.async :as a]
7 | [missionary.core :as m]
8 | [hyperfiddle.rcf :refer [tests]]))
9 |
10 | (defn chan-read!
11 | "Return a task taking one value from `chan`. Return nil if chan is closed. Does
12 | not close chan. Stops waiting for chan when cancelled."
13 | ([chan] (chan-read! chan (Cancelled.)))
14 | ([chan cancelled-value]
15 | (fn [success failure] ; a task is a 2-args function, success and failure are callbacks.
16 | (let [cancel-chan (a/chan)] ; we will put a value on this chan to cancel reading from `chan`
17 | (a/go (let [[v port] (a/alts! [chan cancel-chan])] ; race two chans
18 | (if (= port cancel-chan) ; if the winning chan is the cancelation one, then task has been cancelled
19 | (failure cancelled-value) ; task has been cancelled, must produce a failure state
20 | (success v)))) ; complete task with value from chan
21 | (fn cancel []
22 | ;; if this task is cancelled by its parent process, close the cancel-chan
23 | ;; which will make cancel-chan produce `nil` and cause cancellation of read on `chan`.
24 | (a/close! cancel-chan))))))
25 |
26 | (defn chan->ap
27 | "Adapt a core.async channel to a discrete flow"
28 | [ch]
29 | (m/ap
30 | (loop []
31 | (if-some [x (m/? (chan-read! ch))] ; wait for one value, nil means channel closed.
32 | ;; We successfully read a non-nil value, we use `m/amb` with two branches. m/amb will fork
33 | ;; the current process (ap) and do two things sequentially, in two branches:
34 | ;; - return x, meaning `loop` ends and return x, ap will produce x
35 | ;; - recur to read the next value from chan
36 | (m/amb x (recur))
37 | ;; nil means the channel has been closed, so terminate this flow without producing any value
38 | ;; (not even nil). We use (m/amb) which produces nothing and terminates immediately. The
39 | ;; parent m/ap block has nothing to produce anymore and will also terminate.
40 | (m/amb)))))
41 |
42 | (defmacro use-channel ; TODO rename
43 | ([chan] `(use-channel nil ~chan))
44 | ([init chan] `(new (m/reductions {} ~init (chan->ap ~chan)))))
45 |
46 | (defn chan->task [ch]
47 | ; for streaming database results into a vector at the repl (which is not great)
48 | (->> (chan->ap ch)
49 | (m/reduce into [])))
50 |
51 | ;(defn chan->cp [ch] (->> (chan->ap ch) (m/reductions into []))) ; is this useful? Channels are discrete
52 |
--------------------------------------------------------------------------------
/src/contrib/test_match.clj:
--------------------------------------------------------------------------------
1 | (ns contrib.test-match
2 | (:require [hyperfiddle.rcf :as rcf :refer [tests]]
3 | [fipp.ednize]))
4 |
5 | (set! *warn-on-reflection* true)
6 |
7 | ;; test matcher
8 | ;; goal: succinct, simple, useful test output
9 | ;; patterns:
10 | ;; _ -> any value
11 | ;; _& -> any values
12 | ;; view f subpat -> match subpat on (f v)
13 | ;;
14 | ;; missing:
15 | ;; - strict map check (all keys)
16 | ;; - compiler instead of interpreter
17 | ;; - locals inside pattern
18 | ;; - unification (logical vars)
19 | ;; - guard predicates
20 | ;;
21 | ;; differences to matcher-combinators:
22 | ;; - no pretty printing. Result can be used programatically
23 | ;; - more concise syntax
24 | ;; - fits on 1 page
25 | ;; - test framework agnostic
26 | ;;
27 | ;; how to check if pattern matched?
28 | ;; (= v (test-match v pat))
29 | ;; this is also RCF-friendly
30 |
31 | (deftype Diff [a b]
32 | Object
33 | (toString [_] (str "<>"))
34 | (hashCode [_] (+ (.hashCode a) (.hashCode b)))
35 | (equals [_ that]
36 | (and (instance? Diff that)
37 | (= a (.-a ^Diff that)) (= b (.-b ^Diff that))))
38 | clojure.lang.IPersistentCollection
39 | (equiv [this that] (.equals this that))
40 | fipp.ednize/IEdn
41 | (-edn [_] (list '<Diff 1 [2]) := (->Diff 1 [2])
46 | #{(->Diff 1 [2])} := #{(->Diff 1 [2])}
47 | )
48 |
49 | (defmethod print-method Diff [^Diff d ^java.io.Writer w]
50 | (.write w "<>"))
51 |
52 | (deftype Missing []
53 | Object (toString [_] "_")
54 | fipp.ednize/IEdn (-edn [_] '_)
55 | )
56 | (defmethod print-method Missing [_ ^java.io.Writer w] (.write w "_"))
57 | (def missing (Missing.))
58 |
59 | (defn pair [v pat]
60 | (loop [v v, pat pat, ret []]
61 | (let [v* (if (seq v) (first v) missing)
62 | pat* (if (seq pat) (first pat) missing)]
63 | (if (= missing v* pat*)
64 | ret
65 | (recur (rest v) (rest pat) (conj ret [v* pat*]))))))
66 |
67 | (tests
68 | (pair [1] [:a]) := [[1 :a]]
69 | (pair [1 2] [:a]) := [[1 :a] [2 missing]]
70 | (pair [1] [:a :b]) := [[1 :a] [missing :b]]
71 | )
72 |
73 | (defn diffs-over-50%? [v] (> (/ (count ((group-by #(instance? Diff %) v) true)) (count v)) 0.5))
74 |
75 | (tests
76 | (diffs-over-50%? [1 2 3]) := false
77 | (diffs-over-50%? [(->Diff 1 2) (->Diff 2 3) 3])
78 | (diffs-over-50%? [(->Diff 1 2) 2]) := false
79 | (diffs-over-50%? [(->Diff 1 2) (->Diff 2 3)]) := true)
80 |
81 | (defn test-match [v pat]
82 | (cond
83 | (coll? pat) (if (and (or (list? pat) (seq? pat)) (= `view (first pat)))
84 | ;; TODO turn into pattern compiler so we don't need `eval`
85 | (let [[_ ap subpat] pat, subv (eval (list ap v)), ret (test-match subv subpat)]
86 | (if (= subv ret) v ret))
87 | (if (coll? v)
88 | (cond
89 | (map? v)
90 | (if (map? pat)
91 | (let [[v pat] (reduce-kv (fn [[ac pat] k v]
92 | (if (contains? pat k)
93 | [(assoc ac k (test-match v (get pat k))) (dissoc pat k)]
94 | [(assoc ac k v) pat]))
95 | [{} pat] v)]
96 | (reduce-kv (fn [ac k pat] (assoc ac k (test-match missing pat))) v pat))
97 | (->Diff v pat))
98 |
99 | (set? v)
100 | (if (set? pat)
101 | (reduce (fn [v nx] (if (contains? v nx) v (conj v (->Diff missing nx)))) v pat)
102 | (->Diff v pat))
103 |
104 | :else
105 | (let [ret (first (reduce (fn [[ac care?] [v pat]]
106 | (if care?
107 | (let [ret (test-match v pat)]
108 | (if (= ::dont-care ret)
109 | [(conj ac v) false]
110 | [(conj ac ret) care?]))
111 | [(conj ac v) false]))
112 | [(empty v) true] (pair v pat)))
113 | listy-v? (or (list? v) (seq? v)), listy-pat? (or (list? pat) (seq? pat))]
114 | (if (and (seq v) (diffs-over-50%? ret))
115 | (->Diff (into (empty v) (map #(if (instance? Diff %) (.-a ^Diff %) %)) ret)
116 | (into (empty pat) (map #(if (instance? Diff %) (.-b ^Diff %) %)) (cond-> ret (not= listy-v? listy-pat?) reverse)))
117 | (cond-> ret (or (list? v) (seq? v)) reverse))))
118 | (->Diff v pat)))
119 | (= `_& pat) ::dont-care
120 | (= `_ pat) v
121 | (= v pat) v
122 | :else (->Diff v pat))
123 | )
124 |
125 | (tests
126 | (test-match 1 1) := 1
127 | (test-match :x :x) := :x
128 | (test-match 1 0) := (->Diff 1 0)
129 | (test-match 1 2) := (->Diff 1 2)
130 | (test-match [1 2] [1 2]) := [1 2]
131 | (test-match [1 2] [1 0]) := [1 (->Diff 2 0)]
132 | (test-match '(1 2) [1 0]) := (list 1 (->Diff 2 0))
133 | (test-match '(1 2) '(1 2)) := '(1 2)
134 | (class (test-match '(1 2) '(1 2))) := (class '(1 2))
135 | (test-match [1 2 3] [1 2]) := [1 2 (->Diff 3 missing)]
136 | (test-match [1 2] [1 2 3]) := [1 2 (->Diff missing 3)]
137 | (test-match [1 2 3] [1 `_&]) := [1 2 3]
138 | (test-match [1 2 3] [1 `_ 3]) := [1 2 3]
139 | (test-match [1 2] [1 2 `_]) := [1 2 missing]
140 | (test-match [1 [2 3]] [1 [2 `_]]) := [1 [2 3]]
141 | (test-match `(inc (dec x)) `(inc (dec _))) := `(inc (dec x))
142 | (test-match {:x 1} {:x `_}) := {:x 1}
143 | (test-match {:x 1} 1) := (->Diff {:x 1} 1)
144 | (test-match 1 {:x 1}) := (->Diff 1 {:x 1})
145 | (test-match {:x 1} {:x 1 :y 2}) := {:x 1 :y (->Diff missing 2)}
146 | (test-match {:x 1} {:x 1 :y `_}) := {:x 1 :y missing}
147 | (test-match {:x 1, :y 2} {:y 2}) := {:x 1, :y 2}
148 | (test-match {:x [1 2], :y 3} {:x [1 `_]}) := {:x [1 2], :y 3}
149 | (test-match [1 2] `(view first 1)) := [1 2]
150 | (test-match [1 2] `(view first 2)) := (->Diff 1 2)
151 | (test-match [1 2] `[(view identity 0) 2]) := [(->Diff 1 0) 2]
152 | (test-match [1 2] [3 4]) := (->Diff [1 2] [3 4])
153 | (test-match '(1 2) [3 4]) := (->Diff '(1 2) [3 4])
154 | (test-match [1 2] '(3 4)) := (->Diff [1 2] '(3 4))
155 | (test-match '(1 2) '(3 4)) := (->Diff '(1 2) '(3 4))
156 | (test-match [] []) := []
157 | (test-match #{1 2 3} #{1 2}) := #{1 2 3}
158 | (test-match #{1 2} #{2 3}) := #{1 2 (->Diff missing 3)}
159 | (test-match #{1 2 3} [1 2]) := (->Diff #{1 2 3} [1 2])
160 | (test-match {:a 1} [:a 1]) := (->Diff {:a 1} [:a 1])
161 |
162 | (require '[hyperfiddle.electric.impl.lang3 :as-alias lang])
163 | (require '[hyperfiddle.electric.impl.runtime3 :as-alias r])
164 | (let [v `(r/peer
165 | (lang/r-defs
166 | (lang/r-static 1)
167 | (lang/r-ap (lang/r-static
168 | (clojure.core/fn [x32133]
169 | (clojure.core/fn [& rest-args32134]
170 | (clojure.core/let [x x32133]
171 | (clojure.core/apply (fn* ([] x)) rest-args32134)))))
172 | (lang/r-local 0)))
173 | [] 1)]
174 | (test-match v
175 | `(r/peer
176 | (lang/r-defs
177 | (lang/r-static 1)
178 | (lang/r-ap (lang/r-static (clojure.core/fn _&))
179 | (lang/r-local 0)))
180 | [] 1)) := v)
181 | )
182 |
--------------------------------------------------------------------------------
/src/contrib/trace3.cljc:
--------------------------------------------------------------------------------
1 | (ns contrib.trace3
2 | (:require
3 | #?(:clj [contrib.triple-store :as ts])
4 | [clojure.math :as math]
5 | [dustingetz.str]
6 | [hyperfiddle.electric3 :as e :refer [$]]
7 | [hyperfiddle.electric-dom3 :as dom]
8 | #?(:cljs [hyperfiddle.electric.impl.runtime3 :refer [Failure]])
9 | [hyperfiddle.token-zoo0 :refer [CyclicToken StampedToken TokenNofail]]
10 | [missionary.core :as m])
11 | #?(:clj (:import [hyperfiddle.electric.impl.runtime3 Failure]))
12 | #?(:cljs (:require-macros contrib.trace3)))
13 |
14 | (e/declare current)
15 | (declare !db db !measure measure !q q)
16 | (let [c (atom {})]
17 | (defn ->trace-id [nm]
18 | [nm (-> (swap! c update nm (fnil inc 0)) (get nm))]))
19 | (defn ->stamp ([] #?(:clj (System/currentTimeMillis) :cljs (.now js/Date))) ([_] (->stamp)))
20 | (let [!i (atom 0)] (defn ->id [_] (swap! !i inc)))
21 |
22 | #?(:clj
23 | (defn insert-trace [db trace]
24 | (if (::id trace)
25 | (cond-> db (not (ts/find db ::id (::id trace))) (ts/add (assoc trace :db/id (->id trace))))
26 | (ts/add db (assoc trace :db/id (->id trace))))))
27 |
28 | (defn save-trace [!db trace] #?(:clj (swap! !db insert-trace trace)))
29 | (defn push-trace [!q trace] #?(:cljs (swap! !q conj trace)))
30 |
31 | (defn save-trace! [trace !db !q]
32 | (if (instance? Failure !db)
33 | (push-trace !q trace)
34 | (save-trace !db trace)))
35 |
36 | (defn ->stable-trace-id [v] [v 0])
37 |
38 | (letfn [(save [!db !q a b c]
39 | (save-trace! a !db !q)
40 | (save-trace! b !db !q)
41 | (save-trace! c !db !q))]
42 | (e/defn Trace
43 | ([nm F] ($ Trace nm identity F))
44 | ([nm ->pretty F] ($ Trace nm ->trace-id ->pretty F))
45 | ([nm ->trace-id ->pretty F]
46 | (let [nm (->trace-id nm)]
47 | (save-trace! {::id nm, ::parent current} !db !q)
48 | (save-trace! {::v ::mount, ::v-of nm, ::stamp (->stamp), ::pretty-v "🟢"} !db !q)
49 | (let [v (binding [current nm] ($ F))]
50 | (save-trace! {::v-of nm, ::stamp (->stamp v), ::v v, ::pretty-v (->pretty v)} !db !q)
51 | (e/on-unmount #(save-trace! {::v-of nm, ::stamp (->stamp), ::v ::unmount, ::pretty-v "🔴"} !db !q))
52 | v)))))
53 |
54 | (defmacro trace
55 | ([nm form] `(trace ~nm identity ~form))
56 | ([nm ->pretty form] `(trace ~nm ->trace-id ~->pretty ~form))
57 | ([nm ->trace-id ->pretty form] `($ Trace ~nm ~->trace-id ~->pretty (e/fn [] ~form))))
58 |
59 | (defn ->queue
60 | ([] #?(:clj clojure.lang.PersistentQueue/EMPTY :cljs #queue []))
61 | ([& args] (into (->queue) args)))
62 |
63 | #?(:clj (defn save-traces [!db trace+] (swap! !db (fn [db] (reduce insert-trace db trace+)))))
64 |
65 | (e/defn SendClientTraces [ms]
66 | (e/client
67 | (when-some [spend! ($ CyclicToken (seq q))]
68 | (case ($ e/Task (m/sleep ms))
69 | (let [[trace+] (swap-vals! !q (constantly []))]
70 | (spend! (e/server (save-traces !db trace+))))))))
71 |
72 | (defmacro with-defaults [& body]
73 | `(let [!db# (e/server (atom (ts/->ts))), m# (e/server (atom (->queue nil nil))), q# (e/client (atom []))]
74 | (binding [!db !db#, db (e/server (e/watch !db#)), !measure m#, measure (e/server (e/watch m#))
75 | !q q#, q (e/client (e/watch q#))]
76 | ($ SendClientTraces 80)
77 | ~@body)))
78 |
79 | #?(:clj (defn get-latest-pretty-v [db id]
80 | (->> (ts/find db ::v-of id) reverse first (ts/->node db) ::pretty-v)))
81 |
82 | (defn ->pretty [v] (if (nil? v) "␀" v))
83 |
84 | (e/defn RenderPoint [e depth]
85 | (e/client
86 | (let [nd (e/server (ts/->node db e))]
87 | (dom/span
88 | (dom/props {:style {:margin-left (str (* 12 depth) "px")}})
89 | (dom/text (e/server (-> (::id nd) first name symbol))))
90 | (dom/span
91 | (dom/text (e/server (->pretty (get-latest-pretty-v db (::id nd))))))
92 | (e/cursor [c (e/server (e/diff-by identity (ts/find db ::parent (::id nd))))]
93 | ($ RenderPoint c (inc depth))))))
94 |
95 | (def pixel-secs 1000)
96 |
97 | (e/defn RenderPointHistory [vs-e origin]
98 | (dom/div
99 | (dom/props {:style {:position "relative"}})
100 | (e/cursor [ve (e/diff-by identity vs-e)]
101 | (let [nd (e/server (ts/->node db ve))
102 | ;; 200ms difference
103 | ;; 10px = 1sec = 1000ms
104 | ;; 10px/1000ms = offset/200ms
105 | ;; offset = 200ms*10px/1000ms = 2px
106 | offset (-> (e/server (::stamp nd)) (- origin) (* pixel-secs) (quot 1000))]
107 | (dom/span
108 | (dom/props {:style {:position "absolute", :left (str offset "px")}
109 | :title (e/server (dustingetz.str/pprint-str nd))})
110 | (dom/text (->pretty (e/server (::pretty-v nd))))
111 | (when-some [spend! (TokenNofail (dom/On "click" identity nil))]
112 | (spend! (e/server (swap! !measure (fn [m] (conj (pop m) ve)))))))))))
113 |
114 | (e/defn RenderHistory [e origin]
115 | (let [id (e/server (::id (ts/->node db e)))]
116 | ($ RenderPointHistory (e/server (ts/find db ::v-of id)) origin)
117 | (e/cursor [ce (e/server (e/diff-by identity (ts/find db ::parent id)))]
118 | ($ RenderHistory ce origin))))
119 |
120 | #?(:clj (defn ->origin [db] (->> db :ave ::stamp keys (reduce min))))
121 |
122 | (e/defn Header [s] (dom/strong (dom/text s)))
123 |
124 | (def grid-color "repeating-linear-gradient(to bottom, #fff 0, #fff 30px, #e5fff5 30px, #e5fff5 60px)")
125 |
126 | (defn time-str [ms] (if (> ms 1000) (str (-> ms (/ 10) math/round (/ 100)) "s") (str ms "ms")))
127 | #?(:clj (defn measure-distance [db [starte ende]]
128 | (when ende
129 | (abs (- (::stamp (ts/->node db starte)) (::stamp (ts/->node db ende)))))))
130 |
131 | (e/defn Throttle [ms v]
132 | (let [[v2 spend!] ($ StampedToken v)]
133 | (when spend! (spend! ($ e/Task (m/sleep ms))))
134 | (if spend! v2 v)))
135 |
136 | (e/defn TraceView []
137 | ;; binding [db ($ Throttle 2000 db)]
138 | (e/client
139 | (dom/div
140 | (dom/props {:class "dstrace"})
141 | (dom/div (dom/text "Distance: " (e/server (some-> (measure-distance db measure) time-str))))
142 | (dom/div
143 | (dom/props {:style {:display "flex"}})
144 | (dom/div
145 | (dom/props {:style {:display "inline-grid", :grid-template-columns "1fr 1fr", :min-width "400px"
146 | :background grid-color, :grid-auto-rows "30px"}})
147 | ($ Header "Name") ($ Header "Value")
148 | (e/cursor [root-e (e/server (e/diff-by identity (ts/find db ::parent nil)))]
149 | ($ RenderPoint root-e 0)))
150 | (dom/div
151 | (dom/props {:style {:display "inline-grid", :overflow "scroll", :white-space "nowrap", :flex-grow 1
152 | :background grid-color, :grid-auto-rows "30px"}})
153 | ($ Header "History")
154 | (let [origin (e/server (->origin @!db))]
155 | (e/cursor [root-e (e/server (e/diff-by identity (ts/find db ::parent nil)))]
156 | ($ RenderHistory root-e origin))))))))
157 |
--------------------------------------------------------------------------------
/src/contrib/triple_store.cljc:
--------------------------------------------------------------------------------
1 | (ns contrib.triple-store
2 | (:refer-clojure :exclude [find key])
3 | (:require [clojure.set :as set]
4 | [contrib.assert :as ca]
5 | [contrib.data :refer [->box]]))
6 |
7 | ;; ts - triple store
8 | ;; e - entity (id of entity)
9 | ;; a - attribute (key of map)
10 | ;; v - value (val of map)
11 | ;; o - options
12 | ;; nd - node, the entity map
13 | ;; ch - cache
14 |
15 | ;; [{:db/id 1, :foo 1, :bar 1}
16 | ;; {:db/id 2, :foo 1, :bar 2}]
17 | ;; eav 1 :foo -> 1
18 | ;; ave :foo 1 -> (sorted-set 1 2) <- sorted so e.g. :parent e is well ordered
19 | ;; vea 1 1 -> #{:foo :bar} CURRENTLY NOT USED/FILLED
20 |
21 | (defrecord TripleStore [o eav ave])
22 |
23 | (defn ->ts ([] (->ts {})) ([o] (->TripleStore o {} {})))
24 |
25 | (defn add [ts nd]
26 | (let [e (get nd :db/id)
27 | -eav (->box (:eav ts)), -ave (->box (:ave ts))]
28 | (reduce-kv (fn [_ a v]
29 | (-eav (update (-eav) e assoc a v))
30 | (-ave (update (-ave) a update v (fnil conj (sorted-set)) e)))
31 | nil nd)
32 | (->TripleStore (:o ts) (-eav) (-ave))))
33 |
34 | (defn del [ts e]
35 | (let [nd (-> ts :eav (get e))
36 | {:keys [o eav ave]} ts
37 | eav (dissoc eav e)
38 | ave (reduce-kv (fn [ave a v] (update ave a update v disj e)) ave nd)]
39 | (->TripleStore o eav ave)))
40 |
41 | (defn upd [ts e a f]
42 | (let [v0 (-> ts :eav (get e) (get a))
43 | eav (update (:eav ts) e update a f)
44 | v1 (-> eav (get e) (get a))
45 | ave (if (= v0 v1)
46 | (:ave ts)
47 | (let [ave (update (:ave ts) a update v1 (fnil conj (sorted-set)) e)
48 | ave (cond-> ave (contains? (get ave a) v0) (update a update v0 disj e))]
49 | (cond-> ave (not (seq (-> ave (get a) (get v0)))) (update a dissoc v0))))]
50 | (->TripleStore (:o ts) eav ave)))
51 |
52 | (defn asc
53 | ([ts e a v] (upd ts e a (fn [_] v)))
54 | ([ts e a v & avs] (apply asc (asc ts e a v) e avs)))
55 |
56 | ;;;;;;;;;;;;;;;
57 | ;;; HELPERS ;;;
58 | ;;;;;;;;;;;;;;;
59 |
60 | (defn ->node [ts e] (get (:eav ts) e))
61 | (defn ? [ts e k] (get (->node ts e) k))
62 | (defn find
63 | ([ts k v] (-> ts :ave (get k) (get v) not-empty))
64 | ([ts k v & kvs]
65 | (not-empty (reduce set/intersection
66 | (into [] (comp (partition-all 2) (map (fn [[k v]] (-> ts :ave (get k) (get v))))) (list* k v kvs))))))
67 | (defn find1 [ts & kvs]
68 | (let [vs (apply find ts kvs)]
69 | (ca/check #(= 1 (count %)) vs)
70 | (first vs)))
71 | (defn key [ts k] (when-some [vs (get (:ave ts) k)] (reduce into (vals vs))))
72 |
--------------------------------------------------------------------------------
/src/contrib/walk.cljc:
--------------------------------------------------------------------------------
1 | (ns contrib.walk
2 | "Like clojure.walk, but preserves metadata.")
3 |
4 | ;; NOTE already implemented slightly differently by `edamame.impl.read-fn`. We
5 | ;; should analyse borkdude’s impl and compare with this one.
6 |
7 | (defn has-meta? [o] #?(:clj (instance? clojure.lang.IMeta o)
8 | :cljs (satisfies? IMeta o)))
9 |
10 | (defn supports-with-meta? [o] #?(:clj (instance? clojure.lang.IObj o)
11 | :cljs (satisfies? IWithMeta o)))
12 |
13 | (defn walk [inner outer form]
14 | (cond
15 | (list? form) (outer form (apply list (map inner form)))
16 | (map-entry? form) (outer form (first {(inner (key form)) (inner (val form))}))
17 | (seq? form) (outer form (doall (map inner form))) ;; Must be after `list?` and `map-entry?`
18 | (record? form) (outer form (reduce (fn [r x] (conj r (inner x))) form form))
19 | (coll? form) (outer form (into (empty form) (map inner form)))
20 | :else (outer form form)))
21 |
22 | (defn forward-metas [form form']
23 | (if (and (has-meta? form') (supports-with-meta? form'))
24 | (with-meta form' (merge (meta form) (meta form')))
25 | form'))
26 |
27 | (defn prewalk [f form]
28 | (if (reduced? form)
29 | (unreduced form)
30 | (unreduced (walk (partial prewalk f) forward-metas (f form)))))
31 |
32 | (defn postwalk [f form]
33 | (if (reduced? form)
34 | (unreduced form)
35 | (unreduced (walk (partial postwalk f) (fn [form form'] (forward-metas form (f (forward-metas form form'))))
36 | form))))
37 |
--------------------------------------------------------------------------------
/src/hyperfiddle/detest.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.detest
2 | (:import #?(:clj [clojure.lang IFn IDeref])
3 | #?(:clj [clojure.lang ExceptionInfo])
4 | #?(:cljs [goog.math Long])
5 | [missionary Cancelled])
6 | (:require [hyperfiddle.incseq.flow-protocol-enforcer :as fpe]
7 | #?(:cljs [contrib.data :refer [->box]])
8 | [contrib.debug :as dbg]
9 | [clojure.string :as str]))
10 |
11 | ;; DETErministic TESTing, so naturally, DETEST
12 |
13 | #?(:clj
14 | (defn ->xorshift64 [seed]
15 | (let [!v (atom seed)]
16 | (fn step
17 | ([] (swap! !v (fn [v]
18 | (let [v (bit-xor v (bit-shift-left v 7))]
19 | (bit-xor v (unsigned-bit-shift-right v 9))))))
20 | ([n] (if (zero? n) n (mod (step) n)))))))
21 |
22 | #?(:clj (defn random-seed [] (-> java.security.SecureRandom new .nextLong)))
23 |
24 | #?(:cljs
25 | (defn ->xorshift64 [seed]
26 | (let [ (->box seed)
27 | step (fn [] (let [^Long v ()
28 | ^Long v (.xor v (.shiftLeft v 7))]
29 | ( (.xor v (.shiftRightUnsigned v 9)))))]
30 | (fn self
31 | ([] (let [^Long v (step)] (.toNumber v)))
32 | ([n] (if (zero? n) n (let [^Long v (step)] (mod (.toNumber v) n))))))))
33 |
34 | #?(:cljs (defn random-seed [] (Long/fromBits (rand-int 0x100000000) (rand-int 0x100000000))))
35 |
36 | (defprotocol Engine
37 | (exercise [this flow])
38 | (->rng [this])
39 | (->opts [this])
40 | (->dbgf [this])
41 | (roll [this] [this nm])
42 | (add-proc [this proc])
43 | (del-proc [this proc]))
44 |
45 | (defn instrument [nm ngn flow]
46 | (fn [step done]
47 | (let [it ((dbg/instrument* nm (->dbgf ngn) flow) step done)]
48 | (reify
49 | IFn
50 | (#?(:clj invoke :cljs -invoke) [_] (it))
51 | (#?(:clj invoke :cljs -invoke) [_ n] ((it :process) n))
52 | IDeref
53 | (#?(:clj deref :cljs -deref) [_] @it)))))
54 |
55 | (defn on-violate
56 | ([nm msg] (on-violate nm msg nil))
57 | ([nm msg e] (throw (ex-info (str nm " flow protocol violation: " msg) {} e))))
58 |
59 | (defn debug? [ngn] (-> ngn ->opts :debug))
60 |
61 | (defn ->engine
62 | ([] (->engine {}))
63 | ([{:keys [seed] :as o}]
64 | (let [seed (or seed (random-seed)), rng (->xorshift64 seed), !proc* (atom [])
65 | !n (atom 0), dbgf (case (:debug o)
66 | (:steps) (fn [_] (swap! !n inc))
67 | (:full) (fn [x] (swap! !n inc) (prn x))
68 | #_else prn)]
69 | (reify Engine
70 | (add-proc [_ proc] (swap! !proc* conj proc))
71 | (del-proc [_ proc] (swap! !proc* (fn [proc*] (filterv #(not= % proc) proc*))))
72 | (roll [_] (rng))
73 | (roll [_ n] (rng n))
74 | (->rng [_] rng)
75 | (->opts [_] o)
76 | (->dbgf [_] dbgf)
77 | (exercise [this flow]
78 | (try (let [flow (fpe/enforce {:name 'root, :on-violate on-violate}
79 | (cond->> flow (debug? this) (dbg/instrument* 'root dbgf)))
80 | !s (atom nil)
81 | root (flow #(reset! !s :step) #(reset! !s :done))]
82 | (add-proc this root)
83 | (while (not= :done @!s)
84 | (let [proc* @!proc*, n (rng (count proc*)), proc (nth proc* n)]
85 | (if (= proc root)
86 | (case @!s
87 | (:done nil) (when (> 1 (rng 100)) (root))
88 | (:step) (condp > (rng 100)
89 | 1 (root)
90 | 25 nil
91 | #_else (try (reset! !s nil) @root
92 | (catch Cancelled _)
93 | (catch ExceptionInfo e
94 | (when-not (str/starts-with? (ex-message e) "[DETEST OK] ")
95 | (throw e))))))
96 | (proc (rng)))))
97 | (dotimes [_ (rng 10)] (root)))
98 | (catch #?(:clj Throwable :cljs :default) e
99 | (throw (ex-info (str "exercise failed") {:seed seed, :steps @!n} e)))))))))
100 |
101 | (defn minimize [ngn flow]
102 | (try (exercise ngn flow)
103 | (catch ExceptionInfo e
104 | (let [[n0] (), n1 (-> e ex-data :steps)]
105 | (when (or (nil? n0) (< n1 n0)) ( [n1 (-> e ex-data :seed)]))))))
106 |
--------------------------------------------------------------------------------
/src/hyperfiddle/domlike.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.domlike "
2 | A mutable tree implementation with an API isomorphic to a subset of the DOM.
3 | ")
4 |
5 | (defn node "
6 | Return a fresh node.
7 | " []
8 | (doto (object-array 3)
9 | (aset 2 [])))
10 |
11 | (defn parent "
12 | Return `node`'s current parent.
13 | " [^objects node]
14 | (aget node 0))
15 |
16 | (defn set-parent "
17 | Assign `node`'s parent to `parent`.
18 | " [^objects node parent]
19 | (aset node 0 parent))
20 |
21 | (defn index "
22 | Return `node`'s current index.
23 | " [^objects node]
24 | (aget node 1))
25 |
26 | (defn set-index "
27 | Assign `node`'s index to `index`.
28 | " [^objects node index]
29 | (aset node 1 index))
30 |
31 | (defn children "
32 | Return `node`'s current children.
33 | " [^objects node]
34 | (aget node 2))
35 |
36 | (defn set-children "
37 | Assign `node`s children to `children`.
38 | " [^objects node children]
39 | (aset node 2 children))
40 |
41 | (defn nth-child "
42 | Return `node`'s child in position `i`, or `nil` if out of bounds.
43 | " [node i]
44 | (nth (children node) i nil))
45 |
46 | (defn remove-at [node i]
47 | (let [v (children node)]
48 | (set-children node
49 | (into (subvec v 0 i)
50 | (map (fn [c] (set-index c (dec (index c))) c))
51 | (subvec v (inc i))))))
52 |
53 | (defn remove-child "
54 | Remove `child` from `node`'s children and return the removed node.
55 | " [node child]
56 | (when-not (identical? node (parent child))
57 | (throw (#?(:clj Error. :cljs js/Error.) "not a child")))
58 | (remove-at node (index child))
59 | (set-parent child nil)
60 | (set-index child nil)
61 | child)
62 |
63 | (defn replace-child "
64 | Replace `old` by `child` in `node`'s children and return the removed node.
65 | " [node child old]
66 | (when-not (identical? node (parent old))
67 | (throw (#?(:clj Error. :cljs js/Error.) "not a child")))
68 | (when-some [p (parent child)]
69 | (remove-at p (index child)))
70 | (set-parent child node)
71 | (set-index child (index old))
72 | (set-children node
73 | (assoc (children node)
74 | (index old) child))
75 | (set-parent old nil)
76 | (set-index old nil)
77 | old)
78 |
79 | (defn insert-before "
80 | Insert `child` before `sibling` in `node`s children and return the added node.
81 | " [node child sibling]
82 | (when-not (nil? sibling)
83 | (when (identical? child sibling)
84 | (throw (#?(:clj Error. :cljs js/Error.) "insert before self")))
85 | (when-not (identical? node (parent sibling))
86 | (throw (#?(:clj Error. :cljs js/Error.) "not a child"))))
87 | (when-some [p (parent child)]
88 | (remove-at p (index child)))
89 | (let [v (children node)
90 | i (if (nil? sibling)
91 | (count v)
92 | (index sibling))]
93 | (set-parent child node)
94 | (set-index child i)
95 | (set-children node
96 | (-> []
97 | (into (subvec v 0 i))
98 | (conj child)
99 | (into (map (fn [c] (set-index c (inc (index c))) c))
100 | (subvec v i))))
101 | child))
102 |
103 | (defn append-child "
104 | Adds `child` at the end of `node`'s children and return the added node.
105 | " [node child]
106 | (insert-before node child nil))
107 |
108 | (defn tree "
109 | Return a snapshot of the tree rooted at `node`.
110 | " [node] (into [node] (map tree) (children node)))
--------------------------------------------------------------------------------
/src/hyperfiddle/electric/impl/array_fields.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.array-fields
2 | (:refer-clojure :exclude [get set])
3 | #?(:cljs (:require-macros hyperfiddle.electric.impl.array-fields))
4 | (:require [hyperfiddle.rcf :as rcf :refer [tests]]))
5 | #?(:clj (set! *warn-on-reflection* true))
6 | (defmacro deffields [& fields]
7 | `(do ~@(for [[fld idx] (mapv vector fields (range))]
8 | `(def ~fld (int ~idx)))
9 | ~(count fields)))
10 | (defn get [^objects a k] (aget a (int k)))
11 | (defn set
12 | ([^objects a i v] (aset a (int i) v))
13 | ([^objects a i v i2 v2] (aset a (int i) v) (aset a (int i2) v2))
14 | ([^objects a i v i2 v2 i3 v3] (aset a (int i) v) (aset a (int i2) v2) (aset a (int i3) v3))
15 | ([^objects a i v i2 v2 i3 v3 i4 v4] (aset a (int i) v) (aset a (int i2) v2) (aset a (int i3) v3) (aset a (int i4) v4))
16 | ([^objects a i v i2 v2 i3 v3 i4 v4 & more] (set a i v i2 v2 i3 v3 i4 v4) (apply set a more)))
17 | (defn swap
18 | ([^objects a k f] (set a k (f (get a k))))
19 | ([^objects a k f x] (set a k (f (get a k) x)))
20 | ([^objects a k f x y] (set a k (f (get a k) x y)))
21 | ([^objects a k f x y z] (set a k (f (get a k) x y z)))
22 | ([^objects a k f x y z & more] (set a k (apply f (get a k) x y z more))))
23 | (defmacro fswap [O k f & args] `(swap (.-state- ~O) ~k ~f ~@args))
24 | (defmacro fget [O k] `(get (.-state- ~O) ~k))
25 | (defmacro fset [O & kvs] `(set (.-state- ~O) ~@kvs))
26 | (defn getset [^objects a k v] (let [ret (get a k)] (when (not= ret v) (set a k v)) ret))
27 | (defmacro fgetset [O k v] `(getset (.-state- ~O) ~k ~v))
28 | (defn getswap [^objects a k f] (let [ret (get a k)] (swap a k f) ret))
29 | (defn set= [^objects a i oldv newv] (if (= oldv (get a i)) (do (set a i newv) true) false))
30 | (defmacro fset= [O i oldv newv] `(set= (.-state- ~O) ~i ~oldv ~newv))
31 | (defn set-not= [^objects a i oldv newv] (if (not= oldv (get a i)) (do (set a i newv) true) false))
32 | (defmacro fset-not= [O i oldv newv] `(set-not= (.-state- ~O) ~i ~oldv ~newv))
33 |
34 | (defn copy [x y n] #?(:clj (System/arraycopy x 0 y 0 n) :cljs (dotimes [i n] (aset y i (aget x i)))) y)
35 | (defn overfit [k n] (loop [k (* 2 k)] (if (>= k n) k (recur (* 2 k)))))
36 | (defn ensure-fits ^objects [^objects a n] (let [l (alength a)] (cond-> a (< l n) (copy (object-array (overfit l n)) l))))
37 |
38 | (defn rot
39 | ([^objects a i j] (let [tmp (get a i)] (set a i (get a j) j tmp)))
40 | ([^objects a i j k] (let [tmp (get a i)] (set a i (get a j) j (get a k) k tmp)))
41 | ([^objects a i j k l] (let [tmp (get a i)] (set a i (get a j) j (get a k) k (get a l) l tmp)))
42 | ([^objects a i j k l & more]
43 | (let [tmp (get a i)]
44 | (rot a i j k l)
45 | (loop [[i j :as more] (seq (cons l more))]
46 | (if j
47 | (do (set a i (get a j)) (recur (next more)))
48 | (set a i tmp))))))
49 |
50 |
51 | ;;; TESTS ;;;
52 | (deftype P [state-])
53 | (tests
54 | (deffields x y)
55 | (def aP (->P (object-array 2)))
56 | (let [^P aP aP]
57 | (fset aP x 1 y 2) := 2
58 | [(fget aP x) (fget aP y)] := [1 2]
59 | (fswap aP x inc) := 2
60 | (swap (.-state- aP) x inc) := 3
61 | (fgetset aP x 0) := 3
62 | (getset (.-state- aP) x 100) := 0
63 | (fget aP x) := 100
64 | (getswap (.-state- aP) x inc) := 100
65 | (fget aP x) := 101
66 | ))
67 |
68 | (tests
69 | (let [a (object-array [:a :b])]
70 | (rot a 0 1)
71 | (vec a) := [:b :a])
72 | (let [a (object-array [:a :b :c])]
73 | (rot a 0 2 1)
74 | (vec a) := [:c :a :b])
75 | (let [a (object-array [:a :b :c :d])]
76 | (rot a 0 2 1 3)
77 | (vec a) := [:c :d :b :a])
78 | (let [a (object-array [:a :b :c :d :e :f :g])]
79 | (apply rot a (range 7))
80 | (vec a) := [:b :c :d :e :f :g :a]))
81 |
82 | (tests
83 | (alength (ensure-fits (object-array 2) 9)) := 16
84 | )
85 |
--------------------------------------------------------------------------------
/src/hyperfiddle/electric/impl/destructure.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.destructure
2 | "Cross-platform (clj/cljs) destructuring. Adapted from clojurescript codebase"
3 | (:require [cljs.core]
4 | [hyperfiddle.electric.impl.runtime3 :as r]))
5 |
6 | (defn destructure* [bindings]
7 | (let [bents (partition 2 bindings)
8 | pb (fn pb [bvec b v]
9 | (let [pvec
10 | (fn [bvec b val]
11 | (let [gvec (gensym "vec__")
12 | gseq (gensym "seq__")
13 | gfirst (gensym "first__")
14 | has-rest (some #{'&} b)]
15 | (loop [ret (let [ret (conj bvec gvec val)]
16 | (if has-rest
17 | (conj ret gseq (list `seq gvec))
18 | ret))
19 | n 0
20 | bs b
21 | seen-rest? false]
22 | (if (seq bs)
23 | (let [firstb (first bs)]
24 | (cond
25 | (= firstb '&) (recur (pb ret (second bs) gseq)
26 | n
27 | (nnext bs)
28 | true)
29 | (= firstb :as) (pb ret (second bs) gvec)
30 | :else (if seen-rest?
31 | (throw #?(:clj (new Exception "Unsupported binding form, only :as can follow & parameter")
32 | :cljs (new js/Error "Unsupported binding form, only :as can follow & parameter")))
33 | (recur (pb (if has-rest
34 | (conj ret
35 | gfirst `(first ~gseq)
36 | gseq `(next ~gseq))
37 | ret)
38 | firstb
39 | (if has-rest
40 | gfirst
41 | (list `nth gvec n nil)))
42 | (inc n)
43 | (next bs)
44 | seen-rest?))))
45 | ret))))
46 | pmap
47 | (fn [bvec b v]
48 | (let [gmap (gensym "map__")
49 | defaults (:or b)]
50 | (loop [ret (-> bvec (conj gmap) (conj v)
51 | (conj gmap) (conj `(r/get-destructure-map ~gmap))
52 | ((fn [ret]
53 | (if (:as b)
54 | (conj ret (:as b) gmap)
55 | ret))))
56 | bes (let [transforms
57 | (reduce
58 | (fn [transforms mk]
59 | (if (keyword? mk)
60 | (let [mkns (namespace mk)
61 | mkn (name mk)]
62 | (cond (= mkn "keys") (assoc transforms mk #(keyword (or mkns (namespace %)) (name %)))
63 | (= mkn "syms") (assoc transforms mk #(list `quote (symbol (or mkns (namespace %)) (name %))))
64 | (= mkn "strs") (assoc transforms mk str)
65 | :else transforms))
66 | transforms))
67 | {}
68 | (keys b))]
69 | (reduce
70 | (fn [bes entry]
71 | (reduce #(assoc %1 %2 ((val entry) %2))
72 | (dissoc bes (key entry))
73 | ((key entry) bes)))
74 | (dissoc b :as :or)
75 | transforms))]
76 | (if (seq bes)
77 | (let [bb (key (first bes))
78 | bk (val (first bes))
79 | local (if #?(:clj (instance? clojure.lang.Named bb)
80 | :cljs (cljs.core/implements? INamed bb))
81 | (with-meta (symbol nil (name bb)) (meta bb))
82 | bb)
83 | bv (if (contains? defaults local)
84 | (list 'get gmap bk (defaults local))
85 | (list 'get gmap bk))]
86 | (recur
87 | (if (or (keyword? bb) (symbol? bb)) ;(ident? bb)
88 | (-> ret (conj local bv))
89 | (pb ret bb bv))
90 | (next bes)))
91 | ret))))]
92 | (cond
93 | (symbol? b) (-> bvec (conj (if (namespace b) (symbol (name b)) b)) (conj v))
94 | (keyword? b) (-> bvec (conj (symbol (name b))) (conj v))
95 | (vector? b) (pvec bvec b v)
96 | (map? b) (pmap bvec b v)
97 | :else (throw
98 | #?(:clj (new Exception (str "Unsupported binding form: " b))
99 | :cljs (new js/Error (str "Unsupported binding form: " b)))))))
100 | process-entry (fn [bvec b] (pb bvec (first b) (second b)))]
101 | (if (every? symbol? (map first bents))
102 | bindings
103 | (if-let [kwbs (seq (filter #(keyword? (first %)) bents))]
104 | (throw
105 | #?(:clj (new Exception (str "Unsupported binding key: " (ffirst kwbs)))
106 | :cljs (new js/Error (str "Unsupported binding key: " (ffirst kwbs)))))
107 | (reduce process-entry [] bents)))))
108 |
--------------------------------------------------------------------------------
/src/hyperfiddle/electric/impl/event_store.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.event-store
2 | (:refer-clojure :exclude [empty read]))
3 |
4 | (def empty {::events [], ::reductions {}})
5 | (defn reduct [es k init rf]
6 | (update es ::reductions assoc k {::rf rf, ::init init, ::v (reduce rf init (::events es))}))
7 | (defn read [es k] (-> es ::reductions (get k) ::v))
8 | (defn act [es evt]
9 | (update es ::reductions (fn [pj*] (update-vals pj* (fn [pj] (update pj ::v (::rf pj) evt))))))
10 |
11 | (defn add [es evt]
12 | (act (update es ::events conj evt) evt))
13 |
14 | (comment
15 | (-> empty (add {:foo 1, :bar 2})
16 | (reduct :foo+ 0 (fn [ac nx] (+ ac (:foo nx))))
17 | (add {:foo 10, :bar 20})
18 | (reduct :bar* 1 (fn [ac nx] (* ac (:bar nx))))
19 | (read :bar*))
20 | )
21 |
--------------------------------------------------------------------------------
/src/hyperfiddle/electric/impl/lang3.cljs:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.lang3)
2 |
3 |
--------------------------------------------------------------------------------
/src/hyperfiddle/electric/impl/lang_3_walkthrough.md:
--------------------------------------------------------------------------------
1 | # Compiler walkthrough
2 |
3 | The electric compiler has 3 major components - expander, analyzer and emitter.
4 | Each stage has its own complications and separating them aids in debugging and
5 | reasoning. The final `compile` var calls them in the correct order to generate
6 | electric runtime code.
7 |
8 | ## Expander
9 |
10 | Expanding correctly across both clj and cljs is tricker than it should be.
11 | Having it as a separate phase helped honing in on the differences and finding
12 | the best solutions.
13 |
14 | The expander expands all macros to electric built-ins. The analyzer can use the
15 | expander to re-expand a built-in to a set of other built-ins.
16 |
17 | Electric Clojurescript macroexpansion is different from stock expansion:
18 | - cljs allows (defn foo) and (defmacro foo) to live alongside, since macroexpansion happens in a separate stage.
19 | - cljs prefers the macro version wherever it can since it generates code GCC can better optimize.
20 | - electric prefers defns since it generate smaller code which should be faster.
21 |
22 | For this reason we have our own analyzer. It's not a full analyzer, just enough to find macros and vars.
23 |
24 | We want to be able to source map electric code and clojure macroexpansion
25 | doesn't forward line/column information since it's stored in the seq's metadata.
26 | The expander takes care to forward metadata on re-expansion so we can later
27 | source map.
28 |
29 | ## Analyzer
30 |
31 | The analyzer is the hardest stage of all. It has to take in the expanded user
32 | code and figure out what electric code we need to generate.
33 |
34 | Since the analyzer is changing all the time, is complicated and I didn't
35 | know/understand all of its requirements I chose to keep all information in a
36 | single triple store. Using a triple store allows working with the data flexibly
37 | and in multiple passes. I built my own simple triple store to gain speed and
38 | customize it to my needs. The triple store has 3 parts
39 |
40 | - o - an options map that can carry arbitrary extra data
41 | - eav - the main index, for `{:db/id 1, :foo :bar}` it looks like `{1 {:db/id 1, :foo :bar}}`,
42 | i.e. we can get our hands on the inserted map through a single map lookup
43 | - ave - the key-value index which allows traversing the graph in arbitrary ways.
44 | For `:foo` from the map before it looks like `{:foo {:bar (sorted-set 1)}}`. The
45 | sorted set is (ab)used in the analyzer to keep track of node ordering in the graph.
46 |
47 | There's 4 main keys we use:
48 | - `:db/id`, used by the triple store internally, as the entity key. We refer to
49 | this value as `e` in the codebase. Function returning the entity ID end with
50 | a `-e` suffix.
51 | - `::type`, to categorize the nodes.
52 | - `::parent`, a universal backreference key, holding the parent's `:db/id` value.
53 | This allows traversing the graph both ways easily. Reading it we can go to the
54 | parent, querying it in the :ave index we can find all children. Since the :ave
55 | index uses a sorted set for the values we get the ordering for free, provided
56 | the children's `:db/ids` are sorted. This is a strength during initial analysis
57 | and poses some problems when doing graph rewrites, as one has to take care to
58 | preserve the ordering during rewrites.
59 | - `::uid`, used as a universal, unchanging ID. When I started implementing graph
60 | rewrites I realized backreferences can get stale. Instead of meticulously
61 | updating all of them I decided to create this unchanging ID which survives all
62 | rewrites.
63 |
64 | The analyzer uses `->id` and `->uid` to generate a monotonically-increasing
65 | integer. Together with the triple store's sorted maps we get node ordering for
66 | free.
67 |
68 | The analyzer operates in multiple passes over the triple store. The first pass
69 | is `analyze`, which takes the expanded user code, potentially re-expands some
70 | forms and produces the first triple store. There are some non-obvious node types:
71 | - `::mklocal` and `::bindlocal` - `let` expands to these, but also `e/letfn` uses
72 | these. `::mklocal` introduces a local and `::bindlocal` binds it. Separating the
73 | creation and binding of the local allows circular and forward references. E.g.
74 | in `e/letfn` if one defines `Foo` and `Bar` we can first introduce the 2
75 | locals through `::mklocal` and bind them with `::bindlocal` afterwards.
76 | - `::localref` - a reference to an electric local. E.g. the returning `x` in `(let [x 1] x)`.
77 | - `::lookup` - in electric all vars are dynamic and can be rebound. This node type
78 | is a lookup into the dynamic binding of the vars. We allow binding through
79 | non-symbolic keys, e.g. we use keywords for some private bindings and numbers
80 | for passing positional arguments.
81 |
82 | `analyze-electric` takes the output of `analyze` and performs deeper analysis
83 | and graph rewrites. The current passes are:
84 | - `compute-effect-order` - reachable nodes get an ::fx-order key with an
85 | increasing integer value denoting their evaluation order. The ordering is
86 | later used to generate side effecting code in correct order as required by the
87 | runtime.
88 | - `mark-used-ctors` - marks and orders all used constructors (e/fns desugar to
89 | ctors). Used means we perform DCE, e.g. in (let [x 1, y (e/ctor 1)] x) we
90 | won't compile the ctor.
91 | - `mark-used-calls2` - inside the marked ctors, marks and order all calls. It's
92 | safe to mark inside ctors since calls can't happen outside of a ctor.
93 | - `reroute-local-aliases` - if a local just aliases another one, reroutes the
94 | references to the origin. E.g. a similar clojure pass would rewrite
95 | `(let [x 1, y x] [y y])` to `(let [x 1] [x x])`.
96 | - `optimize-locals` - walking the code, finding all localrefs, decides whether the
97 | locals need to become runtime nodes. The compiler aggressively inlines when
98 | possible. This pass also has to handle closed over references (free variables).
99 | - `inline-locals` - inlines locals
100 | - `order-nodes` - orders nodes based on compute-effect-order ordering
101 | - `order-frees` - orders frees based on compute-effect-order ordering
102 | - `collapse-ap-with-only-pures` - `(r/ap (r/pure x) (r/pure y) (r/pure z))` can
103 | optimize to 2 cases:
104 | - `(r/ap (r/pure (fn* [] (x y z))))` if `x` is an impure fn
105 | - `(r/pure (x y z))` if `x` is a pure fn
106 | This pass handles both cases. We list pure fns in a hash-map.
107 |
108 | ## Emitter
109 |
110 | This is the simplest part of the compiler. It takes the final triple store as
111 | input has a straightforward mapping from the graph to the final runtime code.
112 | `emit` is the main var which is currently ~40 lines of simple code. `emit-ctor`
113 | is the glue which ties together `emit` and other parts of the emitter to
114 | generate code for a single ctor.
115 |
--------------------------------------------------------------------------------
/src/hyperfiddle/electric/impl/pures_fns.clj:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.pures-fns)
2 |
3 | (def pure-fns
4 | '#{clojure.core/*
5 | clojure.core/+
6 | clojure.core/-
7 | clojure.core//
8 | clojure.core/<
9 | clojure.core/<=
10 | clojure.core/=
11 | clojure.core/==
12 | clojure.core/>
13 | clojure.core/>=
14 | clojure.core/aget
15 | clojure.core/alength
16 | clojure.core/any?
17 | clojure.core/apply
18 | clojure.core/array-map
19 | clojure.core/assoc
20 | clojure.core/assoc-in
21 | clojure.core/atom
22 | clojure.core/boolean
23 | clojure.core/boolean?
24 | clojure.core/butlast
25 | clojure.core/cat
26 | clojure.core/char
27 | clojure.core/class
28 | clojure.core/class?
29 | clojure.core/coll?
30 | clojure.core/comp
31 | clojure.core/comparator
32 | clojure.core/compare
33 | clojure.core/complement
34 | clojure.core/completing
35 | clojure.core/concat
36 | clojure.core/conj
37 | clojure.core/cons
38 | clojure.core/constantly
39 | clojure.core/contains?
40 | clojure.core/count
41 | clojure.core/counted?
42 | clojure.core/cycle
43 | clojure.core/dec
44 | clojure.core/dedupe
45 | clojure.core/delay
46 | clojure.core/delay?
47 | clojure.core/disj
48 | clojure.core/dissoc
49 | clojure.core/distinct
50 | clojure.core/distinct?
51 | clojure.core/drop
52 | clojure.core/drop-last
53 | clojure.core/drop-while
54 | clojure.core/eduction
55 | clojure.core/empty
56 | clojure.core/empty?
57 | clojure.core/even?
58 | clojure.core/every-pred
59 | clojure.core/every?
60 | clojure.core/ex-cause
61 | clojure.core/ex-data
62 | clojure.core/ex-info
63 | clojure.core/ex-message
64 | clojure.core/ffirst
65 | clojure.core/filter
66 | clojure.core/filterv
67 | clojure.core/find
68 | clojure.core/first
69 | clojure.core/flatten
70 | clojure.core/fnext
71 | clojure.core/fnil
72 | clojure.core/format
73 | clojure.core/frequencies
74 | clojure.core/gensym
75 | clojure.core/get
76 | clojure.core/get-in
77 | clojure.core/group-by
78 | clojure.core/hash
79 | clojure.core/hash-map
80 | clojure.core/hash-set
81 | clojure.core/identical?
82 | clojure.core/identity
83 | clojure.core/inc
84 | clojure.core/instance?
85 | clojure.core/interleave
86 | clojure.core/interpose
87 | clojure.core/into
88 | clojure.core/iterate
89 | clojure.core/juxt
90 | clojure.core/keep
91 | clojure.core/keep-indexed
92 | clojure.core/key
93 | clojure.core/keys
94 | clojure.core/keyword
95 | clojure.core/last
96 | clojure.core/list*
97 | clojure.core/list?
98 | clojure.core/map
99 | clojure.core/map-indexed
100 | clojure.core/mapcat
101 | clojure.core/mapv
102 | clojure.core/max
103 | clojure.core/max-key
104 | clojure.core/merge
105 | clojure.core/merge-with
106 | clojure.core/meta
107 | clojure.core/min
108 | clojure.core/min-key
109 | clojure.core/mod
110 | clojure.core/name
111 | clojure.core/namespace
112 | clojure.core/next
113 | clojure.core/nfirst
114 | clojure.core/nil?
115 | clojure.core/nnext
116 | clojure.core/not
117 | clojure.core/not-empty
118 | clojure.core/not=
119 | clojure.core/nth
120 | clojure.core/nthnext
121 | clojure.core/nthrest
122 | clojure.core/odd?
123 | clojure.core/partial
124 | clojure.core/partition
125 | clojure.core/partition-all
126 | clojure.core/partition-by
127 | clojure.core/peek
128 | clojure.core/pop
129 | clojure.core/pos-int?
130 | clojure.core/pos?
131 | clojure.core/quot
132 | clojure.core/range
133 | clojure.core/reduce
134 | clojure.core/reduce-kv
135 | clojure.core/reductions
136 | clojure.core/remove
137 | clojure.core/repeat
138 | clojure.core/repeatedly
139 | clojure.core/rest
140 | clojure.core/reverse
141 | clojure.core/second
142 | clojure.core/select-keys
143 | clojure.core/seq
144 | clojure.core/seq?
145 | clojure.core/sequence
146 | clojure.core/str
147 | clojure.core/string?
148 | clojure.core/subs
149 | clojure.core/symbol
150 | clojure.core/take
151 | clojure.core/take-last
152 | clojure.core/take-nth
153 | clojure.core/take-while
154 | clojure.core/transduce
155 | clojure.core/type
156 | clojure.core/update
157 | clojure.core/update-in
158 | clojure.core/vals
159 | clojure.core/vec
160 | clojure.core/vector
161 | clojure.core/zero?
162 | clojure.core/zipmap
163 | clojure.core/list
164 | missionary.core/absolve
165 | missionary.core/ap
166 | missionary.core/compel
167 | missionary.core/cp
168 | missionary.core/dfv
169 | missionary.core/eduction
170 | missionary.core/group-by
171 | missionary.core/join
172 | missionary.core/latest
173 | missionary.core/mbx
174 | missionary.core/never
175 | missionary.core/none
176 | missionary.core/observe
177 | missionary.core/race
178 | missionary.core/rdv
179 | missionary.core/reduce
180 | missionary.core/reductions
181 | missionary.core/relieve
182 | missionary.core/sample
183 | missionary.core/seed
184 | missionary.core/sem
185 | missionary.core/sleep
186 | missionary.core/sp
187 | missionary.core/timeout
188 | missionary.core/via-call
189 | missionary.core/watch
190 | missionary.core/zip
191 | hyperfiddle.incseq/count
192 | hyperfiddle.incseq/mount-items
193 | hyperfiddle.incseq/combine
194 | hyperfiddle.incseq/compose
195 | hyperfiddle.incseq/cycle
196 | hyperfiddle.incseq/diff-by
197 | hyperfiddle.incseq/empty-diff
198 | hyperfiddle.incseq/fixed
199 | hyperfiddle.incseq/inverse
200 | hyperfiddle.incseq/items
201 | hyperfiddle.incseq/latest-concat
202 | hyperfiddle.incseq/latest-product
203 | hyperfiddle.incseq/patch-vec
204 | hyperfiddle.incseq/spine
205 | hyperfiddle.electric.impl.runtime3/bind
206 | hyperfiddle.electric.impl.runtime3/dispatch
207 | hyperfiddle.electric.impl.runtime3/drain
208 | hyperfiddle.electric.impl.runtime3/get-destructure-map
209 | hyperfiddle.electric.impl.runtime3/incseq
210 | hyperfiddle.electric.impl.runtime3/invariant
211 | hyperfiddle.electric.impl.runtime3/pure
212 | hyperfiddle.electric.impl.runtime3/effect
213 | hyperfiddle.electric.impl.runtime3/fixed-signals
214 | hyperfiddle.electric-dom3/attach!
215 | hyperfiddle.electric-dom3/await-element
216 | hyperfiddle.electric-dom3/await-elements
217 | })
218 |
--------------------------------------------------------------------------------
/src/hyperfiddle/electric3_contrib.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric3-contrib
2 | "Experimental operators under consideration for inclusion in Electric core"
3 | (:require [contrib.missionary-contrib :as mx]
4 | [hyperfiddle.electric3 :as e]
5 | [hyperfiddle.incseq :as i]
6 | [missionary.core :as m]))
7 |
8 | (defmacro If [amb-test left right] `(if (e/Some? ~amb-test) ~left ~right))
9 |
10 | #_(defmacro verse-if [test then else] `(case (e/as-vec ~test) [] ~else ~then))
11 | #_(defmacro verse-if [test then else] `(e/$ (e/one (e/amb ({} test (e/fn [] ~then)) (e/fn [] ~else)))))
12 |
13 | ; L: I don't think we need e/one but we could have e/take and e/drop, then the one operator is just (e/take 1 ,,,)
14 |
15 | (e/defn None? [xs] (zero? (e/Count xs)))
16 | (e/defn Nothing [& args] (e/amb))
17 | (e/defn Outputs [xs] (e/join (i/items (e/pure xs))))
18 | #_(e/defn Seq [xs] (If xs xs nil))
19 | #_(e/defn Some "return first non-nothing in order"
20 | [xs] (first (e/as-vec xs))) ; todo optimize
21 |
22 | (e/defn Sleep
23 | ([ms x] (e/Task (m/sleep ms x)))
24 | ([ms] (Sleep ms nil)))
25 |
26 | (e/defn Throttle [ms x] (e/input (mx/throttle ms (Outputs x))))
27 |
28 | (e/defn Latch-stale [x]
29 | (let [!cache (atom [])]
30 | (when (e/Some? x) (reset! !cache (e/as-vec x)))
31 | (e/diff-by {} (e/watch !cache))))
32 |
33 | (e/defn ^:deprecated Offload-reset "Deprecated. Promoted to `e/Offload-reset`." [f] (e/Offload-reset f))
34 | (e/defn ^:deprecated Offload-latch "Deprecated. Promoted to `e/Offload-latch`." [f] (e/Offload-latch f))
35 |
36 | #?(:clj (defonce *tap nil)) ; for repl & survive refresh
37 | #?(:clj (def >tap (m/signal
38 | (m/relieve {}
39 | (m/observe
40 | (fn [!]
41 | (! *tap)
42 | (let [! (fn [x] (def *tap x) (! x))]
43 | (clojure.core/add-tap !)
44 | #(clojure.core/remove-tap !))))))))
45 |
46 | (e/defn Tap [] (e/server (e/input >tap)))
47 |
48 | (e/defn UnglitchC [x else]
49 | (e/client
50 | (let [[x clock] (e/with-cycle [[p c] [::init 0]]
51 | [x (if (= p x) c (inc c))])]
52 | (e/Reconcile (if (= clock (e/server (identity clock))) x else)))))
53 |
54 | (e/defn UnglitchS [x else]
55 | (e/server
56 | (let [[x clock] (e/with-cycle [[p c] [::init 0]]
57 | [x (if (= p x) c (inc c))])]
58 | (e/Reconcile (if (= clock (e/client (identity clock))) x else)))))
59 |
--------------------------------------------------------------------------------
/src/hyperfiddle/electric_dom3_events.cljc:
--------------------------------------------------------------------------------
1 | ;; This ns only exists to prevent code duplication.
2 | ;; Required in dom3 and electric core (to pause Clock on DOM hidden)
3 |
4 | (ns hyperfiddle.electric-dom3-events
5 | (:require [missionary.core :as m]))
6 |
7 | #?(:cljs (defn with-listener
8 | ([n e f] (with-listener n e f nil))
9 | ([n e f o] (.addEventListener n e f o) #(.removeEventListener n e f o))))
10 |
11 | #?(:cljs
12 | (defn listen "Takes the same arguments as `addEventListener` and returns an uninitialized
13 | missionary flow that handles the listener's lifecycle producing `(f e)`.
14 | Relieves backpressure. `opts` can be a clojure map."
15 | ([node event-type] (listen node event-type identity))
16 | ([node event-type f] (listen node event-type f {}))
17 | ([node event-type f opts]
18 | (->> (m/observe (fn [!] (with-listener node event-type #(! (f %)) (clj->js opts))))
19 | (m/relieve {})))))
20 |
21 | #?(:cljs
22 | (defn listen-some "Takes the same arguments as `addEventListener` and returns an uninitialized
23 | missionary flow that handles the listener's lifecycle producing `(f e)` unless
24 | the result is `nil`. Relieves backpressure. `opts` can be a clojure map."
25 | ([node event-type] (listen-some node event-type identity))
26 | ([node event-type f] (listen-some node event-type f {}))
27 | ([node event-type f opts]
28 | (->> (m/observe (fn [!]
29 | (let [! #(some-> (f %) !), opts (clj->js opts)]
30 | (.addEventListener node event-type ! opts)
31 | #(.removeEventListener node event-type ! opts))))
32 | (m/relieve {}))
33 | ;; alternative implementation
34 | #_(m/eduction (filter some?) (listen node typ f opts)))))
35 |
36 |
37 |
--------------------------------------------------------------------------------
/src/hyperfiddle/electric_fulcro_dom_adapter.cljc:
--------------------------------------------------------------------------------
1 | ;; TODO Port to v3 if needed
2 | (ns hyperfiddle.electric-fulcro-dom-adapter
3 | (:require [hyperfiddle.electric :as e]
4 | [hyperfiddle.electric-dom2]
5 | #?(:cljs [goog.object :as gobj])
6 | #?(:cljs [com.fulcrologic.fulcro.components :as comp :refer [defsc]])
7 | #?(:cljs [com.fulcrologic.fulcro.dom :as dom :refer [div]]))
8 | #?(:cljs (:require-macros [hyperfiddle.electric-fulcro-dom-adapter])))
9 |
10 | (def ^:private !props "Contains props of all fulcro->electric instances, keyed by `id`"
11 | ;; Only needed under Electric IC first iteration. Next electric version will
12 | ;; allow server and client to inject arguments.
13 | (atom {}))
14 |
15 | (e/def props (e/watch !props)) ; A single top level watch for better perfs
16 | (e/defn GetProps [id] (get props id))
17 |
18 | #?(:cljs
19 | (defsc ElectricBridge [this props]
20 | {:componentDidMount (fn [^js this]
21 | (let [reactor ((::electric-program (comp/props this)))
22 | process (reactor
23 | #(js/console.log "Reactor success:" %)
24 | #(js/console.error "Reactor failure:" %))]
25 | (swap! !props assoc-in [(::id (comp/props this)) ::react-ref] (gobj/get this "container"))
26 | (comp/set-state! this {:process process})))
27 | :componentWillUnmount (fn [this]
28 | ((:process (comp/get-state this)))
29 | (swap! !props dissoc (::id (comp/props this))))}
30 | (div (-> props
31 | (dissoc ::electric-program)
32 | (assoc :ref (fn [r] (gobj/set this "container" r)))))))
33 |
34 | #?(:cljs (def ui-electric-bridge (comp/factory ElectricBridge)))
35 |
36 | (defmacro run-electric!
37 | "Runs an electric program inside a fulcro component. Only one instance of an
38 | electric program can run on a given fulcro page. i.e. one can have multiple
39 | `run-electric!` calls on a fulcro page, but they must all run different
40 | electric programs.
41 |
42 | - `props`: a props map passed to a fulcro-dom wrapper div. Electric will mount
43 | inside of this div.
44 | - `Electric-Entrypoint-Fn`: fully-qualified symbol referring to an Electric e/def or e/defn to run.
45 | - `args-map`: an arbitrary clojure map passed to `Electric-Entrypoint-Fn` as
46 | first argument. Use it to convey reactive values from fulcro to electric.
47 |
48 | Example:
49 | ```
50 | (ns fulcro-electric-example
51 | (:require [hyperfiddle.electric :as e]
52 | [hyperfiddle.electric-dom2 :as dom]
53 | [hyperfiddle.electric-fulcro-dom-adapter :as fulcro-adapter]
54 | [com.fulcrologic.fulcro.dom :as fulcro-dom])
55 |
56 | (e/defn ElectricApp [ring-request] ; starts on the server
57 | (e/client
58 | (let [{:keys [this OtherPage ::fulcro-adapter/react-ref]} (fulcro-adapter/GetProps. `ElectricApp)]
59 | (binding [dom/node react-ref]
60 | (dom/button
61 | (dom/on! \"click\" (fn [_e] (dr/change-route this (dr/path-to OtherPage))))
62 | (dom/text \"Go to OtherPage\"))))))
63 |
64 | (defsc OtherPage []
65 | {:route-segment [\"page-1\"]]}
66 | (fulcro-dom/div \"page-1\")
67 |
68 | (defsc MainPage [this]
69 | (run-electric! {:id \"my-electric-app-in-main-page\"} fulcro-electric-example/ElectricApp {:this this, :OtherPage OtherPage}))
70 | ```
71 | "
72 | [props Electric-Entrypoint-Fn args-map]
73 | (assert (qualified-symbol? Electric-Entrypoint-Fn) "Electric-Entrypoint-Fn must be a fully qualified symbol resolving to an e/def or e/defn.")
74 | `(do
75 | (swap! !props update '~Electric-Entrypoint-Fn merge ~args-map)
76 | (ui-electric-bridge (merge ~props {::id '~Electric-Entrypoint-Fn ::electric-program (fn [] (e/boot-client {} ~Electric-Entrypoint-Fn nil))}))))
77 |
78 |
--------------------------------------------------------------------------------
/src/hyperfiddle/electric_httpkit_adapter3.clj:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric-httpkit-adapter3
2 | "Provide a `wrap-electric-websocket` HTTPKit compatible middleware, starting and
3 | managing an Electric Server. This is a variant of
4 | `hyperfiddle.electric-ring-adapter` made compatible with HTTPKit."
5 | (:require
6 | [clojure.tools.logging :as log]
7 | [hyperfiddle.electric-ring-adapter3 :as ering]
8 | [org.httpkit.server :as httpkit]
9 | [ring.websocket :as ws])
10 | (:import
11 | (org.httpkit.server AsyncChannel)))
12 |
13 | (defrecord HTTPKitSocket [^AsyncChannel channel]
14 | ering/Socket
15 | (open? [_] (httpkit/open? channel))
16 | (close [_this code] (.serverClose channel code))
17 | (close [_this code _reason] (.serverClose channel code)) ; HTTPKit doesn't support close reason
18 | (send [_this value] (httpkit/send! channel {:body value}))
19 | (send [_this value success-cb failure-cb]
20 | (if (httpkit/send! channel {:body value})
21 | (success-cb)
22 | (failure-cb (ex-info "Can't send message to client, remote channel is closed" {}))))
23 |
24 | ;; ping and pong are not exposed by HTTPKit. Instead ping is replaced by a
25 | ;; special "HEARTBEAT" message that the client will echo. HTTPKit will
26 | ;; automatically answer client pings with an immediate echo pong.
27 | ering/Pingable
28 | (ping [this] (ering/ping this "HEARTBEAT"))
29 | (ping [this value] (assert (= "HEARTBEAT" value)) (ering/send this value))
30 | (pong [this] (throw (ex-info "Pong is not supported" {})))
31 | (pong [this value] (throw (ex-info "Pong with arbitrary data is not supported" {})))
32 | )
33 |
34 | (defn reject-websocket-handler
35 | "Will accept socket connection upgrade and immediately close the socket on
36 | connection, with given `code` and `reason`. Use this to cleanly reject a
37 | websocket connection."
38 | ;; Rejecting the HTTP 101 Upgrade request would also prevent the socket to
39 | ;; open, but for security reasons, the client is never informed of the HTTP
40 | ;; 101 failure cause.
41 | [code reason]
42 | {:on-open (fn [socket] (ering/close (HTTPKitSocket. socket) code reason))})
43 |
44 | (def STATUS-CODE
45 | "Map HTTPKit custom WS status names to the actual RFC-defined status code, if it
46 | can be mapped. Fully qualify the status name otherwise."
47 | {:server-close ::server-close
48 | :client-close ::client-close
49 | :normal 1000
50 | :going-away 1001
51 | :protocol-error 1002
52 | :unsupported 1003
53 | :no-status-received 1005
54 | :abnormal 1006
55 | :invalid-payload-data 1007
56 | :policy-violation 1008
57 | :message-too-big 1009
58 | :mandatory-extension 1010
59 | :internal-server-error 1011
60 | :tls-handshake 1015
61 | :unknown ::unknown})
62 |
63 | (defmethod ering/handle-close-status-code ::server
64 | [_ring-req _socket _status-code & [_reason]]
65 | (log/debug "HTTPKit server closed the websocket connection"))
66 |
67 | (defmethod ering/handle-close-status-code ::client
68 | [_ring-req _socket _status-code & [_reason]]
69 | (log/debug "Websocket client closed the connection for an unknown reason"))
70 |
71 | (defmethod ering/handle-close-status-code ::unknown
72 | [_ring-req _socket _status-code & [_reason]]
73 | (log/debug "HTTPKit websocket connection closed for an unknown reason"))
74 |
75 | (defn httpkit-ws-handler
76 | "Return a map of HTTPkit-compatible handlers, describing how to start and manage an Electric server process, hooked onto a websocket."
77 | ([boot-fn] (httpkit-ws-handler boot-fn nil))
78 | ([boot-fn ring-req]
79 | (let [{:keys [on-open on-close on-ping #_on-pong #_on-error on-message]} (ering/electric-ws-handler boot-fn ring-req)]
80 | (-> {:init (fn [_socket]) ; called pre handshake, no use case
81 | :on-open on-open
82 | :on-close (fn [socket status-code]
83 | (ering/handle-close-status-code ring-req socket (or (STATUS-CODE status-code) status-code))
84 | (on-close socket status-code))
85 | :on-ping on-ping
86 | ;; :on-pong on-pong ; unsupported by HTTPKit
87 | ;; :on-error on-error ; unsupported by HTTPKit
88 | :on-receive on-message}
89 | (update-vals
90 | (fn [f]
91 | (fn [async-channel & args]
92 | (apply f (HTTPKitSocket. async-channel) args))))))))
93 |
94 | (defn wrap-electric-websocket
95 | "An HTTPKit-compatible ring middleware, starting an Electric server program defined by `electric-boot-fn` on websocket connection.
96 | E.g.: ```
97 | (-> ring-handler
98 | (wrap-electric-websocket (fn [ring-req] (hyperfiddle.entrypoint/boot-server {} my-ns/MyElectricDefn (e/server ring-req))))
99 | (wrap-cookies)
100 | (wrap-params)
101 | )
102 | ```
103 | "
104 | [next-handler electric-boot-fn]
105 | (fn [ring-request]
106 | (if (ws/upgrade-request? ring-request)
107 | (httpkit/as-channel ring-request
108 | (httpkit-ws-handler (partial electric-boot-fn ring-request) ring-request))
109 | (next-handler ring-request))))
110 |
--------------------------------------------------------------------------------
/src/hyperfiddle/electric_scroll0.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric-scroll0
2 | (:require [clojure.math :as math]
3 | [contrib.data :refer [clamp window]]
4 | [contrib.missionary-contrib :as mx]
5 | [hyperfiddle.electric3 :as e]
6 | [hyperfiddle.electric-dom3 :as dom]
7 | [hyperfiddle.rcf :as rcf :refer [tests with tap %]]
8 | [missionary.core :as m]
9 | [hyperfiddle.electric-local-def3 :as l]))
10 |
11 | #?(:cljs (defn scroll-state [scrollable]
12 | (->> (m/observe
13 | (fn [!]
14 | (let [sample (fn [] (! [(.. scrollable -scrollTop) ; optimization - detect changes (pointless)
15 | (.. scrollable -scrollHeight) ; snapshot height to detect layout shifts in flipped mode
16 | (.. scrollable -clientHeight)]))] ; measured viewport height (scrollbar length)
17 | (sample) #_(! [0 0 0]) ; don't emit 0 when flow is rebuilt
18 | (.addEventListener scrollable "scroll" sample #js {"passive" true})
19 | #(.removeEventListener scrollable "scroll" sample))))
20 | (mx/throttle 16) ; RAF interval
21 | (m/relieve {}))))
22 |
23 | #?(:cljs (defn resize-observer [node]
24 | (->>
25 | (m/observe (fn [!] (! [(.-clientHeight node)
26 | (.-clientWidth node)])
27 | (let [obs (new js/ResizeObserver
28 | (fn [entries]
29 | (let [content-box-size (-> entries (aget 0) .-contentBoxSize (aget 0))]
30 | (! [(.-blockSize content-box-size)
31 | (.-inlineSize content-box-size)]))))]
32 | (.observe obs node) #(.unobserve obs node))))
33 | (mx/throttle 100) ; Optimization – (un)mounting rows is expensive. 100ms is usually considered "minimum human-perceptible latency".
34 | (m/relieve {}))))
35 |
36 | #?(:cljs (defn compute-overquery [overquery-factor record-count offset limit]
37 | (let [q-limit (* limit overquery-factor)
38 | occluded (clamp (- q-limit limit) 0 record-count)
39 | q-offset (clamp (- offset (math/floor (/ occluded overquery-factor))) 0 record-count)]
40 | [q-offset q-limit])))
41 |
42 | #?(:cljs (defn compute-scroll-window [row-height record-count clientHeight scrollTop overquery-factor]
43 | (let [padding-top 0 ; e.g. sticky header row
44 | limit (math/ceil (/ (- clientHeight padding-top) row-height)) ; aka page-size
45 | offset (int (/ (clamp scrollTop 0 (* record-count row-height)) ; prevent overscroll past the end
46 | row-height))]
47 | (compute-overquery overquery-factor record-count offset limit))))
48 |
49 | (e/defn Scroll-window ; returns [offset, limit]
50 | [row-height record-count node
51 | #_& {:keys [overquery-factor]
52 | :or {overquery-factor 1}}]
53 | (e/client
54 | ((fn [_] (set! (.-scrollTop dom/node) 0)) record-count) ; scroll to top on search or navigate
55 | ; backlog: don't touch scrollTop when records are inserted (e.g., live chat view)
56 | (let [[clientHeight] (e/input (resize-observer node))
57 | [scrollTop scrollHeight #_clientHeight] (e/input (scroll-state node))] ; smooth scroll has already happened, cannot quantize
58 | (compute-scroll-window row-height record-count clientHeight scrollTop overquery-factor))))
59 |
60 | (e/defn Spool2 [cnt xs! offset limit] ; legacy
61 | (->> xs!
62 | (map vector (cycle (range limit)))
63 | (window cnt offset limit)
64 | (e/diff-by first)))
65 |
66 | (e/defn Spool [cnt xs! offset limit] ; legacy
67 | (->> (map-indexed vector xs!)
68 | (window cnt offset limit)
69 | (e/diff-by #(mod (first %) limit))))
70 |
71 | (defn index-ring
72 | "Return a vector of numbers of size `size` containing numbers [0..size[ shifted by `offset`, in the direction of sgn(offset).
73 | Contrary to usual \"sliding window\" shifting, where all slots shift one place left or right, this ring shifts as a tape.
74 | Values shift, not slots. Allowing for stable indexing of a sliding window.
75 | e.g.: Usual : [1 2 3] -> [2 3 4] ; shift one right - all values changed, as if all slots shifted.
76 | Tape: [1 2 3] -> [4 2 3] ; 4 replaced 1 at slot 0. Slots 1 and 2 untouched.
77 | Example: assuming size = 5, and offset in [0,1,2,3,4,5]
78 | Offset
79 | 0 -> [0 1 2 3 4] ; 5 slots, initial state
80 | 1 -> [5 1 2 3 4] ; shift one right – 5 replaces 0 at slot 0, 1 2 3 4 untouched
81 | 2 -> [5 6 2 3 4] ; shift one right – 6 replaces 1 at slot 1, 5 and the rest untouched
82 | 3 -> [5 6 7 3 4]
83 | 4 -> [5 6 7 8 4]
84 | 5 -> [5 6 7 8 9] ; offset = size, full window slide, all values shifted, but no slot shifted.
85 | "
86 | [size offset]
87 | (let [start (- size offset)]
88 | (mapv #(+ offset (mod % size)) (range start (+ size start)))))
89 |
90 | (tests
91 | (let [size 7]
92 | (mapv #(index-ring size %) (range (inc size)))
93 | := [[0 1 2 3 4 5 6]
94 | [7 1 2 3 4 5 6]
95 | [7 8 2 3 4 5 6]
96 | [7 8 9 3 4 5 6]
97 | [7 8 9 10 4 5 6]
98 | [7 8 9 10 11 5 6]
99 | [7 8 9 10 11 12 6]
100 | [7 8 9 10 11 12 13]]
101 |
102 | (range 0 (- (inc size)) -1) := '(0 -1 -2 -3 -4 -5 -6 -7) ; for reference
103 | (mapv #(index-ring size %) (range 0 (- (inc size)) -1))
104 | := [[ 0 1 2 3 4 5 6]
105 | [ 0 1 2 3 4 5 -1]
106 | [ 0 1 2 3 4 -2 -1]
107 | [ 0 1 2 3 -3 -2 -1]
108 | [ 0 1 2 -4 -3 -2 -1]
109 | [ 0 1 -5 -4 -3 -2 -1]
110 | [ 0 -6 -5 -4 -3 -2 -1]
111 | [-7 -6 -5 -4 -3 -2 -1]]))
112 |
113 | (let [index-ring index-ring] ; FIXME without this let, below rcf test crashes at the repl
114 | (e/defn IndexRing [size offset] (e/diff-by {} (index-ring size offset))))
115 |
116 | (tests
117 | (let [size 7
118 | !offset (atom 0)]
119 | (with ((l/single {} (e/Tap-diffs tap (IndexRing size (e/watch !offset)))) {} {})
120 | % := {:degree 7, :permutation {}, :grow 7, :shrink 0, :change {0 0, 1 1, 2 2, 3 3, 4 4, 5 5, 6 6}, :freeze #{}}
121 | (swap! !offset inc)
122 | % := {:degree 7, :permutation {}, :grow 0, :shrink 0, :change {0 7}, :freeze #{}}
123 | (swap! !offset + 2)
124 | % := {:degree 7, :permutation {}, :grow 0, :shrink 0, :change {1 8, 2 9}, :freeze #{}}
125 | (reset! !offset size) ; check offset = size
126 | % := {:degree 7, :permutation {}, :grow 0, :shrink 0, :change {3 10, 4 11, 5 12, 6 13}, :freeze #{}}
127 | (swap! !offset inc) ; check offset > size
128 | % := {:degree 7, :permutation {}, :grow 0, :shrink 0, :change {0 14}, :freeze #{}}
129 | ;; negative offset, no use case for now but check for correctness
130 | (reset! !offset 0) ; reset to initial state
131 | % := {:degree 7, :permutation {}, :grow 0, :shrink 0, :change {0 0, 1 1, 2 2, 3 3, 4 4, 5 5, 6 6}, :freeze #{}}
132 | (swap! !offset dec) ; check offset < 0
133 | % := {:degree 7, :permutation {}, :grow 0, :shrink 0, :change {6 -1}, :freeze #{}}
134 | (reset! !offset -7)
135 | % := {:degree 7, :permutation {}, :grow 0, :shrink 0, :change {0 -7, 1 -6, 2 -5, 3 -4, 4 -3, 5 -2}, :freeze #{}}
136 | )))
137 |
138 | ;; NOTE: output is weird when size isn't divisible by step
139 | ;; For now it's up to the user to provide correct values
140 | (let [ring (fn ring [size offset step]
141 | (let [start (- size offset)]
142 | (mapv #(+ offset (mod % size)) (range start (+ size start) step))))]
143 | (e/defn Ring [size offset step]
144 | (e/diff-by {} (ring size offset step))))
145 |
--------------------------------------------------------------------------------
/src/hyperfiddle/electric_svg3.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric-svg3
2 | "SVG support is experimental, API subject to change"
3 | (:refer-clojure :exclude [filter set symbol use])
4 | (:require [hyperfiddle.electric-dom3 :as dom]
5 | [hyperfiddle.electric-dom3-props :as props])
6 | #?(:cljs (:require-macros [hyperfiddle.electric-svg3])))
7 |
8 | (defn element* [tag forms] (dom/element* props/SVG-NS tag forms))
9 |
10 | (defmacro element [tag & body] (element* tag body))
11 |
12 | ;;;;;;;;;;;
13 | ;; Sugar ;;
14 | ;;;;;;;;;;;
15 |
16 | (defmacro a [& body] (element* :a body))
17 | (defmacro altGlyph [& body] (element* :altGlyph body))
18 | (defmacro altGlyphDef [& body] (element* :altGlyphDef body))
19 | (defmacro altGlyphItem [& body] (element* :altGlyphItem body))
20 | (defmacro animate [& body] (element* :animate body))
21 | (defmacro animateMotion [& body] (element* :animateMotion body))
22 | (defmacro animateTransform [& body] (element* :animateTransform body))
23 | (defmacro circle [& body] (element* :circle body))
24 | (defmacro clipPath [& body] (element* :clipPath body))
25 | (defmacro color-profile [& body] (element* :color-profile body))
26 | (defmacro cursor [& body] (element* :cursor body))
27 | (defmacro defs [& body] (element* :defs body))
28 | (defmacro desc [& body] (element* :desc body))
29 | (defmacro ellipse [& body] (element* :ellipse body))
30 | (defmacro feBlend [& body] (element* :feBlend body))
31 | (defmacro feColorMatrix [& body] (element* :feColorMatrix body))
32 | (defmacro feComponentTransfer [& body] (element* :feComponentTransfer body))
33 | (defmacro feComposite [& body] (element* :feComposite body))
34 | (defmacro feConvolveMatrix [& body] (element* :feConvolveMatrix body))
35 | (defmacro feDiffuseLighting [& body] (element* :feDiffuseLighting body))
36 | (defmacro feDisplacementMap [& body] (element* :feDisplacementMap body))
37 | (defmacro feDistantLight [& body] (element* :feDistantLight body))
38 | (defmacro feFlood [& body] (element* :feFlood body))
39 | (defmacro feFuncA [& body] (element* :feFuncA body))
40 | (defmacro feFuncB [& body] (element* :feFuncB body))
41 | (defmacro feFuncG [& body] (element* :feFuncG body))
42 | (defmacro feFuncR [& body] (element* :feFuncR body))
43 | (defmacro feGaussianBlur [& body] (element* :feGaussianBlur body))
44 | (defmacro feImage [& body] (element* :feImage body))
45 | (defmacro feMerge [& body] (element* :feMerge body))
46 | (defmacro feMergeNode [& body] (element* :feMergeNode body))
47 | (defmacro feMorphology [& body] (element* :feMorphology body))
48 | (defmacro feOffset [& body] (element* :feOffset body))
49 | (defmacro fePointLight [& body] (element* :fePointLight body))
50 | (defmacro feSpecularLighting [& body] (element* :feSpecularLighting body))
51 | (defmacro feSpotLight [& body] (element* :feSpotLight body))
52 | (defmacro feTile [& body] (element* :feTile body))
53 | (defmacro feTurbulence [& body] (element* :feTurbulence body))
54 | (defmacro filter [& body] (element* :filter body))
55 | (defmacro font [& body] (element* :font body))
56 | (defmacro font-face [& body] (element* :font-face body))
57 | (defmacro font-face-format [& body] (element* :font-face-format body))
58 | (defmacro font-face-name [& body] (element* :font-face-name body))
59 | (defmacro font-face-src [& body] (element* :font-face-src body))
60 | (defmacro font-face-uri [& body] (element* :font-face-uri body))
61 | (defmacro foreignObject [& body] (element* :foreignObject body))
62 | (defmacro g [& body] (element* :g body))
63 | (defmacro glyph [& body] (element* :glyph body))
64 | (defmacro glyphRef [& body] (element* :glyphRef body))
65 | (defmacro hkern [& body] (element* :hkern body))
66 | (defmacro image [& body] (element* :image body))
67 | (defmacro line [& body] (element* :line body))
68 | (defmacro linearGradient [& body] (element* :linearGradient body))
69 | (defmacro marker [& body] (element* :marker body))
70 | (defmacro mask [& body] (element* :mask body))
71 | (defmacro metadata [& body] (element* :metadata body))
72 | (defmacro missing-glyph [& body] (element* :missing-glyph body))
73 | (defmacro mpath [& body] (element* :mpath body))
74 | (defmacro path [& body] (element* :path body))
75 | (defmacro pattern [& body] (element* :pattern body))
76 | (defmacro polygon [& body] (element* :polygon body))
77 | (defmacro polyline [& body] (element* :polyline body))
78 | (defmacro radialGradient [& body] (element* :radialGradient body))
79 | (defmacro rect [& body] (element* :rect body))
80 | (defmacro script [& body] (element* :script body))
81 | (defmacro set [& body] (element* :set body))
82 | (defmacro stop [& body] (element* :stop body))
83 | (defmacro style [& body] (element* :style body))
84 | (defmacro svg [& body] (element* :svg body))
85 | (defmacro switch [& body] (element* :switch body))
86 | (defmacro symbol [& body] (element* :symbol body))
87 | (defmacro text [& body] (element* :text body))
88 | (defmacro textPath [& body] (element* :textPath body))
89 | (defmacro title [& body] (element* :title body))
90 | (defmacro tref [& body] (element* :tref body))
91 | (defmacro tspan [& body] (element* :tspan body))
92 | (defmacro use [& body] (element* :use body))
93 | (defmacro view [& body] (element* :view body))
94 | (defmacro vkern [& body] (element* :vkern body))
95 |
96 |
97 |
--------------------------------------------------------------------------------
/src/hyperfiddle/electric_tokens.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric-tokens
2 | (:require [clojure.datafy :refer [datafy]]
3 | [hyperfiddle.electric3 :as e]))
4 |
5 | (defn- fn-name [f]
6 | (when (fn? f)
7 | #?(:cljs (.-name f)
8 | :clj (-> f class .getName ((requiring-resolve 'clojure.main/demunge))))))
9 |
10 | (def ansi-color-no-color 0)
11 | (def ansi-color-256 {:ansi.color-256/red 196, :ansi.color-256/green 46, :ansi.color-256/orange 202}) ; use with "\033[38;5;m\033[0m"
12 | (def diff-color {::added :ansi.color-256/green, ::retracted :ansi.color-256/red, ::changed :ansi.color-256/orange})
13 |
14 | (defn- colorize [color string]
15 | #?(:clj (str "\033[38;5;" (ansi-color-256 color ansi-color-no-color) "m" string "\033[0m")
16 | :cljs string #_(str "\u001B[38;5;" (ansi-color-256 color ansi-color-no-color) "m" string "\u001B[m")))
17 |
18 | (defn- ansi-bold [string] #?(:clj (str "\033[1m" string "\033[0m")
19 | :cljs string #_(str "\u001B[1m" string "\u001B[m")))
20 |
21 | (defn token-trace
22 | ([t] (token-trace 0 t))
23 | ([level t]
24 | (if-not t
25 | "nil\n"
26 | (let [{:keys [::e/name ::e/children ::e/diff ::e/hash]} (datafy t)]
27 | (apply str (cond-> (or name (fn-name t)) (not (e/token? t)) (ansi-bold))
28 | " "
29 | (colorize (diff-color diff) (some-> diff clojure.core/name not-empty))
30 | (cond (= ::changed diff) (str " #" hash)
31 | (and t (not (e/token? t))) (str " #" (clojure.core/hash t)))
32 | "\n"
33 | (map (fn [child]
34 | (let [level (inc level)]
35 | (str (apply str (repeat (max 0 (dec level)) "│ ")) "├─ "
36 | (token-trace level child))))
37 | children))))))
38 |
39 | (defn- token-diff-1 [ta tb]
40 | (cond (= ta tb) nil ; account for nil
41 | (nil? ta) ::added
42 | (nil? tb) ::retracted
43 | () ::changed))
44 |
45 | (defn- pad [v n coll] (concat coll (repeat n v)))
46 |
47 | (defn- pad-colls [coll-a coll-b]
48 | (let [ca (count coll-a)
49 | cb (count coll-b)]
50 | (cond (= ca cb) [coll-a coll-b]
51 | (< ca cb) [(pad nil (- cb ca) coll-a) coll-b]
52 | (> ca cb) [coll-a (pad nil (- ca cb) coll-b)])))
53 |
54 | (defn token-diff [ta tb]
55 | (let [diff (token-diff-1 ta tb)]
56 | (case diff
57 | ::added (vary-meta tb assoc ::e/diff diff)
58 | ::retracted nil
59 | ::changed (-> (vary-meta tb update ::e/children #(apply map token-diff (pad-colls (::e/children (meta ta)) %)))
60 | (vary-meta assoc ::e/diff diff))
61 | (if (e/token? ta)
62 | (-> (vary-meta ta update ::e/children #(apply map token-diff (pad-colls % (::e/children (meta tb)))))
63 | (vary-meta assoc ::e/diff diff))
64 | ta))))
65 |
66 | (comment
67 | (def left (e/->Token "left1"
68 | (e/->Token "left1.1")
69 | (e/->Token "left1.2")))
70 |
71 | (def right-1 (e/->Token "right1.1" #(prn "hello")))
72 | (def right-2 (e/->Token "right1.2"))
73 |
74 | (def right (e/->Token "right" right-1 right-2))
75 |
76 | (def ta
77 | (e/->Token "root"
78 | left
79 | right))
80 |
81 | (def tb
82 | (e/->Token "root"
83 | left
84 | (e/->Token "right"
85 | (e/->Token "right1.3")
86 | right-2)
87 | ))
88 | (datafy ta)
89 |
90 | (println (token-trace ta))
91 | (println (token-trace tb))
92 |
93 | (println (token-trace (token-diff ta ta)))
94 | (println (token-trace (token-diff ta tb)))
95 |
96 | )
97 |
--------------------------------------------------------------------------------
/src/hyperfiddle/incseq/arrays_impl.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.incseq.arrays-impl
2 | (:refer-clojure :exclude [int-array]))
3 |
4 | (defn int-array ^ints [n]
5 | #?(:clj (make-array Integer/TYPE n)
6 | :cljs (let [a (make-array n)]
7 | (dotimes [i n] (aset a i 0)) a)))
8 |
9 | (defn acopy [source source-offset target target-offset length]
10 | #?(:clj (System/arraycopy source source-offset target target-offset length)
11 | :cljs (dotimes [i length]
12 | (aset target (+ target-offset i)
13 | (aget source (+ source-offset i))))))
14 |
15 | (defn aget-aset [^objects arr i x]
16 | (let [y (aget arr i)]
17 | (aset arr i x) y))
18 |
19 | (defn weight-tree [size]
20 | (let [o (loop [o 1]
21 | (if (< o size)
22 | (recur (bit-shift-left o 1)) o))
23 | n (bit-shift-left o 1)
24 | arr (int-array n)]
25 | (loop [f (unchecked-subtract o size)
26 | o o
27 | n n]
28 | (when (< 1 o)
29 | (loop [i (unchecked-subtract n f)]
30 | (when (< i n)
31 | (aset arr i 1)
32 | (recur (unchecked-inc i))))
33 | (recur (bit-shift-right f 1)
34 | (bit-shift-right o 1) o))) arr))
--------------------------------------------------------------------------------
/src/hyperfiddle/incseq/diff_impl.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.incseq.diff-impl
2 | (:require [hyperfiddle.incseq.perm-impl :as p]
3 | [hyperfiddle.rcf :refer [tests]]))
4 |
5 | (defn empty-diff [n]
6 | {:degree n :grow 0 :shrink 0 :permutation {} :change {} :freeze #{}})
7 |
8 | (defn empty-diff? [{:keys [grow shrink permutation change freeze]}]
9 | (-> (unchecked-add grow shrink)
10 | (unchecked-add (count permutation))
11 | (unchecked-add (count change))
12 | (unchecked-add (count freeze))
13 | (zero?)))
14 |
15 | (def patch-vec
16 | (let [grow! (fn [v n]
17 | (reduce conj! v (repeat n nil)))
18 | shrink! (fn [v n]
19 | (loop [i 0, v v]
20 | (if (< i n)
21 | (recur (inc i)
22 | (pop! v)) v)))
23 | change! (fn [r c]
24 | (reduce-kv assoc! r c))
25 | cycles! (partial p/decompose
26 | (fn [v c]
27 | (let [i (nth c 0)
28 | x (nth v i)]
29 | (loop [v v
30 | i i
31 | k 1]
32 | (let [j (nth c k)
33 | v (assoc! v i (nth v j))
34 | k (unchecked-inc-int k)]
35 | (if (< k (count c))
36 | (recur v j k)
37 | (assoc! v j x)))))))]
38 | (fn
39 | ([] [])
40 | ([v d]
41 | (-> v
42 | (transient)
43 | (grow! (:grow d))
44 | (cycles! (:permutation d))
45 | (shrink! (:shrink d))
46 | (change! (:change d))
47 | (persistent!))))))
48 |
49 | (defn unlink [p i j] (let [k (get p j)] (cond-> (dissoc p i j) (not= i k) (assoc i k))))
50 |
51 | (defn remove-shrunk-reorders [p i j]
52 | (reduce (fn [p k] (if-some [[_ v] (find p k)] (cond-> p (>= v i) (unlink k v)) p)) p (range i (inc j))))
53 |
54 | (defn remove-change-reorders [p changeset]
55 | (-> (fn [p k] (if-some [[_ v] (find p k)] (if (changeset v) (recur (unlink p k v) k) p) p))
56 | (reduce p changeset)))
57 |
58 | (defn combine
59 | ([x] x)
60 | ([x y]
61 | (let [px (:permutation x), py (:permutation y)
62 | dx (:degree x), dy (:degree y)
63 | cx (:change x), cy (:change y)
64 | fx (:freeze x), fy (:freeze y)
65 | degree (unchecked-add dy (:shrink x))
66 | size-before (unchecked-subtract dx (:grow x))
67 | size-between (unchecked-subtract dy (:grow y))
68 | size-after (unchecked-subtract dy (:shrink y))]
69 | (loop [i size-after
70 | d degree
71 | p (p/compose py
72 | (p/split-swap size-between
73 | (unchecked-subtract degree dy)
74 | (unchecked-subtract degree dx)) px)
75 | c (reduce-kv assoc!
76 | (reduce-kv
77 | (fn [r i j]
78 | (if (contains? cx j)
79 | (assoc! r i (cx j)) r))
80 | (reduce dissoc! (transient cx)
81 | (vals py)) py) cy)
82 | f (reduce conj!
83 | (reduce-kv
84 | (fn [r i j]
85 | (if (contains? fx j)
86 | (conj! r i) r))
87 | (reduce disj! (transient fx)
88 | (vals py)) py) fy)]
89 | (if (< i d)
90 | (let [j (p i i)]
91 | (if (< j size-before)
92 | (recur (unchecked-inc i) d p (dissoc! c i) (disj! f i))
93 | (recur i (unchecked-dec d)
94 | (p/compose (p/rotation i d)
95 | p (p/rotation d j)) (dissoc! c d) (disj! f d))))
96 | (let [c (persistent! (dissoc! c d))]
97 | {:degree d
98 | :permutation (-> p (remove-shrunk-reorders size-after d) (remove-change-reorders (set (keys c))))
99 | :grow (unchecked-subtract d size-before)
100 | :shrink (unchecked-subtract d size-after)
101 | :change c
102 | :freeze (persistent! (disj! f d))})))))
103 | ([x y & zs] (reduce combine (combine x y) zs)))
104 |
105 | (defn subdiff [{:keys [grow shrink degree permutation change freeze]} size offset]
106 | (let [global-degree (unchecked-add-int size grow)
107 | shift (unchecked-subtract-int global-degree (unchecked-add-int degree offset))
108 | +offset (partial + offset)]
109 | {:grow grow
110 | :shrink shrink
111 | :degree global-degree
112 | :permutation (p/compose
113 | (p/split-swap (unchecked-add-int offset (unchecked-subtract-int degree shrink)) shrink shift)
114 | (into {} (map (juxt (comp +offset key) (comp +offset val))) permutation)
115 | (p/split-swap (unchecked-add-int offset (unchecked-subtract-int degree grow)) shift grow))
116 | :change (into {} (map (juxt (comp +offset key) val)) change)
117 | :freeze (into #{} (map +offset) freeze)}))
118 |
119 | (tests "sequence diffs"
120 | (patch-vec [:a :b :c]
121 | {:grow 1
122 | :degree 4
123 | :permutation (p/rotation 3 1)
124 | :shrink 2
125 | :change {1 :e}}) :=
126 | [:a :e]
127 | (patch-vec [:a :e]
128 | {:grow 2
129 | :degree 4
130 | :permutation (p/rotation 1 3)
131 | :shrink 1
132 | :change {0 :f 1 :g 2 :h}}) :=
133 | [:f :g :h]
134 |
135 | (patch-vec [:a :b :c]
136 | {:grow 1
137 | :degree 4
138 | :permutation {}
139 | :shrink 1
140 | :change {0 :f, 1 :g, 2 :h}}) :=
141 | [:f :g :h]
142 | )
143 |
--------------------------------------------------------------------------------
/src/hyperfiddle/incseq/fixed_impl.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.incseq.fixed-impl
2 | (:require [hyperfiddle.incseq.arrays-impl :as a])
3 | (:import #?(:clj (clojure.lang IFn IDeref))))
4 |
5 | (def slot-notifier 0)
6 | (def slot-terminator 1)
7 | (def slot-processes 2)
8 | (def slot-ready 3)
9 | (def slot-push 4)
10 | (def slot-live 5)
11 | (def slot-value 6)
12 | (def slot-results 7)
13 | (def slots 8)
14 |
15 | (deftype EmptySeq [t]
16 | IFn
17 | (#?(:clj invoke :cljs -invoke) [_])
18 | IDeref
19 | (#?(:clj deref :cljs -deref) [_]
20 | (t) {:grow 0
21 | :shrink 0
22 | :degree 0
23 | :permutation {}
24 | :change {}
25 | :freeze #{}}))
26 |
27 | (defn empty-seq [n t]
28 | (n) (->EmptySeq t))
29 |
30 | (defn nop [])
31 |
32 | (defn input-ready [^objects state item]
33 | ((locking state
34 | (let [^objects processes (aget state slot-processes)
35 | ^ints ready (aget state slot-ready)
36 | arity (alength processes)
37 | item (int item)]
38 | (if-some [i (aget state slot-push)]
39 | (do (aset state slot-push (identity (rem (unchecked-inc-int i) arity)))
40 | (aset ready i item) nop)
41 | (do (aset state slot-push (identity (rem 1 arity)))
42 | (if-some [cb (aget state slot-notifier)]
43 | (do (aset ready 0 item) cb)
44 | (loop [item item
45 | i (rem 1 arity)]
46 | (if (neg? item)
47 | (aset state slot-live (dec (aget state slot-live)))
48 | (try @(aget processes item) (catch #?(:clj Throwable :cljs :default) _)))
49 | (let [item (aget ready i)]
50 | (if (== arity item)
51 | (do (aset state slot-push nil)
52 | (if (zero? (aget state slot-live))
53 | (aget state slot-terminator) nop))
54 | (do (aset ready i arity)
55 | (recur item (rem (unchecked-inc-int i) arity)))))))))))))
56 |
57 | (defn item-spawn [^objects state item flow]
58 | (let [^objects results (aget state slot-results)
59 | ^objects processes (aget state slot-processes)
60 | arity (alength processes)]
61 | (aset results item state)
62 | (aset processes item
63 | (flow #(input-ready state item)
64 | #(input-ready state (unchecked-subtract-int item arity)))))
65 | state)
66 |
67 | (defn cancel [^objects state]
68 | (let [^objects processes (aget state slot-processes)]
69 | (dotimes [item (alength processes)] ((aget processes item)))))
70 |
71 | (defn transfer [^objects state]
72 | (let [^objects results (aget state slot-results)
73 | ^objects processes (aget state slot-processes)
74 | ^ints ready (aget state slot-ready)
75 | arity (alength processes)
76 | item (aget ready 0)]
77 | (aset ready 0 arity)
78 | ((locking state
79 | (loop [item item
80 | i (rem 1 arity)]
81 | (if (nil? (aget state slot-notifier))
82 | (if (neg? item)
83 | (aset state slot-live (dec (aget state slot-live)))
84 | (try @(aget processes item) (catch #?(:clj Throwable :cljs :default) _)))
85 | (let [diff (aget state slot-value)]
86 | (aset state slot-value
87 | (if (neg? item)
88 | (do (aset state slot-live (dec (aget state slot-live)))
89 | (update diff :freeze conj (unchecked-add-int arity item)))
90 | (try (let [r @(aget processes item)]
91 | (if (= (aget results item) (aset results item r))
92 | diff (update diff :change assoc item r)))
93 | (catch #?(:clj Throwable :cljs :default) e
94 | (aset state slot-notifier nil)
95 | (cancel state) e))))))
96 | (let [item (aget ready i)]
97 | (if (== arity item)
98 | (do (aset state slot-push nil)
99 | (if (zero? (aget state slot-live))
100 | (aget state slot-terminator) nop))
101 | (do (aset ready i arity)
102 | (recur item (rem (unchecked-inc-int i) arity))))))))
103 | (let [x (aget state slot-value)]
104 | (aset state slot-value
105 | {:grow 0
106 | :shrink 0
107 | :degree arity
108 | :permutation {}
109 | :change {}
110 | :freeze #{}})
111 | (if (nil? (aget state slot-notifier))
112 | (throw x) x))))
113 |
114 | (deftype Ps [state]
115 | IFn
116 | (#?(:clj invoke :cljs -invoke) [_]
117 | (cancel state))
118 | IDeref
119 | (#?(:clj deref :cljs -deref) [_]
120 | (transfer state)))
121 |
122 | (defn flow
123 | ([] empty-seq)
124 | ([item & items]
125 | (let [items (into [item] items)]
126 | (fn [n t]
127 | (let [state (object-array slots)
128 | arity (count items)
129 | ready (a/int-array arity)]
130 | (dotimes [i arity] (aset ready i arity))
131 | (aset state slot-notifier n)
132 | (aset state slot-terminator t)
133 | (aset state slot-processes (object-array arity))
134 | (aset state slot-ready ready)
135 | (aset state slot-live (identity arity))
136 | (aset state slot-value
137 | {:grow arity
138 | :degree arity
139 | :shrink 0
140 | :permutation {}
141 | :change {}
142 | :freeze #{}})
143 | (aset state slot-results (object-array arity))
144 | (reduce-kv item-spawn state items)
145 | (->Ps state))))))
--------------------------------------------------------------------------------
/src/hyperfiddle/incseq/flow_protocol_enforcer.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.incseq.flow-protocol-enforcer
2 | #?(:clj (:import [clojure.lang IDeref IFn]))
3 | #?(:cljs (:require-macros [hyperfiddle.incseq.flow-protocol-enforcer :refer [cannot-throw]])))
4 |
5 | (defn %violated
6 | ([nm msg] (println nm "flow protocol violation:" msg) #?(:cljs (.error js/console) :clj (prn (Throwable.))))
7 | ([nm msg e]
8 | (println nm "flow protocol violation:" msg)
9 | (#?(:clj prn :cljs js/console.error) e)))
10 |
11 | (defmacro cannot-throw [f nm violated]
12 | `(try (~f) (catch ~(if (:js-globals &env) :default 'Throwable) e#
13 | (~violated ~nm ~(str f " cannot throw") e#))))
14 |
15 | (def diff? (every-pred :grow :degree :shrink :change :permutation :freeze))
16 |
17 | (defn is-array? [v] #?(:clj (-> v class .isArray) :cljs (array? v)))
18 | (defn pretty [v] (cond-> v (is-array? v) vec))
19 |
20 | (defn enforce
21 | ([flow] (enforce {} flow))
22 | ([{nm :name, f :transfer, violated :on-violate :as o :or {violated %violated}} flow]
23 | (fn [step done]
24 | (let [!should-step? (atom ::init), !done? (atom false), !threw? (atom false)
25 | step (fn []
26 | (when @!done? (violated nm "step after done"))
27 | (when @!threw? (violated nm "step after throw"))
28 | (if (first (swap-vals! !should-step? not)) (cannot-throw step nm violated) (violated nm "double step")))
29 | done (fn [] (if (first (reset-vals! !done? true)) (violated nm "done called twice") (cannot-throw done nm violated)))
30 | cancel (try (flow step done)
31 | (catch #?(:clj Throwable :cljs :default) e (violated nm "flow process creation threw" e)))
32 | check-transfer (if f
33 | (fn [t v]
34 | (when (and (= :ok t) (not (f v)))
35 | (violated nm (str "transferred value doesn't satisfy " f ": " (pretty v)))))
36 | (fn [_ _]))]
37 | (when (and (:initialized o) (= ::init @!should-step?)) (violated nm "missing initial step"))
38 | (reify
39 | IFn (#?(:clj invoke :cljs -invoke) [_] (cannot-throw cancel nm violated))
40 | IDeref (#?(:clj deref :cljs -deref) [_]
41 | (let [should-step (first (swap-vals! !should-step? not))
42 | [t v] (try [:ok @cancel] (catch #?(:clj Throwable :cljs :default) e [:ex e]))]
43 | (check-transfer t v)
44 | (when (= :ex t) (reset! !threw? true))
45 | (when should-step (violated nm "transfer without step" (when (= :ex t) v)))
46 | (when (and (not @!should-step?) (= :ex t)) (violated nm "step in exceptional transfer"))
47 | (if (= :ex t) (throw v) v))))))))
48 |
49 | (defn incseq [nm flow] (enforce {:name nm, :initialized true, :transfer #'diff?} flow))
50 | (defn initialized [nm flow] (enforce {:name nm, :initialized true} flow))
51 | (defn uninitialized [nm flow] (enforce {:name nm} flow))
52 |
--------------------------------------------------------------------------------
/src/hyperfiddle/incseq/mount_impl.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.incseq.mount-impl
2 | (:require [hyperfiddle.incseq.perm-impl :as p]))
3 |
4 | (defn permute-keys [rf r p m]
5 | (reduce-kv (fn [r k v] (rf r (p k k) v)) r m))
6 |
7 | (defn mount [append-child replace-child insert-before remove-child nth-child]
8 | (letfn [(append [element degree grow permutation change]
9 | (let [q (p/inverse permutation)]
10 | (loop [i (- degree grow)
11 | c change
12 | p permutation]
13 | (if (== i degree)
14 | (do (permute-keys replace element p c)
15 | (p/rotations rotate element p))
16 | (let [j (q i i)
17 | e (c j)]
18 | (recur (inc i) (dissoc c j)
19 | (if (< j i)
20 | (do (insert-before element e (nth-child element j))
21 | (p/compose p (p/rotation j i)))
22 | (do (append-child element e) p))))))))
23 | (replace [element i e]
24 | (replace-child element e (nth-child element i)))
25 | (rotate [element i j]
26 | (insert-before element (nth-child element i)
27 | (nth-child element (if (< i j) (inc j) j)))
28 | element)]
29 | (fn [element {:keys [grow shrink degree permutation change]}]
30 | (let [size-after (- degree shrink)]
31 | (loop [d degree
32 | p permutation]
33 | (if (== d size-after)
34 | (append element d grow p change)
35 | (let [i (dec d)
36 | j (p i i)]
37 | (remove-child element (nth-child element j))
38 | (recur i (p/compose p (p/rotation i j))))))))))
--------------------------------------------------------------------------------
/src/hyperfiddle/incseq/perm_impl.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.incseq.perm-impl
2 | (:refer-clojure :exclude [cycle])
3 | (:require [clojure.set]))
4 |
5 | (def inverse clojure.set/map-invert)
6 |
7 | (defn transposition [i j]
8 | {i j, j i})
9 |
10 | (defn cycle
11 | ([xs]
12 | (let [n (count xs)
13 | f (nth xs 0)]
14 | (loop [j f
15 | i 1
16 | p (transient {})]
17 | (let [k (nth xs i)
18 | i (unchecked-inc i)
19 | p (assoc! p j k)]
20 | (if (< i n)
21 | (recur k i p)
22 | (persistent! (assoc! p k f))))))))
23 |
24 | (defn rotation [i j]
25 | (case (compare i j)
26 | -1 (cycle (range i (inc j) +1))
27 | 0 {}
28 | +1 (cycle (range i (dec j) -1))))
29 |
30 | (defn split-swap [i l r]
31 | (let [l (int l)
32 | r (int r)]
33 | (case l
34 | 0 {}
35 | (case r
36 | 0 {}
37 | (let [j (unchecked-add-int i l)
38 | k (unchecked-add-int j r)]
39 | (zipmap (range i k)
40 | (concat (range j k)
41 | (range i j))))))))
42 |
43 | (defn arrange [v p]
44 | (persistent!
45 | (reduce-kv
46 | (fn [r i j]
47 | (assoc! r i (nth v j)))
48 | (transient v) p)))
49 |
50 | (defn decompose [rf r p]
51 | (loop [p p
52 | r r]
53 | (case p
54 | {} r
55 | (let [[i j] (first p)]
56 | (let [c (loop [c [i]
57 | j j]
58 | (let [c (conj c j)
59 | j (p j)]
60 | (if (== i j)
61 | c (recur c j))))
62 | r (rf r c)]
63 | (if (reduced? r)
64 | @r (recur (apply dissoc p c) r)))))))
65 |
66 | (defn compose
67 | ([] {})
68 | ([x] x)
69 | ([x y]
70 | (reduce-kv
71 | (fn [r i j]
72 | (let [k (y j j)]
73 | (if (== i k)
74 | (dissoc r i)
75 | (assoc r i k))))
76 | y x))
77 | ([x y & zs]
78 | (reduce compose (compose x y) zs)))
79 |
80 | (defn order [p]
81 | (loop [o 1, q p]
82 | (case q
83 | {} o
84 | (recur (unchecked-inc o)
85 | (compose p q)))))
86 |
87 | (defn involution? [p]
88 | (and (not= {} p) (= {} (compose p p))))
89 |
90 | (defn transposition? [p]
91 | (= 2 (count p)))
92 |
93 | (defn recompose [cycles]
94 | (->> cycles
95 | (eduction (map cycle))
96 | (reduce compose (compose))))
97 |
98 | (defn split-long-swap [o l c r]
99 | (->> (range o (+ o (min l r)))
100 | (eduction (map (fn [i] (transposition i (+ l c i)))))
101 | (reduce compose {})
102 | (compose
103 | (case (compare l r)
104 | -1 (split-swap (+ o l) (+ l c) (- r l))
105 | 0 {}
106 | +1 (split-swap (+ o r) (- l r) (+ c r))))))
107 |
108 | (defn cycle-transpositions [rf r cycle]
109 | (loop [r r
110 | i (unchecked-dec-int (count cycle))]
111 | (if (zero? i)
112 | r (let [x (cycle 0)
113 | y (cycle i)
114 | r (if (< x y)
115 | (rf r x y)
116 | (rf r y x))]
117 | (if (reduced? r)
118 | @r (recur r (unchecked-dec-int i)))))))
119 |
120 | (defn transpositions [rf r p]
121 | (decompose (partial cycle-transpositions rf) r p))
122 |
123 | (defn transposition-rotations [rf r i j]
124 | (let [k (dec j)
125 | r (rf r i j)]
126 | (if (reduced? r)
127 | @r (if (== k i)
128 | r (unreduced
129 | (rf r k i))))))
130 |
131 | ;; TODO generate optimal sequence if possible
132 | (defn rotations [rf r p]
133 | (decompose
134 | (->> rf
135 | (partial transposition-rotations)
136 | (partial cycle-transpositions))
137 | r p))
--------------------------------------------------------------------------------
/src/hyperfiddle/input_zoo0.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.input-zoo0
2 | (:require clojure.string
3 | [hyperfiddle.electric3 :as e]
4 | [hyperfiddle.electric-dom3 :as dom]))
5 |
6 | ;; Crude uncontrolled inputs, rarely useful
7 |
8 | (e/defn Input* [& {:keys [maxlength type parse] :as props
9 | :or {maxlength 100 type "text" parse identity}}]
10 | (e/client ; explicit site on all controls for compat with neutral callers
11 | (dom/input (dom/props (-> props (dissoc :parse)
12 | (assoc :maxLength maxlength :type type)))
13 | (dom/On "input" #(-> % .-target .-value (subs 0 maxlength) parse) ""))))
14 |
15 | (e/defn Checkbox* [& {:keys [id label parse] :as props
16 | :or {id (random-uuid) parse identity}}]
17 | (e/client
18 | (e/amb
19 | (dom/input (dom/props {:type "checkbox", :id id})
20 | (dom/props (dissoc props :id :label :parse))
21 | (dom/On "change" #(-> % .-target .-checked parse) false))
22 | (e/When label (dom/label (dom/props {:for id}) (dom/text label))))))
23 |
24 | (e/defn InputSubmitCreate!
25 | "optimistic, cancel & retry are forwarded to optimistic list item's InputSubmit!
26 | buffers (dirty), commit, discard bundled as enter/esc"
27 | [& {:keys [maxlength type parse] :as props
28 | :or {maxlength 100 type "text" parse identity}}]
29 | (e/client
30 | (dom/input (dom/props (-> props (dissoc :parse) (assoc :maxLength maxlength :type type)))
31 | (letfn [(read! [node] (not-empty (subs (.-value node) 0 maxlength)))
32 | (read-clear! [node] (when-some [v (read! node)] (set! (.-value node) "") v))
33 | (submit! [e] (let [k (.-key e)]
34 | (cond
35 | (= "Enter" k) (parse (read-clear! (.-target e)))
36 | (= "Escape" k) (do (set! (.-value dom/node) "") nil)
37 | () nil)))]
38 | #_(PendingMonitor) ; the optimistic list item is responsible for pending/retry affordances
39 | (dom/On-all "keydown" submit!)))))
40 |
41 | (e/defn InputSubmitCreate?!
42 | "transactional chat input with busy state. Supports rapid submit, sending
43 | concurrent in-flight submits to the server which race. ?! marks this control
44 | as an anti-pattern because it has no error handling: rejected edits are silently
45 | lost. Fixing this requires form semantics, see upcoming tutorial."
46 | [& {:keys [maxlength type parse] :as props
47 | :or {maxlength 100 type "text" parse identity}}]
48 | (e/client
49 | (dom/input (dom/props (-> props (dissoc :parse) (assoc :maxLength maxlength :type type)))
50 | (letfn [(read! [node] (not-empty (subs (.-value node) 0 maxlength)))
51 | (read-clear! [node] (when-some [v (read! node)] (set! (.-value node) "") v))
52 | (submit! [e] (let [k (.-key e)]
53 | (cond
54 | (= "Enter" k) (parse (read-clear! (.-target e)))
55 | (= "Escape" k) (do (set! (.-value dom/node) "") nil)
56 | () nil)))]
57 | (let [edits (dom/On-all "keydown" submit!)] ; concurrent pending submits
58 | (dom/props {:aria-busy (pos? (e/Count edits))})
59 | edits)))))
--------------------------------------------------------------------------------
/src/hyperfiddle/kvs.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.kvs)
2 |
3 | (defprotocol KVS
4 | (insert! [_ k v])
5 | (update! [_ k f])
6 | (remove! [_ k]))
--------------------------------------------------------------------------------
/src/hyperfiddle/token_zoo0.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.token-zoo0
2 | ; mirror bootstrap structure of electric3 for copy/paste
3 | (:require [hyperfiddle.electric3 :as e]))
4 |
5 | (let [->token (fn [!t]
6 | (fn token
7 | ([] (token nil))
8 | ([ret] (reset! !t nil) ret)))
9 | step (fn [!t v on?] (when (on? v) (compare-and-set! !t nil (->token !t))))]
10 | (hyperfiddle.electric3/defn TokenNofail
11 | ([v] (TokenNofail v some?))
12 | ([v on?] (let [!t (atom nil)]
13 | (step !t v on?)
14 | (e/watch !t)))))
15 |
16 | (let [->spend-fn (fn [!spend!] (fn f ([] (f nil)) ([ret] (reset! !spend! nil) ret)))
17 | step (fn [!spend! _spend! v on?] (when (on? v) (compare-and-set! !spend! nil (->spend-fn !spend!))))]
18 | (hyperfiddle.electric3/defn CyclicToken ; todo retry
19 | ([v] (CyclicToken v some?))
20 | ([v on?] (let [!spend! (atom nil), spend! (e/watch !spend!)] (step !spend! spend! v on?) spend!))))
21 |
22 | (let [->spend-fn (fn [!held] (fn f ([] (f nil)) ([ret] (swap! !held assoc 1 nil) ret)))
23 | step (fn [!held v on?]
24 | (let [[_ spend! :as held] @!held]
25 | (when (and (not spend!) (on? v))
26 | (compare-and-set! !held held [v (->spend-fn !held)]))))]
27 | (hyperfiddle.electric3/defn StampedToken ; todo retry
28 | ([v] (StampedToken v some?))
29 | ([v on?] (let [!held (atom [nil nil])] (step !held v on?) (e/watch !held)))))
30 |
31 | (let [->spend-fn (fn [!held] (fn f ([] (f nil)) ([ret] (swap! !held assoc 1 nil) ret)))
32 | step (fn [!held _held v on?]
33 | (let [[_ next! :as held] @!held]
34 | (when (and (not next!) (on? v))
35 | (compare-and-set! !held held [v (->spend-fn !held)]))))]
36 | (hyperfiddle.electric3/defn StampedCyclicToken ; todo retry
37 | ([v] (StampedCyclicToken v some?))
38 | ([v on?] (let [!held (atom [nil nil]), held (e/watch !held)] (step !held held v on?) held))))
39 |
40 | (letfn [(->unlatch-fn [!latched?] (fn f ([] (f nil)) ([v] (reset! !latched? false) v)))
41 | (->latch-fn [!latched? unlatch!] (fn f ([] (reset! !latched? unlatch!)) ([_] (f))))]
42 | (hyperfiddle.electric3/defn Latchable [v]
43 | (let [!latched? (atom false), unlatch! (->unlatch-fn !latched?)]
44 | [(if (e/watch !latched?) (e/Snapshot v) v) (->latch-fn !latched? unlatch!)])))
45 |
46 | (let [->spend-fn (fn [t !d] (when t (fn t2 ([] (t2 nil)) ([d] (reset! !d d) (t d)))))]
47 | (e/defn WithDataSlot
48 | ([t] (WithDataSlot t nil))
49 | ([t init-v]
50 | (let [!d (atom init-v)]
51 | [(->spend-fn t !d) (e/watch !d)]))))
52 |
--------------------------------------------------------------------------------
/test/cljs/analyzer_testing_auto_alias.cljc:
--------------------------------------------------------------------------------
1 | (ns cljs.analyzer-testing-auto-alias)
2 |
3 | (defmacro auto-aliased [x] `(def ~x))
4 |
--------------------------------------------------------------------------------
/test/contrib/missionary_contrib_test.edn:
--------------------------------------------------------------------------------
1 | ;; FIXME revisit the entire use case/design
2 | (ns contrib.missionary-contrib-test
3 | (:require [clojure.core.async :as a]
4 | [contrib.missionary-core-async :as mc]
5 | [hyperfiddle.electric :as p]
6 | [hyperfiddle.electric-local-def :as l]
7 | [hyperfiddle.rcf :as rcf :refer [tests tap % with]]
8 | [missionary.core :as m])
9 | (:import missionary.Cancelled))
10 |
11 | ;; TODO port to standard lib
12 | (defn chan-write
13 | "Return a task writing `val` onto `chan`. Produces true if
14 | val was succesfully written, false if chan was closed."
15 | [chan val]
16 | (fn [success failure]
17 | (let [cancel-chan (a/chan)]
18 | (a/go (let [[v port] (a/alts! [[chan val] cancel-chan])]
19 | (if (= port cancel-chan)
20 | (failure (Cancelled.))
21 | (success v))))
22 | #(a/close! cancel-chan))))
23 |
24 | ;; TODO port to standard lib
25 | (defn onto-chan
26 | "Transfer values from flow to chan. Produces a flow of values that couldn't
27 | be transfered onto chan."
28 | [flow chan]
29 | (m/ap (let [val (m/?> flow)] ; for each successive values of `flow`
30 | (if-not (m/? (chan-write chan val)) ; try to write it onto chan
31 | val ; if write failed, emit val
32 | (m/amb) ; emit nothing
33 | ))))
34 |
35 | ;; These tests are CLJ only. These tests could be made to pass in JS but added
36 | ;; value is low as constraints are external to the domain. m/? is not defined
37 | ;; outside of sp/ap/cp in JS and we rely on future and Thread/sleep.
38 | #?(:clj
39 | (tests
40 | "Read a value from a channel"
41 | (let [c (a/chan)
42 | t (mc/chan-read! c)]
43 | (a/put! c 1)
44 | (m/? t) := 1)))
45 |
46 | #?(:clj
47 | (tests
48 | "Reading a value from a channel blocks until a value is available."
49 | (let [c (a/chan)
50 | t (mc/chan-read! c)]
51 | (future (tap (m/? t))) ; don't block main (repl) thread
52 | (a/put! c 1)
53 | % := 1)))
54 |
55 | #?(:clj
56 | (tests
57 | "Write a value to a channel"
58 | (let [c (a/chan)
59 | t (chan-write c 1)]
60 | (a/take! c tap)
61 | (m/? t) := true
62 | % := 1)))
63 |
64 | #?(:clj
65 | (tests
66 | "Writing a value to a channel blocks if the channel is full."
67 | (let [c (a/chan)
68 | t (chan-write c 2)]
69 | (a/put! c 1) := true
70 | (Thread/sleep 100)
71 | (future (m/? t) := true)
72 | (Thread/sleep 100)
73 | (a/take! c tap)
74 | (a/take! c tap)
75 | % := 1
76 | % := 2)))
77 |
78 | #?(:clj
79 | (tests
80 | "Turn a channel into a discrete flow"
81 | (let [c (a/chan)
82 | f (mc/chan->ap c)
83 | it (f #(tap :ready) #(tap :done))]
84 | (a/put! c 1)
85 | ;; chan-read rely on a go block, which will run its body in another thread.
86 | ;; We can not assume flow is immediately ready. Hence we await for :ready with %
87 | % := :ready
88 | @it := 1)))
89 |
90 | #?(:clj
91 | (tests
92 | "Put values of a flow onto a channel, and read it back as a flow."
93 | (def c (a/chan))
94 | (future (tap (m/? (m/reduce conj ; just run the flow until it terminates
95 | (m/ap (m/amb= (m/?> (onto-chan (m/seed [1 2]) c))
96 | (m/?> (mc/chan->ap c))))))))
97 | (a/close! c)
98 | % := [1 2]))
99 |
100 | #?(:clj
101 | (tests
102 | "When transferring values from a discrete flow to a channel, values are not lost if the channel is closed."
103 | (def input (a/chan))
104 | (def c (a/chan))
105 | (future (m/? (m/reduce {} nil ; just run the flow until it terminates
106 | (m/ap (m/amb= (tap [:success (m/?> (mc/chan->ap c))])
107 | (tap [:failure (m/?> (onto-chan (mc/chan->ap input) c))]))))))
108 | (a/>!! input 1) ; put 1 on input, which transfers to a flow, then is put onto c.
109 | (Thread/sleep 100) ; even if >!! is blocking, go blocks might race with the next instruction
110 | (a/close! c)
111 | (a/>!! input 2) ; put 2 on input, which will be put onto c, but c is closed.
112 | % := [:success 1] ; c got 1
113 | % := [:failure 2] ; onto-chan failed to write 2 on c and returned it.
114 | ))
115 |
116 | #?(:clj
117 | (tests
118 | "Using a core.async channel from Electric"
119 | (def c (a/to-chan [1 2 3]))
120 | (with (l/run (tap (mc/use-channel c)))
121 | % := nil
122 | % := 1
123 | % := 2
124 | % := 3)))
125 |
126 | ;; TODO WIP
127 | (comment
128 | #?(:clj
129 | (tests
130 | "Putting values on a channel from Electric"
131 | (def !a (atom 0))
132 | (def c (a/chan))
133 | (with (l/run (tap (new (onto-chan (p/fn [] (p/watch !a)) c))))
134 | (a/go-loop [x (a/ (ts/->ts) (ts/add {:db/id 1, :foo 2}) (ts/->node 1) :foo) := 2
7 | (-> (ts/->ts) (ts/add {:db/id 1, :foo 1}) (ts/add {:db/id 2, :foo 1}) :ave :foo (get 1)) := #{1 2}
8 | ;; (-> (ts/->ts) (ts/add {:db/id 1, :foo 2, :bar 2}) :vea (get 2) (get 1)) := #{:foo :bar}
9 | (-> (ts/->ts) (ts/add {:db/id 1, :foo 2, :bar 2}) (ts/->node 1) (select-keys [:foo :bar :baz])) := {:foo 2, :bar 2}
10 |
11 | (-> (ts/->ts) (ts/add {:db/id '_}) (ts/upd '_ :x (fnil inc 0)) (ts/upd '_ :x (fnil inc 0)) (ts/->node '_) :x) := 2
12 |
13 | (-> (ts/->ts) (ts/add {:db/id 1}) (ts/asc 1 :x 2) (ts/asc 1 :x 2) :ave :x (get 2)) := #{1}
14 | (-> (ts/->ts) (ts/add {:db/id 1}) (ts/asc 1 :x 2 :y 3) :eav (get 1)) := {:db/id 1, :x 2, :y 3}
15 |
16 | (-> (ts/->ts) (ts/add {:db/id 1, :foo 1, :bar 1}) (ts/add {:db/id 2, :foo 1, :bar 1}) (ts/find :foo 1 :bar 1)) := #{1 2}
17 |
18 | (-> (ts/->ts) (ts/add {:db/id 1, :foo 1}) (ts/asc 1 :foo 2) :ave :foo) := {2 #{1}}
19 |
20 | (let [ts (-> (ts/->ts) (ts/add {:db/id 1, :foo 1}) (ts/add {:db/id 2, :foo 2}))]
21 | (count (->> ts :ave :foo vals (reduce into))) := 2
22 | (let [ts (ts/del ts 2)]
23 | (ts/->node ts 2) := nil
24 | (count (->> ts :ave :foo vals (reduce into))) := 1
25 | )))
26 |
--------------------------------------------------------------------------------
/test/hyperfiddle/browser_test_setup.clj:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.browser-test-setup
2 | (:require [cljs.analyzer :as ana]))
3 |
4 | ;; makes sure CI fails when there are undeclared var warnings
5 | ;; useful to test goog requires
6 | (defn blow-up-tests-on-warnings {:shadow.build/stage :compile-prepare} [build-state]
7 | (defmethod ana/error-message :undeclared-var [_warning-type info]
8 | (throw (ex-info (str "undeclared var: " (:prefix info) "/" (:suffix info)) info)))
9 | build-state)
10 |
--------------------------------------------------------------------------------
/test/hyperfiddle/detest/incseq_test.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.detest.incseq-test
2 | (:import #?(:clj [clojure.lang IFn IDeref])
3 | [missionary Cancelled])
4 | (:require [hyperfiddle.detest :as dt]
5 | [hyperfiddle.incseq :as i]
6 | [hyperfiddle.incseq.diff-impl :as d]
7 | [hyperfiddle.incseq.perm-impl :as p]
8 | [clojure.set :as set]
9 | [contrib.assert :as ca]
10 | [contrib.debug :as dbg]
11 | [contrib.data :refer [->box]]
12 | [clojure.test :as t]
13 | [missionary.core :as m]
14 | [hyperfiddle.incseq.flow-protocol-enforcer :as fpe]))
15 |
16 | (defn pick [ngn v]
17 | (if (seq v)
18 | (let [i (dt/roll ngn (count v))]
19 | [(nth v i) (reduce-kv (fn [ac j x] (if (= i j) ac (conj ac x))) [] v)])
20 | v))
21 |
22 | (defn %next-diff [prev-size ngn next-fn]
23 | (let [grow (dt/roll ngn 10), degree (+ prev-size grow)
24 | shrink (dt/roll ngn prev-size), size (- degree shrink)
25 | to-rot (vec (range (max size prev-size) degree))
26 | stay-space (vec (range #_size (min size prev-size)))
27 | perm-vec (loop [to-rot to-rot, stay stay-space, ret []]
28 | (if (seq to-rot)
29 | (let [[i stay] (pick ngn stay), [j to-rot] (pick ngn to-rot)]
30 | (recur to-rot stay (conj ret i j)))
31 | ret))
32 | ;; _ (prn 'perm-vec perm-vec)
33 | perm (if (seq perm-vec) (p/recompose #{perm-vec}) {})
34 | ;; perm (p/rotation (dt/roll ngn degree) (dt/roll ngn degree))
35 | inv (set/map-invert perm)
36 | ;; _ (prn 'inv inv)
37 | change (reduce (fn [m i] #_(prn 'i i (inv i i)) (let [i (inv i i)] (cond-> m (< i size) (assoc i (next-fn ngn)))))
38 | {} (range prev-size (+ prev-size grow)))
39 | ;; _ (prn 'change-grown change)
40 | change (reduce (fn [m i] (cond-> m (zero? (dt/roll ngn 2)) (assoc i (next-fn ngn))))
41 | change (range size))]
42 | {:grow grow :degree degree :shrink shrink :permutation perm :change change :freeze #{}}))
43 |
44 | (defn %rand-incseq [ngn next-incseq-fn]
45 | (cond->> (fn [step done]
46 | (step)
47 | (let [!should-step? (atom false), !v (atom (d/empty-diff 0)), !done? (atom false), !cancelled? (atom false)
48 | ;; !dbg (atom [])
49 | fin #(when-not (first (reset-vals! !done? true)) (done))
50 | proc
51 | (reify
52 | IFn
53 | (#?(:clj invoke :cljs -invoke) [_]
54 | (let [cancelled? (first (reset-vals! !cancelled? true))]
55 | (when (and @!should-step? (not @!done?) (not cancelled?))
56 | (swap! !should-step? not) (step))))
57 | (#?(:clj invoke :cljs -invoke) [this n]
58 | (if @!done?
59 | (dt/del-proc ngn this)
60 | (if (> 1 (mod n 100))
61 | (when @!should-step? (fin))
62 | (when (and @!should-step? (not @!done?)) (swap! !should-step? not) (step)))))
63 | IDeref
64 | (#?(:clj deref :cljs -deref) [_]
65 | (cond
66 | @!done?
67 | (throw (ex-info "transfer after done" {}))
68 |
69 | @!cancelled?
70 | (do (fin) (throw (Cancelled.)))
71 |
72 | @!should-step?
73 | (throw (ex-info "transfer without step" {}))
74 |
75 | :else
76 | (do (swap! !should-step? not)
77 | (if (> 1 (dt/roll ngn 100))
78 | (do (fin) (throw (ex-info "[DETEST OK] random incseq throw" {})))
79 | (do (condp > (dt/roll ngn 100)
80 | 1 (fin)
81 | 25 (do (swap! !should-step? not) (step))
82 | #_else nil)
83 | (swap! !v next-incseq-fn ngn)
84 | #_(let [nx (swap! !v next-incseq-fn ngn)]
85 | (prn 'state (swap! !dbg i/patch-vec nx))
86 | nx)))))))]
87 | (dt/add-proc ngn proc)
88 | proc))
89 | (dt/debug? ngn) (dt/instrument 'rand-incseq ngn)))
90 |
91 | (defn next-diff [prev-diff ngn]
92 | (%next-diff (- (:degree prev-diff) (:shrink prev-diff)) ngn dt/roll))
93 |
94 | (defn rand-incseq [ngn] (%rand-incseq ngn next-diff))
95 |
96 | (defn next-lc-diff [prev-diff ngn]
97 | (%next-diff (- (:degree prev-diff) (:shrink prev-diff)) ngn rand-incseq))
98 |
99 | (defn rand-lc-incseq [ngn] (%rand-incseq ngn next-lc-diff))
100 |
101 | (t/deftest detest-latest-product
102 | (dotimes [_ 20]
103 | (let [ngn (dt/->engine)]
104 | (t/is (nil?
105 | (dt/exercise ngn (i/latest-product vector (rand-incseq ngn) (rand-incseq ngn))))))))
106 |
107 | (t/deftest detest-latest-concat
108 | (dotimes [_ 100]
109 | (let [ngn (dt/->engine)]
110 | (t/is (nil?
111 | (dt/exercise ngn (i/latest-concat (rand-lc-incseq ngn))))))))
112 |
113 | (comment
114 | ;; how to repro and debug print
115 | (let [ngn (dt/->engine {:seed -6858028806708848032, :debug :full})]
116 | (dt/exercise ngn (i/latest-concat (rand-lc-incseq ngn))))
117 | ;; how to minimize when a flow test fails often
118 | (let [ (->box)]
119 | (dotimes [_ 1000]
120 | (let [ngn (dt/->engine {:debug :steps})]
121 | (dt/minimize ngn (i/latest-concat (rand-lc-incseq ngn)))))
122 | ())
123 | )
124 |
125 | (t/deftest detest-fixed
126 | (dotimes [_ 500]
127 | (let [ngn (dt/->engine)]
128 | (t/is (nil?
129 | (dt/exercise ngn (i/fixed (rand-incseq ngn) (rand-incseq ngn) (rand-incseq ngn)
130 | (rand-incseq ngn) (rand-incseq ngn) (rand-incseq ngn)
131 | (rand-incseq ngn) (rand-incseq ngn) (rand-incseq ngn))))))))
132 |
133 | (t/deftest detest-diff-by
134 | (dotimes [_ 1000]
135 | (let [ngn (dt/->engine)]
136 | (t/is (nil?
137 | (dt/exercise ngn (m/reductions i/patch-vec [] (rand-incseq ngn))))))))
138 |
139 | (t/deftest detest-items
140 | (dotimes [_ 500]
141 | (let [ngn (dt/->engine)]
142 | (t/is (nil?
143 | (dt/exercise ngn (i/items (rand-incseq ngn))))))))
144 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/cljs_analyzer2_test.clj:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.cljs-analyzer2-test
2 | (:require [clojure.test :as t]
3 | [cljs.env]
4 | [cljs.analyzer]
5 | [hyperfiddle.electric.impl.cljs-analyzer2 :as ana]))
6 |
7 | (comment
8 | (time (let [!a (atom {})] (ana/analyze-nsT !a {} 'cljs.core)))
9 | (-> @!a ::ana/nses (get 'cljs.core) ::ana/defs count)
10 | )
11 |
12 | (t/deftest ns-expansion
13 | (let [ns$ 'hyperfiddle.electric.impl.cljs-file-to-analyze
14 | !a (ana/->!a)
15 | _ (ana/analyze-nsT !a {} ns$)
16 | a @!a]
17 | (t/is (nil? (ana/find-var a 'non ns$)))
18 | (t/is (nil? (ana/find-var a 'first ns$)))
19 | (t/is (= 'cljs.core/next (::ana/name (ana/find-var a 'nxt ns$))))
20 | (t/are [x] (some? (ana/find-var a x ns$))
21 | 'foo
22 | 'bar
23 | 'baz
24 | 'an-fn
25 | 'behind-require
26 | 'str
27 | 'behind-alias
28 | 'behind-require-macros
29 | 'behind-require-macro-alias
30 | 'behind-required-refer
31 | 'behind-required-rename
32 | 'behind-require-macro-refer
33 | 'behind-require-macro-rename
34 | 'behind-include-macros
35 | 'behind-refer-macros
36 | 'behind-use
37 | 'behind-use-renamed
38 | 'behind-use-macro
39 | 'behind-use-macro-renamed
40 | 'behind-auto-alias
41 | 'behind-auto-alias-alias
42 | 'behind-auto-alias-refer
43 | 'nxt)))
44 |
45 | (t/deftest runtime-vars
46 | (let [ns$ 'hyperfiddle.electric.impl.cljs-file-to-analyze,
47 | !a (ana/->!a)
48 | _ (ana/analyze-nsT !a {} ns$)
49 | a @!a]
50 | (t/are [x] (nil? (ana/find-var a x ns$))
51 | 'hyperfiddle.electric.impl.cljs-file-to-analyze.runtime/only-macro
52 | 'run/only-macro
53 | 'only-macro
54 | 'next) ; renamed in :refer-clojure
55 | (t/are [x] (some? (ana/find-var a x ns$))
56 | 'hyperfiddle.electric.impl.cljs-file-to-analyze.runtime/macro-and-runtime
57 | 'run/macro-and-runtime
58 | 'macro-and-runtime
59 | 'hyperfiddle.electric.impl.cljs-file-to-analyze.runtime/only-runtime
60 | 'run/only-runtime
61 | 'only-runtime)))
62 |
63 | (t/deftest local-shadowing
64 | (let [ns$ 'hyperfiddle.electric.impl.cljs-file-to-analyze
65 | !a (ana/->!a)
66 | _ (ana/analyze-nsT !a {} ns$)
67 | a @!a]
68 | (t/are [x] (nil? (ana/find-var a x ns$))
69 | 'shadowed-by-let
70 | 'shadowed-by-let-destructure
71 | 'shadowed-by-fn
72 | 'shadowed-by-fn-destructure
73 | 'shadowed-by-letfn-fn-name
74 | 'shadowed-by-letfn-other-fn-name
75 | 'shadowed-by-letfn-local)))
76 |
77 | (t/deftest defs-match-official-cljs-analyzer
78 | (let [ns$ 'cljs.analyzer
79 | !a (ana/->!a)
80 | _ (ana/analyze-nsT !a {} ns$)
81 | a @!a
82 | c (cljs.env/ensure
83 | (cljs.analyzer/analyze-file "cljs/core.cljs")
84 | (cljs.analyzer/analyze-file "cljs/analyzer.cljc")
85 | @cljs.env/*compiler*)]
86 | (t/are [ns$] (= (into #{} (keep (fn [[k v]] (when-not (:anonymous v) k)))
87 | (-> c :cljs.analyzer/namespaces (get ns$) :defs))
88 | (set (-> a ::ana/nses (get ns$) ::ana/defs keys)))
89 | 'cljs.core
90 | 'cljs.analyzer)))
91 |
92 | (t/deftest clojure-core-var-found-as-cljs-core-var
93 | (let [ns$ 'cljs.analyzer
94 | !a (ana/->!a)
95 | _ (ana/analyze-nsT !a {} ns$)
96 | a @!a]
97 | (t/is (some? (ana/find-var a 'clojure.core/vector ns$)))))
98 |
99 | (t/deftest non-required-var-can-be-found ; e.g. a macro from another ns might have expanded to it
100 | (let [ns$ 'cljs.source-map
101 | !a (ana/->!a)
102 | _ (ana/analyze-nsT !a {} ns$)
103 | a @!a]
104 | (t/is (some? (ana/find-var a 'cljs.source-map/encode 'cljs.core)))))
105 |
106 | (t/deftest npm-shadow-extension
107 | (let [ns$ 'hyperfiddle.electric.impl.cljs-file-to-analyze
108 | !a (ana/->!a)
109 | _ (ana/analyze-nsT !a {} ns$)
110 | a @!a]
111 | (t/is (boolean (ana/js-call? a 'jslib/foo ns$)))
112 | (t/is (boolean (ana/js-call? a 'js/alert ns$)))
113 | (t/is (boolean (ana/js-call? a 'js-referred ns$)))
114 | (t/is (boolean (ana/js-call? a 'js-renamed ns$)))
115 | (t/is (not (ana/js-call? a 'not-js-referred ns$)))
116 | (t/is (not (ana/js-call? a 'run/only-runtime ns$)))))
117 |
118 | (t/deftest imports
119 | (let [a (ana/add-import (atom {}) 'foo '[Foo [java.util X Y]])]
120 | (t/is (= '{::ana/nses {foo {::ana/imports #{java.util.X X Foo java.util.Y Y}}}} a))
121 | (t/is (some? (ana/imported? a 'X.XXX 'foo)))
122 | (t/is (some? (ana/imported? a 'java.util.X.XXX 'foo)))
123 | (t/is (some? (ana/imported? a 'Foo.Bar 'foo)))))
124 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/cljs_file_to_analyze.cljs:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.cljs-file-to-analyze
2 | "docstring" {:attr :map}
3 | (:require
4 | [hyperfiddle.electric.impl.cljs-file-to-analyze.require :as req :refer [refdef renameme] :rename {renameme renamed}]
5 | [hyperfiddle.electric.impl.cljs-file-to-analyze.include :as inc :include-macros true]
6 | [hyperfiddle.electric.impl.cljs-file-to-analyze.refer-macros :refer-macros [refmac]]
7 | [hyperfiddle.electric.impl.cljs-file-to-analyze.runtime :as run :refer [only-macro only-runtime macro-and-runtime]]
8 | [clojure.analyzer-testing-auto-alias :as auto-alias :refer [auto-aliased]]
9 | ["some-js-lib" :as jslib :refer [js-referred js-to-rename] :rename {js-to-rename js-renamed}])
10 | (:require-macros [hyperfiddle.electric.impl.cljs-file-to-analyze.macro-ns :as reqmac :refer [reqmacrefer reqmacrename] :rename {reqmacrename reqmacrenamed}])
11 | (:use [hyperfiddle.electric.impl.cljs-file-to-analyze.use :only [useme renameme] :rename {renameme use-renamed}])
12 | (:use-macros [hyperfiddle.electric.impl.cljs-file-to-analyze.use-macros :only [useme-mac renameme-mac] :rename {renameme-mac use-renamed-mac}])
13 | (:refer-clojure :exclude [first] :rename {next nxt}))
14 |
15 | (def foo 1)
16 |
17 | (do (def bar 2) (def baz 3))
18 |
19 | (do (defn an-fn []))
20 |
21 | (hyperfiddle.electric.impl.cljs-file-to-analyze.require/macrodef behind-require)
22 | (req/macrodef behind-alias)
23 | (hyperfiddle.electric.impl.cljs-file-to-analyze.macro-ns/reqmacrodef behind-require-macros)
24 | (reqmac/reqmacrodef behind-require-macro-alias)
25 | (refdef behind-required-refer)
26 | (renamed behind-required-rename)
27 | (reqmacrefer behind-require-macro-refer)
28 | (reqmacrenamed behind-require-macro-rename)
29 | (inc/include behind-include-macros)
30 | (refmac behind-refer-macros)
31 | (useme behind-use)
32 | (use-renamed behind-use-renamed)
33 | (useme-mac behind-use-macro)
34 | (use-renamed-mac behind-use-macro-renamed)
35 | (clojure.analyzer-testing-auto-alias/auto-aliased behind-auto-alias)
36 | (auto-alias/auto-aliased behind-auto-alias-alias)
37 | (auto-aliased behind-auto-alias-refer)
38 |
39 | (let [useme inc] (useme shadowed-by-let))
40 | (let [{:keys [useme]} {:useme inc}] (useme shadowed-by-let-destructure))
41 | (fn [useme] (useme shadowed-by-fn))
42 | (fn [{:keys [useme]}] (useme shadowed-by-fn-destructure))
43 | (letfn [(useme [] (useme shadowed-by-letfn-fn-name))
44 | (foooo [] (useme shadowed-by-letfn-other-fn-name))])
45 | (letfn [(foo [useme] (useme shadowed-by-letfn-local))])
46 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/cljs_file_to_analyze/include.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.cljs-file-to-analyze.include)
2 |
3 | (defmacro include [v] `(def ~v))
4 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/cljs_file_to_analyze/macro_ns.clj:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.cljs-file-to-analyze.macro-ns)
2 |
3 | (defmacro reqmacrodef [v] `(def ~v))
4 | (defmacro reqmacrefer [v] `(def ~v))
5 | (defmacro reqmacrename [v] `(def ~v))
6 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/cljs_file_to_analyze/refer_macros.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.cljs-file-to-analyze.refer-macros)
2 |
3 | (defmacro refmac [v] `(def ~v))
4 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/cljs_file_to_analyze/require.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.cljs-file-to-analyze.require
2 | #?(:cljs (:require-macros hyperfiddle.electric.impl.cljs-file-to-analyze.require)))
3 |
4 | (defmacro macrodef [sym] `(def ~sym))
5 | (defmacro refdef [sym] `(def ~sym))
6 | (defmacro renameme [sym] `(def ~sym))
7 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/cljs_file_to_analyze/runtime.clj:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.cljs-file-to-analyze.runtime)
2 |
3 | (defmacro only-macro [])
4 | (defmacro macro-and-runtime [])
5 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/cljs_file_to_analyze/runtime.cljs:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.cljs-file-to-analyze.runtime
2 | (:require-macros hyperfiddle.electric.impl.cljs-file-to-analyze.runtime))
3 |
4 | (defn macro-and-runtime [])
5 | (defn only-runtime [])
6 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/cljs_file_to_analyze/use.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.cljs-file-to-analyze.use)
2 |
3 | (defmacro useme [x] `(def ~x))
4 | (defmacro renameme [x] `(def ~x))
5 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/cljs_file_to_analyze/use_macros.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.cljs-file-to-analyze.use-macros)
2 |
3 | (defmacro useme-mac [x] `(def ~x))
4 | (defmacro renameme-mac [x] `(def ~x))
5 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/compiler_test_clj.clj:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.compiler-test-clj)
2 |
3 | (def cannot-be-unsited)
4 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/compiler_test_cljs.cljs:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.compiler-test-cljs)
2 |
3 | (def cannot-be-unsited)
4 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/expand_macro.clj:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.expand-macro)
2 |
3 | (defmacro twice [x] `[~x ~x])
4 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/expand_require_referred.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.expand-require-referred
2 | #?(:cljs (:require-macros hyperfiddle.electric.impl.expand-require-referred)))
3 |
4 | (defmacro referred [] :referred)
5 |
6 | (defn referred-fn [])
7 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/expand_unloaded.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.expand-unloaded)
2 |
--------------------------------------------------------------------------------
/test/hyperfiddle/electric/impl/mount_point_test.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.electric.impl.mount-point-test
2 | (:require [hyperfiddle.incseq :as i]
3 | [hyperfiddle.incseq.diff-impl :as d]
4 | [missionary.core :as m]
5 | [hyperfiddle.kvs :as kvs]
6 | [hyperfiddle.electric.impl.runtime3 :as r]
7 | [hyperfiddle.electric.impl.mount-point :as mp]
8 | [clojure.test :refer [deftest is]])
9 | (:import #?(:clj (java.util LinkedList))
10 | missionary.Cancelled))
11 |
12 | (defn frame [peer slot rank & tags]
13 | (let [tags-array (object-array (count tags))
14 | frame (r/->Frame peer slot rank nil nil nil tags-array nil)]
15 | (reduce (fn [i tag]
16 | (when tag
17 | (aset tags-array i
18 | (r/create-call
19 | (r/->Slot frame i)
20 | :client (r/effect tag))))
21 | (inc i)) 0 tags) frame))
22 |
23 | (defn queue []
24 | #?(:clj (let [q (LinkedList.)]
25 | (fn
26 | ([] (.remove q))
27 | ([x] (.add q x) nil)))
28 | :cljs (let [q (make-array 0)]
29 | (fn
30 | ([]
31 | (when (zero? (alength q))
32 | (throw (js/Error. "No such element.")))
33 | (.shift q))
34 | ([x] (.push q x) nil)))))
35 |
36 | (deftest sibling-tags
37 | (let [q (queue)
38 | _ (r/make-peer :client {} nil
39 | {:root (fn ([] {0 (r/ctor :root 0)})
40 | ([idx]
41 | (case idx
42 | 0 (r/cdef 0 [] [nil nil nil] nil (fn [frame] (q frame) (r/pure nil))))))}
43 | :root nil)
44 | f (q)
45 | mp (doto (mp/create (r/frame-peer f))
46 | (kvs/insert! (r/tag f 0) :foo)
47 | (kvs/insert! (r/tag f 1) :bar)
48 | (kvs/insert! (r/tag f 2) :baz))
49 | ps (mp #(q :step) #(q :done))]
50 | (is (= (q) :step))
51 | (is (= @ps {:grow 3
52 | :degree 3
53 | :shrink 0
54 | :permutation {}
55 | :change {0 :foo, 1 :bar, 2 :baz}
56 | :freeze #{}}))
57 | (kvs/update! mp (r/tag f 1) (constantly :BAR))
58 | (is (= (q) :step))
59 | (kvs/remove! mp (r/tag f 0))
60 | (is (= @ps {:grow 0
61 | :degree 3
62 | :shrink 1
63 | :permutation {0 1, 1 2, 2 0}
64 | :change {0 :BAR}
65 | :freeze #{}}))
66 | (kvs/remove! mp (r/tag f 1))
67 | (is (= (q) :step))
68 | (kvs/remove! mp (r/tag f 2))
69 | (is (= @ps {:grow 0
70 | :degree 2
71 | :shrink 2
72 | :permutation {}
73 | :change {}
74 | :freeze #{}}))
75 | (ps)
76 | (is (= (q) :step))
77 | (is (thrown? Cancelled @ps))
78 | (is (= (q) :done))))
79 |
80 | (deftest sibling-tags-insert-after-read
81 | (let [q (queue)
82 | _ (r/make-peer :client {} nil
83 | {:root (fn ([] {0 (r/ctor :root 0)})
84 | ([idx]
85 | (case idx
86 | 0 (r/cdef 0 [] [nil nil] nil (fn [frame] (q frame) (r/pure nil))))))}
87 | :root nil)
88 | f (q)
89 | mp (mp/create (r/frame-peer f))
90 | ps (mp #(q :step) #(q :done))]
91 | (is (= (q) :step))
92 | (is (= @ps (d/empty-diff 0)))
93 | (kvs/insert! mp (r/tag f 0) :foo)
94 | (kvs/insert! mp (r/tag f 1) :bar)
95 | (is (= (q) :step))
96 | (is (= @ps {:grow 2
97 | :degree 2
98 | :shrink 0
99 | :permutation {}
100 | :change {0 :foo
101 | 1 :bar}
102 | :freeze #{}}))))
103 |
104 | (deftest cousin-tags-insert-after-read
105 | (let [q (queue)
106 | _ ((m/reduce (constantly nil)
107 | (r/peer-root
108 | (r/make-peer :client {} nil
109 | {:root (fn ([] {0 (r/ctor :root 0)})
110 | ([idx]
111 | (case idx
112 | 0 (r/cdef 0 [] [nil] nil
113 | (fn [frame]
114 | (q frame)
115 | (r/define-call frame 0
116 | (r/effect (m/observe
117 | (fn [!]
118 | (! {:grow 2
119 | :degree 2
120 | :shrink 0
121 | :permutation {}
122 | :change {0 (r/ctor :root 1)
123 | 1 (r/ctor :root 1)}
124 | :freeze #{}})
125 | #(q :dispose)))))
126 | (r/call frame 0)))
127 | 1 (r/cdef 0 [] [nil] nil
128 | (fn [frame]
129 | (q frame)
130 | (r/pure nil))))))}
131 | :root nil))) {} {})
132 | f (q)
133 | f1 (q)
134 | f2 (q)
135 | mp (mp/create (r/frame-peer f))
136 | ps (mp #(q :step) #(q :done))]
137 | (is (= (q) :step))
138 | (is (= @ps (i/empty-diff 0)))
139 | (kvs/insert! mp (r/tag f1 0) :foo)
140 | (kvs/insert! mp (r/tag f2 0) :bar)
141 | (is (= (q) :step))
142 | (is (= @ps {:grow 2
143 | :degree 2
144 | :shrink 0
145 | :permutation {}
146 | :change {1 :bar
147 | 0 :foo}
148 | :freeze #{}}))))
149 |
150 | (deftest add-item-in-parent-frame
151 | (let [q (queue)
152 | _ ((m/reduce {} nil
153 | (r/peer-root
154 | (r/make-peer :client {} nil
155 | {:root (fn ([] {0 (r/ctor :root 0)})
156 | ([idx]
157 | (case idx
158 | 0 (r/cdef 0 [] [nil nil] nil
159 | (fn [frame]
160 | (q frame)
161 | (r/define-call frame 0
162 | (r/effect (m/observe
163 | (fn [!]
164 | (! {:grow 1
165 | :degree 1
166 | :shrink 0
167 | :permutation {}
168 | :change {0 (r/ctor :root 1)}
169 | :freeze #{}})
170 | #(q :dispose)))))
171 | (r/call frame 0)))
172 | 1 (r/cdef 0 [] [nil] nil
173 | (fn [frame]
174 | (q frame)
175 | (r/pure nil))))))}
176 | :root nil))) q q)
177 | root (q)
178 | child (q)
179 | mp (doto (mp/create (r/frame-peer root))
180 | (kvs/insert! (r/tag root 1) 3)
181 | (kvs/insert! (r/tag child 0) 0))
182 | ps (mp #(q :step) #(q :done))]
183 | (is (= (q) :step))
184 | (is (= @ps {:degree 2, :permutation {}, :grow 2, :shrink 0, :change {0 0, 1 3}, :freeze #{}}))))
--------------------------------------------------------------------------------
/test/hyperfiddle/goog_calls_test3.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.goog-calls-test3
2 | (:require [hyperfiddle.electric3 :as e]
3 | [hyperfiddle.electric.impl.lang3 :as lang]
4 | #?(:cljs [goog.color])
5 | #?(:cljs [goog.math :as gm])
6 | #?(:cljs [goog.string.format])
7 | #?(:cljs [goog.string :refer (format)]))
8 | #?(:cljs (:import [goog Uri]
9 | [goog.events EventType])))
10 |
11 | (e/defn Main []
12 | (e/client
13 | (list
14 | (goog.color/hslToHex 0.5 0.5 0.5)
15 | (Uri. "http://example.com")
16 | EventType.CLICK
17 | goog.events.EventType.CLICK
18 | (gm/clamp -1 0 5)
19 | (format "%4d" 12)
20 | (js/matchMedia (e/watch (atom "(max-width: 600px)"))))))
21 |
--------------------------------------------------------------------------------
/test/hyperfiddle/incseq/diff_impl_test.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.incseq.diff-impl-test
2 | (:require [hyperfiddle.incseq.diff-impl :as d]
3 | [hyperfiddle.incseq.perm-impl :as p]
4 | [hyperfiddle.incseq :as i]
5 | [clojure.test :refer [deftest is]]
6 | [clojure.test.check :as tc]
7 | [clojure.test.check.properties :as tc-prop]
8 | [clojure.test.check.generators :as tc-gen]
9 | [clojure.test.check.clojure-test :as tct]))
10 |
11 | (deftest combine-simple
12 | (is (= (d/combine
13 | {:grow 1
14 | :degree 1
15 | :shrink 0
16 | :permutation {}
17 | :change {0 :a}
18 | :freeze #{}}
19 | {:grow 0
20 | :degree 1
21 | :shrink 1
22 | :permutation {}
23 | :change {}
24 | :freeze #{}})
25 | {:grow 0
26 | :degree 0
27 | :shrink 0
28 | :permutation {}
29 | :change {}
30 | :freeze #{}}))
31 | (is (= (d/combine
32 | {:grow 1
33 | :degree 4
34 | :shrink 2
35 | :permutation (p/rotation 3 1)
36 | :change {1 :e}
37 | :freeze #{}}
38 | {:grow 2
39 | :degree 4
40 | :shrink 1
41 | :permutation (p/rotation 1 3)
42 | :change {0 :f 1 :g 2 :h}
43 | :freeze #{}})
44 | {:grow 2
45 | :degree 5
46 | :shrink 2
47 | :permutation (p/compose (p/transposition 2 4) (p/transposition 1 3))
48 | :change {0 :f, 1 :g, 2 :h}
49 | :freeze #{}})))
50 |
51 | (deftest combine-grow-dont-move
52 | (is (= (d/combine
53 | {:grow 2
54 | :degree 2
55 | :shrink 0
56 | :permutation {}
57 | :change {0 :x1, 1 :y1}
58 | :freeze #{}}
59 | {:grow 3
60 | :shrink 0
61 | :degree 5
62 | :permutation {0 2, 1 3, 2 4, 3 0, 4 1}
63 | :change {0 :x0, 1 :y0, 2 :z0}
64 | :freeze #{}})
65 | {:grow 5
66 | :degree 5
67 | :shrink 0
68 | :permutation {}
69 | :change {3 :x1, 4 :y1, 0 :x0, 1 :y0, 2 :z0}
70 | :freeze #{}})))
71 |
72 | (deftest grow-permutation-simplifies
73 | (is (= (d/combine ;; [:z] -> [:z] -> [:x :y :z]
74 | {:degree 1, :permutation {}, :grow 0, :shrink 0, :change {}, :freeze #{}} ; [:z]
75 | {:grow 2, :shrink 0, :degree 3, :permutation {0 1, 1 2, 2 0}, :change {0 :x, 1 :y}, :freeze #{}})
76 | {:degree 3, :permutation {2 0, 0 2}, :grow 2, :shrink 0, :change {0 :x, 1 :y}, :freeze #{}})))
77 |
78 | (deftest shrink-permutation-simplifies
79 | (is (= (d/combine ;; [:w :x :y :z] -> [:w :x :y :z] -> [:z]
80 | {:degree 4, :grow 0, :shrink 0, :permutation {}, :change {}, :freeze #{}}
81 | {:degree 4, :grow 0, :shrink 3, :permutation {1 0, 2 1, 3 2, 0 3}, :change {}, :freeze #{}})
82 | {:degree 4, :permutation {0 3, 3 0}, :grow 0, :shrink 3, :change {}, :freeze #{}})))
83 |
84 | (def patch-vecing-differ-result-returns-same-vector
85 | (tc-prop/for-all [a (tc-gen/fmap vec (tc-gen/set tc-gen/small-integer))
86 | b (tc-gen/fmap vec (tc-gen/set tc-gen/small-integer))]
87 | (let [a (into [] (distinct) a), b (into [] (distinct) b)
88 | diff-seq (i/->seq-differ identity)]
89 | (= b (d/patch-vec a (do (diff-seq a) (diff-seq b)))))))
90 |
91 | (tct/defspec patch-vecing-differ-result-returns-same-vector-spec 100 patch-vecing-differ-result-returns-same-vector)
92 |
93 | (def d-combine
94 | (tc-prop/for-all [a (tc-gen/fmap vec (tc-gen/set tc-gen/small-integer))
95 | b (tc-gen/fmap vec (tc-gen/set tc-gen/small-integer))
96 | c (tc-gen/fmap vec (tc-gen/set tc-gen/small-integer))]
97 | (let [a (into [] (distinct) a), b (into [] (distinct) b), c (into [] (distinct) c)
98 | diff-seq (i/->seq-differ identity)
99 | _ (diff-seq a), a->b (diff-seq b), b->c (diff-seq c)]
100 | (= c (d/patch-vec a (d/combine a->b b->c))))))
101 |
102 | (tct/defspec d-combine-spec 100 d-combine)
103 |
--------------------------------------------------------------------------------
/test/hyperfiddle/incseq/fixed_impl_test.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.incseq.fixed-impl-test
2 | (:require [hyperfiddle.incseq.fixed-impl :refer [flow]]
3 | [clojure.test :refer [deftest is]])
4 | #?(:clj (:import [clojure.lang IFn IDeref])))
5 |
6 | (defn queue []
7 | #?(:clj (let [q (java.util.LinkedList.)]
8 | (fn
9 | ([] (.remove q))
10 | ([x] (.add q x) nil)))
11 | :cljs (let [q (make-array 0)]
12 | (fn
13 | ([]
14 | (when (zero? (alength q))
15 | (throw (js/Error. "No such element.")))
16 | (.shift q))
17 | ([x] (.push q x) nil)))))
18 |
19 | (deftype Ps [cancel transfer]
20 | IFn
21 | (#?(:clj invoke :cljs -invoke) [_]
22 | (cancel))
23 | IDeref
24 | (#?(:clj deref :cljs -deref) [_]
25 | (transfer)))
26 |
27 | (deftest zero
28 | (let [q (queue)
29 | ps ((flow) #(q :step) #(q :done))]
30 | (is (= (q) :step))
31 | @ps := {:grow 0
32 | :degree 0
33 | :shrink 0
34 | :permutation {}
35 | :change {}
36 | :freeze #{}}))
37 |
38 | (deftest one
39 | (let [q (queue)
40 | ps ((flow (fn [n t] (q n) (n) (->Ps #(q :cancel) q)))
41 | #(q :step) #(q :done))
42 | n (q)]
43 | (q) := :step
44 | (q 0)
45 | @ps := {:grow 1, :degree 1, :shrink 0, :permutation {}, :change {0 0}, :freeze #{}}
46 | (n)
47 | (q) := :step
48 | (q 1)
49 | @ps := {:grow 0, :shrink 0, :degree 1, :permutation {}, :change {0 1}, :freeze #{}}))
50 |
51 | (deftest two
52 | (let [q (queue)
53 | ps ((flow
54 | (fn [n t] (q n) (->Ps #(q :cancel) q))
55 | (fn [n t] (q n) (->Ps #(q :cancel) q)))
56 | #(q :step) #(q :done))
57 | n1 (q)
58 | n2 (q)]
59 | (n1)
60 | (q) := :step
61 | (n2)
62 | (q 0)
63 | (q :a)
64 | @ps := {:grow 2
65 | :degree 2
66 | :shrink 0
67 | :permutation {}
68 | :change {0 0, 1 :a}
69 | :freeze #{}}
70 | (n1)
71 | (q) := :step
72 | (n2)
73 | (q 1)
74 | (q :b)
75 | @ps := {:grow 0
76 | :degree 2
77 | :shrink 0
78 | :permutation {}
79 | :change {0 1, 1 :b}
80 | :freeze #{}}))
81 |
--------------------------------------------------------------------------------
/test/hyperfiddle/incseq/items_impl_test.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.incseq.items-impl-test
2 | (:require [hyperfiddle.incseq.diff-impl :as d]
3 | [hyperfiddle.incseq.items-impl :as ii]
4 | [clojure.test :as t])
5 | (:import #?(:clj [clojure.lang IFn IDeref])
6 | [missionary Cancelled]))
7 |
8 | (t/deftest basic
9 | (let [q #?(:clj (let [q (java.util.LinkedList.)]
10 | (fn
11 | ([] (.remove q))
12 | ([x] (.add q x) nil)))
13 | :cljs (let [q (make-array 0)]
14 | (fn
15 | ([]
16 | (when (zero? (alength q))
17 | (throw (js/Error. "No such element.")))
18 | (.shift q))
19 | ([x] (.push q x) nil))))
20 | ps ((ii/flow (fn [step done]
21 | (q [step done])
22 | (step)
23 | (reify
24 | IFn
25 | (#?(:clj invoke :cljs -invoke) [_]
26 | (q :cancel))
27 | IDeref
28 | (#?(:clj deref :cljs -deref) [_]
29 | (q)))))
30 | #(q :step) #(q :done))
31 | [step done] (q)
32 | _ (t/is (= (q) :step))
33 | _ (q (assoc (d/empty-diff 2)
34 | :change {0 :foo 1 :bar}
35 | :grow 2))
36 | diff @ps
37 | _ (t/is (= (dissoc diff :change)
38 | (assoc (dissoc (d/empty-diff 2) :change)
39 | :freeze #{0 1}
40 | :grow 2)))
41 | [item0 item1] (map (:change diff) [0 1])
42 | ps0 (item0 #(q :step0) #(q :done0))
43 | _ (t/is (= (q) :step0))
44 | _ (t/is (= @ps0 :foo))
45 | ps1 (item1 #(q :step1) #(q :done1))
46 | _ (t/is (= (q) :step1))
47 | _ (step)
48 | _ (t/is (= (hash-set (q) (q)) #{:step :step0}))
49 | _ (q (assoc (d/empty-diff 2)
50 | :permutation {0 1 1 0}
51 | :change {1 :foo 0 :BAR}))
52 | _ (t/is (= @ps (assoc (d/empty-diff 2) :permutation {0 1 1 0})))
53 | _ (t/is (= @ps1 :BAR))
54 | _ (t/is (= @ps0 :foo))
55 | _ (ps0)
56 | _ (t/is (= (q) :step0))
57 | ps0- (item0 #(q :step0-) #(q :done0-))
58 | _ (t/is (= (q) :step0-))
59 | _ (t/is (= nil (try @ps0 (catch Cancelled _))))
60 | _ (t/is (= (q) :done0))
61 | _ (step)
62 | _ (t/is (= (hash-set (q) (q)) #{:step :step1}))
63 | _ (q (assoc (d/empty-diff 2)
64 | :change {1 :FOO}))
65 | _ (t/is (= @ps0- :FOO))
66 | _ (t/is (= nil (try (item1 #(q :step1-) #(q :done1-))
67 | (catch #?(:clj Error :cljs js/Error) _))))
68 | _ (step)
69 | _ (t/is (= (hash-set (q)) #{:step0-}))
70 | _ (q (assoc (d/empty-diff 2)
71 | :freeze #{0 1}))
72 | _ (t/is (= @ps1 :BAR))
73 | _ (t/is (= (q) :done1))
74 | _ (t/is (= @ps0- :FOO))
75 | _ (t/is (= (q) :done0-))
76 | _ (t/is (= @ps (d/empty-diff 2)))
77 | _ (done)
78 | _ (t/is (= (q) :done))]))
79 |
--------------------------------------------------------------------------------
/test/hyperfiddle/incseq/latest_product_impl_test.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.incseq.latest-product-impl-test
2 | (:require [hyperfiddle.incseq.latest-product-impl :refer [flow]]
3 | [clojure.test :refer [deftest is testing]])
4 | #?(:clj (:import (clojure.lang IFn IDeref))))
5 |
6 | (defn queue []
7 | #?(:clj (let [q (java.util.LinkedList.)]
8 | (fn
9 | ([] (.remove q))
10 | ([x] (.add q x) nil)))
11 | :cljs (let [q (make-array 0)]
12 | (fn
13 | ([]
14 | (when (zero? (alength q))
15 | (throw (js/Error. "No such element.")))
16 | (.shift q))
17 | ([x] (.push q x) nil)))))
18 |
19 | (deftype Ps [cancel transfer]
20 | IFn
21 | (#?(:clj invoke :cljs -invoke) [_]
22 | (cancel))
23 | IDeref
24 | (#?(:clj deref :cljs -deref) [_]
25 | (transfer)))
26 |
27 | (deftest large-input
28 | (let [d1 {:grow 32 :degree 32 :shrink 0
29 | :permutation {}
30 | :change (zipmap (range 32) (range 32))
31 | :freeze #{}}
32 | d2 {:grow 1 :degree 33 :shrink 0
33 | :permutation {}
34 | :change {32 32}
35 | :freeze #{}}
36 | q (queue)
37 | ps ((flow identity
38 | (fn [step done]
39 | (q step)
40 | (step)
41 | (->Ps #(q :cancel) q)))
42 | #(q :step) #(q :done))
43 | step (q)]
44 | (is (= (q) :step))
45 | (q d1)
46 | (is (= @ps d1))
47 | (step)
48 | (is (= (q) :step))
49 | (q d2)
50 | (is (= @ps d2))))
--------------------------------------------------------------------------------
/test/hyperfiddle/incseq/mount_impl_test.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.incseq.mount-impl-test
2 | (:require [hyperfiddle.domlike :as d]
3 | [hyperfiddle.incseq.mount-impl :refer [mount]]
4 | [clojure.test :refer [deftest is]]))
5 |
6 | (def mount-items (mount d/append-child d/replace-child d/insert-before d/remove-child d/nth-child))
7 |
8 | (deftest grow-shrink-same
9 | (let [p (d/node)
10 | a (d/node)
11 | b (d/node)]
12 | (d/append-child p a)
13 | (d/append-child p b)
14 | (is (= (d/tree p)
15 | (d/tree (mount-items p
16 | {:grow 2
17 | :degree 4
18 | :shrink 2
19 | :permutation {0 2, 1 3, 2 0, 3 1}
20 | :change {0 a, 1 b}
21 | :freeze #{}}))))))
22 |
23 | (deftest append-unordered
24 | (let [p (d/node)
25 | a (d/node)
26 | b (d/node)]
27 | (= [p [a] [b]]
28 | (d/tree
29 | (mount-items p
30 | {:grow 2
31 | :degree 2
32 | :shrink 0
33 | :permutation {0 1, 1 0}
34 | :change {0 a, 1 b}
35 | :freeze #{}})))))
--------------------------------------------------------------------------------
/test/hyperfiddle/incseq/perm_impl_test.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.incseq.perm-impl-test
2 | (:require [hyperfiddle.incseq.perm-impl :as p]
3 | [clojure.test :refer [deftest is]]))
4 |
5 | (deftest suite
6 | (is (= (p/decompose conj #{} {0 1, 1 4, 2 3, 3 2, 4 0})
7 | #{[0 1 4] [2 3]}))
8 |
9 | (is (= (p/recompose #{[0 1 4] [2 3]})
10 | {0 1, 1 4, 2 3, 3 2, 4 0}))
11 |
12 | (is (= (p/decompose conj #{} (p/inverse {0 1, 1 4, 2 3, 3 2, 4 0}))
13 | #{[1 0 4] [3 2]}))
14 |
15 | (is (= (p/recompose #{[1 0 4] [3 2]})
16 | {0 4, 1 0, 2 3, 3 2, 4 1}))
17 |
18 | (is (= (p/arrange [0 1 2 3 4] {0 1, 1 4, 2 3, 3 2, 4 0})
19 | [1 4 3 2 0]))
20 |
21 | (is (= (p/arrange [:a :b :c :d :e] {0 1, 1 4, 2 3, 3 2, 4 0})
22 | [:b :e :d :c :a]))
23 |
24 | (is (= (p/compose
25 | (p/cycle [1 3 2 4])
26 | (p/cycle [1 4 2 3]))
27 | {}))
28 |
29 | (is (= (p/inverse (p/split-swap 4 2 3))
30 | (p/split-swap 4 3 2)))
31 |
32 | (is (= (p/order {}) 1))
33 |
34 | (is (= (p/order (p/cycle [2 3])) 2))
35 |
36 | (is (= (p/order (p/cycle [2 3 4])) 3))
37 |
38 | (is (= (p/order (p/compose (p/cycle [0 1]) (p/cycle [2 3 4]))) 6))
39 |
40 | (is (= (p/involution? {}) false))
41 |
42 | (is (= (p/involution? (p/cycle [2 3])) true))
43 |
44 | (is (= (p/involution? (p/cycle [2 3 4])) false))
45 |
46 | (is (= (p/transposition? (p/cycle [2 3])) true))
47 |
48 | (is (= (p/transposition? (p/cycle [2 3 4])) false))
49 |
50 | (is (= (p/rotations (fn [r i j] (p/compose (p/rotation i j) r))
51 | {} {0 1, 1 4, 2 3, 3 2, 4 0})
52 | {0 1, 1 4, 2 3, 3 2, 4 0})))
--------------------------------------------------------------------------------
/test/hyperfiddle/js_calls_test3.cljs:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.js-calls-test3
2 | (:require [hyperfiddle.electric-local-def3 :as l]
3 | [hyperfiddle.rcf :as rcf :refer [tests tap % with]]
4 | ["./js_calls_test3" :as call-test]))
5 |
6 | ;;; Goal: confirm Electric and CLJS have the same js function call semantics.
7 |
8 | (call-test/install) ; required for later tests
9 |
10 | ;;; The two tests blocks should be identical in intent and result.
11 |
12 | ;; CLJS
13 | (tests
14 | "js scoped call in cljs"
15 | call-test/scope.fn := call-test/scope.fn
16 | (call-test/scope.fn) := "value"
17 | (.fn call-test/scope) := "value"
18 | (js/hyperfiddle.js_calls_test3.scope.fn) := "value" ; requires `(call-test/install)`
19 | (let [fn (.-fn call-test/scope)]
20 | (undefined? (fn)) := true ; fn lost its `this` context
21 | ((.bind fn call-test/scope)) := "value" ; re-set `this` context to `scope`
22 | ))
23 |
24 | ;; Electric
25 | (tests
26 | "js scoped call in electric"
27 | (with ((l/single {}
28 | (let [fn (.-fn call-test/scope)]
29 | (tap [call-test/scope.fn
30 | (call-test/scope.fn) ; direct access
31 | (.fn call-test/scope) ; two-step access
32 | (js/hyperfiddle.js_calls_test3.scope.fn) ; global access, requires `(call-test/install)`
33 | (undefined? (fn))
34 | ((.bind fn call-test/scope))]))) tap tap)
35 | % := [call-test/scope.fn "value" "value" "value" true "value"]))
36 |
37 |
--------------------------------------------------------------------------------
/test/hyperfiddle/js_calls_test3.js:
--------------------------------------------------------------------------------
1 | // Test that when electric calls scope.fn(), fn is called with `scope` bound as `this`, thus returning `"value"`
2 | // See `js_calls_test3.cljs`
3 |
4 | // How to reproduce from JS console:
5 |
6 | // ```js
7 | // scope.fn(); // => "value"
8 | // var fn = scope.fn;
9 | // fn(); // => undefined
10 |
11 | // fn.bind(scope)(); // => "value
12 | // ```
13 |
14 | export var scope = {
15 | value: "value",
16 | fn: function(){
17 | return this.value;
18 | }
19 | };
20 |
21 | export function install(){
22 | globalThis.hyperfiddle.js_calls_test3.scope = scope;
23 | }
24 |
--------------------------------------------------------------------------------
/test/hyperfiddle/missionary_test.cljc:
--------------------------------------------------------------------------------
1 | (ns hyperfiddle.missionary-test
2 | (:require [missionary.core :as m]
3 | [hyperfiddle.rcf :refer [tests tap % with]])
4 | (:import (missionary Cancelled)))
5 |
6 |
7 | (tests
8 | "flow cancel before transfer"
9 | (def !x (atom 0))
10 | (def >x (m/watch !x))
11 | (def !it (>x (fn [] (tap ::notify))
12 | (fn [] (tap ::terminate))))
13 | % := ::notify
14 | (!it)
15 | @!it :throws Cancelled
16 | % := ::terminate)
17 |
18 | (tests
19 | "pentagram of death - via Kenny Tilton"
20 | (def !aa (atom 1))
21 | (def !a7 (atom 7))
22 | (with
23 | ((m/reactor
24 | (let [client [] (d/client {:server-type :dev-local :storage-dir :mem :system "test"}))
6 | (defn v! [db e a] (d/q '[:find ?v :in $ ?e ?a :where [?e ?a ?v]] (d/db db) e a))
7 | (defn pull! [c e] (d/pull (d/db c) '[*] e))
8 |
9 | (defmacro with-fresh-connection [sym & body]
10 | `(let [client# (->client)
11 | g# (d/create-database client# {:db-name "testing"})
12 | ~sym (d/connect client# {:db-name "testing"})]
13 | (do ~@body)))
14 |
15 | (rcf/tests
16 | "a ref survives even if the entity it refers to gets retracted"
17 | (with-fresh-connection c
18 | (let [txs [[{:db/ident :aref :db/valueType :db.type/ref :db/cardinality :db.cardinality/one}
19 | {:db/ident :bar :db/valueType :db.type/string :db/cardinality :db.cardinality/one}]
20 | [[:db/add "foo" :aref "-2"]
21 | [:db/add "-2" :bar "asdf"]]
22 | [[:db/retractEntity "-2"]]]
23 | ids (apply merge (map (comp :tempids #(d/transact c {:tx-data %})) txs))]
24 | (v! c (ids "foo") :aref) := [[_]])))
25 |
--------------------------------------------------------------------------------
36 |
37 |