more refactoring

src/metabase/driver/generic_sql/query_processor.clj

@@ -16,7 +16,9 @@
             [metabase.util :as u])
   (:import java.sql.Timestamp
            java.util.Date
-           (metabase.driver.query_processor.interface Field
+           (metabase.driver.query_processor.interface DateTimeField
+                                                      DateTimeValue
+                                                      Field
                                                       OrderByAggregateField
                                                       Value)))
 
@@ -101,13 +103,20 @@
   (formatted
     ([this]
      (formatted this false))
-    ([{:keys [table-name base-type special-type field-name], :as field} include-as?]
-     (let [kw-name (keyword (str table-name \. field-name))
-           field   (cond
-                     (contains? #{:DateField :DateTimeField} base-type) (cast-as-date kw-name)
-                     (= special-type :timestamp_seconds)                (cast-as-date (i/unix-timestamp->timestamp (:driver *query*) kw-name :seconds))
-                     (= special-type :timestamp_milliseconds)           (cast-as-date (i/unix-timestamp->timestamp (:driver *query*) kw-name :milliseconds))
-                     :else                                              kw-name)]
+    ([{:keys [table-name special-type field-name], :as field} include-as?]
+     (let [->timestamp (partial i/unix-timestamp->timestamp (:driver *query*))
+           field       (cond-> (keyword (str table-name \. field-name))
+                         (= special-type :timestamp_seconds)      (->timestamp :seconds)
+                         (= special-type :timestamp_milliseconds) (->timestamp :milliseconds))]
+       (if include-as? [field (keyword field-name)]
+           field))))
+
+  DateTimeField
+  (formatted
+    ([this]
+     (formatted this false))
+    ([{unit :unit, {:keys [field-name base-type special-type], :as field} :field} include-as?]
+     (let [field (cast-as-date (formatted field))]
        (if include-as? [field (keyword field-name)]
            field))))
 
@@ -129,11 +138,18 @@
   (formatted
     ([this]
      (formatted this false))
-    ([{:keys [value base-type]} _]
-     (cond
-       (instance? Timestamp value) (cast-as-date `(Timestamp/valueOf ~(.toString value))) ; prevent Clojure from converting this to #inst literal, which is a util.date
-       (= base-type :UUIDField)    (java.util.UUID/fromString value)
-       :else                       value))))
+    ([{value :value, {:keys [base-type]} :field} _]
+     (if (= base-type :UUIDField)
+       (java.util.UUID/fromString value)
+       value)))
+
+  DateTimeValue
+  (formatted
+    ([this]
+     (formatted this false))
+    ([{:keys [value]} _]
+     ;; prevent Clojure from converting this to #inst literal, which is a util.date
+     (cast-as-date `(Timestamp/valueOf ~(.toString value))))))
 
 
 (defmethod apply-form :aggregation [[_ {:keys [aggregation-type field]}]]

src/metabase/driver/query_processor/expand.clj

@@ -68,18 +68,7 @@
     ["fk->" (fk-field-id :guard integer?) (dest-field-id :guard integer?)] true
     _                                                                      false))
 
-(defn- parse-value
-  "Convert the `value` of a `Value` to a date or timestamp if needed.
-   The original `YYYY-MM-DD` string date is retained under the key `:original-value`."
-  [{:keys [value base-type special-type] :as qp-value}]
-  (assoc qp-value
-         :original-value value
-         ;; Since Value *doesn't* revert to YYYY-MM-DD when collapsing make sure we're not parsing it twice
-         :value (or (when (and (string? value)
-                               (or (contains? #{:DateField :DateTimeField} base-type)
-                                   (contains? #{:timestamp_seconds :timestamp_milliseconds} special-type)))
-                      (u/parse-iso8601 value))
-                    value)))
+
 
 (defn- ph
   "Create a new placeholder object for a Field ID or value that can be resolved later."
@@ -95,7 +84,7 @@
 
       _ (throw (Exception. (str "Invalid field: " field-id))))))
   ([field-id value]
-   (->ValuePlaceholder (:field-id (ph field-id)) value)))
+   (->ValuePlaceholder (ph field-id) value)))
 
 
 

src/metabase/driver/query_processor/interface.clj

@@ -2,7 +2,8 @@
   "Definitions of `Field`, `Value`, and other record types present in an expanded query.
    This namespace should just contain definitions of various protocols and record types; associated logic
    should go in `metabase.driver.query-processor.expand`."
-  (:import clojure.lang.Keyword))
+  (:import clojure.lang.Keyword
+           java.sql.Timestamp))
 
 ;; Expansion Happens in a Few Stages:
 ;; 1. A query dict is parsed via pattern-matching code in the Query Expander.
@@ -52,24 +53,29 @@
             [table-name])
           field-name)))
 
+;; wrapper around Field
+(defrecord DateTimeField [^Field   field
+                          ^Keyword unit])
+
 ;; Value is the expansion of a value within a QL clause
 ;; Information about the associated Field is included for convenience
-(defrecord Value [value              ; e.g. parsed Date / timestamp
-                  ^Keyword base-type
-                  ^Keyword special-type
-                  ^Integer field-id
-                  ^String  field-name])
+(defrecord Value [value
+                  ^Field field])
+
+(defrecord DateTimeValue [^Timestamp value
+                          ^DateTimeField field])
 
 
 ;;; # ------------------------------------------------------------ PLACEHOLDER TYPES: FIELDPLACEHOLDER + VALUEPLACEHOLDER ------------------------------------------------------------
 
 ;; Replace Field IDs with these during first pass
 (defrecord FieldPlaceholder [^Integer field-id
-                             ^Integer fk-field-id]) ;
+                             ^Integer fk-field-id
+                             ^Keyword datetime-unit])
 
 ;; Replace values with these during first pass over Query.
 ;; Include associated Field ID so appropriate the info can be found during Field resolution
-(defrecord ValuePlaceholder [^Integer field-id
+(defrecord ValuePlaceholder [^FieldPlaceholder field-placeholder
                              value])
 
 

src/metabase/driver/query_processor/parse.clj

+(ns metabase.driver.query-processor.parse
+  "Logic relating to parsing values associated with different Query Processor `Field` types."
+  (:require [metabase.driver.query-processor.interface :refer :all]
+            [metabase.util :as u])
+  (:import (metabase.driver.query_processor.interface DateTimeField
+                                                      Field)))
+
+(defmulti parse-value (fn [field value]
+                        (class field)))
+
+(defmethod parse-value Field [field value]
+  (map->Value {:field field
+               :value value}))
+
+(defmethod parse-value DateTimeField [field value]
+  (try (let [value (u/parse-iso8601 value)]
+         (map->DateTimeValue {:value value
+                              :field field}))
+       (catch Throwable _
+         (throw (Exception. "Invalid value '%s': expected a DateTime.")))))

src/metabase/driver/query_processor/resolve.clj

@@ -6,7 +6,8 @@
             [medley.core :as m]
             [swiss.arrows :refer [-<>]]
             [metabase.db :refer [sel]]
-            [metabase.driver.query-processor.interface :refer :all]
+            (metabase.driver.query-processor [interface :refer :all]
+                                             [parse :as parse])
             (metabase.models [database :refer [Database]]
                              [field :as field]
                              [foreign-key :refer [ForeignKey]]
@@ -29,84 +30,85 @@
                           :table_id        :table-id
                           :parent_id       :parent-id}))
 
-;;; # ------------------------------------------------------------ IRESOLVE PROTOCOL (INTERNAL) ------------------------------------------------------------
-
-(defprotocol IResolve
-  "Methods called during `Field` and `Table` resolution. Placeholder types should implement this protocol."
-  (unresolved-field-id [this]
-    "Return the unresolved Field ID associated with this object, if any.")
-  (fk-field-id [this]
-    "Return a the FK Field ID (for joining) associated with this object, if any.")
-  (resolve-field [this field-id->fields]
-    "This method is called when walking the Query after fetching `Fields`.
-     Placeholder objects should lookup the relevant Field in FIELD-ID->FIELDS and
-     return their expanded form. Other objects should just return themselves.")
-  (resolve-table [this table-id->tables]
-    "Called when walking the Query after `Fields` have been resolved and `Tables` have been fetched.
-     Objects like `Fields` can add relevant information like the name of their `Table`."))
-
-(extend Object
-  IResolve {:unresolved-field-id (constantly nil)
-            :fk-field-id         (constantly nil)
-            :resolve-field       (fn [this _] this)
-            :resolve-table       (fn [this _] this)})
-
-(extend nil
-  IResolve {:unresolved-field-id (constantly nil)
-            :fk-field-id         (constantly nil)
-            :resolve-field       (constantly nil)
-            :resolve-table       (constantly nil)})
-
-(extend-protocol IResolve
-  Field
-  (unresolved-field-id [{:keys [parent parent-id]}]
-    (or (unresolved-field-id parent)
-        parent-id))
-
-  (fk-field-id [_] nil)
-
-  (resolve-field [{:keys [parent parent-id], :as this} field-id->fields]
-    (cond
-      parent    (if (= (type parent) Field)
-                  this
-                  (resolve-field parent field-id->fields))
-      parent-id (assoc this :parent (or (field-id->fields parent-id)
-                                        (map->FieldPlaceholder {:field-id parent-id})))
-      :else     this))
-
-  (resolve-table [{:keys [table-id], :as this} table-id->table]
-    (assoc this :table-name (:name (or (table-id->table table-id)
-                                       (throw (Exception. (format "Query expansion failed: could not find table %d." table-id)))))))
-
-
-  FieldPlaceholder
-  (unresolved-field-id [{:keys [field-id]}]
-    field-id)
+;;; # ------------------------------------------------------------ MULTIMETHODS - INTERNAL ------------------------------------------------------------
 
-  (fk-field-id [{:keys [fk-field-id]}]
-    fk-field-id)
+;; Return the unresolved Field ID associated with this object, if any.
+(defmulti unresolved-field-id class)
 
-  (resolve-field [this field-id->fields]
-    (or
-     ;; try to resolve the Field with the ones available in field-id->fields
-     (some->> (field-id->fields (:field-id this))
-              (merge (select-keys this [:value]))
-              map->Field)
-     ;; If that fails just return ourselves as-is
-     this))
+(defmethod unresolved-field-id :default [_]
+  nil)
 
+;; Return a the FK Field ID (for joining) associated with this object, if any.
+(defmulti fk-field-id class)
 
-  ValuePlaceholder
-  (unresolved-field-id [{:keys [field-id]}]
-    field-id)
+(defmethod fk-field-id :default [_]
+  nil)
+
+;; This method is called when walking the Query after fetching `Fields`.
+;; Placeholder objects should lookup the relevant Field in FIELD-ID->FIELDS and
+;; return their expanded form. Other objects should just return themselves.
+(defmulti resolve-field (fn [this field-id->fields]
+                          (class this)))
+
+(defmethod resolve-field :default [this _]
+  this)
+
+;; Called when walking the Query after `Fields` have been resolved and `Tables` have been fetched.
+;; Objects like `Fields` can add relevant information like the name of their `Table`.
+(defmulti resolve-table (fn [this table-id->tables]
+                          (class this)))
+
+(defmethod resolve-table :default [this _]
+  this)
 
-  (fk-field-id [_] nil)
 
-  (resolve-field [this field-id->fields]
-    (let [resolved-field (field-id->fields (:field-id this))]
-      (when-not resolved-field
-        (throw (Exception. (format "Unable to resolve field: %d" (:field-id this)))))
-      (map->Value (merge this (select-keys resolved-field [:base-type :special-type :field-id :field-name]))))))
+;; ## Field
+(defmethod unresolved-field-id Field [{:keys [parent parent-id]}]
+  (or (unresolved-field-id parent)
+      parent-id))
+
+(defmethod resolve-field Field [{:keys [parent parent-id], :as this} field-id->fields]
+  (cond
+    parent    (if (= (type parent) Field)
+                this
+                (resolve-field parent field-id->fields))
+    parent-id (assoc this :parent (or (field-id->fields parent-id)
+                                      (map->FieldPlaceholder {:field-id parent-id})))
+    :else     this))
+
+(defmethod resolve-table Field [{:keys [table-id], :as this} table-id->table]
+  (assoc this :table-name (:name (or (table-id->table table-id)
+                                     (throw (Exception. (format "Query expansion failed: could not find table %d." table-id)))))))
+
+
+;; ## FieldPlaceholder
+(defmethod unresolved-field-id FieldPlaceholder [{:keys [field-id]}]
+    field-id)
+
+(defmethod fk-field-id FieldPlaceholder [{:keys [fk-field-id]}]
+  fk-field-id)
+
+(defmethod resolve-field FieldPlaceholder [{:keys [field-id, datetime-unit], :as this} field-id->fields]
+  (if-let [{:keys [base-type special-type], :as field} (some-> (field-id->fields field-id)
+                                                               map->Field)]
+    ;; try to resolve the Field with the ones available in field-id->fields
+    (let [datetime-field? (or datetime-unit
+                              (contains? #{:DateField :DateTimeField} base-type)
+                              (contains? #{:timestamp_seconds :timestamp_milliseconds} special-type))]
+      (if-not datetime-field?
+        field
+        (map->DateTimeField {:field field
+                             :unit  (or datetime-unit :day)})))
+    ;; If that fails just return ourselves as-is
+    this))
+
+
+;; ## ValuePlaceholder
+(defmethod resolve-field ValuePlaceholder [{:keys [field-placeholder value], :as this} field-id->fields]
+  (let [resolved-field (resolve-field field-placeholder field-id->fields)]
+    (when-not resolved-field
+      (throw (Exception. (format "Unable to resolve field: %s" field-placeholder))))
+    (parse/parse-value resolved-field value)))
 
 
 ;;; # ------------------------------------------------------------ IMPL ------------------------------------------------------------