diff --git a/project.clj b/project.clj
index 1223baf874495873dd8085dadbd7225d30cb4ede..61cae437805ce044bee4d0657ae2ad5bec4eb3bf 100644
--- a/project.clj
+++ b/project.clj
@@ -9,7 +9,6 @@
"generate-sample-dataset" ["with-profile" "+generate-sample-dataset" "run"]}
:dependencies [[org.clojure/clojure "1.7.0"]
[org.clojure/core.async "0.1.346.0-17112a-alpha"]
- [org.clojure/core.logic "0.8.10"]
[org.clojure/core.match "0.3.0-alpha4"] ; optimized pattern matching library for Clojure
[org.clojure/core.memoize "0.5.7"] ; needed by core.match; has useful FIFO, LRU, etc. caching mechanisms
[org.clojure/data.csv "0.1.3"] ; CSV parsing / generation
@@ -17,7 +16,6 @@
[org.clojure/java.jdbc "0.4.2"] ; basic jdbc access from clojure
[org.clojure/math.numeric-tower "0.0.4"] ; math functions like `ceil`
[org.clojure/tools.logging "0.3.1"] ; logging framework
- [org.clojure/tools.macro "0.1.5"] ; tools for writing macros
[org.clojure/tools.namespace "0.2.10"]
[amalloy/ring-gzip-middleware "0.1.3"] ; Ring middleware to GZIP responses if client can handle it
[cheshire "5.5.0"] ; fast JSON encoding (used by Ring JSON middleware)
diff --git a/src/metabase/driver/query_processor/annotate.clj b/src/metabase/driver/query_processor/annotate.clj
index 46e2657ee45e41164ae0fabd1d8fd90c62dace39..e0e55ea2a2a684108987e06cd40919bc34ef9746 100644
--- a/src/metabase/driver/query_processor/annotate.clj
+++ b/src/metabase/driver/query_processor/annotate.clj
@@ -1,17 +1,14 @@
(ns metabase.driver.query-processor.annotate
(:refer-clojure :exclude [==])
- (:require [clojure.core.logic :refer :all]
- (clojure.core.logic [arithmetic :as ar]
- [fd :as fd])
- [clojure.tools.macro :refer [macrolet]]
- (clojure [set :as set]
+ (:require (clojure [set :as set]
[string :as s])
+ [clojure.tools.logging :as log]
+ [medley.core :as m]
[metabase.db :refer [sel]]
[metabase.driver.query-processor.interface :as i]
(metabase.models [field :refer [Field], :as field]
[foreign-key :refer [ForeignKey]])
- [metabase.util :as u]
- [metabase.util.logic :refer :all]))
+ [metabase.util :as u]))
;; Fields should be returned in the following order:
;; 1. Breakout Fields
@@ -35,246 +32,219 @@
;; When two Fields have the same :position and :special_type "group", fall back to sorting Fields alphabetically by name.
;; This is arbitrary, but it makes the QP deterministic by keeping the results in a consistent order, which makes it testable.
-;;; # ---------------------------------------- FIELD COLLECTION ----------------------------------------
-
-;; Walk the expanded query and collect the fields found therein. Associate some additional info to each that we'll pass to core.logic so it knows
-;; how to order the results
-
-(defn- field-qualify-name [field]
- (assoc field :field-name (keyword (apply str (->> (rest (i/qualified-name-components field))
- (interpose "."))))))
-
-(defn- flatten-collect-fields [form]
- (let [fields (transient [])]
- (clojure.walk/prewalk (fn [f]
- (cond
- (= (type f) metabase.driver.query_processor.interface.Field)
- (do
- (conj! fields f)
- ;; HACK !!!
- ;; Nested Mongo fields come back inside of their parent when you specify them in the fields clause
- ;; e.g. (Q fields venue...name) will return rows like {:venue {:name "Kyle's Low-Carb Grill"}}
- ;; Until we fix this the right way we'll just include the parent Field in the :query-fields list so the pattern
- ;; matching works correctly.
- ;; (This hack was part of the old annotation code too, it just sticks out better because it's no longer hidden amongst the others)
- (when (:parent f)
- (conj! fields (:parent f))))
-
- ;; For a DateTimeField we'll flatten it back into regular Field but include the :unit info for the frontend
- ;; Recurse so this fn will handle the resulting Field normally
- (= (type f) metabase.driver.query_processor.interface.DateTimeField)
- (recur (assoc (:field f)
- :unit (:unit f)))
-
- :else f))
- form)
- (->> (persistent! fields)
- distinct
- (map field-qualify-name)
- (mapv (u/rpartial dissoc :parent :parent-id :table-name)))))
-
-(defn- flatten-collect-ids-domain [form]
- (apply fd/domain (sort (map :field-id (flatten-collect-fields form)))))
-
-
-;;; # ---------------------------------------- COLUMN RESOLUTION & ORDERING (CORE.LOGIC) ----------------------------------------
-
-;; Use core.logic to determine the appropriate ordering / result Fields
-
-(defn- field-name° [field field-name]
- (featurec field {:field-name field-name}))
-
-(defn- make-field-in° [items]
- (if-not (seq items)
- (constantly fail)
- (let [ids-domain (flatten-collect-ids-domain items)]
- (fn [field]
- (fresh [id]
- (featurec field {:field-id id})
- (fd/in id ids-domain))))))
-
-(defn- breakout-field° [{:keys [breakout]}]
- (make-field-in° breakout))
-
-(defn- explicit-fields-field° [{:keys [fields-is-implicit fields], :as query}]
- (if fields-is-implicit (constantly fail)
- (make-field-in° fields)))
-
-(defn- aggregate-field° [{{ag-type :aggregation-type, ag-field :field} :aggregation}]
- (if-not (contains? #{:avg :count :distinct :stddev :sum} ag-type)
- (constantly fail)
- (let [ag-field (if (contains? #{:count :distinct} ag-type)
- {:base-type :IntegerField
- :field-name :count
- :field-display-name "count"
- :special-type :number}
- (-> ag-field
- (select-keys [:base-type :special-type])
- (assoc :field-name (if (= ag-type :distinct) :count
- ag-type))
- (assoc :field-display-name (if (= ag-type :distinct) "count"
- (name ag-type)))))]
- (fn [out]
- (trace-lvars "*" out)
- (== out ag-field)))))
-
-(defn- unknown-field° [field-name out]
- (all
- (== out {:base-type :UnknownField
- :special-type nil
- :field-name field-name
- :field-display-name field-name})
- (trace-lvars "UNKNOWN FIELD - NOT PRESENT IN EXPANDED QUERY (!)" out)))
-
-(defn- field° [query]
- (let [ag-field° (aggregate-field° query)
- normal-field° (let [field-name->field (let [fields (flatten-collect-fields query)]
- (zipmap (map :field-name fields) fields))]
- (fn [field-name out]
- (if-let [field (field-name->field field-name)]
- (== out field)
- fail)))]
- (fn [field-name field]
- (conda
- ((normal-field° field-name field))
- ((ag-field° field))))))
-
-(def ^:const ^:private field-groups
- {:breakout 0
- :aggregation 1
- :explicit-fields 2
- :other 3})
-
-(defn- field-group° [query]
- (let [breakout° (breakout-field° query)
- agg° (aggregate-field° query)
- xfields° (explicit-fields-field° query)]
- (fn [field out]
- (conda
- ((breakout° field) (== out (field-groups :breakout)))
- ((agg° field) (== out (field-groups :aggregation)))
- ((xfields° field) (== out (field-groups :explicit-fields)))
- (s# (== out (field-groups :other)))))))
-
-(defn- field-position° [field out]
- (featurec field {:position out}))
-
-(def ^:const ^:private special-type-groups
- {:id 0
- :name 1
- :other 2})
-
-(defn- special-type-group° [field out]
- (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]
- (field-name° f1 name-1)
- (field-name° f2 name-2)
- (matches-seq-order° name-1 name-2 (:result-keys query)))))
-
-(defn- clause-position< [query]
- (let [group° (field-group° query)
- breakout-fields (flatten-collect-fields (:breakout query))
- fields-fields (flatten-collect-fields (:fields query))]
- (fn [f1 f2]
- (conda
- ((group° f1 (field-groups :breakout)) (matches-seq-order° f1 f2 breakout-fields))
- ((group° f1 (field-groups :explicit-fields)) (matches-seq-order° f1 f2 fields-fields))))))
-
-(defn- fields-sorted° [query]
- (let [group° (field-group° query)
- name< (field-name< query)
- clause-pos< (clause-position< query)]
- (fn [f1 f2]
- (macrolet [(<-or-== [f & ==-clauses] `(conda
- ((fresh [v#]
- (~f ~'f1 v#)
- (~f ~'f2 v#)) ~@==-clauses)
- ((fresh [v1# v2#]
- (~f ~'f1 v1#)
- (~f ~'f2 v2#)
- (ar/< v1# v2#)) ~'s#)))]
- (<-or-== group°
- (<-or-== field-position°
- (conda
- ((group° f1 (field-groups :other)) (<-or-== special-type-group°
- (name< f1 f2)))
- ((clause-pos< f1 f2)))))))))
-
-(defn- resolve+order-cols [{:keys [result-keys], :as query}]
- (when (seq result-keys)
- (first (let [fields (vec (lvars (count result-keys)))
- known-field° (field° query)]
- (run 1 [q]
- (everyg (fn [[result-key field]]
- (conda
- ((known-field° result-key field))
- ((unknown-field° result-key field))))
- (zipmap result-keys fields))
- (sorted-permutation° (fields-sorted° query) fields q))))))
-
-
-;;; # ---------------------------------------- COLUMN DETAILS ----------------------------------------
-
-;; Format the results in the way the front-end expects.
-
-(defn- format-col [col]
- (merge {:description nil
- :id nil
- :table_id nil}
- (-> col
- (set/rename-keys {:base-type :base_type
- :field-id :id
- :field-name :name
- :field-display-name :display_name
- :schema-name :schema_name
- :special-type :special_type
- :preview-display :preview_display
- :table-id :table_id})
- (dissoc :position))))
-
-(defn- add-fields-extra-info
+;;; ## Field Resolution
+
+(defn- collect-fields
+ "Return a sequence of all the `Fields` inside THIS, recursing as needed for collections.
+ For maps, add or `conj` to property `:path`, recording the keypath used to reach each `Field.`
+
+ (collect-fields {:name \"id\", ...}) -> [{:name \"id\", ...}]
+ (collect-fields [{:name \"id\", ...}]) -> [{:name \"id\", ...}]
+ (collect-fields {:a {:name \"id\", ...}) -> [{:name \"id\", :path [:a], ...}]"
+ [this]
+ {:post [(every? (partial instance? metabase.driver.query_processor.interface.Field) %)]}
+ (condp instance? this
+ ;; For a DateTimeField we'll flatten it back into regular Field but include the :unit info for the frontend.
+ ;; Recurse so it is otherwise handled normally
+ metabase.driver.query_processor.interface.DateTimeField
+ (let [{:keys [field unit]} this]
+ (collect-fields (assoc field :unit unit)))
+
+ metabase.driver.query_processor.interface.Field
+ (if-let [parent (:parent this)]
+ ;; Nested Mongo fields come back inside of their parent when you specify them in the fields clause
+ ;; e.g. (Q fields venue...name) will return rows like {:venue {:name "Kyle's Low-Carb Grill"}}
+ ;; Until we fix this the right way we'll just include the parent Field in the :query-fields list so the pattern
+ ;; matching works correctly.
+ [this parent]
+ [this])
+
+ clojure.lang.IPersistentMap
+ (for [[k v] (seq this)
+ field (collect-fields v)
+ :when field]
+ (assoc field :source k))
+
+ clojure.lang.Sequential
+ (for [[i field] (m/indexed (mapcat collect-fields this))]
+ (assoc field :clause-position i))
+
+ nil))
+
+(defn- qualify-field-name
+ "Update the `field-name` to reflect the name we expect to see coming back from the query.
+ (This is for handling Mongo nested Fields, I think (?))"
+ [field]
+ {:post [(keyword? (:field-name %))]}
+ (assoc field :field-name (->> (rest (i/qualified-name-components field))
+ (interpose ".")
+ (apply str)
+ keyword)))
+
+(defn- add-aggregate-field-if-needed
+ "Add a Field containing information about an aggregate column such as `:count` or `:distinct` if needed."
+ [{{ag-type :aggregation-type, ag-field :field, :as ag} :aggregation} fields]
+ (if (or (not ag-type)
+ (= ag-type :rows))
+ fields
+ (conj fields (merge {:source :aggregation}
+ (if (contains? #{:count :distinct} ag-type)
+ {:base-type :IntegerField
+ :field-name :count
+ :field-display-name :count
+ :special-type :number}
+ (merge (select-keys ag-field [:base-type :special-type])
+ {:field-name ag-type
+ :field-display-name ag-type}))))))
+
+(defn- add-unknown-fields-if-needed
+ "When create info maps for any fields we didn't expect to come back from the query.
+ Ideally, this should never happen, but on the off chance it does we still want to return it in the results."
+ [actual-keys fields]
+ {:pre [(set? actual-keys)
+ (every? keyword? actual-keys)]}
+ (let [expected-keys (set (map :field-name fields))
+ _ (assert (every? keyword? expected-keys))
+ missing-keys (set/difference actual-keys expected-keys)]
+ (when (seq missing-keys)
+ (log/error (u/format-color 'red "Unknown fields - returned by results but not present in expanded query: %s\nExpected: %s\nActual: %s"
+ missing-keys expected-keys actual-keys)))
+ (concat fields (for [k missing-keys]
+ {:base-type :UnknownField
+ :special-type nil
+ :field-name k
+ :field-display-name k}))))
+
+
+;;; ## Field Sorting
+
+;; We sort Fields with a "importance" vector like [source-importance position special-type-importance name]
+
+(defn- source-importance-fn
+ "Create a function to return a importance for FIELD based on its source clause in the query.
+ e.g. if a Field comes from a `:breakout` clause, we should return that column first in the results."
+ [{:keys [fields-is-implicit]}]
+ (fn [{:keys [source]}]
+ (or (when (= source :breakout)
+ :0-breakout)
+ (when (= source :aggregation)
+ :1-aggregation)
+ (when-not fields-is-implicit
+ (when (= source :fields)
+ :2-fields))
+ :3-other)))
+
+(defn- special-type-importance
+ "Return a importance for FIELD based on the relative importance of its `:special-type`.
+ i.e. a Field with special type `:id` should be sorted ahead of all other Fields in the results."
+ [{:keys [special-type]}]
+ (condp = special-type
+ :id :0-id
+ :name :1-name
+ :2-other))
+
+(defn- field-importance-fn
+ "Create a function to return an \"importance\" vector for use in sorting FIELD."
+ [query]
+ (let [source-importance (source-importance-fn query)]
+ (fn [{:keys [position clause-position field-name source], :as field}]
+ [(source-importance field)
+ (or position
+ (when (= source :fields)
+ clause-position)
+ Integer/MAX_VALUE)
+ (special-type-importance field)
+ field-name])))
+
+(defn- sort-fields
+ "Sort FIELDS by their \"importance\" vectors."
+ [query fields]
+ (let [field-importance (field-importance-fn query)]
+ (log/debug (u/format-color 'yellow "Sorted fields:\n%s" (u/pprint-to-str (sort (map field-importance fields)))))
+ (sort-by field-importance fields)))
+
+(defn- convert-field-to-expected-format
+ "Rename keys, provide default values, etc. for FIELD so it is in the format expected by the frontend."
+ [field]
+ {:pre [field]
+ :post [(keyword? (:name %))]}
+ (let [defaults {:description nil
+ :id nil
+ :table_id nil}]
+ (-> (merge defaults field)
+ (update :field-display-name name)
+ (set/rename-keys {:base-type :base_type
+ :field-id :id
+ :field-name :name
+ :field-display-name :display_name
+ :schema-name :schema_name
+ :special-type :special_type
+ :preview-display :preview_display
+ :table-id :table_id})
+ (dissoc :position :clause-position :source :parent :parent-id :table-name))))
+
+(defn- fk-field->dest-fn
+ "Fetch fk info and return a function that returns the destination Field of a given Field."
+ ([fields]
+ (or (fk-field->dest-fn fields (for [{:keys [special_type id]} fields
+ :when (= special_type :fk)]
+ id))
+ (constantly nil)))
+ ;; Fetch the ForeignKey objects whose origin is in the returned Fields, create a map of origin-field-id->destination-field-id
+ ([fields fk-ids]
+ (when (seq fk-ids)
+ (fk-field->dest-fn fields fk-ids (sel :many :field->field [ForeignKey :origin_id :destination_id]
+ :origin_id [in fk-ids]
+ :destination_id [not= nil]))))
+ ;; Fetch the destination Fields referenced by the ForeignKeys
+ ([fields fk-ids id->dest-id]
+ (when (seq (vals id->dest-id))
+ (fk-field->dest-fn fields fk-ids id->dest-id (sel :many :id->fields [Field :id :name :display_name :table_id :description :base_type :special_type :preview_display]
+ :id [in (vals id->dest-id)]))))
+ ;; Return a function that will return the corresponding destination Field for a given Field
+ ([fields fk-ids id->dest-id dest-id->field]
+ (fn [{:keys [id]}]
+ (some-> id id->dest-id dest-id->field))))
+
+(defn- add-extra-info-to-fk-fields
"Add `:extra_info` about `ForeignKeys` to `Fields` whose `special_type` is `:fk`."
[fields]
- ;; Get a sequence of add Field IDs that have a :special_type of FK
- (let [fk-field-ids (->> fields
- (filter #(= (:special_type %) :fk))
- (map :id)
- (filter identity))
- ;; Look up the Foreign keys info if applicable.
- ;; Build a map of FK Field IDs -> Destination Field IDs
- field-id->dest-field-id (when (seq fk-field-ids)
- (sel :many :field->field [ForeignKey :origin_id :destination_id], :origin_id [in fk-field-ids], :destination_id [not= nil]))
-
- ;; Build a map of Destination Field IDs -> Destination Fields
- dest-field-id->field (when (and (seq fk-field-ids)
- (seq (vals field-id->dest-field-id)))
- (sel :many :id->fields [Field :id :name :display_name :table_id :description :base_type :special_type :preview_display], :id [in (vals field-id->dest-field-id)]))]
-
- ;; Add the :extra_info + :target to every Field. For non-FK Fields, these are just {} and nil, respectively.
- (vec (for [{field-id :id, :as field} fields]
- (let [dest-field (when (seq fk-field-ids)
- (some->> field-id
- field-id->dest-field-id
- dest-field-id->field))]
- (assoc field
- :target dest-field
- :extra_info (if-not dest-field {}
- {:target_table_id (:table_id dest-field)})))))))
-
-(defn post-annotate [qp]
+ (let [field->dest (fk-field->dest-fn fields)]
+ (for [field fields]
+ (let [{:keys [table_id], :as dest-field} (field->dest field)]
+ (assoc field
+ :target dest-field
+ :extra_info (if table_id {:target_table_id table_id} {}))))))
+
+(defn- resolve-sort-and-format-columns
+ "Collect the Fields referenced in QUERY, sort them according to the rules at the top
+ of this page, format them as expected by the frontend, and return the results."
+ [query result-keys]
+ {:pre [(set? result-keys)]}
+ (when (seq result-keys)
+ (->> (collect-fields query)
+ (map qualify-field-name)
+ (add-aggregate-field-if-needed query)
+ (map (u/rpartial update :field-name keyword))
+ (add-unknown-fields-if-needed result-keys)
+ (sort-fields query)
+ (map convert-field-to-expected-format)
+ (filter (comp (partial contains? result-keys) :name))
+ (m/distinct-by :name)
+ add-extra-info-to-fk-fields)))
+
+(defn post-annotate
+ "QP middleware that runs directly after the the query is ran. This stage:
+
+ 1. Sorts the results according to the rules at the top of this page
+ 2. Resolves the Fields returned in the results and adds information like `:columns` and `:cols`
+ expected by the frontend."
+ [qp]
(fn [query]
- (let [results (qp query)
- cols (->> (assoc (:query query) :result-keys (vec (sort (keys (first results)))))
- resolve+order-cols
- (map format-col)
- add-fields-extra-info)
- columns (map :name cols)]
+ (let [results (qp query)
+ result-keys (set (keys (first results)))
+ cols (resolve-sort-and-format-columns (:query query) result-keys)
+ columns (mapv :name cols)]
{:cols (vec (for [col cols]
(update col :name name)))
:columns (mapv name columns)
diff --git a/src/metabase/util.clj b/src/metabase/util.clj
index f32855f8dbbb7a9863b565516a4ccf8cdb2f8b8d..74f4ebcf9bc71be8a93ff8c307b128805d095c41 100644
--- a/src/metabase/util.clj
+++ b/src/metabase/util.clj
@@ -3,10 +3,10 @@
(:require [clojure.java.jdbc :as jdbc]
[clojure.pprint :refer [pprint]]
[clojure.tools.logging :as log]
- [colorize.core :as color]
- [medley.core :as m]
+ [clj-time.coerce :as coerce]
[clj-time.format :as time]
- [clj-time.coerce :as coerce])
+ [colorize.core :as color]
+ [medley.core :as m])
(:import (java.net Socket
InetSocketAddress
InetAddress)
@@ -237,10 +237,13 @@
(defn format-color
"Like `format`, but uses a function in `colorize.core` to colorize the output.
- COLOR-SYMB should be a symbol like `green`.
+ COLOR-SYMB should be a quoted symbol like `green`, `red`, `yellow`, `blue`,
+ `cyan`, `magenta`, etc. See the entire list of avaliable colors
+ [here](https://github.com/ibdknox/colorize/blob/master/src/colorize/core.clj).
(format-color 'red \"Fatal error: %s\" error-message)"
[color-symb format-string & args]
+ {:pre [(symbol? color-symb)]}
((ns-resolve 'colorize.core color-symb) (apply format format-string args)))
(defn pprint-to-str
@@ -267,31 +270,81 @@
[^Throwable e]
(when e
(when-let [stacktrace (.getStackTrace e)]
- (->> (map str (.getStackTrace e))
- (filterv (partial re-find #"metabase"))))))
-
-(defmacro try-apply
- "Call F with PARAMS inside a try-catch block and log exceptions caught."
- [f & params]
- `(try
- (~f ~@params)
- (catch java.sql.SQLException e#
- (log/error (color/red ~(format "Caught exception in %s: " f)
- (with-out-str (jdbc/print-sql-exception-chain e#))
- (pprint-to-str (filtered-stacktrace e#)))))
- (catch Throwable e#
- (log/error (color/red ~(format "Caught exception in %s: " f)
- (or (.getMessage e#) e#)
- (pprint-to-str (filtered-stacktrace e#)))))))
+ (filterv (partial re-find #"metabase")
+ (map str (.getStackTrace e))))))
+
+(defn wrap-try-catch
+ "Returns a new function that wraps F in a `try-catch`. When an exception is caught, it is logged
+ with `log/error` and returns `nil`."
+ ([f]
+ (wrap-try-catch f nil))
+ ([f f-name]
+ (let [exception-message (if f-name
+ (format "Caught exception in %s: " f-name)
+ "Caught exception: ")]
+ (fn [& args]
+ (try
+ (apply f args)
+ (catch java.sql.SQLException e
+ (log/error (color/red exception-message "\n"
+ (with-out-str (jdbc/print-sql-exception-chain e)) "\n"
+ (pprint-to-str (filtered-stacktrace e)))))
+ (catch Throwable e
+ (log/error (color/red exception-message (or (.getMessage e) e) "\n"
+ (pprint-to-str (filtered-stacktrace e))))))))))
+
+(defn try-apply
+ "Like `apply`, but wraps F inside a `try-catch` block and logs exceptions caught."
+ [^clojure.lang.IFn f & args]
+ (apply (wrap-try-catch f) args))
+
+(defn wrap-try-catch!
+ "Re-intern FN-SYMB as a new fn that wraps the original with a `try-catch`. Intended for debugging.
+
+ (defn z [] (throw (Exception. \"!\")))
+ (z) ; -> exception
+
+ (wrap-try-catch! 'z)
+ (z) ; -> nil; exception logged with log/error"
+ [fn-symb]
+ {:pre [(symbol? fn-symb)
+ (fn? @(resolve fn-symb))]}
+ (let [varr (resolve fn-symb)
+ {nmspc :ns, symb :name} (meta varr)]
+ (println (format "wrap-try-catch! %s/%s" nmspc symb))
+ (intern nmspc symb (wrap-try-catch @varr fn-symb))))
+
+(defn ns-wrap-try-catch!
+ "Re-intern all functions in NAMESPACE as ones that wrap the originals with a `try-catch`.
+ Defaults to the current namespace. You may optionally exclude a set of symbols using the kwarg `:exclude`.
+
+ (ns-wrap-try-catch!)
+ (ns-wrap-try-catch! 'metabase.driver)
+ (ns-wrap-try-catch! 'metabase.driver :exclude 'query-complete)
+
+ Intended for debugging."
+ {:arglists '([namespace? :exclude & excluded-symbs])}
+ [& args]
+ (let [[nmspc args] (optional #(try-apply the-ns [%]) args *ns*)
+ excluded (when (= (first args) :exclude)
+ (set (rest args)))]
+ (doseq [[symb varr] (ns-interns nmspc)]
+ (when (fn? @varr)
+ (when-not (contains? excluded symb)
+ (wrap-try-catch! (symbol (str (ns-name nmspc) \/ symb))))))))
+
+(defn deref-with-timeout
+ "Call `deref` on a FUTURE and throw an exception if it takes more than TIMEOUT-MS."
+ [futur timeout-ms]
+ (let [result (deref futur timeout-ms ::timeout)]
+ (when (= result ::timeout)
+ (throw (Exception. (format "Timed out after %d milliseconds." timeout-ms))))
+ result))
(defmacro with-timeout
"Run BODY in a `future` and throw an exception if it fails to complete after TIMEOUT-MS."
[timeout-ms & body]
- `(let [future# (future ~@body)
- result# (deref future# ~timeout-ms :timeout)]
- (when (= result# :timeout)
- (throw (Exception. (format "Timed out after %d milliseconds." ~timeout-ms))))
- result#))
+ `(deref-with-timeout (future ~@body) ~timeout-ms))
(defmacro cond-as->
"Anaphoric version of `cond->`. Binds EXPR to NAME through a series
diff --git a/src/metabase/util/logic.clj b/src/metabase/util/logic.clj
deleted file mode 100644
index 1acdb153a9c394e4405b8715ee79747db21563eb..0000000000000000000000000000000000000000
--- a/src/metabase/util/logic.clj
+++ /dev/null
@@ -1,61 +0,0 @@
-(ns metabase.util.logic
- "Useful relations for `core.logic`."
- (:refer-clojure :exclude [==])
- (:require [clojure.core.logic :refer :all]))
-
-(defna butlast°
- "A relation such that BUSTLASTV is all items but the last item LASTV of list L."
- [butlastv lastv l]
- ([[] ?x [?x]])
- ([_ _ [?x . ?more]] (fresh [more-butlast]
- (butlast° more-butlast lastv ?more)
- (conso ?x more-butlast butlastv))))
-
-(defna split°
- "A relation such that HALF1 and HALF2 are even divisions of list L.
- If L has an odd number of items, HALF1 will have one more item than HALF2."
- [half1 half2 l]
- ([[] [] []])
- ([[?x] [] [?x]])
- ([[?x] [?y] [?x ?y]])
- ([[?x ?y . ?more-half1-butlast] [?more-half1-last . ?more-half2] [?x ?y . ?more]]
- (fresh [more-half1]
- (split° more-half1 ?more-half2 ?more)
- (butlast° ?more-half1-butlast ?more-half1-last more-half1))))
-
-(defn sorted-into°
- "A relation such that OUT is the list L with V sorted into it doing comparisons with PRED-F."
- [pred-f l v out]
- (matche [l]
- ([[]] (== out [v]))
- ([[?x . ?more]] (conda
- ((pred-f v ?x) (conso v (lcons ?x ?more) out))
- (s# (fresh [more]
- (sorted-into° pred-f ?more v more)
- (conso ?x more out)))))))
-
-(defna sorted-permutation°
- "A relation such that OUT is a permutation of L where all items are sorted by PRED-F."
- [pred-f l out]
- ([_ [] []])
- ([_ [?x . ?more] _] (fresh [more]
- (sorted-permutation° pred-f ?more more)
- (sorted-into° pred-f more ?x out))))
-
-(defn matches-seq-order°
- "A relation such that V1 is present and comes before V2 in list L."
- [v1 v2 l]
- (conda
- ;; This is just an optimization for cases where L isn't a logic var; it's much faster <3
- ((nonlvaro l) ((fn -ordered° [[item & more]]
- (conda
- ((== v1 item) s#)
- ((== v2 item) fail)
- ((when (seq more) s#) (-ordered° more))))
- l))
- (s# (conda
- ((firsto l v1))
- ((firsto l v2) fail)
- ((fresh [more]
- (resto l more)
- (matches-seq-order° v1 v2 more)))))))
diff --git a/test/metabase/driver/query_processor_test.clj b/test/metabase/driver/query_processor_test.clj
index afcf729fb6cc11a3174da9bcb2255c788e9058e0..6136414b384f194a4a7de5875094f80ee4b2c20d 100644
--- a/test/metabase/driver/query_processor_test.clj
+++ b/test/metabase/driver/query_processor_test.clj
@@ -1304,3 +1304,39 @@
:aggregation ["count"]
:filter ["TIME_INTERVAL" (id :checkins :timestamp) "last" "week"]}})
:data :rows first first)))
+
+;; Make sure that when referencing the same field multiple times with different units we return the one
+;; that actually reflects the units the results are in.
+;; eg when we breakout by one unit and filter by another, make sure the results and the col info
+;; use the unit used by breakout
+(defn- date-bucketing-unit-when-you [& {:keys [breakout-by filter-by]}]
+ (with-temp-db [_ (checkins:1-per-day)]
+ (let [results (driver/process-query
+ {:database (db-id)
+ :type :query
+ :query {:source_table (id :checkins)
+ :aggregation ["count"]
+ :breakout [["datetime_field" (id :checkins :timestamp) "as" breakout-by]]
+ :filter ["TIME_INTERVAL" (id :checkins :timestamp) "current" filter-by]}})]
+ {:rows (-> results :row_count)
+ :unit (-> results :data :cols first :unit)})))
+
+(datasets/expect-with-datasets sql-engines
+ {:rows 1, :unit :day}
+ (date-bucketing-unit-when-you :breakout-by "day", :filter-by "day"))
+
+(datasets/expect-with-datasets sql-engines
+ {:rows 7, :unit :day}
+ (date-bucketing-unit-when-you :breakout-by "day", :filter-by "week"))
+
+(datasets/expect-with-datasets sql-engines
+ {:rows 1, :unit :week}
+ (date-bucketing-unit-when-you :breakout-by "week", :filter-by "day"))
+
+(datasets/expect-with-datasets sql-engines
+ {:rows 1, :unit :quarter}
+ (date-bucketing-unit-when-you :breakout-by "quarter", :filter-by "day"))
+
+(datasets/expect-with-datasets sql-engines
+ {:rows 1, :unit :hour}
+ (date-bucketing-unit-when-you :breakout-by "hour", :filter-by "day"))