[prismatic-plumbing-clojure] 01/03: Add generated Clojure code
Apollon Oikonomopoulos
apoikos at moszumanska.debian.org
Fri Aug 4 21:05:37 UTC 2017
This is an automated email from the git hooks/post-receive script.
apoikos pushed a commit to branch master
in repository prismatic-plumbing-clojure.
commit 16b3df3f8683c02d9f58035ca8856070bfa76082
Author: Apollon Oikonomopoulos <apoikos at debian.org>
Date: Fri Aug 4 16:46:33 2017 -0400
Add generated Clojure code
---
src/plumbing/core.clj | 489 +++++++++++++++++++++++++++++++++++++++++++
src/plumbing/fnk/pfnk.clj | 58 +++++
src/plumbing/fnk/schema.clj | 244 +++++++++++++++++++++
src/plumbing/graph.clj | 341 ++++++++++++++++++++++++++++++
src/plumbing/graph_async.clj | 85 ++++++++
src/plumbing/map.clj | 233 +++++++++++++++++++++
6 files changed, 1450 insertions(+)
diff --git a/src/plumbing/core.clj b/src/plumbing/core.clj
new file mode 100644
index 0000000..6f026e6
--- /dev/null
+++ b/src/plumbing/core.clj
@@ -0,0 +1,489 @@
+(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
diff --git a/src/plumbing/fnk/pfnk.clj b/src/plumbing/fnk/pfnk.clj
new file mode 100644
index 0000000..30b3838
--- /dev/null
+++ b/src/plumbing/fnk/pfnk.clj
@@ -0,0 +1,58 @@
+(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
diff --git a/src/plumbing/fnk/schema.clj b/src/plumbing/fnk/schema.clj
new file mode 100644
index 0000000..3dfe745
--- /dev/null
+++ b/src/plumbing/fnk/schema.clj
@@ -0,0 +1,244 @@
+(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
diff --git a/src/plumbing/graph.clj b/src/plumbing/graph.clj
new file mode 100644
index 0000000..0c61b8e
--- /dev/null
+++ b/src/plumbing/graph.clj
@@ -0,0 +1,341 @@
+(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
diff --git a/src/plumbing/graph_async.clj b/src/plumbing/graph_async.clj
new file mode 100644
index 0000000..fe5a9ff
--- /dev/null
+++ b/src/plumbing/graph_async.clj
@@ -0,0 +1,85 @@
+(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 (<! (f (select-keys @results (pfnk/input-schema-keys f))))]
+ (swap! results assoc k r)
+ (doseq [c (child-map k)]
+ (when (empty? (c (swap! remaining-parents
+ update-in [c]
+ disj k)))
+ (run-node c)))))))]
+ (doseq [k (keys g)]
+ (when (empty? (parent-map k))
+ (run-node k)))
+ result))
+ (pfnk/io-schemata g)))))
+
+;;;;;;;;;;;; This file autogenerated from src/plumbing/graph_async.cljx
diff --git a/src/plumbing/map.clj b/src/plumbing/map.clj
new file mode 100644
index 0000000..026ed31
--- /dev/null
+++ b/src/plumbing/map.clj
@@ -0,0 +1,233 @@
+(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]
+ ))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 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
+
+
+(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
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-java/prismatic-plumbing-clojure.git
More information about the pkg-java-commits
mailing list