From 208ac021a063dff156fc579e8046b03320984bdd Mon Sep 17 00:00:00 2001
From: Daniel Ziltener <dziltener@lyrion.ch>
Date: Tue, 10 Mar 2020 02:02:40 +0100
Subject: [PATCH] Malli

---
 deps.edn                        |  1 +
 src/ch/lyrion/pgwiz.clj         |  9 ----
 src/ch/lyrion/pgwiz/inspect.clj | 87 ++++++++++++++++++++++++++++++++-
 3 files changed, 87 insertions(+), 10 deletions(-)

diff --git a/deps.edn b/deps.edn
index 0b6d975..d56b910 100644
--- a/deps.edn
+++ b/deps.edn
@@ -3,6 +3,7 @@
   org.clojure/core.async {:mvn/version "1.0.567"}
   org.postgresql/postgresql {:mvn/version "42.2.10"}
   seancorfield/next.jdbc {:mvn/version "1.0.395"}
+  tick {:mvn/version "0.4.23-alpha"}
   cljfx {:mvn/version "1.6.5"}
   org.openjfx/javafx-base {:mvn/version "13.0.2"}
   org.openjfx/javafx-controls {:mvn/version "13.0.2"}
diff --git a/src/ch/lyrion/pgwiz.clj b/src/ch/lyrion/pgwiz.clj
index ac130f9..cf04f36 100644
--- a/src/ch/lyrion/pgwiz.clj
+++ b/src/ch/lyrion/pgwiz.clj
@@ -38,15 +38,6 @@
                  :event-handler gui/event-handler
                  :desc-fn (fn [_] {:fx/type mainwindow})))
 
-#_(defonce renderer
-  (fx/create-renderer
-   :middleware (comp
-                fx/wrap-context-desc
-                (fx/wrap-map-desc (fn [_] {:fx/type sampletable})))
-   :opts {:fx.opt/type->lifecycle #(or (fx/keyword->lifecycle %)
-                                       (fx/fn->lifecycle-with-context %))
-          :fx.opt/map-event-handler event-handler}))
-
 (when *compile-files*
   (Thread/sleep 1500)
   (javafx.application.Platform/exit))
diff --git a/src/ch/lyrion/pgwiz/inspect.clj b/src/ch/lyrion/pgwiz/inspect.clj
index e3f594d..3d38835 100644
--- a/src/ch/lyrion/pgwiz/inspect.clj
+++ b/src/ch/lyrion/pgwiz/inspect.clj
@@ -1,5 +1,9 @@
 (ns ch.lyrion.pgwiz.inspect
-  (:require [next.jdbc :as jdbc]))
+  (:require [next.jdbc :as jdbc]
+            [next.jdbc.result-set :as resultset]
+            [malli.core :as m]
+            [malli.transform :as mt]
+            [tick.alpha.api :as t]))
 
 (def db {:dbtype "postgresql"
          :dbname "sompani-dev"
@@ -10,6 +14,8 @@
 
 (def conn (atom (jdbc/get-connection db)))
 
+;; Basics
+
 (defn get-named-rows [pg-result-set]
   (.next pg-result-set)
   (loop [pg-meta (.getMetaData pg-result-set)
@@ -42,3 +48,82 @@
 
 (defn get-columns [schema table]
   (get-named-rows (.getColumns (.getMetaData @conn) nil schema table nil)))
+
+;; Type checker
+(defn interval? [x]
+  (instance? org.postgresql.util.PGInterval x))
+
+(defn citext? [x]
+  (instance? org.postgresql.util.PGobject x))
+
+(def registry
+  (merge malli.core/default-registry
+         {'interval? (m/fn-schema :interval interval?)
+          'citext? (m/fn-schema :citext citext?)}))
+
+;; Type converter
+
+#_(defn PGInterval->JInterval [^org.postgresql.util.PGInterval interval]
+  (t/+ (t/new-duration (.getSeconds interval) :seconds)
+       (t/new-duration (.getMinutes interval) :minutes)
+       (t/new-duration (.getHours interval) :hours)
+       (t/new-duration (.getDays interval) :days)
+       (t/new-duration (.getMonths interval) :months)
+       (t/new-duration (.getYears interval) :years)))
+
+(defn citext->string [citext]
+  (str citext))
+
+(def psql-decoders
+  {'citext? citext->string})
+
+(def psql-encoders
+  {'citext? identity
+   'uuid? identity
+   'inst? identity})
+
+(defn psql-transformer []
+  (mt/transformer
+   {:name :psql
+    :decoders (merge mt/+string-decoders+ psql-decoders)
+    :encoders (merge mt/+string-encoders+ psql-encoders)}))
+
+;; Map column generation
+
+(def typemapping
+  {"bool" :boolean
+   "text" :string
+   "citext" :citext
+   "serial" :long
+   "uuid" :uuid
+   "interval" :interval
+   "timestamp" :inst})
+
+(def checker-mapping
+  {:string 'string?
+   :citext 'citext?
+   :boolean 'boolean?
+   :long 'number?
+   :inst 'inst?
+   :uuid 'uuid?
+   :interval 'interval?})
+
+(defn gen-checker-mapping [type nullable?]
+  (if nullable?
+    [:or (get checker-mapping type) 'nil?]
+    (get checker-mapping type)))
+
+(defn gen-mapcol [{:keys [COLUMN_NAME TYPE_NAME IS_AUTOINCREMENT IS_NULLABLE]}]
+  (let [datatype (get typemapping TYPE_NAME)
+        nullable? (or (and (= IS_NULLABLE "YES") true) false)]
+    [(keyword COLUMN_NAME) {:nullable nullable?
+                            :autoincrement (or (and (= IS_AUTOINCREMENT "YES") true) false)
+                            :type datatype}
+     (gen-checker-mapping datatype nullable?)]))
+
+(defn gen-tableschema [schema table]
+  (reduce #(conj %1 (gen-mapcol %2))
+          [:map {:schema schema :table table}]
+          (get-columns schema table)))
+
+;; (m/explain (gen-tableschema "company" "vc") (jdbc/execute-one! @conn ["SELECT * FROM company.vc LIMIT 1"] {:builder-fn resultset/as-unqualified-lower-maps}))