status-im
/
pluto
mirror of https://github.com/status-im/pluto.git
2
0
Fork 0
Code Issues Projects Releases Wiki Activity

[Fixes #103] [Fixes #86] Added trace facilities

This commit is contained in:
Julien Eluard 2019-02-01 10:48:33 +01:00
parent 5f3552a3ca
commit 0aefcf599f
No known key found for this signature in database
GPG Key ID: 6FD7DB5437FCBEF6
8 changed files with 156 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
deps.edn
View File

@ -1,8 +1,7 @@
{:deps {org.clojure/clojure {:mvn/version "1.10.0"}
org.clojure/clojurescript {:mvn/version "1.10.439"}
org.clojure/tools.reader {:mvn/version "1.3.2"}
reagent {:mvn/version "0.8.1"}
re-frame {:mvn/version "0.10.6"}}
{:deps {org.clojure/clojure {:mvn/version "1.10.0"}
org.clojure/clojurescript {:mvn/version "1.10.516"}
reagent {:mvn/version "0.8.1"}
re-frame {:mvn/version "0.10.6"}}
:paths ["src"]
:aliases {:examples {:extra-paths ["pluto-web/src" "target" "test" "examples/src" "examples/resources"]
:extra-deps {com.bhauman/figwheel-main {:mvn/version "0.2.0"}
@ -10,8 +9,8 @@
binaryage/devtools {:mvn/version "0.9.10"}}
:main-opts ["-m" "figwheel.main" "-b" "examples/dev" "-r"]}
:test-clj {:extra-paths ["test"]
:extra-deps {eftest {:mvn/version "0.5.2"}}
:extra-deps {eftest {:mvn/version "0.5.4"}}
:main-opts ["-e" "(require,'[eftest.runner,:refer,[find-tests,run-tests]]),(run-tests,(find-tests,\"test\"))"]}
:test-cljs {:extra-paths ["test"]
:extra-deps {olical/cljs-test-runner {:mvn/version "2.1.0"}}
:extra-deps {olical/cljs-test-runner {:mvn/version "3.4.0"}}
:main-opts ["-m" "cljs-test-runner.main" "-o" "target/cljs-test-runner-out"]}}}

48
examples/src/pluto/examples.cljs
View File

@ -1,16 +1,19 @@
(ns pluto.examples
(:require [pluto.web.components :as components]
(:require [pluto.web.components :as components]
pluto.web.events
pluto.web.queries
[pluto.core :as pluto]
[pluto.storages :as storages]
[pluto.core :as pluto]
[pluto.trace :as trace]
[pluto.storages :as storages]
[pluto.web.editor.markdown :as mk]
pluto.reader.views
[reagent.core :as reagent]
[reagent.dom :as dom]
[re-frame.core :as re-frame]
[re-frame.registrar :as registrar]
[re-frame.loggers :as re-frame.loggers]))
[reagent.core :as reagent]
[reagent.dom :as dom]
[re-frame.core :as re-frame]
[re-frame.registrar :as registrar]
[re-frame.loggers :as re-frame.loggers]
[pluto.trace :as trace]
[pluto.trace :as trace]))
(def warn (js/console.warn.bind js/console))
(re-frame.loggers/set-loggers!
@ -33,20 +36,22 @@
[:li
[:span [:b (str type)] (pr-str (dissoc m :type))]]))]))
(defn dispatch-events [events]
(doseq [event events]
(when (vector? event)
(re-frame/dispatch event))))
;; TODO somehow hook re-frame loggers into :logger
;; https://github.com/Day8/re-frame/blob/master/docs/FAQs/Logging.md
(defn resolve-query [[id :as data]]
(when (registrar/get-handler :sub id)
(re-frame/subscribe data)))
(defn dispatch-events [ctx events]
(doseq [event events]
(if (vector? event)
(re-frame/dispatch event)
(trace/trace ctx (trace/create-trace :error :event/dispatch event)))))
(defn resolve-query [ctx [id :as data]]
(if (registrar/get-handler :sub id)
(re-frame/subscribe data)
(trace/trace ctx (trace/create-trace :error :query/resolve data))))
(defn parse [m]
(pluto/parse {:env {:id "Extension ID"
:logger nil
:event-fn dispatch-events
:query-fn resolve-query}
(pluto/parse {:env {:id "Extension ID"}
:capacities {:components components/all
:queries {'random-boolean
{:data :random-boolean}
@ -62,7 +67,10 @@
'alert
{:permissions [:read]
:data :alert
:arguments {:value :string}}}}}
:arguments {:value :string}}}}
:event-fn dispatch-events
:query-fn resolve-query
:tracer #(.log js/console %)}
m))
(defn render-extension [m el el-errors]

11
project.clj
View File

@ -1,9 +1,6 @@
(defproject status-im/pluto "iteration-4-8-SNAPSHOT"
:dependencies [[org.clojure/clojure "1.9.0"]
[org.clojure/clojurescript "1.10.439"]
[org.clojure/tools.reader "1.2.1"]
[reagent "0.8.0"]
[re-frame "0.10.5"]
[binaryage/devtools "0.9.10"]
[day8.re-frame/re-frame-10x "0.3.2"]]
:dependencies [[org.clojure/clojure "1.10.0"]
[org.clojure/clojurescript "1.10.516"]
[reagent "0.8.1"]
[re-frame "0.10.6"]]
:source-paths ["src"])

28
src/pluto/core.cljc
View File

@ -1,13 +1,13 @@
(ns pluto.core
"Main pluto namespace entry point."
(:refer-clojure :exclude [read])
(:require [clojure.string :as string]
[clojure.tools.reader.edn :as edn]
[pluto.reader.errors :as errors]
[pluto.reader.events :as events]
[pluto.reader.types :as types]
[pluto.reader.views :as views]
[pluto.utils :as utils]))
(:require [clojure.string :as string]
[clojure.edn :as edn]
[pluto.reader.errors :as errors]
[pluto.reader.events :as events]
[pluto.reader.types :as types]
[pluto.reader.views :as views]
[pluto.utils :as utils]))
(defn- reader-error [ex]
(errors/error ::errors/reader-error (:ex-kind (ex-data ex))
@ -33,10 +33,6 @@
"Parse an extension value from its type"
(fn [ctx ext k v] (namespace k)))
(defmulti parse-value
"Parse an extension value from its type"
(fn [ctx ext k v] (namespace k)))
(defn- capacity? [m s]
(let [keys (set (map name (keys m)))]
(keys (name s))))
@ -83,24 +79,22 @@
(let [indexes (zipmap order (range))]
(compare [(get indexes (namespace k1)) k1] [(get indexes (namespace k2)) k2])))
;; TODO somehow hook re-frame loggers into :logger
;; https://github.com/Day8/re-frame/blob/master/docs/FAQs/Logging.md
(defn parse
"Parse an extension definition map as encapsulated in :data key of the map returned by `read`.
`ctx` is a map defining:
* `capacities` a map of valid supported capacities (hooks, queries, events)
* `env` a map of extension environment, will be provided as second parameter into event and query handlers
* `event-fn` a function used to fire events
* `query-fn` a function receiving a query and returning an `atom`
* `tracer` [optional] a function that will be passed details about runtime extension execution (event fired, query values updated, ..): {:id 0 :category :error :type :event/dispatch :data {}}
`env` is a map defining:
* `logger` [optional] a function that will be passed details about runtime extension execution (event fired, query values updated, ..): {:type :event :name 'my-event :properties {}}
Returns the input map modified so that values have been parsed into:
* `:data` the result of parsing
* `:permissions` a vector of required permissions
* `:errors` a vector of errors maps triggered during the parsing
If `errors` is not empty `data` will not be available.
If `errors` is not empty, `data` will not be available.
e.g.

62
src/pluto/reader/blocks.cljc
View File

@ -1,30 +1,40 @@
(ns pluto.reader.blocks
(:require [clojure.walk :as walk]
[re-frame.core :as re-frame]
[reagent.core :as reagent]
(:require [clojure.walk :as walk]
[re-frame.core :as re-frame]
#?(:cljs [reagent.core :as reagent])
[pluto.reader.destructuring :as destructuring]
[pluto.reader.errors :as errors]
[pluto.reader.types :as types]
[pluto.utils :as utils]
[pluto.reader.reference :as reference]))
[pluto.reader.errors :as errors]
[pluto.reader.types :as types]
[pluto.trace :as trace]
[pluto.utils :as utils]))
(defmulti parse
"Parse a block element. Return hiccup data."
(fn [ctx ext parent [type]] type))
(defn substitute-query-values [m v]
(walk/prewalk #(or (get m %) (when (string? %) (:data (utils/interpolate m %))) %) v))
(defn- interpolate [ctx m v]
(let [{:keys [data errors]} (utils/interpolate m v)]
(if errors
(trace/trace ctx (trace/create-trace :error :query/interpolation errors))
data)))
(defn substitute-query-values [ctx m v]
(walk/prewalk #(or (get m %) (when (string? %) (interpolate ctx m %)) %) v))
(defn- query? [binding-value]
(and (vector? binding-value)
(let [s (first binding-value)]
(or (symbol? s) (keyword? s)))))
(defn resolve-rhs [env v]
(defn resolve-rhs [ctx env v]
(cond
(= v 'properties) (get env :pluto.reader/properties)
(symbol? v) (get env v)
(query? v) (some-> (re-frame/subscribe (substitute-query-values env v)) deref)
(query? v)
(when-let [signal (re-frame/subscribe (substitute-query-values ctx env v))]
(let [o @signal]
(trace/trace ctx (trace/create-trace :trace :query/resolve o))
o))
:else v))
(defn destructure-into [env k v]
@ -32,18 +42,18 @@
(into env (:data (destructuring/destructure k v)))
(assoc env k v)))
(defn resolve-binding [env k v]
(let [v' (resolve-rhs env v)]
(defn resolve-binding [ctx env k v]
(let [v' (resolve-rhs ctx env v)]
(destructure-into env k v')))
(defn resolve-bindings-into [env bindings]
(reduce #(apply resolve-binding %1 %2) (or env {}) (partition 2 bindings)))
(defn resolve-bindings-into [ctx env bindings]
(reduce #(apply resolve-binding ctx %1 %2) (or env {}) (partition 2 bindings)))
(defn replace-atom [values o]
(defn replace-atom [ctx values o]
(cond (contains? values o) (get values o)
(symbol? o) nil
(string? o) (:data (utils/interpolate values o))
(and (fn? o) (:event (meta o))) #(o % values) ;; Intercept events and inject the env. TODO remove this hack
(string? o) (interpolate ctx values o)
(and (fn? o) (:event (meta o))) #(o %1 (merge %2 {:env values})) ;; Intercept events and inject the env. TODO remove this hack
:else (walk/postwalk-replace values o)))
(defn walkup-upto-leaf [f lp? lf tree]
@ -59,24 +69,24 @@
(declare let-block for-block)
(defn let-block [{:keys [prev-env bindings]} children]
(let [new-env (resolve-bindings-into prev-env bindings)]
(walkup-upto-leaf #(replace-atom new-env %)
(defn let-block [{:keys [ctx prev-env bindings]} children]
(let [new-env (resolve-bindings-into ctx prev-env bindings)]
(walkup-upto-leaf #(replace-atom ctx new-env %)
#(and (vector? %) (#{for-block let-block} (first %)))
(fn [[x props children]]
[x (assoc props :prev-env new-env) children])
children)))
(defn for-block [{:keys [prev-env bindings]} children]
(defn for-block [{:keys [ctx prev-env bindings]} children]
(let [[k v] bindings
for-values (resolve-rhs prev-env v)]
for-values (resolve-rhs ctx prev-env v)]
(when (sequential? for-values)
#?(:cljs
(apply array
(map reagent/as-element
(for [val for-values]
^{:key val}
[let-block {:prev-env prev-env :bindings [k val]}
[let-block {:ctx ctx :prev-env prev-env :bindings [k val]}
children])))))))
(defn static-value? [v]
@ -127,7 +137,7 @@
(let [{:keys [errors data]} (resolve-and-validate-queries ctx ext bindings)]
(if (not-empty errors)
{:errors errors}
{:data [let-block {:bindings data} (last body)]}))))))
{:data [let-block {:ctx ctx :bindings data} (last body)]}))))))
(defmethod parse 'for [ctx ext parent [_ binding & body]]
(cond
@ -140,7 +150,7 @@
(let [{:keys [errors data]} (resolve-and-validate-queries ctx ext binding)]
(if (not-empty errors)
{:errors errors}
{:data [for-block {:bindings data}
{:data [for-block {:ctx ctx :bindings data}
(last body)]}))))
(defn when-block [{:keys [test]} body]

55
src/pluto/reader/events.cljc
View File

@ -4,22 +4,29 @@
[pluto.reader.errors :as errors]
[pluto.reader.reference :as reference]
[pluto.reader.types :as types]
[pluto.trace :as trace]
[pluto.utils :as utils]))
;; TODO part of this is duplicated from blocks/let
(defn replace-atom [env o]
(defn- interpolate [ctx m v]
(let [{:keys [data errors]} (utils/interpolate m v)]
(if errors
(trace/trace ctx (trace/create-trace :error :query/interpolation errors))
data)))
(defn replace-atom [ctx env o]
(cond (contains? env o) (get env o)
(symbol? o) nil
(string? o) (:data (utils/interpolate env o))
(fn? o) #(o % env)
(string? o) (interpolate ctx env o)
(fn? o) #(o %1 (merge {:a %2} {:env env}))
:else (walk/postwalk-replace env o)))
(defn- resolve-env
"Resolve pairs from `env` in `m`.
Uses #replace-atom to perform the resolution."
[env m]
(reduce-kv #(assoc %1 %2 (replace-atom env %3)) {} m))
[ctx env m]
(reduce-kv #(assoc %1 %2 (replace-atom ctx env %3)) {} m))
(defn- resolve-arguments
"Resolve an event arguments based on event definition"
@ -30,18 +37,23 @@
(defn- dispatch-events
"Dispatches an event using ctx"
[ctx events]
(when-let [f (get-in ctx [:env :event-fn])]
(if (seq events)
(f events)
(println "Empty event dispatched"))))
[{:keys [event-fn] :as ctx} events raw?]
(if (seq events)
(do
(trace/trace ctx (trace/create-trace :log :event/dispatch events))
(cond
raw?
events
event-fn
(event-fn ctx events)))
(trace/trace ctx (trace/create-trace :error :event/dispatch {}))))
(defn- resolve-event
"Returns the final event vector"
[ctx ext env [event args :as reference]]
(let [{data :data} (reference/resolve ctx ext :event reference)
{inline :data} (resolve-arguments ctx ext event (or args {}))]
[data (:env ctx) (resolve-env env inline)]))
[data (:env ctx) (resolve-env ctx env inline)]))
(defn- create-event [ctx ext env ref]
(cond
@ -55,13 +67,15 @@
(defn- resolve-query
"Resolve a query using ctx"
[ctx ext query]
[{:keys [query-fn] :as ctx} ext query]
(let [{data :data} (types/resolve ctx ext :query query)]
(when-let [f (get-in ctx [:env :query-fn])]
(when-let [signal (f data)]
@signal))))
(when query-fn
(when-let [signal (query-fn ctx data)]
(let [o @signal]
(trace/trace ctx (trace/create-trace :log :query/resolve o))
o)))))
(defn merge-resolved-query [ctx ext m {:keys [value bindings]}]
(defn- merge-resolved-query [ctx ext m {:keys [value bindings]}]
(cond
(map? bindings)
(merge m (:data (destructuring/destructure bindings (merge m (resolve-query ctx ext value)))))
@ -74,16 +88,17 @@
(errors/merge-errors
{:data
(with-meta
(fn [dynamic env]
(fn [dynamic {:keys [env raw?] :as all}]
;; TODO env contains data that shouldn't be there
;; env is the dispatched argument. Used as default but is overridden by the local arguments
;; Perform destructuring based on dynamic and static arguments
;; Then resolve recursive properties in the aggregated env
;; Final map contains inline arguments resolved
(let [{:keys [data errors]} (destructuring/destructure properties (merge dynamic arguments))]
;; TODO handle errors
(let [env' (resolve-env env (merge env (reduce #(merge-resolved-query ctx ext %1 %2) data queries)))]
(dispatch-events ctx (map #(create-event ctx ext env' %) refs)))))
(when (seq errors)
(trace/trace ctx (trace/create-trace :error :event/destructuring errors)))
(let [env' (resolve-env ctx env (merge env (reduce #(merge-resolved-query ctx ext %1 %2) data queries)))]
(dispatch-events ctx (map #(create-event ctx ext env' %) refs) raw?))))
{:event true})}
nil))

33
src/pluto/reader/views.cljc
View File

@ -1,11 +1,12 @@
(ns pluto.reader.views
(:require [clojure.spec.alpha :as spec]
#?(:cljs [reagent.core :as reagent])
[pluto.reader.blocks :as blocks]
[pluto.reader.errors :as errors]
(:require [clojure.spec.alpha :as spec]
#?(:cljs [reagent.core :as reagent])
[pluto.reader.blocks :as blocks]
[pluto.reader.errors :as errors]
[pluto.reader.reference :as reference]
[pluto.reader.types :as types]
[pluto.utils :as utils]))
[pluto.reader.types :as types]
[pluto.utils :as utils]
[pluto.trace :as trace]))
(spec/def ::form
(spec/or
@ -130,21 +131,21 @@
:else acc))
(defn event->fn [ctx ext event f]
(fn [o]
(fn [& o]
(when event
(let [{:keys [data errors]} (types/resolve ctx ext :event event)]
(when data
(data {:a (f o)}))))))
(data (apply f o)))))))
#?(:cljs
(defn default-logger [err info]
(.log js/console err info)))
(defn default-logger [ctx error info]
(trace/trace ctx (trace/create-trace :error :view {:error error :info info}))))
(defn error-boundary [component]
(defn error-boundary [ctx component]
#?(:cljs
(reagent/create-class
{:display-name "error-boundary-wrapper"
:component-did-catch default-logger
:component-did-catch #(default-logger ctx %1 %2)
:reagent-render (fn error-boundary [_] component)})))
(defn- inject-properties
@ -168,16 +169,16 @@
component-did-update component-will-unmount]} data]
(merge {:display-name (str (first data))
:reagent-render (fn [o]
[error-boundary
[error-boundary ctx
(inject-properties data o)])}
(when get-initial-state {:get-initial-state-mount (event->fn ctx ext get-initial-state #(js->clj %))})
(when component-will-receive-props {:component-will-receive-props (event->fn ctx ext component-will-receive-props #(assoc (js->clj %1) :new %2))})
(when should-component-update {:should-component-update (event->fn ctx ext should-component-update #(assoc (js->clj %1) :old %2 :new %3))})
(when component-will-mount {:component-will-mount (event->fn ctx ext component-will-mount #(js->clj %))})
(when component-did-mount {:component-did-mount (event->fn ctx ext component-did-mount #(js->clj %))})
(when component-did-mount {:component-did-mount (event->fn ctx ext component-did-mount #(do {}))})
(when component-will-update {:component-will-update (event->fn ctx ext component-will-update #(assoc (js->clj %1) :new %2))})
(when component-did-update {:component-did-update (event->fn ctx ext component-did-update #(assoc (js->clj %1) :old %2))})
(when component-will-unmount {:component-will-unmount (event->fn ctx ext component-will-unmount #(js->clj %))}))))
(when component-will-unmount {:component-will-unmount (event->fn ctx ext component-will-unmount #(do {}))}))))
;; TODO normalize to always have a props map
(defn parse
@ -189,7 +190,7 @@
#?(:cljs {:data (reagent/create-class (create-reagent-spec ctx ext o data))})
{:data
(fn [o]
[error-boundary
[error-boundary ctx
(inject-properties data o)])}))))
([ctx ext parent o]
(if (list? o)

19
src/pluto/trace.cljc Normal file
View File

@ -0,0 +1,19 @@
(ns pluto.trace)
(def ^:private id (atom 0))
(defn- next-id [] (swap! id inc))
(defn create-trace
"Create a trace map. To be used with `trace`"
[c t v]
{:id (next-id)
:category c
:type t
:data v})
(defn trace
"Trace provided object using the ctx `tracer`"
[{:keys [tracer]} m]
(when (fn? tracer)
(tracer m)))