;; Copyright (c) Stuart Sierra, 2012. All rights reserved. The use and
;; distribution terms for this software are covered by the Eclipse
;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; which can be found in the file epl-v10.html at the root of this
;; distribution. By using this software in any fashion, you are
;; agreeing to be bound by the terms of this license. You must not
;; remove this notice, or any other, from this software.

(ns ^{:author "Stuart Sierra"
      :doc "Bidirectional graphs of dependencies and dependent objects."}
  clojure.tools.namespace.dependency
  (:require [clojure.set :as set]))

(defprotocol DependencyGraph
  (immediate-dependencies [graph node]
    "Returns the set of immediate dependencies of node.")
  (immediate-dependents [graph node]
    "Returns the set of immediate dependents of node.")
  (transitive-dependencies [graph node]
    "Returns the set of all things which node depends on, directly or
    transitively.")
  (transitive-dependencies-set [graph node-set]
    "Returns the set of all things which any node in node-set depends
    on, directly or transitively.")
  (transitive-dependents [graph node]
    "Returns the set of all things which depend upon node, directly or
    transitively.")
  (transitive-dependents-set [graph node-set]
    "Returns the set of all things which depend upon any node in
    node-set, directly or transitively.")
  (nodes [graph]
    "Returns the set of all nodes in graph."))

(defprotocol DependencyGraphUpdate
  (depend [graph node dep]
    "Returns a new graph with a dependency from node to dep (\"node depends
    on dep\"). Forbids circular dependencies.")
  (remove-edge [graph node dep]
    "Returns a new graph with the dependency from node to dep removed.")
  (remove-all [graph node]
    "Returns a new dependency graph with all references to node removed.")
  (remove-node [graph node]
    "Removes the node from the dependency graph without removing it as a
    dependency of other nodes. That is, removes all outgoing edges from
    node."))

(defn- remove-from-map [amap x]
  (reduce (fn [m [k vs]]
	    (assoc m k (disj vs x)))
	  {} (dissoc amap x)))

(defn- transitive
  "Recursively expands the set of dependency relationships starting
  at (get neighbors x), for each x in node-set"
  [neighbors node-set]
  (loop [unexpanded (mapcat neighbors node-set)
         expanded #{}]
    (if-let [[node & more] (seq unexpanded)]
      (if (contains? expanded node)
        (recur more expanded)
        (recur (concat more (neighbors node))
               (conj expanded node)))
      expanded)))

(declare depends?)

(def set-conj (fnil conj #{}))

(defrecord MapDependencyGraph [dependencies dependents]
  DependencyGraph
  (immediate-dependencies [graph node]
    (get dependencies node #{}))
  (immediate-dependents [graph node]
    (get dependents node #{}))
  (transitive-dependencies [graph node]
    (transitive dependencies #{node}))
  (transitive-dependencies-set [graph node-set]
    (transitive dependencies node-set))
  (transitive-dependents [graph node]
    (transitive dependents #{node}))
  (transitive-dependents-set [graph node-set]
    (transitive dependents node-set))
  (nodes [graph]
    (clojure.set/union (set (keys dependencies))
                       (set (keys dependents))))
  DependencyGraphUpdate
  (depend [graph node dep]
    (when (or (= node dep) (depends? graph dep node))
      (throw (Exception. (str "Circular dependency between "
                              (pr-str node) " and " (pr-str dep)))))
    (MapDependencyGraph.
     (update-in dependencies [node] set-conj dep)
     (update-in dependents [dep] set-conj node)))
  (remove-edge [graph node dep]
    (MapDependencyGraph.
     (update-in dependencies [node] disj dep)
     (update-in dependents [dep] disj node)))
  (remove-all [graph node]
    (MapDependencyGraph.
     (remove-from-map dependencies node)
     (remove-from-map dependents node)))
  (remove-node [graph node]
    (MapDependencyGraph.
     (dissoc dependencies node)
     dependents)))

(defn graph "Returns a new, empty, dependency graph." []
  (->MapDependencyGraph {} {}))

(defn depends?
  "True if x is directly or transitively dependent on y."
  [graph x y]
  (contains? (transitive-dependencies graph x) y))

(defn dependent?
  "True if y is a dependent of x."
  [graph x y]
  (contains? (transitive-dependents graph x) y))

(defn topo-sort
  "Returns a topologically-sorted list of nodes in graph."
  [graph]
  (loop [sorted ()
         g graph
         todo (set (filter #(empty? (immediate-dependents graph %))
                           (nodes graph)))]
    (if (empty? todo)
      sorted
      (let [[node & more] (seq todo)
            deps (immediate-dependencies g node)
            [add g'] (loop [deps deps
                            g g
                            add #{}]
                       (if (seq deps)
                         (let [d (first deps)
                               g' (remove-edge g node d)]
                           (if (empty? (immediate-dependents g' d))
                             (recur (rest deps) g' (conj add d))
                             (recur (rest deps) g' add)))
                         [add g]))]
        (recur (cons node sorted)
               (remove-node g' node)
               (clojure.set/union (set more) (set add)))))))

(def ^:private max-number
  #?(:clj Long/MAX_VALUE
     :cljs js/Number.MAX_VALUE))

(defn topo-comparator
  "Returns a comparator fn which produces a topological sort based on
  the dependencies in graph. Nodes not present in the graph will sort
  after nodes in the graph."
  [graph]
  (let [pos (zipmap (topo-sort graph) (range))]
    (fn [a b]
      (compare (get pos a max-number)
               (get pos b max-number)))))

;; Copyright (c) Stuart Sierra, 2012. All rights reserved. The use and
;; distribution terms for this software are covered by the Eclipse
;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; which can be found in the file epl-v10.html at the root of this
;; distribution. By using this software in any fashion, you are
;; agreeing to be bound by the terms of this license. You must not
;; remove this notice, or any other, from this software.

(ns ^{:author "Stuart Sierra"
      :doc "Bidirectional graphs of dependencies and dependent objects."}
  clojure.tools.namespace.dependency
  (:require [clojure.set :as set]))

(defprotocol DependencyGraph
  (immediate-dependencies [graph node]
    "Returns the set of immediate dependencies of node.")
  (immediate-dependents [graph node]
    "Returns the set of immediate dependents of node.")
  (transitive-dependencies [graph node]
    "Returns the set of all things which node depends on, directly or
    transitively.")
  (transitive-dependencies-set [graph node-set]
    "Returns the set of all things which any node in node-set depends
    on, directly or transitively.")
  (transitive-dependents [graph node]
    "Returns the set of all things which depend upon node, directly or
    transitively.")
  (transitive-dependents-set [graph node-set]
    "Returns the set of all things which depend upon any node in
    node-set, directly or transitively.")
  (nodes [graph]
    "Returns the set of all nodes in graph."))

(defprotocol DependencyGraphUpdate
  (depend [graph node dep]
    "Returns a new graph with a dependency from node to dep (\"node depends
    on dep\"). Forbids circular dependencies.")
  (remove-edge [graph node dep]
    "Returns a new graph with the dependency from node to dep removed.")
  (remove-all [graph node]
    "Returns a new dependency graph with all references to node removed.")
  (remove-node [graph node]
    "Removes the node from the dependency graph without removing it as a
    dependency of other nodes. That is, removes all outgoing edges from
    node."))

(defn- remove-from-map [amap x]
  (reduce (fn [m [k vs]]
	    (assoc m k (disj vs x)))
	  {} (dissoc amap x)))

(defn- transitive
  "Recursively expands the set of dependency relationships starting
  at (get neighbors x), for each x in node-set"
  [neighbors node-set]
  (loop [unexpanded (mapcat neighbors node-set)
         expanded #{}]
    (if-let [[node & more] (seq unexpanded)]
      (if (contains? expanded node)
        (recur more expanded)
        (recur (concat more (neighbors node))
               (conj expanded node)))
      expanded)))

(declare depends?)

(def set-conj (fnil conj #{}))

(defrecord MapDependencyGraph [dependencies dependents]
  DependencyGraph
  (immediate-dependencies [graph node]
    (get dependencies node #{}))
  (immediate-dependents [graph node]
    (get dependents node #{}))
  (transitive-dependencies [graph node]
    (transitive dependencies #{node}))
  (transitive-dependencies-set [graph node-set]
    (transitive dependencies node-set))
  (transitive-dependents [graph node]
    (transitive dependents #{node}))
  (transitive-dependents-set [graph node-set]
    (transitive dependents node-set))
  (nodes [graph]
    (clojure.set/union (set (keys dependencies))
                       (set (keys dependents))))
  DependencyGraphUpdate
  (depend [graph node dep]
    (when (or (= node dep) (depends? graph dep node))
      (throw (ex-info (str "Circular dependency between "
                           (pr-str node) " and " (pr-str dep))
                      {:reason ::circular-dependency
                       :node node
                       :dependency dep})))
    (MapDependencyGraph.
     (update-in dependencies [node] set-conj dep)
     (update-in dependents [dep] set-conj node)))
  (remove-edge [graph node dep]
    (MapDependencyGraph.
     (update-in dependencies [node] disj dep)
     (update-in dependents [dep] disj node)))
  (remove-all [graph node]
    (MapDependencyGraph.
     (remove-from-map dependencies node)
     (remove-from-map dependents node)))
  (remove-node [graph node]
    (MapDependencyGraph.
     (dissoc dependencies node)
     dependents)))

(defn graph "Returns a new, empty, dependency graph." []
  (->MapDependencyGraph {} {}))

(defn depends?
  "True if x is directly or transitively dependent on y."
  [graph x y]
  (contains? (transitive-dependencies graph x) y))

(defn dependent?
  "True if y is a dependent of x."
  [graph x y]
  (contains? (transitive-dependents graph x) y))

(defn topo-sort
  "Returns a topologically-sorted list of nodes in graph."
  [graph]
  (loop [sorted ()
         g graph
         todo (set (filter #(empty? (immediate-dependents graph %))
                           (nodes graph)))]
    (if (empty? todo)
      sorted
      (let [[node & more] (seq todo)
            deps (immediate-dependencies g node)
            [add g'] (loop [deps deps
                            g g
                            add #{}]
                       (if (seq deps)
                         (let [d (first deps)
                               g' (remove-edge g node d)]
                           (if (empty? (immediate-dependents g' d))
                             (recur (rest deps) g' (conj add d))
                             (recur (rest deps) g' add)))
                         [add g]))]
        (recur (cons node sorted)
               (remove-node g' node)
               (clojure.set/union (set more) (set add)))))))

(def ^:private max-number
  #?(:clj Long/MAX_VALUE
     :cljs js/Number.MAX_VALUE))

(defn topo-comparator
  "Returns a comparator fn which produces a topological sort based on
  the dependencies in graph. Nodes not present in the graph will sort
  after nodes in the graph."
  [graph]
  (let [pos (zipmap (topo-sort graph) (range))]
    (fn [a b]
      (compare (get pos a max-number)
               (get pos b max-number)))))

replace Exception with ex-info

c.t.n.dependency: replace Exception with ex-info

For ClojureScript compatibility


(ns plastic.util.helpers
  (:require-macros [plastic.logging :refer [log info warn error group group-end]]
                   [cljs.core.async.macros :refer [go]])
  (:require [cljs.pprint :as pprint :refer [pprint]]
            [cljs.core.async :refer [put! <! chan timeout close!]]
            [clojure.set :as set]
            [cuerdas.core :as str]))

(def noop (fn [] []))

(defn deep-merge
  "Recursively merges maps. If keys are not maps, the last value wins."
  [& vals]
  (let [inputs (remove nil? vals)
        res (if (every? map? inputs)
              (apply merge-with deep-merge inputs)
              (last vals))]
    ;(log "DM" inputs "===>" res)
    res))

; --------------------------------------------------------
;

(defn- type-dispatcher [obj]
  (cond
    (fn? obj) :fn
    :default :default))

(defmulti clean-dispatch type-dispatcher)

(defmethod clean-dispatch :default [thing]
  (pprint/simple-dispatch thing))

#_(defmethod clean-dispatch :fn []
  (-write *out* "..."))

(defn nice-print [o]
  (with-out-str
    (pprint/with-pprint-dispatch clean-dispatch
      (binding [pprint/*print-pretty* true
                pprint/*print-suppress-namespaces* true
                pprint/*print-lines* true]
        (pprint o)))))

; --------------------------------------------------------

; underscore-like debounce
(defn debounce [f wait]
  (let [counter (atom 0)
        chan (atom (chan))]
    (fn [& args]
      (swap! counter inc)
      (let [snapshot @counter]
        (go
          (swap! chan (fn [c] (do (close! c) (timeout wait))))
          (<! @chan)
          (if (= snapshot @counter)
            (apply f args)))))))

(defn abs [x]
  (if (neg? x) (- x) x))

(defn selector-match? [selector-spec val]
  (cond
    (vector? selector-spec) (some #{val} selector-spec)
    (set? selector-spec) (contains? selector-spec val)
    :default (= val selector-spec)))

(defn key-selector [k selector-spec]
  (fn [o]
    (let [key-val (get o k)]
      (selector-match? selector-spec key-val))))

(defn update-selected [selector f coll]
  (map #(if (selector %) (f %) %) coll))

(defn get-by-key [key val coll]
  (some #(if (= (key %) val) %) coll))

(def get-by-id (partial get-by-key :id))

(defn next-item [f coll]
  (nth (drop-while #(not (f %)) coll) 1 nil))

(defn prev-item [f coll]
  (last (take-while #(not (f %)) coll)))

(defn strip-colon [text]
  (str/ltrim text ":"))                                     ; TODO: this must be more robust

(defn selector-matches? [selector id]
  (cond
    (nil? selector) true
    (vector? selector) (some #{id} selector)
    (set? selector) (contains? selector id)
    :default (= id selector)))

; We have to be extra careful when updating data observed by reagent's reactions.
; For performance reasons reactions do identical? tests to detect changes.
; See discussion https://github.com/reagent-project/reagent/pull/143
;
; We may want to run a code which constructs same values which do not turn to be indentical.
; For example, imagine editor's layouting code running after some trivial change in code tree structure.
; The code will produce almost same layouting data strucutre, but individual nodes
; in the structure won't be indentical to the old versions (although many will be equal).
; => this triggers re-rendeing of whole tree of reagent components
;
; To avoid unnecessary rendering we split our layouting results into bite-sized chunks
; (in case of layouting we keep per-node layouting data key-ed by node-id) and put them into maps.
; Then when commiting new layouting results, we use overwrite-map to do equality check on individual pieces
; and replace old value only if there is any change.
;
; A similar strategy should be applied everywhere where we are touching individual
; data pieces observed by reagent's reactions (and re-frame subscriptions).
;
(defn overwrite-map [old-map new-map]
  {:pre [(or (nil? old-map) (map? old-map))
         (map? new-map)]}
  (if (nil? old-map)
    new-map
    (let [new-keys (set (keys new-map))
          old-keys (set (keys old-map))
          keys-to-be-removed (set/difference old-keys new-keys)
          keys-to-be-added (set/difference new-keys old-keys)
          keys-to-be-updated (set/intersection old-keys new-keys)
          careful-updater (fn [accum k]
                            (update accum k (fn [old-val]
                                              (let [new-val (get new-map k)]
                                                (if (= old-val new-val)
                                                  old-val
                                                  new-val)))))
          simple-adder (fn [accum k] (assoc accum k (get new-map k)))
          old-map-after-removal (apply dissoc old-map keys-to-be-removed)
          old-map-after-removal-and-update (reduce careful-updater old-map-after-removal keys-to-be-updated)]
      (reduce simple-adder old-map-after-removal-and-update keys-to-be-added))))

(defn indexed-iteration [coll]
  {:pre [(coll? coll)]}
  (map-indexed (fn [i v] [i v]) coll))

;; ----------------------------------------------------------------------
;; scgilardi at gmail
;; taken from https://github.com/clojure/core.incubator/blob/master/src/main/clojure/clojure/core/incubator.clj

(defn dissoc-in
  "Dissociates an entry from a nested associative structure returning a new
  nested structure. keys is a sequence of keys. Any empty maps that result
  will not be present in the new structure."
  [m [k & ks :as keys]]
  (if ks
    (if-let [nextmap (get m k)]
      (let [newmap (dissoc-in nextmap ks)]
        (if (seq newmap)
          (assoc m k newmap)
          (dissoc m k)))
      m)
    (dissoc m k)))

(ns plastic.util.helpers
  (:require-macros [plastic.logging :refer [log info warn error group group-end]]
                   [cljs.core.async.macros :refer [go]])
  (:require [cljs.pprint :as pprint :refer [pprint]]
            [cljs.core.async :refer [put! <! chan timeout close!]]
            [goog.object :as gobj]
            [clojure.set :as set]
            [cuerdas.core :as str]))

(def noop (fn [] []))

(defn deep-merge
  "Recursively merges maps. If keys are not maps, the last value wins."
  [& vals]
  (let [inputs (remove nil? vals)
        res (if (every? map? inputs)
              (apply merge-with deep-merge inputs)
              (last vals))]
    ;(log "DM" inputs "===>" res)
    res))

; --------------------------------------------------------
;

(defn- type-dispatcher [obj]
  (cond
    (fn? obj) :fn
    :default :default))

(defmulti clean-dispatch type-dispatcher)

(defmethod clean-dispatch :default [thing]
  (pprint/simple-dispatch thing))

#_(defmethod clean-dispatch :fn []
  (-write *out* "..."))

(defn nice-print [o]
  (with-out-str
    (pprint/with-pprint-dispatch clean-dispatch
      (binding [pprint/*print-pretty* true
                pprint/*print-suppress-namespaces* true
                pprint/*print-lines* true]
        (pprint o)))))

; --------------------------------------------------------

; underscore-like debounce
(defn debounce [f wait]
  (let [counter (atom 0)
        chan (atom (chan))]
    (fn [& args]
      (swap! counter inc)
      (let [snapshot @counter]
        (go
          (swap! chan (fn [c] (do (close! c) (timeout wait))))
          (<! @chan)
          (if (= snapshot @counter)
            (apply f args)))))))

(defn abs [x]
  (if (neg? x) (- x) x))

(defn selector-match? [selector-spec val]
  (cond
    (vector? selector-spec) (some #{val} selector-spec)
    (set? selector-spec) (contains? selector-spec val)
    :default (= val selector-spec)))

(defn key-selector [k selector-spec]
  (fn [o]
    (let [key-val (get o k)]
      (selector-match? selector-spec key-val))))

(defn update-selected [selector f coll]
  (map #(if (selector %) (f %) %) coll))

(defn get-by-key [key val coll]
  (some #(if (= (key %) val) %) coll))

(def get-by-id (partial get-by-key :id))

(defn next-item [f coll]
  (nth (drop-while #(not (f %)) coll) 1 nil))

(defn prev-item [f coll]
  (last (take-while #(not (f %)) coll)))

(defn strip-colon [text]
  (str/ltrim text ":"))                                     ; TODO: this must be more robust

(defn selector-matches? [selector id]
  (cond
    (nil? selector) true
    (vector? selector) (some #{id} selector)
    (set? selector) (contains? selector id)
    :default (= id selector)))

; We have to be extra careful when updating data observed by reagent's reactions.
; For performance reasons reactions do identical? tests to detect changes.
; See discussion https://github.com/reagent-project/reagent/pull/143
;
; We may want to run a code which constructs same values which do not turn to be indentical.
; For example, imagine editor's layouting code running after some trivial change in code tree structure.
; The code will produce almost same layouting data strucutre, but individual nodes
; in the structure won't be indentical to the old versions (although many will be equal).
; => this triggers re-rendeing of whole tree of reagent components
;
; To avoid unnecessary rendering we split our layouting results into bite-sized chunks
; (in case of layouting we keep per-node layouting data key-ed by node-id) and put them into maps.
; Then when commiting new layouting results, we use overwrite-map to do equality check on individual pieces
; and replace old value only if there is any change.
;
; A similar strategy should be applied everywhere where we are touching individual
; data pieces observed by reagent's reactions (and re-frame subscriptions).
;
(defn overwrite-map [old-map new-map]
  {:pre [(or (nil? old-map) (map? old-map))
         (map? new-map)]}
  (if (nil? old-map)
    new-map
    (let [new-keys (set (keys new-map))
          old-keys (set (keys old-map))
          keys-to-be-removed (set/difference old-keys new-keys)
          keys-to-be-added (set/difference new-keys old-keys)
          keys-to-be-updated (set/intersection old-keys new-keys)
          careful-updater (fn [accum k]
                            (update accum k (fn [old-val]
                                              (let [new-val (get new-map k)]
                                                (if (= old-val new-val)
                                                  old-val
                                                  new-val)))))
          simple-adder (fn [accum k] (assoc accum k (get new-map k)))
          old-map-after-removal (apply dissoc old-map keys-to-be-removed)
          old-map-after-removal-and-update (reduce careful-updater old-map-after-removal keys-to-be-updated)]
      (reduce simple-adder old-map-after-removal-and-update keys-to-be-added))))

(defn indexed-iteration [coll]
  {:pre [(coll? coll)]}
  (map-indexed (fn [i v] [i v]) coll))

;; ----------------------------------------------------------------------
;; scgilardi at gmail
;; taken from https://github.com/clojure/core.incubator/blob/master/src/main/clojure/clojure/core/incubator.clj

(defn dissoc-in
  "Dissociates an entry from a nested associative structure returning a new
  nested structure. keys is a sequence of keys. Any empty maps that result
  will not be present in the new structure."
  [m [k & ks :as keys]]
  (if ks
    (if-let [nextmap (get m k)]
      (let [newmap (dissoc-in nextmap ks)]
        (if (seq newmap)
          (assoc m k newmap)
          (dissoc m k)))
      m)
    (dissoc m k)))

; https://gist.github.com/ptaoussanis/2556c56d93bde4af0415
(defn oget
  "Like `aget` for JS objects, Ref. https://goo.gl/eze8hY. Unlike `aget`,
  returns nil for missing keys instead of throwing."
  ([o k] (when o (gobj/get o k nil)))
  ([o k1 k2] (when-let [o (oget o k1)] (gobj/get o k2 nil))) ; Optimized common case
  ([o k1 k2 & ks] (when-let [o (oget o k1 k2)] (apply oget o ks)))) ; Can also lean on optimized 2-case

add oget to helpers

add oget to helpers


(ns replumb.source-node-test
  (:require [cljs.test :refer-macros [deftest is]]
            [cljs.nodejs :as nodejs]
            [doo.runner :as doo]
            [replumb.core :as core :refer [nodejs-options success? unwrap-result]]
            [replumb.common :as common :refer [echo-callback valid-eval-result?
                                               extract-message valid-eval-error?]]
            [replumb.repl :as repl]
            [replumb.load :as load]
            [replumb.nodejs.io :as io]))

(let [src-paths ["dev-resources/private/test/node/compiled/out"
                 "dev-resources/private/test/src/cljs"
                 "dev-resources/private/test/src/clj"]
      validated-echo-cb (partial repl/validated-call-back! echo-callback)
      target-opts (nodejs-options src-paths io/read-file!)
      reset-env! (partial repl/reset-env! target-opts)
      read-eval-call (partial repl/read-eval-call target-opts validated-echo-cb)]

  (deftest source-in-cljs-core
    (let [res (read-eval-call "(source max)")
          source-string (unwrap-result res)
          expected "(defn ^number max
  \"Returns the greatest of the nums.\"
  ([x] x)
  ([x y] (cljs.core/max x y))
  ([x y & more]
   (reduce max (cljs.core/max x y) more)))"]
      (is (success? res) "(source max) should succeed.")
      (is (valid-eval-result? source-string) "(source max) should be a valid result")
      (is (= expected source-string) "(source max) should return valid source")
      (reset-env!))

    (let [res (read-eval-call "(source nil?)")
          source-string (unwrap-result res)
          expected "(defn ^boolean nil?
  \"Returns true if x is nil, false otherwise.\"
  [x]
  (coercive-= x nil))"]
      (is (success? res) "(source nil?) should succeed.")
      (is (valid-eval-result? source-string) "(source nil?) should be a valid result")
      (is (= expected source-string) "(source nil?) should return valid source")
      (reset-env!))

    (let [res (read-eval-call "(source not-existing)")
          source-string (unwrap-result res)]
      (is (success? res) "(source not-existing) should succeed.")
      (is (valid-eval-result? source-string) "(source not-existing) should be a valid result")
      (is (= "nil" source-string) "(source not-existing) should return nil")
      (reset-env!)))

  (deftest source-in-non-core-ns
    (let [res (do (read-eval-call "(require 'clojure.set)")
                  (read-eval-call "(source clojure.set/union)"))
          source-string (unwrap-result res)
          expected "(defn union
  \"Return a set that is the union of the input sets\"
  ([] #{})
  ([s1] s1)
  ([s1 s2]
     (if (< (count s1) (count s2))
       (reduce conj s2 s1)
       (reduce conj s1 s2)))
  ([s1 s2 & sets]
     (let [bubbled-sets (bubble-max-key count (conj sets s2 s1))]
       (reduce into (first bubbled-sets) (rest bubbled-sets)))))"]
      (is (success? res) "(source clojure.set/union) should succeed.")
      (is (valid-eval-result? source-string) "(source clojure.set/union) should be a valid result")
      (is (= expected source-string) "(source clojure.set/union) should return valid source")
      (reset-env! '[clojure.set]))

    (let [res (do (read-eval-call "(require 'clojure.string)")
                  (read-eval-call "(source clojure.string/trim)"))
          source-string (unwrap-result res)
          expected "(defn trim
  \"Removes whitespace from both ends of string.\"
  [s]
  (gstring/trim s))"]
      (is (success? res) "(source clojure.string/trim) should succeed.")
      (is (valid-eval-result? source-string) "(source clojure.string/trim) should be a valid result")
      (is (= expected source-string) "(source clojure.string/trim) should return valid source")
      (reset-env! '[clojure.string goog.string goog.string.StringBuffer]))

    (let [res (do (read-eval-call "(require 'clojure.string)")
                  (read-eval-call "(source clojure.string/not-existing)"))
          source-string (unwrap-result res)]
      (is (success? res) "(source clojure.string/not-existing) should succeed.")
      (is (valid-eval-result? source-string) "(source clojure.string/not-existing) should be a valid result")
      (is (= "nil" source-string) "(source clojure.string/not-existing) should return valid source")
      (reset-env! '[clojure.string goog.string goog.string.StringBuffer]))

    ;; https://github.com/ScalaConsultants/replumb/issues/86
    (let [res (do (read-eval-call "(require '[clojure.string :as s])")
                  (read-eval-call "(source s/trim)"))
          docstring (unwrap-result res)]
      (is (success? res) "(require '[clojure.string :as s]) and (doc s/trim) should succeed.")
      (is (valid-eval-result? docstring) "(require '[clojure.string :as s]) and (doc s/trim) should be a valid result")
      (is (re-find #"Removes whitespace from both ends of string" docstring) "(require '[clojure.string :as s]) and (doc s/trim) should return valid docstring")
      (reset-env! '[clojure.string goog.string goog.string.StringBuffer])))

  (deftest source-in-custom-ns
    (let [res (do (read-eval-call "(require 'foo.bar.baz)")
                  (read-eval-call "(source foo.bar.baz/a)"))
          source-string (unwrap-result res)
          expected "(def a \"whatever\")"]
      (is (success? res) "(source foo.bar.baz/a) should succeed.")
      (is (valid-eval-result? source-string) "(source foo.bar.baz/a) should be a valid result")
      (is (= expected source-string) "(source foo.bar.baz/a) should return valid source")
      (reset-env! '[foo.bar.baz]))

    ;; https://github.com/ScalaConsultants/replumb/issues/86
    (let [res (do (read-eval-call "(require '[foo.bar.baz :as baz])")
                  (read-eval-call "(source baz/a)"))
          source-string (unwrap-result res)
          expected "(def a \"whatever\")"]
      (is (success? res) "(require '[foo.bar.baz :as baz]) and (source baz/a) should succeed.")
      (is (valid-eval-result? source-string) "(require '[foo.bar.baz :as baz]) and (source baz/a) should be a valid result")
      (is (= expected source-string) "(require '[foo.bar.baz :as baz]) and (source baz/a) should return valid source")
      (reset-env! '[foo.bar.baz])))

  ;; see "RUNNING TESTS" section for explanation of `test-ns-hook` special function
  ;; https://clojure.github.io/clojure/clojure.test-api.html
  (defn test-ns-hook []
    (repl/force-init!)
    (source-in-cljs-core)
    (source-in-non-core-ns)
    (source-in-custom-ns)))

(let [validated-echo-cb (partial repl/validated-call-back! echo-callback)
      target-opts (nodejs-options load/no-resource-load-fn!)
      reset-env! (partial repl/reset-env! target-opts)
      read-eval-call (partial repl/read-eval-call target-opts validated-echo-cb)]
  (deftest source-when-read-file-return-nil
    (let [res (do (read-eval-call "(require 'clojure.string)")
                  (read-eval-call "(source clojure.string/trim)"))
          source-string (unwrap-result res)]
      (is (success? res) "(source clojure.string/trim) should succeed.")
      (is (valid-eval-result? source-string) "(source clojure.string/trim) should be a valid result")
      (is (= "nil" source-string) "(source clojure.string/trim) should return nil")
      (reset-env! '[clojure.string goog.string goog.string.StringBuffer]))))

(ns replumb.source-node-test
  (:require [cljs.test :refer-macros [deftest is]]
            [cljs.nodejs :as nodejs]
            [doo.runner :as doo]
            [replumb.core :as core :refer [nodejs-options success? unwrap-result]]
            [replumb.common :as common :refer [echo-callback valid-eval-result?
                                               extract-message valid-eval-error?]]
            [replumb.repl :as repl]
            [replumb.load :as load]
            [replumb.nodejs.io :as io]))

(let [src-paths ["dev-resources/private/test/node/compiled/out"
                 "dev-resources/private/test/src/cljs"
                 "dev-resources/private/test/src/clj"]
      validated-echo-cb (partial repl/validated-call-back! echo-callback)
      target-opts (nodejs-options src-paths io/read-file!)
      reset-env! (partial repl/reset-env! target-opts)
      read-eval-call (partial repl/read-eval-call target-opts validated-echo-cb)]

  (deftest source-in-cljs-core
    (let [res (read-eval-call "(source max)")
          source-string (unwrap-result res)
          expected "(defn ^number max
  \"Returns the greatest of the nums.\"
  ([x] x)
  ([x y] (cljs.core/max x y))
  ([x y & more]
   (reduce max (cljs.core/max x y) more)))"]
      (is (success? res) "(source max) should succeed.")
      (is (valid-eval-result? source-string) "(source max) should be a valid result")
      (is (= expected source-string) "(source max) should return valid source")
      (reset-env!))

    (let [res (read-eval-call "(source nil?)")
          source-string (unwrap-result res)
          expected "(defn ^boolean nil?
  \"Returns true if x is nil, false otherwise.\"
  [x]
  (coercive-= x nil))"]
      (is (success? res) "(source nil?) should succeed.")
      (is (valid-eval-result? source-string) "(source nil?) should be a valid result")
      (is (= expected source-string) "(source nil?) should return valid source")
      (reset-env!))

    (let [res (read-eval-call "(source not-existing)")
          source-string (unwrap-result res)]
      (is (success? res) "(source not-existing) should succeed.")
      (is (valid-eval-result? source-string) "(source not-existing) should be a valid result")
      (is (= "nil" source-string) "(source not-existing) should return nil")
      (reset-env!)))

  (deftest source-in-non-core-ns
    (let [res (do (read-eval-call "(require 'clojure.set)")
                  (read-eval-call "(source clojure.set/union)"))
          source-string (unwrap-result res)
          expected "(defn union
  \"Return a set that is the union of the input sets\"
  ([] #{})
  ([s1] s1)
  ([s1 s2]
     (if (< (count s1) (count s2))
       (reduce conj s2 s1)
       (reduce conj s1 s2)))
  ([s1 s2 & sets]
     (let [bubbled-sets (bubble-max-key count (conj sets s2 s1))]
       (reduce into (first bubbled-sets) (rest bubbled-sets)))))"]
      (is (success? res) "(source clojure.set/union) should succeed.")
      (is (valid-eval-result? source-string) "(source clojure.set/union) should be a valid result")
      (is (= expected source-string) "(source clojure.set/union) should return valid source")
      (reset-env! '[clojure.set]))

    (let [res (do (read-eval-call "(require 'clojure.string)")
                  (read-eval-call "(source clojure.string/trim)"))
          source-string (unwrap-result res)
          expected "(defn trim
  \"Removes whitespace from both ends of string.\"
  [s]
  (gstring/trim s))"]
      (is (success? res) "(source clojure.string/trim) should succeed.")
      (is (valid-eval-result? source-string) "(source clojure.string/trim) should be a valid result")
      (is (= expected source-string) "(source clojure.string/trim) should return valid source")
      (reset-env! '[clojure.string goog.string goog.string.StringBuffer]))

    (let [res (do (read-eval-call "(require 'clojure.string)")
                  (read-eval-call "(source clojure.string/not-existing)"))
          source-string (unwrap-result res)]
      (is (success? res) "(source clojure.string/not-existing) should succeed.")
      (is (valid-eval-result? source-string) "(source clojure.string/not-existing) should be a valid result")
      (is (= "nil" source-string) "(source clojure.string/not-existing) should return valid source")
      (reset-env! '[clojure.string goog.string goog.string.StringBuffer]))

    ;; https://github.com/ScalaConsultants/replumb/issues/86
    (let [res (do (read-eval-call "(require '[clojure.string :as s])")
                  (read-eval-call "(source s/trim)"))
          docstring (unwrap-result res)]
      (is (success? res) "(require '[clojure.string :as s]) and (doc s/trim) should succeed.")
      (is (valid-eval-result? docstring) "(require '[clojure.string :as s]) and (doc s/trim) should be a valid result")
      (is (re-find #"Removes whitespace from both ends of string" docstring) "(require '[clojure.string :as s]) and (doc s/trim) should return valid docstring")
      (reset-env! '[clojure.string goog.string goog.string.StringBuffer])))

  (deftest source-in-custom-ns
    (let [res (do (read-eval-call "(require 'foo.bar.baz)")
                  (read-eval-call "(source foo.bar.baz/a)"))
          source-string (unwrap-result res)
          expected "(def a \"whatever\")"]
      (is (success? res) "(source foo.bar.baz/a) should succeed.")
      (is (valid-eval-result? source-string) "(source foo.bar.baz/a) should be a valid result")
      (is (= expected source-string) "(source foo.bar.baz/a) should return valid source")
      (reset-env! '[foo.bar.baz]))

    ;; https://github.com/ScalaConsultants/replumb/issues/86
    (let [res (do (read-eval-call "(require '[foo.bar.baz :as baz])")
                  (read-eval-call "(source baz/a)"))
          source-string (unwrap-result res)
          expected "(def a \"whatever\")"]
      (is (success? res) "(require '[foo.bar.baz :as baz]) and (source baz/a) should succeed.")
      (is (valid-eval-result? source-string) "(require '[foo.bar.baz :as baz]) and (source baz/a) should be a valid result")
      (is (= expected source-string) "(require '[foo.bar.baz :as baz]) and (source baz/a) should return valid source")
      (reset-env! '[foo.bar.baz])))

  ;; see "RUNNING TESTS" section for explanation of `test-ns-hook` special function
  ;; https://clojure.github.io/clojure/clojure.test-api.html
  (defn test-ns-hook []
    (repl/force-init!)
    (source-in-cljs-core)
    (source-in-non-core-ns)
    (source-in-custom-ns)))

(let [validated-echo-cb (partial repl/validated-call-back! echo-callback)
      target-opts (nodejs-options load/no-resource-load-fn!)
      reset-env! (partial repl/reset-env! target-opts)
      read-eval-call-no-resource (partial repl/read-eval-call target-opts validated-echo-cb)
      read-eval-call-nil-read-file-fn (partial repl/read-eval-call (assoc target-opts :read-file-fn! nil) validated-echo-cb)]

  (deftest source-corner-cases
    (let [res (do (read-eval-call-no-resource "(require 'clojure.string)")
                  (read-eval-call-no-resource "(source clojure.string/trim)"))
          source-string (unwrap-result res)]
      (is (success? res) "(source ...) when *load-fn* returns nil should succeed.")
      (is (valid-eval-result? source-string) "(source ...) when *load-fn* returns nil should be a valid result")
      (is (= "nil" source-string) "(source ...) when *load-fn* returns nil should return nil")
      (reset-env! '[clojure.string goog.string goog.string.StringBuffer]))

    (let [res (do (read-eval-call-nil-read-file-fn "(require 'clojure.string)")
                  (read-eval-call-nil-read-file-fn "(source clojure.string/trim)"))
          source-string (unwrap-result res)]
      (is (success? res) "(source ...) when :read-file-fn! is nil should succeed.")
      (is (valid-eval-result? source-string) "(source ...) when :read-file-fn! is nil should be a valid result")
      (is (= "nil" source-string) "(source ...) when :read-file-fn! is nil should return nil")
      (reset-env! '[clojure.string goog.string goog.string.StringBuffer]))))

Include an explicit corner case test for source


(ns maestro.validators
  (:require [bouncer
             [core :as b]
             [validators :as v]]
            [clj-time.format :as fmt]
            [clojure
             [set :as set]
             [string :as str]]
            [maestro
             [environments :as environments]
             [util :as util]]))

(def healthcheck-types
  #{"EC2" "ELB"})

(def para-instance-types
  #{"c1.medium"
    "c1.xlarge"
    "c3.2xlarge"
    "c3.4xlarge"
    "c3.8xlarge"
    "c3.large"
    "c3.xlarge"
    "hi1.4xlarge"
    "hs1.8xlarge"
    "m1.large"
    "m1.medium"
    "m1.small"
    "m1.xlarge"
    "m2.2xlarge"
    "m2.4xlarge"
    "m2.xlarge"
    "m3.2xlarge"
    "m3.large"
    "m3.medium"
    "m3.xlarge"
    "t1.micro"})

(def hvm-instance-types
  #{"c3.2xlarge"
    "c3.4xlarge"
    "c3.8xlarge"
    "c3.large"
    "c3.xlarge"
    "cc2.8xlarge"
    "cg1.4xlarge"
    "cr1.8xlarge"
    "g2.2xlarge"
    "hi1.4xlarge"
    "hs1.8xlarge"
    "i2.2xlarge"
    "i2.4xlarge"
    "i2.8xlarge"
    "i2.xlarge"
    "m3.2xlarge"
    "m3.large"
    "m3.medium"
    "m3.xlarge"
    "r3.2xlarge"
    "r3.4xlarge"
    "r3.8xlarge"
    "r3.large"
    "r3.xlarge"
    "t2.micro"
    "t2.small"
    "t2.medium"})

(defn allowed-instances
  [virtualisation-type]
  (cond (= (name virtualisation-type) "para") para-instance-types
        (= (name virtualisation-type) "hvm") hvm-instance-types
        :else (throw (ex-info (format "Unknown virtualisation type %s" virtualisation-type) {}))))

(def instance-types
  (set/union para-instance-types hvm-instance-types))

(def availability-zones
  #{"a" "b" "c"})

(def subnet-purposes
  #{"internal" "mgmt" "publiceip" "publicnat"})

(def termination-policies
  #{"ClosestToNextInstanceHour" "Default" "NewestInstance" "OldestInstance" "OldestLaunchConfiguration"})

(v/defvalidator zero-or-more?
  {:default-message-format "%s must be zero or more"}
  [input]
  (if input
    (if-let [number (util/string->int input)]
      (or (zero? number) (v/positive number))
      false)
    true))

(v/defvalidator positive?
  {:default-message-format "%s must be positive"}
  [input]
  (if input
    (if-let [number (util/string->int input)]
      (v/positive number)
      false)
    true))

(v/defvalidator valid-date?
  {:default-message-format "%s must be a valid date"}
  [input]
  (if input
    (try
      (fmt/parse input)
      (catch Exception _
        false))
    true))

(v/defvalidator valid-boolean?
  {:default-message-format "%s must be 'true' or 'false'"}
  [input]
  (if input
    (or (= (str input) "true")
        (= (str input) "false"))
    true))

(v/defvalidator valid-healthcheck-type?
  {:default-message-format "%s must be either 'EC2' or 'ELB'"}
  [input]
  (if input
    (contains? healthcheck-types input)
    true))

(v/defvalidator valid-instance-type?
  {:default-message-format "%s must be a known instance type"}
  [input]
  (if input
    (contains? instance-types input)
    true))

(defn valid-availability-zone?
  [input]
  (if input
    (contains? availability-zones input)
    true))

(v/defvalidator valid-availability-zones?
  {:default-message-format "%s must be valid availability zones"}
  [input]
  (if input
    (if (coll? input)
      (every? valid-availability-zone? input)
      (valid-availability-zone? input))
    true))

(v/defvalidator valid-subnet-purpose?
  {:default-message-format "%s must be a known purpose"}
  [input]
  (if input
    (contains? subnet-purposes input)
    true))

(v/defvalidator valid-termination-policy?
  {:default-message-format "%s must be a valid termination policy"}
  [input]
  (if input
    (contains? termination-policies input)
    true))

(v/defvalidator known-environment?
  {:default-message-format "environment %s is not known"}
  [input]
  (contains? (apply hash-set (keys (environments/environments))) (keyword input)))

(def scheduled-action-validators
  {:cron v/required
   :desired-capacity [v/required zero-or-more?]
   :max [v/required zero-or-more?]
   :min [v/required zero-or-more?]})

(v/defvalidator valid-scheduled-actions?
  {:default-message-format "%s must all be valid scheduled actions"}
  [input]
  (nil? (seq (remove nil? (map (fn [[name description]] (first (b/validate description scheduled-action-validators))) input)))))

(def query-param-validators
  "The validators we should use to validate query parameters."
  {:from zero-or-more?
   :full valid-boolean?
   :size positive?
   :start-from valid-date?
   :start-to valid-date?})

(def log-param-validators
  "The validators we should use to validate deployment log parameters."
  {:since valid-date?})

(def deployment-params-validators
  "The validators we should use to validate Tyranitar deployment parameters."
  {:default-cooldown positive?
   :desired-capacity positive?
   :health-check-grace-period positive?
   :health-check-type valid-healthcheck-type?
   :instance-healthy-attempts positive?
   :instance-type valid-instance-type?
   :load-balancer-healthy-attempts positive?
   :max positive?
   :min zero-or-more?
   :pause-after-instances-healthy valid-boolean?
   :pause-after-load-balancers-healthy valid-boolean?
   :scale-down-after-deployment valid-boolean?
   :scheduled-actions valid-scheduled-actions?
   :selected-zones valid-availability-zones?
   :subnet-purpose valid-subnet-purpose?
   :termination-policy valid-termination-policy?})

(def deployment-request-validators
  "The validators we should use to validate deployment requests."
  {:ami [v/required [v/matches #"^ami-[0-9a-f]{8}$"]]
   :application v/required
   :environment [v/required known-environment?]
   :message v/required})

(def deployment-validators
  "The validators we should use to validate deployment parameters."
  {:application v/required
   :environment [v/required known-environment?]
   :id v/required
   :message v/required
   [:new-state :image-details :id] [v/required [v/matches #"^ami-[0-9a-f]{8}$"]]
   :region v/required
   :user v/required})

(ns maestro.validators
  (:require [bouncer
             [core :as b]
             [validators :as v]]
            [clj-time.format :as fmt]
            [clojure
             [set :as set]
             [string :as str]]
            [maestro
             [environments :as environments]
             [util :as util]]))

(def healthcheck-types
  #{"EC2" "ELB"})

(def para-instance-types
  #{"c1.medium"
    "c1.xlarge"
    "c3.2xlarge"
    "c3.4xlarge"
    "c3.8xlarge"
    "c3.large"
    "c3.xlarge"
    "hi1.4xlarge"
    "hs1.8xlarge"
    "m1.large"
    "m1.medium"
    "m1.small"
    "m1.xlarge"
    "m2.2xlarge"
    "m2.4xlarge"
    "m2.xlarge"
    "m3.2xlarge"
    "m3.large"
    "m3.medium"
    "m3.xlarge"
    "t1.micro"})

(def hvm-instance-types
  #{"c3.2xlarge"
    "c3.4xlarge"
    "c3.8xlarge"
    "c3.large"
    "c3.xlarge"
    "c4.large"
    "c4.xlarge"
    "c4.2xlarge"
    "c4.4xlarge"
    "c4.8xlarge"
    "cc2.8xlarge"
    "cg1.4xlarge"
    "cr1.8xlarge"
    "g2.2xlarge"
    "hi1.4xlarge"
    "hs1.8xlarge"
    "i2.2xlarge"
    "i2.4xlarge"
    "i2.8xlarge"
    "i2.xlarge"
    "m3.2xlarge"
    "m3.large"
    "m3.medium"
    "m3.xlarge"
    "r3.2xlarge"
    "r3.4xlarge"
    "r3.8xlarge"
    "r3.large"
    "r3.xlarge"
    "t2.micro"
    "t2.small"
    "t2.medium"})

(defn allowed-instances
  [virtualisation-type]
  (cond (= (name virtualisation-type) "para") para-instance-types
        (= (name virtualisation-type) "hvm") hvm-instance-types
        :else (throw (ex-info (format "Unknown virtualisation type %s" virtualisation-type) {}))))

(def instance-types
  (set/union para-instance-types hvm-instance-types))

(def availability-zones
  #{"a" "b" "c"})

(def subnet-purposes
  #{"internal" "mgmt" "publiceip" "publicnat"})

(def termination-policies
  #{"ClosestToNextInstanceHour" "Default" "NewestInstance" "OldestInstance" "OldestLaunchConfiguration"})

(v/defvalidator zero-or-more?
  {:default-message-format "%s must be zero or more"}
  [input]
  (if input
    (if-let [number (util/string->int input)]
      (or (zero? number) (v/positive number))
      false)
    true))

(v/defvalidator positive?
  {:default-message-format "%s must be positive"}
  [input]
  (if input
    (if-let [number (util/string->int input)]
      (v/positive number)
      false)
    true))

(v/defvalidator valid-date?
  {:default-message-format "%s must be a valid date"}
  [input]
  (if input
    (try
      (fmt/parse input)
      (catch Exception _
        false))
    true))

(v/defvalidator valid-boolean?
  {:default-message-format "%s must be 'true' or 'false'"}
  [input]
  (if input
    (or (= (str input) "true")
        (= (str input) "false"))
    true))

(v/defvalidator valid-healthcheck-type?
  {:default-message-format "%s must be either 'EC2' or 'ELB'"}
  [input]
  (if input
    (contains? healthcheck-types input)
    true))

(v/defvalidator valid-instance-type?
  {:default-message-format "%s must be a known instance type"}
  [input]
  (if input
    (contains? instance-types input)
    true))

(defn valid-availability-zone?
  [input]
  (if input
    (contains? availability-zones input)
    true))

(v/defvalidator valid-availability-zones?
  {:default-message-format "%s must be valid availability zones"}
  [input]
  (if input
    (if (coll? input)
      (every? valid-availability-zone? input)
      (valid-availability-zone? input))
    true))

(v/defvalidator valid-subnet-purpose?
  {:default-message-format "%s must be a known purpose"}
  [input]
  (if input
    (contains? subnet-purposes input)
    true))

(v/defvalidator valid-termination-policy?
  {:default-message-format "%s must be a valid termination policy"}
  [input]
  (if input
    (contains? termination-policies input)
    true))

(v/defvalidator known-environment?
  {:default-message-format "environment %s is not known"}
  [input]
  (contains? (apply hash-set (keys (environments/environments))) (keyword input)))

(def scheduled-action-validators
  {:cron v/required
   :desired-capacity [v/required zero-or-more?]
   :max [v/required zero-or-more?]
   :min [v/required zero-or-more?]})

(v/defvalidator valid-scheduled-actions?
  {:default-message-format "%s must all be valid scheduled actions"}
  [input]
  (nil? (seq (remove nil? (map (fn [[name description]] (first (b/validate description scheduled-action-validators))) input)))))

(def query-param-validators
  "The validators we should use to validate query parameters."
  {:from zero-or-more?
   :full valid-boolean?
   :size positive?
   :start-from valid-date?
   :start-to valid-date?})

(def log-param-validators
  "The validators we should use to validate deployment log parameters."
  {:since valid-date?})

(def deployment-params-validators
  "The validators we should use to validate Tyranitar deployment parameters."
  {:default-cooldown positive?
   :desired-capacity positive?
   :health-check-grace-period positive?
   :health-check-type valid-healthcheck-type?
   :instance-healthy-attempts positive?
   :instance-type valid-instance-type?
   :load-balancer-healthy-attempts positive?
   :max positive?
   :min zero-or-more?
   :pause-after-instances-healthy valid-boolean?
   :pause-after-load-balancers-healthy valid-boolean?
   :scale-down-after-deployment valid-boolean?
   :scheduled-actions valid-scheduled-actions?
   :selected-zones valid-availability-zones?
   :subnet-purpose valid-subnet-purpose?
   :termination-policy valid-termination-policy?})

(def deployment-request-validators
  "The validators we should use to validate deployment requests."
  {:ami [v/required [v/matches #"^ami-[0-9a-f]{8}$"]]
   :application v/required
   :environment [v/required known-environment?]
   :message v/required})

(def deployment-validators
  "The validators we should use to validate deployment parameters."
  {:application v/required
   :environment [v/required known-environment?]
   :id v/required
   :message v/required
   [:new-state :image-details :id] [v/required [v/matches #"^ami-[0-9a-f]{8}$"]]
   :region v/required
   :user v/required})

Add new C4 instances

Add new C4 instances


;   Copyright (c) Rich Hickey. All rights reserved.
;   The use and distribution terms for this software are covered by the
;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;   which can be found in the file epl-v10.html at the root of this distribution.
;   By using this software in any fashion, you are agreeing to be bound by
;   the terms of this license.
;   You must not remove this notice, or any other, from this software.

(ns cljs.js
  (:require-macros [cljs.env :as env])
  (:require [cljs.env :as env]
            [cljs.analyzer :as ana]
            [cljs.compiler :as comp]
            [cljs.tools.reader :as r]
            [cljs.tools.reader.reader-types :as rt]
            [cljs.tagged-literals :as tags]))

(defonce
  ^{:doc "Each runtime environment provides a different way to load libraries.
  Whatever function *load-fn* is bound to will be passed a library name
  (a string) and a callback. The callback should be invoked with the source of
  the library (a string)."
    :dynamic true}
  *load-fn*
  (fn [name cb]
    (throw (js/Error. "No *load-fn* set"))))

(defn empty-env []
  (env/default-compiler-env))

;; -----------------------------------------------------------------------------
;; Analyze

(defn analyze* [env source cb]
  (let [rdr (rt/string-push-back-reader source)
        eof (js-obj)
        env (ana/empty-env)]
    (env/with-compiler-env env
      (loop []
        (let [form (r/read {:eof eof} rdr)]
          (if-not (identical? eof form)
            (let [env (assoc env :ns (ana/get-namespace ana/*cljs-ns*))]
              (ana/analyze env form))
            (recur))
          (cb))))))

(defn analyze [env source cb]
  (binding [ana/*cljs-ns*    (or (:ns env) 'cljs.user)
            *ns*             (create-ns ana/*cljs-ns*)
            r/*data-readers* tags/*cljs-data-readers*]
    (analyze* env source cb)))

;; -----------------------------------------------------------------------------
;; Emit

(defn emit* [env ast cb]
  (cb (with-out-str (comp/emit ast))))

(defn emit [env ast cb]
  (env/with-compiler-env env
    (emit* env ast cb)))

;; -----------------------------------------------------------------------------
;; Eval

(defn eval* [env form cb]
  (let [ana-env (ana/empty-env)]
    (cb (ana/analyze ana-env form))))

(defn eval [env form cb]
  (env/with-compiler-env env
    (eval* env form cb)))

;   Copyright (c) Rich Hickey. All rights reserved.
;   The use and distribution terms for this software are covered by the
;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;   which can be found in the file epl-v10.html at the root of this distribution.
;   By using this software in any fashion, you are agreeing to be bound by
;   the terms of this license.
;   You must not remove this notice, or any other, from this software.

(ns cljs.js
  (:require-macros [cljs.env :as env])
  (:require [cljs.env :as env]
            [cljs.analyzer :as ana]
            [cljs.compiler :as comp]
            [cljs.tools.reader :as r]
            [cljs.tools.reader.reader-types :as rt]
            [cljs.tagged-literals :as tags]))

(defonce
  ^{:doc "Each runtime environment provides a different way to load libraries.
  Whatever function *load-fn* is bound to will be passed a library name
  (a string) and a callback. The callback should be invoked with the source of
  the library (a string)."
    :dynamic true}
  *load-fn*
  (fn [name cb]
    (throw (js/Error. "No *load-fn* set"))))

(defn empty-env []
  (env/default-compiler-env))

;; -----------------------------------------------------------------------------
;; Analyze

(defn analyze* [env source cb]
  (let [rdr  (rt/string-push-back-reader source)
        eof  (js-obj)
        aenv (ana/empty-env)]
    (env/with-compiler-env env
      (loop []
        (let [form (r/read {:eof eof} rdr)]
          (if-not (identical? eof form)
            (let [aenv (assoc aenv :ns (ana/get-namespace ana/*cljs-ns*))]
              (ana/analyze aenv form)
              (recur))
            (cb)))))))

(defn analyze [env source cb]
  (binding [ana/*cljs-ns*    (or (:ns env) 'cljs.user)
            *ns*             (create-ns ana/*cljs-ns*)
            r/*data-readers* tags/*cljs-data-readers*]
    (analyze* env source cb)))

;; -----------------------------------------------------------------------------
;; Emit

(defn emit* [env ast cb]
  (cb (with-out-str (comp/emit ast))))

(defn emit [env ast cb]
  (env/with-compiler-env env
    (emit* env ast cb)))

;; -----------------------------------------------------------------------------
;; Eval

(defn eval* [env form cb]
  (let [ana-env (ana/empty-env)]
    (cb (ana/analyze ana-env form))))

(defn eval [env form cb]
  (env/with-compiler-env env
    (eval* env form cb)))

fix cljs.js/analyze*

fix cljs.js/analyze*


(ns akvo.lumen.lib.visualisation.maps
  (:require [akvo.lumen.lib :as lib]
            [akvo.lumen.postgres.filter :as filter]
            [akvo.lumen.lib.visualisation.map-config :as map-config]
            [akvo.lumen.lib.visualisation.map-metadata :as map-metadata]
            [akvo.lumen.lib.transformation.engine :as engine]
            [akvo.lumen.util :as util]
            [cheshire.core :as json]
            [clj-http.client :as client]
            [clojure.core.match :refer [match]]
            [clojure.walk :as walk]
            [hugsql.core :as hugsql])
  (:import [com.zaxxer.hikari HikariDataSource]
           [java.net URI]))

(hugsql/def-db-fns "akvo/lumen/lib/dataset.sql")
(hugsql/def-db-fns "akvo/lumen/lib/raster.sql")

(defn- headers [tenant-conn]
  (let [db-uri (-> ^HikariDataSource (:datasource tenant-conn)
                   .getJdbcUrl
                   (subs 5)
                   URI.)
        {:keys [password user]} (util/query-map (.getQuery db-uri))
        port (let [p (.getPort db-uri)]
               (if (pos? p) p 5432))
        db-name (subs (.getPath db-uri) 1)]
    {"x-db-host" (.getHost db-uri)
     "x-db-last-update" (quot (System/currentTimeMillis) 1000)
     "x-db-password" password
     "x-db-port" port
     "X-db-name" db-name
     "x-db-user" user}))

(defn- check-columns
  "Make sure supplied columns are distinct and satisfy predicate."
  [p & columns]
  (and (= (count columns)
          (count (into #{} columns)))
       (every? p columns)))

(defn valid-location?
  "Validate map spec layer."
  [layer p]
  (let [m (into {} (remove (comp nil? val)
                           (select-keys layer [:geom :latitude :longitude])))]
    (match [m]
           [({:geom geom} :only [:geom])] (p geom)

           [({:geom geom :latitude latitude} :only [:geom :latitude])]
           (check-columns p geom latitude)

           [({:geom geom :longitude longitude} :only [:geom :longitude])]
           (check-columns p geom longitude)

           [({:latitude latitude :longitude longitude}
             :only [:latitude :longitude])]
           (check-columns p latitude longitude)

           [{:geom geom :latitude latitude :longitude longitude}]
           (check-columns p geom latitude longitude)

           :else false)))

(defn conform-create-args [layers]
  (let [dataset-id (->> layers
                        (filter (fn[layer] (util/valid-dataset-id? (:datasetId layer))))
                        first
                        :datasetId)
        raster-id (->> layers
                       (filter (fn[layer] (util/valid-dataset-id? (:rasterId layer))))
                       first
                       :rasterId)]
    (cond
      (and (not dataset-id) (not raster-id))
      (throw (ex-info "No valid datasetID"
                      {"reason" "No valid datasetID"}))

      (some (fn [layer] (not (valid-location? layer util/valid-column-name?)))
            (filter (fn [layer] (not (= (:layerType layer) "raster"))) layers))
      (throw (ex-info "Location spec not valid"
                      {"reason" "Location spec not valid"}))

      :else [(if (not dataset-id) raster-id dataset-id)])))

(defn create-raster [tenant-conn windshaft-url raster-id]
  (let [{:keys [raster_table metadata]} (raster-by-id tenant-conn {:id raster-id})
        headers (headers tenant-conn)
        url (format "%s/layergroup" windshaft-url)
        map-config (map-config/build-raster raster_table (:min metadata) (:max metadata))
        layer-group-id (-> (client/post url {:body (json/encode map-config)
                                             :headers headers
                                             :content-type :json})
                           :body json/decode (get "layergroupid"))
        layer-meta (map-metadata/build tenant-conn raster_table {:layerType "raster"} nil)]
    (lib/ok {:layerGroupId layer-group-id
             :layerMetadata layer-meta})))

(defn metadata-layers [tenant-conn layers]
  (map (fn [current-layer]
         (let [current-layer-type (:layerType current-layer)
               current-dataset-id (if (= current-layer-type "raster")
                                    (:rasterId current-layer)
                                    (:datasetId current-layer))
               {:keys [table-name columns raster_table]} (if (= current-layer-type "raster")
                                                           (raster-by-id tenant-conn {:id current-dataset-id})
                                                           (dataset-by-id tenant-conn {:id current-dataset-id}))
               current-where-clause (filter/sql-str (walk/keywordize-keys columns) (:filters current-layer))]
           (map-metadata/build tenant-conn
                               (or raster_table
                                   table-name
                                   (when (not= current-layer-type "raster")
                                     (throw
                                      (ex-info "no authorised to create a map visualisation with current dataset associated" {:datasetId current-dataset-id}))))
                               current-layer current-where-clause)))
       layers))

(defn create
  [tenant-conn windshaft-url layers]
  (try
    (conform-create-args layers)
    (let [metadata-array (metadata-layers tenant-conn layers)
          map-config (map-config/build tenant-conn "todo: remove this" layers metadata-array)
          layer-group-id (-> (client/post (format "%s/layergroup" windshaft-url)
                                          {:body (json/encode map-config)
                                           :headers (headers tenant-conn)
                                           :content-type :json})
                             :body json/decode (get "layergroupid"))]
      (lib/ok {:layerGroupId layer-group-id
               :layerMetadata metadata-array}))
    (catch Exception e
      (println e)
      (lib/bad-request (ex-data e)))))

(ns akvo.lumen.lib.visualisation.maps
  (:require [akvo.lumen.lib :as lib]
            [akvo.lumen.postgres.filter :as filter]
            [akvo.lumen.lib.visualisation.map-config :as map-config]
            [akvo.lumen.lib.visualisation.map-metadata :as map-metadata]
            [akvo.lumen.lib.transformation.engine :as engine]
            [clojure.tools.logging :as log]
            [akvo.lumen.util :as util]
            [cheshire.core :as json]
            [clj-http.client :as client]
            [clojure.core.match :refer [match]]
            [clojure.walk :as walk]
            [hugsql.core :as hugsql])
  (:import [com.zaxxer.hikari HikariDataSource]
           [java.net URI]))

(hugsql/def-db-fns "akvo/lumen/lib/dataset.sql")
(hugsql/def-db-fns "akvo/lumen/lib/raster.sql")

(defn- headers [tenant-conn]
  (let [db-uri (-> ^HikariDataSource (:datasource tenant-conn)
                   .getJdbcUrl
                   (subs 5)
                   URI.)
        {:keys [password user]} (util/query-map (.getQuery db-uri))
        port (let [p (.getPort db-uri)]
               (if (pos? p) p 5432))
        db-name (subs (.getPath db-uri) 1)]
    {"x-db-host" (.getHost db-uri)
     "x-db-last-update" (quot (System/currentTimeMillis) 1000)
     "x-db-password" password
     "x-db-port" port
     "X-db-name" db-name
     "x-db-user" user}))

(defn- check-columns
  "Make sure supplied columns are distinct and satisfy predicate."
  [p & columns]
  (and (= (count columns)
          (count (into #{} columns)))
       (every? p columns)))

(defn valid-location?
  "Validate map spec layer."
  [layer p]
  (let [m (into {} (remove (comp nil? val)
                           (select-keys layer [:geom :latitude :longitude])))]
    (match [m]
           [({:geom geom} :only [:geom])] (p geom)

           [({:geom geom :latitude latitude} :only [:geom :latitude])]
           (check-columns p geom latitude)

           [({:geom geom :longitude longitude} :only [:geom :longitude])]
           (check-columns p geom longitude)

           [({:latitude latitude :longitude longitude}
             :only [:latitude :longitude])]
           (check-columns p latitude longitude)

           [{:geom geom :latitude latitude :longitude longitude}]
           (check-columns p geom latitude longitude)

           :else false)))

(defn conform-create-args [layers]
  (let [dataset-id (->> layers
                        (filter (fn[layer] (util/valid-dataset-id? (:datasetId layer))))
                        first
                        :datasetId)
        raster-id (->> layers
                       (filter (fn[layer] (util/valid-dataset-id? (:rasterId layer))))
                       first
                       :rasterId)]
    (cond
      (and (not dataset-id) (not raster-id))
      (throw (ex-info "No valid datasetID"
                      {"reason" "No valid datasetID"}))

      (some (fn [layer] (not (valid-location? layer util/valid-column-name?)))
            (filter (fn [layer] (not (= (:layerType layer) "raster"))) layers))
      (throw (ex-info "Location spec not valid"
                      {"reason" "Location spec not valid"}))

      :else [(if (not dataset-id) raster-id dataset-id)])))

(defn create-raster [tenant-conn windshaft-url raster-id]
  (let [{:keys [raster_table metadata]} (raster-by-id tenant-conn {:id raster-id})
        headers (headers tenant-conn)
        url (format "%s/layergroup" windshaft-url)
        map-config (map-config/build-raster raster_table (:min metadata) (:max metadata))
        layer-group-id (-> (client/post url {:body (json/encode map-config)
                                             :headers headers
                                             :content-type :json})
                           :body json/decode (get "layergroupid"))
        layer-meta (map-metadata/build tenant-conn raster_table {:layerType "raster"} nil)]
    (lib/ok {:layerGroupId layer-group-id
             :layerMetadata layer-meta})))

(defn metadata-layers [tenant-conn layers]
  (map (fn [current-layer]
         (let [current-layer-type (:layerType current-layer)
               current-dataset-id (if (= current-layer-type "raster")
                                    (:rasterId current-layer)
                                    (:datasetId current-layer))
               {:keys [table-name columns raster_table]} (if (= current-layer-type "raster")
                                                           (raster-by-id tenant-conn {:id current-dataset-id})
                                                           (dataset-by-id tenant-conn {:id current-dataset-id}))
               current-where-clause (filter/sql-str (walk/keywordize-keys columns) (:filters current-layer))]
           (map-metadata/build tenant-conn
                               (or raster_table
                                   table-name
                                   (when (not= current-layer-type "raster")
                                     (throw
                                      (ex-info "no authorised to create a map visualisation with current dataset associated" {:datasetId current-dataset-id}))))
                               current-layer current-where-clause)))
       layers))

(defn create
  [tenant-conn windshaft-url layers]
  (try
    (conform-create-args layers)
    (let [metadata-array (metadata-layers tenant-conn layers)
          map-config (map-config/build tenant-conn "todo: remove this" layers metadata-array)
          headers* (headers tenant-conn)
          _ (log/warn :map-config map-config)
          _ (log/warn :headers headers)
          layer-group-id (-> (client/post (format "%s/layergroup" windshaft-url)
                                          {:body (json/encode map-config)
                                           :headers headers*
                                           :content-type :json})
                             :body json/decode (get "layergroupid"))]
      (lib/ok {:layerGroupId layer-group-id
               :layerMetadata metadata-array}))
    (catch Exception e
      (println e)
      (lib/bad-request (ex-data e)))))

Debug #2097

Debug #2097


(ns elfeed-cljsrn.android.scenes.entries
  (:require [reagent.core :as r]
            [re-frame.core :refer [subscribe dispatch]]
            [elfeed-cljsrn.rn :as rn]
            [elfeed-cljsrn.navigation :refer [navigate-to]]
            [elfeed-cljsrn.ui :as ui :refer [colors palette button icon]]
            [elfeed-cljsrn.events]
            [elfeed-cljsrn.subs])
  (:import [goog.i18n DateTimeFormat]))

(defn format-update-time [time]
  (let [js-date (js/Date. (* time 1000))]
    (.format (goog.i18n.DateTimeFormat. "dd/MM/yyyy hh:mm") js-date)))

(defn format-entry-date [date]
  (let [js-date (js/Date. date)]
    (.format (goog.i18n.DateTimeFormat. "dd/MM/yyyy") js-date)))

(defn remote-error-message []
  [rn/view {:style {:padding 10
                    :background-color "#fff9c4"}}
   [rn/text "Network error. Check your wifi or your elfeed server."]])

(defn entry-row [entry]
  (let [styles {:list-wrapper {:flex-direction "row"
                               :background-color (if (:selected? entry) "#d4d4d4"
                                                     (if (:unread? entry)
                                                       (:white colors)
                                                       (:grey100 colors)))
                               :padding-left 16
                               :padding-right 16
                               :height 72
                               :align-items "center"}
                :first-line {:flex-direction "row"}
                :primary-text-wrapper {:flex 1
                                       :padding-right 16}
                :primary-text {:font-size 16
                               :font-weight "400"
                               :line-height 24}
                :caption-text-wrapper {:align-self "flex-start"
                                       :align-items "flex-start"}
                :caption-text {:font-size 12
                               :font-weight "400"
                               :line-height 20}
                :secondary-text-wrapper {}
                :secondary-text {:line-height 22
                                 :font-size 14
                                 :color "rgba(0,0,0,.54)"}}]
    [rn/touchable {:key (:webid entry)
                   :underlay-color (:grey-100 colors)
                   :on-long-press (fn [_]
                                    (dispatch [:toggle-select-entry entry]))
                   :on-press (fn [_]
                               (dispatch [:press-entry-row entry]))}
     [rn/view {:style (:list-wrapper styles)}
      [rn/view {:style {:flex 1
                        :justify-content "center"}}
       [rn/view {:style (:first-line styles)}
        [rn/view {:style (:primary-text-wrapper styles)}
         [rn/text {:number-of-lines 1
                   :style (:primary-text styles)}
          (:title entry)]]
        [rn/view {:style (:caption-text-wrapper styles)}
         [rn/text {:style (:caption-text styles)} (format-entry-date (:date entry))]]]
       [rn/view
        [rn/text {:style (:secondary-text styles)} (str "»" (:title (:feed entry)))]]]]]))

(defn update-time-info [update-time]
  (let [styles {:wrapper {:background-color (:grey300 colors)
                          :padding-vertical 6
                          :padding-left 16}
                :text {:font-size 12
                       :font-weight "500"
                       :color (:secondary-text palette)}}]
    [rn/view {:style (:wrapper styles)}
     [rn/text {:style (:text styles)}
      (str "LAST UPDATE: ") (format-update-time update-time)]]))

(defn entry-quick-actions [entry]
  (let [styles {:wrapper {:flex 1
                          :flex-direction "row"
                          :justify-content "flex-end"}
                :icon {:color (:dark-primary palette)}}]
    [rn/view {:style (:wrapper styles)}
     [rn/touchable {:on-press #(dispatch [:mark-entries-as-read (list (:webid entry))])}
      [rn/view {}
       [icon {:style (:icon styles) :name "archive" :size 22}]]]]))

(defn no-entries-component []
  (let [styles {:wrapper {:height 300
                          :align-items "center"}}]
    [rn/view {:style (:wrapper styles)}
     [icon {:style {} :name "rss-feed" :size 84}]
     [rn/text "There are no entries"]]))

(defn entries-scene []
  (let [loading (subscribe [:loading?])
        update-time (subscribe [:update-time])
        remote-error (subscribe [:remote-error :entries])
        entries (subscribe [:entries])
        styles {:wrapper {:flex 1}
                :list {:margin-top 0
                       :padding-bottom 0}
                :separator {:height 1
                            :background-color (:grey300 colors)}}]
    (fn []
      (let [datasource (.cloneWithRowsAndSections
                        (rn/ReactNative.SwipeableListView.getNewDataSource.)
                        (clj->js {:s1 (or @entries '())})
                        (clj->js '("s1")))]
        [rn/view {:style (:wrapper styles)}
         (when @remote-error
           [remote-error-message])
         [rn/swipeable-list-view {:dataSource datasource
                                  :max-swipe-distance 50
                                  :bounceFirstRowOnMount false
                                  :refresh-control (r/as-element [rn/refresh-control {:refreshing @loading
                                                                                :on-refresh #(dispatch [:fetch-content])}])
                                  :style (:list styles)
                                  :enableEmptySections true
                                  :render-header (fn [_ _]
                                                   (when (> @update-time 0)
                                                     (r/as-element [update-time-info @update-time])))
                                  ;; :render-quick-actions (fn [row-data _section-id _row-id]
                                  ;;                         (r/as-element [entry-quick-actions (js->clj row-data :keywordize-keys true)]))
                                  :render-row (fn [data _section-id _row-id]
                                                (r/as-element [entry-row (js->clj data :keywordize-keys true)]))
                                  :render-separator (fn [section-id row-id _]
                                                      (r/as-element [rn/view {:key (str section-id "-" row-id)
                                                                              :style (:separator styles)}]))}]
         (when (empty? @entries)
           [no-entries-component])]))))

(ns elfeed-cljsrn.android.scenes.entries
  (:require [reagent.core :as r]
            [re-frame.core :refer [subscribe dispatch]]
            [elfeed-cljsrn.rn :as rn]
            [elfeed-cljsrn.navigation :refer [navigate-to]]
            [elfeed-cljsrn.ui :as ui :refer [colors palette button icon]]
            [elfeed-cljsrn.events]
            [elfeed-cljsrn.subs])
  (:import [goog.i18n DateTimeFormat]))

(defn format-update-time [time]
  (let [js-date (js/Date. (* time 1000))]
    (.format (goog.i18n.DateTimeFormat. "dd/MM/yyyy hh:mm") js-date)))

(defn format-entry-date [date]
  (let [js-date (js/Date. date)]
    (.format (goog.i18n.DateTimeFormat. "dd/MM/yyyy") js-date)))

(defn remote-error-message []
  [rn/view {:style {:padding 10
                    :background-color "#fff9c4"}}
   [rn/text "Network error. Check your wifi or your elfeed server."]])

(defn entry-row [entry]
  (let [styles {:list-wrapper {:background-color (if (:selected? entry) "#d4d4d4"
                                                     (if (:unread? entry)
                                                       (:white colors)
                                                       (:grey100 colors)))
                               :padding-horizontal 16
                               :height 72
                               :justify-content "center"}
                :first-line {:flex-direction "row"
                             :justify-content "space-between"}
                :title {:flex-shrink 1
                        :padding-right 16
                        :font-size 16
                        :font-weight "400"
                        :line-height 24}
                :date {:font-size 12
                       :font-weight "400"
                       :line-height 20}
                :feed {:line-height 22
                       :font-size 14
                       :color "rgba(0,0,0,.54)"}}]
    [rn/touchable {:key (:webid entry)
                   :underlay-color (:grey-100 colors)
                   :on-long-press (fn [_]
                                    (dispatch [:toggle-select-entry entry]))
                   :on-press (fn [_]
                               (dispatch [:press-entry-row entry]))}
     [rn/view {:style (:list-wrapper styles)}
      [rn/view {:style (:first-line styles)}
       [rn/text {:number-of-lines 1 :style (:title styles)} (:title entry)]
       [rn/text {:style (:date styles)} (format-entry-date (:date entry))]]
      [rn/text {:style (:feed styles)} (str "» " (:title (:feed entry)))]]]))

(defn update-time-info [update-time]
  (let [styles {:wrapper {:background-color (:grey300 colors)
                          :padding-vertical 6
                          :padding-left 16}
                :text {:font-size 12
                       :font-weight "500"
                       :color (:secondary-text palette)}}]
    [rn/view {:style (:wrapper styles)}
     [rn/text {:style (:text styles)}
      (str "LAST UPDATE: ") (format-update-time update-time)]]))

(defn entry-quick-actions [entry]
  (let [styles {:wrapper {:flex 1
                          :flex-direction "row"
                          :justify-content "flex-end"}
                :icon {:color (:dark-primary palette)}}]
    [rn/view {:style (:wrapper styles)}
     [rn/touchable {:on-press #(dispatch [:mark-entries-as-read (list (:webid entry))])}
      [rn/view {}
       [icon {:style (:icon styles) :name "archive" :size 22}]]]]))

(defn no-entries-component []
  (let [styles {:wrapper {:height 300
                          :align-items "center"}}]
    [rn/view {:style (:wrapper styles)}
     [icon {:style {} :name "rss-feed" :size 84}]
     [rn/text "There are no entries"]]))

(defn entries-scene []
  (let [loading (subscribe [:loading?])
        update-time (subscribe [:update-time])
        remote-error (subscribe [:remote-error :entries])
        entries (subscribe [:entries])
        styles {:wrapper {:flex 1}
                :list {:margin-top 0
                       :padding-bottom 0}
                :separator {:height 1
                            :background-color (:grey300 colors)}}]
    (fn []
      (let [datasource (.cloneWithRowsAndSections
                        (rn/ReactNative.SwipeableListView.getNewDataSource.)
                        (clj->js {:s1 (or @entries '())})
                        (clj->js '("s1")))]
        [rn/view {:style (:wrapper styles)}
         (when @remote-error
           [remote-error-message])
         [rn/swipeable-list-view {:dataSource datasource
                                  :max-swipe-distance 50
                                  :bounceFirstRowOnMount false
                                  :refresh-control (r/as-element [rn/refresh-control {:refreshing @loading
                                                                                :on-refresh #(dispatch [:fetch-content])}])
                                  :style (:list styles)
                                  :enableEmptySections true
                                  :render-header (fn [_ _]
                                                   (when (> @update-time 0)
                                                     (r/as-element [update-time-info @update-time])))
                                  ;; :render-quick-actions (fn [row-data _section-id _row-id]
                                  ;;                         (r/as-element [entry-quick-actions (js->clj row-data :keywordize-keys true)]))
                                  :render-row (fn [data _section-id _row-id]
                                                (r/as-element [entry-row (js->clj data :keywordize-keys true)]))
                                  :render-separator (fn [section-id row-id _]
                                                      (r/as-element [rn/view {:key (str section-id "-" row-id)
                                                                              :style (:separator styles)}]))}]
         (when (empty? @entries)
           [no-entries-component])]))))

Simplify layout for entry-row component

Simplify layout for entry-row component


(ns overtunes.songs.row-row-row-your-boat
  (:use
    [overtone.live :only [at now]]
    [overtone.inst.sampled-piano :only [sampled-piano]]))

(defn sum-n [series n] (reduce + (take n series)))
(def major-scale (partial sum-n (cycle [2 2 1 2 2 2 1])))
(def g-major #(-> % major-scale (+ 67)))

(defn bpm [beats start] #(-> % (/ beats) (* 60) (* 1000) (+ start)))
(defn after [timing beats] #(timing (+ beats %)))
(defn syncopate [timing durations] #(timing (sum-n durations %)))

(def pitches [0 0 0 1 2, 2 1 2 3 4, 7 7 7 4 4 4 2 2 2 0 0 0, 4 3 2 1 0])
(def durations [1 1 2/3 1/3 1, 2/3 1/3 2/3 1/3 2, 1/3 1/3 1/3 1/3 1/3 1/3 1/3 1/3 1/3 1/3 1/3 1/3, 2/3 1/3 2/3 1/3 2])

(defn melody# [timing notes]
  (let [note# #(at (timing %1) (sampled-piano (g-major %2)))]
    (dorun (map-indexed note# notes))))

(defn play# []
  (let [timing (bpm 150 (now))
        rhythm-from #(syncopate (after timing %) durations)]
    (melody# (rhythm-from 0)  pitches)
    (melody# (rhythm-from 16) pitches)
    (melody# (rhythm-from 20) pitches)
    (melody# (rhythm-from 24) pitches)
    (melody# (rhythm-from 28) pitches)
    ))

(play#)

(ns overtunes.songs.row-row-row-your-boat
  (:use
    [overtone.live :only [at now]]
    [overtone.inst.sampled-piano :only [sampled-piano]]))

(defn sum-n [series n] (reduce + (take n series)))
(def major-scale (partial sum-n (cycle [2 2 1 2 2 2 1])))
(def g-major #(-> % major-scale (+ 67)))

(defn bpm [beats start] #(-> % (/ beats) (* 60) (* 1000) (+ start)))
(defn after [timing beats] #(-> % (+ beats) timing))
(defn syncopate [timing durations] #(-> (sum-n durations %) timing))

(def pitches [0 0 0 1 2, 2 1 2 3 4, 7 7 7 4 4 4 2 2 2 0 0 0, 4 3 2 1 0])
(def durations [1 1 2/3 1/3 1, 2/3 1/3 2/3 1/3 2, 1/3 1/3 1/3 1/3 1/3 1/3 1/3 1/3 1/3 1/3 1/3 1/3, 2/3 1/3 2/3 1/3 2])

(defn melody# [timing notes]
  (let [note# #(at (timing %1) (sampled-piano (g-major %2)))]
    (dorun (map-indexed note# notes))))

(defn play# []
  (let [timing (bpm 150 (now))
        rhythm-from #(syncopate (after timing %) durations)]
    (melody# (rhythm-from 0)  pitches)
    (melody# (rhythm-from 16) pitches)
    (melody# (rhythm-from 20) pitches)
    (melody# (rhythm-from 24) pitches)
    (melody# (rhythm-from 28) pitches)
    ))

(play#)

Use -> instead of nesting.

Use -> instead of nesting.


(ns ^:no-doc onyx.peer.function
    (:require [clojure.core.async :refer [chan >! go alts!! close! timeout]]
              [onyx.static.planning :refer [find-task]]
              [onyx.messaging.acking-daemon :as acker]
              [onyx.peer.pipeline-extensions :as p-ext]
              [onyx.peer.operation :as operation]
              [onyx.extensions :as extensions]
              [taoensso.timbre :as timbre :refer [debug info]]
              [onyx.types :refer [->Leaf]]
              [dire.core :refer [with-post-hook!]])
    (:import [java.util UUID]))

(defmethod p-ext/read-batch :default
  [{:keys [onyx.core/messenger] :as event}]
  {:onyx.core/batch (onyx.extensions/receive-messages messenger event)})

(defn apply-fn
  [{:keys [onyx.core/params] :as event} segment]
  (if-let [f (:onyx.core/fn event)]
    (operation/apply-function f params segment)
    segment))

(defn filter-by-route [messages task-name]
  (->> messages
       (filter (fn [msg] (some #{task-name} (:flow (:routes msg)))))
       (map #(dissoc % :routes :hash-group))))

(defn into-transient [coll vs]
  (loop [rs (seq vs) updated-coll coll]
    (if rs
      (recur (next rs)
             (conj! updated-coll (first rs)))
      updated-coll)))

(defn fast-concat [vvs]
  (loop [vs (seq vvs) coll (transient [])]
    (if vs
      (recur (next vs)
             (into-transient coll (first vs)))
      (persistent! coll))))

;; needs a performance boost
(defn build-segments-to-send [leaves]
  (->> leaves
       (map (fn [{:keys [routes ack-vals hash-group message] :as leaf}]
              (if (= :retry (:action routes))
                []
                (map (fn [route ack-val]
                       (->Leaf (:message leaf)
                               (:id leaf)
                               (:acker-id leaf)
                               (:completion-id leaf)
                               ack-val
                               nil
                               route
                               nil
                               (get hash-group route)))
                     (:flow routes)
                     ack-vals))))
       fast-concat))

(defn pick-peer [id active-peers hash-group max-downstream-links]
  (when-not (empty? active-peers)
    (if hash-group
      (nth active-peers
           (mod (hash hash-group)
                (count active-peers)))
      (rand-nth (operation/select-n-peers id active-peers max-downstream-links)))))

;; Needs a performance boost
(defmethod p-ext/write-batch :default
  [{:keys [onyx.core/id onyx.core/results onyx.core/messenger onyx.core/job-id onyx.core/max-downstream-links] :as event}]
  (let [leaves (fast-concat (map :leaves results))
        egress-tasks (:egress-ids (:onyx.core/serialized-task event))]
    (when-not (empty? leaves)
      (let [replica @(:onyx.core/replica event)
            peer-state (:peer-state replica)
            segments (build-segments-to-send leaves)
            groups (group-by (juxt :route :hash-group) segments)
            allocations (get (:allocations replica) job-id)]
        (doseq [[[route hash-group] segs] groups]
          (let [peers (get allocations (get egress-tasks route))
                active-peers (filter #(= (get peer-state %) :active) peers)
                target (pick-peer id active-peers hash-group max-downstream-links)]
            (when target
              (let [link (operation/peer-link event target)]
                (onyx.extensions/send-messages messenger event link segs)))))
        {}))))

(ns ^:no-doc onyx.peer.function
    (:require [clojure.core.async :refer [chan >! go alts!! close! timeout]]
              [onyx.static.planning :refer [find-task]]
              [onyx.messaging.acking-daemon :as acker]
              [onyx.peer.pipeline-extensions :as p-ext]
              [onyx.peer.operation :as operation]
              [onyx.extensions :as extensions]
              [taoensso.timbre :as timbre :refer [debug info]]
              [onyx.types :refer [->Leaf]]
              [dire.core :refer [with-post-hook!]])
    (:import [java.util UUID]))

(defmethod p-ext/read-batch :default
  [{:keys [onyx.core/messenger] :as event}]
  {:onyx.core/batch (onyx.extensions/receive-messages messenger event)})

(defn apply-fn
  [{:keys [onyx.core/params] :as event} segment]
  (if-let [f (:onyx.core/fn event)]
    (operation/apply-function f params segment)
    segment))

(defn filter-by-route [messages task-name]
  (->> messages
       (filter (fn [msg] (some #{task-name} (:flow (:routes msg)))))
       (map #(dissoc % :routes :hash-group))))

(defn into-transient [coll vs]
  (loop [rs (seq vs) updated-coll coll]
    (if rs
      (recur (next rs)
             (conj! updated-coll (first rs)))
      updated-coll)))

(defn fast-concat [vvs]
  (loop [vs (seq vvs) coll (transient [])]
    (if vs
      (recur (next vs)
             (into-transient coll (first vs)))
      (persistent! coll))))

;; needs a performance boost
(defn build-segments-to-send [leaves]
  (->> leaves
       (map (fn [{:keys [routes ack-vals hash-group message] :as leaf}]
              (if (= :retry (:action routes))
                []
                (map (fn [route ack-val]
                       (->Leaf (:message leaf)
                               (:id leaf)
                               (:acker-id leaf)
                               (:completion-id leaf)
                               ack-val
                               nil
                               route
                               nil
                               (get hash-group route)))
                     (:flow routes)
                     ack-vals))))
       fast-concat))

(defn pick-peer [id active-peers hash-group max-downstream-links]
  (when-not (empty? active-peers)
    (if hash-group
      (nth active-peers
           (mod (hash hash-group)
                (count active-peers)))
      (rand-nth (operation/select-n-peers id active-peers max-downstream-links)))))

;; Needs a performance boost
(defmethod p-ext/write-batch :default
  [{:keys [onyx.core/id onyx.core/results onyx.core/messenger onyx.core/job-id onyx.core/max-downstream-links] :as event}]
  (let [leaves (fast-concat (map :leaves results))
        egress-tasks (:egress-ids (:onyx.core/serialized-task event))]
    (when-not (empty? leaves)
      (let [replica @(:onyx.core/replica event)
            peer-state (:peer-state replica)
            segments (build-segments-to-send leaves)
            groups (group-by :route segments)
            allocations (get (:allocations replica) job-id)]
        (doseq [[route segs] groups]
          (let [peers (get allocations (get egress-tasks route))
                active-peers (filter #(= (get peer-state %) :active) peers)
                groups-hash (group-by :hash-group segs)]
            (doseq [[hash-group segs*] groups-hash]
              (when-let [target (pick-peer id active-peers hash-group max-downstream-links)]
                (let [link (operation/peer-link event target)]
                  (onyx.extensions/send-messages messenger event link segs*))))))
        {}))))

Perf: split some computation out of loop. Perform
separate group-by for :route and :hash-group to allow reuse of results