introspect.clj

(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)))