Skip to content

Instantly share code, notes, and snippets.

@mharju
Created September 10, 2020 17:29
Show Gist options
  • Save mharju/df5ad108bc2400d6cd8a6ce065e226f2 to your computer and use it in GitHub Desktop.
Save mharju/df5ad108bc2400d6cd8a6ce065e226f2 to your computer and use it in GitHub Desktop.
(ns introspect
(:require [clindex.api :as clindex]
[clindex.forms-facts.core :as forms-facts]
[clindex.utils :as clindex-utils]
[datascript.core :as d]
[clojure.pprint :as pprint]
[clojure.walk :as w]
[clojure.java.io :as io]
[clojure.string :as str]))
(def extra-schema
{:re-frame.event/key {:db/cardinality :db.cardinality/one}
:namespace/re-frame-events {:db/cardinality :db.cardinality/many :db/valueType :db.type/ref :db/isComponent true}
:re-frame.subs/key {:db/cardinality :db.cardinality/one}
:namespace/re-frame-subs {:db/cardinality :db.cardinality/many :db/valueType :db.type/ref :db/isComponent true}
:re-frame.subs/dependencies {:db/cardinality :db.cardinality/many :db/valueType :db.type/ref :db/isComponent true}
:re-frame.subs/dependency {:db/cardinality :db.cardinality/one}
:re-frame.fx/key {:db/cardinality :db.cardinality/one}
:namespace/re-frame-fxs {:db/cardinality :db.cardinality/many :db/valueType :db.type/ref :db/isComponent true}
:re-frame.fx/invokes {:db/cardinality :db.cardinality/many :db/valueType :db.type/ref :db/isComponent true}
:re-frame.fx/dispatches {:db/cardinality :db.cardinality/many :db/valueType :db.type/ref :db/isComponent true}
:re-frame.cofx/key {:db/cardinality :db.cardinality/one}
:namespace/re-frame-cofxs {:db/cardinality :db.cardinality/many :db/valueType :db.type/ref :db/isComponent true}
})
(defn events-facts [ctx [_ ev-key :as form]]
(let [ev-id (clindex-utils/stable-id :re-frame :event ev-key)]
{:facts [[:db/add ev-id :re-frame.event/key ev-key]
[:db/add ev-id :function/source-form form]
[:db/add (clindex-utils/namespace-id (:namespace/name ctx)) :namespace/re-frame-events ev-id]]
:ctx ctx}))
(defmethod forms-facts/form-facts 're-frame.core/reg-event-db
[all-ns-map ctx form]
(events-facts ctx form))
(defmethod forms-facts/form-facts 're-frame.core/reg-event-fx
[all-ns-map ctx form]
(events-facts ctx form))
(defn parse-sub-deps [form]
(reduce
(fn [dep [id maybe-dep & _]]
(when (= ':<- id)
(conj dep (first maybe-dep))))
[]
(partition 2 (drop 2 form))))
(defmethod forms-facts/form-facts 're-frame.core/reg-sub
[_ ctx [_ subs-key :as form]]
(let [subs-id (clindex-utils/stable-id :re-frame :subs subs-key)
deps (parse-sub-deps form)]
{:facts (->> deps
(mapcat (fn [dep]
(let [dep-id (clindex-utils/stable-id dep)]
[[:db/add dep-id :re-frame.subs/dependency dep]
[:db/add subs-id :re-frame.subs/dependencies dep-id]])))
(into [[:db/add subs-id :re-frame.subs/key subs-key]
[:db/add subs-id :function/source-form form]
[:db/add (clindex-utils/namespace-id (:namespace/name ctx)) :namespace/re-frame-subs subs-id]]))
:ctx ctx}))
(defmethod forms-facts/form-facts 're-frame.core/reg-fx
[all-ns-map ctx [_ fx-key :as form]]
(let [fx-id (clindex-utils/stable-id :re-frame :fx fx-key)]
{:facts [[:db/add fx-id :re-frame.fx/key fx-key]
[:db/add fx-id :function/source-form form]
[:db/add (clindex-utils/namespace-id (:namespace/name ctx)) :namespace/re-frame-fxs fx-id]]
:ctx ctx}))
(defn is-event? [db entity]
(->> (d/q '[:find ?event :in $ ?event :where [_ :re-frame.event/key ?event]] db entity) seq boolean))
(defn is-effect? [db entity]
(if (= entity :db)
true
(->> (d/q '[:find ?event :in $ ?event :where [_ :re-frame.fx/key ?event]] db entity) seq boolean)))
(defn dispatch [_ [_ _ & event]]
[(vector? (first event))
(= 'fn (if (seq? (first event)) (ffirst event) nil))])
(defmulti parse-event-2 #'dispatch)
(defmethod parse-event-2 [false true]
[db [_ nm & event]]
(let [effects (atom #{})
events (atom #{})
event-id (clindex-utils/stable-id :re-frame :event nm)]
(w/postwalk
(fn [item]
(cond
(and (keyword? item) (is-effect? db item)) (swap! effects conj item)
(and (keyword? item) (is-event? db item)) (swap! events conj item)))
(first event))
(concat
(mapv (fn [fx-key]
(let [fx-id (clindex-utils/stable-id :re-frame :fx fx-key)]
[:db/add event-id :re-frame.fx/invokes fx-id]))
@effects)
(mapv (fn [event-key]
(let [dispatch-id (clindex-utils/stable-id :re-frame :event event-key)]
[:db/add event-id :re-frame.fx/dispatches dispatch-id]))
@events))))
(defmethod parse-event-2 :default
[_ [_ _ & event]]
#_(println "Don't know to handle this just yet." [(vector? (first event)) (= 'fn (ffirst event))]))
(defmethod forms-facts/form-facts 're-frame.core/reg-cofx
[all-ns-map ctx [_ cofx-key :as form]]
(let [cofx-id (clindex-utils/stable-id :re-frame :cofx cofx-key)]
{:facts [[:db/add cofx-id :re-frame.cofx/key cofx-key]
[:db/add (clindex-utils/namespace-id (:namespace/name ctx)) :namespace/re-frame-cofxs cofx-id]]
:ctx ctx}))
(defn process-events [db]
(->> (d/q '[:find ?form
:where
[?evid :re-frame.event/key _]
[?evid :function/source-form ?form]]
db)
(mapcat (comp (partial parse-event-2 db) first))))
(defn subscription-info [subscription]
(let [dependencies (->> (d/q '[:find ?dep
:in $ ?skey
:where
[?sub :namespace/re-frame-subs ?sub-id]
[?sub-id :re-frame.subs/key ?skey]
[?sub-id :re-frame.subs/dependencies ?dep-id]
[?dep-id :re-frame.subs/dependency ?dep]]
db
subscription)
(into []))]
{:name subscription
:dependencies dependencies}))
(defn namespace-info [ns]
(let [dependencies (->> (d/q '[:find ?dep
:in $ ?skey
:where
[?nid :namespace/name ?skey]
[?nid :namespace/depends ?dep-id]
[?dep-id :namespace/name ?dep]]
db
ns)
(into []))]
{:name ns
:dependencies dependencies}))
(defn traverse-up
([key f] (traverse-up key f nil))
([key f depth] (traverse-up key f depth (atom #{}) 0))
([key f depth visited current-depth]
(let [{:keys [dependencies]} (f key)
child-deps (->> dependencies
(mapv
(fn [dep]
(when (and (not (contains? @visited (first dep)))
(or (nil? depth)
(< current-depth depth)))
(swap! visited conj key)
(traverse-up (first dep) f depth visited (inc current-depth)))))
(remove nil?))]
{key child-deps})))
(defn print-deps [deps]
(doall
(for [[child child-deps] deps]
(doall
(for [cdep child-deps]
(doall
(for [[k v] cdep]
(do
(println (str "\t\"" (str child) "\" -> \"" (str k) "\""))
(print-deps {k v})))))))))
(defn make-tree
([root f]
(make-tree root f nil))
([root f depth]
(let [tree (traverse-up root f depth)]
(with-out-str
(println "digraph data {")
(print-deps tree)
(println "\n}")))))
(defn save-tree! [tree output-file]
(with-open [out (io/writer output-file)]
(.write out tree)))
(defn show-tree!
([root f] (show-tree! root f nil))
([root f depth]
(-> root
(make-tree f depth)
(save-tree! "/tmp/data.dot"))
(let [runtime (Runtime/getRuntime)]
(.exec runtime (into-array ["/bin/bash" "-c" "dot -Tpdf /tmp/data.dot | open -f -a /Applications/Preview.app"])))))
(defn index! []
(clindex/index-project! "./" {:platforms #{:cljs} :extra-schema extra-schema})
(clindex/db :cljs))
(comment
(def db (index!))
(show-tree! :filippos.product.subs.recipe/recipe-sorted subscription-info)
(let [events (process-events db)]
(println "Transacting" (count events) "facts")
events
#_(d/transact! (get @clindex/db-conns :cljs) events))
(subscription-info :filippos.core.subs.common/products)
(let [result (->> (d/q '[:find ?skey ?dep
:where
[?sub :namespace/re-frame-subs ?sub-id]
[?sub-id :re-frame.subs/key ?skey]
[?sub-id :re-frame.subs/dependencies ?dep-id]
[?dep-id :re-frame.subs/dependency ?dep]]
db)
(sort-by first)
(group-by first)
(map #(zipmap [:sub :dep] %)))]
(pprint/print-table result)
(println (count result) "dependencies found"))
(let [result (->> (d/q '[:find ?id
:where
[_ :re-frame.fx/dispatches ?id]]
db))]
result
#_(pprint/print-table result))
(let [result (->> (d/q '[:find ?skey ?dep
:where
[?fid :file/name ?fname]
[?pid :project/name ?pname]
[?nid :namespace/file ?fid]
[?pid :project/namespaces ?nid]
[?nid :namespace/name ?nname]
[?sub :namespace/re-frame-subs ?sub-id]
[?sub-id :re-frame.subs/key ?skey]
[?sub-id :re-frame.subs/dependencies ?dep-id]
[?dep-id :re-frame.subs/dependency ?dep]
[(str/starts-with? ?dep ":filippos.editor/editor-state")]]
db)
(map #(zipmap [:sub :dep] %))
#_(take 10))]
(pprint/print-table result)
(println (count result) "dependencies to editor-state found"))
(let [result (->> (d/q '[:find ?skey
:where
[?fid :file/name ?fname]
[?pid :project/name ?pname]
[?nid :namespace/file ?fid]
[?pid :project/namespaces ?nid]
[?nid :namespace/name ?nname]
[?sub :namespace/re-frame-subs ?sub-id]
[?sub-id :re-frame.subs/key ?skey]]
db)
(map #(zipmap [:sub :dep] %))
#_(take 10))]
(pprint/print-table result)
(println (count result) "effects found"))
(namespace-info 'filippos.devices.handlers.backend)
(traverse-up 'filippos.discounts.subs.edit namespace-info)
(save-tree! (make-tree 'filippos.core.core namespace-info 1) "/tmp/deps.dot")
(->> (d/q '[:find ?nname ?dep
:where
[?nid :namespace/name ?nname]
[?nid :namespace/depends ?did]
[?did :namespace/name ?dep]]
db))
(->> (d/q '[:find ?nname ?dep
:in $ ?nname
:where
[?nid :namespace/name ?nname]
[?nid :namespace/depends ?did]
[?did :namespace/name ?dep]]
db
'filippos.discounts.subs.edit)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment