Skip to content
Snippets Groups Projects
Unverified Commit e344fb3b authored by Cam Saul's avatar Cam Saul Committed by GitHub
Browse files

Debugging QP Improvements (#19565)

* Debugging QP Improvements

* Appease namespace linter

* Backport additional debug QP changes from #19384

* Test fix :wrench:
parent ef597af3
No related branches found
No related tags found
No related merge requests found
(ns dev.debug-qp
"TODO -- I think this should be moved to something like [[metabase.test.util.debug-qp]]"
(:require [clojure.data :as data]
[clojure.pprint :as pprint]
[clojure.string :as str]
[clojure.test :refer :all]
[clojure.walk :as walk]
[medley.core :as m]
[metabase.mbql.schema :as mbql.s]
[metabase.mbql.util :as mbql.u]
[metabase.models :refer [Field Table]]
[metabase.models.field :refer [Field]]
[metabase.models.table :refer [Table]]
[metabase.query-processor :as qp]
[metabase.query-processor.reducible :as qp.reducible]
[metabase.test :as mt]
[metabase.util :as u]
[toucan.db :as db]))
;; see docstring for `process-query-debug` for descriptions of what these do.
;;;; [[add-names]]
(defn- field-and-table-name [field-id]
(let [{field-name :name, table-id :table_id} (db/select-one [Field :name :table_id] :id field-id)]
[(db/select-one-field :name Table :id table-id) field-name]))
(defn- add-table-id-name [table-id]
(list 'do
(symbol (format "#_%s" (pr-str (db/select-one-field :name Table :id table-id))))
table-id))
(defn add-names
"Walk a MBQL snippet `x` and add comment forms with the names of the Fields referenced to any `:field` clauses nil
encountered. Helpful for debugging!"
[x]
(walk/postwalk
(fn add-names* [form]
(letfn [(add-name-to-field-id [id]
(when id
(let [[field-name table-name] (field-and-table-name id)]
(symbol (format "#_\"%s.%s\"" field-name table-name)))))
(field-id->name-form [field-id]
(list 'do (add-name-to-field-id field-id) field-id))]
(mbql.u/replace form
[:field (id :guard integer?) opts]
[:field id (add-name-to-field-id id) (cond-> opts
(integer? (:source-field opts))
(update :source-field field-id->name-form))]
(m :guard (every-pred map? (comp integer? :source-table)))
(add-names* (update m :source-table add-table-id-name))
(m :guard (every-pred map? (comp integer? :metabase.query-processor.util.add-alias-info/source-table)))
(add-names* (update m :metabase.query-processor.util.add-alias-info/source-table add-table-id-name))
(m :guard (every-pred map? (comp integer? :fk-field-id)))
(-> m
(update :fk-field-id field-id->name-form)
add-names*)
;; don't recursively replace the `do` lists above, other we'll get vectors.
(_ :guard (every-pred list? #(= (first %) 'do)))
&match)))
x))
;;;; [[process-query-debug]]
;; see docstring for [[process-query-debug]] for descriptions of what these do.
(def ^:private ^:dynamic *print-full?* true)
(def ^:private ^:dynamic *print-metadata?* false)
(def ^:private ^:dynamic *print-names?* true)
(def ^:private ^:dynamic *validate-query?* false)
(defn- remove-metadata
"Replace field metadata in `x` with `...`."
[x]
......@@ -35,37 +84,6 @@
form))
x))
(defn- field-and-table-name [field-id]
(let [{field-name :name, table-id :table_id} (db/select-one [Field :name :table_id] :id field-id)]
[(db/select-one-field :name Table :id table-id) field-name]))
(defn- add-name-to-field-id [id]
(when id
(let [[field-name table-name] (field-and-table-name id)]
(symbol (format "#_\"%s.%s\"" field-name table-name)))))
(defn add-names
"Walk a MBQL snippet `x` and add comment forms with the names of the Fields referenced to any `:field` clauses nil
encountered. Helpful for debugging!"
[x]
(walk/postwalk
(fn [form]
(mbql.u/replace form
[:field (id :guard integer?) opts]
[:field id (add-name-to-field-id id) (cond-> opts
(integer? (:source-field opts))
(update :source-field (fn [source-field]
(symbol (format "(do %s %d)"
(add-name-to-field-id source-field)
source-field)))))]
(m :guard (every-pred map? (comp integer? :source-table)))
(update m :source-table (fn [table-id]
(symbol (format "(do #_%s %d)"
(db/select-one-field :name Table :id table-id)
table-id))))))
x))
(defn- format-output [x]
(cond-> x
(not *print-metadata?*) remove-metadata
......@@ -274,8 +292,13 @@
(qp query context)
(qp query)))))
;;;; [[to-mbql-shorthand]]
(defn- strip-$ [coll]
(vec (remove (partial = ::$) coll)))
(into []
(map (fn [x] (if (= x ::$) ::no-$ x)))
coll))
(defn- can-symbolize? [x]
(mbql.u/match-one x
......@@ -304,13 +327,13 @@
_
false))
(defn- expand [x table]
(defn- expand [form table]
(try
(mbql.u/replace x
(mbql.u/replace form
([:field (id :guard integer?) nil] :guard can-symbolize?)
(let [[table-name field-name] (field-and-table-name id)
field-name (str/lower-case field-name)
table-name (str/lower-case table-name)]
field-name (some-> field-name str/lower-case)
table-name (some-> table-name str/lower-case)]
(if (= table-name table)
[::$ field-name]
[::$ table-name field-name]))
......@@ -321,7 +344,7 @@
([:field _ (opts :guard :temporal-unit)] :guard can-symbolize?)
(let [without-unit (mbql.u/update-field-options &match dissoc :temporal-unit)
expansion (expand without-unit table)]
(into [::! (name (:temporal-unit opts))] (strip-$ expansion)))
[::! (name (:temporal-unit opts)) (strip-$ expansion)])
([:field _ (opts :guard :source-field)] :guard can-symbolize?)
(let [without-source-field (mbql.u/update-field-options &match dissoc :source-field)
......@@ -340,22 +363,69 @@
expansion (expand without-opts table)]
(if (= expansion without-opts)
&match
[:field (into [::%] (strip-$ expansion)) opts]))
[:field [::% (strip-$ expansion)] opts]))
(m :guard (every-pred map? (comp integer? :source-table)))
(-> (update m :source-table (fn [table-id]
[::$$ (str/lower-case (db/select-one-field :name Table :id table-id))]))
[::$$ (some-> (db/select-one-field :name Table :id table-id) str/lower-case)]))
(expand table))
(m :guard (every-pred map? (comp integer? :fk-field-id)))
(-> (update m :fk-field-id (fn [fk-field-id]
(let [[table-name field-name] (field-and-table-name fk-field-id)
field-name (some-> field-name str/lower-case)
table-name (some-> table-name str/lower-case)]
(if (= table-name table)
[::% field-name]
[::% table-name field-name]))))
(expand table)))
(catch Throwable e
(throw (ex-info (format "Error expanding %s: %s" (pr-str x) (ex-message e))
{:x x, :table table}
(throw (ex-info (format "Error expanding %s: %s" (pr-str form) (ex-message e))
{:form form, :table table}
e)))))
(defn- no-$ [x]
(mbql.u/replace x [::$ & args] (into [::no-$] args)))
(defn- symbolize [query]
(mbql.u/replace query
(def ^:private mbql-clause->sort-order
(into {}
(map-indexed (fn [i k]
[k i]))
[;; top-level keys
:database
:type
:query
:native
;; inner-query keys
:source-table
:source-query
:source-metadata
:joins
:expressions
:breakout
:aggregation
:fields
:filter
:order-by
:page
:limit
;; join keys
:alias
:condition
:strategy]))
(defn- sorted-mbql-query-map []
(sorted-map-by (fn [x y]
(let [x-order (mbql-clause->sort-order x)
y-order (mbql-clause->sort-order y)]
(cond
(and x-order y-order) (compare x-order y-order)
x-order -1
y-order 1
:else (compare (pr-str x) (pr-str y)))))))
(defn- symbolize [form]
(mbql.u/replace form
[::-> x y]
(symbol (format "%s->%s" (symbolize x) (str/replace (symbolize y) #"^\$" "")))
......@@ -394,39 +464,4 @@
(defn expand-symbolize [x]
(-> x (expand "orders") symbolize))
(deftest to-mbql-shorthand-test
(mt/dataset sample-dataset
(testing "Normal Field ID clause"
(is (= '$user_id
(expand-symbolize [:field (mt/id :orders :user_id) nil])))
(is (= '$products.id
(expand-symbolize [:field (mt/id :products :id) nil]))))
(testing "Field literal name"
(is (= '*wow/Text
(expand-symbolize [:field "wow" {:base-type :type/Text}])))
(is (= [:field "w o w" {:base-type :type/Text}]
(expand-symbolize [:field "w o w" {:base-type :type/Text}]))))
(testing "Field with join alias"
(is (= '&P.people.source
(expand-symbolize [:field (mt/id :people :source) {:join-alias "P"}])))
(is (= [:field '%people.id {:join-alias "People - User"}]
(expand-symbolize [:field (mt/id :people :id) {:join-alias "People - User"}])))
(is (= '&Q.*ID/BigInteger
(expand-symbolize [:field "ID" {:base-type :type/BigInteger, :join-alias "Q"}]))))
(testing "Field with source-field"
(is (= '$product_id->products.id
(expand-symbolize [:field (mt/id :products :id) {:source-field (mt/id :orders :product_id)}])))
(is (= '$product_id->*wow/Text
(expand-symbolize [:field "wow" {:base-type :type/Text, :source-field (mt/id :orders :product_id)}]))))
(testing "Binned field - no expansion (%id only)"
(is (= [:field '%people.source {:binning {:strategy :default}}]
(expand-symbolize [:field (mt/id :people :source) {:binning {:strategy :default}}]))))
(testing "source table"
(is (= '(mt/mbql-query orders
{:joins [{:source-table $$people}]})
(to-mbql-shorthand
{:database (mt/id)
:type :query
:query {:source-table (mt/id :orders)
:joins [{:source-table (mt/id :people)}]}}))))))
;; tests are in [[dev.debug-qp-test]] (in `./dev/test/dev` dir)
(ns dev.debug-qp-test
(:require [clojure.test :refer :all]
[dev.debug-qp :as debug-qp]
[metabase.test :as mt]))
(deftest add-names-test
(testing "Joins"
(is (= [{:strategy :left-join
:alias "CATEGORIES__via__CATEGORY_ID"
:condition [:=
[:field
(mt/id :venues :category_id)
(symbol "#_\"VENUES.CATEGORY_ID\"")
nil]
[:field
(mt/id :categories :id)
(symbol "#_\"CATEGORIES.ID\"")
{:join-alias "CATEGORIES__via__CATEGORY_ID"}]]
:source-table (list 'do (symbol "#_\"CATEGORIES\"") (mt/id :categories))
:fk-field-id (list 'do (symbol "#_\"VENUES.CATEGORY_ID\"") (mt/id :venues :category_id))}]
(debug-qp/add-names
[{:strategy :left-join
:alias "CATEGORIES__via__CATEGORY_ID"
:condition [:=
[:field (mt/id :venues :category_id) nil]
[:field (mt/id :categories :id) {:join-alias "CATEGORIES__via__CATEGORY_ID"}]]
:source-table (mt/id :categories)
:fk-field-id (mt/id :venues :category_id)}])))))
(deftest to-mbql-shorthand-test
(mt/dataset sample-dataset
(testing "Normal Field ID clause"
(is (= '$user_id
(debug-qp/expand-symbolize [:field (mt/id :orders :user_id) nil])))
(is (= '$products.id
(debug-qp/expand-symbolize [:field (mt/id :products :id) nil]))))
(testing "Field literal name"
(is (= '*wow/Text
(debug-qp/expand-symbolize [:field "wow" {:base-type :type/Text}])))
(is (= [:field "w o w" {:base-type :type/Text}]
(debug-qp/expand-symbolize [:field "w o w" {:base-type :type/Text}]))))
(testing "Field with join alias"
(is (= '&P.people.source
(debug-qp/expand-symbolize [:field (mt/id :people :source) {:join-alias "P"}])))
(is (= [:field '%people.id {:join-alias "People - User"}]
(debug-qp/expand-symbolize [:field (mt/id :people :id) {:join-alias "People - User"}])))
(is (= '&Q.*ID/BigInteger
(debug-qp/expand-symbolize [:field "ID" {:base-type :type/BigInteger, :join-alias "Q"}]))))
(testing "Field with source-field"
(is (= '$product_id->products.id
(debug-qp/expand-symbolize [:field (mt/id :products :id) {:source-field (mt/id :orders :product_id)}])))
(is (= '$product_id->*wow/Text
(debug-qp/expand-symbolize [:field "wow" {:base-type :type/Text, :source-field (mt/id :orders :product_id)}]))))
(testing "Binned field - no expansion (%id only)"
(is (= [:field '%people.source {:binning {:strategy :default}}]
(debug-qp/expand-symbolize [:field (mt/id :people :source) {:binning {:strategy :default}}]))))
(testing "Field with temporal unit"
(is (= '!default.created_at
(debug-qp/expand-symbolize [:field (mt/id :orders :created_at) {:temporal-unit :default}]))))
(testing "Field with join alias AND temporal unit"
(is (= '!default.&P1.created_at
(debug-qp/expand-symbolize [:field (mt/id :orders :created_at) {:temporal-unit :default, :join-alias "P1"}]))))
(testing "source table"
(is (= '(mt/mbql-query orders
{:joins [{:source-table $$people}]})
(debug-qp/to-mbql-shorthand
{:database (mt/id)
:type :query
:query {:source-table (mt/id :orders)
:joins [{:source-table (mt/id :people)}]}}))))))
(deftest to-mbql-shorthand-joins-test
(testing :fk-field-id
(is (= '(mt/$ids venues
[{:strategy :left-join
:alias "CATEGORIES__via__CATEGORY_ID"
:condition [:= $category_id &CATEGORIES__via__CATEGORY_ID.categories.id]
:source-table $$categories
:fk-field-id %category_id}])
(debug-qp/to-mbql-shorthand
[{:strategy :left-join
:alias "CATEGORIES__via__CATEGORY_ID"
:condition [:=
[:field (mt/id :venues :category_id) nil]
[:field (mt/id :categories :id) {:join-alias "CATEGORIES__via__CATEGORY_ID"}]]
:source-table (mt/id :categories)
:fk-field-id (mt/id :venues :category_id)}]
"venues")))))
......@@ -8,7 +8,9 @@
This would not have had the random namespace that requires these helpers and the run fails.
"
(:require [clojure.test :as t]
(:require [clojure.data :as data]
[clojure.test :as t]
dev.debug-qp
[metabase.util.date-2 :as date-2]
[metabase.util.i18n.impl :as i18n.impl]
[schema.core :as s]))
......@@ -43,3 +45,21 @@
:actual actual#
:diffs (when-not pass?#
[[actual# [(s/check schema# actual#) nil]]])})))
;; basically the same as normal `=` but will add comment forms to MBQL queries for Field clauses and source tables
;; telling you the name of the referenced Fields/Tables
(defmethod t/assert-expr 'query=
[message [_ expected actual :as args]]
`(let [expected# ~expected
actual# ~actual
pass?# (= expected# actual#)
expected# (dev.debug-qp/add-names expected#)
actual# (dev.debug-qp/add-names actual#)]
(t/do-report
{:type (if pass?# :pass :fail)
:message ~message
:expected expected#
:actual actual#
:diffs (when-not pass?#
(let [[only-in-actual# only-in-expected#] (data/diff actual# expected#)]
[[actual# [only-in-expected# only-in-actual#]]]))})))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment