pax_global_header 0000666 0000000 0000000 00000000064 13141156451 0014513 g ustar 00root root 0000000 0000000 52 comment=16b3df3f8683c02d9f58035ca8856070bfa76082
prismatic-plumbing-clojure-0.5.4/ 0000755 0000000 0000000 00000000000 13141156451 0016766 5 ustar 00root root 0000000 0000000 prismatic-plumbing-clojure-0.5.4/.gitignore 0000644 0000000 0000000 00000000145 13141156451 0020756 0 ustar 00root root 0000000 0000000 .lein-failures
*~
pom.xml
pom.xml.asc
target/**
.*.swp
.nrepl-port
.repl
out
.lein-repl-history
/doc/ prismatic-plumbing-clojure-0.5.4/CHANGELOG.md 0000644 0000000 0000000 00000011616 13141156451 0020604 0 ustar 00root root 0000000 0000000 ## 0.5.4
* Allow redefining keys in an inner scope, and clarify the semantics.
* Nicer error messages for `safe-get`, `safe-select-keys`, `merge-disjoint`.
## 0.5.3
* **Deprecate** `keywordize-map` in favor of `clojure.walk/keywordize-keys`
* Fix dependent optional bindings (e.g. (fnk [a {b a}])) broken in 0.5.1
* 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))`).
## 0.5.2
* Fix broken cycle check in Clojurescript topological sort.
## 0.5.1
* (Experimental) include default values as metadata on fnk schemas.
## 0.5.0
* **BREAKING**: Bump to Schema 1.0.1, breaking compatibility with pre-1.0.0 Schema.
## 0.4.4
* Bump to latest Schema version, which should fix AOT compilation when used with Clojure 1.7-RC1 and later.
## 0.4.3
* Actually fix *update* warnings under Clojure 1.7 (commit missed the 0.4.2 release).
## 0.4.2
* Letk now supports simple symbol bindings as well as map destructuring bindings.
* Fix *update* warnings under Clojure 1.7.
## 0.4.1
* Fix concurrency issue recently introduced in distinct-by in Clojure (sequence had to be realized in creator thread due to transient restrictions)
## 0.4.0
* **Breaking** Bump dependencies, potemkin no longer included transitively through schema.
## 0.3.7
* Add support for destructuring namespaced keywords, i.e.
`(= 1 (letk [[a/b] {:a/b 1}] b))` and `(= 1 ((fnk [a/b] b) {:a/b 1}))`
* Fix warnings about `*clojurescript-version*` when compiling ClojureScript
## 0.3.6
* **BREAKING**: Define `update` only if `clojure.core/update` does not exist (ie. legacy clojure(script) versions)
## 0.3.5
* Fix bug in `safe-get` in ClojureScript due to missing `:include-macros true` in plumbing.core
## 0.3.4
* Add `plumbing.map/keyword-map`, `plumbing.core/if-letk`, `plumbing.core/when-letk`
* Bump schema version to 0.3.1, fixing cljs warnings from that project, and move schema.macros calls over to schema.core.
* Minimum required schema version is now 0.3.0
## 0.3.3
* Properly generate cross-platform assertions, fixing ClojureScript errors that tried to throw Java errors.
## 0.3.2
* Fix cljs compilation issue appearing in some circumstances (No such namespace: js)
## 0.3.1
* Fix cljs issue where plumbing.fnk.schema was missing from dependency tree
## 0.3.0
* **BREAKING**: `?>` and `?>>` require a body expression in parens, and take an arbitrary number of body expressions.
* Add ClojureScript support via cljx
* 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.
* Add `update` and `mapply` to plumbing.core
## 0.2.2
* Don't depend on a specific Clojure version, and add support for Clojure 1.6.x
## 0.2.1
* Fix for issues with AOT compilation after introducing schema
## 0.2.0
* 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.
* Drop support for Clojure 1.4.x
## 0.1.1
* Fix bug when aliasing optional values with arg names, i.e. `(let [a 1] ((fnk [{a a}] a) {}))`
* 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.
* Add update-in-when, grouped-map, conk-when, cons-when, rsort-by, as->> to plumbing.core
## 0.1.0
* Minor bugfixes and improved tests
* Perf improvements for `map-keys` and `map-vals` (thanks [bendlas](https://github.com/bendlas)!)
* 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.
* 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.
* 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.
* Moved `comp-partial` from pfnk to graph, and added `instance` for fnks/graphs
* Automatic efficient positional forms for fnks that take no rest args.
* 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`.
## 0.0.1
* Initial release
prismatic-plumbing-clojure-0.5.4/README.md 0000644 0000000 0000000 00000022551 13141156451 0020252 0 ustar 00root root 0000000 0000000 # Plumbing and Graph: the Clojure utility belt
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.
*New in 0.3.0: support for ClojureScript*
*New in 0.2.0: support for schema.core/defn-style schemas on fnks and Graphs. See `(doc fnk)` for details.*
Leiningen dependency (Clojars):
[](http://clojars.org/prismatic/plumbing)
[Latest API docs](http://plumatic.github.io/plumbing).
**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.**
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.
## Graph: the Functional Swiss-Army Knife
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:
```clojure
(require '[plumbing.core :refer (sum)])
(defn stats
"Take a map {:xs xs} and return a map of simple statistics on xs"
[{:keys [xs] :as m}]
(assert (contains? m :xs))
(let [n (count xs)
m (/ (sum identity xs) n)
m2 (/ (sum #(* % %) xs) n)
v (- m2 (* m m))]
{:n n ; count
:m m ; mean
:m2 m2 ; mean-square
:v v ; variance
}))
(require '[plumbing.core :refer (fnk sum)])
(def stats-graph
"A graph specifying the same computation as 'stats'"
{:n (fnk [xs] (count xs))
:m (fnk [xs n] (/ (sum identity xs) n))
:m2 (fnk [xs n] (/ (sum #(* % %) xs) n))
:v (fnk [m m2] (- m2 (* m m)))})
```
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).
We can "compile" this Graph to produce a single function (equivalent to `stats`), which also checks that the map represents a valid Graph:
```clojure
(require '[plumbing.graph :as graph] '[schema.core :as s])
(def stats-eager (graph/compile stats-graph))
(= {:n 4
:m 3
:m2 (/ 25 2)
:v (/ 7 2)}
(into {} (stats-eager {:xs [1 2 3 6]})))
;; Missing :xs key exception
(thrown? Throwable (stats-eager {:ys [1 2 3]}))
```
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.
Unlike the opaque `stats` fn, however, we can modify and extend `stats-graph` using ordinary operations on maps:
```clojure
(def extended-stats
(graph/compile
(assoc stats-graph
:sd (fnk [^double v] (Math/sqrt v)))))
(= {:n 4
:m 3
:m2 (/ 25 2)
:v (/ 7 2)
:sd (Math/sqrt 3.5)}
(into {} (extended-stats {:xs [1 2 3 6]})))
```
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:
```clojure
(def lazy-stats (graph/lazy-compile stats-graph))
(def output (lazy-stats {:xs [1 2 3 6]}))
;; Nothing has actually been computed yet
(= (/ 25 2) (:m2 output))
;; Now :n, :m, and :m2 have been computed, but :v is still behind a delay
(def par-stats (graph/par-compile stats-graph))
(def output (par-stats {:xs [1 2 3 6]}))
;; Nodes are being computed in futures, with :m and :m2 going in parallel after :n
(= (/ 7 2) (:v output))
```
We can also ask a Graph for information about its inputs and outputs (automatically computed from its definition):
```clojure
(require '[plumbing.fnk.pfnk :as pfnk])
;; stats-graph takes a map with one required key, :xs
(= {:xs s/Any}
(pfnk/input-schema stats-graph))
;; stats-graph outputs a map with four keys, :n, :m, :m2, and :v
(= {:n s/Any :m s/Any :m2 s/Any :v s/Any}
(pfnk/output-schema stats-graph))
```
If schemas are provided on the inputs and outputs of the node functions, these propagate through into the Graph schema as expected.
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:
```clojure
(def profiled-stats (graph/compile (graph/profiled ::profile-data stats-graph)))
;;; times in milliseconds for each step:
(= {:n 1.001, :m 0.728, :m2 0.996, :v 0.069}
@(::profile-data (profiled-stats {:xs (range 10000)})))
```
… 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.cljx).
## Bring on (de)fnk
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:
```clojure
(use 'plumbing.core)
(defnk simple-fnk [a b c]
(+ a b c))
(= 6 (simple-fnk {:a 1 :b 2 :c 3}))
;; Below throws: Key :c not found in (:a :b)
(thrown? Throwable (simple-fnk {:a 1 :b 2}))
```
You can declare a key as optional and provide a default:
```clojure
(defnk simple-opt-fnk [a b {c 1}]
(+ a b c))
(= 4 (simple-opt-fnk {:a 1 :b 2}))
```
You can do nested map bindings:
```clojure
(defnk simple-nested-fnk [a [:b b1] c]
(+ a b1 c))
(= 6 (simple-nested-fnk {:a 1 :b {:b1 2} :c 3}))
;; Below throws: Expected a map at key-path [:b], got type class java.lang.Long
(thrown? Throwable (simple-nested-fnk {:a 1 :b 1 :c 3}))
```
Of course, you can bind multiple variables from an inner map and do multiple levels of nesting:
```clojure
(defnk simple-nested-fnk2 [a [:b b1 [:c {d 3}]]]
(+ a b1 d))
(= 4 (simple-nested-fnk2 {:a 1 :b {:b1 2 :c {:d 1}}}))
(= 5 (simple-nested-fnk2 {:a 1 :b {:b1 1 :c {}}}))
```
You can also use this binding style in a `let` statement using `letk`
or within an anonymous function by using `fnk`.
## More good stuff
There are a bunch of functions in `plumbing.core` that we can't live without. Here are a few of our favorites.
When we build maps, we often use `for-map`, which works like `for` but for maps:
```clojure
(use 'plumbing.core)
(= (for-map [i (range 3)
j (range 3)
:let [s (+ i j)]
:when (< s 3)]
[i j]
s)
{[0 0] 0, [0 1] 1, [0 2] 2, [1 0] 1, [1 1] 2, [2 0] 2})
```
`safe-get` is like `get` but throws when the key doesn't exist:
```clojure
;; IllegalArgumentException Key :c not found in {:a 1, :b 2}
(thrown? Exception (safe-get {:a 1 :b 2} :c))
```
Another frequently used map function is `map-vals`:
```clojure
;; return k -> (f v) for [k, v] in map
(= (map-vals inc {:a 0 :b 0})
{:a 1 :b 1})
```
Ever wanted to conditionally do steps in a `->>` or `->`? Now you can with our
'penguin' operators. Here's a few examples:
```clojure
(use 'plumbing.core)
(= (let [add-b? false]
(-> {:a 1}
(merge {:c 2})
(?> add-b? (assoc :b 2))))
{:a 1 :c 2})
(= (let [inc-all? true]
(->> (range 10)
(filter even?)
(?>> inc-all? (map inc))))
[1 3 5 7 9])
```
Check out [`plumbing.core`](https://github.com/plumatic/plumbing/blob/master/src/plumbing/core.cljx) for many other useful functions.
## ClojureScript
As of 0.3.0, plumbing is available in ClojureScript! The vast majority of the
library supports ClojureScript, with the only exceptions that are JVM-specific
optimizations.
Here's an example usage of `for-map`:
```clojure
(ns plumbing.readme
(:require [plumbing.core :refer-macros [for-map]]))
(defn js-obj->map
"Recursively converts a JavaScript object into a map with keyword keys"
[obj]
(for-map [k (js-keys obj)
:let [v (aget obj k)]]
(keyword k) (if (object? v) (js-obj->map v) v)))
(is (= {:a 1 :b {:x "x" :y "y"}}
(js-obj->map
(js-obj "a" 1
"b" (js-obj "x" "x"
"y" "y")))))
;; Note: this is a contrived example; you would normally use `cljs.core/clj->js`
```
## Community
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.
## Supported Clojure versions
Plumbing is currently supported on Clojure 1.5.x and 1.6.x.
## License
Distributed under the Eclipse Public License, the same as Clojure.
prismatic-plumbing-clojure-0.5.4/bin/ 0000755 0000000 0000000 00000000000 13141156451 0017536 5 ustar 00root root 0000000 0000000 prismatic-plumbing-clojure-0.5.4/bin/push_docs.sh 0000755 0000000 0000000 00000000702 13141156451 0022063 0 ustar 00root root 0000000 0000000 #!/bin/bash
set -e
# Script to generate docs and push to github pages.
# https://github.com/weavejester/codox/wiki/Deploying-to-GitHub-Pages
cd `dirname $0`
git fetch --tags
latestTag=$(git describe --tags `git rev-list --tags --max-count=1`)
git checkout $latestTag
lein doc
cd ../doc
git checkout gh-pages # To be sure you're on the right branch
git add .
git commit -am "new documentation push."
git push -u origin gh-pages
cd ..
git checkout - prismatic-plumbing-clojure-0.5.4/bin/release.sh 0000755 0000000 0000000 00000000201 13141156451 0021506 0 ustar 00root root 0000000 0000000 #!/bin/bash
set -e
# Script to push a release with lein-release and then push docs.
cd `dirname $0`
lein release
./push_docs.sh
prismatic-plumbing-clojure-0.5.4/bin/setup_codox.sh 0000755 0000000 0000000 00000000502 13141156451 0022426 0 ustar 00root root 0000000 0000000 #!/bin/bash
set -e
# One-time script to setup codox deploy to github pages.
# https://github.com/weavejester/codox/wiki/Deploying-to-GitHub-Pages
cd `dirname $0`
cd ..
rm -rf doc && mkdir doc
git clone git@github.com:plumatic/plumbing.git doc
cd doc
git symbolic-ref HEAD refs/heads/gh-pages
rm .git/index
git clean -fdx prismatic-plumbing-clojure-0.5.4/project.clj 0000644 0000000 0000000 00000007052 13141156451 0021132 0 ustar 00root root 0000000 0000000 (defproject prismatic/plumbing "0.5.4"
:description "Prismatic's Clojure utility belt."
:url "https://github.com/plumatic/plumbing"
:license {:name "Eclipse Public License - v 1.0"
:url "http://www.eclipse.org/legal/epl-v10.html"
:distribution :repo}
:dependencies [[prismatic/schema "1.0.1"]
[de.kotka/lazymap "3.1.0" :exclusions [org.clojure/clojure]]]
:profiles {:dev {:dependencies [[org.clojure/clojure "1.6.0"]
[org.clojure/clojurescript "0.0-2665"]
[org.clojure/core.async "0.1.346.0-17112a-alpha"]]
:plugins [[com.keminglabs/cljx "0.6.0" :exclusions [org.clojure/clojure]]
[codox "0.8.8"]
[lein-cljsbuild "1.0.5"]
[com.cemerick/clojurescript.test "0.3.1"]]
:cljx {:builds [{:source-paths ["src"]
:output-path "target/generated/src/clj"
:rules :clj}
{:source-paths ["src"]
:output-path "target/generated/src/cljs"
:rules :cljs}
{:source-paths ["test"]
:output-path "target/generated/test/clj"
:rules :clj}
{:source-paths ["test"]
:output-path "target/generated/test/cljs"
:rules :cljs}]}}
:1.5 {:dependencies [[org.clojure/clojure "1.5.1"]]}
:1.7 {:dependencies [[org.clojure/clojure "1.7.0"]]}
:1.8 {:dependencies [[org.clojure/clojure "1.8.0-RC1"]]}}
:jar-exclusions [#"\.cljx"]
:aliases {"all" ["with-profile" "dev:dev,1.5:dev,1.7;dev,1.8"]
"deploy" ["do" "clean," "cljx" "once," "deploy" "clojars"]
"test" ["do" "clean," "cljx" "once," "test," "with-profile" "dev" "cljsbuild" "test"]}
:lein-release {:deploy-via :shell
:shell ["lein" "deploy"]}
:auto-clean false
:source-paths ["target/generated/src/clj" "src"]
:resource-paths ["target/generated/src/cljs"]
:test-paths ["target/generated/test/clj" "test"]
:cljsbuild {:test-commands {"unit" ["phantomjs" :runner
"this.literal_js_was_evaluated=true"
"target/unit-test.js"]}
:builds
{:dev {:source-paths ["src"
"target/generated/src/clj"
"target/generated/src/cljs"]
:compiler {:output-to "target/main.js"
:optimizations :whitespace
:pretty-print true}}
:test {:source-paths ["src"
"target/generated/src/clj"
"target/generated/src/cljs"
"target/generated/test/clj"
"target/generated/test/cljs"]
:compiler {:output-to "target/unit-test.js"
:optimizations :whitespace
:pretty-print true}}}}
:codox {:src-uri-mapping {#"target/generated/src/clj" #(str "src/" % "x")}
:src-dir-uri "http://github.com/plumatic/plumbing/blob/master/"
:src-linenum-anchor-prefix "L"}
:jvm-opts ^:replace [])
prismatic-plumbing-clojure-0.5.4/src/ 0000755 0000000 0000000 00000000000 13141156451 0017555 5 ustar 00root root 0000000 0000000 prismatic-plumbing-clojure-0.5.4/src/plumbing/ 0000755 0000000 0000000 00000000000 13141156451 0021372 5 ustar 00root root 0000000 0000000 prismatic-plumbing-clojure-0.5.4/src/plumbing/core.clj 0000644 0000000 0000000 00000036407 13141156451 0023026 0 ustar 00root root 0000000 0000000 (ns plumbing.core
"Utility belt for Clojure in the wild"
(:refer-clojure :exclude [update])
(:require
[schema.utils :as schema-utils]
[schema.macros :as schema-macros]
[plumbing.fnk.schema :as schema :include-macros true]
[plumbing.fnk.impl :as fnk-impl]))
(set! *warn-on-reflection* true)
(def ^:private +none+
"A sentinel value representing missing portions of the input data."
::missing)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Maps
(defmacro for-map
"Like 'for' for building maps. Same bindings except the body should have a
key-expression and value-expression. If a key is repeated, the last
value (according to \"for\" semantics) will be retained.
(= (for-map [i (range 2) j (range 2)] [i j] (even? (+ i j)))
{[0 0] true, [0 1] false, [1 0] false, [1 1] true})
An optional symbol can be passed as a first argument, which will be
bound to the transient map containing the entries produced so far."
([seq-exprs key-expr val-expr]
`(for-map ~(gensym "m") ~seq-exprs ~key-expr ~val-expr))
([m-sym seq-exprs key-expr val-expr]
`(let [m-atom# (atom (transient {}))]
(doseq ~seq-exprs
(let [~m-sym @m-atom#]
(reset! m-atom# (assoc! ~m-sym ~key-expr ~val-expr))))
(persistent! @m-atom#))))
(defmacro -unless-update
"Execute and yield body only if Clojure version preceeds introduction
of 'update' into core namespace."
[body]
`(schema-macros/if-cljs
~body
~(when (pos? (compare
[1 7 0]
(mapv #(get *clojure-version* %)
[:major :minor :incremental])))
body)))
(-unless-update
(defn update
"Updates the value in map m at k with the function f.
Like update-in, but for updating a single top-level key.
Any additional args will be passed to f after the value.
WARNING As of Clojure 1.7 this function exists in clojure.core and
will not be exported by this namespace."
([m k f] (assoc m k (f (get m k))))
([m k f x1] (assoc m k (f (get m k) x1)))
([m k f x1 x2] (assoc m k (f (get m k) x1 x2)))
([m k f x1 x2 & xs] (assoc m k (apply f (get m k) x1 x2 xs)))))
(defn map-vals
"Build map k -> (f v) for [k v] in map, preserving the initial type"
[f m]
(cond
(sorted? m)
(reduce-kv (fn [out-m k v] (assoc out-m k (f v))) (sorted-map) m)
(map? m)
(persistent! (reduce-kv (fn [out-m k v] (assoc! out-m k (f v))) (transient {}) m))
:else
(for-map [[k v] m] k (f v))))
(defn map-keys
"Build map (f k) -> v for [k v] in map m"
[f m]
(if (map? m)
(persistent! (reduce-kv (fn [out-m k v] (assoc! out-m (f k) v)) (transient {}) m))
(for-map [[k v] m] (f k) v)))
(defn map-from-keys
"Build map k -> (f k) for keys in ks"
[f ks]
(for-map [k ks] k (f k)))
(defn map-from-vals
"Build map (f v) -> v for vals in vs"
[f vs]
(for-map [v vs] (f v) v))
(defn dissoc-in
"Dissociate this keyseq from m, removing any empty maps created as a result
(including at the top-level)."
[m [k & ks]]
(when m
(if-let [res (and ks (dissoc-in (get m k) ks))]
(assoc m k res)
(let [res (dissoc m k)]
(when-not (empty? res)
res)))))
(defn ^:deprecated keywordize-map
"DEPRECATED. prefer clojure.walk/keywordize-keys.
Recursively convert maps in m (including itself)
to have keyword keys instead of string"
[x]
(cond
(map? x)
(for-map [[k v] x]
(if (string? k) (keyword k) k) (keywordize-map v))
(seq? x)
(map keywordize-map x)
(vector? x)
(mapv keywordize-map x)
:else
x))
(defmacro lazy-get
"Like get but lazy about default"
[m k d]
`(if-let [pair# (find ~m ~k)]
(val pair#)
~d))
(defn safe-get
"Like get but throw an exception if not found"
[m k]
(lazy-get
m k
(schema/assert-iae false "Key %s not found in %s" k
(binding [*print-length* 200]
(print-str (mapv key m))))))
(defn safe-get-in
"Like get-in but throws exception if not found"
[m ks]
(if (seq ks)
(recur (safe-get m (first ks)) (next ks))
m))
(defn assoc-when
"Like assoc but only assocs when value is truthy"
[m & kvs]
(assert (even? (count kvs)))
(into (or m {})
(for [[k v] (partition 2 kvs)
:when v]
[k v])))
(defn update-in-when
"Like update-in but returns m unchanged if key-seq is not present."
[m key-seq f & args]
(let [found (get-in m key-seq +none+)]
(if-not (identical? +none+ found)
(assoc-in m key-seq (apply f found args))
m)))
(defn grouped-map
"Like group-by, but accepts a map-fn that is applied to values before
collected."
[key-fn map-fn coll]
(persistent!
(reduce
(fn [ret x]
(let [k (key-fn x)]
(assoc! ret k (conj (get ret k []) (map-fn x)))))
(transient {}) coll)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Seqs
(defn aconcat
"Like (apply concat s) but lazier (and shorter) "
[s]
(lazy-cat (first s) (when-let [n (next s)] (aconcat n))))
(defn unchunk
"Takes a seqable and returns a lazy sequence that
is maximally lazy and doesn't realize elements due to either
chunking or apply.
Useful when you don't want chunking, for instance,
(first awesome-website? (map slurp +a-bunch-of-urls+))
may slurp up to 31 unneed webpages, wherease
(first awesome-website? (map slurp (unchunk +a-bunch-of-urls+)))
is guaranteed to stop slurping after the first awesome website.
Taken from http://stackoverflow.com/questions/3407876/how-do-i-avoid-clojures-chunking-behavior-for-lazy-seqs-that-i-want-to-short-ci"
[s]
(when (seq s)
(cons (first s)
(lazy-seq (unchunk (rest s))))))
(defn sum
"Return sum of (f x) for each x in xs"
([f xs] (reduce + (map f xs)))
([xs] (reduce + xs)))
(defn singleton
"returns (first xs) when xs has only 1 element"
[xs]
(when-let [xs (seq xs)]
(when-not (next xs)
(first xs))))
(defn indexed
"Returns [idx x] for x in seqable s"
[s]
(map-indexed vector s))
(defn positions
"Returns indices idx of sequence s where (f (nth s idx))"
[f s]
(keep-indexed (fn [i x] (when (f x) i)) s))
(defn frequencies-fast
"Like clojure.core/frequencies, but faster.
Uses Java's equal/hash, so may produce incorrect results if
given values that are = but not .equal"
[xs]
(let [res (java.util.HashMap.)]
(doseq [x xs]
(.put res x (unchecked-inc (int (or (.get res x) 0)))))
(into {} res)))
(defn distinct-fast
"Like clojure.core/distinct, but faster.
Uses Java's equal/hash, so may produce incorrect results if
given values that are = but not .equal"
[xs]
(let [s (java.util.HashSet.)]
(filter #(when-not (.contains s %) (.add s %) true) xs)))
(defn distinct-by
"Returns elements of xs which return unique
values according to f. If multiple elements of xs return the same
value under f, the first is returned"
[f xs]
(let [s (atom #{})]
(for [x xs
:let [id (f x)]
:when (not (contains? @s id))]
(do (swap! s conj id)
x))))
(defn distinct-id
"Like distinct but uses reference rather than value identity, very clojurey"
[xs]
(let [s (java.util.IdentityHashMap.)]
(doseq [x xs]
(.put s x true))
(iterator-seq (.iterator (.keySet s)))))
(defn interleave-all
"Analogy: partition:partition-all :: interleave:interleave-all"
[& colls]
(lazy-seq
((fn helper [seqs]
(when (seq seqs)
(concat (map first seqs)
(lazy-seq (helper (keep next seqs))))))
(keep seq colls))))
(defn count-when
"Returns # of elements of xs where pred holds"
[pred xs]
(count (filter pred xs)))
(defn conj-when
"Like conj but ignores non-truthy values"
([coll x] (if x (conj coll x) coll))
([coll x & xs]
(if xs
(recur (conj-when coll x)
(first xs)
(next xs))
(conj-when coll x))))
(defn cons-when
"Like cons but does nothing if x is non-truthy."
[x s]
(if x (cons x s) s))
(def rsort-by
"Like sort-by, but prefers higher values rather than lower ones."
(comp reverse sort-by))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Control flow
(defmacro ?>>
"Conditional double-arrow operation (->> nums (?>> inc-all? (map inc)))"
[do-it? & args]
`(if ~do-it?
(->> ~(last args) ~@(butlast args))
~(last args)))
(defmacro ?>
"Conditional single-arrow operation (-> m (?> add-kv? (assoc :k :v)))"
[arg do-it? & rest]
`(if ~do-it?
(-> ~arg ~@rest)
~arg))
(defmacro fn->
"Equivalent to `(fn [x] (-> x ~@body))"
[& body]
`(fn [x#] (-> x# ~@body)))
(defmacro fn->>
"Equivalent to `(fn [x] (->> x ~@body))"
[& body]
`(fn [x#] (->> x# ~@body)))
(defmacro <-
"Converts a ->> to a ->
(->> (range 10) (map inc) (<- (doto prn)) (reduce +))
Jason W01fe is happy to give a talk anywhere any time on
the calculus of arrow macros"
[& body]
`(-> ~(last body) ~@(butlast body)))
(defmacro as->>
"Like as->, but can be used in double arrow."
[name & forms-and-expr]
`(as-> ~(last forms-and-expr) ~name ~@(butlast forms-and-expr)))
(defmacro memoized-fn
"Like fn, but memoized (including recursive calls).
The clojure.core memoize correctly caches recursive calls when you do a top-level def
of your memoized function, but if you want an anonymous fibonacci function, you must use
memoized-fn rather than memoize to cache the recursive calls."
[name args & body]
`(let [a# (atom {})]
(fn ~name ~args
(let [m# @a#
args# ~args]
(if-let [[_# v#] (find m# args#)]
v#
(let [v# (do ~@body)]
(swap! a# assoc args# v#)
v#))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Miscellaneous
(defn swap-pair!
"Like swap! but returns a pair [old-val new-val]"
([a f]
(loop []
(let [old-val @a
new-val (f old-val)]
(if (compare-and-set! a old-val new-val)
[old-val new-val]
(recur)))))
([a f & args]
(swap-pair! a #(apply f % args))))
(defn get-and-set!
"Like reset! but returns old-val"
[a new-val]
(first (swap-pair! a (constantly new-val))))
(defn millis ^long []
(System/currentTimeMillis)
)
(defn mapply
"Like apply, but applies a map to a function with positional map
arguments. Can take optional initial args just like apply."
([f m] (apply f (apply concat m)))
([f arg & args] (apply f arg (concat (butlast args) (apply concat (last args))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; fnk
(defmacro letk
"Keyword let. Accepts an interleaved sequence of binding forms and map forms like:
(letk [[a {b 2} [:f g h] c d {e 4} :as m & more] a-map ...] & body)
a, c, d, and f are required keywords, and letk will barf if not in a-map.
b and e are optional, and will be bound to default values if not present.
g and h are required keys in the map found under :f.
m will be bound to the entire map (a-map).
more will be bound to all the unbound keys (ie (dissoc a-map :a :b :c :d :e)).
:as and & are both optional, but must be at the end in the specified order if present.
The same symbol cannot be bound multiple times within the same destructing level.
Optional values can reference symbols bound earlier within the same binding, i.e.,
(= [2 2] (let [a 1] (letk [[a {b a}] {:a 2}] [a b]))) but
(= [2 1] (let [a 1] (letk [[{b a} a] {:a 2}] [a b])))
If present, :as and :& symbols are bound before other symbols within the binding.
Namespaced keys are supported by specifying fully-qualified key in binding form. The bound
symbol uses the _name_ portion of the namespaced key, i.e,
(= 1 (letk [[a/b] {:a/b 1}] b)).
Map destructuring bindings can be mixed with ordinary symbol bindings."
[bindings & body]
(schema/assert-iae (vector? bindings) "Letk binding must be a vector")
(schema/assert-iae (even? (count bindings)) "Letk binding must have even number of elements")
(reduce
(fn [cur-body-form [bind-form value-form]]
(if (symbol? bind-form)
`(let [~bind-form ~value-form] ~cur-body-form)
(let [{:keys [map-sym body-form]} (fnk-impl/letk-input-schema-and-body-form
&env
(fnk-impl/ensure-schema-metadata &env bind-form)
[]
cur-body-form)]
`(let [~map-sym ~value-form] ~body-form))))
`(do ~@body)
(reverse (partition 2 bindings))))
(defmacro if-letk
"bindings => binding-form test
If test is true, evaluates then with binding-form bound to the value of
test, if not, yields else"
([bindings then]
`(if-letk ~bindings ~then nil))
([bindings then else]
(assert (vector? bindings) "if-letk requires a vector for its binding")
(assert (= 2 (count bindings)) "if-letk requires exactly 2 forms in binding vector")
(let [form (bindings 0) tst (bindings 1)]
`(let [temp# ~tst]
(if temp#
(letk [~form temp#]
~then)
~else)))))
(defmacro when-letk
"bindings => binding-form test
When test is true, evaluates body with binding-form bound to the value of test"
[bindings & body]
`(if-letk ~bindings (do ~@body)))
(defmacro fnk
"Keyword fn, using letk. Generates a prismatic/schema schematized fn that
accepts a single explicit map i.e., (f {:foo :bar}).
Explicit top-level map structure will be recorded in output spec, or
to capture implicit structure use an explicit prismatic/schema hint on the
function name.
Individual inputs can also be schematized by putting :- schemas after the
binding symbol. Schemas can also be used on & more symbols to describe
additional map inputs, or on entire [] bindings to override the automatically
generated schema for the contents (caveat emptor).
By default, input schemas allow for arbitrary additional mappings
({s/Keyword s/Any}) unless explicit binding or & more schemas are provided."
[& args]
(let [[name? more-args] (if (symbol? (first args))
(schema-macros/extract-arrow-schematized-element &env args)
[nil args])
[bind body] (schema-macros/extract-arrow-schematized-element &env more-args)]
(fnk-impl/fnk-form &env name? bind body &form)))
(defmacro defnk
"Analogy: fn:fnk :: defn::defnk"
[& defnk-args]
(let [[name args] (schema-macros/extract-arrow-schematized-element &env defnk-args)
take-if (fn [p s] (if (p (first s)) [(first s) (next s)] [nil s]))
[docstring? args] (take-if string? args)
[attr-map? args] (take-if map? args)
[bind body] (schema-macros/extract-arrow-schematized-element &env args)]
(schema/assert-iae (symbol? name) "Name for defnk is not a symbol: %s" name)
(let [f (fnk-impl/fnk-form &env name bind body &form)]
`(def ~(with-meta name (merge (meta name) (assoc-when (or attr-map? {}) :doc docstring?)))
~f))))
(set! *warn-on-reflection* false)
;;;;;;;;;;;; This file autogenerated from src/plumbing/core.cljx
prismatic-plumbing-clojure-0.5.4/src/plumbing/core.cljx 0000644 0000000 0000000 00000036305 13141156451 0023213 0 ustar 00root root 0000000 0000000 (ns plumbing.core
"Utility belt for Clojure in the wild"
(:refer-clojure :exclude [update])
#+cljs
(:require-macros
[plumbing.core :refer [for-map lazy-get -unless-update]]
[schema.macros :as schema-macros])
(:require
[schema.utils :as schema-utils]
#+clj [schema.macros :as schema-macros]
[plumbing.fnk.schema :as schema :include-macros true]
#+clj [plumbing.fnk.impl :as fnk-impl]))
#+clj (set! *warn-on-reflection* true)
(def ^:private +none+
"A sentinel value representing missing portions of the input data."
::missing)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Maps
(defmacro for-map
"Like 'for' for building maps. Same bindings except the body should have a
key-expression and value-expression. If a key is repeated, the last
value (according to \"for\" semantics) will be retained.
(= (for-map [i (range 2) j (range 2)] [i j] (even? (+ i j)))
{[0 0] true, [0 1] false, [1 0] false, [1 1] true})
An optional symbol can be passed as a first argument, which will be
bound to the transient map containing the entries produced so far."
([seq-exprs key-expr val-expr]
`(for-map ~(gensym "m") ~seq-exprs ~key-expr ~val-expr))
([m-sym seq-exprs key-expr val-expr]
`(let [m-atom# (atom (transient {}))]
(doseq ~seq-exprs
(let [~m-sym @m-atom#]
(reset! m-atom# (assoc! ~m-sym ~key-expr ~val-expr))))
(persistent! @m-atom#))))
(defmacro -unless-update
"Execute and yield body only if Clojure version preceeds introduction
of 'update' into core namespace."
[body]
`(schema-macros/if-cljs
~body
~(when (pos? (compare
[1 7 0]
(mapv #(get *clojure-version* %)
[:major :minor :incremental])))
body)))
(-unless-update
(defn update
"Updates the value in map m at k with the function f.
Like update-in, but for updating a single top-level key.
Any additional args will be passed to f after the value.
WARNING As of Clojure 1.7 this function exists in clojure.core and
will not be exported by this namespace."
([m k f] (assoc m k (f (get m k))))
([m k f x1] (assoc m k (f (get m k) x1)))
([m k f x1 x2] (assoc m k (f (get m k) x1 x2)))
([m k f x1 x2 & xs] (assoc m k (apply f (get m k) x1 x2 xs)))))
(defn map-vals
"Build map k -> (f v) for [k v] in map, preserving the initial type"
[f m]
(cond
(sorted? m)
(reduce-kv (fn [out-m k v] (assoc out-m k (f v))) (sorted-map) m)
(map? m)
(persistent! (reduce-kv (fn [out-m k v] (assoc! out-m k (f v))) (transient {}) m))
:else
(for-map [[k v] m] k (f v))))
(defn map-keys
"Build map (f k) -> v for [k v] in map m"
[f m]
(if (map? m)
(persistent! (reduce-kv (fn [out-m k v] (assoc! out-m (f k) v)) (transient {}) m))
(for-map [[k v] m] (f k) v)))
(defn map-from-keys
"Build map k -> (f k) for keys in ks"
[f ks]
(for-map [k ks] k (f k)))
(defn map-from-vals
"Build map (f v) -> v for vals in vs"
[f vs]
(for-map [v vs] (f v) v))
(defn dissoc-in
"Dissociate this keyseq from m, removing any empty maps created as a result
(including at the top-level)."
[m [k & ks]]
(when m
(if-let [res (and ks (dissoc-in (get m k) ks))]
(assoc m k res)
(let [res (dissoc m k)]
(when-not (empty? res)
res)))))
(defn ^:deprecated keywordize-map
"DEPRECATED. prefer clojure.walk/keywordize-keys.
Recursively convert maps in m (including itself)
to have keyword keys instead of string"
[x]
(cond
(map? x)
(for-map [[k v] x]
(if (string? k) (keyword k) k) (keywordize-map v))
(seq? x)
(map keywordize-map x)
(vector? x)
(mapv keywordize-map x)
:else
x))
(defmacro lazy-get
"Like get but lazy about default"
[m k d]
`(if-let [pair# (find ~m ~k)]
(val pair#)
~d))
(defn safe-get
"Like get but throw an exception if not found"
[m k]
(lazy-get
m k
(schema/assert-iae false "Key %s not found in %s" k
(binding [*print-length* 200]
(print-str (mapv key m))))))
(defn safe-get-in
"Like get-in but throws exception if not found"
[m ks]
(if (seq ks)
(recur (safe-get m (first ks)) (next ks))
m))
(defn assoc-when
"Like assoc but only assocs when value is truthy"
[m & kvs]
(assert (even? (count kvs)))
(into (or m {})
(for [[k v] (partition 2 kvs)
:when v]
[k v])))
(defn update-in-when
"Like update-in but returns m unchanged if key-seq is not present."
[m key-seq f & args]
(let [found (get-in m key-seq +none+)]
(if-not (identical? +none+ found)
(assoc-in m key-seq (apply f found args))
m)))
(defn grouped-map
"Like group-by, but accepts a map-fn that is applied to values before
collected."
[key-fn map-fn coll]
(persistent!
(reduce
(fn [ret x]
(let [k (key-fn x)]
(assoc! ret k (conj (get ret k []) (map-fn x)))))
(transient {}) coll)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Seqs
(defn aconcat
"Like (apply concat s) but lazier (and shorter) "
[s]
(lazy-cat (first s) (when-let [n (next s)] (aconcat n))))
(defn unchunk
"Takes a seqable and returns a lazy sequence that
is maximally lazy and doesn't realize elements due to either
chunking or apply.
Useful when you don't want chunking, for instance,
(first awesome-website? (map slurp +a-bunch-of-urls+))
may slurp up to 31 unneed webpages, wherease
(first awesome-website? (map slurp (unchunk +a-bunch-of-urls+)))
is guaranteed to stop slurping after the first awesome website.
Taken from http://stackoverflow.com/questions/3407876/how-do-i-avoid-clojures-chunking-behavior-for-lazy-seqs-that-i-want-to-short-ci"
[s]
(when (seq s)
(cons (first s)
(lazy-seq (unchunk (rest s))))))
(defn sum
"Return sum of (f x) for each x in xs"
([f xs] (reduce + (map f xs)))
([xs] (reduce + xs)))
(defn singleton
"returns (first xs) when xs has only 1 element"
[xs]
(when-let [xs (seq xs)]
(when-not (next xs)
(first xs))))
(defn indexed
"Returns [idx x] for x in seqable s"
[s]
(map-indexed vector s))
(defn positions
"Returns indices idx of sequence s where (f (nth s idx))"
[f s]
(keep-indexed (fn [i x] (when (f x) i)) s))
#+clj
(defn frequencies-fast
"Like clojure.core/frequencies, but faster.
Uses Java's equal/hash, so may produce incorrect results if
given values that are = but not .equal"
[xs]
(let [res (java.util.HashMap.)]
(doseq [x xs]
(.put res x (unchecked-inc (int (or (.get res x) 0)))))
(into {} res)))
#+clj
(defn distinct-fast
"Like clojure.core/distinct, but faster.
Uses Java's equal/hash, so may produce incorrect results if
given values that are = but not .equal"
[xs]
(let [s (java.util.HashSet.)]
(filter #(when-not (.contains s %) (.add s %) true) xs)))
(defn distinct-by
"Returns elements of xs which return unique
values according to f. If multiple elements of xs return the same
value under f, the first is returned"
[f xs]
(let [s (atom #{})]
(for [x xs
:let [id (f x)]
:when (not (contains? @s id))]
(do (swap! s conj id)
x))))
#+clj
(defn distinct-id
"Like distinct but uses reference rather than value identity, very clojurey"
[xs]
(let [s (java.util.IdentityHashMap.)]
(doseq [x xs]
(.put s x true))
(iterator-seq (.iterator (.keySet s)))))
(defn interleave-all
"Analogy: partition:partition-all :: interleave:interleave-all"
[& colls]
(lazy-seq
((fn helper [seqs]
(when (seq seqs)
(concat (map first seqs)
(lazy-seq (helper (keep next seqs))))))
(keep seq colls))))
(defn count-when
"Returns # of elements of xs where pred holds"
[pred xs]
(count (filter pred xs)))
(defn conj-when
"Like conj but ignores non-truthy values"
([coll x] (if x (conj coll x) coll))
([coll x & xs]
(if xs
(recur (conj-when coll x)
(first xs)
(next xs))
(conj-when coll x))))
(defn cons-when
"Like cons but does nothing if x is non-truthy."
[x s]
(if x (cons x s) s))
(def rsort-by
"Like sort-by, but prefers higher values rather than lower ones."
(comp reverse sort-by))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Control flow
(defmacro ?>>
"Conditional double-arrow operation (->> nums (?>> inc-all? (map inc)))"
[do-it? & args]
`(if ~do-it?
(->> ~(last args) ~@(butlast args))
~(last args)))
(defmacro ?>
"Conditional single-arrow operation (-> m (?> add-kv? (assoc :k :v)))"
[arg do-it? & rest]
`(if ~do-it?
(-> ~arg ~@rest)
~arg))
(defmacro fn->
"Equivalent to `(fn [x] (-> x ~@body))"
[& body]
`(fn [x#] (-> x# ~@body)))
(defmacro fn->>
"Equivalent to `(fn [x] (->> x ~@body))"
[& body]
`(fn [x#] (->> x# ~@body)))
(defmacro <-
"Converts a ->> to a ->
(->> (range 10) (map inc) (<- (doto prn)) (reduce +))
Jason W01fe is happy to give a talk anywhere any time on
the calculus of arrow macros"
[& body]
`(-> ~(last body) ~@(butlast body)))
(defmacro as->>
"Like as->, but can be used in double arrow."
[name & forms-and-expr]
`(as-> ~(last forms-and-expr) ~name ~@(butlast forms-and-expr)))
(defmacro memoized-fn
"Like fn, but memoized (including recursive calls).
The clojure.core memoize correctly caches recursive calls when you do a top-level def
of your memoized function, but if you want an anonymous fibonacci function, you must use
memoized-fn rather than memoize to cache the recursive calls."
[name args & body]
`(let [a# (atom {})]
(fn ~name ~args
(let [m# @a#
args# ~args]
(if-let [[_# v#] (find m# args#)]
v#
(let [v# (do ~@body)]
(swap! a# assoc args# v#)
v#))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Miscellaneous
(defn swap-pair!
"Like swap! but returns a pair [old-val new-val]"
([a f]
(loop []
(let [old-val @a
new-val (f old-val)]
(if (compare-and-set! a old-val new-val)
[old-val new-val]
(recur)))))
([a f & args]
(swap-pair! a #(apply f % args))))
(defn get-and-set!
"Like reset! but returns old-val"
[a new-val]
(first (swap-pair! a (constantly new-val))))
(defn millis ^long []
#+clj (System/currentTimeMillis)
#+cljs (.getTime (js/Date.)))
(defn mapply
"Like apply, but applies a map to a function with positional map
arguments. Can take optional initial args just like apply."
([f m] (apply f (apply concat m)))
([f arg & args] (apply f arg (concat (butlast args) (apply concat (last args))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; fnk
(defmacro letk
"Keyword let. Accepts an interleaved sequence of binding forms and map forms like:
(letk [[a {b 2} [:f g h] c d {e 4} :as m & more] a-map ...] & body)
a, c, d, and f are required keywords, and letk will barf if not in a-map.
b and e are optional, and will be bound to default values if not present.
g and h are required keys in the map found under :f.
m will be bound to the entire map (a-map).
more will be bound to all the unbound keys (ie (dissoc a-map :a :b :c :d :e)).
:as and & are both optional, but must be at the end in the specified order if present.
The same symbol cannot be bound multiple times within the same destructing level.
Optional values can reference symbols bound earlier within the same binding, i.e.,
(= [2 2] (let [a 1] (letk [[a {b a}] {:a 2}] [a b]))) but
(= [2 1] (let [a 1] (letk [[{b a} a] {:a 2}] [a b])))
If present, :as and :& symbols are bound before other symbols within the binding.
Namespaced keys are supported by specifying fully-qualified key in binding form. The bound
symbol uses the _name_ portion of the namespaced key, i.e,
(= 1 (letk [[a/b] {:a/b 1}] b)).
Map destructuring bindings can be mixed with ordinary symbol bindings."
[bindings & body]
(schema/assert-iae (vector? bindings) "Letk binding must be a vector")
(schema/assert-iae (even? (count bindings)) "Letk binding must have even number of elements")
(reduce
(fn [cur-body-form [bind-form value-form]]
(if (symbol? bind-form)
`(let [~bind-form ~value-form] ~cur-body-form)
(let [{:keys [map-sym body-form]} (fnk-impl/letk-input-schema-and-body-form
&env
(fnk-impl/ensure-schema-metadata &env bind-form)
[]
cur-body-form)]
`(let [~map-sym ~value-form] ~body-form))))
`(do ~@body)
(reverse (partition 2 bindings))))
(defmacro if-letk
"bindings => binding-form test
If test is true, evaluates then with binding-form bound to the value of
test, if not, yields else"
([bindings then]
`(if-letk ~bindings ~then nil))
([bindings then else]
(assert (vector? bindings) "if-letk requires a vector for its binding")
(assert (= 2 (count bindings)) "if-letk requires exactly 2 forms in binding vector")
(let [form (bindings 0) tst (bindings 1)]
`(let [temp# ~tst]
(if temp#
(letk [~form temp#]
~then)
~else)))))
(defmacro when-letk
"bindings => binding-form test
When test is true, evaluates body with binding-form bound to the value of test"
[bindings & body]
`(if-letk ~bindings (do ~@body)))
(defmacro fnk
"Keyword fn, using letk. Generates a prismatic/schema schematized fn that
accepts a single explicit map i.e., (f {:foo :bar}).
Explicit top-level map structure will be recorded in output spec, or
to capture implicit structure use an explicit prismatic/schema hint on the
function name.
Individual inputs can also be schematized by putting :- schemas after the
binding symbol. Schemas can also be used on & more symbols to describe
additional map inputs, or on entire [] bindings to override the automatically
generated schema for the contents (caveat emptor).
By default, input schemas allow for arbitrary additional mappings
({s/Keyword s/Any}) unless explicit binding or & more schemas are provided."
[& args]
(let [[name? more-args] (if (symbol? (first args))
(schema-macros/extract-arrow-schematized-element &env args)
[nil args])
[bind body] (schema-macros/extract-arrow-schematized-element &env more-args)]
(fnk-impl/fnk-form &env name? bind body &form)))
(defmacro defnk
"Analogy: fn:fnk :: defn::defnk"
[& defnk-args]
(let [[name args] (schema-macros/extract-arrow-schematized-element &env defnk-args)
take-if (fn [p s] (if (p (first s)) [(first s) (next s)] [nil s]))
[docstring? args] (take-if string? args)
[attr-map? args] (take-if map? args)
[bind body] (schema-macros/extract-arrow-schematized-element &env args)]
(schema/assert-iae (symbol? name) "Name for defnk is not a symbol: %s" name)
(let [f (fnk-impl/fnk-form &env name bind body &form)]
`(def ~(with-meta name (merge (meta name) (assoc-when (or attr-map? {}) :doc docstring?)))
~f))))
#+clj (set! *warn-on-reflection* false)
prismatic-plumbing-clojure-0.5.4/src/plumbing/fnk/ 0000755 0000000 0000000 00000000000 13141156451 0022150 5 ustar 00root root 0000000 0000000 prismatic-plumbing-clojure-0.5.4/src/plumbing/fnk/README.md 0000644 0000000 0000000 00000022351 13141156451 0023432 0 ustar 00root root 0000000 0000000 ## Motivation
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.
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.
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`.
### Background
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.
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.
```clojure
{:n (fnk [xs] (count xs))
:m (fnk [xs n] (/ (sum xs) n))
:m2 (fnk [xs n] (/ (sum #(* % %) xs) n))
:v (fnk [m m2] (- m2 (* m m)))}
```
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`:
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.
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.
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.
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*.
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`.
## Fnk syntax
### (Why not) Clojure's destructuring syntax?
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:
* 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}])`.
* 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.
* Similarly, for default values, `(fn [{:keys [a] :or {a 2}}])` requires repeating argument names.
* 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}])`
This, while one option for Graph would be to just add arglist metadata to Clojure's `fn`, we have instead explored alternative syntax possibilities.
### Our fnk syntax proposal
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:
* Functions take a single map argument, and bare symbols in the top-level binding represent required keys of this map:
```clojure
(defnk foo [x y]
(+ x y))
(= (foo {:x 1 :y 2}) 3)
(thrown? Exception (foo {:x 1})) ;; y is required
```
* Optional keys with defaults are given as maps:
```clojure
(defnk foo [x y {z 10}]
(+ x y z))
(= (foo {:x 1 :y 2)) 13)
(= (foo {:x 1 :y 2 :z 3)) 6)
```
* Nested bindings are introduced with a vector (to match top-level bindings), but begin with the keyword to bind from:
```clojure
(defnk foo [x [:sub c {d 10}]] (+ x c d))
(= (foo {:x 1 :sub {:c 2}}) 13)
```
* `:as` and `&` are allowed in terminal binding positions, with same meaning as ordinary Clojure destructuring:
```clojure
(defnk foo [x & y :as z] [x y z])
(= (foo {:x 10 :y 20}) [10 {:y 20} {:x 10 :y 20}])
````
Advantages:
* Common case of flat required keys with no defaults is as simple as can be
* Nested bindings are as minimal as possible
* Notation is internally consistent: `[]` always indicates map binding, `{}` optional args
* Key name repetition is eliminated for required keys and default values.
Known disadvantages:
* Different from existing Clojure destructuring
* No sequence binding
* Disparity between outer binding and nested bindings (which begin with keyword)
* Renaming a key is a bit verbose -- `[:a :as b]`
### Alternatives
Let's take a simple example that includes most features of the above proposal, and compare with several alternative possibilities:
```clojure
(defnk foo [x {y 1} [:z :as zalt] [:sub c]] ;; above proposal
[x y zalt c])
(= (foo {:x 5 :z 10 :sub {:c 20}}) [5 1 10 20])
```
**Potential alternative 1:** exising Clojure syntax (see above).
```clojure
(defn foo [{x :x y :y zalt :z {c :c} :sub :or {y 1} :as m}] ;; existing syntax
(assert (and (contains? m :x) (contains? (:sub m) :c)))
[x y zalt c])
```
* Advantages: already exists, known to everyone, consistent
* 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.
* 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.
**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.
```clojure
(defnk-2 foo [x [y 1] {zalt :z [c] :sub}] ;; alternative 2
[x y zalt c])
(= (foo {:x 5 :z 10 :sub {:c 20}}) [5 1 10 20])
```
* Advantage: Nested binding completely uniform with top-level (due to extra level of syntax)
* Disadvantage: Each nested binding requires two levels of syntax
* Disadvantage: [] used for two things (map binding and default values)
**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:
```clojure
(defnk-3 foo #{x {y 1} #{:z ^:as zalt} #{:sub c}} ;; alternative 3
[x y zalt c])
```
* Advantage: Set literal for binding conveys un-ordered nature of bindings
* Advangage: Set literal also avoids any possibility for confusion with existing destructuring/`defn`
* Disadvantage: `#{}` is not so pretty
* 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.
## Addendum: underlying metadata representation for `fnk`
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.
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).
For example, `(satisfies-schema? {:x true :y false :z true} {:x 2 :z 1})`.
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.
[Graph]: http://plumatic.github.io/prismatics-graph-at-strange-loop
prismatic-plumbing-clojure-0.5.4/src/plumbing/fnk/impl.clj 0000644 0000000 0000000 00000045270 13141156451 0023613 0 ustar 00root root 0000000 0000000 (ns plumbing.fnk.impl
"Core utilities for parsing our 'fnk'-style binding syntax.
Documented and tested through the actual 'letk','fnk', and 'defnk'
macros in plumbing.core.
The core entry points into this namespace are 'letk*' and 'fnk*',
which parse the new binding syntax and generate fnk bodies,
respectively.
For efficiency, two different methods of generating fnk bodies are
used. If the fnk takes a fixed set of arguments (i.e., no & or
:as), then a 'positional' version of the fnk that is called like an
ordinary Clojure fn (e.g., (f a b) rather than (f {:a a :b b}) is
generated as an implementation detail, and stored in metadata of
the actual keyword fnk (which is just a thin wrapper around the
positional version). If '& or :as are used, no such positional
function is generated.
The advantage of these 'positional' functions is that they can be
accessed using 'efficient-call-forms' or 'positional-fn' to call
the fnk without incurring the overhead of producing and then
destructuring a top-level map. See plumbing.graph.positional for
an example use."
(:require
[clojure.set :as set]
[schema.core :as s]
[schema.macros :as schema-macros]
[plumbing.fnk.schema :as schema]
[plumbing.fnk.pfnk :as pfnk]))
;; TODO: maybe ^:strict metadata to turn off accepting additional keys?
;;; Helpers
(defn name-sym
"Returns symbol of x's name.
Converts a keyword/string to symbol, or removes namespace (if any) of symbol"
[x]
(with-meta (symbol (name x)) (meta x)))
(defn qualified-sym
"Returns qualified symbol of x, an instance of Named"
[x]
(symbol (namespace x) (name x)))
;;; Parsing new fnk binding style
(declare letk-input-schema-and-body-form)
(defn- any-schema? [s]
(= `s/Any s))
(defn- assert-unschematized [x]
(let [schema (schema-macros/extract-schema-form x)]
(schema/assert-iae (any-schema? schema) "Schema metadata not allowed on %s :- %s" x schema)))
(defn ensure-schema-metadata [env x]
(schema-macros/normalized-metadata env x nil))
(defn schema-override [sym schema]
(vary-meta sym assoc :schema schema))
(defn- process-schematized-map
"Take an optional binding map like {a 2} or {a :- Number 2} and convert the schema
information to canonical metadata, if present."
[env binding]
(case (count binding)
1 (let [[sym v] (first binding)]
{(ensure-schema-metadata env sym) v})
2 (let [[[[sym _]] [[schema v]]] ((juxt filter remove) #(= (val %) :-) binding)]
(schema/assert-iae (and (symbol? sym) schema)
"Bad schematized binding %s: should look like {a :- Number 2}" binding)
{(schema-macros/normalized-metadata env sym schema) v})))
;; TODO: unify this with positional version.
(defn letk-arg-bind-sym-and-body-form
"Given a single element of a single letk binding form and a current body form, return
a map {:schema-entry :body-form} where schema-entry is a tuple
[bound-key schema external-schema?], and body-form wraps body with destructuring
for this binding as necessary."
[env map-sym binding key-path body-form]
(cond (symbol? binding)
{:schema-entry [(keyword binding) (schema-macros/extract-schema-form binding)]
:body-form `(let [~(name-sym binding) (schema/safe-get ~map-sym ~(keyword binding) ~key-path)]
~body-form)}
(map? binding)
(let [schema-fixed-binding (process-schematized-map env binding)
[bound-sym opt-val-expr] (first schema-fixed-binding)
bound-key (keyword bound-sym)]
(assert-unschematized binding)
(schema/assert-iae (= 1 (count schema-fixed-binding))
"optional binding has more than 1 entry: %s" schema-fixed-binding)
{:schema-entry [`(with-meta (s/optional-key ~bound-key) {:default '~opt-val-expr}) (schema-macros/extract-schema-form bound-sym)]
:body-form `(let [~(name-sym bound-sym) (get ~map-sym ~bound-key ~opt-val-expr)]
~body-form)})
(vector? binding)
(let [[bound-key & more] binding
{inner-input-schema :input-schema
inner-external-input-schema :external-input-schema
inner-map-sym :map-sym
inner-body-form :body-form} (letk-input-schema-and-body-form
env
(with-meta (vec more) (meta binding))
(conj key-path bound-key)
body-form)]
(schema/assert-iae
(keyword? bound-key)
"First element to nested binding not a keyword: %s" bound-key)
{:schema-entry [bound-key inner-input-schema inner-external-input-schema]
:body-form `(let [~inner-map-sym (schema/safe-get ~map-sym ~bound-key ~key-path)]
~inner-body-form)})
:else (throw (IllegalArgumentException. (format "bad binding: %s" binding)))))
(defn- extract-special-args
"Extract trailing & sym and :as sym, possibly with schema metadata. Returns
[more-bindings special-args-map] where special-args-map is a map from each
special symbol found to the symbol that was found."
[env special-arg-signifier-set binding-form]
{:pre [(set? special-arg-signifier-set)]}
(let [[more-bindings special-bindings] (split-with (complement special-arg-signifier-set) binding-form)]
(loop [special-args-map {}
special-arg-set special-arg-signifier-set
[arg-signifier & other-bindings :as special-bindings] special-bindings]
(if-not (seq special-bindings)
[more-bindings special-args-map]
(do
(schema/assert-iae (special-arg-set arg-signifier) "Got illegal special arg: " arg-signifier)
(let [[sym remaining-bindings] (schema-macros/extract-arrow-schematized-element env other-bindings)]
(schema/assert-iae (symbol? sym) "Argument to %s not a symbol: %s" arg-signifier binding-form)
(recur (assoc special-args-map arg-signifier sym)
(disj special-arg-set arg-signifier)
remaining-bindings)))))))
(defn letk-input-schema-and-body-form
"Given a single letk binding form, value form, key path, and body
form, return a map {:input-schema :external-input-schema :map-sym :body-form}
where input-schema is the schema imposed by binding-form, external-input-schema
is like input-schema but includes user overrides for binding vectors,
map-sym is the symbol which it expects the bound value to be bound to,
and body-form wraps body in the bindings from binding-form from map-sym."
[env binding-form key-path body-form]
(schema/assert-iae (vector? binding-form) "Binding form is not vector: %s" binding-form)
(let [binding-schema (schema-macros/extract-schema-form binding-form)
[bindings {more-sym '& as-sym :as}] (extract-special-args env #{'& :as} binding-form)
as-sym (or as-sym (ensure-schema-metadata env (gensym "map")))
[input-schema-elts
external-input-schema-elts
bound-body-form] (reduce
(fn [[input-schema-elts external-input-schema-elts cur-body] binding]
(let [{:keys [schema-entry body-form]}
(letk-arg-bind-sym-and-body-form
env as-sym binding key-path cur-body)
[bound-key input-schema external-input-schema] schema-entry]
[(conj input-schema-elts [bound-key input-schema])
(conj external-input-schema-elts
[bound-key (or external-input-schema input-schema)])
body-form]))
[[] [] body-form]
(reverse
(schema-macros/process-arrow-schematized-args
env bindings)))
explicit-schema-keys (keep (comp first schema/unwrap-schema-form-key first)
input-schema-elts)
final-body-form (if more-sym
`(let [~more-sym (dissoc ~as-sym ~@explicit-schema-keys)]
~bound-body-form)
bound-body-form)
make-input-schema (fn [elts]
(if-not (or more-sym (seq elts) (empty? key-path))
`s/Any ;; allow [:a :as :b] inner bindings without requiring :a be a map
(merge
(into {} elts)
(let [more-schema (if more-sym
(schema-macros/extract-schema-form more-sym)
`s/Any)]
(if (any-schema? more-schema)
{`s/Keyword `s/Any}
(do (schema/assert-iae (map? more-schema)
"& %s schema must be a map" more-sym)
more-schema))))))]
(when as-sym (assert-unschematized as-sym))
(schema/assert-iae (not (some #{'&} (map first input-schema-elts))) "Cannot bind to &")
(schema/assert-distinct (concat (map name-sym explicit-schema-keys)
(remove nil? [more-sym as-sym])))
{:input-schema (make-input-schema input-schema-elts)
:external-input-schema (if-not (any-schema? binding-schema)
binding-schema
(make-input-schema external-input-schema-elts))
:map-sym as-sym
:body-form final-body-form}))
;;; Positional fnks
(def +none+
"A sentinel value used to indicate a non-provided optional value in a positional form."
::none)
(defn positional-arg-bind-sym-and-body
"Given a single element of a fnk binding form and a current body form, return
a pair [[k bind-sym] new-body-form] where bind-sym is a suitable symbol to bind
to k in the fnk arglist (including tag metadata if applicable) and new-body-form
is wrapped with destructuring for this binding as necessary."
[env binding body-form]
(cond (symbol? binding)
(let [bind-sym (gensym (name binding))]
[[(keyword binding) bind-sym]
`(let [~(name-sym binding) ~bind-sym] ~body-form)])
(map? binding)
(let [[bs ov] (first (process-schematized-map env binding))
bind-sym (gensym (name bs))]
[[(keyword bs) bind-sym]
`(let [~(name-sym bs) (if (identical? +none+ ~bind-sym) ~ov ~bind-sym)]
~body-form)])
(vector? binding)
(let [[k & more] binding
{:keys [map-sym body-form]} (letk-input-schema-and-body-form
env (ensure-schema-metadata env (vec more)) [k]
body-form)]
[[k
(with-meta map-sym
(if (= (last (butlast binding)) :as) (meta (last binding)) {}))]
body-form])
:else (throw (IllegalArgumentException. (format "bad binding: %s" binding)))))
(defn positional-arg-bind-syms-and-body
"Given a fnk binding form and body form, return a pair
[bind-sym-map new-body-form] where bind-sym-map is a map from keyword args
to binding symbols and and new-body-form wraps body to do any extra processing
of nested or optional bindings above and beyond the bindings achieved by
bind-sym-vector."
[env bind body-form]
(reduce
(fn [[cur-bind cur-body] binding]
(let [[bind-sym new-body] (positional-arg-bind-sym-and-body env binding cur-body)]
[(conj cur-bind bind-sym) new-body]))
[{} body-form]
(reverse (schema-macros/process-arrow-schematized-args env bind))))
(defn positional-info
"If fnk has a positional function implementation, return the pair
[positional-fn positional-arg-ks] such that if positional-arg-ks is [:a :b :c],
calling (positional-fn a b c) is equivalent to calling (fnk {:a a :b b :c c}),
but faster. Optional values to fnk can be simulated by passing +none+ as the
value, i.e., (positional-fn +none+ b +none) is like (fnk {:b b})."
[fnk]
(get (meta fnk) ::positional-info))
(defn efficient-call-forms
"Get [f arg-forms] that can be used to call a fnk most efficiently, using the
positional version if available, or otherwise the raw fnk. arg-form-map
is a map from keywords representing arguments to fnk to *forms* that evaluate
to the corresponding arguments.
The basic idea is that (eval (cons f arg-forms)) would yield code for an
efficient call to fnk. However, this form is not returned directly, because
in most cases the literal function f cannot be directly evaluated due to
a quirk in Clojure -- e.g., try (eval `(~(let [x 1] (fn [y] (+ y x))) 2)).
For examples of how this is used, see 'positional-fn' below, or the positional
compilation in plumbing.graph.positional."
[fnk arg-form-map]
(if-let [[positional-f positional-args] (positional-info fnk)]
(do (schema/assert-iae (set/superset? (set (keys arg-form-map))
(set positional-args))
"Trying to call fn that takes args %s with args %s"
positional-args arg-form-map)
[positional-f (map arg-form-map positional-args)])
[fnk [`(into {} (remove #(identical? +none+ (second %)) ~arg-form-map))]]))
(defn positional-fn
"Given argument order in arg-ks, produce an ordinary fn that can be called
with arguments in this order. arg-ks must include all required keys of fnk.
Example: (= ((positional-fn a-fnk [:b :a]) [1 2]) (a-fnk {:a 2 :b 1}))
Can only be applied to fnks with a positional form, and should yield
a function that is significantly faster than calling fnk directly by
avoiding the construction and destructuring of the outer map. Uses 'eval',
so while the produced function is fast, the actual production of the
positional-fn is generally relatively slow."
[fnk arg-ks]
(schema/assert-iae (apply distinct? ::dummy arg-ks)
"Invalid positional args %s contain duplicates" arg-ks)
(schema/assert-iae (positional-info fnk)
"Called positional-fn on a fnk without a positional form")
(let [input-schema (pfnk/input-schema fnk)
[missing-req missing-opt] (schema/split-schema-keys
(apply dissoc (schema/explicit-schema-key-map input-schema)
(set arg-ks)))
extra-args (remove (partial schema/possibly-contains? input-schema) arg-ks)
arg-syms (mapv name-sym arg-ks)
[pos-fn pos-args] (efficient-call-forms
fnk
(merge (zipmap arg-ks arg-syms)
(zipmap missing-opt (repeat +none+))))]
(schema/assert-iae (and (empty? missing-req) (empty? extra-args))
"Invalid positional args %s missing %s, with extra %s"
arg-ks missing-req extra-args)
((eval `(fn [f#] (fn ~arg-syms (f# ~@pos-args))))
pos-fn)))
(defn positional-fnk-form
"Takes an optional name, input schema, seq of ordered [key optional?] pairs,
an arg-sym-map from these keywords to symbols, and and a positional fn body
that can reference these symbols.
Produces a form generating a IFn/PFnk that can be called as a keyword function,
and has metadata containing the positional function for efficient compilation
as described in 'efficient-call-forms' and 'positional-fn' above, with
argument order the same as in input-schema by default. Example:
(def f (eval (i/positional-fnk-form 'foo {:x s/Any (s/optional-key :y) s/Any}
[`(+ ~'x (if (= ~'y i/+none+) 5 ~'y))])))
(= [6 3] [(f {:x 1}) (f {:x 1 :y 2})])
(= [6 3] [((i/positional-fn f [:x]) 1) ((i/positional-fn f [:y :x]) 2 1)])."
[fn-name external-input-schema ordered-ks->opt arg-sym-map body form]
(let [[req-ks opt-ks] (schema/split-schema-keys (into {} ordered-ks->opt))
explicit-schema-keys (mapv first ordered-ks->opt)
pos-args (mapv #(do (schema-macros/assert! (contains? arg-sym-map %))
(arg-sym-map %))
explicit-schema-keys)]
`(let [pos-fn# (fn ~(symbol (str fn-name "-positional"))
~pos-args
~@body)]
(vary-meta
(s/fn
~fn-name
[m# :- ~external-input-schema]
(plumbing.core/letk [~(into (mapv qualified-sym req-ks)
(mapv (fn [k] {(qualified-sym k) +none+}) opt-ks))
m#]
(pos-fn# ~@(mapv name-sym explicit-schema-keys))))
merge
(assoc ~(meta form) ::positional-info [pos-fn# ~explicit-schema-keys])))))
;;; Generating fnk bodies
(defn fnk-form
"Take an optional name, binding form, and body for a fnk, and make an
IFn/PFnk for these arguments.
For efficiency, two different methods of generating fnk bodies are
used. If the fnk takes a fixed set of arguments (i.e., no & or
:as), then a 'positional' version of the fnk that is called like an
ordinary Clojure fn (e.g., (f a b) rather than (f {:a a :b b}) is
generated as an implementation detail, and stored in metadata of
the actual keyword fnk (which is just a thin wrapper around the
positional version). If '& or :as are used, no such positional
function is generated."
[env name? bind body form]
(let [{:keys [map-sym body-form input-schema external-input-schema]}
(letk-input-schema-and-body-form env bind [] `(do ~@body))
explicit-output-schema (if name? (schema-macros/extract-schema-form name?) `s/Any)
output-schema (if (any-schema? explicit-output-schema)
(schema/guess-expr-output-schema (last body))
explicit-output-schema)
fn-name (vary-meta (or name? (gensym "fnk")) assoc :schema output-schema)]
((fn [fn-form]
`(vary-meta ~fn-form assoc :name '~name?))
(if (and (not (schema-macros/cljs-env? env))
(not-any? #{'& :as} bind)) ;; If we can make a positional fnk form, do it.
(let [[bind-sym-map bound-body] (positional-arg-bind-syms-and-body env bind `(do ~@body))]
(positional-fnk-form
fn-name
external-input-schema
(vec (schema/explicit-schema-key-map input-schema))
bind-sym-map
[bound-body]
form))
(with-meta `(s/fn ~fn-name
[~(schema-override map-sym external-input-schema)]
(schema/assert-iae (map? ~map-sym) "fnk called on non-map: %s" ~map-sym)
~body-form)
(meta form))))))
prismatic-plumbing-clojure-0.5.4/src/plumbing/fnk/pfnk.clj 0000644 0000000 0000000 00000004140 13141156451 0023577 0 ustar 00root root 0000000 0000000 (ns plumbing.fnk.pfnk
"Core protocol and helpers for schema.core to extract and attach
input and output schemas to fnks. This protocol says nothing about
how fnks are created, so users are free to create PFnks directly
using fn->fnk, or using custom binding syntax (of which 'fnk' et al
are one possible example)."
(:require
[schema.core :as s :include-macros true]
[plumbing.fnk.schema :as schema :include-macros true]))
(set! *warn-on-reflection* true)
(defprotocol PFnk
"Protocol for keyword functions and their specifications, e.g., fnks and graphs."
(io-schemata [this]
"Return a pair of [input-schema output-schema], as specified in plumbing.fnk.schema."))
(defn input [^schema.core.FnSchema s]
(let [[[is :as args] :as schemas] (.-input-schemas s)]
(schema/assert-iae (= 1 (count schemas)) "Fnks have a single arity, not %s" (count schemas))
(schema/assert-iae (= 1 (count args)) "Fnks take a single argument, not %s" (count args))
(schema/assert-iae (instance? schema.core.One is) "Fnks take a single argument, not variadic")
(let [s (.-schema ^schema.core.One is)]
(schema/assert-iae (map? s) "Fnks take a map argument, not %s" (type s))
s)))
(defn output [^schema.core.FnSchema s]
(.-output-schema s))
(extend-type clojure.lang.Fn
PFnk
(io-schemata [this]
(assert (fn? this))
((juxt input output) (s/fn-schema this))))
(defn input-schema [pfnk]
(first (io-schemata pfnk)))
(defn output-schema [pfnk]
(second (io-schemata pfnk)))
(defn input-schema-keys [f]
(-> f input-schema schema/explicit-schema-key-map keys))
(defn fn->fnk
"Make a keyword function into a PFnk, by associating input and output schema metadata."
([f io] (fn->fnk f nil io))
([f name [input-schema output-schema :as io]]
(vary-meta (s/schematize-fn f (s/=> output-schema input-schema)) assoc :name name)))
(defn fnk-name
"Get the name of a fnk, if named"
[f]
(:name (meta f)))
(set! *warn-on-reflection* false)
;;;;;;;;;;;; This file autogenerated from src/plumbing/fnk/pfnk.cljx
prismatic-plumbing-clojure-0.5.4/src/plumbing/fnk/pfnk.cljx 0000644 0000000 0000000 00000004032 13141156451 0023767 0 ustar 00root root 0000000 0000000 (ns plumbing.fnk.pfnk
"Core protocol and helpers for schema.core to extract and attach
input and output schemas to fnks. This protocol says nothing about
how fnks are created, so users are free to create PFnks directly
using fn->fnk, or using custom binding syntax (of which 'fnk' et al
are one possible example)."
(:require
[schema.core :as s :include-macros true]
[plumbing.fnk.schema :as schema :include-macros true]))
#+clj (set! *warn-on-reflection* true)
(defprotocol PFnk
"Protocol for keyword functions and their specifications, e.g., fnks and graphs."
(io-schemata [this]
"Return a pair of [input-schema output-schema], as specified in plumbing.fnk.schema."))
(defn input [^schema.core.FnSchema s]
(let [[[is :as args] :as schemas] (.-input-schemas s)]
(schema/assert-iae (= 1 (count schemas)) "Fnks have a single arity, not %s" (count schemas))
(schema/assert-iae (= 1 (count args)) "Fnks take a single argument, not %s" (count args))
(schema/assert-iae (instance? schema.core.One is) "Fnks take a single argument, not variadic")
(let [s (.-schema ^schema.core.One is)]
(schema/assert-iae (map? s) "Fnks take a map argument, not %s" (type s))
s)))
(defn output [^schema.core.FnSchema s]
(.-output-schema s))
(extend-type #+clj clojure.lang.Fn #+cljs object
PFnk
(io-schemata [this]
(assert (fn? this))
((juxt input output) (s/fn-schema this))))
(defn input-schema [pfnk]
(first (io-schemata pfnk)))
(defn output-schema [pfnk]
(second (io-schemata pfnk)))
(defn input-schema-keys [f]
(-> f input-schema schema/explicit-schema-key-map keys))
(defn fn->fnk
"Make a keyword function into a PFnk, by associating input and output schema metadata."
([f io] (fn->fnk f nil io))
([f name [input-schema output-schema :as io]]
(vary-meta (s/schematize-fn f (s/=> output-schema input-schema)) assoc :name name)))
(defn fnk-name
"Get the name of a fnk, if named"
[f]
(:name (meta f)))
#+clj (set! *warn-on-reflection* false)
prismatic-plumbing-clojure-0.5.4/src/plumbing/fnk/schema.clj 0000644 0000000 0000000 00000022474 13141156451 0024113 0 ustar 00root root 0000000 0000000 (ns plumbing.fnk.schema
"A very simple type system for a subset of schemas consisting of nested
maps with optional or required keyword keys; used by fnk and kin.
Since schemas are turing-complete and not really designed for type inference,
(and for simplicity) we err on the side of completeness (allowing all legal programs)
at the cost of soundness.
These operations also bake in some logic specific to reasoning about Graphs,
namely that all input keys to a node must be explicitly mentioned as optional or
required, or provided via `instance`, and will thus deliberately drop extra key
schemas on inputs as appropriate. Output schemas may not have optional keys."
(:require
[schema.core :as s :include-macros true]
[schema.utils :as schema-utils]
[schema.macros :as schema-macros])
)
(def Schema (s/protocol s/Schema))
(def InputSchema {(s/cond-pre (s/eq s/Keyword) schema.core.OptionalKey s/Keyword) Schema})
(def OutputSchema Schema)
(def IOSchemata [(s/one InputSchema 'input) (s/one OutputSchema 'output)])
(def GraphInputSchema {(s/cond-pre schema.core.OptionalKey s/Keyword) Schema})
(def MapOutputSchema {s/Keyword Schema})
(def GraphIOSchemata [(s/one GraphInputSchema 'input) (s/one MapOutputSchema 'output)])
;;; Helpers
(defmacro assert-iae
"Like assert, but throws a RuntimeException in Clojure (not an AssertionError),
and also takes args to format."
[form & format-args]
`(schema-macros/assert! ~form ~@format-args))
(defn assert-distinct
"Like (assert (distinct? things)) but with a more helpful error message."
[things]
(let [repeated-things (->> things
frequencies
(filter #(> (val %) 1))
seq)]
(assert-iae (empty? repeated-things) "Got repeated items (expected distinct): %s" repeated-things)))
(defn safe-get
"Like (get m k), but throws if k is not present in m."
[m k key-path]
(assert-iae (map? m)
"Expected a map at key-path %s, got type %s" key-path (schema-utils/type-of m))
(let [[_ v :as p] (find m k)]
(when-not p (throw (ex-info ^String (schema-utils/format* "Key %s not found in %s" k (keys m))
{:error :missing-key
:key k
:map m})))
v))
(defn non-map-union [s1 s2]
(cond (= s1 s2) s1
(= s1 s/Any) s2
(= s2 s/Any) s1
:else s1)) ;; Punt, just take the first
(defn non-map-diff
"Return a difference of schmas s1 and s2, where one is not a map.
Punt for now, assuming s2 always satisfies s1."
[s1 s2]
nil)
(defn map-schema? [m]
(instance? clojure.lang.APersistentMap m)
)
;;; Input schemata
(s/defn unwrap-schema-form-key :- (s/maybe (s/pair s/Keyword "k" s/Bool "optional?"))
"Given a possibly-unevaluated schema map key form, unpack an explicit keyword
and optional? flag, or return nil for a non-explicit key"
[k]
(cond (s/specific-key? k)
[(s/explicit-schema-key k) (s/required-key? k)]
;; Deal with `(s/optional-key k) form from impl
(and (sequential? k) (not (vector? k)) (= (count k) 2)
(= (first k) 'schema.core/optional-key))
[(second k) false]
;; Deal with `(with-meta ...) form from impl
(and (sequential? k) (not (vector? k)) (= (first k) `with-meta))
(unwrap-schema-form-key (second k))))
(s/defn explicit-schema-key-map :- {s/Keyword s/Bool}
"Given a possibly-unevaluated map schema, return a map from bare keyword to true
(for required) or false (for optional)"
[s]
(->> s
keys
(keep unwrap-schema-form-key)
(into {})))
(s/defn split-schema-keys :- [(s/one [s/Keyword] 'required) (s/one [s/Keyword] 'optional)]
"Given output of explicit-schema-key-map, split into seq [req opt]."
[s :- {s/Keyword s/Bool}]
(->> s
((juxt filter remove) val)
(mapv (partial mapv key))))
(defn- merge-on-with
"Like merge-with, but also projects keys to a smaller space and merges them similar to the
values."
[key-project key-combine val-combine & maps]
(->> (apply concat maps)
(reduce
(fn [m [k v]]
(let [pk (key-project k)]
(if-let [[ok ov] (get m pk)]
(assoc m pk [(key-combine ok k) (val-combine ov v)])
(assoc m pk [k v]))))
{})
vals
(into {})))
(s/defn union-input-schemata :- InputSchema
"Returns a minimal input schema schema that entails satisfaction of both s1 and s2"
[i1 :- InputSchema i2 :- InputSchema]
(merge-on-with
#(if (s/specific-key? %) (s/explicit-schema-key %) :extra)
(fn [k1 k2]
(cond (s/required-key? k1) k1
(s/required-key? k2) k2
(s/optional-key? k1) (do (assert (= k1 k2)) k1)
(= k1 k2) k1
:else (assert-iae false "Only one extra schema allowed")))
(fn [s1 s2]
(if (and (map-schema? s1) (map-schema? s2))
(union-input-schemata s1 s2)
(non-map-union s1 s2)))
i1 i2))
(s/defn required-toplevel-keys :- [s/Keyword]
"Which top-level keys are required (i.e., non-false) by this input schema."
[input-schema :- InputSchema]
(keep
(fn [k]
(when (s/required-key? k)
(s/explicit-schema-key k)))
(keys input-schema)))
;;; Output schemata
(defn guess-expr-output-schema
"Guess an output schema for an expr. Currently just looks for literal map structure and
all keyword keys."
[expr]
(if (and (map? expr) (every? keyword? (keys expr)))
(into {} (for [[k v] expr] [k (guess-expr-output-schema v)]))
'schema.core/Any))
;;; Combining inputs and outputs.
(defn schema-diff ;; don't validate since it returns better errors.
"Subtract output-schema from input-schema, returning nil if it's possible that an object
satisfying the output-schema satisfies the input-schema, or otherwise a description
of the part(s) of input-schema not met by output-schema. Strict about the map structure
of output-schema matching input-schema, but loose about everything else (only looks at
required keys of output-schema."
[input-schema output-schema] ;; not schematized since it returns more helpful errors
(cond (not (map-schema? input-schema))
(non-map-diff input-schema output-schema)
(not (map-schema? output-schema))
(schema-macros/validation-error input-schema output-schema (list 'map? (s/explain output-schema)))
:else
(->> (for [[k v] input-schema
:when (s/specific-key? k)
:let [required? (s/required-key? k)
raw-k (s/explicit-schema-key k)
present? (contains? output-schema raw-k)]
:when (or required? present?)
:let [fail (if-not present?
'missing-required-key
(schema-diff v (get output-schema raw-k)))]
:when fail]
[k fail])
(into {})
not-empty)))
(defn assert-satisfies-schema [input-schema output-schema]
(let [fails (schema-diff input-schema output-schema)]
(when fails (throw (ex-info (str fails) {:error :does-not-satisfy-schema
:failures fails})))))
(s/defn ^:always-validate compose-schemata
"Given pairs of input and output schemata for fnks f1 and f2,
return a pair of input and output schemata for #(f2 (merge % (f1 %))).
f1's output schema must not contain any optional keys."
[[i2 o2] :- IOSchemata
[i1 o1] :- [(s/one InputSchema 'input) (s/one MapOutputSchema 'output)]]
(assert-satisfies-schema (select-keys i2 (keys o1)) o1)
[(union-input-schemata (apply dissoc i2 (concat (keys o1) (map s/optional-key (keys o1)))) i1)
o2])
(defn schema-key [m k]
(cond (contains? m k)
k
(contains? m (s/optional-key k))
(s/optional-key k)
:else nil))
(defn possibly-contains? [m k]
(boolean (schema-key m k)))
(s/defn split-schema
"Return a pair [ks-part non-ks-part], with any extra schema removed."
[s :- InputSchema ks :- [s/Keyword]]
(let [ks (set ks)]
(for [in? [true false]]
(into {} (for [[k v] s
:when (and (s/specific-key? k)
(= in? (contains? ks (s/explicit-schema-key k))))]
[k v])))))
(s/defn sequence-schemata :- GraphIOSchemata
"Given pairs of input and output schemata for fnks f1 and f2, and a keyword k,
return a pair of input and output schemata for #(let [v1 (f1 %)] (assoc v1 k (f2 (merge-disjoint % v1))))"
[[i1 o1] :- GraphIOSchemata
[k [i2 o2]] :- [(s/one s/Keyword "key") (s/one IOSchemata "inner-schemas")]]
(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))
(assert-iae (not (possibly-contains? o1 k)) "Node outputs a duplicate key %s given inputs %s" k (s/explain i1))
(let [[used unused] (split-schema i2 (keys o1))]
(assert-satisfies-schema used o1)
[(union-input-schemata unused i1)
(assoc o1 k o2)]))
;;;;;;;;;;;; This file autogenerated from src/plumbing/fnk/schema.cljx
prismatic-plumbing-clojure-0.5.4/src/plumbing/fnk/schema.cljx 0000644 0000000 0000000 00000022364 13141156451 0024301 0 ustar 00root root 0000000 0000000 (ns plumbing.fnk.schema
"A very simple type system for a subset of schemas consisting of nested
maps with optional or required keyword keys; used by fnk and kin.
Since schemas are turing-complete and not really designed for type inference,
(and for simplicity) we err on the side of completeness (allowing all legal programs)
at the cost of soundness.
These operations also bake in some logic specific to reasoning about Graphs,
namely that all input keys to a node must be explicitly mentioned as optional or
required, or provided via `instance`, and will thus deliberately drop extra key
schemas on inputs as appropriate. Output schemas may not have optional keys."
(:require
[schema.core :as s :include-macros true]
[schema.utils :as schema-utils]
#+clj [schema.macros :as schema-macros])
#+cljs
(:require-macros
#+cljs [schema.macros :as schema-macros]
[plumbing.fnk.schema :refer [assert-iae]]))
(def Schema (s/protocol s/Schema))
(def InputSchema {(s/cond-pre (s/eq s/Keyword) schema.core.OptionalKey s/Keyword) Schema})
(def OutputSchema Schema)
(def IOSchemata [(s/one InputSchema 'input) (s/one OutputSchema 'output)])
(def GraphInputSchema {(s/cond-pre schema.core.OptionalKey s/Keyword) Schema})
(def MapOutputSchema {s/Keyword Schema})
(def GraphIOSchemata [(s/one GraphInputSchema 'input) (s/one MapOutputSchema 'output)])
;;; Helpers
(defmacro assert-iae
"Like assert, but throws a RuntimeException in Clojure (not an AssertionError),
and also takes args to format."
[form & format-args]
`(schema-macros/assert! ~form ~@format-args))
(defn assert-distinct
"Like (assert (distinct? things)) but with a more helpful error message."
[things]
(let [repeated-things (->> things
frequencies
(filter #(> (val %) 1))
seq)]
(assert-iae (empty? repeated-things) "Got repeated items (expected distinct): %s" repeated-things)))
(defn safe-get
"Like (get m k), but throws if k is not present in m."
[m k key-path]
(assert-iae (map? m)
"Expected a map at key-path %s, got type %s" key-path (schema-utils/type-of m))
(let [[_ v :as p] (find m k)]
(when-not p (throw (ex-info ^String (schema-utils/format* "Key %s not found in %s" k (keys m))
{:error :missing-key
:key k
:map m})))
v))
(defn non-map-union [s1 s2]
(cond (= s1 s2) s1
(= s1 s/Any) s2
(= s2 s/Any) s1
:else s1)) ;; Punt, just take the first
(defn non-map-diff
"Return a difference of schmas s1 and s2, where one is not a map.
Punt for now, assuming s2 always satisfies s1."
[s1 s2]
nil)
(defn map-schema? [m]
#+clj (instance? clojure.lang.APersistentMap m)
#+cljs (or (instance? cljs.core.PersistentArrayMap m)
(instance? cljs.core.PersistentHashMap m)))
;;; Input schemata
(s/defn unwrap-schema-form-key :- (s/maybe (s/pair s/Keyword "k" s/Bool "optional?"))
"Given a possibly-unevaluated schema map key form, unpack an explicit keyword
and optional? flag, or return nil for a non-explicit key"
[k]
(cond (s/specific-key? k)
[(s/explicit-schema-key k) (s/required-key? k)]
;; Deal with `(s/optional-key k) form from impl
(and (sequential? k) (not (vector? k)) (= (count k) 2)
(= (first k) 'schema.core/optional-key))
[(second k) false]
;; Deal with `(with-meta ...) form from impl
(and (sequential? k) (not (vector? k)) (= (first k) `with-meta))
(unwrap-schema-form-key (second k))))
(s/defn explicit-schema-key-map :- {s/Keyword s/Bool}
"Given a possibly-unevaluated map schema, return a map from bare keyword to true
(for required) or false (for optional)"
[s]
(->> s
keys
(keep unwrap-schema-form-key)
(into {})))
(s/defn split-schema-keys :- [(s/one [s/Keyword] 'required) (s/one [s/Keyword] 'optional)]
"Given output of explicit-schema-key-map, split into seq [req opt]."
[s :- {s/Keyword s/Bool}]
(->> s
((juxt filter remove) val)
(mapv (partial mapv key))))
(defn- merge-on-with
"Like merge-with, but also projects keys to a smaller space and merges them similar to the
values."
[key-project key-combine val-combine & maps]
(->> (apply concat maps)
(reduce
(fn [m [k v]]
(let [pk (key-project k)]
(if-let [[ok ov] (get m pk)]
(assoc m pk [(key-combine ok k) (val-combine ov v)])
(assoc m pk [k v]))))
{})
vals
(into {})))
(s/defn union-input-schemata :- InputSchema
"Returns a minimal input schema schema that entails satisfaction of both s1 and s2"
[i1 :- InputSchema i2 :- InputSchema]
(merge-on-with
#(if (s/specific-key? %) (s/explicit-schema-key %) :extra)
(fn [k1 k2]
(cond (s/required-key? k1) k1
(s/required-key? k2) k2
(s/optional-key? k1) (do (assert (= k1 k2)) k1)
(= k1 k2) k1
:else (assert-iae false "Only one extra schema allowed")))
(fn [s1 s2]
(if (and (map-schema? s1) (map-schema? s2))
(union-input-schemata s1 s2)
(non-map-union s1 s2)))
i1 i2))
(s/defn required-toplevel-keys :- [s/Keyword]
"Which top-level keys are required (i.e., non-false) by this input schema."
[input-schema :- InputSchema]
(keep
(fn [k]
(when (s/required-key? k)
(s/explicit-schema-key k)))
(keys input-schema)))
;;; Output schemata
(defn guess-expr-output-schema
"Guess an output schema for an expr. Currently just looks for literal map structure and
all keyword keys."
[expr]
(if (and (map? expr) (every? keyword? (keys expr)))
(into {} (for [[k v] expr] [k (guess-expr-output-schema v)]))
'schema.core/Any))
;;; Combining inputs and outputs.
(defn schema-diff ;; don't validate since it returns better errors.
"Subtract output-schema from input-schema, returning nil if it's possible that an object
satisfying the output-schema satisfies the input-schema, or otherwise a description
of the part(s) of input-schema not met by output-schema. Strict about the map structure
of output-schema matching input-schema, but loose about everything else (only looks at
required keys of output-schema."
[input-schema output-schema] ;; not schematized since it returns more helpful errors
(cond (not (map-schema? input-schema))
(non-map-diff input-schema output-schema)
(not (map-schema? output-schema))
(schema-macros/validation-error input-schema output-schema (list 'map? (s/explain output-schema)))
:else
(->> (for [[k v] input-schema
:when (s/specific-key? k)
:let [required? (s/required-key? k)
raw-k (s/explicit-schema-key k)
present? (contains? output-schema raw-k)]
:when (or required? present?)
:let [fail (if-not present?
'missing-required-key
(schema-diff v (get output-schema raw-k)))]
:when fail]
[k fail])
(into {})
not-empty)))
(defn assert-satisfies-schema [input-schema output-schema]
(let [fails (schema-diff input-schema output-schema)]
(when fails (throw (ex-info (str fails) {:error :does-not-satisfy-schema
:failures fails})))))
(s/defn ^:always-validate compose-schemata
"Given pairs of input and output schemata for fnks f1 and f2,
return a pair of input and output schemata for #(f2 (merge % (f1 %))).
f1's output schema must not contain any optional keys."
[[i2 o2] :- IOSchemata
[i1 o1] :- [(s/one InputSchema 'input) (s/one MapOutputSchema 'output)]]
(assert-satisfies-schema (select-keys i2 (keys o1)) o1)
[(union-input-schemata (apply dissoc i2 (concat (keys o1) (map s/optional-key (keys o1)))) i1)
o2])
(defn schema-key [m k]
(cond (contains? m k)
k
(contains? m (s/optional-key k))
(s/optional-key k)
:else nil))
(defn possibly-contains? [m k]
(boolean (schema-key m k)))
(s/defn split-schema
"Return a pair [ks-part non-ks-part], with any extra schema removed."
[s :- InputSchema ks :- [s/Keyword]]
(let [ks (set ks)]
(for [in? [true false]]
(into {} (for [[k v] s
:when (and (s/specific-key? k)
(= in? (contains? ks (s/explicit-schema-key k))))]
[k v])))))
(s/defn sequence-schemata :- GraphIOSchemata
"Given pairs of input and output schemata for fnks f1 and f2, and a keyword k,
return a pair of input and output schemata for #(let [v1 (f1 %)] (assoc v1 k (f2 (merge-disjoint % v1))))"
[[i1 o1] :- GraphIOSchemata
[k [i2 o2]] :- [(s/one s/Keyword "key") (s/one IOSchemata "inner-schemas")]]
(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))
(assert-iae (not (possibly-contains? o1 k)) "Node outputs a duplicate key %s given inputs %s" k (s/explain i1))
(let [[used unused] (split-schema i2 (keys o1))]
(assert-satisfies-schema used o1)
[(union-input-schemata unused i1)
(assoc o1 k o2)]))
prismatic-plumbing-clojure-0.5.4/src/plumbing/graph.clj 0000644 0000000 0000000 00000032427 13141156451 0023175 0 ustar 00root root 0000000 0000000 (ns plumbing.graph
"A Graph is a simple, declarative way to define a composition of functions that is
easy to define, modify, execute, test, and monitor.
This blog post provides a high-level overview of Graph and its benefits:
http://plumatic.github.io/prismatics-graph-at-strange-loop
Concretely, a Graph specification is just a Clojure (nested) map with keyword keys
and keyword functions at the leaves.
A Graph is defined recursively as either:
1. a keyword function (i.e., fn satisfying PFnk), or
2. a Clojure map from keywords to (sub)graphs.
A Graph is a declarative specification of a single keyword function that
produces a map output, where each value in the output is produced by executing
the corresponding keyword function in the Graph. The inputs to the keyword
function are given by the outputs of other nodes in the graph with matching
keywords (mimicking lexical scope in the case of nested maps), or failing that,
from keywords in the input map.
For more details and examples of Graphs, see test/plumbing/graph_examples_test.cljx."
(:refer-clojure :exclude [compile])
(:require
[lazymap.core :as lazymap]
[schema.core :as s]
[schema.macros :as schema-macros]
[plumbing.fnk.schema :as schema :include-macros true]
[plumbing.fnk.pfnk :as pfnk]
[plumbing.fnk.impl :as fnk-impl]
[plumbing.graph.positional :as graph-positional]
[plumbing.core :as plumbing :include-macros true]
[plumbing.map :as map])
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Constructing graphs
(defn working-array-map
"array-map in cljs no longer preserves ordering, replicate the old functionality."
[& args]
(schema-macros/if-cljs
(.fromArray cljs.core/PersistentArrayMap (apply array args) true true)
(apply array-map args)))
(defn ->graph
"Convert a graph specification into a canonical well-formed 'graph', which
is an array-map with nodes in a correct topological order that will respond
to 'io-schemata' with a specification of the graph inputs and outputs.
The graph specification can be a Clojure map, in which case the topological
order will be computed (an error will be thrown for cyclic specifications),
or a sequence of key-value pairs that are already in a valid topological order
(an error will be thrown if the order is not valid). Values in the input
sequence are also converted to canonical graphs via recursive calls to ->graph."
[graph-nodes]
(if (or (fn? graph-nodes) (= graph-nodes (::self (meta graph-nodes))))
graph-nodes
(let [canonical-nodes (plumbing/map-vals ->graph graph-nodes)
graph (->> (if-not (map? graph-nodes)
(map first graph-nodes)
(->> canonical-nodes
(plumbing/map-vals pfnk/input-schema-keys)
map/topological-sort
reverse))
(mapcat #(find canonical-nodes %))
(apply working-array-map))]
(assert (every? keyword? (keys graph)))
(with-meta graph
{::io-schemata (update-in (reduce schema/sequence-schemata
[{} {}]
(for [[k node] graph]
[k (pfnk/io-schemata node)]))
[0] assoc s/Keyword s/Any)
::self graph}))))
;; Any Clojure map can be treated as a graph directly, without calling ->graph
(defn io-schemata* [g]
(plumbing/safe-get (meta (->graph g)) ::io-schemata))
(extend-protocol pfnk/PFnk
clojure.lang.IPersistentMap
(io-schemata [g] (io-schemata* g))
(io-schemata [g] (io-schemata* g)))
(defn- split-nodes [s]
(loop [in s out []]
(if-let [[f & r] (seq in)]
(cond (keyword? f) ;; key then value
(recur (next r) (conj out [f (first r)]))
(fn? f)
(do (schema/assert-iae (pfnk/fnk-name f) "Inline fnks must have a name (to be used as a key)")
(recur r (conj out [(keyword (pfnk/fnk-name f)) f])))
:else ;; inline graph
(recur r (into out f)))
out)))
(defn graph
"An ordered constructor for graphs, which enforces that the Graph is provided
in a valid topological ordering. This is a sanity check, and also enforces
defining graphs in a readable way. Most explicit graphs should be created
with this constructor.
(graph
:x-plus-1 (fnk [x] (inc x))
:2-x-plus-2 (fnk [x-plus-1] (* 2 x-plus-1)))
in addition, an 'inline' graph can be provided in place of a key-value
sequence, which will be merged into the graph at this position.
a named fnk can also be provided in place of a key-value pair,
where the fnk's name (as a keyword) is the implicit key."
[& nodes]
(let [partitioned (split-nodes nodes)]
(schema/assert-distinct (map first partitioned))
(->graph partitioned)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compiling and running graphs
(defn eager-compile
"Compile graph specification g to a corresponding fnk that is optimized for
speed. Wherever possible, fnks are called positionally, to reduce the
overhead of creating and destructuring maps, and the return value is a
record, which is much faster to create and access than a map. Compilation
is relatively slow, however, due to internal calls to 'eval'."
[g]
(if (fn? g)
g
(let [g (for [[k sub-g] (->graph g)]
[k (eager-compile sub-g)])]
(graph-positional/positional-flat-compile (->graph g)))))
(defn positional-eager-compile
"Like eager-compile, but produce a non-keyword function that can be called
with args in the order provided by arg-ks, avoiding the overhead of creating
and destructuring a top-level map. This can yield a substantially faster
fn for Graphs with very computationally inexpensive node fnks."
[g arg-ks]
(fnk-impl/positional-fn (eager-compile g) arg-ks))
(defn simple-flat-compile
"Helper method for simple (non-nested) graph compilations that convert a graph
specification to a fnk that returns a Clojure map of the graph node values.
(make-map m) converts an initial Clojure map m to the return type of the fnk,
and (assoc-f m k f) associates the value given by (f) under key k to map m."
[g check-input? make-map assoc-f]
(let [g (->graph g)
req-ks (schema/required-toplevel-keys (pfnk/input-schema g))]
(pfnk/fn->fnk
(fn [m]
(when check-input?
(let [missing-keys (seq (remove #(contains? m %) req-ks))]
(schema/assert-iae (empty? missing-keys)
"Missing top-level keys in graph input: %s"
(set missing-keys))))
(apply
dissoc
(reduce
(fn [inner [k node-f]]
(schema/assert-iae (not (contains? inner k))
"Inner graph key %s duplicated" k)
(assoc-f inner k node-f))
(make-map m)
g)
(keys m)))
(pfnk/io-schemata g))))
(defn simple-hierarchical-compile
"Hierarchical extension of simple-nonhierarchical-compile."
[g check-input? make-map assoc-f]
(if (fn? g)
g
(simple-flat-compile
(for [[k sub-g] (->graph g)]
[k (simple-hierarchical-compile sub-g check-input? make-map assoc-f)])
check-input? make-map assoc-f)))
(defn restricted-call
"Call fnk f on the subset of keys its input schema explicitly asks for"
[f in-m]
(f (select-keys in-m (pfnk/input-schema-keys f))))
(defn interpreted-eager-compile
"Compile graph specification g to a corresponding fnk that returns an
ordinary Clojure map of the node result fns on a given input. The
compilation is much faster than 'eager-compile', but the compiled fn
will typically be much slower."
[g]
(simple-hierarchical-compile
g
true
(fn [m] m)
(fn [m k f] (assoc m k (restricted-call f m)))))
(defn lazy-compile
"Compile graph specification g to a corresponding fnk that returns a
lazymap of the node result fns on a given input. This fnk returns
the lazymap immediately, and node values are computed and cached as needed
as values are extracted from the lazymap. Besides this lazy behavior,
the lazymap can be used interchangeably with an ordinary Clojure map.
Required inputs to the graph are checked lazily, so you can omit input
keys not required by unneeded output keys."
[g]
(simple-hierarchical-compile
g
false
(fn [m] (reduce-kv assoc (lazymap/lazy-hash-map) m)) ;; into is extremely slow on lazymaps.
(fn [m k f] (lazymap/delay-assoc m k (delay (restricted-call f m))))))
;; TODO: move out.
(defn par-compile
"Experimental. Launches one future per node at startup; we probably woudln't
use this in production, and will release more sophisticated parallel
compilations later.
Compile graph specification g to a corresponding fnk that returns a
lazymap of the node result fns on a given input. This fnk returns
the lazymap immediately, and node values are computed and cached in parallel
starting immediately (and attempts to extract values from the lazymap will
block until each value is computed). Besides this lazy behavior,
the lazymap can be used interchangeably with an ordinary Clojure map."
[g]
(simple-hierarchical-compile
g
true
(fn [m] (into (lazymap/lazy-hash-map) m))
(fn [m k f] (lazymap/delay-assoc m k (future (restricted-call f m))))))
(defn compile
"Compile graph specification g to a corresponding fnk using the a default
compile strategy for host.
Clojure: eager-compile
ClojureScript: interpreted-eager-compile"
[g]
(eager-compile g)
)
(defn run
"Eagerly run a graph on an input by compiling and then executing on this input."
[g input]
((interpreted-eager-compile g) input))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Higher-order functions on graphs
(defn check-comp-partial!
"Check that instance-fn is a valid fn to comp-partial with graph g."
[g instance-fn]
(let [is (pfnk/input-schema g)
os (pfnk/output-schema instance-fn)]
(schema/assert-iae (map? os) "instance-fn must have output metadata")
(let [extra-ks (remove #(schema/possibly-contains? is %) (keys os))]
(schema/assert-iae (empty? extra-ks) "instance-fn provides unused keys: %s" (vec extra-ks)))
(doseq [[k s] os]
(schema/assert-satisfies-schema (or (get is k) (get is (s/optional-key k))) s))))
(defn comp-partial-fn
"Return a new pfnk representing the composition #(f (merge % (other %)))"
[f other]
(pfnk/fn->fnk
(fn [m] (f (merge m (other m))))
(schema/compose-schemata (pfnk/io-schemata f) (pfnk/io-schemata other))))
(defn comp-partial
"Experimental.
An extension of pfnk/comp-partial that supplies new parameters to a subgraph,
useful in composing hierarchical graphs.
g is a graph, and instance-fn is a fnk that takes arguments from the surrounding
context and produces new parameters that are fed into g. Works by comp-partialing
all leafs that expects any parameter produced by instance-fn with instance-fn,
so beware of expensive instance-fns, or those that expect caching of some sort
(i.e., attempt to generate shared state).
Throws an error if any parameter supplied by instance-fn is not used by at least
one node in g."
[g instance-fn]
(if (fn? g)
(comp-partial-fn g instance-fn)
(let [os (pfnk/output-schema instance-fn)]
(check-comp-partial! g instance-fn)
(->graph
(map/map-leaves
(fn [node-fn]
(if (some os (pfnk/input-schema-keys node-fn))
(comp-partial-fn node-fn instance-fn)
node-fn))
g)))))
(defmacro instance
"Experimental.
Convenience macro for comp-partial, used to supply inline parameters to a
subgraph (or fnk).
Example:
(= {:x 21}
(run (instance {:x (fnk [a] (inc a))} [z] {:a (* z 2)})
{:z 10}))"
([g m] `(instance ~g [] ~m))
([g bind m]
`(comp-partial ~g (plumbing/fnk ~bind ~m))))
(defn profiled
"Modify graph spec g, producing a new graph spec with a new top-level key
'profile-key'. After each node value is computed, the number of milliseconds
taken to compute its value will be stored under an atom at 'profile-key'."
[profile-key g]
(assert (and (keyword? profile-key) (not (get g profile-key))))
(->graph
(assoc (map/map-leaves-and-path
(fn [ks f]
(pfnk/fn->fnk
(fn [m]
(let [pm (plumbing/safe-get m profile-key)
start (System/nanoTime)
res (f (dissoc m profile-key))]
(swap! pm assoc-in ks
(/ (- (System/nanoTime) start) 1000000.0)
)
res))
[(assoc (pfnk/input-schema f)
profile-key s/Any)
(pfnk/output-schema f)]))
(->graph g))
profile-key (plumbing/fnk [] (atom {})))))
;;;;;;;;;;;; This file autogenerated from src/plumbing/graph.cljx
prismatic-plumbing-clojure-0.5.4/src/plumbing/graph.cljx 0000644 0000000 0000000 00000032324 13141156451 0023361 0 ustar 00root root 0000000 0000000 (ns plumbing.graph
"A Graph is a simple, declarative way to define a composition of functions that is
easy to define, modify, execute, test, and monitor.
This blog post provides a high-level overview of Graph and its benefits:
http://plumatic.github.io/prismatics-graph-at-strange-loop
Concretely, a Graph specification is just a Clojure (nested) map with keyword keys
and keyword functions at the leaves.
A Graph is defined recursively as either:
1. a keyword function (i.e., fn satisfying PFnk), or
2. a Clojure map from keywords to (sub)graphs.
A Graph is a declarative specification of a single keyword function that
produces a map output, where each value in the output is produced by executing
the corresponding keyword function in the Graph. The inputs to the keyword
function are given by the outputs of other nodes in the graph with matching
keywords (mimicking lexical scope in the case of nested maps), or failing that,
from keywords in the input map.
For more details and examples of Graphs, see test/plumbing/graph_examples_test.cljx."
(:refer-clojure :exclude [compile])
(:require
#+clj [lazymap.core :as lazymap]
[schema.core :as s]
#+clj [schema.macros :as schema-macros]
[plumbing.fnk.schema :as schema :include-macros true]
[plumbing.fnk.pfnk :as pfnk]
#+clj [plumbing.fnk.impl :as fnk-impl]
#+clj [plumbing.graph.positional :as graph-positional]
[plumbing.core :as plumbing :include-macros true]
[plumbing.map :as map])
#+cljs (:require-macros [schema.macros :as schema-macros]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Constructing graphs
(defn working-array-map
"array-map in cljs no longer preserves ordering, replicate the old functionality."
[& args]
(schema-macros/if-cljs
(.fromArray cljs.core/PersistentArrayMap (apply array args) true true)
(apply array-map args)))
(defn ->graph
"Convert a graph specification into a canonical well-formed 'graph', which
is an array-map with nodes in a correct topological order that will respond
to 'io-schemata' with a specification of the graph inputs and outputs.
The graph specification can be a Clojure map, in which case the topological
order will be computed (an error will be thrown for cyclic specifications),
or a sequence of key-value pairs that are already in a valid topological order
(an error will be thrown if the order is not valid). Values in the input
sequence are also converted to canonical graphs via recursive calls to ->graph."
[graph-nodes]
(if (or (fn? graph-nodes) (= graph-nodes (::self (meta graph-nodes))))
graph-nodes
(let [canonical-nodes (plumbing/map-vals ->graph graph-nodes)
graph (->> (if-not (map? graph-nodes)
(map first graph-nodes)
(->> canonical-nodes
(plumbing/map-vals pfnk/input-schema-keys)
map/topological-sort
reverse))
(mapcat #(find canonical-nodes %))
(apply working-array-map))]
(assert (every? keyword? (keys graph)))
(with-meta graph
{::io-schemata (update-in (reduce schema/sequence-schemata
[{} {}]
(for [[k node] graph]
[k (pfnk/io-schemata node)]))
[0] assoc s/Keyword s/Any)
::self graph}))))
;; Any Clojure map can be treated as a graph directly, without calling ->graph
(defn io-schemata* [g]
(plumbing/safe-get (meta (->graph g)) ::io-schemata))
(extend-protocol pfnk/PFnk
#+clj clojure.lang.IPersistentMap
#+cljs cljs.core.PersistentArrayMap
(io-schemata [g] (io-schemata* g))
#+cljs cljs.core.PersistentHashMap
(io-schemata [g] (io-schemata* g)))
(defn- split-nodes [s]
(loop [in s out []]
(if-let [[f & r] (seq in)]
(cond (keyword? f) ;; key then value
(recur (next r) (conj out [f (first r)]))
(fn? f)
(do (schema/assert-iae (pfnk/fnk-name f) "Inline fnks must have a name (to be used as a key)")
(recur r (conj out [(keyword (pfnk/fnk-name f)) f])))
:else ;; inline graph
(recur r (into out f)))
out)))
(defn graph
"An ordered constructor for graphs, which enforces that the Graph is provided
in a valid topological ordering. This is a sanity check, and also enforces
defining graphs in a readable way. Most explicit graphs should be created
with this constructor.
(graph
:x-plus-1 (fnk [x] (inc x))
:2-x-plus-2 (fnk [x-plus-1] (* 2 x-plus-1)))
in addition, an 'inline' graph can be provided in place of a key-value
sequence, which will be merged into the graph at this position.
a named fnk can also be provided in place of a key-value pair,
where the fnk's name (as a keyword) is the implicit key."
[& nodes]
(let [partitioned (split-nodes nodes)]
(schema/assert-distinct (map first partitioned))
(->graph partitioned)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compiling and running graphs
#+clj
(defn eager-compile
"Compile graph specification g to a corresponding fnk that is optimized for
speed. Wherever possible, fnks are called positionally, to reduce the
overhead of creating and destructuring maps, and the return value is a
record, which is much faster to create and access than a map. Compilation
is relatively slow, however, due to internal calls to 'eval'."
[g]
(if (fn? g)
g
(let [g (for [[k sub-g] (->graph g)]
[k (eager-compile sub-g)])]
(graph-positional/positional-flat-compile (->graph g)))))
#+clj
(defn positional-eager-compile
"Like eager-compile, but produce a non-keyword function that can be called
with args in the order provided by arg-ks, avoiding the overhead of creating
and destructuring a top-level map. This can yield a substantially faster
fn for Graphs with very computationally inexpensive node fnks."
[g arg-ks]
(fnk-impl/positional-fn (eager-compile g) arg-ks))
(defn simple-flat-compile
"Helper method for simple (non-nested) graph compilations that convert a graph
specification to a fnk that returns a Clojure map of the graph node values.
(make-map m) converts an initial Clojure map m to the return type of the fnk,
and (assoc-f m k f) associates the value given by (f) under key k to map m."
[g check-input? make-map assoc-f]
(let [g (->graph g)
req-ks (schema/required-toplevel-keys (pfnk/input-schema g))]
(pfnk/fn->fnk
(fn [m]
(when check-input?
(let [missing-keys (seq (remove #(contains? m %) req-ks))]
(schema/assert-iae (empty? missing-keys)
"Missing top-level keys in graph input: %s"
(set missing-keys))))
(apply
dissoc
(reduce
(fn [inner [k node-f]]
(schema/assert-iae (not (contains? inner k))
"Inner graph key %s duplicated" k)
(assoc-f inner k node-f))
(make-map m)
g)
(keys m)))
(pfnk/io-schemata g))))
(defn simple-hierarchical-compile
"Hierarchical extension of simple-nonhierarchical-compile."
[g check-input? make-map assoc-f]
(if (fn? g)
g
(simple-flat-compile
(for [[k sub-g] (->graph g)]
[k (simple-hierarchical-compile sub-g check-input? make-map assoc-f)])
check-input? make-map assoc-f)))
(defn restricted-call
"Call fnk f on the subset of keys its input schema explicitly asks for"
[f in-m]
(f (select-keys in-m (pfnk/input-schema-keys f))))
(defn interpreted-eager-compile
"Compile graph specification g to a corresponding fnk that returns an
ordinary Clojure map of the node result fns on a given input. The
compilation is much faster than 'eager-compile', but the compiled fn
will typically be much slower."
[g]
(simple-hierarchical-compile
g
true
(fn [m] m)
(fn [m k f] (assoc m k (restricted-call f m)))))
#+clj
(defn lazy-compile
"Compile graph specification g to a corresponding fnk that returns a
lazymap of the node result fns on a given input. This fnk returns
the lazymap immediately, and node values are computed and cached as needed
as values are extracted from the lazymap. Besides this lazy behavior,
the lazymap can be used interchangeably with an ordinary Clojure map.
Required inputs to the graph are checked lazily, so you can omit input
keys not required by unneeded output keys."
[g]
(simple-hierarchical-compile
g
false
(fn [m] (reduce-kv assoc (lazymap/lazy-hash-map) m)) ;; into is extremely slow on lazymaps.
(fn [m k f] (lazymap/delay-assoc m k (delay (restricted-call f m))))))
#+clj ;; TODO: move out.
(defn par-compile
"Experimental. Launches one future per node at startup; we probably woudln't
use this in production, and will release more sophisticated parallel
compilations later.
Compile graph specification g to a corresponding fnk that returns a
lazymap of the node result fns on a given input. This fnk returns
the lazymap immediately, and node values are computed and cached in parallel
starting immediately (and attempts to extract values from the lazymap will
block until each value is computed). Besides this lazy behavior,
the lazymap can be used interchangeably with an ordinary Clojure map."
[g]
(simple-hierarchical-compile
g
true
(fn [m] (into (lazymap/lazy-hash-map) m))
(fn [m k f] (lazymap/delay-assoc m k (future (restricted-call f m))))))
(defn compile
"Compile graph specification g to a corresponding fnk using the a default
compile strategy for host.
Clojure: eager-compile
ClojureScript: interpreted-eager-compile"
[g]
#+clj (eager-compile g)
#+cljs (interpreted-eager-compile g))
(defn run
"Eagerly run a graph on an input by compiling and then executing on this input."
[g input]
((interpreted-eager-compile g) input))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Higher-order functions on graphs
(defn check-comp-partial!
"Check that instance-fn is a valid fn to comp-partial with graph g."
[g instance-fn]
(let [is (pfnk/input-schema g)
os (pfnk/output-schema instance-fn)]
(schema/assert-iae (map? os) "instance-fn must have output metadata")
(let [extra-ks (remove #(schema/possibly-contains? is %) (keys os))]
(schema/assert-iae (empty? extra-ks) "instance-fn provides unused keys: %s" (vec extra-ks)))
(doseq [[k s] os]
(schema/assert-satisfies-schema (or (get is k) (get is (s/optional-key k))) s))))
(defn comp-partial-fn
"Return a new pfnk representing the composition #(f (merge % (other %)))"
[f other]
(pfnk/fn->fnk
(fn [m] (f (merge m (other m))))
(schema/compose-schemata (pfnk/io-schemata f) (pfnk/io-schemata other))))
(defn comp-partial
"Experimental.
An extension of pfnk/comp-partial that supplies new parameters to a subgraph,
useful in composing hierarchical graphs.
g is a graph, and instance-fn is a fnk that takes arguments from the surrounding
context and produces new parameters that are fed into g. Works by comp-partialing
all leafs that expects any parameter produced by instance-fn with instance-fn,
so beware of expensive instance-fns, or those that expect caching of some sort
(i.e., attempt to generate shared state).
Throws an error if any parameter supplied by instance-fn is not used by at least
one node in g."
[g instance-fn]
(if (fn? g)
(comp-partial-fn g instance-fn)
(let [os (pfnk/output-schema instance-fn)]
(check-comp-partial! g instance-fn)
(->graph
(map/map-leaves
(fn [node-fn]
(if (some os (pfnk/input-schema-keys node-fn))
(comp-partial-fn node-fn instance-fn)
node-fn))
g)))))
(defmacro instance
"Experimental.
Convenience macro for comp-partial, used to supply inline parameters to a
subgraph (or fnk).
Example:
(= {:x 21}
(run (instance {:x (fnk [a] (inc a))} [z] {:a (* z 2)})
{:z 10}))"
([g m] `(instance ~g [] ~m))
([g bind m]
`(comp-partial ~g (plumbing/fnk ~bind ~m))))
(defn profiled
"Modify graph spec g, producing a new graph spec with a new top-level key
'profile-key'. After each node value is computed, the number of milliseconds
taken to compute its value will be stored under an atom at 'profile-key'."
[profile-key g]
(assert (and (keyword? profile-key) (not (get g profile-key))))
(->graph
(assoc (map/map-leaves-and-path
(fn [ks f]
(pfnk/fn->fnk
(fn [m]
(let [pm (plumbing/safe-get m profile-key)
start #+clj (System/nanoTime) #+cljs (plumbing/millis)
res (f (dissoc m profile-key))]
(swap! pm assoc-in ks
#+clj (/ (- (System/nanoTime) start) 1000000.0)
#+cljs (- (plumbing/millis) start))
res))
[(assoc (pfnk/input-schema f)
profile-key s/Any)
(pfnk/output-schema f)]))
(->graph g))
profile-key (plumbing/fnk [] (atom {})))))
prismatic-plumbing-clojure-0.5.4/src/plumbing/graph/ 0000755 0000000 0000000 00000000000 13141156451 0022473 5 ustar 00root root 0000000 0000000 prismatic-plumbing-clojure-0.5.4/src/plumbing/graph/positional.clj 0000644 0000000 0000000 00000007254 13141156451 0025356 0 ustar 00root root 0000000 0000000 (ns plumbing.graph.positional
"A compilation method for graphs that avoids maps for speed."
(:use plumbing.core)
(:require
[schema.core :as s]
[plumbing.fnk.schema :as schema]
[plumbing.fnk.pfnk :as pfnk]
[plumbing.fnk.impl :as fnk-impl])
(:import
clojure.lang.IFn))
(defn def-graph-record
"Define a record for the output of a graph. It is usable as a function to be
as close to a map as possible. Return the typename."
([g] (def-graph-record g (gensym "graph-record")))
([g record-type-name]
;; NOTE: This eval is needed because we want to define a record based on
;; information (a graph) that's only available at runtime.
(eval `(defrecord ~record-type-name ~(->> g
pfnk/output-schema
keys
(mapv (comp symbol name)))
IFn
(invoke [this# k#]
(get this# k#))
(invoke [this# k# not-found#]
(get this# k# not-found#))
(applyTo [this# args#]
(apply get this# args#))))
record-type-name))
(defn graph-let-bindings
"Compute the bindings for functions and intermediates needed to form the body
of a positional graph, E.g.
[`[[f-3 ~some-function]] `[[intermediate-3 (f-3 intermediate-1 intermediate-2)]]]"
[g g-value-syms]
(->> g
(map (fn [[kw f]]
(let [f-sym (-> kw name (str "-fn") gensym)
arg-forms (map-from-keys g-value-syms (pfnk/input-schema-keys f))
[f arg-forms] (fnk-impl/efficient-call-forms f arg-forms)]
[[f-sym f] [(g-value-syms kw) (cons f-sym arg-forms)]])))
(apply map vector)))
(defn eval-bound
"Evaluate a form with some symbols bound to some values."
[form bindings]
((eval `(fn [~(mapv first bindings)] ~form))
(map second bindings)))
(defn graph-form
"Construct [body-form bindings-needed-for-eval] for a positional graph."
[g arg-keywords]
(let [value-syms (->> g
pfnk/io-schemata
(mapcat schema/explicit-schema-key-map)
(map key)
(map-from-keys (comp gensym name)))
[needed-bindings value-bindings] (graph-let-bindings g value-syms)
record-type (def-graph-record g)]
[`(fn
positional-graph# ;; Name it just for kicks.
~(mapv value-syms arg-keywords)
(let ~(vec (apply concat value-bindings))
(new ~record-type ~@(->> g pfnk/output-schema keys (mapv value-syms)))))
needed-bindings]))
(defn positional-flat-compile
"Positional compile for a flat (non-nested) graph."
[g]
(let [arg-ks (->> g pfnk/input-schema-keys)
[positional-fn-form eval-bindings] (graph-form g arg-ks)
input-schema (pfnk/input-schema g)
pos-fn-sym (gensym "pos")
input-schema-sym (gensym "input-schema")
output-schema-sym (gensym "output-schema")]
(vary-meta ;; workaround evaluation quirks
(eval-bound
`(let [~pos-fn-sym ~positional-fn-form]
~(fnk-impl/positional-fnk-form
(fnk-impl/schema-override 'graph-positional output-schema-sym)
input-schema-sym
(vec (schema/explicit-schema-key-map input-schema))
(into {} (for [k (keys (schema/explicit-schema-key-map input-schema))] [k (symbol (name k))]))
(list `(~pos-fn-sym ~@(mapv (comp symbol name) arg-ks)))
nil))
(into eval-bindings
[[input-schema-sym input-schema]
[output-schema-sym (pfnk/output-schema g)]]))
assoc :schema (let [[is os] (pfnk/io-schemata g)] (s/=> os is)))))
prismatic-plumbing-clojure-0.5.4/src/plumbing/graph_async.clj 0000644 0000000 0000000 00000006335 13141156451 0024371 0 ustar 00root root 0000000 0000000 (ns plumbing.graph-async
(:require
[clojure.core.async :as async :refer [go !]]
[clojure.core.async.impl.protocols :as async-protocols]
[plumbing.fnk.pfnk :as pfnk]
[plumbing.fnk.schema :as schema :include-macros true]
[plumbing.core :as plumbing :include-macros true]
[plumbing.graph :as graph :include-macros true]))
(defn asyncify
"Take a fnk f and return an async version by wrapping non-channel
return values in a channel"
[f]
(pfnk/fn->fnk
(fn [m]
(let [v (f m)]
(if (satisfies? async-protocols/ReadPort v)
v
(go v))))
(pfnk/io-schemata f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Public
(defn async-compile
"Experimental.
Compile a hierarchical graph with (some) async fnks into an channel that
contains the computed graph once completed.
Each fnk can perform async operations by returning a channel that contains
its node value once completed.
Each node function will be evaluated as its dependencies have been fully
computed."
[g]
(if (fn? g)
(asyncify g)
(let [g (graph/->graph (plumbing/map-vals async-compile g))
req-ks (schema/required-toplevel-keys (pfnk/input-schema g))
edges (concat
(for [[k v] g
parent-k (filter g (pfnk/input-schema-keys v))]
[parent-k k])
(for [k (keys g)]
[k ::done]))
child-map (->> edges
(group-by first)
(plumbing/map-vals #(set (map second %))))
parent-map (->> edges
(group-by second)
(plumbing/map-vals #(set (map first %))))]
(pfnk/fn->fnk
(fn [m]
(let [missing-keys (seq (remove #(contains? m %) req-ks))]
(schema/assert-iae (empty? missing-keys)
"Missing top-level keys in graph input: %s"
(set missing-keys)))
(let [result (async/chan)
remaining-parents (atom parent-map)
results (atom m)
run-node (fn run-node [k]
(go
(if (= ::done k)
(>! result (select-keys @results (keys g)))
(let [f (g k)
r (!]]
#+cljs [cljs.core.async :as async :refer [!]]
#+clj [clojure.core.async.impl.protocols :as async-protocols]
#+cljs [cljs.core.async.impl.protocols :as async-protocols]
[plumbing.fnk.pfnk :as pfnk]
[plumbing.fnk.schema :as schema :include-macros true]
[plumbing.core :as plumbing :include-macros true]
[plumbing.graph :as graph :include-macros true]))
(defn asyncify
"Take a fnk f and return an async version by wrapping non-channel
return values in a channel"
[f]
(pfnk/fn->fnk
(fn [m]
(let [v (f m)]
(if (satisfies? async-protocols/ReadPort v)
v
(go v))))
(pfnk/io-schemata f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Public
(defn async-compile
"Experimental.
Compile a hierarchical graph with (some) async fnks into an channel that
contains the computed graph once completed.
Each fnk can perform async operations by returning a channel that contains
its node value once completed.
Each node function will be evaluated as its dependencies have been fully
computed."
[g]
(if (fn? g)
(asyncify g)
(let [g (graph/->graph (plumbing/map-vals async-compile g))
req-ks (schema/required-toplevel-keys (pfnk/input-schema g))
edges (concat
(for [[k v] g
parent-k (filter g (pfnk/input-schema-keys v))]
[parent-k k])
(for [k (keys g)]
[k ::done]))
child-map (->> edges
(group-by first)
(plumbing/map-vals #(set (map second %))))
parent-map (->> edges
(group-by second)
(plumbing/map-vals #(set (map first %))))]
(pfnk/fn->fnk
(fn [m]
(let [missing-keys (seq (remove #(contains? m %) req-ks))]
(schema/assert-iae (empty? missing-keys)
"Missing top-level keys in graph input: %s"
(set missing-keys)))
(let [result (async/chan)
remaining-parents (atom parent-map)
results (atom m)
run-node (fn run-node [k]
(go
(if (= ::done k)
(>! result (select-keys @results (keys g)))
(let [f (g k)
r ( {:x 41, :y 42}"
[& syms]
(when-not (every? symbol? syms)
(throw (ex-info "Arguments to keyword-map must be symbols!" {:args syms})))
(zipmap (map #(keyword (name %)) syms) syms))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Java mutable Maps
(do
(defn update-key!
"Transform value in java.util.Map m under key k with fn f."
([^java.util.Map m k f]
(.put m k (f (.get m k))))
([^java.util.Map m k f & args]
(.put m k (apply f (.get m k) args))))
(defmacro get!
"Get the value in java.util.Map m under key k. If the key is not present,
set the value to the result of default-expr and return it. Useful for
constructing mutable nested structures on the fly.
(.add ^List (get! m :k (java.util.ArrayList.)) :foo)"
[m k default-expr]
`(let [^java.util.Map m# ~m k# ~k]
(or (.get m# k#)
(let [nv# ~default-expr]
(.put m# k# nv#)
nv#))))
(defn inc-key!
"Increment the value in java.util.Map m under key k by double d."
[^java.util.Map m k ^double d]
(.put m k (if-let [v (.get m k)]
(+ (double v) d)
d)))
(defn inc-key-in!
"Increment the value in java.util.Map m under key-seq ks by double d,
creating and storing HashMaps under missing keys on the path to this leaf."
[^java.util.Map m ks ^double d]
(if-let [mk (next ks)]
(recur (get! m (first ks) (java.util.HashMap.)) mk d)
(inc-key! m (first ks) d)))
(defn ^java.util.HashMap collate
"Take a seq of [k v] counts and sum them up into a HashMap on k."
[flat-counts]
(let [m (java.util.HashMap.)]
(doseq [[k v] flat-counts]
(inc-key! m k v))
m))
(defn ^java.util.HashMap deep-collate
"Take a seq of [kseq v] counts and sum them up into nested HashMaps"
[nested-counts]
(let [m (java.util.HashMap.)]
(doseq [[ks v] nested-counts]
(inc-key-in! m ks v))
m)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Ops on graphs represented as maps.
(defn topological-sort
"Take an adjacency list representation of a graph (a map from node names to
sequences of child node names), and return a topological ordering of the node
names in linear time, or throw an error if the graph is cyclic.
If include-leaves? is false the ordering will only include keys from child-map,
and if true it will also include nodes only named as children in child-map."
[child-map & [include-leaves?]]
(let [e (java.util.HashMap. ^java.util.Map child-map)
re (java.util.HashMap.)
s (java.util.Stack.)]
(doseq [[p children] child-map
c children]
(when include-leaves? (when-not (.containsKey e c) (.put e c nil)))
(update-key! re c #(cons p %)))
(while (not (.isEmpty e))
((fn dfs1 [n]
(when (.containsKey e n)
(let [nns (.get e n)]
(.remove e n)
(doseq [nn nns] (dfs1 nn)))
(.push s n)))
(first (keys e))))
(let [candidate (reverse (seq s))]
(doseq [c candidate
r (.remove re c)]
(when (.containsKey re r)
(throw (IllegalArgumentException. (format "Graph contains a cycle containing %s and %s" c r)))))
candidate)))
;;;;;;;;;;;; This file autogenerated from src/plumbing/map.cljx
prismatic-plumbing-clojure-0.5.4/src/plumbing/map.cljx 0000644 0000000 0000000 00000017734 13141156451 0023045 0 ustar 00root root 0000000 0000000 (ns plumbing.map
"Common operations on maps (both Clojure immutable and mutable Java stuff)"
(:refer-clojure :exclude [flatten])
(:require
[plumbing.core :as plumbing :include-macros true]
[plumbing.fnk.schema :as schema :include-macros true]
#+cljs [clojure.set :as set]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Clojure immutable maps
(defn safe-select-keys
"Like select-keys, but asserts that all keys are present."
[m ks]
(let [missing (remove (partial contains? m) ks)]
(schema/assert-iae (empty? missing) "Keys %s not found in %s" (vec missing)
(binding [*print-length* 200]
(print-str (mapv key m)))))
(select-keys m ks))
(defn merge-disjoint
"Like merge, but throws with any key overlap between maps"
([] {})
([m] m)
([m1 m2]
(let [duplicates (filter (partial contains? m2) (keys m1))]
(schema/assert-iae (empty? duplicates) "Duplicate keys %s"
(vec duplicates)))
(into (or m2 {}) m1))
([m1 m2 & maps]
(reduce merge-disjoint m1 (cons m2 maps))))
(defn merge-with-key
"Like merge-with, but the merging function takes the key being merged
as the first argument"
[f & maps]
(when (some identity maps)
(let [merge-entry (fn [m e]
(let [k (key e) v (val e)]
(if (contains? m k)
(assoc m k (f k (get m k) v))
(assoc m k v))))
merge2 (fn [m1 m2]
(reduce merge-entry (or m1 {}) (seq m2)))]
(reduce merge2 maps))))
(defn flatten
"Transform a nested map into a seq of [keyseq leaf-val] pairs"
[m]
(when m
((fn flatten-helper [keyseq m]
(when m
(if (map? m)
(mapcat (fn [[k v]] (flatten-helper (conj keyseq k) v)) m)
[[keyseq m]])))
[] m)))
(defn unflatten
"Transform a seq of [keyseq leaf-val] pairs into a nested map.
If one keyseq is a prefix of another, you're on your own."
[s]
(reduce (fn [m [ks v]] (if (seq ks) (assoc-in m ks v) v)) {} s))
;; TODO: make sure we're safe with false here -- pretty sure we're not. Same for nil.
(defn map-leaves-and-path
"Takes a nested map and returns a nested map with the same shape, where each
(non-map) leaf v is transformed to (f key-seq v).
key-seq is the sequence of keys to reach this leaf, starting at the root."
([f m] (when m (map-leaves-and-path f [] m)))
([f ks m]
(if-not (map? m)
(f ks m)
(plumbing/for-map [[k v] m]
k
(map-leaves-and-path f (conj ks k) v)))))
(defn keep-leaves-and-path
"Takes a nested map and returns a nested map with the same shape, where each
(non-map) leaf v is transformed to (f key-seq v), or removed if it returns nil.
key-seq is the sequence of keys to reach this leaf, starting at the root.
Empty maps produced by this pruning are themselves pruned from the output."
([f m] (keep-leaves-and-path f [] m))
([f ks m]
(if-not (map? m)
(f ks m)
(plumbing/for-map [[k ov] m
:let [nv (keep-leaves-and-path f (conj ks k) ov)]
:when (not (or (nil? nv) (and (map? nv) (empty? nv))))]
k nv))))
(defn map-leaves
"Takes a nested map and returns a nested map with the same shape, where each
(non-map) leaf v is transformed to (f v)."
([f m] (map-leaves-and-path (fn [_ l] (f l)) m)))
(defn keep-leaves
"Takes a nested map and returns a nested map with the same shape, where each
(non-map) leaf v is transformed to (f v), or removed if it returns nil.
Empty maps produced by this pruning are themselves pruned from the output."
([f m] (keep-leaves-and-path (fn [_ l] (f l)) m)))
(defmacro keyword-map
"Expands to a map whose keys are keywords with the same name as the given
symbols, e.g.:
(let [x 41, y (inc x)]
(keyword-map x y))
;; => {:x 41, :y 42}"
[& syms]
(when-not (every? symbol? syms)
(throw (ex-info "Arguments to keyword-map must be symbols!" {:args syms})))
(zipmap (map #(keyword (name %)) syms) syms))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Java mutable Maps
#+clj
(do
(defn update-key!
"Transform value in java.util.Map m under key k with fn f."
([^java.util.Map m k f]
(.put m k (f (.get m k))))
([^java.util.Map m k f & args]
(.put m k (apply f (.get m k) args))))
(defmacro get!
"Get the value in java.util.Map m under key k. If the key is not present,
set the value to the result of default-expr and return it. Useful for
constructing mutable nested structures on the fly.
(.add ^List (get! m :k (java.util.ArrayList.)) :foo)"
[m k default-expr]
`(let [^java.util.Map m# ~m k# ~k]
(or (.get m# k#)
(let [nv# ~default-expr]
(.put m# k# nv#)
nv#))))
(defn inc-key!
"Increment the value in java.util.Map m under key k by double d."
[^java.util.Map m k ^double d]
(.put m k (if-let [v (.get m k)]
(+ (double v) d)
d)))
(defn inc-key-in!
"Increment the value in java.util.Map m under key-seq ks by double d,
creating and storing HashMaps under missing keys on the path to this leaf."
[^java.util.Map m ks ^double d]
(if-let [mk (next ks)]
(recur (get! m (first ks) (java.util.HashMap.)) mk d)
(inc-key! m (first ks) d)))
(defn ^java.util.HashMap collate
"Take a seq of [k v] counts and sum them up into a HashMap on k."
[flat-counts]
(let [m (java.util.HashMap.)]
(doseq [[k v] flat-counts]
(inc-key! m k v))
m))
(defn ^java.util.HashMap deep-collate
"Take a seq of [kseq v] counts and sum them up into nested HashMaps"
[nested-counts]
(let [m (java.util.HashMap.)]
(doseq [[ks v] nested-counts]
(inc-key-in! m ks v))
m)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Ops on graphs represented as maps.
#+clj
(defn topological-sort
"Take an adjacency list representation of a graph (a map from node names to
sequences of child node names), and return a topological ordering of the node
names in linear time, or throw an error if the graph is cyclic.
If include-leaves? is false the ordering will only include keys from child-map,
and if true it will also include nodes only named as children in child-map."
[child-map & [include-leaves?]]
(let [e (java.util.HashMap. ^java.util.Map child-map)
re (java.util.HashMap.)
s (java.util.Stack.)]
(doseq [[p children] child-map
c children]
(when include-leaves? (when-not (.containsKey e c) (.put e c nil)))
(update-key! re c #(cons p %)))
(while (not (.isEmpty e))
((fn dfs1 [n]
(when (.containsKey e n)
(let [nns (.get e n)]
(.remove e n)
(doseq [nn nns] (dfs1 nn)))
(.push s n)))
(first (keys e))))
(let [candidate (reverse (seq s))]
(doseq [c candidate
r (.remove re c)]
(when (.containsKey re r)
(throw (IllegalArgumentException. (format "Graph contains a cycle containing %s and %s" c r)))))
candidate)))
#+cljs
(defn topological-sort
[child-map & [include-leaves?]]
(let [e (atom child-map)
re (atom {})
s (atom [])]
(doseq [[p children] child-map
c children]
(when include-leaves? (when-not (find @e c) (swap! e assoc c nil)))
(swap! re update c #(cons p %)))
(while (seq @e)
((fn dfs1 [n]
(when-let [[_ nns] (find @e n)]
(swap! e dissoc n)
(doseq [nn nns] (dfs1 nn))
(swap! s conj n)))
(first (keys @e))))
(let [candidate (reverse @s)]
(doseq [c candidate
:let [rs (@re c)
_ (swap! re dissoc c)]
r rs]
(when (find @re r)
(throw (ex-info (str "Graph contains a cycle containing " c " and " r) {:nodes [c r]}))))
candidate)))
prismatic-plumbing-clojure-0.5.4/test/ 0000755 0000000 0000000 00000000000 13141156451 0017745 5 ustar 00root root 0000000 0000000 prismatic-plumbing-clojure-0.5.4/test/plumbing/ 0000755 0000000 0000000 00000000000 13141156451 0021562 5 ustar 00root root 0000000 0000000 prismatic-plumbing-clojure-0.5.4/test/plumbing/core_test.cljx 0000644 0000000 0000000 00000051310 13141156451 0024433 0 ustar 00root root 0000000 0000000 (ns plumbing.core-test
(:require
[schema.core :as s]
[schema.test :as schema-test]
[plumbing.core :as p :include-macros true]
[plumbing.fnk.pfnk :as pfnk]
#+clj [plumbing.fnk.impl :as fnk-impl]
#+clj [clojure.test :refer :all]
#+cljs [cemerick.cljs.test :refer-macros [is are deftest testing use-fixtures]]))
#+cljs
(do
(def Exception js/Error)
(def AssertionError js/Error)
(def Throwable js/Error))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Maps
(deftest for-map-test
(is (= (p/for-map [i [1 2]
j [10 20]]
(+ i j)
j)
{11 10 12 10
21 20 22 20}))
(is (= (p/for-map [i [1 2]
j [10 20]]
i
j)
{1 20 2 20}))
(let [m (p/for-map m [i (range 1000)] i (+ i (get m (dec i) 0)))]
(is (= (count m) 1000))
(is (= (m 999) 499500))))
(p/-unless-update
(deftest update-test
(testing "0 extra args"
(is (= {:a 5, :b 0}
(p/update {:a 4, :b 0} :a inc)))
(is (= {:a 1}
(p/update {} :a (fnil inc 0)))))
(testing "1 extra arg"
(is (= {:a 42, :b 0}
(p/update {:a 6, :b 0} :a * 7)))
(is (= {:a #{42}}
(p/update {} :a (fnil conj #{}) 42))))
(testing "100 extra args"
(is (= {:a 4951} (apply p/update {:a 1} :a + (range 100)))))))
(deftest map-vals-test
(is (= (p/map-vals inc {:a 0 :b 0})
{:a 1 :b 1}))
(is (= (p/map-vals inc [[:a 0] [:b 0]])
{:a 1 :b 1}))
(is (= (p/map-vals inc (sorted-map :a 0 :b 0))
{:a 1 :b 1}))
(is (sorted? (p/map-vals inc (sorted-map :a 0 :b 0)))))
(deftest map-keys-test
(is (= (p/map-keys str {:a 1 :b 1})
{":a" 1 ":b" 1}))
(is (= (p/map-keys str [[:a 1] [:b 1]])
{":a" 1 ":b" 1})))
(deftest map-from-keys-test
(is (= (p/map-from-keys inc [0 1 2])
{0 1, 1 2, 2 3})))
(deftest map-from-vals-test
(is (= (p/map-from-vals inc [0 1 2])
{1 0, 2 1, 3 2})))
(deftest dissoc-in-test
(is (= {:a 1} (p/dissoc-in {:a 1 :b 2} [:b])))
(is (= {:a 1 :b {:d 3}} (p/dissoc-in {:a 1 :b {:c 2 :d 3}} [:b :c])))
(is (= {:a 1} (p/dissoc-in {:a 1 :b {:c 2}} [:b :c])))
(is (= {:a 1} (p/dissoc-in {:a 1} [:b :c])))
(is (thrown? Exception (p/dissoc-in {:a 1 :b :not-a-map} [:b :c])))
(is (= nil (p/dissoc-in {:a 1} [:a])))
(is (= nil (p/dissoc-in nil [:a])))
(is (= nil (p/dissoc-in {} [:a]))))
(deftest keywordize-map-test
(is (= {:foo 1
:bar [2]
:baz [{:x 42}]}
(p/keywordize-map {"foo" 1
"bar" [2]
:baz [{"x" 42}]})))
(is (= {:foo 1
:bar [2]
:baz {:x 42}}
(p/keywordize-map {"foo" 1
"bar" [2]
:baz {"x" 42}}))))
(deftest lazy-get-test
(let [counter (atom 0)]
(is (= 1 (p/lazy-get {:a 1} :a (do (swap! counter inc) 2))))
(is (zero? @counter))
(is (= 2 (p/lazy-get {:a 1} :b (do (swap! counter inc) 2))))
(is (= 1 @counter))
(is (= 2 (p/lazy-get {:a 1 :b 2} :b (do (swap! counter inc) 2))))
(is (= 1 @counter))))
(deftest safe-get-test
(is (= 2 (p/safe-get {:a 2} :a)))
(is (thrown? Exception (p/safe-get {:a 2} :b)))
(is (= 2 (p/safe-get-in {:a {:b 2}} [:a :b])))
(is (thrown? Exception (p/safe-get-in {:a {:b 2}} [:b])))
(is (thrown? Exception (p/safe-get-in {:a {:b 2}} [:a :c])))
(is (thrown? Exception (p/safe-get-in {:a {:b 2}} [:a :b :d]))))
(deftest assoc-when-test
(is (= {:a 1} (p/assoc-when nil :a 1)))
(is (= {:a 1 :c 2} (p/assoc-when {:a 1} :b nil :c 2))))
(deftest update-in-when-test
(is (= nil (p/update-in-when nil [:a] inc)))
(is (= {:a {:b 2}} (p/update-in-when {:a {:b 2}} [:a :c] inc)))
(is (= {} (p/update-in-when {} [:foo :bar] inc)))
(is (= {:foo 2 :bar 1} (p/update-in-when {:foo 1 :bar 1} [:foo] inc)))
(is (= {:a {:b 3 :z 5}} (p/update-in-when {:a {:b 2 :z 5}} [:a :b] inc))))
(deftest grouped-map-test
(is (= {:a [1 2] :b [3]} (p/grouped-map first second [[:a 1] [:b 3] [:a 2]]))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Seqs
(deftest aconcat-test
(is (= [1 2 3 4 5 6] (p/aconcat [[1 2 3] [4 5 6]]))))
(deftest unchunk-test
(let [realized (atom #{})
xs (map (fn [x]
(swap! realized conj x)
x)
(p/unchunk (range 10)))]
(is (empty? @realized))
(doseq [x (range 10)]
(is (not (@realized x)))
(is (= x (nth xs x)))
(is (@realized x)))))
(deftest sum-test
(is (= 55 (p/sum (range 1 11))))
(is (= 55 (p/sum inc (range 10)))))
(deftest singleton-test
(is (= 1 (p/singleton [1])))
(is (nil? (p/singleton [1 2]))))
(deftest indexed-test
(is (empty? (p/indexed nil)))
(is (= [[0 :a] [1 :b] [2 :c]] (p/indexed [:a :b :c])))
(is (= [[0 :a] [1 :b] [2 :c] [3 0]] (take 4 (p/indexed (concat [:a :b :c] (range)))))))
(deftest positions-test
(is (empty? (p/positions odd? [2 4 6 8 10])))
(is (= [0 1 2] (p/positions odd? [1 3 5 2 4 6])))
(is (= [1 3 5] (take 3 (p/positions odd? (range))))))
#+clj
(deftest frequencies-fast-test
(is (= {\p 2, \s 4, \i 4, \m 1}
(p/frequencies-fast "mississippi")))
(is (= {1 3 2 2 3 1}
(p/frequencies-fast [1 2 3 1 2 1])))
;; We don't return the right thing on = but not .equals things,
;; because of the difference between Java Maps and Clojure maps.
(is (= {1 1}
(p/frequencies-fast [1 (BigInteger. "1")]))))
#+clj
(deftest distinct-fast-test
(is (= [1 2 3]
(p/distinct-fast [1 2 3])))
(is (= [1 2 3]
(p/distinct-fast [1 2 3 2 1 2 3 2 2])))
(is (= []
(p/distinct-fast []))))
#+clj
(defn are-fast-things-faster []
(let [s (apply concat (repeat 100 (range 10000)))]
(doseq [f [frequencies p/frequencies-fast distinct p/distinct-fast]]
(println f)
(dotimes [_ 5]
(time (doall (f s)))))))
(deftest distinct-by-test
(is (= [{:id 1 :data "a"}]
(p/distinct-by :id
[{:id 1 :data "a"}
{:id 1 :data "b"}])))
(is (= [1 2 3 2 1]
(map second
(p/distinct-by
first
[[1 1]
[1 10]
[17 2]
[1 12]
[:foo 3]
[:foo 3]
['bar 2]
[1 3]
[3 1]])))))
#+clj
(deftest distinct-id-test
(let [x (p/distinct-id [:a :b :c :a :b (Long. 1) (Long. 1)])]
(is (= 5 (count x)))
(is (= #{:a :b :c 1} (set x)))
(is (= #{:a :b :c 1} (set x)))
(is (empty? (p/distinct-id nil)))))
(deftest interleave-all-test
(is (= [:a 0 :b 1 :c :d] (p/interleave-all [:a :b :c :d] [0 1]))))
(deftest count-when-test
(is (= 5 (p/count-when even? (range 10)))))
(deftest conj-when-test
(is (= [:a :b :c]
(p/conj-when [:a] :b nil :c))))
(deftest cons-when-test
(is (= [1 2] (p/cons-when nil [1 2])))
(is (= [1 2] (p/cons-when false [1 2])))
(is (= [3 1 2] (p/cons-when 3 [1 2]))))
(deftest rsort-by-test
(is (= [5 4 3 2 1] (p/rsort-by identity [3 2 1 4 5]))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Control flow
(deftest ?>>-test
(let [side-effect (atom [])]
(is (= (range 10)
(->> (range 10)
(p/?>> false
((do (swap! side-effect conj :bad) map) inc)
(map inc)))))
(is (empty? @side-effect))
(is (= (range 2 12)
(->> (range 10)
(p/?>> true
((do (swap! side-effect conj :good) map) inc)
(map inc)))))
(is (= @side-effect [:good]))))
(deftest ?>-test
(let [side-effect (atom [])]
(is (= {:a 1}
(-> {:a 1}
(p/?> false
((do (swap! side-effect conj :bad) assoc) :b 1)
(dissoc :a)))))
(is (empty? @side-effect))
(is (= {:b 1}
(-> {:a 1}
(p/?> true
((do (swap! side-effect conj :good) assoc) :b 1)
(dissoc :a)))))
(is (= @side-effect [:good]))))
(deftest fn->-test
(is (= {:a 1 :b 1} ((p/fn-> (assoc :a 1)) {:b 1}))))
(deftest fn->>-test
(is (= (range 1 11) ((p/fn->> (map inc)) (range 10)))))
(deftest <--test
(is (= [2 3]
(-> {1 1}
(assoc 3 4)
(update-in [1] inc)
(->> (p/map-vals dec)
(p/map-keys inc)
(p/<- (update-in [2] inc)
(map [2 4])))))))
(deftest as->>-test
(is (= [1 2 3]
(->> (range 5)
(map inc)
(p/as->> x (drop-last 2 x))))))
(deftest memoized-fn-test
(let [calls (atom 0)]
(is (= 55
((p/memoized-fn fib [x] (swap! calls inc)
(case x 0 0 1 1 (+ (fib (- x 1)) (fib (- x 2)))))
10)))
(is (= 11 @calls))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Miscellaneous
(deftest swap-pair!-test
(let [a (atom {:a 1})]
(is (= [{:a 1} {:a 2}] (p/swap-pair! a #(update-in % [:a] inc)))))
(let [a (atom {:a 1})]
(is (= [{:a 1} {:a 2}] (p/swap-pair! a update-in [:a] inc)))))
(deftest get-and-set!-test
(let [a (atom 1)]
(is (= 1 (p/get-and-set! a 2)))
(is (= 2 @a))))
(deftest mapply-test
(letfn [(f [& {:as m}]
(p/for-map [[k v] m] v k))
(g [a b c & {:as m}]
{:init [a b c] :m m})]
(is (= {42 :foo 90 :bar} (p/mapply f {:bar 90 :foo 42})))
(is (= {:init [1 2 3]
:m nil}
(p/mapply g 1 2 3 {})))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; fnk
(deftest letk-test
(let [called? (atom false)
om {:a 1 :c 3 :d 4 :e 17 :g 22}]
(p/letk [[a { b 2} c d {e 5} :as m & more] om]
(is (= [a b c d e] [1 2 3 4 17]))
(is (= m om))
(is (= {:g 22} more))
(reset! called? true))
(is @called?)
(p/letk [[:as m] om]
(is (= m om)))
(p/letk [[a & m] om]
(is (= a 1))
(is (= m (dissoc om :a))))
(p/letk [[a] {:a {:b 1}}
[b] a]
(is (= b 1)))
(p/letk [[a] {:a [{:c 3}]}
b (first a)
[c] b]
(is (= c 3)))
(is (thrown? Throwable
(p/letk [[a] {:b 2}] a)))))
(deftest letk-self-shadow-test
(is (= 2 (let [a 1] (p/letk [[{a a}] {:a 2}] a))))
(is (= 1 (let [a 1] (p/letk [[{a a}] {}] a))))
(is (= 2 (let [a 1] (p/letk [[{b/a a}] {:b/a 2}] a))))
(is (= 1 (let [a 1] (p/letk [[{b/a a}] {}] a)))))
(deftest letk-single-shadow-test
(let [a 1 b 2 c 3 e 4 e 5]
(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])))
(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])))))
(deftest letk-dont-require-map-for-nested-only-as
(is (= 1 (p/letk [[[:a :as a]] {:a 1}] a))))
#+clj
(deftest letk-no-multiple-binding-test
(is (thrown? Exception (eval '(p/letk [[a a] {:a 1}] a))))
(is (thrown? Exception (eval '(p/letk [[a/a b/a] {:a/a 1 :b/a 2}] a))))
(is (= 1 (p/letk [[a] {:a 1} [a] {:a a}] a)))
(is (= 1 (p/letk [[a/b] {:a/b 1} [a/b] {:a/b b}] b))))
(deftest letk-multi-shadow-test
(let [a 1 b 2 c 3 e 4 e 5
inp {:c 8 :e 10}]
(is (= [8 8 8 5 10] (p/letk [[c] inp
[{a c}] inp
[{b a}] inp
[{d e}] inp
[e] inp]
[a b c d e])))))
(deftest letk-qualified-key-test
(let [m {:a/b 1 :c/d {:e/f 2 :a/b 2}}]
(is (= 1 (p/letk [[a/b] m] b)))
(is (= 2 (p/letk [[[:c/d e/f]] m] f)))
(is (= 2 (p/letk [[a/b] m [[:c/d a/b]] m] b))))
(is (= 2 (p/letk [[a/b] {:a/b 1} [a/b] {:a/b 2}] b)))
(is (= 2 (p/letk [[[:a/b :as c]] {:a/b 2}] c))))
(deftest when-letk-test
(is (= "123" (p/when-letk [[a b c] {:a 1 :b 2 :c 3}] (str a b c))))
(is (= 5 (p/when-letk [[five] {:five 5}] 1 2 3 4 five)))
(is (nil? (p/when-letk [[a b c] nil] (throw (Exception.))))))
(deftest if-letk-test
(is (= "then" (p/if-letk [[a b c] {:a 1 :b 2 :c "then"}] c (throw (Exception.)))))
(is (= "else" (p/if-letk [[a b c] nil] (throw (Exception.)) "else")))
(is (nil? (p/if-letk [[a b c] nil] (throw (Exception.))))))
(deftest fnk-test
(testing "error on invalid input"
(is (thrown? Throwable ((p/fnk [a] a) {:b 1}))))
(let [call-count (atom 0)
om {:a 1 :c 3 :d 4 :e 17 :g 22}]
(testing "basic fnk"
((p/fnk [a b]
(is (= a 1))
(is (= b 2))
(swap! call-count inc))
{:a 1 :b 2}))
(testing "complex fnk"
((p/fnk [a {b 2} c d {e 5} :as m & more]
(is (= [a b c d e] [4 2 3 4 17]))
(is (= m (assoc om :a 4 :h 77)))
(is (= {:g 22 :h 77} more))
(swap! call-count inc))
(assoc om :a 4 :h 77)))
(testing "both fnks called"
(is (= @call-count 2)))
(testing "dependent optional values"
(is (= [1 2 3]
((p/fnk [a {b (* a 2)} {c (inc b)}] [a b c]) {:a 1}))))
#+clj
(testing "positional-fn"
(let [f (p/fnk [a {b 2} [:c :as c0] [:d d1 {d2 2} [:d3 :as d30] [:d4 d41 :as d4]]]
(is (= [a b c0 d1 d2 d30 d41 d4]
[4 2 3 4 2 17 18 {:d41 18 :d42 :foo}]))
(swap! call-count inc))]
(f {:a 4 :c 3 :d {:d1 4 :d3 17 :d4 {:d41 18 :d42 :foo}}})
((fnk-impl/positional-fn f [:d :a :c])
{:d1 4 :d3 17 :d4 {:d41 18 :d42 :foo}} 4 3)
(is (= @call-count 4))
(is (thrown? Throwable ((p/fnk [a] a) {:b 3}))))))
(testing "fnk output-schema"
(doseq [f [(p/fnk [] {:a 1 :b {:b1 2}})
(p/fnk f :- {:a s/Any :b {:b1 s/Any}} []
(hash-map :a 1 :b {:b1 2} :c 3))]]
(is (= (pfnk/output-schema f) {:a s/Any :b {:b1 s/Any}})))
(let [a :k]
(is (= (pfnk/output-schema (p/fnk [a] {a a})) s/Any))))
(testing "metadata via reader macro"
(let [fnk-with-meta ^{:has-meta true} (p/fnk [])]
(is (:has-meta (meta fnk-with-meta)))))
(testing "name if proivded"
(is (= 'bob (pfnk/fnk-name (p/fnk bob []))))
(is (nil? (pfnk/fnk-name (p/fnk []))))))
(deftest fnk-input-schema-test
(testing "simple fnk with one string key"
(doseq [[t f] {"no-as" (p/fnk [a :- s/Str] a)
"with-as" (p/fnk [a :- s/Str :as b] a)}]
(testing t
(is (= {:a s/Str s/Keyword s/Any}
(pfnk/input-schema f)))
(is (= "hi" (f {:a "hi"})))
(is (= "hi" (f {:a "hi" :b 123})))
(is (thrown? Exception (f {:a :lo})))
(is (thrown? Exception (f {:a "hi" "b" "no-string-keys"})))))
(is (= :lo ((p/fnk ^:never-validate foo [a :- s/Str] a) {:a :lo}))))
(testing "schemas on nested and optional bindings"
(doseq [[t f] {"no-as" (p/fnk [a :- s/Str {b :- s/Str "1"} [:c d :- s/Num]]
[a b d])
"with-as" (p/fnk [a :- s/Str {b :- s/Str "1"} [:c d :- s/Num] :as m]
[a b d])}]
(testing t
(is (= {:a s/Str
(s/optional-key :b) s/Str
:c {:d s/Num s/Keyword s/Any}
s/Keyword s/Any}
(pfnk/input-schema f)))
(is (= ["hi" "1" 2] (f {:a "hi" :c {:d 2}})))
(is (= ["hi" "1" 2] (f {:a "hi" :c {:d 2 :e 3} :f :g})))
(is (= ["hi" "bye" 2] (f {:a "hi" :b "bye" :c {:d 2}})))
(is (thrown? Exception (f {:a "hi" :c {:d "2"}})))
(is (thrown? Exception (f {:a "hi" :b :bye :c {:d 2}}))))))
(testing "schemas on & bindings"
(let [f (p/fnk [a :- s/Str [:b c & more :- {s/Keyword s/Num}] & more :- {}]
[a c])]
(is (= {:a s/Str
:b {:c s/Any s/Keyword s/Num}}
(pfnk/input-schema f)))
(is (= ["hi" 1] (f {:a "hi" :b {:c 1}})))
(is (= ["hi" 1] (f {:a "hi" :b {:c 1 :z 3}})))
(is (thrown? Exception (f {:a "hi" :b {:c 1 :z "3"}})))
(is (thrown? Exception (f {:a "hi" :b {:c 1} :d :e})))))
(testing "schema override on top-level map bindings"
(let [override {:a s/Num (s/optional-key :b) s/Str (s/optional-key :e) s/Str}]
(doseq [[t f] {"no-as" (p/fnk [a :- s/Str {b :- s/Str "1"}] :- override
[a b])
"with-as" (p/fnk [a :- s/Str {b :- s/Str "1"} :as m] :- override
[a b])}]
(testing t
(is (= override (pfnk/input-schema f)))
(is (= [2 "1"] (f {:a 2})))
(is (= [2 "2"] (f {:a 2 :b "2"})))
(is (= [2 "2"] (f {:a 2 :b "2" :e "asdf"})))
(is (thrown? Exception (f {:a "2"})))
(is (thrown? Exception (f {:a 2 :b 2})))
(is (thrown? Exception (f {:a 2 :z :huh})))))))
(testing "schema override on inner map bindings"
(let [f (p/fnk [a :- s/Str [:b c] :- {:c s/Str}]
[a c])]
(is (= {:a s/Str :b {:c s/Str} s/Keyword s/Any} (pfnk/input-schema f)))
(is (= ["1" "2"] (f {:a "1" :b {:c "2"}})))
(is (thrown? Exception (f {:a "1" :b {:c 2}})))
(is (thrown? Exception (f {:a "1" :b {:c "2" :d "3"}})))))
(testing "default values"
(let [first-key-meta (p/fn-> pfnk/input-schema (dissoc s/Keyword) keys first meta)]
(is (= {:default "foo"}
(first-key-meta (p/fnk [{a :- s/Str "foo"}]))))
(is (= {:default 'apple}
(first-key-meta (p/fnk [apple {a :- s/Str apple}])))))))
(deftest fnk-qualified-key-test
(is (= [1 2 3] ((p/fnk [a/b b/c c/d] [b c d]) {:a/b 1 :b/c 2 :c/d 3})))
(is (= 1 ((p/fnk [[:a/b b/c]] c) {:a/b {:b/c 1}})))
(is (= 1 ((p/fnk [{a/b 1}] b) {})))
(is (= 1 ((p/fnk [[:a/b :as c]] c) {:a/b 1})))
(testing "schemas"
(let [f (p/fnk [a/b :- s/Str [:b/c c/d :- s/Keyword]] [b d])]
(is (= ["hi" :bye] (f {:a/b "hi" :b/c {:c/d :bye}})))
(is (= {:a/b s/Str
:b/c {:c/d s/Keyword s/Keyword s/Any}
s/Keyword s/Any}
(pfnk/input-schema f)))
(are [invalid-input] (thrown? Exception (f invalid-input))
nil
{}
{:b "hi" :c {:d :bye}}
{:a/b nil :b/c nil}
{:a/b nil :b/c {:c/d :bye}}
{:a/b "hi" :b/c {:c/d "bye"}}
{:a/b "hi" :b/c :bye}))))
(p/defnk keyfn-test-docstring "whoa" [dude {wheres :foo} :as my & car]
[dude wheres my car])
(p/defnk keyfn-test-no-docstring [{city :sf} foo]
[foo city])
(deftest defnk-test
(is (= [11 :foo {:dude 11 :sweet 17} {:sweet 17}]
(keyfn-test-docstring {:dude 11 :sweet 17})))
(is (= [:foo :sf] (keyfn-test-no-docstring {:foo :foo})))
(is (= [{:foo s/Any (s/optional-key :city) s/Any s/Keyword s/Any} s/Any]
(pfnk/io-schemata keyfn-test-no-docstring)))
(is (thrown? Throwable (keyfn-test-docstring :wheres :mycar))))
;; Test that type hints are properly propagated for fnk and defnk.
#+clj
(p/defnk ^Byte a-typehinted-defnk [^Long l]
(.byteValue l))
#+clj
(deftest type-hints-test
(is (= Byte (:tag (meta #'a-typehinted-defnk))))
(doseq [f [a-typehinted-defnk
(p/fnk [^Long l] (.byteValue l))
(p/fnk [{^Long l 1}] (.byteValue l))
(p/fnk [^Long l & m] (.byteValue l))]]
(is (= (Byte. (byte 1)) (f {:l (Long. 1)})))
(is (thrown? Exception (f {:l (Integer. 1)})))))
#+clj
(deftest ^:slow repeated-bindings-test
(is (thrown? Exception (eval '(p/fnk [x [:x y]] (+ x y)))))
(is (thrown? Exception (eval '(p/fnk [{x {:y 1}} [:x y]] (+ x y)))))
(is (thrown? Exception (eval '(p/fnk [x :as x] (+ x y)))))
(is (thrown? Exception (eval '(p/fnk [x & x] (+ x y)))))
(is (thrown? Exception (eval '(p/fnk [{x {:y 1}} x] (+ x y)))))
(is (thrown? Exception (eval '(p/fnk [x [:x y] :as m] (+ x y)))))
(is (thrown? Exception (eval '(p/fnk [{x {:y 1}} [:x y] :as m] (+ x y)))))
(is (thrown? Exception (eval '(p/fnk [{x {:y 1}} x :as m] (+ x y))))))
(deftest optional-self-shadow-test
(is (= 1 (let [b 1] ((p/fnk [{a b}] a) {}))))
(doseq [[desc f] (let [a 1]
{"pos" (p/fnk [{a a}] a)
"non-pos" (p/fnk [{a a} :as m] a)})]
(testing desc
(is (= 1 (f {})))
(is (= 2 (f {:a 2}))))))
(deftest optional-cross-arg-shadow-test
(doseq [[desc f] (let [a 1 b 2 c 3 e 4 e 5]
{"pos" (p/fnk [c {a c} {b a} {d e} e] [a b c d e])
"non-pos" (p/fnk [c {a c} {b a} {d e} e :as m] [a b c d e])})]
(testing desc
(is (= [6 7 8 9 10] (f {:a 6 :b 7 :c 8 :d 9 :e 10})))
(is (= [8 7 8 9 10] (f {:b 7 :c 8 :d 9 :e 10})))
(is (= [8 8 8 9 10] (f {:c 8 :d 9 :e 10})))
(is (= [8 8 8 5 10] (f {:c 8 :e 10}))))))
(deftest dont-shadow-nested-test
(let [m {:x 1}]
(is (= 3 ((p/fnk [[:m x]] (+ x (:x m))) {:m {:x 2}})))))
(deftest miliis-test
(let [now #+clj (System/currentTimeMillis) #+cljs (.getTime (js/Date.))
threshold 5]
(is (> threshold
(- (p/millis) now)))))
(use-fixtures :once schema-test/validate-schemas)
prismatic-plumbing-clojure-0.5.4/test/plumbing/fnk/ 0000755 0000000 0000000 00000000000 13141156451 0022340 5 ustar 00root root 0000000 0000000 prismatic-plumbing-clojure-0.5.4/test/plumbing/fnk/fnk_examples_test.cljx 0000644 0000000 0000000 00000017546 13141156451 0026752 0 ustar 00root root 0000000 0000000 (ns plumbing.fnk.fnk-examples-test
"Explaining input and output schemata, fnk syntax, and their relationships
by example."
#+cljs
(:require-macros
[cemerick.cljs.test :refer [is deftest testing]])
(:require
[schema.core :as s]
[plumbing.core :as p :include-macros true]
[plumbing.fnk.schema :as schema]
[plumbing.fnk.pfnk :as pfnk]
#+clj [clojure.test :refer :all]
#+cljs cemerick.cljs.test))
#+cljs
(do
(def Exception js/Error)
(def AssertionError js/Error)
(def Throwable js/Error))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Input and output schemata
;; Input and output schemas describe the shape of nested maps with keyword keys
;; that are inputs and outputs of keyword functions, using the relevant
;; portions of the prismatic/schema library.
;; The structure of an input map is described using a nested map with keyword
;; keys, value schemas at the leaves, and (s/optional-key) for optional keys.
(def input-schema-1
{(s/optional-key :a) s/Any
:b s/Any
:c {:c1 s/Any (s/optional-key :c2) s/Any}})
;; Fnk and graph understand only this subset of schema; additional constructs
;; are allowed, but fnk cannot 'see through' them to reason about their
;; semantics.
;; Output schemas are similar, except that the output schemas for Graphs
;; must consist of only required keys at the top level.
(def output-schema-1
{:b s/Any
:c {:c1 s/Any :c3 s/Any}})
(def output-schema-2
{:b s/Any
:c s/Any})
;; plumbing.fnk.schema has library functions for building, composing,
;; and checking schemata
(deftest assert-satisfies-schema-test
(is (thrown? Exception (schema/assert-satisfies-schema input-schema-1 output-schema-2)))
(is (nil? (schema/assert-satisfies-schema input-schema-1 output-schema-1))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Fnk
;; For our purposes, a keyword function is an ordinary clojure fn? that
;; accepts a nested map with keyword keys as input, whose 'leaves' are
;; arbitrary values (including maps with non-keyword keys), and returns
;; an arbitrary value.
;; In addition, a keyword function must respond to the pfnk/io-schemata
;; call, returning a pair of an input schema and output schema.
;; (fnks also carry general function schemas via prismatic/schema, and
;; the pfnk/io-schemata protocol is just a convencience method on top of this).
;; We can manually define a simple fnk by attaching io-schemata metadata
;; to a fn satisfying the above properties:
(def a-manual-keyword-function
(pfnk/fn->fnk
(fn [{:keys [a b o] :or {o 10} :as m}]
(assert (every? #(contains? m %) [:a :b]))
{:x (+ a b o)})
[{:a s/Any :b s/Any (s/optional-key :o) s/Any s/Keyword s/Any}
{:x s/Any}]))
(defn test-simple-keyword-function [f]
(is (= {:x 13}
(f {:a 1 :b 2})))
;; for convience, you can also extract a pair of input and output scheams
(is (= [{:a s/Any :b s/Any (s/optional-key :o) s/Any s/Keyword s/Any}
{:x s/Any}]
(pfnk/io-schemata f)))
;; or the input-schema or output-schema individually.
(is (= {:a s/Any :b s/Any (s/optional-key :o) s/Any s/Keyword s/Any}
(pfnk/input-schema f)))
(is (= {:x s/Any}
(pfnk/output-schema f)))
;; a keyword function should throw if required keys not given.
(is (thrown? Throwable (f {:a 3}))))
(deftest a-manual-keyword-function-test
(testing "manual keyword fn"
(test-simple-keyword-function a-manual-keyword-function)))
;; As a shortcut for defining keyword functions, we've defined macros
;; 'fnk' and 'defnk' with a different destructuring syntax than
;; 'fn' and 'defn', and which automatically infer input and output
;; schemata. For more details and rationale for this syntax, see
;; plumbing.fnk/readme.md.
(p/defnk a-simple-fnk
"This fnk has required keys :a and :b, and an optional key :o
that defaults to 10 -- equivalent to a-manual-keyword-function."
[a b {o 10}]
{:x (+ a b o)})
;; This fnk automatically throws if required keys aren't present,
;; and infers its input schema from the binding form and output
;; schema from the literal map in its body.
(deftest a-simple-fnk-test
(testing "fnk macro keyword fn"
(test-simple-keyword-function a-simple-fnk)))
(p/defnk a-simple-fnk2
"This fnk is like a-simple-fnk, but does not have a literal
map body so nothing can be automatically inferred about its
output schema"
[a b {o 10}]
(hash-map :x (+ a b o)))
(deftest a-simple-fnk2-test
(is (= s/Any
(pfnk/output-schema a-simple-fnk2))))
;; For these cases, we can provide explicit metadata to hint the
;; output schema of the fnk.
(p/defnk a-simple-fnk3 :- {:x s/Any}
"This fnk is like a-simple-fnk2, but uses an explicit output
schema hint, and is equivalent to a-simple-fnk"
[a b {o 10}]
(hash-map :x (+ a b o)))
(deftest a-simple-fnk3-test
(testing "fnk with explicit output schema"
(test-simple-keyword-function a-simple-fnk3)))
;; You can also provide schema information on the inputs, with
;; validation like schema.core/defn. See (doc fnk) for details.
#+clj ;; This example uses clj-only annotations, but should otherwise work in cljs
(p/defnk a-schematized-fnk :- (s/pred odd?)
[a :- long b :- int]
(+ a b))
#+clj
(deftest a-schematized-fnk-test
(is (= [{:a long :b int s/Keyword s/Any} (s/pred odd?)]
(pfnk/io-schemata a-schematized-fnk)))
(testing "No validation by default"
(is (= 2 (a-schematized-fnk {:a 1 :b 1}))))
(s/with-fn-validation
(is (= 3 (a-schematized-fnk {:a 1 :b (int 2)})))
(is (thrown? Exception (a-schematized-fnk {:a 1 :b 2})))
(is (thrown? Exception (a-schematized-fnk {:a 1 :b (int 1)})))))
;; fnks also have support for nested bindings, and nested maps
;; for input and output schemata.
;; A nested map binding is introduced by an inner vector, whose
;; first element is a keyword specifying the key to bind under.
(p/defnk a-nested-fnk
[a [:b b1 {b2 5}] c]
{:sum (+ a b1 b2 c)
:products {:as a
:bs (* b1 b2)
:cs c}})
(deftest a-nested-fnk-test
(is (= {:sum 20
:products {:as 1
:bs 60
:cs 2}}
(a-nested-fnk {:a 1
:b {:b1 12}
:c 2})))
(is (= {:a s/Any
:b {:b1 s/Any (s/optional-key :b2) s/Any s/Keyword s/Any}
:c s/Any
s/Keyword s/Any}
(pfnk/input-schema a-nested-fnk)))
(is (= {:sum s/Any :products {:as s/Any :bs s/Any :cs s/Any}}
(pfnk/output-schema a-nested-fnk)))
(is (thrown? Throwable (a-nested-fnk {:a 1 :b {:b2 10} :c 3}))) ;; :b1 is missing
)
;; finally, fnks have support for :as and & bindings like Clojure's
;; built-in destructuring. :as binds a symbol to the entire map
;; input, and & binds to a map of any extra keys not destructured.
(p/defnk a-fancier-nested-fnk
[a [:b b1 :as b] :as m & more]
[a b1 b m more])
(deftest a-fancier-nested-fnk-test
;; :as and & are not reflected in input schema currently.
(is (= {:a s/Any :b {:b1 s/Any s/Keyword s/Any} s/Keyword s/Any}
(pfnk/input-schema a-fancier-nested-fnk)))
(is (= s/Any
(pfnk/output-schema a-fancier-nested-fnk)))
(is (= [1 2 {:b1 2 :b2 3} {:a 1 :b {:b1 2 :b2 3} :c 4} {:c 4}]
(a-fancier-nested-fnk {:a 1 :b {:b1 2 :b2 3} :c 4}))))
(p/defnk special-binding-fnk-with-schemas-1
[a :- s/Keyword :as m & r :- {s/Symbol s/Keyword}]
[a r m])
(p/defnk special-binding-fnk-with-schemas-2
[a :- s/Keyword & r :- {s/Symbol s/Keyword} :as m]
[a r m])
(deftest special-binding-fnk-with-schemas-test
(is (= {:a s/Keyword s/Symbol s/Keyword}
(pfnk/input-schema special-binding-fnk-with-schemas-1)
(pfnk/input-schema special-binding-fnk-with-schemas-2)))
(is (= [:foo {'bar :bar} {:a :foo 'bar :bar}]
(special-binding-fnk-with-schemas-1 {:a :foo 'bar :bar})
(special-binding-fnk-with-schemas-2 {:a :foo 'bar :bar}))))
prismatic-plumbing-clojure-0.5.4/test/plumbing/fnk/pfnk_test.cljx 0000644 0000000 0000000 00000001212 13141156451 0025213 0 ustar 00root root 0000000 0000000 (ns plumbing.fnk.pfnk-test
#+cljs
(:require-macros
[cemerick.cljs.test :refer [is deftest testing]])
(:require
[schema.core :as s]
[plumbing.core :as p :include-macros true]
[plumbing.fnk.pfnk :as pfnk]
#+clj [clojure.test :refer :all]
#+cljs cemerick.cljs.test))
(deftest meta-round-trip-test
(let [i-schema {:x s/Any}
o-schema {:y s/Any}
schemata [i-schema o-schema]
f (pfnk/fn->fnk (fn [m] {:y (inc (p/safe-get m :x))}) schemata)]
(is (= {:y 2} (f {:x 1})))
(is (= schemata (pfnk/io-schemata f)))
(is (= i-schema (pfnk/input-schema f)))
(is (= o-schema (pfnk/output-schema f)))))
prismatic-plumbing-clojure-0.5.4/test/plumbing/fnk/schema_test.cljx 0000644 0000000 0000000 00000013523 13141156451 0025525 0 ustar 00root root 0000000 0000000 (ns plumbing.fnk.schema-test
(:require
[schema.core :as s]
[schema.test :as schema-test]
[plumbing.core :as p :include-macros true]
[plumbing.fnk.pfnk :as pfnk]
[plumbing.fnk.schema :as fnk-schema]
#+clj [clojure.test :refer :all]
#+cljs [cemerick.cljs.test :refer-macros [is are deftest testing use-fixtures]]))
#+cljs
(do
(def Exception js/Error)
(def RuntimeException js/Error))
#+clj ;; the expression-munging doesn't play well with cljs.
(deftest explicit-schema-key-map-test
(is (= {:foo true :bar false :baz false}
(fnk-schema/explicit-schema-key-map
{:foo s/Any (s/optional-key :bar) s/Any s/Keyword s/Keyword
`(s/optional-key :baz) s/Any}))))
(deftest split-schema-keys-test
(is (= [[:foo :bar] [:baz :bat]]
(fnk-schema/split-schema-keys
(array-map :foo true :baz false :bar true :bat false)))))
(deftest merge-on-with-test
(is (= {0 5 4 9 9 12}
(#+clj #'fnk-schema/merge-on-with #+cljs fnk-schema/merge-on-with
#(quot % 2) min + {1 2 4 9 9 4} {9 8 0 3}))))
(deftest union-input-schemata-test
(is (= {:a s/Any}
(fnk-schema/union-input-schemata {:a s/Any} {:a s/Any})))
(is (= {:a s/Str}
(fnk-schema/union-input-schemata {:a s/Str} {(s/optional-key :a) s/Str})))
(is (= {:a s/Str}
(fnk-schema/union-input-schemata {(s/optional-key :a) s/Str} {:a s/Any})))
(is (= {:a s/Str} ;; punt, should be both Str and Num
(fnk-schema/union-input-schemata {(s/optional-key :a) s/Str} {:a s/Num})))
(is (= {:a {(s/optional-key :a1) s/Str
:a2 s/Num
:a3 s/Str}
(s/optional-key :b) s/Num}
(fnk-schema/union-input-schemata
{:a {(s/optional-key :a1) s/Str
(s/optional-key :a2) s/Num}
(s/optional-key :b) s/Num}
{:a {:a2 s/Num
:a3 s/Str}}))))
(deftest required-toplevel-keys-test
(is (= #{:a :b}
(set
(fnk-schema/required-toplevel-keys
{:a {:a1 s/Str}
:b s/Int
(s/optional-key :c) s/Any})))))
(deftest guess-expr-output-schema-test
(is (= 'schema.core/Any (fnk-schema/guess-expr-output-schema "foo")))
(is (= {:a 'schema.core/Any :b 'schema.core/Any} (fnk-schema/guess-expr-output-schema {:a (+ 1 1) :b false})))
(is (= 'schema.core/Any (fnk-schema/guess-expr-output-schema {'a (+ 1 1)}))))
(deftest compose-schemata-test
(is (= [{:a s/Any :c s/Any :d s/Any}
{:x s/Any}]
(fnk-schema/compose-schemata
[{:a s/Any :b {:b1 s/Any} :c s/Any}
{:x s/Any}]
[{:c s/Any :d s/Any}
{:b {:b1 s/Any}}])))
(is (= [{:a s/Any (s/optional-key :e) s/Any :c s/Any :d s/Any}
{:x s/Any}]
(fnk-schema/compose-schemata
[{:a s/Any
:b {:b1 s/Any}
(s/optional-key :c) s/Any
(s/optional-key :e) s/Any
(s/optional-key :f) s/Any}
{:x s/Any}]
[{:c s/Any :d s/Any}
{:b {:b1 s/Any} :c s/Any :f s/Any}])))
(is (thrown? Exception
(fnk-schema/compose-schemata
[{:a s/Any :b {:b1 s/Any} :c s/Any}
{:x s/Any}]
[{:c s/Any :d s/Any}
{:b s/Any}]))))
(deftest sequence-schemata-test
(is (= [{:a s/Any (s/optional-key :b) s/Any} {:c s/Any :o2 {:o21 s/Any}}]
(fnk-schema/sequence-schemata
[{:a s/Any} {:c s/Any}]
[:o2 [{(s/optional-key :b) s/Any :c s/Any} {:o21 s/Any}]])))
(is (= [{:a s/Any, :o2 s/Any, (s/optional-key :b) s/Any}
{:o2 {:o21 s/Any}, :c s/Any}]
(fnk-schema/sequence-schemata
[{:a s/Any} {:c s/Any}]
[:o2 [{(s/optional-key :b) s/Any :c s/Any :o2 s/Any} {:o21 s/Any}]])))
(is (thrown? RuntimeException
(fnk-schema/sequence-schemata
[{:a s/Any} {:c s/Any :o2 s/Any}]
[:o2 [{(s/optional-key :b) s/Any :c s/Any} {:o21 s/Any}]])))
(is (thrown? RuntimeException
(fnk-schema/sequence-schemata
[{:a s/Any :o2 s/Any} {:c s/Any}]
[:o2 [{(s/optional-key :b) s/Any :c s/Any} {:o21 s/Any}]]))))
(deftest fnk-input-schemata-test
(are [in fnk-form] (= in (pfnk/input-schema fnk-form))
{:x s/Any :y s/Any s/Keyword s/Any}
(p/fnk [x y])
{:x s/Any (s/optional-key :y) s/Any :z s/Any s/Keyword s/Any}
(p/fnk [x {y 2} z])
{:x s/Any (s/optional-key :y) s/Any :z s/Any :q {:r s/Any s/Keyword s/Any} s/Keyword s/Any}
(p/fnk [x {y 2} z [:q r] :as m & more])
{(s/optional-key :x) s/Any :y {:alias s/Any s/Keyword s/Any} s/Keyword s/Any}
(p/fnk [ {x 1} [:y alias]])
{(s/optional-key :o1) s/Any
:o2 s/Any
: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}
s/Keyword s/Any}
(p/fnk [{o1 1} o2 [:o3 x {y 2} z [:q r]]]))
#+clj
(do
(is (= [1 2] ((eval `(p/fnk [[:x ~'x] [:y ~'y]] [~'x ~'y])) {:x {:x 1} :y {:y 2}})))
(is (thrown? Throwable (eval `(p/fnk [{:y ~'x} {:y ~'y}] [~'x ~'y]))))
(is (thrown? Throwable (eval `(p/fnk [{:x ~'x} {:y ~'x}] [~'x]))))
(is (thrown? Throwable (eval `(p/fnk [[:x ~'x] ~'x] [~'x]))))
(is (thrown? Throwable (eval `(p/fnk [{~'x 1} ~'x] [~'x]))))))
(deftest fnk-out-schemata-test
;; Are somehow breaks the metadata on fnk forms.
(is (= s/Any (pfnk/output-schema (p/fnk []))))
(is (= s/Any (pfnk/output-schema (p/fnk [] (hash-map :x :y)))))
(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}}}))))
(is (= {:o1 s/Any :o2 s/Any} (pfnk/output-schema (p/fnk f :- {:o1 s/Any :o2 s/Any} [x]))))
(is (= {:o1 s/Any :o2 s/Any} (pfnk/output-schema (p/fnk f :- {:o1 s/Any :o2 s/Any} [x]
{:o1 x :o2 {:i x :j {:q 2}}})))))
(use-fixtures :once schema-test/validate-schemas)
prismatic-plumbing-clojure-0.5.4/test/plumbing/graph_async_test.cljx 0000644 0000000 0000000 00000002035 13141156451 0026001 0 ustar 00root root 0000000 0000000 (ns plumbing.graph-async-test
#+cljs
(:require-macros
[cljs.core.async.macros :refer [go]])
(:require
[plumbing.core :as plumbing :include-macros true]
[plumbing.graph-async :as graph-async]
#+clj [clojure.core.async :as async :refer [go fnk
(fn [{:keys [a b] :as m}]
(assert (every? #(contains? m %) [:a :b]))
{:x (+ a b)})
[{:a s/Any :b s/Any s/Keyword s/Any}
{:x s/Any}]))
(defn test-simple-keyword-function [f]
(is (= {:x 3}
(f {:a 1 :b 2})))
;; a keyword function knows its io-schemata
(is (= [{:a s/Any :b s/Any s/Keyword s/Any}
{:x s/Any}]
(pfnk/io-schemata f)))
;; a keyword function should throw if required keys not given.
(is (thrown? Throwable (f {:a 3}))))
(deftest a-manual-keyword-function-test
(test-simple-keyword-function a-manual-keyword-function))
;; Because this is rather tedious, we've defined new macros 'fnk' and
;; 'defnk' that define keyword functions that automatically compute
;; their own input and output schemata, and also include a new
;; destructuring syntax that we find convenient for working with Graphs
;; (and elsewhere).
(p/defnk a-simple-fnk
"This fnk is equivalent to a-manual-keyword-function."
[a b]
{:x (+ a b)})
(deftest a-simple-fnk-test
(test-simple-keyword-function a-simple-fnk))
;; In this simple case, fnks are similar to Clojure's {:keys []}
;; destructuring. Functionally, the main differences are slightly
;; cleaner syntax for optional arguments and nested maps, assertions
;; by default that all required keys are present, and the automatic
;; assignment of input and output schema metadata.
;; (You do not have to use 'fnk' to use Graph, however -- see
;; plumbing.fnk.fnk-examples-test for more motivation and details about
;; fnk, as well as a description of how to define keyword functions
;; that can be used with Graph without the 'fnk' macro.)
;; With this addition, we can now formally define a Graph: a Graph is just
;; a (possibly-nested) map from keywords to fnks. The required keys of each
;; fnk specify the node relationships: each required key refers to the output
;; of a previous node function under the same name, or if no such node is
;; present, the value associated with this keyword in the input map.
(defn graph? [g]
(or (and (fn? g) (try (pfnk/io-schemata g) true (catch Throwable t false)))
(and (map? g)
(every? (fn [[k sub-g]]
(and (keyword? k)
(graph? sub-g)))
g))))
(deftest graph?-test
(is (graph? stats-graph))
(is (not (graph? {:a (fn [x] (inc x))})))
(is (not (graph? {:a 42})))
(is (not (graph? {"a" (p/fnk [x] (inc x))}))))
;; The entire Graph itself specifies a fnk from input parameters to a map
;; of results, just like the example 'stats' fn written explicitly with
;; defn and let above. Note, however, that the graph itself just describes the
;; compositional structure of the computation, but says nothing about
;; the actual execution strategy.
;; That said, to be well-defined, a Graph must specify an *acyclic*
;; computation. That is, there must exist a valid topological ordering
;; of the node functions, so that each node function only depends on the
;; outputs of previous node functions.
;; When you ask for the io-schemata of a Graph, a valid topological
;; ordering is automatically computed, and an error will be thrown if the
;; Graph has a cycle. You can also call graph/->graph on a map to
;; check that it represents a valid Graph, and return an array-map
;; version of the Graph where the nodes are in a valid topological order.
(deftest topological-graph-ordering-test
;; ->graph finds the only valid topological order
(is (= [:x :y]
(keys (graph/->graph
{:y (p/fnk [x] (* 2 x))
:x (p/fnk [a] (inc a))})))))
;; Subgraphs can have nodes which shadow nodes in parent graphs.
;; The value computed in the most local graph (e.g. the same graph)
;; should shadow the values of the one from the parent graph, but they
;; can take the value from the parent as input.
;; when using a positional graph, you need to order your nodes such that
;; the local version is created before it is used.
#+clj
(deftest local-scoping-rules-test
(let [x (p/fnk [a x] (inc (+ a x)))
y (p/fnk [x] (* 2 x))
z (graph/->graph
{:x (p/fnk [x] (+ x 13))
:x2 (p/fnk [x] (inc x))})
normalize-output (p/fn->> (into {})
(p/<- (update-in [:z] #(into {} %))))
expected-result {:x 27 :y 54 :z {:x 40 :x2 41}}
graph-result (->> {:a 5 :x 21}
((graph/compile (graph/->graph {:y y :x x :z z})))
normalize-output)
positional-graph-result (->> ((graph/positional-eager-compile
(graph/graph :x x :y y :z z)
[:a :x])
5 21)
normalize-output)]
(is (= expected-result graph-result positional-graph-result))
(is (thrown? RuntimeException (graph/graph :y y :x x :z z)))))
;; If you're defining a graph explicitly in code, it's rather bad form
;; to put the nodes out of topological order (like the first example
;; above). To enforce that the nodes are actually provided in a valid
;; order (for readability, and to catch bugs), you can use the 'graph'
;; constructor:
(deftest ordered-graph-constructor-test
;; nodes in of topological order.
(is (= [:x :y]
(keys (graph/graph
:x (p/fnk [a] (inc a))
:y (p/fnk [x] (* 2 x))))))
;; nodes out of topological order
(is (thrown? Exception
(graph/graph
:y (p/fnk [x] (* 2 x))
:x (p/fnk [a] (inc a))))))
;; Finally, while all of the Graphs we've seen thus far have a single
;; level of nesting, we can also create deeper graphs where each node
;; is itself a graph, and use fnk's nested binding syntax to pull
;; keys out of subgraphs. Like in the flat case, to the extent possible,
;; everything is checked at compile-time to ensure the composition is
;; well-formed. Schemas on the function inputs and outputs propagate
;; to the graph schema.
(deftest a-nested-graph-test
(let [a-nested-graph {:x (p/fnk xf :- s/Int [a :- s/Int] (inc a))
:y {:y1 (p/fnk [a x] (* a x))
:y2 (p/fnk [b y1] (* y1 (dec b)))}
:z (p/fnk [x [:y y1 y2]] ;; nested binding!
(- y1 y2))}
f (graph/compile a-nested-graph)]
(is (= [{:a s/Int :b s/Any s/Keyword s/Any}
{:x s/Int
:y {:y1 s/Any :y2 s/Any}
:z s/Any}]
(pfnk/io-schemata f)))
(is (= -6
(- (* 1 (inc 1)) (* 1 (inc 1) (dec 5)))
(:z (f {:a 1 :b 5})))))
;; The presence of the correct nested keys is checked when a graph
;; is verified -- so here, we know that :x does not produce sub-key
;; :x-out2 required by the node function of :y.
(is (thrown? Exception
(graph/->graph
{:x (p/fnk [a] {:x-out (inc a)})
:y (p/fnk [[:x x-out2]] (inc x-out2))}))))
;; For more about the nested binding syntax of fnk, check out the
;; docstring or plumbing.fnk.fnk_examples_test.cljx.
;; Nested graphs essentially model lexical scope, so a subgraph
;; can refer to any node or input at a previous ancestor, but
;; it can not refer directly to later nodes or arbitrary descencents
;; of ancestors.
;; We use nested graphs extensively when composing production services,
;; an application we explore briefly at the end of this file.
;; Finally, there is one more thing to know about the semantics of
;; Graph nodes -- they get only what they ask for. So while 'fnk'
;; and friends allow binding a symbol to the entire top-level map
;; (or additional keys) with :as (or &), in the context of a Graph,
;; only explicitly named required or optional keys will be provided.
(deftest graph-as-test
(let [x-fn (p/fnk [a {b 2} :as m] ;; b is optional with default 2, m bound to whole input
[a b m])]
(is (= [1 2 {:a 1}]
(x-fn {:a 1})))
;; When called directly, the :as binding gets the whole map
(is (= [1 10 {:a 1 :b 10 :c 100}]
(x-fn {:a 1 :b 10 :c 100})))
;; When called in a graph, it only gets what it asked for -- :a and :b
(is (= [1 10 {:a 1 :b 10}]
(:x (graph/run {:x x-fn} {:a 1 :b 10 :c 100}))))))
(deftest graph-ampersand-test
(let [x-fn (p/fnk [a {b 2} & m]
[a b m])]
;; When called directly, the & binding gets the leftover inputs
(is (= [1 2 {:c 3 :d 4}]
(x-fn {:a 1 :c 3 :d 4})))
;; When called in a graph, it only gets what it asked for -- :a and :b
(is (= [1 2 {}]
(:x (graph/run {:x x-fn} {:a 1 :c 100}))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compiling Graphs
;; Compiling a graph produces a single fnk that can be called with an
;; input map to produce an output map. We've already illustrated the
;; basic compilation strategies above -- eager, lazy, and parallel,
;; so we'll just say a bit more about them here.
;; For example, here's a graph with the same shape as 'stats' but
;; where the nodes are slow to compute:
#+clj
(do
(def slow-graph
(graph/graph
:a (p/fnk [x] (Thread/sleep 100) (inc x))
:b1 (p/fnk [a] (Thread/sleep 200) (* a 2))
:b2 (p/fnk [a] (Thread/sleep 300) (- a 3))
:c (p/fnk [b1 b2] (Thread/sleep 50) (+ b1 b2))))
;; Then, we can example the properties of the different compilations
;; on this graph. First, some scaffolding:
(defmacro timed-is
"Test that (pred form) and also that form takes about
expected-ms milliseconds to run, and return the output of form"
[expected-ms pred form]
`(let [start# (p/millis)
v# ~form
pv# (~pred v#)
end# (p/millis)]
(is (identity pv#))
(is (< (Math/abs (- ~expected-ms (- end# start#))) 30))
v#))
(deftest ^:slow timed-compilation-tests
(let [in {:x 3}
out {:a 4 :b1 8 :b2 1 :c 9}]
;; eager computes everything before returning
(let [eager (graph/eager-compile slow-graph)
eager-out (timed-is 650 identity (eager in))]
;; into {} because eager-compile returns a record for speed.
(timed-is 0 true? (= out (into {} eager-out))))
;; lazy computes stuff as needed
(let [lazy (graph/lazy-compile slow-graph)
lazy-out (timed-is 0 keys (lazy in))]
(timed-is 400 true? (= (:b2 out) (:b2 lazy-out))) ;; 100 + 300
(timed-is 250 true? (= (:c out) (:c lazy-out))) ;; 200 + 50
(timed-is 0 true? (= (:b1 out) (:b1 lazy-out)))) ;; already computed by :c
;; lazy computes stuff as needed
(let [par (graph/par-compile slow-graph)
par-out (timed-is 0 keys (par in))]
(timed-is 450 true? (= out (into {} par-out))))))) ;; :b1 and :b2 are done in parallel
;; There are also some compilation modes for performance tuning. If you're
;; going to call your graph in an inner loop, where creating and destructuring
;; maps would be too expensive, you can get an ordinary positional function
;; version with positional-eager-compile.
(def fast-graph
(graph/graph
:a (p/fnk [x] (inc x))
:b1 (p/fnk [a] (* a 2))
:b2 (p/fnk [a] (- a 3))
:c (p/fnk [b1 b2] (+ b1 b2))))
#+clj
(deftest positional-graph-test
(let [out {:a 4 :b1 8 :b2 1 :c 9}
positional-fast (graph/positional-eager-compile fast-graph [:x])
output (positional-fast 3)]
(testing "output is a record, not a map"
(is (not (hash-or-array-map? output))))
(is (= out (into {} output)))))
;; You won't get all the speedup if you have fnks that expect graph parameters,
;; though, such as
;; (p/fnk [x & more])
;; (p/fnk [x y :as all])
;; (fn->fnk (fn [m]) {:x true})
;; It's also worth noting that eager-compile does many of the same
;; optimizations on the inside, so it also returns a record, not a map.
#+clj
(deftest eager-graph-test
(let [out {:a 4 :b1 8 :b2 1 :c 9}
eager-fast (graph/eager-compile fast-graph)
output (eager-fast {:x 3})]
;; The output is a record, not a map.
(testing "output is a record, not a map"
(is (not (hash-or-array-map? output))))
(is (= out (into {} output)))))
;; On the other hand, if you're worried about the computational expense of
;; compiling, you can reduce it from a few tens of milliseconds (usually not a
;; problem unless you're doing it many times) to a few milliseconds by using
;; interpreted-eager-compile. But the resulting function will be a bit slower.
(deftest interpreted-graph-test
(let [out {:a 4 :b1 8 :b2 1 :c 9}
interpreted-fast (graph/interpreted-eager-compile fast-graph)
output (interpreted-fast {:x 3})]
(testing "output is a map"
(is (hash-or-array-map? output)))
(is (= out (into {} output)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 'Comp-partial' and 'instance'
;; graph also defines an composition operation on keyword functions called
;; comp-partial, which is useful in graph and elsewhere.
;; (comp-partial-fn f1 f2) returns a new keyword function equivalent to
;; #(f1 (merge % (f2 %))), with inferred input and output schemata.
;; comp-partial throws if outputs of f2 used by f1 do not satisfy
;; the input structure required by f1, and 'comp-partial' is similar, except
;; it works on graphs as well as simple fnks.
(deftest comp-partial-fn-test
(let [f1 (p/fnk [a [:b b1] c]
{:x (+ a b1 c)})
f2 (p/fnk [c d]
{:b {:b1 (* c d)}})
composed (graph/comp-partial-fn f1 f2)]
;; the final function does not require :b, since it is provided to f1 by f2.
(is (= [{:a s/Any :c s/Any :d s/Any s/Keyword s/Any}
{:x s/Any}]
(pfnk/io-schemata composed)))
(is (= {:x 20}
(composed {:a 2 :c 2 :d 8})))
;; This throws, because the value output by the second function under :b
;; cannot satisfy the input schema of f1 under :b.
(is (thrown? Throwable (graph/comp-partial-fn f1 (p/fnk [c d] {:b (* c d)}))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; More fun stuff with Graphs
;; In the above examples, we've already seen a number of interesting
;; things we can do with Graphs that we could not do with ordinary
;; (opaque) function compositions, including:
;; - automatic computation of input and output schemas
;; - automatic lazy and parallel compilations
;; - easy extension with normal map operations (assoc, etc.)
;; - automatic profiling of individual node execution times
;; Here we explore a few more interesting ideas centered around
;; defining, executing, monitoring, and testing production services.
;; These are techniques we already use in our real production services,
;; and we plan to release our real implementations soon (we wouldn't
;; recommend using the simple test implementations here for that purpose).
;; While the basic machinery in this setting is the same as above, its
;; use is rather different. In particular, each service is defined by a
;; Graph that executes once on service startup, with each node building
;; a resource (such as a storage system, cache, thread pool, web server, etc)
;; that can be in turn used by other resources. The output of this
;; graph is a map of resources that can be introspected for debugging
;; while the service runs, and on shutdown can be used to cleanly close
;; out all components in the correct order (the inverse of startup).
;; In this case, a very simple approach would be to have each node function
;; return a map with two possible keys:
;; - :resource is the actual resource that should be passed into other
;; nodes,
;; - :shutdown is a shutdown hook to cleanly shut down this resource.
;; Under this simple scheme, we can define functions to start up and
;; shutdown a service in just 20 lines of code.
#+clj
(do
(defn resource-transform [g]
(assoc (map/map-leaves
(fn [node-fn]
(pfnk/fn->fnk
(fn [m]
(let [r (node-fn m)]
(when-let [shutdown (:shutdown r)]
(swap! (:shutdown-hooks m) conj shutdown))
(assert (contains? r :resource))
(:resource r)))
[(assoc (pfnk/input-schema node-fn) :shutdown-hooks s/Any)
(pfnk/output-schema node-fn)]))
g)
:shutdown-hooks (p/fnk [] (atom nil))))
(defn start-service [graph params]
((graph/eager-compile (resource-transform graph)) params))
(defn shutdown-service [m]
(doseq [f @(:shutdown-hooks m)]
(f)))
;; Now we'll have to get a bit imaginative, since we don't have much
;; in the way of interesting resources available on our classpath
;; at the moment. We can start with simple resources like this one:
(p/defnk schedule-work
"Cron for clojure fns. Schedule a single fn with a pool to run every rate seconds."
[work-fn rate]
(let [pool (java.util.concurrent.Executors/newSingleThreadScheduledExecutor)]
(.scheduleAtFixedRate pool work-fn (long 0) (long rate) java.util.concurrent.TimeUnit/SECONDS)
{:resource nil
:shutdown #(.shutdown pool)}))
;; and then we can build up more complex resources as Graphs from these
;; components (getting a bit silly for the sake of brevity):
(def expiring-cache
(graph/graph
:atom (p/fnk [] {:resource (atom nil)})
:prune (p/fnk [atom max-age {prune-rate 1}]
(schedule-work
{:work-fn (fn [] (swap! atom (fn [m]
(let [cutoff (- (p/millis) (* 1000 max-age))]
(p/for-map [[k [v ts]] m
:when (> ts cutoff)]
k [v ts])))))
:rate prune-rate}))))
(defn ec-get [ec k f]
(p/letk [[atom] ec]
(if-let [[_ [v]] (find @atom k)]
v
(let [v (f k)]
(swap! atom assoc k [v (p/millis)])
v))))
;; and finally we can build up services from these components
(def pointless-service
(graph/graph
:cache expiring-cache
:sql-query (p/fnk []
;; pretend this gives a database query fn
(throw (RuntimeException.)))
:web-server (p/fnk [cache sql-query]
;; pretend this is a real webserver, not just a fn.
{:resource (fn [q] (ec-get cache q sql-query))})))
;; and we can start and stop these services, and mock out components
(defn test-pointless-service [graph params]
(let [svc-map (start-service
(assoc graph
:sql-query (p/fnk mock-sql [] {:resource inc}))
params)
web-server (:web-server svc-map)]
(is (= 3 (web-server 2)))
(is (= 11 (web-server 10)))
(is (= #{2 10} (-> svc-map :cache :atom deref keys set)))
(Thread/sleep 3000)
(is (= #{} (-> svc-map :cache :atom deref keys set)))
(shutdown-service svc-map)))
(deftest ^:slow pointless-service-test
(test-pointless-service pointless-service {:max-age 1})))
;; To make this sort of composition useful on a large scale, we also
;; need a way to provide contextual arguments to subgraphs,
;; via a version of comp-partial. We do this extensively in our
;; real services, but are still working on cleaning this mechanism
;; up and preparing it for release.
;; Stay tuned for future releases that will include our library
;; of useful resources and subgraphs, utilities for starting, stopping,
;; and managing services based on Graph, and more.
prismatic-plumbing-clojure-0.5.4/test/plumbing/graph_perf_test.clj 0000644 0000000 0000000 00000026447 13141156451 0025445 0 ustar 00root root 0000000 0000000 (ns plumbing.graph-perf-test
"Simple performance test based on example graph from Climate."
(:use
[plumbing.core :only [fnk]])
(:require
[plumbing.graph :as graph]))
(def ^:const kelvin 273.15)
(def ^:const days-in-year 365)
(defn to-kelvin
"Converts Celcius to Kelvin"
^double [^double temp]
(+ temp kelvin))
(defn inverse-relational-distance
"Inverse relational distance between the Earth and sun at a
given day of the year (1 to 366)"
^double [^long day-of-year]
(-> (* day-of-year 2 Math/PI)
(/ days-in-year)
Math/cos
(* 0.033)
inc))
(defn solar-declination
"Solar declination at a given day of the year (1 to 366)"
^double [^long day-of-year]
(-> (* day-of-year Math/PI 2)
(/ days-in-year)
(- 1.39)
Math/sin
(* 0.409)))
(defn sunset-hour-angle
"Sunset hour angle given day of year (1 to 366) and latitude in radians"
^double [^double solar-dec ^double lat-in-rad]
(-> (Math/tan lat-in-rad)
(* (Math/tan solar-dec) -1)
Math/acos))
(defn sat-vapour-pressure
"Saturated vapour pressure at given temperature
Parameters
----------
temp: float
Temperature, deg C
Returns
-------
Saturated vapour pressure, kPa"
^double [^double temp]
(* 0.6108 (-> (* temp 17.27) (/ (+ temp 237.3)) Math/exp)))
(defn degree-to-radians
"Convert degrees to radians"
^double [^double deg]
(-> (* deg Math/PI)
(/ 180)))
(defn solar-rad-et
"Extraterrestrial solar radiation
Parameters
----------
day-of-year: int
Day of the year (1 to 366)
lat: float
Latitude, decimal degrees
Returns:
-------
solar radiation, MJ/(m^2*day)"
^double [^long day-of-year ^double lat]
(let [lat-in-rad (degree-to-radians lat)
inv-dist (inverse-relational-distance day-of-year)
c (-> (* 24 60 0.0820 inv-dist)
(/ Math/PI))
solar-dec (solar-declination day-of-year)
sun-hour-angle (sunset-hour-angle solar-dec lat-in-rad)
a (* sun-hour-angle (Math/sin lat-in-rad) (Math/sin solar-dec))
b (* (Math/cos lat-in-rad) (Math/cos solar-dec) (Math/sin sun-hour-angle))]
(* c (+ a b))))
(def solar-rad-from-temp
"Estimate the solar radiation from temperature
Required
--------
lat: float,
Latitude, decimal degrees
alt: float,
Altitude, in m
tmax, tmin: float
Maximum and minimum temperatures, deg C. Must be
between -5 and 45 C.
doy: int
Day of the year (1 to 366)
Optional
--------
kRs: float, default = 0.16
adjustment coefficient for solar radiation
a: float, default = 0.23
Canopy reflection coefficient (default is for grass)
Calculated
----------
tmaxK: float
Max Temperature in Kelvin
tminK: float
Min Temperature in Kelvin
Ra: float
Rs: float
Rso: float
Rns: float
Net short wave radiation
Rn: float
Net solar radiation, MJ/(m^2*day)"
{:Ra (fnk [doy lat] (solar-rad-et doy lat))
:Rs (fnk [tmax tmin {kRs 0.16} Ra] (-> (- tmax tmin) Math/sqrt (* kRs Ra)))
:Rso (fnk [alt Ra] (-> (* 2e-5 alt) (+ 0.75) (* Ra)))
:Rns (fnk [{a 0.23} Rs] (-> (- 1 a) (* Rs)))
:tmaxK (fnk [tmax] (to-kelvin tmax))
:tminK (fnk [tmin] (to-kelvin tmin))
:ea (fnk [tmin] (sat-vapour-pressure tmin))
:term1 (fnk [tmaxK tminK {s 4.903e-9}]
(-> (Math/pow tmaxK 4) (+ (Math/pow tminK 4)) (* s) (/ 2)))
:term2 (fnk [ea] (-> (Math/sqrt ea) (* -0.14) (+ 0.34)))
:term3 (fnk [Rs Rso] (-> (* 1.35 Rs) (/ Rso) (- 0.35)))
:Rnl (fnk [term1 term2 term3] (* term1 term2 term3))
:Rn (fnk [Rns Rnl] (- Rns Rnl))})
(defn solar-rad-from-temp-fn
([lat alt tmax tmin day-of-year]
(let [kRs 0.16
a 0.23]
(solar-rad-from-temp-fn kRs lat alt tmax tmin day-of-year a)))
([kRs lat alt tmax tmin day-of-year]
(let [a 0.23]
(solar-rad-from-temp-fn kRs lat alt tmax tmin day-of-year a)))
([kRs lat alt tmax tmin day-of-year a]
(let [Ra (solar-rad-et day-of-year lat)
Rs (-> (- tmax tmin) Math/sqrt (* kRs Ra)) ;;solar radiaion
Rso (-> (* 2e-5 alt) (+ 0.75) (* Ra)) ;;Clear sky solar radiation
Rns (-> (- 1 a) (* Rs)) ;;net short wave radiation
s 4.903e-9 ;;Stefan-Boltzman constant, MJ/(K^4*m^2*day^-1)
tmax-kelvin (to-kelvin tmax)
tmin-kelvin (to-kelvin tmin)
ea (sat-vapour-pressure tmin)
term-1 (-> (Math/pow tmax-kelvin 4)
(+ (Math/pow tmin-kelvin 4))
(* s)
(/ 2))
term-2 (-> (Math/sqrt ea) (* -0.14) (+ 0.34))
term-3 (-> (* 1.35 Rs) (/ Rso) (- 0.35))
Rnl (* term-1 term-2 term-3)
Rn (- Rns Rnl)]
Rn)))
(defmacro fn-call
[args body]
`((fn ~args ~body) ~@args))
(defrecord SolarRadRecord [Ra Rs Rso Rns tmax-kelvin tmin-kelvin ea term-1
term-2 term-3 Rnl Rn])
(defn solar-rad-from-temp-fn-calls
([lat alt tmax tmin day-of-year]
(let [kRs 0.16
a 0.23]
(solar-rad-from-temp-fn-calls kRs lat alt tmax tmin day-of-year a)))
([kRs lat alt tmax tmin day-of-year]
(let [a 0.23]
(solar-rad-from-temp-fn-calls kRs lat alt tmax tmin day-of-year a)))
([kRs lat alt tmax tmin day-of-year a]
(let [Ra (fn-call [day-of-year lat] (solar-rad-et day-of-year lat))
Rs (fn-call [tmax tmin kRs Ra] (-> (- tmax tmin) Math/sqrt (* kRs Ra)))
Rso (fn-call [alt Ra] (-> (* 2e-5 alt) (+ 0.75) (* Ra)))
Rns (fn-call [a Rs] (-> (- 1 a) (* Rs)))
tmaxK (fn-call [tmax] (to-kelvin tmax))
tminK (fn-call [tmin] (to-kelvin tmin))
ea (fn-call [tmin] (sat-vapour-pressure tmin))
term1 (fn-call [tmaxK tminK]
(-> (Math/pow tmaxK 4) (+ (Math/pow tminK 4)) (* 4.903e-9) (/ 2)))
term2 (fn-call [ea] (-> (Math/sqrt ea) (* -0.14) (+ 0.34)))
term3 (fn-call [Rs Rso] (-> (* 1.35 Rs) (/ Rso) (- 0.35)))
Rnl (fn-call [term1 term2 term3] (* term1 term2 term3))
Rn (fn-call [Rns Rnl] (- Rns Rnl))]
(new SolarRadRecord Ra Rs Rso Rns tmaxK tminK ea term1 term2 term3 Rnl Rn))))
(defn -main
[& args]
;; Simple profiling, comparing the various compilations to the let
;; implementation.
(println "Interpreted eager")
(println " compiling")
(let [solar-rad-as-graph (time (graph/interpreted-eager-compile solar-rad-from-temp))]
(println " gives value" (solar-rad-as-graph {:lat 45.0 :alt 100.0 :tmin 15.0 :tmax 25.0 :doy 205}))
(dotimes [_ 10]
(time (dotimes [_ 10000]
(solar-rad-as-graph {:lat 45.0 :alt 100.0 :tmin 15.0 :tmax 25.0 :doy 205})))))
(println)
(println "Eager called with map")
(println " compiling")
(let [solar-rad-pos-graph (time (graph/eager-compile solar-rad-from-temp))]
(println " gives value" (solar-rad-pos-graph {:lat 45.0 :alt 100.0 :tmin 15.0 :tmax 25.0 :doy 205}))
(dotimes [_ 10]
(time (dotimes [_ 10000]
(solar-rad-pos-graph {:lat 45.0 :alt 100.0 :tmin 15.0 :tmax 25.0 :doy 205})))))
(println)
(println "Eager positional fn")
(println " compiling")
(let [solar-rad-pos-graph-pos (time (graph/positional-eager-compile
(into {} solar-rad-from-temp)
[:lat :alt :tmin :tmax :doy]))]
(println " gives value" (solar-rad-pos-graph-pos 45.0 100.0 15.0 25.0 205))
(dotimes [_ 10]
(time (dotimes [_ 10000]
(solar-rad-pos-graph-pos 45.0 100.0 15.0 25.0 205)))))
(println)
(println "Let with fn calls")
(println " no need to compile")
(println " gives value" (solar-rad-from-temp-fn-calls 45.0 100.0 25.0 15.0 205))
(dotimes [_ 10]
(time (dotimes [_ 10000]
(solar-rad-from-temp-fn-calls 45.0 100.0 25.0 15.0 205))))
(println)
(println "Let")
(println " no need to compile")
(println " gives value" (solar-rad-from-temp-fn 45.0 100.0 25.0 15.0 205))
(dotimes [_ 10]
(time (dotimes [_ 10000]
(solar-rad-from-temp-fn 45.0 100.0 25.0 15.0 205)))))
;;Interpreted eager
;; compiling
;;"Elapsed time: 6.037156 msecs"
;; 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}
;;"Elapsed time: 391.094708 msecs"
;;"Elapsed time: 341.611376 msecs"
;;"Elapsed time: 333.087152 msecs"
;;"Elapsed time: 367.831138 msecs"
;;"Elapsed time: 341.161334 msecs"
;;"Elapsed time: 324.572381 msecs"
;;"Elapsed time: 337.84041 msecs"
;;"Elapsed time: 336.182569 msecs"
;;"Elapsed time: 360.237391 msecs"
;;"Elapsed time: 371.491237 msecs"
;;
;;Eager called with map
;; compiling
;;"Elapsed time: 36.108162 msecs"
;; 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}
;;"Elapsed time: 29.617148 msecs"
;;"Elapsed time: 28.233836 msecs"
;;"Elapsed time: 29.150146 msecs"
;;"Elapsed time: 28.360114 msecs"
;;"Elapsed time: 28.416531 msecs"
;;"Elapsed time: 38.486866 msecs"
;;"Elapsed time: 25.48484 msecs"
;;"Elapsed time: 27.788339 msecs"
;;"Elapsed time: 30.93764 msecs"
;;"Elapsed time: 25.088613 msecs"
;;
;;Eager positional fn
;; compiling
;;"Elapsed time: 40.813282 msecs"
;; 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}
;;"Elapsed time: 15.038361 msecs"
;;"Elapsed time: 13.721086 msecs"
;;"Elapsed time: 13.787 msecs"
;;"Elapsed time: 16.328639 msecs"
;;"Elapsed time: 14.597608 msecs"
;;"Elapsed time: 13.985261 msecs"
;;"Elapsed time: 13.96927 msecs"
;;"Elapsed time: 13.764979 msecs"
;;"Elapsed time: 14.824762 msecs"
;;"Elapsed time: 13.781415 msecs"
;;
;;Let with fn calls
;; no need to compile
;; 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}
;;"Elapsed time: 15.278042 msecs"
;;"Elapsed time: 12.319934 msecs"
;;"Elapsed time: 12.543768 msecs"
;;"Elapsed time: 12.316507 msecs"
;;"Elapsed time: 12.812431 msecs"
;;"Elapsed time: 12.724281 msecs"
;;"Elapsed time: 13.105688 msecs"
;;"Elapsed time: 12.757586 msecs"
;;"Elapsed time: 12.865573 msecs"
;;"Elapsed time: 12.54549 msecs"
;;
;;Let
;; no need to compile
;; gives value 12.209062049816033
;;"Elapsed time: 11.762075 msecs"
;;"Elapsed time: 10.430211 msecs"
;;"Elapsed time: 10.343818 msecs"
;;"Elapsed time: 10.372467 msecs"
;;"Elapsed time: 10.906296 msecs"
;;"Elapsed time: 10.285573 msecs"
;;"Elapsed time: 10.464272 msecs"
;;"Elapsed time: 10.357106 msecs"
;;"Elapsed time: 10.409813 msecs"
;;"Elapsed time: 10.512621 msecs"
prismatic-plumbing-clojure-0.5.4/test/plumbing/graph_test.cljx 0000644 0000000 0000000 00000035772 13141156451 0024622 0 ustar 00root root 0000000 0000000 (ns plumbing.graph-test
(:require
[plumbing.core :as plumbing :include-macros true]
[plumbing.graph :as graph :include-macros true]
[clojure.walk :as walk]
[schema.core :as s]
[schema.test :as schema-test]
[plumbing.fnk.pfnk :as pfnk]
#+clj [plumbing.fnk.impl :as fnk-impl]
#+clj [clojure.test :refer :all]
#+cljs [cemerick.cljs.test :refer-macros [is deftest testing use-fixtures]]))
#+cljs
(do
(def Exception js/Error)
(def AssertionError js/Error)
(def Throwable js/Error))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deftest graph-construction-test
(testing "io-schemata works correctly for flat graphs"
(is (= [{:x s/Any :z s/Any
(s/optional-key :q) s/Any (s/optional-key :y) s/Int (s/optional-key :r) s/Any
s/Keyword s/Any}
{:foo {:foox s/Any :fooy s/Any} :bar s/Any}]
(pfnk/io-schemata
(graph/graph :foo (plumbing/fnk [x {y :- s/Int 1} {q 2}] {:foox x :fooy y})
:bar (plumbing/fnk [foo z {q 4} {r 1}] [foo z]))))))
(testing "io-schemata works correctly for nested graphs"
(is (= [{:x s/Any (s/optional-key :q) s/Any (s/optional-key :y) s/Any s/Keyword s/Any}
{:foo {:foox s/Any :fooy s/Any} :bar {:a s/Int :baz {:foo s/Any}}}]
(pfnk/io-schemata
(graph/graph :foo (plumbing/fnk [x {y 1} {q 2}] {:foox x :fooy y})
:bar {:a (plumbing/fnk f :- s/Int [foo] (inc foo))
:baz {:foo (plumbing/fnk [x] x)}})))))
(testing "io-schemata works correctly for inline graphs"
(is (= [{:x s/Any (s/optional-key :q) s/Any (s/optional-key :y) s/Any :b s/Any s/Keyword s/Any}
{:foo {:foox s/Any :fooy s/Any} :a s/Any :baz {:foo s/Any} :z s/Any}]
(pfnk/io-schemata
(graph/graph :foo (plumbing/fnk [x {y 1} {q 2}] {:foox x :fooy y})
(graph/graph
:a (plumbing/fnk [foo] (inc foo))
:baz {:foo (plumbing/fnk [x] x)})
:z (plumbing/fnk [a b]))))))
(testing "named fnks work as expected"
(let [f (plumbing/fnk foo [x {y 1}] (+ x y))
g (graph/graph
f
(plumbing/fnk bar [foo] (* foo 2)))]
(is (= [{:x s/Any (s/optional-key :y) s/Any s/Keyword s/Any}
{:foo s/Any :bar s/Any}]
(pfnk/io-schemata g)))
(is (= (set (keys g)) #{:foo :bar}))
(is (identical? f (:foo g)))
(is (= {:foo 3 :bar 6} (graph/run g {:x 2}))))
(testing "non-named fnks generate an error"
(is (thrown? Exception (graph/graph (plumbing/fnk []))))))
(let [g {:foo (plumbing/fnk [x {y 1} {q 2}] {:foox x :fooy y})
:bar {:a (plumbing/fnk [foo] (inc foo))
:baz {:foo (plumbing/fnk [x] x)}}}]
(is (= g (graph/->graph g))))
(testing "Key order should be preserved by graph."
(let [ks (map #(keyword (str %)) (range 100))]
(is (= ks
(keys (apply graph/graph (interleave ks (repeat (plumbing/fnk [x] (inc x))))))))))
(testing "Exception on duplicate keys"
(is (thrown? Exception (graph/graph :foo (plumbing/fnk [x]) :foo (plumbing/fnk [y])))))
(testing "Exception on cycle"
(is (thrown? Exception (graph/graph :foo (plumbing/fnk [x {y 1}]) :x (plumbing/fnk [y])))))
(testing "Exception on self-cycle"
(is (thrown? Exception (graph/graph :foo (plumbing/fnk [x {y 1}]) :y (plumbing/fnk [y]))))))
(defn test-eager-compile
"Test eager compilation eager-compile-fn, where normalize-output-fn turns the outputs
into ordinary clojure maps from records if necessary."
[compile-fn normalize-output-fn]
(let [a (atom [])
g (graph/graph
:x (plumbing/fnk xfn [p1] (swap! a conj :x) (inc p1))
:y (plumbing/fnk yfn [x] (swap! a conj :y) (inc x)))
c (compile-fn g)
l (c {:p1 42})]
(is (= [:x :y] @a))
(is (= (:y l) 44))
(is (= (:x l) 43)))
(let [run-fn (fn [g m] (normalize-output-fn ((compile-fn g) m)))]
(is (= {:x 1 :y {:z 1}}
(run-fn (graph/graph
:x (plumbing/fnk [] 1)
:y {:z (plumbing/fnk [a] 1)})
{:a 1})))
(is (= {:x {:y 6} :q 12}
(run-fn (graph/graph
:x {:y (plumbing/fnk [a] (inc a))}
:q (plumbing/fnk [[:x y]] (* 2 y)))
{:a 5})))
(is (= {:foo 6 :bar {:a -6 :baz {:foo -5}}}
(run-fn (graph/graph :foo (plumbing/fnk [x] (inc x))
:bar {:a (plumbing/fnk [foo] (- foo))
:baz {:foo (plumbing/fnk [a] (inc a))}})
{:x 5})))
(is (thrown? Exception
(run-fn (graph/graph
:x {:y (plumbing/fnk [a] (inc a))}
:q (plumbing/fnk [[:x z]] z))
{:a 5})))
(is (= {:foo 6 :bar {:a -6 :baz {:foo 4}}}
(run-fn (graph/graph :foo (plumbing/fnk [x] (inc x))
:bar {:a (plumbing/fnk [foo] (- foo))
:baz {:foo (plumbing/fnk [x] (dec x))}})
{:x 5})))
(is (thrown? Exception
(compile-fn (graph/graph :foo {:bar (plumbing/fnk [] 1)}
:baz (plumbing/fnk [[:foo baz]] (inc baz))))))
;; Test as many of the advanced Graph features as possible.
(let [complex-graph
{;; Ordinary fnks.
:a (plumbing/fnk [x] (+ x 2))
;; Fnks that use &.
:b (plumbing/fnk [a x & more] (+ a x (count more)))
;; Fnks that use :as.
:c (plumbing/fnk [b x :as inputs] (+ b (count inputs) (* x -1)))
;; Nested graphs.
:g {:ga (plumbing/fnk [x] (+ 5 x))
;; Fnks with hand-crafted schemas.
:gm (pfnk/fn->fnk (fn [m] {:gmy (+ (:x m) (:ga m))
:gmz (- 0 1 (:x m) (:ga m))})
[{:ga s/Any :x s/Any} ;; input schema
{:gmy s/Any :gmz s/Any}]) ;; output schema
;; Fnks that depend on nested outputs.
:gb (plumbing/fnk [[:gm gmy gmz]] (+ gmy gmz 10))
;; Fnks with properly un-shadowed variables.
:gc (let [gm 2]
(plumbing/fnk [[:gm gmy] x] (+ gm gmy x)))}
;; Fnks that depend on deeply nested values.
:d (plumbing/fnk [[:g [:gm gmy]] b] (+ gmy b))
;; Fnks that are compiled graphs.
:cg (graph/interpreted-eager-compile {:cga (plumbing/fnk [x b] (* 3 x b))})
;; Fnks that we'll remove.
:z (plumbing/fnk [x] (* x 10))}
;; Graphs modified at runtime
complex-graph-modified (assoc (dissoc complex-graph :z)
:e (plumbing/fnk [x [:cg cga]] (+ cga (rem x cga))))]
(is (= (run-fn (compile-fn complex-graph-modified)
{:x 1
:ignored 2})
{:a 3
:b 4
:c 5
:g {:ga 6
:gm {:gmy 7
:gmz -8}
:gb 9
:gc 10}
:d 11
:cg {:cga 12}
:e 13})))))
(deftest interpreted-eager-compile-test
(test-eager-compile graph/interpreted-eager-compile identity))
#+clj
(deftest eager-compile-test
;; eager-compile outputs records rather than ordinary maps as outputs.
(test-eager-compile graph/eager-compile (partial walk/prewalk #(if (map? %) (into {} %) %)))
(let [o ((graph/eager-compile (graph/graph :x (plumbing/fnk [y] (inc 1)))) {:y 1})]
(is (= [:x] (keys o)))
(is (= [2] (vals o)))
(is (= 2 (o :x) (get o :x) (:x o)))
(is (= {:x 2} (into {} o)))
(is (not= {:x 2} o))))
#+clj
(do ;; test defschema with eager-compile -- there were some issues previously
(ns test (:require [schema.core :as s]))
(s/defschema Foo {s/Keyword s/Num})
(ns plumbing.graph-test)
(deftest eager-compile-defschema-test
(let [g {:foo (plumbing/fnk [bar :- test/Foo])}
f (graph/eager-compile g)]
(is (= [{:bar test/Foo s/Keyword s/Any}
{:foo s/Any}]
(pfnk/io-schemata f)
(pfnk/io-schemata g))))))
#+clj
(deftest positional-eager-compile-test
(let [f (graph/positional-eager-compile
(graph/graph
:x (plumbing/fnk [a {b 1} {c 2}]
(+ a (* b 2) (* c 3))))
[:b :a])]
(is (= 19 (:x (f 5 3))))
(is (= 11 (:x (f fnk-impl/+none+ 3))))
(is (thrown? Exception (f 1)))
(is (thrown? Exception (f 3 fnk-impl/+none+)))))
#+clj
(deftest lazy-compile-test
(let [a (atom [])
g (graph/graph
:x (plumbing/fnk [p1] (swap! a conj :x) (inc p1))
:y (plumbing/fnk [x] (swap! a conj :y) (inc x))
:z (plumbing/fnk [x] (swap! a conj :z)))
l ((graph/lazy-compile g) {:p1 42})]
(is (empty? @a))
(is (= (:y l) 44))
(is (= (:x l) 43))
(is (= [:x :y] @a)))
(testing "lazy about error checking"
(is (= 5 (:z ((graph/lazy-compile
(graph/graph :x (plumbing/fnk [a])
:y (plumbing/fnk [b] (inc b))
:z (plumbing/fnk [y] (inc y))))
{:b 3})))))
(is (thrown? Exception (:x ((graph/lazy-compile
(graph/graph
:x (plumbing/fnk [a])
:y (plumbing/fnk [b] (inc b))
:z (plumbing/fnk [y] (inc y))))
{:b 3})))))
(deftest bind-non-map-with-as-test
(is (= (:y (graph/run (graph/graph :x (plumbing/fnk [] {:a "1"})
:y (plumbing/fnk [[:x [:a :as q]]] q))
{}))
"1")))
#+clj
(defn chain-graph [n]
(plumbing/for-map [i (range n)]
(keyword (str "x" (inc i)))
(let [p (keyword (str "x" i))]
(pfnk/fn->fnk (fn [m] (inc (p m))) [{p s/Any} s/Any]))))
#+clj
(deftest chain-graph-test
(is (= 100 (:x100 ((graph/eager-compile (chain-graph 100)) {:x0 0}))))
(is (= 100 (:x100 ((graph/lazy-compile (chain-graph 100)) {:x0 0})))))
(deftest comp-partial-fn-test
(let [in (plumbing/fnk [a b {c 2} :as m] m)]
(let [out (graph/comp-partial-fn in (plumbing/fnk [d a {q 2}] {:b d :e (inc a)}))]
(is (= {:a 1 :b 5 :d 5 :e 2}
(out {:a 1 :d 5})))
(is (= {:a 1 :b 5 :c 4 :d 5 :e 2}
(out {:a 1 :c 4 :d 5})))
(is (= {:a s/Any :d s/Any
(s/optional-key :c) s/Any (s/optional-key :q) s/Any
s/Keyword s/Any}
(pfnk/input-schema out))))
(let [out (graph/comp-partial-fn in (plumbing/fnk [d a {q 2}] {:b d :e (inc a) :c q}))]
(is (= {:a 1 :b 5 :c 2 :d 5 :e 2}
(out {:a 1 :d 5})))
(is (= {:a 1 :b 5 :c 2 :d 5 :e 2}
(out {:a 1 :c 4 :d 5})))
(is (= {:a s/Any :d s/Any (s/optional-key :q) s/Any s/Keyword s/Any}
(pfnk/input-schema out)))))
(let [in2 (plumbing/fnk [[:a a1] b] (+ a1 b))]
(let [out (graph/comp-partial-fn in2 (plumbing/fnk [x] {:a {:a1 x} :b (inc x)}))]
(is (= 3 (out {:x 1})))
(is (= {:x s/Any s/Keyword s/Any} (pfnk/input-schema out))))
(is (thrown? Exception (graph/comp-partial-fn in2 (plumbing/fnk [x] {:a x :b (inc x)})))))
(is (= 10 ((graph/comp-partial-fn (plumbing/fnk [x {y 2} z] (+ x y z)) (plumbing/fnk [] {:x 7}))
{:z 1})))
(is (= 12 ((graph/comp-partial-fn (plumbing/fnk [x {y 2} z :as m & more]
(is (= [5 2 5] [x y z]))
(is (= {:x 5 :z 5 :efour 4 :enine 9 :q 44 :r 5} m))
(is (= {:efour 4 :enine 9 :q 44 :r 5 } more))
(+ x y z))
(plumbing/fnk [r enine] {:efour 4 :x r :z r :enine enine}))
{:r 5 :enine 9 :q 44}))))
(deftest instance-test
;; on a fnk, instance should just return a fnk.
(is (= 21 ((graph/instance (plumbing/fnk [x] (inc x)) [y] {:x (* y 2)}) {:y 10})))
(is (= 23 ((graph/instance (plumbing/fnk [x {z 1}] (+ x z)) [y] {:z (* y 2)}) {:x 3 :y 10})))
(let [raw-g {:x (plumbing/fnk [a] (* a 2))
:y (plumbing/fnk [x] (+ x 1))}
inst-g (graph/instance raw-g [z] {:a (+ z 5)})]
(is (= {:z s/Any s/Keyword s/Any} (pfnk/input-schema inst-g)))
(is (= {:x s/Any :y s/Any} (select-keys (pfnk/output-schema inst-g) [:x :y])))
(is (= {:x 16 :y 17} (select-keys (graph/run inst-g {:z 3}) [:x :y])))
(is (thrown? Exception (graph/instance raw-g [z] {:q 22}))))
(let [raw-g {:x (plumbing/fnk [[:a a1]] (* a1 2))
:y (plumbing/fnk [x {o 1}] (+ x o))}]
(let [inst-g (graph/instance raw-g [z] {:a {:a1 (+ z 5)}})]
(is (= {:z s/Any (s/optional-key :o) s/Any s/Keyword s/Any} (pfnk/input-schema inst-g)))
(is (= {:x s/Any :y s/Any} (select-keys (pfnk/output-schema inst-g) [:x :y])))
(is (= {:x 16 :y 17} (select-keys (graph/run inst-g {:z 3}) [:x :y]))))
(testing "optional keys"
(let [inst-o (graph/instance raw-g [z] {:a {:a1 (+ z 5)} :o 10})]
(is (= {:z s/Any s/Keyword s/Any} (pfnk/input-schema inst-o)))
(is (= {:x 16 :y 26} (select-keys (graph/run inst-o {:z 3}) [:x :y])))))
(is (thrown? Exception (graph/instance raw-g [z] {:a z})))))
#+clj
(deftest ^:slow profiled-test
(let [approx-= (fn [x y] (< (Math/abs (- x y)) 10))
times {:a 100 :b 200 :c 400}
raw-g (graph/graph
:a (plumbing/fnk [i] (Thread/sleep (times :a)) (inc i))
:b (plumbing/fnk [i] (Thread/sleep (times :b)) (- i))
:c (plumbing/fnk [a b] (Thread/sleep (times :c)) (* a b)))
compiled (graph/lazy-compile (graph/profiled :profile-stats raw-g))
execed (compiled {:i 10})]
(is (= (select-keys execed [:a :b :c])
{:a 11 :b -10 :c -110}))
(doseq [[k t] times]
(is (approx-= t (get @(:profile-stats execed) k))))))
#+cljs
(deftest profiled-test
(let [stats-graph {:n (plumbing/fnk [xs] (count xs))
:m (plumbing/fnk [xs n] (/ (plumbing/sum identity xs) n))
:m2 (plumbing/fnk [xs n] (/ (plumbing/sum #(* % %) xs) n))
:v (plumbing/fnk [m m2] (- m2 (* m m)))}
compiled (graph/compile (graph/profiled ::profile-stats stats-graph))
output (compiled {:xs (range 5000)})
profile-stats @(::profile-stats output)]
(is (map? profile-stats))
(is (= #{:n :m :m2 :v}
(set (keys profile-stats))))))
#+clj
(defn time-graphs "How slow are big chain graphs?" []
(let [n 1000
g (chain-graph n)
tk (keyword (str "x" n))]
(doseq [[k f]
{:direct (plumbing/fnk [x0] {tk (nth (iterate inc 1) n)})
:eager (time (graph/eager-compile g))
:lazy (time (graph/lazy-compile g))}]
(println k)
(dotimes [_ 5]
(println (time (plumbing/sum tk (repeatedly 10 #(f {:x0 1})))))))))
(use-fixtures :once schema-test/validate-schemas)
prismatic-plumbing-clojure-0.5.4/test/plumbing/lazymap_test.clj 0000644 0000000 0000000 00000004372 13141156451 0024776 0 ustar 00root root 0000000 0000000 (ns plumbing.lazymap-test
(:use plumbing.core clojure.test lazymap.core))
(deftest lazy-map-entry-extend-test
(is (= :a (get-key [:a 2])))
(is (= 2 @(get-raw-value [:a 2])))
(is (thrown? IllegalArgumentException (get-key [:a])))
(is (thrown? IllegalArgumentException (get-raw-value [:a])))
(is (= :a (get-key (first {:a 2}))))
(is (= 2 @(get-raw-value (first {:a 2})))))
(deftest lazy-hash-map-test
(let [evals (atom [])
recorded-val (fn [x] (swap! evals conj x) x)
base (lazy-hash-map :a (recorded-val 1) :b (recorded-val 2))
b2 (lazy-assoc base :a (recorded-val 11) :d (recorded-val 3))
b3 (assoc b2 :d 33)]
(is (true? (map? b2)))
(is (= #{:a :b :d} (set (keys b2))))
(is (= #{:b :d} (set (keys (dissoc b2 :a)))))
(is (empty? (meta base)))
(is (= {:foo :bar} (meta (with-meta b2 {:foo :bar}))))
(is (true? (contains? b3 :a)))
(is (not (contains? b3 :f)))
(is (not (nil? (find b3 :a))))
(is (nil? (find b3 :f)))
(is (not (empty? b3)))
(is (empty? (dissoc b3 :a :b :d)))
(is (empty? @evals))
(is (= {:a 11 :d 33} (select-keys b3 [:a :d])))
(is (= #{11} (set @evals)))
(is (= 11 (get b3 :a)))
(is (= 11 (get b3 :a 12)))
(is (= nil (get b3 :f)))
(is (= 12 (get b3 :f 12)))
(is (= #{11 3} (set (vals (dissoc b2 :b)))))
(is (= #{:a :b :c} (set (keys (merge base {:c :e})))))
(is (= :a (key (first (dissoc base :b)))))
(is (= #{11 3} (set @evals)))
(is (= 2 (count @evals)))
(is (= 1 (val (first (dissoc base :b)))))
(is (= #{11 3 1} (set @evals)))
(is (= 3 (count @evals)))
(is (= 2 (base :b)))
(is (= 3 (base :f 3)))
(is (= nil (base :f)))
(is (= 3 (apply base [:f 3])))
(is (= #{11 2 3 1} (set @evals)))
(is (= 4 (count @evals)))
(is (= {:a 1} (select-keys base [:a])))
(is (= {:a 1 :b 2} (into {} base)))
;; (is (= [[:a 1]] (seq (dissoc base :b)))) ;; TODO: this fails because of entry equality.
(let [b4 (delay-assoc b2 :d (delay (recorded-val 42)))]
(is (= 4 (count @evals)))
(is (= {:a 11 :b 2 :d 42} (into {} b4))))
(is (= #{11 2 3 1 42} (set @evals)))
(is (= 5 (count @evals)))
(is (= {:a 1 :b 2 :d 3} (into {} (merge b3 b2 base))))
(is (= 5 (count @evals))))) prismatic-plumbing-clojure-0.5.4/test/plumbing/map_test.cljx 0000644 0000000 0000000 00000013700 13141156451 0024261 0 ustar 00root root 0000000 0000000 (ns plumbing.map-test
(:refer-clojure :exclude [flatten])
(:require
[plumbing.core :as plumbing]
[plumbing.map :as map]
[clojure.string :as str]
#+clj [clojure.test :refer :all]
#+cljs [cemerick.cljs.test :refer-macros [is deftest testing use-fixtures]])
#+cljs
(:require-macros [plumbing.map :as map]))
#+cljs
(do
(def Exception js/Error)
(def AssertionError js/Error)
(def Throwable js/Error))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Clojure immutable maps
(deftest safe-select-keys-test
(is (= {:a 1 :c 3}
(map/safe-select-keys {:a 1 :b 2 :c 3} [:a :c])))
(is (= {}
(map/safe-select-keys {:a 1 :b 2 :c 3} [])))
(is (thrown? Throwable
(map/safe-select-keys {:a 1 :b 2 :c 3} [:a :b :d]))))
(deftest merge-disjoint-test
(is (= {:a 1 :b 2 :c 3}
(map/merge-disjoint
{} {:a 1 :b 2} {:c 3} {})))
(is (thrown? Throwable
(map/merge-disjoint
{} {:a 1 :b 2} {:b 5 :c 3} {}))))
(deftest merge-with-key-test
(is (=
{"k1" "v1" :k1 :v2}
(map/merge-with-key
(fn [k v1 v2]
(if (string? k)
v1
v2))
{"k1" "v1"
:k1 :v1}
{"k1" "v2"
:k1 :v2}))))
(deftest flatten-test
(is (empty? (map/flatten nil)))
(is (empty? (map/flatten {})))
(is (= [[[] :foo]] (map/flatten :foo)))
(is (= {[:a] 1
[:b :c] 2
[:b :d :e] 3
[:b :d :f] 4}
(into {} (map/flatten {:a 1 :b {:c 2 :d {:e 3 :f 4}}})))))
(deftest unflatten-test
(is (= {} (map/unflatten nil)))
(is (= :foo (map/unflatten [[[] :foo]])))
(is (= {:a 1 :b {:c 2 :d {:e 3 :f 4}}}
(map/unflatten
{[:a] 1
[:b :c] 2
[:b :d :e] 3
[:b :d :f] 4}))))
(deftest map-leaves-and-path-test
(is (empty? (map/map-leaves-and-path (constantly 2) nil)))
(is (= {:a {:b "a,b2"} :c {:d "c,d3"} :e "e11"}
(map/map-leaves-and-path
(fn [ks v] (str (str/join "," (map name ks)) (inc v)))
{:a {:b 1} :c {:d 2} :e 10}))))
(deftest map-leaves-test
(is (empty? (map/map-leaves (constantly 2) nil)))
(is (= {:a {:b "1"} :c {:d "2"} :e "10"}
(map/map-leaves str {:a {:b 1} :c {:d 2} :e 10})))
(is (= {:a {:b nil} :c {:d nil} :e nil}
(map/map-leaves (constantly nil) {:a {:b 1} :c {:d 2} :e 10}))))
(deftest keep-leaves-test
(is (empty? (map/keep-leaves (constantly 2) {})))
(is (= {:a {:b "1"} :c {:d "2"} :e "10"}
(map/keep-leaves str {:a {:b 1} :c {:d 2} :e 10})))
(is (= {:a {:b false} :c {:d false} :e false}
(map/keep-leaves (constantly false) {:a {:b 1} :c {:d 2} :e 10})))
(is (= {}
(map/keep-leaves (constantly nil) {:a {:b 1} :c {:d 2} :e 10})))
(is (= {:c {:d 10} :e 4}
(map/keep-leaves #(when (even? %) %) {:a {:b 5} :c {:d 10 :e {:f 5}} :e 4}))))
(def some-var "hey hey")
(deftest keyword-map-test
(is (= {} (map/keyword-map)) "works with no args")
(is (= {:x 42} (let [x (* 2 3 7)] (map/keyword-map x))))
(is (= {:some-var "hey hey"
:$ \$}
(let [$ \$]
(map/keyword-map some-var $)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Java mutable Maps
#+clj
(do
(deftest update-key!-test
(let [m (java.util.HashMap. {:a 1 :b 2})]
(map/update-key! m :a inc)
(is (= {:a 2 :b 2} (into {} m)))
(map/update-key! m :c conj "foo")
(is (= {:a 2 :b 2 :c ["foo"]} (into {} m)))))
(deftest get!-test
(let [m (java.util.HashMap.)
a! (fn [k v] (.add ^java.util.List (map/get! m k (java.util.ArrayList.)) v))
value (fn [] (plumbing/map-vals seq m))]
(is (= {} (value)))
(a! :a 1)
(is (= {:a [1]} (value)))
(a! :a 2)
(a! :b 3)
(is (= {:a [1 2] :b [3]} (value)))))
(defn clojureize [m] (plumbing/map-vals #(if (map? %) (into {} %) %) m))
(deftest inc-key!-test
(let [m (java.util.HashMap.)]
(is (= {} (clojureize m)))
(map/inc-key! m :a 1.0)
(is (= {:a 1.0} (clojureize m)))
(map/inc-key! m :a 2.0)
(map/inc-key! m :b 4.0)
(is (= {:a 3.0 :b 4.0} (clojureize m)))))
(deftest inc-key-in!-test
(let [m (java.util.HashMap.)]
(is (= {} (clojureize m)))
(map/inc-key-in! m [:a :b] 1.0)
(is (= {:a {:b 1.0}} (clojureize m)))
(map/inc-key-in! m [:a :b] 2.0)
(map/inc-key-in! m [:a :c] -1.0)
(map/inc-key-in! m [:b] 4.0)
(is (= {:a {:b 3.0 :c -1.0} :b 4.0} (clojureize m)))))
(deftest collate-test
(is (= {:a 3.0 :b 2.0}
(clojureize (map/collate [[:a 1] [:b 3.0] [:a 2] [:b -1.0]])))))
(deftest deep-collate-test
(is (= {:a {:b 3.0 :c -1.0} :b 4.0}
(clojureize (map/deep-collate [[[:a :b] 1.0] [[:a :c] -1.0] [[:a :b] 2.0] [[:b] 4.0]]))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Ops on graphs represented as maps.
(deftest topological-sort-test
(is (= [:first :second :third :fourth :fifth]
(map/topological-sort {:first [:second :fourth]
:second [:third]
:third [:fourth]
:fourth [:fifth]
:fifth []})))
(is (= (range 100)
(map/topological-sort (into {99 []} (for [i (range 99)] [i [(inc i)]])))))
(is (= (range 99)
(map/topological-sort (into {} (for [i (range 99)] [i [(inc i)]])))))
(testing "include-leaves?"
(is (= (range 1000)
(map/topological-sort (into {} (for [i (range 999)] [i [(inc i)]])) true))))
(testing "exception thrown if cycle"
(is (thrown? Exception (map/topological-sort {:first [:second :fourth]
:second [:third]
:third [:fourth]
:fourth [:fifth]
:fifth [:first]})))))