Added sample project, base component to reproduce polyfy/polylith#261

.gitignore

@@ -37,3 +37,5 @@ projects/**/pom.xml
 
 # Calva VS Code Extension
 .calva/output-window/output.calva-repl
+
+.portal

bases/issue-261/deps.edn

@@ -0,0 +1,4 @@
+{:paths ["src" "resources"]
+ :deps {poly/sqldb {:local/root "../components/sqldb"}}
+ :aliases {:test {:extra-paths ["test"]
+                  :extra-deps {}}}}

bases/issue-261/resources/issue-261/.keep

@@ -0,0 +1 @@
+

bases/issue-261/src/poly_rcf/rcf/issue_261/core.clj

@@ -0,0 +1 @@
+(ns poly-rcf.rcf.issue-261.core)

bases/issue-261/test/poly_rcf/rcf/issue_261/core_test.clj

@@ -0,0 +1,6 @@
+(ns poly-rcf.rcf.issue-261.core-test
+  (:require [clojure.test :as test :refer :all]
+            [poly-rcf.rcf.issue-261.core :as core]))
+
+(deftest dummy-test
+  (is (= 1 1)))

bases/rcf/src/poly_rcf/rcf/config.clj

@@ -0,0 +1,8 @@
+(ns poly-rcf.rcf.config)
+;; A master configuration file.
+;; Can be overriden with configuration files down in the classpath,
+;; environment variables, and system properties
+
+{:dre {}
+ :sentry {:dsn ""
+          :environment ""}}

components/sqldb/deps.edn

@@ -0,0 +1,9 @@
+{:paths ["src" "resources"]
+ :deps {com.github.seancorfield/next.jdbc        {:mvn/version "1.3.874"}
+        com.github.seancorfield/honeysql         {:mvn/version "2.4.1026"}
+        com.zaxxer/HikariCP                      {:mvn/version "5.0.1"
+                                                  :exclusions [org.slf4j/slf4j-api]}
+        org.clojure/tools.logging                {:mvn/version "1.2.4"}}
+ :aliases {:test {:extra-paths ["test" "src"] ;; Adding src makes poly tool discover RCF tests under src/
+                  :extra-deps {com.h2database/h2 {:mvn/version "2.1.214"}
+                               com.stuartsierra/component {:mvn/version "1.1.0"}}}}}

components/sqldb/resources/sqldb/.keep

@@ -0,0 +1 @@
+

components/sqldb/src/poly_rcf/rcf/sqldb/core.clj

@@ -0,0 +1,211 @@
+;; Copyright (C) 2022, Doctor Evidence. All rights reserved.
+
+(ns poly-rcf.rcf.sqldb.core
+  "SQL DB client impl."
+  {:authors ["Jozef Wagner"]}
+  (:require [hugsql.adapter :as adapter]
+            [hugsql.adapter.next-jdbc :as next-jdbc-adapter]
+            [hugsql.core :as hugsql]
+            [next.jdbc :as jdbc]
+            [next.jdbc.connection :as connection]
+            [next.jdbc.result-set :as rs]
+            [next.jdbc.transaction :as transaction]
+            [clojure.tools.logging :refer [info warn trace]])
+  (:import [com.zaxxer.hikari HikariDataSource]))
+
+
+;;; HikariCP
+
+;;; HugSQL
+
+(defn get-connection
+  [sqlconn]
+  (or (:hikari-datasource sqlconn) sqlconn))
+
+(defn strip-update-count
+  [result]
+  (if (and (seqable? result)
+           (= 1 (count result))
+           (empty? (dissoc (first result) :next.jdbc/update-count))
+           (integer? (:next.jdbc/update-count (first result))))
+    [(:next.jdbc/update-count (first result))]
+    result))
+
+(deftype HugsqlAdapterSqldb [child-adapter]
+  adapter/HugsqlAdapter
+  (execute [this sqlconn sqlvec options]
+    (adapter/execute child-adapter (get-connection sqlconn) sqlvec options))
+  (query [this sqlconn sqlvec options]
+    (strip-update-count
+     (adapter/query child-adapter (get-connection sqlconn) sqlvec options)))
+  (result-one [this result options]
+    (first (strip-update-count [(adapter/result-one child-adapter result options)])))
+  (result-many [this result options]
+    (strip-update-count (adapter/result-many child-adapter result options)))
+  (result-affected [this result options]
+    (adapter/result-affected child-adapter result options))
+  (result-raw [this result options]
+    (strip-update-count (adapter/result-raw child-adapter result options)))
+  (on-exception [this exception]
+    (adapter/on-exception child-adapter exception)))
+
+(defn hugsql-adapter-sqldb
+  ([]
+   (hugsql-adapter-sqldb {}))
+  ([default-command-options]
+   (->HugsqlAdapterSqldb
+    (next-jdbc-adapter/hugsql-adapter-next-jdbc default-command-options))))
+
+;;; SQLDB
+
+(deftype SqlReduce [sqlconn query params query-timeout fetch-size ptf]
+  clojure.lang.IReduce
+  (reduce [this f]
+    (.reduce ^clojure.lang.IReduceInit this f (f)))
+  clojure.lang.IReduceInit
+  (reduce [this f init]
+    (trace "DB: reducing sql query" query params)
+    #_(when-let [span (apm/current-apm-span)]
+        (apm/set-label span "sqldb-query" (str query))
+        (apm/set-label span "sqldb-params" (str params)))
+    (binding [transaction/*nested-tx* :ignore]
+      (jdbc/with-transaction [tx (get-connection sqlconn) {}]
+        (let [ptf (or ptf #(rs/datafiable-row % tx {}))
+              opts {:fetch-size fetch-size
+                    :timeout query-timeout
+                    :result-type :forward-only
+                    :concurrency :read-only
+                    :builder-fn rs/as-unqualified-lower-maps}
+              sql-params (cons query params)
+              plan (jdbc/plan tx sql-params opts)]
+          (reduce f init (eduction (map ptf) plan)))))))
+
+(defn query
+  "Returns a reducible collection of query results. sql-params may be
+  a query string or a collection of query and params.
+  Supported opts are:
+  :sqldb/query-timeout - timeout in s; default as defined by driver
+  :sqldb/fetch-size - passed to jdbc; defaults to 1000
+  :sqldb/ptf - row transformation function that'll be called
+               in parallel; defaults to sequential processing and
+               no additional transformation."
+  [conn sql-params opts]
+  (let [{:keys [:sqldb/query-timeout :sqldb/fetch-size :sqldb/ptf]} opts
+        fetch-size (or fetch-size 1000)
+        query (if (string? sql-params) sql-params (first sql-params))
+        params (when-not (string? sql-params) (rest sql-params))]
+    (->SqlReduce conn query params query-timeout fetch-size ptf)))
+
+(defn query-eager
+  "Returns a reducible collection of query results. sql-params may be
+  a query string or a collection of query and params.
+
+  Supported opts are:
+  :sqldb/query-timeout - timeout in s; default as defined by driver
+  :sqldb/fetch-size - passed to jdbc; defaults to 1000
+  :sqldb/ptf - row transformation function that'll be called
+               in parallel; defaults to sequential processing and
+               no additional transformation."
+  [sqlconn sql-params opts]
+  (let [{:keys [:sqldb/query-timeout :sqldb/fetch-size :sqldb/ptf]} opts
+        fetch-size (or fetch-size 1000)
+        query (if (string? sql-params) sql-params (first sql-params))
+        params (when-not (string? sql-params) (rest sql-params))
+        sql-params (cons query params)
+        opts (merge opts
+                    {:fetch-size fetch-size
+                     :timeout query-timeout
+                     :result-type :forward-only
+                     :concurrency :read-only
+                     :builder-fn rs/as-unqualified-lower-maps})
+        conn (get-connection sqlconn)
+        ptf (or ptf #(rs/datafiable-row % conn {}))]
+    (eduction (map ptf) (jdbc/plan conn sql-params opts))))
+
+(defn execute!
+  "Performs execute operation.
+
+  Supported opts are:
+  :sqldb/query-timeout - timeout in s; default as defined by driver"
+  [sqlconn sql-params opts]
+  (let [{:keys [:sqldb/query-timeout]} opts
+        query (if (string? sql-params) sql-params (first sql-params))
+        params (when-not (string? sql-params) (rest sql-params))
+        opts (merge opts
+                    {:timeout query-timeout
+                     :builder-fn rs/as-unqualified-lower-maps})
+        sql-params (into [query] params)
+        conn (get-connection sqlconn)]
+    (jdbc/execute! conn sql-params opts)))
+
+
+;;; System Component
+
+(defn start-component
+  [new-sqldb]
+  (info "Create component with db" new-sqldb)
+  (let [db-spec (:db-spec new-sqldb)
+        hugsql-opts (:hugsql-opts new-sqldb)
+        hikari-datasource (connection/->pool HikariDataSource db-spec)]
+    (hugsql/set-adapter! (hugsql-adapter-sqldb hugsql-opts))
+    (assoc new-sqldb
+           :hikari-datasource hikari-datasource)))
+
+(defn stop-component
+  [sqldb]
+  (when-let [^HikariDataSource ds (:hikari-datasource sqldb)]
+    (when-not (.isClosed ds)
+      (.close ds)))
+  (dissoc sqldb :hikari-datasource))
+
+(defn suspend-component
+  [sqldb]
+  (info "Suspending SQLDB component")
+  sqldb)
+
+(defn resume-component
+  [_new-sqldb suspended-sqldb]
+  ;; TODO: Proper reconnect when cfg changes
+  (info "Resuming SQLDB component")
+  suspended-sqldb)
+
+(defn new-component
+  "Returns new sqldb system component."
+  [cfg tag]
+  (let [db-config (get-in cfg [:dre tag])]
+    (-> db-config
+        (with-meta {'com.stuartsierra.component/start start-component
+                    'com.stuartsierra.component/stop stop-component
+                    'suspendable.core/suspend suspend-component
+                    'suspendable.core/resume resume-component}))))
+
+(comment
+
+  (set! *warn-on-reflection* true)
+
+  (def SQLDB
+    (-> {:dre {:db {:maximum-pool-size 10
+                    :connection-timeout 30000
+                    :idle-timeout 600000
+                    :validation-timeout 5000
+                    :max-lifetime 1800000
+                    :jdbc "jdbc:postgresql://db:5432/docsearch?user=docsearch&password=docsearch"}}}
+        (new-component nil)
+        start-component))
+
+  (let [q "select * from articles_stats"
+        opts {:sqldb/ptf #(let [{:keys [:source :category :count]} %]
+                            (warn "info" source category)
+                            (nn-hash-map
+                             :source source
+                             :category category
+                             :count count))}]
+    (try
+      (vec (eduction (take 2) (query SQLDB q opts)))
+      (catch org.postgresql.util.PSQLException e
+        (warn "Article stats materialized view was not refreshed" e)
+        {})))
+
+  (execute! SQLDB ["insert into file_activity(file_name, source) values (?, ?) returning id;"
+                   "file123" "sourcetest"]
+            {}))

components/sqldb/src/poly_rcf/rcf/sqldb/interface.clj

@@ -0,0 +1 @@
+(ns poly-rcf.rcf.sqldb.interface)

components/sqldb/test/poly_rcf/rcf/sqldb/interface_test.clj

@@ -0,0 +1,35 @@
+(ns poly-rcf.rcf.sqldb.interface-test
+  (:require [clojure.set :as set]
+            [clojure.test :as test :refer :all]
+            [clojure.tools.logging :as log]
+            [com.stuartsierra.component :as component]
+            [next.jdbc :as jdbc]
+            [next.jdbc.result-set :as rs]
+            [poly-rcf.rcf.sqldb.interface :as sqldb]))
+
+;; This fails because of https://github.com/polyfy/polylith/issues/261
+(deftest new-component-test
+  "Test component works by starting a system and running a query."
+  (let [config {:dre {:test {:db-spec {:maximum-pool-size 10
+                                       :connection-timeout 30000
+                                       :idle-timeout 600000
+                                       :validation-timeout 5000
+                                       :max-lifetime 1800000
+                                       :jdbcUrl "jdbc:h2:mem:semmed"}}}}
+        sys (component/system-map
+             :sqldb (sqldb/new-component config :test))
+        s (component/start-system sys)
+        sqldb (:sqldb s)
+        data-source (:hikari-datasource sqldb)
+        _ (log/info "datasource" sqldb)
+        ;; read table metadata
+        d (with-open [con (jdbc/get-connection data-source)]
+            (-> (.getMetaData con) ; produces java.sql.DatabaseMetaData
+                (.getTables nil nil nil (into-array ["TABLE" "VIEW"]))
+                (rs/datafiable-result-set con)))
+        some-tables #{"CONSTANTS" "ENUM_VALUES" "INDEXES"
+                      "INDEX_COLUMNS" "INFORMATION_SCHEMA_CATALOG_NAME"}
+        all-tables (into #{} (map :TABLE_NAME d))]
+              ;; test that some tables are present in metadata
+    (is (true? (set/subset? some-tables all-tables)))
+    (component/stop-system s)))

deps.edn

@@ -1,18 +1,21 @@
 {:aliases  {:dev {:extra-paths ["development/src"]
-                  :extra-deps {
-                               ;; bases
+                  :extra-deps {;; bases
                                poly/rcf {:local/root "bases/rcf"}
-
+                               poly/issue-261 {:local/root "bases/issue-261"}
+                               ;; components
+                               poly/sqldb {:local/root "components/sqldb"}
+
                                org.clojure/clojure {:mvn/version "1.11.1"}}}
 
             :test {:extra-paths ["bases/rcf/test"
-                                 "projects/rcf/test"]}
+                                 "projects/rcf/test"
+                                 "bases/issue-261/test"]}
 
             :poly {:main-opts ["-m" "polylith.clj.core.poly-cli.core"]
                    :jvm-opts [;; Run RCF tests when loading files in REPL
                              ;; https://github.com/hyperfiddle/rcf#ci
                               "-Dhyperfiddle.rcf.generate-tests=true"]
                    :extra-deps {polyfy/polylith
                                 {:git/url   "https://github.com/polyfy/polylith"
-                                 :sha       "ccc261e60f6a875ff30858bf84cf67be105eac6f"
+                                 :sha       "a073b7c8dbea176a8cb39b3c4d7c3d465c99e946"
                                  :deps/root "projects/poly"}}}}}

projects/poly261/deps.edn

@@ -0,0 +1,8 @@
+{:deps {org.clojure/clojure {:mvn/version "1.11.1"}
+        org.clojure/tools.deps.alpha {:mvn/version "0.12.985"}
+
+        poly/issue-261 {:local/root "../bases/issue-261"}
+        poly/sqldb {:local/root "../components/sqldb"}}
+
+ :aliases {:test {:extra-paths ["test"]
+                  :extra-deps  {}}}}

workspace.edn

@@ -7,4 +7,5 @@
  :tag-patterns {:stable "stable-*"
                 :release "v[0-9]*"}
  :projects {"development" {:alias "dev"}
-            "rcf" {:alias "rcf"}}}
+            "rcf" {:alias "rcf"}
+            "poly261" {:alias "poly261"}}}