yay yay

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

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

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

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

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)

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)

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]