Back
cat (clj)
(source)function
(cat rf)
A transducer which concatenates the contents of each input, which must be a
collection, into the reduction.
Examples
clojure
(deftest division
(is (= clojure.core// /))
(binding [*ns* *ns*]
(eval '(do (ns foo
(:require [clojure.core :as bar])
(:use [clojure.test]))
(is (= clojure.core// bar//))))))
(deftest Instants
(testing "Instants are read as java.util.Date by default"
(is (= java.util.Date (class #inst "2010-11-12T13:14:15.666"))))
(let [s "#inst \"2010-11-12T13:14:15.666-06:00\""]
(binding [*data-readers* {'inst read-instant-date}]
(testing "read-instant-date produces java.util.Date"
(is (= java.util.Date (class (read-string s)))))
(testing "java.util.Date instants round-trips"
(is (= (-> s read-string)
(-> s read-string pr-str read-string))))
(testing "java.util.Date instants round-trip throughout the year"
(doseq [month (range 1 13) day (range 1 29) hour (range 1 23)]
(let [s (format "#inst \"2010-%02d-%02dT%02d:14:15.666-06:00\"" month day hour)]
(is (= (-> s read-string)
(-> s read-string pr-str read-string))))))
(testing "java.util.Date handling DST in time zones"
(let [dtz (TimeZone/getDefault)]
(try
;; A timezone with DST in effect during 2010-11-12
(TimeZone/setDefault (TimeZone/getTimeZone "Australia/Sydney"))
(is (= (-> s read-string)
(-> s read-string pr-str read-string)))
(finally (TimeZone/setDefault dtz)))))
(testing "java.util.Date should always print in UTC"
(let [d (read-string s)
pstr (print-str d)
len (.length pstr)]
(is (= (subs pstr (- len 7)) "-00:00\"")))))
(binding [*data-readers* {'inst read-instant-calendar}]
(testing "read-instant-calendar produces java.util.Calendar"
(is (instance? java.util.Calendar (read-string s))))
(testing "java.util.Calendar round-trips"
(is (= (-> s read-string)
(-> s read-string pr-str read-string))))
(testing "java.util.Calendar remembers timezone in literal"
(is (= "#inst \"2010-11-12T13:14:15.666-06:00\""
(-> s read-string pr-str)))
(is (= (-> s read-string)
(-> s read-string pr-str read-string))))
(testing "java.util.Calendar preserves milliseconds"
(is (= 666 (-> s read-string
(.get java.util.Calendar/MILLISECOND)))))))
(let [s "#inst \"2010-11-12T13:14:15.123456789\""
s2 "#inst \"2010-11-12T13:14:15.123\""
s3 "#inst \"2010-11-12T13:14:15.123456789123\""]
(binding [*data-readers* {'inst read-instant-timestamp}]
(testing "read-instant-timestamp produces java.sql.Timestamp"
(is (= java.sql.Timestamp (class (read-string s)))))
(testing "java.sql.Timestamp preserves nanoseconds"
(is (= 123456789 (-> s read-string .getNanos)))
(is (= 123456789 (-> s read-string pr-str read-string .getNanos)))
;; truncate at nanos for s3
(is (= 123456789 (-> s3 read-string pr-str read-string .getNanos))))
(testing "java.sql.Timestamp should compare nanos"
(is (= (read-string s) (read-string s3)))
(is (not= (read-string s) (read-string s2)))))
(binding [*data-readers* {'inst read-instant-date}]
(testing "read-instant-date should truncate at milliseconds"
(is (= (read-string s) (read-string s2) (read-string s3))))))
(let [s "#inst \"2010-11-12T03:14:15.123+05:00\""
s2 "#inst \"2010-11-11T22:14:15.123Z\""]
(binding [*data-readers* {'inst read-instant-date}]
(testing "read-instant-date should convert to UTC"
(is (= (read-string s) (read-string s2)))))
(binding [*data-readers* {'inst read-instant-timestamp}]
(testing "read-instant-timestamp should convert to UTC"
(is (= (read-string s) (read-string s2)))))
(binding [*data-readers* {'inst read-instant-calendar}]
(testing "read-instant-calendar should preserve timezone"
(is (not= (read-string s) (read-string s2)))))))
(defn roundtrip
"Print an object and read it back. Returns rather than throws
any exceptions."
[o]
(binding [*print-length* nil
*print-dup* nil
*print-level* nil]
(try
(-> o pr-str read-string)
(catch Throwable t t))))
(defn roundtrip-dup
"Print an object with print-dup and read it back.
Returns rather than throws any exceptions."
[o]
(binding [*print-length* nil
*print-dup* true
*print-level* nil]
(try
(-> o pr-str read-string)
(catch Throwable t t))))
(deftest namespaced-map-errors
(are [err msg form] (thrown-with-msg? err msg (read-string form))
Exception #"Invalid token" "#:::"
Exception #"Namespaced map literal must contain an even number of forms" "#:s{1}"
Exception #"Namespaced map must specify a valid namespace" "#:s/t{1 2}"
Exception #"Unknown auto-resolved namespace alias" "#::BOGUS{1 2}"
Exception #"Namespaced map must specify a namespace" "#: s{:a 1}"
Exception #"Duplicate key: :user/a" "#::{:a 1 :a 2}"
Exception #"Duplicate key: user/a" "#::{a 1 a 2}"))
clojure
(ns clojure.test-clojure.server
(:import java.util.Random)
(:require [clojure.test :refer :all])
(:require [clojure.core.server :as s]))
(defn check-invalid-opts
[opts msg]
(try
(#'clojure.core.server/validate-opts opts)
(is nil)
(catch Exception e
(is (= (ex-data e) opts))
(is (= msg (.getMessage e))))))
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))
(defequivtest test-mapcat
[mapcat r/mapcat #(into [] %)]
[(fn [x] [x])
(fn [x] [x (inc x)])
(fn [x] [x (inc x) x])])
(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 [])))))
penpot/penpot
(ns app.main.ui.icons
(:require
[clojure.core :as c]
[cuerdas.core :as str]
[rumext.v2]))
(defmacro collect-icons
[]
(let [ns-info (:ns &env)]
`(cljs.core/js-obj
~@(->> (:defs ns-info)
(map val)
(filter (fn [entry] (-> entry :meta :icon)))
(mapcat (fn [{:keys [name] :as entry}]
[(-> name c/name str/camel str/capital) name]))))))
penpot/penpot
#_: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 str
[& params]
`(str/concat ~@params))
(defmacro check
"Applies a predicate to the value, if result is true, return the
value if not, returns nil."
[pred-fn value]
`(if (~pred-fn ~value)
~value
nil))
replikativ/datahike
(ns datahike.http.writer
"Remote writer implementation for datahike.http.server through datahike.http.client."
(:require [datahike.writer :refer [PWriter create-writer create-database delete-database]]
[datahike.http.client :refer [request-json] :as client]
[datahike.json :as json]
[datahike.tools :as dt :refer [throwable-promise]]
[taoensso.timbre :as log]
[clojure.core.async :refer [promise-chan put!]]))
(defrecord DatahikeServerWriter [remote-peer conn]
PWriter
(-dispatch! [_ arg-map]
(let [{:keys [op args]} arg-map
p (promise-chan)
config (:config @(:wrapped-atom conn))]
(log/debug "Sending operation to datahike-server:" op)
(log/trace "Arguments:" arg-map)
(put! p
(try
(request-json :post
(str op "-writer")
remote-peer
(vec (concat [config] args))
json/mapper)
(catch Exception e
e)))
p))
(-shutdown [_])
(-streaming? [_] false))
(defmethod create-database :datahike-server
[& args]
(let [p (throwable-promise)
{:keys [writer] :as config} (first args)]
;; redirect call to remote-peer as writer config
(deliver p (try (->
(request-json :post
"create-database-writer"
writer
(vec (concat [(-> config
(assoc :remote-peer writer)
(dissoc :writer))]
(rest args))))
(dissoc :remote-peer))
(catch Exception e
e)))
p))
(defmethod delete-database :datahike-server
[& args]
(let [p (throwable-promise)
{:keys [writer] :as config} (first args)]
;; redirect call to remote-peer as writer config
(deliver p (try
(-> (request-json :post
"delete-database-writer"
writer
(vec (concat [(-> config
(assoc :remote-peer writer)
(dissoc :writer))]
(rest args))))
(dissoc :remote-peer))
(catch Exception e
e)))
p))
arohner/spectrum
(ns spectrum.core-specs
(:require [clojure.core :as core]
[clojure.spec.alpha :as s]
[spectrum.core :as st]
[spectrum.types :as t]
[spectrum.util :refer [def-instance-predicate]]))
;;; specs for clojure.core fns, should only be used in cases where
;;; inference can't work, i.e. mostly on things that are built in,
;;; i.e. not defined in clojure source.
(def-instance-predicate namespace? clojure.lang.Namespace)
(s/fdef clojure.core/in-ns :args (s/cat :ns symbol?) :ret namespace?)
(s/fdef clojure.core/list :args (s/* any?) :ret list?)
hraberg/deuce
(ns deuce.emacs.category
(:use [deuce.emacs-lisp :only (defun defvar)])
(:require [clojure.core :as c]
[deuce.emacs.fns :as fns])
(:refer-clojure :exclude []))
(defvar word-separating-categories nil
"List of pair (cons) of categories to determine word boundary.
See the documentation of the variable `word-combining-categories'.")
(defvar word-combining-categories nil
"List of pair (cons) of categories to determine word boundary.
(1) The case that characters are in different scripts is controlled
by the variable `word-combining-categories'.
Emacs finds no word boundary between characters of different scripts
if they have categories matching some element of this list.
More precisely, if an element of this list is a cons of category CAT1
and CAT2, and a multibyte character C1 which has CAT1 is followed by
C2 which has CAT2, there's no word boundary between C1 and C2.
(2) The case that character are in the same script is controlled by
the variable `word-separating-categories'.
Emacs finds a word boundary between characters of the same script
if they have categories matching some element of this list.
More precisely, if an element of this list is a cons of category CAT1
and CAT2, and a multibyte character C1 which has CAT1 but not CAT2 is
followed by C2 which has CAT2 but not CAT1, there's a word boundary
between C1 and C2.
(fns/put 'category-table 'char-table-extra-slots 2)
(defun standard-category-table ()
"Return the standard category table.
This is the one used for new buffers."
)
(defun make-category-table ()
"Construct a new and empty category table and return it."
)
(defun copy-category-table (&optional table)
"Construct a new category table and return it.
It is a copy of the TABLE, which defaults to the standard category table."
)
(defun char-category-set (char)
"Return the category set of CHAR."
)
(defun make-category-set (categories)
"Return a newly created category-set which contains CATEGORIES.
CATEGORIES is a string of category mnemonics.
The value is a bool-vector which has t at the indices corresponding to
those categories."
)
(defun category-set-mnemonics (category-set)
"Return a string containing mnemonics of the categories in CATEGORY-SET.
CATEGORY-SET is a bool-vector, and the categories \"in\" it are those
that are indexes where t occurs in the bool-vector.
The return value is a string containing those same categories."
)
(defun set-category-table (table)
"Specify TABLE as the category table for the current buffer.
Return TABLE."
)
(defun category-table-p (arg)
"Return t if ARG is a category table."
)
(defun category-table ()
"Return the current category table.
This is the one specified by the current buffer."
)
(defun modify-category-entry (character category &optional table reset)
"Modify the category set of CHARACTER by adding CATEGORY to it.
The category is changed only for table TABLE, which defaults to
the current buffer's category table.
CHARACTER can be either a single character or a cons representing the
lower and upper ends of an inclusive character range to modify.
If optional fourth argument RESET is non-nil,
then delete CATEGORY from the category set instead of adding it."
)
(defun category-docstring (category &optional table)
"Return the documentation string of CATEGORY, as defined in TABLE.
TABLE should be a category table and defaults to the current buffer's
category table."
)
(defun define-category (category docstring &optional table)
"Define CATEGORY as a category which is described by DOCSTRING.
CATEGORY should be an ASCII printing character in the range ` ' to `~'.
DOCSTRING is the documentation string of the category. The first line
should be a terse text (preferably less than 16 characters),
and the rest lines should be the full description.
The category is defined only in category table TABLE, which defaults to
the current buffer's category table."
)
(defun get-unused-category (&optional table)
"Return a category which is not yet defined in TABLE.
If no category remains available, return nil.
The optional argument TABLE specifies which category table to modify;
it defaults to the current buffer's category table."
)