├── .travis.yml ├── .compatibility-test-config ├── RELEASING ├── test └── such │ ├── f_environment.clj │ ├── f_use_favorites.clj │ ├── f_use_types.clj │ ├── f_wrongness.clj │ ├── f_control_flow.clj │ ├── f_sequences.clj │ ├── f_symbols.clj │ ├── f_imperfection.clj │ ├── f_metadata.clj │ ├── f_immigration.clj │ ├── f_vars.clj │ ├── f_maps.clj │ ├── f_types.clj │ ├── f_shorthand.clj │ ├── f_ns_state.clj │ ├── f_ns.clj │ ├── f_casts.clj │ ├── f_wide_domains.clj │ ├── f_function_makers.clj │ ├── f_better_doc.clj │ ├── f_readable.clj │ └── f_relational.clj ├── src └── such │ ├── versions.clj │ ├── wide_domains.clj │ ├── random.clj │ ├── environment.clj │ ├── metadata.clj │ ├── types.clj │ ├── wrongness.clj │ ├── control_flow.clj │ ├── vars.clj │ ├── sequences.clj │ ├── symbols.clj │ ├── doc.clj │ ├── maps.clj │ ├── imperfection.clj │ ├── shorthand.clj │ ├── ns.clj │ ├── ns_state.clj │ ├── immigration.clj │ ├── function_makers.clj │ ├── casts.clj │ ├── readable.clj │ ├── better_doc.clj │ └── relational.clj ├── Rakefile ├── .gitignore ├── LICENSE ├── project.clj ├── README.md └── CHANGELOG.md /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | lein: lein 3 | script: lein travis 4 | sudo: false 5 | -------------------------------------------------------------------------------- /.compatibility-test-config: -------------------------------------------------------------------------------- 1 | (change-defaults :print-level :print-normally 2 | :visible-deprecation false 3 | :visible-future false) 4 | 5 | -------------------------------------------------------------------------------- /RELEASING: -------------------------------------------------------------------------------- 1 | * Bump version in project and readme and Changelog 2 | * lein ancient 3 | * lein compatibility 4 | * push 5 | * Check that readme and changelog look OK 6 | * rake doc 7 | * lein deploy 8 | * lein install 9 | -------------------------------------------------------------------------------- /test/such/f_environment.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-environment 2 | (:require [such.environment :as subject]) 3 | (:use midje.sweet)) 4 | 5 | (fact env 6 | (subject/env :home) => string? 7 | (subject/env :does-not-exist) => (throws)) 8 | 9 | (fact env-nil-ok 10 | (subject/env-nil-ok :home) => string? 11 | (subject/env-nil-ok :does-not-exist) => nil) 12 | 13 | 14 | -------------------------------------------------------------------------------- /test/such/f_use_favorites.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-use-favorites 2 | (:use such.f-immigration) 3 | (:use midje.sweet)) 4 | 5 | (fact 6 | (count-permutations [1 2 3]) => 6 7 | (permutations [1 2]) => [ [1 2] [2 1] ] 8 | 9 | (write-str [1 2]) => "[1,2]") 10 | 11 | (fact 12 | (subset? #{1} #{1 2}) => true) 13 | 14 | (fact 15 | (str-trim " f ") => "f") 16 | -------------------------------------------------------------------------------- /test/such/f_use_types.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-use-types 2 | "I expect types to be `:use`d (or, if you like a less readable way of doing the same thing, 3 | `:refer :all`)." 4 | (:use such.versions such.types) 5 | (:use midje.sweet)) 6 | 7 | (defrecord R [a]) 8 | 9 | (facts "so, for example..." 10 | (stringlike? "s") => true) 11 | 12 | 13 | (facts "don't override 1.6 version of `record?` (which would produce a warning message)" 14 | (record? (R. 1)) => true 15 | (record? (hash-map)) => false 16 | (record? (sorted-map)) => false 17 | (record? 1) => false) 18 | -------------------------------------------------------------------------------- /src/such/versions.clj: -------------------------------------------------------------------------------- 1 | (ns ^{:doc "Which version of Clojure am I running in?"} 2 | such.versions) 3 | 4 | (def ^:private minor (:minor *clojure-version*)) 5 | 6 | (defmacro when=1-6 [& body] 7 | (when (= minor 6) 8 | `(do ~@body))) 9 | 10 | (defmacro when>=1-7 [& body] 11 | (when (>= minor 7) 12 | `(do ~@body))) 13 | 14 | (defmacro when=1-7 [& body] 15 | (when (= minor 7) 16 | `(do ~@body))) 17 | 18 | (defmacro when>=1-8 [& body] 19 | (when (>= minor 8) 20 | `(do ~@body))) 21 | 22 | (defmacro when=1-8 [& body] 23 | (when (= minor 8) 24 | `(do ~@body))) 25 | -------------------------------------------------------------------------------- /test/such/f_wrongness.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-wrongness 2 | (:require [such.wrongness :as subject] 3 | [midje.sweet :refer :all])) 4 | 5 | (fact 6 | (try 7 | (subject/boom! "wow!") 8 | "fail" => true 9 | (catch Exception ex 10 | (.getMessage ex) => "wow!")) 11 | 12 | (try 13 | (subject/boom! "wow! %s" 5) 14 | "fail" => true 15 | (catch Exception ex 16 | (.getMessage ex) => "wow! 5")) 17 | 18 | (try 19 | (subject/boom! NumberFormatException "wow! %s" 5) 20 | "fail" => true 21 | (catch NumberFormatException ex 22 | (.getMessage ex) => "wow! 5"))) 23 | -------------------------------------------------------------------------------- /test/such/f_control_flow.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-control-flow 2 | (:require [such.control-flow :as subject] 3 | [midje.sweet :refer :all])) 4 | 5 | (facts "about let-maybe" 6 | (fact "often the same as `let`" 7 | (subject/let-maybe [] 3) => 3 8 | (subject/let-maybe [a 1] a) => 1 9 | (subject/let-maybe [a 1 10 | b (inc a)] 11 | (+ a b)) => 3) 12 | 13 | (fact "nil stops processing" 14 | (subject/let-maybe [a nil 15 | b (throw "Exception")] 16 | (throw "exception")) => nil) 17 | 18 | (fact "false does not" 19 | (subject/let-maybe [a false 20 | b true] 21 | (or a b)) => true)) 22 | -------------------------------------------------------------------------------- /src/such/wide_domains.clj: -------------------------------------------------------------------------------- 1 | (ns such.wide-domains 2 | "Variants of clojure.core functions that accept more types of inputs. 3 | This is a catch-all namespace that collects core-overriding functions 4 | from other namespaces. It has two purposes: 5 | 6 | * to show you all of such functions on one page of documentation. 7 | * to let you immigrate all of them in one swell foop. 8 | 9 | See [`such.clojure.core`](https://github.com/marick/suchwow/blob/master/test/such/clojure/core.clj) for an example. 10 | " 11 | (:require [such.immigration :as immigrate])) 12 | 13 | (immigrate/import-vars [such.ns +find-var] 14 | [such.symbols +symbol] 15 | [such.sequences +into]) 16 | 17 | 18 | -------------------------------------------------------------------------------- /test/such/f_sequences.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-sequences 2 | (:require [such.sequences :as subject]) 3 | (:use midje.sweet)) 4 | 5 | (fact "vertical-slices" 6 | (subject/vertical-slices [1 2 3] [:a :b :c]) 7 | => [ [1 :a] [2 :b] [3 :c]]) 8 | 9 | (fact "only" 10 | (subject/only [1]) => 1 11 | (subject/only [1 2]) => (throws #"`\[1 2\]` should have only one") 12 | (subject/only []) => (throws #"`\[\]` should have only one")) 13 | 14 | 15 | (fact +into 16 | (subject/+into [1]) => [1] 17 | (subject/+into [1] [2 3]) => [1 2 3] 18 | (subject/+into [1] [2 3] [4 5] [] [6]) => [1 2 3 4 5 6]) 19 | 20 | (fact bifurcate 21 | (subject/bifurcate even? [1 2 3 4]) => [ [2 4] [1 3] ] 22 | (take 5 (first (subject/bifurcate even? (range)))) => [0 2 4 6 8]) 23 | -------------------------------------------------------------------------------- /src/such/random.clj: -------------------------------------------------------------------------------- 1 | (ns such.random 2 | "Random numbers and crypographic hashes" 3 | (:import org.apache.commons.codec.digest.DigestUtils)) 4 | 5 | 6 | (defn guid 7 | "A random almost-certainly-unique identifier" 8 | [] 9 | (str (java.util.UUID/randomUUID))) 10 | 11 | (def uuid "Synonym for `guid`" guid) 12 | 13 | (defn form-hash 14 | "Returns a SHA-1 hash (encoded as a hex string) from the `prn` representation of the input. 15 | Use for collision avoidance when the highest security is not needed." 16 | [form] 17 | ;; Note: this is deprecated in later versions of commons.codec. However, 18 | ;; we're using an old version for compatibility with Compojure. 19 | ;; When compojure updates, we can use sha1Hex. 20 | (DigestUtils/shaHex (pr-str form))) 21 | -------------------------------------------------------------------------------- /Rakefile: -------------------------------------------------------------------------------- 1 | # -*- Mode: ruby -*- 2 | 3 | require 'rubygems' 4 | require 'rake' 5 | 6 | def doit(text) 7 | puts "== " + text 8 | system(text) 9 | end 10 | 11 | def working_directory_clean? 12 | output = `git status --porcelain` 13 | output.empty? 14 | end 15 | 16 | desc "Codox into gh-pages branch" 17 | task :doc do 18 | if working_directory_clean? 19 | doit("rm -rf /var/tmp/suchwow-doc") 20 | doit("lein doc") 21 | doit("git checkout gh-pages") 22 | doit("cp -r /var/tmp/suchwow-doc/* .") 23 | doit("git add *html") 24 | doit("git commit -am 'doc update'") 25 | doit("git push origin gh-pages") 26 | doit("git checkout master") 27 | else 28 | puts "The working directory is not clean" 29 | doit("git status") 30 | end 31 | end 32 | 33 | desc "Check many versions of Clojure" 34 | task :compatibility do 35 | doit("lein compatibility") 36 | end 37 | -------------------------------------------------------------------------------- /src/such/environment.clj: -------------------------------------------------------------------------------- 1 | (ns such.environment 2 | (:require environ.core) 3 | (:require [such.wrongness :as !])) 4 | 5 | (defn env 6 | "Select a keyword `key` from the environment. The result is a string. 7 | Throws an error if the environment lookup returns `nil`. See [[env-nil-ok]]. 8 | 9 | Environment variables are handled as described in 10 | [weavejester/environ](https://github.com/weavejester/environ): 11 | 12 | (env :home) ; lowercased 13 | (env :database-url) ; would match `DATABASE_URL` 14 | 15 | Also see that documentation for where environment variables can be set. 16 | " 17 | [key] 18 | (if-let [result (environ.core/env key)] 19 | result 20 | (!/boom! "%s is not in the environment." key))) 21 | 22 | (defn env-nil-ok 23 | "Select a keyword `key` from the environment, returning a string. 24 | The result may be `nil`." 25 | [key] 26 | (environ.core/env key)) 27 | -------------------------------------------------------------------------------- /test/such/f_symbols.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-symbols (:require [such.symbols :as symbol]) 2 | (:use midje.sweet)) 3 | 4 | (def d) 5 | 6 | (fact symbol 7 | (symbol/+symbol "th") => 'th 8 | (symbol/+symbol #'clojure.core/even?) => 'even? 9 | (symbol/+symbol *ns* "th2") => 'such.f-symbols/th2 10 | (symbol/+symbol 'such.f-symbols "th3") => 'such.f-symbols/th3 11 | (symbol/+symbol "such.f-symbols" "th4") => 'such.f-symbols/th4 12 | (symbol/+symbol "no.such.namespace" "th5") => 'no.such.namespace/th5 13 | (symbol/+symbol *ns* 'th6) => 'such.f-symbols/th6 14 | (symbol/+symbol *ns* :th7) => 'such.f-symbols/th7) 15 | 16 | (fact "from-concatenation" 17 | (symbol/from-concatenation ['a "b" :c #'d]) => 'abcd 18 | (symbol/from-concatenation [:namespace/un #'clojure.core/even?]) => 'uneven? 19 | 20 | (symbol/from-concatenation ["a" "b"] '-) => 'a-b) 21 | 22 | 23 | (fact "without-namespace" 24 | (symbol/without-namespace 'clojure.core/even?) => 'even? 25 | (symbol/without-namespace 'red) => 'red) 26 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | pom.xml.asc 3 | *jar 4 | /lib/ 5 | /classes/ 6 | /target/ 7 | /checkouts/ 8 | .lein-deps-sum 9 | .lein-repl-history 10 | .lein-plugins/ 11 | .lein-failures 12 | .nrepl-port 13 | doc 14 | .pre-commit-config.yaml 15 | 16 | # Covers JetBrains IDEs: IntelliJ, RubyMine, PhpStorm, AppCode, PyCharm, CLion 17 | 18 | *.iml 19 | 20 | ## Directory-based project format: 21 | .idea/ 22 | # if you remove the above rule, at least ignore the following: 23 | 24 | # User-specific stuff: 25 | # .idea/workspace.xml 26 | # .idea/tasks.xml 27 | # .idea/dictionaries 28 | 29 | # Sensitive or high-churn files: 30 | # .idea/dataSources.ids 31 | # .idea/dataSources.xml 32 | # .idea/sqlDataSources.xml 33 | # .idea/dynamic.xml 34 | # .idea/uiDesigner.xml 35 | 36 | # Gradle: 37 | # .idea/gradle.xml 38 | # .idea/libraries 39 | 40 | # Mongo Explorer plugin: 41 | # .idea/mongoSettings.xml 42 | 43 | ## File-based project format: 44 | *.ipr 45 | *.iws 46 | 47 | ## Plugin-specific files: 48 | 49 | # IntelliJ 50 | /out/ 51 | 52 | # mpeltonen/sbt-idea plugin 53 | .idea_modules/ 54 | 55 | # JIRA plugin 56 | atlassian-ide-plugin.xml 57 | 58 | # Crashlytics plugin (for Android Studio and IntelliJ) 59 | com_crashlytics_export_strings.xml 60 | crashlytics.properties 61 | crashlytics-build.properties 62 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | 3 | Anyone is free to copy, modify, publish, use, compile, sell, or 4 | distribute this software, either in source code form or as a compiled 5 | binary, for any purpose, commercial or non-commercial, and by any 6 | means. 7 | 8 | In jurisdictions that recognize copyright laws, the author or authors 9 | of this software dedicate any and all copyright interest in the 10 | software to the public domain. We make this dedication for the benefit 11 | of the public at large and to the detriment of our heirs and 12 | successors. We intend this dedication to be an overt act of 13 | relinquishment in perpetuity of all present and future rights to this 14 | software under copyright law. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | For more information, please refer to 25 | 26 | -------------------------------------------------------------------------------- /src/such/metadata.clj: -------------------------------------------------------------------------------- 1 | (ns such.metadata 2 | "Convenience functions for working with metadata. Intended to be used with 3 | `(:require [such.metadata :as meta])`." 4 | (:refer-clojure :exclude [merge assoc get contains?])) 5 | 6 | (defn get 7 | "Equivalent to `(get (meta o) k)` or `(get (meta o) k default)`." 8 | ([o k default] 9 | (clojure.core/get (meta o) k default)) 10 | ([o k] 11 | (get o k nil))) 12 | 13 | (defn merge 14 | "Merge the maps onto the metadata of `o`, creating a new object 15 | equal to `o` but with the merged metadata. 16 | 17 | (meta/merge o {:author \"Brian\" :lang :en-ca}) 18 | " 19 | [o & maps] 20 | (let [all (apply clojure.core/merge maps)] 21 | (vary-meta o clojure.core/merge all))) 22 | 23 | (defn assoc 24 | "`assoc` the key-value pairs onto the metadata of `o`, creating a 25 | new object equal to `o` but with the new metadata. 26 | 27 | (meta/assoc o :author \"Brian\" :lang :en-ca) 28 | " 29 | [o & kvs] 30 | (let [all (apply hash-map kvs)] 31 | (merge o all))) 32 | 33 | (defn contains? 34 | "Answer whether the metadata contains the given key. A key with 35 | a `nil` value counts as being contained. 36 | 37 | (meta/contains? o :author) => true 38 | " 39 | [o key] 40 | (clojure.core/contains? (meta o) key)) 41 | 42 | -------------------------------------------------------------------------------- /src/such/types.clj: -------------------------------------------------------------------------------- 1 | (ns such.types 2 | "Type (and \"type-like\") predicates not included in clojure.core." 3 | (:use such.versions)) 4 | 5 | (defn regex? 6 | "Is x a regular expression (a Java Pattern)?" 7 | [x] 8 | (instance? java.util.regex.Pattern x)) 9 | 10 | (defn stringlike? 11 | "Is x a string or a regex?" 12 | [x] 13 | (or (string? x) (regex? x))) 14 | 15 | (defn classic-map? 16 | "`map?` will return true for Records. This returns true only for hashmaps and sorted maps." 17 | [x] 18 | (instance? clojure.lang.APersistentMap x)) 19 | 20 | (defn big-decimal? 21 | "Is x a Java BigDecimal?" 22 | [x] 23 | (instance? java.math.BigDecimal x)) 24 | 25 | (defn multi? 26 | "Was `x` created with `defmulti`?" 27 | [x] 28 | (instance? clojure.lang.MultiFn x)) 29 | 30 | (defn extended-fn? 31 | "`fn?` does not consider multimethods to be functions. This does." 32 | [x] 33 | (or (fn? x) (multi? x))) 34 | 35 | (defn named? 36 | "Will `name` work on x? Two cases: It implements the Named protocol OR it's a string." 37 | [x] 38 | (or (string? x) 39 | (instance? clojure.lang.Named x))) 40 | 41 | (defn linear-access? 42 | "Is the collection one where you can't do better than linear access?" 43 | [x] 44 | (or (list? x) 45 | (seq? x))) 46 | 47 | (defn namespace? 48 | "Is x a namespace?" 49 | [x] 50 | (instance? clojure.lang.Namespace x)) 51 | -------------------------------------------------------------------------------- /test/such/f_imperfection.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-imperfection 2 | (:require [such.imperfection :as subject]) 3 | (:use midje.sweet)) 4 | 5 | ;; These are kludges because the function names look like metaconstants. 6 | (def x-pprint- subject/-pprint-) 7 | (def x-prn- subject/-prn-) 8 | 9 | (fact -pprint- 10 | (subject/val-and-output (-> [1 :a] x-pprint-)) => (just [1 :a] #"\[1 :a\]")) 11 | 12 | (fact -prn- 13 | (subject/val-and-output (-> [1 :a] x-prn-)) => (just [1 :a] #"\[1 :a\]")) 14 | 15 | (fact tag- 16 | (let [[val s] (subject/val-and-output (->> [1 :a] (subject/tag- "hi") x-prn-))] 17 | val => [1 :a] 18 | s => "hi\n[1 :a]\n") 19 | (fact "accepts values other than strings" 20 | (let [[_ s] (subject/val-and-output (subject/tag- 'hi 1))] 21 | s => "hi\n") 22 | (let [[_ s] (subject/val-and-output (subject/tag- :hi 1))] 23 | s => ":hi\n"))) 24 | 25 | (fact -tag 26 | (let [[val s] (subject/val-and-output (-> [1 :a] (subject/-tag "hi %s" 1) x-prn-))] 27 | val => [1 :a] 28 | s => "hi 1\n[1 :a]\n") 29 | (fact "accepts values other than strings" 30 | (let [[val s] (subject/val-and-output (subject/-tag :input :hi))] 31 | val => :input 32 | s => ":hi\n")) 33 | (fact "for non-string case, further arguments are ignored" 34 | (let [[val s] (subject/val-and-output (subject/-tag :input :hi 33))] 35 | val => :input 36 | s => ":hi\n"))) 37 | 38 | -------------------------------------------------------------------------------- /test/such/f_metadata.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-metadata 2 | (:require [such.metadata :as meta]) 3 | (:use midje.sweet)) 4 | 5 | 6 | (def o (with-meta [] {:meta :here})) 7 | 8 | (fact "get avoids needing to use `meta`" 9 | (get (meta o) :meta) => :here 10 | (meta/get o :meta) => :here 11 | 12 | (get (meta o) :unknown) => nil 13 | (meta/get o :unknown) => nil 14 | 15 | (get (meta o) :unknown "default") => "default" 16 | (meta/get o :unknown "default") => "default") 17 | 18 | (fact "merge avoids needing to use `meta`" 19 | (let [oo (meta/merge o {:a 1})] 20 | (meta oo) => {:meta :here, :a 1} 21 | (= oo o) => true) 22 | 23 | (fact "multiple arguments" 24 | (let [oo (meta/merge o {:a 1} {:b 2})] 25 | (meta oo) => {:meta :here, :a 1 :b 2})) 26 | 27 | (fact "no arguments are required" 28 | (let [oo (meta/merge o)] 29 | (meta oo) => (meta o)))) 30 | 31 | (fact "assoc avoids needing to use `meta`" 32 | (let [oo (meta/assoc o :a 1)] 33 | (meta oo) => {:meta :here, :a 1} 34 | (= oo o) => true) 35 | 36 | (fact "multiple arguments" 37 | (let [oo (meta/assoc o :a 1 :b 2)] 38 | (meta oo) => {:meta :here, :a 1 :b 2})) 39 | 40 | (fact "no arguments are required" 41 | (let [oo (meta/assoc o)] 42 | (meta oo) => (meta o)))) 43 | 44 | (fact "contains?" 45 | (meta/contains? o :meta) => true 46 | (meta/contains? o :not-meta) => false 47 | (meta/contains? (with-meta [] {:protocol nil}) :protocol) => true) 48 | -------------------------------------------------------------------------------- /src/such/wrongness.clj: -------------------------------------------------------------------------------- 1 | (ns such.wrongness) 2 | 3 | (defn boom! 4 | "In the first case, throw a java.lang.Exception whose message was constructed 5 | by applying `format` to `fmt` and the `args`. In the second case, the exception 6 | thrown is given by `exception-class`. 7 | 8 | (boom! \"wow\") 9 | (boom! \"wow: %s\" (cons 1 (cons 2 nil))) 10 | (boom! NumberFormatException \"wow: %s\" input)" 11 | {:arglists '([fmt & args] [exception-class fmt & args])} 12 | [& args] 13 | (if (instance? java.lang.Class (first args)) 14 | (let [[klass fmt & vals] args 15 | arglist-fmt (into-array java.lang.Class [java.lang.String]) 16 | constructor (.getConstructor ^Class klass arglist-fmt) 17 | message (apply format fmt vals) 18 | arglist (into-array java.lang.String [message]) 19 | exception (.newInstance constructor arglist)] 20 | (throw exception)) 21 | (apply boom! (cons Exception args)))) 22 | 23 | (def ^:no-doc not-namespace-and-name 24 | (partial boom! "%s can't be interpreted as having a namespace and name")) 25 | 26 | (def ^:no-doc bad-arg-type 27 | (partial boom! "Bad argument type for `%s`: %s.")) 28 | 29 | (def ^:no-doc should-not-have-namespace 30 | (partial boom! "`%s` should not be given a val with a namespace. %s has one.")) 31 | 32 | (def ^:no-doc should-have-namespace 33 | (partial boom! "`%s` should be given a val with a namespace. %s has none.")) 34 | -------------------------------------------------------------------------------- /src/such/control_flow.clj: -------------------------------------------------------------------------------- 1 | (ns such.control-flow) 2 | 3 | (defmacro branch-on 4 | " (branch-on (str \"one\" \"two\") 5 | vector? :vector 6 | string? :string 7 | :else :unknown) 8 | 9 | Evaluates the `value-form` once, then checks that value against 10 | each predicate in the cond-like body. The value after the first 11 | matching predicate is returned. If there is no match and an `:else` 12 | clause is present, its value is returned, otherwise `nil`. 13 | " 14 | [value-form & body] 15 | (let [value-sym (gensym "value-form-") 16 | cond-pairs (mapcat (fn [[branch-pred-form branch-val-form]] 17 | (let [test (if (= branch-pred-form :else) 18 | :else 19 | `(~branch-pred-form ~value-sym))] 20 | `(~test ~branch-val-form))) 21 | (partition 2 body))] 22 | 23 | `(let [~value-sym ~value-form] 24 | (cond ~@cond-pairs)))) 25 | 26 | (defmacro let-maybe 27 | "Like `let` except that if any symbol would be bound to a `nil`, the 28 | entire expression immediately short-circuits and returns `nil`. 29 | 30 | (let-maybe [v [] 31 | f (first v) 32 | _ (throw (new Exception))] 33 | (throw (new Exception))) 34 | => nil 35 | " 36 | [bindings & body] 37 | (if (empty? bindings) 38 | `(do ~@body) 39 | `(when-some [~@(take 2 bindings)] 40 | (let-maybe [~@(drop 2 bindings)] ~@body)))) 41 | -------------------------------------------------------------------------------- /test/such/f_immigration.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-immigration 2 | (:require [such.immigration :as immigrate] 3 | [such.metadata :as meta]) 4 | (:require clojure.math.combinatorics 5 | clojure.data.json) 6 | (:use midje.sweet)) 7 | 8 | 9 | ;;; This creates a "favorite functions" namespace. The imported functions 10 | ;;; are available here. See `f_use_favorites.clj` to see that the 11 | ;;; imported functions can be "referred into" another namespace. 12 | 13 | ;; Potemkin's original import function 14 | (immigrate/import-vars [clojure.math.combinatorics 15 | count-permutations permutations] 16 | [clojure.data.json 17 | write-str]) 18 | 19 | (fact 20 | (count-permutations [1 2 3]) => 6 21 | (permutations [1 2]) => [ [1 2] [2 1] ] 22 | 23 | (write-str [1 2]) => "[1,2]") 24 | 25 | (fact "Immigrating a nonexistent var blows up with a nice error message" 26 | (immigrate/import-vars [clojure.math.combinatorics combinations no-such-var]) 27 | => (throws "`clojure.math.combinatorics/no-such-var` does not exist")) 28 | 29 | 30 | ;;; Importing everything 31 | (immigrate/import-all-vars clojure.set) 32 | 33 | (fact 34 | (subset? #{1} #{1 2}) => true) 35 | 36 | 37 | ;;; Importing everything but adding a prefix 38 | (immigrate/import-prefixed-vars clojure.string str-) 39 | 40 | (fact 41 | (str-trim " f ") => "f") 42 | 43 | (fact "If the old source information is retained, codox blows up" 44 | (meta/contains? #'str-trim :file) => false 45 | (meta/contains? #'str-trim :line) => false 46 | (meta/contains? #'str-trim :column) => false) 47 | -------------------------------------------------------------------------------- /src/such/vars.clj: -------------------------------------------------------------------------------- 1 | (ns such.vars 2 | "Common operations on vars.") 3 | 4 | (defprotocol Rootable 5 | "A protocol to look at \"root\" values of Vars. The root value is 6 | the value before any `binding` - it's the value altered by `alter-var-root`. 7 | Defines `has-root-value?` and `root-value`." 8 | (has-root-value? [this] 9 | "Does this var have a root value?" ) 10 | (root-value [this] 11 | "What is the value of the var, ignoring any bindings in effect?")) 12 | 13 | (extend-type clojure.lang.Var 14 | Rootable 15 | (has-root-value? [var] (.hasRoot var)) 16 | (root-value [var] (alter-var-root var identity))) 17 | 18 | (defn name-as-symbol 19 | "Unlike symbols and keywords, the \"name\" of a var is a symbol. This function 20 | returns that symbol. See also [[name-as-string]]. 21 | 22 | (var/name-as-symbol #'clojure.core/even?) => 'even?) 23 | 24 | Note that the symbol does not have a namespace." 25 | [^clojure.lang.Var var] 26 | (.sym var)) 27 | 28 | (defn name-as-string 29 | "Unlike symbols and keywords, the \"name\" of a var is a symbol. This function 30 | returns the string name of that symbol. See also [[name-as-symbol]]. 31 | 32 | (var/name-as-string #'clojure.core/even?) => \"even?\")" 33 | [var] 34 | (name (name-as-symbol var))) 35 | 36 | (defn has-macro? 37 | "Does the var point to a macro?" 38 | [v] 39 | (boolean (:macro (meta v)))) 40 | 41 | (defn has-function? 42 | "Does the var point to a function?" 43 | [v] 44 | (or (and (boolean (:arglists (meta v))) 45 | (not (has-macro? v))) 46 | (= (type (root-value v)) clojure.lang.MultiFn))) 47 | 48 | (defn has-plain-value? 49 | "Does the var point to something not a macro nor a function?" 50 | [v] 51 | ((complement (some-fn has-macro? has-function?)) v)) 52 | -------------------------------------------------------------------------------- /src/such/sequences.clj: -------------------------------------------------------------------------------- 1 | (ns such.sequences 2 | (:require [such.wrongness :as !])) 3 | 4 | (defn vertical-slices 5 | "Given N sequences, return one sequence whose first element 6 | is a sequence of all the first elements, etc." 7 | [& sequences] 8 | (apply (partial map (fn [& args] args)) sequences)) 9 | 10 | 11 | (defn only 12 | "Gives the first element of a sequence. Throws an exception if there is not 13 | exactly one element." 14 | [coll] 15 | (if (seq (rest coll)) 16 | (!/boom! "`%s` should have only one element." coll) 17 | (if (seq coll) 18 | (first coll) 19 | (!/boom! "`%s` should have only one element." coll)))) 20 | 21 | (defn +into 22 | "The result collection is formed by `conj`ing all elements of the other 23 | `colls` onto `coll` (in order). 24 | 25 | (+into [] (map inc [1 2]) (map dec [-1 -2])) => [2 3 -2 -3] 26 | 27 | `+into` is a convenient way to coerce a number of collections into a vector 28 | or other collection of your choice. 29 | 30 | Note: the Clojure 1.7 version of `into` has a three argument version that takes a 31 | transducer as its second argument. Unlike in 1.6 and earlier, `+into` is not a 32 | compatible replacement for 1.7's `into`. 33 | " 34 | [coll & colls] 35 | (reduce into coll colls)) 36 | 37 | (defn bifurcate 38 | "Apply `pred` to all elements of `coll` and return two sequences. 39 | Those elements for which `pred` returns a truthy value go in the 40 | first sequence. `pred` is only evaluated once per element. 41 | Sequences are created lazily. 42 | 43 | (bifurcate even? [1 2 3 4]) => [ [2 4] [1 3] ] 44 | (take 5 (first (bifurcate even? (range)))) => [0 2 4 6 8] 45 | " 46 | [pred coll] 47 | (let [tagged (map #(vector (pred %) %) coll) 48 | choice (fn [in-or-out] (map second (in-or-out first tagged)))] 49 | (vector (choice filter) (choice remove)))) 50 | 51 | -------------------------------------------------------------------------------- /src/such/symbols.clj: -------------------------------------------------------------------------------- 1 | (ns such.symbols 2 | "Symbol utilities, such as different ways to create symbols." 3 | (:require [such.casts :as cast] 4 | [clojure.string :as str])) 5 | 6 | (defn +symbol 7 | "Creates a symbol. A variant of the `clojure.core` version with a wider domain. 8 | The `ns` argument may be a namespace, symbol, keyword, or string ([[as-ns-string]]). 9 | The `name` argument may be a symbol, string, keyword, or var ([[as-string-without-namespace]]). 10 | 11 | In the one-argument version, the resulting symbol has a `nil` namespace. 12 | In the two-argument version, it has the symbol version of `ns` as the namespace. 13 | Note that `ns` need not refer to an existing namespace. 14 | 15 | (+symbol \"th\") => 'th 16 | (+symbol 'clojure.core \"th\") => 'clojure.core/th 17 | 18 | (+symbol *ns* 'th) => 'this.namespace/th ; \"add\" a namespace 19 | (+symbol *ns* 'clojure.core/even?) => 'this.namespace/even? ; \"localize\" a symbol. 20 | " 21 | ([name] 22 | (symbol (cast/as-string-without-namespace name))) 23 | ([ns name] 24 | (symbol (str (cast/as-ns-symbol ns)) (cast/as-string-without-namespace name)))) 25 | 26 | 27 | 28 | (defn from-concatenation 29 | "Construct a symbol from the concatenation of the string versions of the 30 | `nameables`, which may be symbols, strings, keywords, or vars. If given, 31 | the `join-nameable` is interposed between the segments. 32 | 33 | (symbol/from-concatenation ['a \"b\" :c #'d]) => 'abcd 34 | (symbol/from-concatenation [\"a\" \"b\"] '-) => 'a-b) 35 | 36 | Note that the namespace qualifiers for symbols and strings are not included: 37 | 38 | (symbol/from-concatenation [:namespace/un #'clojure.core/even?]) => 'uneven? 39 | " 40 | ([nameables join-nameable] 41 | (symbol (str/join (cast/as-string-without-namespace join-nameable) 42 | (map cast/as-string-without-namespace nameables)))) 43 | ([nameables] 44 | (from-concatenation nameables ""))) 45 | 46 | (defn without-namespace 47 | "Return a symbol with the same name as `sym` but no 48 | namespace. 49 | 50 | (symbol/without-namespace 'clojure.core/even?) => 'even? 51 | " 52 | [sym] 53 | (symbol (name sym))) 54 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject marick/suchwow "6.0.3" 2 | :description "Such functions! Such doc strings! Much utility!" 3 | :url "https://github.com/marick/suchwow" 4 | :pedantic? :warn 5 | :license {:name "The Unlicense" 6 | :url "http://unlicense.org/" 7 | :distribution :repo} 8 | 9 | :dependencies [[org.clojure/clojure "1.10.3"] 10 | [potemkin "0.4.5" :exclusions [org.clojure/clojure]] 11 | [com.rpl/specter "1.1.3" :exclusions [org.clojure/clojure org.clojure/clojurescript]] 12 | [environ "1.2.0" :exclusions [org.clojure/clojure]] 13 | [commons-codec/commons-codec "1.15"]] 14 | 15 | :repl-options {:init (do (require 'such.doc) 16 | (such.doc/apis))} 17 | 18 | :profiles {:dev {:dependencies [[midje "1.9.10" :exclusions [org.clojure/clojure]] 19 | [org.clojure/math.combinatorics "0.1.6"] 20 | [org.clojure/data.json "1.1.0"] 21 | ;; Including compojure so that `lein ancient` will 22 | ;; tell us to upgrade, which might alert us that 23 | ;; compojure now depends on a more-modern version of 24 | ;; commons-codec. 25 | [marick/structural-typing "2.0.5" :exclusions [marick/suchwow]] 26 | [compojure "1.6.2" :exclusions [org.clojure/clojure]]]} 27 | :1.7 {:dependencies [[org.clojure/clojure "1.7.0"]]} 28 | :1.8 {:dependencies [[org.clojure/clojure "1.8.0"]]} 29 | :1.9 {:dependencies [[org.clojure/clojure "1.9.0"]]}} 30 | 31 | :plugins [[lein-midje "3.2.1"] 32 | [codox "0.8.11"]] 33 | 34 | :codox {:src-dir-uri "https://github.com/marick/suchwow/blob/master/" 35 | :src-linenum-anchor-prefix "L" 36 | :output-dir "/var/tmp/suchwow-doc" 37 | :defaults {:doc/format :markdown}} 38 | 39 | :aliases {"compatibility" ["with-profile" "+1.7:+1.8:+1.9" "midje" ":config" ".compatibility-test-config"] 40 | "travis" ["with-profile" "+1.7:+1.8:+1.9" "midje"]} 41 | 42 | ;; For Clojure snapshots 43 | :repositories {"sonatype-oss-public" "https://oss.sonatype.org/content/groups/public/"} 44 | :deploy-repositories [["releases" :clojars]]) 45 | -------------------------------------------------------------------------------- /test/such/f_vars.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-vars 2 | (:require [such.vars :as var]) 3 | (:use midje.sweet)) 4 | 5 | 6 | (def unbound) 7 | (def ^:dynamic bound 1) 8 | (def ^:dynamic rebound) 9 | 10 | (fact "has-root-value?" 11 | (var/has-root-value? #'unbound) => false 12 | (var/has-root-value? #'rebound) => false 13 | (var/has-root-value? #'bound) => true 14 | 15 | (fact "bindings don't affect root value" 16 | (binding [rebound 3] 17 | rebound => 3 18 | (var/has-root-value? #'rebound) => false)) 19 | 20 | (fact "requires a var" 21 | (var/has-root-value? 'bound) => (throws IllegalArgumentException))) 22 | 23 | (fact "root-value" 24 | ;; root value of unbound value differs in Clojure versions; undefined here. 25 | (var/root-value #'bound) => 1 26 | 27 | (fact "bindings don't affect root value" 28 | (binding [bound 3] 29 | bound => 3 30 | (var/root-value #'bound) => 1)) 31 | 32 | (fact "requires a var" 33 | (var/root-value 'bound) => (throws IllegalArgumentException))) 34 | 35 | (fact "name-as-symbol" 36 | (var/name-as-symbol #'clojure.core/even?) => 'even?) 37 | 38 | 39 | (fact "name-as-string" 40 | (var/name-as-string #'clojure.core/even?) => "even?") 41 | 42 | 43 | ;;; What vars point to 44 | 45 | (defn a-fun [n] (inc n)) 46 | (defmulti a-multi identity) 47 | (defmacro a-macro [n] `(+ ~n ~n)) 48 | (def a-thing 5) 49 | 50 | (defprotocol P 51 | (a-proto-fn [this])) 52 | 53 | (defrecord R [a] 54 | P 55 | (a-proto-fn [this] a)) 56 | 57 | (fact 58 | (var/has-macro? #'cons) => false 59 | (var/has-macro? #'cond) => true 60 | (var/has-macro? #'a-fun) => false 61 | (var/has-macro? #'a-multi) => false 62 | (var/has-macro? #'a-macro) => true 63 | (var/has-macro? #'a-thing) => false 64 | (var/has-macro? #'a-proto-fn) => false 65 | 66 | (var/has-function? #'cons) => true 67 | (var/has-function? #'cond) => false 68 | (var/has-function? #'a-fun) => true 69 | (var/has-function? #'a-multi) => true 70 | (var/has-function? #'a-macro) => false 71 | (var/has-function? #'a-thing) => false 72 | (var/has-function? #'a-proto-fn) => true 73 | 74 | (var/has-plain-value? #'cons) => false 75 | (var/has-plain-value? #'cond) => false 76 | (var/has-plain-value? #'a-fun) => false 77 | (var/has-plain-value? #'a-multi) => false 78 | (var/has-plain-value? #'a-macro) => false 79 | (var/has-plain-value? #'a-thing) => true 80 | (var/has-plain-value? #'a-proto-fn) => false) 81 | 82 | 83 | 84 | 85 | -------------------------------------------------------------------------------- /src/such/doc.clj: -------------------------------------------------------------------------------- 1 | (ns such.doc 2 | "Links to, and support for, online documentation." 3 | (:require [clojure.java.browse :as browse] 4 | [clojure.pprint :refer [cl-format]] 5 | [clojure.string :as str])) 6 | 7 | (def ^:private api-namespaces (atom [])) 8 | 9 | (def ^:private api-doc-template 10 | "Open this library's API documentation in a browser. 11 | 12 | To auto-load this and all such functions into the repl, put 13 | the following in `project.clj`: 14 | 15 | :repl-options {:init (do (require '%s 'etc 'etc) 16 | ;; List available api docs on repl startup: 17 | (such.doc/apis))} 18 | ") 19 | 20 | ;; This is a macro to let us capture the calling namespace. 21 | (defmacro api-url! 22 | "This defines an `api` function that jumps to online documentation. 23 | Put something like the following in a `some-library.doc` namespace: 24 | 25 | (ns some-library.doc 26 | \"Functions that jump to online documentation.\" 27 | (:require such.doc)) 28 | 29 | (such.doc/api-url! \"http://marick.github.io/structural-typing/\") 30 | 31 | A client of `some-library` can put the following in `project.clj`: 32 | 33 | :repl-options {:init (do (require 'some-library.doc 'etc 'etc) 34 | ;; List available api docs on repl startup: 35 | (such.doc/apis))} 36 | 37 | Thereafter, the documentation is available in the repl via 38 | 39 | (some-library.doc/api) 40 | " 41 | [url] 42 | (do 43 | (swap! api-namespaces #(-> % 44 | (conj (ns-name *ns*)) 45 | set 46 | vec 47 | sort)) 48 | 49 | (let [var (intern *ns* 'api (fn [] (browse/browse-url url)))] 50 | (alter-meta! var assoc 51 | :doc (format api-doc-template (ns-name *ns*)) 52 | :arglists '([]))) 53 | nil)) 54 | 55 | 56 | (api-url! "http://marick.github.io/suchwow/") 57 | 58 | (defn apis 59 | "List (to stdout) all APIs that provide in-repl documentation via 60 | `(some-library.doc/api)`." 61 | [] 62 | (println "The following namespaces have an `api` function to take you to API docs:") 63 | (cl-format true " ~{~<~% ~1,80:; ~S~>~^,~}~%" @api-namespaces) 64 | (println "At any time, see available namespaces with `(such.api/apis)`") 65 | (println)) 66 | 67 | -------------------------------------------------------------------------------- /test/such/f_maps.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-maps 2 | (:require [such.maps :as subject] 3 | [such.versions :refer [when=1-6]]) 4 | (:use midje.sweet)) 5 | 6 | 7 | ;;; Maps 8 | 9 | (facts "you can tack new keys onto a hashmap" 10 | (subject/conj-into {}) => {} 11 | (subject/conj-into {:a 1}) => {:a 1} 12 | 13 | (subject/conj-into {} :a 1) => '{:a (1)} 14 | (subject/conj-into {} :a 1) => (just {:a list?}) 15 | 16 | (subject/conj-into {:a [1] :b '(1)} :a 2 :b 2) => '{:a [1 2] :b (2 1)} 17 | (subject/conj-into {:a [1] :b '(1)} :a 2 :b 2) => (just {:a vector? :b list?}) 18 | 19 | (subject/conj-into {:a [1], :b [55] :c 'blah} :a 2 :b 56) => {:a [1 2], :b [55 56], :c 'blah}) 20 | 21 | (fact "key-difference" 22 | (subject/key-difference {} {}) => {} 23 | (subject/key-difference {:a 1} {}) => {:a 1} 24 | (subject/key-difference {:a 1} {:a ..irrelevant..}) => {} 25 | (subject/key-difference {} {:a ..irrelevant..}) => {} 26 | 27 | (subject/key-difference {:a 1, :b 2, :c 3} {:a ..irrelevant.., :c ..irrelevant.., :d ..irrelevant..}) => {:b 2}) 28 | 29 | 30 | 31 | (fact "invert" 32 | (subject/invert {:a 1, :b 2}) => {1 :a, 2 :b}) 33 | 34 | (fact "dissoc-keypath" 35 | (fact "removes a key/value pair" 36 | (subject/dissoc-keypath {:by-name {:name1 1, :name2 2}} [:by-name :name1]) 37 | => {:by-name { :name2 2}} 38 | (subject/dissoc-keypath {:by-name {:name1 1}} [:by-name :name1]) 39 | => {:by-name { }} 40 | (subject/dissoc-keypath {"1" {"2" {"3.1" 3, "3.2" 3}}} ["1" "2" "3.1"]) 41 | => {"1" {"2" { "3.2" 3}}}) 42 | (fact "leaves the map alone if the last key is incorrect" 43 | (subject/dissoc-keypath {:by-name {:name1 1}} [:by-name :NOTFOUND]) 44 | => {:by-name {:name1 1}}) 45 | (fact "requires that the path up to the last key exists" 46 | (subject/dissoc-keypath {:by-name {:name1 1}} [:NOTFOUND :name1]) 47 | =not=> {:NOTFOUND {:name1 1}})) 48 | 49 | (fact update-each-value 50 | (subject/update-each-value {} inc) => {} 51 | (subject/update-each-value {:a 1, :b 2} inc) => {:a 2 :b 3} 52 | (subject/update-each-value {:a [], :b [:b]} conj 1) => {:a [1] :b [:b 1]}) 53 | 54 | (fact "making a map with uniform keys" 55 | (subject/mkmap:all-keys-with-value [] 3) => {} 56 | (subject/mkmap:all-keys-with-value [:a] 3) => {:a 3} 57 | (subject/mkmap:all-keys-with-value [:a [:b]] 3) => {:a 3, [:b] 3}) 58 | 59 | (when=1-6 60 | (fact "update" 61 | (subject/update {:a 1} :a + 5) => {:a 6}) 62 | ) 63 | -------------------------------------------------------------------------------- /test/such/f_types.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-types 2 | (:use such.versions) 3 | (:require [such.types :as subject]) 4 | (:use midje.sweet)) 5 | 6 | (facts "about stringlike objects" 7 | (string? "s") => true 8 | (string? #"s") => false 9 | (string? 1) => false 10 | 11 | (subject/regex? "s") => false 12 | (subject/regex? #"s") => true 13 | (subject/regex? 1) => false 14 | 15 | (subject/stringlike? "s") => true 16 | (subject/stringlike? #"s") => true 17 | (subject/stringlike? 1) => false) 18 | 19 | (defrecord R [a]) 20 | 21 | (facts "about maps and records" 22 | (map? (R. 1)) => true 23 | (map? (hash-map)) => true 24 | (map? (sorted-map)) => true 25 | (map? 1) => false 26 | 27 | (subject/classic-map? (R. 1)) => false 28 | (subject/classic-map? (hash-map)) => true 29 | (subject/classic-map? (sorted-map)) => true 30 | (subject/classic-map? 1) => false) 31 | 32 | (facts "about bigdecimal" 33 | (subject/big-decimal? 1) => false 34 | (subject/big-decimal? (int 1)) => false 35 | (subject/big-decimal? (long 1)) => false 36 | (subject/big-decimal? 1.0) => false 37 | (subject/big-decimal? 1.0M) => true) 38 | 39 | (defmulti twofer identity) 40 | 41 | (facts "about extended-fn" 42 | (fn? cons) => true 43 | (fn? twofer) => false 44 | 45 | (subject/extended-fn? cons) => true 46 | (subject/extended-fn? twofer) => true) 47 | 48 | (defrecord ExampleNamed [] 49 | clojure.lang.Named 50 | (getName [this] "name") 51 | (getNamespace [this] "namespace")) 52 | 53 | (facts "about named objects" 54 | (name "foo") => "foo" ; yay! 55 | (name 'foo) => "foo" 56 | (name 'such.named) => "such.named" 57 | (name :foo) => "foo" 58 | (name ::foo) => "foo" 59 | (name :fake/namespace) => "namespace" 60 | (name (ExampleNamed.)) => "name" 61 | (name *ns*) => (throws) ; Boo! 62 | (name \c) => (throws) 63 | 64 | (subject/named? "foo") => true 65 | (subject/named? 'foo) => true 66 | (subject/named? 'such.subject/named) => true 67 | (subject/named? :foo) => true 68 | (subject/named? ::foo) => true 69 | (subject/named? :fake/namespace) => true 70 | (subject/named? (ExampleNamed.)) => true 71 | (subject/named? *ns*) => false 72 | (subject/named? \c) => false) 73 | 74 | (fact "linear access" 75 | (subject/linear-access? []) => false 76 | (subject/linear-access? '(1)) => true 77 | (subject/linear-access? '()) => true 78 | (subject/linear-access? nil) => false 79 | (subject/linear-access? (map identity [1 2 3])) => true 80 | (subject/linear-access? (hash-map)) => false) 81 | 82 | (fact "namespace?" 83 | (subject/namespace? *ns*) => true 84 | (subject/namespace? (ns-name *ns*)) => false 85 | (subject/namespace? "ns") => false) 86 | -------------------------------------------------------------------------------- /test/such/f_shorthand.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-shorthand (:require [such.shorthand :as subject]) 2 | (:use midje.sweet)) 3 | 4 | (facts "any?" 5 | (fact "first arg is a function" 6 | (subject/any? even? [1 2 3]) => true 7 | (subject/any? even? [1 3]) => false 8 | (subject/any? inc [1 2 3]) => true 9 | (subject/any? identity [nil false]) => false) 10 | 11 | (fact "first arg is a collection" 12 | (subject/any? #{1 3} [5 3 1]) => true 13 | (subject/any? #{1 3} [5 "a" "b"]) => false 14 | (subject/any? [1 3] [5 3 1]) => true 15 | (subject/any? [1 3] [5 "a" "b"]) => false 16 | 17 | (subject/any? {:a 1} {:a 1}) => true 18 | (subject/any? {:a 1} {:a 2}) => false 19 | (subject/any? {:a 1} {:b 1}) => false 20 | (subject/any? {:a 2, :b 1} {:b 1, :c 3}) => true) 21 | 22 | (fact "first arg is a keyword" 23 | (contains? {:a 1, :b 2} :a) => true 24 | (subject/any? :a {:a 1, :b 2}) => true 25 | (subject/any? :a {:b 1}) => false)) 26 | 27 | 28 | (fact "not-empty?" 29 | (subject/not-empty? [1]) => true 30 | (subject/not-empty? []) => false 31 | (subject/not-empty? (cons 1 '())) => true 32 | (subject/not-empty? '()) => false 33 | (subject/not-empty? nil) => false 34 | (subject/not-empty? (range 0)) => false 35 | (subject/not-empty? (range 1)) => true 36 | (subject/not-empty? (next (next (range 2)))) => false 37 | (subject/not-empty? (rest (rest (range 2)))) => false 38 | (subject/not-empty? (next (next (range 3)))) => true 39 | (subject/not-empty? (rest (rest (range 3)))) => true 40 | 41 | (subject/not-empty? "") => false 42 | (subject/not-empty? "1") => true 43 | 44 | (subject/not-empty? (byte-array 0)) => false 45 | (subject/not-empty? (byte-array 1)) => true 46 | 47 | (subject/not-empty? 1) => (throws)) 48 | 49 | 50 | (fact "third" 51 | (subject/third [1 2 3]) => 3 52 | (subject/third [1 2]) => nil) 53 | 54 | (fact "fourth" 55 | (subject/fourth [1 2 3 4]) => 4 56 | (subject/fourth [1 2 3]) => nil) 57 | 58 | (fact "find-first" 59 | (subject/find-first even? [1 3 4 6]) => 4 60 | (subject/find-first even? [3 5]) => nil 61 | (subject/find-first even? nil) => nil 62 | (subject/find-first :key {:key "value"}) => nil 63 | (subject/find-first #(= :key (first %)) {:key "value"}) => [:key "value"] 64 | (subject/find-first #{1 2} [3 2 1]) => 2 65 | (subject/find-first even? (range)) => 0) 66 | 67 | (fact "without-nils" 68 | (subject/without-nils nil) => empty? 69 | (subject/without-nils []) => empty? 70 | (subject/without-nils [1 nil 2 false]) => [1 2 false] 71 | (take 2 (subject/without-nils (range))) => [0 1]) 72 | 73 | 74 | (def a (atom 100)) 75 | (fact "prog1" 76 | (subject/prog1 (+ 1 1) 77 | (swap! a inc)) => 2 78 | @a => 101) 79 | -------------------------------------------------------------------------------- /test/such/f_ns_state.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-ns-state (:require [such.ns-state :as subject]) 2 | (:use midje.sweet)) 3 | 4 | (subject/dissoc!) 5 | 6 | (fact "state starts out as empty" 7 | (#'subject/state) => empty? 8 | (subject/get :k) => empty?) 9 | 10 | (fact "setting" 11 | (subject/alter! :setting (constantly 1)) 12 | (subject/get :setting) => 1 13 | 14 | (subject/alter! :setting + 3) 15 | (subject/get :setting) => 4 16 | 17 | (subject/set! :setting 0) 18 | (subject/get :setting) => 0 19 | 20 | (subject/get :missing) => nil 21 | (subject/get :missing :nowhere) => :nowhere) 22 | 23 | (fact "stack interface" 24 | (subject/count :stack) => 0 25 | (subject/empty? :stack) => true 26 | (subject/pop! :stack) => (throws) 27 | 28 | (subject/push! :stack "top") 29 | (subject/get :stack) => ["top"] 30 | 31 | (subject/top :stack) => "top" 32 | (subject/count :stack) => 1 33 | (subject/empty? :stack) => false 34 | 35 | (subject/pop! :stack) => "top" 36 | 37 | (subject/top :stack) => (throws) 38 | (subject/count :stack) => 0 39 | (subject/empty? :stack) => true 40 | (subject/get :stack) => empty?) 41 | 42 | (fact "note that stacks can contain nils" 43 | (subject/push! :nilable nil) 44 | (subject/push! :nilable 3) 45 | 46 | (subject/pop! :nilable) => 3 47 | (subject/pop! :nilable) => nil 48 | (subject/pop! :nilable) => (throws)) 49 | 50 | (fact "stack history" 51 | (subject/history :history) => [] 52 | (subject/history :history) => vector? 53 | 54 | (subject/push! :history 1) 55 | (subject/push! :history 2) 56 | (subject/history :history) => [1 2] 57 | (subject/history :history) => vector? 58 | 59 | (fact "history requires a that the value of a key be something that can be made a vector" 60 | (subject/set! :history 1) 61 | (subject/history :history) => (throws))) 62 | 63 | 64 | (fact "flattened history" 65 | (subject/push! :flattened [1 2]) 66 | (subject/push! :flattened [3]) 67 | (subject/flattened-history :flattened) => [1 2 3] 68 | 69 | (fact "history isn't lazy" 70 | (subject/flattened-history :flattened) => vector?)) 71 | 72 | (fact "the key needn't be a keyword" 73 | (subject/get 'symbol) => nil 74 | (subject/set! 'symbol []) 75 | (subject/get 'symbol) => [] 76 | (subject/top 'symbol) => (throws) 77 | (subject/pop! 'symbol) => (throws) 78 | (subject/push! 'symbol [1]) 79 | (subject/get 'symbol) => [[1]] 80 | (subject/push! 'symbol [2]) 81 | (subject/get 'symbol) => [[1] [2]] 82 | (subject/history 'symbol) => [[1] [2]] 83 | (subject/flattened-history 'symbol) => [1 2]) 84 | 85 | (fact "cleanup" 86 | (subject/get :setting) =not=> nil 87 | (subject/dissoc! :setting) 88 | (subject/get :setting :missing) => :missing 89 | 90 | (#'subject/state) =not=> nil 91 | (subject/get :flattened) =not=> nil 92 | (subject/dissoc!) 93 | (#'subject/state) => nil 94 | (subject/get :flattened :missing) => :missing) 95 | 96 | -------------------------------------------------------------------------------- /src/such/maps.clj: -------------------------------------------------------------------------------- 1 | (ns such.maps 2 | "Various functions on key-value structures" 3 | (:require [such.versions :refer [when=1-6]])) 4 | 5 | (when=1-6 6 | (defn update 7 | "The update function from Clojure 1.7. The same as `update-in` except 8 | the second argument is a key instead of a path. 9 | 10 | (subject/update {:a 1} :a + 5)" 11 | [m k f & args] 12 | (apply update-in m [k] f args)) 13 | ) 14 | 15 | (defn invert 16 | "Produce a map with values as keys. 17 | Values are assumed unique." 18 | [map] 19 | (reduce (fn [so-far [key val]] 20 | (assoc so-far val key)) 21 | {} 22 | map)) 23 | 24 | (defn conj-into 25 | "`original` is a map. `additions` is a sequence of keys and values (not a map). 26 | Each key is used to identify a value within the map. That `original` value is 27 | updated by conjing on the associated `additions` value. 28 | 29 | (conj-into {:a [1] :b '(1)} :a 2 :b 2) => '{:a [1 2] :b (2 1)} 30 | 31 | If the key isn't present in the map, it is created as a list containing 32 | the value. 33 | 34 | (conj-into {} :a 1) => '{:a (1)} 35 | " 36 | [original & additions] 37 | (loop [[k v & more :as all] additions 38 | so-far original] 39 | (if (empty? all) 40 | so-far 41 | (recur more 42 | (update-in so-far [k] conj v))))) 43 | 44 | (defn dissoc-keypath 45 | "Like `dissoc`, but takes a sequence of keys that describes a path to a value. 46 | There must be at least two keys in the path. 47 | 48 | (subject/dissoc-keypath {:by-name {:name1 1}} [:by-name :name1]) 49 | => {:by-name { }} 50 | " 51 | [map keys] 52 | (let [[path-to-end-key end-key] [(butlast keys) (last keys)] 53 | ending-container (get-in map path-to-end-key) 54 | without-key (dissoc ending-container end-key)] 55 | (assoc-in map path-to-end-key without-key))) 56 | 57 | 58 | 59 | (defn key-difference 60 | "Remove (as with `dissoc`) all the keys in `original` that are in 61 | `unwanted`. 62 | 63 | (key-difference {:a 1, :b 2} {:b ..irrelevant.., :c ..irrelevant..}) => {:a 1} 64 | " 65 | 66 | [original unwanted] 67 | (apply dissoc original (keys unwanted))) 68 | 69 | (defn update-each-value 70 | "Call `f` on each value in map `kvs`, passing it the value and 71 | any `args`. 72 | 73 | (update-each-value {:a 1, :b 0} + 2) => {:a 3, :b 2} 74 | " 75 | [kvs f & args] 76 | (reduce (fn [so-far k] 77 | (assoc so-far k (apply f (get kvs k) args))) 78 | kvs 79 | (keys kvs))) 80 | 81 | (defn mkmap:all-keys-with-value 82 | "Create a map with keys `keys`. Each key will have `v` as 83 | its value. 84 | 85 | (mkmap:all-keys-with-value [:a, :b] 3) => {:a 3, :b 3} 86 | " 87 | [keys v] 88 | (reduce (fn [so-far k] 89 | (assoc so-far k v)) 90 | {} 91 | keys)) 92 | -------------------------------------------------------------------------------- /src/such/imperfection.clj: -------------------------------------------------------------------------------- 1 | (ns such.imperfection 2 | "Were we perfect, we wouldn't need to test or debug. Since we're not, a 3 | few helpers organized around printing." 4 | (:require [clojure.pprint :refer [pprint]] 5 | [such.readable :as readable] 6 | [such.metadata :as meta] 7 | [such.ns :as ns])) 8 | 9 | (defmacro val-and-output 10 | "Execute the body. Instead of just returning the resulting value, 11 | return a pair of the `value` and any output (as with `with-out-str`)." 12 | [& body] 13 | `(let [val-recorder# (atom nil) 14 | str-recorder# (with-out-str (swap! val-recorder# (fn [_#] (do ~@body))))] 15 | (vector (deref val-recorder#) str-recorder#))) 16 | 17 | (defn -pprint- 18 | "Unlike regular `pprint`, this returns the value passed in, making it useful 19 | for cases like this: 20 | 21 | (-> v 22 | frob 23 | -pprint- 24 | tweak 25 | -pprint-) 26 | 27 | [[value]] is used to produce more helpful function-names. 28 | " 29 | [v] 30 | (pprint (readable/value v)) 31 | v) 32 | 33 | (defn -prn- 34 | "Unlike regular `prn`, this returns the value passed in, making it useful 35 | for cases like this: 36 | 37 | (-> v 38 | frob 39 | -prn- 40 | tweak 41 | -prn-) 42 | 43 | [[value]] is used to produce more helpful function-names. 44 | " 45 | [v] 46 | (prn (readable/value v)) 47 | v) 48 | 49 | (defn tag- 50 | "Prints (as with `println`) the given `tag`, which may be any value. 51 | The `value` is returned. 52 | 53 | (->> v 54 | frob 55 | (tag \"frobout\") -prn- 56 | ...) 57 | " 58 | [tag value] 59 | (println tag) 60 | value) 61 | 62 | (defn -tag 63 | "If `tag` is a string, formats `tag` and `args` and prints the results as with `println`. 64 | If `tag` is not a string, it is printed and any `args` are ignored. 65 | The `value` is returned. 66 | 67 | Use as follows: 68 | 69 | (-> v 70 | frob 71 | (tag \"Frob with %s\" flag) (-pprint-) 72 | quux 73 | (tag :quux) 74 | ...) 75 | " 76 | [value tag & args] 77 | (println (if (string? tag) 78 | (apply format tag args) 79 | tag)) 80 | value) 81 | 82 | 83 | (defn- one-e [[existing-sym prefix suffix]] 84 | (let [outsym '*out* 85 | errsym '*err* 86 | args 'args 87 | new-sym (symbol (str "e" existing-sym)) 88 | docstring (format "Like %s, but prints to `*err*`. 89 | Useful for keeping debug output from being captured by [[val-and-output]]." 90 | (str prefix existing-sym suffix))] 91 | `(defn ~new-sym ~docstring [& ~args] 92 | (binding [~outsym ~errsym] 93 | (apply ~existing-sym ~args))))) 94 | 95 | (defmacro e 96 | {:private true} 97 | [& pairs] 98 | `(do ~@(map one-e pairs))) 99 | 100 | (e [pr "`" "`"] 101 | [prn "`" "`"] 102 | [print "`" "`"] 103 | [println "`" "`"] 104 | [pprint "`" "`"] 105 | [-pprint- "[[" "]]"] 106 | [-prn- "[[" "]]"] 107 | [tag- "[[" "]]"] 108 | [-tag "[[" "]]"]) 109 | -------------------------------------------------------------------------------- /test/such/f_ns.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-ns (:require [such.ns :as subject]) 2 | (:use midje.sweet) 3 | (:require [such.vars :as var])) 4 | 5 | (facts "about `with-scratch-namespace`" 6 | (fact "typical use" 7 | (subject/with-scratch-namespace scratch.ns 8 | (intern 'scratch.ns 'foo 3) 9 | (var/root-value (ns-resolve 'scratch.ns 'foo)) => 3) 10 | (find-ns 'scratch.ns) => nil) 11 | 12 | (fact "an existing namespace is deleted first" 13 | (create-ns 'scratch.ns) 14 | (intern 'scratch.ns 'foo 3) 15 | (ns-resolve 'scratch.ns 'foo) => var? 16 | 17 | (subject/with-scratch-namespace scratch.ns 18 | (ns-resolve 'scratch.ns 'foo) => nil ; deleted. 19 | (intern 'scratch.ns 'foo 3) 20 | (ns-resolve 'scratch.ns 'foo) => var?) 21 | (find-ns 'scratch.ns) => nil)) 22 | 23 | 24 | (def here-var) 25 | (def intersection) 26 | 27 | (fact +find-var 28 | (fact "old behavior still works" 29 | (subject/+find-var 'clojure.core/even?) => #'clojure.core/even? 30 | (subject/+find-var 'no-such-ns/even?) => (throws #"No such namespace") 31 | (subject/+find-var 'clojure.core/nonex) => nil) 32 | 33 | (fact "and there's new behavior in the one-argument case" 34 | (fact "lookup can be by symbol, string, or keyword" 35 | (subject/+find-var 'such.f-ns/here-var) => #'here-var ; as before 36 | (subject/+find-var :such.f-ns/here-var) => #'here-var 37 | (subject/+find-var "such.f-ns/here-var") => #'here-var 38 | (subject/+find-var "no.such.namespace/here-var") => (throws #"No such namespace") 39 | (subject/+find-var "such.f-ns/no-here") => nil) 40 | 41 | (fact "a symbol, string, or keyword without a namespace is looked up in `*ns*`" 42 | (subject/+find-var 'here-var) => #'such.f-ns/here-var 43 | (subject/+find-var :here-var) => #'such.f-ns/here-var 44 | (subject/+find-var "here-var") => #'such.f-ns/here-var 45 | (subject/+find-var 'not-here) => nil) 46 | 47 | (fact "a var is just returned" 48 | (subject/+find-var #'even?) => #'clojure.core/even?)) 49 | 50 | (fact "the two argument case is used for easier lookup" 51 | (fact "typical cases" 52 | (subject/+find-var 'clojure.core 'even?) => #'clojure.core/even? 53 | (subject/+find-var *ns* 'even?) => nil 54 | (subject/+find-var *ns* 'here-var) => #'here-var) 55 | 56 | (fact "other types of arguments" 57 | (subject/+find-var "clojure.core" "even?") => #'clojure.core/even? 58 | (subject/+find-var "clojure.core" #'even?) => #'clojure.core/even? 59 | (subject/+find-var *ns* #'intersection) => #'such.f-ns/intersection 60 | (subject/+find-var *ns* :intersection) => #'such.f-ns/intersection 61 | (subject/+find-var *ns* #'even?) => nil) 62 | 63 | (fact "namespace symbols can't have namespaces" 64 | (subject/+find-var 'derp/clojure.core 'odd?) => (throws) 65 | (subject/+find-var "derp/clojure.core" :odd?) => (throws)) 66 | 67 | (fact "namespace parts of second argument are ignored - a bit icky" 68 | (subject/+find-var 'clojure.core 'derp/odd?) => #'clojure.core/odd? 69 | (subject/+find-var 'clojure.core "derp/odd?") => #'clojure.core/odd? 70 | (subject/+find-var "clojure.core" ::odd?) => #'clojure.core/odd? 71 | (subject/+find-var *ns* 'clojure.set/intersection) => #'intersection))) 72 | 73 | 74 | -------------------------------------------------------------------------------- /test/such/f_casts.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-casts (:require [such.casts :as cast]) 2 | (:use midje.sweet)) 3 | 4 | (fact has-namespace? 5 | (cast/has-namespace? 1) => (throws) 6 | (cast/has-namespace? 'some.namespace) => false 7 | (cast/has-namespace? 'some.namespace/some.namespace) => true 8 | (cast/has-namespace? :food) => false 9 | (cast/has-namespace? :clojure.core) => false 10 | (cast/has-namespace? :clojure.core/food) => true 11 | (cast/has-namespace? "foo") => false 12 | (cast/has-namespace? "clojure.core/foo") => true 13 | (cast/has-namespace? "clojure.core/foo/bar") => (throws)) 14 | 15 | (fact as-ns-symbol 16 | (cast/as-ns-symbol *ns*) => 'such.f-casts 17 | (cast/as-ns-symbol 'some.namespace) => 'some.namespace 18 | (cast/as-ns-symbol 'some.namespace/some.namespace) => (throws) 19 | (cast/as-ns-symbol :food) => 'food 20 | (cast/as-ns-symbol :clojure.core) => 'clojure.core 21 | (cast/as-ns-symbol :clojure.core/food) => (throws) 22 | (cast/as-ns-symbol "foo") => 'foo 23 | (cast/as-ns-symbol "clojure.core/foo") => (throws)) 24 | 25 | (fact extract-namespace-into-symbol 26 | (cast/extract-namespace-into-symbol *ns*) => 'such.f-casts 27 | (cast/extract-namespace-into-symbol 'some.namespace) => (throws) 28 | (cast/extract-namespace-into-symbol 'some.namespace/x) => 'some.namespace 29 | (cast/extract-namespace-into-symbol :food) => (throws) 30 | (cast/extract-namespace-into-symbol :clojure.core) => (throws) 31 | (cast/extract-namespace-into-symbol :clojure.core/food) => 'clojure.core 32 | (cast/extract-namespace-into-symbol "foo") => (throws) 33 | (cast/extract-namespace-into-symbol "clojure.core/foo") => 'clojure.core) 34 | 35 | 36 | 37 | (def local) 38 | 39 | (fact "as-symbol-without-namespace" 40 | (cast/as-symbol-without-namespace 'foo) => 'foo 41 | (cast/as-symbol-without-namespace 'clojure.core/foo) => 'foo 42 | (cast/as-symbol-without-namespace :clojure.core/even?) => 'even? 43 | (cast/as-symbol-without-namespace ::even?) => 'even? 44 | (cast/as-symbol-without-namespace :even?) => 'even? 45 | (cast/as-symbol-without-namespace #'clojure.core/even?) => 'even? 46 | (cast/as-symbol-without-namespace #'local) => 'local 47 | (cast/as-symbol-without-namespace "local") => 'local 48 | (cast/as-symbol-without-namespace "core.foo/bar") => 'bar) 49 | 50 | 51 | 52 | (fact "as-string-without-namespace" 53 | (cast/as-string-without-namespace 'clojure/foo) => "foo" ; namespace omitted 54 | (cast/as-string-without-namespace #'even?) => "even?" 55 | (cast/as-string-without-namespace :bar) => "bar" ; colon omitted. 56 | (cast/as-string-without-namespace :util.x/quux) => "quux" ; \"namespace\" omitted 57 | (cast/as-string-without-namespace "derp") => "derp") 58 | 59 | (def here) 60 | (fact as-namespace-and-name-symbols 61 | (cast/as-namespace-and-name-symbols 'clojure.core/even?) => ['clojure.core 'even?] 62 | (cast/as-namespace-and-name-symbols 'even?) => [nil 'even?] 63 | 64 | (cast/as-namespace-and-name-symbols :clojure.core/even?) => ['clojure.core 'even?] 65 | (cast/as-namespace-and-name-symbols :foo) => [nil 'foo] 66 | 67 | (cast/as-namespace-and-name-symbols "even?") => [nil 'even?] 68 | (cast/as-namespace-and-name-symbols "clojure.core/even?") => ['clojure.core 'even?] 69 | (cast/as-namespace-and-name-symbols "clojure/core/even?") => (throws) 70 | 71 | (cast/as-namespace-and-name-symbols #'even?) => ['clojure.core 'even?] 72 | (cast/as-namespace-and-name-symbols #'here) => ['such.f-casts 'here]) 73 | -------------------------------------------------------------------------------- /src/such/shorthand.clj: -------------------------------------------------------------------------------- 1 | (ns such.shorthand 2 | "Explicit functions for what could be done easily - but less clearly - 3 | by composing clojure.core functions. Anti-shibboleths such as using 4 | `not-empty?` instead of `seq`." 5 | (:refer-clojure :exclude [any?])) 6 | 7 | 8 | (def ^:no-doc this-var-has-no-value-and-is-used-in-testing) 9 | 10 | (defn any? 11 | "`any?` provides shorthand for \"containment\" queries that otherwise 12 | require different functions. Behavior depends on the type of `predlike`. 13 | 14 | * A function: `true` iff `predlike` returns a *truthy* value for any value in `coll`. 15 | 16 | (any? even? [1 2 3]) => true ; works best with boolean-valued functions 17 | (any? inc [1 2 3]) => true ; a silly example to demo truthiness. 18 | (any? identity [nil false]) => false ; also silly 19 | 20 | * A collection: `true` iff `predlike` contains any element of `coll`. 21 | 22 | (any? #{1 3} [5 4 1]) => true 23 | (any? [1 3] [5 4 1]) => true 24 | 25 | When `predlike` is a map, it checks key/value pairs: 26 | 27 | (any? {:a 1} {:a 1}) => true 28 | (any? {:a 1} {:a 2}) => false 29 | (any? {:a 2, :b 1} {:b 1, :c 3}) => true 30 | 31 | * A keyword: `true` iff `predlike` is a key in `coll`, which *must* be a map. 32 | 33 | (any? :a {:a 1, :b 2}) => true ; equivalent to: 34 | (contains? {:a 1, :b 2} :a) => true 35 | " 36 | [predlike coll] 37 | (boolean (cond (coll? predlike) 38 | (some (set predlike) coll) 39 | 40 | (keyword? predlike) 41 | (contains? coll predlike) 42 | 43 | :else 44 | (some predlike coll)))) 45 | 46 | (defn not-empty? 47 | "Returns `true` if `value` has any values, `false` otherwise. `value` *must* be a collection, 48 | a String, a native Java array, or something that implements the `Iterable` interface." 49 | [value] 50 | (boolean (seq value))) 51 | 52 | (defn third 53 | "Returns the third element of `coll`. Returns `nil` if there are fewer than three elements." 54 | [coll] 55 | (second (rest coll))) 56 | 57 | (defn fourth 58 | "Returns the fourth element of `coll`. Returns `nil` if there are fewer than four elements." 59 | [coll] 60 | (third (rest coll))) 61 | 62 | (defn find-first 63 | "Returns the first item of `coll` where `(pred item)` returns a truthy value, `nil` otherwise. 64 | `coll` is evaluated lazily. 65 | 66 | (find-first even? [1 2 3]) => 2 67 | 68 | You can apply `find-first` to a map, even though which 69 | element matches \"first\" is undefined. Note that the item passed to `pred` will 70 | be a key-value pair: 71 | 72 | (find-first #(even? (second %)) {:a 2, :b 22, :c 222}) => [:c 222] 73 | " 74 | [pred coll] 75 | (first (filter pred coll))) 76 | 77 | (defn without-nils 78 | "A lazy sequence of non-nil values of `coll`." 79 | [coll] 80 | (keep identity coll)) 81 | 82 | 83 | (defmacro prog1 84 | "The `retform` is evaluated, followed by the `body`. The value of the 85 | form is returned, so the point of `body` should be to have side-effects. 86 | 87 | (defn pop! [k] 88 | (prog1 (top k) 89 | (alter! k clojure.core/pop))) 90 | 91 | The name is a homage to older Lisps. 92 | " 93 | [retform & body] 94 | `(let [retval# ~retform] 95 | ~@body 96 | retval#)) 97 | 98 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## Such Wow 2 | 3 | [![License: Unlicense](https://img.shields.io/badge/license-Unlicense-blue.svg)](http://unlicense.org/) 4 | [![Current Version](https://img.shields.io/clojars/v/marick/suchwow.svg)](https://clojars.org/marick/suchwow) 5 | 6 | The [API documentation index](http://marick.github.io/suchwow) gives an overview of what this library offers. 7 | 8 | Snippets from serious work, wrapped in a whimsical container. A bit of a tribute to the spirit of [_why](http://en.wikipedia.org/wiki/Why_the_lucky_stiff), but with a [Shiba Inu](http://en.wikipedia.org/wiki/Shiba_Inu) instead of [foxes](http://mislav.uniqpath.com/poignant-guide/images/the.foxes-3.png). 9 | 10 | This package offers three types of functions: 11 | * `clojure.core` functions, but with better documentation (including examples). 12 | * Variants of `clojure.core` functions that accept more kinds of inputs. 13 | * A grab-bag of useful functions that, importantly, you can copy into your own code without worrying about licenses or giving credit or any of that. As a programmer trying to get work done, I use this library and others to create a ["favorite functions" namespace](https://github.com/marick/clojure-commons/blob/master/src/commons/clojure/core.clj) that I `use` everywhere. 14 | 15 | ![By Euterpia (Own work, CC0), via Wikimedia Commons](http://upload.wikimedia.org/wikipedia/commons/thumb/d/df/Doge_homemade_meme.jpg/256px-Doge_homemade_meme.jpg) 16 | [via Euterpia](http://commons.wikimedia.org/wiki/File:Doge_homemade_meme.jpg) 17 | 18 | [![Build Status](https://travis-ci.org/marick/suchwow.png?branch=master)](https://travis-ci.org/marick/suchwow) 19 | 20 | ## Such Usage 21 | 22 | Available via [clojars](https://clojars.org/marick/suchwow) for Clojure 1.7+ 23 | For lein: [marick/suchwow "6.0.0"] 24 | 25 | [Much API doc](http://marick.github.io/suchwow/) 26 | 27 | Copy the source if you want, do the normal `(:require 28 | [such.types :as wow])` thing, or create your own `commons.clojure.core` 29 | namespace with all the things you think should be packaged with Clojure. 30 | 31 | The files [test/such/clojure/f_immigration.clj](https://github.com/marick/suchwow/blob/master/test/such/f_immigration.clj) and [commons.clojure.core](https://github.com/marick/clojure-commons/blob/master/src/commons/clojure/core.clj) show how to arrange for that last. 32 | 33 | 34 | ## Such License 35 | 36 | This software is covered by the [Unlicense](http://unlicense.org/) 37 | and, as such, is in the public domain. 38 | 39 | ## Such Contributors 40 | 41 | * Alex Miller 42 | * Bahadir Cambel 43 | * Børge Svingen 44 | * Brian Marick 45 | 46 | ## Such Contributing 47 | 48 | Pull requests accepted, provided: 49 | 50 | 1. Your contribution has tests. In keeping with the spirit of the library, they 51 | don't even have to be written with 52 | [Midje](https://github.com/marick/Midje), since Midje can run 53 | clojure.test tests. 54 | 55 | 2. Your contribution doesn't depend on anything other than Clojure itself. 56 | 57 | 3. You have the right to put your contribution into the public domain. 58 | 59 | To allow me to be a teensy bit scrupulous, please include the following text in 60 | the comment of your pull request: 61 | 62 | > I dedicate any and all copyright interest in this software to the 63 | > public domain. I make this dedication for the benefit of the public at 64 | > large and to the detriment of my heirs and successors. I intend this 65 | > dedication to be an overt act of relinquishment in perpetuity of all 66 | > present and future rights to this software under copyright law. 67 | 68 | -------------------------------------------------------------------------------- /test/such/f_wide_domains.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-wide-domains 2 | (:require [such.wide-domains :as subject] 3 | [clojure.set]) 4 | (:use midje.sweet)) 5 | 6 | 7 | ;; These tests are just copies of the ones in the originating namespace. 8 | ;; They give assurance that the particular functions actually *have* been 9 | ;; immigrated. There's no need to keep them in sync. 10 | 11 | (fact +symbol 12 | (subject/+symbol "th") => 'th 13 | (subject/+symbol #'clojure.core/even?) => 'even? 14 | (subject/+symbol *ns* "th2") => 'such.f-wide-domains/th2 15 | (subject/+symbol 'such.f-wide-domains "th3") => 'such.f-wide-domains/th3 16 | (subject/+symbol "such.f-wide-domains" "th4") => 'such.f-wide-domains/th4 17 | (subject/+symbol "no.such.namespace" "th5") => 'no.such.namespace/th5 18 | (subject/+symbol *ns* 'th6) => 'such.f-wide-domains/th6 19 | (subject/+symbol *ns* :th7) => 'such.f-wide-domains/th7) 20 | 21 | 22 | (def here-var) 23 | (def intersection) 24 | 25 | (fact +find-var 26 | (fact "old behavior still works" 27 | (subject/+find-var 'clojure.core/even?) => #'clojure.core/even? 28 | (subject/+find-var 'no-such-ns/even?) => (throws #"No such namespace") 29 | (subject/+find-var 'clojure.core/nonex) => nil) 30 | 31 | (fact "and there's new behavior in the one-argument case" 32 | (fact "lookup can be by symbol, string, or keyword" 33 | (subject/+find-var 'such.f-wide-domains/here-var) => #'here-var ; as before 34 | (subject/+find-var :such.f-wide-domains/here-var) => #'here-var 35 | (subject/+find-var "such.f-wide-domains/here-var") => #'here-var 36 | (subject/+find-var "no.such.namespace/here-var") => (throws #"No such namespace") 37 | (subject/+find-var "such.f-wide-domains/no-here") => nil) 38 | 39 | (fact "a symbol, string, or keyword without a namespace is looked up in `*ns*`" 40 | (subject/+find-var 'here-var) => #'such.f-wide-domains/here-var 41 | (subject/+find-var :here-var) => #'such.f-wide-domains/here-var 42 | (subject/+find-var "here-var") => #'such.f-wide-domains/here-var 43 | (subject/+find-var 'not-here) => nil) 44 | 45 | (fact "a var is just returned" 46 | (subject/+find-var #'even?) => #'clojure.core/even?)) 47 | 48 | (fact "the two argument case is used for easier lookup" 49 | (fact "typical cases" 50 | (subject/+find-var 'clojure.core 'even?) => #'clojure.core/even? 51 | (subject/+find-var *ns* 'even?) => nil 52 | (subject/+find-var *ns* 'here-var) => #'here-var) 53 | 54 | (fact "other types of arguments" 55 | (subject/+find-var "clojure.core" "even?") => #'clojure.core/even? 56 | (subject/+find-var "clojure.core" #'even?) => #'clojure.core/even? 57 | (subject/+find-var *ns* #'intersection) => #'such.f-wide-domains/intersection 58 | (subject/+find-var *ns* :intersection) => #'such.f-wide-domains/intersection 59 | (subject/+find-var *ns* #'even?) => nil) 60 | 61 | (fact "namespace symbols can't have namespaces" 62 | (subject/+find-var 'derp/clojure.core 'odd?) => (throws) 63 | (subject/+find-var "derp/clojure.core" :odd?) => (throws)) 64 | 65 | (fact "namespace parts of second argument are ignored - a bit icky" 66 | (subject/+find-var 'clojure.core 'derp/odd?) => #'clojure.core/odd? 67 | (subject/+find-var 'clojure.core "derp/odd?") => #'clojure.core/odd? 68 | (subject/+find-var "clojure.core" ::odd?) => #'clojure.core/odd? 69 | (subject/+find-var *ns* 'clojure.set/intersection) => #'intersection))) 70 | 71 | (fact +into 72 | (let [result (subject/+into [] [1] (list 3 4))] 73 | result => [1 3 4] 74 | result => vector?)) 75 | -------------------------------------------------------------------------------- /src/such/ns.clj: -------------------------------------------------------------------------------- 1 | (ns such.ns 2 | "Makes working with namespaces easier." 3 | (:use such.types) 4 | (:require [such.casts :as cast] 5 | [such.vars :as vars] 6 | [such.symbols :as sym])) 7 | 8 | (defmacro with-scratch-namespace 9 | "Create a scratch namespace named `ns-name`, run `body` within it, then 10 | remove it. `ns-name` *must* be a symbol. If the namespace already 11 | exists, it will be removed, then recreated, then removed." 12 | [ns-sym & body] 13 | (when (and (sequential? ns-sym) 14 | (= (first ns-sym) 'quote)) 15 | (println "You quoted the `ns-sym` arg to `with-scratch-namespace`. Don't do that.")) 16 | `(try 17 | (remove-ns '~ns-sym) 18 | (create-ns '~ns-sym) 19 | ~@body 20 | (finally 21 | (remove-ns '~ns-sym)))) 22 | 23 | (defn +find-var 24 | "Return a variable identified by the arguments, or `nil`. 25 | A version of the built-in function, but with a wider domain. 26 | 27 | *Case 1*: 28 | If the single argument is a namespace-qualified symbol, the behavior is 29 | the same as `clojure.core/find-var`: the variable of that name in that 30 | namespace is returned: 31 | 32 | (+find-var 'clojure.core/even?) => #'clojure.core/even? 33 | 34 | Note that the namespace *must* exist or an exception is thrown. 35 | 36 | Strings with a single slash are treated as symbols: 37 | 38 | (+find-var \"clojure.core/even?\") => #'clojure.core/even? 39 | 40 | Namespace-qualified keywords can also be used. 41 | 42 | *Case 2*: 43 | If the single argument is not namespace-qualified, it is treated as if it 44 | were qualified with `*ns*`: 45 | 46 | (+find-var 'find-var) => #'this.namespace/find-var 47 | (+find-var \"symbol\") => #'this.namespace/symbol 48 | 49 | *Case 3*: 50 | If the single argument is a var, it is returned. 51 | 52 | *Case 4*: 53 | In the two-argument case, the `ns` argument supplies the namespace and 54 | the `name` argument the var's name. `ns` may be a namespace, symbol, keyword, 55 | or string ([[as-ns-symbol]]). `name` may be a string, symbol, keyword, 56 | or var. In the first three cases, the namespace part of `name` (if any) 57 | is ignored: 58 | 59 | (+find-var 'such.wide-domains 'clojure.core/find-var) => #'such.wide-domains/find-var 60 | (+find-var *ns* :find-var) => #'this.namespace/find-var 61 | 62 | If the `name` argument is a var, `find-var` looks for a var with the same name 63 | in `ns`: 64 | 65 | (+find-var 'such.wide-domains #'clojure.core/find-var) => #'such.wide-domains/find-var 66 | " 67 | ([name] 68 | (if (var? name) 69 | name 70 | (let [[ns name] (cast/as-namespace-and-name-symbols name)] 71 | (find-var (sym/+symbol (or ns *ns*) name))))) 72 | ([ns name] 73 | (let [ns-sym (cast/as-ns-symbol ns) 74 | name-sym (cast/as-symbol-without-namespace name)] 75 | (find-var (sym/+symbol ns-sym name-sym))))) 76 | 77 | (defn alias-var 78 | "Create a var with the supplied name in the current namespace, having the 79 | same metadata and root-binding as the supplied var." 80 | [name ^clojure.lang.Var var] 81 | (apply intern *ns* 82 | (with-meta name (merge {:dont-test (str "Alias of " (vars/name-as-string var))} 83 | (meta var) 84 | (meta name))) 85 | (when (.hasRoot var) [@var]))) 86 | 87 | (defmacro defalias 88 | "Defines an alias for a var: a new var with the same root binding (if any) 89 | and similar metadata. The metadata of the alias is its initial metadata (as 90 | provided by def) merged into the metadata of the original." 91 | [dst src] 92 | `(alias-var (quote ~dst) (var ~src))) 93 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | This project adheres to [Semantic Versioning](http://semver.org/). 3 | See [here](http://keepachangelog.com/) for the change log format. 4 | 5 | ## [6.0.3] - 2021-03-17 6 | - bump libs 7 | 8 | ## [6.0.2] - 2017-12-27 9 | - Move `defalias` and `alias-var` code over from `clojure-commons` 10 | 11 | ## [6.0.1] - 2017-12-27 12 | - Upgrade to Specter 1.0.4 to avoid `any? in com.rpl.specter.impl` warning 13 | - Fix reflection warnings 14 | - Bump libs 15 | 16 | ## [6.0.0] - 2016-10-26 17 | - Upgrade to Specter 0.13 18 | - ... which caused Clojure 1.6 to be abandoned, so major version bump. 19 | 20 | ## [5.2.4] 21 | - Update dependencies. 22 | 23 | ## [5.2.3] 24 | - Fixes bad `ns` form. @puredanger 25 | 26 | ## [5.2.1] 27 | - Specter 0.12.0 broke downstream dependencies. Reverting to 0.11.2 28 | 29 | ## [5.2.0] 30 | - ADD: Better error message when trying to immigrate a variable that does not exist. 31 | - Update dependencies 32 | 33 | ## [5.1.4] 34 | - CHANGE: Guard against Clojure 1.9's `any?` - Børge Svingen 35 | 36 | ## [5.1.3] 37 | - CHANGE: Bump structural typing dependency 38 | 39 | ## [5.1.2] 40 | - CHANGE: Update `structural-typing` because of annoying circular dependency. 41 | 42 | ## [5.1.1] 43 | - CHANGE: Update versions, most notably `specter`, but also `environ`, 44 | `combinatorics`, `structural-typing`, and `compojure`. 45 | 46 | ## [5.1] 47 | - ADD: such.imperfection has variants that print to *err* of these functions: 48 | `pr`, `prn`, `print`, `println`, `pprint`, `-pprint-`, `-prn-`, `tag-`, and `-tag`. 49 | 50 | ## [5.0] 51 | - CHANGED: No longer support Clojure 1.5 52 | - ADD: such.control-flow/let-maybe 53 | - ADD: An *experimental* such.relational namespace. See the API docs and [the wiki](https://github.com/marick/suchwow/wiki/such.relational) 54 | 55 | ## [4.4.3] 56 | - DEPRECATION: In upcoming release, immigration functions will not `require` namespaces themselves. 57 | 58 | ## [4.4.2] 59 | 60 | - bump versions of dependencies, including commons-codec 61 | 62 | ## [4.4.1] 63 | 64 | - Use commons-codec 1.6 instead of 1.10. ring-codec uses 1.6. Since it's more popular, 65 | we might as well just track its preference to avoid shoving version conflicts into 66 | people's faces. 67 | 68 | ## [4.4.0] 69 | 70 | ### Added 71 | 72 | - such.maps now supplies Clojure 1.7's `update` under Clojure 1.6. 73 | - -tag and tag- can now take any value, not just a string. 74 | 75 | ## [4.3.0] 76 | 77 | ### Added 78 | 79 | - Functions in such.imperfection and such.readable can now be used with Clojure 1.6. 80 | 81 | ## [4.2.0] 82 | 83 | ### Added 84 | - `such.metadata/contains?` 85 | 86 | ### Fixed 87 | - All the `such.immigration` functions now do requires at compile time. 88 | - Workaround to prevent Codox from crashing on vars imported with `import-prefixed-vars`. 89 | 90 | ## [4.1.0] - 2015-08-19 91 | 92 | ### Added 93 | - `imperfection` namespace for debugging and testing functions. 94 | 95 | ## [4.0.1] - 2015-08-14 96 | 97 | ### Fixed 98 | 99 | - The generated `api` function didn't have `:arglist` metadata. 100 | 101 | ## [4.0.0] - 2015-08-14 102 | 103 | ### Changed 104 | 105 | - Names in previous were bad: such.api -> such.doc, `open` -> `api`. 106 | 107 | ## [3.5.0] - 2015-08-14 108 | 109 | ### Added 110 | - docs for `reduce`, `reductions`, `reduce-kv`, and `map-indexed`. 111 | - `such.api` 112 | 113 | ## [3.4.0] - 2015-07-31 114 | 115 | ### Added 116 | - `such.metadata` namespace 117 | 118 | ## [3.3.0] - 2015-07-11 119 | 120 | ### Added 121 | - Docs for `sequential?`, `cond->`, and `cond->>` 122 | - `pred:not-any?`, `pred:none-of?` 123 | 124 | ### Deprecated 125 | - `any-pred` is now `pred:any?` 126 | - `wrap-pred-with-catcher` is now `pred:exception->false` 127 | 128 | 129 | -------------------------------------------------------------------------------- /test/such/f_function_makers.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-function-makers 2 | (:require [such.function-makers :as mkfn]) 3 | (:use midje.sweet)) 4 | 5 | 6 | (fact "pred:any?" 7 | ((mkfn/pred:any? odd? even?) 1) => true 8 | ((mkfn/pred:any? pos? neg?) 0) => false 9 | ((mkfn/pred:any? :key :word) {:key false}) => false 10 | ((mkfn/pred:any? :key :word) {:key false :word 3}) => true 11 | ((mkfn/pred:any? #{1 2} #{3 4}) 3) => true 12 | ;; stops at first match 13 | ((mkfn/pred:any? (partial = 3) (fn[_](throw (new Error "boom!")))) 3) => true 14 | ;; Any empty list means that everything matches 15 | ((mkfn/pred:any?) 3) => true) 16 | 17 | (fact "pred:not-any? and pred:none-of?" 18 | ((mkfn/pred:not-any? odd? even?) 1) => false 19 | ((mkfn/pred:not-any? pos? neg?) 0) => true 20 | ((mkfn/pred:none-of? :key :word) {:key false}) => true 21 | ((mkfn/pred:none-of? :key :word) {:key false :word 3}) => false 22 | ((mkfn/pred:not-any? #{1 2} #{3 4}) 3) => false 23 | ;; stops at first match 24 | ((mkfn/pred:not-any? (partial = 3) (fn[_](throw (new Error "boom!")))) 3) => false 25 | ;; Any empty list means that everything matches 26 | ((mkfn/pred:not-any?) 3) => false) 27 | 28 | (fact pred:exception->false 29 | (let [wrapped (mkfn/pred:exception->false even?)] 30 | (wrapped 2) => true 31 | (wrapped 3) => false 32 | (even? nil) => (throws) 33 | (wrapped nil) => false)) 34 | 35 | 36 | (fact "`lazyseq:x->abc` converts (possibly optionally) each element of a lazyseq and replaces it with N results" 37 | (fact "one arg form processes each element" 38 | ( (mkfn/lazyseq:x->abc #(repeat % %)) [1 2 3]) => [1 2 2 3 3 3]) 39 | 40 | (fact "two arg form processes only elements that match predicate" 41 | ( (mkfn/lazyseq:x->abc #(repeat % %) even?) [1 2 3 4]) => [1 2 2 3 4 4 4 4]) 42 | 43 | (fact "empty sequences are handled" 44 | ( (mkfn/lazyseq:x->abc #(repeat % %) even?) []) => empty?) 45 | 46 | (fact "it is indeed lazy" 47 | (let [made (mkfn/lazyseq:x->abc #(repeat % %) even?)] 48 | (take 2 (made [0])) => empty? 49 | (take 2 (made [0 1])) => [1] 50 | (take 2 (made [0 1 2])) => [1 2] 51 | (take 2 (made [0 1 2 3])) => [1 2] 52 | (take 2 (made [0 1 2 3 4])) => [1 2] 53 | (take 2 (made (range))) => [ 1 2 ] 54 | (count (take 100000 (made (range)))) => 100000))) 55 | 56 | 57 | (fact "`lazyseq:x->xabc` converts (possibly optionally) each element of a lazyseq and replaces it 58 | with N results. The first argument is preserved" 59 | (fact "one arg form processes each element" 60 | ( (mkfn/lazyseq:x->xabc #(repeat % (- %))) [1 2 3]) => [1 -1 2 -2 -2 3 -3 -3 -3]) 61 | 62 | (fact "two arg form processes only elements that match predicate" 63 | ( (mkfn/lazyseq:x->xabc #(repeat % (- %)) even?) [1 2 3 4]) => [1 2 -2 -2 3 4 -4 -4 -4 -4])) 64 | 65 | 66 | (fact "`lazyseq:x->y` converts (possibly optionally) each element of a lazyseq and replaces it 67 | with 1 result." 68 | (fact "one arg form processes each element" 69 | ( (mkfn/lazyseq:x->y -) [1 2 3]) => [-1 -2 -3 ]) 70 | 71 | (fact "two arg form processes only elements that match predicate" 72 | ( (mkfn/lazyseq:x->y - even?) [1 2 3 4]) => [1 -2 3 -4])) 73 | 74 | 75 | (fact lazyseq:criticize-deviationism 76 | (let [recorder (atom []) 77 | messager #(format "%s - %s" %1 %2) 78 | critiquer (mkfn/lazyseq:criticize-deviationism (comp neg? second) 79 | #(swap! recorder 80 | conj 81 | (messager %1 %2))) 82 | data [[:ok 0] [:brian -1] [:corey 10326] [:gary -3]]] 83 | (critiquer data) => data 84 | @recorder => [(format "%s - %s" data [:brian -1]) 85 | (format "%s - %s" data [:gary -3])])) 86 | 87 | -------------------------------------------------------------------------------- /src/such/ns_state.clj: -------------------------------------------------------------------------------- 1 | (ns such.ns-state 2 | "Manipulate, in a stateful way, a key-value store that belongs to a particular namespace. 3 | 4 | Throughout this documentation, `f` is any callable. It must not have side effects. 5 | `k` is a value (of any type) that indexes the key-value store. 6 | 7 | Values in the store can be treated as single entities or as stacks. 8 | 9 | All state-changing operations end in `\"!\". They are atomic. 10 | Except where explicitly noted, their return value is undefined." 11 | (:require [such.wrongness :as !]) 12 | (:refer-clojure :exclude [dissoc! pop!] :rename {get core-get 13 | count core-count 14 | empty? core-empty?})) 15 | 16 | (defn- state [] 17 | (-> *ns* meta ::state)) 18 | 19 | (defn alter! 20 | "Replace the value of the store at `k` with the value 21 | of `(apply f args)`. 22 | 23 | (nss/alter! :counter + 2) 24 | " 25 | [k f & args] 26 | (alter-meta! *ns* #(apply update-in % [::state k] f args)) 27 | :undefined) 28 | 29 | (defn set! 30 | "Replace the value of the store at `k` 31 | with `v`. 32 | 33 | (nss/set! :counter 0) 34 | " 35 | [k v] 36 | (alter! k (constantly v))) 37 | 38 | (defn dissoc! 39 | "In the no-argument versions, delete all keys from the store. 40 | In the N-argument version, delete each of the keys." 41 | ([& ks] 42 | (alter-meta! *ns* (fn [all] (update-in all [::state] #(apply dissoc % ks)))) 43 | :undefined) 44 | ([] 45 | (alter-meta! *ns* dissoc ::state) 46 | :undefined)) 47 | 48 | (defn get 49 | "Return the value of the store at `k` or the default if there is no value. 50 | If no default value, return `nil`." 51 | ([k] 52 | (get k nil)) 53 | ([k default] 54 | (get-in (meta *ns*) [::state k] default))) 55 | 56 | 57 | ;; Stack-structured 58 | 59 | (defn count 60 | "The value of the store at `k` must be a stack. Returns the number of elements. 61 | A never-created (or destroyed) stack has zero elements." 62 | [k] 63 | (core-count (get k))) 64 | 65 | (defn empty? 66 | "The value of the store at `k` must be a stack. Returns `true` iff the stack 67 | has no elements. A never-created (or destroyed) stack has zero elements." 68 | [k] 69 | (core-empty? (get k))) 70 | 71 | (defn top 72 | "Returns the element of the stack at `k` that was most recently pushed. 73 | Throws an `Exception` if the stack is empty or does not exist. 74 | 75 | (nss/push! :s 1) 76 | (nss/push! :s 2) 77 | (nss/pop! :s) 78 | (nss/top :s) => 1 79 | " 80 | [k] 81 | (if (empty? k) 82 | (!/boom! "Namespace state `%s` is empty." k) 83 | (peek (get k)))) 84 | 85 | (defn push! 86 | "Change the stack at `k` to have `v` as its [[top]] element. 87 | The stack need not be created before the first push." 88 | [k v] 89 | (alter! k #(conj (or % []) v))) 90 | 91 | (defn pop! 92 | "Change the stack at `k` to remove its [[top]]. 93 | Throws an `Exception` if the stack is empty or does not exist." 94 | [k] 95 | (let [result (top k)] 96 | (alter! k pop) 97 | result)) 98 | 99 | (defn history 100 | "The value of the store at `k` must be a stack. The elements are returned in the 101 | order they were pushed. (Thus, [[top]] is the final element.) The return value 102 | is specifically a vector. 103 | 104 | (nss/push! :s 1) 105 | (nss/push! :s 2) 106 | (nss/history :s) => [1 2] 107 | " 108 | [k] 109 | (vec (get k))) 110 | 111 | (defn flattened-history 112 | "The value of the store at `k` must be a stack. Each element must be a sequential 113 | collection. The result is a vector of `flatten` applied to the [[history]]. 114 | 115 | (nss/push! :s [1 2) 116 | (nss/push! :s []) 117 | (nss/push! :s [3]) 118 | (nss/flattened-history :s) => [1 2 3] 119 | " 120 | [k] 121 | (vec (flatten (history k)))) 122 | -------------------------------------------------------------------------------- /test/such/f_better_doc.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-better-doc (:require such.better-doc) 2 | (:use midje.sweet such.types)) 3 | 4 | 5 | (fact "doc strings have been updated" 6 | (resolve 'find-ns) => #'clojure.core/find-ns 7 | (-> #'find-ns meta :doc) => #"Other examples") 8 | 9 | ;;; The following are just tests derived from the documentation, demonstrating 10 | ;;; that it was true at one time. 11 | 12 | (def a-var) 13 | 14 | ;; ns-name 15 | (fact "`ns-name` converts either a namespace or its symbol representation into a symbol" 16 | (ns-name 'such.f-better-doc) => 'such.f-better-doc 17 | (ns-name (find-ns 'such.f-better-doc)) => 'such.f-better-doc 18 | (ns-name 'no.such.namespace) => (throws #"No namespace.*found") 19 | 20 | (fact "Note that `name` doesn't work with namespaces" 21 | (name *ns*) => (throws))) 22 | 23 | ;; find-ns 24 | (fact "`find-ns` only works on a symbol, not a namespace" 25 | (find-ns 'such.f-better-doc) => namespace? 26 | (find-ns (find-ns 'such.f-better-doc)) => (throws)) 27 | 28 | ;; ns-resolve 29 | (fact "ns-resolve can be used to find vars" 30 | (fact "it's straightforward for a non-qualified symbol" 31 | (ns-resolve *ns* 'a-var) => #'a-var 32 | (ns-resolve *ns* 'i-no-exist) => nil) 33 | 34 | (fact "the namespace argument is ignored when the symbol is namespace-qualified" 35 | (ns-resolve *ns* 'clojure.core/i-no-exist) => nil 36 | (ns-resolve *ns* 'clojure.core/even?) => #'even? 37 | (ns-resolve (find-ns 'clojure.core) 'clojure.core/even?) => #'even?) 38 | 39 | (fact "the first argument may also be a symbol" 40 | (ns-resolve 'clojure.core 'even?) => #'even? 41 | (ns-resolve 'clojure.core 'i-no-exist) => nil) 42 | 43 | (fact "if the symbol argument does not name an existing namespace, an exception is thrown" 44 | (ns-resolve 'gorp.foo 'even?) => (throws #"No namespace"))) 45 | 46 | (fact "`ns-resolve` can also be used to find classes" 47 | (fact "with fully-qualified names" 48 | (ns-resolve *ns* 'java.util.AbstractCollection) => java.util.AbstractCollection 49 | (ns-resolve 'clojure.core 'java.util.AbstractCollection) => java.util.AbstractCollection 50 | 51 | (fact "the namespace is irrelevant except that it should exist" 52 | (ns-resolve 'derp.foo 'java.util.AbstractCollection) => (throws #"No namespace"))) 53 | 54 | (fact "it can also be used to find imported names" 55 | (ns-resolve *ns* 'Object) => java.lang.Object 56 | (import 'java.util.AbstractCollection) 57 | (ns-resolve *ns* 'AbstractCollection) => java.util.AbstractCollection 58 | (fact "in such a case, the namespace matters" 59 | ;; Note that the result is nil, as with var lookup, not as with fully-qualified class lookup 60 | (ns-resolve 'clojure.core 'AbstractCollection) => nil))) 61 | 62 | (fact "`ns-resolve takes an `env` argument that can force it to return nil instead of a var" 63 | (ns-resolve *ns* {} 'a-var) => #'a-var 64 | (ns-resolve *ns* {'a-var ..irrelevant..} 'a-var) => nil 65 | (ns-resolve 'clojure.core {'even? ..irrelevant..} 'even?) => nil 66 | 67 | (fact "a namespace-qualified symbol is not masked by a symbol with the same name" 68 | (ns-resolve 'clojure.core {'even? ..irrelevant..} 'clojure.core/even?) => #'even? 69 | (ns-resolve *ns* {'a-var ..irrelevant..} 'such.f-better-doc/a-var) => #'a-var 70 | 71 | (fact "to mask it, the \"env\" must contain the namespace-qualified name (which 72 | I imagine never happens" 73 | ;; Note that the namespace is still irrelevant 74 | (ns-resolve *ns* {'clojure.core/even? ..irrelevant..} 'clojure.core/even?) => nil 75 | (ns-resolve 'clojure.core {'such.f-better-doc/a-var ..irrelevant..} 'such.f-better-doc/a-var) => nil))) 76 | 77 | 78 | (fact "The `env` argument can also prevent lookup of classes" 79 | (ns-resolve *ns* {} 'Object) => java.lang.Object 80 | (ns-resolve *ns* {'Object ..irrelevant..} 'Object) => nil 81 | 82 | (fact "as with vars, lookup of a fully-qualified classname-symbol requires same of map argument." 83 | (ns-resolve *ns* {} 'java.lang.Object) => java.lang.Object 84 | (ns-resolve *ns* {'Object ..irrelevant..} 'java.lang.Object) => java.lang.Object 85 | (ns-resolve *ns* {'java.lang.Object ..irrelevant..} 'java.lang.Object) => nil)) 86 | 87 | 88 | 89 | (fact symbol 90 | (symbol "th") => 'th 91 | (symbol *ns* "th") => (throws) 92 | (symbol 'such.f-better-doc "th") => (throws) 93 | (symbol "such.f-better-doc" "th") => 'such.f-better-doc/th 94 | (symbol "no.such.namespace" "th") => 'no.such.namespace/th) 95 | -------------------------------------------------------------------------------- /src/such/immigration.clj: -------------------------------------------------------------------------------- 1 | (ns such.immigration 2 | "[Potemkin](https://github.com/ztellman/potemkin)'s `import-vars` 3 | is the most reliable way I know to make a namespace that gathers vars from several 4 | namespaces and presents them as a unified API. This namespace builds 5 | on it. 6 | See [the tests](https://github.com/marick/suchwow/blob/master/test/such/f_immigration.clj) 7 | and [commons.clojure.core](https://github.com/marick/clojure-commons/blob/master/src/commons/clojure/core.clj) 8 | for two examples of creating a \"favorite functions\" namespace that 9 | can be included everywhere with (for example) `(ns my.ns (:use my.clojure.core))`. 10 | " 11 | (:require [potemkin.namespaces :as potemkin] 12 | [such.symbols :as symbol] 13 | [such.ns :as ns] 14 | [such.vars :as var] 15 | [such.control-flow :as flow])) 16 | 17 | (defn warning-require [sym] 18 | (when-not (find-ns sym) 19 | (binding [*out* *err*] 20 | (println (format "-------- WARNING for %s" (ns-name *ns*))) 21 | (println (format "You should include `%s` in your `ns` form." sym)) 22 | (println "Currently, you are not required to, but such behavior is ") 23 | (println "DEPRECATED and will be removed in a future release.") 24 | (println "The problem is that code without the `ns` declaration") 25 | (println "does not work with uberjars - and fails in puzzling way."))) 26 | (require sym)) 27 | 28 | ;; I hope to remove this fairly soon. 29 | (defmacro ^:no-doc next-version-potemkin-import-vars 30 | "Imports a list of vars from other namespaces." 31 | [& syms] 32 | (let [unravel (fn unravel [x] 33 | (if (sequential? x) 34 | (->> x 35 | rest 36 | (mapcat unravel) 37 | (map 38 | #(symbol 39 | (str (first x) 40 | (when-let [n (namespace %)] 41 | (str "." n))) 42 | (name %)))) 43 | [x])) 44 | syms (mapcat unravel syms)] 45 | `(do 46 | ~@(map 47 | (fn [sym] 48 | (let [vr (resolve sym) 49 | m (meta vr)] 50 | (cond 51 | (nil? vr) `(throw (ex-info (format "`%s` does not exist" '~sym) {})) 52 | (:macro m) `(potemkin/import-macro ~sym) 53 | (:arglists m) `(potemkin/import-fn ~sym) 54 | :else `(potemkin/import-def ~sym)))) 55 | syms)))) 56 | 57 | (defmacro import-vars 58 | "Import named vars from the named namespaces and make them (1) public in this 59 | namespace and (2) available for `refer` by namespaces that require this one. 60 | See [Potemkin](https://github.com/ztellman/potemkin) for more. 61 | 62 | (import-vars [clojure.math.combinatorics 63 | count-permutations permutations] 64 | [clojure.data.json 65 | write-str]) 66 | " 67 | [& namespace-and-var-descriptions] 68 | (let [namespaces (map first namespace-and-var-descriptions) 69 | requires (map (fn [ns] `(require '~ns)) namespaces)] 70 | (doseq [ns namespaces] (warning-require ns)) 71 | `(next-version-potemkin-import-vars ~@namespace-and-var-descriptions))) 72 | 73 | 74 | (defmacro import-all-vars 75 | "Import all public vars from the namespaces, using Potemkin's 76 | `import-vars`. 77 | 78 | (import-all-vars clojure.set) ; note namespace is unquoted. 79 | 80 | " 81 | [& ns-syms] 82 | (let [expand (fn [ns-sym] 83 | (warning-require ns-sym) 84 | (into (vector ns-sym) (keys (ns-publics ns-sym)))) 85 | expanded (map #(list `import-vars (expand %)) ns-syms)] 86 | `(do ~@expanded))) 87 | 88 | (defmacro import-prefixed-vars 89 | "Import all public vars from the namespace, using Potemkin's `import-vars`. 90 | Within the current namespace, the imported vars are prefixed by `prefix`, 91 | a symbol. 92 | 93 | (import-prefixed-vars clojure.string str-) ; note lack of quotes 94 | (str-trim \" f \") => \"f\" 95 | " 96 | [ns-sym prefix] 97 | (letfn [(one-call [[unqualified var]] 98 | (let [qualified (symbol/+symbol ns-sym unqualified) 99 | to (symbol/from-concatenation [prefix unqualified]) 100 | importer (flow/branch-on var 101 | var/has-macro? `potemkin/import-macro 102 | var/has-function? `potemkin/import-fn 103 | :else `potemkin/import-def)] 104 | `(do 105 | (~importer ~qualified ~to) 106 | (alter-meta! (ns/+find-var '~to) #(dissoc % :file :line :column)))))] 107 | (warning-require ns-sym) 108 | `(do 109 | ~@(map one-call (ns-publics ns-sym))))) 110 | 111 | (defn ^:no-doc namespaces 112 | [& ns-names] 113 | (println "`namespaces` has been removed in favor of potemkin/import-vars")) 114 | 115 | (defn ^:no-doc namespaces-by-reference 116 | [& ns-names] 117 | (println "`namespaces-by-reference` has been removed in favor of potemkin/import-vars")) 118 | 119 | (defn ^:no-doc selection 120 | [ns var-names] 121 | (println "`selection` has been removed in favor of potemkin/import-vars")) 122 | 123 | (defn ^:no-doc prefixed 124 | [ns prefix] 125 | (println "`selection` has been removed in favor of potemkin/import-vars")) 126 | -------------------------------------------------------------------------------- /test/such/f_readable.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-readable 2 | (:require [such.readable :as subject] 3 | [com.rpl.specter :as specter]) 4 | (:use midje.sweet)) 5 | 6 | (defmulti multi identity) 7 | (subject/set-function-elaborations! subject/default-function-elaborations) 8 | 9 | (fact fn-symbol 10 | (fact "plain functions" 11 | (subject/fn-symbol even?) => ' 12 | (subject/fn-symbol (fn [])) => ' 13 | 14 | (let [f ( ( (fn [a] (fn [b] (fn [c] (+ a b c)))) 1) 2)] 15 | (subject/fn-symbol f) => ') 16 | 17 | (let [f ( ( (fn [a] (fn [b] (fn my:tweedle-dum [c] (+ a b c)))) 1) 2)] 18 | (subject/fn-symbol f) => ')) 19 | 20 | (fact "multimethods" 21 | (subject/fn-symbol multi) => ') 22 | 23 | (fact letfn 24 | (letfn [(x [a] a)] 25 | (subject/fn-symbol x) => ')) 26 | 27 | (fact "behavior within let" 28 | (let [foo (fn [] 1)] 29 | (subject/fn-symbol foo) => ')) 30 | 31 | (fact "function-generating functions" 32 | (let [gen (fn [x] (fn [y] (+ x y)))] 33 | (subject/fn-symbol (gen 3)) => ')) 34 | 35 | (fact "readable name given" 36 | (let [f (subject/rename (fn []) 'fred)] 37 | (subject/fn-symbol f) => ')) 38 | 39 | (fact "effect of elaborations" 40 | (subject/with-function-elaborations {:anonymous-name "functoid" :surroundings ""} 41 | (subject/fn-symbol (fn [])) => 'functoid 42 | (subject/fn-symbol even?) => 'even?))) 43 | 44 | (fact fn-string 45 | (fact "plain functions" 46 | (subject/fn-string even?) => "" 47 | (subject/fn-string (fn [])) => "" 48 | 49 | (let [f ( ( (fn [a] (fn [b] (fn [c] (+ a b c)))) 1) 2)] 50 | (subject/fn-string f) => "") 51 | 52 | (let [f ( ( (fn [a] (fn [b] (fn my:tweedle-dum [c] (+ a b c)))) 1) 2)] 53 | (subject/fn-string f) => "")) 54 | 55 | (fact "multimethods" 56 | (subject/fn-string multi) => "") 57 | 58 | (fact letfn 59 | (letfn [(x [a] a)] 60 | (subject/fn-string x) => ""))) 61 | 62 | (fact value-string 63 | (fact "plain output" 64 | (subject/value 1) => 1 65 | (subject/value-string 1) => "1") 66 | 67 | (fact "given translation" 68 | (subject/with-translations [5 :five] 69 | (subject/value 5) => :five 70 | (subject/value-string 5) => ":five") 71 | (subject/value-string 5) => "5") 72 | 73 | (fact "a plain function" 74 | (subject/value even?) => ' 75 | (subject/value-string even?) => "") 76 | 77 | (fact "a translation takes precedence over the automatic name" 78 | (subject/with-translations [even? 'EVEN!] 79 | (subject/value even?) => 'EVEN! 80 | (subject/value-string even?) => "EVEN!")) 81 | 82 | (fact "flat lists of functions" 83 | (let [foo (fn [a] 1) 84 | bar (fn [a] 2)] 85 | (subject/value [(fn []) (fn []) foo bar foo even?]) 86 | => '[ ] 87 | (subject/value-string [(fn []) (fn []) foo bar foo even?]) 88 | => "[ ]")) 89 | 90 | (fact "embedded translations" 91 | (subject/with-translations [5 'five] 92 | (subject/value [3 4 5 6]) => [3 4 'five 6] 93 | (subject/value-string [3 4 5 6]) => "[3 4 five 6]")) 94 | 95 | (fact "you can translate complex structures too" 96 | (subject/with-translations [[1 2 3] 'short] 97 | (subject/value [[1 2 3] [1 2] [1 2 3 4]]) => ['short [1 2] [1 2 3 4]] 98 | (subject/value-string [[1 2 3] [1 2] [1 2 3 4]]) => "[short [1 2] [1 2 3 4]]")) 99 | 100 | (fact "translations take precedence over automatic function names" 101 | (subject/with-translations [even? :even] 102 | (subject/value-string [even? odd?]) => "[:even ]")) 103 | 104 | (fact "nested functions" 105 | (let [foo (fn [a] 1) 106 | named (subject/rename (fn [b] 2) "named")] 107 | (subject/value-string [(fn []) 108 | foo 109 | named 110 | [(fn []) foo] 111 | [[[foo]]]]) 112 | => "[ [ ] [[[]]]]")) 113 | 114 | (fact "generated functions have indexes repeated" 115 | (let [generator (fn [x] (fn [y] (+ x y))) 116 | one (generator 1) 117 | two (generator 2)] 118 | (subject/value-string one) => "" 119 | (subject/value-string [one two one two]) => "[ ]")) 120 | 121 | (fact "changing elaborations" 122 | ;; Since the `with` form is used above 123 | (let [generator (fn [x] (fn [y] (+ x y))) 124 | one (generator 1) 125 | two (generator 2)] 126 | (subject/set-function-elaborations! {:anonymous-name "derp" :surroundings "{{}}"}) 127 | (subject/value-string [ [ [generator one two two one generator]]]) 128 | => "[[[{{generator}} {{derp}} {{derp-2}} {{derp-2}} {{derp}} {{generator}}]]]" 129 | (subject/set-function-elaborations! subject/default-function-elaborations) 130 | (subject/value-string [ [ [generator one two two one generator]]]) 131 | => "[[[ ]]]"))) 132 | 133 | 134 | 135 | (fact "global transation functions" 136 | (subject/forget-translations!) 137 | (subject/value-string 5) => "5" 138 | (subject/instead-of 5 'five) 139 | (subject/value-string 5) => "five" 140 | (subject/forget-translations!) 141 | (subject/value-string 5) => "5") 142 | 143 | 144 | (fact "a combo : translations take precedence" 145 | (subject/with-translations [5 :five 146 | specter/ALL 'ALL 147 | even? odd?] 148 | (subject/value-string {even? odd?, 149 | :deep [(fn []) 3 5 [specter/ALL + specter/ALL]]}) 150 | => "{ , :deep [ 3 :five [ALL <+> ALL]]}")) 151 | -------------------------------------------------------------------------------- /src/such/function_makers.clj: -------------------------------------------------------------------------------- 1 | (ns such.function-makers 2 | "Functions that make other functions. 3 | 4 | Commonly used with a naming convention that flags such functions with 5 | `mkfn`: 6 | 7 | (ns ... 8 | (:require [such.function-makers :as mkfn])) 9 | ... 10 | (def stringlike? (mkfn/any-pred string? regex?)) 11 | ") 12 | 13 | 14 | (defn pred:any? 15 | "Constructs a strict predicate that takes a single argument. 16 | That predicate returns `true` iff any of the `preds` is 17 | truthy of that argument. 18 | 19 | (def stringlike? (mkfn/pred:any? string? regex?)) 20 | (stringlike? []) => false 21 | (stringlike? \"\") => true 22 | 23 | (def has-favs? (mkfn/pred:any? (partial some #{0 4}) odd?) 24 | (has-favs? [2 4]) => true 25 | (has-favs? [1 6]) => true 26 | 27 | Stops checking after the first success. A predicate created from 28 | no arguments always returns `true`. 29 | 30 | Note: this predates [[some-fn]]. It differs in that it always returns 31 | `true` or `false`, and that it allows zero arguments (which produces a 32 | function that always returns `true`). 33 | 34 | [[none-of?]] is the complement. 35 | " 36 | [& preds] 37 | (if (empty? preds) 38 | (constantly true) 39 | (fn [arg] 40 | (loop [[candidate & remainder :as preds] preds] 41 | (cond (empty? preds) false 42 | (candidate arg) true 43 | :else (recur remainder)))))) 44 | 45 | 46 | (defn pred:none-of? 47 | "Constructs a strict predicate that takes a single argument. 48 | That predicate returns `false` iff any of the `preds` is 49 | truthy of that argument. 50 | 51 | (def not-function? 52 | (mkfn/pred:none-of? fn? 53 | (partial instance? clojure.lang.MultiFn))) 54 | (not-function? even?) => false 55 | (not-function? \"\") => true 56 | 57 | Stops checking after the first success. A predicate created from 58 | no arguments always returns `false`. 59 | 60 | [[pred:any?]] is the complement. 61 | " 62 | [& preds] 63 | (if (empty? preds) 64 | (constantly false) 65 | (fn [arg] 66 | (loop [[candidate & remainder :as preds] preds] 67 | (cond (empty? preds) true 68 | (candidate arg) false 69 | :else (recur remainder)))))) 70 | 71 | (def pred:not-any? 72 | "Synonym for [[pred:none-of?]]." 73 | pred:none-of?) 74 | 75 | (defn pred:exception->false 76 | "Produces a new function. It returns whatever value `pred` does, except 77 | that it traps exceptions and returns `false`. 78 | 79 | ( (pred:exception->false even?) 4) => true 80 | 81 | (even? :hi) => (throws) 82 | ( (pred:exception->false even?) :hi) => false 83 | " 84 | [pred] 85 | (fn [& xs] 86 | (try (apply pred xs) 87 | (catch Exception ex false)))) 88 | 89 | 90 | (defn mkfn:lazyseq 91 | "This is used to generate the `lazyseq:x->...` functions. See the source." 92 | [prefixer] 93 | (fn two-arg-form 94 | ([transformer pred] 95 | (fn lazily-handle [[x & xs :as lazyseq]] 96 | (lazy-seq 97 | (cond (empty? lazyseq) 98 | nil 99 | 100 | (pred x) 101 | ((prefixer x (transformer x)) (lazily-handle xs)) 102 | 103 | :else 104 | (cons x (lazily-handle xs)))))) 105 | ([transformer] 106 | (two-arg-form transformer (constantly true))))) 107 | 108 | (def ^{:arglists '([f] [f pred])} 109 | lazyseq:x->abc 110 | "Takes a transformer function and an optional predicate. 111 | The transformer function must produce a collection, call it `coll`. 112 | `pred` defaults to `(constantly true)`. 113 | Produces a function that converts one lazy sequence into another. 114 | For each element of the input sequence: 115 | 116 | * If `pred` is falsey, the unchanged element is in the output sequence. 117 | 118 | * If `pred` is truthy, the new `coll` is \"spliced\" into the output 119 | sequence in place of the original element. 120 | 121 | (let [replace-with-N-copies (lazyseq:x->abc #(repeat % %))] 122 | (replace-with-N-copies [0 1 2 3]) => [1 2 2 3 3 3]) 123 | 124 | (let [replace-evens-with-N-copies (lazyseq:x->abc #(repeat % %) even?)] 125 | (replace-evens-with-N-copies [0 1 2 3]) => [1 2 2 3]) 126 | " 127 | (mkfn:lazyseq (fn [x tx] #(concat tx %)))) 128 | 129 | (def ^{:arglists '([f] [f pred])} 130 | lazyseq:x->xabc 131 | "The same behavior as [[lazyseq:x->abc]], except that the generated collection 132 | is spliced in *after* the original element, rather than replacing it. 133 | 134 | (let [augment-with-N-negatives (lazyseq:x->xabc #(repeat % (- %)))] 135 | (augment-with-N-negatives [0 1 2 3]) => [0 1 -1 2 -2 -2 3 -3 -3 -3]) 136 | " 137 | (mkfn:lazyseq (fn [x tx] #(cons x (concat tx %))))) 138 | 139 | 140 | (def ^{:arglists '([f] [f pred])} 141 | lazyseq:x->y 142 | "Takes an arbitrary function and an optional predicate. 143 | `pred` defaults to `(constantly true)`. 144 | Produces a function that converts one lazy sequence into another. 145 | It differs from the input sequence in that elements for which `pred` 146 | is truthy are replaced with `(f elt)`. 147 | 148 | (let [force-positive (lazyseq:x->y - neg?)] 149 | (force-positive [0 1 -2 -3]) => [0 1 2 3]) 150 | " 151 | (mkfn:lazyseq (fn [x tx] #(cons tx %)))) 152 | 153 | 154 | 155 | 156 | (defn lazyseq:criticize-deviationism 157 | "Produces a function that inspects a given `coll` according to the `deviancy-detector`. 158 | When a deviant element is found, the `reporter` is called for side-effect. It is given 159 | the `coll` and the deviant element as arguments. 160 | 161 | All deviant elements are reported. The original collection is returned. 162 | 163 | (def bad-attitude? neg?) 164 | (def flagged-negativity 165 | (lazyseq:criticize-deviationism (comp neg? second) 166 | (fn [coll elt] 167 | (println \"Bad attitude from\" elt)))) 168 | 169 | (def attitudes [ [:fred 32] [:joe 23] [:gary -10] [:brian -30] [:corey 10326] ]) 170 | (flagged-negativity attitudes) ;; :gary and :brian are flagged. 171 | " 172 | [deviancy-detector reporter] 173 | (fn [coll] 174 | (doseq [x coll] 175 | (when (deviancy-detector x) (reporter coll x))) 176 | coll)) 177 | 178 | 179 | 180 | ;;; Deprecated 181 | 182 | (defn ^:no-doc any-pred [& args] 183 | (println "any-pred has been deprecated in favor of pred:any?") 184 | (apply pred:any? args)) 185 | 186 | (defn ^:no-doc wrap-pred-with-catcher [& args] 187 | (println "any pred has been deprecated in favor of pred:exception->false") 188 | (apply pred:exception->false args)) 189 | 190 | 191 | 192 | -------------------------------------------------------------------------------- /src/such/casts.clj: -------------------------------------------------------------------------------- 1 | (ns such.casts 2 | " \"Be conservative in what you send, be liberal in what you accept.\" 3 | [(Postel's Robustness Principle)](http://en.wikipedia.org/wiki/Robustness_principle) 4 | 5 | Some Clojure functions require specific types of arguments, such as 6 | a symbol representing a namespace. You can use the following functions to 7 | convert from what you've got to what Clojure requires. Or you can 8 | use them to build more accepting variants of those Clojure 9 | functions." 10 | (:use such.types) 11 | (:require [such.vars :as var] 12 | [such.wrongness :as !] 13 | [clojure.string :as str])) 14 | 15 | (defn- namespacishly-split [s] 16 | (str/split s #"/")) 17 | 18 | (defn- string-parts 19 | [s] 20 | (let [substrings (namespacishly-split s)] 21 | (case (count substrings) 22 | 1 (vector nil (symbol (first substrings))) 23 | 2 (into [] (map symbol substrings)) 24 | (!/not-namespace-and-name s)))) 25 | 26 | (defn- named-namespace [named] 27 | (if (string? named) 28 | (first (string-parts named)) 29 | (namespace named))) 30 | 31 | (defn- named-name [named] 32 | (if (string? named) 33 | (second (string-parts named)) 34 | (name named))) 35 | 36 | (defn has-namespace? 37 | "`arg` *must* satisfy [[named?]] (string or `clojure.lang.Named`). 38 | Returns true iff the `arg` has a non-`nil`namespace. For a string, 39 | \"has a namespace\" means it contains exactly one slash - the part 40 | before the slash is considered the namespace. 41 | 42 | (has-namespace? :foo) => false 43 | (has-namespace? ::foo) => true 44 | (has-namespace? 'clojure.core/even?) => true 45 | (has-namespace? \"clojure.core/even?\") => true" 46 | [arg] 47 | (when-not (named? arg) (!/not-namespace-and-name arg)) 48 | (boolean (named-namespace arg))) 49 | 50 | (defn as-ns-symbol 51 | "Returns a symbol with no namespace. 52 | Use with namespace functions that require a symbol ([[find-ns]], etc.) or 53 | to convert the result of functions that return the wrong sort of reference 54 | to a namespace. (For example,`(namespace 'a/a)` returns a string.) 55 | 56 | The argument *must* be a namespace, symbol, keyword, or string. 57 | In the latter three cases, `arg` *must not* have a namespace. 58 | (But see [[extract-namespace-into-symbol]].) 59 | (Note: strings have \"namespaces\" if they contain exactly one slash. 60 | See [[as-namespace-and-name-symbols]].) 61 | 62 | The result is a symbol with no namespace. There are two cases: 63 | 64 | 1. If `arg` is a namespace, its symbol name is returned: 65 | 66 | (as-ns-symbol *ns*) => 'such.casts 67 | 68 | 2. Otherwise, the `arg` is converted to a symbol: 69 | 70 | (as-ns-symbol \"clojure.core\") => 'clojure.core 71 | (as-ns-symbol 'clojure.core) => 'clojure.core 72 | (as-ns-symbol :clojure.core) => 'clojure.core" 73 | [arg] 74 | (cond (namespace? arg) 75 | (ns-name arg) 76 | 77 | (has-namespace? arg) 78 | (!/should-not-have-namespace 'as-ns-symbol arg) 79 | 80 | :else 81 | (symbol (named-name arg)))) 82 | 83 | (defn extract-namespace-into-symbol 84 | "Extract the namespace from `arg`. 85 | 86 | The argument *must* be a namespace, symbol, keyword, or string. 87 | In the latter three cases, `arg` *must* have a namespace. 88 | (Note: strings have \"namespaces\" if they contain exactly one slash.) 89 | 90 | The result is a symbol with no namespace. There are two cases: 91 | 92 | 1. If `arg` is a namespace, its symbol name is returned: 93 | 94 | (extract-namespace-into-symbol *ns*) => 'such.casts 95 | 96 | 2. Otherwise, the \"namespace\" of the `arg` is converted to a symbol: 97 | 98 | (extract-namespace-into-symbol \"clojure.core/even?\") => 'clojure.core 99 | (extract-namespace-into-symbol 'clojure.core/even?) => 'clojure.core 100 | (extract-namespace-into-symbol :clojure.core/even?) => 'clojure.core" 101 | [arg] 102 | (cond (namespace? arg) 103 | (ns-name arg) 104 | 105 | (not (has-namespace? arg)) 106 | (!/should-have-namespace 'extract-namespace-into-symbol arg) 107 | 108 | :else 109 | (symbol (named-namespace arg)))) 110 | 111 | (defn as-namespace-and-name-symbols 112 | "`val` is something that can be thought of as having namespace and name parts. 113 | This function splits `val` and returns those two parts as symbols, except that 114 | the namespace may be nil. Accepts symbols, keywords, vars, and strings containing 115 | at most one slash. 116 | 117 | (as-namespace-and-name-symbols 'clojure.core/even?) => ['clojure.core 'even?] 118 | (as-namespace-and-name-symbols :foo) => [nil 'foo] 119 | 120 | (as-namespace-and-name-symbols #'even) => ['clojure.core 'even?] 121 | 122 | (as-namespace-and-name-symbols \"even?\") => [nil 'even?] 123 | (as-namespace-and-name-symbols \"clojure.core/even?\") => ['clojure.core 'even?] 124 | (as-namespace-and-name-symbols \"foo/bar/baz\") => (throws)" 125 | [val] 126 | (letfn [(pairify [substrings] 127 | (case (count substrings) 128 | 1 (vector nil (symbol (first substrings))) 129 | 2 (into [] (map symbol substrings)) 130 | (!/not-namespace-and-name substrings)))] 131 | (cond (string? val) 132 | (pairify (str/split val #"/")) 133 | 134 | (instance? clojure.lang.Named val) 135 | (pairify (remove nil? ((juxt namespace name) val))) 136 | 137 | (var? val) 138 | (let [var-val ^clojure.lang.Var val] 139 | (vector (ns-name (.ns var-val)) (.sym var-val))) 140 | 141 | :else 142 | (!/not-namespace-and-name val)))) 143 | 144 | (defn as-symbol-without-namespace 145 | "The argument *must* be a symbol, string, keyword, or var. In all cases, the 146 | result is a symbol without a namespace: 147 | 148 | (as-symbol-without-namespace 'clojure.core/even?) => 'even? 149 | (as-symbol-without-namespace #'clojure.core/even?) => 'even? 150 | (as-symbol-without-namespace :clojure.core/even?) => 'even? 151 | (as-symbol-without-namespace :even?) => 'even? 152 | (as-symbol-without-namespace \"even?\") => 'even? 153 | (as-symbol-without-namespace \"core.foo/bar\") => 'bar 154 | 155 | Use with namespace functions that require a symbol ([[ns-resolve]], etc.)" 156 | [arg] 157 | (second (as-namespace-and-name-symbols arg))) 158 | 159 | (defn as-string-without-namespace 160 | "The argument *must* be a symbol, string, keyword, or var. The result is a 161 | string name that omits the namespace: 162 | 163 | (as-string-without-namespace 'clojure/foo) => \"foo\" ; namespace omitted 164 | (as-string-without-namespace #'even?) => \"even?\" 165 | (as-string-without-namespace :bar) => \"bar\" ; colon omitted. 166 | (as-string-without-namespace :util.x/quux) => \"quux\" ; \"namespace\" omitted 167 | (as-string-without-namespace \"util.x/quux\") => \"quux\" ; \"namespace\" omitted" 168 | [arg] 169 | (str (as-symbol-without-namespace arg))) 170 | 171 | -------------------------------------------------------------------------------- /src/such/readable.clj: -------------------------------------------------------------------------------- 1 | (ns such.readable 2 | "Stringify nested structures such that all functions - and particular values of your 3 | choice - are displayed in a more readable way. [[value-string]] and [[fn-symbol]] are 4 | the key functions." 5 | (:refer-clojure :exclude [print]) 6 | (:require [such.symbols :as symbol] 7 | [such.types :as type] 8 | [clojure.string :as str] 9 | [clojure.repl :as repl] 10 | [com.rpl.specter :as specter])) 11 | 12 | ;;; What is stringified is controlled by two dynamically-bound variables. 13 | 14 | (def default-function-elaborations 15 | "Anonymous functions are named `fn` and functions are surrounded by `<>`" 16 | {:anonymous-name "fn" :surroundings "<>"}) 17 | 18 | (def ^:private ^:dynamic *function-elaborations* 19 | {:anonymous-name "fn" :surroundings "<>"}) 20 | 21 | (defn set-function-elaborations! 22 | "Control the way functions are prettified. Note: this does not override 23 | any value changed with `with-function-elaborations`. 24 | 25 | (set-function-elaborations! {:anonymous-name 'anon :surroundings \"\"}) 26 | " 27 | [{:keys [anonymous-name surroundings] :as all}] 28 | (alter-var-root #'*function-elaborations* (constantly all))) 29 | 30 | (defmacro with-function-elaborations 31 | "Change the function elaborations, execute the body, and revert the 32 | elaborations. 33 | 34 | (with-function-elaborations {:anonymous-name 'fun :surroundings \"{{}}\"} 35 | (fn-symbol (fn []))) => {{fun}} 36 | " 37 | [{:keys [anonymous-name surroundings] :as all} & body] 38 | `(binding [*function-elaborations* ~all] 39 | ~@body)) 40 | 41 | (def ^:private ^:dynamic *translations* 42 | "This atom contains the map from values->names that [[with-translations]] and 43 | [[value-strings]] use." 44 | (atom {})) 45 | 46 | (defn- translatable? [x] 47 | (contains? (deref *translations*) x)) 48 | 49 | (defn- translate [x] 50 | (get (deref *translations*) x)) 51 | 52 | (defn forget-translations! 53 | "There is a global store of translations from values to names, used by 54 | [[with-translations]] and [[value-strings]]. Empty it." 55 | [] 56 | (reset! *translations* {})) 57 | 58 | (defn instead-of 59 | "Arrange for [[value-string]] to show `value` as `show`. `show` is typically 60 | a symbol, but can be anything." 61 | [value show] 62 | (swap! *translations* assoc value show)) 63 | 64 | (defmacro with-translations 65 | "Describe a set of value->name translations, then execute the body 66 | (which presumably contains a call to [[value-string]]). 67 | 68 | (with-translations [5 'five 69 | {1 2} 'amap] 70 | (value-string {5 {1 2} 71 | :key [:value1 :value2 5]})) 72 | => \"{five amap, :key [:value1 :value2 five]}\" 73 | " 74 | [let-style & body] 75 | `(binding [*translations* (atom {})] 76 | (doseq [pair# (partition 2 ~let-style)] 77 | (apply instead-of pair#)) 78 | ~@body)) 79 | 80 | (defn rename 81 | "Produce a new function from `f`. It has the same behavior and metadata, 82 | except that [[fn-symbol]] and friends will use the given `name`. 83 | 84 | Note: `f` may actually be any object that allows metadata. That's irrelevant 85 | to `fn-symbol`, which accepts only functions, but it can be used to affect 86 | the output of [[value-string]]." 87 | 88 | [f name] 89 | (with-meta f (merge (meta f) {::name name}))) 90 | 91 | (defn- generate-name [f base-name anonymous-names] 92 | (if (contains? @anonymous-names f) 93 | (@anonymous-names f) 94 | (let [name (if (empty? @anonymous-names) 95 | base-name 96 | (str base-name "-" (+ 1 (count @anonymous-names))))] 97 | (swap! anonymous-names assoc f name) 98 | name))) 99 | 100 | (defn- super-demunge [f] 101 | (-> (str f) 102 | repl/demunge 103 | (str/split #"/") 104 | last 105 | (str/split #"@") 106 | first 107 | (str/split #"--[0-9]+$") 108 | first 109 | ;; last clause required by 1.5.X 110 | (str/replace "-COLON-" ":"))) 111 | 112 | (def ^:private show-as-anonymous? #{"fn" "clojure.lang.MultiFn"}) 113 | 114 | (defn elaborate-fn-symbol 115 | "A more customizable version of [[fn-symbol]]. Takes `f`, which *must* be a function 116 | or multimethod. In all cases, the return value is a symbol where `f`'s name is embedded 117 | in the `surroundings`, a string. For example, if the surroundings are \"\", a 118 | result would look like ``. 119 | 120 | `f`'s name is found by these rules, checked in 121 | order: 122 | 123 | * `f` has had a name assigned with `rename`. 124 | 125 | * `f` is a key in `(deref anonymous-names)`. The value is its name. 126 | 127 | * The function had a name assigned by `defn`, `let`, 128 | or the seldom used \"named lambda\": `(fn name [...] ...)`. 129 | Note that multimethods do not have accessible names in current versions 130 | of Clojure. They are treated as anonymous functions. 131 | 132 | * The function is anonymous and there are no other anonymous names. The name is 133 | `anonymous-name`, which is also stored in the `anonymous-names` atom. 134 | 135 | * After the first anonymous name, the names are `-2` `-3` 136 | and so on. 137 | 138 | In the single-argument version, the global or default elaborations are used, 139 | and `anonymous-names` is empty. See [[set-function-elaborations!]]. 140 | " 141 | ([f {:keys [anonymous-name surroundings]} anonymous-names] 142 | (let [candidate (if (contains? (meta f) ::name) 143 | (get (meta f) ::name) 144 | (super-demunge f))] 145 | (symbol/from-concatenation [(subs surroundings 0 (/ (count surroundings) 2)) 146 | (if (show-as-anonymous? candidate) 147 | (generate-name f anonymous-name anonymous-names) 148 | candidate) 149 | (subs surroundings (/ (count surroundings) 2))]))) 150 | ([f] 151 | (elaborate-fn-symbol f *function-elaborations* (atom {})))) 152 | 153 | 154 | (defn fn-symbol 155 | "Transform `f` into a symbol with a more pleasing string representation. 156 | `f` *must* be a function or multimethod. 157 | 158 | (fn-symbol even?) => ' 159 | (fn-symbol (fn [])) => ' 160 | (fn-symbol (fn name [])) => ' 161 | (let [foo (fn [])] (fn-symbol foo)) => ' 162 | 163 | See [[elaborate-fn-symbol]] for the gory details. 164 | " 165 | [f] 166 | (elaborate-fn-symbol f)) 167 | 168 | (defn fn-string 169 | "`str` applied to the result of [[fn-symbol]]." 170 | [f] 171 | (str (fn-symbol f))) 172 | 173 | 174 | (defn- better-aliases [x aliases] 175 | (specter/transform (specter/walker translatable?) 176 | translate 177 | x)) 178 | 179 | (defn- better-function-names [x anonymous-names] 180 | (specter/transform (specter/walker type/extended-fn?) 181 | #(elaborate-fn-symbol % *function-elaborations* anonymous-names) 182 | x)) 183 | 184 | (defn value 185 | "Like [[value-string]], but the final step of converting the value into 186 | a string is omitted. Note that this means functions are replaced by 187 | symbols." 188 | [x] 189 | (cond (translatable? x) 190 | (translate x) 191 | 192 | (type/extended-fn? x) 193 | (fn-symbol x) 194 | 195 | (coll? x) 196 | (let [anonymous-names (atom {})] 197 | (-> x 198 | (better-aliases (deref *translations*)) 199 | (better-function-names anonymous-names))) 200 | 201 | :else 202 | x)) 203 | 204 | (defn value-string 205 | "Except for special values, converts `x` into a string as with `pr-str`. 206 | Exceptions (which apply anywhere within collections): 207 | 208 | * If a value was given an alternate name in [[with-translations]] or [[instead-of]], 209 | that alternate is used. 210 | 211 | * Functions and multimethods are given better names as per [[fn-symbol]]. 212 | 213 | Examples: 214 | 215 | (value-string even?) => \"\" 216 | (value-string {1 {2 [even? odd?]}}) => \"{1 {2 [ ]}}\" 217 | 218 | (instead-of even? 'not-odd) 219 | (value-string {1 {2 [even? odd?]}}) => \"{1 {2 [not-odd ]}}\" 220 | 221 | (def generator (fn [x] (fn [y] (+ x y)))) 222 | (def add2 (generator 2)) 223 | (def add3 (generator 3)) 224 | (value-string [add2 add3 add3 add2]) => \"[ ]\" 225 | 226 | (def add4 (rename (generator 4) 'add4)) 227 | (def add5 (rename (generator 4) 'add5)) 228 | (value-string [add4 add5 add5 add4]) => \"[ ]\" 229 | " 230 | [x] 231 | (pr-str (value x))) 232 | -------------------------------------------------------------------------------- /test/such/f_relational.clj: -------------------------------------------------------------------------------- 1 | (ns such.f-relational 2 | (:require [such.versions :refer [when>=1-7]] 3 | [such.relational :as subject] 4 | [such.metadata :as meta] 5 | [clojure.set :as set] 6 | [clojure.pprint :refer [pprint]] 7 | [midje.sweet :refer :all])) 8 | 9 | (fact "confirm that clojure.set imports are really here" 10 | (fact index 11 | (subject/index [{:a 1}] [:a]) => { {:a 1} #{ {:a 1} }} 12 | 13 | (subject/index [ {:a 1} {:b 1} {:a 1, :b 1} {:c 1}] [:a :b]) 14 | => { {:a 1, :b 1} #{ {:a 1 :b 1} } 15 | {:a 1 } #{ {:a 1} } 16 | { :b 1} #{ {:b 1} } 17 | { } #{ {:c 1} }}) 18 | 19 | (fact join 20 | (let [has-a-and-b [{:a 1, :b 2} {:a 2, :b 1} {:a 2, :b 2}] 21 | has-b-and-c [{:blike 1, :c 2} {:blike 2, :c 1} {:blike 2, :c 2}]] 22 | (subject/join has-a-and-b has-b-and-c {:b :blike}) 23 | => #{{:a 1, :b 2, :blike 2, :c 1} {:a 1, :b 2, :blike 2, :c 2} 24 | {:a 2, :b 1, :blike 1, :c 2} {:a 2, :b 2, :blike 2, :c 1} 25 | {:a 2, :b 2, :blike 2, :c 2}})) 26 | ) 27 | 28 | 29 | (when>=1-7 30 | 31 | 32 | ;;;;; The two one-level indexes 33 | 34 | (fact "one-to-one indices" 35 | (let [data [{:id 1 :rest ..rest1..} {:id 2 :rest ..rest2..}] 36 | index (subject/one-to-one-index-on data :id)] 37 | (subject/index-select 1 :using index) => {:id 1 :rest ..rest1..}) 38 | 39 | (fact "one-to-one indices where the keys are compound" 40 | (let [data [{:id 1 :pk 1 :rest ..rest11..} 41 | {:id 1 :pk 2 :rest ..rest12..} 42 | {:id 2 :pk 2 :rest ..rest22..}] 43 | index (subject/one-to-one-index-on data [:id :pk])] 44 | (subject/index-select [1 1] :using index) => (first data) 45 | (subject/index-select [1 2] :using index) => (second data))) 46 | 47 | (fact "options used when selecting" 48 | (let [data [{:id 1 :rest ..rest1..} {:id 2 :rest ..rest2..}] 49 | index (subject/one-to-one-index-on data :id)] 50 | (fact "can limit the number of keys returned" 51 | (subject/index-select 1 :using index :keys [:rest]) => {:rest ..rest1..}) 52 | (fact "can add a prefix to keys as keyword..." 53 | (subject/index-select 1 :using index :prefix :pre-) => {:pre-id 1 :pre-rest ..rest1..}) 54 | (fact "both" 55 | (subject/index-select 1 :using index :keys [:rest] :prefix :pre-) => {:pre-rest ..rest1..}) 56 | 57 | (fact "options can also be provided as maps" 58 | (subject/index-select 1 {:using index :keys [:rest]}) => {:rest ..rest1..})))) 59 | 60 | 61 | (fact "one-to-many indices" 62 | (let [data [{:id 1 :rest ..rest11..} 63 | {:id 1 :rest ..rest12..} 64 | {:id 2 :rest ..rest22..}] 65 | index (subject/one-to-many-index-on data :id)] 66 | (subject/index-select 1 :using index) => (just (first data) (second data) :in-any-order)) 67 | 68 | (fact "options for one-to-many-maps" 69 | (let [data [{:id 1 "rest" ..rest11..} 70 | {:id 1 "rest" ..rest12..} 71 | {:id 2 "rest" ..rest22..}] 72 | index (subject/one-to-many-index-on data :id)] 73 | (subject/index-select 1 :using index :keys ["rest"]) => (just {"rest" ..rest11..} 74 | {"rest" ..rest12..} 75 | :in-any-order) 76 | (subject/index-select 1 :using index :keys ["rest"] :prefix "XX") 77 | => (just {"XXrest" ..rest11..} 78 | {"XXrest" ..rest12..} 79 | :in-any-order)))) 80 | 81 | ;;; A third type of index: The Combined Index 82 | 83 | (let [one-to-one-top [{:id "top" :foreign "middle"}] 84 | one-to-one-middle [{:id "middle" :foreign "bottom"} 85 | {:id "middle2" :foreign "bottom2"}] 86 | one-to-one-bottom [{:id "bottom"} 87 | {:id "bottom2"}] 88 | 89 | one-to-many-top [{:id "top" :foreign "middle"} 90 | {:id "top" :foreign "middle2"}] 91 | one-to-many-middle [{:id "middle" :foreign "bottom"} 92 | {:id "middle" :foreign "bottom2"} 93 | {:id "middle2" :foreign "bottom"} 94 | {:id "middle2" :foreign "bottom2"}] 95 | one-to-many-bottom [{:id "bottom" :tag 1} 96 | {:id "bottom" :tag 2} 97 | {:id "bottom2" :tag 3} 98 | {:id "bottom2" :tag 4}] 99 | 100 | one-to-one-top-index (subject/one-to-one-index-on one-to-one-top :id) 101 | one-to-one-middle-index (subject/one-to-one-index-on one-to-one-middle :id) 102 | one-to-one-bottom-index (subject/one-to-one-index-on one-to-one-bottom :id) 103 | 104 | one-to-many-top-index (subject/one-to-many-index-on one-to-many-top :id) 105 | one-to-many-middle-index (subject/one-to-many-index-on one-to-many-middle :id) 106 | one-to-many-bottom-index (subject/one-to-many-index-on one-to-many-bottom :id)] 107 | 108 | (fact "selecting along a path (a building block)" 109 | (fact "1-N 1-N 1-N" 110 | (#'subject/select-along-path "top" one-to-many-top-index 111 | :foreign one-to-many-middle-index 112 | :foreign one-to-many-bottom-index) 113 | => (just {:id "bottom" :tag 1} {:id "bottom" :tag 2} 114 | {:id "bottom2" :tag 3} {:id "bottom2" :tag 4} :in-any-order)) 115 | 116 | 117 | (fact "1-N 1-1 1-N" 118 | (#'subject/select-along-path "top" one-to-many-top-index 119 | :foreign one-to-one-middle-index 120 | :foreign one-to-many-bottom-index) 121 | => (just {:id "bottom" :tag 1} {:id "bottom" :tag 2} 122 | {:id "bottom2" :tag 3} {:id "bottom2" :tag 4} :in-any-order)) 123 | 124 | 125 | (fact "1-N 1-1 1-1" 126 | (#'subject/select-along-path "top" one-to-many-top-index 127 | :foreign one-to-one-middle-index 128 | :foreign one-to-one-bottom-index) 129 | => (just {:id "bottom"} {:id "bottom2"} :in-any-order)) 130 | 131 | (fact "1-1 1-N 1-1" 132 | (#'subject/select-along-path "top" one-to-one-top-index 133 | :foreign one-to-many-middle-index 134 | :foreign one-to-one-bottom-index) 135 | => (just {:id "bottom"} {:id "bottom2"} :in-any-order)) 136 | 137 | (fact "1-1 1-1 1-N" 138 | (#'subject/select-along-path "top" one-to-one-top-index 139 | :foreign one-to-one-middle-index 140 | :foreign one-to-many-bottom-index) 141 | => (just {:id "bottom" :tag 1} {:id "bottom" :tag 2} :in-any-order)) 142 | 143 | 144 | (fact "1-1 1-1 1-1" 145 | ;; Note that it does *not* remove the singleton wrapper around the return value. 146 | (#'subject/select-along-path "top" one-to-one-top-index 147 | :foreign one-to-one-middle-index 148 | :foreign one-to-one-bottom-index) 149 | => (just {:id "bottom"}))) 150 | 151 | 152 | (fact "making an index and then selecting" 153 | (fact "1-N 1-N 1-N" 154 | (let [combined-index (subject/combined-index-on one-to-many-top-index 155 | :foreign one-to-many-middle-index 156 | :foreign one-to-many-bottom-index)] 157 | (subject/index-select "top" :using combined-index) 158 | => (just {:id "bottom" :tag 1} {:id "bottom" :tag 2} 159 | {:id "bottom2" :tag 3} {:id "bottom2" :tag 4} :in-any-order))) 160 | 161 | (fact "1-N 1-1 1-N" 162 | (let [combined-index (subject/combined-index-on one-to-many-top-index 163 | :foreign one-to-one-middle-index 164 | :foreign one-to-many-bottom-index)] 165 | (subject/index-select "top" :using combined-index) 166 | => (just {:id "bottom" :tag 1} {:id "bottom" :tag 2} 167 | {:id "bottom2" :tag 3} {:id "bottom2" :tag 4} :in-any-order))) 168 | 169 | (fact "1-N 1-1 1-1" 170 | (let [combined-index (subject/combined-index-on one-to-many-top-index 171 | :foreign one-to-one-middle-index 172 | :foreign one-to-one-bottom-index)] 173 | (subject/index-select "top" :using combined-index) 174 | => (just {:id "bottom"} {:id "bottom2"} :in-any-order))) 175 | 176 | (fact "1-1 1-N 1-1" 177 | (let [combined-index (subject/combined-index-on one-to-one-top-index 178 | :foreign one-to-many-middle-index 179 | :foreign one-to-one-bottom-index)] 180 | (subject/index-select "top" :using combined-index) 181 | => (just {:id "bottom"} {:id "bottom2"} :in-any-order))) 182 | 183 | (fact "1-1 1-1 1-N" 184 | (let [combined-index (subject/combined-index-on one-to-one-top-index 185 | :foreign one-to-one-middle-index 186 | :foreign one-to-many-bottom-index)] 187 | (subject/index-select "top" :using combined-index) 188 | => (just {:id "bottom" :tag 1} {:id "bottom" :tag 2} :in-any-order))) 189 | 190 | 191 | (fact "1-1 1-1 1-1" 192 | (let [combined-index (subject/combined-index-on one-to-one-top-index 193 | :foreign one-to-one-middle-index 194 | :foreign one-to-one-bottom-index)] 195 | (subject/index-select "top" :using combined-index) 196 | => {:id "bottom"}))) 197 | 198 | 199 | (fact "a less abstract example" 200 | (let [people [{:id 1 :note "ruler of one country" :name "onesie"} 201 | {:id 2 :note "ruler of two countries" :name "twosie"} 202 | {:id 0 :note "ruler of no countries" :name "nonesie"}] 203 | 204 | rulerships [{:id 1 :country_code "ESP" :person_id 1} 205 | {:id 2 :country_code "NOR" :person_id 2} 206 | {:id 3 :country_code "ESP" :person_id 2}] 207 | 208 | countries [{:id 1 :country_code "ESP" :gdp 1690} 209 | {:id 2 :country_code "NOR" :gdp 513}] 210 | 211 | 212 | index:person-by-id (subject/one-to-one-index-on people :id) 213 | index:rulership-by-person-id (subject/one-to-many-index-on rulerships :person_id) 214 | index:country-by-country-code (subject/one-to-one-index-on countries :country_code) 215 | 216 | 217 | index:countries-by-person-id (subject/combined-index-on index:rulership-by-person-id 218 | :country_code 219 | index:country-by-country-code)] 220 | 221 | 222 | 223 | (subject/index-select 1 :using index:countries-by-person-id :keys [:gdp]) 224 | => [{:gdp 1690}] 225 | (subject/index-select 2 :using index:countries-by-person-id :keys [:gdp]) 226 | => (just {:gdp 1690} {:gdp 513} :in-any-order) 227 | (subject/index-select 0 :using index:countries-by-person-id :keys [:gdp]) 228 | => empty? 229 | 230 | ;; Use with `extend-map` (fully tested elsewhere) 231 | (-> (subject/index-select 2 :using index:person-by-id :keys [:name :id]) 232 | (subject/extend-map :using index:countries-by-person-id 233 | :via :id 234 | :keys [:country_code :gdp] 235 | :into :countries)) 236 | => (just {:name "twosie" :id 2, 237 | :countries (just {:country_code "NOR" :gdp 513} 238 | {:country_code "ESP" :gdp 1690} 239 | :in-any-order)})))) 240 | 241 | 242 | ;;; In addition to selecting elements, you can extend maps (similar to joins) 243 | 244 | (fact "one-to-one tables" 245 | (let [original-map {:id 1 :foreign_id "a" :rest ..rest1..} 246 | foreign-table [{:id "a" :val "fa"} {:id "b" :val "fb"}] 247 | foreign-index (subject/one-to-one-index-on foreign-table :id)] 248 | 249 | (subject/extend-map original-map :using foreign-index :via :foreign_id 250 | :keys [:val] :prefix "foreign-") 251 | => {:id 1 :foreign_id "a" :rest ..rest1.. :foreign-val "fa"})) 252 | 253 | (fact "one-to-one tables with compound keys" 254 | (let [original-map {:id 1 :foreign_id_alpha "a" :foreign_id_num 1 :rest ..rest1..} 255 | foreign-table [{:alpha "a" :id 1 :val "fa"} {:alpha "b" :id "2" :val "fb"}] 256 | foreign-index (subject/one-to-one-index-on foreign-table [:alpha :id])] 257 | 258 | ;; TODO: This test fails under 1.6, but not 1.7 or 1.8. 259 | (future-fact "why does this test fail 1.6 but not 1.7 or 1.8?") 260 | (subject/extend-map original-map :using foreign-index :via [:foreign_id_alpha :foreign_id_num] 261 | :keys [:val] :prefix "foreign-") 262 | => {:id 1 :foreign_id_alpha "a" :foreign_id_num 1 :rest ..rest1.. 263 | :foreign-val "fa"})) 264 | 265 | 266 | (fact "one-to-many tables merge under a given key" 267 | (let [foreign-table [{:id "a" :val "fa"} {:id "a" :val "fb"}] 268 | foreign-index (subject/one-to-many-index-on foreign-table :id)] 269 | 270 | (fact "you can add the key" 271 | (let [original-map {:id 1 :foreign_id "a" :rest ..rest1..} 272 | result (subject/extend-map original-map :using foreign-index :via :foreign_id 273 | :into :foreign-data 274 | :keys [:val] :prefix "f-")] 275 | 276 | result => (contains original-map) 277 | (:foreign-data result) => (just [{:f-val "fa"} {:f-val "fb"}] 278 | :in-any-order))) 279 | 280 | (fact "you can append to existing values" 281 | (let [original-map {:id 1 :foreign_id "a" :rest ..rest1.. 282 | :foreign-data ["already here"]} 283 | result (subject/extend-map original-map :using foreign-index :via :foreign_id 284 | :into :foreign-data 285 | :keys [:val] :prefix "f-")] 286 | (:foreign-data result) => (just ["already here" {:f-val "fa"} {:f-val "fb"}] 287 | :in-any-order))))) 288 | 289 | ;;;; Miscellany 290 | 291 | 292 | (fact "Everything works with string keys and prefixes" 293 | (future-fact "more is probably needed") 294 | (let [data [{"id" 1 "rest" ..rest1..} {"id" 2 "rest" ..rest2..}] 295 | index (subject/one-to-one-index-on data "id")] 296 | (fact "both can be strings" 297 | (subject/index-select 1 :using index :prefix "pre-") => {"pre-id" 1 "pre-rest" ..rest1..}) 298 | (fact "note that it is the type of the original key that determines type of result key" 299 | (subject/index-select 1 :using index :prefix :pre-) => {"pre-id" 1 "pre-rest" ..rest1..}))) 300 | 301 | 302 | 303 | (future-fact "error handling" 304 | (fact "bad keyword passed in `:using`, etc.") 305 | (fact "try to `extend-map` through a :key that doesn't exist")) 306 | 307 | ) ; when>=1-7 308 | -------------------------------------------------------------------------------- /src/such/better_doc.clj: -------------------------------------------------------------------------------- 1 | (ns such.better-doc 2 | "Requiring this file will replace some `clojure.core` docstrings with 3 | better versions. 4 | 5 | I'd be ecstatic if documentation like this, or derived from this, were 6 | included in clojure.core. Note that the Unlicense allows anyone to do that." 7 | (:require [such.vars :as vars])) 8 | 9 | ;; Interning copies in this namespace allows codox to find them. 10 | (defmacro ^:no-doc update-and-make-local-copy! 11 | [var doc-string] 12 | `(let [var-name# (:name (meta ~var))] 13 | (alter-meta! ~var assoc :doc ~doc-string) 14 | (ns-unmap *ns* var-name#) 15 | (intern *ns* (with-meta var-name# 16 | (assoc (meta ~var) :doc ~doc-string)) (vars/root-value ~var)))) 17 | 18 | (update-and-make-local-copy! #'clojure.core/ns-name 19 | "`ns` *must* be either a namespace or a symbol naming a namespace. 20 | If the namespace exists, its symbol-name is returned. If not, an exception is thrown. 21 | Note: the more common `name` function cannot be applied to namespaces. 22 | [Other examples](https://clojuredocs.org/clojure.core/ns-name) 23 | 24 | (ns-name *ns*) => 'such.better-doc 25 | ") 26 | 27 | (update-and-make-local-copy! #'clojure.core/find-ns 28 | "`sym` *must* be a symbol. If it names an existing namespace, that namespace is returned. 29 | Otherwise, `nil` is returned. [Other examples](https://clojuredocs.org/clojure.core/find-ns) 30 | 31 | (find-ns 'clojure.core) => # 32 | ") 33 | 34 | (update-and-make-local-copy! #'clojure.core/ns-resolve 35 | "`ns-resolve` goes from a symbol to the var or class it represents. [Other examples](https://clojuredocs.org/clojure.core/ns-resolve) 36 | 37 | 38 | The first (`ns`) argument *must* be either a namespace or a symbol naming a namespace 39 | (e.g., `'clojure.core`). The final argument `sym` *must* be a symbol. 40 | There are four cases for that final argument: 41 | 42 | 1. `sym` is not namespace qualified (e.g., `'even?`), and you hope it corresponds 43 | to a var in `ns`. If there is a var that (1) is \"available\" in `ns` and 44 | (2) has the same name as `sym`, it is returned. Otherwise, `nil` is returned. 45 | \"Available\" means the var has either been `intern`ed in the namespace or `refer`ed 46 | into it. 47 | 48 | (ns-resolve *ns* 'a-var) => #'this.namespace/a-var 49 | (ns-resolve *ns* 'even?) => #'clojure.core/even? 50 | (ns-resolve 'clojure.core 'even?) => #'clojure.core/even? 51 | 52 | 2. `sym` is a namespace-qualified symbol (e.g., `'clojure.core/even?`) that you 53 | hope corresponds to a var. 54 | The behavior is the same as (1), except that `ns` is not used. 55 | The symbol's namespace is used instead. 56 | 57 | (ns-resolve *ns* 'clojure.core/even?) => #'clojure.core/even? 58 | 59 | Note: Even though the `ns` argument is not used in the lookup, 60 | it must still either be a namespace or a symbol that names an 61 | *existing* namespace. If not, an exception will be thrown. 62 | 63 | Because `ns` is unused, `resolve` is better for this case. 64 | 65 | 3. `sym` is a fully qualified class name (e.g., `'java.lang.Object`). If such 66 | a class exists, it is returned. Otherwise, a `ClassNotFoundException` is thrown. 67 | The `ns` argument is ignored, except that it must be a namespace or a symbol 68 | naming one. 69 | 70 | (ns-resolve *ns* 'java.lang.Object) => java.lang.Object 71 | 72 | Because `ns` is unused, `resolve` is better for this case. 73 | 74 | 4. `sym` is a symbol you hope names a class `import`ed into `ns`. If there is 75 | a class with that (unqualified) name in `ns`, it is returned. 76 | 77 | (ns-resolve 'clojure.core 'Object) => java.lang.Object 78 | (import 'java.util.AbstractCollection) 79 | (ns-resolve *ns* 'AbstractCollection) => java.util.AbstractCollection 80 | 81 | If the class hasn't been imported, the function returns `nil` (rather than 82 | throwing an exception, as in the fully-qualified case). 83 | 84 | (ns-resolve 'clojure.core 'AbstractMethodHandlerFactoryFactory) => nil 85 | (ns-resolve 'clojure.core 'java.lang.AbstractMethodHandlerFactoryFactory) => (throws) 86 | 87 | In the three-argument case, the second `env` argument is a map whose keys 88 | *must* be symbols. If any of the keys are `=` to the final argument, `nil` is 89 | returned (instead of a match, if any). 90 | 91 | (ns-resolve *ns* 'even?) => #'clojure.core/even? 92 | (ns-resolve *ns* '{even? \"irrelevant\"} 'even?) => nil 93 | (ns-resolve *ns* 'Object) => java.lang.Object 94 | (ns-resolve *ns* '{Object \"irrelevant\"} 'Object) => nil 95 | 96 | [Other examples](https://clojuredocs.org/clojure.core/ns-resolve) 97 | ") 98 | 99 | 100 | (update-and-make-local-copy! #'clojure.core/symbol 101 | "Creates a symbol from its arguments, which *must* be strings. 102 | The name of that result is `name`. In the one-argument version, 103 | the result's namespace is `nil`. In the two-argument version, it's 104 | `ns`. Note that `ns` need not refer to an existing namespace: 105 | 106 | (symbol \"no.such.namespace\" \"the\") => 'no.such.namespace/the 107 | ") 108 | 109 | (update-and-make-local-copy! #'clojure.core/butlast 110 | "Return a seq of all but the last item in coll, in linear time. 111 | If you are working on a vector and want the result to be a vector, use `pop`.") 112 | 113 | 114 | (update-and-make-local-copy! #'clojure.core/every-pred 115 | "Take N functions and produce a single predicate - call it `result`. `result` 116 | will return `true` iff each of the original functions returns a truthy 117 | value. `result` evaluates the functions in order, and the first one that produces 118 | a falsey value stops any further checking. In that case, `false` is returned. 119 | 120 | See also [[some-fn]]. 121 | 122 | ( (every-pred integer? even? pos?) \"hi\") => false 123 | ( (every-pred integer? even? pos?) 4) => true 124 | ") 125 | 126 | 127 | (update-and-make-local-copy! #'clojure.core/some-fn 128 | "Take N functions and produce a single function - call it `result`. `result` 129 | evaluates the N functions in order. When one returns a truthy result, `result` 130 | skips the remaining functions and returns that result. If none of the functions 131 | returns a truthy value, `result` returns a falsey value. 132 | 133 | This function is called `some-fn` because it does not produce a pure (true/false) 134 | result. See also [[every-pred]]. 135 | 136 | ( (some-fn even? pos?) 3) => true 137 | ( (some-fn even? pos?) -3) => false 138 | 139 | ( (some-fn second first) [1 2 3]) => 2 140 | ( (some-fn second first) [1]) => 1 141 | ( (some-fn second first) []) => nil 142 | ") 143 | 144 | 145 | (update-and-make-local-copy! #'clojure.core/some 146 | "Apply `pred` to each element in `coll` until it returns a truthy value, 147 | then return that value (*not* the element). This can be used to ask 148 | the question \"is there an even value in the collection?\": 149 | 150 | (some even? [1 2 3 4]) => true 151 | 152 | However, as signaled by the lack of a '?' in `some`, its value is not 153 | necessarily a boolean. Here is how you would ask \"is there a value 154 | greater than zero and, if so, what is the first of them?\": 155 | 156 | (some #(and (pos? %) %) [-1 -3 2 4]) => 2 157 | 158 | `some` is often used to ask the question \"is X in the collection?\". 159 | That takes advantage of how sets can be treated as a \"contains value?\" 160 | function: 161 | 162 | (#{1 2 3} 2) => 2 163 | (#{1 2 3} -88) => nil 164 | 165 | So: 166 | 167 | (some #{2} [1 2 3]) => 2 168 | (some #{2} [-1 -2 -3]) => nil 169 | 170 | You may find [[any?]] (in `such.shorthand`) easier to remember. 171 | 172 | It's easy to forget that `some` returns the *value of the predicate*, 173 | not the element itself. To be sure you get the element, do this: 174 | 175 | (first (filter pred coll)) 176 | 177 | That's [[find-first]] in `such.shorthand`. 178 | ") 179 | 180 | 181 | (update-and-make-local-copy! #'clojure.core/sequential? 182 | "True of lazy sequences, vectors, and lists. False for other 183 | Clojure built-in types. Note: perhaps surprisingly, *not* true 184 | of strings and java arrays. 185 | Any new type can be `sequential?` if it implements the Java 186 | interface `Sequential`, a marker interface that has no methods.") 187 | 188 | (update-and-make-local-copy! #'clojure.core/cond-> 189 | "The `clauses` have two parts: a *test expression* and a *form*. 190 | An entire `cond->` expression looks like this: 191 | 192 | (cond-> 193 | 194 | 195 | ...) 196 | 197 | The independent tests do *not* have the value of `expr` threaded 198 | into them. If, however, `independent-test-1` is truthy, the 199 | value of `expr` will be threaded into `exec-1`, using the rules of `->`. 200 | The resulting value will be threaded into the value of `exec2` 201 | when `independent-test-2` is truthy. 202 | 203 | Examples will clarify. Here is a `cond->` form that threads through 204 | each of the `exec` forms: 205 | 206 | (cond-> 1 207 | true inc 208 | true inc 209 | true inc) 210 | => 4 211 | 212 | Here's an example that illustrates that the original `expr` has *nothing to do* 213 | with the tests: 214 | 215 | (cond-> 1 216 | string? inc 217 | string? inc 218 | string? inc) 219 | => 4 220 | 221 | The result is 4 because `string?`, a function, is a truthy value. 222 | 223 | Here's an example of a function that takes arguments describing which 224 | branches to take: 225 | 226 | (defn brancher [& branches] 227 | (letfn [(take? [n] (contains? (set branches) n))] 228 | (cond-> [] 229 | (take? 1) (conj 1) 230 | (take? 2) (conj 2) 231 | (take? 3) (conj 3)))) 232 | 233 | (brancher 1 3) => [1 3] 234 | ") 235 | 236 | (update-and-make-local-copy! #'clojure.core/cond->> 237 | "This is like [[cond->]], except that values are threaded into the 238 | last position, as with `->>`. 239 | 240 | (cond->> [1 2 3] 241 | false (map inc) ; not taken 242 | true (map -)) 243 | => [-1 -2 -3]") 244 | 245 | (update-and-make-local-copy! #'clojure.core/reduce 246 | "`reduce` converts a collection into a single value. Except for 247 | one exception (described below), `f` must take two arguments. 248 | `+` takes two arguments, so it can be used to reduce a collection 249 | of numbers to their sum: 250 | 251 | (reduce + 0 [1 2 3 4]) => 10 252 | 253 | `+` is called four times. Here is the sequence of calls. 254 | 255 | (+ 0 1) => 1 ; sum of first element 256 | (+ 1 2) => 3 ; sum of first two elements 257 | (+ 3 3) => 6 ; sum of first three elements 258 | (+ 6 4) => 10 ; ... 259 | 260 | At any point, the first argument to `f` is the \"reduction\" of all 261 | the previous calls to `f`, and the second argument is the next 262 | collection element to add into the reduction. When defining functions to 263 | use with `reduce`, the first argument is often called `acc` (for 264 | \"accumulator\") or `so-far`. 265 | 266 | When using `+`, the distinction between the two arguments isn't 267 | clear, so here's an example that returns the longest string in a 268 | collection: 269 | 270 | (reduce (fn [max-so-far elt] 271 | (if (> (count elt) max-so-far) 272 | (count elt) 273 | max-so-far)) 274 | 0 275 | [\"abc\" \"ab\" \"abcd\" \"a\"]) => 4 276 | 277 | When you're surprised by the results of a call to `reduce`, you 278 | can use [[reductions]] as an easy way to see what's going on: 279 | 280 | (reductions + 0 [1 2 3 4]) 281 | => (0 1 3 6 10) 282 | 283 | `reductions` returns a collection of all the first arguments to `f` 284 | plus the final result. 285 | 286 | Reduce is lazy, so the reduction isn't done until the result is used. 287 | 288 | The **two-argument form** can be used when `(f val (first coll))` 289 | is the same as `(first coll)`. That's the case with `+`, where 290 | `(+ 0 1)` is `1`. So, in the two argument form, the first call to `f` 291 | uses the first argument of the collection as the starting reduction 292 | and begins working with the second element: 293 | 294 | (reduce + [1 2 3 4]) => 10 295 | (reductions + [1 2 3 4]) => (1 3 6 10) ; slightly different result 296 | 297 | **Small arrays:** `f` takes two values. What if there aren't two values 298 | to give it? There's one special case 299 | for the three-argument form: 300 | 301 | (reduce + 0 []) => 0 302 | (reductions + 0 []) => (0) 303 | 304 | In this case, `val` is returned and `f` is never called. 305 | 306 | There are two special two-argument cases. The first is when there's 307 | only one element in the collection: 308 | 309 | (reduce + [10]) => 10 310 | 311 | The handling is really the same as the above, since the first argument in 312 | the collection is treated as the starting `val`. More interesting is the 313 | empty collection: 314 | 315 | (reduce + []) => 0 316 | (reductions + []) => (0) 317 | 318 | Here, `f` *is* called, but with zero arguments. It happens that `(+)` is `0`. 319 | In the longest-string example, though, the result is not so pretty: 320 | 321 | (reduce (fn [max-so-far elt]...) []) 322 | ArityException Wrong number of args (0) ... 323 | 324 | **See also:** [[reductions]], [[reduce-kv]] 325 | ") 326 | 327 | (update-and-make-local-copy! #'clojure.core/reductions 328 | "Perform a [[reduce]] but don't return only the final reduction. 329 | Return a sequence of the intermediate reductions, ending with the 330 | final reduction. 331 | 332 | Consider this reduction that produces nested vectors: 333 | 334 | (reduce (fn [so-far elt] (vector (conj so-far elt))) 335 | [] 336 | [1 2 3 4 5]) 337 | => [[[[[[1] 2] 3] 4] 5]] 338 | 339 | Using `reductions` instead: 340 | 341 | (reductions (fn [so-far elt] (vector (conj so-far elt))) 342 | [] 343 | [1 2 3 4 5]) 344 | => ([] 345 | [[1]] 346 | [[[1] 2]] 347 | [[[[1] 2] 3]] [[[[[1] 2] 3] 4]] [[[[[[1] 2] 3] 4] 5]]) 348 | 349 | To be more precise, the result is a sequence of the first arguments to 350 | `f`, followed by the final value. Those are slightly different in the two-argument 351 | and three-argument cases: 352 | 353 | (reductions + 0 [1 2 3]) => (0 1 3 6) 354 | (reductions + [1 2 3]) => ( 1 3 6) 355 | 356 | The sequence is lazy: 357 | 358 | (take 3 (reductions (fn [so-far elt] (vector (conj so-far elt))) 359 | [] 360 | (range))) ; infinite list here 361 | => ([] [[0]] [[[0] 1]]) 362 | ") 363 | 364 | (update-and-make-local-copy! #'clojure.core/reduce-kv 365 | "For maps, `reduce-kv` is a trivial variant on [[reduce]]. The following 366 | two functions are the same: 367 | 368 | (reduce (fn [so-far [key val]] ...) ... {...} 369 | (reduce-kvs (fn [so-far key val ] ...) ... {...} 370 | 371 | For vectors, `reduce-kv` is to `reduce` as [[map-indexed]] is to `map`: 372 | it provides indexes as well as collection elements. The argument list 373 | is `[reduction-so-far index element]`. 374 | 375 | This example sums up the indices and values of a vector: 376 | 377 | (reduce-kv + 0 [-1 -2 -3 -4]) => -4 378 | 379 | It works because `+` allows three arguments. Here's an example that converts 380 | a vector to a map whose keys are the vector indexes: 381 | 382 | (reduce-kv (fn [acc i elt] (assoc acc i elt)) 383 | {} 384 | [\"0\" \"2\" \"3\" \"4\"]) 385 | => {0 \"0\", 1 \"2\", 2 \"3\", 3 \"4\"} 386 | 387 | If `coll` is empty, `init` is returned and `f` is not called. 388 | ") 389 | 390 | 391 | (update-and-make-local-copy! #'clojure.core/map-indexed 392 | "In the two-argument form, the following two are equivalent: 393 | 394 | (map-indexed f coll) 395 | (map f (range) coll) 396 | 397 | Thus, `f` should accept two arguments: the index of an element in `coll` 398 | and the element itself. 399 | 400 | (map-indexed vector [:a :b :c]) => ([0 :a] [1 :b] [2 :c]) 401 | 402 | Like `map`, `map-indexed` is lazy. 403 | 404 | The single argument form produces a transducer. 405 | ") 406 | 407 | -------------------------------------------------------------------------------- /src/such/relational.clj: -------------------------------------------------------------------------------- 1 | (ns such.relational 2 | "This namespace provides two things: better documentation for relational 3 | functions in `clojure.set`, and an *experimental* set of functions for 4 | \"pre-joining\" relational tables for a more tree-structured or path-based 5 | lookup. See [the wiki](https://github.com/marick/suchwow/wiki/such.relational) 6 | for more about the latter. 7 | 8 | The API for the experimental functions may change without triggering a [semver](http://semver.org/) major number change." 9 | (:require [clojure.set :as set] 10 | [such.better-doc :as doc] 11 | [such.maps :as map] 12 | [such.imperfection :refer :all] 13 | [such.shorthand :refer :all] 14 | [such.wrongness :refer [boom!]] 15 | [such.metadata :as meta]) 16 | (:refer-clojure :exclude [any?])) 17 | 18 | 19 | 20 | (doc/update-and-make-local-copy! #'clojure.set/index 21 | "`xrel` is a collection of maps; consider it the result of an SQL SELECT. 22 | `ks` is a collection of values assumed to be keys of the maps (think table columns). 23 | The result maps from particular key-value pairs to a set of all the 24 | maps in `xrel` that contain them. 25 | 26 | Consider this `xrel`: 27 | 28 | (def xrel [ {:first \"Brian\" :order 1 :count 4} 29 | {:first \"Dawn\" :order 1 :count 6} 30 | {:first \"Paul\" :order 1 :count 5} 31 | {:first \"Sophie\" :order 2 :count 9} ]) 32 | 33 | Then `(index xrel [:order])` is: 34 | 35 | {{:order 1} 36 | #{{:first \"Paul\", :order 1, :count 5} 37 | {:first \"Dawn\", :order 1, :count 6} 38 | {:first \"Brian\", :order 1, :count 4}}, 39 | {:order 2} 40 | #{{:first \"Sophie\", :order 2, :count 9}}} 41 | 42 | ... and `(index xrel [:order :count])` is: 43 | 44 | {{:order 1, :count 4} #{ {:first \"Brian\", :order 1, :count 4} }, 45 | {:order 1, :count 6} #{ {:first \"Dawn\", :order 1, :count 6} }, 46 | {:order 1, :count 5} #{ {:first \"Paul\", :order 1, :count 5} }, 47 | {:order 2, :count 9} #{ {:first \"Sophie\", :order 2, :count 9} }} 48 | 49 | If one of the `xrel` maps doesn't have an key, it is assigned to an index without 50 | that key. Consider this `xrel`: 51 | 52 | (def xrel [ {:a 1, :b 1} {:a 1} {:b 1} {:c 1}]) 53 | 54 | Then `(index xrel [:a b])` is: 55 | 56 | { {:a 1, :b 1} #{ {:a 1 :b 1} } 57 | {:a 1 } #{ {:a 1} } 58 | { :b 1} #{ {:b 1} } 59 | { } #{ {:c 1} }}) 60 | ") 61 | 62 | 63 | (doc/update-and-make-local-copy! #'clojure.set/join 64 | "`xrel` and `yrel` are collections of maps (think SQL SELECT). 65 | In the first form, produces the [natural join](https://en.wikipedia.org/wiki/Join_%28SQL%29#Natural_join). 66 | That is, it joins on the shared keys. In the following, `:b` is shared: 67 | 68 | (def has-a-and-b [{:a 1, :b 2} {:a 2, :b 1} {:a 2, :b 2}]) 69 | (def has-b-and-c [{:b 1, :c 2} {:b 2, :c 1} {:b 2, :c 2}]) 70 | (join has-a-and-b has-b-and-c) => #{{:a 1, :b 2, :c 1} 71 | {:a 1, :b 2, :c 2} 72 | 73 | {:a 2, :b 1, :c 2} 74 | 75 | {:a 2, :b 2, :c 1} 76 | {:a 2, :b 2, :c 2}}} 77 | 78 | Alternately, you can use a map to describe which left-hand-side keys should be 79 | considered the same as which right-hand-side keys. In 80 | the above case, the sharing could be made explicit with `(join 81 | has-a-and-b has-b-and-c {:b :b})`. 82 | 83 | A more likely example is one where the two relations have slightly different 84 | \"b\" keys, like this: 85 | 86 | (def has-a-and-b [{:a 1, :b 2} {:a 2, :b 1} {:a 2, :b 2}]) 87 | (def has-b-and-c [{:blike 1, :c 2} {:blike 2, :c 1} {:blike 2, :c 2}]) 88 | 89 | In such a case, the join would look like this: 90 | 91 | (join has-a-and-b has-b-and-c {:b :blike}) => 92 | #{{:a 1, :b 2, :blike 2, :c 1} 93 | {:a 1, :b 2, :blike 2, :c 2} 94 | 95 | {:a 2, :b 1, :blike 1, :c 2} 96 | 97 | {:a 2, :b 2, :blike 2, :c 1} 98 | {:a 2, :b 2, :blike 2, :c 2}} 99 | 100 | Notice that the `:b` and `:blike` keys are both included. 101 | 102 | The join when there are no keys shared is the cross-product of the relations. 103 | 104 | (clojure.set/join [{:a 1} {:a 2}] [{:b 1} {:b 2}]) 105 | => #{{:a 1, :b 2} {:a 2, :b 1} {:a 1, :b 1} {:a 2, :b 2}} 106 | 107 | The behavior when maps are missing keys is probably not something you should 108 | depend on. 109 | ") 110 | 111 | (doc/update-and-make-local-copy! #'clojure.set/project 112 | "`xrel` is a collection of maps (think SQL `SELECT *`). This function 113 | produces a set of maps, each of which contains only the keys in `ks`. 114 | 115 | (project [{:a 1, :b 1} {:a 2, :b 2}] [:b]) => #{{:b 1} {:b 2}} 116 | 117 | `project` differs from `(map #(select-keys % ks) ...)` in two ways: 118 | 119 | 1. It returns a set, rather than a lazy sequence. 120 | 2. Any metadata on the original `xrel` is preserved. (It shares this behavior 121 | with [[rename]] but with no other relational functions.) 122 | ") 123 | 124 | (doc/update-and-make-local-copy! #'clojure.set/rename 125 | "`xrel` is a collection of maps. Transform each map according to the 126 | keys and values in `kmap`. Each map key that matches a `kmap` key is 127 | replaced with that `kmap` key's value. 128 | 129 | (rename [{:a 1, :b 2}] {:b :replacement}) => #{{:a 1, :replacement 2}} 130 | 131 | `rename` differs from `(map #(set/rename-keys % kmap) ...)` in two ways: 132 | 133 | 1. It returns a set, rather than a lazy sequence. 134 | 2. Any metadata on the original `xrel` is preserved. (It shares this behavior 135 | with [[project]] but with no other relational functions.) 136 | ") 137 | 138 | ;;; Extensions 139 | 140 | 141 | (defn- force-sequential [v] 142 | (if (sequential? v) v (vector v))) 143 | 144 | (defn- mkfn:key-for-index 145 | "Given [:x :y], produce a function that takes [1 2] and 146 | returns {:x 1 :y 2}" 147 | [map-keys] 148 | (fn [map-values] 149 | (apply hash-map (interleave map-keys map-values)))) 150 | 151 | (defn- multi-get [kvs keyseq] 152 | "(multi-get {:x 1, :y 2, :z 3} [:x :z]) => [1 3]" 153 | (vals (select-keys kvs (force-sequential keyseq)))) 154 | 155 | (defn- prefix-all-keys [kvs prefix] 156 | (letfn [(prefixer [k] 157 | (-> (str (name prefix) (name k)) 158 | (cond-> (keyword? k) keyword)))] 159 | (let [translation (apply hash-map 160 | (interleave (keys kvs) 161 | (map prefixer (keys kvs))))] 162 | (set/rename-keys kvs translation)))) 163 | 164 | (defn- option-controlled-merge [old new options] 165 | (if-let [destination (:into options)] 166 | (let [current (or (get old destination) []) 167 | extended (into current new)] 168 | (assoc old destination extended)) 169 | (merge old new))) 170 | 171 | 172 | ;; Use of indexes is controlled by metadata 173 | 174 | (defn- one-to-one-index? [index] 175 | (= :one-to-one (meta/get index ::type))) 176 | (defn- one-to-many-index? [index] 177 | (= :one-to-many (meta/get index ::type))) 178 | 179 | (defn- index-keyseq [index] 180 | (meta/get index ::keyseq)) 181 | 182 | 183 | (defn- with-one-to-one-metadata [index keyseq] 184 | (meta/assoc index 185 | ::type :one-to-one 186 | ::keyseq keyseq ; the keys this is an index on (a singleton like [:id] 187 | ;; convert a singleton sequence (a value like `[5]`) into the format 188 | ;; clojure.set/index wants: `{:id 5}` 189 | ::key-maker (mkfn:key-for-index keyseq) 190 | 191 | ::value-handler first ; the result is always a set containing one value 192 | ::key-selector select-keys ; how to pick a smaller (projected map) 193 | ::prefix-adder prefix-all-keys)) 194 | 195 | (defn- with-one-to-many-metadata [index keyseq] 196 | (meta/assoc index 197 | ::type :one-to-many 198 | ::keyseq keyseq 199 | ::key-maker (mkfn:key-for-index keyseq) 200 | 201 | ::value-handler identity ; multiple values are returned 202 | ::key-selector (fn [value keyseq] 203 | (mapv #(select-keys % keyseq) value)) 204 | ::prefix-adder (fn [value prefix] 205 | (mapv #(prefix-all-keys % prefix) value)))) 206 | 207 | 208 | 209 | ;;;; Public 210 | 211 | (defn one-to-one-index-on 212 | "`table` should be a sequence of maps. `keyseq` is either a single value 213 | (corresponding to a traditional `:id` or `:pk` entry) or a sequence of 214 | values (corresponding to a compound key). 215 | 216 | The resulting index provides fast access to individual maps. 217 | 218 | (def index:traditional (one-to-one-index-on table :id)) 219 | (index-select 5 :using index:traditional :keys [:key1 :key2]) 220 | 221 | (def index:compound (one-to-one-index-on table [\"intkey\" \"strkey\"))) 222 | (index-select [4 \"dawn\"] :using index:compound) 223 | 224 | Note that keys need not be Clojure keywords. 225 | " 226 | [table keyseq] 227 | (if (sequential? keyseq) 228 | (-> table 229 | (index keyseq) 230 | (with-one-to-one-metadata keyseq)) 231 | (one-to-one-index-on table [keyseq]))) 232 | 233 | 234 | (defn one-to-many-index-on 235 | "`table` should be a sequence of maps. `keyseq` is either a single value 236 | (corresponding to a traditional `:id` or `:pk` entry) or a sequence of 237 | values (corresponding to a compound key). 238 | 239 | The resulting index provides fast retrieval of vectors of matching maps. 240 | 241 | (def index:traditional (one-to-many-index-on table :id)) 242 | (index-select 5 :using index:traditional :keys [:key-i-want]) ; a vector of maps 243 | 244 | (def index:compound (one-to-many-index-on table [\"intkey\" \"strkey\"))) 245 | (index-select [4 \"dawn\"] :using index:compound) ; a vector of maps 246 | 247 | Keys may be either Clojure keywords or strings. 248 | " 249 | [table keyseq] 250 | (if (sequential? keyseq) 251 | (-> table 252 | (index keyseq) 253 | (with-one-to-many-metadata keyseq)) 254 | (one-to-many-index-on table [keyseq]))) 255 | 256 | (defn index-select 257 | "Produce a map by looking a key up in an index. 258 | 259 | See [the wiki](https://github.com/marick/suchwow/wiki/such.relational) for examples. 260 | 261 | `key` is a unique or compound key that's been indexed with [[one-to-one-index-on]] 262 | or [[one-to-many-index-on]]. The `options` may be given as N keys and values 263 | following `key` (Smalltalk style) or as a single map. They are: 264 | 265 | :using 266 | (required) The index to use. 267 | :keys <[keys...]> 268 | (optional) Keys you're interested in (default is all of them) 269 | :prefix 270 | (optional) Prepend the given prefix to all the keys in the selected map. 271 | The prefix may be either a string or keyword. The resulting key will be 272 | of the same type (string or keyword) as the original. 273 | 274 | The return value depends on the index. If it is `one-to-one`, a map is returned. 275 | If it is `one-to-many`, a vector of maps is returned. 276 | " 277 | ([key options] 278 | (assert (contains? options :using) "You must provide an index with `:using`.") 279 | (when-let [keys (options :keys)] 280 | (assert (vector? keys) ":keys takes a vector as an argument")) 281 | 282 | (let [index (get options :using) 283 | 284 | [key-maker value-handler key-selector prefix-adder] 285 | (mapv #(meta/get index %) 286 | [::key-maker ::value-handler ::key-selector ::prefix-adder]) 287 | 288 | [desired-keys prefix] (mapv #(get options %) [:keys :prefix])] 289 | 290 | (-> index 291 | (get (key-maker (force-sequential key))) 292 | value-handler 293 | (cond-> desired-keys (key-selector desired-keys)) 294 | (cond-> prefix (prefix-adder prefix))))) 295 | ([key k v & rest] ; k and v are to give this different arity than above 296 | (index-select key (apply hash-map k v rest)))) 297 | 298 | 299 | (defn extend-map 300 | "Add more key/value pairs to `kvs`. They are found by looking up values 301 | in a [[one-to-one-index-on]] or [[one-to-many-index-on]] index. 302 | 303 | See [the wiki](https://github.com/marick/suchwow/wiki/such.relational) for examples. 304 | 305 | The `options` control what maps are returned and how they're merged into the 306 | original `kvs`. They may be given as N keys and values 307 | following the `kvs` argument (Smalltalk style) or as a single map. They are: 308 | 309 | :using 310 | (required) The index to use. 311 | :via 312 | (required) A single foreign key or a sequence of them that is used to 313 | look up a map in the . 314 | :into 315 | (optional, relevant only to a one-to-many map). Since a one-to-many map 316 | can't be merged into the `kvs`, it has to be added \"under\" (as the 317 | value of) a particular `key`. 318 | :keys [key1 key2 key3 ...] 319 | (optional) Keys you're interested in (default is all of them) 320 | :prefix 321 | (optional) Prepend the given prefix to all the keys in the selected map. 322 | The prefix may be either a string or keyword. The resulting key will be 323 | of the same type (string or keyword) as the original. 324 | " 325 | 326 | ([kvs options] 327 | (assert (contains? options :via) "You must provide a foreign key with `:via`.") 328 | (assert (contains? options :using) "You must provide an index with `:using`.") 329 | (when (one-to-many-index? (:using options)) 330 | (assert (contains? options :into) "When using a one-to-many index, you must provide `:into`")) 331 | 332 | (let [foreign-key-value (multi-get kvs (:via options))] 333 | (option-controlled-merge kvs 334 | (index-select foreign-key-value options) 335 | options))) 336 | 337 | ([kvs k v & rest] ; k and v are to give this different arity than above 338 | (extend-map kvs (apply hash-map k v rest)))) 339 | 340 | 341 | ;;;; 342 | 343 | (defn- select-along-path 344 | "This is not really intended for public use. Note: doesn't handle compound keys." 345 | [val starting-index & foreign-index-pairs] 346 | (loop [many-return-values? false 347 | result [{::sentinel-key val}] 348 | [foreign-key next-index & remainder :as all] 349 | (concat [::sentinel-key starting-index] foreign-index-pairs)] 350 | 351 | (cond (empty? all) 352 | result ; note that even 1-1 indexes return a set result. 353 | 354 | (one-to-one-index? next-index) 355 | (recur many-return-values? 356 | (set (map #(index-select (get % foreign-key) :using next-index) result)) 357 | remainder) 358 | 359 | :else 360 | (recur true 361 | (set (mapcat #(index-select (get % foreign-key) :using next-index) result)) 362 | remainder)))) 363 | 364 | (defn combined-index-on 365 | "Create an index that maps directly from values in the starting index to values 366 | in the last of the list of indexes, following keys to move from index to index. 367 | Example: 368 | 369 | (let [index:countries-by-person-id (subject/combined-index-on index:rulership-by-person-id 370 | :country_code 371 | index:country-by-country-code)] 372 | (subject/index-select 1 :using index:countries-by-person-id :keys [:gdp]) 373 | => [{:gdp 1690}]) 374 | 375 | (See [the wiki](https://github.com/marick/suchwow/wiki/such.relational) for details.) 376 | " 377 | {:arglists '([starting-index foreign-key next-index ...])} 378 | [starting-index & path-pairs] 379 | (let [raw-index (reduce (fn [so-far key-and-value-map] 380 | (let [starting-val (multi-get key-and-value-map 381 | (index-keyseq starting-index))] 382 | (assoc so-far 383 | key-and-value-map 384 | (apply select-along-path 385 | starting-val starting-index path-pairs)))) 386 | {} 387 | (keys starting-index)) 388 | ;; Bit of sliminess here in that we're checking the metadata on non-indexes 389 | metadata-adder (if (any? one-to-many-index? (cons starting-index path-pairs)) 390 | with-one-to-many-metadata 391 | with-one-to-one-metadata)] 392 | (metadata-adder raw-index (index-keyseq starting-index)))) 393 | --------------------------------------------------------------------------------