diff --git a/.gitattributes b/.gitattributes index f865be5..9551477 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1,3 +1,3 @@ -calcit.cirru -diff linguist-generated +calcit.cirru diff linguist-generated yarn.lock -diff linguist-generated diff --git a/.github/workflows/upload.yaml b/.github/workflows/upload.yaml index f017c3b..8c449c8 100644 --- a/.github/workflows/upload.yaml +++ b/.github/workflows/upload.yaml @@ -20,12 +20,12 @@ jobs: timeout-minutes: 15 steps: - name: Check out repository - uses: actions/checkout@fbc6f3992d24b796d5a048ff273f7fcc4a7b6c09 # v5.1.0 + uses: actions/checkout@v7.0.1 with: persist-credentials: false - name: Set up Node.js - uses: actions/setup-node@249970729cb0ef3589644e2896645e5dc5ba9c38 # v6 + uses: actions/setup-node@v6.5.0 with: node-version: 24 package-manager-cache: false @@ -33,11 +33,10 @@ jobs: - name: Enable Corepack run: | corepack enable - corepack prepare yarn@4.12.0 --activate - yarn --version + corepack prepare yarn@4.18.0 --activate - name: Set up Calcit and Caps - uses: calcit-lang/setup-calcit@ca701be5a471759e442aa053cd100720bbe1f09f # v1.5.0 + uses: calcit-lang/setup-calcit@v1.5.0 with: deps-file: deps.cirru tools: calcit,caps @@ -46,7 +45,7 @@ jobs: - name: Resolve immutable dependencies run: | set -euo pipefail - caps --ci + caps --strict --ci yarn install --immutable caps verify --toolchain @@ -55,10 +54,11 @@ jobs: set -euo pipefail calcit calcit.cirru edit format git diff --exit-code -- calcit.cirru - calcit calcit.cirru --check-only - calcit calcit.cirru --entry server --check-only - calcit calcit.cirru analyze deprecated --summary-only - calcit calcit.cirru --entry server analyze deprecated --summary-only + calcit calcit.cirru --check-only --warn-dyn-method + calcit calcit.cirru --entry server --check-only --warn-dyn-method + calcit calcit.cirru fix --workflow strict --verify --format edn + calcit calcit.cirru test --exclude-tag server-effect --require-match --summary-only + calcit calcit.cirru --entry server test --tag server-effect --require-match --summary-only - name: Select CDN asset path id: asset-path @@ -66,6 +66,7 @@ jobs: CDN_ORIGIN: https://cos-sh.tiye.me PR_NUMBER: ${{ github.event.pull_request.number }} run: | + set -euo pipefail if [[ "$GITHUB_EVENT_NAME" == "pull_request" ]]; then asset_prefix="${GITHUB_REPOSITORY}/pr/${PR_NUMBER}/${GITHUB_RUN_ID}/${GITHUB_RUN_ATTEMPT}/" else @@ -81,9 +82,7 @@ jobs: set -euo pipefail calcit calcit.cirru js yarn vite build --base="$VITE_BASE_URL" - calcit calcit.cirru --entry server ir mkdir -p dist-server - cp js-out/program-ir.cirru dist-server/compact.cirru cp calcit.cirru deps.cirru package.json dist-server/ - name: Check COS credentials @@ -119,11 +118,10 @@ jobs: secret-id: ${{ secrets.COS_SECRET_ID }} secret-key: ${{ secrets.COS_SECRET_KEY }} - - name: Upload web assets id: deploy if: github.event_name == 'push' && github.ref == 'refs/heads/main' - uses: Pendect/action-rsyncer@2554a1e574cf229fb144f23ea5971dbdca8ae8e3 # v1.1.0 + uses: Pendect/action-rsyncer@v1.1.0 env: DEPLOY_KEY: ${{secrets.rsync_private_key}} with: @@ -133,14 +131,10 @@ jobs: src: 'dist/*' dest: 'rsync-user@tiye.me:/web-assets/repo/${{ github.repository }}' - - name: Display status from deploy - if: github.event_name == 'push' && github.ref == 'refs/heads/main' - run: echo "${{ steps.deploy.outputs.status }}" - - name: Upload server script id: deploy-server if: github.event_name == 'push' && github.ref == 'refs/heads/main' - uses: Pendect/action-rsyncer@2554a1e574cf229fb144f23ea5971dbdca8ae8e3 # v1.1.0 + uses: Pendect/action-rsyncer@v1.1.0 env: DEPLOY_KEY: ${{secrets.rsync_private_key}} with: @@ -149,7 +143,3 @@ jobs: ssh_options: '' src: 'dist-server/*' dest: 'rsync-user@tiye.me:/servers/tabletwo/' - - - name: Display status from deploy - if: github.event_name == 'push' && github.ref == 'refs/heads/main' - run: echo "${{ steps.deploy-server.outputs.status }}" diff --git a/.yarnrc.yml b/.yarnrc.yml index 3186f3f..d5c5eb5 100644 --- a/.yarnrc.yml +++ b/.yarnrc.yml @@ -1 +1,3 @@ nodeLinker: node-modules + +npmMinimalAgeGate: 1h diff --git a/README.md b/README.md index b4f1064..2734335 100644 --- a/README.md +++ b/README.md @@ -1,28 +1,96 @@ +# Table Two -Table Two ------- +两人实时协作编辑 Markdown 表格的应用，基于 Calcium Workflow。 -http://repo.topix.im/tabletwo/ +- 应用页面：http://repo.topix.im/tabletwo/ +- 框架：https://github.com/Cumulo/calcium-workflow -The existing web entry and the separate `/servers/tabletwo/` rsync deployment -remain in place. COS migration applies only to the frontend `dist/` assets: -GitHub Actions builds them against `https://cos-sh.tiye.me/TopixIM/tabletwo/` -(`.../pr////` on pull requests), uploads them, and verifies their public URLs. +## 开发与构建 -前端使用 COS Action v1.2.0 的 `public-base-url` 内置校验，不添加重复验证脚本。 -PR 资源隔离到独立运行目录，上传按事件及分支排队；job/上传分别限制为 15/10 分钟。 -保留现有 Yarn 4.12.0 锁文件；Calcit 从 deps.cirru 读取版本，现有 client/server 门禁保留。 -本轮保留 Calcit/procs 0.27.0，不代表已完成 0.28 类型迁移。生产 CDN 前缀与 -`/servers/tabletwo/` 服务端部署路径不变。 -移除误跟踪的过时 `dist-server/package.json`；它仍由原构建步骤从根 manifest 生成， -不会改变服务端打包或部署内容。`dist-server/` 原本已被 gitignore 忽略。 +使用 Node.js 24、Yarn 4.18.0 和 Caps 0.1.1。 +先安装 `deps.cirru :calcit-version` 指定的已发布 Calcit CLI， +`package.json` 中的 `@calcit/procs` 必须与它精确配对。 +模块使用 `deps.cirru` 中的正式 tag，npm 新包安装保留一小时隔离。 -> We need a table for two people. They sit in front of each other, seeing into the eyes, and to compose the same markdown file togather. +```sh +caps --strict --ci +yarn install --immutable +caps verify --toolchain +calcit calcit.cirru --check-only --warn-dyn-method +calcit calcit.cirru --entry server --check-only --warn-dyn-method +calcit calcit.cirru fix --workflow strict --verify --format edn +calcit calcit.cirru test --exclude-tag server-effect --require-match --summary-only --format edn +calcit calcit.cirru --entry server test --tag server-effect --require-match --summary-only --format edn +calcit calcit.cirru js +yarn release-page +``` -### Workflow +`yarn watch-page` 显式监听源码变化。生成的 `js-out/`、`dist/`、 +`dist-server/` 和 `.calcit/` 缓存不提交。 -https://github.com/Cumulo/calcium-workflow +`calcit.cirru` 是结构化程序，修改前先读取当前 CLI 的 mutation contract， +用 query 定位，再通过结构化命令和 revision 守卫写入： -### License +```sh +calcit docs agents --contract +calcit query context app.client/main! --format edn +``` + +`:require` 规则和 `:refer` 名称列表直接使用 Cirru syntax list，不加前导 `[]`。 + +## 类型与运行合同 + +前端以单个 Enum 派发操作，服务端保留原 `op` / `data` envelope； +消息和存储默认使用 Cirru EDN。Recollect 的发布版 codec 还原 patch 的名义值， +开放 wire Map 不直接断言成已验证的业务类型。 + +客户端 store 是 `Ref>>`：离线为 None，连接后为 Some。 +session key 保持 Number；路由、消息、标题、正文、凭据和时间在具体使用处验证。 +成员计数的缺失与 nil 保持空值显示，0 仍显示为 0。 + +组件 props、拖放事件和 storage/time/DOM 等宿主方法具有明确合同。 +渲染与服务端 effect callback 返回 Unit，Reel 未变化的分支同样遵守该合同； +不把 `reset!` 或连接函数的赋值结果当作 Unit，也不在尾 recur 后补 Unit。 +升级已运行的页面时完整刷新，避免保留旧状态或 watcher。 + +Markdown 高亮回调保持 String 输入和输出。Text 导出通过类型化 MapEntry +保留段落 key/value，按 key 排序后验证正文；输出保留标题、分隔符与 Unicode， +写入弹窗前转义 HTML。 + +## 验证 + +语义测试保存在定义的 `:tests` 中，涵盖空值、Unicode、0、访客、 +时间选择、段落和消息顺序、文本导出及错误输入拒绝。 +`server-effect` 测试在 native server entry 下验证 Unit 和进程内状态， +并恢复测试修改的 Reel；共同语义回放复用 Calcit 仓库已有的 +`scripts/run-core-tests.mjs`，比较 native / JS 的原断言与日志。 + +验收还包括双入口完整 strict、严格依赖图、生产构建、 +隔离 WebSocket 与持久化，以及真实浏览器交互。 +测试使用合成数据库和独立服务，不连接生产存储。 +Dynamic / unsafe 数量基线已退役，不以统计预算代替类型和业务语义门槛。 + +## 部署 + +COS 只接收前端 `dist/` 资产。生产前缀为 `TopixIM/tabletwo/`； +PR 前缀包含编号、run 和 attempt，使用 COS Action 的公共 URL 校验。 +上传按事件和分支排队，job / 上传分别限制为 15 / 10 分钟。 + +只有 main 触发原网页与 `/servers/tabletwo/` 的 rsync 部署。 +`dist-server/` 保存 Snapshot 与依赖清单；服务器安装匹配工具和模块后运行： + +```sh +calcit calcit.cirru --entry server +``` + +## 限制 + +- 完整交互及迁移验收尚未完成，局部测试不代表整个应用已可发布。 +- 删除 Confirm 与 Text 弹窗完整内容仍需独立验收。 +- 框架 state、投影和宿主的开放边界仍存在，不宣称全应用已静态化。 +- Highlight.js 保留原 legacy 调用及弃用提示，依赖中仍有旧 require 写法告警。 +- Vite 保留大 chunk 提示，未通过放宽阈值掩盖。 + +## License MIT diff --git a/calcit.cirru b/calcit.cirru index c7f4097..c97b39b 100644 --- a/calcit.cirru +++ b/calcit.cirru @@ -3,13 +3,13 @@ :about "|Machine-generated snapshot. Do not edit directly — changes will be overwritten. Use `calcit query` to inspect and `calcit edit`/`calcit tree` to modify. Run `calcit docs agents --contract` before mutations; use `--full` for first orientation or changed contract digest. Manual edits must follow format and schema conventions, then run `calcit edit format`." :package |app :entries $ {} - :default $ {} (:description |) (:init-fn 'app.client/main!) (:mode :js) (:reload-fn 'app.client/reload!) + :default $ {} (:description |) (:init-fn 'app.client/main!) (:mode :js) (:reload-fn 'app.client/reload!) (:target :browser) :feature-policy $ {} - :modules $ [] |respo.calcit/ |lilac/ |recollect/ |memof/ |respo-ui.calcit/ |ws-edn.calcit/ |cumulo-util.calcit/ |respo-message.calcit/ |cumulo-reel.calcit/ |alerts.calcit/ |bisection-key/ |respo-feather.calcit/ |respo-markdown.calcit/ + :modules $ [] |respo.calcit/ |recollect/ |memof/ |respo-ui.calcit/ |ws-edn.calcit/ |cumulo-util.calcit/ |respo-message.calcit/ |cumulo-reel.calcit/ |alerts.calcit/ |bisection-key/ |respo-feather.calcit/ |respo-markdown.calcit/ :type-slots $ {} - :server $ {} (:description |) (:init-fn 'app.server/main!) (:mode :native) (:reload-fn 'app.server/reload!) + :server $ {} (:description |) (:init-fn 'app.server/main!) (:mode :native) (:reload-fn 'app.server/reload!) (:target :native) :feature-policy $ {} - :modules $ [] |lilac/ |recollect/ |memof/ |cumulo-util.calcit/ |cumulo-reel.calcit/ |bisection-key/ |calcit.std/ |calcit-wss/ + :modules $ [] |recollect/ |memof/ |cumulo-util.calcit/ |cumulo-reel.calcit/ |bisection-key/ |calcit.std/ |calcit-wss/ :type-slots $ {} :files $ {} 'app.client $ %{} 'FileEntry @@ -19,69 +19,87 @@ {} $ :states $ {} :cursor $ [] :examples $ [] - :schema $ :: 'Ref 'Dynamic + :schema $ :: 'Ref $ :: 'Map 'Tag 'Dynamic '*store $ %{} 'CodeEntry (:doc |) - :code $ quote $ defatom *store nil + :code $ quote $ defatom *store (Option :none) :examples $ [] - :schema $ :: 'Ref 'Dynamic + :schema $ :: 'Ref $ :: 'Option (:: 'Map 'Tag 'Dynamic) 'connect! $ %{} 'CodeEntry (:doc |) :code $ quote $ defn connect! () let location $ location-snapshot url-obj $ unsafe-coerce url-parse (location :href) true - , ParsedUrlHost - query $ unsafe-coerce (js-get url-obj :query) QueryHost + , 'app.ffi.url/ParsedUrlHost + query $ unsafe-coerce (js-get url-obj :query) 'app.ffi.url/QueryHost raw-host $ js-get query :host raw-port $ js-get query :port - host $ if (js-present? raw-host) (unsafe-coerce raw-host String) (location :hostname) - port $ if (js-present? raw-port) (unsafe-coerce raw-port String) (&map:get config/site :port) + host $ if (js-present? raw-host) raw-host $ location :hostname + port $ if (js-present? raw-port) raw-port $ :port config/site ws-connect! (str |ws:// host |: port) {} :on-open $ fn (event) (simulate-login!) - :on-close $ fn (event) (reset! *store nil) (js/console.error |Disconnected) + :on-close $ fn (event) + reset! *store $ Option :none + js/console.error |Disconnected :on-data on-server-data :examples $ [] - :schema $ :: 'Fn $ {} (:return 'Dynamic) + :schema $ :: 'Fn $ {} (:return 'ws-edn.client/WsClient) :args $ [] :features $ #{} :js-ffi 'dispatch! $ %{} 'CodeEntry (:doc |) - :code $ quote $ defn dispatch! (op op-data) - when - and config/dev? $ not= op :states - println |Dispatch op op-data - case-default op - ws-send! $ {} (:kind :op) (:op op) (:data op-data) - :states $ let[] (cursor s) op-data $ reset! *states (update-states @*states cursor s) - :effect/connect $ connect! - :examples $ [] - :schema $ :: 'Fn $ {} (:return 'Unit) - :args $ [] 'Tag 'Dynamic - 'dispatch-action! $ %{} 'CodeEntry (:doc |) - :code $ quote $ defn dispatch-action! (action) + :code $ quote $ defn dispatch! (action) let - action-enum $ if (enum? action) (assert-type action Enum) (:: :noop) - op $ if (tag? action) (assert-type action Tag) (&enum:nth action-enum 0) - params $ if (tag? action) ([]) (&enum:params action-enum) + op $ &enum:nth action 0 + params $ &enum:params action data $ if (= op :states) params $ option:unwrap-or (first params) nil - dispatch! op data + when + and config/dev? $ not= op :states + println |Dispatch op data + case-default op + ws-send! $ {} (:kind :op) (:op op) (:data data) + :states $ let[] (cursor s) params $ reset! *states + decode-map-as + update-states @*states + decode-map-as cursor $ :: 'List 'Dynamic + , s + :: 'Map 'Tag 'Dynamic + :effect/connect $ do (connect!) &unit + , &unit :examples $ [] :schema $ :: 'Fn $ {} (:return 'Unit) - :args $ [] 'Dynamic + :args $ [] 'Enum + :features $ #{} :js-ffi 'main! $ %{} 'CodeEntry (:doc |) :code $ quote $ defn main! () let - highlighter $ unsafe-coerce hljs HighlightHost + highlighter $ unsafe-coerce hljs 'app.ffi.highlight/HighlightHost if config/dev? $ load-console-formatter! highlighter .register-language! |clojure clojure-lang highlighter .register-language! |bash bash-lang highlighter .register-language! |javascript javascript-lang render-app! connect! - add-watch *store :changes $ fn (store prev) (render-app!) - add-watch *states :changes $ fn (states pre) (render-app!) - on-page-touch $ fn () $ if (nil? @*store) (connect!) + add-watch! *store :changes $ fn (store prev) + hint-fn $ {} + :args $ [] + :: 'Option $ :: 'Map 'Tag 'Dynamic + :: 'Option $ :: 'Map 'Tag 'Dynamic + :return 'Unit + render-app! + add-watch! *states :changes $ fn (states pre) + hint-fn $ {} + :args $ [] (:: 'Map 'Tag 'Dynamic) (:: 'Map 'Tag 'Dynamic) + :return 'Unit + render-app! + on-page-touch $ fn () + hint-fn $ {} + :args $ [] + :return 'Unit + if (.none? @*store) (connect!) + , &unit println |App-started! + , &unit :examples $ [] :schema $ :: 'Fn $ {} (:return 'Unit) :args $ [] @@ -90,86 +108,117 @@ :code $ quote $ def mount-target option:unwrap $ query-selector |.app :examples $ [] - :schema $ :: 'Dynamic + :schema $ :: 'respo.dom/DomElement 'on-server-data $ %{} 'CodeEntry (:doc |) :code $ quote $ defn on-server-data (data) let - data-map $ unsafe-coerce data 'Map + data-map $ decode-map-as data $ :: 'Map 'Tag 'Dynamic case-default (&map:get data-map :kind) (js/console.warn "|unknown server data kind:" data) :patch $ let changes $ &map:get data-map :data when config/dev? $ js/console.log |Changes $ to-js-data changes - reset! *store $ patch-twig @*store $ assert-type changes (:: 'List 'recollect.schema/change-op) + let + base $ match @*store + (:some previous-store) previous-store + (:none) nil + next-value $ patch-twig base $ schema/read-patch-changes changes + next-store $ decode-map-as next-value $ :: 'Map 'Tag 'Dynamic + reset! *store $ Option :some next-store + , &unit :examples $ [] - :schema $ :: 'Fn $ {} (:return 'Dynamic) + :schema $ :: 'Fn $ {} (:return 'Unit) :args $ [] 'Dynamic :features $ #{} :js-ffi 'reload! $ %{} 'CodeEntry (:doc |) :code $ quote $ defn reload! () if - or (some? client-errors) (some? server-errors) + or (non-nil? client-errors) (non-nil? server-errors) hud! |error $ str client-errors &newline server-errors - do (hud! |inactive nil) (remove-watch *store :changes) (remove-watch *states :changes) (clear-cache!) (render-app!) - add-watch *store :changes $ fn (store prev) (render-app!) - add-watch *states :changes $ fn (states prev) (render-app!) + do (hud! |inactive nil) (remove-watch! *store :changes) (remove-watch! *states :changes) (clear-cache!) (render-app!) + add-watch! *store :changes $ fn (store prev) + hint-fn $ {} + :args $ [] + :: 'Option $ :: 'Map 'Tag 'Dynamic + :: 'Option $ :: 'Map 'Tag 'Dynamic + :return 'Unit + render-app! + add-watch! *states :changes $ fn (states prev) + hint-fn $ {} + :args $ [] (:: 'Map 'Tag 'Dynamic) (:: 'Map 'Tag 'Dynamic) + :return 'Unit + render-app! println "|Code updated." + , &unit :examples $ [] - :schema $ :: 'Fn $ {} (:return 'Dynamic) + :schema $ :: 'Fn $ {} (:return 'Unit) :args $ [] + :features $ #{} :js-ffi 'render-app! $ %{} 'CodeEntry (:doc |) :code $ quote $ defn render-app! () render! mount-target - comp-container (&map:get @*states :states) @*store - , dispatch-action! + comp-container (&map:get @*states :states) + match @*store + (:some online-store) online-store + (:none) nil + fn (value) + hint-fn $ {} + :args $ [] 'Dynamic + :return 'Unit + dispatch! $ schema/read-dispatch-operation value :examples $ [] - :schema $ :: 'Fn $ {} (:return 'Dynamic) + :schema $ :: 'Fn $ {} (:return 'Unit) :args $ [] + :features $ #{} :js-ffi 'simulate-login! $ %{} 'CodeEntry (:doc |) :code $ quote $ defn simulate-login! () - let - raw $ js/localStorage.getItem $ &map:get config/site :storage-key - if (js-present? raw) + match + js-ffi.browser/storage-get $ :storage-key config/site + (:some saved) do (println "|Found storage.") - dispatch! :user/log-in $ parse-cirru-edn $ unsafe-coerce raw String - do $ println "|Found no storage." + dispatch! $ :: :user/log-in $ parse-cirru-edn saved + (:none) (println "|Found no storage.") + , &unit :examples $ [] - :schema $ :: 'Fn $ {} (:return 'Dynamic) + :schema $ :: 'Fn $ {} (:return 'Unit) :args $ [] :features $ #{} :js-ffi :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.client :require - [] respo.core :refer $ [] render! clear-cache! realize-ssr! - [] respo.cursor :refer $ [] update-states - [] app.comp.container :refer $ [] comp-container - [] cljs.reader :refer $ [] read-string - [] app.schema :as schema - [] app.config :as config - [] ws-edn.client :refer $ [] ws-connect! ws-send! - [] recollect.patch :refer $ [] patch-twig - [] applied-science.js-interop :as j - [] |highlight.js/lib/core :default hljs - [] |highlight.js/lib/languages/clojure :default clojure-lang - [] |highlight.js/lib/languages/bash :default bash-lang - [] |highlight.js/lib/languages/javascript :default javascript-lang - [] |url-parse :default url-parse + respo.core :refer $ render! clear-cache! realize-ssr! + respo.cursor :refer $ update-states + app.comp.container :refer $ comp-container + cljs.reader :refer $ read-string + app.schema :as schema + app.config :as config + ws-edn.client :refer $ ws-connect! ws-send! + recollect.patch :refer $ patch-twig + applied-science.js-interop :as j + |highlight.js/lib/core :default hljs + |highlight.js/lib/languages/clojure :default clojure-lang + |highlight.js/lib/languages/bash :default bash-lang + |highlight.js/lib/languages/javascript :default javascript-lang + |url-parse :default url-parse cumulo-util.core :refer $ on-page-touch |./calcit.build-errors :default client-errors |../js-out/calcit.build-errors :default server-errors |bottom-tip :default hud! - js-ffi.browser :refer $ [] location-snapshot query-selector - app.ffi.highlight :refer $ [] HighlightHost - app.ffi.url :refer $ [] ParsedUrlHost QueryHost + js-ffi.browser :refer $ location-snapshot + app.ffi.highlight :refer $ HighlightHost + app.ffi.url :refer $ ParsedUrlHost QueryHost + respo.ffi.browser :refer $ query-selector 'app.comp.articles $ %{} 'FileEntry :defs $ {} 'comp-article $ %{} 'CodeEntry (:doc |) :code $ quote $ defcomp comp-article (states article focuses) let - article-map $ unsafe-coerce article 'Map - focuses-map $ unsafe-coerce focuses 'Map + article-map $ decode-map-as article $ :: 'Map 'Tag 'Dynamic + article-title $ read-article-title article + article-id $ decode-map-as (&map:get article-map :id) 'String + focuses-map $ decode-map-as focuses $ :: 'Map 'String + :: 'List $ :: 'Map 'Tag 'Dynamic edit-plugin $ use-prompt (>> states :edit) - {} (:text "|New title?") - :initial $ &map:get article-map :title + {} (:text "|New title?") (:initial article-title) remove-plugin $ use-confirm (>> states :remove) {} $ :text "|Sure to delete?" div @@ -178,11 +227,10 @@ :border $ str "|1px solid " $ hsl 0 0 90 :box-shadow $ str "|0 0 2px " $ hsl 0 0 0 :on-click $ fn (e d!) - d! :session/view-article $ &map:get article-map :id + d! $ :: :session/view-article article-id div {} $ :style ui/row-parted - <> (&map:get article-map :title) - {} $ :font-size 16 + <> article-title $ {} $ :font-size 16 div ({}) comp-icon :edit {} (:font-size 14) @@ -191,17 +239,15 @@ fn (e d!) .show edit-plugin d! $ fn (result) (println "|as result:" result) when - not $ blank? $ unsafe-coerce result String - d! :article/title $ {} - :id $ &map:get article-map :id - :title result + not $ blank? $ decode-map-as result 'String + d! $ :: :article/title $ {} (:id article-id) (:title result) =< 16 nil comp-icon :trash {} (:font-size 14) :color $ hsl 200 80 70 :cursor :pointer fn (e d!) - .show remove-plugin d! $ fn () $ d! :article/remove-one (&map:get article-map :id) + .show remove-plugin d! $ fn () $ d! (:: :article/remove-one article-id) div {} $ :style $ {} :color $ hsl 0 0 80 @@ -209,18 +255,19 @@ {} $ :style ui/row -> assert-type - option:unwrap-or - get focuses-map $ &map:get article-map :id - [] + option:unwrap-or (get focuses-map article-id) ([]) :: 'List 'Dynamic .to-list .map $ fn (info) let - info-map $ unsafe-coerce info 'Map + info-map $ decode-map-as info $ :: 'Map 'Tag 'Dynamic [] (&map:get info-map :id) div {} $ :style $ {} (:margin-right 8) - <> $ &map:get info-map :name + match (read-focus-name info-map) + (:some focus-name) (<> focus-name) + (:none) + span $ {} .render edit-plugin .render remove-plugin :examples $ [] @@ -230,29 +277,23 @@ 'comp-articles $ %{} 'CodeEntry (:doc |) :code $ quote $ defcomp comp-articles (states router-data) let - router-map $ unsafe-coerce router-data 'Map - articles $ unsafe-coerce + router-map $ decode-map-as router-data $ :: 'Map 'Tag 'Dynamic + articles $ decode-map-as or (&map:get router-map :articles) ({}) - , 'Map + :: 'Map 'String $ :: 'Map 'Tag 'Dynamic focuses $ or (&map:get router-map :focuses) ({}) create-plugin $ use-prompt (>> states :create) {} (:text "|Title of article:") (:initial |) div - {} $ :style $ merge - unsafe-coerce ui/flex $ :: 'Map 'Tag 'Dynamic - unsafe-coerce - {} $ :padding 16 - :: 'Map 'Tag 'Dynamic + {} $ :style $ merge ui/flex + {} $ :padding 16 div {} $ :style $ {} (:font-size 24) (:font-weight 300) (:font-family ui/font-fancy) :color $ hsl 0 0 70 <> |Articles list-> - {} $ :style $ merge - unsafe-coerce ui/row $ :: 'Map 'Tag 'Dynamic - unsafe-coerce - {} $ :flex-wrap :wrap - :: 'Map 'Tag 'Dynamic + {} $ :style $ merge ui/row + {} $ :flex-wrap :wrap -> articles (.to-list) sort $ fn (a b) &compare @@ -260,9 +301,9 @@ option:unwrap-or (first b) | .map-pair $ fn (k article) let - article-map $ unsafe-coerce article 'Map + article-map $ decode-map-as article $ :: 'Map 'Tag 'Dynamic [] k $ comp-article - >> states $ &map:get article-map :id + >> states $ decode-map-as (&map:get article-map :id) 'String , article focuses div ({}) button @@ -271,36 +312,106 @@ :on-click $ fn (e d!) .show create-plugin d! $ fn (result) when - not $ blank? $ unsafe-coerce result String - d! :article/create result + not $ blank? $ decode-map-as result 'String + d! $ :: :article/create result <> "|Create Article" .render create-plugin :examples $ [] :schema $ :: 'Fn $ {} (:return 'respo.schema/Component) :args $ [] 'Dynamic 'Dynamic :features $ #{} :js-ffi + 'read-article-title $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn read-article-title (value) + let + value-map $ decode-map-as value $ :: 'Map 'Tag 'Dynamic + decode-map-as (&map:get value-map :title) 'String + :examples $ [] + :schema $ :: 'Fn $ {} (:return 'String) + :args $ [] 'Dynamic + :tests $ [] + %{} 'TestEntry (:name |empty-and-unicode-text) + :code $ quote $ do + assert= | $ read-article-title $ {} (:title |) + assert= "|内容🌱" $ read-article-title $ {} (:title "|内容🌱") (:extra false) + :tags $ #{} :text-boundary :unit + %{} 'TestEntry (:name |rejects-missing-and-non-text) + :code $ quote $ do + assert= true $ try + do + read-article-title $ {} + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + assert= true $ try + do + read-article-title $ {} $ :title 4 + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + :tags $ #{} :text-boundary :unit + 'read-focus-name $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn read-focus-name (info) + let + info-map $ decode-map-as info $ :: 'Map 'Tag 'Dynamic + raw-name $ &map:get info-map :name + if (nil? raw-name) (Option :none) + Option :some $ decode-map-as raw-name 'String + :examples $ [] + :schema $ :: 'Fn $ {} + :args $ [] 'Dynamic + :return $ :: 'Option 'String + :tests $ [] $ %{} 'TestEntry (:name |missing-name-remains-absent) + :code $ quote $ do + assert= (Option :none) + read-focus-name $ {} + assert= (Option :none) + read-focus-name $ {} $ :name nil + assert= (Option :some |) + read-focus-name $ {} $ :name | + :tags $ #{} :text-boundary :unit :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.comp.articles :require - [] respo-ui.core :refer $ [] hsl - [] respo-ui.core :as ui - [] respo.core :refer $ [] defcomp <> >> list-> span div button textarea - [] respo.comp.space :refer $ [] =< - [] app.style :as style - [] respo-alerts.core :refer $ [] use-confirm use-prompt - [] feather.core :refer $ [] comp-icon comp-i + respo-ui.core :refer $ hsl + respo-ui.core :as ui + respo.core :refer $ defcomp <> >> list-> span div button textarea + respo.comp.space :refer $ =< + app.style :as style + respo-alerts.core :refer $ use-confirm use-prompt + feather.core :refer $ comp-icon comp-i 'app.comp.container $ %{} 'FileEntry :defs $ {} + 'NavigationView $ %{} 'CodeEntry (:doc |) + :code $ quote $ defstruct NavigationView (:logged-in? 'Bool) + :count $ :: 'Option 'Number + :examples $ [] + :schema $ :: 'StructDef 'comp-container $ %{} 'CodeEntry (:doc |) :code $ quote $ defcomp comp-container (states store) - let - states-map $ unsafe-coerce states 'Map - store-map $ unsafe-coerce store 'Map - session $ unsafe-coerce (&map:get store-map :session) 'Map - paragraph-id $ &map:get session :paragraph-id - router $ unsafe-coerce (&map:get store-map :router) 'Map - router-data $ unsafe-coerce (&map:get router :data) 'Map - if (nil? store) (comp-offline) + if (nil? store) (comp-offline) + let + states-map $ unsafe-coerce states 'Map + store-map $ decode-map-as store $ :: 'Map 'Tag 'Dynamic + navigation-view $ read-navigation-view store-map + session $ decode-map-as (&map:get store-map :session) (:: 'Map 'Tag 'Dynamic) + paragraph-id $ &map:get session :paragraph-id + router $ if (:logged-in? navigation-view) + decode-map-as (&map:get store-map :router) (:: 'Map 'Tag 'Dynamic) + {} + router-data $ &map:get router :data + raw-color $ &map:get store-map :color + status-color $ if (nil? raw-color) (Option :none) + Option :some $ decode-map-as raw-color 'String + article-data $ if + = (&map:get router :name) :article + decode-map-as router-data $ :: 'Map 'Tag 'Dynamic + {} div {} $ :style $ merge unsafe-coerce ui/global $ :: 'Map 'Tag 'Dynamic @@ -310,39 +421,42 @@ {} $ :style $ merge unsafe-coerce ui/expand $ :: 'Map 'Tag 'Dynamic unsafe-coerce ui/row $ :: 'Map 'Tag 'Dynamic - comp-navigation (&map:get store-map :logged-in?) (&map:get store-map :count) - if (&map:get store-map :logged-in?) + comp-navigation (:logged-in? navigation-view) (:count navigation-view) + if (:logged-in? navigation-view) case-default (&map:get router :name) div {} $ :style ui/flex <> $ str router - :profile $ comp-profile (&map:get store-map :user) router-data - :home $ comp-articles (>> states :articles) router-data + :profile $ comp-profile (&map:get store-map :user) + decode-map-as router-data $ :: 'Map 'Number 'Dynamic + :home $ comp-articles (>> states :articles) + decode-map-as router-data $ :: 'Map 'Tag 'Dynamic :article $ div {} $ :style $ merge unsafe-coerce ui/row $ :: 'Map 'Tag 'Dynamic unsafe-coerce ui/flex $ :: 'Map 'Tag 'Dynamic - comp-previewer (>> states :previewer) (&map:get router-data :article) (&map:get router-data :focuses) (&map:get router-data :members) paragraph-id + comp-previewer (>> states :previewer) (&map:get article-data :article) (&map:get article-data :focuses) (&map:get article-data :members) paragraph-id comp-login $ >> states :login let - visible? $ and (&map:get store-map :logged-in?) (some? paragraph-id) + visible? $ and (:logged-in? navigation-view) (non-nil? paragraph-id) = :article $ &map:get router :name comp-editor-panel (>> states :editor) paragraph-id option:unwrap-or - get-in router-data $ [] :article :paragraphs paragraph-id + get-in article-data $ [] :article :paragraphs paragraph-id {} , visible? comp-messages - unsafe-coerce + decode-map-as option:unwrap-or get-in store-map $ [] :session :messages {} :: 'Map 'String 'Dynamic {} - fn (info d!) (d! :session/remove-message info) - comp-status-color $ &map:get store-map :color + fn (info d!) + d! $ :: :session/remove-message info + comp-status-color status-color when dev? $ comp-inspect |Store store $ {} (:bottom 0) (:right 0) (:max-width |100%) - when dev? $ comp-reel (&map:get store-map :reel-length) + when dev? $ comp-reel (read-reel-length store-map) {} (:right 0) (:bottom 40) :examples $ [] :schema $ :: 'Fn $ {} (:return 'respo.schema/Component) @@ -355,18 +469,128 @@ span {} :style $ {} $ :cursor :pointer - :on-click $ fn (e d!) (d! :effect/connect nil) + :on-click $ fn (e d!) + d! $ :: :effect/connect nil <> "|Socket broken! Click to retry." $ {} (:font-family ui/font-fancy) (:font-weight 100) (:font-size 32) :examples $ [] :schema $ :: 'Fn $ {} (:return 'respo.schema/Component) :args $ [] 'comp-status-color $ %{} 'CodeEntry (:doc |) :code $ quote $ defcomp comp-status-color (color) - div $ {} $ :style - {} (:position :absolute) (:top 8) (:right 8) (:background-color color) (:border-radius |8px) (:height 16) (:width 16) (:transition-duration |200ms) (:opacity 0.8) (:pointer-events :none) + let + indicator-style $ {} (:position :absolute) (:top 8) (:right 8) (:border-radius |8px) (:height 16) (:width 16) (:transition-duration |200ms) (:opacity 0.8) (:pointer-events :none) + div $ {} $ :style + match color + (:some color-value) (assoc indicator-style :background-color color-value) + (:none) indicator-style :examples $ [] :schema $ :: 'Fn $ {} (:return 'respo.schema/Component) - :args $ [] 'String + :args $ [] $ :: 'Option 'String + 'read-navigation-view $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn read-navigation-view (store) + let + store-map $ decode-map-as store $ :: 'Map 'Tag 'Dynamic + raw-count $ &map:get store-map :count + NavigationView :logged-in? + decode-map-as (&map:get store-map :logged-in?) 'Bool + , :count $ if (nil? raw-count) (Option :none) + Option :some $ decode-map-as raw-count 'Number + :examples $ [] + :schema $ :: 'Fn $ {} (:return 'app.comp.container/NavigationView) + :args $ [] 'Dynamic + :tests $ [] + %{} 'TestEntry (:name |guest-count-is-absent-not-zero) + :code $ quote $ let + view $ read-navigation-view $ {} (:logged-in? false) + assert= false $ :logged-in? view + assert= (Option :none) (:count view) + :tags $ #{} :navigation-view :unit + %{} 'TestEntry (:name |present-zero-count) + :code $ quote $ let + view $ read-navigation-view $ {} (:logged-in? true) (:count 0) + assert= true $ :logged-in? view + assert= (Option :some 0) (:count view) + :tags $ #{} :navigation-view :unit + %{} 'TestEntry (:name |navigation-view-keeps-source-extra-fields) + :code $ quote $ let + store $ {} (:logged-in? false) (:count 2) (:payload |preserved) + view $ read-navigation-view store + assert= false $ :logged-in? view + assert= (Option :some 2) (:count view) + assert= |preserved $ &map:get store :payload + :tags $ #{} :navigation-view :unit + %{} 'TestEntry (:name |rejects-untyped-navigation-values) + :code $ quote $ do + assert= true $ try + do + read-navigation-view $ {} $ :logged-in? |not-a-bool + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + assert= true $ try + do + read-navigation-view $ {} (:logged-in? false) (:count |not-a-number) + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + assert= true $ try + do + read-navigation-view $ {} + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + :tags $ #{} :navigation-view :unit + %{} 'TestEntry (:name |explicit-nil-count-is-absent) + :code $ quote $ let + view $ read-navigation-view $ {} (:logged-in? false) (:count nil) + assert= (Option :none) (:count view) + :tags $ #{} :navigation-view :unit + 'read-reel-length $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn read-reel-length (store) + decode-map-as + &map:get + decode-map-as store $ :: 'Map 'Tag 'Dynamic + , :reel-length + , 'Number + :examples $ [] + :schema $ :: 'Fn $ {} (:return 'Number) + :args $ [] 'Dynamic + :tests $ [] + %{} 'TestEntry (:name |preserves-zero-and-numeric-record-count) + :code $ quote $ do + assert= 0 $ read-reel-length $ {} (:reel-length 0) + assert= 2 $ read-reel-length $ {} (:reel-length 2) + :tags $ #{} :projection :unit + %{} 'TestEntry (:name |rejects-missing-or-text-count) + :code $ quote $ do + assert= true $ try + do + read-reel-length $ {} + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + assert= true $ try + do + read-reel-length $ {} $ :reel-length |2 + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + :tags $ #{} :projection :unit 'style-body $ %{} 'CodeEntry (:doc |) :code $ quote $ def style-body {} $ :padding "|8px 16px" @@ -375,161 +599,297 @@ :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.comp.container :require - [] hsl.core :refer $ [] hsl - [] respo-ui.core :as ui - [] respo.core :refer $ [] defcomp <> div span >> button - [] respo.comp.inspect :refer $ [] comp-inspect - [] respo.comp.space :refer $ [] =< - [] app.comp.navigation :refer $ [] comp-navigation - [] app.comp.profile :refer $ [] comp-profile - [] app.comp.login :refer $ [] comp-login - [] respo-message.comp.messages :refer $ [] comp-messages - [] cumulo-reel.comp.reel :refer $ [] comp-reel - [] app.config :refer $ [] dev? - [] app.comp.previewer :refer $ [] comp-previewer - [] app.comp.editor-panel :refer $ [] comp-editor-panel - [] app.comp.articles :refer $ [] comp-articles + hsl.core :refer $ hsl + respo-ui.core :as ui + respo.core :refer $ defcomp <> div span >> button + respo.comp.inspect :refer $ comp-inspect + respo.comp.space :refer $ =< + app.comp.navigation :refer $ comp-navigation + app.comp.profile :refer $ comp-profile + app.comp.login :refer $ comp-login + respo-message.comp.messages :refer $ comp-messages + cumulo-reel.comp.reel :refer $ comp-reel + app.config :refer $ dev? + app.comp.previewer :refer $ comp-previewer + app.comp.editor-panel :refer $ comp-editor-panel + app.comp.articles :refer $ comp-articles 'app.comp.editor-panel $ %{} 'FileEntry - :defs $ {} $ 'comp-editor-panel - %{} 'CodeEntry (:doc |) + :defs $ {} + 'EditorInputProps $ %{} 'CodeEntry (:doc |) + :code $ quote $ defstruct EditorInputProps + :style $ :: 'Map 'Tag 'Dynamic + :class-name 'String + :placeholder 'String + :value 'String + :on-input 'respo.schema/EventHandler + :on-keydown 'respo.schema/EventHandler + :examples $ [] + :schema $ :: 'StructDef + 'comp-editor-panel $ %{} 'CodeEntry (:doc |) :code $ quote $ defcomp comp-editor-panel (states sort-id paragraph visible?) let - states-map $ unsafe-coerce states 'Map - paragraph-map $ unsafe-coerce paragraph 'Map + states-map $ decode-map-as states 'Map + paragraph-map $ decode-map-as paragraph $ :: 'Map 'Tag 'Dynamic cursor $ &map:get states-map :cursor - state $ unsafe-coerce + state $ decode-map-as or (&map:get states-map :data) {} (:text |) (:time 0) - , 'Map + :: 'Map 'Tag 'Dynamic remove-plugin $ use-confirm (>> states :remove) {} :style $ {} (:cursor :pointer) (:position :absolute) (:right 8) (:color :red) :text "|Sure to delete?" div - {} $ :style $ merge - unsafe-coerce ui/column $ :: 'Map 'Tag 'Dynamic - unsafe-coerce - {} (:transition-duration |200ms) (:transition-timing-function :linear) (:position :relative) (:transition-property :height) - :height $ if visible? |40% |0% - :background-color $ hsl 0 0 100 - :border-top $ str "|1px solid " $ hsl 0 0 90 - :padding $ if visible? 8 0 - :padding-left $ if visible? 88 false - :: 'Map 'Tag 'Dynamic + {} $ :style $ merge ui/column + {} (:transition-duration |200ms) (:transition-timing-function :linear) (:position :relative) (:transition-property :height) + :height $ if visible? |40% |0% + :background-color $ hsl 0 0 100 + :border-top $ str "|1px solid " $ hsl 0 0 90 + :padding $ if visible? 8 0 + :padding-left $ if visible? 88 false when visible? $ div - {} $ :style $ merge - unsafe-coerce ui/flex $ :: 'Map 'Tag 'Dynamic - unsafe-coerce ui/column $ :: 'Map 'Tag 'Dynamic - unsafe-coerce - {} (:max-width 960) (:width |100%) (:margin :auto) - :: 'Map 'Tag 'Dynamic + {} $ :style $ merge ui/flex ui/column + {} (:max-width 960) (:width |100%) (:margin :auto) comp-editor-toolbar states sort-id =< nil 8 - textarea $ {} - :style $ merge ui/textarea ui/flex $ {} (:width |100%) (:min-height |20vh) (:resize :vertical) (:padding 16) (:font-family ui/font-code) (:font-size 13) (:border-radius |4px) (:line-height |1.6em) (:padding-bottom 120) + textarea $ EditorInputProps :style + merge ui/textarea ui/flex $ {} (:width |100%) (:min-height |20vh) (:resize :vertical) (:padding 16) (:font-family ui/font-code) (:font-size 13) (:border-radius |4px) (:line-height |1.6em) (:padding-bottom 120) :border $ str "|1px solid " $ hsl 240 80 90 :background-color $ hsl 0 0 100 - :class-name |editor-area - :placeholder |Paragraph - :value $ if - > (&map:get state :time) (&map:get paragraph-map :time) - &map:get state :text - &map:get paragraph-map :content - :on-input $ fn (e d!) - let - timestamp $ js/Date.now - event-map $ unsafe-coerce e 'Map - value $ &map:get event-map :value - d! cursor $ {} (:time timestamp) (:text value) - d! :paragraph/content $ {} (:id sort-id) (:time timestamp) (:text value) - :on-keydown $ fn (e d!) - when - = - &map:get (unsafe-coerce e 'Map) :keycode - , 27 - d! :paragraph/finish-editing sort-id + , :class-name |editor-area :placeholder |Paragraph :value (read-editor-text state paragraph-map) :on-input + fn (e d!) + hint-fn $ {} + :args $ [] (:: 'Map 'Tag 'Dynamic) + :: 'Fn $ {} + :args $ [] 'Dynamic + :return 'Unit + :return 'Unit + let + timestamp $ decode-map-as (js/Date.now) 'Number + value $ decode-map-as + .unwrap $ get e :value + , 'String + state-cursor $ decode-map-as cursor $ :: 'List 'Dynamic + d! $ :: :states state-cursor $ {} (:time timestamp) (:text value) + d! $ :: :paragraph/content $ {} (:id sort-id) (:time timestamp) (:text value) + , &unit + , :on-keydown $ fn (e d!) + hint-fn $ {} + :args $ [] (:: 'Map 'Tag 'Dynamic) + :: 'Fn $ {} + :args $ [] 'Dynamic + :return 'Unit + :return 'Unit + when + = + .unwrap-or (get e :keycode) nil + , 27 + d! $ :: :paragraph/finish-editing sort-id + , &unit when visible? $ comp-icon :trash {} (:font-size 14) (:cursor :pointer) :color $ hsl 200 80 70 fn (e d!) - .show remove-plugin d! $ fn () $ d! :paragraph/remove sort-id + hint-fn $ {} + :args $ [] (:: 'Map 'Tag 'Dynamic) + :: 'Fn $ {} + :args $ [] 'Dynamic + :return 'Unit + :return 'Unit + .show remove-plugin d! $ fn () + hint-fn $ {} + :args $ [] + :return 'Unit + d! $ :: :paragraph/remove sort-id + , &unit + , &unit .render remove-plugin :examples $ [] :schema $ :: 'Fn $ {} (:return 'respo.schema/Component) :args $ [] 'Dynamic 'Dynamic 'Dynamic 'Bool :features $ #{} :js-ffi + 'read-editor-text $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn read-editor-text (state paragraph) + let + state-map $ decode-map-as state $ :: 'Map 'Tag 'Dynamic + paragraph-map $ decode-map-as paragraph $ :: 'Map 'Tag 'Dynamic + state-time $ decode-map-as (&map:get state-map :time) 'Number + paragraph-time $ decode-map-as (&map:get paragraph-map :time) 'Number + if (> state-time paragraph-time) + decode-map-as (&map:get state-map :text) 'String + decode-map-as (&map:get paragraph-map :content) 'String + :examples $ [] + :schema $ :: 'Fn $ {} (:return 'String) + :args $ [] 'Dynamic 'Dynamic + :tests $ [] + %{} 'TestEntry (:name |strictly-newer-local-edit-wins) + :code $ quote $ do + assert= "|local🌱" $ read-editor-text + {} (:time 20) (:text "|local🌱") + {} (:time 10) (:content |remote) + assert= |remote $ read-editor-text + {} (:time 10) (:text |local) + {} (:time 10) (:content |remote) + assert= | $ read-editor-text + {} (:time 0) (:text |local) + {} (:time 1) (:content |) + :tags $ #{} :editor-text :unit + %{} 'TestEntry (:name |rejects-invalid-time-without-defaulting) + :code $ quote $ assert= true + try + do + read-editor-text + {} (:time |bad) (:text |local) + {} (:time 10) (:content |remote) + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + :tags $ #{} :editor-text :unit :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.comp.editor-panel :require - [] respo-ui.core :refer $ [] hsl - [] respo-ui.core :as ui - [] respo.core :refer $ [] defcomp <> >> list-> span div button textarea - [] respo-md.comp.md :refer $ [] comp-md-block - [] respo.comp.space :refer $ [] =< - [] app.style :as style - [] app.comp.editor-toolbar :refer $ [] comp-editor-toolbar - [] respo-alerts.core :refer $ [] use-confirm - [] feather.core :refer $ [] comp-i comp-icon + respo-ui.core :refer $ hsl + respo-ui.core :as ui + respo.core :refer $ defcomp <> >> list-> span div button textarea + respo-md.comp.md :refer $ comp-md-block + respo.comp.space :refer $ =< + app.style :as style + app.comp.editor-toolbar :refer $ comp-editor-toolbar + respo-alerts.core :refer $ use-confirm + feather.core :refer $ comp-i comp-icon 'app.comp.editor-toolbar $ %{} 'FileEntry - :defs $ {} $ 'comp-editor-toolbar - %{} 'CodeEntry (:doc |) + :defs $ {} + 'ToolbarCloseProps $ %{} 'CodeEntry (:doc |) + :code $ quote $ defstruct ToolbarCloseProps + :style $ :: 'Map 'Tag 'Dynamic + :on-click 'respo.schema/EventHandler + :examples $ [] + :schema $ :: 'StructDef + 'ToolbarDragProps $ %{} 'CodeEntry (:doc |) + :code $ quote $ defstruct ToolbarDragProps + :style $ :: 'Map 'Tag 'Dynamic + :draggable 'Bool + :on-dragstart 'respo.schema/EventHandler + :examples $ [] + :schema $ :: 'StructDef + 'comp-editor-toolbar $ %{} 'CodeEntry (:doc |) :code $ quote $ defcomp comp-editor-toolbar (states sort-id) div - unsafe-coerce - {} - :style $ merge ui/row $ {} (:font-size 16) (:justify-content :flex-end) (:cursor :move) (:padding "|0 8px") - :draggable true - :on-dragstart $ fn (e d!) - let - event $ unsafe-coerce - option:unwrap-or (get e :event) (js-object) - , DragEventHost - data-transfer $ option:unwrap $ js-nullish->option (js-get event :data-transfer) - .set-data! data-transfer |text $ str sort-id - , respo.schema/DomProps + ToolbarDragProps :style + merge ui/row $ {} (:font-size 16) (:justify-content :flex-end) (:cursor :move) (:padding "|0 8px") + , :draggable true :on-dragstart $ fn (e d!) + hint-fn $ {} (:return 'Unit) + :args $ [] (:: 'Map 'Tag 'Dynamic) + :: 'Fn $ {} (:rest 'Dynamic) (:return 'Unit) + :args $ [] 'Dynamic + let + event $ unsafe-coerce + option:unwrap-or (get e :event) (js-object) + , 'app.ffi.drag/DragEventHost + data-transfer $ option:unwrap $ js-nullish->option (js-get event :data-transfer) + .set-data! data-transfer |text $ str sort-id + , &unit span - {} - :style $ {} $ :cursor :pointer - :on-click $ fn (e d!) (d! :paragraph/finish-editing sort-id) - d! - &map:get (unsafe-coerce states 'Map) :cursor - , nil + ToolbarCloseProps :style + {} $ :cursor :pointer + , :on-click $ on-close states sort-id comp-i :chevron-down 14 $ hsl 200 80 70 :examples $ [] :schema $ :: 'Fn $ {} (:return 'respo.schema/Component) :args $ [] 'Dynamic 'Dynamic :features $ #{} :js-ffi + 'on-close $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn on-close (states sort-id) + let + states-map $ decode-map-as states $ :: 'Map 'Tag 'Dynamic + cursor $ decode-map-as + .unwrap $ get states-map :cursor + :: 'List 'Dynamic + paragraph-key $ decode-map-as sort-id 'String + fn (event dispatch!) + hint-fn $ {} (:return 'Unit) + :args $ [] (:: 'Map 'Tag 'Dynamic) + :: 'Fn $ {} (:rest 'Dynamic) (:return 'Unit) + :args $ [] 'Dynamic + dispatch! $ :: :paragraph/finish-editing paragraph-key + dispatch! $ :: :states cursor nil + , &unit + :examples $ [] + :schema $ :: 'Fn $ {} (:return 'respo.schema/EventHandler) + :args $ [] 'Dynamic 'Dynamic + :tests $ [] + %{} 'TestEntry (:name |dispatches-finish-before-clear-on-mixed-cursor) + :code $ quote $ let + cursor $ [] :editor |paragraph 2 + handler $ on-close + {} $ :cursor cursor + , |c32 + calls $ ref 0 + assert= &unit $ handler ({}) + fn (op & extra-args) + hint-fn $ {} + :args $ [] 'Dynamic + :rest 'Dynamic + :return 'Unit + assert= ([]) extra-args + assert= + if + = (deref calls) 0 + :: :paragraph/finish-editing |c32 + :: :states cursor nil + , op + reset! calls $ inc $ deref calls + , &unit + assert= 2 $ deref calls + :tags $ #{} :toolbar-close :unit + %{} 'TestEntry (:name |rejects-invalid-cursor-before-creating-handler) + :code $ quote $ assert= true + try + do + on-close + {} $ :cursor |not-a-list + , |c32 + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + :tags $ #{} :toolbar-close :unit :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.comp.editor-toolbar :require - [] respo-ui.core :refer $ [] hsl - [] respo-ui.core :as ui - [] respo.core :refer $ [] defcomp <> >> list-> span div button textarea - [] respo-md.comp.md :refer $ [] comp-md-block - [] respo.comp.space :refer $ [] =< - [] app.style :as style - [] feather.core :refer $ [] comp-i + respo-ui.core :refer $ hsl + respo-ui.core :as ui + respo.core :refer $ defcomp <> >> list-> span div button textarea + respo-md.comp.md :refer $ comp-md-block + respo.comp.space :refer $ =< + app.style :as style + feather.core :refer $ comp-i app.ffi.drag :refer $ DragEventHost 'app.comp.login $ %{} 'FileEntry :defs $ {} + 'LoginFields $ %{} 'CodeEntry (:doc |) + :code $ quote $ defstruct LoginFields (:username 'String) (:password 'String) + :examples $ [] + :schema $ :: 'StructDef 'comp-login $ %{} 'CodeEntry (:doc |) :code $ quote $ defcomp comp-login (states) let - states-map $ unsafe-coerce states 'Map - cursor $ &map:get states-map :cursor - state $ unsafe-coerce + states-map $ decode-map-as states 'Map + cursor $ decode-map-as (&map:get states-map :cursor) (:: 'List 'Dynamic) + state $ decode-map-as or (&map:get states-map :data) initial-state - , 'Map + :: 'Map 'Tag 'Dynamic + fields $ read-login-fields state div - {} $ :style $ merge - unsafe-coerce ui/flex $ :: 'Map 'Tag 'Dynamic - unsafe-coerce ui/center $ :: 'Map 'Tag 'Dynamic + {} $ :style $ merge ui/flex ui/center div - {} $ :style $ merge - unsafe-coerce ui/center $ :: 'Map 'Tag 'Dynamic - unsafe-coerce - {} $ :max-width 200 - :: 'Map 'Tag 'Dynamic + {} $ :style $ merge ui/center + {} $ :max-width 200 div {} $ :style $ {} div ({}) @@ -538,26 +898,24 @@ =< nil 16 div ({}) input $ {} (:placeholder |Username) - :value $ &map:get state :username + :value $ :username fields :style $ merge ui/input $ {} (:width 200) - :on-input $ fn (e d!) - d! cursor $ assoc state :username $ &map:get (unsafe-coerce e 'Map) :value + :on-input $ on-input cursor state :username ; div ({}) input $ {} (:placeholder |Password) - :value $ &map:get state :password + :value $ :password fields :style ui/input - :on-input $ fn (e d!) - d! cursor $ assoc state :password $ &map:get (unsafe-coerce e 'Map) :value + :on-input $ on-input cursor state :password =< nil 8 div {} $ :style $ {} (:text-align :right) span $ {} (:inner-text "|Sign up") :style $ merge style/link - :on-click $ on-submit (&map:get state :username) (&map:get state :password) true + :on-click $ on-submit (:username fields) (:password fields) true =< 8 nil span $ {} (:inner-text "|Log in") :style $ merge style/link - :on-click $ on-submit (&map:get state :username) (&map:get state :password) false + :on-click $ on-submit (:username fields) (:password fields) false :examples $ [] :schema $ :: 'Fn $ {} (:return 'respo.schema/Component) :args $ [] 'Dynamic @@ -567,29 +925,146 @@ {} (:username |) (:password |) :examples $ [] :schema $ :: 'Dynamic + 'on-input $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn on-input (cursor state field) + fn (event dispatch!) + hint-fn $ {} (:return 'Unit) + :args $ [] (:: 'Map 'Tag 'Dynamic) + :: 'Fn $ {} (:rest 'Dynamic) (:return 'Unit) + :args $ [] 'Dynamic + dispatch! $ :: :states cursor $ assoc state field + decode-map-as (&map:get event :value) 'String + , &unit + :examples $ [] + :schema $ :: 'Fn $ {} (:return 'respo.schema/EventHandler) + :args $ [] (:: 'List 'Dynamic) (:: 'Map 'Tag 'Dynamic) 'Tag + :tests $ [] + %{} 'TestEntry (:name |dispatches-one-state-enum-with-mixed-cursor) + :code $ quote $ let + cursor $ [] :login |panel 2 + state $ {} (:username |old) (:password |secret) (:extra false) + handler $ on-input cursor state :username + calls $ ref 0 + assert= &unit $ handler + {} $ :value "|用户🌱" + fn (op & extra-args) + hint-fn $ {} + :args $ [] 'Dynamic + :return 'Unit + :rest 'Dynamic + assert= ([]) extra-args + assert= + :: :states cursor $ assoc state :username "|用户🌱" + , op + reset! calls $ inc $ deref calls + , &unit + assert= 1 $ deref calls + assert= |old $ &map:get state :username + :tags $ #{} :login-fields :unit + %{} 'TestEntry (:name |rejects-non-text-before-dispatch) + :code $ quote $ let + calls $ ref 0 + handler $ on-input ([]) initial-state :password + assert= true $ try + do + handler + {} $ :value 9 + fn (op & extra-args) + hint-fn $ {} + :args $ [] 'Dynamic + :return 'Unit + :rest 'Dynamic + assert= ([]) extra-args + reset! calls $ inc $ deref calls + , &unit + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + assert= 0 $ deref calls + :tags $ #{} :login-fields :unit 'on-submit $ %{} 'CodeEntry (:doc |) :code $ quote $ defn on-submit (username password signup?) fn (e dispatch!) - dispatch! (if signup? :user/sign-up :user/log-in) ([] username password) - .setItem js/localStorage (&map:get config/site :storage-key) + hint-fn $ {} (:return 'Unit) + :args $ [] (:: 'Map 'Tag 'Dynamic) + :: 'Fn $ {} (:rest 'Dynamic) (:return 'Unit) + :args $ [] 'Dynamic + dispatch! $ if signup? + :: :user/sign-up $ [] username password + :: :user/log-in $ [] username password + storage-set! (:storage-key config/site) format-cirru-edn $ [] username password + , &unit :examples $ [] - :schema $ :: 'Fn $ {} (:return 'Dynamic) + :schema $ :: 'Fn $ {} (:return 'respo.schema/EventHandler) :args $ [] 'String 'String 'Bool :features $ #{} :js-ffi + 'read-login-fields $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn read-login-fields (state) + let + state-map $ decode-map-as state $ :: 'Map 'Tag 'Dynamic + LoginFields :username + decode-map-as (&map:get state-map :username) 'String + , :password $ decode-map-as (&map:get state-map :password) 'String + :examples $ [] + :schema $ :: 'Fn $ {} (:return 'app.comp.login/LoginFields) + :args $ [] 'Dynamic + :tests $ [] + %{} 'TestEntry (:name |empty-and-unicode-fields-preserve-extras) + :code $ quote $ let + empty-fields $ read-login-fields initial-state + source $ {} (:username "|用户🌱") (:password "|密钥") (:extra false) + filled $ read-login-fields source + assert= | $ :username empty-fields + assert= | $ :password empty-fields + assert= "|用户🌱" $ :username filled + assert= "|密钥" $ :password filled + assert= false $ &map:get source :extra + :tags $ #{} :login-fields :unit + %{} 'TestEntry (:name |rejects-invalid-and-missing-fields) + :code $ quote $ do + assert= true $ try + do + read-login-fields $ {} (:username 2) (:password |) + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + assert= true $ try + do + read-login-fields $ {} $ :username | + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + :tags $ #{} :login-fields :unit :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.comp.login :require - [] respo.core :refer $ [] defcomp <> div input button span - [] respo.comp.space :refer $ [] =< - [] respo.comp.inspect :refer $ [] comp-inspect - [] respo-ui.core :as ui - [] app.schema :as schema - [] app.style :as style - [] respo-md.comp.md :refer $ [] comp-md-block - [] app.config :as config + respo.core :refer $ defcomp <> div input button span + respo.comp.space :refer $ =< + respo.comp.inspect :refer $ comp-inspect + respo-ui.core :as ui + app.schema :as schema + app.style :as style + respo-md.comp.md :refer $ comp-md-block + app.config :as config + js-ffi.browser :refer $ storage-set! 'app.comp.navigation $ %{} 'FileEntry :defs $ {} + 'NavigationProps $ %{} 'CodeEntry (:doc |) + :code $ quote $ defstruct NavigationProps + :style $ :: 'Map 'Tag 'Dynamic + :on-click 'respo.schema/EventHandler + :examples $ [] + :schema $ :: 'StructDef 'comp-navigation $ %{} 'CodeEntry (:doc |) :code $ quote $ defcomp comp-navigation (logged-in? members-count) div @@ -600,22 +1075,51 @@ div {} $ :style ui/column div - {} - :on-click $ fn (e d!) - d! :router/change $ {} $ :name :home - :style style-entry + NavigationProps :on-click + fn (e d!) + hint-fn $ {} + :args $ [] (:: 'Map 'Tag 'Dynamic) + :: 'Fn $ {} + :args $ [] 'Dynamic + :return 'Unit + :return 'Unit + d! $ :: :router/change $ {} (:name :home) + , &unit + , :style style-entry <> |Table $ {} $ :font-size 14 - <> (str members-count) + <> (navigation-count-text members-count) {} $ :font-size 20 div - {} - :style $ {} $ :cursor |pointer - :on-click $ fn (e d!) - d! :router/change $ {} $ :name :profile + NavigationProps :style + {} $ :cursor |pointer + , :on-click $ fn (e d!) + hint-fn $ {} + :args $ [] (:: 'Map 'Tag 'Dynamic) + :: 'Fn $ {} + :args $ [] 'Dynamic + :return 'Unit + :return 'Unit + d! $ :: :router/change $ {} (:name :profile) + , &unit <> $ if logged-in? |Me |Guest :examples $ [] :schema $ :: 'Fn $ {} (:return 'respo.schema/Component) - :args $ [] 'Bool 'Number + :args $ [] 'Bool $ :: 'Option 'Number + 'navigation-count-text $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn navigation-count-text (members-count) + match members-count + (:some value) (str value) + (:none) (str nil) + :examples $ [] + :schema $ :: 'Fn $ {} (:return 'String) + :args $ [] $ :: 'Option 'Number + :tests $ [] $ %{} 'TestEntry (:name |missing-and-zero-count-display) + :code $ quote $ do + assert= (str nil) + navigation-count-text $ Option :none + assert= |0 $ navigation-count-text $ Option :some 0 + assert= |2 $ navigation-count-text $ Option :some 2 + :tags $ #{} :navigation-view :unit 'style-entry $ %{} 'CodeEntry (:doc |) :code $ quote $ def style-entry {} (:cursor :pointer) (:padding "|8px 0") @@ -624,27 +1128,90 @@ :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.comp.navigation :require - [] respo-ui.core :refer $ [] hsl - [] respo-ui.core :as ui - [] respo.core :refer $ [] defcomp <> span div - [] respo.comp.space :refer $ [] =< + respo-ui.core :refer $ hsl + respo-ui.core :as ui + respo.core :refer $ defcomp <> span div + respo.comp.space :refer $ =< 'app.comp.previewer $ %{} 'FileEntry :defs $ {} + 'ParagraphDropProps $ %{} 'CodeEntry (:doc |) + :code $ quote $ defstruct ParagraphDropProps + :style $ :: 'Map 'Tag 'Dynamic + :on-drop 'respo.schema/EventHandler + :on-dragover 'respo.schema/EventHandler + :on-dragenter 'respo.schema/EventHandler + :examples $ [] + :schema $ :: 'StructDef + 'article-text $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn article-text (article) + let + title $ read-article-title article + paragraphs $ decode-map-as (&map:get article :paragraphs) + :: 'Map 'String $ :: 'Map 'Tag 'Dynamic + entries $ map-entries paragraphs + contents $ -> entries + .sort-by $ fn (entry) (:key entry) + .map $ fn (entry) + read-paragraph-content $ :value entry + str &newline "|# " title &newline &newline |---- &newline &newline $ .join-string contents $ str &newline &newline |---- &newline &newline + :examples $ [] + :schema $ :: 'Fn $ {} (:return 'String) + :args $ [] $ :: 'Map 'Tag 'Dynamic + :tests $ [] + %{} 'TestEntry (:name |export-orders-keys-and-preserves-unicode) + :code $ quote $ let + article $ {} (:title "|协作🐈") + :paragraphs $ {} + |b $ {} $ :content "|第二段" + |a $ {} $ :content | + expected $ str &newline "|# 协作🐈" &newline &newline |---- &newline &newline | &newline &newline |---- &newline &newline "|第二段" + assert= expected $ article-text article + :tags $ #{} :export :unit + %{} 'TestEntry (:name |export-empty-paragraphs-preserves-header) + :code $ quote $ let + article $ {} (:title |) + :paragraphs $ {} + assert= (str &newline "|# " &newline &newline |---- &newline &newline) (article-text article) + :tags $ #{} :export :unit + %{} 'TestEntry (:name |export-rejects-invalid-wire-fields) + :code $ quote $ let + rejected? $ fn (article) + hint-fn $ {} + :args $ [] $ :: 'Map 'Tag 'Dynamic + :return 'Bool + try + do (article-text article) false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + assert= true $ rejected? $ {} (:title 42) + :paragraphs $ {} + assert= true $ rejected? $ {} (:title |Title) + :paragraphs $ {} $ 1 + {} $ :content |body + assert= true $ rejected? $ {} (:title |Title) + :paragraphs $ {} $ |a + {} $ :content 42 + :tags $ #{} :export :unit 'comp-info-list $ %{} 'CodeEntry (:doc |) :code $ quote $ defcomp comp-info-list (focus-list) let - focus-map $ unsafe-coerce focus-list 'Map + focus-records $ read-focus-list focus-list list-> {} $ :style ui/row - -> focus-map (.to-list) - .map $ fn (info) - let - info-map $ unsafe-coerce info 'Map - [] (&map:get info-map :sid) - div - {} $ :style $ {} (:padding "|0 8px") (:border-radius |16px) (:margin-right 8) - :border $ str "|1px solid " $ hsl 0 0 90 - <> $ &map:get info-map :name + -> focus-records $ .map $ fn (info) + let + info-map info + [] (&map:get info-map :sid) + div + {} $ :style $ {} (:padding "|0 8px") (:border-radius |16px) (:margin-right 8) + :border $ str "|1px solid " $ hsl 0 0 90 + match (read-focus-name info-map) + (:none) + span $ {} + (:some focus-name) (<> focus-name) :examples $ [] :schema $ :: 'Fn $ {} (:return 'respo.schema/Component) :args $ [] 'Dynamic @@ -652,74 +1219,98 @@ 'comp-paragraph $ %{} 'CodeEntry (:doc |) :code $ quote $ defcomp comp-paragraph (states sort-id paragraph focus-list focused?) let - states-map $ unsafe-coerce states 'Map - paragraph-map $ unsafe-coerce paragraph 'Map + states-map $ decode-map-as states 'Map + paragraph-map $ decode-map-as paragraph $ :: 'Map 'Tag 'Dynamic + paragraph-text $ read-paragraph-content paragraph cursor $ &map:get states-map :cursor state $ or (&map:get states-map :data) {} (:text |) (:time 0) div - unsafe-coerce - {} - :style $ merge - unsafe-coerce ui/column $ :: 'Map 'Tag 'Dynamic - unsafe-coerce - {} (:background-color :white) (:border-radius |6px) (:margin-bottom 12) - :border $ str "|1px solid " $ hsl 0 0 90 - :: 'Map 'Tag 'Dynamic - :on-drop $ fn (e d!) + ParagraphDropProps :style + merge ui/column $ {} (:background-color :white) (:border-radius |6px) (:margin-bottom 12) + :border $ str "|1px solid " $ hsl 0 0 90 + , :on-drop + fn (e d!) + hint-fn $ {} + :args $ [] (:: 'Map 'Tag 'Dynamic) + :: 'Fn $ {} + :args $ [] 'Dynamic + :rest 'Dynamic + :return 'Unit + :return 'Unit let event $ unsafe-coerce option:unwrap-or (get e :event) (js-object) - , DragEventHost + , 'app.ffi.drag/DragEventHost data-transfer $ option:unwrap $ js-nullish->option (js-get event :data-transfer) data $ data-transfer .get-data |text event .stop-propagation! if (not= sort-id data) - d! :paragraph/move $ {} (:target data) (:base sort-id) - :on-dragover $ fn (e d!) - let - event $ unsafe-coerce - option:unwrap-or (get e :event) (js-object) - , DragEventHost - event .prevent-default! - :on-dragenter $ fn (e d!) - let - event $ unsafe-coerce - option:unwrap-or (get e :event) (js-object) - , DragEventHost - event .prevent-default! - , respo.schema/DomProps - comp-md-block (&map:get paragraph-map :content) - {} (:class-name |preview-content) - :style $ {} $ :padding "|0 16px" - :highlight $ fn (code lang) + d! $ :: :paragraph/move $ {} (:target data) (:base sort-id) + , &unit + , :on-dragover + fn (e d!) + hint-fn $ {} + :args $ [] (:: 'Map 'Tag 'Dynamic) + :: 'Fn $ {} + :args $ [] 'Dynamic + :rest 'Dynamic + :return 'Unit + :return 'Unit + let + event $ unsafe-coerce + option:unwrap-or (get e :event) (js-object) + , 'app.ffi.drag/DragEventHost + event .prevent-default! + , &unit + , :on-dragenter $ fn (e d!) + hint-fn $ {} + :args $ [] (:: 'Map 'Tag 'Dynamic) + :: 'Fn $ {} + :args $ [] 'Dynamic + :rest 'Dynamic + :return 'Unit + :return 'Unit + let + event $ unsafe-coerce + option:unwrap-or (get e :event) (js-object) + , 'app.ffi.drag/DragEventHost + event .prevent-default! + , &unit + comp-md-block paragraph-text $ {} (:class-name |preview-content) + :style $ {} $ :padding "|0 16px" + :highlight $ fn (code lang) + hint-fn $ {} + :args $ [] 'String 'String + :return 'String + decode-map-as if (contains? supprted-langs lang) let - highlighter $ unsafe-coerce hljs HighlightHost + highlighter $ unsafe-coerce hljs 'app.ffi.highlight/HighlightHost result $ highlighter .highlight - option:unwrap-or - get supprted-langs $ assert-type lang 'String - , | + option:unwrap-or (get supprted-langs lang) | , code result :value escape-html code + , 'String div - unsafe-coerce - {} - :style $ merge - unsafe-coerce ui/row-parted $ :: 'Map 'Tag 'Dynamic - unsafe-coerce - {} (:padding "|4px 8px") (:cursor :move) (:min-height 40) - :: 'Map 'Tag 'Dynamic - :draggable true - :on-dragstart $ fn (e d!) - let - event $ unsafe-coerce - option:unwrap-or (get e :event) (js-object) - , DragEventHost - data-transfer $ option:unwrap $ js-nullish->option (js-get event :data-transfer) - data-transfer .set-data! |text $ str sort-id - , respo.schema/DomProps + ToolbarDragProps :style + merge ui/row-parted $ {} (:padding "|4px 8px") (:cursor :move) (:min-height 40) + , :draggable true :on-dragstart $ fn (e d!) + hint-fn $ {} + :args $ [] (:: 'Map 'Tag 'Dynamic) + :: 'Fn $ {} + :args $ [] 'Dynamic + :rest 'Dynamic + :return 'Unit + :return 'Unit + let + event $ unsafe-coerce + option:unwrap-or (get e :event) (js-object) + , 'app.ffi.drag/DragEventHost + data-transfer $ option:unwrap $ js-nullish->option (js-get event :data-transfer) + data-transfer .set-data! |text $ str sort-id + , &unit comp-info-list focus-list div {} $ :style ui/row @@ -727,18 +1318,23 @@ div {} :style $ {} $ :cursor :pointer - :on-click $ fn (e d!) (d! :paragraph/finish-editing sort-id) + :on-click $ fn (e d!) + d! $ :: :paragraph/finish-editing sort-id comp-i :eye 14 $ hsl 200 80 70 div {} :style $ {} $ :cursor :pointer - :on-click $ fn (e d!) (d! :paragraph/edit sort-id) (delay-focus! 400 |.editor-area) + :on-click $ fn (e d!) + d! $ :: :paragraph/edit sort-id + delay-focus! 400 |.editor-area comp-i :edit 14 $ hsl 200 80 70 =< 16 nil div {} :style $ {} $ :cursor :pointer - :on-click $ fn (e d!) (d! :paragraph/append-to sort-id) (delay-focus! 400 |.editor-area) + :on-click $ fn (e d!) + d! $ :: :paragraph/append-to sort-id + delay-focus! 400 |.editor-area comp-i :file-plus 14 $ hsl 200 70 80 :examples $ [] :schema $ :: 'Fn $ {} (:return 'respo.schema/Component) @@ -747,67 +1343,56 @@ 'comp-previewer $ %{} 'CodeEntry (:doc |) :code $ quote $ defcomp comp-previewer (states article focuses members sort-id) let - article-map $ unsafe-coerce article 'Map - focuses-map $ unsafe-coerce focuses 'Map - members-map $ unsafe-coerce members 'Map - paragraphs-map $ unsafe-coerce (&map:get article-map :paragraphs) 'Map - div $ {} $ :style - merge - unsafe-coerce ui/flex $ :: 'Map 'Tag 'Dynamic - unsafe-coerce ui/column $ :: 'Map 'Tag 'Dynamic - unsafe-coerce - {} (:overflow :auto) (:padding-bottom 20) (:padding-top 32) - :: 'Map 'Tag 'Dynamic + article-map $ decode-map-as article $ :: 'Map 'Tag 'Dynamic + article-title $ read-article-title article + focuses-map $ decode-map-as focuses $ :: 'Map 'String + :: 'List $ :: 'Map 'Tag 'Dynamic + members-map $ decode-map-as members $ :: 'Map 'Number 'Dynamic + paragraphs-map $ decode-map-as (&map:get article-map :paragraphs) + :: 'Map 'String $ :: 'Map 'Tag 'Dynamic div - {} $ :style $ merge - unsafe-coerce ui/column $ :: 'Map 'Tag 'Dynamic - unsafe-coerce - {} (:max-width 960) (:width |96%) (:margin "|0px auto") - :: 'Map 'Tag 'Dynamic + {} $ :style $ merge ui/flex ui/column + {} (:overflow :auto) (:padding-bottom 20) (:padding-top 32) div - {} $ :style ui/row-parted + {} $ :style $ merge ui/column + {} (:max-width 960) (:width |96%) (:margin "|0px auto") div - {} $ :style $ merge - unsafe-coerce ui/row $ :: 'Map 'Tag 'Dynamic - unsafe-coerce + {} $ :style ui/row-parted + div + {} $ :style $ merge ui/row {} $ :align-items :center - :: 'Map 'Tag 'Dynamic - <> (&map:get article-map :title) - {} (:font-family ui/font-fancy) (:font-size 24) - =< 8 nil - list-> - {} $ :style $ merge - unsafe-coerce ui/row $ :: 'Map 'Tag 'Dynamic - unsafe-coerce + <> article-title $ {} (:font-family ui/font-fancy) (:font-size 24) + =< 8 nil + list-> + {} $ :style $ merge ui/row {} $ :display :inline-block - :: 'Map 'Tag 'Dynamic - -> members-map (.to-list) - .map-pair $ fn (k username) - [] k $ span - {} $ :style $ {} (:margin-right 8) - :color $ hsl 0 0 70 - <> username - div - {} $ :style ui/row - comp-text-viewer article - =< 16 nil - button - {} - :style $ merge style/button $ {} - :on-click $ fn (e d!) (d! :paragraph/prepend nil) (delay-focus! 400 |.editor-area) - <> |Prepend - =< nil 16 - list-> - {} $ :style $ merge - unsafe-coerce ui/flex $ :: 'Map 'Tag 'Dynamic - unsafe-coerce ui/column $ :: 'Map 'Tag 'Dynamic - unsafe-coerce + -> members-map (.to-list) + .map-pair $ fn (k username) + [] k $ span + {} $ :style $ {} (:margin-right 8) + :color $ hsl 0 0 70 + if (nil? username) + span $ {} + <> $ decode-map-as username 'String + div + {} $ :style ui/row + comp-text-viewer article + =< 16 nil + button + {} + :style $ merge style/button $ {} + :on-click $ fn (e d!) + d! $ :: :paragraph/prepend nil + delay-focus! 400 |.editor-area + <> |Prepend + =< nil 16 + list-> + {} $ :style $ merge ui/flex ui/column {} $ :border $ str "|1px solid " (hsl 0 0 94) - :: 'Map 'Tag 'Dynamic - -> paragraphs-map (.to-list) (.sort-by first) - .map-pair $ fn (k paragraph) - [] k $ comp-paragraph (>> states k) k paragraph (&map:get focuses-map k) (= k sort-id) - =< nil 300 + -> paragraphs-map (.to-list) (.sort-by first) + .map-pair $ fn (k paragraph) + [] k $ comp-paragraph (>> states k) k paragraph (&map:get focuses-map k) (= k sort-id) + =< nil 300 :examples $ [] :schema $ :: 'Fn $ {} (:return 'respo.schema/Component) :args $ [] 'Dynamic 'Dynamic 'Dynamic 'Dynamic 'Dynamic @@ -815,28 +1400,86 @@ 'comp-text-viewer $ %{} 'CodeEntry (:doc |) :code $ quote $ defcomp comp-text-viewer (article) let - article-map $ unsafe-coerce article 'Map + article-map $ decode-map-as article $ :: 'Map 'Tag 'Dynamic button {} :style $ merge style/button $ {} :on-click $ fn (e d!) let child $ option:unwrap $ window-open | - paragraphs $ unsafe-coerce (&map:get article-map :paragraphs) 'Map - content $ str &newline "|# " (&map:get article-map :title) &newline &newline |---- &newline &newline $ -> paragraphs (.to-list) (.sort-by first) - map $ fn (pair) - let - paragraph-map $ unsafe-coerce (last pair) 'Map - &map:get paragraph-map :content - .join-str $ str &newline &newline |---- &newline &newline + content $ article-text article-map html $ str |
 (escape-html content) |
- document $ unsafe-coerce (child :document) DocumentWriterHost + document $ unsafe-coerce (child :document) 'app.ffi.popup/DocumentWriterHost document .write! html <> |Text :examples $ [] :schema $ :: 'Fn $ {} (:return 'respo.schema/Component) :args $ [] 'Dynamic :features $ #{} :js-ffi + 'read-focus-list $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn read-focus-list (value) + if (nil? value) ([]) + decode-map-as value $ :: 'List $ :: 'Map 'Tag 'Dynamic + :examples $ [] + :schema $ :: 'Fn $ {} + :args $ [] 'Dynamic + :return $ :: 'List $ :: 'Map 'Tag 'Dynamic + :tests $ [] + %{} 'TestEntry + :name |absent-focus-is-empty-and-numeric-session-key-is-preserved + :code $ quote $ let + record $ {} (:sid 7) (:name "|成员🌱") + assert= ([]) (read-focus-list nil) + assert= ([] record) + read-focus-list $ [] record + :tags $ #{} :projection :unit + %{} 'TestEntry (:name |rejects-map-instead-of-projected-focus-list) + :code $ quote $ assert= true + try + do + read-focus-list $ {} + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + :tags $ #{} :projection :unit + 'read-paragraph-content $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn read-paragraph-content (value) + let + value-map $ decode-map-as value $ :: 'Map 'Tag 'Dynamic + decode-map-as (&map:get value-map :content) 'String + :examples $ [] + :schema $ :: 'Fn $ {} (:return 'String) + :args $ [] 'Dynamic + :tests $ [] + %{} 'TestEntry (:name |empty-and-unicode-text) + :code $ quote $ do + assert= | $ read-paragraph-content $ {} (:content |) + assert= "|内容🌱" $ read-paragraph-content $ {} (:content "|内容🌱") (:extra false) + :tags $ #{} :text-boundary :unit + %{} 'TestEntry (:name |rejects-missing-and-non-text) + :code $ quote $ do + assert= true $ try + do + read-paragraph-content $ {} + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + assert= true $ try + do + read-paragraph-content $ {} $ :content 4 + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + :tags $ #{} :text-boundary :unit 'supprted-langs $ %{} 'CodeEntry (:doc |) :code $ quote $ def supprted-langs {} (|clojure |clojure) (|javascript |javascript) (|js |javascript) (|bash |bash) @@ -845,88 +1488,116 @@ :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.comp.previewer :require - [] respo-ui.core :refer $ [] hsl - [] respo-ui.core :as ui - [] respo.core :refer $ [] defcomp <> >> list-> span div button textarea - [] respo-md.comp.md :refer $ [] comp-md-block - [] respo.comp.space :refer $ [] =< - [] app.style :as style - [] |highlight.js/lib/core :default hljs - [] |escape-html :default escape-html - [] clojure.string :as string - [] app.util :refer $ [] delay-focus! - [] feather.core :refer $ [] comp-i + respo-ui.core :refer $ hsl + respo-ui.core :as ui + respo.core :refer $ defcomp <> >> list-> span div button textarea + respo-md.comp.md :refer $ comp-md-block + respo.comp.space :refer $ =< + app.style :as style + |highlight.js/lib/core :default hljs + |escape-html :default escape-html + clojure.string :as string + app.util :refer $ delay-focus! + feather.core :refer $ comp-i app.ffi.drag :refer $ DragEventHost - app.ffi.highlight :refer $ [] HighlightHost HighlightResultHost - app.ffi.popup :refer $ [] DocumentWriterHost - js-ffi.browser :refer $ [] window-open + app.ffi.highlight :refer $ HighlightHost HighlightResultHost + app.ffi.popup :refer $ DocumentWriterHost + js-ffi.browser :refer $ window-open + app.comp.articles :refer $ read-article-title read-focus-name + app.comp.editor-toolbar :refer $ ToolbarDragProps 'app.comp.profile $ %{} 'FileEntry - :defs $ {} $ 'comp-profile - %{} 'CodeEntry (:doc |) + :defs $ {} + 'comp-profile $ %{} 'CodeEntry (:doc |) :code $ quote $ defcomp comp-profile (user members) let - user-map $ unsafe-coerce user 'Map - members-map $ unsafe-coerce members 'Map - div $ {} $ :style - merge ui/flex $ {} $ :padding 16 + user-map $ decode-map-as user $ :: 'Map 'Tag 'Dynamic + members-map $ read-profile-members members div - {} $ :style $ {} (:font-family ui/font-fancy) (:font-size 32) (:font-weight 100) - <> $ str "|Hello! " $ &map:get user-map :name - =< nil 16 - div - {} $ :style ui/row - <> |Members: - =< 8 nil - list-> + {} $ :style $ merge ui/flex + {} $ :padding 16 + div + {} $ :style $ {} (:font-family ui/font-fancy) (:font-size 32) (:font-weight 100) + <> $ str "|Hello! " $ &map:get user-map :name + =< nil 16 + div {} $ :style ui/row - -> members-map (.to-list) - .map-pair $ fn (k username) - [] k $ div - {} $ :style $ {} (:padding "|0 8px") - :border $ str "|1px solid " $ hsl 0 0 80 - :border-radius |16px - :margin "|0 4px" - <> username - =< nil 48 - div ({}) - button - {} - :style $ merge ui/button - :on-click $ fn (e d!) - js/location.replace $ str js/location.origin |?time= $ .now js/Date - <> |Refresh - =< 8 nil - button - {} - :style $ merge ui/button $ {} (:color :red) (:border-color :red) - :on-click $ fn (e dispatch!) (dispatch! :user/log-out nil) - .removeItem js/localStorage $ :storage-key config/site - <> "|Log out" + <> |Members: + =< 8 nil + list-> + {} $ :style ui/row + -> members-map (.to-list) + .map-pair $ fn (k username) + [] k $ div + {} $ :style $ {} (:padding "|0 8px") + :border $ str "|1px solid " $ hsl 0 0 80 + :border-radius |16px + :margin "|0 4px" + if (nil? username) + span $ {} + <> $ decode-map-as username 'String + =< nil 48 + div ({}) + button + {} + :style $ merge ui/button + :on-click $ fn (e d!) + js/location.replace $ str js/location.origin |?time= $ .now js/Date + <> |Refresh + =< 8 nil + button + {} + :style $ merge ui/button $ {} (:color :red) (:border-color :red) + :on-click $ fn (e dispatch!) + dispatch! $ :: :user/log-out nil + storage-remove! $ :storage-key config/site + <> "|Log out" :examples $ [] :schema $ :: 'Fn $ {} (:return 'respo.schema/Component) :args $ [] 'Dynamic 'Dynamic :features $ #{} :js-ffi + 'read-profile-members $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn read-profile-members (value) + decode-map-as value $ :: 'Map 'Number 'Dynamic + :examples $ [] + :schema $ :: 'Fn $ {} + :args $ [] 'Dynamic + :return $ :: 'Map 'Number 'Dynamic + :tests $ [] + %{} 'TestEntry + :name |numeric-session-keys-preserve-string-and-absent-names + :code $ quote $ let + value $ {} (7 "|成员🌱") (0 nil) + assert= value $ read-profile-members value + :tags $ #{} :projection :unit + %{} 'TestEntry (:name |rejects-string-session-key-without-coercion) + :code $ quote $ assert= true + try + do + read-profile-members $ {} $ |7 "|成员" + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + :tags $ #{} :projection :unit :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.comp.profile :require - [] respo-ui.core :refer $ [] hsl - [] app.schema :as schema - [] respo-ui.core :as ui - [] respo.core :refer $ [] defcomp list-> <> span button div a - [] respo.comp.space :refer $ [] =< - [] app.style :as style - [] app.config :as config + respo-ui.core :refer $ hsl + app.schema :as schema + respo-ui.core :as ui + respo.core :refer $ defcomp list-> <> span button div a + respo.comp.space :refer $ =< + app.style :as style + app.config :as config + js-ffi.browser :refer $ storage-remove! 'app.config $ %{} 'FileEntry :defs $ {} - 'cdn? $ %{} 'CodeEntry (:doc |) - :code $ quote $ def cdn? - cond - exists? js/window - , false - (exists? js/process) (= |true js/process.env.cdn) - :else false + 'SiteConfig $ %{} 'CodeEntry (:doc |) + :code $ quote $ defstruct SiteConfig (:port 'Number) (:title 'String) (:icon 'String) (:theme 'String) (:storage-key 'String) (:storage-file 'String) :examples $ [] - :schema $ :: 'Dynamic + :schema $ :: 'StructDef 'dev? $ %{} 'CodeEntry (:doc |) :code $ quote $ def dev? = |dev $ option:unwrap-or (get-env |mode) |release @@ -934,9 +1605,18 @@ :schema $ :: 'Dynamic 'site $ %{} 'CodeEntry (:doc |) :code $ quote $ def site - {} (:port 11003) (:title |Table2) (:icon |http://cdn.tiye.me/logo/topix.png) (:theme |#eeeeff) (:storage-key |table2) (:storage-file |storage.cirru) - :examples $ [] - :schema $ :: 'Dynamic + SiteConfig :port 11003 :title |Table2 :icon |http://cdn.tiye.me/logo/topix.png :theme |#eeeeff :storage-key |table2 :storage-file |storage.cirru + :examples $ [] + :schema $ :: 'app.config/SiteConfig + :tests $ [] $ %{} 'TestEntry (:name |preserves-original-site-values) + :code $ quote $ do + assert= 11003 $ :port site + assert= |Table2 $ :title site + assert= |http://cdn.tiye.me/logo/topix.png $ :icon site + assert= |#eeeeff $ :theme site + assert= |table2 $ :storage-key site + assert= |storage.cirru $ :storage-file site + :tags $ #{} :site-config :unit :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.config 'app.ffi.drag $ %{} 'FileEntry @@ -1009,7 +1689,7 @@ :ffi $ {} (:backend :js) (:kind :external-object) (:target :browser) :schema $ :: 'Trait 'QueryHost $ %{} 'CodeEntry (:doc |) - :code $ quote $ deftrait QueryHost (:host 'Dynamic) (:port 'Dynamic) + :code $ quote $ deftrait QueryHost (:host 'String) (:port 'String) :examples $ [] :ffi $ {} (:backend :js) (:kind :external-object) (:target :browser) :schema $ :: 'Trait @@ -1042,6 +1722,80 @@ {} (:id nil) (:content |) (:time nil) :examples $ [] :schema $ :: 'Dynamic + 'read-dispatch-operation $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn read-dispatch-operation (value) + if (enum? value) value $ raise |Invalid-render-operation + :examples $ [] + :schema $ :: 'Fn $ {} (:return 'Enum) + :args $ [] 'Dynamic + :tests $ [] + %{} 'TestEntry (:name |dispatch-preserves-enum-payload) + :code $ quote $ let + op $ :: :states ([] :article 42) + {} $ :text "|正文🐈" + assert= op $ read-dispatch-operation op + :tags $ #{} :operation :unit + %{} 'TestEntry (:name |dispatch-rejects-non-enum-input) + :code $ quote $ let + rejected? $ fn (value) + hint-fn $ {} + :args $ [] 'Dynamic + :return 'Bool + try + do (read-dispatch-operation value) false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + &= message |Invalid-render-operation + assert= true $ rejected? nil + assert= true $ rejected? $ {} + assert= true $ rejected? |operation + :tags $ #{} :operation :unit + 'read-patch-changes $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn read-patch-changes (value) (recollect.schema/decode-changes value) + :examples $ [] + :schema $ :: 'Fn $ {} + :args $ [] 'Dynamic + :return $ :: 'List 'recollect.schema/change-op + :tests $ [] + %{} 'TestEntry (:name |patch-empty-and-valid-enums) + :code $ quote $ let + changes $ [] + recollect.schema/change-op :replace $ {} $ :title "|正文🐈" + recollect.schema/change-op :vec-drop 0 + assert= ([]) + read-patch-changes $ [] + assert= changes $ read-patch-changes changes + :tags $ #{} :input-boundary :unit + %{} 'TestEntry (:name |patch-rejects-invalid-shape-before-applying) + :code $ quote $ let + rejected? $ fn (value) + hint-fn $ {} + :args $ [] 'Dynamic + :return 'Bool + try + do (read-patch-changes value) false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + assert= true $ rejected? $ {} + assert= true $ rejected? $ [] 42 + assert= true $ rejected? $ [] (:: :unknown nil) + assert= true $ rejected? $ [] (:: :vec-drop |not-a-number) + :tags $ #{} :input-boundary :unit + %{} 'TestEntry (:name |patch-reifies-real-edn-wire-enums) + :code $ quote $ let + original $ [] + recollect.schema/change-op :replace $ {} $ :title "|正文🐈" + recollect.schema/change-op :update-in ([] :sessions 42) + recollect.schema/change-op :pick :messages $ [] $ recollect.schema/change-op :map-splice (#{} |old) + {} $ |new $ {} (:text "|消息") + wire $ parse-cirru-edn $ format-cirru-edn original + assert= original $ read-patch-changes wire + :tags $ #{} :input-boundary :unit 'router $ %{} 'CodeEntry (:doc |) :code $ quote $ def router {} (:name nil) (:title nil) @@ -1070,13 +1824,13 @@ '*client-caches $ %{} 'CodeEntry (:doc |) :code $ quote $ defatom *client-caches ({}) :examples $ [] - :schema $ :: 'Dynamic + :schema $ :: 'Ref $ :: 'Map 'Number (:: 'Map 'Tag 'Dynamic) '*initial-db $ %{} 'CodeEntry (:doc |) :code $ quote $ defatom *initial-db if - path-exists? $ w-log storage-file + path-exists? $ dbg storage-file do (println "|Found local EDN data") - merge-dynamic schema/database $ assert-type + merge schema/database $ decode-map-as parse-cirru-edn $ read-file storage-file :: 'Map 'Tag 'Dynamic do (println "|Found no data") schema/database @@ -1085,12 +1839,12 @@ '*reader-reel $ %{} 'CodeEntry (:doc |) :code $ quote $ defatom *reader-reel @*reel :examples $ [] - :schema $ :: 'Dynamic + :schema $ :: 'Ref $ :: 'cumulo-reel.core/ReelState (:: 'Map 'Tag 'Dynamic) '*reel $ %{} 'CodeEntry (:doc |) :code $ quote $ defatom *reel - struct-with reel-schema (:base @*initial-db) (:db @*initial-db) + ReelState :base @*initial-db :db @*initial-db :records ([]) :merged? false :examples $ [] - :schema $ :: 'Dynamic + :schema $ :: 'Ref $ :: 'cumulo-reel.core/ReelState (:: 'Map 'Tag 'Dynamic) 'dispatch! $ %{} 'CodeEntry (:doc |) :code $ quote $ defn dispatch! (op op-data sid) let @@ -1099,9 +1853,24 @@ if config/dev? $ println |Dispatch! (str op) op-data sid if (= op :effect/persist) (persist-db!) reset! *reel $ reel-reducer @*reel updater (:: op op-data) sid op-id op-time config/dev? + , &unit :examples $ [] :schema $ :: 'Fn $ {} (:return 'Unit) :args $ [] 'Tag 'Dynamic 'Number + :tests $ [] $ %{} 'TestEntry (:name |unit-result-preserves-state-transition) + :code $ quote $ let + reel-before @*reel + dispatch-result $ dispatch! :unknown nil 42 + reel-after @*reel + reset! *reel reel-before + assert= &unit dispatch-result + assert= (:db reel-before) (:db reel-after) + assert= + if config/dev? + inc $ count $ :records reel-before + count $ :records reel-before + count $ :records reel-after + :tags $ #{} :server-effect :unit 'get-backup-path! $ %{} 'CodeEntry (:doc |) :code $ quote $ defn get-backup-path! () let @@ -1117,14 +1886,15 @@ println "|Running mode:" $ if config/dev? |dev |release let port $ let - default-port $ assert-type (&map:get config/site :port) Number + default-port $ assert-type (:port config/site) Number match (get-env |port) (:some raw) result:unwrap-or (parse-float raw) default-port (:none) default-port run-server! port println $ str "|Server started on port:" port - do (; "|init it before doing multi-threading") (identity @*reader-reel) + ; "|init it before doing multi-threading" + identity @*reader-reel set-interval 200 $ fn () $ render-loop! set-interval 600000 $ fn () $ persist-db! on-control-c on-exit! @@ -1144,6 +1914,7 @@ backup-path $ get-backup-path! check-write-file! storage-path file-content check-write-file! backup-path file-content + , &unit :examples $ [] :schema $ :: 'Fn $ {} (:return 'Unit) :args $ [] @@ -1153,7 +1924,7 @@ clear-twig-caches! reset! *reel $ refresh-reel @*reel assert-type @*initial-db $ :: 'Map 'Tag 'Dynamic - , updater + , replay-updater sync-clients! @*reader-reel :examples $ [] :schema $ :: 'Fn $ {} (:return 'Dynamic) @@ -1164,9 +1935,27 @@ not $ identical? @*reader-reel @*reel reset! *reader-reel @*reel sync-clients! @*reader-reel + , &unit :examples $ [] - :schema $ :: 'Fn $ {} (:return 'Dynamic) + :schema $ :: 'Fn $ {} (:return 'Unit) :args $ [] + :tests $ [] $ %{} 'TestEntry (:name |unchanged-reel-still-returns-unit) + :code $ quote $ let + original @*reader-reel + reset! *reader-reel @*reel + assert= &unit $ render-loop! + assert= true $ identical? @*reader-reel @*reel + reset! *reader-reel original + :tags $ #{} :server-effect :unit + 'replay-updater $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn replay-updater (db op sid op-id op-time) + if (enum? op) + updater db op (decode-map-as sid 'Number) (decode-map-as op-id 'String) (decode-map-as op-time 'Number) + raise "|replay operation must be an Enum" + :examples $ [] + :schema $ :: 'Fn $ {} + :args $ [] (:: 'Map 'Tag 'Dynamic) 'Dynamic 'Dynamic 'Dynamic 'Dynamic + :return $ :: 'Map 'Tag 'Dynamic 'run-server! $ %{} 'CodeEntry (:doc |) :code $ quote $ defn run-server! (port) wss-serve! (&{} :port port) @@ -1176,9 +1965,12 @@ do (dispatch! :session/connect nil sid) (println "|New client.") (:message sid msg) let - action $ parse-cirru-edn msg + action $ decode-map-as (parse-cirru-edn msg) (:: 'Map 'Tag 'Dynamic) case-default (&map:get action :kind) (println "|unknown action:" action) - :op $ dispatch! (&map:get action :op) (&map:get action :data) sid + :op $ dispatch! + decode-map-as (&map:get action :op) 'Tag + &map:get action :data + , sid (:disconnect sid) do (println "|Client closed!") (dispatch! :session/disconnect nil sid) _ $ println "|unknown data:" data @@ -1188,8 +1980,8 @@ 'storage-file $ %{} 'CodeEntry (:doc |) :code $ quote $ def storage-file if (empty? calcit-dirname) - str calcit-dirname $ option:unwrap $ get config/site :storage-file - str calcit-dirname |/ $ option:unwrap $ get config/site :storage-file + str calcit-dirname $ :storage-file config/site + str calcit-dirname |/ $ :storage-file config/site :examples $ [] :schema $ :: 'Dynamic 'sync-clients! $ %{} 'CodeEntry (:doc |) @@ -1200,7 +1992,9 @@ db $ :db reel-state records $ :records reel-state session $ get-in db $ [] :sessions sid - old-store $ option:unwrap-or (get @*client-caches sid) nil + old-store $ match (get @*client-caches sid) + (:some previous-store) previous-store + (:none) nil new-store $ twig-container db session records changes $ diff-twig old-store new-store $ {} (:key :id) ; when config/dev? $ println "|Changes for" sid |: changes $ count records @@ -1208,16 +2002,18 @@ not $ empty? changes wss-send! sid $ format-cirru-edn $ {} (:kind :patch) (:data changes) swap! *client-caches assoc sid new-store + , &unit finish-twig-frame! + , &unit :examples $ [] - :schema $ :: 'Fn $ {} (:return 'Dynamic) + :schema $ :: 'Fn $ {} (:return 'Unit) :args $ [] 'Dynamic :features $ #{} :js-ffi :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.server :require (app.schema :as schema) app.updater :refer $ updater - cumulo-reel.core :refer $ reel-reducer refresh-reel reel-schema + cumulo-reel.core :refer $ reel-reducer refresh-reel reel-schema ReelState app.config :as config app.twig.container :refer $ twig-container recollect.diff :refer $ diff-twig @@ -1246,34 +2042,84 @@ :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.style :require - [] respo-ui.core :refer $ [] hsl - [] respo-ui.core :as ui + respo-ui.core :refer $ hsl + respo-ui.core :as ui 'app.twig.container $ %{} 'FileEntry :defs $ {} + 'read-user-name $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn read-user-name (users user-id) + if (nil? user-id) (Option :none) + let + id $ decode-map-as user-id 'String + match + get-in users $ [] id :name + (:none) (Option :none) + (:some value) + Option :some $ decode-map-as value 'String + :examples $ [] + :schema $ :: 'Fn $ {} + :args $ [] + :: 'Map 'String $ :: 'Map 'Tag 'Dynamic + , 'Dynamic + :return $ :: 'Option 'String + :tests $ [] + %{} 'TestEntry (:name |user-name-preserves-guest-missing-and-unicode) + :code $ quote $ let + users $ {} + |u $ {} $ :name "|用户🐈" + |empty $ {} $ :name nil + assert= (Option :none) (read-user-name users nil) + assert= (Option :none) (read-user-name users |missing) + assert= (Option :none) (read-user-name users |empty) + assert= (Option :some "|用户🐈") (read-user-name users |u) + :tags $ #{} :projection :unit + %{} 'TestEntry (:name |user-name-rejects-invalid-id-and-name) + :code $ quote $ let + rejected? $ fn (users id) + hint-fn $ {} + :args $ [] + :: 'Map 'String $ :: 'Map 'Tag 'Dynamic + , 'Dynamic + :return 'Bool + try + do (read-user-name users id) false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + assert= true $ rejected? ({}) 42 + assert= true $ rejected? + {} $ |u $ {} (:name 42) + , |u + :tags $ #{} :projection :unit 'twig-articles $ %{} 'CodeEntry (:doc |) :code $ quote $ defn twig-articles (articles) filter-map-kv - assert-type articles $ :: 'Map 'String $ :: 'Map 'Tag 'Dynamic + decode-map-as articles $ :: 'Map 'String $ :: 'Map 'Tag 'Dynamic fn (k v) - %:: MapEntryDecision :keep k $ dissoc v :paragraphs + MapEntryDecision :keep k $ dissoc v :paragraphs :examples $ [] :schema $ :: 'Fn $ {} (:return 'Dynamic) :args $ [] 'Dynamic 'twig-container $ %{} 'CodeEntry (:doc |) :code $ quote $ defn twig-container (db session records) let - db-map $ assert-type db 'Map - session-map $ assert-type + records-list $ decode-map-as records $ :: 'List 'Dynamic + db-map $ decode-map-as db $ :: 'Map 'Tag 'Dynamic + session-map $ decode-map-as option:unwrap-or session $ {} - , 'Map + :: 'Map 'Tag 'Dynamic user-id $ &map:get session-map :user-id - logged-in? $ some? user-id - router $ assert-type (&map:get session-map :router) 'Map + logged-in? $ non-nil? user-id + router $ decode-map-as (&map:get session-map :router) (:: 'Map 'Tag 'Dynamic) base-data $ {} (:logged-in? logged-in?) (:session session-map) - :reel-length $ count records - sessions $ assert-type (&map:get db-map :sessions) 'Map - users $ assert-type (&map:get db-map :users) 'Map - merge-dynamic base-data $ assert-type + :reel-length $ count records-list + sessions $ decode-map-as (&map:get db-map :sessions) + :: 'Map 'Number $ :: 'Map 'Tag 'Dynamic + users $ decode-map-as (&map:get db-map :users) + :: 'Map 'String $ :: 'Map 'Tag 'Dynamic + merge base-data $ decode-map-as if logged-in? {} :user $ twig-user $ option:unwrap-or @@ -1298,39 +2144,73 @@ {} :: 'Map 'Tag 'Dynamic :examples $ [] - :schema $ :: 'Fn $ {} (:return 'Dynamic) + :schema $ :: 'Fn $ {} :args $ [] 'Dynamic (:: 'Option 'Dynamic) 'Dynamic + :return $ :: 'Map 'Tag 'Dynamic + :tests $ [] + %{} 'TestEntry + :name |guest-projection-retains-session-and-record-count + :code $ quote $ let + session-value $ {} (:user-id nil) + :router $ {} $ :name :home + :guest-field |preserved + db $ {} + :sessions $ {} $ 7 session-value + :users $ {} + projection $ twig-container db (Option :some session-value) ([] |record-a |record-b) + assert= false $ &map:get projection :logged-in? + assert= 2 $ &map:get projection :reel-length + assert= session-value $ &map:get projection :session + assert= nil $ &map:get projection :color + assert= nil $ &map:get projection :count + :tags $ #{} :business :unit + %{} 'TestEntry (:name |rejects-non-list-records-before-db-access) + :code $ quote $ assert= true + try + do + twig-container nil (Option :none) ({}) + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + :tags $ #{} :business :unit 'twig-focuses $ %{} 'CodeEntry (:doc |) :code $ quote $ defn twig-focuses (router-id sessions users) let - sessions-map $ assert-type sessions $ :: 'Map 'Number (:: 'Map 'Tag 'Dynamic) - users-map $ assert-type users $ :: 'Map 'String (:: 'Map 'Tag 'Dynamic) - filtered $ assert-type + sessions-map $ decode-map-as sessions $ :: 'Map 'Number (:: 'Map 'Tag 'Dynamic) + users-map $ decode-map-as users $ :: 'Map 'String (:: 'Map 'Tag 'Dynamic) + filtered $ decode-map-as filter-kv sessions-map $ fn (k session) let - session-map $ assert-type session 'Map - router-map $ assert-type (&map:get session-map :router) 'Map + session-map $ decode-map-as session $ :: 'Map 'Tag 'Dynamic + router-map $ decode-map-as (&map:get session-map :router) (:: 'Map 'Tag 'Dynamic) and = :article $ &map:get router-map :name - some? $ &map:get session-map :user-id - some? $ &map:get session-map router-id + non-nil? $ &map:get session-map :user-id + non-nil? $ &map:get session-map router-id :: 'Map 'Number $ :: 'Map 'Tag 'Dynamic - result $ -> filtered - .map-list $ fn (entry) - let-sugar - [] k session - , entry - session-map $ assert-type session 'Map + result $ -> filtered (map-entries) + map $ fn (entry) + hint-fn $ {} + :args $ [] $ :: 'MapEntry 'Number (:: 'Map 'Tag 'Dynamic) + :return $ :: 'Map 'Tag 'Dynamic + let + k $ :key entry + session-map $ :value entry article-id $ &map:get session-map router-id + user-id $ decode-map-as (&map:get session-map :user-id) 'String {} (:id article-id) :name $ option:unwrap-or - get-in users-map $ [] - assert-type (&map:get session-map :user-id) String - , :name + get-in users-map $ [] user-id :name , nil :sid k group-by $ fn (x) - &map:get (assert-type x 'Map) :id + hint-fn $ {} + :args $ [] $ :: 'Map 'Tag 'Dynamic + :return 'String + decode-map-as (&map:get x :id) 'String , result :examples $ [] :schema $ :: 'Fn $ {} (:return 'Dynamic) @@ -1338,53 +2218,53 @@ 'twig-members $ %{} 'CodeEntry (:doc |) :code $ quote $ defn twig-members (article-id sessions users) let - sessions-map $ assert-type sessions $ :: 'Map 'Number (:: 'Map 'Tag 'Dynamic) - users-map $ assert-type users $ :: 'Map 'String (:: 'Map 'Tag 'Dynamic) + sessions-map $ decode-map-as sessions $ :: 'Map 'Number (:: 'Map 'Tag 'Dynamic) + users-map $ decode-map-as users $ :: 'Map 'String (:: 'Map 'Tag 'Dynamic) let - filtered $ assert-type + filtered $ decode-map-as filter-kv sessions-map $ fn (k session) let - session-map $ assert-type session 'Map - router $ assert-type (&map:get session-map :router) 'Map + session-map $ decode-map-as session $ :: 'Map 'Tag 'Dynamic + router $ decode-map-as (&map:get session-map :router) (:: 'Map 'Tag 'Dynamic) and = :article $ &map:get router :name = article-id $ &map:get session-map :article-id :: 'Map 'Number $ :: 'Map 'Tag 'Dynamic -> filtered $ .map-kv $ fn (k session) let - session-map $ assert-type session 'Map - [] k $ option:unwrap-or - get-in users-map $ [] - assert-type (&map:get session-map :user-id) String - , :name - , nil + session-map $ decode-map-as session $ :: 'Map 'Tag 'Dynamic + [] k $ match + read-user-name users-map $ &map:get session-map :user-id + (:none) nil + (:some name) name :examples $ [] :schema $ :: 'Fn $ {} (:return 'Dynamic) :args $ [] 'Dynamic 'Dynamic 'Dynamic 'twig-profile $ %{} 'CodeEntry (:doc |) :code $ quote $ defn twig-profile (sessions users) let - sessions-map $ assert-type sessions $ :: 'Map 'Number (:: 'Map 'Tag 'Dynamic) - users-map $ assert-type users $ :: 'Map 'String (:: 'Map 'Tag 'Dynamic) - filtered $ assert-type + sessions-map $ decode-map-as sessions $ :: 'Map 'Number (:: 'Map 'Tag 'Dynamic) + users-map $ decode-map-as users $ :: 'Map 'String (:: 'Map 'Tag 'Dynamic) + filtered $ decode-map-as filter-kv sessions-map $ fn (k session) - some? $ &map:get (assert-type session 'Map) :user-id + non-nil? $ &map:get + decode-map-as session $ :: 'Map 'Tag 'Dynamic + , :user-id :: 'Map 'Number $ :: 'Map 'Tag 'Dynamic filter-map-kv filtered $ fn (k session) let - session-map $ assert-type session 'Map - %:: MapEntryDecision :keep k $ option:unwrap-or - get-in users-map $ [] - assert-type (&map:get session-map :user-id) String - , :name - , nil + session-map $ decode-map-as session $ :: 'Map 'Tag 'Dynamic + MapEntryDecision :keep k $ match + read-user-name users-map $ &map:get session-map :user-id + (:none) nil + (:some name) name :examples $ [] :schema $ :: 'Fn $ {} (:return 'Dynamic) :args $ [] 'Dynamic 'Dynamic :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.twig.container :require - [] app.twig.user :refer $ [] twig-user + app.twig.user :refer $ twig-user calcit.std.rand :refer $ rand-hex-color! app.util :refer $ filter-kv 'app.twig.user $ %{} 'FileEntry @@ -1396,44 +2276,69 @@ :args $ [] 'Dynamic :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.twig.user - :require $ [] recollect.twig :refer $ [] deftwig + :require $ recollect.twig :refer $ deftwig 'app.updater $ %{} 'FileEntry :defs $ {} $ 'updater %{} 'CodeEntry (:doc |) :code $ quote $ defn updater (db op sid op-id op-time) - match op - (:session/connect op-data) (session/connect db op-data sid op-id op-time) - (:session/disconnect op-data) (session/disconnect db op-data sid op-id op-time) - (:session/remove-message op-data) (session/remove-message db op-data sid op-id op-time) - (:user/log-in op-data) (user/log-in db op-data sid op-id op-time) - (:user/sign-up op-data) (user/sign-up db op-data sid op-id op-time) - (:user/log-out op-data) (user/log-out db op-data sid op-id op-time) - (:session/view-article op-data) (session/view-article db op-data sid op-id op-time) - (:router/change op-data) (router/change db op-data sid op-id op-time) - (:paragraph/prepend op-data) (paragraph/para-prepend db op-data sid op-id op-time) - (:paragraph/append-to op-data) (paragraph/append-to db op-data sid op-id op-time) - (:paragraph/content op-data) (paragraph/update-content db op-data sid op-id op-time) - (:paragraph/remove op-data) (paragraph/remove-one db op-data sid op-id op-time) - (:paragraph/move op-data) (paragraph/move db op-data sid op-id op-time) - (:paragraph/edit op-data) (paragraph/edit db op-data sid op-id op-time) - (:paragraph/finish-editing op-data) (paragraph/finish-editing db op-data sid op-id op-time) - (:article/create op-data) (article/create db op-data sid op-id op-time) - (:article/remove-one op-data) (article/remove-one db op-data sid op-id op-time) - (:article/title op-data) (article/change-title db op-data sid op-id op-time) - _ $ do (println "|Unknown op:" op) db + decode-map-as + match op + (:session/connect op-data) (session/connect db op-data sid op-id op-time) + (:session/disconnect op-data) (session/disconnect db op-data sid op-id op-time) + (:session/remove-message op-data) (session/remove-message db op-data sid op-id op-time) + (:user/log-in op-data) (user/log-in db op-data sid op-id op-time) + (:user/sign-up op-data) (user/sign-up db op-data sid op-id op-time) + (:user/log-out op-data) (user/log-out db op-data sid op-id op-time) + (:session/view-article op-data) (session/view-article db op-data sid op-id op-time) + (:router/change op-data) (router/change db op-data sid op-id op-time) + (:paragraph/prepend op-data) (paragraph/para-prepend db op-data sid op-id op-time) + (:paragraph/append-to op-data) (paragraph/append-to db op-data sid op-id op-time) + (:paragraph/content op-data) (paragraph/update-content db op-data sid op-id op-time) + (:paragraph/remove op-data) (paragraph/remove-one db op-data sid op-id op-time) + (:paragraph/move op-data) (paragraph/move db op-data sid op-id op-time) + (:paragraph/edit op-data) (paragraph/edit db op-data sid op-id op-time) + (:paragraph/finish-editing op-data) (paragraph/finish-editing db op-data sid op-id op-time) + (:article/create op-data) (article/create db op-data sid op-id op-time) + (:article/remove-one op-data) (article/remove-one db op-data sid op-id op-time) + (:article/title op-data) (article/change-title db op-data sid op-id op-time) + _ $ do (println "|Unknown op:" op) db + :: 'Map 'Tag 'Dynamic :examples $ [] :schema $ :: 'Fn $ {} :args $ [] (:: 'Map 'Tag 'Dynamic) 'Enum 'Number 'String 'Number :return $ :: 'Map 'Tag 'Dynamic + :tests $ [] + %{} 'TestEntry + :name |session-operation-preserves-root-and-numeric-key + :code $ quote $ let + db $ {} + :sessions $ {} + :users $ {} $ |u-1 + {} $ :name |Ada + connected $ updater db (:: :session/connect nil) 42 |op-1 1 + sessions $ decode-map-as (&map:get connected :sessions) (:: 'Map 'Number 'Dynamic) + session-value $ decode-map-as (&map:get sessions 42) (:: 'Map 'Tag 'Dynamic) + assert= 42 $ &map:get session-value :id + assert= (&map:get db :users) (&map:get connected :users) + assert= db $ updater connected (:: :session/disconnect nil) 42 |op-2 2 + :tags $ #{} :unit :updater + %{} 'TestEntry (:name |unknown-operation-preserves-root-map) + :code $ quote $ let + db $ {} + :sessions $ {} $ 42 + {} $ :id 42 + :users $ {} + assert= db $ updater db (:: :unknown nil) 42 |op 1 + :tags $ #{} :unit :updater :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.updater - :require ([] app.updater.session :as session) ([] app.updater.user :as user) ([] app.updater.router :as router) ([] app.updater.paragraph :as paragraph) ([] app.updater.article :as article) + :require (app.updater.session :as session) (app.updater.user :as user) (app.updater.router :as router) (app.updater.paragraph :as paragraph) (app.updater.article :as article) 'app.updater.article $ %{} 'FileEntry :defs $ {} 'change-title $ %{} 'CodeEntry (:doc |) :code $ quote $ defn change-title (db op-data sid op-id op-time) let - op-map $ assert-type op-data 'Map + op-map $ decode-map-as op-data $ :: 'Map 'Tag 'Dynamic assoc-in db [] :articles (&map:get op-map :id) :title &map:get op-map :title @@ -1455,21 +2360,22 @@ :args $ [] 'Dynamic 'Dynamic 'Number 'String 'Number :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.updater.article - :require $ [] app.schema :as schema + :require $ app.schema :as schema 'app.updater.paragraph $ %{} 'FileEntry :defs $ {} 'append-to $ %{} 'CodeEntry (:doc |) :code $ quote $ defn append-to (db op-data sid op-id op-time) let + base-key $ decode-map-as op-data 'String article-id $ option:unwrap-or get-in db $ [] :sessions sid :article-id , nil - paragraphs $ assert-type + paragraphs $ decode-map-as option:unwrap-or get-in db $ [] :articles article-id :paragraphs {} :: 'Map 'String $ :: 'Map 'Tag 'Dynamic - new-key $ bisection-util/key-after paragraphs op-data + new-key $ bisection-util/key-after paragraphs base-key -> db update-in ([] :articles article-id :paragraphs) fn (paragraphs) @@ -1480,6 +2386,42 @@ :examples $ [] :schema $ :: 'Fn $ {} (:return 'Dynamic) :args $ [] 'Dynamic 'Dynamic 'Number 'String 'Number + :tests $ [] + %{} 'TestEntry (:name |rejects-non-string-key-before-db-access) + :code $ quote $ assert= true + try + do + append-to ({}) 9 7 |new-id 42 + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + :tags $ #{} :text-boundary :unit + %{} 'TestEntry + :name |preserves-existing-paragraph-and-updates-numeric-session-cursor + :code $ quote $ let + base-key bisection-key.core/mid-id + original $ {} (:id |existing-id) (:time 1) (:content "|原文🌱") + db $ {} + :sessions $ {} $ 7 + {} (:article-id |a) (:paragraph-id base-key) + :users $ {} + :articles $ {} $ |a + {} $ :paragraphs $ {} (base-key original) + next-db $ append-to db base-key 7 |new-id 42 + new-key $ option:unwrap $ get-in next-db ([] :sessions 7 :paragraph-id) + paragraphs $ option:unwrap $ get-in next-db ([] :articles |a :paragraphs) + paragraphs-map $ decode-map-as paragraphs $ :: 'Map 'String 'Dynamic + assert= 2 $ count paragraphs-map + assert= original $ option:unwrap $ get-in next-db ([] :articles |a :paragraphs base-key) + assert= false $ = base-key new-key + assert= + {} (:id |new-id) (:time 42) (:content |) + option:unwrap $ get-in next-db $ [] :articles |a :paragraphs new-key + assert= original $ option:unwrap $ get-in db ([] :articles |a :paragraphs base-key) + :tags $ #{} :business :unit 'edit $ %{} 'CodeEntry (:doc |) :code $ quote $ defn edit (db op-data sid op-id op-time) let @@ -1502,13 +2444,13 @@ 'move $ %{} 'CodeEntry (:doc |) :code $ quote $ defn move (db op-data sid op-id op-time) let - op-map $ assert-type op-data $ :: 'Map 'Tag 'String + op-map $ decode-map-as op-data $ :: 'Map 'Tag 'String target-key $ &map:get op-map :target base-key $ &map:get op-map :base article-id $ option:unwrap-or get-in db $ [] :sessions sid :article-id , nil - paragraphs $ assert-type + paragraphs $ decode-map-as option:unwrap-or get-in db $ [] :articles article-id :paragraphs {} @@ -1527,7 +2469,7 @@ dissoc target-key update ([] :sessions sid :paragraph-id) fn (old-key) - if (some? old-key) new-key nil + if (non-nil? old-key) new-key nil :examples $ [] :schema $ :: 'Fn $ {} (:return 'Dynamic) :args $ [] 'Dynamic 'Dynamic 'Number 'String 'Number @@ -1537,7 +2479,7 @@ article-id $ option:unwrap-or get-in db $ [] :sessions sid :article-id , nil - paragraphs $ assert-type + paragraphs $ decode-map-as option:unwrap-or get-in db $ [] :articles article-id :paragraphs {} @@ -1569,10 +2511,60 @@ :examples $ [] :schema $ :: 'Fn $ {} (:return 'Dynamic) :args $ [] 'Dynamic 'Dynamic 'Number 'String 'Number + :tests $ [] + %{} 'TestEntry + :name |removes-only-selected-paragraph-and-clears-numeric-session-cursor + :code $ quote $ let + db $ {} + :sessions $ {} $ 7 + {} (:article-id |a) (:paragraph-id |T) + :articles $ {} $ |a + {} $ :paragraphs $ {} + |T $ {} $ :content "|删除对象" + |g $ {} $ :content "|保留对象🌱" + next-db $ remove-one db |T 7 |operation-id 42 + assert= nil $ &map:get + option:unwrap $ get-in next-db $ [] :sessions 7 + , :paragraph-id + assert= + option:unwrap $ get-in db $ [] :articles |a :paragraphs |g + option:unwrap $ get-in next-db $ [] :articles |a :paragraphs |g + assert= |T $ option:unwrap $ get-in db ([] :sessions 7 :paragraph-id) + assert= (Option :none) + get-in next-db $ [] :articles |a :paragraphs |T + assert= true $ contains? + option:unwrap $ get-in next-db $ [] :sessions 7 + , :paragraph-id + :tags $ #{} :business :unit + %{} 'TestEntry + :name |missing-paragraph-keeps-content-and-clears-cursor + :code $ quote $ let + db $ {} + :sessions $ {} $ 7 + {} (:article-id |a) (:paragraph-id |T) + :articles $ {} $ |a + {} $ :paragraphs $ {} + |T $ {} $ :content "|删除对象" + |g $ {} $ :content "|保留对象🌱" + next-db $ remove-one db |absent 7 |operation-id 42 + assert= nil $ &map:get + option:unwrap $ get-in next-db $ [] :sessions 7 + , :paragraph-id + assert= + option:unwrap $ get-in db $ [] :articles |a :paragraphs |g + option:unwrap $ get-in next-db $ [] :articles |a :paragraphs |g + assert= |T $ option:unwrap $ get-in db ([] :sessions 7 :paragraph-id) + assert= + option:unwrap $ get-in db $ [] :articles |a :paragraphs + option:unwrap $ get-in next-db $ [] :articles |a :paragraphs + assert= true $ contains? + option:unwrap $ get-in next-db $ [] :sessions 7 + , :paragraph-id + :tags $ #{} :business :unit 'update-content $ %{} 'CodeEntry (:doc |) :code $ quote $ defn update-content (db op-data sid op-id op-time) let - op-map $ assert-type op-data 'Map + op-map $ decode-map-as op-data $ :: 'Map 'Tag 'Dynamic article-id $ option:unwrap-or get-in db $ [] :sessions sid :article-id , nil @@ -1588,7 +2580,7 @@ :args $ [] 'Dynamic 'Dynamic 'Number 'String 'Number :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.updater.paragraph - :require ([] bisection-key.util :as bisection-util) ([] app.schema :as schema) + :require (bisection-key.util :as bisection-util) (app.schema :as schema) 'app.updater.router $ %{} 'FileEntry :defs $ {} $ 'change %{} 'CodeEntry (:doc |) @@ -1616,14 +2608,76 @@ :args $ [] 'Dynamic 'Dynamic 'Number 'String 'Number 'remove-message $ %{} 'CodeEntry (:doc |) :code $ quote $ defn remove-message (db op-data sid op-id op-time) - update-in db ([] :sessions sid :messages) - fn (messages) - dissoc - option:unwrap-or messages $ {} - &map:get (assert-type op-data 'Map) :id + let + payload $ decode-map-as op-data $ :: 'Map 'Tag 'Dynamic + message-id $ decode-map-as (&map:get payload :id) 'String + update-in db ([] :sessions sid :messages) + fn (messages) + dissoc + decode-map-as + option:unwrap-or messages $ {} + :: 'Map 'String 'Dynamic + , message-id :examples $ [] :schema $ :: 'Fn $ {} (:return 'Dynamic) :args $ [] 'Dynamic 'Dynamic 'Number 'String 'Number + :tests $ [] + %{} 'TestEntry + :name |removal-preserves-numeric-session-and-other-messages + :code $ quote $ let + removed-message $ {} (:id |m-1) (:text "|错误🐈") + second $ {} (:id |m-2) (:text "|保留") + other-session $ {} $ :messages + {} $ |m-3 second + current-session $ {} + :cursor $ [] :article 42 + :messages $ {} (|m-1 removed-message) (|m-2 second) + db $ {} + :users $ {} $ |u-1 + {} $ :name |Ada + :sessions $ {} (42 current-session) (7 other-session) + expected $ assoc-in db ([] :sessions 42 :messages) + {} $ |m-2 second + assert= expected $ remove-message db + {} $ :id |m-1 + , 42 |op 1 + :tags $ #{} :message :unit + %{} 'TestEntry (:name |missing-message-preserves-existing-data) + :code $ quote $ let + message $ {} (:id |m-1) (:text "|保留") + db $ {} $ :sessions + {} $ 42 $ {} + :messages $ {} $ |m-1 message + assert= db $ remove-message db + {} $ :id |missing + , 42 |op 1 + assert= + {} $ :sessions $ {} + 42 $ {} $ :messages ({}) + remove-message ({}) + {} $ :id |missing + , 42 |op 1 + :tags $ #{} :message :unit + %{} 'TestEntry (:name |removal-rejects-invalid-payload-and-message-key) + :code $ quote $ let + rejected? $ fn (payload) + hint-fn $ {} + :args $ [] 'Dynamic + :return 'Bool + try + do + remove-message ({}) payload 42 |op 1 + , false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + assert= true $ rejected? nil + assert= true $ rejected? $ {} + assert= true $ rejected? $ {} (:id 42) + assert= true $ rejected? $ {} (:id nil) + :tags $ #{} :message :unit 'view-article $ %{} 'CodeEntry (:doc |) :code $ quote $ defn view-article (db op-data sid op-id op-time) update-in db ([] :sessions sid) @@ -1638,40 +2692,48 @@ :args $ [] 'Dynamic 'Dynamic 'Number 'String 'Number :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.updater.session - :require $ [] app.schema :as schema + :require $ app.schema :as schema 'app.updater.user $ %{} 'FileEntry :defs $ {} + 'LoginCredentials $ %{} 'CodeEntry (:doc |) + :code $ quote $ defstruct LoginCredentials (:username 'String) (:password 'String) + :examples $ [] + :schema $ :: 'StructDef 'log-in $ %{} 'CodeEntry (:doc |) :code $ quote $ defn log-in (db op-data sid op-id op-time) - let-sugar - [] username password - , op-data - users $ assert-type - option:unwrap-or (get db :users) ({}) + let + db-map $ decode-map-as db $ :: 'Map 'Tag 'Dynamic + credentials $ read-login-credentials op-data + username $ :username credentials + password $ :password credentials + users $ decode-map-as + option:unwrap-or (get db-map :users) ({}) :: 'Map 'String $ :: 'Map 'Tag 'Dynamic maybe-user $ -> users (vals) (.to-list) find $ fn (user) - = username $ &map:get (assert-type user 'Map) :name - update-in db ([] :sessions sid) + = username $ &map:get + decode-map-as user $ :: 'Map 'Tag 'Dynamic + , :name + update-in db-map ([] :sessions sid) fn (session) let - session-map $ assert-type + session-map $ decode-map-as option:unwrap-or session $ {} - , 'Map + :: 'Map 'Tag 'Dynamic if (option:some? maybe-user) let - user-map $ assert-type (option:unwrap maybe-user) 'Map + user-map $ decode-map-as (option:unwrap maybe-user) (:: 'Map 'Tag 'Dynamic) if = (md5 password) (&map:get user-map :password) assoc session-map :user-id $ &map:get user-map :id update session-map :messages $ fn (messages) assoc - assert-type messages $ :: 'Map 'String 'Dynamic + decode-map-as messages $ :: 'Map 'String 'Dynamic , op-id $ {} (:id op-id) :text $ str "|Wrong password for " username update session-map :messages $ fn (messages) assoc - assert-type messages $ :: 'Map 'String 'Dynamic + decode-map-as messages $ :: 'Map 'String 'Dynamic , op-id $ {} (:id op-id) :text $ str "|No user named: " username :examples $ [] @@ -1683,26 +2745,74 @@ :examples $ [] :schema $ :: 'Fn $ {} (:return 'Dynamic) :args $ [] 'Dynamic 'Dynamic 'Number 'String 'Number + 'read-login-credentials $ %{} 'CodeEntry (:doc |) + :code $ quote $ defn read-login-credentials (value) + let + fields $ decode-map-as value $ :: 'List 'Dynamic + username $ decode-map-as (&list:nth fields 0) 'String + password $ decode-map-as (&list:nth fields 1) 'String + LoginCredentials :username username :password password + :examples $ [] + :schema $ :: 'Fn $ {} (:return 'app.updater.user/LoginCredentials) + :args $ [] 'Dynamic + :tests $ [] + %{} 'TestEntry (:name |credentials-strings-and-extra-fields) + :code $ quote $ let + source $ [] "|用户🐈" |password 42 + value $ read-login-credentials source + assert= "|用户🐈" $ :username value + assert= |password $ :password value + assert= 42 $ &list:nth source 2 + :tags $ #{} :input-boundary :unit + %{} 'TestEntry (:name |credentials-empty-password-preserved) + :code $ quote $ let + value $ read-login-credentials $ [] |guest | + assert= |guest $ :username value + assert= | $ :password value + :tags $ #{} :input-boundary :unit + %{} 'TestEntry (:name |credentials-reject-invalid-fields) + :code $ quote $ let + rejected? $ fn (value) + hint-fn $ {} + :args $ [] 'Dynamic + :return 'Bool + try + do (read-login-credentials value) false + fn (message) + hint-fn $ {} + :args $ [] 'String + :return 'Bool + , true + assert= true $ rejected? $ [] 42 |password + assert= true $ rejected? $ [] |user nil + assert= true $ rejected? $ [] |user + assert= true $ rejected? $ {} + assert= true $ rejected? nil + :tags $ #{} :input-boundary :unit 'sign-up $ %{} 'CodeEntry (:doc |) :code $ quote $ defn sign-up (db op-data sid op-id op-time) - let-sugar - [] username password - , op-data - users $ assert-type - option:unwrap-or (get db :users) ({}) + let + db-map $ decode-map-as db $ :: 'Map 'Tag 'Dynamic + credentials $ read-login-credentials op-data + username $ :username credentials + password $ :password credentials + users $ decode-map-as + option:unwrap-or (get db-map :users) ({}) :: 'Map 'String $ :: 'Map 'Tag 'Dynamic maybe-user $ find .to-list $ vals users fn (user) - = username $ &map:get (assert-type user 'Map) :name + = username $ &map:get + decode-map-as user $ :: 'Map 'Tag 'Dynamic + , :name if (option:some? maybe-user) - update-in db ([] :sessions sid :messages) + update-in db-map ([] :sessions sid :messages) fn (messages) assoc option:unwrap-or messages $ {} , op-id $ {} (:id op-id) :text $ str "|Name is taken: " username - -> db + -> db-map assoc-in ([] :sessions sid :user-id) op-id assoc-in ([] :users op-id) {} (:id op-id) (:name username) (:nickname username) @@ -1718,21 +2828,24 @@ :defs $ {} 'delay-focus! $ %{} 'CodeEntry (:doc |) :code $ quote $ defn delay-focus! (duration target) - js/setTimeout - fn () $ let - el $ query-selector target - if (el .some?) - .focus! $ option:unwrap el - .warn js/console "|focus target box not ready." + set-timeout! + fn () + let + el $ query-selector target + if (el .some?) + .focus! $ option:unwrap el + js/console.warn "|focus target box not ready." + , &unit , duration + , &unit :examples $ [] - :schema $ :: 'Fn $ {} (:return 'Dynamic) + :schema $ :: 'Fn $ {} (:return 'Unit) :args $ [] 'Number 'String :features $ #{} :js-ffi 'filter-kv $ %{} 'CodeEntry (:doc |) :code $ quote $ defn filter-kv (xs f) filter-map-kv xs $ fn (k v) - if (f k v) (%:: MapEntryDecision :keep k v) (%:: MapEntryDecision :drop) + if (f k v) (MapEntryDecision :keep k v) (MapEntryDecision :drop) :examples $ [] :schema $ :: 'Fn $ {} :args $ [] (:: 'Map 'K 'V) @@ -1742,4 +2855,4 @@ :return $ :: 'Map 'K 'V :ns $ %{} 'NsEntry (:doc |) :code $ quote $ ns app.util - :require $ js-ffi.browser :refer $ query-selector + :require $ js-ffi.browser :refer $ query-selector set-timeout! diff --git a/config/calcit-quality.cirru b/config/calcit-quality.cirru deleted file mode 100644 index cfb8600..0000000 --- a/config/calcit-quality.cirru +++ /dev/null @@ -1,752 +0,0 @@ -{} (:schemaVersion 2) - :definitions $ {} - |app.client/*states $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.client/*store $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 0 - |app.client/connect! $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 5 - |app.client/dispatch! $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.client/main! $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.client/mount-target $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.client/on-server-data $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 1 - |app.client/reload! $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 0 - |app.client/render-app! $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.client/simulate-login! $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 1 - |app.comp.articles/comp-article $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 4 - |app.comp.articles/comp-articles $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 8 - |app.comp.container/comp-container $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 13 - |app.comp.container/comp-offline $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 0 - |app.comp.container/comp-status-color $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.comp.container/style-body $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 0 - :unresolved 1 - :unsafeCoerce 0 - |app.comp.editor-panel/comp-editor-panel $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 10 - |app.comp.editor-toolbar/comp-editor-toolbar $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 4 - |app.comp.login/comp-login $ {} (:codeDynamic 0) - :codeNil 3 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 4 - :unsafeCoerce 8 - |app.comp.login/initial-state $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 0 - :unresolved 1 - :unsafeCoerce 0 - |app.comp.login/on-submit $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.comp.navigation/comp-navigation $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.comp.navigation/style-entry $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 0 - :unresolved 1 - :unsafeCoerce 0 - |app.comp.previewer/comp-info-list $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 2 - |app.comp.previewer/comp-paragraph $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 16 - |app.comp.previewer/comp-previewer $ {} (:codeDynamic 0) - :codeNil 5 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 6 - :unsafeCoerce 16 - |app.comp.previewer/comp-text-viewer $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 5 - |app.comp.previewer/supprted-langs $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 0 - :unresolved 1 - :unsafeCoerce 0 - |app.comp.profile/comp-profile $ {} (:codeDynamic 0) - :codeNil 5 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 6 - :unsafeCoerce 2 - |app.config/cdn? $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.config/dev? $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.config/site $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 0 - :unresolved 1 - :unsafeCoerce 0 - |app.schema/article $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 0 - :unresolved 2 - :unsafeCoerce 0 - |app.schema/database $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 0 - :unresolved 1 - :unsafeCoerce 0 - |app.schema/notification $ {} (:codeDynamic 0) - :codeNil 3 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 0 - :unresolved 4 - :unsafeCoerce 0 - |app.schema/paragraph $ {} (:codeDynamic 0) - :codeNil 2 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 0 - :unresolved 3 - :unsafeCoerce 0 - |app.schema/router $ {} (:codeDynamic 0) - :codeNil 3 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 0 - :unresolved 4 - :unsafeCoerce 0 - |app.schema/session $ {} (:codeDynamic 0) - :codeNil 6 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 0 - :unresolved 7 - :unsafeCoerce 0 - |app.schema/user $ {} (:codeDynamic 0) - :codeNil 5 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 0 - :unresolved 6 - :unsafeCoerce 0 - |app.server/*client-caches $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.server/*initial-db $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.server/*reader-reel $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.server/*reel $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.server/dispatch! $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.server/get-backup-path! $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.server/main! $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.server/on-exit! $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.server/persist-db! $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.server/reload! $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.server/render-loop! $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.server/run-server! $ {} (:codeDynamic 0) - :codeNil 2 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 3 - :unsafeCoerce 0 - |app.server/storage-file $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.server/sync-clients! $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 1 - |app.style/button $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.style/link $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 0 - :typeNotFull 0 - :unresolved 1 - :unsafeCoerce 0 - |app.twig.container/twig-articles $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 1 - |app.twig.container/twig-container $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 5 - |app.twig.container/twig-focuses $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 7 - |app.twig.container/twig-members $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 6 - |app.twig.container/twig-profile $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 5 - |app.twig.user/twig-user $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.updater.article/change-title $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 1 - |app.updater.article/create $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.updater.article/remove-one $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.updater.paragraph/append-to $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 1 - |app.updater.paragraph/edit $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 0 - |app.updater.paragraph/finish-editing $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 0 - |app.updater.paragraph/move $ {} (:codeDynamic 0) - :codeNil 2 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 3 - :unsafeCoerce 2 - |app.updater.paragraph/para-prepend $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 1 - |app.updater.paragraph/remove-one $ {} (:codeDynamic 0) - :codeNil 2 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 3 - :unsafeCoerce 0 - |app.updater.paragraph/update-content $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 1 - |app.updater.router/change $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.updater.session/connect $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.updater.session/disconnect $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.updater.session/remove-message $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 1 - |app.updater.session/view-article $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 0 - |app.updater.user/log-in $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 4 - |app.updater.user/log-out $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 0 - |app.updater.user/sign-up $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 2 - |app.updater/updater $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 0 - |app.util/delay-focus! $ {} (:codeDynamic 0) - :codeNil 0 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 1 - :unsafeCoerce 1 - |app.util/filter-kv $ {} (:codeDynamic 0) - :codeNil 1 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 1 - :typeNone 1 - :typeNotFull 1 - :unresolved 2 - :unsafeCoerce 0 - :metrics $ {} (:codeDynamic 0) - :codeNil 60 - :declaredOptional 0 - :deprecatedCalls 0 - :schemaDynamic 82 - :typeNone 63 - :typeNotFull 69 - :unresolved 142 - :unsafeCoerce 134 - :scope $ {} (:includeDependencies false) - :namespace nil - :namespacePrefix nil diff --git a/deps.cirru b/deps.cirru index 3edecbb..403028c 100644 --- a/deps.cirru +++ b/deps.cirru @@ -1,18 +1,17 @@ -{} (:calcit-version |0.27.0) +{} (:calcit-version |0.30.0-alpha.3) :version |0.1.1 - :dependencies $ {} (|Cumulo/cumulo-reel.calcit |0.0.47) - |Cumulo/cumulo-util.calcit |0.0.23 - |Respo/alerts.calcit |0.10.46 - |Respo/respo-feather.calcit |0.4.21 - |Respo/respo-markdown.calcit |0.4.46 - |Respo/respo-message.calcit |0.0.28 - |Respo/respo-ui.calcit |0.7.32-alpha.3 - |Respo/respo.calcit |0.16.114-alpha.5 - |calcit-lang/bisection-key |0.0.29 - |calcit-lang/calcit-wss |0.2.32 - |calcit-lang/calcit.std |0.2.35 - |calcit-lang/lilac |0.5.9 - |calcit-lang/memof |0.0.36 - |calcit-lang/recollect |0.0.53 - |mvc-works/ws-edn.calcit |0.0.32 + :dependencies $ {} (|Cumulo/cumulo-reel.calcit |0.0.53) + |Cumulo/cumulo-util.calcit |0.0.28 + |Respo/alerts.calcit |0.10.52 + |Respo/respo-feather.calcit |0.4.26 + |Respo/respo-markdown.calcit |0.4.54 + |Respo/respo-message.calcit |0.0.34 + |Respo/respo-ui.calcit |0.7.39 + |Respo/respo.calcit |0.16.120 + |calcit-lang/bisection-key |0.0.30 + |calcit-lang/calcit-wss |0.2.34 + |calcit-lang/calcit.std |0.2.41 + |calcit-lang/memof |0.0.38 + |calcit-lang/recollect |0.0.60 + |mvc-works/ws-edn.calcit |0.0.39 diff --git a/history/202610150610-typed-article-text-export.md b/history/202610150610-typed-article-text-export.md new file mode 100644 index 0000000..a8b3b3d --- /dev/null +++ b/history/202610150610-typed-article-text-export.md @@ -0,0 +1,27 @@ +# 文章文本导出的 MapEntry 类型关系 + +## 问题与决策 + +正式 alpha.3 浏览器业务回放发现：点击 Text 后，旧代码把异构 Map pair 的 +`last` 结果交给 Map decoder，但 `last` 返回 Option，实际解码必然失败。 +可失败的显式 decoder 不代表其调用一定成功，完整 strict 通过不能代替业务回放。 + +将文本生成提取为纯函数 `article-text`，输入沿用受检文章的 +`Map` 边界，返回 String。段落集合检查为 +`Map>` 后，使用 `map-entries` 保留 key/value +关系，按 key 排序，用已有 `read-paragraph-content` 验证文本；不再拆解 +异构 pair，也不使用 Option unwrap、unsafe 或补充强制断言。 + +原文章标题、段落顺序、分隔符、空集合、Unicode 和 HTML 转义位置保持不变。 +组件仍负责打开窗口及转义 HTML，纯函数不新增宿主能力或公开工具入口。 + +## 验证 + +定义 `:tests` 覆盖 key 排序与 Unicode/原始 HTML 字符、空段落集合，以及错误 +标题、Number key 和非 String 段落内容的拒绝。使用已发布的 alpha.3 CLI/runtime +配对执行原 native/JS 回放：50 项共同测试在两侧通过，完整 strict 诊断与改写建议为空， +Vite 构建通过。实际浏览器重新加载最新生成 JS 后点击 Text，没有再产生原 Option→Map +异常；弹出窗口的完整内容展示仍须独立核对，不以控制台无新异常冒充该项完成。 + +完整消费者验收仍要求正式依赖更新、其余浏览器业务和 PR/main 门禁；本文不作为 +依赖退场或稳定 0.30.0 已完成的声明。 diff --git a/package.json b/package.json index 3dd5f55..2a5aa80 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "tabletwo", - "packageManager": "yarn@4.12.0", + "packageManager": "yarn@4.18.0", "version": "0.1.1", "description": "A markdown table ot two", "main": "index.js", @@ -26,7 +26,7 @@ "vite": "^8.2.2" }, "dependencies": { - "@calcit/procs": "0.27.0", + "@calcit/procs": "0.30.0-alpha.3", "escape-html": "^1.0.3", "nanoid": "^5.1.5" } diff --git a/yarn.lock b/yarn.lock index ba7db6b..f351af8 100644 --- a/yarn.lock +++ b/yarn.lock @@ -2,17 +2,25 @@ # Manual changes might be lost - proceed with caution! __metadata: - version: 8 + version: 10 cacheKey: 10c0 -"@calcit/procs@npm:0.27.0": - version: 0.27.0 - resolution: "@calcit/procs@npm:0.27.0" +"@calcit/finger-vec@npm:0.1.1": + version: 0.1.1 + resolution: "@calcit/finger-vec@npm:0.1.1" + checksum: 10c0/c75e7f58924a7bb226ca4a47f6b0702021796b096c04d7fb7e9a92cb49b11ca64d654ea10d78bde29a8ac2d2d05ef9e7865efd2b358af2ca989d950b04d529a8 + languageName: node + linkType: hard + +"@calcit/procs@npm:0.30.0-alpha.3": + version: 0.30.0-alpha.3 + resolution: "@calcit/procs@npm:0.30.0-alpha.3" dependencies: + "@calcit/finger-vec": "npm:0.1.1" "@calcit/ternary-tree": "npm:0.0.26" - "@cirru/parser.ts": "npm:^0.0.9" + "@cirru/parser.ts": "npm:0.0.10" "@cirru/writer.ts": "npm:^0.1.9" - checksum: 10c0/85edf1724beaf5e3b895f456b9d81ae93100316802b19bc20ab7cbcc61e295892e787c2f9cca0c9c231ba1cc3c3d320ae158d3f8c9fd39eda24500c56ebe99b1 + checksum: 10c0/02ab938f03a2e79b4bdac0e2b982b6cafed57795881c5c9d69d39559cc8624d412d7b9d863813d24d158bc4d922af789ef1b67ff7c2cf86c174279ff19040e71 languageName: node linkType: hard @@ -23,10 +31,10 @@ __metadata: languageName: node linkType: hard -"@cirru/parser.ts@npm:^0.0.9": - version: 0.0.9 - resolution: "@cirru/parser.ts@npm:0.0.9" - checksum: 10c0/3b13623b8f627ac81adae0cb6a4e3664f0da09115a997ca9b78b8d5d0b0f9b9b18c1ad847e068831cb1052c7da2a00329d2af04421b1024a004eef0ddca5fd7a +"@cirru/parser.ts@npm:0.0.10": + version: 0.0.10 + resolution: "@cirru/parser.ts@npm:0.0.10" + checksum: 10c0/d66a16bcf49c60865fb8e733a5c219289a7c755c6400dea7e7a8d3166ee7841a623030f35f8ee96e232bc40f974f1b79a0ccdf089947fc5779699485102b5995 languageName: node linkType: hard @@ -717,7 +725,7 @@ __metadata: version: 0.0.0-use.local resolution: "tabletwo@workspace:." dependencies: - "@calcit/procs": "npm:0.27.0" + "@calcit/procs": "npm:0.30.0-alpha.3" bottom-tip: "npm:^0.1.3" cirru-color: "npm:^0.2.4" copy-text-to-clipboard: "npm:^3.2.2"