├── .circleci └── config.yml ├── .gitignore ├── Makefile ├── README.md ├── deps.edn ├── dev ├── core.cljs.edn ├── resources │ └── public │ │ ├── assets │ │ └── extensions │ │ │ └── demo │ │ │ └── extension.edn │ │ └── index.html └── src │ └── pluto │ ├── dev.cljs │ └── web │ ├── components.cljs │ ├── events.cljs │ └── queries.cljs ├── docs ├── discoverability.md ├── editor.md ├── ideas.md ├── integration.md ├── presentations │ └── security.md └── security.md ├── package.json ├── project.clj ├── scripts └── npm.sh ├── src └── pluto │ ├── core.cljc │ ├── error.cljc │ ├── log.cljc │ ├── reader │ ├── blocks.cljc │ ├── destructuring.cljc │ ├── events.cljc │ ├── reference.cljc │ ├── types.cljc │ └── views.cljc │ ├── storage.cljc │ ├── storage │ ├── gist.cljs │ ├── http.cljs │ └── ipfs.cljs │ ├── storages.cljc │ └── utils.cljc └── test └── pluto ├── core_test.cljc ├── examples_test.cljc ├── reader ├── block_test.cljc ├── destructuring_test.cljc ├── events_test.cljc ├── reference_test.cljc ├── types_test.cljc └── views_test.cljc └── utils_test.cljc /.circleci/config.yml: -------------------------------------------------------------------------------- 1 | # Clojure CircleCI 2.0 configuration file 2 | # 3 | # Check https://circleci.com/docs/2.0/language-clojure/ for more details 4 | # 5 | version: 2 6 | jobs: 7 | build: 8 | docker: 9 | # specify the version you desire here 10 | - image: circleci/clojure:openjdk-11-tools-deps-1.10.0.408-node 11 | 12 | # Specify service dependencies here if necessary 13 | # CircleCI maintains a library of pre-built images 14 | # documented at https://circleci.com/docs/2.0/circleci-images/ 15 | 16 | working_directory: ~/repo 17 | 18 | environment: 19 | # Customize the JVM maximum heap limit 20 | JVM_OPTS: -Xmx3200m 21 | 22 | steps: 23 | - checkout 24 | 25 | # Download and cache dependencies 26 | - restore_cache: 27 | keys: 28 | - dependencies-{{ checksum "deps.edn" }} 29 | # fallback to using the latest cache if no exact match is found 30 | - dependencies- 31 | 32 | - run: clojure -A:test-cljs 33 | 34 | - save_cache: 35 | paths: 36 | - ~/.m2 37 | key: dependencies-{{ checksum "deps.edn" }} 38 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | pom.xml.asc 3 | pluto.iml 4 | figwheel-main.log 5 | target/ 6 | /npm-debug.log 7 | node_modules/ 8 | nashorn_code_cache/ 9 | .cljs_nashorn_repl/ 10 | resources/public/js/ 11 | .rebel_readline_history 12 | .idea/ 13 | .cpcache/ 14 | website/build/ 15 | website/static/js/ 16 | website/static/extensions/ 17 | \.\#* 18 | .nrepl-port 19 | *.lck 20 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: dev 2 | 3 | compile: 4 | clojure -m cljs.main -O advanced -d target -o target/pluto.core -c pluto.core 5 | 6 | dev: 7 | clojure -A:dev 8 | 9 | install: 10 | lein install 11 | 12 | deploy: 13 | lein deploy clojars 14 | 15 | tests: 16 | clojure -A:test-clj 17 | clojure -A:test-cljs 18 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | [![CircleCI](https://img.shields.io/circleci/project/github/status-im/pluto.svg)](https://circleci.com/gh/status-im/pluto/tree/master) 3 | 4 | ## Development 5 | 6 | Development requires [Deps and CLI](https://clojure.org/guides/getting_started) tooling installed. 7 | 8 | Run dev mode using `make dev`. 9 | 10 | ### Tests 11 | 12 | Run Clojure tests using `clojure -A:test-clj` (or continuously via `clojure -A:test-clj -w src`) 13 | Run ClojureScript tests using `clojure -A:test-cljs` 14 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {org.clojure/clojurescript {:mvn/version "1.10.516"} 2 | org.clojure/tools.reader {:mvn/version "1.3.2"} 3 | reagent {:mvn/version "0.8.1"}} 4 | :paths ["src"] 5 | :aliases {:dev {:extra-paths ["dev/src" "dev/resources" "target"] 6 | :extra-deps {re-frame {:mvn/version "0.10.6"} 7 | com.bhauman/figwheel-main {:mvn/version "0.2.0"} 8 | com.bhauman/rebel-readline-cljs {:mvn/version "0.1.4"} 9 | binaryage/devtools {:mvn/version "0.9.10"}} 10 | :main-opts ["-m" "figwheel.main" "-b" "dev/core" "-r"]} 11 | :test-clj {:extra-paths ["test"] 12 | :extra-deps {eftest {:mvn/version "0.5.7"}} 13 | :main-opts ["-e" "(require,'[eftest.runner,:refer,[find-tests,run-tests]]),(run-tests,(find-tests,\"test\"))"]} 14 | :test-cljs {:extra-paths ["test"] 15 | :extra-deps {olical/cljs-test-runner {:mvn/version "3.5.0"}} 16 | :main-opts ["-m" "cljs-test-runner.main" "-o" "target/cljs-test-runner-out"]}}} 17 | -------------------------------------------------------------------------------- /dev/core.cljs.edn: -------------------------------------------------------------------------------- 1 | ^{:watch-dirs ["src" "dev/src"] 2 | :log-level :info} 3 | {:main pluto.dev} 4 | 5 | -------------------------------------------------------------------------------- /dev/resources/public/assets/extensions/demo/extension.edn: -------------------------------------------------------------------------------- 1 | {meta 2 | {:name "Simple Demo" 3 | :description "A simple demo of extension" 4 | :documentation "Nothing. Just see a text with dynamic random color."} 5 | 6 | lifecycle 7 | {:on-activation [alert {:value "Activation !!"}]} 8 | 9 | hooks/main.demo 10 | {:view [main]} 11 | 12 | events/my-alert 13 | (let [{you :arg [value :as all] :value} properties] 14 | [alert {:value "Eh! ${you} ${value}"}]) 15 | 16 | events/cb 17 | (let [{value :arg v :value} properties 18 | {cond2? :cond?} [random-boolean]] 19 | (if cond? 20 | [alert {:value "Eh bis! ${cond2?}"}] 21 | [alert {:value "Eh ter! ${cond2?}"}]) 22 | [identity {:cb [my-alert {:arg value :value ["%% ${v}"]}]}]) 23 | 24 | views/local-view 25 | {:component-did-mount [alert {:value "Mount!!"}] 26 | :view 27 | (let [{name :name color :color level :level} properties] 28 | (case level 29 | :polite [text {:style {:color color}} "Hello!! ${name}"] 30 | :neutral [text {:style {:color color}} "Hey!! ${name}"] 31 | [text "?? ${name}"]))} 32 | 33 | views/local-view2 34 | (let [{name :name color :color level :level} properties] 35 | (case level 36 | :polite [text {:style {:color color}} "Hey!! ${name}"] 37 | "Hello ${name}")) 38 | 39 | views/main 40 | (let [{name :name users :users} properties 41 | {cond? :cond?} [random-boolean]] 42 | [view 43 | [text "1"] 44 | [text "2"] 45 | ;[local-view {:name "Hey!! ${name}" :color :red :level :polite}] 46 | [button {:on-click [cb {:arg name :value "AA"}]} 47 | "Click!"] 48 | ;[button {:on-click [alert {}]} 49 | ; "Click2 !"] 50 | 51 | [button {:on-click [my-alert {:arg cond? :value ["%% ${name}"]}]} 52 | "Click2 !"] 53 | [button {:on-click [alert {:value "AA"}]} 54 | "Click3 !"] 55 | (if cond? 56 | [text {:style {:color "green"}} 57 | name] 58 | [text {:style {:color "red"}} 59 | name]) 60 | [view "Nested for block"] 61 | (for [{nm :nm} users] 62 | [view 63 | (for [{nm2 :nm} users] 64 | [text nm " and " nm2])])])} 65 | -------------------------------------------------------------------------------- /dev/resources/public/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 29 | 30 | 31 |
32 |
33 | 34 |
35 |
36 |
37 | 38 | 39 | 40 | 41 | 44 | -------------------------------------------------------------------------------- /dev/src/pluto/dev.cljs: -------------------------------------------------------------------------------- 1 | (ns ^:figwheel-hooks pluto.dev 2 | (:require pluto.reader.events 3 | pluto.reader.views 4 | pluto.web.events 5 | pluto.web.queries 6 | [pluto.core :as pluto] 7 | [pluto.log :as log] 8 | [pluto.storages :as storages] 9 | [pluto.web.components :as components] 10 | [devtools.core :as devtools] 11 | [reagent.core :as reagent] 12 | [re-frame.core :as re-frame] 13 | [re-frame.registrar :as registrar] 14 | [re-frame.loggers :as re-frame.loggers])) 15 | 16 | (enable-console-print!) 17 | (devtools/install!) 18 | 19 | (defn ^:before-load before-reload [] 20 | (re-frame/clear-subscription-cache!) 21 | (println "Reloading ...")) 22 | 23 | (defn ^:after-load after-reload [] 24 | (println "Reloading done.")) 25 | 26 | (def warn (js/console.warn.bind js/console)) 27 | (re-frame.loggers/set-loggers! 28 | {:warn (fn [& args] 29 | (cond 30 | (= "re-frame: overwriting" (first args)) nil 31 | :else (apply warn args)))}) 32 | 33 | (defn- dispatch-events [ctx events] 34 | (doseq [event events] 35 | (if (vector? event) 36 | (re-frame/dispatch event) 37 | (log/fire! ctx ::log/error :event/dispatch event)))) 38 | 39 | (defn- resolve-query [ctx [id :as data]] 40 | (if (registrar/get-handler :sub id) 41 | (re-frame/subscribe data) 42 | (log/fire! ctx ::log/error :query/resolve data))) 43 | 44 | (defn view-fn [parent-ctx data] 45 | [:div {} 46 | data]) 47 | 48 | (def ctx 49 | {:env {:id "Extension ID"} 50 | :capacities {:components components/all 51 | :queries {'random-boolean 52 | {:data :random-boolean} 53 | 'identity 54 | {:data :extensions/identity 55 | :arguments {:value :map}}} 56 | :hooks {:main 57 | {:properties {:view :view}}} 58 | :events {'identity 59 | {:permissions [:read] 60 | :data :identity 61 | :arguments {:cb :event}} 62 | 'alert 63 | {:permissions [:read] 64 | :data :alert 65 | :arguments {:value :string}}}} 66 | :event-fn dispatch-events 67 | :query-fn resolve-query 68 | :view-fn view-fn}) 69 | 70 | (def payload 71 | {:name "Test Extension" 72 | :users [{:nm "Jane"} 73 | {:nm "Sue"}]}) 74 | 75 | (defn render [h el] 76 | (reagent/render (h {:name "Test Extension" 77 | :users [{:nm "Jane"} 78 | {:nm "Sue"}]}) el)) 79 | 80 | (defn errors-list [v] 81 | (fn [] 82 | [:div 83 | [:div "Errors"] 84 | (into [:ul] 85 | (for [[_ {type :type :as m}] v] 86 | [:li 87 | [:span [:b (str type)] (pr-str (dissoc m :type))]]))])) 88 | 89 | (defn render-extension [m el el-errors] 90 | (let [{:keys [data errors]} (pluto/parse ctx m)] 91 | (when errors 92 | (render (errors-list errors) el-errors)) 93 | (when-let [f (get-in data [:lifecycle :on-activation])] 94 | (f)) 95 | (if-let [view (get-in data [:hooks :main.demo :view])] 96 | (render view el) 97 | (render (fn [] [:div "Oups"]) el)))) 98 | 99 | (defn read-extension [o el el-errors] 100 | (let [{:keys [data errors]} (pluto/read (:content o))] 101 | (render-extension data el el-errors))) 102 | 103 | (defn render-result [{:keys [type value]} el el-errors] 104 | (case type 105 | :error (set! (.-innerHTML el-errors) value) 106 | (read-extension value el el-errors))) 107 | 108 | (defn ^:export bootstrap 109 | [s el el-errors] 110 | (storages/fetch s #(render-result % el el-errors))) 111 | -------------------------------------------------------------------------------- /dev/src/pluto/web/components.cljs: -------------------------------------------------------------------------------- 1 | (ns pluto.web.components 2 | (:require [re-frame.core :as re-frame])) 3 | 4 | (defn view [props & content] 5 | (into [:div props] content)) 6 | 7 | (defn button [{:keys [on-click] :as m} & content] 8 | (into [:button {:on-click #(on-click {})}] content)) 9 | 10 | (defn text [props & content] 11 | (into [:span props] content)) 12 | 13 | (def all {'view {:properties {} 14 | :data view 15 | :description "" 16 | :examples []} 17 | 'button {:properties {:on-click :event} 18 | :data button 19 | :examples []} 20 | 'text {:properties {} 21 | :data text 22 | :examples []}}) 23 | -------------------------------------------------------------------------------- /dev/src/pluto/web/events.cljs: -------------------------------------------------------------------------------- 1 | (ns pluto.web.events 2 | (:require [re-frame.core :as re-frame])) 3 | 4 | (re-frame/reg-fx 5 | ::alert 6 | (fn [value] (js/alert value))) 7 | 8 | (re-frame/reg-event-fx 9 | :alert 10 | (fn [_ [_ env {:keys [value]}]] 11 | {::alert (str "id = " (:id env) " value = " value)})) 12 | 13 | (re-frame/reg-fx 14 | ::identity 15 | (fn [{:keys [cb]}] (cb {}))) 16 | 17 | (re-frame/reg-event-fx 18 | :identity 19 | (fn [_ [_ _ m]] 20 | {::identity m})) 21 | -------------------------------------------------------------------------------- /dev/src/pluto/web/queries.cljs: -------------------------------------------------------------------------------- 1 | (ns pluto.web.queries 2 | (:require [re-frame.core :as re-frame])) 3 | 4 | (defonce do-timer (js/setInterval #(re-frame/dispatch [:random (zero? (rand-int 2))]) 1000)) 5 | 6 | (re-frame/reg-event-db 7 | :random 8 | (fn [db [_ b]] 9 | (assoc db :random {:cond? b}))) 10 | 11 | (re-frame/reg-sub 12 | :random-boolean 13 | :random) 14 | 15 | (re-frame/reg-sub :extensions/identity 16 | (fn [_ [_ _ {:keys [value]}]] value)) 17 | -------------------------------------------------------------------------------- /docs/discoverability.md: -------------------------------------------------------------------------------- 1 | How can an end user discover and install an extension? 2 | 3 | Let’s explore different options. 4 | 5 | ##Serendipity 6 | 7 | Extensions can be installed via a universal link that can be embedded in a QR code. So it can be as simple as finding a link or a QR code in the wild. 8 | 9 | ## Browsing a DApp 10 | 11 | Extensions references can be added via a status specific API. When browsing a DApp user could be informed that some extensions can be installed. See https://github.com/estebanmino/EIPs/blob/master/EIPS/eip-747.md 1 12 | 13 | ## Status discovery 14 | 15 | Status discovery might relay users extensions. Extensions would then be available via the discovery UI. 16 | 17 | ## Joining a chat 18 | 19 | A list of extensions could be associated to a chat. Once joining, a user would then be proposed to install those extensions to have a better experience. Those extensions would only be active in that specific chat. 20 | Private groups admin could manage this list of extensions. 21 | 22 | How can we have extensions associated to public chats? 23 | 24 | ## Chat command recipient call to action 25 | 26 | A chat command might be sent to a recipient who didn’t install the extension. It should be trivial for them to install the extension. 27 | 28 | ## ENS username 29 | 30 | Some well know key/value pair associated to a ENS username name could point to a set of extensions. Those extensions could be used during account creation/restoration. -------------------------------------------------------------------------------- /docs/editor.md: -------------------------------------------------------------------------------- 1 | # Extension editor 2 | 3 | Extension editor is the one tool used to create and permissionlessly publish an extension. 4 | As extension do not rely on existing languages or frameworks barrier to entry is significant. 5 | 6 | The following points are considered to improve the developer experience: 7 | - guidance to initiate an extension 8 | - cues to easily build bit by bit 9 | - feedback to make sure it will work as expected 10 | 11 | ## From zero to hero 12 | 13 | Add more examples, templates and one click option to create an extension skeleton. 14 | 15 | ## A feature complete editor 16 | 17 | Improve the editor basic features to match common expectations. 18 | 19 | ### Never loose work 20 | 21 | It should not be possible to loose the result of a work session. 22 | Indivual extensions are saved locally. All extensions ever edited can be retrieved via a workspace style panel. 23 | 24 | ### Improve syntax navigation 25 | 26 | Matching parens and nesting level are visualized using colors. 27 | Easily identify when a block syntax is correct. 28 | 29 | ### Semantic highlighting 30 | 31 | Semantic highlighting: each variable is identifyed by a unique color (https://medium.com/@evnbr/coding-in-color-3a6db2743a1e) 32 | References (events, views) are colored and can be navigated. 33 | 34 | ### Documentation 35 | 36 | Completion and easy doc access is provided for all supported primitives. 37 | 38 | ### Navigation 39 | 40 | A reference can be navigated on user clicks. A query can be listened to (data show inline) (LightTable watch https://www.youtube.com/watch?v=d8-b6QEN-rk) 41 | An event can be triggered with user provided data. 42 | Destructuring is facilitated. 43 | 44 | ## Prevent creation of invalid extension 45 | 46 | The editor is not a regular text editor. Users can't randomly edit extension, making it mostly read-only. 47 | Changes can only be introduced semantically, via custom actions. 48 | New pimitives can only be added via a custom editor action. Primitives children can be added. Text element and properties can be edited. 49 | Renaming a custom primitive will rename all its usages. 50 | 51 | ### Resources 52 | 53 | https://www.timmclean.net/json-editor/ 54 | https://github.com/projectional-haskell/structured-haskell-mode 55 | https://www.greenfoot.org/frames/ 56 | https://www.jetbrains.com/mps/ 57 | http://concrete-editor.org/ 58 | 59 | # Further improvments 60 | 61 | ## Time navigation 62 | 63 | Triple time axis (navigation) 64 | git history 65 | data changes (query changes, track events) 66 | extension changes (visual undo https://www.youtube.com/watch?v=UDTSyWA31XI https://vimsical.com) 67 | Time travelling 68 | 69 | ## Illiterate programming 70 | 71 | # Resources 72 | 73 | - https://harc.ycr.org/project/ 74 | - https://fr.wikipedia.org/wiki/Dynabook 75 | - https://history-computer.com/ModernComputer/Personal/Dynabook.html 76 | - https://github.com/reduxjs/redux-devtools 77 | - http://lighttable.com/archive/ 78 | - https://github.com/darwin/plastic 79 | - https://harc.ycr.org/project/ 80 | - http://cirru.org/ 81 | - https://mkremins.github.io/riffle/ 82 | - https://glitch.com/culture/an-intro-to-webvr/ 83 | - https://github.com/mkremins/flense 84 | - https://developer.apple.com/xcode/interface-builder/ 85 | - https://vimeo.com/62618532 86 | - https://www.youtube.com/watch?v=dl0CbKYUFTY 87 | - https://www.levenez.com/NeXTSTEP/ 88 | - http://unisonweb.org/posts/ 89 | - https://groups.google.com/forum/#!forum/augmented-programming 90 | - https://blog.isomorf.io/ 91 | - http://witheve.com/ https://github.com/witheve/Eve https://github.com/witheve/eve-experiments 92 | - https://observablehq.com/@jashkenas/against-the-current-what-we-learned-from-eve-transcript 93 | - https://github.com/witheve/eve-native/blob/master/examples/counter.eve 94 | - http://play.witheve.com/#/examples/editor.eve 95 | - http://play.witheve.com/#/examples/CRM.eve 96 | - http://incidentalcomplexity.com/ 97 | - http://mech-lang.org/ https://github.com/mech-lang/mech/blob/master/examples/tutorial.mec 98 | - https://github.com/mech-lang/mech 99 | - https://github.com/mozilla/mentat 100 | - https://dynamicland.org/ 101 | - http://incidentalcomplexity.com/ 102 | - https://lively-next.org/ 103 | - https://observablehq.com/ 104 | - https://glitch.com/ 105 | - https://observablehq.com/@jashkenas/against-the-current-what-we-learned-from-eve-transcript -------------------------------------------------------------------------------- /docs/ideas.md: -------------------------------------------------------------------------------- 1 | ## Easy token onboarding 2 | 3 | https://medium.com/connext/introducing-the-dai-card-fc46520078d3 4 | https://media.consensys.net/introducing-streaming-payments-for-ujo-with-connext-payment-channels-and-dai-16725929fe38 5 | https://daicard.io/redeem?secret=0x66091135e3c54d1d02bf28cd754bb2c209fc0895dc5f47bad5fa43a1a2923d78&amountToken=1000000000000000000&amountWei=0 6 | https://cash.cryptostaw.com/ (https://medium.com/matic-network/tackling-the-adoption-issue-one-dapp-at-a-time-e756fbabfea0) 7 | https://qrtoken.io 8 | https://medium.com/linkdrop-protocol/introducing-linkdrop-protocol-f612ae181e31 9 | https://twitter.com/rampnetwork/status/1113441698938589185 (buy using a credit card) 10 | 11 | ## Other exchange integration 12 | 13 | Similar to the Kyber extension 14 | 15 | https://uniswap.io/ 16 | https://twitter.com/uniswapexchange/status/1104658818741477376 17 | https://0x.org/instant 18 | 19 | ## Price oracle 20 | 21 | https://medium.com/@mykelp/introducing-polaris-ced195dd798e (based on Uniswap) 22 | 23 | ## Easy interface to provide liquidity 24 | 25 | https://compound.finance/ 26 | https://bzx.network/ 27 | https://uniswap.io/ 28 | https://makerdao.com/en/ 29 | xDai integration 30 | aka Burner wallet 31 | 32 | xdai.io 33 | https://twitter.com/uegabs/status/1103011155679870976 34 | 35 | ## Voting DApp extension 36 | 37 | MakerDAO CDP UI 38 | 0x integration ideas 39 | https://blog.0xproject.com/22-ideas-to-explore-with-0x-4d551c10dd4e 40 | https://blog.0xproject.com/0x-extensions-enabling-new-types-of-exchange-1db0bf6125b6 41 | 42 | ## Bloom integration (credit) 43 | 44 | bloom.co 45 | https://bloom.co/blog/introducing-bloom-starter/ 46 | https://bloom.co/blog/built-on-bloom-doxa-uses-bloom-to-build-more-efficient-lottery-system 47 | Discover local groups based on location 48 | https://www.foam.space/ 49 | 50 | ## Lend money 51 | 52 | http://trustlines.network/ (from your contacts) 53 | https://nuo.network/ 54 | https://dharma.io/ 55 | https://twitter.com/kermankohli/status/1103571081573486592 56 | https://twitter.com/joemccann/status/1103413202052833280 57 | https://dharmalytics.io/ 58 | https://medium.com/marbleorg/introducing-marble-a-smart-contract-bank-c9c438a12890 59 | 60 | ## Secure file exchange 61 | 62 | https://blog.datafund.net/fairdrop-secure-private-unstoppable-file-transfer-for-the-free-world-f1a39adbdeab -------------------------------------------------------------------------------- /docs/integration.md: -------------------------------------------------------------------------------- 1 | `stateofus.eth` allows anyone to associate an address to a logical name. 2 | On top of that, extra meta information can be stored using the `text` dictionary. 3 | This capacity can be used to link extensions to a name and leveraged by status in various ways. 4 | 5 | # An extension can be installed by name 6 | 7 | The `status.extension` property is associated to an ENS name. An extension can then easily be installed via its name e.g. `kyber`. 8 | Once installed, the user is automatically notified of updates and can easily install them. 9 | Older versions are still accessible and usable. 10 | 11 | # An account restoration triggers an extension activation 12 | 13 | An extension can be associated to a regular ENS name representing a user address via `status.account.extension`. 14 | Upon restoration, this extension is triggered allowing to perform restorative actions (e.g. adding contacts, groups, DApps, tokens, ..) 15 | 16 | # A public channel with bells and whistles 17 | 18 | When opening a public channel for the first time, a ENS lookup is performed on this channel name. 19 | The associated `status.channel.extension` is discovered and proposed for installation. 20 | 21 | e.g. Opening `#kyber` triggers a lookup on `kyber.stateofus.eth`. User is proposed to load associated `status.channel.extension`, if defined. This extension installs a `chat.command` in the `#kyber` channel and the kyber `wallet.settings` exchange. -------------------------------------------------------------------------------- /docs/presentations/security.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Extensions - security/privacy 3 | revealOptions: 4 | transition: 'fade' 5 | --- 6 | 7 | # Extensions 8 | ## security/privacy 9 | 10 | --- 11 | 12 | ## Context 13 | 14 | - Extend status features natively, permissionless 15 | - Data based 16 | - Simple primitives: hooks, queries, events, views 17 | 18 | --- 19 | 20 | # A simple language 21 | 22 | - No user defined logic (for now?) 23 | - Non turing complete language (only loop on finite set) 24 | - Can be analysed 25 | 26 | --- 27 | 28 | # What can go wrong? 29 | 30 | - Crashes 31 | - Unauthorized actions 32 | - Data leaks 33 | - Replicate sensitive UI (chat messages/wallet) 34 | 35 | --- 36 | 37 | # Crashes 38 | 39 | - Static analysis to detect incorrect syntax 40 | - Lightweight sandbox (React [error boundaries](https://reactjs.org/docs/error-boundaries.html), exception catching) 41 | 42 | --- 43 | 44 | # Privacy 45 | 46 | What (*capabilities*) accessed by whom (*scope*) after which action (*trigger*). 47 | 48 | --- 49 | 50 | # Capability-based security 51 | 52 | - An extension defines a set of capabilities and can only access those 53 | - Enhanced for decentralized world 54 | 55 | Note: 56 | 57 | - http://habitatchronicles.com/2017/05/what-are-capabilities/ 58 | - https://agoric.com/about/ 59 | - https://github.com/NuxiNL/cloudabi#capability-based-security 60 | - https://en.wikipedia.org/wiki/Capability-based_security 61 | - https://www.cl.cam.ac.uk/research/security/capsicum/ 62 | - https://fuchsia.googlesource.com/fuchsia/+/master/docs/the-book/sandboxing.md 63 | - https://github.com/CraneStation/wasmtime/blob/master/docs/WASI-overview.md#capability-oriented 64 | - https://github.com/CraneStation/wasmtime/blob/master/docs/WASI-capabilities.md 65 | - https://webassembly.org/docs/security/ 66 | - https://developers.google.com/caja/ 67 | - https://github.com/fastly/lucet/blob/master/SECURITY.md 68 | - https://sandstorm.io/how-it-works#capabilities 69 | 70 | - https://ethereum-magicians.org/t/ethereum-object-capabilities/3035 71 | - http://www.erights.org/elib/distrib/captp/index.html 72 | - http://www.erights.org/elib/capability/ode/index.html 73 | - http://zesty.ca/capmyths/usenix.pdf 74 | - https://github.com/danfinlay/capnode/tree/eip-712 75 | - https://w3c-ccg.github.io/ocap-ld/ 76 | - https://medium.com/capabul/minimum-viable-consensus-algorithms-with-object-capabilities-6059f926ab88 77 | 78 | Simple security model, no [same-origin policy](https://www.w3.org/Security/wiki/Same_Origin_Policy) 79 | --- 80 | 81 | # Leveraging data 82 | 83 | - Capabilities fully inferred per hook 84 | - Surfaced to user for validation 85 | 86 | --- 87 | 88 | # Example #1 89 | 90 | ```clojure 91 | {views/hello 92 | [text "Hello"] 93 | 94 | hooks/wallet.settings.hello 95 | {:label "Test wallet settings" 96 | :view [hello]}} 97 | ``` 98 | 99 | Note: 100 | 101 | No capabilities required 102 | 103 | --- 104 | 105 | # Example #2 106 | 107 | ```clojure 108 | {views/hello 109 | [gallery] ;; or input 110 | 111 | hooks/wallet.settings.hello 112 | {:label "Test wallet settings" 113 | :view [hello]}} 114 | ``` 115 | 116 | Note: 117 | 118 | Some capability required, extension scope 119 | 120 | --- 121 | 122 | # Example #3 123 | 124 | ```clojure 125 | {views/hello 126 | [image {:url "http://..."}] 127 | 128 | hooks/wallet.settings.hello 129 | {:label "Test wallet settings" 130 | :view [hello]}} 131 | ``` 132 | 133 | Note: 134 | 135 | Scope remote 136 | Depends on the URL 137 | 138 | --- 139 | 140 | # Example #4 141 | 142 | ```clojure 143 | {views/hello 144 | [image {:url "data:image/png;base64,iVBORw..."}] 145 | 146 | hooks/wallet.settings.hello 147 | {:label "Test wallet settings" 148 | :view [hello]}} 149 | ``` 150 | 151 | Note: 152 | 153 | No scope issue 154 | 155 | --- 156 | 157 | # Example #5 158 | 159 | ```clojure 160 | {views/hello 161 | (let [url [store/get {:value "KEY"}]] 162 | [image {:url url}]) 163 | 164 | hooks/wallet.settings.hello 165 | {:label "Test wallet settings" 166 | :view [hello] 167 | :on-open [http/get {...}]}} 168 | ``` 169 | 170 | Note: 171 | 172 | Send image issue: have all participants in a chat hit some HTTP endpoint with ethereum address and IPs 173 | Runtime check? User select scope, if doesn't match => fails 174 | 175 | --- 176 | 177 | # Scope 178 | 179 | What can be done with data accessed 180 | 181 | - hook 182 | - extension 183 | - local 184 | - remote (HTTP, IPFS) 185 | 186 | --- 187 | 188 | # Trigger 189 | 190 | What flow can lead to data leaks 191 | 192 | - user controlled (e.g. on button click) 193 | - extension controlled (on extension installation) 194 | 195 | Note: 196 | 197 | Scenario: on extension installation, access user address and send it using HTTP 198 | 199 | --- 200 | 201 | # Runtime 202 | 203 | - necessary capabilities inferred 204 | - surfaced to end user 205 | - end user can *reduce* those 206 | - extension can be run with insufficient capabilities, some features won't work (sandboxing) 207 | 208 | --- 209 | 210 | # Potential attack #1 211 | 212 | An extension uses OCR to read the seed from one of stored image 213 | 214 | - no such event currently 215 | - not clear how it could be prevented with 3rd party events 216 | - constrained by scope 217 | 218 | --- 219 | 220 | # Potential attack #2 221 | 222 | An extension periodically makes screenshot of the whole screen 223 | 224 | - no such event currently 225 | - not clear how it could be prevented with 3rd party events 226 | - constrained by scope 227 | - trigger could include status state information (e.g. only activate after seed is backuped) 228 | 229 | --- 230 | 231 | # Potential attack #3 232 | 233 | An extension replicates the whole status UI 234 | 235 | - constrained by scope 236 | - 3 words can't be accessed by extensions 237 | 238 | --- 239 | 240 | # UX is a challenge 241 | 242 | - Security profile to only surface selected capabilities 243 | - JIT user validation? 244 | - Problematic events? (e.g. send a message on behalf of user) 245 | 246 | --- 247 | 248 | # Risk level 249 | 250 | - Extracted from capabilities/scopes 251 | - Simplify user validation process 252 | 253 | --- 254 | 255 | # Security profile 256 | 257 | - A set of capabilities/scopes a user is confortable with 258 | - Once enabled, matching extensions can be installed w/o user validation 259 | 260 | --- 261 | 262 | # Open Questions 263 | 264 | - Mobile level permission is all or nothing 265 | - How to handle primitives created by 3rd parties? (future) 266 | -------------------------------------------------------------------------------- /docs/security.md: -------------------------------------------------------------------------------- 1 | Extensions are 3rd party chunk of data that can dynamically and permissionlessly modify Status behavior. 2 | How do we ensure Status security is preserved and no unauthorized data access is performed? 3 | 4 | # What can go wrong? 5 | 6 | - Crashes 7 | - Unauthorized actions 8 | - Data leaks 9 | - Replicate sensitive UI (chat messages/wallet) 10 | 11 | ## Crashes 12 | 13 | Static analysis is performed to detect incorrect syntax. Then a lightweight sandbox (React [error boundaries](https://reactjs.org/docs/error-boundaries.html), exception catching) act as safe guard. 14 | 15 | ## Status hijacking 16 | 17 | Any screen (including the wallet) can be recreated as an extension. Only Status has access to the 3 words, preventing users to be tricked into signing forged transactions. 18 | 19 | ## Privacy / Security 20 | 21 | Status contains a number of private data and can potential trigger actions with consequences (signing a transaction). 22 | A user must be made aware of what an extension can do during its installation. The set of what can be done can be restricted by the user. 23 | 24 | # Capability based security 25 | 26 | The proposed solution to address security and privacy risks is to rely on [Capacity based security](https://en.wikipedia.org/wiki/Capability-based_security) tailored for decentralized architecture. 27 | This model is used by a number of modern stacks ([Fuchsia](https://fuchsia.googlesource.com/fuchsia/+/master/docs/the-book/sandboxing.md), [WASI](https://github.com/CraneStation/wasmtime/blob/master/docs/WASI-capabilities.md) or even [Agoric](https://agoric.com/about/)). 28 | A good introduction to this model can be found [here](http://habitatchronicles.com/2017/05/what-are-capabilities/). 29 | 30 | Essentially each extension would run in an isolated sandbox with only pre-granted accesses. Extension then run under those capabilities and cannot access anything not provided. 31 | This is in contrast to hold user/permision model. 32 | 33 | Extensions extend this model by puting emphasis on the localisation of the data (`scope`) 34 | 35 | ## Scope 36 | 37 | Scope encompass what can be done with an identified piece of data. A data accessed but kept in the extension sandbox doesn't pose the same threat that the same send to arbitrary remote server. 38 | 39 | Scope can be: 40 | 41 | - hook 42 | - extension 43 | - local 44 | - remote (HTTP, IPFS) 45 | 46 | ## Trigger 47 | 48 | What flow can lead to data leaks. A user controlled leak (e.g. button click) has not the same meaning than an extension controlled one (e.g. triggered during extension activation). 49 | 50 | ## Runtime 51 | 52 | The capability required for an extension can be fully inferred dynamically by Status (due to their data nature). 53 | This set of capabilities is then exposed to end user. Users are free to restrict this set and grant them to the extension. 54 | An extension can always run with no capabilities, in a degraded sandboxed mode (e.g. some UI elements inactive, some events filtered). 55 | 56 | # UX is a challenge 57 | 58 | How to simply surface those informations and ensure end users make an informed decision? 59 | We want to prevent users clicking through those screens and accepting anything. 60 | 61 | ## Risk level 62 | 63 | A level (e.g. a note - A, B .. E-) is extracted from capabnilities and scopes required. It aggregates all associated risks. 64 | 65 | ## Security profile 66 | 67 | Users define a set of capabilities/scopes they are confortable with. Once enabled, matching extensions can be installed w/o validation. 68 | 69 | 70 | 71 | 72 | # Examples 73 | 74 | ```clojure 75 | {views/hello 76 | [text "Hello"] 77 | 78 | hooks/wallet.settings.hello 79 | {:label "Test wallet settings" 80 | :view [hello]}} 81 | ``` 82 | 83 | No specific capabilities required. No data is accessed 84 | 85 | ```clojure 86 | {views/hello 87 | [gallery] ;; or input 88 | 89 | hooks/wallet.settings.hello 90 | {:label "Test wallet settings" 91 | :view [hello]}} 92 | ``` 93 | 94 | Some capability required as `gallery` might leak user photo. No way to have them exported through this extension. 95 | 96 | ```clojure 97 | {views/hello 98 | [image {:url "http://..."}] 99 | 100 | hooks/wallet.settings.hello 101 | {:label "Test wallet settings" 102 | :view [hello]}} 103 | ``` 104 | 105 | Depending on the URL (e.g. `http` yes, `data:image/png;base64,iVBORw...` no) private data can be leaked. 106 | 107 | ```clojure 108 | {views/hello 109 | (let [url [store/get {:value "KEY"}]] 110 | [image {:url url}]) 111 | 112 | hooks/wallet.settings.hello 113 | {:label "Test wallet settings" 114 | :view [hello] 115 | :on-open [http/get {...}]}} 116 | ``` 117 | 118 | Some examples cannot be fully analyzed (e.g. depends on runtime data). -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "@status-im/pluto", 3 | "version": "0.2.0", 4 | "description": "A library for building status extensions", 5 | "main": "npm/pluto.node.js", 6 | "repository": { 7 | "type": "git", 8 | "url": "git+https://github.com/status-im/pluto.git" 9 | }, 10 | "keywords": [ 11 | "status", 12 | "pluto", 13 | "clojure", 14 | "clojurescript", 15 | "dapp", 16 | "ethereum", 17 | "blockchain", 18 | "decentralized" 19 | ], 20 | "author": "jelurad", 21 | "license": "MPL-2.0", 22 | "bugs": { 23 | "url": "https://github.com/status-im/pluto/issues" 24 | }, 25 | "homepage": "https://github.com/status-im/pluto#readme" 26 | } 27 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject status-im/pluto "iteration-4-10-SNAPSHOT" 2 | :dependencies [[org.clojure/clojure "1.10.0"] 3 | [org.clojure/clojurescript "1.10.516"] 4 | [org.clojure/tools.reader "1.3.2"] 5 | [reagent "0.8.1"]] 6 | :source-paths ["src"]) 7 | -------------------------------------------------------------------------------- /scripts/npm.sh: -------------------------------------------------------------------------------- 1 | clojure -m cljs.main -t node -d 'npm/lib' -o 'npm/pluto.node.js' -co '{:asset-path "npm/lib"}' -v true -c pluto.core 2 | -------------------------------------------------------------------------------- /src/pluto/core.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.core 2 | "Main pluto namespace entry point." 3 | (:refer-clojure :exclude [read]) 4 | (:require [clojure.string :as string] 5 | [clojure.tools.reader.edn :as edn] 6 | [pluto.error :as error] 7 | [pluto.reader.events :as events] 8 | [pluto.reader.types :as types] 9 | [pluto.reader.views :as views] 10 | [pluto.utils :as utils])) 11 | 12 | (defn- reader-error [ex] 13 | (error/create ::error/format ::error/invalid nil 14 | (merge {:kind (:ex-kind (ex-data ex)) 15 | :message (utils/ex-message ex)} 16 | (when-let [c (utils/ex-cause ex)] 17 | {:cause c})))) 18 | 19 | (defn read 20 | "Reads an extension definition as an EDN string. 21 | 22 | No semantic validation is performed at this stage. 23 | 24 | Returns a map defining: 25 | * `:data` the extension definition as a map 26 | * `:errors` a vector of errors map triggered during read" 27 | [s] 28 | (try 29 | {:data (edn/read-string {} s)} 30 | (catch #?(:clj Exception :cljs :default) ex 31 | {:errors {'global {'all [(reader-error ex)]}}}))) 32 | 33 | (defn key-name [k] (or (namespace k) (name k))) 34 | 35 | (defmulti parse-value 36 | "Parse an extension value from its type" 37 | (fn [ctx ext k v] (key-name k))) 38 | 39 | (defn- capacity? [m s] 40 | (let [keys (set (map name (keys m)))] 41 | (keys (name s)))) 42 | 43 | (defn parse-value-with [capacities t k f] 44 | (if (capacity? (get capacities t) k) 45 | [(error/syntax ::error/invalid {:type ::error/overridden} {:data k})] 46 | (f))) 47 | 48 | (def ^:private meta-properties 49 | {:name :string 50 | :description :string 51 | :documentation? :string}) 52 | 53 | (defmethod parse-value "meta" [ctx ext _ v] 54 | (types/resolve ctx ext meta-properties v)) 55 | 56 | (defmethod parse-value "events" [{:keys [capacities] :as ctx} ext k v] 57 | (parse-value-with capacities :events k #(events/parse ctx ext v ""))) 58 | 59 | (defmethod parse-value "views" [{:keys [capacities] :as ctx} ext k v] 60 | (parse-value-with capacities :components k #(views/parse ctx ext v))) 61 | 62 | (defn hook-type 63 | "Type of a hook 64 | e.g. (= \"chat.command\" (hook-type 'chat.command.hello-world))" 65 | [s] 66 | (when s 67 | (string/join "." (butlast (string/split (name s) #"\."))))) 68 | 69 | (defmethod parse-value "hooks" [{:keys [capacities] :as ctx} ext k o] 70 | (parse-value-with capacities :hooks k 71 | #(let [{:keys [properties]} (get-in ctx [:capacities :hooks (keyword (hook-type k))])] 72 | (types/resolve ctx ext properties o)))) 73 | 74 | (def ^:private lifecycle-properties 75 | {:ephemeral? :boolean 76 | :on-activation? :event 77 | :on-installation? :event 78 | :on-deactivation? :event 79 | :on-deinstallation? :event}) 80 | 81 | (defmethod parse-value "lifecycle" [ctx ext _ v] 82 | (types/resolve ctx ext lifecycle-properties v)) 83 | 84 | (defmethod parse-value :default [_ _ k _] 85 | [(error/syntax ::error/invalid {:data k})]) 86 | 87 | (defn- accumulate 88 | "Accumulates the result of parsed primitives. 89 | Shape is: {:data {'primitive data} :errors {'primitive errors} :permissions #{}} 90 | If returned map contains :errors, :data is ignored." 91 | [ctx ext acc k v] 92 | (let [{:keys [data errors]} (parse-value ctx ext k v)] 93 | (assoc-in acc 94 | (if (namespace k) 95 | [(if errors :errors :data) (keyword (key-name k)) (keyword (name k))] 96 | [(if errors :errors :data) (keyword (key-name k))]) 97 | (or errors data)))) 98 | 99 | (def ^:const order ["meta" "events" "views" "hooks" "lifecycle"]) 100 | 101 | (defn- order-comparator 102 | "Compares keys based on `order`" 103 | [k1 k2] 104 | (let [indexes (zipmap order (range))] 105 | (compare [(get indexes (key-name k1)) k1] [(get indexes (key-name k2)) k2]))) 106 | 107 | (defn parse 108 | "Parse an extension definition map as encapsulated in :data key of the map returned by `read`. 109 | `ctx` is a map defining: 110 | * `capacities` a map of valid supported capacities (hooks, queries, events) 111 | * `env` a map of extension environment, will be provided as second parameter into event and query handlers 112 | * `event-fn` a function used to fire events 113 | * `query-fn` a function receiving a query and returning an `atom` 114 | * `log-fn` [optional] a function that will be passed details about runtime extension execution (event fired, query values updated, ..): {:id 0 :category :error :type ::log/dispatch :data {}} 115 | 116 | 117 | Returns the input map modified so that values have been parsed into: 118 | * `:data` the result of parsing 119 | * `:permissions` a vector of required permissions 120 | * `:errors` a vector of errors maps triggered during the parsing 121 | 122 | If `errors` is not empty, `data` will not be available. 123 | 124 | e.g. 125 | 126 | {:data {'views/a (fn [o] [text \"hello\"])} 127 | :permissions {'events/f #{}}} 128 | 129 | or 130 | 131 | {:errors {'views/a [{:category ::error/invalid ..}]} 132 | :permissions {'events/f #{}}}" 133 | [ctx ext] 134 | (reduce-kv #(accumulate ctx ext %1 %2 %3) {} ;; TODO move ext to %1 135 | ;; Make sure elements are parsed in a controlled order 136 | (into (sorted-map-by order-comparator) ext))) 137 | -------------------------------------------------------------------------------- /src/pluto/error.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.error 2 | "Errors are generated during the static analysis of an extension source" 3 | (:require [clojure.spec.alpha :as spec])) 4 | 5 | (spec/def ::category #{::format ::syntax}) 6 | 7 | (spec/def ::type #{::invalid ::missing ::unknown ::overridden}) 8 | 9 | (spec/def ::target (spec/keys :req [::type ::key] 10 | :opt [::location])) 11 | 12 | (spec/def ::context map?) 13 | 14 | (spec/def ::error (spec/keys :req [::category ::type] 15 | :opt [::target ::context])) 16 | 17 | (defn create 18 | [category type target context] 19 | {:pre [(spec/valid? ::category category) 20 | (spec/valid? ::type type)]} 21 | (cond-> {:category category :type type} 22 | target (assoc :target target) 23 | context (assoc :context context))) 24 | 25 | (defn syntax 26 | ([type] (syntax type nil)) 27 | ([type target] (syntax type target nil)) 28 | ([type target context] 29 | (create ::syntax type target context))) 30 | 31 | ;; TODO move to another ns 32 | 33 | (defn- update-errors [m errors] 34 | (if (seq errors) 35 | (update m :errors concat errors) 36 | m)) 37 | 38 | (defn- update-data [m f data] 39 | (if data 40 | (update m :data f data) 41 | m)) 42 | 43 | (defn merge-result 44 | ([m mm] (merge-result merge m mm)) 45 | ([f m {:keys [data errors]}] 46 | (-> m 47 | (update-data f data) 48 | (update-errors errors)))) 49 | 50 | (defn merge-results [& ms] 51 | (reduce merge-result {} ms)) 52 | 53 | (defn merge-results-with [f & ms] 54 | (reduce #(merge-result f %1 %2) {} ms)) 55 | -------------------------------------------------------------------------------- /src/pluto/log.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.log 2 | "Logs capture the runtime activity of an extension" 3 | (:require [clojure.spec.alpha :as spec])) 4 | 5 | (spec/def ::category #{::error ::log ::trace}) 6 | 7 | (def ^:private id (atom 0)) 8 | 9 | (defn- next-id [] (swap! id inc)) 10 | 11 | (defn- create 12 | "Create a log map. To be used with `fire!`" 13 | [c t v] 14 | {:id (next-id) 15 | :category c ;; a keyword 16 | :type t ;; :error or :trace 17 | :data v}) ;; a map 18 | 19 | (defn fire! 20 | "Fire an event provided object using the ctx `log-fn`" 21 | [{:keys [log-fn]} category type data] 22 | (when (fn? log-fn) 23 | (log-fn (create category type data)))) 24 | -------------------------------------------------------------------------------- /src/pluto/reader/blocks.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.reader.blocks 2 | (:require [clojure.walk :as walk] 3 | #?(:cljs [reagent.core :as reagent]) 4 | [pluto.error :as error] 5 | [pluto.log :as log] 6 | [pluto.reader.destructuring :as destructuring] 7 | [pluto.reader.types :as types] 8 | [pluto.utils :as utils])) 9 | 10 | (defn- invalid-block 11 | [type m] 12 | (error/syntax ::error/invalid {:type :block} (assoc m :type type))) 13 | 14 | (defmulti parse 15 | "Parse a block element. Return hiccup data." 16 | (fn [ctx ext parent [type]] type)) 17 | 18 | (defn- interpolate [ctx m v] 19 | (let [{:keys [data errors]} (utils/interpolate m v)] 20 | (if errors 21 | (log/fire! ctx ::log/error :query/interpolation errors) 22 | data))) 23 | 24 | (defn substitute-query-values [ctx m v] 25 | (walk/prewalk #(or (get m %) (when (string? %) (interpolate ctx m %)) %) v)) 26 | 27 | (defn- query? [binding-value] 28 | (and (vector? binding-value) 29 | (let [s (first binding-value)] 30 | (or (symbol? s) (keyword? s))))) 31 | 32 | (defn resolve-rhs [{:keys [query-fn] :as ctx} env v] 33 | (cond 34 | (= v 'properties) (get env :pluto.reader/properties) 35 | (symbol? v) (get env v) 36 | (query? v) 37 | (when (fn? query-fn) 38 | (when-let [signal (query-fn ctx (substitute-query-values ctx env v))] 39 | (let [o @signal] 40 | (log/fire! ctx ::log/trace :query/resolve {:key v :value o}) 41 | o))) 42 | :else v)) 43 | 44 | (defn destructure-into [env k v] 45 | (if (map? k) 46 | (into env (:data (destructuring/destructure k v))) 47 | (assoc env k v))) 48 | 49 | (defn resolve-binding [ctx env k v] 50 | (let [v' (resolve-rhs ctx env v)] 51 | (destructure-into env k v'))) 52 | 53 | (defn resolve-bindings-into [ctx env bindings] 54 | (reduce #(apply resolve-binding ctx %1 %2) (or env {}) (partition 2 bindings))) 55 | 56 | (defn replace-atom [ctx values o] 57 | (cond (contains? values o) (get values o) 58 | (symbol? o) nil 59 | (string? o) (interpolate ctx values o) 60 | (and (fn? o) (:event (meta o))) #(o %1 (merge %2 {:env values})) ;; Intercept events and inject the env. TODO remove this hack 61 | :else (walk/postwalk-replace values o))) 62 | 63 | (defn walkup-upto-leaf [f lp? lf tree] 64 | (if (lp? tree) 65 | (lf tree) 66 | (let [res (f tree) 67 | f2 (partial walkup-upto-leaf f lp? lf)] 68 | (cond (list? res) (apply list (map f2 res)) 69 | (map-entry? res) (vec (map f2 res)) 70 | (seq? res) (doall (map f2 res)) 71 | (coll? res) (into (empty res) (map f2 res)) 72 | :else res)))) 73 | 74 | (declare let-block for-block) 75 | 76 | (defn let-block [{:keys [ctx prev-env bindings]} children] 77 | (let [new-env (resolve-bindings-into ctx prev-env bindings)] 78 | (walkup-upto-leaf #(replace-atom ctx new-env %) 79 | #(and (vector? %) (#{for-block let-block} (first %))) 80 | (fn [[x props children]] 81 | [x (assoc props :prev-env new-env) children]) 82 | children))) 83 | 84 | (defn for-block [{:keys [ctx prev-env bindings]} children] 85 | (let [[k v] bindings 86 | for-values (resolve-rhs ctx prev-env v)] 87 | (when (sequential? for-values) 88 | #?(:cljs 89 | (apply array 90 | (map reagent/as-element 91 | (for [val for-values] 92 | ^{:key val} 93 | [let-block {:ctx ctx :prev-env prev-env :bindings [k val]} 94 | children]))))))) 95 | 96 | (defn static-value? [v] 97 | (or (utils/primitive? v) (map? v))) 98 | 99 | (defn valid-bindings? [k v] 100 | (and (or (symbol? k) (map? k) (vector? k)) 101 | (or (symbol? v) (static-value? v) (query? v)))) 102 | 103 | (defn- valid-bindings-form? [bindings] 104 | (when (seqable? bindings) 105 | (even? (count bindings)))) 106 | 107 | (defn resolve-and-validate-queries [ctx ext bindings] 108 | (reduce (fn [accum [k v]] 109 | (if (vector? v) 110 | (let [{:keys [data errors]} (types/resolve ctx ext :query v)] 111 | (if (not-empty errors) 112 | (update accum :errors concat errors) 113 | (update accum :data concat [k data]))) 114 | (update accum :data concat [k v]))) 115 | {:data []} 116 | (partition 2 bindings))) 117 | 118 | ;; we also need a set of available symbols bound at this point 119 | (defn validate-bindings [bindings] 120 | (if (valid-bindings-form? bindings) 121 | (not-empty 122 | (let [binding-pairs (partition 2 bindings)] 123 | (concat 124 | (->> binding-pairs 125 | (filter #(not (apply valid-bindings? %))) 126 | (mapv #(invalid-block 'let {:data % :reason :bindings}))) 127 | (->> binding-pairs 128 | (map first) 129 | (filter (some-fn sequential? map?)) 130 | (mapcat destructuring/validate-destructure-bindings))))) 131 | [(invalid-block 'let {:data bindings :reason :bindings-format})])) 132 | 133 | (defn- valid-let-block? [body] 134 | (= 1 (count body))) 135 | 136 | (defmethod parse 'let [ctx ext _ [_ bindings & body]] 137 | (if-not (valid-let-block? body) 138 | {:errors [(invalid-block 'let {:data body :reason :body})]} 139 | (let [binding-errors (validate-bindings bindings)] 140 | (if (not-empty binding-errors) 141 | {:errors binding-errors} 142 | (let [{:keys [errors data]} (resolve-and-validate-queries ctx ext bindings)] 143 | (if (not-empty errors) 144 | {:errors errors} 145 | {:data [let-block {:ctx ctx :bindings data} (last body)]})))))) 146 | 147 | (defmethod parse 'for [ctx ext _ [_ binding & body]] 148 | (cond 149 | (not= 1 (count body)) 150 | {:errors [(invalid-block 'for {:data body :reason :body})]} 151 | (or (not= 2 (count binding)) 152 | (not ((some-fn symbol? map?) (first binding)))) 153 | {:errors [(invalid-block 'for {:data binding :reason :bindings})]} 154 | :else 155 | (let [{:keys [errors data]} (resolve-and-validate-queries ctx ext binding)] 156 | (if (not-empty errors) 157 | {:errors errors} 158 | {:data [for-block {:ctx ctx :bindings data} 159 | (last body)]})))) 160 | 161 | (defn when-block [{:keys [test]} body] 162 | (when test body)) 163 | 164 | (defmethod parse 'when [_ _ _ [_ test & body :as parts]] 165 | (let [errors (cond-> nil 166 | (not (symbol? test)) 167 | (conj (invalid-block 'when {:data test :reason :invalid-test-type})) 168 | (empty? body) 169 | (conj (invalid-block 'when {:data parts :reason :empty-body-clause})))] 170 | (if (not-empty errors) 171 | {:errors errors} 172 | {:data (apply conj [when-block {:test test}] body)}))) 173 | 174 | (defn if-block [{:keys [test]} & body] 175 | (if test 176 | (first body) 177 | (second body))) 178 | 179 | (defmethod parse 'if [_ _ _ [_ test then else :as parts]] 180 | (let [parts-count (count (rest parts)) 181 | errors (cond-> nil 182 | (not (symbol? test)) 183 | (conj (invalid-block 'if {:reason :test :data test})) 184 | (< 3 parts-count) 185 | (conj (invalid-block 'if {:reason :too-many-clauses :data parts})) 186 | (> 3 parts-count) 187 | (conj (invalid-block 'if {:reason :three-clauses-required :data parts})))] 188 | (if (not-empty errors) 189 | {:errors errors} 190 | {:data (apply conj [if-block {:test test}] (list then else))}))) 191 | 192 | (defn case-block [{:keys [expression tests]} & results] 193 | (or (some #(when (= expression (key %)) (val %)) (zipmap tests results)) 194 | (when (not= (count tests) (count results)) 195 | (last results)))) 196 | 197 | (defmethod parse 'case [_ _ _ [_ expression & clauses]] 198 | (let [pairs (partition 2 clauses) 199 | errors (cond-> nil 200 | (not (every? keyword? (map first pairs))) 201 | (conj (invalid-block 'case {:reason :tests :data (map first pairs)})))] 202 | (if (not-empty errors) 203 | {:errors errors} 204 | {:data (into [case-block {:expression expression :tests (map first pairs)}] 205 | (concat (mapv second pairs) 206 | (when (odd? (count clauses)) [(last clauses)])))}))) 207 | 208 | (defmethod parse :default [_ _ _ block] {:errors [(error/syntax ::error/unknown {:type :block} {:data block})]}) 209 | -------------------------------------------------------------------------------- /src/pluto/reader/destructuring.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.reader.destructuring 2 | (:refer-clojure :exclude [destructure]) 3 | (:require [pluto.error :as error])) 4 | 5 | (declare destructure-assoc destructure-seq) 6 | 7 | (defn- valid-bindings-form? [o] 8 | (or (symbol? o) (vector? o) (map? o) (= :as o))) 9 | 10 | (defn- seq-bindings-size [bindings] 11 | (let [size (count bindings)] 12 | (if (some #{:as} bindings) 13 | (- size 2) 14 | size))) 15 | 16 | (defn- symbol-afer-as? [bindings idx] 17 | (and (pos? idx) (= :as (nth bindings (dec idx))))) 18 | 19 | (defn- merge-seq-bindings [bindings s m idx value] 20 | (cond 21 | (or (= :as value) (= '_ value)) m 22 | (symbol-afer-as? bindings idx) (assoc-in m [:data value] s) 23 | (symbol? value) (assoc-in m [:data value] (nth s idx)) 24 | ;; Recursive destructuring 25 | (map? value) (error/merge-results m (destructure-assoc value (nth s idx))) 26 | (sequential? value) (error/merge-results m (destructure-seq value (nth s idx))))) 27 | 28 | (defn- valid-seq-format? [bindings s] 29 | (and (sequential? bindings) 30 | (every? valid-bindings-form? bindings) 31 | (<= (seq-bindings-size bindings) (count s)))) 32 | 33 | (defn destructure-seq [bindings s] 34 | (if (valid-seq-format? bindings s) 35 | (reduce-kv #(merge-seq-bindings bindings s %1 %2 %3) {} (into {} (map-indexed vector bindings))) 36 | {:errors [(error/syntax ::error/invalid {:type :destructuring} {:type :sequential :data bindings})]})) 37 | 38 | (defn- merge-assoc-bindings [s m k v] 39 | (cond 40 | (vector? v) (assoc-in m [:data k] (or ((first v) s) (second v))) 41 | (symbol? k) (assoc-in m [:data k] (v s)) 42 | (= :as k) (assoc-in m [:data v] s) 43 | ;; Recursive destructuring 44 | (map? k) (error/merge-results m (destructure-assoc k (v s))) 45 | (sequential? k) (error/merge-results m (destructure-seq k (v s))))) 46 | 47 | (defn- valid-assoc-format? [bindings] 48 | (and (map? bindings) 49 | (every? valid-bindings-form? (keys bindings)))) 50 | 51 | (defn destructure-assoc [bindings s] 52 | (if (valid-assoc-format? bindings) 53 | (reduce-kv #(merge-assoc-bindings s %1 %2 %3) {} bindings) 54 | {:errors [(error/syntax ::error/invalid {:type :destructuring} {:type :assoc :data bindings})]})) 55 | 56 | ;; recursively validate destructure bindings form 57 | (defn validate-destructure-bindings [bindings] 58 | (not-empty 59 | (cond 60 | (map? bindings) 61 | (if (valid-assoc-format? bindings) 62 | (mapcat 63 | validate-destructure-bindings 64 | (filter (some-fn sequential? map?) (keys bindings))) 65 | [(error/syntax ::error/invalid {:type :destructuring} {:type :assoc :data bindings})]) 66 | (sequential? bindings) 67 | (if (every? valid-bindings-form? bindings) 68 | (mapcat 69 | validate-destructure-bindings 70 | (filter (some-fn sequential? map?) bindings)) 71 | [(error/syntax ::error/invalid {:type :destructuring} {:type :assoc :data bindings})])))) 72 | 73 | (defn destructure 74 | "Given a pattern and an associated data structure, return a map of either: 75 | * :data, a map of extracted symbol / value pairs 76 | * :errors, a vector of errors encountered during the destructuring" 77 | [bindings s] 78 | (cond 79 | (sequential? bindings) 80 | (destructure-seq bindings s) 81 | (map? bindings) 82 | (destructure-assoc bindings s))) 83 | -------------------------------------------------------------------------------- /src/pluto/reader/events.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.reader.events 2 | (:require [clojure.walk :as walk] 3 | [pluto.error :as error] 4 | [pluto.log :as log] 5 | [pluto.reader.destructuring :as destructuring] 6 | [pluto.reader.reference :as reference] 7 | [pluto.reader.types :as types] 8 | [pluto.utils :as utils])) 9 | 10 | ;; TODO part of this is duplicated from blocks/let 11 | 12 | (defn- interpolate [ctx m v] 13 | (let [{:keys [data errors]} (utils/interpolate m v)] 14 | (if errors 15 | (log/fire! ctx ::log/error :query/interpolation errors) 16 | data))) 17 | 18 | (defn replace-atom [ctx env o] 19 | (cond (contains? env o) (get env o) 20 | (symbol? o) nil 21 | (string? o) (interpolate ctx env o) 22 | (fn? o) #(o %1 (merge {:a %2} {:env env})) 23 | :else (walk/postwalk-replace env o))) 24 | 25 | (defn- resolve-env 26 | "Resolve pairs from `env` in `m`. 27 | Uses #replace-atom to perform the resolution." 28 | [ctx env m] 29 | (reduce-kv #(assoc %1 %2 (replace-atom ctx env %3)) {} m)) 30 | 31 | (defn- resolve-arguments 32 | "Resolve an event arguments based on event definition" 33 | [ctx ext event arguments] 34 | (if-let [type (get-in ctx [:capacities :events event :arguments])] 35 | (types/resolve ctx ext type arguments) 36 | {:errors [(error/syntax ::error/invalid {:type :reference} {:type :event :data event})]})) 37 | 38 | (defn- dispatch-event 39 | "Safely call `event-fn`" 40 | [event-fn ctx events] 41 | (try 42 | (when-let [o (event-fn ctx events)] 43 | (log/fire! ctx ::log/error :event/dispatch {:reason :return-value-ignored :data o})) 44 | (catch #?(:clj Exception :cljs :default) ex 45 | (log/fire! ctx ::log/error :event/dispatch {:reason :exception-thrown :data ex})))) 46 | 47 | (defn- dispatch-events 48 | "Dispatches an event using ctx" 49 | [{:keys [event-fn] :as ctx} events raw?] 50 | (if (seq events) 51 | (do 52 | (log/fire! ctx ::log/trace :event/dispatch {:data events}) 53 | (cond 54 | raw? events 55 | (fn? event-fn) (dispatch-event event-fn ctx events) 56 | :else 57 | (log/fire! ctx ::log/error :event/dispatch {:reason (if event-fn :invalid-event-fn :missing-event-fn) :data events}))) 58 | (log/fire! ctx ::log/error :event/dispatch {}))) 59 | 60 | (defn- resolve-event 61 | "Returns the final event vector" 62 | [ctx ext env [event args :as reference]] 63 | (let [{data :data} (reference/resolve ctx ext :event reference) 64 | {inline :data} (resolve-arguments ctx ext event (or args {}))] 65 | [data (:env ctx) (resolve-env ctx env inline)])) 66 | 67 | (defn- create-event [ctx ext env ref] 68 | (cond 69 | (vector? ref) 70 | (resolve-event ctx ext env ref) 71 | :else 72 | (let [[_ test if else] ref] 73 | (if (get env test) 74 | (resolve-event ctx ext env if) 75 | (resolve-event ctx ext env else))))) 76 | 77 | (defn- resolve-query 78 | "Resolve a query using ctx" 79 | [{:keys [query-fn] :as ctx} ext query] 80 | (let [{data :data} (types/resolve ctx ext :query query)] 81 | (when query-fn 82 | (when-let [signal (query-fn ctx data)] 83 | (let [o @signal] 84 | (log/fire! ctx ::log/trace :query/resolve {:value o :query query}) 85 | o))))) 86 | 87 | (defn- merge-resolved-query [ctx ext m {:keys [value bindings]}] 88 | (cond 89 | (map? bindings) 90 | (merge m (:data (destructuring/destructure bindings (merge m (resolve-query ctx ext value))))) 91 | (symbol? bindings) 92 | (assoc m bindings (resolve-query ctx ext value)))) 93 | 94 | (defn- event-dispatcher 95 | "Returns a function of 2 arguments " 96 | [ctx ext refs arguments {:keys [queries properties]}] 97 | {:data 98 | (with-meta 99 | (fn [dynamic {:keys [env raw?]}] 100 | ;; TODO env contains data that shouldn't be there 101 | ;; env is the dispatched argument. Used as default but is overridden by the local arguments 102 | ;; Perform destructuring based on dynamic and static arguments 103 | ;; Then resolve recursive properties in the aggregated env 104 | ;; Final map contains inline arguments resolved 105 | (let [{:keys [data errors]} (destructuring/destructure properties (merge dynamic arguments))] 106 | (when (seq errors) 107 | (log/fire! ctx ::log/error :event/destructuring errors)) 108 | (let [env' (resolve-env ctx env (merge env (reduce #(merge-resolved-query ctx ext %1 %2) data queries)))] 109 | (dispatch-events ctx (map #(create-event ctx ext env' %) refs) raw?)))) 110 | {:event true})}) 111 | 112 | (defn- references 113 | "Returns a list of local event references" 114 | [data] 115 | (drop 2 data)) 116 | 117 | (defn if-block? [o] 118 | (and (list? o) 119 | (let [[s test if else] o] 120 | (and (= 'if s) 121 | (symbol? test) 122 | (reference/reference? if) 123 | (and else (reference/reference? else)))))) 124 | 125 | (defn- event? [o] 126 | (or (reference/reference? o) 127 | (if-block? o))) 128 | 129 | (defn local-event? 130 | "A local event must define a let block and have a single destructuring binding accessing 'properties." 131 | [data] 132 | (when (list? data) 133 | (let [[form bindings] data] 134 | (and (< 2 (count data)) 135 | (= 'let form) 136 | (even? (count bindings)) 137 | (map? (first bindings)) 138 | (= 'properties (second bindings)) 139 | (every? event? (references data)))))) 140 | 141 | (defn- merge-pair [m [k v]] 142 | (cond 143 | (= v 'properties) (assoc m :properties k) 144 | :else (update m :queries concat [{:value v :bindings k}]))) 145 | 146 | (defn- parse-let-bindings [bindings] 147 | (let [pairs (partition 2 bindings)] 148 | (reduce merge-pair 149 | {} 150 | pairs))) 151 | 152 | (defn parse 153 | "Parses local references defining let blocks" 154 | [ctx ext [_ let-bindings :as local] arguments] 155 | (if (local-event? local) 156 | (event-dispatcher ctx ext (references local) arguments (parse-let-bindings let-bindings)) 157 | {:errors [(error/syntax ::error/invalid {:type :local-event} {:data local})]})) 158 | 159 | ;; TODO check unresolved symbols 160 | 161 | (defmethod types/resolve :event [ctx ext _ [_ arguments :as value]] 162 | (let [{:keys [data errors] :as m} (reference/resolve ctx ext :event value)] 163 | ;; resolve returns either data or errors 164 | (if data 165 | (merge (when data 166 | (if (keyword? data) 167 | (event-dispatcher ctx ext (list value) arguments nil) 168 | (parse ctx ext data arguments))) 169 | (when errors 170 | {:errors (apply conj [(error/syntax ::error/unknown {:type :event} {:data symbol})] errors)})) 171 | m))) 172 | -------------------------------------------------------------------------------- /src/pluto/reader/reference.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.reader.reference 2 | "Utils functions helping with primitive references. 3 | 4 | A reference is a vector whose first element is a symbol and optional second element is a map. 5 | 6 | e.g. [view] or [ethereum/log {:address \"\"}]" 7 | (:refer-clojure :exclude [resolve]) 8 | (:require [pluto.error :as error])) 9 | 10 | (defn reference? 11 | "Return true if argument is a reference" 12 | [ref] 13 | (when (vector? ref) 14 | (let [[name arguments] ref] 15 | (and (symbol? name) 16 | (>= 2 (count ref)) 17 | (or (nil? arguments) (map? arguments) (symbol? arguments)))))) 18 | 19 | (defn reference->symbol 20 | "Return the symbol pointed by the reference 21 | 22 | ```clojure 23 | (= 'some.ref (reference->symbol ['some.ref])) 24 | ```" 25 | [o] 26 | (when (reference? o) 27 | (first o))) 28 | 29 | (def ^:const type->ns {:view "views" :query "queries" :event "events"}) 30 | (def ^:const type->capacity {:view :components :query :queries :event :events}) 31 | 32 | (defn- resolve-symbol 33 | "Resolve a symbol first via the extension definition then via the host ctx." 34 | [ctx ext type ns s] 35 | (or (get ext (symbol ns (name s))) 36 | (get-in ctx [:capacities (get type->capacity type) s :data]))) 37 | 38 | (defn resolve 39 | "Resolve a reference to a primitive. 40 | 41 | ```clojure 42 | (= {:data \"view\"} (resolve {} {'views/id \"view\"} :view ['id])) 43 | ```" 44 | [ctx ext type ref] 45 | (if-let [s (reference->symbol ref)] 46 | (if-let [ns (get type->ns type)] 47 | (if-let [o (resolve-symbol ctx ext type ns s)] 48 | {:data o} 49 | {:errors [(error/syntax ::error/unknown {:type :reference} {:data s :type type})]}) 50 | {:errors [(error/syntax ::error/invalid {:type :reference} {:reason :type :data type})]}) 51 | {:errors [(error/syntax ::error/invalid {:type :reference} {:type type :data ref})]})) 52 | -------------------------------------------------------------------------------- /src/pluto/reader/types.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.reader.types 2 | "Resolve values based on provided types. 3 | Handles primitives, references and composed values." 4 | (:refer-clojure :exclude [resolve]) 5 | (:require [clojure.set :as set] 6 | [clojure.string :as string] 7 | [pluto.error :as error] 8 | [pluto.reader.reference :as reference])) 9 | 10 | (def reference-types #{:view :event :query}) 11 | 12 | (defmulti resolve 13 | "Resolve a value based on a type. 14 | Returns a map of either: 15 | * data with the resolved data 16 | * errors encapsulating all errors generated during resolution" 17 | (fn [ctx ext type value] 18 | (cond 19 | (symbol? value) :symbol 20 | (:one-of type) :one-of 21 | (:or type) :or 22 | (keyword? type) type 23 | (set? type) :subset 24 | (map? type) :assoc 25 | (vector? type) :sequence))) 26 | 27 | (defmethod resolve :symbol [_ _ _ value] 28 | ;; TODO properly validate symbols based on inferred type 29 | {:data value}) 30 | 31 | (defn invalid-type-value [type value] 32 | (error/syntax ::error/invalid {:type :type} {:type type :data value})) 33 | 34 | (defmethod resolve :any [_ _ _ value] 35 | {:data value}) 36 | 37 | (defmethod resolve :boolean [_ _ _ value] 38 | (if (boolean? value) 39 | {:data value} 40 | {:errors [(invalid-type-value :boolean value)]})) 41 | 42 | (defmethod resolve :number [_ _ _ value] 43 | (if (number? value) 44 | {:data value} 45 | {:errors [(invalid-type-value :number value)]})) 46 | 47 | (defmethod resolve :string [_ _ _ value] 48 | (if (string? value) 49 | {:data value} 50 | {:errors [(invalid-type-value :string value)]})) 51 | 52 | (defmethod resolve :keyword [_ _ _ value] 53 | (if (keyword? value) 54 | {:data value} 55 | {:errors [(invalid-type-value :keyword value)]})) 56 | 57 | (defmethod resolve :vector [_ _ _ value] 58 | (if (vector? value) 59 | {:data value} 60 | {:errors [(invalid-type-value :vector value)]})) 61 | 62 | (defmethod resolve :map [_ _ _ value] 63 | (if (map? value) 64 | {:data value} 65 | {:errors [(invalid-type-value :map value)]})) 66 | 67 | (defmethod resolve :subset [_ _ type value] 68 | (if (and (set? value) (set/subset? value type)) 69 | {:data value} 70 | {:errors [(invalid-type-value :subset value)]})) 71 | 72 | (defmethod resolve :sequence [ctx ext type value] 73 | (if (and (vector? type) (= 1 (count type)) (map? (first type))) 74 | (apply error/merge-results-with #(conj (vec %1) %2) (map #(resolve ctx ext (first type) %) value)) 75 | {:errors [(error/syntax ::error/invalid {:type :type} {:type type :data value :reason :sequential-type})]})) 76 | 77 | (defmethod resolve :one-of [_ _ {:keys [one-of]} value] 78 | (if-let [o (one-of value)] 79 | {:data o} 80 | {:errors [(invalid-type-value :one-of value)]})) 81 | 82 | (defmethod resolve :or [ctx ext {:keys [or]} value] 83 | (if (coll? or) 84 | (if-let [o (some #(when-let [{:keys [data]} (resolve ctx ext % value)] data) or)] 85 | {:data o} 86 | {:errors [(invalid-type-value :or value)]}) 87 | {:errors [(invalid-type-value :or value)]})) 88 | 89 | (def ^:private sentinel ::sentinel) 90 | 91 | (defn- property [name value] 92 | (let [normalized-name (keyword (string/replace (clojure.core/name name) "?" ""))] 93 | {:value (get value normalized-name sentinel) 94 | :name normalized-name 95 | :optional? (not= name normalized-name)})) 96 | 97 | (defn- resolve-property [ctx ext m {:keys [name optional? value]} type] 98 | (if (not= sentinel value) 99 | (let [{:keys [data errors]} (resolve ctx ext type value)] 100 | (error/merge-result 101 | (if data (assoc-in m [:data name] data) m) 102 | {:errors errors})) 103 | (if optional? 104 | (update m :data #(if (empty? %) {} %)) 105 | (assoc m :errors [(error/syntax ::error/invalid {:type :type} {:reason :missing-property :data name})])))) 106 | 107 | (defmethod resolve :assoc [ctx ext type value] 108 | (if (map? type) 109 | (reduce-kv #(resolve-property ctx ext %1 (property %2 value) %3) 110 | {} type) 111 | {:errors [(error/syntax ::error/invalid {:type :type} {:type type :data value :reason :assoc-type})]})) 112 | 113 | ;; TODO replace with generic reference resolution? 114 | ;; reference resolution: first lookup ctx, then local primitives if supported 115 | 116 | (defmethod resolve :query [{:keys [env] :as ctx} ext type [name arguments :as value]] 117 | (let [{:keys [data errors]} (reference/resolve ctx ext type value)] 118 | (merge (when data {:data (if arguments [data env arguments] [data env])}) 119 | (when errors 120 | {:errors (apply conj [(error/syntax ::error/invalid {:type :type} {:reason :unknown-query :data name})] errors)})))) 121 | 122 | (defmethod resolve :default [_ _ type value] 123 | {:errors [(error/syntax ::error/invalid {:type :type} (merge {:type type} (when value {:data value})))]}) 124 | -------------------------------------------------------------------------------- /src/pluto/reader/views.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.reader.views 2 | (:require [clojure.set :as set] 3 | [clojure.spec.alpha :as spec] 4 | #?(:cljs [reagent.core :as reagent]) 5 | [pluto.error :as error] 6 | [pluto.log :as log] 7 | [pluto.reader.blocks :as blocks] 8 | [pluto.reader.reference :as reference] 9 | [pluto.reader.types :as types] 10 | [pluto.utils :as utils])) 11 | 12 | (spec/def ::form 13 | (spec/or 14 | :string string? 15 | :number number? 16 | :symbol symbol? 17 | :element vector? 18 | :block list?)) 19 | 20 | (spec/def ::property-map (spec/map-of keyword? any?)) 21 | 22 | (spec/def ::element 23 | (spec/cat 24 | :tag (spec/or :symbol symbol? :fn fn?) 25 | :attrs (spec/? map?) 26 | :children (spec/* ::form))) 27 | 28 | (declare parse) 29 | 30 | (defn parse-hiccup-children [ctx ext parent children] 31 | (reduce #(let [{:keys [data errors]} (parse ctx ext parent %2)] 32 | (error/merge-result (update %1 :data conj data) {:errors errors})) 33 | {:data []} children)) 34 | 35 | (defn component? [o] 36 | (symbol? o)) 37 | 38 | (defn- block? [o] 39 | ;; TODO better abstract blocks 40 | (fn? o)) 41 | 42 | (defn- resolve-component [ctx ext [element :as o]] 43 | (cond 44 | (block? element) element 45 | (symbol? element) (or (get-in ctx [:capacities :components element :data]) 46 | ; First resolve using default components then lookup for local views 47 | ;; TODO handle errors 48 | (:data (types/resolve ctx ext :view o))))) 49 | 50 | (defmulti resolve-default-component-properties 51 | "Resolve default properties available for all components." 52 | (fn [property value] property)) 53 | 54 | (defmethod resolve-default-component-properties :style [_ value] 55 | {:data value}) 56 | 57 | (defmethod resolve-default-component-properties :default [_ _] 58 | nil) 59 | 60 | (defn resolve-custom-component-properties [ctx ext component k v] 61 | (if-let [type (get-in ctx [:capacities :components component :properties k])] 62 | (if-not (and (types/reference-types type) (not (#{:event :view} type))) 63 | ;; TODO Infer symbol types and fail if type does not match 64 | (if-not (symbol? v) 65 | (let [{:keys [data errors]} (types/resolve ctx ext type v)] 66 | (if errors 67 | {:errors errors} 68 | {:data data})) 69 | {:data v}) 70 | {:errors [(error/syntax ::error/invalid {:type :view} {:reason :component-property-type :component component :property k :type type})]}) 71 | (if (types/resolve ctx ext :view v) 72 | {:data v} 73 | {:errors [(error/syntax ::error/invalid {:type :view} {:reason :unknown-component-property :component component :property k})]}))) 74 | 75 | (defn- resolve-component-property [ctx ext component k v] 76 | (or (resolve-default-component-properties k v) 77 | (resolve-custom-component-properties ctx ext component k v))) 78 | 79 | (defn- resolve-property [ctx ext component k v] 80 | (if (component? component) 81 | (resolve-component-property ctx ext component k v) 82 | {:data v})) 83 | 84 | (defn- resolve-component-properties [ctx ext component properties] 85 | (if-let [explain (spec/explain-data ::property-map properties)] 86 | {:errors [(error/syntax ::error/invalid {:type :view} {:reason :property-map :data properties :explain-data explain})]} 87 | (reduce-kv (fn [acc k v] 88 | (let [{:keys [data errors]} (resolve-property ctx ext component k v)] 89 | (error/merge-result 90 | (update acc :data assoc k data) 91 | {:errors errors}))) 92 | {:data {} 93 | :errors []} 94 | properties))) 95 | 96 | (defn- resolve-properties-children [[properties? & children]] 97 | [(and (map? properties?) properties?) 98 | (cond 99 | (map? properties?) children 100 | (not (nil? properties?)) (cons properties? children) 101 | :else children)]) 102 | 103 | (defn parse-hiccup-element [ctx ext parent-ctx o] 104 | (let [explain 105 | (if (vector? o) ;; this eliminates spec explain data noise 106 | (spec/explain-data ::element o) 107 | (spec/explain-data ::form o))] 108 | (cond 109 | (not (nil? explain)) 110 | {:errors [(error/syntax ::error/invalid {:type :view} {:data o :explain-data explain})]} 111 | 112 | (or (symbol? o) (utils/primitive? o)) {:data o} 113 | 114 | (vector? o) 115 | (let [[element & properties-children] o 116 | component (resolve-component ctx ext o) 117 | [properties children] (resolve-properties-children properties-children) 118 | {:keys [data errors]} (when properties 119 | (resolve-component-properties ctx ext element properties))] 120 | (error/merge-result 121 | (let [m (parse-hiccup-children ctx ext o children)] 122 | ;; Reduce parsed children to a single map and wrap them in a hiccup element 123 | ;; whose component has been translated to the local platform 124 | (if component (update m :data #(apply conj (if data [component data] [component]) %)) m)) 125 | {:errors 126 | (concat 127 | (when (nil? component) [(error/syntax ::error/unknown {:type :view} {:data o :type :component})]) 128 | errors)})) 129 | :else {:errors [(error/syntax ::error/unknown {:type :view} {:data o :type :component})]}))) 130 | 131 | (defn unresolved-properties [acc o] 132 | (cond 133 | (symbol? o) (conj acc o) 134 | (map? o) (reduce #(apply conj %1 (unresolved-properties acc %2)) acc (vals o)) 135 | (vector? o) (reduce #(apply conj %1 (unresolved-properties acc %2)) acc o) 136 | :else acc)) 137 | 138 | (defn event->fn [ctx ext event f] 139 | (fn [& o] 140 | (when event 141 | (let [{:keys [data errors]} (types/resolve ctx ext :event event)] 142 | ;; TODO errors 143 | (when data 144 | (data (apply f o))))))) 145 | 146 | #?(:cljs 147 | (defn default-logger [ctx error info] 148 | (log/fire! ctx ::log/error :view {:error error :info info}))) 149 | 150 | (defn error-boundary [ctx component] 151 | #?(:cljs 152 | (reagent/create-class 153 | {:display-name "error-boundary-wrapper" 154 | :component-did-catch #(default-logger ctx %1 %2) 155 | :reagent-render (fn error-boundary [_] component)}))) 156 | 157 | (defn- inject-properties 158 | "Inject `properties` into the top level `let` block." 159 | ;; TODO remove this dependency on specifics of let block 160 | [h properties] 161 | (if (vector? h) 162 | (let [[tag & properties-children] h 163 | [props children] (resolve-properties-children properties-children) 164 | ;; Only need to add this to the first let block but no harm really 165 | props (if (and properties (= tag blocks/let-block)) 166 | (assoc-in props [:prev-env :pluto.reader/properties] properties) 167 | props)] 168 | (apply conj (if props [tag props] [tag]) 169 | (map #(inject-properties % properties) children))) 170 | h)) 171 | 172 | #?(:cljs 173 | (defn- create-reagent-spec [ctx ext {:keys [get-initial-state component-will-receive-props should-component-update 174 | component-will-mount component-did-mount component-will-update 175 | component-did-update component-will-unmount]} data] 176 | (merge {:display-name (str (first data)) 177 | :reagent-render (fn [o] 178 | [error-boundary ctx 179 | (inject-properties data o)])} 180 | (when get-initial-state {:get-initial-state-mount (event->fn ctx ext get-initial-state #(js->clj %))}) 181 | (when component-will-receive-props {:component-will-receive-props (event->fn ctx ext component-will-receive-props #(assoc (js->clj %1) :new %2))}) 182 | (when should-component-update {:should-component-update (event->fn ctx ext should-component-update #(assoc (js->clj %1) :old %2 :new %3))}) 183 | (when component-will-mount {:component-will-mount (event->fn ctx ext component-will-mount #(js->clj %))}) 184 | (when component-did-mount {:component-did-mount (event->fn ctx ext component-did-mount #(do {}))}) 185 | (when component-will-update {:component-will-update (event->fn ctx ext component-will-update #(assoc (js->clj %1) :new %2))}) 186 | (when component-did-update {:component-did-update (event->fn ctx ext component-did-update #(assoc (js->clj %1) :old %2))}) 187 | (when component-will-unmount {:component-will-unmount (event->fn ctx ext component-will-unmount #(do {}))})))) 188 | 189 | (defn bindings [data] 190 | (let [o (first (get-in data [1 :bindings]))] 191 | ;; TODO Follow symbols 192 | (when (map? o) 193 | (set (keys o))))) ;; TODO extract all bindings props, not only first level 194 | 195 | 196 | (defn- wrap-view [parent-ctx {:keys [view-fn] :as ctx} {:keys [data errors] :as m}] 197 | (if (and (not errors) view-fn) 198 | (let [view (view-fn parent-ctx data)] 199 | (if (vector? view) 200 | {:data view} 201 | (do 202 | (log/fire! ctx ::log/error :view/fn view) 203 | m))) 204 | m)) 205 | 206 | ;; TODO normalize to always have a props map 207 | (defn parse 208 | ([ctx ext o] 209 | (let [{:keys [data errors] :as m} (parse ctx ext nil (if (map? o) (:view o) o))] 210 | (if errors 211 | m 212 | (if (map? o) 213 | #?(:cljs {:data (reagent/create-class (create-reagent-spec ctx ext o data))}) 214 | {:data 215 | (fn [o] 216 | [error-boundary ctx 217 | (inject-properties data o)])})))) 218 | ([ctx ext {:keys [path] :as parent-ctx} o] 219 | (wrap-view parent-ctx ctx 220 | (if (list? o) 221 | (let [{:keys [data errors]} (blocks/parse ctx ext parent-ctx o)] 222 | (if errors 223 | {:errors errors} 224 | (let [d (parse ctx ext {:parent o :path (conj path 0)} data) 225 | ;; TODO Properly introduce `bindings` at top parsing level, not in blocks 226 | props (set/difference (reduce unresolved-properties #{} d) 227 | (bindings data))] 228 | (error/merge-result 229 | d 230 | {:errors [] #_(concat errors (when (seq props) [(error/syntax ::error/invalid {:type :view} {:reason :unresolved-properties :data props})]))})))) 231 | (parse-hiccup-element ctx ext parent-ctx o))))) 232 | 233 | (defmethod types/resolve :view [ctx ext type value] 234 | (let [{:keys [data errors]} (reference/resolve ctx ext type value)] 235 | (if data 236 | (parse ctx ext data) 237 | {:errors errors}))) 238 | -------------------------------------------------------------------------------- /src/pluto/storage.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.storage) 2 | 3 | (defprotocol Storage 4 | "" 5 | (fetch [this id callback])) 6 | -------------------------------------------------------------------------------- /src/pluto/storage/gist.cljs: -------------------------------------------------------------------------------- 1 | (ns pluto.storage.gist 2 | (:require [pluto.storage :as storage])) 3 | 4 | (defn result [xhr] 5 | (let [status (.-status xhr)] 6 | (if (= 404 status) 7 | {:type :error :value status} 8 | {:type :success :value {:content (.-responseText xhr)}}))) 9 | 10 | ;; TODO Handle all edn files types, not only extension.edn 11 | 12 | (defn gist-url [id] 13 | (str "https://gist.githubusercontent.com/" id "/raw")) 14 | 15 | (deftype GistStorage [] 16 | storage/Storage 17 | (fetch [_ {:keys [value]} callback] 18 | (let [xhr (js/XMLHttpRequest.)] 19 | (.open xhr "GET" (gist-url value) true) 20 | (.send xhr nil) 21 | (set! (.-onreadystatechange xhr) 22 | #(when (= (.-readyState xhr) 4) 23 | (callback (result xhr))))))) 24 | -------------------------------------------------------------------------------- /src/pluto/storage/http.cljs: -------------------------------------------------------------------------------- 1 | (ns pluto.storage.http 2 | (:require [pluto.storage :as storage])) 3 | 4 | (defn result [xhr] 5 | (let [status (.-status xhr) 6 | content (.-responseText xhr) ] 7 | (if (= 200 status) 8 | {:type :success :value {:content content}} 9 | {:type :error :value {:status status :content content}}))) 10 | 11 | (def default-timeout 5000) 12 | 13 | (defn get-url [url callback] 14 | (let [xhr (js/XMLHttpRequest.)] 15 | (set! (.-timeout xhr) default-timeout) 16 | (.open xhr "GET" url true) 17 | (.send xhr nil) 18 | (set! (.-onreadystatechange xhr) 19 | #(when (= (.-readyState xhr) 4) 20 | (callback (result xhr)))))) 21 | 22 | (deftype HTTPStorage [] 23 | storage/Storage 24 | (fetch [_ {:keys [value]} callback] 25 | (get-url (str value "/extension.edn") callback))) 26 | -------------------------------------------------------------------------------- /src/pluto/storage/ipfs.cljs: -------------------------------------------------------------------------------- 1 | (ns pluto.storage.ipfs 2 | (:require [pluto.storage :as storage] 3 | [pluto.storage.http :as http])) 4 | 5 | (defn infura-url [hash] 6 | (str "https://ipfs.infura.io/ipfs/" hash)) 7 | 8 | (deftype IPFSStorage [] 9 | storage/Storage 10 | (fetch [_ {:keys [value]} callback] 11 | (http/get-url (infura-url value) callback))) 12 | -------------------------------------------------------------------------------- /src/pluto/storages.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.storages 2 | (:require [clojure.string :as string] 3 | [pluto.storage :as storage] 4 | [pluto.storage.http :as http] 5 | [pluto.storage.gist :as gist] 6 | [pluto.storage.ipfs :as ipfs])) 7 | 8 | (def all 9 | {"url" (http/HTTPStorage.) 10 | "gist" (gist/GistStorage.) 11 | "ipfs" (ipfs/IPFSStorage.)}) 12 | 13 | (defn fetch [uri cb] 14 | (when (and uri cb) 15 | (let [[type id] (string/split uri "@")] 16 | (when-let [s (get all type)] 17 | (storage/fetch 18 | s 19 | {:value id} cb))))) 20 | -------------------------------------------------------------------------------- /src/pluto/utils.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.utils 2 | (:refer-clojure :exclude [ex-cause ex-message]) 3 | #?(:clj (:import java.util.Locale)) 4 | (:require [clojure.set :as set] 5 | [clojure.string :as string] 6 | [pluto.error :as error] 7 | #?(:cljs [goog.string :as gstring]) 8 | #?(:cljs [goog.string.format]))) 9 | 10 | (defn ex-cause 11 | [ex] 12 | #?(:clj (when (instance? Throwable ex) 13 | (.getCause ^Throwable ex)) 14 | :cljs (cljs.core/ex-cause ex))) 15 | 16 | (defn ex-message 17 | [ex] 18 | #?(:clj (when (instance? Throwable ex) 19 | (.getMessage ^Throwable ex)) 20 | :cljs (cljs.core/ex-message ex))) 21 | 22 | (defn primitive? [o] 23 | (or (boolean? o) 24 | (int? o) 25 | (float? o) 26 | (string? o))) 27 | 28 | (def ^:private placeholder-pattern #"\$\{([^\{]*)\}") 29 | 30 | (defn- placeholders 31 | "Extract a collection of placeholders from a string. 32 | (placeholders \"\")" 33 | [s] 34 | (map (comp #(hash-map :name (symbol (first %)) :pattern (second %)) #(string/split % #":") second) 35 | (re-seq placeholder-pattern s))) 36 | 37 | (defn- default-format 38 | "`format` but using `en` locale" 39 | [pattern] 40 | (str "%" (or (second (string/split pattern #":")) pattern))) 41 | 42 | (defmulti format-pattern 43 | "Extract the format pattern from the full format. 44 | Dispatch is done using the last character of the format. 45 | 46 | e.g. format name:5s is dispatched using 's'" 47 | (fn [pattern] (when (string/includes? pattern ":") (str (last pattern))))) 48 | 49 | (defmethod format-pattern "f" [pattern] (default-format pattern)) 50 | 51 | (defmethod format-pattern "d" [pattern] (default-format pattern)) 52 | 53 | (defmethod format-pattern "s" [pattern] (default-format pattern)) 54 | 55 | (defmethod format-pattern :default [_] "%s") 56 | 57 | #?(:clj 58 | (defn- format-en 59 | "`format` but using `en` locale" 60 | [fmt & args] 61 | (String/format (Locale. "en") fmt (to-array args)))) 62 | 63 | (defn interpolate 64 | "Interpolates placeholders inside a string. 65 | Returns an error if a placeholder can't be resolved." 66 | [values s] 67 | (let [v (placeholders s) 68 | names (map :name v) 69 | extra (set/difference (set names) (set (keys values)))] 70 | (if (seq extra) 71 | {:errors [(error/syntax ::error/invalid {:type :placeholders} {:data extra})]} 72 | {:data 73 | (if (seq v) 74 | (apply #?(:clj format-en :cljs gstring/format) 75 | (string/replace s placeholder-pattern 76 | (fn [[_ pattern]] (format-pattern pattern))) (map #(or (get values %) "") names)) 77 | s)}))) 78 | -------------------------------------------------------------------------------- /test/pluto/core_test.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.core-test 2 | (:refer-clojure :exclude [read]) 3 | (:require [clojure.test :refer [is deftest]] 4 | [pluto.core :as pluto] 5 | [pluto.error :as error] 6 | [pluto.reader.blocks :as blocks])) 7 | 8 | #_ 9 | (deftest read 10 | (is (= {:data nil} (pluto/read ""))) 11 | (is (= {:errors [{::error/message "No reader function for tag =." 12 | ::error/type ::error/reader-error ::error/value :reader-error}]} 13 | (pluto/read "#=(eval (def x 3))"))) 14 | (is (= {:errors [{::error/type ::error/reader-error ::error/value :eof ::error/message "Unexpected EOF while reading item 0 of vector."}]} (pluto/read "["))) 15 | (is (= {:errors [{::error/type ::error/reader-error ::error/value :reader-error ::error/message "No reader function for tag unknown."}]} 16 | (pluto/read "#unknown []"))) 17 | (is (= {:data {:extension/main 'view/main 18 | :views/main ['view {} 19 | ['text "Hello"] 20 | (list 'let ['cond? 'queries/random-boolean] 21 | (list 'when 'cond? 22 | ['text {} 23 | "World"]))]}} 24 | (pluto/read 25 | "{:extension/main view/main 26 | 27 | :views/main 28 | [view {} 29 | [text \"Hello\"] 30 | (let [cond? queries/random-boolean] 31 | (when cond? 32 | [text {} 33 | \"World\"]))]}")))) 34 | 35 | (def default-meta {:name "" :description "" :documentation ""}) 36 | 37 | (defn extension [m] 38 | (assoc m 'meta default-meta)) 39 | 40 | (def default-hooks {:main {:properties {:view :view}}}) 41 | (def default-components {'text :text 'view :view}) 42 | (def default-capacities {:capacities {:hooks default-hooks :components default-components}}) 43 | 44 | (defn view [m] 45 | ((get-in m [:data :hooks :main :a :parsed :view]) {})) 46 | 47 | #_ 48 | (deftest parse-blocks 49 | (is (= [blocks/let-block 50 | '{:bindings [s "Hello"] 51 | :prev-env {:pluto.reader/properties {}}} 52 | '[text {} s]] 53 | (view (pluto/parse default-capacities 54 | (extension {'views/main (list 'let ['s "Hello"] ['text {} 's]) 55 | 'hooks/main.a {:view ['views/main]}}))))) 56 | (is (= [blocks/when-block {:test 'cond} '[text {} ""]] 57 | (view (pluto/parse default-capacities 58 | (extension {'views/main (list 'when 'cond ['text {} ""]) 59 | 'hooks/main.a {:view ['views/main]}}))))) 60 | (is (= {:data {'meta default-meta 61 | :hooks {:main {:a {:parsed nil 62 | :hook-ref (:main default-hooks)}}}} 63 | :errors (list {::error/type ::error/unsupported-test-type ::error/value "string"})} 64 | (pluto/parse default-capacities (extension {'views/main (list 'when "string" ['text {} ""]) 65 | 'hooks/main.a {:view ['views/main]}}))))) 66 | 67 | #_ 68 | (deftest parse 69 | (is (= (list {::error/type ::error/unknown-component ::error/value 'text}) 70 | (:errors (pluto/parse {:capacities {:hooks default-hooks}} 71 | (extension {'views/main ['text {} "Hello"] 72 | 'hooks/main.a {:view ['views/main]}}))))) 73 | (is (= '[text {} "Hello"] 74 | (view (pluto/parse default-capacities 75 | (extension {'views/main ['text {} "Hello"] 76 | 'hooks/main.a {:view ['views/main]}})))))) 77 | -------------------------------------------------------------------------------- /test/pluto/examples_test.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.examples-test 2 | (:refer-clojure :exclude [read]) 3 | (:require [clojure.test :refer [is deftest]] 4 | [pluto.core :as reader] 5 | #?(:cljs [pluto.utils-test :include-macros true :refer [slurp]]))) 6 | 7 | #_ 8 | (deftest examples 9 | (is (empty? (:errors (reader/parse {:capacities {:hooks {:main {:properties {}}}}} 10 | (:data (reader/read (slurp "examples/resources/public/assets/extensions/demo/extension.edn")))))))) 11 | 12 | -------------------------------------------------------------------------------- /test/pluto/reader/block_test.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.reader.block-test 2 | (:require [clojure.test :refer [is deftest testing]] 3 | [pluto.core :as reader] 4 | [pluto.error :as error] 5 | [pluto.reader.blocks :as blocks]) 6 | #?(:cljs (:require-macros 7 | [pluto.reader.block-test :refer [with-fetch-data]]))) 8 | 9 | #_ 10 | (deftest let-block 11 | (testing "parse" 12 | (is (= {:data [blocks/let-block '{:bindings [s "Hello"]} 's]} 13 | (blocks/parse {} {} nil '(let [s "Hello"] s)))) 14 | (is (empty? 15 | (:errors (blocks/parse {:capacities {:queries {'aa {:value :a}}}} {} nil '(let [{a :a} [aa]] a))))) 16 | 17 | (is (= {:data [blocks/let-block 18 | '{:bindings [{a :a} {:a {:b 1}} {b :b} a]} 19 | 'b]} 20 | (blocks/parse {} {} nil '(let [{a :a} {:a {:b 1}} {b :b} a] b)))) 21 | (is (empty? 22 | (:errors (blocks/parse {:capacities 23 | {:queries {'aa {:value :a :arguments {:x :string}}}}} 24 | {} 25 | nil 26 | '(let [x 1 {a :a} [aa {:x x}]] a))))) 27 | 28 | (is (= {:data [blocks/let-block '{:bindings [s "Hello"]} 29 | ['test {} 's]]} 30 | (blocks/parse {} {} nil (list 'let ['s "Hello"] ['test {} 's])))) 31 | (is (= (blocks/validate-bindings '[s "Hello" 1]) 32 | [(error/syntax ::error/invalid-bindings-format ['s "Hello" 1])]))) 33 | 34 | 35 | 36 | #_ 37 | (is (= {:errors [(error/syntax ::error/invalid-bindings-format ['s "Hello" 1])]} 38 | (blocks/parse {} {} nil (list 'let ['s "Hello" 1] ['test {} 's])))) 39 | 40 | (is (= {:data [blocks/let-block '{:bindings [{a :a} {:a 1}]} 41 | '[test {} a]]} 42 | (blocks/parse {} {} nil '(let [{a :a} {:a 1}] [test {} a]))))) 43 | 44 | 45 | 46 | (deftest let-block-resolution 47 | (is (= [identity {} 1] (blocks/let-block {:bindings '[a 1] } [identity {} 'a]))) 48 | #_ 49 | (is (= ['test {} 1] (blocks/let-block {:env '{{a :a} [:aa]}} '[test {} a])))) 50 | 51 | (defn first-error-type [{:keys [errors]}] 52 | (-> errors first ::error/type)) 53 | 54 | #_ 55 | (deftest parse-if-when-errors 56 | (is (= (first-error-type (blocks/parse {} {} nil '(if []))) 57 | ::error/invalid-if-block)) 58 | (is (= (first-error-type (blocks/parse {} {} nil '(if asdf []))) 59 | ::error/invalid-if-block)) 60 | (is (= (first-error-type (blocks/parse {} {} nil '(if asdf))) 61 | ::error/invalid-if-block)) 62 | (is (= (first-error-type (blocks/parse {} {} nil '(when []))) 63 | ::error/invalid-when-block)) 64 | (is (= (first-error-type (blocks/parse {} {} nil '(when asdf))) 65 | ::error/invalid-when-block))) 66 | 67 | (declare let-test-capacities) 68 | 69 | #_ 70 | (deftest resolve-bindings 71 | (is (= '{a "asdf" 72 | b "asdf"} 73 | (blocks/resolve-binding {} '{a "asdf"} 'b 'a))) 74 | (is (= '{a {:asdf "foo"}, asdf "foo"} 75 | (blocks/resolve-binding {} '{a {:asdf "foo"}} '{asdf :asdf} 'a))) 76 | (is (= '{:pluto.reader/properties {:asdf "foo"}, asdf "foo"} 77 | (blocks/resolve-binding {} 78 | '{:pluto.reader/properties {:asdf "foo"}} '{asdf :asdf} 'properties))) 79 | (is (= "asdfg" 80 | (blocks/resolve-rhs {} {} '[::identity-query nil {:x "asdfg"}]))) 81 | 82 | (is (= "asdfg" 83 | (blocks/resolve-rhs {} '{a "asdfg"} '[::identity-query nil {:x a}]))) 84 | 85 | (is (= '{a "asdf", b "asdf", c "asdf" :hey 1} 86 | (blocks/resolve-bindings-into {} {:hey 1} '[a "asdf" b a c b])))) 87 | 88 | #_ 89 | (deftest resolve-and-validate-queries 90 | (is (= {:data 91 | '[a [:pluto.reader.block-test/identity-query nil {:x "asdf"}] 92 | g "asdf" 93 | b [:pluto.reader.block-test/identity-map nil {:x "asdf"}]]} 94 | 95 | (blocks/resolve-and-validate-queries 96 | {:capacities let-test-capacities} {} 97 | '[a [identity-query {:x "asdf"}] 98 | g "asdf" 99 | b [identity-map {:x "asdf"}]]))) 100 | 101 | (is (not-empty (:errors (blocks/resolve-and-validate-queries 102 | {:capacities let-test-capacities} {} '[a [identity-querye {:x "asdf"}]])))) 103 | (is (empty? (:errors (blocks/resolve-and-validate-queries 104 | {:capacities let-test-capacities} {} 105 | '[a [identity-query {:x a}]]))))) 106 | 107 | ;; The following is all set up so that we can fake "render" the blocks 108 | ;; in the resulting view tree 109 | 110 | ;; this will allow us to verify basic binding replacement behaviors of let blocks 111 | 112 | (defn view-component [& args] [:view args]) 113 | (defn text-component [& args] [:text args]) 114 | (defn button-component [& args] [:button args]) 115 | 116 | #_ 117 | (re-frame/reg-sub ::identity-query 118 | (fn [db [_ _ {:keys [x]}]] x)) 119 | 120 | #_ 121 | (re-frame/reg-sub ::bool-query 122 | (fn [db [_ _ {:keys [x]}]] (= x "true"))) 123 | 124 | #_ 125 | (re-frame/reg-sub ::array-query 126 | (fn [db [_ _ {:keys [x y]}]] (cond-> [] 127 | x (conj x) 128 | y (conj y)))) 129 | 130 | #_ 131 | (re-frame/reg-sub ::identity-map 132 | (fn [db [_ _ {:keys [x]}]] {:asdf x})) 133 | 134 | (def fetch-data (atom {})) 135 | 136 | #_ 137 | (re-frame/reg-sub ::fetch-data 138 | (fn [db [_ _ {:keys [id]}]] (get @fetch-data id))) 139 | 140 | #?(:clj (defmacro with-fetch-data [data & body] 141 | `(do (swap! fetch-data merge ~data) 142 | ~@body))) 143 | 144 | (def let-test-capacities 145 | {:components {'view {:properties {} 146 | :value view-component} 147 | 'button {:properties {:on-click :event} 148 | :value button-component} 149 | 'text {:properties {} 150 | :value text-component}} 151 | :queries '{identity-query {:value ::identity-query :arguments {:x :string}} 152 | identity-map {:value ::identity-map :arguments {:x :string}} 153 | bool-query {:value ::bool-query :arguments {:x :string}} 154 | fetch-data {:value ::fetch-data :arguments {:id :string}} 155 | array-query {:value ::array-query :arguments {:x :string :y :string}}} 156 | :events {'alert 157 | {:value :alert}} 158 | :hooks {:main 159 | {:properties {:view :view}}}}) 160 | 161 | (defn exec [parsed] 162 | (cond-> parsed 163 | (not (:errors parsed)) 164 | (assoc 165 | :execed 166 | ((get-in parsed [:data :hooks :main :demo :parsed :view]) 167 | {:name "test-name-prop"})))) 168 | 169 | (defn test-parse [extention] 170 | (-> (reader/parse {:capacities let-test-capacities} extention) 171 | exec)) 172 | 173 | (defn valid-input [val] 174 | (or (seq? val) 175 | (nil? val) 176 | (map? val) 177 | (vector? val) 178 | (symbol? val) 179 | (string? val) 180 | (number? val))) 181 | 182 | ; vector-tag | list-of-vector-tags => list-of-vector-tags 183 | (defn simple-render-tree-blocks [current] 184 | {:pre [(valid-input current)] 185 | :post [(or (seq? %) (nil? %))]} 186 | (cond 187 | (seq? current) 188 | (mapcat simple-render-tree-blocks current) 189 | (vector? current) 190 | (let [[x & xs] current] 191 | (cond 192 | (and (fn? x) (#{pluto.reader.blocks/if-block 193 | pluto.reader.blocks/when-block 194 | pluto.reader.blocks/let-block 195 | pluto.reader.blocks/for-block} x)) 196 | (let [new-tree (apply x xs)] 197 | (simple-render-tree-blocks new-tree)) 198 | :else 199 | (list (apply vector x (mapcat simple-render-tree-blocks xs))))) 200 | (nil? current) current 201 | :else (list current))) 202 | 203 | (defn blocks-render [block-syn] 204 | (let [{:keys [execed errors] :as res} 205 | (test-parse (-> '{meta 206 | {:name "Test Ext", 207 | :description "A test extension", 208 | :documentation "Nothing."}, 209 | hooks/main.demo {:view [main]}} 210 | (assoc 'views/main block-syn)))] 211 | ;; for dev time 212 | #?(:clj 213 | (when-not (nil? errors) 214 | (clojure.pprint/pprint errors) 215 | (assert (nil? errors)))) 216 | (when (and execed (sequential? execed)) 217 | (simple-render-tree-blocks execed)))) 218 | 219 | ;; end of rendering util to support testing block rendering 220 | 221 | #_ 222 | (deftest if-when-block-rendering 223 | ;; need to set up a query to have a false value? 224 | (is (= [[view-component "true"]] 225 | (blocks-render '(let [a "asdf"] 226 | (if a 227 | [view "true"] 228 | [view "false"]))))) 229 | 230 | (is (= [[view-component "false"]] 231 | (blocks-render '(let [a [bool-query {:x "false"}]] 232 | (if a 233 | [view "true"] 234 | [view "false"]))))) 235 | 236 | (is (= [[view-component "true"]] 237 | (blocks-render '(let [a [bool-query {:x "true"}]] 238 | (if a 239 | [view "true"] 240 | [view "false"]))))) 241 | 242 | (is (= [[view-component "true"]] 243 | (blocks-render '(let [a "asdf"] 244 | (when a [view "true"]))))) 245 | 246 | (is (= [[view-component]] 247 | (blocks-render '(let [a [bool-query {:x "false"}]] 248 | [view (when a [view "true"])]))))) 249 | 250 | 251 | #_ 252 | (deftest basic-let-block-replacement [] 253 | (is (= [[view-component "hello"]] 254 | (blocks-render '(let [a "hello"] 255 | [view a])))) 256 | 257 | (is (= [[view-component "hello" "jenny" 258 | [text-component "jenny" "hello"] 259 | [text-component "hello" "darlene"]]] 260 | (blocks-render '(let [a "hello" 261 | b "jenny" 262 | c "darlene"] 263 | [view a b 264 | [text b a] 265 | [text a c]])))) 266 | (is (= [[view-component "john"]] 267 | (blocks-render '(let [a "john" 268 | b a] 269 | [view b])))) 270 | (is (= [[view-component "john"]] 271 | (blocks-render '(let [a "john" 272 | b a] 273 | [view b])))) 274 | (is (= [[view-component "john"]] 275 | (blocks-render '(let [a "john"] 276 | (let [b a] 277 | [view b]))))) 278 | (is (= [[view-component "john"]] 279 | (blocks-render '(let [a "john" 280 | dd a] 281 | (let [b a 282 | c b] 283 | [view b])))))) 284 | 285 | #_ 286 | (deftest let-blocks-with-properties 287 | (is (= [[view-component "test-name-prop"]] 288 | (blocks-render '(let [{name :name} properties] 289 | [view name])))) 290 | 291 | (is (= [[view-component "test-name-prop"]] 292 | (blocks-render '(let [{name :name} properties 293 | b name] 294 | [view b])))) 295 | 296 | (is (= [[view-component "jolly"]] 297 | (blocks-render '(let [{name :name} properties 298 | b name] 299 | (let [name "jolly"] 300 | [view name]))))) 301 | 302 | (is (= [[view-component "test-name-prop"]] 303 | (blocks-render '(let [name "jolly" 304 | {name :name} properties] 305 | [view name]))))) 306 | 307 | 308 | #_ 309 | (deftest let-blocks-with-queries 310 | (is (= [[view-component "a temp"]] 311 | (blocks-render '(let [temp [identity-query {:x "a temp"}]] 312 | [view temp])))) 313 | 314 | (is (= [[view-component "a temp" "a temp"]] 315 | (blocks-render '(let [a "a temp" 316 | temp [identity-query {:x a}]] 317 | [view a temp])))) 318 | 319 | (is (= [[view-component "a temp" "charmed"]] 320 | (blocks-render '(let [a "a temp" 321 | {asdf :asdf} [identity-map {:x "charmed"}]] 322 | [view a asdf])))) 323 | 324 | (is (= [[view-component "a temp" "a temp"]] 325 | (blocks-render '(let [a "a temp" 326 | temp [identity-query {:x a}] 327 | ouch temp] 328 | [view temp ouch])))) 329 | 330 | (is (= [[view-component "a temp" "a temp"]] 331 | (blocks-render '(let [a "a temp" 332 | temp [identity-query {:x a}]] 333 | (let [ouch temp] 334 | [view temp ouch]))))) 335 | 336 | (is (= [[view-component "hello"]] 337 | (with-fetch-data {"data-id" {:foo "hello"}} 338 | (blocks-render '(let [{foo :foo} [fetch-data {:id "data-id"}]] 339 | [view foo])))))) 340 | 341 | 342 | #_ 343 | (deftest for-block-parse 344 | (is (= {:data 345 | [blocks/for-block 346 | {:bindings '(a [:pluto.reader.block-test/identity-query nil {:x a}]) 347 | :wrapper-component view-component} 348 | 'asdf]} 349 | (blocks/parse {:capacities let-test-capacities} {} nil 350 | '[for [a [identity-query {:x a}]] asdf])))) 351 | 352 | #_ 353 | (deftest for-blocks 354 | (is (= [[view-component {} [view-component "foo"] [view-component "bar"]]] 355 | (blocks-render '(for [a [array-query {:x "foo" :y "bar"}]] 356 | [view a])))) 357 | 358 | (is (= [[view-component {} [view-component "foo"] [view-component "bar"]]] 359 | (blocks-render '(let [b "bar"] 360 | (for [a [array-query {:x "foo" :y b}]] 361 | [view a]))))) 362 | 363 | (is (= [[view-component {} [view-component "foo"] [view-component "bar"]]] 364 | (blocks-render '(let [b "bar" 365 | c [array-query {:x "foo" :y b}]] 366 | (for [a c] 367 | [view a]))))) 368 | 369 | (is (= [[view-component {} [view-component "foo"] [view-component "bar"]]] 370 | (blocks-render '(for [a [array-query {:x "foo" :y "bar"}]] 371 | (let [b a] 372 | [view b]))))) 373 | 374 | (with-fetch-data {"for-blocks-data" [{:name "Jane"} {:name "John"} {:name "Sue"}]} 375 | 376 | (is (= [[view-component {} 377 | [view-component "Jane"] 378 | [view-component "John"] 379 | [view-component "Sue"]]] 380 | (blocks-render 381 | '(for [{name :name} [fetch-data {:id "for-blocks-data"}]] 382 | [view name])))) 383 | 384 | (is (= [[view-component {} 385 | [view-component "Jane"] 386 | [view-component "John"] 387 | [view-component "Sue"]]] 388 | (blocks-render '(for [{name :name} [fetch-data {:id "for-blocks-data"}]] 389 | (let [b name] 390 | [view b]))))))) 391 | 392 | 393 | 394 | 395 | 396 | 397 | -------------------------------------------------------------------------------- /test/pluto/reader/destructuring_test.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.reader.destructuring-test 2 | (:refer-clojure :exclude [destructure]) 3 | (:require [clojure.test :refer [is deftest]] 4 | [pluto.reader.destructuring :as destructuring] 5 | [pluto.error :as error])) 6 | 7 | (deftest destructure-seq 8 | #_ 9 | (is (= {:errors [{::error/type ::error/invalid-destructuring-format ::error/value {:data [1] :type :sequential}}]} 10 | (destructuring/destructure-seq '[1] [1]))) 11 | #_ 12 | (is (= {:errors [{::error/type ::error/invalid-destructuring-format ::error/value {:data '[a b] :type :sequential}}]} 13 | (destructuring/destructure-seq '[a b] [1]))) 14 | (is (= {:data '{a 1}} (destructuring/destructure-seq '[a] [1]))) 15 | (is (= {:data '{a 1 c 3}} (destructuring/destructure-seq '[a _ c] [1 2 3]))) 16 | (is (= {} (destructuring/destructure-seq '[_ _ _] [1 2 3]))) 17 | (is (= {:data '{all [1 2 3]}} (destructuring/destructure-seq '[_ _ _ :as all] [1 2 3])))) 18 | 19 | (deftest destructure-assoc 20 | (is (= {:data '{a nil b nil}} 21 | (destructuring/destructure-assoc '{a :a b :b} nil))) 22 | (is (= {:data '{a 1 b 2}} 23 | (destructuring/destructure-assoc '{a :a b :b} {:a 1 :b 2}))) 24 | #_ 25 | (is (= {:errors [{::error/type ::error/invalid-destructuring-format 26 | ::error/value {:data {1 :a} :type :assoc}}]} 27 | (destructuring/destructure-assoc '{1 :a} {:a 1}))) 28 | #_ 29 | (is (= {:errors [{::error/type ::error/invalid-destructuring-format 30 | ::error/value {:data [] :type :assoc}}]} 31 | (destructuring/destructure-assoc [] {:a 1}))) 32 | #_ 33 | (is (= {:errors [{::error/type ::error/invalid-destructuring-format 34 | ::error/value {:data '[a1 a2] :type :sequential}}]} 35 | (destructuring/destructure-assoc '{[a1 a2] :a} {:a [1]}))) 36 | (is (= {:data '{a 1 b 2 c 4 all {:a 1 :b 2 :d 3}}} 37 | (destructuring/destructure-assoc '{a :a b :b c [:c 4] :as all} {:a 1 :b 2 :d 3})))) 38 | 39 | (deftest destructure 40 | (is (= {:data '{a nil}} (destructuring/destructure '{a :a} nil))) 41 | (is (= {:data '{a 1}} (destructuring/destructure '[a] [1]))) 42 | (is (= {:data '{a 1 b 2}} (destructuring/destructure '[a {b :b}] [1 {:b 2}]))) 43 | (is (= {:data '{a 1 b 2 c 3}} (destructuring/destructure '[a [b [c]]] [1 [2 [3]]]))) 44 | (is (= {:data '{a 1 b 2}} (destructuring/destructure '{a :a b :b} {:a 1 :b 2}))) 45 | (is (= {:data '{a 1 b2 3}} (destructuring/destructure '{a :a [_ b2] :b} {:a 1 :b [2 3]}))) 46 | (is (= {:data '{a 1 c 3}} (destructuring/destructure '{a :a {c :c} :b} {:a 1 :b {:c 3}}))) 47 | (is (= {:data '{a1 1 a3 3 d 4 e2 6 f 7 g2 10 48 | all {:a [1 2 3] :b {:d 4 :e [5 6] :g [9 10]}}}} 49 | (destructuring/destructure '{[a1 _ a3] :a {d :d f [:f 7] [_ e2] :e [_ g2] :g} :b :as all} 50 | {:a [1 2 3] :b {:d 4 :e [5 6] :g [9 10]}})))) 51 | -------------------------------------------------------------------------------- /test/pluto/reader/events_test.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.reader.events-test 2 | (:refer-clojure :exclude [resolve]) 3 | (:require [clojure.test :refer [is deftest testing]] 4 | [pluto.reader.events :as events])) 5 | 6 | (deftest local-event? 7 | (is (events/local-event? '(let [{} properties] [alert {}])))) 8 | -------------------------------------------------------------------------------- /test/pluto/reader/reference_test.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.reader.reference-test 2 | (:refer-clojure :exclude [resolve]) 3 | (:require [clojure.test :refer [is deftest]] 4 | [pluto.error :as error] 5 | [pluto.reader.reference :as reference])) 6 | 7 | (deftest valid-reference? 8 | (is (nil? (reference/reference? nil))) 9 | (is (nil? (reference/reference? ""))) 10 | (is (nil? (reference/reference? 'test))) 11 | (is (nil? (reference/reference? :keyword))) 12 | (is (true? (reference/reference? ['test]))) 13 | (is (true? (reference/reference? ['views/id {}]))) 14 | (is (false? (reference/reference? ['views/id {} {}]))) 15 | (is (false? (reference/reference? ['views/id 1 {}]))) 16 | (is (false? (reference/reference? ["views/id" {}]))) 17 | (is (true? (reference/reference? ['views/id {}]))) 18 | (is (true? (reference/reference? ['views/id 'arg])))) 19 | 20 | (deftest reference->symbol 21 | (is (= nil (reference/reference->symbol ""))) 22 | (is (= 'test (reference/reference->symbol ['test]))) 23 | (is (= 'views/id (reference/reference->symbol ['views/id {}])))) 24 | 25 | (deftest resolve 26 | #_ 27 | (is (= {:errors [{::error/type ::error/unknown-reference 28 | ::error/value {:value 'id :type :view}}]} 29 | (reference/resolve {} {} :view ['id]))) 30 | #_ 31 | (is (= {:errors [{::error/type ::error/invalid-reference 32 | ::error/value {:value "" :type :view}}]} 33 | (reference/resolve {} {'views/id "view"} :view ""))) 34 | #_ 35 | (is (= {:errors [{::error/type ::error/unknown-reference-type 36 | ::error/value {:value :unknown}}]} 37 | (reference/resolve {} {'views/id "view"} :unknown ['id]))) 38 | (is (= {:data "view"} 39 | (reference/resolve {} {'views/id "view"} :view ['id]))) 40 | (is (= {:data :div} 41 | (reference/resolve {:capacities {:components {'component {:data :div}}}} {} :view ['component])))) 42 | -------------------------------------------------------------------------------- /test/pluto/reader/types_test.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.reader.types-test 2 | (:refer-clojure :exclude [resolve]) 3 | (:require [clojure.test :refer [is deftest testing]] 4 | [pluto.error :as error] 5 | [pluto.reader.types :as types])) 6 | 7 | #_ 8 | (deftest resolve-primitive 9 | (is (= {:errors [{::error/type ::error/invalid-type 10 | ::error/value {:type :unknown}}]} 11 | (types/resolve {} {} :unknown nil))) 12 | (testing "Any" 13 | (is (= {:data "value"} (types/resolve {} {} :any "value"))) 14 | (is (= {:data 1} (types/resolve {} {} :any 1)))) 15 | (testing "String" 16 | (is (= {:errors [{::error/type ::error/invalid-type-value 17 | ::error/value {:type :string :data nil}}]} 18 | (types/resolve {} {} :string nil))) 19 | (is (= {:errors [{::error/type ::error/invalid-type-value 20 | ::error/value {:type :string :data :value}}]} 21 | (types/resolve {} {} :string :value))) 22 | (is (= {:data "value"} 23 | (types/resolve {} {} :string "value")))) 24 | (testing "Keyword" 25 | (is (= {:errors [{::error/type ::error/invalid-type-value 26 | ::error/value {:type :keyword :value nil}}]} 27 | (types/resolve {} {} :keyword nil))) 28 | (is (= {:errors [{::error/type ::error/invalid-type-value 29 | ::error/value {:type :keyword :value "value"}}]} 30 | (types/resolve {} {} :keyword "value"))) 31 | (is (= {:data :value} 32 | (types/resolve {} {} :keyword :value)))) 33 | (testing "Boolean" 34 | (is (= {:errors [{::error/type ::error/invalid-type-value 35 | ::error/value {:type :boolean :value nil}}]} 36 | (types/resolve {} {} :boolean nil))) 37 | (is (= {:errors [{::error/type ::error/invalid-type-value 38 | ::error/value {:type :boolean :value "value"}}]} 39 | (types/resolve {} {} :boolean "value"))) 40 | (is (= {:data true} 41 | (types/resolve {} {} :boolean true)))) 42 | (testing "Number" 43 | (is (= {:errors [{::error/type ::error/invalid-type-value 44 | ::error/value {:type :number :value nil}}]} 45 | (types/resolve {} {} :number nil))) 46 | (is (= {:errors [{::error/type ::error/invalid-type-value 47 | ::error/value {:type :number :value "value"}}]} 48 | (types/resolve {} {} :number "value"))) 49 | (is (= {:data 1} 50 | (types/resolve {} {} :number 1))) 51 | (is (= {:data 1.0} 52 | (types/resolve {} {} :number 1.0)))) 53 | (testing "Map" 54 | (is (= {:errors [{::error/type ::error/invalid-type-value 55 | ::error/value {:type :map :value nil}}]} 56 | (types/resolve {} {} :map nil))) 57 | (is (= {:errors [{::error/type ::error/invalid-type-value 58 | ::error/value {:type :map :value "value"}}]} 59 | (types/resolve {} {} :map "value"))) 60 | (is (= {:data {}} 61 | (types/resolve {} {} :map {})))) 62 | (testing "Vector" 63 | (is (= {:errors [{::error/type ::error/invalid-type-value 64 | ::error/value {:type :vector :value nil}}]} 65 | (types/resolve {} {} :vector nil))) 66 | (is (= {:errors [{::error/type ::error/invalid-type-value 67 | ::error/value {:type :vector :value "value"}}]} 68 | (types/resolve {} {} :vector "value"))) 69 | (is (= {:data []} 70 | (types/resolve {} {} :vector [])))) 71 | (testing "Subset" 72 | (is (= {:errors [{::error/type ::error/invalid-type-value 73 | ::error/value {:type :subset :value nil}}]} 74 | (types/resolve {} {} #{"a" "b" "c"} nil))) 75 | (is (= {:errors [{::error/type ::error/invalid-type-value 76 | ::error/value {:type :subset :value "value"}}]} 77 | (types/resolve {} {} #{"a" "b" "c"} "value"))) 78 | (is (= {:errors [{::error/type ::error/invalid-type-value 79 | ::error/value {:type :subset :value "value"}}]} 80 | (types/resolve {} {} #{"a" "b" "c"} "value"))) 81 | (is (= {:data #{"a"}} 82 | (types/resolve {} {} #{"a" "b" "c"} #{"a"})))) 83 | (testing "One of" 84 | (is (= {:errors [{::error/type ::error/invalid-type-value 85 | ::error/value {:type :one-of :value nil}}]} 86 | (types/resolve {} {} {:one-of #{:one :two :three}} nil))) 87 | (is (= {:errors [{::error/type ::error/invalid-type-value 88 | ::error/value {:type :one-of :value :for}}]} 89 | (types/resolve {} {} {:one-of #{:one :two :three}} :for))) 90 | (is (= {:errors [{::error/type ::error/invalid-type-value 91 | ::error/value {:type :one-of :value "one"}}]} 92 | (types/resolve {} {} {:one-of #{:one :two :three}} "one"))) 93 | (is (= {:data :one} 94 | (types/resolve {} {} {:one-of #{:one :two :three}} :one)))) 95 | (testing "Or" 96 | (is (= {:errors [{::error/type ::error/invalid-type-value 97 | ::error/value {:type :or :value nil}}]} 98 | (types/resolve {} {} {:or [:keyword #{:one :two :three}]} nil))) 99 | (is (= {:data :one} 100 | (types/resolve {} {} {:or [:keyword #{:one :two :three}]} :one))))) 101 | 102 | #_ 103 | (deftest resolve-sequential 104 | (is (= {:errors [{::error/type ::error/invalid-sequential-type 105 | ::error/value {:type [:string] :value ["value"]}}]} 106 | (types/resolve {} {} [:string] ["value"]))) 107 | (is (= {:errors [{::error/type ::error/invalid-sequential-type 108 | ::error/value {:type [{:name :string} {:name :string}] :value ["value"]}}]} 109 | (types/resolve {} {} [{:name :string} {:name :string}] ["value"]))) 110 | (is (= {:data [{:name "name"} 111 | {:name "name"}]} 112 | (types/resolve {} {} [{:name :string}] 113 | [{:name "name"} 114 | {:name "name"}]))) 115 | (is (= {:data [{:name "name" :scopes [{:scope :one}]} 116 | {:name "name" :scopes [{:scope :two}]}]} 117 | (types/resolve {} {} [{:name :string :scopes [{:scope {:one-of #{:one :two :three}}}]}] 118 | [{:name "name" :scopes [{:scope :one}]} 119 | {:name "name" :scopes [{:scope :two}]}])))) 120 | #_ 121 | (deftest resolve-assoc 122 | (is (= {:data {:name "value"}} 123 | (types/resolve {} {} {:name :string} {:name "value"}))) 124 | (is (= {:data {:name "value"}} 125 | (types/resolve {} {} {:name? :string} {:name "value"}))) 126 | (is (= {:data {}} 127 | (types/resolve {} {} {:name? :string} {}))) 128 | (is (= {:errors [{::error/type ::error/invalid-type-value 129 | ::error/value {:type :string :value nil}}]} 130 | (types/resolve {} {} {:name? :string} {:name nil}))) 131 | (is (= {:data {}} 132 | (types/resolve {} {} {:name? :string} {:extra "value"}))) 133 | (is (= {:data {:scopes [{:scope :one}]}} 134 | (types/resolve {} {} {:scopes [{:scope {:one-of #{:one :two :three}}}]} 135 | {:scopes [{:scope :one}]}))) 136 | (is (= {:data {:students [{:firstname "John" :lastname "Doe"}]}} 137 | (types/resolve {} {} {:students [{:firstname :string :lastname :string :name? :string}]} 138 | {:students [{:firstname "John" :lastname "Doe"}]}))) 139 | (is (= '[text] 140 | (let [m (types/resolve {} '{views/screen [text]} {:screen :view :students [{:firstname :string :lastname :string :name? :string}]} 141 | {:screen ['screen] :students [{:firstname "John" :lastname "Doe"}]})] 142 | ((get-in m [:data :screen]) {})))) 143 | (is (= '[text] 144 | (let [m (types/resolve {} '{views/screen [text]} {:screen? :view :students [{:firstname :string :lastname :string :name? :string}]} 145 | {:screen ['screen] :students [{:firstname "John" :lastname "Doe" :name "Henry"}]})] 146 | ((get-in m [:data :screen]) {})))) 147 | (is (= {:data {:name "hello" 148 | :children [{:name "name" :scopes [{:scope :one}]} 149 | {:name "name" :scopes [{:scope :two}]}]}} 150 | (types/resolve {} {} {:name? :string 151 | :children [{:name :string :scopes [{:scope {:one-of #{:one :two :three}}}]}]} 152 | {:extra "value" 153 | :name "hello" 154 | :children [{:name "name" :scopes [{:scope :one}]} 155 | {:name "name" :scopes [{:scope :two}]}]})))) 156 | 157 | #_ 158 | (deftest resolve-reference 159 | (is (= {:errors [{::error/type ::error/unknown-event 160 | ::error/value 'event} 161 | {::error/type ::error/unknown-reference 162 | ::error/value {:value 'event :type :event}}]} 163 | (types/resolve {} {} :event ['event]))) 164 | (let [{:keys [data errors]} (types/resolve {:capacities {:events {'event {:value :event}}}} {} :event ['event])] 165 | (is (not errors)) 166 | (is data)) 167 | (let [{:keys [data errors]} (types/resolve {:capacities {:events {'event {:value :event :arguments {:on-finished? :event}}}}} 168 | {} :event ['event {:on-finished ['event]}])] 169 | (is (not errors)) 170 | (is (fn? (:on-finished (last (data {} {})))))) 171 | (let [{:keys [data errors]} (types/resolve {:capacities {:events {'alert {:value :alert :arguments {:value :string}}}}} 172 | {'events/event '(let [{value :value} properties] [alert {:value value}])} 173 | :event ['event {:value {:key "value"}}])] 174 | (is (not errors)) 175 | (is (= [:alert nil {:value {:key "value"}}] (data {} {:value {:key2 "value2"}}))))) 176 | -------------------------------------------------------------------------------- /test/pluto/reader/views_test.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.reader.views-test 2 | (:refer-clojure :exclude [resolve]) 3 | (:require [clojure.test :refer [is deftest testing]] 4 | [pluto.error :as error] 5 | [pluto.reader.types :as types] 6 | [pluto.reader.views :as views])) 7 | 8 | #_ 9 | (deftest parse-hiccup-children 10 | (is (= {:data (list [:text {} ""])} 11 | (views/parse-hiccup-children {:capacities {:components {'text {:value :text}}}} 12 | {} 13 | nil 14 | (list ['text {} ""]))))) 15 | 16 | (defn- first-error-type [m] 17 | (::error/type (first (:errors m)))) 18 | 19 | #_ 20 | (deftest parse 21 | #_ 22 | (is (= ::error/invalid-view (first-error-type (views/parse {} {})))) 23 | #_ 24 | (is (= ::error/invalid-view 25 | (first-error-type (views/parse {:capacities {:components {'text {:value :text}}}} ['text "Hello"])))) 26 | #_ 27 | (is (= ::error/invalid-view 28 | (first-error-type (views/parse {:capacities {:components {'text {:value :text}}}} ['text {} []])))) 29 | #_ 30 | (is (= {:data ['text {} "Hello"] 31 | :errors (list {::error/type ::error/unknown-component ::error/value 'text})} 32 | (views/parse {} ['text {} "Hello"]))) 33 | (is (= {:data [:text {} "Hello"]} 34 | (views/parse {:capacities {:components {'text {:value :text}}}} {} ['text {} "Hello"]))) 35 | #_ 36 | (is (= {:errors [(errors/error ::error/unresolved-properties #{'a})]} 37 | (views/parse {:capacities {:components {'text {:value :text}}}} {} ['text {} 'a]))) 38 | (is (empty? 39 | (:errors (views/parse {:capacities {:queries {'random-boolean {:value :value}} 40 | :components {'text {:value :text} 41 | 'view {:value :view}}}} 42 | {} 43 | '[view 44 | [text {} "Hello"] 45 | (let [cond? [random-boolean]] 46 | (if cond? 47 | [text {:style {:color "green"}} 48 | "World?"] 49 | [text {:style {:color "red"}} 50 | "World?"]))])))) 51 | (testing "Properties" 52 | (is (= {:data [:text {} "Hello"]} 53 | (views/parse {:capacities {:components {'text {:value :text}}}} {} ['text {} "Hello"]))))) 54 | 55 | #_ 56 | (deftest resolve 57 | (is (= [:text "Hello"] ((:data (types/resolve {:capacities {:components {'text {:value :text}}}} {'views/main ['text "Hello"]} :view ['views/main])) {}))) 58 | (is (= {:errors [{::error/type ::error/unknown-reference 59 | ::error/value {:value 'views/unknown :type :view}}]} 60 | (types/resolve {:capacities {:components {'text {:value :text}}}} {'views/main ['text "Hello"]} :view ['views/unknown])))) 61 | 62 | #_ 63 | (deftest invalid-view-element-spec-errors 64 | (letfn [(p [view] (views/parse 65 | {:capacities {:components {'text {:properties {:asdf :string} 66 | :value :text}}}} 67 | {} 68 | view))] 69 | (is (= (first-error-type (p '[text :sadf])) 70 | ::error/invalid-view)) 71 | (is (= (first-error-type (p '[text {} {}])) 72 | ::error/invalid-view)) 73 | 74 | (is (not (:errors (p '[text [text]])))) 75 | (is (not (:errors (p '[text {} 1 2 3 4 asdf])))) 76 | 77 | (is (= (first-error-type (p '[text {asdf "asdf"}])) 78 | ::error/invalid-property-map)))) 79 | 80 | (deftest unresolved-properties 81 | (is (= #{} (views/unresolved-properties #{} [:view {} ""]))) 82 | (is (= #{'a} (views/unresolved-properties #{} [:view {} 'a]))) 83 | (is (= #{'a} (views/unresolved-properties #{} [:view {} [:view 'a]]))) 84 | (is (= #{'a} (views/unresolved-properties #{} [:view {:style {:key 'a}} ""]))) 85 | (is (= #{'a} (views/unresolved-properties #{} [:view {:style [:event ['a]]}]))) 86 | (is (= #{'a} (views/unresolved-properties #{} [:view {:style [:event {:params {:title 'a}}]}]))) 87 | (is (= #{'a} (views/unresolved-properties #{} [:view {} [:view {} 'a]])))) 88 | -------------------------------------------------------------------------------- /test/pluto/utils_test.cljc: -------------------------------------------------------------------------------- 1 | (ns pluto.utils-test 2 | (:refer-clojure :exclude [slurp]) 3 | (:require [clojure.test :refer [is deftest testing]] 4 | [pluto.error :as error] 5 | [pluto.utils :as utils])) 6 | 7 | #?(:clj 8 | (defmacro slurp [file] 9 | (clojure.core/slurp file))) 10 | 11 | (deftest interpolate 12 | (is (= {:errors [(error/syntax ::error/invalid {:type :placeholders} {:data #{'id}})]} 13 | (utils/interpolate nil "test-${id}"))) 14 | (is (= {:errors [(error/syntax ::error/invalid {:type :placeholders} {:data #{'id1}})]} 15 | (utils/interpolate {'id 3} "${id1}"))) 16 | (is (= {:data "test-"} (utils/interpolate {'id nil} "test-${id}"))) 17 | (is (= {:data "test-3"} (utils/interpolate {'id 3} "test-${id}"))) 18 | (is (= {:data "test- 3"} (utils/interpolate {'id "3"} "test-${id:2s}"))) 19 | (is (= {:data "2.369"} (utils/interpolate {'f 2.369} "${f}"))) 20 | (is (= {:data "12345"} (utils/interpolate {'d 12345} "${d:2d}"))) 21 | (is (= {:data " 12345"} (utils/interpolate {'d 12345} "${d:6d}"))) 22 | (is (= {:data "2.37"} (utils/interpolate {'f 2.369} "${f:1.2f}"))) 23 | (is (= {:errors [(error/syntax ::error/invalid {:type :placeholders} {:data #{'f}})]} 24 | (utils/interpolate {'e 2.369} "${f:1.2f}")))) 25 | --------------------------------------------------------------------------------