├── .github └── workflows │ └── test.yml ├── .gitignore ├── CHANGELOG.md ├── README.md ├── bin ├── push_docs.sh ├── release.sh └── setup_codox.sh ├── deps.edn ├── project.clj ├── src └── plumbing │ ├── core.cljc │ ├── fnk │ ├── README.md │ ├── impl.clj │ ├── pfnk.cljc │ └── schema.cljc │ ├── graph.cljc │ ├── graph │ └── positional.clj │ ├── graph_async.cljc │ ├── lazymap.clj │ └── map.cljc └── test └── plumbing ├── core_test.cljc ├── fnk ├── fnk_examples_test.cljc ├── pfnk_test.cljc └── schema_test.cljc ├── graph_async_test.cljc ├── graph_examples_test.cljc ├── graph_perf_test.clj ├── graph_test.cljc ├── lazymap_test.clj ├── map_test.cljc └── test_runner.cljs /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: Test 2 | 3 | on: 4 | push: 5 | branches: 6 | - master 7 | pull_request: 8 | schedule: 9 | # monthly 10 | - cron: "0 0 1 * *" 11 | 12 | env: 13 | #bump to clear caches 14 | ACTION_CACHE_VERSION: 'v1' 15 | 16 | jobs: 17 | test: 18 | strategy: 19 | matrix: 20 | java: ['8', '11', '17'] 21 | runs-on: ubuntu-latest 22 | steps: 23 | - name: Checkout 24 | uses: actions/checkout@v2 25 | - uses: actions/cache@v2 26 | with: 27 | path: ~/.m2/repository 28 | key: ${{ env.ACTION_CACHE_VERSION }}-${{ runner.os }}-maven-${{ hashFiles('**/project.clj') }}-${{ matrix.java }} 29 | restore-keys: | 30 | ${{ env.ACTION_CACHE_VERSION }}-${{ runner.os }}-maven-${{ hashFiles('**/project.clj') }}- 31 | - name: Prepare java 32 | uses: actions/setup-java@v2 33 | with: 34 | distribution: 'temurin' 35 | java-version: ${{ matrix.java }} 36 | - uses: actions/setup-node@v2 37 | with: 38 | node-version: '10.13.0' 39 | - name: Install clojure tools 40 | uses: DeLaGuardo/setup-clojure@3.5 41 | with: 42 | lein: 2.9.8 43 | - name: Run tests 44 | run: lein all test 45 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .lein-failures 2 | *~ 3 | pom.xml 4 | pom.xml.asc 5 | target/** 6 | .*.swp 7 | .nrepl-port 8 | .repl 9 | out 10 | .lein-repl-history 11 | /doc/ 12 | .cpcache/ 13 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | ## 0.6.0 2 | * **BREAKING** Minimum supported Clojure version is now 1.8 3 | * migrate cljx => cljc 4 | * Fix #138: Compile graphs bigger than 100 nodes with interpreted mode in Clojure 5 | 6 | ## 0.5.5 7 | * Bump schema dependency to avoid issues with Clojure 1.9 out of the box. 8 | 9 | ## 0.5.4 10 | * Allow redefining keys in an inner scope, and clarify the semantics. 11 | * Nicer error messages for `safe-get`, `safe-select-keys`, `merge-disjoint`. 12 | 13 | ## 0.5.3 14 | * **Deprecate** `keywordize-map` in favor of `clojure.walk/keywordize-keys` 15 | * Fix dependent optional bindings (e.g. (fnk [a {b a}])) broken in 0.5.1 16 | * Fnks remember their name, and named fnks can be used without a key in `graph/graph` forms (with an implicit key generated from `(keyword (name f))`). 17 | 18 | ## 0.5.2 19 | * Fix broken cycle check in Clojurescript topological sort. 20 | 21 | ## 0.5.1 22 | * (Experimental) include default values as metadata on fnk schemas. 23 | 24 | ## 0.5.0 25 | * **BREAKING**: Bump to Schema 1.0.1, breaking compatibility with pre-1.0.0 Schema. 26 | 27 | ## 0.4.4 28 | * Bump to latest Schema version, which should fix AOT compilation when used with Clojure 1.7-RC1 and later. 29 | 30 | ## 0.4.3 31 | * Actually fix *update* warnings under Clojure 1.7 (commit missed the 0.4.2 release). 32 | 33 | ## 0.4.2 34 | * Letk now supports simple symbol bindings as well as map destructuring bindings. 35 | * Fix *update* warnings under Clojure 1.7. 36 | 37 | ## 0.4.1 38 | * Fix concurrency issue recently introduced in distinct-by in Clojure (sequence had to be realized in creator thread due to transient restrictions) 39 | 40 | ## 0.4.0 41 | * **Breaking** Bump dependencies, potemkin no longer included transitively through schema. 42 | 43 | ## 0.3.7 44 | * Add support for destructuring namespaced keywords, i.e. 45 | `(= 1 (letk [[a/b] {:a/b 1}] b))` and `(= 1 ((fnk [a/b] b) {:a/b 1}))` 46 | * Fix warnings about `*clojurescript-version*` when compiling ClojureScript 47 | 48 | ## 0.3.6 49 | * **BREAKING**: Define `update` only if `clojure.core/update` does not exist (ie. legacy clojure(script) versions) 50 | 51 | ## 0.3.5 52 | * Fix bug in `safe-get` in ClojureScript due to missing `:include-macros true` in plumbing.core 53 | 54 | ## 0.3.4 55 | * Add `plumbing.map/keyword-map`, `plumbing.core/if-letk`, `plumbing.core/when-letk` 56 | * Bump schema version to 0.3.1, fixing cljs warnings from that project, and move schema.macros calls over to schema.core. 57 | * Minimum required schema version is now 0.3.0 58 | 59 | ## 0.3.3 60 | * Properly generate cross-platform assertions, fixing ClojureScript errors that tried to throw Java errors. 61 | 62 | ## 0.3.2 63 | * Fix cljs compilation issue appearing in some circumstances (No such namespace: js) 64 | 65 | ## 0.3.1 66 | * Fix cljs issue where plumbing.fnk.schema was missing from dependency tree 67 | 68 | ## 0.3.0 69 | * **BREAKING**: `?>` and `?>>` require a body expression in parens, and take an arbitrary number of body expressions. 70 | * Add ClojureScript support via cljx 71 | * Add plumbing.graph-async namespace to define asynchronous graphs using core.async channels. A core.async dependency has *not* been added to project.clj and must be supplied by user if this namespace is used. 72 | * Add `update` and `mapply` to plumbing.core 73 | 74 | ## 0.2.2 75 | * Don't depend on a specific Clojure version, and add support for Clojure 1.6.x 76 | 77 | ## 0.2.1 78 | * Fix for issues with AOT compilation after introducing schema 79 | 80 | ## 0.2.0 81 | * Replace fnk/graph's internal schema format with `prismatic/schema`. This is a breaking change if (and only if) you've explicitly written old-style fnk/graph schemas like `{:x true :y false}`, or code for manipulating such schemas. 82 | * Drop support for Clojure 1.4.x 83 | 84 | ## 0.1.1 85 | * Fix bug when aliasing optional values with arg names, i.e. `(let [a 1] ((fnk [{a a}] a) {}))` 86 | * Implement well-defined semantics for optional values that reference other symbols bound within a (let/(de)fnk) form, matching Clojure: symbols are bound in the order given, so that an optional value can reference a symbol bound within the same destructuring form iff that symbol appears earlier in the form. 87 | * Add update-in-when, grouped-map, conk-when, cons-when, rsort-by, as->> to plumbing.core 88 | 89 | ## 0.1.0 90 | * Minor bugfixes and improved tests 91 | * Perf improvements for `map-keys` and `map-vals` (thanks [bendlas](https://github.com/bendlas)!) 92 | * Pulled out [lazymap](https://bitbucket.org/kotarak/lazymap) as a dependency. `plumbing.lazymap` is no more -- it's now included indirectly as `lazymap.core`. Thanks to Meikel Brandmeyer for a great library, and working with us to extend it to accommodate Graph's use case. 93 | * Lazily compiled graphs are now lazy about checking for required inputs, so a lazily compiled graph fn can be called without inputs not needed for computing the subset of outputs that will be extracted. 94 | * Explicit output-schema metadata on a fnk is taken as gold, rather than being merged with explicit data by analyzing the fnk body, and must be explicit rather than a spec. 95 | * Moved `comp-partial` from pfnk to graph, and added `instance` for fnks/graphs 96 | * Automatic efficient positional forms for fnks that take no rest args. 97 | * A new `eager-compile` that can produce graphs that are almost as fast as hand-coded replacements, by avoiding maps internally where possible using positional fns, and using Records when maps are necessary. The old `eager-compile` is still available as `interpreted-eager-compile`. 98 | 99 | ## 0.0.1 100 | * Initial release 101 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Plumbing and Graph: the Clojure utility belt 2 | 3 | prismatic/plumbing logo 4 | 5 | This first release includes our '[Graph](http://plumatic.github.io/prismatics-graph-at-strange-loop)' library, our `plumbing.core` library of very commonly used functions (the only namespace we `:use` across our codebase), and a few other supporting namespaces. 6 | 7 | *New in 0.3.0: support for ClojureScript* 8 | 9 | *New in 0.2.0: support for schema.core/defn-style schemas on fnks and Graphs. See `(doc fnk)` for details.* 10 | 11 | Leiningen dependency (Clojars): 12 | 13 | [![Clojars Project](http://clojars.org/prismatic/plumbing/latest-version.svg)](http://clojars.org/prismatic/plumbing) 14 | 15 | [Latest API docs](http://plumatic.github.io/plumbing). 16 | 17 | **This is an alpha release. We are using it internally in production, but the API and organizational structure are subject to change. Comments and suggestions are much appreciated.** 18 | 19 | Check back often, because we'll keep adding more useful namespaces and functions as we work through cleaning up and open-sourcing our stack of Clojure libraries. 20 | 21 | ## Graph: the Functional Swiss-Army Knife 22 | 23 | Graph is a simple and *declarative* way to specify a structured computation, which is easy to analyze, change, compose, and monitor. Here's a simple example of an ordinary function definition, and its Graph equivalent: 24 | 25 | ```clojure 26 | (require '[plumbing.core :refer (sum)]) 27 | (defn stats 28 | "Take a map {:xs xs} and return a map of simple statistics on xs" 29 | [{:keys [xs] :as m}] 30 | (assert (contains? m :xs)) 31 | (let [n (count xs) 32 | m (/ (sum identity xs) n) 33 | m2 (/ (sum #(* % %) xs) n) 34 | v (- m2 (* m m))] 35 | {:n n ; count 36 | :m m ; mean 37 | :m2 m2 ; mean-square 38 | :v v ; variance 39 | })) 40 | 41 | (require '[plumbing.core :refer (fnk sum)]) 42 | (def stats-graph 43 | "A graph specifying the same computation as 'stats'" 44 | {:n (fnk [xs] (count xs)) 45 | :m (fnk [xs n] (/ (sum identity xs) n)) 46 | :m2 (fnk [xs n] (/ (sum #(* % %) xs) n)) 47 | :v (fnk [m m2] (- m2 (* m m)))}) 48 | ``` 49 | 50 | A Graph is just a map from keywords to keyword functions ([learn more](#fnk)). In this case, `stats-graph` represents the steps in taking a sequence of numbers (`xs`) and producing univariate statistics on those numbers (i.e., the mean `m` and the variance `v`). The names of arguments to each `fnk` can refer to other steps that must happen before the step executes. For instance, in the above, to execute `:v`, you must first execute the `:m` and `:m2` steps (mean and mean-square respectively). 51 | 52 | We can "compile" this Graph to produce a single function (equivalent to `stats`), which also checks that the map represents a valid Graph: 53 | 54 | ```clojure 55 | (require '[plumbing.graph :as graph] '[schema.core :as s]) 56 | (def stats-eager (graph/compile stats-graph)) 57 | 58 | (= {:n 4 59 | :m 3 60 | :m2 (/ 25 2) 61 | :v (/ 7 2)} 62 | (into {} (stats-eager {:xs [1 2 3 6]}))) 63 | 64 | ;; Missing :xs key exception 65 | (thrown? Throwable (stats-eager {:ys [1 2 3]})) 66 | ``` 67 | 68 | Moreover, as of the 0.1.0 release, `stats-eager` is *fast* -- only about 30% slower than the hand-coded `stats` if `xs` has a single element, and within 5% of `stats` if `xs` has ten elements. 69 | 70 | Unlike the opaque `stats` fn, however, we can modify and extend `stats-graph` using ordinary operations on maps: 71 | 72 | ```clojure 73 | (def extended-stats 74 | (graph/compile 75 | (assoc stats-graph 76 | :sd (fnk [^double v] (Math/sqrt v))))) 77 | 78 | (= {:n 4 79 | :m 3 80 | :m2 (/ 25 2) 81 | :v (/ 7 2) 82 | :sd (Math/sqrt 3.5)} 83 | (into {} (extended-stats {:xs [1 2 3 6]}))) 84 | ``` 85 | 86 | A Graph encodes the structure of a computation, but not how it happens, allowing for many execution strategies. For example, we can compile a Graph lazily so that step values are computed as needed. Or, we can parallel-compile the Graph so that independent step functions are run in separate threads: 87 | 88 | ```clojure 89 | (def lazy-stats (graph/lazy-compile stats-graph)) 90 | 91 | (def output (lazy-stats {:xs [1 2 3 6]})) 92 | ;; Nothing has actually been computed yet 93 | (= (/ 25 2) (:m2 output)) 94 | ;; Now :n and :m2 have been computed, but :v and :m are still behind a delay 95 | 96 | 97 | (def par-stats (graph/par-compile stats-graph)) 98 | 99 | (def output (par-stats {:xs [1 2 3 6]})) 100 | ;; Nodes are being computed in futures, with :m and :m2 going in parallel after :n 101 | (= (/ 7 2) (:v output)) 102 | ``` 103 | 104 | We can also ask a Graph for information about its inputs and outputs (automatically computed from its definition): 105 | 106 | ```clojure 107 | (require '[plumbing.fnk.pfnk :as pfnk]) 108 | 109 | ;; stats-graph takes a map with one required key, :xs 110 | (= {:xs s/Any} 111 | (pfnk/input-schema stats-graph)) 112 | 113 | ;; stats-graph outputs a map with four keys, :n, :m, :m2, and :v 114 | (= {:n s/Any :m s/Any :m2 s/Any :v s/Any} 115 | (pfnk/output-schema stats-graph)) 116 | ``` 117 | 118 | If schemas are provided on the inputs and outputs of the node functions, these propagate through into the Graph schema as expected. 119 | 120 | We can also have higher-order functions on Graphs to wrap the behavior on each step. For instance, we can automatically profile each sub-function in 'stats' to see how long it takes to execute: 121 | 122 | ```clojure 123 | (def profiled-stats (graph/compile (graph/profiled ::profile-data stats-graph))) 124 | 125 | ;;; times in milliseconds for each step: 126 | (= {:n 1.001, :m 0.728, :m2 0.996, :v 0.069} 127 | @(::profile-data (profiled-stats {:xs (range 10000)}))) 128 | ``` 129 | 130 | … and so on. For more examples and details about Graph, check out the [graph examples test](https://github.com/plumatic/plumbing/blob/master/test/plumbing/graph_examples_test.cljc). 131 | 132 | 133 | 134 | ## Bring on (de)fnk 135 | 136 | Many of the functions we write (in Graph and elsewhere) take a single (nested) map argument with keyword keys and have expectations about which keys must be present and which are optional. We developed a new style of binding ([read more here](https://github.com/plumatic/plumbing/tree/master/src/plumbing/fnk)) to make this a lot easier and to check that input data has the right 'shape'. We call these 'keyword functions' (defined by `defnk`) and here's what one looks like: 137 | 138 | ```clojure 139 | (use 'plumbing.core) 140 | (defnk simple-fnk [a b c] 141 | (+ a b c)) 142 | 143 | (= 6 (simple-fnk {:a 1 :b 2 :c 3})) 144 | ;; Below throws: Key :c not found in (:a :b) 145 | (thrown? Throwable (simple-fnk {:a 1 :b 2})) 146 | ``` 147 | 148 | You can declare a key as optional and provide a default: 149 | ```clojure 150 | (defnk simple-opt-fnk [a b {c 1}] 151 | (+ a b c)) 152 | 153 | (= 4 (simple-opt-fnk {:a 1 :b 2})) 154 | ``` 155 | 156 | You can do nested map bindings: 157 | ```clojure 158 | (defnk simple-nested-fnk [a [:b b1] c] 159 | (+ a b1 c)) 160 | 161 | (= 6 (simple-nested-fnk {:a 1 :b {:b1 2} :c 3})) 162 | ;; Below throws: Expected a map at key-path [:b], got type class java.lang.Long 163 | (thrown? Throwable (simple-nested-fnk {:a 1 :b 1 :c 3})) 164 | ``` 165 | 166 | Of course, you can bind multiple variables from an inner map and do multiple levels of nesting: 167 | ```clojure 168 | (defnk simple-nested-fnk2 [a [:b b1 [:c {d 3}]]] 169 | (+ a b1 d)) 170 | 171 | (= 4 (simple-nested-fnk2 {:a 1 :b {:b1 2 :c {:d 1}}})) 172 | (= 5 (simple-nested-fnk2 {:a 1 :b {:b1 1 :c {}}})) 173 | ``` 174 | 175 | You can also use this binding style in a `let` statement using `letk` 176 | or within an anonymous function by using `fnk`. 177 | 178 | 179 | ## More good stuff 180 | 181 | There are a bunch of functions in `plumbing.core` that we can't live without. Here are a few of our favorites. 182 | 183 | When we build maps, we often use `for-map`, which works like `for` but for maps: 184 | 185 | ```clojure 186 | (use 'plumbing.core) 187 | (= (for-map [i (range 3) 188 | j (range 3) 189 | :let [s (+ i j)] 190 | :when (< s 3)] 191 | [i j] 192 | s) 193 | {[0 0] 0, [0 1] 1, [0 2] 2, [1 0] 1, [1 1] 2, [2 0] 2}) 194 | ``` 195 | 196 | `safe-get` is like `get` but throws when the key doesn't exist: 197 | 198 | ```clojure 199 | ;; IllegalArgumentException Key :c not found in {:a 1, :b 2} 200 | (thrown? Exception (safe-get {:a 1 :b 2} :c)) 201 | ``` 202 | 203 | Another frequently used map function is `map-vals`: 204 | 205 | ```clojure 206 | ;; return k -> (f v) for [k, v] in map 207 | (= (map-vals inc {:a 0 :b 0}) 208 | {:a 1 :b 1}) 209 | ``` 210 | 211 | Ever wanted to conditionally do steps in a `->>` or `->`? Now you can with our 212 | 'penguin' operators. Here's a few examples: 213 | 214 | ```clojure 215 | (use 'plumbing.core) 216 | (= (let [add-b? false] 217 | (-> {:a 1} 218 | (merge {:c 2}) 219 | (?> add-b? (assoc :b 2)))) 220 | {:a 1 :c 2}) 221 | 222 | (= (let [inc-all? true] 223 | (->> (range 10) 224 | (filter even?) 225 | (?>> inc-all? (map inc)))) 226 | [1 3 5 7 9]) 227 | ``` 228 | 229 | Check out [`plumbing.core`](https://github.com/plumatic/plumbing/blob/master/src/plumbing/core.cljc) for many other useful functions. 230 | 231 | ## ClojureScript 232 | 233 | As of 0.3.0, plumbing is available in ClojureScript! The vast majority of the 234 | library supports ClojureScript, with the only exceptions that are JVM-specific 235 | optimizations. 236 | 237 | Here's an example usage of `for-map`: 238 | 239 | ```clojure 240 | (ns plumbing.readme 241 | (:require [plumbing.core :refer-macros [for-map]])) 242 | 243 | (defn js-obj->map 244 | "Recursively converts a JavaScript object into a map with keyword keys" 245 | [obj] 246 | (for-map [k (js-keys obj) 247 | :let [v (aget obj k)]] 248 | (keyword k) (if (object? v) (js-obj->map v) v))) 249 | 250 | (is (= {:a 1 :b {:x "x" :y "y"}} 251 | (js-obj->map 252 | (js-obj "a" 1 253 | "b" (js-obj "x" "x" 254 | "y" "y"))))) 255 | 256 | ;; Note: this is a contrived example; you would normally use `cljs.core/clj->js` 257 | ``` 258 | 259 | ## Community 260 | 261 | Plumbing now has a [mailing list](https://groups.google.com/forum/#!forum/prismatic-plumbing). Please feel free to join and ask questions or discuss how you're using Plumbing and Graph. 262 | 263 | ## Supported Clojure versions 264 | 265 | Plumbing is currently supported on Clojure 1.8 or later, and the latest ClojureScript version. 266 | 267 | ## License 268 | 269 | Distributed under the Eclipse Public License, the same as Clojure. 270 | -------------------------------------------------------------------------------- /bin/push_docs.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -e 3 | 4 | # Script to generate docs and push to github pages. 5 | # https://github.com/weavejester/codox/wiki/Deploying-to-GitHub-Pages 6 | cd `dirname $0` 7 | 8 | git fetch --tags 9 | latestTag=$(git describe --tags `git rev-list --tags --max-count=1`) 10 | git checkout $latestTag 11 | 12 | lein doc 13 | cd ../doc 14 | git checkout gh-pages # To be sure you're on the right branch 15 | git add . 16 | git commit -am "new documentation push." 17 | git push -u origin gh-pages 18 | cd .. 19 | git checkout - -------------------------------------------------------------------------------- /bin/release.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -e 3 | 4 | # Script to push a release with lein-release and then push docs. 5 | cd `dirname $0` 6 | lein release 7 | ./push_docs.sh 8 | -------------------------------------------------------------------------------- /bin/setup_codox.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -e 3 | 4 | # One-time script to setup codox deploy to github pages. 5 | # https://github.com/weavejester/codox/wiki/Deploying-to-GitHub-Pages 6 | cd `dirname $0` 7 | cd .. 8 | 9 | rm -rf doc && mkdir doc 10 | git clone git@github.com:plumatic/plumbing.git doc 11 | cd doc 12 | git symbolic-ref HEAD refs/heads/gh-pages 13 | rm .git/index 14 | git clean -fdx -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src"] 2 | :deps {prismatic/schema {:mvn/version "1.2.0"}}} 3 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject prismatic/plumbing "0.6.1-SNAPSHOT" 2 | :description "Prismatic's Clojure utility belt." 3 | :url "https://github.com/plumatic/plumbing" 4 | :license {:name "Eclipse Public License - v 1.0" 5 | :url "http://www.eclipse.org/legal/epl-v10.html" 6 | :distribution :repo} 7 | 8 | :dependencies [[prismatic/schema "1.2.0"]] 9 | 10 | :profiles {:dev {:dependencies [[org.clojure/clojure "1.10.3"] 11 | [org.clojure/clojurescript "1.10.891"] 12 | [org.clojure/core.async "1.4.627"]] 13 | :plugins [[codox "0.10.8"] 14 | [lein-cljsbuild "1.1.8"] 15 | [lein-doo "0.1.10"]]} 16 | :1.8 {:dependencies [[org.clojure/clojure "1.8.0"]]} 17 | :1.9 {:dependencies [[org.clojure/clojure "1.9.0"]]} 18 | :1.11 {:dependencies [[org.clojure/clojure "1.11.0-master-SNAPSHOT"]] 19 | :repositories [["sonatype-oss-public" {:url "https://oss.sonatype.org/content/groups/public"}]]}} 20 | 21 | :aliases {"all" ["with-profile" "+1.8:+1.9:+dev:+1.11"] 22 | "deploy" ["do" "deploy" "clojars"] 23 | "test" ["do" "test," "doo" "node" "test" "once"]} 24 | 25 | :lein-release {:deploy-via :shell 26 | :shell ["lein" "deploy"]} 27 | 28 | :source-paths ["src"] 29 | :test-paths ["test"] 30 | 31 | :cljsbuild {:builds 32 | {:dev {:source-paths ["src"] 33 | :compiler {:output-to "target/main.js" 34 | :optimizations :whitespace 35 | :pretty-print true}} 36 | :test {:source-paths ["src" "test"] 37 | :compiler {:output-to "target/unit-test.js" 38 | :main plumbing.test-runner 39 | :target :nodejs 40 | :pretty-print true}}}} 41 | 42 | :codox {:src-dir-uri "http://github.com/plumatic/plumbing/blob/master/" 43 | :src-linenum-anchor-prefix "L"} 44 | 45 | :jvm-opts ^:replace []) 46 | -------------------------------------------------------------------------------- /src/plumbing/core.cljc: -------------------------------------------------------------------------------- 1 | (ns plumbing.core 2 | "Utility belt for Clojure in the wild" 3 | (:refer-clojure :exclude [update]) 4 | #?(:cljs 5 | (:require-macros 6 | [plumbing.core :refer [for-map lazy-get]] 7 | [schema.macros :as schema-macros])) 8 | (:require 9 | [schema.utils :as schema-utils] 10 | #?(:clj [schema.macros :as schema-macros]) 11 | [plumbing.fnk.schema :as schema #?@(:cljs [:include-macros true])] 12 | #?(:clj [plumbing.fnk.impl :as fnk-impl]))) 13 | 14 | #?(:clj (set! *warn-on-reflection* true)) 15 | 16 | (def ^:private +none+ 17 | "A sentinel value representing missing portions of the input data." 18 | ::missing) 19 | 20 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 21 | ;;; Maps 22 | 23 | #?(:clj 24 | (defmacro for-map 25 | "Like 'for' for building maps. Same bindings except the body should have a 26 | key-expression and value-expression. If a key is repeated, the last 27 | value (according to \"for\" semantics) will be retained. 28 | 29 | (= (for-map [i (range 2) j (range 2)] [i j] (even? (+ i j))) 30 | {[0 0] true, [0 1] false, [1 0] false, [1 1] true}) 31 | 32 | An optional symbol can be passed as a first argument, which will be 33 | bound to the transient map containing the entries produced so far." 34 | ([seq-exprs key-expr val-expr] 35 | `(for-map ~(gensym "m") ~seq-exprs ~key-expr ~val-expr)) 36 | ([m-sym seq-exprs key-expr val-expr] 37 | `(let [m-atom# (atom (transient {}))] 38 | (doseq ~seq-exprs 39 | (let [~m-sym @m-atom#] 40 | (reset! m-atom# (assoc! ~m-sym ~key-expr ~val-expr)))) 41 | (persistent! @m-atom#))))) 42 | 43 | (defn map-vals 44 | "Build map k -> (f v) for [k v] in map, preserving the initial type" 45 | [f m] 46 | (cond 47 | (sorted? m) 48 | (reduce-kv (fn [out-m k v] (assoc out-m k (f v))) (sorted-map) m) 49 | (map? m) 50 | (persistent! (reduce-kv (fn [out-m k v] (assoc! out-m k (f v))) (transient {}) m)) 51 | :else 52 | (for-map [[k v] m] k (f v)))) 53 | 54 | (defn map-keys 55 | "Build map (f k) -> v for [k v] in map m" 56 | [f m] 57 | (if (map? m) 58 | (persistent! (reduce-kv (fn [out-m k v] (assoc! out-m (f k) v)) (transient {}) m)) 59 | (for-map [[k v] m] (f k) v))) 60 | 61 | (defn map-from-keys 62 | "Build map k -> (f k) for keys in ks" 63 | [f ks] 64 | (for-map [k ks] k (f k))) 65 | 66 | (defn map-from-vals 67 | "Build map (f v) -> v for vals in vs" 68 | [f vs] 69 | (for-map [v vs] (f v) v)) 70 | 71 | (defn dissoc-in 72 | "Dissociate this keyseq from m, removing any empty maps created as a result 73 | (including at the top-level)." 74 | [m [k & ks]] 75 | (when m 76 | (if-let [res (and ks (dissoc-in (get m k) ks))] 77 | (assoc m k res) 78 | (let [res (dissoc m k)] 79 | (when-not (empty? res) 80 | res))))) 81 | 82 | (defn ^:deprecated keywordize-map 83 | "DEPRECATED. prefer clojure.walk/keywordize-keys. 84 | 85 | Recursively convert maps in m (including itself) 86 | to have keyword keys instead of string" 87 | [x] 88 | (cond 89 | (map? x) 90 | (for-map [[k v] x] 91 | (if (string? k) (keyword k) k) (keywordize-map v)) 92 | (seq? x) 93 | (map keywordize-map x) 94 | (vector? x) 95 | (mapv keywordize-map x) 96 | :else 97 | x)) 98 | 99 | #?(:clj 100 | (defmacro lazy-get 101 | "Like get but lazy about default" 102 | [m k d] 103 | `(if-let [pair# (find ~m ~k)] 104 | (val pair#) 105 | ~d))) 106 | 107 | (defn safe-get 108 | "Like get but throw an exception if not found" 109 | [m k] 110 | (lazy-get 111 | m k 112 | (schema/assert-iae false "Key %s not found in %s" k 113 | (binding [*print-length* 200] 114 | (print-str (mapv key m)))))) 115 | 116 | (defn safe-get-in 117 | "Like get-in but throws exception if not found" 118 | [m ks] 119 | (if (seq ks) 120 | (recur (safe-get m (first ks)) (next ks)) 121 | m)) 122 | 123 | (defn assoc-when 124 | "Like assoc but only assocs when value is truthy" 125 | [m & kvs] 126 | (assert (even? (count kvs))) 127 | (into (or m {}) 128 | (for [[k v] (partition 2 kvs) 129 | :when v] 130 | [k v]))) 131 | 132 | (defn update-in-when 133 | "Like update-in but returns m unchanged if key-seq is not present." 134 | [m key-seq f & args] 135 | (let [found (get-in m key-seq +none+)] 136 | (if-not (identical? +none+ found) 137 | (assoc-in m key-seq (apply f found args)) 138 | m))) 139 | 140 | (defn grouped-map 141 | "Like group-by, but accepts a map-fn that is applied to values before 142 | collected." 143 | [key-fn map-fn coll] 144 | (persistent! 145 | (reduce 146 | (fn [ret x] 147 | (let [k (key-fn x)] 148 | (assoc! ret k (conj (get ret k []) (map-fn x))))) 149 | (transient {}) coll))) 150 | 151 | 152 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 153 | ;;; Seqs 154 | 155 | (defn aconcat 156 | "Like (apply concat s) but lazier (and shorter) " 157 | [s] 158 | (lazy-cat (first s) (when-let [n (next s)] (aconcat n)))) 159 | 160 | (defn unchunk 161 | "Takes a seqable and returns a lazy sequence that 162 | is maximally lazy and doesn't realize elements due to either 163 | chunking or apply. 164 | 165 | Useful when you don't want chunking, for instance, 166 | (first awesome-website? (map slurp +a-bunch-of-urls+)) 167 | may slurp up to 31 unneed webpages, wherease 168 | (first awesome-website? (map slurp (unchunk +a-bunch-of-urls+))) 169 | is guaranteed to stop slurping after the first awesome website. 170 | 171 | Taken from http://stackoverflow.com/questions/3407876/how-do-i-avoid-clojures-chunking-behavior-for-lazy-seqs-that-i-want-to-short-ci" 172 | [s] 173 | (when (seq s) 174 | (cons (first s) 175 | (lazy-seq (unchunk (rest s)))))) 176 | 177 | (defn sum 178 | "Return sum of (f x) for each x in xs" 179 | ([f xs] (reduce + (map f xs))) 180 | ([xs] (reduce + xs))) 181 | 182 | (defn singleton 183 | "returns (first xs) when xs has only 1 element" 184 | [xs] 185 | (when-let [xs (seq xs)] 186 | (when-not (next xs) 187 | (first xs)))) 188 | 189 | (defn indexed 190 | "Returns [idx x] for x in seqable s" 191 | [s] 192 | (map-indexed vector s)) 193 | 194 | (defn positions 195 | "Returns indices idx of sequence s where (f (nth s idx))" 196 | [f s] 197 | (keep-indexed (fn [i x] (when (f x) i)) s)) 198 | 199 | #?(:clj 200 | (defn frequencies-fast 201 | "Like clojure.core/frequencies, but faster. 202 | Uses Java's equal/hash, so may produce incorrect results if 203 | given values that are = but not .equal" 204 | [xs] 205 | (let [res (java.util.HashMap.)] 206 | (doseq [x xs] 207 | (.put res x (unchecked-inc (int (or (.get res x) 0))))) 208 | (into {} res)))) 209 | 210 | #?(:clj 211 | (defn distinct-fast 212 | "Like clojure.core/distinct, but faster. 213 | Uses Java's equal/hash, so may produce incorrect results if 214 | given values that are = but not .equal" 215 | [xs] 216 | (let [s (java.util.HashSet.)] 217 | (filter #(when-not (.contains s %) (.add s %) true) xs)))) 218 | 219 | (defn distinct-by 220 | "Returns elements of xs which return unique 221 | values according to f. If multiple elements of xs return the same 222 | value under f, the first is returned" 223 | [f xs] 224 | (let [s (atom #{})] 225 | (for [x xs 226 | :let [id (f x)] 227 | :when (not (contains? @s id))] 228 | (do (swap! s conj id) 229 | x)))) 230 | 231 | #?(:clj 232 | (defn distinct-id 233 | "Like distinct but uses reference rather than value identity, very clojurey" 234 | [xs] 235 | (let [s (java.util.IdentityHashMap.)] 236 | (doseq [x xs] 237 | (.put s x true)) 238 | (iterator-seq (.iterator (.keySet s)))))) 239 | 240 | (defn interleave-all 241 | "Analogy: partition:partition-all :: interleave:interleave-all" 242 | [& colls] 243 | (lazy-seq 244 | ((fn helper [seqs] 245 | (when (seq seqs) 246 | (concat (map first seqs) 247 | (lazy-seq (helper (keep next seqs)))))) 248 | (keep seq colls)))) 249 | 250 | (defn count-when 251 | "Returns # of elements of xs where pred holds" 252 | [pred xs] 253 | (count (filter pred xs))) 254 | 255 | (defn conj-when 256 | "Like conj but ignores non-truthy values" 257 | ([coll x] (if x (conj coll x) coll)) 258 | ([coll x & xs] 259 | (if xs 260 | (recur (conj-when coll x) 261 | (first xs) 262 | (next xs)) 263 | (conj-when coll x)))) 264 | 265 | (defn cons-when 266 | "Like cons but does nothing if x is non-truthy." 267 | [x s] 268 | (if x (cons x s) s)) 269 | 270 | (def rsort-by 271 | "Like sort-by, but prefers higher values rather than lower ones." 272 | (comp reverse sort-by)) 273 | 274 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 275 | ;;; Control flow 276 | 277 | #?(:clj 278 | (defmacro ?>> 279 | "Conditional double-arrow operation (->> nums (?>> inc-all? (map inc)))" 280 | [do-it? & args] 281 | `(if ~do-it? 282 | (->> ~(last args) ~@(butlast args)) 283 | ~(last args)))) 284 | 285 | #?(:clj 286 | (defmacro ?> 287 | "Conditional single-arrow operation (-> m (?> add-kv? (assoc :k :v)))" 288 | [arg do-it? & rest] 289 | `(if ~do-it? 290 | (-> ~arg ~@rest) 291 | ~arg))) 292 | 293 | #?(:clj 294 | (defmacro fn-> 295 | "Equivalent to `(fn [x] (-> x ~@body))" 296 | [& body] 297 | `(fn [x#] (-> x# ~@body)))) 298 | 299 | #?(:clj 300 | (defmacro fn->> 301 | "Equivalent to `(fn [x] (->> x ~@body))" 302 | [& body] 303 | `(fn [x#] (->> x# ~@body)))) 304 | 305 | #?(:clj 306 | (defmacro <- 307 | "Converts a ->> to a -> 308 | 309 | (->> (range 10) (map inc) (<- (doto prn)) (reduce +)) 310 | 311 | Jason W01fe is happy to give a talk anywhere any time on 312 | the calculus of arrow macros" 313 | [& body] 314 | `(-> ~(last body) ~@(butlast body)))) 315 | 316 | #?(:clj 317 | (defmacro as->> 318 | "Like as->, but can be used in double arrow." 319 | [name & forms-and-expr] 320 | `(as-> ~(last forms-and-expr) ~name ~@(butlast forms-and-expr)))) 321 | 322 | #?(:clj 323 | (defmacro memoized-fn 324 | "Like fn, but memoized (including recursive calls). 325 | 326 | The clojure.core memoize correctly caches recursive calls when you do a top-level def 327 | of your memoized function, but if you want an anonymous fibonacci function, you must use 328 | memoized-fn rather than memoize to cache the recursive calls." 329 | [name args & body] 330 | `(let [a# (atom {})] 331 | (fn ~name ~args 332 | (let [m# @a# 333 | args# ~args] 334 | (if-let [[_# v#] (find m# args#)] 335 | v# 336 | (let [v# (do ~@body)] 337 | (swap! a# assoc args# v#) 338 | v#))))))) 339 | 340 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 341 | ;;; Miscellaneous 342 | 343 | (defn swap-pair! 344 | "Like swap! but returns a pair [old-val new-val]" 345 | ([a f] 346 | (loop [] 347 | (let [old-val @a 348 | new-val (f old-val)] 349 | (if (compare-and-set! a old-val new-val) 350 | [old-val new-val] 351 | (recur))))) 352 | ([a f & args] 353 | (swap-pair! a #(apply f % args)))) 354 | 355 | (defn get-and-set! 356 | "Like reset! but returns old-val" 357 | [a new-val] 358 | (first (swap-pair! a (constantly new-val)))) 359 | 360 | (defn millis ^long [] 361 | #?(:clj (System/currentTimeMillis) 362 | :cljs (.getTime (js/Date.)))) 363 | 364 | (defn mapply 365 | "Like apply, but applies a map to a function with positional map 366 | arguments. Can take optional initial args just like apply." 367 | ([f m] (apply f (apply concat m))) 368 | ([f arg & args] (apply f arg (concat (butlast args) (apply concat (last args)))))) 369 | 370 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 371 | ;;; fnk 372 | 373 | #?(:clj 374 | (defmacro letk 375 | "Keyword let. Accepts an interleaved sequence of binding forms and map forms like: 376 | (letk [[a {b 2} [:f g h] c d {e 4} :as m & more] a-map ...] & body) 377 | a, c, d, and f are required keywords, and letk will barf if not in a-map. 378 | b and e are optional, and will be bound to default values if not present. 379 | g and h are required keys in the map found under :f. 380 | m will be bound to the entire map (a-map). 381 | more will be bound to all the unbound keys (ie (dissoc a-map :a :b :c :d :e)). 382 | :as and & are both optional, but must be at the end in the specified order if present. 383 | The same symbol cannot be bound multiple times within the same destructing level. 384 | 385 | Optional values can reference symbols bound earlier within the same binding, i.e., 386 | (= [2 2] (let [a 1] (letk [[a {b a}] {:a 2}] [a b]))) but 387 | (= [2 1] (let [a 1] (letk [[{b a} a] {:a 2}] [a b]))) 388 | 389 | If present, :as and :& symbols are bound before other symbols within the binding. 390 | 391 | Namespaced keys are supported by specifying fully-qualified key in binding form. The bound 392 | symbol uses the _name_ portion of the namespaced key, i.e, 393 | (= 1 (letk [[a/b] {:a/b 1}] b)). 394 | 395 | Map destructuring bindings can be mixed with ordinary symbol bindings." 396 | [bindings & body] 397 | (schema/assert-iae (vector? bindings) "Letk binding must be a vector") 398 | (schema/assert-iae (even? (count bindings)) "Letk binding must have even number of elements") 399 | (reduce 400 | (fn [cur-body-form [bind-form value-form]] 401 | (if (symbol? bind-form) 402 | `(let [~bind-form ~value-form] ~cur-body-form) 403 | (let [{:keys [map-sym body-form]} (fnk-impl/letk-input-schema-and-body-form 404 | &env 405 | (fnk-impl/ensure-schema-metadata &env bind-form) 406 | [] 407 | cur-body-form)] 408 | `(let [~map-sym ~value-form] ~body-form)))) 409 | `(do ~@body) 410 | (reverse (partition 2 bindings))))) 411 | 412 | #?(:clj 413 | (defmacro if-letk 414 | "bindings => binding-form test 415 | 416 | If test is true, evaluates then with binding-form bound to the value of 417 | test, if not, yields else" 418 | ([bindings then] 419 | `(if-letk ~bindings ~then nil)) 420 | ([bindings then else] 421 | (assert (vector? bindings) "if-letk requires a vector for its binding") 422 | (assert (= 2 (count bindings)) "if-letk requires exactly 2 forms in binding vector") 423 | (let [form (bindings 0) tst (bindings 1)] 424 | `(let [temp# ~tst] 425 | (if temp# 426 | (letk [~form temp#] 427 | ~then) 428 | ~else)))))) 429 | 430 | #?(:clj 431 | (defmacro when-letk 432 | "bindings => binding-form test 433 | 434 | When test is true, evaluates body with binding-form bound to the value of test" 435 | [bindings & body] 436 | `(if-letk ~bindings (do ~@body)))) 437 | 438 | #?(:clj 439 | (defmacro fnk 440 | "Keyword fn, using letk. Generates a prismatic/schema schematized fn that 441 | accepts a single explicit map i.e., (f {:foo :bar}). 442 | 443 | Explicit top-level map structure will be recorded in output spec, or 444 | to capture implicit structure use an explicit prismatic/schema hint on the 445 | function name. 446 | 447 | Individual inputs can also be schematized by putting :- schemas after the 448 | binding symbol. Schemas can also be used on & more symbols to describe 449 | additional map inputs, or on entire [] bindings to override the automatically 450 | generated schema for the contents (caveat emptor). 451 | 452 | By default, input schemas allow for arbitrary additional mappings 453 | ({s/Keyword s/Any}) unless explicit binding or & more schemas are provided." 454 | [& args] 455 | (let [[name? more-args] (if (symbol? (first args)) 456 | (schema-macros/extract-arrow-schematized-element &env args) 457 | [nil args]) 458 | [bind body] (schema-macros/extract-arrow-schematized-element &env more-args)] 459 | (fnk-impl/fnk-form &env name? bind body &form)))) 460 | 461 | #?(:clj 462 | (defmacro defnk 463 | "Analogy: fn:fnk :: defn::defnk" 464 | [& defnk-args] 465 | (let [[name args] (schema-macros/extract-arrow-schematized-element &env defnk-args) 466 | take-if (fn [p s] (if (p (first s)) [(first s) (next s)] [nil s])) 467 | [docstring? args] (take-if string? args) 468 | [attr-map? args] (take-if map? args) 469 | [bind body] (schema-macros/extract-arrow-schematized-element &env args)] 470 | (schema/assert-iae (symbol? name) "Name for defnk is not a symbol: %s" name) 471 | (let [f (fnk-impl/fnk-form &env name bind body &form)] 472 | `(def ~(with-meta name (merge (meta name) (assoc-when (or attr-map? {}) :doc docstring?))) 473 | ~f))))) 474 | 475 | #?(:clj (set! *warn-on-reflection* false)) 476 | -------------------------------------------------------------------------------- /src/plumbing/fnk/README.md: -------------------------------------------------------------------------------- 1 | ## Motivation 2 | 3 | As part of our first open source release, we're contemplating introducing `fnk` and `defnk` macros with different destructuring syntax than the rest of Clojure. 4 | 5 | Below, we've collected some background on the rational behind introducing `fnk`, together with a proposed syntax and several alternatives. Any and all input on these ideas would be much appreciated. 6 | 7 | For more documentation and examples of graph and fnk, we encourage checking out `test/plumbing/fnk/fnk_examples_test.clj` and `test/plumbing/graph_examples_test.clj`. 8 | 9 | ### Background 10 | 11 | We're very excited to begin sharing the Clojure infrastructure that powers Prismatic. Our goals for 2013 include releasing open-source libraries for storage, machine learning, deployment, production services, and more for the Clojure community to (hopefully) use, contribute to, and build upon. 12 | 13 | Our first release is plumbing.[Graph], a library for declaratively specifying the composition structure of complex functions, along with other portions of our low-level "plumbing" library that support it. 14 | 15 | ```clojure 16 | {:n (fnk [xs] (count xs)) 17 | :m (fnk [xs n] (/ (sum xs) n)) 18 | :m2 (fnk [xs n] (/ (sum #(* % %) xs) n)) 19 | :v (fnk [m m2] (- m2 (* m m)))} 20 | ``` 21 | 22 | A graphical depiction of this example graph 23 | 24 | This example shows a simple Graph that expresses the computation of univariate statistics of a sequence of input numbers `xs` in four steps. Dependencies between steps are expressed by argument and keyword names (e.g., the variance `v` is computed from the mean `m` and mean-square `m2`). The details of Graph are not vital for this discussion (see the [blog post](Graph) if you're interested), except for the following two high-level constraints on the implementation of `fnk`: 25 | 26 | 1. To express dependency structure simply (without repeating ourselves), we must be be able to interrogate a `fnk` to ask for the *names* of its arguments. 27 | 2. The inputs, outputs, and intermediate values of a Graph are (nested) maps with keyword keys. Thus, the arguments to a `fnk` are equivalent to keyword destructuring. 28 | 29 | We cannot simply implement `(fnk [xs n] …)` with `(fn [{:keys [xs n]}])` for two reasons. First, arglist metadata is not supported by Clojure's current function-defining macros (`defn` puts it on the var, but neither `defn` nor `fn` puts it on the fn itself). Second, while Clojure does offer excellent destructuring support (including for maps) out of the box, it turns out to be somewhat verbose for the cases commonly encountered in Graph. 30 | 31 | Thus, we are exploring the definition of a new family keyword functions (`fnk` and `defnk`) that use a new destructuring syntax focused around (nested) maps with keyword keys, and also provide explicit metadata about a function's input and output *schemata*. 32 | 33 | Our `fnk` experiment has been running internally for more than a year now, and we've found `fnk` to be quite useful for not only for defining Graphs, but also for many other situations involving maps with keyword keys. Across our current codebase, about 5% of function definitions use a variant of `fnk` over `fn`. 34 | 35 | 36 | ## Fnk syntax 37 | 38 | ### (Why not) Clojure's destructuring syntax? 39 | 40 | While Clojure's built-in destructuring is generally great, it leaves some things to be desired when we're only concerned with destructuring nested maps with keyword keys, and want to make heavy use of extra features like required keys or default values: 41 | 42 | * If we're only interested in top-level map inputs, we'd prefer to be able to say just `(fnk [a b c])` over `(fn [{:keys [a b c]}])` or `(fn [{a :a b :b c :c}])`. 43 | * To require keys, I have to say (`fn [{:keys [a b c] :as m}] (assert (every? (partial contains? m) [:a :b :c]))) …)`. This means I have to mention every argument twice. 44 | * Similarly, for default values, `(fn [{:keys [a] :or {a 2}}])` requires repeating argument names. 45 | * For nested map bindings, I must either repeat myself or mix :keys with direct map destructuring: `(fnk [{{b :b} :a}])` or `(fnk [{{:keys [b]} :a}])` 46 | 47 | This, while one option for Graph would be to just add arglist metadata to Clojure's `fn`, we have instead explored alternative syntax possibilities. 48 | 49 | ### Our fnk syntax proposal 50 | 51 | Our primary design goal was to make keyword map destructuring, including nested and optional bindings, as straightforward and clear as possible. Other forms of destructuring (i.e., for sequences) will not be supported. We will introduce the syntax by example: 52 | 53 | * Functions take a single map argument, and bare symbols in the top-level binding represent required keys of this map: 54 | 55 | ```clojure 56 | (defnk foo [x y] 57 | (+ x y)) 58 | 59 | (= (foo {:x 1 :y 2}) 3) 60 | 61 | (thrown? Exception (foo {:x 1})) ;; y is required 62 | ``` 63 | 64 | * Optional keys with defaults are given as maps: 65 | 66 | ```clojure 67 | (defnk foo [x y {z 10}] 68 | (+ x y z)) 69 | 70 | (= (foo {:x 1 :y 2)) 13) 71 | 72 | (= (foo {:x 1 :y 2 :z 3)) 6) 73 | ``` 74 | 75 | * Nested bindings are introduced with a vector (to match top-level bindings), but begin with the keyword to bind from: 76 | 77 | ```clojure 78 | (defnk foo [x [:sub c {d 10}]] (+ x c d)) 79 | 80 | (= (foo {:x 1 :sub {:c 2}}) 13) 81 | ``` 82 | 83 | * `:as` and `&` are allowed in terminal binding positions, with same meaning as ordinary Clojure destructuring: 84 | 85 | ```clojure 86 | (defnk foo [x & y :as z] [x y z]) 87 | 88 | (= (foo {:x 10 :y 20}) [10 {:y 20} {:x 10 :y 20}]) 89 | ```` 90 | 91 | 92 | Advantages: 93 | 94 | * Common case of flat required keys with no defaults is as simple as can be 95 | * Nested bindings are as minimal as possible 96 | * Notation is internally consistent: `[]` always indicates map binding, `{}` optional args 97 | * Key name repetition is eliminated for required keys and default values. 98 | 99 | Known disadvantages: 100 | 101 | * Different from existing Clojure destructuring 102 | * No sequence binding 103 | * Disparity between outer binding and nested bindings (which begin with keyword) 104 | * Renaming a key is a bit verbose -- `[:a :as b]` 105 | 106 | 107 | ### Alternatives 108 | 109 | Let's take a simple example that includes most features of the above proposal, and compare with several alternative possibilities: 110 | 111 | ```clojure 112 | (defnk foo [x {y 1} [:z :as zalt] [:sub c]] ;; above proposal 113 | [x y zalt c]) 114 | 115 | (= (foo {:x 5 :z 10 :sub {:c 20}}) [5 1 10 20]) 116 | ``` 117 | 118 | **Potential alternative 1:** exising Clojure syntax (see above). 119 | 120 | ```clojure 121 | (defn foo [{x :x y :y zalt :z {c :c} :sub :or {y 1} :as m}] ;; existing syntax 122 | (assert (and (contains? m :x) (contains? (:sub m) :c))) 123 | [x y zalt c]) 124 | ``` 125 | 126 | * Advantages: already exists, known to everyone, consistent 127 | * Disadvantages: verbose if you only care about map bindings, especially if you want required keys, default values, or nested bindings, all of which we use quite frequently. 128 | * Neutral: for Graph, we also have to modify `fn` (or create our own version) to record metadata about arglists and extract required or optional keys. 129 | 130 | **Potential alternative 2:** an earlier version of fnk used `[]` for map bindings, and within a binding, `{}` to introduce sub-bindings and renamings, and `[]` for default values. 131 | 132 | ```clojure 133 | (defnk-2 foo [x [y 1] {zalt :z [c] :sub}] ;; alternative 2 134 | [x y zalt c]) 135 | 136 | (= (foo {:x 5 :z 10 :sub {:c 20}}) [5 1 10 20]) 137 | ``` 138 | 139 | * Advantage: Nested binding completely uniform with top-level (due to extra level of syntax) 140 | * Disadvantage: Each nested binding requires two levels of syntax 141 | * Disadvantage: [] used for two things (map binding and default values) 142 | 143 | **Potential alternative 3:** like primary proposal, but use `#{}` literals for map binding (rather than `[]`) because map bindings are unordered (and to differentiate from existing syntax). It's not clear how to best support nested binding keys, `:as:` and `&` in this unordered setting, but something like this might work: 144 | 145 | ```clojure 146 | (defnk-3 foo #{x {y 1} #{:z ^:as zalt} #{:sub c}} ;; alternative 3 147 | [x y zalt c]) 148 | ``` 149 | 150 | * Advantage: Set literal for binding conveys un-ordered nature of bindings 151 | * Advangage: Set literal also avoids any possibility for confusion with existing destructuring/`defn` 152 | * Disadvantage: `#{}` is not so pretty 153 | * Disadvantage: No obvious clean way to support `:as` and `&`, or enforce that the keyword comes first in nested binding, unless we change these to use metadata or add additional syntax. 154 | 155 | ## Addendum: underlying metadata representation for `fnk` 156 | 157 | For the purposes of Graph, a `fnk` is just a fn of a single map argument, which also responds to protocol fn `(io-schemata f)` that returns a pair of an input schema and an output schema. 158 | 159 | An input schema is a nested map where keys are keywords and leaves are true or false, to indicate optional or required keys. (Ultimately, it might be useful to put more sophisticated type information at the leaves). Similarly, an output schema is a nested map where all the leaves are true (representing guaranteed elements of the return value). 160 | 161 | For example, `(satisfies-schema? {:x true :y false :z true} {:x 2 :z 1})`. 162 | 163 | Because Graph only depends on these protocol and schema definitions, you can use it without our `fnk` by definining schema metadata directly, or designing your own syntax. Of course, we'd still like to get `fnk` right in our release, which is why we really need your input. 164 | 165 | 166 | [Graph]: http://plumatic.github.io/prismatics-graph-at-strange-loop 167 | -------------------------------------------------------------------------------- /src/plumbing/fnk/impl.clj: -------------------------------------------------------------------------------- 1 | (ns plumbing.fnk.impl 2 | "Core utilities for parsing our 'fnk'-style binding syntax. 3 | Documented and tested through the actual 'letk','fnk', and 'defnk' 4 | macros in plumbing.core. 5 | 6 | The core entry points into this namespace are 'letk*' and 'fnk*', 7 | which parse the new binding syntax and generate fnk bodies, 8 | respectively. 9 | 10 | For efficiency, two different methods of generating fnk bodies are 11 | used. If the fnk takes a fixed set of arguments (i.e., no & or 12 | :as), then a 'positional' version of the fnk that is called like an 13 | ordinary Clojure fn (e.g., (f a b) rather than (f {:a a :b b}) is 14 | generated as an implementation detail, and stored in metadata of 15 | the actual keyword fnk (which is just a thin wrapper around the 16 | positional version). If '& or :as are used, no such positional 17 | function is generated. 18 | 19 | The advantage of these 'positional' functions is that they can be 20 | accessed using 'efficient-call-forms' or 'positional-fn' to call 21 | the fnk without incurring the overhead of producing and then 22 | destructuring a top-level map. See plumbing.graph.positional for 23 | an example use." 24 | (:require 25 | [clojure.set :as set] 26 | [schema.core :as s] 27 | [schema.macros :as schema-macros] 28 | [plumbing.fnk.schema :as schema] 29 | [plumbing.fnk.pfnk :as pfnk])) 30 | 31 | ;; TODO: maybe ^:strict metadata to turn off accepting additional keys? 32 | 33 | ;;; Helpers 34 | 35 | (defn name-sym 36 | "Returns symbol of x's name. 37 | Converts a keyword/string to symbol, or removes namespace (if any) of symbol" 38 | [x] 39 | (with-meta (symbol (name x)) (meta x))) 40 | 41 | (defn qualified-sym 42 | "Returns qualified symbol of x, an instance of Named" 43 | [x] 44 | (symbol (namespace x) (name x))) 45 | 46 | ;;; Parsing new fnk binding style 47 | 48 | (declare letk-input-schema-and-body-form) 49 | 50 | (defn- any-schema? [s] 51 | (= `s/Any s)) 52 | 53 | (defn- assert-unschematized [x] 54 | (let [schema (schema-macros/extract-schema-form x)] 55 | (schema/assert-iae (any-schema? schema) "Schema metadata not allowed on %s :- %s" x schema))) 56 | 57 | (defn ensure-schema-metadata [env x] 58 | (schema-macros/normalized-metadata env x nil)) 59 | 60 | (defn schema-override [sym schema] 61 | (vary-meta sym assoc :schema schema)) 62 | 63 | (defn- process-schematized-map 64 | "Take an optional binding map like {a 2} or {a :- Number 2} and convert the schema 65 | information to canonical metadata, if present." 66 | [env binding] 67 | (case (count binding) 68 | 1 (let [[sym v] (first binding)] 69 | {(ensure-schema-metadata env sym) v}) 70 | 71 | 2 (let [[[[sym _]] [[schema v]]] ((juxt filter remove) #(= (val %) :-) binding)] 72 | (schema/assert-iae (and (symbol? sym) schema) 73 | "Bad schematized binding %s: should look like {a :- Number 2}" binding) 74 | {(schema-macros/normalized-metadata env sym schema) v}))) 75 | 76 | ;; TODO: unify this with positional version. 77 | (defn letk-arg-bind-sym-and-body-form 78 | "Given a single element of a single letk binding form and a current body form, return 79 | a map {:schema-entry :body-form} where schema-entry is a tuple 80 | [bound-key schema external-schema?], and body-form wraps body with destructuring 81 | for this binding as necessary." 82 | [env map-sym binding key-path body-form] 83 | (cond (symbol? binding) 84 | {:schema-entry [(keyword binding) (schema-macros/extract-schema-form binding)] 85 | :body-form `(let [~(name-sym binding) (schema/safe-get ~map-sym ~(keyword binding) ~key-path)] 86 | ~body-form)} 87 | 88 | (map? binding) 89 | (let [schema-fixed-binding (process-schematized-map env binding) 90 | [bound-sym opt-val-expr] (first schema-fixed-binding) 91 | bound-key (keyword bound-sym)] 92 | (assert-unschematized binding) 93 | (schema/assert-iae (= 1 (count schema-fixed-binding)) 94 | "optional binding has more than 1 entry: %s" schema-fixed-binding) 95 | {:schema-entry [`(with-meta (s/optional-key ~bound-key) {:default '~opt-val-expr}) (schema-macros/extract-schema-form bound-sym)] 96 | :body-form `(let [~(name-sym bound-sym) (get ~map-sym ~bound-key ~opt-val-expr)] 97 | ~body-form)}) 98 | 99 | (vector? binding) 100 | (let [[bound-key & more] binding 101 | {inner-input-schema :input-schema 102 | inner-external-input-schema :external-input-schema 103 | inner-map-sym :map-sym 104 | inner-body-form :body-form} (letk-input-schema-and-body-form 105 | env 106 | (with-meta (vec more) (meta binding)) 107 | (conj key-path bound-key) 108 | body-form)] 109 | (schema/assert-iae 110 | (keyword? bound-key) 111 | "First element to nested binding not a keyword: %s" bound-key) 112 | {:schema-entry [bound-key inner-input-schema inner-external-input-schema] 113 | :body-form `(let [~inner-map-sym (schema/safe-get ~map-sym ~bound-key ~key-path)] 114 | ~inner-body-form)}) 115 | 116 | :else (throw (IllegalArgumentException. (format "bad binding: %s" binding))))) 117 | 118 | (defn- extract-special-args 119 | "Extract trailing & sym and :as sym, possibly with schema metadata. Returns 120 | [more-bindings special-args-map] where special-args-map is a map from each 121 | special symbol found to the symbol that was found." 122 | [env special-arg-signifier-set binding-form] 123 | {:pre [(set? special-arg-signifier-set)]} 124 | (let [[more-bindings special-bindings] (split-with (complement special-arg-signifier-set) binding-form)] 125 | (loop [special-args-map {} 126 | special-arg-set special-arg-signifier-set 127 | [arg-signifier & other-bindings :as special-bindings] special-bindings] 128 | (if-not (seq special-bindings) 129 | [more-bindings special-args-map] 130 | (do 131 | (schema/assert-iae (special-arg-set arg-signifier) "Got illegal special arg: " arg-signifier) 132 | (let [[sym remaining-bindings] (schema-macros/extract-arrow-schematized-element env other-bindings)] 133 | (schema/assert-iae (symbol? sym) "Argument to %s not a symbol: %s" arg-signifier binding-form) 134 | (recur (assoc special-args-map arg-signifier sym) 135 | (disj special-arg-set arg-signifier) 136 | remaining-bindings))))))) 137 | 138 | (defn letk-input-schema-and-body-form 139 | "Given a single letk binding form, value form, key path, and body 140 | form, return a map {:input-schema :external-input-schema :map-sym :body-form} 141 | where input-schema is the schema imposed by binding-form, external-input-schema 142 | is like input-schema but includes user overrides for binding vectors, 143 | map-sym is the symbol which it expects the bound value to be bound to, 144 | and body-form wraps body in the bindings from binding-form from map-sym." 145 | [env binding-form key-path body-form] 146 | (schema/assert-iae (vector? binding-form) "Binding form is not vector: %s" binding-form) 147 | (let [binding-schema (schema-macros/extract-schema-form binding-form) 148 | [bindings {more-sym '& as-sym :as}] (extract-special-args env #{'& :as} binding-form) 149 | as-sym (or as-sym (ensure-schema-metadata env (gensym "map"))) 150 | [input-schema-elts 151 | external-input-schema-elts 152 | bound-body-form] (reduce 153 | (fn [[input-schema-elts external-input-schema-elts cur-body] binding] 154 | (let [{:keys [schema-entry body-form]} 155 | (letk-arg-bind-sym-and-body-form 156 | env as-sym binding key-path cur-body) 157 | [bound-key input-schema external-input-schema] schema-entry] 158 | [(conj input-schema-elts [bound-key input-schema]) 159 | (conj external-input-schema-elts 160 | [bound-key (or external-input-schema input-schema)]) 161 | body-form])) 162 | [[] [] body-form] 163 | (reverse 164 | (schema-macros/process-arrow-schematized-args 165 | env bindings))) 166 | explicit-schema-keys (keep (comp first schema/unwrap-schema-form-key first) 167 | input-schema-elts) 168 | final-body-form (if more-sym 169 | `(let [~more-sym (dissoc ~as-sym ~@explicit-schema-keys)] 170 | ~bound-body-form) 171 | bound-body-form) 172 | make-input-schema (fn [elts] 173 | (if-not (or more-sym (seq elts) (empty? key-path)) 174 | `s/Any ;; allow [:a :as :b] inner bindings without requiring :a be a map 175 | (merge 176 | (into {} elts) 177 | (let [more-schema (if more-sym 178 | (schema-macros/extract-schema-form more-sym) 179 | `s/Any)] 180 | (if (any-schema? more-schema) 181 | {`s/Keyword `s/Any} 182 | (do (schema/assert-iae (map? more-schema) 183 | "& %s schema must be a map" more-sym) 184 | more-schema))))))] 185 | (when as-sym (assert-unschematized as-sym)) 186 | (schema/assert-iae (not (some #{'&} (map first input-schema-elts))) "Cannot bind to &") 187 | (schema/assert-distinct (concat (map name-sym explicit-schema-keys) 188 | (remove nil? [more-sym as-sym]))) 189 | {:input-schema (make-input-schema input-schema-elts) 190 | :external-input-schema (if-not (any-schema? binding-schema) 191 | binding-schema 192 | (make-input-schema external-input-schema-elts)) 193 | :map-sym as-sym 194 | :body-form final-body-form})) 195 | 196 | ;;; Positional fnks 197 | 198 | (def +none+ 199 | "A sentinel value used to indicate a non-provided optional value in a positional form." 200 | ::none) 201 | 202 | (defn positional-arg-bind-sym-and-body 203 | "Given a single element of a fnk binding form and a current body form, return 204 | a pair [[k bind-sym] new-body-form] where bind-sym is a suitable symbol to bind 205 | to k in the fnk arglist (including tag metadata if applicable) and new-body-form 206 | is wrapped with destructuring for this binding as necessary." 207 | [env binding body-form] 208 | (cond (symbol? binding) 209 | (let [bind-sym (gensym (name binding))] 210 | [[(keyword binding) bind-sym] 211 | `(let [~(name-sym binding) ~bind-sym] ~body-form)]) 212 | 213 | (map? binding) 214 | (let [[bs ov] (first (process-schematized-map env binding)) 215 | bind-sym (gensym (name bs))] 216 | [[(keyword bs) bind-sym] 217 | `(let [~(name-sym bs) (if (identical? +none+ ~bind-sym) ~ov ~bind-sym)] 218 | ~body-form)]) 219 | 220 | (vector? binding) 221 | (let [[k & more] binding 222 | {:keys [map-sym body-form]} (letk-input-schema-and-body-form 223 | env (ensure-schema-metadata env (vec more)) [k] 224 | body-form)] 225 | [[k 226 | (with-meta map-sym 227 | (if (= (last (butlast binding)) :as) (meta (last binding)) {}))] 228 | body-form]) 229 | 230 | :else (throw (IllegalArgumentException. (format "bad binding: %s" binding))))) 231 | 232 | (defn positional-arg-bind-syms-and-body 233 | "Given a fnk binding form and body form, return a pair 234 | [bind-sym-map new-body-form] where bind-sym-map is a map from keyword args 235 | to binding symbols and and new-body-form wraps body to do any extra processing 236 | of nested or optional bindings above and beyond the bindings achieved by 237 | bind-sym-vector." 238 | [env bind body-form] 239 | (reduce 240 | (fn [[cur-bind cur-body] binding] 241 | (let [[bind-sym new-body] (positional-arg-bind-sym-and-body env binding cur-body)] 242 | [(conj cur-bind bind-sym) new-body])) 243 | [{} body-form] 244 | (reverse (schema-macros/process-arrow-schematized-args env bind)))) 245 | 246 | 247 | (defn positional-info 248 | "If fnk has a positional function implementation, return the pair 249 | [positional-fn positional-arg-ks] such that if positional-arg-ks is [:a :b :c], 250 | calling (positional-fn a b c) is equivalent to calling (fnk {:a a :b b :c c}), 251 | but faster. Optional values to fnk can be simulated by passing +none+ as the 252 | value, i.e., (positional-fn +none+ b +none) is like (fnk {:b b})." 253 | [fnk] 254 | (get (meta fnk) ::positional-info)) 255 | 256 | (defn efficient-call-forms 257 | "Get [f arg-forms] that can be used to call a fnk most efficiently, using the 258 | positional version if available, or otherwise the raw fnk. arg-form-map 259 | is a map from keywords representing arguments to fnk to *forms* that evaluate 260 | to the corresponding arguments. 261 | 262 | The basic idea is that (eval (cons f arg-forms)) would yield code for an 263 | efficient call to fnk. However, this form is not returned directly, because 264 | in most cases the literal function f cannot be directly evaluated due to 265 | a quirk in Clojure -- e.g., try (eval `(~(let [x 1] (fn [y] (+ y x))) 2)). 266 | 267 | For examples of how this is used, see 'positional-fn' below, or the positional 268 | compilation in plumbing.graph.positional." 269 | [fnk arg-form-map] 270 | (if-let [[positional-f positional-args] (positional-info fnk)] 271 | (do (schema/assert-iae (set/superset? (set (keys arg-form-map)) 272 | (set positional-args)) 273 | "Trying to call fn that takes args %s with args %s" 274 | positional-args arg-form-map) 275 | [positional-f (map arg-form-map positional-args)]) 276 | [fnk [`(into {} (remove #(identical? +none+ (second %)) ~arg-form-map))]])) 277 | 278 | (defn positional-fn 279 | "Given argument order in arg-ks, produce an ordinary fn that can be called 280 | with arguments in this order. arg-ks must include all required keys of fnk. 281 | 282 | Example: (= ((positional-fn a-fnk [:b :a]) [1 2]) (a-fnk {:a 2 :b 1})) 283 | 284 | Can only be applied to fnks with a positional form, and should yield 285 | a function that is significantly faster than calling fnk directly by 286 | avoiding the construction and destructuring of the outer map. Uses 'eval', 287 | so while the produced function is fast, the actual production of the 288 | positional-fn is generally relatively slow." 289 | [fnk arg-ks] 290 | (schema/assert-iae (apply distinct? ::dummy arg-ks) 291 | "Invalid positional args %s contain duplicates" arg-ks) 292 | (schema/assert-iae (positional-info fnk) 293 | "Called positional-fn on a fnk without a positional form") 294 | (let [input-schema (pfnk/input-schema fnk) 295 | [missing-req missing-opt] (schema/split-schema-keys 296 | (apply dissoc (schema/explicit-schema-key-map input-schema) 297 | (set arg-ks))) 298 | extra-args (remove (partial schema/possibly-contains? input-schema) arg-ks) 299 | arg-syms (mapv name-sym arg-ks) 300 | [pos-fn pos-args] (efficient-call-forms 301 | fnk 302 | (merge (zipmap arg-ks arg-syms) 303 | (zipmap missing-opt (repeat +none+))))] 304 | (schema/assert-iae (and (empty? missing-req) (empty? extra-args)) 305 | "Invalid positional args %s missing %s, with extra %s" 306 | arg-ks missing-req extra-args) 307 | ((eval `(fn [f#] (fn ~arg-syms (f# ~@pos-args)))) 308 | pos-fn))) 309 | 310 | (defn positional-fnk-form 311 | "Takes an optional name, input schema, seq of ordered [key optional?] pairs, 312 | an arg-sym-map from these keywords to symbols, and and a positional fn body 313 | that can reference these symbols. 314 | Produces a form generating a IFn/PFnk that can be called as a keyword function, 315 | and has metadata containing the positional function for efficient compilation 316 | as described in 'efficient-call-forms' and 'positional-fn' above, with 317 | argument order the same as in input-schema by default. Example: 318 | 319 | (def f (eval (i/positional-fnk-form 'foo {:x s/Any (s/optional-key :y) s/Any} 320 | [`(+ ~'x (if (= ~'y i/+none+) 5 ~'y))]))) 321 | 322 | (= [6 3] [(f {:x 1}) (f {:x 1 :y 2})]) 323 | (= [6 3] [((i/positional-fn f [:x]) 1) ((i/positional-fn f [:y :x]) 2 1)])." 324 | [fn-name external-input-schema ordered-ks->opt arg-sym-map body form] 325 | (let [[req-ks opt-ks] (schema/split-schema-keys (into {} ordered-ks->opt)) 326 | explicit-schema-keys (mapv first ordered-ks->opt) 327 | pos-args (mapv #(do (schema-macros/assert! (contains? arg-sym-map %)) 328 | (arg-sym-map %)) 329 | explicit-schema-keys)] 330 | `(let [pos-fn# (fn ~(symbol (str fn-name "-positional")) 331 | ~pos-args 332 | ~@body)] 333 | (vary-meta 334 | (s/fn 335 | ~fn-name 336 | [m# :- ~external-input-schema] 337 | (plumbing.core/letk [~(into (mapv qualified-sym req-ks) 338 | (mapv (fn [k] {(qualified-sym k) +none+}) opt-ks)) 339 | m#] 340 | (pos-fn# ~@(mapv name-sym explicit-schema-keys)))) 341 | merge 342 | (assoc ~(meta form) ::positional-info [pos-fn# ~explicit-schema-keys]))))) 343 | 344 | ;;; Generating fnk bodies 345 | 346 | (defn fnk-form 347 | "Take an optional name, binding form, and body for a fnk, and make an 348 | IFn/PFnk for these arguments. 349 | 350 | For efficiency, two different methods of generating fnk bodies are 351 | used. If the fnk takes a fixed set of arguments (i.e., no & or 352 | :as), then a 'positional' version of the fnk that is called like an 353 | ordinary Clojure fn (e.g., (f a b) rather than (f {:a a :b b}) is 354 | generated as an implementation detail, and stored in metadata of 355 | the actual keyword fnk (which is just a thin wrapper around the 356 | positional version). If '& or :as are used, no such positional 357 | function is generated." 358 | [env name? bind body form] 359 | (let [{:keys [map-sym body-form input-schema external-input-schema]} 360 | (letk-input-schema-and-body-form env bind [] `(do ~@body)) 361 | 362 | explicit-output-schema (if name? (schema-macros/extract-schema-form name?) `s/Any) 363 | output-schema (if (any-schema? explicit-output-schema) 364 | (schema/guess-expr-output-schema (last body)) 365 | explicit-output-schema) 366 | fn-name (vary-meta (or name? (gensym "fnk")) assoc :schema output-schema)] 367 | ((fn [fn-form] 368 | `(vary-meta ~fn-form assoc :name '~name?)) 369 | (if (and (not (schema-macros/cljs-env? env)) 370 | (not-any? #{'& :as} bind)) ;; If we can make a positional fnk form, do it. 371 | (let [[bind-sym-map bound-body] (positional-arg-bind-syms-and-body env bind `(do ~@body))] 372 | (positional-fnk-form 373 | fn-name 374 | external-input-schema 375 | (vec (schema/explicit-schema-key-map input-schema)) 376 | bind-sym-map 377 | [bound-body] 378 | form)) 379 | (with-meta `(s/fn ~fn-name 380 | [~(schema-override map-sym external-input-schema)] 381 | (schema/assert-iae (map? ~map-sym) "fnk called on non-map: %s" ~map-sym) 382 | ~body-form) 383 | (meta form)))))) 384 | -------------------------------------------------------------------------------- /src/plumbing/fnk/pfnk.cljc: -------------------------------------------------------------------------------- 1 | (ns plumbing.fnk.pfnk 2 | "Core protocol and helpers for schema.core to extract and attach 3 | input and output schemas to fnks. This protocol says nothing about 4 | how fnks are created, so users are free to create PFnks directly 5 | using fn->fnk, or using custom binding syntax (of which 'fnk' et al 6 | are one possible example)." 7 | (:require 8 | [schema.core :as s #?@(:cljs [:include-macros true])] 9 | [plumbing.fnk.schema :as schema #?@(:cljs [:include-macros true])])) 10 | 11 | #?(:clj (set! *warn-on-reflection* true)) 12 | 13 | (defprotocol PFnk 14 | "Protocol for keyword functions and their specifications, e.g., fnks and graphs." 15 | (io-schemata [this] 16 | "Return a pair of [input-schema output-schema], as specified in plumbing.fnk.schema.")) 17 | 18 | (defn input [^schema.core.FnSchema s] 19 | (let [[[is :as args] :as schemas] (.-input-schemas s)] 20 | (schema/assert-iae (= 1 (count schemas)) "Fnks have a single arity, not %s" (count schemas)) 21 | (schema/assert-iae (= 1 (count args)) "Fnks take a single argument, not %s" (count args)) 22 | (schema/assert-iae (instance? schema.core.One is) "Fnks take a single argument, not variadic") 23 | (let [s (.-schema ^schema.core.One is)] 24 | (schema/assert-iae (map? s) "Fnks take a map argument, not %s" (type s)) 25 | s))) 26 | 27 | (defn output [^schema.core.FnSchema s] 28 | (.-output-schema s)) 29 | 30 | (extend-type #?(:clj clojure.lang.Fn 31 | :cljs object) 32 | PFnk 33 | (io-schemata [this] 34 | (assert (fn? this)) 35 | ((juxt input output) (s/fn-schema this)))) 36 | 37 | (defn input-schema [pfnk] 38 | (first (io-schemata pfnk))) 39 | 40 | (defn output-schema [pfnk] 41 | (second (io-schemata pfnk))) 42 | 43 | (defn input-schema-keys [f] 44 | (-> f input-schema schema/explicit-schema-key-map keys)) 45 | 46 | (defn fn->fnk 47 | "Make a keyword function into a PFnk, by associating input and output schema metadata." 48 | ([f io] (fn->fnk f nil io)) 49 | ([f name [input-schema output-schema :as io]] 50 | (vary-meta (s/schematize-fn f (s/=> output-schema input-schema)) assoc :name name))) 51 | 52 | (defn fnk-name 53 | "Get the name of a fnk, if named" 54 | [f] 55 | (:name (meta f))) 56 | 57 | #?(:clj (set! *warn-on-reflection* false)) 58 | -------------------------------------------------------------------------------- /src/plumbing/fnk/schema.cljc: -------------------------------------------------------------------------------- 1 | (ns plumbing.fnk.schema 2 | "A very simple type system for a subset of schemas consisting of nested 3 | maps with optional or required keyword keys; used by fnk and kin. 4 | 5 | Since schemas are turing-complete and not really designed for type inference, 6 | (and for simplicity) we err on the side of completeness (allowing all legal programs) 7 | at the cost of soundness. 8 | 9 | These operations also bake in some logic specific to reasoning about Graphs, 10 | namely that all input keys to a node must be explicitly mentioned as optional or 11 | required, or provided via `instance`, and will thus deliberately drop extra key 12 | schemas on inputs as appropriate. Output schemas may not have optional keys." 13 | (:require 14 | [schema.core :as s #?@(:cljs [:include-macros true])] 15 | [schema.utils :as schema-utils] 16 | #?(:clj [schema.macros :as schema-macros])) 17 | #?(:cljs 18 | (:require-macros 19 | [schema.macros :as schema-macros] 20 | [plumbing.fnk.schema :refer [assert-iae]]))) 21 | 22 | (def Schema (s/protocol s/Schema)) 23 | (def InputSchema {(s/cond-pre (s/eq s/Keyword) schema.core.OptionalKey s/Keyword) Schema}) 24 | (def OutputSchema Schema) 25 | (def IOSchemata [(s/one InputSchema 'input) (s/one OutputSchema 'output)]) 26 | 27 | (def GraphInputSchema {(s/cond-pre schema.core.OptionalKey s/Keyword) Schema}) 28 | (def MapOutputSchema {s/Keyword Schema}) 29 | (def GraphIOSchemata [(s/one GraphInputSchema 'input) (s/one MapOutputSchema 'output)]) 30 | 31 | ;;; Helpers 32 | 33 | #?(:clj 34 | (defmacro assert-iae 35 | "Like assert, but throws a RuntimeException in Clojure (not an AssertionError), 36 | and also takes args to format." 37 | [form & format-args] 38 | `(schema-macros/assert! ~form ~@format-args))) 39 | 40 | (defn assert-distinct 41 | "Like (assert (distinct? things)) but with a more helpful error message." 42 | [things] 43 | (let [repeated-things (->> things 44 | frequencies 45 | (filter #(> (val %) 1)) 46 | seq)] 47 | (assert-iae (empty? repeated-things) "Got repeated items (expected distinct): %s" repeated-things))) 48 | 49 | (defn safe-get 50 | "Like (get m k), but throws if k is not present in m." 51 | [m k key-path] 52 | (assert-iae (map? m) 53 | "Expected a map at key-path %s, got type %s" key-path (schema-utils/type-of m)) 54 | (let [[_ v :as p] (find m k)] 55 | (when-not p (throw (ex-info ^String (schema-utils/format* "Key %s not found in %s" k (keys m)) 56 | {:error :missing-key 57 | :key k 58 | :map m}))) 59 | v)) 60 | 61 | (defn non-map-union [s1 s2] 62 | (cond (= s1 s2) s1 63 | (= s1 s/Any) s2 64 | (= s2 s/Any) s1 65 | :else s1)) ;; Punt, just take the first 66 | 67 | (defn non-map-diff 68 | "Return a difference of schmas s1 and s2, where one is not a map. 69 | Punt for now, assuming s2 always satisfies s1." 70 | [s1 s2] 71 | nil) 72 | 73 | (defn map-schema? [m] 74 | #?(:clj (instance? clojure.lang.APersistentMap m) 75 | :cljs (or (instance? cljs.core.PersistentArrayMap m) 76 | (instance? cljs.core.PersistentHashMap m)))) 77 | 78 | ;;; Input schemata 79 | 80 | (s/defn unwrap-schema-form-key :- (s/maybe (s/pair s/Keyword "k" s/Bool "optional?")) 81 | "Given a possibly-unevaluated schema map key form, unpack an explicit keyword 82 | and optional? flag, or return nil for a non-explicit key" 83 | [k] 84 | (cond (s/specific-key? k) 85 | [(s/explicit-schema-key k) (s/required-key? k)] 86 | 87 | ;; Deal with `(s/optional-key k) form from impl 88 | (and (sequential? k) (not (vector? k)) (= (count k) 2) 89 | (= (first k) 'schema.core/optional-key)) 90 | [(second k) false] 91 | 92 | ;; Deal with `(with-meta ...) form from impl 93 | (and (sequential? k) (not (vector? k)) (= (first k) `with-meta)) 94 | (unwrap-schema-form-key (second k)))) 95 | 96 | (s/defn explicit-schema-key-map :- {s/Keyword s/Bool} 97 | "Given a possibly-unevaluated map schema, return a map from bare keyword to true 98 | (for required) or false (for optional)" 99 | [s] 100 | (->> s 101 | keys 102 | (keep unwrap-schema-form-key) 103 | (into {}))) 104 | 105 | (s/defn split-schema-keys :- [(s/one [s/Keyword] 'required) (s/one [s/Keyword] 'optional)] 106 | "Given output of explicit-schema-key-map, split into seq [req opt]." 107 | [s :- {s/Keyword s/Bool}] 108 | (->> s 109 | ((juxt filter remove) val) 110 | (mapv (partial mapv key)))) 111 | 112 | (defn- merge-on-with 113 | "Like merge-with, but also projects keys to a smaller space and merges them similar to the 114 | values." 115 | [key-project key-combine val-combine & maps] 116 | (->> (apply concat maps) 117 | (reduce 118 | (fn [m [k v]] 119 | (let [pk (key-project k)] 120 | (if-let [[ok ov] (get m pk)] 121 | (assoc m pk [(key-combine ok k) (val-combine ov v)]) 122 | (assoc m pk [k v])))) 123 | {}) 124 | vals 125 | (into {}))) 126 | 127 | (s/defn union-input-schemata :- InputSchema 128 | "Returns a minimal input schema schema that entails satisfaction of both s1 and s2" 129 | [i1 :- InputSchema i2 :- InputSchema] 130 | (merge-on-with 131 | #(if (s/specific-key? %) (s/explicit-schema-key %) :extra) 132 | (fn [k1 k2] 133 | (cond (s/required-key? k1) k1 134 | (s/required-key? k2) k2 135 | (s/optional-key? k1) (do (assert (= k1 k2)) k1) 136 | (= k1 k2) k1 137 | :else (assert-iae false "Only one extra schema allowed"))) 138 | (fn [s1 s2] 139 | (if (and (map-schema? s1) (map-schema? s2)) 140 | (union-input-schemata s1 s2) 141 | (non-map-union s1 s2))) 142 | i1 i2)) 143 | 144 | (s/defn required-toplevel-keys :- [s/Keyword] 145 | "Which top-level keys are required (i.e., non-false) by this input schema." 146 | [input-schema :- InputSchema] 147 | (keep 148 | (fn [k] 149 | (when (s/required-key? k) 150 | (s/explicit-schema-key k))) 151 | (keys input-schema))) 152 | 153 | 154 | 155 | ;;; Output schemata 156 | 157 | 158 | (defn guess-expr-output-schema 159 | "Guess an output schema for an expr. Currently just looks for literal map structure and 160 | all keyword keys." 161 | [expr] 162 | (if (and (map? expr) (every? keyword? (keys expr))) 163 | (into {} (for [[k v] expr] [k (guess-expr-output-schema v)])) 164 | 'schema.core/Any)) 165 | 166 | ;;; Combining inputs and outputs. 167 | 168 | 169 | (defn schema-diff ;; don't validate since it returns better errors. 170 | "Subtract output-schema from input-schema, returning nil if it's possible that an object 171 | satisfying the output-schema satisfies the input-schema, or otherwise a description 172 | of the part(s) of input-schema not met by output-schema. Strict about the map structure 173 | of output-schema matching input-schema, but loose about everything else (only looks at 174 | required keys of output-schema." 175 | [input-schema output-schema] ;; not schematized since it returns more helpful errors 176 | (cond (not (map-schema? input-schema)) 177 | (non-map-diff input-schema output-schema) 178 | 179 | (not (map-schema? output-schema)) 180 | (schema-macros/validation-error input-schema output-schema (list 'map? (s/explain output-schema))) 181 | 182 | :else 183 | (->> (for [[k v] input-schema 184 | :when (s/specific-key? k) 185 | :let [required? (s/required-key? k) 186 | raw-k (s/explicit-schema-key k) 187 | present? (contains? output-schema raw-k)] 188 | :when (or required? present?) 189 | :let [fail (if-not present? 190 | 'missing-required-key 191 | (schema-diff v (get output-schema raw-k)))] 192 | :when fail] 193 | [k fail]) 194 | (into {}) 195 | not-empty))) 196 | 197 | (defn assert-satisfies-schema [input-schema output-schema] 198 | (let [fails (schema-diff input-schema output-schema)] 199 | (when fails (throw (ex-info (str fails) {:error :does-not-satisfy-schema 200 | :failures fails}))))) 201 | (s/defn ^:always-validate compose-schemata 202 | "Given pairs of input and output schemata for fnks f1 and f2, 203 | return a pair of input and output schemata for #(f2 (merge % (f1 %))). 204 | f1's output schema must not contain any optional keys." 205 | [[i2 o2] :- IOSchemata 206 | [i1 o1] :- [(s/one InputSchema 'input) (s/one MapOutputSchema 'output)]] 207 | (assert-satisfies-schema (select-keys i2 (keys o1)) o1) 208 | [(union-input-schemata (apply dissoc i2 (concat (keys o1) (map s/optional-key (keys o1)))) i1) 209 | o2]) 210 | 211 | (defn schema-key [m k] 212 | (cond (contains? m k) 213 | k 214 | 215 | (contains? m (s/optional-key k)) 216 | (s/optional-key k) 217 | 218 | :else nil)) 219 | 220 | (defn possibly-contains? [m k] 221 | (boolean (schema-key m k))) 222 | 223 | (s/defn split-schema 224 | "Return a pair [ks-part non-ks-part], with any extra schema removed." 225 | [s :- InputSchema ks :- [s/Keyword]] 226 | (let [ks (set ks)] 227 | (for [in? [true false]] 228 | (into {} (for [[k v] s 229 | :when (and (s/specific-key? k) 230 | (= in? (contains? ks (s/explicit-schema-key k))))] 231 | [k v]))))) 232 | 233 | (s/defn sequence-schemata :- GraphIOSchemata 234 | "Given pairs of input and output schemata for fnks f1 and f2, and a keyword k, 235 | return a pair of input and output schemata for #(let [v1 (f1 %)] (assoc v1 k (f2 (merge-disjoint % v1))))" 236 | [[i1 o1] :- GraphIOSchemata 237 | [k [i2 o2]] :- [(s/one s/Keyword "key") (s/one IOSchemata "inner-schemas")]] 238 | (assert-iae (not (possibly-contains? i1 k)) "Duplicate key output (possibly due to a misordered graph) %s for input %s from input %s" k (s/explain i2) (s/explain i1)) 239 | (assert-iae (not (possibly-contains? o1 k)) "Node outputs a duplicate key %s given inputs %s" k (s/explain i1)) 240 | (let [[used unused] (split-schema i2 (keys o1))] 241 | (assert-satisfies-schema used o1) 242 | [(union-input-schemata unused i1) 243 | (assoc o1 k o2)])) 244 | -------------------------------------------------------------------------------- /src/plumbing/graph.cljc: -------------------------------------------------------------------------------- 1 | (ns plumbing.graph 2 | "A Graph is a simple, declarative way to define a composition of functions that is 3 | easy to define, modify, execute, test, and monitor. 4 | 5 | This blog post provides a high-level overview of Graph and its benefits: 6 | http://plumatic.github.io/prismatics-graph-at-strange-loop 7 | 8 | Concretely, a Graph specification is just a Clojure (nested) map with keyword keys 9 | and keyword functions at the leaves. 10 | 11 | A Graph is defined recursively as either: 12 | 1. a keyword function (i.e., fn satisfying PFnk), or 13 | 2. a Clojure map from keywords to (sub)graphs. 14 | 15 | A Graph is a declarative specification of a single keyword function that 16 | produces a map output, where each value in the output is produced by executing 17 | the corresponding keyword function in the Graph. The inputs to the keyword 18 | function are given by the outputs of other nodes in the graph with matching 19 | keywords (mimicking lexical scope in the case of nested maps), or failing that, 20 | from keywords in the input map. 21 | 22 | For more details and examples of Graphs, see test/plumbing/graph_examples_test.cljx." 23 | (:refer-clojure :exclude [compile]) 24 | (:require 25 | #?(:clj [plumbing.lazymap :as lazymap]) 26 | [schema.core :as s] 27 | #?(:clj [schema.macros :as schema-macros]) 28 | [plumbing.fnk.schema :as schema #?@(:cljs [:include-macros true])] 29 | [plumbing.fnk.pfnk :as pfnk] 30 | #?(:clj [plumbing.fnk.impl :as fnk-impl]) 31 | #?(:clj [plumbing.graph.positional :as graph-positional]) 32 | [plumbing.core :as plumbing #?@(:cljs [:include-macros true])] 33 | [plumbing.map :as map]) 34 | #?(:cljs (:require-macros [schema.macros :as schema-macros]))) 35 | 36 | 37 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 38 | ;;; Constructing graphs 39 | 40 | (defn working-array-map 41 | "array-map in cljs no longer preserves ordering, replicate the old functionality." 42 | [& args] 43 | (schema-macros/if-cljs 44 | (.fromArray cljs.core/PersistentArrayMap (apply array args) true true) 45 | (apply array-map args))) 46 | 47 | (defn ->graph 48 | "Convert a graph specification into a canonical well-formed 'graph', which 49 | is an array-map with nodes in a correct topological order that will respond 50 | to 'io-schemata' with a specification of the graph inputs and outputs. 51 | 52 | The graph specification can be a Clojure map, in which case the topological 53 | order will be computed (an error will be thrown for cyclic specifications), 54 | or a sequence of key-value pairs that are already in a valid topological order 55 | (an error will be thrown if the order is not valid). Values in the input 56 | sequence are also converted to canonical graphs via recursive calls to ->graph." 57 | [graph-nodes] 58 | (if (or (fn? graph-nodes) (= graph-nodes (::self (meta graph-nodes)))) 59 | graph-nodes 60 | (let [canonical-nodes (plumbing/map-vals ->graph graph-nodes) 61 | graph (->> (if-not (map? graph-nodes) 62 | (map first graph-nodes) 63 | (->> canonical-nodes 64 | (plumbing/map-vals pfnk/input-schema-keys) 65 | map/topological-sort 66 | reverse)) 67 | (mapcat #(find canonical-nodes %)) 68 | (apply working-array-map))] 69 | (assert (every? keyword? (keys graph))) 70 | (with-meta graph 71 | {::io-schemata (update (reduce schema/sequence-schemata 72 | [{} {}] 73 | (for [[k node] graph] 74 | [k (pfnk/io-schemata node)])) 75 | 0 assoc s/Keyword s/Any) 76 | ::self graph})))) 77 | 78 | ;; Any Clojure map can be treated as a graph directly, without calling ->graph 79 | 80 | (defn io-schemata* [g] 81 | (plumbing/safe-get (meta (->graph g)) ::io-schemata)) 82 | 83 | (extend-protocol pfnk/PFnk 84 | #?(:clj clojure.lang.IPersistentMap 85 | :cljs cljs.core.PersistentArrayMap) 86 | (io-schemata [g] (io-schemata* g)) 87 | #?(:cljs cljs.core.PersistentHashMap) 88 | (io-schemata [g] (io-schemata* g))) 89 | 90 | (defn- split-nodes [s] 91 | (loop [in s out []] 92 | (if-let [[f & r] (seq in)] 93 | (cond (keyword? f) ;; key then value 94 | (recur (next r) (conj out [f (first r)])) 95 | 96 | (fn? f) 97 | (do (schema/assert-iae (pfnk/fnk-name f) "Inline fnks must have a name (to be used as a key)") 98 | (recur r (conj out [(keyword (pfnk/fnk-name f)) f]))) 99 | 100 | :else ;; inline graph 101 | (recur r (into out f))) 102 | out))) 103 | 104 | (defn graph 105 | "An ordered constructor for graphs, which enforces that the Graph is provided 106 | in a valid topological ordering. This is a sanity check, and also enforces 107 | defining graphs in a readable way. Most explicit graphs should be created 108 | with this constructor. 109 | 110 | (graph 111 | :x-plus-1 (fnk [x] (inc x)) 112 | :2-x-plus-2 (fnk [x-plus-1] (* 2 x-plus-1))) 113 | 114 | in addition, an 'inline' graph can be provided in place of a key-value 115 | sequence, which will be merged into the graph at this position. 116 | 117 | a named fnk can also be provided in place of a key-value pair, 118 | where the fnk's name (as a keyword) is the implicit key." 119 | [& nodes] 120 | (let [partitioned (split-nodes nodes)] 121 | (schema/assert-distinct (map first partitioned)) 122 | (->graph partitioned))) 123 | 124 | 125 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 126 | ;;; Compiling and running graphs 127 | 128 | #?(:clj (declare interpreted-eager-compile)) 129 | #?(:clj 130 | (defn eager-compile 131 | "Compile graph specification g to a corresponding fnk that is optimized for 132 | speed. Wherever possible, fnks are called positionally, to reduce the 133 | overhead of creating and destructuring maps, and the return value is a 134 | record, which is much faster to create and access than a map. Compilation 135 | is relatively slow, however, due to internal calls to 'eval'. 136 | 137 | Options: 138 | :positional-limit is used to decide when to switch to interpreted mode, 139 | which does not compile positionally. If positional compilation is required, 140 | use option {:positional-limit ##Inf} (at the risk of method-too-large errors)." 141 | ([g] (eager-compile g {})) 142 | ([g {:keys [positional-limit] 143 | :or {positional-limit graph-positional/max-graph-size} 144 | :as _opts}] 145 | (let [eager-compile (fn eager-compile [g] 146 | (if (fn? g) 147 | g 148 | (let [g* (for [[k sub-g] (->graph g)] 149 | [k (eager-compile sub-g)])] 150 | (when (every? second g*) 151 | (let [g (->graph g*)] 152 | (when (<= (-> g pfnk/output-schema count) 153 | positional-limit) 154 | (graph-positional/positional-flat-compile g)))))))] 155 | (or (eager-compile g) 156 | (interpreted-eager-compile g)))))) 157 | 158 | #?(:clj 159 | (defn positional-eager-compile 160 | "Like eager-compile, but produce a non-keyword function that can be called 161 | with args in the order provided by arg-ks, avoiding the overhead of creating 162 | and destructuring a top-level map. This can yield a substantially faster 163 | fn for Graphs with very computationally inexpensive node fnks. 164 | 165 | Warning: if any level of g exceeds `graph-positional/max-graph-size`, compilation 166 | may fail. Do not use for arbitrarily large graphs." 167 | [g arg-ks] 168 | (fnk-impl/positional-fn 169 | (eager-compile g 170 | ;; there is no interpreted mode (yet) for positional compilation, 171 | ;; but it is required by `positional-fn`. this forces eager-compile to 172 | ;; always return a positional graph, even though compilation may fail 173 | ;; due to code size. when available, should be replaced with a scalable 174 | ;; positional compilation. 175 | {:positional-limit Double/POSITIVE_INFINITY}) 176 | arg-ks))) 177 | 178 | (defn simple-flat-compile 179 | "Helper method for simple (non-nested) graph compilations that convert a graph 180 | specification to a fnk that returns a Clojure map of the graph node values. 181 | (make-map m) converts an initial Clojure map m to the return type of the fnk, 182 | and (assoc-f m k f) associates the value given by (f) under key k to map m." 183 | [g check-input? make-map assoc-f] 184 | (let [g (->graph g) 185 | req-ks (schema/required-toplevel-keys (pfnk/input-schema g))] 186 | (pfnk/fn->fnk 187 | (fn [m] 188 | (when check-input? 189 | (let [missing-keys (seq (remove #(contains? m %) req-ks))] 190 | (schema/assert-iae (empty? missing-keys) 191 | "Missing top-level keys in graph input: %s" 192 | (set missing-keys)))) 193 | (apply 194 | dissoc 195 | (reduce 196 | (fn [inner [k node-f]] 197 | (schema/assert-iae (not (contains? inner k)) 198 | "Inner graph key %s duplicated" k) 199 | (assoc-f inner k node-f)) 200 | (make-map m) 201 | g) 202 | (keys m))) 203 | (pfnk/io-schemata g)))) 204 | 205 | (defn simple-hierarchical-compile 206 | "Hierarchical extension of simple-nonhierarchical-compile." 207 | [g check-input? make-map assoc-f] 208 | (if (fn? g) 209 | g 210 | (simple-flat-compile 211 | (for [[k sub-g] (->graph g)] 212 | [k (simple-hierarchical-compile sub-g check-input? make-map assoc-f)]) 213 | check-input? make-map assoc-f))) 214 | 215 | (defn restricted-call 216 | "Call fnk f on the subset of keys its input schema explicitly asks for" 217 | [f in-m] 218 | (f (select-keys in-m (pfnk/input-schema-keys f)))) 219 | 220 | (defn interpreted-eager-compile 221 | "Compile graph specification g to a corresponding fnk that returns an 222 | ordinary Clojure map of the node result fns on a given input. The 223 | compilation is much faster than 'eager-compile', but the compiled fn 224 | will typically be much slower." 225 | [g] 226 | (simple-hierarchical-compile 227 | g 228 | true 229 | (fn [m] m) 230 | (fn [m k f] (assoc m k (restricted-call f m))))) 231 | 232 | #?(:clj 233 | (defn lazy-compile 234 | "Compile graph specification g to a corresponding fnk that returns a 235 | lazymap of the node result fns on a given input. This fnk returns 236 | the lazymap immediately, and node values are computed and cached as needed 237 | as values are extracted from the lazymap. Besides this lazy behavior, 238 | the lazymap can be used interchangeably with an ordinary Clojure map. 239 | Required inputs to the graph are checked lazily, so you can omit input 240 | keys not required by unneeded output keys." 241 | [g] 242 | (simple-hierarchical-compile 243 | g 244 | false 245 | (fn [m] (reduce-kv assoc (lazymap/lazy-hash-map) m)) ;; into is extremely slow on lazymaps. 246 | (fn [m k f] (lazymap/delay-assoc m k (delay (restricted-call f m))))))) 247 | 248 | #?(:clj ;; TODO: move out. 249 | (defn par-compile 250 | "Experimental. Launches one future per node at startup; we probably woudln't 251 | use this in production, and will release more sophisticated parallel 252 | compilations later. 253 | 254 | Compile graph specification g to a corresponding fnk that returns a 255 | lazymap of the node result fns on a given input. This fnk returns 256 | the lazymap immediately, and node values are computed and cached in parallel 257 | starting immediately (and attempts to extract values from the lazymap will 258 | block until each value is computed). Besides this lazy behavior, 259 | the lazymap can be used interchangeably with an ordinary Clojure map." 260 | [g] 261 | (simple-hierarchical-compile 262 | g 263 | true 264 | (fn [m] (into (lazymap/lazy-hash-map) m)) 265 | (fn [m k f] (lazymap/delay-assoc m k (future (restricted-call f m))))))) 266 | 267 | (defn compile 268 | "Compile graph specification g to a corresponding fnk using the a default 269 | compile strategy for host. 270 | Clojure: eager-compile 271 | ClojureScript: interpreted-eager-compile" 272 | [g] 273 | #?(:clj (eager-compile g) 274 | :cljs (interpreted-eager-compile g))) 275 | 276 | (defn run 277 | "Eagerly run a graph on an input by compiling and then executing on this input." 278 | [g input] 279 | ((interpreted-eager-compile g) input)) 280 | 281 | 282 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 283 | ;;; Higher-order functions on graphs 284 | 285 | (defn check-comp-partial! 286 | "Check that instance-fn is a valid fn to comp-partial with graph g." 287 | [g instance-fn] 288 | (let [is (pfnk/input-schema g) 289 | os (pfnk/output-schema instance-fn)] 290 | (schema/assert-iae (map? os) "instance-fn must have output metadata") 291 | (let [extra-ks (remove #(schema/possibly-contains? is %) (keys os))] 292 | (schema/assert-iae (empty? extra-ks) "instance-fn provides unused keys: %s" (vec extra-ks))) 293 | (doseq [[k s] os] 294 | (schema/assert-satisfies-schema (or (get is k) (get is (s/optional-key k))) s)))) 295 | 296 | (defn comp-partial-fn 297 | "Return a new pfnk representing the composition #(f (merge % (other %)))" 298 | [f other] 299 | (pfnk/fn->fnk 300 | (fn [m] (f (merge m (other m)))) 301 | (schema/compose-schemata (pfnk/io-schemata f) (pfnk/io-schemata other)))) 302 | 303 | (defn comp-partial 304 | "Experimental. 305 | 306 | An extension of pfnk/comp-partial that supplies new parameters to a subgraph, 307 | useful in composing hierarchical graphs. 308 | 309 | g is a graph, and instance-fn is a fnk that takes arguments from the surrounding 310 | context and produces new parameters that are fed into g. Works by comp-partialing 311 | all leafs that expects any parameter produced by instance-fn with instance-fn, 312 | so beware of expensive instance-fns, or those that expect caching of some sort 313 | (i.e., attempt to generate shared state). 314 | 315 | Throws an error if any parameter supplied by instance-fn is not used by at least 316 | one node in g." 317 | [g instance-fn] 318 | (if (fn? g) 319 | (comp-partial-fn g instance-fn) 320 | (let [os (pfnk/output-schema instance-fn)] 321 | (check-comp-partial! g instance-fn) 322 | (->graph 323 | (map/map-leaves 324 | (fn [node-fn] 325 | (if (some os (pfnk/input-schema-keys node-fn)) 326 | (comp-partial-fn node-fn instance-fn) 327 | node-fn)) 328 | g))))) 329 | 330 | #?(:clj 331 | (defmacro instance 332 | "Experimental. 333 | 334 | Convenience macro for comp-partial, used to supply inline parameters to a 335 | subgraph (or fnk). 336 | 337 | Example: 338 | (= {:x 21} 339 | (run (instance {:x (fnk [a] (inc a))} [z] {:a (* z 2)}) 340 | {:z 10}))" 341 | ([g m] `(instance ~g [] ~m)) 342 | ([g bind m] 343 | `(comp-partial ~g (plumbing/fnk ~bind ~m))))) 344 | 345 | (defn profiled 346 | "Modify graph spec g, producing a new graph spec with a new top-level key 347 | 'profile-key'. After each node value is computed, the number of milliseconds 348 | taken to compute its value will be stored under an atom at 'profile-key'." 349 | [profile-key g] 350 | (assert (and (keyword? profile-key) (not (get g profile-key)))) 351 | (->graph 352 | (assoc (map/map-leaves-and-path 353 | (fn [ks f] 354 | (pfnk/fn->fnk 355 | (fn [m] 356 | (let [pm (plumbing/safe-get m profile-key) 357 | start #?(:clj (System/nanoTime) 358 | :cljs (plumbing/millis)) 359 | res (f (dissoc m profile-key))] 360 | (swap! pm assoc-in ks 361 | #?(:clj (/ (- (System/nanoTime) start) 1000000.0) 362 | :cljs (- (plumbing/millis) start))) 363 | res)) 364 | [(assoc (pfnk/input-schema f) 365 | profile-key s/Any) 366 | (pfnk/output-schema f)])) 367 | (->graph g)) 368 | profile-key (plumbing/fnk [] (atom {}))))) 369 | -------------------------------------------------------------------------------- /src/plumbing/graph/positional.clj: -------------------------------------------------------------------------------- 1 | (ns plumbing.graph.positional 2 | "A compilation method for graphs that avoids maps for speed. 3 | Prone to failure for graphs with more nodes than `max-graph-size`." 4 | (:use plumbing.core) 5 | (:require 6 | [schema.core :as s] 7 | [plumbing.fnk.schema :as schema] 8 | [plumbing.fnk.pfnk :as pfnk] 9 | [plumbing.fnk.impl :as fnk-impl]) 10 | (:import 11 | clojure.lang.IFn)) 12 | 13 | (def max-graph-size 14 | "The positional compilation algorithm provided by this namespace 15 | reliably succeeds only with graphs with `max-graph-size` or less nodes. 16 | 17 | The basic strategy is to generate a defrecord field for each node 18 | (of which there is a limit of around 120) and then generate a constructor 19 | function (whose code size grows linearly in the number of nodes)." 20 | 100) 21 | 22 | (defn def-graph-record 23 | "Define a record for the output of a graph. It is usable as a function to be 24 | as close to a map as possible. Return the typename." 25 | ([g] (def-graph-record g (gensym "graph-record"))) 26 | ([g record-type-name] 27 | ;; NOTE: This eval is needed because we want to define a record based on 28 | ;; information (a graph) that's only available at runtime. 29 | (eval `(defrecord ~record-type-name ~(->> g 30 | pfnk/output-schema 31 | keys 32 | (mapv (comp symbol name))) 33 | IFn 34 | (invoke [this# k#] 35 | (get this# k#)) 36 | (invoke [this# k# not-found#] 37 | (get this# k# not-found#)) 38 | (applyTo [this# args#] 39 | (apply get this# args#)))) 40 | record-type-name)) 41 | 42 | (defn graph-let-bindings 43 | "Compute the bindings for functions and intermediates needed to form the body 44 | of a positional graph, E.g. 45 | [`[[f-3 ~some-function]] `[[intermediate-3 (f-3 intermediate-1 intermediate-2)]]]" 46 | [g g-value-syms] 47 | (->> g 48 | (map (fn [[kw f]] 49 | (let [f-sym (-> kw name (str "-fn") gensym) 50 | arg-forms (map-from-keys g-value-syms (pfnk/input-schema-keys f)) 51 | [f arg-forms] (fnk-impl/efficient-call-forms f arg-forms)] 52 | [[f-sym f] [(g-value-syms kw) (cons f-sym arg-forms)]]))) 53 | (apply map vector))) 54 | 55 | (defn eval-bound 56 | "Evaluate a form with some symbols bound to some values." 57 | [form bindings] 58 | ((eval `(fn [~(mapv first bindings)] ~form)) 59 | (map second bindings))) 60 | 61 | (defn graph-form 62 | "Construct [body-form bindings-needed-for-eval] for a positional graph." 63 | [g arg-keywords] 64 | (let [value-syms (->> g 65 | pfnk/io-schemata 66 | (mapcat schema/explicit-schema-key-map) 67 | (map key) 68 | (map-from-keys (comp gensym name))) 69 | [needed-bindings value-bindings] (graph-let-bindings g value-syms) 70 | record-type (def-graph-record g)] 71 | [`(fn 72 | positional-graph# ;; Name it just for kicks. 73 | ~(mapv value-syms arg-keywords) 74 | (let ~(vec (apply concat value-bindings)) 75 | (new ~record-type ~@(->> g pfnk/output-schema keys (mapv value-syms))))) 76 | needed-bindings])) 77 | 78 | (defn positional-flat-compile 79 | "Positional compile for a flat (non-nested) graph." 80 | [g] 81 | (let [arg-ks (->> g pfnk/input-schema-keys) 82 | [positional-fn-form eval-bindings] (graph-form g arg-ks) 83 | input-schema (pfnk/input-schema g) 84 | pos-fn-sym (gensym "pos") 85 | input-schema-sym (gensym "input-schema") 86 | output-schema-sym (gensym "output-schema")] 87 | (vary-meta ;; workaround evaluation quirks 88 | (eval-bound 89 | `(let [~pos-fn-sym ~positional-fn-form] 90 | ~(fnk-impl/positional-fnk-form 91 | (fnk-impl/schema-override 'graph-positional output-schema-sym) 92 | input-schema-sym 93 | (vec (schema/explicit-schema-key-map input-schema)) 94 | (into {} (for [k (keys (schema/explicit-schema-key-map input-schema))] [k (symbol (name k))])) 95 | (list `(~pos-fn-sym ~@(mapv (comp symbol name) arg-ks))) 96 | nil)) 97 | (into eval-bindings 98 | [[input-schema-sym input-schema] 99 | [output-schema-sym (pfnk/output-schema g)]])) 100 | assoc :schema (let [[is os] (pfnk/io-schemata g)] (s/=> os is))))) 101 | -------------------------------------------------------------------------------- /src/plumbing/graph_async.cljc: -------------------------------------------------------------------------------- 1 | (ns plumbing.graph-async 2 | #?(:cljs 3 | (:require-macros 4 | [cljs.core.async.macros :refer [go]])) 5 | (:require 6 | #?(:clj [clojure.core.async :as async :refer [go !]] 7 | :cljs [cljs.core.async :as async :refer [!]]) 8 | #?(:clj [clojure.core.async.impl.protocols :as async-protocols] 9 | :cljs [cljs.core.async.impl.protocols :as async-protocols]) 10 | [plumbing.fnk.pfnk :as pfnk] 11 | [plumbing.fnk.schema :as schema #?@(:cljs [:include-macros true])] 12 | [plumbing.core :as plumbing #?@(:cljs [:include-macros true])] 13 | [plumbing.graph :as graph #?@(:cljs [:include-macros true])])) 14 | 15 | (defn asyncify 16 | "Take a fnk f and return an async version by wrapping non-channel 17 | return values in a channel" 18 | [f] 19 | (pfnk/fn->fnk 20 | (fn [m] 21 | (let [v (f m)] 22 | (if (satisfies? async-protocols/ReadPort v) 23 | v 24 | (go v)))) 25 | (pfnk/io-schemata f))) 26 | 27 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 28 | ;;; Public 29 | 30 | (defn async-compile 31 | "Experimental. 32 | 33 | Compile a hierarchical graph with (some) async fnks into an channel that 34 | contains the computed graph once completed. 35 | 36 | Each fnk can perform async operations by returning a channel that contains 37 | its node value once completed. 38 | 39 | Each node function will be evaluated as its dependencies have been fully 40 | computed." 41 | [g] 42 | (if (fn? g) 43 | (asyncify g) 44 | (let [g (graph/->graph (plumbing/map-vals async-compile g)) 45 | req-ks (schema/required-toplevel-keys (pfnk/input-schema g)) 46 | edges (concat 47 | (for [[k v] g 48 | parent-k (filter g (pfnk/input-schema-keys v))] 49 | [parent-k k]) 50 | (for [k (keys g)] 51 | [k ::done])) 52 | child-map (->> edges 53 | (group-by first) 54 | (plumbing/map-vals #(set (map second %)))) 55 | parent-map (->> edges 56 | (group-by second) 57 | (plumbing/map-vals #(set (map first %))))] 58 | (pfnk/fn->fnk 59 | (fn [m] 60 | (let [missing-keys (seq (remove #(contains? m %) req-ks))] 61 | (schema/assert-iae (empty? missing-keys) 62 | "Missing top-level keys in graph input: %s" 63 | (set missing-keys))) 64 | (let [result (async/chan) 65 | remaining-parents (atom parent-map) 66 | results (atom m) 67 | run-node (fn run-node [k] 68 | (go 69 | (if (= ::done k) 70 | (>! result (select-keys @results (keys g))) 71 | (let [f (g k) 72 | r ( base (get k) deref) 148 | not-found)) 149 | IFn 150 | (invoke [this k] (.valAt this k nil)) 151 | (invoke [this k not-found] (.valAt this k not-found)) 152 | (applyTo 153 | [this args] 154 | (let [[k v & rest-args :as args] (seq args)] 155 | (when (or (not args) rest-args) 156 | (throw (Exception. "lazy map must be called with one or two arguments"))) 157 | (.valAt this k v))) 158 | Seqable 159 | (seq 160 | [this] 161 | (when-let [inner-seq (seq base)] 162 | (create-lazy-map-seq inner-seq))) 163 | IObj 164 | (withMeta [this new-metadata] (create-lazy-map base new-metadata)) 165 | ; IMeta 166 | (meta [this] metadata) 167 | Iterable 168 | (iterator [this] (-> this .seq SeqIterator.))) 169 | 170 | (defn create-lazy-map 171 | ([base] 172 | (create-lazy-map base nil)) 173 | ([base metadata] 174 | (LazyPersistentMap. base metadata))) 175 | 176 | (defn- quote-values 177 | [kvs] 178 | (assert (even? (count kvs))) 179 | (mapcat (fn [[k v]] [k `(delay ~v)]) (partition 2 kvs))) 180 | 181 | (defn lazy-assoc* 182 | "lazy-assoc* is like lazy-assoc but a function and takes values as delays 183 | instead of expanding into a delay of val." 184 | [m & kvs] 185 | (assert (even? (count kvs))) 186 | (reduce (fn [m [k v]] (delay-assoc m k v)) m (partition 2 kvs))) 187 | 188 | (defmacro lazy-assoc 189 | "lazy-assoc associates new values to the given keys in the given lazy map. 190 | The values are not evaluated, before their first retrieval. They are 191 | evaluated at most once." 192 | [m & kvs] 193 | `(lazy-assoc* ~m ~@(quote-values kvs))) 194 | 195 | (defn lazy-hash-map* 196 | "lazy-hash-map* is the same as lazy-hash-map except that its a function 197 | and it takes a seq of keys-delayed-value pairs." 198 | [& kvs] 199 | (create-lazy-map (apply hash-map kvs))) 200 | 201 | (defmacro lazy-hash-map 202 | "lazy-hash-map creates a map. The values are not evaluated before their 203 | first retrieval. Each value is evaluated at most once. The underlying map 204 | is a hash map." 205 | [& kvs] 206 | `(lazy-hash-map* ~@(quote-values kvs))) 207 | 208 | (defn lazy-sorted-map* 209 | "lazy-sorted-map* is the same as lazy-sorted-map except that its a 210 | function and it takes a seq of keys-delayed-value pairs." 211 | [& kvs] 212 | (create-lazy-map (apply sorted-map kvs))) 213 | 214 | (defmacro lazy-sorted-map 215 | "lazy-sorted-map creates a map. The values are not evaluated before their 216 | first retrieval. Each value is evaluated at most once. The underlying map 217 | is a sorted map." 218 | [& kvs] 219 | `(lazy-sorted-map* ~@(quote-values kvs))) 220 | 221 | (defn lazy-struct-map* 222 | "lazy-struct-map* is the same as lazy-struct-map except that its a 223 | function and it takes a seq of keys-delayed-value pairs together with the 224 | struct basis." 225 | [s & kvs] 226 | (create-lazy-map (apply struct-map s kvs))) 227 | 228 | (defmacro lazy-struct-map 229 | "lazy-struct-map creates a map. The values are not evaluated before their 230 | first retrieval. Each value is evaluated at most once. The underlying map 231 | is a struct map according to the provided structure s." 232 | [s & kvs] 233 | `(lazy-struct-map* ~s ~@(quote-values kvs))) 234 | 235 | (defn lazy-struct* 236 | "lazy-struct* is the same as lazy-struct except that its a function and 237 | it takes a seq of delayed value together with the struct basis." 238 | [s & vs] 239 | (create-lazy-map (apply struct s vs))) 240 | 241 | (defmacro lazy-struct 242 | "lazy-struct creates a map. The values are not evaluated before their 243 | first retrieval. Each value is evaluated at most once. The underlying map 244 | is a struct map according to the provided structure s. As with Clojure's 245 | struct the values have to appear in the order of the keys in the structure." 246 | [s & vs] 247 | (let [vs (map (fn [v] `(delay ~v)) vs)] 248 | `(lazy-struct* ~s ~@vs))) -------------------------------------------------------------------------------- /src/plumbing/map.cljc: -------------------------------------------------------------------------------- 1 | (ns plumbing.map 2 | "Common operations on maps (both Clojure immutable and mutable Java stuff)" 3 | (:refer-clojure :exclude [flatten]) 4 | (:require 5 | [plumbing.core :as plumbing #?@(:cljs [:include-macros true])] 6 | [plumbing.fnk.schema :as schema #?@(:cljs [:include-macros true])])) 7 | 8 | 9 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10 | ;;; Clojure immutable maps 11 | 12 | (defn safe-select-keys 13 | "Like select-keys, but asserts that all keys are present." 14 | [m ks] 15 | (let [missing (remove (partial contains? m) ks)] 16 | (schema/assert-iae (empty? missing) "Keys %s not found in %s" (vec missing) 17 | (binding [*print-length* 200] 18 | (print-str (mapv key m))))) 19 | (select-keys m ks)) 20 | 21 | (defn merge-disjoint 22 | "Like merge, but throws with any key overlap between maps" 23 | ([] {}) 24 | ([m] m) 25 | ([m1 m2] 26 | (let [duplicates (filter (partial contains? m2) (keys m1))] 27 | (schema/assert-iae (empty? duplicates) "Duplicate keys %s" 28 | (vec duplicates))) 29 | (into (or m2 {}) m1)) 30 | ([m1 m2 & maps] 31 | (reduce merge-disjoint m1 (cons m2 maps)))) 32 | 33 | (defn merge-with-key 34 | "Like merge-with, but the merging function takes the key being merged 35 | as the first argument" 36 | [f & maps] 37 | (when (some identity maps) 38 | (let [merge-entry (fn [m e] 39 | (let [k (key e) v (val e)] 40 | (if (contains? m k) 41 | (assoc m k (f k (get m k) v)) 42 | (assoc m k v)))) 43 | merge2 (fn [m1 m2] 44 | (reduce merge-entry (or m1 {}) (seq m2)))] 45 | (reduce merge2 maps)))) 46 | 47 | (defn flatten 48 | "Transform a nested map into a seq of [keyseq leaf-val] pairs" 49 | [m] 50 | (when m 51 | ((fn flatten-helper [keyseq m] 52 | (if (map? m) 53 | (mapcat (fn [[k v]] (flatten-helper (conj keyseq k) v)) m) 54 | [[keyseq m]])) 55 | [] m))) 56 | 57 | (defn unflatten 58 | "Transform a seq of [keyseq leaf-val] pairs into a nested map. 59 | If one keyseq is a prefix of another, you're on your own." 60 | [s] 61 | (reduce (fn [m [ks v]] (if (seq ks) (assoc-in m ks v) v)) {} s)) 62 | 63 | 64 | ;; TODO: make sure we're safe with false here -- pretty sure we're not. Same for nil. 65 | (defn map-leaves-and-path 66 | "Takes a nested map and returns a nested map with the same shape, where each 67 | (non-map) leaf v is transformed to (f key-seq v). 68 | key-seq is the sequence of keys to reach this leaf, starting at the root." 69 | ([f m] (when m (map-leaves-and-path f [] m))) 70 | ([f ks m] 71 | (if-not (map? m) 72 | (f ks m) 73 | (plumbing/for-map [[k v] m] 74 | k 75 | (map-leaves-and-path f (conj ks k) v))))) 76 | 77 | (defn keep-leaves-and-path 78 | "Takes a nested map and returns a nested map with the same shape, where each 79 | (non-map) leaf v is transformed to (f key-seq v), or removed if it returns nil. 80 | key-seq is the sequence of keys to reach this leaf, starting at the root. 81 | Empty maps produced by this pruning are themselves pruned from the output." 82 | ([f m] (keep-leaves-and-path f [] m)) 83 | ([f ks m] 84 | (if-not (map? m) 85 | (f ks m) 86 | (plumbing/for-map [[k ov] m 87 | :let [nv (keep-leaves-and-path f (conj ks k) ov)] 88 | :when (not (or (nil? nv) (and (map? nv) (empty? nv))))] 89 | k nv)))) 90 | 91 | (defn map-leaves 92 | "Takes a nested map and returns a nested map with the same shape, where each 93 | (non-map) leaf v is transformed to (f v)." 94 | ([f m] (map-leaves-and-path (fn [_ l] (f l)) m))) 95 | 96 | (defn keep-leaves 97 | "Takes a nested map and returns a nested map with the same shape, where each 98 | (non-map) leaf v is transformed to (f v), or removed if it returns nil. 99 | Empty maps produced by this pruning are themselves pruned from the output." 100 | ([f m] (keep-leaves-and-path (fn [_ l] (f l)) m))) 101 | 102 | (defmacro keyword-map 103 | "Expands to a map whose keys are keywords with the same name as the given 104 | symbols, e.g.: 105 | 106 | (let [x 41, y (inc x)] 107 | (keyword-map x y)) 108 | 109 | ;; => {:x 41, :y 42}" 110 | [& syms] 111 | (when-not (every? symbol? syms) 112 | (throw (ex-info "Arguments to keyword-map must be symbols!" {:args syms}))) 113 | (zipmap (map #(keyword (name %)) syms) syms)) 114 | 115 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 116 | ;;; Java mutable Maps 117 | 118 | #?(:clj 119 | (do 120 | (defn update-key! 121 | "Transform value in java.util.Map m under key k with fn f." 122 | ([^java.util.Map m k f] 123 | (.put m k (f (.get m k)))) 124 | ([^java.util.Map m k f & args] 125 | (.put m k (apply f (.get m k) args)))) 126 | 127 | (defmacro get! 128 | "Get the value in java.util.Map m under key k. If the key is not present, 129 | set the value to the result of default-expr and return it. Useful for 130 | constructing mutable nested structures on the fly. 131 | 132 | (.add ^List (get! m :k (java.util.ArrayList.)) :foo)" 133 | [m k default-expr] 134 | `(let [^java.util.Map m# ~m k# ~k] 135 | (or (.get m# k#) 136 | (let [nv# ~default-expr] 137 | (.put m# k# nv#) 138 | nv#)))) 139 | 140 | (defn inc-key! 141 | "Increment the value in java.util.Map m under key k by double d." 142 | [^java.util.Map m k ^double d] 143 | (.put m k (if-let [v (.get m k)] 144 | (+ (double v) d) 145 | d))) 146 | 147 | (defn inc-key-in! 148 | "Increment the value in java.util.Map m under key-seq ks by double d, 149 | creating and storing HashMaps under missing keys on the path to this leaf." 150 | [^java.util.Map m ks ^double d] 151 | (if-let [mk (next ks)] 152 | (recur (get! m (first ks) (java.util.HashMap.)) mk d) 153 | (inc-key! m (first ks) d))) 154 | 155 | 156 | (defn ^java.util.HashMap collate 157 | "Take a seq of [k v] counts and sum them up into a HashMap on k." 158 | [flat-counts] 159 | (let [m (java.util.HashMap.)] 160 | (doseq [[k v] flat-counts] 161 | (inc-key! m k v)) 162 | m)) 163 | 164 | (defn ^java.util.HashMap deep-collate 165 | "Take a seq of [kseq v] counts and sum them up into nested HashMaps" 166 | [nested-counts] 167 | (let [m (java.util.HashMap.)] 168 | (doseq [[ks v] nested-counts] 169 | (inc-key-in! m ks v)) 170 | m)))) 171 | 172 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 173 | ;;; Ops on graphs represented as maps. 174 | 175 | #?(:clj 176 | (defn topological-sort 177 | "Take an adjacency list representation of a graph (a map from node names to 178 | sequences of child node names), and return a topological ordering of the node 179 | names in linear time, or throw an error if the graph is cyclic. 180 | If include-leaves? is false the ordering will only include keys from child-map, 181 | and if true it will also include nodes only named as children in child-map." 182 | [child-map & [include-leaves?]] 183 | (let [e (java.util.HashMap. ^java.util.Map child-map) 184 | re (java.util.HashMap.) 185 | s (java.util.Stack.)] 186 | (doseq [[p children] child-map 187 | c children] 188 | (when include-leaves? (when-not (.containsKey e c) (.put e c nil))) 189 | (update-key! re c #(cons p %))) 190 | (while (not (.isEmpty e)) 191 | ((fn dfs1 [n] 192 | (when (.containsKey e n) 193 | (let [nns (.get e n)] 194 | (.remove e n) 195 | (doseq [nn nns] (dfs1 nn))) 196 | (.push s n))) 197 | (first (keys e)))) 198 | (let [candidate (reverse (seq s))] 199 | (doseq [c candidate 200 | r (.remove re c)] 201 | (when (.containsKey re r) 202 | (throw (IllegalArgumentException. (format "Graph contains a cycle containing %s and %s" c r))))) 203 | candidate)))) 204 | 205 | #?(:cljs 206 | (defn topological-sort 207 | [child-map & [include-leaves?]] 208 | (let [e (atom child-map) 209 | re (atom {}) 210 | s (atom [])] 211 | (doseq [[p children] child-map 212 | c children] 213 | (when include-leaves? (when-not (find @e c) (swap! e assoc c nil))) 214 | (swap! re update c #(cons p %))) 215 | (while (seq @e) 216 | ((fn dfs1 [n] 217 | (when-let [[_ nns] (find @e n)] 218 | (swap! e dissoc n) 219 | (doseq [nn nns] (dfs1 nn)) 220 | (swap! s conj n))) 221 | (first (keys @e)))) 222 | (let [candidate (reverse @s)] 223 | (doseq [c candidate 224 | :let [rs (@re c) 225 | _ (swap! re dissoc c)] 226 | r rs] 227 | (when (find @re r) 228 | (throw (ex-info (str "Graph contains a cycle containing " c " and " r) {:nodes [c r]})))) 229 | candidate)))) 230 | -------------------------------------------------------------------------------- /test/plumbing/core_test.cljc: -------------------------------------------------------------------------------- 1 | (ns plumbing.core-test 2 | (:require 3 | [schema.core :as s] 4 | [schema.test :as schema-test] 5 | [plumbing.core :as p :include-macros true] 6 | [plumbing.fnk.pfnk :as pfnk] 7 | #?(:clj [plumbing.fnk.impl :as fnk-impl]) 8 | #?(:clj [clojure.test :refer :all] 9 | :cljs [cljs.test :refer-macros [is are deftest testing use-fixtures]]))) 10 | 11 | #?(:cljs 12 | (do 13 | (def Exception js/Error) 14 | (def AssertionError js/Error) 15 | (def Throwable js/Error))) 16 | 17 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 18 | ;;; Maps 19 | 20 | (deftest for-map-test 21 | (is (= (p/for-map [i [1 2] 22 | j [10 20]] 23 | (+ i j) 24 | j) 25 | {11 10 12 10 26 | 21 20 22 20})) 27 | (is (= (p/for-map [i [1 2] 28 | j [10 20]] 29 | i 30 | j) 31 | {1 20 2 20})) 32 | (let [m (p/for-map m [i (range 1000)] i (+ i (get m (dec i) 0)))] 33 | (is (= (count m) 1000)) 34 | (is (= (m 999) 499500)))) 35 | 36 | (deftest map-vals-test 37 | (is (= (p/map-vals inc {:a 0 :b 0}) 38 | {:a 1 :b 1})) 39 | (is (= (p/map-vals inc [[:a 0] [:b 0]]) 40 | {:a 1 :b 1})) 41 | (is (= (p/map-vals inc (sorted-map :a 0 :b 0)) 42 | {:a 1 :b 1})) 43 | (is (sorted? (p/map-vals inc (sorted-map :a 0 :b 0))))) 44 | 45 | (deftest map-keys-test 46 | (is (= (p/map-keys str {:a 1 :b 1}) 47 | {":a" 1 ":b" 1})) 48 | (is (= (p/map-keys str [[:a 1] [:b 1]]) 49 | {":a" 1 ":b" 1}))) 50 | 51 | (deftest map-from-keys-test 52 | (is (= (p/map-from-keys inc [0 1 2]) 53 | {0 1, 1 2, 2 3}))) 54 | 55 | (deftest map-from-vals-test 56 | (is (= (p/map-from-vals inc [0 1 2]) 57 | {1 0, 2 1, 3 2}))) 58 | 59 | (deftest dissoc-in-test 60 | (is (= {:a 1} (p/dissoc-in {:a 1 :b 2} [:b]))) 61 | (is (= {:a 1 :b {:d 3}} (p/dissoc-in {:a 1 :b {:c 2 :d 3}} [:b :c]))) 62 | (is (= {:a 1} (p/dissoc-in {:a 1 :b {:c 2}} [:b :c]))) 63 | (is (= {:a 1} (p/dissoc-in {:a 1} [:b :c]))) 64 | (is (thrown? Exception (p/dissoc-in {:a 1 :b :not-a-map} [:b :c]))) 65 | (is (= nil (p/dissoc-in {:a 1} [:a]))) 66 | (is (= nil (p/dissoc-in nil [:a]))) 67 | (is (= nil (p/dissoc-in {} [:a])))) 68 | 69 | (deftest keywordize-map-test 70 | (is (= {:foo 1 71 | :bar [2] 72 | :baz [{:x 42}]} 73 | (p/keywordize-map {"foo" 1 74 | "bar" [2] 75 | :baz [{"x" 42}]}))) 76 | 77 | (is (= {:foo 1 78 | :bar [2] 79 | :baz {:x 42}} 80 | (p/keywordize-map {"foo" 1 81 | "bar" [2] 82 | :baz {"x" 42}})))) 83 | 84 | (deftest lazy-get-test 85 | (let [counter (atom 0)] 86 | (is (= 1 (p/lazy-get {:a 1} :a (do (swap! counter inc) 2)))) 87 | (is (zero? @counter)) 88 | (is (= 2 (p/lazy-get {:a 1} :b (do (swap! counter inc) 2)))) 89 | (is (= 1 @counter)) 90 | (is (= 2 (p/lazy-get {:a 1 :b 2} :b (do (swap! counter inc) 2)))) 91 | (is (= 1 @counter)))) 92 | 93 | 94 | (deftest safe-get-test 95 | (is (= 2 (p/safe-get {:a 2} :a))) 96 | (is (thrown? Exception (p/safe-get {:a 2} :b))) 97 | (is (= 2 (p/safe-get-in {:a {:b 2}} [:a :b]))) 98 | (is (thrown? Exception (p/safe-get-in {:a {:b 2}} [:b]))) 99 | (is (thrown? Exception (p/safe-get-in {:a {:b 2}} [:a :c]))) 100 | (is (thrown? Exception (p/safe-get-in {:a {:b 2}} [:a :b :d])))) 101 | 102 | (deftest assoc-when-test 103 | (is (= {:a 1} (p/assoc-when nil :a 1))) 104 | (is (= {:a 1 :c 2} (p/assoc-when {:a 1} :b nil :c 2)))) 105 | 106 | (deftest update-in-when-test 107 | (is (= nil (p/update-in-when nil [:a] inc))) 108 | (is (= {:a {:b 2}} (p/update-in-when {:a {:b 2}} [:a :c] inc))) 109 | (is (= {} (p/update-in-when {} [:foo :bar] inc))) 110 | (is (= {:foo 2 :bar 1} (p/update-in-when {:foo 1 :bar 1} [:foo] inc))) 111 | (is (= {:a {:b 3 :z 5}} (p/update-in-when {:a {:b 2 :z 5}} [:a :b] inc)))) 112 | 113 | (deftest grouped-map-test 114 | (is (= {:a [1 2] :b [3]} (p/grouped-map first second [[:a 1] [:b 3] [:a 2]])))) 115 | 116 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 117 | ;;; Seqs 118 | 119 | (deftest aconcat-test 120 | (is (= [1 2 3 4 5 6] (p/aconcat [[1 2 3] [4 5 6]])))) 121 | 122 | (deftest unchunk-test 123 | (let [realized (atom #{}) 124 | xs (map (fn [x] 125 | (swap! realized conj x) 126 | x) 127 | (p/unchunk (range 10)))] 128 | (is (empty? @realized)) 129 | (doseq [x (range 10)] 130 | (is (not (@realized x))) 131 | (is (= x (nth xs x))) 132 | (is (@realized x))))) 133 | 134 | (deftest sum-test 135 | (is (= 55 (p/sum (range 1 11)))) 136 | (is (= 55 (p/sum inc (range 10))))) 137 | 138 | (deftest singleton-test 139 | (is (= 1 (p/singleton [1]))) 140 | (is (nil? (p/singleton [1 2])))) 141 | 142 | (deftest indexed-test 143 | (is (empty? (p/indexed nil))) 144 | (is (= [[0 :a] [1 :b] [2 :c]] (p/indexed [:a :b :c]))) 145 | (is (= [[0 :a] [1 :b] [2 :c] [3 0]] (take 4 (p/indexed (concat [:a :b :c] (range))))))) 146 | 147 | (deftest positions-test 148 | (is (empty? (p/positions odd? [2 4 6 8 10]))) 149 | (is (= [0 1 2] (p/positions odd? [1 3 5 2 4 6]))) 150 | (is (= [1 3 5] (take 3 (p/positions odd? (range)))))) 151 | 152 | #?(:clj 153 | (deftest frequencies-fast-test 154 | (is (= {\p 2, \s 4, \i 4, \m 1} 155 | (p/frequencies-fast "mississippi"))) 156 | (is (= {1 3 2 2 3 1} 157 | (p/frequencies-fast [1 2 3 1 2 1]))) 158 | ;; We don't return the right thing on = but not .equals things, 159 | ;; because of the difference between Java Maps and Clojure maps. 160 | (is (= {1 1} 161 | (p/frequencies-fast [1 (BigInteger. "1")]))))) 162 | #?(:clj 163 | (deftest distinct-fast-test 164 | (is (= [1 2 3] 165 | (p/distinct-fast [1 2 3]))) 166 | (is (= [1 2 3] 167 | (p/distinct-fast [1 2 3 2 1 2 3 2 2]))) 168 | (is (= [] 169 | (p/distinct-fast []))))) 170 | 171 | #?(:clj 172 | (defn are-fast-things-faster [] 173 | (let [s (apply concat (repeat 100 (range 10000)))] 174 | (doseq [f [frequencies p/frequencies-fast distinct p/distinct-fast]] 175 | (println f) 176 | (dotimes [_ 5] 177 | (time (doall (f s)))))))) 178 | 179 | (deftest distinct-by-test 180 | (is (= [{:id 1 :data "a"}] 181 | (p/distinct-by :id 182 | [{:id 1 :data "a"} 183 | {:id 1 :data "b"}]))) 184 | (is (= [1 2 3 2 1] 185 | (map second 186 | (p/distinct-by 187 | first 188 | [[1 1] 189 | [1 10] 190 | [17 2] 191 | [1 12] 192 | [:foo 3] 193 | [:foo 3] 194 | ['bar 2] 195 | [1 3] 196 | [3 1]]))))) 197 | 198 | #?(:clj 199 | (deftest distinct-id-test 200 | (let [x (p/distinct-id [:a :b :c :a :b (Long. 1) (Long. 1)])] 201 | (is (= 5 (count x))) 202 | (is (= #{:a :b :c 1} (set x))) 203 | (is (= #{:a :b :c 1} (set x))) 204 | (is (empty? (p/distinct-id nil)))))) 205 | 206 | (deftest interleave-all-test 207 | (is (= [:a 0 :b 1 :c :d] (p/interleave-all [:a :b :c :d] [0 1])))) 208 | 209 | (deftest count-when-test 210 | (is (= 5 (p/count-when even? (range 10))))) 211 | 212 | (deftest conj-when-test 213 | (is (= [:a :b :c] 214 | (p/conj-when [:a] :b nil :c)))) 215 | 216 | (deftest cons-when-test 217 | (is (= [1 2] (p/cons-when nil [1 2]))) 218 | (is (= [1 2] (p/cons-when false [1 2]))) 219 | (is (= [3 1 2] (p/cons-when 3 [1 2])))) 220 | 221 | (deftest rsort-by-test 222 | (is (= [5 4 3 2 1] (p/rsort-by identity [3 2 1 4 5])))) 223 | 224 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 225 | ;;; Control flow 226 | 227 | (deftest ?>>-test 228 | (let [side-effect (atom [])] 229 | (is (= (range 10) 230 | (->> (range 10) 231 | (p/?>> false 232 | ((do (swap! side-effect conj :bad) map) inc) 233 | (map inc))))) 234 | (is (empty? @side-effect)) 235 | (is (= (range 2 12) 236 | (->> (range 10) 237 | (p/?>> true 238 | ((do (swap! side-effect conj :good) map) inc) 239 | (map inc))))) 240 | (is (= @side-effect [:good])))) 241 | 242 | (deftest ?>-test 243 | (let [side-effect (atom [])] 244 | (is (= {:a 1} 245 | (-> {:a 1} 246 | (p/?> false 247 | ((do (swap! side-effect conj :bad) assoc) :b 1) 248 | (dissoc :a))))) 249 | (is (empty? @side-effect)) 250 | (is (= {:b 1} 251 | (-> {:a 1} 252 | (p/?> true 253 | ((do (swap! side-effect conj :good) assoc) :b 1) 254 | (dissoc :a))))) 255 | (is (= @side-effect [:good])))) 256 | 257 | (deftest fn->-test 258 | (is (= {:a 1 :b 1} ((p/fn-> (assoc :a 1)) {:b 1})))) 259 | 260 | (deftest fn->>-test 261 | (is (= (range 1 11) ((p/fn->> (map inc)) (range 10))))) 262 | 263 | (deftest <--test 264 | (is (= [2 3] 265 | (-> {1 1} 266 | (assoc 3 4) 267 | (update-in [1] inc) 268 | (->> (p/map-vals dec) 269 | (p/map-keys inc) 270 | (p/<- (update-in [2] inc) 271 | (map [2 4]))))))) 272 | 273 | (deftest as->>-test 274 | (is (= [1 2 3] 275 | (->> (range 5) 276 | (map inc) 277 | (p/as->> x (drop-last 2 x)))))) 278 | 279 | (deftest memoized-fn-test 280 | (let [calls (atom 0)] 281 | (is (= 55 282 | ((p/memoized-fn fib [x] (swap! calls inc) 283 | (case x 0 0 1 1 (+ (fib (- x 1)) (fib (- x 2))))) 284 | 10))) 285 | (is (= 11 @calls)))) 286 | 287 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 288 | ;;; Miscellaneous 289 | 290 | (deftest swap-pair!-test 291 | (let [a (atom {:a 1})] 292 | (is (= [{:a 1} {:a 2}] (p/swap-pair! a #(update-in % [:a] inc))))) 293 | (let [a (atom {:a 1})] 294 | (is (= [{:a 1} {:a 2}] (p/swap-pair! a update-in [:a] inc))))) 295 | 296 | (deftest get-and-set!-test 297 | (let [a (atom 1)] 298 | (is (= 1 (p/get-and-set! a 2))) 299 | (is (= 2 @a)))) 300 | 301 | (deftest mapply-test 302 | (letfn [(f [& {:as m}] 303 | (p/for-map [[k v] m] v k)) 304 | (g [a b c & {:as m}] 305 | {:init [a b c] :m m})] 306 | (is (= {42 :foo 90 :bar} (p/mapply f {:bar 90 :foo 42}))) 307 | (is (= {:init [1 2 3] 308 | :m nil} 309 | (p/mapply g 1 2 3 {}))))) 310 | 311 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 312 | ;;; fnk 313 | 314 | (deftest letk-test 315 | (let [called? (atom false) 316 | om {:a 1 :c 3 :d 4 :e 17 :g 22}] 317 | (p/letk [[a { b 2} c d {e 5} :as m & more] om] 318 | (is (= [a b c d e] [1 2 3 4 17])) 319 | (is (= m om)) 320 | (is (= {:g 22} more)) 321 | (reset! called? true)) 322 | (is @called?) 323 | (p/letk [[:as m] om] 324 | (is (= m om))) 325 | (p/letk [[a & m] om] 326 | (is (= a 1)) 327 | (is (= m (dissoc om :a)))) 328 | (p/letk [[a] {:a {:b 1}} 329 | [b] a] 330 | (is (= b 1))) 331 | (p/letk [[a] {:a [{:c 3}]} 332 | b (first a) 333 | [c] b] 334 | (is (= c 3))) 335 | (is (thrown? Throwable 336 | (p/letk [[a] {:b 2}] a))))) 337 | 338 | (deftest letk-self-shadow-test 339 | (is (= 2 (let [a 1] (p/letk [[{a a}] {:a 2}] a)))) 340 | (is (= 1 (let [a 1] (p/letk [[{a a}] {}] a)))) 341 | (is (= 2 (let [a 1] (p/letk [[{b/a a}] {:b/a 2}] a)))) 342 | (is (= 1 (let [a 1] (p/letk [[{b/a a}] {}] a))))) 343 | 344 | (deftest letk-single-shadow-test 345 | (let [a 1 b 2 c 3 e 4 e 5] 346 | (is (= [8 8 8 5 10] (p/letk [[c {a c} {b a} {d e} e] {:c 8 :e 10}] [a b c d e]))) 347 | (is (= [8 8 8 5 10] (p/letk [[c [:nest {a c} {b a} {d e}] e] {:c 8 :e 10 :nest {}}] [a b c d e]))))) 348 | 349 | (deftest letk-dont-require-map-for-nested-only-as 350 | (is (= 1 (p/letk [[[:a :as a]] {:a 1}] a)))) 351 | 352 | #?(:clj 353 | (deftest letk-no-multiple-binding-test 354 | (is (thrown? Exception (eval '(p/letk [[a a] {:a 1}] a)))) 355 | (is (thrown? Exception (eval '(p/letk [[a/a b/a] {:a/a 1 :b/a 2}] a)))) 356 | (is (= 1 (p/letk [[a] {:a 1} [a] {:a a}] a))) 357 | (is (= 1 (p/letk [[a/b] {:a/b 1} [a/b] {:a/b b}] b))))) 358 | 359 | (deftest letk-multi-shadow-test 360 | (let [a 1 b 2 c 3 e 4 e 5 361 | inp {:c 8 :e 10}] 362 | (is (= [8 8 8 5 10] (p/letk [[c] inp 363 | [{a c}] inp 364 | [{b a}] inp 365 | [{d e}] inp 366 | [e] inp] 367 | [a b c d e]))))) 368 | 369 | (deftest letk-qualified-key-test 370 | (let [m {:a/b 1 :c/d {:e/f 2 :a/b 2}}] 371 | (is (= 1 (p/letk [[a/b] m] b))) 372 | (is (= 2 (p/letk [[[:c/d e/f]] m] f))) 373 | (is (= 2 (p/letk [[a/b] m [[:c/d a/b]] m] b)))) 374 | (is (= 2 (p/letk [[a/b] {:a/b 1} [a/b] {:a/b 2}] b))) 375 | (is (= 2 (p/letk [[[:a/b :as c]] {:a/b 2}] c)))) 376 | 377 | (deftest when-letk-test 378 | (is (= "123" (p/when-letk [[a b c] {:a 1 :b 2 :c 3}] (str a b c)))) 379 | (is (= 5 (p/when-letk [[five] {:five 5}] 1 2 3 4 five))) 380 | (is (nil? (p/when-letk [[a b c] nil] (throw (Exception.)))))) 381 | 382 | (deftest if-letk-test 383 | (is (= "then" (p/if-letk [[a b c] {:a 1 :b 2 :c "then"}] c (throw (Exception.))))) 384 | (is (= "else" (p/if-letk [[a b c] nil] (throw (Exception.)) "else"))) 385 | (is (nil? (p/if-letk [[a b c] nil] (throw (Exception.)))))) 386 | 387 | (deftest fnk-test 388 | (testing "error on invalid input" 389 | (is (thrown? Throwable ((p/fnk [a] a) {:b 1})))) 390 | 391 | (let [call-count (atom 0) 392 | om {:a 1 :c 3 :d 4 :e 17 :g 22}] 393 | (testing "basic fnk" 394 | ((p/fnk [a b] 395 | (is (= a 1)) 396 | (is (= b 2)) 397 | (swap! call-count inc)) 398 | {:a 1 :b 2})) 399 | (testing "complex fnk" 400 | ((p/fnk [a {b 2} c d {e 5} :as m & more] 401 | (is (= [a b c d e] [4 2 3 4 17])) 402 | (is (= m (assoc om :a 4 :h 77))) 403 | (is (= {:g 22 :h 77} more)) 404 | (swap! call-count inc)) 405 | (assoc om :a 4 :h 77))) 406 | (testing "both fnks called" 407 | (is (= @call-count 2))) 408 | (testing "dependent optional values" 409 | (is (= [1 2 3] 410 | ((p/fnk [a {b (* a 2)} {c (inc b)}] [a b c]) {:a 1})))) 411 | 412 | #?(:clj 413 | (testing "positional-fn" 414 | (let [f (p/fnk [a {b 2} [:c :as c0] [:d d1 {d2 2} [:d3 :as d30] [:d4 d41 :as d4]]] 415 | (is (= [a b c0 d1 d2 d30 d41 d4] 416 | [4 2 3 4 2 17 18 {:d41 18 :d42 :foo}])) 417 | (swap! call-count inc))] 418 | (f {:a 4 :c 3 :d {:d1 4 :d3 17 :d4 {:d41 18 :d42 :foo}}}) 419 | ((fnk-impl/positional-fn f [:d :a :c]) 420 | {:d1 4 :d3 17 :d4 {:d41 18 :d42 :foo}} 4 3) 421 | (is (= @call-count 4)) 422 | (is (thrown? Throwable ((p/fnk [a] a) {:b 3}))))))) 423 | 424 | (testing "fnk output-schema" 425 | (doseq [f [(p/fnk [] {:a 1 :b {:b1 2}}) 426 | (p/fnk f :- {:a s/Any :b {:b1 s/Any}} [] 427 | (hash-map :a 1 :b {:b1 2} :c 3))]] 428 | (is (= (pfnk/output-schema f) {:a s/Any :b {:b1 s/Any}}))) 429 | (let [a :k] 430 | (is (= (pfnk/output-schema (p/fnk [a] {a a})) s/Any)))) 431 | 432 | (testing "metadata via reader macro" 433 | (let [fnk-with-meta ^{:has-meta true} (p/fnk [])] 434 | (is (:has-meta (meta fnk-with-meta))))) 435 | 436 | (testing "name if proivded" 437 | (is (= 'bob (pfnk/fnk-name (p/fnk bob [])))) 438 | (is (nil? (pfnk/fnk-name (p/fnk [])))))) 439 | 440 | (deftest fnk-input-schema-test 441 | (testing "simple fnk with one string key" 442 | (doseq [[t f] {"no-as" (p/fnk [a :- s/Str] a) 443 | "with-as" (p/fnk [a :- s/Str :as b] a)}] 444 | (testing t 445 | (is (= {:a s/Str s/Keyword s/Any} 446 | (pfnk/input-schema f))) 447 | (is (= "hi" (f {:a "hi"}))) 448 | (is (= "hi" (f {:a "hi" :b 123}))) 449 | (is (thrown? Exception (f {:a :lo}))) 450 | (is (thrown? Exception (f {:a "hi" "b" "no-string-keys"}))))) 451 | (is (= :lo ((p/fnk ^:never-validate foo [a :- s/Str] a) {:a :lo})))) 452 | 453 | (testing "schemas on nested and optional bindings" 454 | (doseq [[t f] {"no-as" (p/fnk [a :- s/Str {b :- s/Str "1"} [:c d :- s/Num]] 455 | [a b d]) 456 | "with-as" (p/fnk [a :- s/Str {b :- s/Str "1"} [:c d :- s/Num] :as m] 457 | [a b d])}] 458 | (testing t 459 | (is (= {:a s/Str 460 | (s/optional-key :b) s/Str 461 | :c {:d s/Num s/Keyword s/Any} 462 | s/Keyword s/Any} 463 | (pfnk/input-schema f))) 464 | (is (= ["hi" "1" 2] (f {:a "hi" :c {:d 2}}))) 465 | (is (= ["hi" "1" 2] (f {:a "hi" :c {:d 2 :e 3} :f :g}))) 466 | (is (= ["hi" "bye" 2] (f {:a "hi" :b "bye" :c {:d 2}}))) 467 | (is (thrown? Exception (f {:a "hi" :c {:d "2"}}))) 468 | (is (thrown? Exception (f {:a "hi" :b :bye :c {:d 2}})))))) 469 | 470 | (testing "schemas on & bindings" 471 | (let [f (p/fnk [a :- s/Str [:b c & more :- {s/Keyword s/Num}] & more :- {}] 472 | [a c])] 473 | (is (= {:a s/Str 474 | :b {:c s/Any s/Keyword s/Num}} 475 | (pfnk/input-schema f))) 476 | (is (= ["hi" 1] (f {:a "hi" :b {:c 1}}))) 477 | (is (= ["hi" 1] (f {:a "hi" :b {:c 1 :z 3}}))) 478 | (is (thrown? Exception (f {:a "hi" :b {:c 1 :z "3"}}))) 479 | (is (thrown? Exception (f {:a "hi" :b {:c 1} :d :e}))))) 480 | 481 | (testing "schema override on top-level map bindings" 482 | (let [override {:a s/Num (s/optional-key :b) s/Str (s/optional-key :e) s/Str}] 483 | (doseq [[t f] {"no-as" (p/fnk [a :- s/Str {b :- s/Str "1"}] :- override 484 | [a b]) 485 | "with-as" (p/fnk [a :- s/Str {b :- s/Str "1"} :as m] :- override 486 | [a b])}] 487 | (testing t 488 | (is (= override (pfnk/input-schema f))) 489 | (is (= [2 "1"] (f {:a 2}))) 490 | (is (= [2 "2"] (f {:a 2 :b "2"}))) 491 | (is (= [2 "2"] (f {:a 2 :b "2" :e "asdf"}))) 492 | (is (thrown? Exception (f {:a "2"}))) 493 | (is (thrown? Exception (f {:a 2 :b 2}))) 494 | (is (thrown? Exception (f {:a 2 :z :huh}))))))) 495 | 496 | (testing "schema override on inner map bindings" 497 | (let [f (p/fnk [a :- s/Str [:b c] :- {:c s/Str}] 498 | [a c])] 499 | (is (= {:a s/Str :b {:c s/Str} s/Keyword s/Any} (pfnk/input-schema f))) 500 | (is (= ["1" "2"] (f {:a "1" :b {:c "2"}}))) 501 | (is (thrown? Exception (f {:a "1" :b {:c 2}}))) 502 | (is (thrown? Exception (f {:a "1" :b {:c "2" :d "3"}}))))) 503 | 504 | (testing "default values" 505 | (let [first-key-meta (p/fn-> pfnk/input-schema (dissoc s/Keyword) keys first meta)] 506 | (is (= {:default "foo"} 507 | (first-key-meta (p/fnk [{a :- s/Str "foo"}])))) 508 | (is (= {:default 'apple} 509 | (first-key-meta (p/fnk [apple {a :- s/Str apple}]))))))) 510 | 511 | (deftest fnk-qualified-key-test 512 | (is (= [1 2 3] ((p/fnk [a/b b/c c/d] [b c d]) {:a/b 1 :b/c 2 :c/d 3}))) 513 | (is (= 1 ((p/fnk [[:a/b b/c]] c) {:a/b {:b/c 1}}))) 514 | (is (= 1 ((p/fnk [{a/b 1}] b) {}))) 515 | (is (= 1 ((p/fnk [[:a/b :as c]] c) {:a/b 1}))) 516 | (testing "schemas" 517 | (let [f (p/fnk [a/b :- s/Str [:b/c c/d :- s/Keyword]] [b d])] 518 | (is (= ["hi" :bye] (f {:a/b "hi" :b/c {:c/d :bye}}))) 519 | (is (= {:a/b s/Str 520 | :b/c {:c/d s/Keyword s/Keyword s/Any} 521 | s/Keyword s/Any} 522 | (pfnk/input-schema f))) 523 | (are [invalid-input] (thrown? Exception (f invalid-input)) 524 | nil 525 | {} 526 | {:b "hi" :c {:d :bye}} 527 | {:a/b nil :b/c nil} 528 | {:a/b nil :b/c {:c/d :bye}} 529 | {:a/b "hi" :b/c {:c/d "bye"}} 530 | {:a/b "hi" :b/c :bye})))) 531 | 532 | (p/defnk keyfn-test-docstring "whoa" [dude {wheres :foo} :as my & car] 533 | [dude wheres my car]) 534 | 535 | (p/defnk keyfn-test-no-docstring [{city :sf} foo] 536 | [foo city]) 537 | 538 | (deftest defnk-test 539 | (is (= [11 :foo {:dude 11 :sweet 17} {:sweet 17}] 540 | (keyfn-test-docstring {:dude 11 :sweet 17}))) 541 | (is (= [:foo :sf] (keyfn-test-no-docstring {:foo :foo}))) 542 | (is (= [{:foo s/Any (s/optional-key :city) s/Any s/Keyword s/Any} s/Any] 543 | (pfnk/io-schemata keyfn-test-no-docstring))) 544 | (is (thrown? Throwable (keyfn-test-docstring :wheres :mycar)))) 545 | 546 | ;; Test that type hints are properly propagated for fnk and defnk. 547 | #?(:clj 548 | (p/defnk ^Byte a-typehinted-defnk [^Long l] 549 | (.byteValue l))) 550 | 551 | #?(:clj 552 | (deftest type-hints-test 553 | (is (= Byte (:tag (meta #'a-typehinted-defnk)))) 554 | (doseq [f [a-typehinted-defnk 555 | (p/fnk [^Long l] (.byteValue l)) 556 | (p/fnk [{^Long l 1}] (.byteValue l)) 557 | (p/fnk [^Long l & m] (.byteValue l))]] 558 | (is (= (Byte. (byte 1)) (f {:l (Long. 1)}))) 559 | (is (thrown? Exception (f {:l (Integer. 1)})))))) 560 | 561 | #?(:clj 562 | (deftest ^:slow repeated-bindings-test 563 | (is (thrown? Exception (eval '(p/fnk [x [:x y]] (+ x y))))) 564 | (is (thrown? Exception (eval '(p/fnk [{x {:y 1}} [:x y]] (+ x y))))) 565 | (is (thrown? Exception (eval '(p/fnk [x :as x] (+ x y))))) 566 | (is (thrown? Exception (eval '(p/fnk [x & x] (+ x y))))) 567 | (is (thrown? Exception (eval '(p/fnk [{x {:y 1}} x] (+ x y))))) 568 | (is (thrown? Exception (eval '(p/fnk [x [:x y] :as m] (+ x y))))) 569 | (is (thrown? Exception (eval '(p/fnk [{x {:y 1}} [:x y] :as m] (+ x y))))) 570 | (is (thrown? Exception (eval '(p/fnk [{x {:y 1}} x :as m] (+ x y))))))) 571 | 572 | (deftest optional-self-shadow-test 573 | (is (= 1 (let [b 1] ((p/fnk [{a b}] a) {})))) 574 | (doseq [[desc f] (let [a 1] 575 | {"pos" (p/fnk [{a a}] a) 576 | "non-pos" (p/fnk [{a a} :as m] a)})] 577 | (testing desc 578 | (is (= 1 (f {}))) 579 | (is (= 2 (f {:a 2})))))) 580 | 581 | (deftest optional-cross-arg-shadow-test 582 | (doseq [[desc f] (let [a 1 b 2 c 3 e 4 e 5] 583 | {"pos" (p/fnk [c {a c} {b a} {d e} e] [a b c d e]) 584 | "non-pos" (p/fnk [c {a c} {b a} {d e} e :as m] [a b c d e])})] 585 | (testing desc 586 | (is (= [6 7 8 9 10] (f {:a 6 :b 7 :c 8 :d 9 :e 10}))) 587 | (is (= [8 7 8 9 10] (f {:b 7 :c 8 :d 9 :e 10}))) 588 | (is (= [8 8 8 9 10] (f {:c 8 :d 9 :e 10}))) 589 | (is (= [8 8 8 5 10] (f {:c 8 :e 10})))))) 590 | 591 | (deftest dont-shadow-nested-test 592 | (let [m {:x 1}] 593 | (is (= 3 ((p/fnk [[:m x]] (+ x (:x m))) {:m {:x 2}}))))) 594 | 595 | (deftest miliis-test 596 | (let [now #?(:clj (System/currentTimeMillis) 597 | :cljs (.getTime (js/Date.))) 598 | threshold 5] 599 | (is (> threshold 600 | (- (p/millis) now))))) 601 | 602 | (use-fixtures :once schema-test/validate-schemas) 603 | -------------------------------------------------------------------------------- /test/plumbing/fnk/fnk_examples_test.cljc: -------------------------------------------------------------------------------- 1 | (ns plumbing.fnk.fnk-examples-test 2 | "Explaining input and output schemata, fnk syntax, and their relationships 3 | by example." 4 | #?(:cljs 5 | (:require-macros 6 | [cljs.test :refer [is deftest testing]])) 7 | (:require 8 | [schema.core :as s] 9 | [plumbing.core :as p #?@(:cljs [:include-macros true])] 10 | [plumbing.fnk.schema :as schema] 11 | [plumbing.fnk.pfnk :as pfnk] 12 | #?(:clj [clojure.test :refer :all] 13 | :cljs cljs.test))) 14 | 15 | #?(:cljs 16 | (do 17 | (def Exception js/Error) 18 | (def AssertionError js/Error) 19 | (def Throwable js/Error))) 20 | 21 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 22 | ;;; Input and output schemata 23 | 24 | ;; Input and output schemas describe the shape of nested maps with keyword keys 25 | ;; that are inputs and outputs of keyword functions, using the relevant 26 | ;; portions of the prismatic/schema library. 27 | 28 | ;; The structure of an input map is described using a nested map with keyword 29 | ;; keys, value schemas at the leaves, and (s/optional-key) for optional keys. 30 | 31 | (def input-schema-1 32 | {(s/optional-key :a) s/Any 33 | :b s/Any 34 | :c {:c1 s/Any (s/optional-key :c2) s/Any}}) 35 | 36 | ;; Fnk and graph understand only this subset of schema; additional constructs 37 | ;; are allowed, but fnk cannot 'see through' them to reason about their 38 | ;; semantics. 39 | 40 | ;; Output schemas are similar, except that the output schemas for Graphs 41 | ;; must consist of only required keys at the top level. 42 | 43 | (def output-schema-1 44 | {:b s/Any 45 | :c {:c1 s/Any :c3 s/Any}}) 46 | 47 | 48 | (def output-schema-2 49 | {:b s/Any 50 | :c s/Any}) 51 | 52 | ;; plumbing.fnk.schema has library functions for building, composing, 53 | ;; and checking schemata 54 | 55 | (deftest assert-satisfies-schema-test 56 | (is (thrown? Exception (schema/assert-satisfies-schema input-schema-1 output-schema-2))) 57 | (is (nil? (schema/assert-satisfies-schema input-schema-1 output-schema-1)))) 58 | 59 | 60 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 61 | ;;; Fnk 62 | 63 | ;; For our purposes, a keyword function is an ordinary clojure fn? that 64 | ;; accepts a nested map with keyword keys as input, whose 'leaves' are 65 | ;; arbitrary values (including maps with non-keyword keys), and returns 66 | ;; an arbitrary value. 67 | 68 | ;; In addition, a keyword function must respond to the pfnk/io-schemata 69 | ;; call, returning a pair of an input schema and output schema. 70 | ;; (fnks also carry general function schemas via prismatic/schema, and 71 | ;; the pfnk/io-schemata protocol is just a convencience method on top of this). 72 | 73 | ;; We can manually define a simple fnk by attaching io-schemata metadata 74 | ;; to a fn satisfying the above properties: 75 | 76 | (def a-manual-keyword-function 77 | (pfnk/fn->fnk 78 | (fn [{:keys [a b o] :or {o 10} :as m}] 79 | (assert (every? #(contains? m %) [:a :b])) 80 | {:x (+ a b o)}) 81 | [{:a s/Any :b s/Any (s/optional-key :o) s/Any s/Keyword s/Any} 82 | {:x s/Any}])) 83 | 84 | 85 | (defn test-simple-keyword-function [f] 86 | (is (= {:x 13} 87 | (f {:a 1 :b 2}))) 88 | 89 | ;; for convience, you can also extract a pair of input and output scheams 90 | (is (= [{:a s/Any :b s/Any (s/optional-key :o) s/Any s/Keyword s/Any} 91 | {:x s/Any}] 92 | (pfnk/io-schemata f))) 93 | 94 | ;; or the input-schema or output-schema individually. 95 | (is (= {:a s/Any :b s/Any (s/optional-key :o) s/Any s/Keyword s/Any} 96 | (pfnk/input-schema f))) 97 | (is (= {:x s/Any} 98 | (pfnk/output-schema f))) 99 | 100 | ;; a keyword function should throw if required keys not given. 101 | (is (thrown? Throwable (f {:a 3})))) 102 | 103 | (deftest a-manual-keyword-function-test 104 | (testing "manual keyword fn" 105 | (test-simple-keyword-function a-manual-keyword-function))) 106 | 107 | 108 | ;; As a shortcut for defining keyword functions, we've defined macros 109 | ;; 'fnk' and 'defnk' with a different destructuring syntax than 110 | ;; 'fn' and 'defn', and which automatically infer input and output 111 | ;; schemata. For more details and rationale for this syntax, see 112 | ;; plumbing.fnk/readme.md. 113 | 114 | (p/defnk a-simple-fnk 115 | "This fnk has required keys :a and :b, and an optional key :o 116 | that defaults to 10 -- equivalent to a-manual-keyword-function." 117 | [a b {o 10}] 118 | {:x (+ a b o)}) 119 | 120 | ;; This fnk automatically throws if required keys aren't present, 121 | ;; and infers its input schema from the binding form and output 122 | ;; schema from the literal map in its body. 123 | 124 | (deftest a-simple-fnk-test 125 | (testing "fnk macro keyword fn" 126 | (test-simple-keyword-function a-simple-fnk))) 127 | 128 | 129 | (p/defnk a-simple-fnk2 130 | "This fnk is like a-simple-fnk, but does not have a literal 131 | map body so nothing can be automatically inferred about its 132 | output schema" 133 | [a b {o 10}] 134 | (hash-map :x (+ a b o))) 135 | 136 | (deftest a-simple-fnk2-test 137 | (is (= s/Any 138 | (pfnk/output-schema a-simple-fnk2)))) 139 | 140 | ;; For these cases, we can provide explicit metadata to hint the 141 | ;; output schema of the fnk. 142 | 143 | (p/defnk a-simple-fnk3 :- {:x s/Any} 144 | "This fnk is like a-simple-fnk2, but uses an explicit output 145 | schema hint, and is equivalent to a-simple-fnk" 146 | [a b {o 10}] 147 | (hash-map :x (+ a b o))) 148 | 149 | (deftest a-simple-fnk3-test 150 | (testing "fnk with explicit output schema" 151 | (test-simple-keyword-function a-simple-fnk3))) 152 | 153 | ;; You can also provide schema information on the inputs, with 154 | ;; validation like schema.core/defn. See (doc fnk) for details. 155 | 156 | #?(:clj ;; This example uses clj-only annotations, but should otherwise work in cljs 157 | (p/defnk a-schematized-fnk :- (s/pred odd?) 158 | [a :- long b :- int] 159 | (+ a b))) 160 | 161 | #?(:clj 162 | (deftest a-schematized-fnk-test 163 | (is (= [{:a long :b int s/Keyword s/Any} (s/pred odd?)] 164 | (pfnk/io-schemata a-schematized-fnk))) 165 | (testing "No validation by default" 166 | (is (= 2 (a-schematized-fnk {:a 1 :b 1})))) 167 | (s/with-fn-validation 168 | (is (= 3 (a-schematized-fnk {:a 1 :b (int 2)}))) 169 | (is (thrown? Exception (a-schematized-fnk {:a 1 :b 2}))) 170 | (is (thrown? Exception (a-schematized-fnk {:a 1 :b (int 1)})))))) 171 | 172 | 173 | ;; fnks also have support for nested bindings, and nested maps 174 | ;; for input and output schemata. 175 | ;; A nested map binding is introduced by an inner vector, whose 176 | ;; first element is a keyword specifying the key to bind under. 177 | 178 | (p/defnk a-nested-fnk 179 | [a [:b b1 {b2 5}] c] 180 | {:sum (+ a b1 b2 c) 181 | :products {:as a 182 | :bs (* b1 b2) 183 | :cs c}}) 184 | 185 | (deftest a-nested-fnk-test 186 | (is (= {:sum 20 187 | :products {:as 1 188 | :bs 60 189 | :cs 2}} 190 | (a-nested-fnk {:a 1 191 | :b {:b1 12} 192 | :c 2}))) 193 | 194 | (is (= {:a s/Any 195 | :b {:b1 s/Any (s/optional-key :b2) s/Any s/Keyword s/Any} 196 | :c s/Any 197 | s/Keyword s/Any} 198 | (pfnk/input-schema a-nested-fnk))) 199 | (is (= {:sum s/Any :products {:as s/Any :bs s/Any :cs s/Any}} 200 | (pfnk/output-schema a-nested-fnk))) 201 | 202 | (is (thrown? Throwable (a-nested-fnk {:a 1 :b {:b2 10} :c 3}))) ;; :b1 is missing 203 | ) 204 | 205 | ;; finally, fnks have support for :as and & bindings like Clojure's 206 | ;; built-in destructuring. :as binds a symbol to the entire map 207 | ;; input, and & binds to a map of any extra keys not destructured. 208 | 209 | (p/defnk a-fancier-nested-fnk 210 | [a [:b b1 :as b] :as m & more] 211 | [a b1 b m more]) 212 | 213 | (deftest a-fancier-nested-fnk-test 214 | ;; :as and & are not reflected in input schema currently. 215 | (is (= {:a s/Any :b {:b1 s/Any s/Keyword s/Any} s/Keyword s/Any} 216 | (pfnk/input-schema a-fancier-nested-fnk))) 217 | (is (= s/Any 218 | (pfnk/output-schema a-fancier-nested-fnk))) 219 | 220 | (is (= [1 2 {:b1 2 :b2 3} {:a 1 :b {:b1 2 :b2 3} :c 4} {:c 4}] 221 | (a-fancier-nested-fnk {:a 1 :b {:b1 2 :b2 3} :c 4})))) 222 | 223 | (p/defnk special-binding-fnk-with-schemas-1 224 | [a :- s/Keyword :as m & r :- {s/Symbol s/Keyword}] 225 | [a r m]) 226 | 227 | (p/defnk special-binding-fnk-with-schemas-2 228 | [a :- s/Keyword & r :- {s/Symbol s/Keyword} :as m] 229 | [a r m]) 230 | 231 | (deftest special-binding-fnk-with-schemas-test 232 | (is (= {:a s/Keyword s/Symbol s/Keyword} 233 | (pfnk/input-schema special-binding-fnk-with-schemas-1) 234 | (pfnk/input-schema special-binding-fnk-with-schemas-2))) 235 | (is (= [:foo {'bar :bar} {:a :foo 'bar :bar}] 236 | (special-binding-fnk-with-schemas-1 {:a :foo 'bar :bar}) 237 | (special-binding-fnk-with-schemas-2 {:a :foo 'bar :bar})))) 238 | -------------------------------------------------------------------------------- /test/plumbing/fnk/pfnk_test.cljc: -------------------------------------------------------------------------------- 1 | (ns plumbing.fnk.pfnk-test 2 | #?(:cljs 3 | (:require-macros 4 | [cljs.test :refer [is deftest testing]])) 5 | (:require 6 | [schema.core :as s] 7 | [plumbing.core :as p #?@(:cljs [:include-macros true])] 8 | [plumbing.fnk.pfnk :as pfnk] 9 | #?(:clj [clojure.test :refer :all] 10 | :cljs cljs.test))) 11 | 12 | (deftest meta-round-trip-test 13 | (let [i-schema {:x s/Any} 14 | o-schema {:y s/Any} 15 | schemata [i-schema o-schema] 16 | f (pfnk/fn->fnk (fn [m] {:y (inc (p/safe-get m :x))}) schemata)] 17 | (is (= {:y 2} (f {:x 1}))) 18 | (is (= schemata (pfnk/io-schemata f))) 19 | (is (= i-schema (pfnk/input-schema f))) 20 | (is (= o-schema (pfnk/output-schema f))))) 21 | -------------------------------------------------------------------------------- /test/plumbing/fnk/schema_test.cljc: -------------------------------------------------------------------------------- 1 | (ns plumbing.fnk.schema-test 2 | (:require 3 | [schema.core :as s] 4 | [schema.test :as schema-test] 5 | [plumbing.core :as p #?@(:cljs [:include-macros true])] 6 | [plumbing.fnk.pfnk :as pfnk] 7 | [plumbing.fnk.schema :as fnk-schema] 8 | #?(:clj [clojure.test :refer :all] 9 | :cljs [cljs.test :refer-macros [is are deftest testing use-fixtures]]))) 10 | 11 | #?(:cljs 12 | (do 13 | (def Exception js/Error) 14 | (def RuntimeException js/Error))) 15 | 16 | #?(:clj ;; the expression-munging doesn't play well with cljs. 17 | (deftest explicit-schema-key-map-test 18 | (is (= {:foo true :bar false :baz false} 19 | (fnk-schema/explicit-schema-key-map 20 | {:foo s/Any (s/optional-key :bar) s/Any s/Keyword s/Keyword 21 | `(s/optional-key :baz) s/Any}))))) 22 | 23 | (deftest split-schema-keys-test 24 | (is (= [[:foo :bar] [:baz :bat]] 25 | (fnk-schema/split-schema-keys 26 | (array-map :foo true :baz false :bar true :bat false))))) 27 | 28 | (deftest merge-on-with-test 29 | (is (= {0 5 4 9 9 12} 30 | (#'fnk-schema/merge-on-with 31 | #(quot % 2) min + {1 2 4 9 9 4} {9 8 0 3})))) 32 | 33 | (deftest union-input-schemata-test 34 | (is (= {:a s/Any} 35 | (fnk-schema/union-input-schemata {:a s/Any} {:a s/Any}))) 36 | (is (= {:a s/Str} 37 | (fnk-schema/union-input-schemata {:a s/Str} {(s/optional-key :a) s/Str}))) 38 | (is (= {:a s/Str} 39 | (fnk-schema/union-input-schemata {(s/optional-key :a) s/Str} {:a s/Any}))) 40 | (is (= {:a s/Str} ;; punt, should be both Str and Num 41 | (fnk-schema/union-input-schemata {(s/optional-key :a) s/Str} {:a s/Num}))) 42 | (is (= {:a {(s/optional-key :a1) s/Str 43 | :a2 s/Num 44 | :a3 s/Str} 45 | (s/optional-key :b) s/Num} 46 | (fnk-schema/union-input-schemata 47 | {:a {(s/optional-key :a1) s/Str 48 | (s/optional-key :a2) s/Num} 49 | (s/optional-key :b) s/Num} 50 | {:a {:a2 s/Num 51 | :a3 s/Str}})))) 52 | 53 | (deftest required-toplevel-keys-test 54 | (is (= #{:a :b} 55 | (set 56 | (fnk-schema/required-toplevel-keys 57 | {:a {:a1 s/Str} 58 | :b s/Int 59 | (s/optional-key :c) s/Any}))))) 60 | 61 | (deftest guess-expr-output-schema-test 62 | (is (= 'schema.core/Any (fnk-schema/guess-expr-output-schema "foo"))) 63 | (is (= {:a 'schema.core/Any :b 'schema.core/Any} (fnk-schema/guess-expr-output-schema {:a (+ 1 1) :b false}))) 64 | (is (= 'schema.core/Any (fnk-schema/guess-expr-output-schema {'a (+ 1 1)})))) 65 | 66 | (deftest compose-schemata-test 67 | (is (= [{:a s/Any :c s/Any :d s/Any} 68 | {:x s/Any}] 69 | (fnk-schema/compose-schemata 70 | [{:a s/Any :b {:b1 s/Any} :c s/Any} 71 | {:x s/Any}] 72 | [{:c s/Any :d s/Any} 73 | {:b {:b1 s/Any}}]))) 74 | 75 | (is (= [{:a s/Any (s/optional-key :e) s/Any :c s/Any :d s/Any} 76 | {:x s/Any}] 77 | (fnk-schema/compose-schemata 78 | [{:a s/Any 79 | :b {:b1 s/Any} 80 | (s/optional-key :c) s/Any 81 | (s/optional-key :e) s/Any 82 | (s/optional-key :f) s/Any} 83 | {:x s/Any}] 84 | [{:c s/Any :d s/Any} 85 | {:b {:b1 s/Any} :c s/Any :f s/Any}]))) 86 | 87 | (is (thrown? Exception 88 | (fnk-schema/compose-schemata 89 | [{:a s/Any :b {:b1 s/Any} :c s/Any} 90 | {:x s/Any}] 91 | [{:c s/Any :d s/Any} 92 | {:b s/Any}])))) 93 | 94 | (deftest sequence-schemata-test 95 | (is (= [{:a s/Any (s/optional-key :b) s/Any} {:c s/Any :o2 {:o21 s/Any}}] 96 | (fnk-schema/sequence-schemata 97 | [{:a s/Any} {:c s/Any}] 98 | [:o2 [{(s/optional-key :b) s/Any :c s/Any} {:o21 s/Any}]]))) 99 | (is (= [{:a s/Any, :o2 s/Any, (s/optional-key :b) s/Any} 100 | {:o2 {:o21 s/Any}, :c s/Any}] 101 | (fnk-schema/sequence-schemata 102 | [{:a s/Any} {:c s/Any}] 103 | [:o2 [{(s/optional-key :b) s/Any :c s/Any :o2 s/Any} {:o21 s/Any}]]))) 104 | (is (thrown? RuntimeException 105 | (fnk-schema/sequence-schemata 106 | [{:a s/Any} {:c s/Any :o2 s/Any}] 107 | [:o2 [{(s/optional-key :b) s/Any :c s/Any} {:o21 s/Any}]]))) 108 | (is (thrown? RuntimeException 109 | (fnk-schema/sequence-schemata 110 | [{:a s/Any :o2 s/Any} {:c s/Any}] 111 | [:o2 [{(s/optional-key :b) s/Any :c s/Any} {:o21 s/Any}]])))) 112 | 113 | 114 | (deftest fnk-input-schemata-test 115 | (are [in fnk-form] (= in (pfnk/input-schema fnk-form)) 116 | {:x s/Any :y s/Any s/Keyword s/Any} 117 | (p/fnk [x y]) 118 | 119 | {:x s/Any (s/optional-key :y) s/Any :z s/Any s/Keyword s/Any} 120 | (p/fnk [x {y 2} z]) 121 | 122 | {:x s/Any (s/optional-key :y) s/Any :z s/Any :q {:r s/Any s/Keyword s/Any} s/Keyword s/Any} 123 | (p/fnk [x {y 2} z [:q r] :as m & more]) 124 | 125 | {(s/optional-key :x) s/Any :y {:alias s/Any s/Keyword s/Any} s/Keyword s/Any} 126 | (p/fnk [ {x 1} [:y alias]]) 127 | 128 | {(s/optional-key :o1) s/Any 129 | :o2 s/Any 130 | :o3 {:x s/Any (s/optional-key :y) s/Any :z s/Any :q {:r s/Any s/Keyword s/Any} s/Keyword s/Any} 131 | s/Keyword s/Any} 132 | (p/fnk [{o1 1} o2 [:o3 x {y 2} z [:q r]]])) 133 | #?(:clj 134 | (do 135 | (is (= [1 2] ((eval `(p/fnk [[:x ~'x] [:y ~'y]] [~'x ~'y])) {:x {:x 1} :y {:y 2}}))) 136 | (is (thrown? Throwable (eval `(p/fnk [{:y ~'x} {:y ~'y}] [~'x ~'y])))) 137 | (is (thrown? Throwable (eval `(p/fnk [{:x ~'x} {:y ~'x}] [~'x])))) 138 | (is (thrown? Throwable (eval `(p/fnk [[:x ~'x] ~'x] [~'x])))) 139 | (is (thrown? Throwable (eval `(p/fnk [{~'x 1} ~'x] [~'x]))))))) 140 | 141 | 142 | (deftest fnk-out-schemata-test 143 | ;; Are somehow breaks the metadata on fnk forms. 144 | (is (= s/Any (pfnk/output-schema (p/fnk [])))) 145 | (is (= s/Any (pfnk/output-schema (p/fnk [] (hash-map :x :y))))) 146 | (is (= {:o1 s/Any :o2 {:i s/Any :j {:q s/Any}}} (pfnk/output-schema (p/fnk [x] {:o1 x :o2 {:i x :j {:q 2}}})))) 147 | (is (= {:o1 s/Any :o2 s/Any} (pfnk/output-schema (p/fnk f :- {:o1 s/Any :o2 s/Any} [x])))) 148 | (is (= {:o1 s/Any :o2 s/Any} (pfnk/output-schema (p/fnk f :- {:o1 s/Any :o2 s/Any} [x] 149 | {:o1 x :o2 {:i x :j {:q 2}}}))))) 150 | 151 | (use-fixtures :once schema-test/validate-schemas) 152 | -------------------------------------------------------------------------------- /test/plumbing/graph_async_test.cljc: -------------------------------------------------------------------------------- 1 | (ns plumbing.graph-async-test 2 | #?(:cljs 3 | (:require-macros 4 | [cljs.core.async.macros :refer [go]])) 5 | (:require 6 | [plumbing.core :as plumbing #?@(:cljs [:include-macros true])] 7 | [plumbing.graph-async :as graph-async] 8 | #?(:clj [clojure.core.async :as async :refer [go (* day-of-year 2 Math/PI) 21 | (/ days-in-year) 22 | Math/cos 23 | (* 0.033) 24 | inc)) 25 | 26 | (defn solar-declination 27 | "Solar declination at a given day of the year (1 to 366)" 28 | ^double [^long day-of-year] 29 | (-> (* day-of-year Math/PI 2) 30 | (/ days-in-year) 31 | (- 1.39) 32 | Math/sin 33 | (* 0.409))) 34 | 35 | (defn sunset-hour-angle 36 | "Sunset hour angle given day of year (1 to 366) and latitude in radians" 37 | ^double [^double solar-dec ^double lat-in-rad] 38 | (-> (Math/tan lat-in-rad) 39 | (* (Math/tan solar-dec) -1) 40 | Math/acos)) 41 | 42 | (defn sat-vapour-pressure 43 | "Saturated vapour pressure at given temperature 44 | 45 | Parameters 46 | ---------- 47 | temp: float 48 | Temperature, deg C 49 | 50 | Returns 51 | ------- 52 | Saturated vapour pressure, kPa" 53 | ^double [^double temp] 54 | (* 0.6108 (-> (* temp 17.27) (/ (+ temp 237.3)) Math/exp))) 55 | 56 | (defn degree-to-radians 57 | "Convert degrees to radians" 58 | ^double [^double deg] 59 | (-> (* deg Math/PI) 60 | (/ 180))) 61 | 62 | (defn solar-rad-et 63 | "Extraterrestrial solar radiation 64 | 65 | Parameters 66 | ---------- 67 | day-of-year: int 68 | Day of the year (1 to 366) 69 | lat: float 70 | Latitude, decimal degrees 71 | 72 | Returns: 73 | ------- 74 | solar radiation, MJ/(m^2*day)" 75 | ^double [^long day-of-year ^double lat] 76 | (let [lat-in-rad (degree-to-radians lat) 77 | inv-dist (inverse-relational-distance day-of-year) 78 | c (-> (* 24 60 0.0820 inv-dist) 79 | (/ Math/PI)) 80 | solar-dec (solar-declination day-of-year) 81 | sun-hour-angle (sunset-hour-angle solar-dec lat-in-rad) 82 | a (* sun-hour-angle (Math/sin lat-in-rad) (Math/sin solar-dec)) 83 | b (* (Math/cos lat-in-rad) (Math/cos solar-dec) (Math/sin sun-hour-angle))] 84 | (* c (+ a b)))) 85 | 86 | 87 | (def solar-rad-from-temp 88 | "Estimate the solar radiation from temperature 89 | 90 | Required 91 | -------- 92 | lat: float, 93 | Latitude, decimal degrees 94 | 95 | alt: float, 96 | Altitude, in m 97 | 98 | tmax, tmin: float 99 | Maximum and minimum temperatures, deg C. Must be 100 | between -5 and 45 C. 101 | 102 | doy: int 103 | Day of the year (1 to 366) 104 | 105 | Optional 106 | -------- 107 | kRs: float, default = 0.16 108 | adjustment coefficient for solar radiation 109 | 110 | a: float, default = 0.23 111 | Canopy reflection coefficient (default is for grass) 112 | 113 | Calculated 114 | ---------- 115 | tmaxK: float 116 | Max Temperature in Kelvin 117 | 118 | tminK: float 119 | Min Temperature in Kelvin 120 | 121 | Ra: float 122 | 123 | Rs: float 124 | 125 | Rso: float 126 | 127 | Rns: float 128 | Net short wave radiation 129 | Rn: float 130 | Net solar radiation, MJ/(m^2*day)" 131 | {:Ra (fnk [doy lat] (solar-rad-et doy lat)) 132 | :Rs (fnk [tmax tmin {kRs 0.16} Ra] (-> (- tmax tmin) Math/sqrt (* kRs Ra))) 133 | :Rso (fnk [alt Ra] (-> (* 2e-5 alt) (+ 0.75) (* Ra))) 134 | :Rns (fnk [{a 0.23} Rs] (-> (- 1 a) (* Rs))) 135 | :tmaxK (fnk [tmax] (to-kelvin tmax)) 136 | :tminK (fnk [tmin] (to-kelvin tmin)) 137 | :ea (fnk [tmin] (sat-vapour-pressure tmin)) 138 | :term1 (fnk [tmaxK tminK {s 4.903e-9}] 139 | (-> (Math/pow tmaxK 4) (+ (Math/pow tminK 4)) (* s) (/ 2))) 140 | :term2 (fnk [ea] (-> (Math/sqrt ea) (* -0.14) (+ 0.34))) 141 | :term3 (fnk [Rs Rso] (-> (* 1.35 Rs) (/ Rso) (- 0.35))) 142 | :Rnl (fnk [term1 term2 term3] (* term1 term2 term3)) 143 | :Rn (fnk [Rns Rnl] (- Rns Rnl))}) 144 | 145 | (defn solar-rad-from-temp-fn 146 | ([lat alt tmax tmin day-of-year] 147 | (let [kRs 0.16 148 | a 0.23] 149 | (solar-rad-from-temp-fn kRs lat alt tmax tmin day-of-year a))) 150 | ([kRs lat alt tmax tmin day-of-year] 151 | (let [a 0.23] 152 | (solar-rad-from-temp-fn kRs lat alt tmax tmin day-of-year a))) 153 | ([kRs lat alt tmax tmin day-of-year a] 154 | (let [Ra (solar-rad-et day-of-year lat) 155 | Rs (-> (- tmax tmin) Math/sqrt (* kRs Ra)) ;;solar radiaion 156 | Rso (-> (* 2e-5 alt) (+ 0.75) (* Ra)) ;;Clear sky solar radiation 157 | Rns (-> (- 1 a) (* Rs)) ;;net short wave radiation 158 | s 4.903e-9 ;;Stefan-Boltzman constant, MJ/(K^4*m^2*day^-1) 159 | tmax-kelvin (to-kelvin tmax) 160 | tmin-kelvin (to-kelvin tmin) 161 | ea (sat-vapour-pressure tmin) 162 | term-1 (-> (Math/pow tmax-kelvin 4) 163 | (+ (Math/pow tmin-kelvin 4)) 164 | (* s) 165 | (/ 2)) 166 | term-2 (-> (Math/sqrt ea) (* -0.14) (+ 0.34)) 167 | term-3 (-> (* 1.35 Rs) (/ Rso) (- 0.35)) 168 | Rnl (* term-1 term-2 term-3) 169 | Rn (- Rns Rnl)] 170 | Rn))) 171 | 172 | (defmacro fn-call 173 | [args body] 174 | `((fn ~args ~body) ~@args)) 175 | (defrecord SolarRadRecord [Ra Rs Rso Rns tmax-kelvin tmin-kelvin ea term-1 176 | term-2 term-3 Rnl Rn]) 177 | (defn solar-rad-from-temp-fn-calls 178 | ([lat alt tmax tmin day-of-year] 179 | (let [kRs 0.16 180 | a 0.23] 181 | (solar-rad-from-temp-fn-calls kRs lat alt tmax tmin day-of-year a))) 182 | ([kRs lat alt tmax tmin day-of-year] 183 | (let [a 0.23] 184 | (solar-rad-from-temp-fn-calls kRs lat alt tmax tmin day-of-year a))) 185 | ([kRs lat alt tmax tmin day-of-year a] 186 | (let [Ra (fn-call [day-of-year lat] (solar-rad-et day-of-year lat)) 187 | Rs (fn-call [tmax tmin kRs Ra] (-> (- tmax tmin) Math/sqrt (* kRs Ra))) 188 | Rso (fn-call [alt Ra] (-> (* 2e-5 alt) (+ 0.75) (* Ra))) 189 | Rns (fn-call [a Rs] (-> (- 1 a) (* Rs))) 190 | tmaxK (fn-call [tmax] (to-kelvin tmax)) 191 | tminK (fn-call [tmin] (to-kelvin tmin)) 192 | ea (fn-call [tmin] (sat-vapour-pressure tmin)) 193 | term1 (fn-call [tmaxK tminK] 194 | (-> (Math/pow tmaxK 4) (+ (Math/pow tminK 4)) (* 4.903e-9) (/ 2))) 195 | term2 (fn-call [ea] (-> (Math/sqrt ea) (* -0.14) (+ 0.34))) 196 | term3 (fn-call [Rs Rso] (-> (* 1.35 Rs) (/ Rso) (- 0.35))) 197 | Rnl (fn-call [term1 term2 term3] (* term1 term2 term3)) 198 | Rn (fn-call [Rns Rnl] (- Rns Rnl))] 199 | (new SolarRadRecord Ra Rs Rso Rns tmaxK tminK ea term1 term2 term3 Rnl Rn)))) 200 | 201 | (defn -main 202 | [& args] 203 | ;; Simple profiling, comparing the various compilations to the let 204 | ;; implementation. 205 | 206 | (println "Interpreted eager") 207 | (println " compiling") 208 | (let [solar-rad-as-graph (time (graph/interpreted-eager-compile solar-rad-from-temp))] 209 | (println " gives value" (solar-rad-as-graph {:lat 45.0 :alt 100.0 :tmin 15.0 :tmax 25.0 :doy 205})) 210 | (dotimes [_ 10] 211 | (time (dotimes [_ 10000] 212 | (solar-rad-as-graph {:lat 45.0 :alt 100.0 :tmin 15.0 :tmax 25.0 :doy 205}))))) 213 | 214 | (println) 215 | (println "Eager called with map") 216 | (println " compiling") 217 | (let [solar-rad-pos-graph (time (graph/eager-compile solar-rad-from-temp))] 218 | (println " gives value" (solar-rad-pos-graph {:lat 45.0 :alt 100.0 :tmin 15.0 :tmax 25.0 :doy 205})) 219 | (dotimes [_ 10] 220 | (time (dotimes [_ 10000] 221 | (solar-rad-pos-graph {:lat 45.0 :alt 100.0 :tmin 15.0 :tmax 25.0 :doy 205}))))) 222 | 223 | (println) 224 | (println "Eager positional fn") 225 | (println " compiling") 226 | (let [solar-rad-pos-graph-pos (time (graph/positional-eager-compile 227 | (into {} solar-rad-from-temp) 228 | [:lat :alt :tmin :tmax :doy]))] 229 | (println " gives value" (solar-rad-pos-graph-pos 45.0 100.0 15.0 25.0 205)) 230 | (dotimes [_ 10] 231 | (time (dotimes [_ 10000] 232 | (solar-rad-pos-graph-pos 45.0 100.0 15.0 25.0 205))))) 233 | 234 | (println) 235 | (println "Let with fn calls") 236 | (println " no need to compile") 237 | (println " gives value" (solar-rad-from-temp-fn-calls 45.0 100.0 25.0 15.0 205)) 238 | (dotimes [_ 10] 239 | (time (dotimes [_ 10000] 240 | (solar-rad-from-temp-fn-calls 45.0 100.0 25.0 15.0 205)))) 241 | 242 | (println) 243 | (println "Let") 244 | (println " no need to compile") 245 | (println " gives value" (solar-rad-from-temp-fn 45.0 100.0 25.0 15.0 205)) 246 | (dotimes [_ 10] 247 | (time (dotimes [_ 10000] 248 | (solar-rad-from-temp-fn 45.0 100.0 25.0 15.0 205))))) 249 | 250 | ;;Interpreted eager 251 | ;; compiling 252 | ;;"Elapsed time: 6.037156 msecs" 253 | ;; gives value {:Rns 15.392102866343723, :tminK 288.15, :Rso 29.71016678897226, :term2 0.15717553186329483, :Rn 12.209062049816033, :Rnl 3.1830408165276896, :term3 0.5583137960058112, :term1 36.27261861695186, :Rs 19.989743982264574, :tmaxK 298.15, :ea 1.7053462321157722, :Ra 39.508200517250344} 254 | ;;"Elapsed time: 391.094708 msecs" 255 | ;;"Elapsed time: 341.611376 msecs" 256 | ;;"Elapsed time: 333.087152 msecs" 257 | ;;"Elapsed time: 367.831138 msecs" 258 | ;;"Elapsed time: 341.161334 msecs" 259 | ;;"Elapsed time: 324.572381 msecs" 260 | ;;"Elapsed time: 337.84041 msecs" 261 | ;;"Elapsed time: 336.182569 msecs" 262 | ;;"Elapsed time: 360.237391 msecs" 263 | ;;"Elapsed time: 371.491237 msecs" 264 | ;; 265 | ;;Eager called with map 266 | ;; compiling 267 | ;;"Elapsed time: 36.108162 msecs" 268 | ;; gives value #user.graph-record1401{:Rns 15.392102866343723, :tminK 288.15, :Rso 29.71016678897226, :term2 0.15717553186329483, :Rn 12.209062049816033, :Rnl 3.1830408165276896, :term3 0.5583137960058112, :term1 36.27261861695186, :Rs 19.989743982264574, :tmaxK 298.15, :ea 1.7053462321157722, :Ra 39.508200517250344} 269 | ;;"Elapsed time: 29.617148 msecs" 270 | ;;"Elapsed time: 28.233836 msecs" 271 | ;;"Elapsed time: 29.150146 msecs" 272 | ;;"Elapsed time: 28.360114 msecs" 273 | ;;"Elapsed time: 28.416531 msecs" 274 | ;;"Elapsed time: 38.486866 msecs" 275 | ;;"Elapsed time: 25.48484 msecs" 276 | ;;"Elapsed time: 27.788339 msecs" 277 | ;;"Elapsed time: 30.93764 msecs" 278 | ;;"Elapsed time: 25.088613 msecs" 279 | ;; 280 | ;;Eager positional fn 281 | ;; compiling 282 | ;;"Elapsed time: 40.813282 msecs" 283 | ;; gives value #user.graph-record1500{:Rns 15.392102866343723, :tminK 288.15, :Rso 29.71016678897226, :term2 0.15717553186329483, :Rn 12.209062049816033, :Rnl 3.1830408165276896, :term3 0.5583137960058112, :term1 36.27261861695186, :Rs 19.989743982264574, :tmaxK 298.15, :ea 1.7053462321157722, :Ra 39.508200517250344} 284 | ;;"Elapsed time: 15.038361 msecs" 285 | ;;"Elapsed time: 13.721086 msecs" 286 | ;;"Elapsed time: 13.787 msecs" 287 | ;;"Elapsed time: 16.328639 msecs" 288 | ;;"Elapsed time: 14.597608 msecs" 289 | ;;"Elapsed time: 13.985261 msecs" 290 | ;;"Elapsed time: 13.96927 msecs" 291 | ;;"Elapsed time: 13.764979 msecs" 292 | ;;"Elapsed time: 14.824762 msecs" 293 | ;;"Elapsed time: 13.781415 msecs" 294 | ;; 295 | ;;Let with fn calls 296 | ;; no need to compile 297 | ;; gives value #plumbing.graph_perf_test.SolarRadRecord{:Ra 39.508200517250344, :Rs 19.989743982264574, :Rso 29.71016678897226, :Rns 15.392102866343723, :tmax-kelvin 298.15, :tmin-kelvin 288.15, :ea 1.7053462321157722, :term-1 36.27261861695186, :term-2 0.15717553186329483, :term-3 0.5583137960058112, :Rnl 3.1830408165276896, :Rn 12.209062049816033} 298 | ;;"Elapsed time: 15.278042 msecs" 299 | ;;"Elapsed time: 12.319934 msecs" 300 | ;;"Elapsed time: 12.543768 msecs" 301 | ;;"Elapsed time: 12.316507 msecs" 302 | ;;"Elapsed time: 12.812431 msecs" 303 | ;;"Elapsed time: 12.724281 msecs" 304 | ;;"Elapsed time: 13.105688 msecs" 305 | ;;"Elapsed time: 12.757586 msecs" 306 | ;;"Elapsed time: 12.865573 msecs" 307 | ;;"Elapsed time: 12.54549 msecs" 308 | ;; 309 | ;;Let 310 | ;; no need to compile 311 | ;; gives value 12.209062049816033 312 | ;;"Elapsed time: 11.762075 msecs" 313 | ;;"Elapsed time: 10.430211 msecs" 314 | ;;"Elapsed time: 10.343818 msecs" 315 | ;;"Elapsed time: 10.372467 msecs" 316 | ;;"Elapsed time: 10.906296 msecs" 317 | ;;"Elapsed time: 10.285573 msecs" 318 | ;;"Elapsed time: 10.464272 msecs" 319 | ;;"Elapsed time: 10.357106 msecs" 320 | ;;"Elapsed time: 10.409813 msecs" 321 | ;;"Elapsed time: 10.512621 msecs" 322 | -------------------------------------------------------------------------------- /test/plumbing/graph_test.cljc: -------------------------------------------------------------------------------- 1 | (ns plumbing.graph-test 2 | (:require 3 | [plumbing.core :as plumbing :include-macros true] 4 | [plumbing.graph :as graph :include-macros true] 5 | [clojure.walk :as walk] 6 | [schema.core :as s] 7 | [schema.test :as schema-test] 8 | [plumbing.fnk.pfnk :as pfnk] 9 | #?@(:clj [[plumbing.fnk.impl :as fnk-impl] 10 | [plumbing.graph.positional :as positional]]) 11 | #?(:clj [clojure.test :refer :all] 12 | :cljs [cljs.test :refer-macros [is deftest testing use-fixtures]]))) 13 | 14 | #?(:cljs 15 | (do 16 | (def Exception js/Error) 17 | (def AssertionError js/Error) 18 | (def Throwable js/Error))) 19 | 20 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 21 | 22 | (deftest graph-construction-test 23 | (testing "io-schemata works correctly for flat graphs" 24 | (is (= [{:x s/Any :z s/Any 25 | (s/optional-key :q) s/Any (s/optional-key :y) s/Int (s/optional-key :r) s/Any 26 | s/Keyword s/Any} 27 | {:foo {:foox s/Any :fooy s/Any} :bar s/Any}] 28 | (pfnk/io-schemata 29 | (graph/graph :foo (plumbing/fnk [x {y :- s/Int 1} {q 2}] {:foox x :fooy y}) 30 | :bar (plumbing/fnk [foo z {q 4} {r 1}] [foo z])))))) 31 | 32 | (testing "io-schemata works correctly for nested graphs" 33 | (is (= [{:x s/Any (s/optional-key :q) s/Any (s/optional-key :y) s/Any s/Keyword s/Any} 34 | {:foo {:foox s/Any :fooy s/Any} :bar {:a s/Int :baz {:foo s/Any}}}] 35 | (pfnk/io-schemata 36 | (graph/graph :foo (plumbing/fnk [x {y 1} {q 2}] {:foox x :fooy y}) 37 | :bar {:a (plumbing/fnk f :- s/Int [foo] (inc foo)) 38 | :baz {:foo (plumbing/fnk [x] x)}}))))) 39 | 40 | 41 | (testing "io-schemata works correctly for inline graphs" 42 | (is (= [{:x s/Any (s/optional-key :q) s/Any (s/optional-key :y) s/Any :b s/Any s/Keyword s/Any} 43 | {:foo {:foox s/Any :fooy s/Any} :a s/Any :baz {:foo s/Any} :z s/Any}] 44 | (pfnk/io-schemata 45 | (graph/graph :foo (plumbing/fnk [x {y 1} {q 2}] {:foox x :fooy y}) 46 | (graph/graph 47 | :a (plumbing/fnk [foo] (inc foo)) 48 | :baz {:foo (plumbing/fnk [x] x)}) 49 | :z (plumbing/fnk [a b])))))) 50 | 51 | (testing "named fnks work as expected" 52 | (let [f (plumbing/fnk foo [x {y 1}] (+ x y)) 53 | g (graph/graph 54 | f 55 | (plumbing/fnk bar [foo] (* foo 2)))] 56 | (is (= [{:x s/Any (s/optional-key :y) s/Any s/Keyword s/Any} 57 | {:foo s/Any :bar s/Any}] 58 | (pfnk/io-schemata g))) 59 | (is (= (set (keys g)) #{:foo :bar})) 60 | (is (identical? f (:foo g))) 61 | (is (= {:foo 3 :bar 6} (graph/run g {:x 2})))) 62 | (testing "non-named fnks generate an error" 63 | (is (thrown? Exception (graph/graph (plumbing/fnk [])))))) 64 | 65 | (let [g {:foo (plumbing/fnk [x {y 1} {q 2}] {:foox x :fooy y}) 66 | :bar {:a (plumbing/fnk [foo] (inc foo)) 67 | :baz {:foo (plumbing/fnk [x] x)}}}] 68 | (is (= g (graph/->graph g)))) 69 | 70 | (testing "Key order should be preserved by graph." 71 | (let [ks (map #(keyword (str %)) (range 100))] 72 | (is (= ks 73 | (keys (apply graph/graph (interleave ks (repeat (plumbing/fnk [x] (inc x)))))))))) 74 | 75 | (testing "Exception on duplicate keys" 76 | (is (thrown? Exception (graph/graph :foo (plumbing/fnk [x]) :foo (plumbing/fnk [y]))))) 77 | (testing "Exception on cycle" 78 | (is (thrown? Exception (graph/graph :foo (plumbing/fnk [x {y 1}]) :x (plumbing/fnk [y]))))) 79 | (testing "Exception on self-cycle" 80 | (is (thrown? Exception (graph/graph :foo (plumbing/fnk [x {y 1}]) :y (plumbing/fnk [y])))))) 81 | 82 | (defn test-eager-compile 83 | "Test eager compilation eager-compile-fn, where normalize-output-fn turns the outputs 84 | into ordinary clojure maps from records if necessary." 85 | [compile-fn normalize-output-fn] 86 | (let [a (atom []) 87 | g (graph/graph 88 | :x (plumbing/fnk xfn [p1] (swap! a conj :x) (inc p1)) 89 | :y (plumbing/fnk yfn [x] (swap! a conj :y) (inc x))) 90 | c (compile-fn g) 91 | l (c {:p1 42})] 92 | (is (= [:x :y] @a)) 93 | (is (= (:y l) 44)) 94 | (is (= (:x l) 43))) 95 | (let [run-fn (fn [g m] (normalize-output-fn ((compile-fn g) m)))] 96 | (is (= {:x 1 :y {:z 1}} 97 | (run-fn (graph/graph 98 | :x (plumbing/fnk [] 1) 99 | :y {:z (plumbing/fnk [a] 1)}) 100 | {:a 1}))) 101 | (is (= {:x {:y 6} :q 12} 102 | (run-fn (graph/graph 103 | :x {:y (plumbing/fnk [a] (inc a))} 104 | :q (plumbing/fnk [[:x y]] (* 2 y))) 105 | {:a 5}))) 106 | 107 | (is (= {:foo 6 :bar {:a -6 :baz {:foo -5}}} 108 | (run-fn (graph/graph :foo (plumbing/fnk [x] (inc x)) 109 | :bar {:a (plumbing/fnk [foo] (- foo)) 110 | :baz {:foo (plumbing/fnk [a] (inc a))}}) 111 | {:x 5}))) 112 | (is (thrown? Exception 113 | (run-fn (graph/graph 114 | :x {:y (plumbing/fnk [a] (inc a))} 115 | :q (plumbing/fnk [[:x z]] z)) 116 | {:a 5}))) 117 | 118 | (is (= {:foo 6 :bar {:a -6 :baz {:foo 4}}} 119 | (run-fn (graph/graph :foo (plumbing/fnk [x] (inc x)) 120 | :bar {:a (plumbing/fnk [foo] (- foo)) 121 | :baz {:foo (plumbing/fnk [x] (dec x))}}) 122 | {:x 5}))) 123 | 124 | (is (thrown? Exception 125 | (compile-fn (graph/graph :foo {:bar (plumbing/fnk [] 1)} 126 | :baz (plumbing/fnk [[:foo baz]] (inc baz)))))) 127 | 128 | ;; Test as many of the advanced Graph features as possible. 129 | (let [complex-graph 130 | {;; Ordinary fnks. 131 | :a (plumbing/fnk [x] (+ x 2)) 132 | ;; Fnks that use &. 133 | :b (plumbing/fnk [a x & more] (+ a x (count more))) 134 | ;; Fnks that use :as. 135 | :c (plumbing/fnk [b x :as inputs] (+ b (count inputs) (* x -1))) 136 | ;; Nested graphs. 137 | :g {:ga (plumbing/fnk [x] (+ 5 x)) 138 | ;; Fnks with hand-crafted schemas. 139 | :gm (pfnk/fn->fnk (fn [m] {:gmy (+ (:x m) (:ga m)) 140 | :gmz (- 0 1 (:x m) (:ga m))}) 141 | [{:ga s/Any :x s/Any} ;; input schema 142 | {:gmy s/Any :gmz s/Any}]) ;; output schema 143 | ;; Fnks that depend on nested outputs. 144 | :gb (plumbing/fnk [[:gm gmy gmz]] (+ gmy gmz 10)) 145 | ;; Fnks with properly un-shadowed variables. 146 | :gc (let [gm 2] 147 | (plumbing/fnk [[:gm gmy] x] (+ gm gmy x)))} 148 | ;; Fnks that depend on deeply nested values. 149 | :d (plumbing/fnk [[:g [:gm gmy]] b] (+ gmy b)) 150 | ;; Fnks that are compiled graphs. 151 | :cg (graph/interpreted-eager-compile {:cga (plumbing/fnk [x b] (* 3 x b))}) 152 | ;; Fnks that we'll remove. 153 | :z (plumbing/fnk [x] (* x 10))} 154 | ;; Graphs modified at runtime 155 | complex-graph-modified (assoc (dissoc complex-graph :z) 156 | :e (plumbing/fnk [x [:cg cga]] (+ cga (rem x cga))))] 157 | (is (= (run-fn (compile-fn complex-graph-modified) 158 | {:x 1 159 | :ignored 2}) 160 | {:a 3 161 | :b 4 162 | :c 5 163 | :g {:ga 6 164 | :gm {:gmy 7 165 | :gmz -8} 166 | :gb 9 167 | :gc 10} 168 | :d 11 169 | :cg {:cga 12} 170 | :e 13}))))) 171 | 172 | (deftest interpreted-eager-compile-test 173 | (test-eager-compile graph/interpreted-eager-compile identity)) 174 | 175 | #?(:clj 176 | (deftest eager-compile-test 177 | ;; eager-compile outputs records rather than ordinary maps as outputs. 178 | (test-eager-compile graph/eager-compile (partial walk/prewalk #(if (map? %) (into {} %) %))) 179 | (let [o ((graph/eager-compile (graph/graph :x (plumbing/fnk [y] (inc 1)))) {:y 1})] 180 | (is (= [:x] (keys o))) 181 | (is (= [2] (vals o))) 182 | (is (= 2 (o :x) (get o :x) (:x o))) 183 | (is (= {:x 2} (into {} o))) 184 | (is (not= {:x 2} o))))) 185 | 186 | #?(:clj 187 | (deftest large-eager-compile-test 188 | ;; graphs equal or smaller than positional/max-graph-size, eager-compile returns records 189 | (let [size positional/max-graph-size 190 | o ((graph/eager-compile 191 | (apply 192 | graph/graph 193 | (mapcat (fn [i] 194 | (let [k (keyword (str "x" i))] 195 | [k (plumbing/fnk [b a] [k a b])])) 196 | (range size)))) 197 | {:a 1, :b 2}) 198 | expected-map (into {} 199 | (map #(let [k (keyword (str "x" %))] 200 | [k [k 1 2]]) 201 | (range size)))] 202 | (is (= [:x0 1 2] (o :x0) (get o :x0) (:x0 o))) 203 | (is (= expected-map (into {} o))) 204 | (is (not= expected-map o))) 205 | ;; above positional/max-graph-size, eager-compile returns ordinary maps 206 | (let [size (inc positional/max-graph-size) 207 | o ((graph/eager-compile 208 | (apply 209 | graph/graph 210 | (mapcat (fn [i] 211 | (let [k (keyword (str "x" i))] 212 | [k (plumbing/fnk [b a] [k a b])])) 213 | (range size)))) 214 | {:a 1, :b 2})] 215 | (is (= (into {} 216 | (map #(let [k (keyword (str "x" %))] 217 | [k [k 1 2]]) 218 | (range size))) 219 | o))))) 220 | 221 | #?(:clj 222 | (do ;; test defschema with eager-compile -- there were some issues previously 223 | (ns test (:require [schema.core :as s])) 224 | (s/defschema Foo {s/Keyword s/Num}) 225 | 226 | (ns plumbing.graph-test) 227 | (deftest eager-compile-defschema-test 228 | (let [g {:foo (plumbing/fnk [bar :- test/Foo])} 229 | f (graph/eager-compile g)] 230 | (is (= [{:bar test/Foo s/Keyword s/Any} 231 | {:foo s/Any}] 232 | (pfnk/io-schemata f) 233 | (pfnk/io-schemata g))))))) 234 | 235 | #?(:clj 236 | (deftest positional-eager-compile-test 237 | (let [f (graph/positional-eager-compile 238 | (graph/graph 239 | :x (plumbing/fnk [a {b 1} {c 2}] 240 | (+ a (* b 2) (* c 3)))) 241 | [:b :a])] 242 | (is (= 19 (:x (f 5 3)))) 243 | (is (= 11 (:x (f fnk-impl/+none+ 3)))) 244 | (is (thrown? Exception (f 1))) 245 | (is (thrown? Exception (f 3 fnk-impl/+none+)))))) 246 | 247 | #?(:clj 248 | (deftest large-positional-eager-compile-test 249 | (let [size (inc positional/max-graph-size) ;; make sure :positional-limit is respected 250 | fields (vec (repeatedly size gensym)) 251 | f (graph/positional-eager-compile 252 | (apply 253 | graph/graph 254 | (mapcat (fn [i] 255 | (let [k (keyword (str "x" i))] 256 | [k (plumbing/fnk [b a] [k a b])])) 257 | (range size))) 258 | [:b :a])] 259 | (is (= [:x0 :asdf 42] 260 | (:x0 (f 42 :asdf))))))) 261 | 262 | #?(:clj 263 | (deftest lazy-compile-test 264 | (let [a (atom []) 265 | g (graph/graph 266 | :x (plumbing/fnk [p1] (swap! a conj :x) (inc p1)) 267 | :y (plumbing/fnk [x] (swap! a conj :y) (inc x)) 268 | :z (plumbing/fnk [x] (swap! a conj :z))) 269 | l ((graph/lazy-compile g) {:p1 42})] 270 | (is (empty? @a)) 271 | (is (= (:y l) 44)) 272 | (is (= (:x l) 43)) 273 | (is (= [:x :y] @a))) 274 | (testing "lazy about error checking" 275 | (is (= 5 (:z ((graph/lazy-compile 276 | (graph/graph :x (plumbing/fnk [a]) 277 | :y (plumbing/fnk [b] (inc b)) 278 | :z (plumbing/fnk [y] (inc y)))) 279 | {:b 3}))))) 280 | (is (thrown? Exception (:x ((graph/lazy-compile 281 | (graph/graph 282 | :x (plumbing/fnk [a]) 283 | :y (plumbing/fnk [b] (inc b)) 284 | :z (plumbing/fnk [y] (inc y)))) 285 | {:b 3})))))) 286 | 287 | (deftest bind-non-map-with-as-test 288 | (is (= (:y (graph/run (graph/graph :x (plumbing/fnk [] {:a "1"}) 289 | :y (plumbing/fnk [[:x [:a :as q]]] q)) 290 | {})) 291 | "1"))) 292 | 293 | #?(:clj 294 | (defn chain-graph [n] 295 | (plumbing/for-map [i (range n)] 296 | (keyword (str "x" (inc i))) 297 | (let [p (keyword (str "x" i))] 298 | (pfnk/fn->fnk (fn [m] (inc (p m))) [{p s/Any} s/Any]))))) 299 | 300 | #?(:clj 301 | (deftest chain-graph-test 302 | (is (= 100 (:x100 ((graph/eager-compile (chain-graph 100)) {:x0 0})))) 303 | (is (= 100 (:x100 ((graph/lazy-compile (chain-graph 100)) {:x0 0})))))) 304 | 305 | 306 | (deftest comp-partial-fn-test 307 | (let [in (plumbing/fnk [a b {c 2} :as m] m)] 308 | (let [out (graph/comp-partial-fn in (plumbing/fnk [d a {q 2}] {:b d :e (inc a)}))] 309 | (is (= {:a 1 :b 5 :d 5 :e 2} 310 | (out {:a 1 :d 5}))) 311 | (is (= {:a 1 :b 5 :c 4 :d 5 :e 2} 312 | (out {:a 1 :c 4 :d 5}))) 313 | (is (= {:a s/Any :d s/Any 314 | (s/optional-key :c) s/Any (s/optional-key :q) s/Any 315 | s/Keyword s/Any} 316 | (pfnk/input-schema out)))) 317 | (let [out (graph/comp-partial-fn in (plumbing/fnk [d a {q 2}] {:b d :e (inc a) :c q}))] 318 | (is (= {:a 1 :b 5 :c 2 :d 5 :e 2} 319 | (out {:a 1 :d 5}))) 320 | (is (= {:a 1 :b 5 :c 2 :d 5 :e 2} 321 | (out {:a 1 :c 4 :d 5}))) 322 | (is (= {:a s/Any :d s/Any (s/optional-key :q) s/Any s/Keyword s/Any} 323 | (pfnk/input-schema out))))) 324 | 325 | (let [in2 (plumbing/fnk [[:a a1] b] (+ a1 b))] 326 | (let [out (graph/comp-partial-fn in2 (plumbing/fnk [x] {:a {:a1 x} :b (inc x)}))] 327 | (is (= 3 (out {:x 1}))) 328 | (is (= {:x s/Any s/Keyword s/Any} (pfnk/input-schema out)))) 329 | (is (thrown? Exception (graph/comp-partial-fn in2 (plumbing/fnk [x] {:a x :b (inc x)}))))) 330 | 331 | (is (= 10 ((graph/comp-partial-fn (plumbing/fnk [x {y 2} z] (+ x y z)) (plumbing/fnk [] {:x 7})) 332 | {:z 1}))) 333 | (is (= 12 ((graph/comp-partial-fn (plumbing/fnk [x {y 2} z :as m & more] 334 | (is (= [5 2 5] [x y z])) 335 | (is (= {:x 5 :z 5 :efour 4 :enine 9 :q 44 :r 5} m)) 336 | (is (= {:efour 4 :enine 9 :q 44 :r 5 } more)) 337 | (+ x y z)) 338 | (plumbing/fnk [r enine] {:efour 4 :x r :z r :enine enine})) 339 | {:r 5 :enine 9 :q 44})))) 340 | 341 | 342 | (deftest instance-test 343 | ;; on a fnk, instance should just return a fnk. 344 | (is (= 21 ((graph/instance (plumbing/fnk [x] (inc x)) [y] {:x (* y 2)}) {:y 10}))) 345 | (is (= 23 ((graph/instance (plumbing/fnk [x {z 1}] (+ x z)) [y] {:z (* y 2)}) {:x 3 :y 10}))) 346 | 347 | (let [raw-g {:x (plumbing/fnk [a] (* a 2)) 348 | :y (plumbing/fnk [x] (+ x 1))} 349 | inst-g (graph/instance raw-g [z] {:a (+ z 5)})] 350 | (is (= {:z s/Any s/Keyword s/Any} (pfnk/input-schema inst-g))) 351 | (is (= {:x s/Any :y s/Any} (select-keys (pfnk/output-schema inst-g) [:x :y]))) 352 | 353 | (is (= {:x 16 :y 17} (select-keys (graph/run inst-g {:z 3}) [:x :y]))) 354 | 355 | (is (thrown? Exception (graph/instance raw-g [z] {:q 22})))) 356 | 357 | (let [raw-g {:x (plumbing/fnk [[:a a1]] (* a1 2)) 358 | :y (plumbing/fnk [x {o 1}] (+ x o))}] 359 | (let [inst-g (graph/instance raw-g [z] {:a {:a1 (+ z 5)}})] 360 | (is (= {:z s/Any (s/optional-key :o) s/Any s/Keyword s/Any} (pfnk/input-schema inst-g))) 361 | (is (= {:x s/Any :y s/Any} (select-keys (pfnk/output-schema inst-g) [:x :y]))) 362 | (is (= {:x 16 :y 17} (select-keys (graph/run inst-g {:z 3}) [:x :y])))) 363 | (testing "optional keys" 364 | (let [inst-o (graph/instance raw-g [z] {:a {:a1 (+ z 5)} :o 10})] 365 | (is (= {:z s/Any s/Keyword s/Any} (pfnk/input-schema inst-o))) 366 | (is (= {:x 16 :y 26} (select-keys (graph/run inst-o {:z 3}) [:x :y]))))) 367 | (is (thrown? Exception (graph/instance raw-g [z] {:a z}))))) 368 | 369 | #?(:clj 370 | (deftest ^:slow profiled-test 371 | (let [approx-= (fn [x y] (< (Math/abs (- x y)) 10)) 372 | times {:a 100 :b 200 :c 400} 373 | raw-g (graph/graph 374 | :a (plumbing/fnk [i] (Thread/sleep (times :a)) (inc i)) 375 | :b (plumbing/fnk [i] (Thread/sleep (times :b)) (- i)) 376 | :c (plumbing/fnk [a b] (Thread/sleep (times :c)) (* a b))) 377 | compiled (graph/lazy-compile (graph/profiled :profile-stats raw-g)) 378 | execed (compiled {:i 10})] 379 | (is (= (select-keys execed [:a :b :c]) 380 | {:a 11 :b -10 :c -110})) 381 | (doseq [[k t] times] 382 | (is (approx-= t (get @(:profile-stats execed) k))))))) 383 | 384 | #?(:cljs 385 | (deftest profiled-test 386 | (let [stats-graph {:n (plumbing/fnk [xs] (count xs)) 387 | :m (plumbing/fnk [xs n] (/ (plumbing/sum identity xs) n)) 388 | :m2 (plumbing/fnk [xs n] (/ (plumbing/sum #(* % %) xs) n)) 389 | :v (plumbing/fnk [m m2] (- m2 (* m m)))} 390 | compiled (graph/compile (graph/profiled ::profile-stats stats-graph)) 391 | output (compiled {:xs (range 5000)}) 392 | profile-stats @(::profile-stats output)] 393 | (is (map? profile-stats)) 394 | (is (= #{:n :m :m2 :v} 395 | (set (keys profile-stats))))))) 396 | 397 | #?(:clj 398 | (defn time-graphs "How slow are big chain graphs?" [] 399 | (let [n 1000 400 | g (chain-graph n) 401 | tk (keyword (str "x" n))] 402 | (doseq [[k f] 403 | {:direct (plumbing/fnk [x0] {tk (nth (iterate inc 1) n)}) 404 | :eager (time (graph/eager-compile g)) 405 | :lazy (time (graph/lazy-compile g))}] 406 | (println k) 407 | (dotimes [_ 5] 408 | (println (time (plumbing/sum tk (repeatedly 10 #(f {:x0 1})))))))))) 409 | 410 | (use-fixtures :once schema-test/validate-schemas) 411 | -------------------------------------------------------------------------------- /test/plumbing/lazymap_test.clj: -------------------------------------------------------------------------------- 1 | (ns plumbing.lazymap-test 2 | (:use plumbing.core clojure.test plumbing.lazymap)) 3 | 4 | (deftest lazy-map-entry-extend-test 5 | (is (= :a (get-key [:a 2]))) 6 | (is (= 2 @(get-raw-value [:a 2]))) 7 | (is (thrown? IllegalArgumentException (get-key [:a]))) 8 | (is (thrown? IllegalArgumentException (get-raw-value [:a]))) 9 | 10 | (is (= :a (get-key (first {:a 2})))) 11 | (is (= 2 @(get-raw-value (first {:a 2}))))) 12 | 13 | (deftest lazy-hash-map-test 14 | (let [evals (atom []) 15 | recorded-val (fn [x] (swap! evals conj x) x) 16 | base (lazy-hash-map :a (recorded-val 1) :b (recorded-val 2)) 17 | b2 (lazy-assoc base :a (recorded-val 11) :d (recorded-val 3)) 18 | b3 (assoc b2 :d 33)] 19 | (is (true? (map? b2))) 20 | (is (= #{:a :b :d} (set (keys b2)))) 21 | (is (= #{:b :d} (set (keys (dissoc b2 :a))))) 22 | (is (empty? (meta base))) 23 | (is (= {:foo :bar} (meta (with-meta b2 {:foo :bar})))) 24 | (is (true? (contains? b3 :a))) 25 | (is (not (contains? b3 :f))) 26 | (is (not (nil? (find b3 :a)))) 27 | (is (nil? (find b3 :f))) 28 | (is (not (empty? b3))) 29 | (is (empty? (dissoc b3 :a :b :d))) 30 | 31 | (is (empty? @evals)) 32 | 33 | (is (= {:a 11 :d 33} (select-keys b3 [:a :d]))) 34 | (is (= #{11} (set @evals))) 35 | 36 | (is (= 11 (get b3 :a))) 37 | (is (= 11 (get b3 :a 12))) 38 | (is (= nil (get b3 :f))) 39 | (is (= 12 (get b3 :f 12))) 40 | (is (= #{11 3} (set (vals (dissoc b2 :b))))) 41 | (is (= #{:a :b :c} (set (keys (merge base {:c :e}))))) 42 | (is (= :a (key (first (dissoc base :b))))) 43 | 44 | (is (= #{11 3} (set @evals))) 45 | (is (= 2 (count @evals))) 46 | 47 | (is (= 1 (val (first (dissoc base :b))))) 48 | (is (= #{11 3 1} (set @evals))) 49 | (is (= 3 (count @evals))) 50 | 51 | (is (= 2 (base :b))) 52 | (is (= 3 (base :f 3))) 53 | (is (= nil (base :f))) 54 | (is (= 3 (apply base [:f 3]))) 55 | 56 | (is (= #{11 2 3 1} (set @evals))) 57 | (is (= 4 (count @evals))) 58 | 59 | (is (= {:a 1} (select-keys base [:a]))) 60 | (is (= {:a 1 :b 2} (into {} base))) 61 | ;; (is (= [[:a 1]] (seq (dissoc base :b)))) ;; TODO: this fails because of entry equality. 62 | 63 | (let [b4 (delay-assoc b2 :d (delay (recorded-val 42)))] 64 | (is (= 4 (count @evals))) 65 | (is (= {:a 11 :b 2 :d 42} (into {} b4)))) 66 | 67 | (is (= #{11 2 3 1 42} (set @evals))) 68 | (is (= 5 (count @evals))) 69 | 70 | (is (= {:a 1 :b 2 :d 3} (into {} (merge b3 b2 base)))) 71 | (is (= 5 (count @evals))))) -------------------------------------------------------------------------------- /test/plumbing/map_test.cljc: -------------------------------------------------------------------------------- 1 | (ns plumbing.map-test 2 | (:refer-clojure :exclude [flatten]) 3 | (:require 4 | [plumbing.core :as plumbing] 5 | [plumbing.map :as map] 6 | [clojure.string :as str] 7 | #?(:clj [clojure.test :refer :all] 8 | :cljs [cljs.test :refer-macros [is deftest testing use-fixtures]])) 9 | #?(:cljs 10 | (:require-macros [plumbing.map :as map]))) 11 | 12 | #?(:cljs 13 | (do 14 | (def Exception js/Error) 15 | (def AssertionError js/Error) 16 | (def Throwable js/Error))) 17 | 18 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 19 | ;;; Clojure immutable maps 20 | 21 | (deftest safe-select-keys-test 22 | (is (= {:a 1 :c 3} 23 | (map/safe-select-keys {:a 1 :b 2 :c 3} [:a :c]))) 24 | (is (= {} 25 | (map/safe-select-keys {:a 1 :b 2 :c 3} []))) 26 | (is (thrown? Throwable 27 | (map/safe-select-keys {:a 1 :b 2 :c 3} [:a :b :d])))) 28 | 29 | (deftest merge-disjoint-test 30 | (is (= {:a 1 :b 2 :c 3} 31 | (map/merge-disjoint 32 | {} {:a 1 :b 2} {:c 3} {}))) 33 | (is (thrown? Throwable 34 | (map/merge-disjoint 35 | {} {:a 1 :b 2} {:b 5 :c 3} {})))) 36 | 37 | (deftest merge-with-key-test 38 | (is (= 39 | {"k1" "v1" :k1 :v2} 40 | (map/merge-with-key 41 | (fn [k v1 v2] 42 | (if (string? k) 43 | v1 44 | v2)) 45 | {"k1" "v1" 46 | :k1 :v1} 47 | {"k1" "v2" 48 | :k1 :v2})))) 49 | 50 | (deftest flatten-test 51 | (is (empty? (map/flatten nil))) 52 | (is (empty? (map/flatten {}))) 53 | (is (= [[[] :foo]] (map/flatten :foo))) 54 | (is (= {[:a] 1 55 | [:b :c] false 56 | [:b :d :e] nil 57 | [:b :d :f] 4} 58 | (into {} (map/flatten {:a 1 :b {:c false :d {:e nil :f 4}}}))))) 59 | 60 | (deftest unflatten-test 61 | (is (= {} (map/unflatten nil))) 62 | (is (= :foo (map/unflatten [[[] :foo]]))) 63 | (is (= {:a 1 :b {:c 2 :d {:e 3 :f 4}}} 64 | (map/unflatten 65 | {[:a] 1 66 | [:b :c] 2 67 | [:b :d :e] 3 68 | [:b :d :f] 4})))) 69 | 70 | (deftest map-leaves-and-path-test 71 | (is (empty? (map/map-leaves-and-path (constantly 2) nil))) 72 | (is (= {:a {:b "a,b2"} :c {:d "c,d3"} :e "e11"} 73 | (map/map-leaves-and-path 74 | (fn [ks v] (str (str/join "," (map name ks)) (inc v))) 75 | {:a {:b 1} :c {:d 2} :e 10})))) 76 | 77 | (deftest map-leaves-test 78 | (is (empty? (map/map-leaves (constantly 2) nil))) 79 | (is (= {:a {:b "1"} :c {:d "2"} :e "10"} 80 | (map/map-leaves str {:a {:b 1} :c {:d 2} :e 10}))) 81 | (is (= {:a {:b nil} :c {:d nil} :e nil} 82 | (map/map-leaves (constantly nil) {:a {:b 1} :c {:d 2} :e 10})))) 83 | 84 | (deftest keep-leaves-test 85 | (is (empty? (map/keep-leaves (constantly 2) {}))) 86 | (is (= {:a {:b "1"} :c {:d "2"} :e "10"} 87 | (map/keep-leaves str {:a {:b 1} :c {:d 2} :e 10}))) 88 | (is (= {:a {:b false} :c {:d false} :e false} 89 | (map/keep-leaves (constantly false) {:a {:b 1} :c {:d 2} :e 10}))) 90 | (is (= {} 91 | (map/keep-leaves (constantly nil) {:a {:b 1} :c {:d 2} :e 10}))) 92 | (is (= {:c {:d 10} :e 4} 93 | (map/keep-leaves #(when (even? %) %) {:a {:b 5} :c {:d 10 :e {:f 5}} :e 4})))) 94 | 95 | (def some-var "hey hey") 96 | 97 | (deftest keyword-map-test 98 | (is (= {} (map/keyword-map)) "works with no args") 99 | (is (= {:x 42} (let [x (* 2 3 7)] (map/keyword-map x)))) 100 | (is (= {:some-var "hey hey" 101 | :$ \$} 102 | (let [$ \$] 103 | (map/keyword-map some-var $))))) 104 | 105 | 106 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 107 | ;;; Java mutable Maps 108 | 109 | #?(:clj 110 | (do 111 | (deftest update-key!-test 112 | (let [m (java.util.HashMap. {:a 1 :b 2})] 113 | (map/update-key! m :a inc) 114 | (is (= {:a 2 :b 2} (into {} m))) 115 | (map/update-key! m :c conj "foo") 116 | (is (= {:a 2 :b 2 :c ["foo"]} (into {} m))))) 117 | 118 | (deftest get!-test 119 | (let [m (java.util.HashMap.) 120 | a! (fn [k v] (.add ^java.util.List (map/get! m k (java.util.ArrayList.)) v)) 121 | value (fn [] (plumbing/map-vals seq m))] 122 | (is (= {} (value))) 123 | (a! :a 1) 124 | (is (= {:a [1]} (value))) 125 | (a! :a 2) 126 | (a! :b 3) 127 | (is (= {:a [1 2] :b [3]} (value))))) 128 | 129 | (defn clojureize [m] (plumbing/map-vals #(if (map? %) (into {} %) %) m)) 130 | 131 | (deftest inc-key!-test 132 | (let [m (java.util.HashMap.)] 133 | (is (= {} (clojureize m))) 134 | (map/inc-key! m :a 1.0) 135 | (is (= {:a 1.0} (clojureize m))) 136 | (map/inc-key! m :a 2.0) 137 | (map/inc-key! m :b 4.0) 138 | (is (= {:a 3.0 :b 4.0} (clojureize m))))) 139 | 140 | (deftest inc-key-in!-test 141 | (let [m (java.util.HashMap.)] 142 | (is (= {} (clojureize m))) 143 | (map/inc-key-in! m [:a :b] 1.0) 144 | (is (= {:a {:b 1.0}} (clojureize m))) 145 | (map/inc-key-in! m [:a :b] 2.0) 146 | (map/inc-key-in! m [:a :c] -1.0) 147 | (map/inc-key-in! m [:b] 4.0) 148 | (is (= {:a {:b 3.0 :c -1.0} :b 4.0} (clojureize m))))) 149 | 150 | 151 | (deftest collate-test 152 | (is (= {:a 3.0 :b 2.0} 153 | (clojureize (map/collate [[:a 1] [:b 3.0] [:a 2] [:b -1.0]]))))) 154 | 155 | (deftest deep-collate-test 156 | (is (= {:a {:b 3.0 :c -1.0} :b 4.0} 157 | (clojureize (map/deep-collate [[[:a :b] 1.0] [[:a :c] -1.0] [[:a :b] 2.0] [[:b] 4.0]]))))))) 158 | 159 | 160 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 161 | ;;; Ops on graphs represented as maps. 162 | 163 | (deftest topological-sort-test 164 | (is (= [:first :second :third :fourth :fifth] 165 | (map/topological-sort {:first [:second :fourth] 166 | :second [:third] 167 | :third [:fourth] 168 | :fourth [:fifth] 169 | :fifth []}))) 170 | (is (= (range 100) 171 | (map/topological-sort (into {99 []} (for [i (range 99)] [i [(inc i)]]))))) 172 | (is (= (range 99) 173 | (map/topological-sort (into {} (for [i (range 99)] [i [(inc i)]]))))) 174 | (testing "include-leaves?" 175 | (is (= (range 1000) 176 | (map/topological-sort (into {} (for [i (range 999)] [i [(inc i)]])) true)))) 177 | (testing "exception thrown if cycle" 178 | (is (thrown? Exception (map/topological-sort {:first [:second :fourth] 179 | :second [:third] 180 | :third [:fourth] 181 | :fourth [:fifth] 182 | :fifth [:first]}))))) 183 | -------------------------------------------------------------------------------- /test/plumbing/test_runner.cljs: -------------------------------------------------------------------------------- 1 | (ns plumbing.test-runner 2 | (:require [doo.runner :refer-macros [doo-tests]] 3 | plumbing.core-test 4 | plumbing.fnk.fnk-examples-test 5 | plumbing.fnk.pfnk-test 6 | plumbing.fnk.schema-test 7 | plumbing.graph-async-test 8 | plumbing.graph-examples-test 9 | plumbing.graph-test 10 | plumbing.map-test)) 11 | 12 | (doo-tests 13 | 'plumbing.core-test 14 | 'plumbing.fnk.fnk-examples-test 15 | 'plumbing.fnk.pfnk-test 16 | 'plumbing.fnk.schema-test 17 | 'plumbing.graph-async-test 18 | 'plumbing.graph-examples-test 19 | 'plumbing.graph-test 20 | 'plumbing.map-test) 21 | --------------------------------------------------------------------------------