From 45181ea15ad0dde2e249f3f3b9d3157c6b9a7c65 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cam=20Sau=CC=88l?= <cammsaul@gmail.com>
Date: Thu, 16 Jul 2015 15:34:24 -0700
Subject: [PATCH] yay yay
---
.dir-locals.el | 1 +
project.clj | 2 +-
src/metabase/api/common/internal.clj | 3 +-
src/metabase/driver/query_processor.clj | 37 ++++---
.../driver/query_processor/annotate.clj | 102 +++++++++++-------
src/metabase/util.clj | 8 ++
src/metabase/util/logic.clj | 14 ---
7 files changed, 97 insertions(+), 70 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index ca39ed3ae8c..6223dde99f4 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -17,6 +17,7 @@
(auto-parse 1)
(catch-api-exceptions 0)
(check 1)
+ (conda 0)
(context 2)
(create-database-definition 1)
(execute-query 1)
diff --git a/project.clj b/project.clj
index 3bc49e83ff6..499f59dd95d 100644
--- a/project.clj
+++ b/project.clj
@@ -84,7 +84,7 @@
:env {:mb-test-setting-1 "ABCDEFG"}
:jvm-opts ["-Dmb.db.file=target/metabase-test"
"-Dmb.jetty.join=false"
- "-Dmb.jetty.port=3001"
+ "-Dmb.jetty.port=3010"
"-Dmb.api.key=test-api-key"
"-Xverify:none"]} ; disable bytecode verification when running tests so they start slightly faster
:uberjar {:aot :all
diff --git a/src/metabase/api/common/internal.clj b/src/metabase/api/common/internal.clj
index 1437a936a13..f0ba141f32d 100644
--- a/src/metabase/api/common/internal.clj
+++ b/src/metabase/api/common/internal.clj
@@ -227,8 +227,7 @@
;; If status code was specified but other data wasn't, it's something like a 404. Return message as the body.
status-code message
;; Otherwise it's a 500. Return a body that includes exception & filtered stacktrace for debugging purposes
- :else (let [stacktrace (->> (map str (.getStackTrace e))
- (filter (partial re-find #"metabase")))]
+ :else (let [stacktrace (u/filtered-stacktrace e)]
(log/debug message "\n" (u/pprint-to-str stacktrace))
(assoc other-info
:message message
diff --git a/src/metabase/driver/query_processor.clj b/src/metabase/driver/query_processor.clj
index 01741a9062b..7731cb4a240 100644
--- a/src/metabase/driver/query_processor.clj
+++ b/src/metabase/driver/query_processor.clj
@@ -41,8 +41,9 @@
(try (qp query)
(catch Throwable e
(.printStackTrace e)
- {:status :failed
- :error (.getMessage e)}))))
+ {:status :failed
+ :error (.getMessage e)
+ :stacktrace (u/filtered-stacktrace e)}))))
(defn- pre-expand [qp]
@@ -62,22 +63,30 @@
;; Add :rows_truncated if we've hit the limit so the UI can let the user know
(= num-results max-result-rows) (assoc-in [:data :rows_truncated] max-result-rows)))))
+(defn- should-add-implicit-fields? [{{:keys [fields breakout], {ag-type :aggregation-type} :aggregation} :query}]
+ (println "AG-TYPE:" ag-type)
+ (and (or (not ag-type)
+ (= ag-type :rows))
+ (not breakout)
+ (not fields)))
(defn- pre-add-implicit-fields
"Add an implicit `fields` clause to queries with `rows` aggregations."
[qp]
- (fn [{{:keys [fields breakout source-table], {source-table-id :id} :source-table, {ag-type :aggregation-type} :aggregation} :query, :as query}]
- (qp (if (or (and ag-type
- (not (= ag-type :rows)))
- breakout
- fields) query
- (-> query
- (assoc-in [:query :fields-is-implicit] true)
- (assoc-in [:query :fields] (->> (sel :many :fields [Field :name :base_type :special_type :table_id :id :position :description], :table_id source-table-id, :active true,
- :preview_display true, :field_type [not= "sensitive"], :parent_id nil, (k/order :position :asc), (k/order :id :desc))
- (map expand/rename-mb-field-keys)
- (map expand/map->Field)
- (map #(expand/resolve-table % {source-table-id source-table})))))))))
+ (fn [{{:keys [source-table], {source-table-id :id} :source-table} :query, :as query}]
+ (qp (if-not (should-add-implicit-fields? query)
+ query
+ (let [fields (->> (sel :many :fields [Field :name :base_type :special_type :table_id :id :position :description], :table_id source-table-id, :active true,
+ :preview_display true, :field_type [not= "sensitive"], :parent_id nil, (k/order :position :asc), (k/order :id :desc))
+ (map expand/rename-mb-field-keys)
+ (map expand/map->Field)
+ (map #(expand/resolve-table % {source-table-id source-table})))]
+ (if-not (seq fields)
+ (do (log/warn (format "Table '%s' has no Fields associated with it." (:name source-table)))
+ query)
+ (-> query
+ (assoc-in [:query :fields-is-implicit] true)
+ (assoc-in [:query :fields] fields))))))))
(defn- pre-add-implicit-breakout-order-by
diff --git a/src/metabase/driver/query_processor/annotate.clj b/src/metabase/driver/query_processor/annotate.clj
index 5fb88344657..ab9ab80ed6a 100644
--- a/src/metabase/driver/query_processor/annotate.clj
+++ b/src/metabase/driver/query_processor/annotate.clj
@@ -67,6 +67,9 @@
;; Use core.logic to determine the appropriate ordering / result Fields
+(defn- field-nameo [field field-name]
+ (featurec field {:field-name field-name}))
+
(defn- breakout-fieldo [{:keys [breakout]}]
(let [breakout-fields (flatten-collect-fields breakout)]
(fn [out]
@@ -92,11 +95,18 @@
(fn [out]
(membero out fields-fields)))))
+(defn- unknown-fieldo [field-name out]
+ (all
+ (== out {:base-type :UnknownField
+ :special-type nil
+ :field-name field-name})
+ (trace-lvars "UNKNOWN FIELD - NOT PRESENT IN EXPANDED QUERY (!)" out)))
+
(defn- fieldo [query]
(let [fields (flatten-collect-fields query)
ag-fieldo (aggregate-fieldo query)]
(fn [out]
- (conde
+ (conda
((membero out fields))
((ag-fieldo out))))))
@@ -126,26 +136,24 @@
:other 2})
(defn- special-typeo [field out]
- (fresh [special-type]
- (trace-lvars "!" field out)
- (featurec field {:special-type special-type})
- (trace-lvars "SPECIAL-TYPEO" special-type)
- (conda
- ((== special-type :id) (== out (special-type-groups :id)))
- ((== special-type :name) (== out (special-type-groups :name)))
- (s# (== out (special-type-groups :other))))))
+ (conda
+ ((featurec field {:special-type :id}) (== out (special-type-groups :id)))
+ ((featurec field {:special-type :name}) (== out (special-type-groups :name)))
+ (s# (== out (special-type-groups :other)))))
(defn- field-name< [query]
- (fn [f1 f2]
- (fresh [name-1 name-2]
- (trace-lvars "!" name-1 name-2)
- (featurec f1 {:field-name name-1})
- (featurec f2 {:field-name name-2})
- ((fn name< [[k & more]]
- (conda
- ((== k name-1) s#)
- ((!= k name-2) (when (seq more)
- (name< more))))) (:result-keys query)))))
+ (let [name< (partial (fn name< [[k & more] name-1 name-2]
+ (conda
+ ((== k name-1))
+ ((== k name-2) fail)
+ (s# (if-not (seq more) fail
+ (name< more name-1 name-2)))))
+ (:result-keys query))]
+ (fn [f1 f2]
+ (fresh [name-1 name-2]
+ (field-nameo f1 name-1)
+ (field-nameo f2 name-2)
+ (name< name-1 name-2)))))
(defn- clause-position< [query]
(let [groupo (field-groupo query)
@@ -156,37 +164,53 @@
((groupo f1 (field-groups :breakout)) (matches-seq-ordero f1 f2 breakout-fields))
((groupo f1 (field-groups :explicit-fields)) (matches-seq-ordero f1 f2 fields-fields))))))
-(defn- ar-< [x y]
- (ar/< x y))
+;; TODO - inline these ?
+(defn- f< [f]
+ (fn [f1 f2]
+ (fresh [v1 v2]
+ (f f1 v1)
+ (f f2 v2)
+ (ar/< v1 v2))))
+
+(defn- f== [f]
+ (fn [f1 f2]
+ (fresh [v]
+ (f f1 v)
+ (f f2 v))))
-(defn- fields< [query]
+(defn- fields-sortedo [query]
(let [groupo (field-groupo query)
name< (field-name< query)
clause-pos< (clause-position< query)]
(fn [f1 f2]
- (fpred-conda [groupo f1 f2]
- (ar-< (trace-lvars "GROUP <" f1 f2))
- (== (fpred-conda [field-positiono f1 f2]
- (ar-< (trace-lvars "POSITION <" f1 f2))
- (== (fresh [g]
- (groupo f1 g)
- (trace-lvars "!!!" f1 g))
- (conda
- ((groupo f1 (field-groups :other)) (trace-lvars "FG -> OTHER" f1) (fpred-conda [special-typeo f1 f2]
- (ar-< (trace-lvars "SPECIAL TYPE <" f1 f2))
- (== (trace-lvars "NAME <" f1 f2) (name< f1 f2))))
- ((clause-pos< f1 f2) (trace-lvars "CLAUSE POS <" f1 f2))))))))))
+ (conda
+ (((f< groupo) f1 f2) s#)
+ (((f== groupo) f1 f2)
+ (conda
+ (((f< field-positiono) f1 f2) s#)
+ (((f== field-positiono) f1 f2)
+ (conda
+ ((groupo f1 (field-groups :other)) (conda
+ (((f< special-typeo) f1 f2) s#)
+ (((f== special-typeo) f1 f2) (name< f1 f2))))
+ ((clause-pos< f1 f2))))))))))
(defn- resolve+order-cols [{:keys [result-keys], :as query}]
- {:post [(sequential? %) (every? map? %)]}
- (time (first (let [fields (vec (lvars (count result-keys)))]
+ {:pre [(seq result-keys)]
+ ;; :post [(sequential? %) (every? map? %)]
+ }
+ (println result-keys)
+ (time (first (let [fields (vec (lvars (count result-keys)))
+ known-fieldo (fieldo query)]
(run 1 [q]
;; Make a new constraint for every lvar FIELDS[i] to give it the name of RESULT-KEYS[i]
(everyg (fn [i]
- (featurec (fields i) {:field-name (result-keys i)}))
+ (let [field (fields i), field-name (result-keys i)]
+ (conda
+ ((all (field-nameo field field-name) (known-fieldo field)))
+ ((unknown-fieldo field-name field)))))
(range 0 (count result-keys)))
- (everyg (fieldo query) fields)
- (sorted-permutationo (fields< query) fields q))))))
+ (sorted-permutationo (fields-sortedo query) fields q))))))
(defn x []
(require 'metabase.driver 'metabase.test.data)
diff --git a/src/metabase/util.clj b/src/metabase/util.clj
index 4b5d93bb0fa..d5296bae8bf 100644
--- a/src/metabase/util.clj
+++ b/src/metabase/util.clj
@@ -275,4 +275,12 @@
~(when (seq more)
`(cond-let ~@more))))
+(defn filtered-stacktrace
+ "Get the stack trace associated with E and return it as a vector with non-metabase frames filtered out."
+ [^Throwable e]
+ (when e
+ (when-let [stacktrace (.getStackTrace e)]
+ (->> (map str (.getStackTrace e))
+ (filterv (partial re-find #"metabase"))))))
+
(require-dox-in-this-namespace)
diff --git a/src/metabase/util/logic.clj b/src/metabase/util/logic.clj
index 1c9ad64d372..26bdf49d64e 100644
--- a/src/metabase/util/logic.clj
+++ b/src/metabase/util/logic.clj
@@ -42,20 +42,6 @@
(sorted-permutationo pred ?more more)
(sorted-intoo pred more ?x out))))
-(defn fpredo
- "Succeds if PRED holds true for the fresh values obtained by `(f value fresh-value)`."
- [pred f v1 v2]
- (fresh [fresh-v1 fresh-v2]
- (f v1 fresh-v1)
- (f v2 fresh-v2)
- (trace-lvars (str f) fresh-v1 fresh-v2)
- (pred fresh-v1 fresh-v2)))
-
-(defmacro fpred-conda [[f & values] & clauses]
- `(conda
- ~@(for [[pred & body] clauses]
- `((fpredo ~pred ~f ~@values) ~@body))))
-
(defna matches-seq-ordero
"A relation such that V1 is present and comes before V2 in list L."
[v1 v2 l]
--
GitLab