Back
reduced (clj)
(source)function
(reduced x)
Wraps x in a way such that a reduce will terminate with the value x
Examples
clojure
(ns clojure.test-clojure.reducers
(:require [clojure.core.reducers :as r]
[clojure.test.generative :refer (defspec)]
[clojure.data.generators :as gen])
(:use clojure.test))
(deftest test-mapcat-obeys-reduced
(is (= [1 "0" 2 "1" 3]
(->> (concat (range 100) (lazy-seq (throw (Exception. "Too eager"))))
(r/mapcat (juxt inc str))
(r/take 5)
(into [])))))
(deftest test-sorted-maps
(let [m (into (sorted-map)
'{1 a, 2 b, 3 c, 4 d})]
(is (= "1a2b3c4d" (reduce-kv str "" m))
"Sorted maps should reduce-kv in sorted order")
(is (= 1 (reduce-kv (fn [acc k v]
(reduced (+ acc k)))
0 m))
"Sorted maps should stop reduction when asked")))
(defn reduced-at-probe
[m p]
(reduce-kv (fn [_ k v] (when (== p k) (reduced :foo))) nil m))
(defspec reduced-always-returns
(fn [probe to-end]
(let [len (+ probe to-end 1)
nums (range len)
m (zipmap nums nums)]
(reduced-at-probe m probe)))
[^{:tag `gen-num} probe ^{:tag `gen-num} to-end]
(assert (= :foo %)))
seancorfield/next-jdbc
(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)))))))
typedclojure/typedclojure
(ns ^:no-doc typed.ann.clojure
"Type annotations for the base Clojure distribution."
#?(:cljs (:require-macros [typed.ann-macros.clojure :as macros]))
(:require [clojure.core :as cc]
[typed.clojure :as t]
#?(:clj [typed.ann-macros.clojure :as macros])
#?(:clj typed.ann.clojure.jvm) ;; jvm annotations
#?(:clj clojure.core.typed))
#?(:clj
(:import (clojure.lang PersistentHashSet PersistentList
APersistentMap #_IPersistentCollection
#_ITransientSet
IRef)
(java.util Comparator Collection))))
(t/defalias
^{:doc "A reduced value of type x."
:forms '[(t/Reduced x)]}
t/Reduced
(t/TFn [[x :variance :covariant]]
#?(:clj (clojure.lang.Reduced x)
:cljs (cljs.core/Reduced x))))
cc/reduce (t/All [a c] (t/IFn
;Without accumulator
; default
; (reduce + my-coll)
[[a a :-> (t/U (t/Reduced a) a)] (t/NonEmptySeqable a) :-> a]
[(t/IFn [a a :-> (t/U (t/Reduced a) a)] [:-> a]) (t/Seqable a) :-> a]
; default
; (reduce + 3 my-coll)
; (reduce (fn [a b] a) (reduced 1) nil)
; ;=> (reduced 1)
[[a c :-> (t/U (t/Reduced a) a)] a (t/Seqable c) :-> a]))
cc/transduce (t/All [a b c] (t/IFn [(t/Transducer a a) (t/Reducer a a) (t/Seqable a) :-> a]
[(t/Transducer b c) (t/IFn [c :-> c] [c a :-> (t/U c (t/Reduced c))]) a (t/Seqable b) :-> a]))
cc/reduce-kv (t/All [a k v] [[a k v :-> (t/U (t/Reduced a) a)] a (t/Option (t/Associative k v)) :-> a])
cc/reductions (t/All [a b] (t/IFn [[a a :-> (t/U (t/Reduced a) a)] (t/NonEmptySeqable a) :-> (t/NonEmptyASeq a)]
[(t/IFn [:-> a] [a a :-> (t/U (t/Reduced a) a)]) (t/Seqable a) :-> (t/NonEmptyASeq a)]
[[a b :-> (t/U (t/Reduced a) a)] a (t/Seqable b) :-> (t/NonEmptyASeq a)]))
cc/reduced (t/All [x] [x :-> (t/Reduced x)])
cc/unreduced (t/All [x] (t/IFn [(t/Reduced x) :-> x]
[(t/U x (t/Reduced x)) :-> x]))
cc/ensure-reduced (t/All [x] [(t/U x (t/Reduced x)) :-> (t/Reduced x)])
cc/completing (t/All [a b] [(t/IFn [:-> b] [b a :-> (t/U b (t/Reduced b))])
[b :-> b]
:-> (t/Reducer a b)])
typedclojure/typedclojure
(ns typed-test.spec.clojure.core
(:require [typed.spec.clojure.core :as api]
[clojure.alpha.spec :as s]
[clojure.alpha.spec.gen :as gen]
[clojure.alpha.spec.test :as stest]
[typed.clj.spec :as t]
[typed.clj.spec.test-utils :as tu]
[clojure.test :refer :all]))
;; reduced-spec
(deftest reduced-spec-test
(doseq [v (gen/sample
(s/gen (api/reduced-spec integer?)))]
(assert (reduced? v) v)
(is (integer? @v) v))
(tu/is-valid (api/reduced-spec integer?) (reduced 1))
(tu/is-invalid (api/reduced-spec symbol?) (reduced 1))
(tu/is-valid (s/or :reduced (api/reduced-spec integer?)
:integer integer?)
(reduced 1))
(tu/is-invalid (s/or :reduced (api/reduced-spec integer?)
:integer integer?)
(gensym))
(tu/is-invalid (api/reduced-spec integer?)
(gensym))
(is (apply
(every-pred
reduced?
(comp integer? deref))
(gen/sample
(s/gen (api/reduced-spec integer?)))))
)
typedclojure/typedclojure
(ns clojure.core.typed.test.symbolic-closures
(:require
[typed.clojure :as t]
[typed.clj.checker.test-utils :refer [is-tc-e is-tc-err tc-e is-tc-err-messages]]
[typed.clj.checker.parse-unparse :refer [parse-clj]]
[clojure.core.typed.util-vars :as vs]
[typed.cljc.checker.type-rep :as r]
[clojure.test :refer [deftest is]]))
(deftest reduce-test
(is-tc-e (reduce (fn [a :- t/Int, b :- t/Int] (+ a b)) 0 [1])
t/Int)
;; (All [a c] [[a c :-> (t/U (t/Reduced a) a)] a (t/Seqable c) :-> a])
(binding [vs/*verbose-types* true]
(is-tc-e (fn [reduce :- (t/All [a] [[a a :-> a] (t/NonEmptySeqable a) :-> a])]
;:- t/Int
(reduce (fn [a b] (+ a b)) [1]))))
(is-tc-e (reduce (fn [a b] (+ a b)) [1]))
(is-tc-e (reduce (fn [a b] (+ a b)) [1]) Long)
(is-tc-e (reduce (fn [a b]
(reduce + a b))
1 [[1]]))
(is-tc-err (reduce (fn [a b] (+ a b)) [1]) (t/Val 1))
(is-tc-e (reduce (fn [a b] (+ a (if b 1 2))) 1 [true]))
(is-tc-err (reduce (fn [a b] a) (reduced 1) nil) t/Int)
(is-tc-e (reduce (fn [a b] a) (reduced 1) nil) (t/Reduced t/Int))
#_;;FIXME just like the previous case except adds Long to the result type
(is-tc-e (let [res (reduce (fn [a b] a) (reduced 1) nil)]
(t/ann-form res (t/Reduced t/Int))))
)
videlalvaro/clochure
[ns clojure.test-clojure.reducers
[:require (clojure.core.reducers :as r)]
[:use clojure.test]]
[deftest test-sorted-maps
[let (m [into [sorted-map]
'{1 a, 2 b, 3 c, 4 d}])
[is [= "1a2b3c4d" [reduce-kv str "" m]]
"Sorted maps should reduce-kv in sorted order"]
[is [= 1 [reduce-kv [fn (acc k v)
[reduced [+ acc k]]]
0 m]]
"Sorted maps should stop reduction when asked"]]]