WIP

.dir-locals.el

@@ -4,6 +4,8 @@
                             (put 'defannotation 'clojure-doc-string-elt 2)
                             (put 'defendpoint 'clojure-doc-string-elt 3)
                             (put 'defhook 'clojure-doc-string-elt 2)
+                            (put 'defna 'clojure-doc-string-elt 2)
+                            (put 'defne 'clojure-doc-string-elt 2)
                             (put 'defsetting 'clojure-doc-string-elt 2)
 
                             ;; Define custom indentation for functions inside metabase.
@@ -34,7 +36,9 @@
                               (let-500 1)
                               (match 1)
                               (match-$ 1)
+                              (matcha 1)
                               (matche 1)
+                              (matchu 1)
                               (macrolet 1)
                               (org-perms-case 1)
                               (pdoseq 1)

src/metabase/driver/query_processor/annotate.clj

@@ -8,7 +8,8 @@
             [metabase.driver.query-processor.expand :as expand]
             (metabase.models [field :refer [Field], :as field]
                              [foreign-key :refer [ForeignKey]])
-            [metabase.util :as u]))
+            [metabase.util :as u]
+            [metabase.util.logic :refer :all]))
 
 ;; Fields should be returned in the following order:
 ;; 1.  Breakout Fields
@@ -144,52 +145,38 @@
           ((!= k name-2) (when (seq more)
                            (name< more))))) (:result-keys query)))))
 
-(defn- fpredo [pred f v1 v2]
-  "Succeds if `(pred & fresh-values)` succeeds, where fresh values
-   are obtained with calls to F like `(f value fresh-value)`."
-  (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)))
+(defn- clause-position< [query]
+  (let [groupo          (field-groupo query)
+        breakout-fields (flatten-collect-fields (:breakout query))
+        fields-fields   (flatten-collect-fields (:fields query))]
+  (fn [f1 f2]
+    (fresh [field-group]
+      (groupo f1 field-group)
+      (conda
+       ((== field-group (field-groups :breakout)) (matches-seq-ordero f1 f2 breakout-fields))
+       (s#                                        (matches-seq-ordero f1 f2 fields-fields)))))))
 
 (defn- ar-< [x y]
   (ar/< x y))
 
-(defmacro ^:private fpred-conda [[f & values] & clauses]
-  `(conda
-    ~@(for [[pred & body] clauses]
-        `((fpredo ~pred ~f ~@values) ~@body))))
-
 (defn- fields< [query]
-  (let [groupo (field-groupo query)
-        name<  (field-name< query)]
+  (let [groupo      (field-groupo query)
+        name<       (field-name< query)
+        clause-pos< (clause-position< query)]
     (fn [f1 f2]
-      (fpred-conda [groupo f1 f2]
-        (ar-< s#)
-        (==  (fpred-conda [positiono f1 f2]
-               (ar-< s#)
-               (== (fpred-conda [groupo f1 f2]
-                     (ar-< s#) ; TODO - sort by sequential position for fields + breakout
-                     (== (fpred-conda [special-typeo f1 f2]
-                           (ar-< s#)
-                           (== (name< f1 f2))))))))))))
-
-(defn- sorted-intoo [pred l v out]
-  (matche [l]
-    ([[]]           (== out [v]))
-    ([[?x . ?more]] (conda
-                     ((pred v ?x) (== out (lcons v (lcons ?x ?more)))) ; TODO - binary search would be faster :sunglasses:
-                     (s#          (fresh [more]
-                                    (sorted-intoo pred ?more v more)
-                                    (== out (lcons ?x more))))))))
-
-(defn- sorted-permutationo [pred l out]
-  (matche [l]
-    ([[]]           (== out []))
-    ([[?x . ?more]] (fresh [more]
-                      (sorted-permutationo pred ?more more)
-                      (sorted-intoo pred more ?x out)))))
+      (all
+       (trace-lvars "*" f1 f2)
+       (fpred-conda [groupo f1 f2]
+         (ar-< (do (println "SORTED BECAUSE GROUP <") s#))
+         (==  (fpred-conda [positiono f1 f2]
+                (ar-< (do (println "SORTED BECAUSE POSITION <") s#))
+                (== (fresh [group]
+                      (groupo f1 group)
+                      (conda
+                       ((== group (field-groups :other)) (fpred-conda [special-typeo f1 f2]
+                                                           (ar-< (do (println "SORTED BECAUSE SPECIAL TYPE GROUP <") s#))
+                                                           (== (name< f1 f2) (do (println "SORTED BECAUSE NAME <") s#))))
+                       (s#                               (clause-pos< f1 f2) (do (println "SORTED BECAUSE CLAUSE POS <") s#))))))))))))
 
 (defn- resolve+order-cols [{:keys [result-keys], :as query}]
   {:post [(sequential? %) (every? map? %)]}

src/metabase/util/logic.clj

+(ns metabase.util.logic
+  "Useful relations for `core.logic`."
+  (:refer-clojure :exclude [==])
+  (:require [clojure.core.logic :refer :all]))
+
+(defne butlasto
+  "A relation such that BUSTLAST is all items but the LAST of list L."
+  [butlast last l]
+  ([[]   ?x [?x]])
+  ([_    _  [?x . ?more]] (fresh [more-butlast]
+                            (butlasto more-butlast last ?more)
+                            (conso ?x more-butlast butlast))))
+
+(defna splito
+  "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]
+     (splito more-half1 ?more-half2 ?more)
+     (butlasto ?more-half1-butlast ?more-half1-last more-half1))))
+
+(defn sorted-intoo
+  "A relation such that OUT is the list L with V sorted into it doing comparisons with PRED."
+  [pred l v out]
+  (matche [l]
+    ([[]]           (== out [v]))
+    ([[?x . ?more]] (conda
+                     ((pred v ?x) (conso v (lcons ?x ?more) out))
+                     (s#          (fresh [more]
+                                    (sorted-intoo pred ?more v more)
+                                    (conso ?x more out)))))))
+
+(defna sorted-permutationo
+  "A relation such that OUT is a permutation of L where all items are sorted by PRED."
+  [pred l out]
+  ([_ [] []])
+  ([_ [?x . ?more] _] (fresh [more]
+                        (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)
+    (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]
+  ([_ _ [v1 . _]]    s#)
+  ([_ _ [v2 . _]]    fail)
+  ([_ _ [_ . ?more]] (matches-seq-ordero v1 v2 ?more)))