vector? (clj)

#_:clj-kondo/ignore
(ns app.common.data.macros
  "Data retrieval & manipulation specific macros."
  (:refer-clojure :exclude [get-in select-keys str with-open min max])
  #?(:cljs (:require-macros [app.common.data.macros]))
  (:require
   #?(:clj [clojure.core :as c]
      :cljs [cljs.core :as c])
   [app.common.data :as d]
   [cljs.analyzer.api :as aapi]
   [cuerdas.core :as str]))

  It is not 100% equivalent, this macro does not removes not existing
  keys in contrast to clojure.core/select-keys"
  [target keys]
  (assert (vector? keys) "keys expected to be a vector")
  `{~@(mapcat (fn [key] [key (list `c/get target key)]) keys) ~@[]})

(defmacro get-in
  "A macro version of `get-in`. Useful when the keys vector is known at
  compile time (20-40% performance improvement)."
  ([target keys]
   (assert (vector? keys) "keys expected to be a vector")
   `(-> ~target ~@(map (fn [key] (list `c/get key)) keys)))
  ([target keys default]
   (assert (vector? keys) "keys expected to be a vector")
   (let [last-index (dec (count keys))]
     `(-> ~target ~@(map-indexed (fn [index key]
                                   (if (= last-index index)
                                     (list `c/get key default)
                                     (list `c/get key)))
                                 keys)))))

(defmacro with-open
  [bindings & body]
  {:pre [(vector? bindings)
         (even? (count bindings))
         (pos? (count bindings))]}
  (reduce (fn [acc bindings]
            `(let ~(vec bindings)
               (try
                 ~acc
                 (finally
                   (d/close! ~(first bindings))))))
          `(do ~@body)
          (reverse (partition 2 bindings))))

(defmacro assert!
  ([expr]
   `(assert! nil ~expr))
  ([hint expr]
   (let [hint (cond
                (vector? hint)
                `(str/ffmt ~@hint)

(defmacro verify!
  ([expr]
   `(verify! nil ~expr))
  ([hint expr]
   (let [hint (cond
                (vector? hint)
                `(str/ffmt ~@hint)

(ns clojure.core.typed.test.poly-record
  (:require [clojure.core.typed :as t]))

      ;polymorphic
      (defrecord> [[x :variance :covariant]]
        FooP [a :- x,
              b :- Number]
        Object
        (toString [this] \"\"))"
  [& args]
  (let [vbnd (when (vector? (first args))
               (first args))
        args (if vbnd
               (next args)
               args)
        [nme fields & args] args]
    `(do (ann-record
           ~@(concat (when vbnd
                       [vbnd])
                     nme
                     fields))
         (defrecord ~nme ~(mapv first (partition 3 fields))
           ~@args))))
  )

(ns next.jdbc-test
  "Basic tests for the primary API of `next.jdbc`."
  (:require [clojure.core.reducers :as r]
            [clojure.string :as str]
            [clojure.test :refer [deftest is testing use-fixtures]]
            [next.jdbc :as jdbc]
            [next.jdbc.connection :as c]
            [next.jdbc.test-fixtures
             :refer [with-test-db db ds column
                     default-options stored-proc?
                     derby? hsqldb? jtds? mssql? mysql? postgres? sqlite?]]
            [next.jdbc.prepare :as prep]
            [next.jdbc.result-set :as rs]
            [next.jdbc.specs :as specs]
            [next.jdbc.types :as types])
  (:import (com.zaxxer.hikari HikariDataSource)
           (com.mchange.v2.c3p0 ComboPooledDataSource PooledDataSource)
           (java.sql ResultSet ResultSetMetaData)))

(deftest basic-tests
  ;; use ds-opts instead of (ds) anywhere you want default options applied:
  (let [ds-opts (jdbc/with-options (ds) (default-options))]
    (testing "plan"
      (is (= "Apple"
             (reduce (fn [_ row] (reduced (:name row)))
                     nil
                     (jdbc/plan
                      ds-opts
                      ["select * from fruit where appearance = ?" "red"]))))
      (is (= "Banana"
             (reduce (fn [_ row] (reduced (:no-such-column row "Banana")))
                     nil
                     (jdbc/plan
                      ds-opts
                      ["select * from fruit where appearance = ?" "red"])))))
    (testing "execute-one!"
      (is (nil? (jdbc/execute-one!
                 (ds)
                 ["select * from fruit where appearance = ?" "neon-green"])))
      (is (= "Apple" ((column :FRUIT/NAME)
                      (jdbc/execute-one!
                       ds-opts
                       ["select * from fruit where appearance = ?" "red"]))))
      (is (= "red" (:fruit/looks-like
                    (jdbc/execute-one!
                     ds-opts
                     ["select appearance as looks_like from fruit where id = ?" 1]
                     jdbc/snake-kebab-opts))))
      (let [ds' (jdbc/with-options ds-opts jdbc/snake-kebab-opts)]
        (is (= "red" (:fruit/looks-like
                      (jdbc/execute-one!
                       ds'
                       ["select appearance as looks_like from fruit where id = ?" 1])))))
      (jdbc/with-transaction+options [ds' (jdbc/with-options ds-opts jdbc/snake-kebab-opts)]
        (is (= (merge (default-options) jdbc/snake-kebab-opts)
               (:options ds')))
        (is (= "red" (:fruit/looks-like
                      (jdbc/execute-one!
                       ds'
                       ["select appearance as looks_like from fruit where id = ?" 1])))))
      (is (= "red" (:looks-like
                    (jdbc/execute-one!
                     ds-opts
                     ["select appearance as looks_like from fruit where id = ?" 1]
                     jdbc/unqualified-snake-kebab-opts)))))
    (testing "execute!"
      (let [rs (jdbc/execute!
                ds-opts
                ["select * from fruit where appearance = ?" "neon-green"])]
        (is (vector? rs))
        (is (= [] rs)))
      (let [rs (jdbc/execute!
                ds-opts
                ["select * from fruit where appearance = ?" "red"])]
        (is (= 1 (count rs)))
        (is (= 1 ((column :FRUIT/ID) (first rs)))))
      (let [rs (jdbc/execute!
                ds-opts
                ["select * from fruit order by id"]
                {:builder-fn rs/as-maps})]
        (is (every? map? rs))
        (is (every? meta rs))
        (is (= 4 (count rs)))
        (is (= 1 ((column :FRUIT/ID) (first rs))))
        (is (= 4 ((column :FRUIT/ID) (last rs)))))
      (let [rs (jdbc/execute!
                ds-opts
                ["select * from fruit order by id"]
                {:builder-fn rs/as-arrays})]
        (is (every? vector? rs))
        (is (= 5 (count rs)))
        (is (every? #(= 5 (count %)) rs))
        ;; columns come first
        (is (every? qualified-keyword? (first rs)))
        ;; :FRUIT/ID should be first column
        (is (= (column :FRUIT/ID) (ffirst rs)))
        ;; and all its corresponding values should be ints
        (is (every? int? (map first (rest rs))))
        (is (every? string? (map second (rest rs))))))
    (testing "execute! with adapter"
      (let [rs (jdbc/execute! ; test again, with adapter and lower columns
                ds-opts
                ["select * from fruit order by id"]
                {:builder-fn (rs/as-arrays-adapter
                              rs/as-lower-arrays
                              (fn [^ResultSet rs _ ^Integer i]
                                (.getObject rs i)))})]
        (is (every? vector? rs))
        (is (= 5 (count rs)))
        (is (every? #(= 5 (count %)) rs))
        ;; columns come first
        (is (every? qualified-keyword? (first rs)))
        ;; :fruit/id should be first column
        (is (= :fruit/id (ffirst rs)))
        ;; and all its corresponding values should be ints
        (is (every? int? (map first (rest rs))))
        (is (every? string? (map second (rest rs))))))
    (testing "execute! with unqualified"
      (let [rs (jdbc/execute!
                (ds)
                ["select * from fruit order by id"]
                {:builder-fn rs/as-unqualified-maps})]
        (is (every? map? rs))
        (is (every? meta rs))
        (is (= 4 (count rs)))
        (is (= 1 ((column :ID) (first rs))))
        (is (= 4 ((column :ID) (last rs)))))
      (let [rs (jdbc/execute!
                ds-opts
                ["select * from fruit order by id"]
                {:builder-fn rs/as-unqualified-arrays})]
        (is (every? vector? rs))
        (is (= 5 (count rs)))
        (is (every? #(= 5 (count %)) rs))
        ;; columns come first
        (is (every? simple-keyword? (first rs)))
        ;; :ID should be first column
        (is (= (column :ID) (ffirst rs)))
        ;; and all its corresponding values should be ints
        (is (every? int? (map first (rest rs))))
        (is (every? string? (map second (rest rs))))))
    (testing "execute! with :max-rows / :maxRows"
      (let [rs (jdbc/execute!
                ds-opts
                ["select * from fruit order by id"]
                {:max-rows 2})]
        (is (every? map? rs))
        (is (every? meta rs))
        (is (= 2 (count rs)))
        (is (= 1 ((column :FRUIT/ID) (first rs))))
        (is (= 2 ((column :FRUIT/ID) (last rs)))))
      (let [rs (jdbc/execute!
                ds-opts
                ["select * from fruit order by id"]
                {:statement {:maxRows 2}})]
        (is (every? map? rs))
        (is (every? meta rs))
        (is (= 2 (count rs)))
        (is (= 1 ((column :FRUIT/ID) (first rs))))
        (is (= 2 ((column :FRUIT/ID) (last rs)))))))
  (testing "prepare"
    ;; default options do not flow over get-connection
    (let [rs (with-open [con (jdbc/get-connection (ds))
                         ps  (jdbc/prepare
                              con
                              ["select * from fruit order by id"]
                              (default-options))]
                 (jdbc/execute! ps))]
      (is (every? map? rs))
      (is (every? meta rs))
      (is (= 4 (count rs)))
      (is (= 1 ((column :FRUIT/ID) (first rs))))
      (is (= 4 ((column :FRUIT/ID) (last rs)))))
    ;; default options do not flow over get-connection
    (let [rs (with-open [con (jdbc/get-connection (ds))
                         ps  (jdbc/prepare
                              con
                              ["select * from fruit where id = ?"]
                              (default-options))]
                 (jdbc/execute! (prep/set-parameters ps [4]) nil {}))]
      (is (every? map? rs))
      (is (every? meta rs))
      (is (= 1 (count rs)))
      (is (= 4 ((column :FRUIT/ID) (first rs))))))
  (testing "statement"
    ;; default options do not flow over get-connection
    (let [rs (with-open [con (jdbc/get-connection (ds))]
               (jdbc/execute! (prep/statement con (default-options))
                              ["select * from fruit order by id"]))]
      (is (every? map? rs))
      (is (every? meta rs))
      (is (= 4 (count rs)))
      (is (= 1 ((column :FRUIT/ID) (first rs))))
      (is (= 4 ((column :FRUIT/ID) (last rs)))))
    ;; default options do not flow over get-connection
    (let [rs (with-open [con (jdbc/get-connection (ds))]
               (jdbc/execute! (prep/statement con (default-options))
                              ["select * from fruit where id = 4"]))]
      (is (every? map? rs))
      (is (every? meta rs))
      (is (= 1 (count rs)))
      (is (= 4 ((column :FRUIT/ID) (first rs))))))
  (testing "transact"
    (is (= [{:next.jdbc/update-count 1}]
           (jdbc/transact (ds)
                          (fn [t] (jdbc/execute! t ["
INSERT INTO fruit (name, appearance, cost, grade)
VALUES ('Pear', 'green', 49, 47)
"]))
                          {:rollback-only true})))
    (is (= 4 (count (jdbc/execute! (ds) ["select * from fruit"])))))
  (testing "with-transaction rollback-only"
    (is (not (jdbc/active-tx?)) "should not be in a transaction")
    (is (= [{:next.jdbc/update-count 1}]
           (jdbc/with-transaction [t (ds) {:rollback-only true}]
             (is (jdbc/active-tx?) "should be in a transaction")
             (jdbc/execute! t ["
INSERT INTO fruit (name, appearance, cost, grade)
VALUES ('Pear', 'green', 49, 47)
"]))))
    (is (= 4 (count (jdbc/execute! (ds) ["select * from fruit"]))))
    (is (not (jdbc/active-tx?)) "should not be in a transaction")
    (with-open [con (jdbc/get-connection (ds))]
      (let [ac (.getAutoCommit con)]
        (is (= [{:next.jdbc/update-count 1}]
               (jdbc/with-transaction [t con {:rollback-only true}]
                 (is (jdbc/active-tx?) "should be in a transaction")
                 (jdbc/execute! t ["
INSERT INTO fruit (name, appearance, cost, grade)
VALUES ('Pear', 'green', 49, 47)
"]))))
        (is (= 4 (count (jdbc/execute! con ["select * from fruit"]))))
        (is (= ac (.getAutoCommit con))))))
  (testing "with-transaction exception"
    (is (thrown? Throwable
           (jdbc/with-transaction [t (ds)]
             (jdbc/execute! t ["
INSERT INTO fruit (name, appearance, cost, grade)
VALUES ('Pear', 'green', 49, 47)
"])
             (is (jdbc/active-tx?) "should be in a transaction")
             (throw (ex-info "abort" {})))))
    (is (= 4 (count (jdbc/execute! (ds) ["select * from fruit"]))))
    (is (not (jdbc/active-tx?)) "should not be in a transaction")
    (with-open [con (jdbc/get-connection (ds))]
      (let [ac (.getAutoCommit con)]
        (is (thrown? Throwable
               (jdbc/with-transaction [t con]
                 (jdbc/execute! t ["
INSERT INTO fruit (name, appearance, cost, grade)
VALUES ('Pear', 'green', 49, 47)
"])
                 (is (jdbc/active-tx?) "should be in a transaction")
                 (throw (ex-info "abort" {})))))
        (is (= 4 (count (jdbc/execute! con ["select * from fruit"]))))
        (is (= ac (.getAutoCommit con))))))
  (testing "with-transaction call rollback"
    (is (= [{:next.jdbc/update-count 1}]
           (jdbc/with-transaction [t (ds)]
             (let [result (jdbc/execute! t ["
INSERT INTO fruit (name, appearance, cost, grade)
VALUES ('Pear', 'green', 49, 47)
"])]
               (.rollback t)
               ;; still in a next.jdbc TX even tho' we rolled back!
               (is (jdbc/active-tx?) "should be in a transaction")
               result))))
    (is (= 4 (count (jdbc/execute! (ds) ["select * from fruit"]))))
    (is (not (jdbc/active-tx?)) "should not be in a transaction")
    (with-open [con (jdbc/get-connection (ds))]
      (let [ac (.getAutoCommit con)]
        (is (= [{:next.jdbc/update-count 1}]
               (jdbc/with-transaction [t con]
                 (let [result (jdbc/execute! t ["
INSERT INTO fruit (name, appearance, cost, grade)
VALUES ('Pear', 'green', 49, 47)
"])]
                   (.rollback t)
                   result))))
        (is (= 4 (count (jdbc/execute! con ["select * from fruit"]))))
        (is (= ac (.getAutoCommit con))))))
  (testing "with-transaction with unnamed save point"
    (is (= [{:next.jdbc/update-count 1}]
           (jdbc/with-transaction [t (ds)]
             (let [save-point (.setSavepoint t)
                   result (jdbc/execute! t ["
INSERT INTO fruit (name, appearance, cost, grade)
VALUES ('Pear', 'green', 49, 47)
"])]
               (.rollback t save-point)
               ;; still in a next.jdbc TX even tho' we rolled back to a save point!
               (is (jdbc/active-tx?) "should be in a transaction")
               result))))
    (is (= 4 (count (jdbc/execute! (ds) ["select * from fruit"]))))
    (is (not (jdbc/active-tx?)) "should not be in a transaction")
    (with-open [con (jdbc/get-connection (ds))]
      (let [ac (.getAutoCommit con)]
        (is (= [{:next.jdbc/update-count 1}]
               (jdbc/with-transaction [t con]
                 (let [save-point (.setSavepoint t)
                       result (jdbc/execute! t ["
INSERT INTO fruit (name, appearance, cost, grade)
VALUES ('Pear', 'green', 49, 47)
"])]
                   (.rollback t save-point)
                   result))))
        (is (= 4 (count (jdbc/execute! con ["select * from fruit"]))))
        (is (= ac (.getAutoCommit con))))))
  (testing "with-transaction with named save point"
    (is (= [{:next.jdbc/update-count 1}]
           (jdbc/with-transaction [t (ds)]
             (let [save-point (.setSavepoint t (name (gensym)))
                   result (jdbc/execute! t ["
INSERT INTO fruit (name, appearance, cost, grade)
VALUES ('Pear', 'green', 49, 47)
"])]
               (.rollback t save-point)
               result))))
    (is (= 4 (count (jdbc/execute! (ds) ["select * from fruit"]))))
    (with-open [con (jdbc/get-connection (ds))]
      (let [ac (.getAutoCommit con)]
        (is (= [{:next.jdbc/update-count 1}]
               (jdbc/with-transaction [t con]
                 (let [save-point (.setSavepoint t (name (gensym)))
                       result (jdbc/execute! t ["
INSERT INTO fruit (name, appearance, cost, grade)
VALUES ('Pear', 'green', 49, 47)
"])]
                   (.rollback t save-point)
                   result))))
        (is (= 4 (count (jdbc/execute! con ["select * from fruit"]))))
        (is (= ac (.getAutoCommit con)))))))

   WARNING: because they lack efficient indexed access, sequences will perform badly for most
   array operations. In general they should be converted to other implementations before use."
  (:require [clojure.core.matrix.protocols :as mp]
            [clojure.core.matrix.implementations :as imp]
    #?(:clj [clojure.core.matrix.macros :refer [scalar-coerce error]]))
  #?(:clj (:import [clojure.lang ISeq])
     :cljs (:require-macros [clojure.core.matrix.macros :refer [scalar-coerce error]])))

(extend-protocol mp/PDimensionInfo
  ISeq
    (dimensionality [m]
      (inc (mp/dimensionality (first m))))
    (is-vector? [m]
      (== 0 (mp/dimensionality (first m))))
    (is-scalar? [m]
      false)
    (get-shape [m]
      #?(:cljs (js/console.log (str "shape of seq: " m)))
      (cons (count m) (mp/get-shape (first m))))
    (dimension-count [m x]
      (if (== x 0)
        (count m)
        (mp/dimension-count (first m) (dec x)))))

(ns typed.clojure.jvm
  "JVM-specific annotations and operations.
  See typed.clojure for cross-platform ops."
  (:require clojure.core.typed
            [clojure.core.typed.current-impl :as impl]
            [clojure.core.typed.internal :refer [take-when]]
            [typed.cljc.runtime.env-utils :refer [delay-type]]
            [clojure.core.typed.macros :as macros]))

(defmacro override-class [& args]
  (let [[binder args] (take-when vector? args)
        [nme args] (take-when symbol? args)
        _ (assert (symbol? nme) (str "Missing name in override-class" [nme args]))
        [opts args] (take-when map? args)
        opts (if opts
               (do (assert (empty? args) (str "Trailing args to override-class: " (pr-str args)))
                   opts)
               (apply hash-map args))
        this-ns (ns-name *ns*)]
    `(clojure.core.typed/tc-ignore
       (let [nme# (or (when-some [^Class c# (ns-resolve '~this-ns '~nme)]
                        (when (class? c#)
                          (-> c# .getName symbol)))
                      (throw (ex-info (str "Could not resolve class: " '~nme) {:class-name '~nme})))]
          ;; TODO runtime env
         #_
         (impl/add-rclass-env nme# {:op :RClass})
         ;; type env
         ;inline when-bindable-defining-ns
         (macros/when-bindable-defining-ns '~this-ns
           (impl/with-clojure-impl
             (impl/add-rclass nme# (delay-type
                                     ((requiring-resolve 'typed.clj.checker.parse-unparse/with-parse-ns*)
                                      '~this-ns
                                      #((requiring-resolve 'typed.cljc.checker.base-env-helper/make-RClass)
                                        nme#
                                        '~binder
                                        '~opts))))))))))