(ns reagent.impl.template
  (:require [clojure.string :as string]
            [reagent.impl.util :as util :refer [is-client]]
            [reagent.impl.component :as comp]
            [reagent.impl.batching :as batch]
            [reagent.ratom :as ratom]
            [reagent.interop :refer-macros [.' .!]]
            [reagent.debug :refer-macros [dbg prn println log dev?]]))

;; From Weavejester's Hiccup, via pump:
(def ^{:doc "Regular expression that parses a CSS-style id and class
             from a tag name."}
  re-tag #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?")

;;; Common utilities

(defn named? [x]
  (or (keyword? x)
      (symbol? x)))

(defn hiccup-tag? [x]
  (or (keyword? x)
      (symbol? x)
      (string? x)))

(defn valid-tag? [x]
  (or (hiccup-tag? x)
      (ifn? x)))

;;; Props conversion

(def prop-name-cache #js{:class "className"
                         :for "htmlFor"
                         :charset "charSet"})

(defn obj-get [o k]
  (when (.hasOwnProperty o k)
    (aget o k)))

(defn cached-prop-name [k]
  (if-not (named? k)
    k
    (if-let [k' (obj-get prop-name-cache (name k))]
      k'
      (aset prop-name-cache (name k)
            (util/dash-to-camel k)))))

(defn convert-prop-value [x]
  (cond (or (string? x) (number? x) (fn? x)) x
        (named? x) (name x)
        (map? x) (reduce-kv (fn [o k v]
                              (doto o
                                (aset (cached-prop-name k)
                                      (convert-prop-value v))))
                            #js{} x)
        (coll? x) (clj->js x)
        (ifn? x) (fn [& args] (apply x args))
        true (clj->js x)))

(defn set-id-class [props id class]
  (let [p (if (nil? props) #js{} props)]
    (when (and (some? id) (nil? (.' p :id)))
      (.! p :id id))
    (when (some? class)
      (let [old (.' p :className)]
        (.! p :className (if (some? old)
                           (str class " " old)
                           class))))
    p))

(defn convert-props [props id-class]
  (let [id (.' id-class :id)
        class (.' id-class :className)
        no-id-class (and (nil? id) (nil? class))]
    (if (and no-id-class (empty? props))
      nil
      (let [objprops (convert-prop-value props)]
        (if no-id-class
          objprops
          (set-id-class objprops id class))))))

;;; Specialization for input components

(defn input-unmount [this]
  (.! this :cljsInputValue nil))

(defn input-set-value [this]
  (when-some [value (.' this :cljsInputValue)]
    (.! this :cljsInputDirty false)
    (let [node (.' this getDOMNode)]
      (when (not= value (.' node :value))
        (.! node :value value)))))

(defn input-handle-change [this on-change e]
  (let [res (on-change e)]
    ;; Make sure the input is re-rendered, in case on-change
    ;; wants to keep the value unchanged
    (when-not (.' this :cljsInputDirty)
      (.! this :cljsInputDirty true)
      (batch/do-later #(input-set-value this)))
    res))

(defn input-render-setup [this jsprops]
  ;; Don't rely on React for updating "controlled inputs", since it
  ;; doesn't play well with async rendering (misses keystrokes).
  (if (and (.' jsprops hasOwnProperty "onChange")
           (.' jsprops hasOwnProperty "value"))
    (let [v (.' jsprops :value)
          value (if (nil? v) "" v)
          on-change (.' jsprops :onChange)]
      (.! this :cljsInputValue value)
      (js-delete jsprops "value")
      (doto jsprops
        (.! :defaultValue value)
        (.! :onChange #(input-handle-change this on-change %))))
    (.! this :cljsInputValue nil)))

(defn input-component? [x]
  (or (identical? x "input")
      (identical? x "textarea")))

(def reagent-input-class nil)

(declare make-element)

(def input-spec
  {:display-name "ReagentInput"
   :component-did-update input-set-value
   :component-will-unmount input-unmount
   :component-function
   (fn [argv comp jsprops first-child]
     (let [this comp/*current-component*]
       (input-render-setup this jsprops)
       (make-element argv comp jsprops first-child)))})

(defn reagent-input [argv comp jsprops first-child]
  (when (nil? reagent-input-class)
    (set! reagent-input-class
          (comp/create-class input-spec)))
  (reagent-input-class argv comp jsprops first-child))

;;; Conversion from Hiccup forms

(defn parse-tag [hiccup-tag]
  (let [[tag id class] (->> hiccup-tag name (re-matches re-tag) next)
        class' (when class
                 (string/replace class #"\." " "))]
    (assert tag (str "Unknown tag: '" hiccup-tag "'"))
    #js{:name tag
        :id id
        :className class'}))

(defn fn-to-class [f]
  (assert (ifn? f) (str "Expected a function, not " (pr-str f)))
  (let [spec (meta f)
        withrender (assoc spec :component-function f)
        res (comp/create-class withrender)
        wrapf (util/cached-react-class res)]
    (util/cache-react-class f wrapf)
    wrapf))

(defn as-class [tag]
  (if-some [cached-class (util/cached-react-class tag)]
    cached-class
    (fn-to-class tag)))

(defn get-key [x]
  (when (map? x) (get x :key)))

(defn reag-element [tag v]
  (let [c (as-class tag)
        jsprops #js{:argv v}]
    (let [key (if-some [k (some-> (meta v) get-key)]
                k
                (-> v (nth 1 nil) get-key))]
      (some->> key (.! jsprops :key)))
    (.' js/React createElement c jsprops)))

(def tag-name-cache #js{})

(defn cached-parse [x]
  (if-let [s (obj-get tag-name-cache (name x))]
    s
    (aset tag-name-cache (name x) (parse-tag x))))

(declare as-element)

(defn native-element [tag argv]
  (when (hiccup-tag? tag)
    (let [parsed (cached-parse tag)
          comp (.' parsed :name)]
      (let [props (nth argv 1 nil)
            hasprops (or (nil? props) (map? props))
            jsprops (convert-props (if hasprops props) parsed)
            first-child (if hasprops 2 1)]
        (if (input-component? comp)
          (-> [reagent-input argv comp jsprops first-child]
              (with-meta (meta argv))
              as-element)
          (let [p (if-some [key (some-> (meta argv) get-key)]
                    (doto (if (nil? jsprops) #js{} jsprops)
                      (.! :key key))
                    jsprops)]
            (make-element argv comp p first-child)))))))

(defn vec-to-elem [v]
  (assert (pos? (count v)) "Hiccup form should not be empty")
  (let [tag (nth v 0)]
    (assert (valid-tag? tag)
            (str "Invalid Hiccup form: " (pr-str v)))
    (if-some [ne (native-element tag v)]
      ne
      (reag-element tag v))))

(def seq-ctx #js{})

(defn warn-on-deref [x]
  (when-not (.' seq-ctx :warned)
    (log "Warning: Reactive deref not supported in seq in "
         (pr-str x))
    (.! seq-ctx :warned true)))

(declare expand-seq)

(defn as-element [x]
  (cond (string? x) x
        (vector? x) (vec-to-elem x)
        (seq? x) (if (dev?)
                   (if (nil? ratom/*ratom-context*)
                     (expand-seq x)
                     (let [s (ratom/capture-derefed
                              #(expand-seq x)
                              seq-ctx)]
                       (when (ratom/captured seq-ctx)
                         (warn-on-deref x))
                       s))
                   (expand-seq x))
        true x))

(defn expand-seq [s]
  (let [a (into-array s)]
    (dotimes [i (alength a)]
      (aset a i (as-element (aget a i))))
    a))

(defn make-element [argv comp jsprops first-child]
  (case (- (count argv) first-child)
    ;; Optimize cases of zero or one child
    0 (.' js/React createElement comp jsprops)

    1 (.' js/React createElement comp jsprops
          (as-element (nth argv first-child)))

    (.apply (.' js/React :createElement) nil
            (reduce-kv (fn [a k v]
                         (when (>= k first-child)
                           (.push a (as-element v)))
                         a)
                       #js[comp jsprops] argv))))

(ns reagent.impl.template
  (:require [clojure.string :as string]
            [reagent.impl.util :as util :refer [is-client]]
            [reagent.impl.component :as comp]
            [reagent.impl.batching :as batch]
            [reagent.ratom :as ratom]
            [reagent.interop :refer-macros [.' .!]]
            [reagent.debug :refer-macros [dbg prn println log dev?]]))

;; From Weavejester's Hiccup, via pump:
(def ^{:doc "Regular expression that parses a CSS-style id and class
             from a tag name."}
  re-tag #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?")

;;; Common utilities

(defn named? [x]
  (or (keyword? x)
      (symbol? x)))

(defn hiccup-tag? [x]
  (or (named? x)
      (string? x)))

(defn valid-tag? [x]
  (or (hiccup-tag? x)
      (ifn? x)))

;;; Props conversion

(def prop-name-cache #js{:class "className"
                         :for "htmlFor"
                         :charset "charSet"})

(defn obj-get [o k]
  (when (.hasOwnProperty o k)
    (aget o k)))

(defn cached-prop-name [k]
  (if (named? k)
    (if-some [k' (obj-get prop-name-cache (name k))]
      k'
      (aset prop-name-cache (name k)
            (util/dash-to-camel k)))
    k))

(defn convert-prop-value [x]
  (cond (or (string? x) (number? x) (fn? x)) x
        (named? x) (name x)
        (map? x) (reduce-kv (fn [o k v]
                              (doto o
                                (aset (cached-prop-name k)
                                      (convert-prop-value v))))
                            #js{} x)
        (coll? x) (clj->js x)
        (ifn? x) (fn [& args] (apply x args))
        true (clj->js x)))

(defn set-id-class [props id class]
  (let [p (if (nil? props) #js{} props)]
    (when (and (some? id) (nil? (.' p :id)))
      (.! p :id id))
    (when (some? class)
      (let [old (.' p :className)]
        (.! p :className (if (some? old)
                           (str class " " old)
                           class))))
    p))

(defn convert-props [props id-class]
  (let [id (.' id-class :id)
        class (.' id-class :className)
        no-id-class (and (nil? id) (nil? class))]
    (if (and no-id-class (empty? props))
      nil
      (let [objprops (convert-prop-value props)]
        (if no-id-class
          objprops
          (set-id-class objprops id class))))))

;;; Specialization for input components

(defn input-unmount [this]
  (.! this :cljsInputValue nil))

(defn input-set-value [this]
  (when-some [value (.' this :cljsInputValue)]
    (.! this :cljsInputDirty false)
    (let [node (.' this getDOMNode)]
      (when (not= value (.' node :value))
        (.! node :value value)))))

(defn input-handle-change [this on-change e]
  (let [res (on-change e)]
    ;; Make sure the input is re-rendered, in case on-change
    ;; wants to keep the value unchanged
    (when-not (.' this :cljsInputDirty)
      (.! this :cljsInputDirty true)
      (batch/do-later #(input-set-value this)))
    res))

(defn input-render-setup [this jsprops]
  ;; Don't rely on React for updating "controlled inputs", since it
  ;; doesn't play well with async rendering (misses keystrokes).
  (if (and (.' jsprops hasOwnProperty "onChange")
           (.' jsprops hasOwnProperty "value"))
    (let [v (.' jsprops :value)
          value (if (nil? v) "" v)
          on-change (.' jsprops :onChange)]
      (.! this :cljsInputValue value)
      (js-delete jsprops "value")
      (doto jsprops
        (.! :defaultValue value)
        (.! :onChange #(input-handle-change this on-change %))))
    (.! this :cljsInputValue nil)))

(defn input-component? [x]
  (or (identical? x "input")
      (identical? x "textarea")))

(def reagent-input-class nil)

(declare make-element)

(def input-spec
  {:display-name "ReagentInput"
   :component-did-update input-set-value
   :component-will-unmount input-unmount
   :component-function
   (fn [argv comp jsprops first-child]
     (let [this comp/*current-component*]
       (input-render-setup this jsprops)
       (make-element argv comp jsprops first-child)))})

(defn reagent-input [argv comp jsprops first-child]
  (when (nil? reagent-input-class)
    (set! reagent-input-class
          (comp/create-class input-spec)))
  (reagent-input-class argv comp jsprops first-child))

;;; Conversion from Hiccup forms

(defn parse-tag [hiccup-tag]
  (let [[tag id class] (->> hiccup-tag name (re-matches re-tag) next)
        class' (when class
                 (string/replace class #"\." " "))]
    (assert tag (str "Unknown tag: '" hiccup-tag "'"))
    #js{:name tag
        :id id
        :className class'}))

(defn fn-to-class [f]
  (assert (ifn? f) (str "Expected a function, not " (pr-str f)))
  (let [spec (meta f)
        withrender (assoc spec :component-function f)
        res (comp/create-class withrender)
        wrapf (util/cached-react-class res)]
    (util/cache-react-class f wrapf)
    wrapf))

(defn as-class [tag]
  (if-some [cached-class (util/cached-react-class tag)]
    cached-class
    (fn-to-class tag)))

(defn get-key [x]
  (when (map? x) (get x :key)))

(defn reag-element [tag v]
  (let [c (as-class tag)
        jsprops #js{:argv v}]
    (let [key (if-some [k (some-> (meta v) get-key)]
                k
                (-> v (nth 1 nil) get-key))]
      (some->> key (.! jsprops :key)))
    (.' js/React createElement c jsprops)))

(def tag-name-cache #js{})

(defn cached-parse [x]
  (if-some [s (obj-get tag-name-cache (name x))]
    s
    (aset tag-name-cache (name x) (parse-tag x))))

(declare as-element)

(defn native-element [tag argv]
  (when (hiccup-tag? tag)
    (let [parsed (cached-parse tag)
          comp (.' parsed :name)]
      (let [props (nth argv 1 nil)
            hasprops (or (nil? props) (map? props))
            jsprops (convert-props (if hasprops props) parsed)
            first-child (if hasprops 2 1)]
        (if (input-component? comp)
          (-> [reagent-input argv comp jsprops first-child]
              (with-meta (meta argv))
              as-element)
          (let [p (if-some [key (some-> (meta argv) get-key)]
                    (doto (if (nil? jsprops) #js{} jsprops)
                      (.! :key key))
                    jsprops)]
            (make-element argv comp p first-child)))))))

(defn vec-to-elem [v]
  (assert (pos? (count v)) "Hiccup form should not be empty")
  (let [tag (nth v 0)]
    (assert (valid-tag? tag)
            (str "Invalid Hiccup form: " (pr-str v)))
    (if-some [ne (native-element tag v)]
      ne
      (reag-element tag v))))

(def seq-ctx #js{})

(defn warn-on-deref [x]
  (when-not (.' seq-ctx :warned)
    (log "Warning: Reactive deref not supported in seq in "
         (pr-str x))
    (.! seq-ctx :warned true)))

(declare expand-seq)

(defn as-element [x]
  (cond (string? x) x
        (vector? x) (vec-to-elem x)
        (seq? x) (if (dev?)
                   (if (nil? ratom/*ratom-context*)
                     (expand-seq x)
                     (let [s (ratom/capture-derefed
                              #(expand-seq x)
                              seq-ctx)]
                       (when (ratom/captured seq-ctx)
                         (warn-on-deref x))
                       s))
                   (expand-seq x))
        true x))

(defn expand-seq [s]
  (let [a (into-array s)]
    (dotimes [i (alength a)]
      (aset a i (as-element (aget a i))))
    a))

(defn make-element [argv comp jsprops first-child]
  (case (- (count argv) first-child)
    ;; Optimize cases of zero or one child
    0 (.' js/React createElement comp jsprops)

    1 (.' js/React createElement comp jsprops
          (as-element (nth argv first-child)))

    (.apply (.' js/React :createElement) nil
            (reduce-kv (fn [a k v]
                         (when (>= k first-child)
                           (.push a (as-element v)))
                         a)
                       #js[comp jsprops] argv))))

Streamline template.cljs a little

Streamline template.cljs a little


(ns refactor-nrepl.middleware
  (:require [cider.nrepl.middleware.util
             [cljs :as cljs]
             [misc :refer [err-info]]]
            [clojure.tools.nrepl
             [middleware :refer [set-descriptor!]]
             [misc :refer [response-for]]
             [transport :as transport]]
            [refactor-nrepl
             [analyzer :refer [warm-ast-cache]]
             [artifacts :refer [artifact-list artifact-versions hotload-dependency]]
             [config :refer [configure]]
             [extract-definition :refer [extract-definition]]
             [plugin :as plugin]
             [rename-file-or-dir :refer [rename-file-or-dir]]
             [stubs-for-interface :refer [stubs-for-interface]]]
            [refactor-nrepl.find
             [find-symbol :refer [create-result-alist find-debug-fns find-symbol]]
             [find-unbound :refer [find-unbound-vars]]]
            [refactor-nrepl.ns
             [clean-ns :refer [clean-ns]]
             [pprint :refer [pprint-ns]]
             [resolve-missing :refer [resolve-missing]]]))

(defmacro ^:private with-errors-being-passed-on [transport msg & body]
  `(try
     ~@body
     (catch IllegalArgumentException e#
       (transport/send
        ~transport (response-for ~msg :error (.getMessage e#) :status :done)))
     (catch IllegalStateException e#
       (transport/send
        ~transport (response-for ~msg :error (.getMessage e#) :status :done)))
     (catch Exception e#
       (transport/send
        ~transport (response-for ~msg (err-info e# :refactor-nrepl-error))))))

(defmacro ^:private reply [transport msg & kv]
  `(with-errors-being-passed-on ~transport ~msg
     (transport/send ~transport (response-for ~msg ~(apply hash-map kv)))))

(defn- serialize-response [{:keys [serialization-format] :as msg} response]
  (condp = serialization-format
    "edn" (pr-str response)
    "bencode" response
    (pr-str response) ; edn as default
    ))

(defn resolve-missing-reply [{:keys [transport] :as msg}]
  (reply transport msg :candidates (resolve-missing msg) :status :done))

(defn- find-symbol-reply [{:keys [transport] :as msg}]
  (with-errors-being-passed-on transport msg
    (let [occurrences (find-symbol msg)]
      (doseq [occurrence occurrences
              :let [response (serialize-response msg (apply create-result-alist occurrence))]]
        (transport/send transport
                        (response-for msg :occurrence response)))
      (transport/send transport (response-for msg :count (count occurrences)
                                              :status :done)))))

(defn- find-debug-fns-reply [{:keys [transport] :as msg}]
  (reply transport msg :value (find-debug-fns msg) :status :done))

(defn- artifact-list-reply [{:keys [transport] :as msg}]
  (reply transport msg :artifacts (artifact-list msg) :status :done))

(defn- artifact-versions-reply [{:keys [transport] :as msg}]
  (reply transport msg :versions (artifact-versions msg) :status :done))

(defn- hotload-dependency-reply [{:keys [transport] :as msg}]
  (reply transport msg :status :done :dependency (hotload-dependency msg)))

(defn- clean-ns-reply [{:keys [transport] :as msg}]
  (reply transport msg :ns (some-> msg clean-ns (pprint-ns path)) :status :done))

(defn- find-unbound-reply [{:keys [transport] :as msg}]
  (reply transport msg :unbound (find-unbound-vars msg) :status :done))

(defn config-reply [{:keys [transport opts] :as msg}]
  (reply transport msg :status (and (configure msg) :done)))

(defn- version-reply [{:keys [transport] :as msg}]
  (reply transport msg :status :done :version (plugin/version)))

(defn- warm-ast-cache-reply [{:keys [transport] :as msg}]
  (reply transport msg :status :done
         :ast-statuses (serialize-response msg (warm-ast-cache))))

(defn- stubs-for-interface-reply [{:keys [transport] :as msg}]
  (reply transport msg :status :done
         :functions (serialize-response msg (stubs-for-interface msg))))

(defn- extract-definition-reply [{:keys [transport] :as msg}]
  (reply transport msg :status :done :definition (pr-str (extract-definition msg))))

(defn- rename-file-or-dir-reply [{:keys [transport old-path new-path] :as msg}]
  (reply transport msg :touched (rename-file-or-dir old-path new-path)
         :status :done))

(def refactor-nrepl-ops
  {
   "artifact-list" artifact-list-reply
   "artifact-versions" artifact-versions-reply
   "clean-ns" clean-ns-reply
   "configure" config-reply
   "extract-definition" extract-definition-reply
   "find-debug-fns" find-debug-fns-reply
   "find-symbol" find-symbol-reply
   "find-unbound" find-unbound-reply
   "hotload-dependency" hotload-dependency-reply
   "rename-file-or-dir" rename-file-or-dir-reply
   "resolve-missing" resolve-missing-reply
   "stubs-for-interface" stubs-for-interface-reply
   "version" version-reply
   "warm-ast-cache" warm-ast-cache-reply
   })

(defn wrap-refactor
  [handler]
  (fn [{:keys [op] :as msg}]
    ((get refactor-nrepl-ops op handler) msg)))

(set-descriptor!
 #'wrap-refactor
 (cljs/requires-piggieback
  {:handles (zipmap (keys refactor-nrepl-ops)
                    (repeat {:doc "See the refactor-nrepl README"
                             :returns {} :requires {}}))}))

(ns refactor-nrepl.middleware
  (:require [cider.nrepl.middleware.util
             [cljs :as cljs]
             [misc :refer [err-info]]]
            [clojure.tools.nrepl
             [middleware :refer [set-descriptor!]]
             [misc :refer [response-for]]
             [transport :as transport]]
            [refactor-nrepl
             [analyzer :refer [warm-ast-cache]]
             [artifacts :refer [artifact-list artifact-versions hotload-dependency]]
             [config :refer [configure]]
             [extract-definition :refer [extract-definition]]
             [plugin :as plugin]
             [rename-file-or-dir :refer [rename-file-or-dir]]
             [stubs-for-interface :refer [stubs-for-interface]]]
            [refactor-nrepl.find
             [find-symbol :refer [create-result-alist find-debug-fns find-symbol]]
             [find-unbound :refer [find-unbound-vars]]]
            [refactor-nrepl.ns
             [clean-ns :refer [clean-ns]]
             [pprint :refer [pprint-ns]]
             [resolve-missing :refer [resolve-missing]]]))

(defmacro ^:private with-errors-being-passed-on [transport msg & body]
  `(try
     ~@body
     (catch IllegalArgumentException e#
       (transport/send
        ~transport (response-for ~msg :error (.getMessage e#) :status :done)))
     (catch IllegalStateException e#
       (transport/send
        ~transport (response-for ~msg :error (.getMessage e#) :status :done)))
     (catch Exception e#
       (transport/send
        ~transport (response-for ~msg (err-info e# :refactor-nrepl-error))))))

(defmacro ^:private reply [transport msg & kv]
  `(with-errors-being-passed-on ~transport ~msg
     (transport/send ~transport (response-for ~msg ~(apply hash-map kv)))))

(defn- serialize-response [{:keys [serialization-format] :as msg} response]
  (condp = serialization-format
    "edn" (pr-str response)
    "bencode" response
    (pr-str response) ; edn as default
    ))

(defn resolve-missing-reply [{:keys [transport] :as msg}]
  (reply transport msg :candidates (resolve-missing msg) :status :done))

(defn- find-symbol-reply [{:keys [transport] :as msg}]
  (with-errors-being-passed-on transport msg
    (let [occurrences (find-symbol msg)]
      (doseq [occurrence occurrences
              :let [response (serialize-response msg (apply create-result-alist occurrence))]]
        (transport/send transport
                        (response-for msg :occurrence response)))
      (transport/send transport (response-for msg :count (count occurrences)
                                              :status :done)))))

(defn- find-debug-fns-reply [{:keys [transport] :as msg}]
  (reply transport msg :value (find-debug-fns msg) :status :done))

(defn- artifact-list-reply [{:keys [transport] :as msg}]
  (reply transport msg :artifacts (artifact-list msg) :status :done))

(defn- artifact-versions-reply [{:keys [transport] :as msg}]
  (reply transport msg :versions (artifact-versions msg) :status :done))

(defn- hotload-dependency-reply [{:keys [transport] :as msg}]
  (reply transport msg :status :done :dependency (hotload-dependency msg)))

(defn- clean-ns-reply [{:keys [transport path] :as msg}]
  (reply transport msg :ns (some-> msg clean-ns (pprint-ns path)) :status :done))

(defn- find-unbound-reply [{:keys [transport] :as msg}]
  (reply transport msg :unbound (find-unbound-vars msg) :status :done))

(defn config-reply [{:keys [transport opts] :as msg}]
  (reply transport msg :status (and (configure msg) :done)))

(defn- version-reply [{:keys [transport] :as msg}]
  (reply transport msg :status :done :version (plugin/version)))

(defn- warm-ast-cache-reply [{:keys [transport] :as msg}]
  (reply transport msg :status :done
         :ast-statuses (serialize-response msg (warm-ast-cache))))

(defn- stubs-for-interface-reply [{:keys [transport] :as msg}]
  (reply transport msg :status :done
         :functions (serialize-response msg (stubs-for-interface msg))))

(defn- extract-definition-reply [{:keys [transport] :as msg}]
  (reply transport msg :status :done :definition (pr-str (extract-definition msg))))

(defn- rename-file-or-dir-reply [{:keys [transport old-path new-path] :as msg}]
  (reply transport msg :touched (rename-file-or-dir old-path new-path)
         :status :done))

(def refactor-nrepl-ops
  {
   "artifact-list" artifact-list-reply
   "artifact-versions" artifact-versions-reply
   "clean-ns" clean-ns-reply
   "configure" config-reply
   "extract-definition" extract-definition-reply
   "find-debug-fns" find-debug-fns-reply
   "find-symbol" find-symbol-reply
   "find-unbound" find-unbound-reply
   "hotload-dependency" hotload-dependency-reply
   "rename-file-or-dir" rename-file-or-dir-reply
   "resolve-missing" resolve-missing-reply
   "stubs-for-interface" stubs-for-interface-reply
   "version" version-reply
   "warm-ast-cache" warm-ast-cache-reply
   })

(defn wrap-refactor
  [handler]
  (fn [{:keys [op] :as msg}]
    ((get refactor-nrepl-ops op handler) msg)))

(set-descriptor!
 #'wrap-refactor
 (cljs/requires-piggieback
  {:handles (zipmap (keys refactor-nrepl-ops)
                    (repeat {:doc "See the refactor-nrepl README"
                             :returns {} :requires {}}))}))

Fix previous fix

Fix previous fix


(ns demo.state)

(def adjectives ["pretty", "large", "big", "small", "tall", "short", "long", "handsome", "plain", "quaint", "clean", "elegant", "easy", "angry", "crazy", "helpful", "mushy", "odd", "unsightly", "adorable", "important", "inexpensive", "cheap", "expensive", "fancy"])
(def colours ["red", "yellow", "blue", "green", "pink", "brown", "purple", "brown", "white", "black", "orange"])
(def nouns ["table", "chair", "house", "bbq", "desk", "car", "pony", "cookie", "sandwich", "burger", "pizza", "mouse", "keyboard"])

(defrecord Data [id label])

(def id 0)

(defn build-data [count]
  ;; eagerly build data
  (loop [i 0
         data #js []]
    (if (< i count)
      (recur
       (inc i)
       (doto data
         (.push (->Data
                 (set! id (inc id))
                 (str (rand-nth adjectives)
                      " "
                      (rand-nth colours)
                      " "
                      (rand-nth nouns))))))
      ;; done
      (vec data))))

(defn add [data]
  (let [last-id (:id (last data) 0)]
    (into data (build-data 1000))))

(defn update-some [data]
  (reduce (fn [data index]
            (update data index update :label str " !!!"))
          data
          (range 0 (count data) 10)))

(defn swap-rows [data]
  (if (> (count data) 998)
    (-> data
        (assoc 1 (get data 998))
        (assoc 998 (get data 1)))
    data))

(defn delete-row [data id]
  (vec (remove #(identical? id (:id %)) data)))

(def initial-state
  {:data []
   :selected nil})

(defn state-reducer
  [state [action payload]]
  (case action
    ::run {:data (build-data 1000)
          :selected nil}
    ::run-lots {:data (build-data 10000)
               :selected nil}

    ::add (update state :data add)
    ::update (update state :data update-some)
    ::swap (update state :data swap-rows)
    ::select (assoc state :selected payload)
    ::delete (update state :data delete-row payload)
    ::clear initial-state))

(ns demo.state)

(def adjectives ["pretty", "large", "big", "small", "tall", "short", "long", "handsome", "plain", "quaint", "clean", "elegant", "easy", "angry", "crazy", "helpful", "mushy", "odd", "unsightly", "adorable", "important", "inexpensive", "cheap", "expensive", "fancy"])
(def colours ["red", "yellow", "blue", "green", "pink", "brown", "purple", "brown", "white", "black", "orange"])
(def nouns ["table", "chair", "house", "bbq", "desk", "car", "pony", "cookie", "sandwich", "burger", "pizza", "mouse", "keyboard"])

(defrecord Data [id label])

(def id 0)

(defn build-data [count]
  ;; eagerly build data
  (loop [i 0
         data (transient [])]
    (if (< i count)
      (recur
       (inc i)
       (conj! data (->Data
                    (set! id (inc id))
                    (str (rand-nth adjectives)
                         " "
                         (rand-nth colours)
                         " "
                         (rand-nth nouns)))))
      ;; done
      (persistent! data))))

(defn add [data]
  (let [last-id (:id (last data) 0)]
    (into data (build-data 1000))))

(defn update-some [data]
  (reduce (fn [data index]
            (update data index update :label str " !!!"))
          data
          (range 0 (count data) 10)))

(defn swap-rows [data]
  (if (> (count data) 998)
    (-> data
        (assoc 1 (get data 998))
        (assoc 998 (get data 1)))
    data))

(defn delete-row [data id]
  (vec (remove #(identical? id (:id %)) data)))

(def initial-state
  {:data []
   :selected nil})

(defn state-reducer
  [state [action payload]]
  (case action
    ::run {:data (build-data 1000)
          :selected nil}
    ::run-lots {:data (build-data 10000)
               :selected nil}

    ::add (update state :data add)
    ::update (update state :data update-some)
    ::swap (update state :data swap-rows)
    ::select (assoc state :selected payload)
    ::delete (update state :data delete-row payload)
    ::clear initial-state))

use transient instead of JS array

use transient instead of JS array


(ns ^:no-doc onyx.peer.task-lifecycle
    (:require [clojure.core.async :refer [alts!! <!! >!! <! >! timeout chan close! thread go dropping-buffer]]
              [com.stuartsierra.component :as component]
              [dire.core :as dire]
              [taoensso.timbre :refer [info warn trace] :as timbre]
              [onyx.log.commands.common :as common]
              [onyx.log.entry :as entry]
              [onyx.planning :refer [find-task]]
              [onyx.messaging.acking-daemon :as acker]
              [onyx.peer.task-lifecycle-extensions :as l-ext]
              [onyx.peer.pipeline-extensions :as p-ext]
              [onyx.peer.function :as function]
              [onyx.peer.aggregate :as aggregate]
              [onyx.peer.operation :as operation]
              [onyx.extensions :as extensions]
              [onyx.plugin.hornetq]))

(def restartable-exceptions [])

(defn resolve-calling-params [catalog-entry opts]
  (concat (get (:onyx.peer/fn-params opts) (:onyx/name catalog-entry))
          (map (fn [param] (get catalog-entry param)) (:onyx/params catalog-entry))))

(defn munge-start-lifecycle [event]
  (l-ext/start-lifecycle?* event))

(defn add-ack-value [m]
  (assoc m :ack-val (acker/gen-ack-value)))

(defn add-acker-id [event m]
  (let [peers (get-in @(:onyx.core/replica event) [:ackers (:onyx.core/job-id event)])
        n (mod (.hashCode (:message m)) (count peers))]
    (assoc m :acker-id (nth peers n))))

(defn add-completion-id [event m]
  (assoc m :completion-id (:onyx.core/id event)))

(defn tag-each-message [event]
  (if (= (:onyx/type (:onyx.core/task-map event)) :input)
    (let [event (update-in event
                           [:onyx.core/batch]
                           (fn [batch]
                             (map (comp (partial add-completion-id event)
                                        (partial add-acker-id event)
                                        add-ack-value)
                                  batch)))]
      (doseq [raw-segment (:onyx.core/batch event)]
        (extensions/internal-ack-message
         (:onyx.core/messenger event)
         event
         (operation/peer-link event (:acker-id raw-segment) :acker-peer-site)
         (:id raw-segment)
         (:completion-id raw-segment)
         (:ack-val raw-segment)))
      event)
    event))

(defn sentinel-found? [event]
  (seq (filter (partial = :done) (map :message (:onyx.core/decompressed event)))))

(defn complete-job [{:keys [onyx.core/job-id onyx.core/task-id] :as event}]
  (let [entry (entry/create-log-entry :exhaust-input {:job job-id :task task-id})]
    (>!! (:onyx.core/outbox-ch event) entry)))

(defn sentinel-id [event]
  (:id (first (filter #(= :done (:message %)) (:onyx.core/decompressed event)))))

(defn drop-nth [n coll]
  (keep-indexed #(if (not= %1 n) %2) coll))

(defn strip-sentinel [{:keys [onyx.core/batch onyx.core/decompressed] :as event}]
  (if-let [k (.indexOf (map :message decompressed) :done)]
    (merge event {:onyx.core/batch (drop-nth k batch)
                  :onyx.core/decompressed (drop-nth k decompressed)})))

(defn fuse-ack-vals [task parent-ack child-ack]
  (if (= (:onyx/type task) :output)
    parent-ack
    (acker/prefuse-vals parent-ack child-ack)))

(defn ack-messages [{:keys [onyx.core/acking-daemon onyx.core/children] :as event}]
  (if children
    (doseq [raw-segment (keys children)]
      (when (:ack-val raw-segment)
        (let [link (operation/peer-link event (:acker-id raw-segment) :acker-peer-site)]
          (extensions/internal-ack-message
           (:onyx.core/messenger event)
           event
           link
           (:id raw-segment)
           (:completion-id raw-segment)
           (fuse-ack-vals (:onyx.core/task-map event) (:ack-val raw-segment) (get children raw-segment))))))))

(defn segments->ack-values [event segments]
  (if (= :output (:onyx/type (:onyx.core/task-map event)))
    (repeat (count segments) nil)
    (map (fn [x] (acker/gen-ack-value)) segments)))

(defn with-clean-up [f ch dead-ch release-f exception-f]
  (try
    (f)
    (catch Exception e
      (exception-f e)
      (close! ch)
      ;; Unblock any blocked puts
      (<!! ch))
    (finally
     (>!! dead-ch true)
     (release-f))))

(defn inject-batch-resources [event]
  (let [cycle-params {:onyx.core/lifecycle-id (java.util.UUID/randomUUID)}]
    (merge event cycle-params (l-ext/inject-batch-resources* event))))

(defn read-batch [event]
  (let [rets (tag-each-message (merge event (p-ext/read-batch event)))]
    (when (= (:onyx/type (:onyx.core/task-map event)) :input)
      (doseq [m (:onyx.core/batch rets)]
        (go (try (<! (timeout 60000))
                 (when (p-ext/pending? rets (:id m))
                   (p-ext/replay-message event (:id m)))
                 (catch Exception e
                   (taoensso.timbre/warn e))))))
    rets))

(defn decompress-batch [event]
  (let [rets (merge event (p-ext/decompress-batch event))]
    (if (sentinel-found? rets)
      (do (if (p-ext/drained? rets)
            (complete-job rets)
            (p-ext/replay-message rets (sentinel-id rets)))
          (strip-sentinel rets))
      rets)))

(defn apply-fn [{:keys [onyx.core/batch onyx.core/decompressed] :as event}]
  (if (seq decompressed)
    (let [rets
          (merge event
                 (reduce
                  (fn [rets [raw thawed]]
                    (let [new-segments (p-ext/apply-fn event (:message thawed))
                          new-segments (if coll? new-segments) new-segments (vector new-segments)
                          new-ack-vals (map (fn [x] (acker/gen-ack-value)) new-segments)
                          tagged (apply acker/prefuse-vals new-ack-vals)
                          results (map (fn [segment ack-val]
                                         {:id (:id raw)
                                          :acker-id (:acker-id raw)
                                          :completion-id (:completion-id raw)
                                          :message segment
                                          :ack-val ack-val})
                                       new-segments new-ack-vals)]
                      (-> rets
                          (update-in [:onyx.core/results] concat results)
                          (assoc-in [:onyx.core/children raw] tagged))))
                  {:onyx.core/results [] :onyx.core/children {}}
                  (map vector batch decompressed)))]
      (ack-messages rets)
      rets)
    (merge event {:onyx.core/results []})))

(defn compress-batch [event]
  (merge event (p-ext/compress-batch event)))

(defn write-batch [event]
  (merge event (p-ext/write-batch event)))

(defn close-batch-resources [event]
  (merge event (l-ext/close-batch-resources* event)))

(defn release-messages! [messenger event]
  (go
   (loop []
     (when-let [id (<! (:release-ch messenger))]
       (p-ext/ack-message event id)
       (recur)))))

(defn forward-completion-calls! [event completion-ch]
  (try
    (loop []
      (when-let [{:keys [id peer-id]} (<!! completion-ch)]
        (let [peer-link (operation/peer-link (:onyx.core/state event) (:onyx.core/messenger event) peer-id :completion-peer-site)]
          (extensions/internal-complete-message (:onyx.core/messenger event) id peer-link)
          (recur))))
    (catch Exception e
      (timbre/fatal e))))

(defn handle-exception [e restart-ch outbox-ch job-id]
  (warn e)
  (if (some #{(type e)} restartable-exceptions)
    (>!! restart-ch true)
    (let [entry (entry/create-log-entry :kill-job {:job job-id})]
      (>!! outbox-ch entry))))

(defn run-task-lifecycle [init-event kill-ch]
  (loop [event init-event]
    (when (first (alts!! [kill-ch] :default true))
      (-> event
          (inject-batch-resources)
          (read-batch)
          (decompress-batch)
          (apply-fn)
          (compress-batch)
          (write-batch)
          (close-batch-resources))
      (recur init-event))))

(defn listen-for-sealer [job task init-event seal-ch outbox-ch]
  ;; TODO: only launch for output tasks
  (go
   (try
     (when (<! seal-ch)
       (p-ext/seal-resource init-event)
       (let [entry (entry/create-log-entry :seal-output {:job job :task task})]
         (>!! outbox-ch entry)))
     (catch Exception e
       (warn e)))))

(defrecord TaskLifeCycle [id log messenger-buffer messenger job-id task-id replica restart-ch outbox-ch seal-resp-ch completion-ch opts]
  component/Lifecycle

  (start [component]
    (try
      (let [catalog (extensions/read-chunk log :catalog job-id)
            task (extensions/read-chunk log :task task-id)
            catalog-entry (find-task catalog (:name task))

            kill-ch (chan (dropping-buffer 1))

            _ (taoensso.timbre/info (format "[%s] Starting Task LifeCycle for %s" id (:name task)))

            pipeline-data {:onyx.core/id id
                           :onyx.core/job-id job-id
                           :onyx.core/task-id task-id
                           :onyx.core/task (:name task)
                           :onyx.core/catalog catalog
                           :onyx.core/workflow (extensions/read-chunk log :workflow job-id)
                           :onyx.core/task-map catalog-entry
                           :onyx.core/serialized-task task
                           :onyx.core/params (resolve-calling-params catalog-entry  opts)
                           :onyx.core/drained-back-off (or (:onyx.peer/drained-back-off opts) 400)
                           :onyx.core/log log
                           :onyx.core/messenger-buffer messenger-buffer
                           :onyx.core/messenger messenger
                           :onyx.core/outbox-ch outbox-ch
                           :onyx.core/seal-response-ch seal-resp-ch
                           :onyx.core/peer-opts opts
                           :onyx.core/replica replica
                           :onyx.core/state (atom {})}

            ex-f (fn [e] (handle-exception e restart-ch outbox-ch job-id))
            pipeline-data (merge pipeline-data (l-ext/inject-lifecycle-resources* pipeline-data))]

        (while (not (:onyx.core/start-lifecycle? (munge-start-lifecycle pipeline-data)))
          (Thread/sleep (or (:onyx.peer/sequential-back-off opts) 2000)))

        (>!! outbox-ch (entry/create-log-entry :signal-ready {:id id}))

        (loop [replica-state @replica]
          (when-not (and (common/job-covered? replica-state job-id)
                         (common/any-ackers? replica-state job-id))
            (taoensso.timbre/info (format "[%s] Not enough virtual peers have warmed up to start the job yet, backing off and trying again..." id))
            (Thread/sleep 500)
            (recur @replica)))

        (release-messages! messenger pipeline-data)
        (thread (forward-completion-calls! pipeline-data completion-ch))
        (listen-for-sealer job-id task-id pipeline-data seal-resp-ch outbox-ch)
        (thread (run-task-lifecycle pipeline-data kill-ch))

        (assoc component :pipeline-data pipeline-data :kill-ch kill-ch :seal-ch seal-resp-ch))
      (catch Exception e
        (handle-exception e restart-ch outbox-ch job-id)
        component)))

  (stop [component]
    (taoensso.timbre/info (format "[%s] Stopping Task LifeCycle for %s" id (:onyx.core/task (:pipeline-data component))))
    (l-ext/close-lifecycle-resources* (:pipeline-data component))

    (close! (:kill-ch component))
    (close! (:seal-ch component))

    component))

(defn task-lifecycle [args {:keys [id log messenger-buffer messenger job task replica
                                   restart-ch outbox-ch seal-ch completion-ch opts]}]
  (map->TaskLifeCycle {:id id :log log :messenger-buffer messenger-buffer
                       :messenger messenger :job-id job
                       :task-id task :restart-ch restart-ch :outbox-ch outbox-ch
                       :replica replica :seal-resp-ch seal-ch :completion-ch completion-ch
                       :opts opts}))

(dire/with-post-hook! #'munge-start-lifecycle
  (fn [{:keys [onyx.core/id onyx.core/lifecycle-id onyx.core/start-lifecycle?] :as event}]
    (when-not start-lifecycle?
      (timbre/info (format "[%s / %s] Sequential task currently has queue consumers. Backing off and retrying..." id lifecycle-id)))))

(dire/with-post-hook! #'inject-batch-resources
  (fn [{:keys [onyx.core/id onyx.core/lifecycle-id]}]
    (taoensso.timbre/trace (format "[%s / %s] Created new tx session" id lifecycle-id))))

(dire/with-post-hook! #'read-batch
  (fn [{:keys [onyx.core/id onyx.core/batch onyx.core/lifecycle-id]}]
    (taoensso.timbre/info (format "[%s / %s] Read %s segments" id lifecycle-id (count batch)))))

(dire/with-post-hook! #'decompress-batch
  (fn [{:keys [onyx.core/id onyx.core/decompressed onyx.core/batch onyx.core/lifecycle-id]}]
    (taoensso.timbre/trace (format "[%s / %s] Decompressed %s segments" id lifecycle-id (count decompressed)))))

(dire/with-post-hook! #'apply-fn
  (fn [{:keys [onyx.core/id onyx.core/results onyx.core/lifecycle-id]}]
    (taoensso.timbre/trace (format "[%s / %s] Applied fn to %s segments" id lifecycle-id (count results)))))

(dire/with-post-hook! #'compress-batch
  (fn [{:keys [onyx.core/id onyx.core/compressed onyx.core/lifecycle-id]}]
    (taoensso.timbre/trace (format "[%s / %s] Compressed %s segments" id lifecycle-id (count compressed)))))

(dire/with-post-hook! #'write-batch
  (fn [{:keys [onyx.core/id onyx.core/lifecycle-id onyx.core/compressed]}]
    (taoensso.timbre/info (format "[%s / %s] Wrote %s segments" id lifecycle-id (count compressed)))))

(dire/with-post-hook! #'close-batch-resources
  (fn [{:keys [onyx.core/id onyx.core/lifecycle-id]}]
    (taoensso.timbre/trace (format "[%s / %s] Closed batch plugin resources" id lifecycle-id))))

(ns ^:no-doc onyx.peer.task-lifecycle
    (:require [clojure.core.async :refer [alts!! <!! >!! <! >! timeout chan close! thread go dropping-buffer]]
              [com.stuartsierra.component :as component]
              [dire.core :as dire]
              [taoensso.timbre :refer [info warn trace] :as timbre]
              [onyx.log.commands.common :as common]
              [onyx.log.entry :as entry]
              [onyx.planning :refer [find-task]]
              [onyx.messaging.acking-daemon :as acker]
              [onyx.peer.task-lifecycle-extensions :as l-ext]
              [onyx.peer.pipeline-extensions :as p-ext]
              [onyx.peer.function :as function]
              [onyx.peer.aggregate :as aggregate]
              [onyx.peer.operation :as operation]
              [onyx.extensions :as extensions]
              [onyx.plugin.hornetq]))

(def restartable-exceptions [])

(defn resolve-calling-params [catalog-entry opts]
  (concat (get (:onyx.peer/fn-params opts) (:onyx/name catalog-entry))
          (map (fn [param] (get catalog-entry param)) (:onyx/params catalog-entry))))

(defn munge-start-lifecycle [event]
  (l-ext/start-lifecycle?* event))

(defn add-ack-value [m]
  (assoc m :ack-val (acker/gen-ack-value)))

(defn add-acker-id [event m]
  (let [peers (get-in @(:onyx.core/replica event) [:ackers (:onyx.core/job-id event)])
        n (mod (.hashCode (:message m)) (count peers))]
    (assoc m :acker-id (nth peers n))))

(defn add-completion-id [event m]
  (assoc m :completion-id (:onyx.core/id event)))

(defn tag-each-message [event]
  (if (= (:onyx/type (:onyx.core/task-map event)) :input)
    (let [event (update-in event
                           [:onyx.core/batch]
                           (fn [batch]
                             (map (comp (partial add-completion-id event)
                                        (partial add-acker-id event)
                                        add-ack-value)
                                  batch)))]
      (doseq [raw-segment (:onyx.core/batch event)]
        (extensions/internal-ack-message
         (:onyx.core/messenger event)
         event
         (operation/peer-link event (:acker-id raw-segment) :acker-peer-site)
         (:id raw-segment)
         (:completion-id raw-segment)
         (:ack-val raw-segment)))
      event)
    event))

(defn sentinel-found? [event]
  (seq (filter (partial = :done) (map :message (:onyx.core/decompressed event)))))

(defn complete-job [{:keys [onyx.core/job-id onyx.core/task-id] :as event}]
  (let [entry (entry/create-log-entry :exhaust-input {:job job-id :task task-id})]
    (>!! (:onyx.core/outbox-ch event) entry)))

(defn sentinel-id [event]
  (:id (first (filter #(= :done (:message %)) (:onyx.core/decompressed event)))))

(defn drop-nth [n coll]
  (keep-indexed #(if (not= %1 n) %2) coll))

(defn strip-sentinel [{:keys [onyx.core/batch onyx.core/decompressed] :as event}]
  (if-let [k (.indexOf (map :message decompressed) :done)]
    (merge event {:onyx.core/batch (drop-nth k batch)
                  :onyx.core/decompressed (drop-nth k decompressed)})))

(defn fuse-ack-vals [task parent-ack child-ack]
  (if (= (:onyx/type task) :output)
    parent-ack
    (acker/prefuse-vals parent-ack child-ack)))

(defn ack-messages [{:keys [onyx.core/acking-daemon onyx.core/children] :as event}]
  (if children
    (doseq [raw-segment (keys children)]
      (when (:ack-val raw-segment)
        (let [link (operation/peer-link event (:acker-id raw-segment) :acker-peer-site)]
          (extensions/internal-ack-message
           (:onyx.core/messenger event)
           event
           link
           (:id raw-segment)
           (:completion-id raw-segment)
           (fuse-ack-vals (:onyx.core/task-map event) (:ack-val raw-segment) (get children raw-segment))))))))

(defn segments->ack-values [event segments]
  (if (= :output (:onyx/type (:onyx.core/task-map event)))
    (repeat (count segments) nil)
    (map (fn [x] (acker/gen-ack-value)) segments)))

(defn with-clean-up [f ch dead-ch release-f exception-f]
  (try
    (f)
    (catch Exception e
      (exception-f e)
      (close! ch)
      ;; Unblock any blocked puts
      (<!! ch))
    (finally
     (>!! dead-ch true)
     (release-f))))

(defn inject-batch-resources [event]
  (let [cycle-params {:onyx.core/lifecycle-id (java.util.UUID/randomUUID)}]
    (merge event cycle-params (l-ext/inject-batch-resources* event))))

(defn read-batch [event]
  (let [rets (tag-each-message (merge event (p-ext/read-batch event)))]
    (when (= (:onyx/type (:onyx.core/task-map event)) :input)
      (doseq [m (:onyx.core/batch rets)]
        (go (try (<! (timeout 60000))
                 (when (p-ext/pending? rets (:id m))
                   (p-ext/replay-message event (:id m)))
                 (catch Exception e
                   (taoensso.timbre/warn e))))))
    rets))

(defn decompress-batch [event]
  (let [rets (merge event (p-ext/decompress-batch event))]
    (if (sentinel-found? rets)
      (do (if (p-ext/drained? rets)
            (complete-job rets)
            (p-ext/replay-message rets (sentinel-id rets)))
          (strip-sentinel rets))
      rets)))

(defn apply-fn [{:keys [onyx.core/batch onyx.core/decompressed] :as event}]
  (if (seq decompressed)
    (let [rets
          (merge event
                 (reduce
                  (fn [rets [raw thawed]]
                    (let [new-segments (p-ext/apply-fn event (:message thawed))
                          new-segments (if coll? new-segments) new-segments (vector new-segments)
                          new-ack-vals (map (fn [x] (acker/gen-ack-value)) new-segments)
                          tagged (apply acker/prefuse-vals new-ack-vals)
                          results (map (fn [segment ack-val]
                                         {:id (:id raw)
                                          :acker-id (:acker-id raw)
                                          :completion-id (:completion-id raw)
                                          :message segment
                                          :ack-val ack-val})
                                       new-segments new-ack-vals)]
                      (-> rets
                          (update-in [:onyx.core/results] concat results)
                          (assoc-in [:onyx.core/children raw] tagged))))
                  {:onyx.core/results [] :onyx.core/children {}}
                  (map vector batch decompressed)))]
      (ack-messages rets)
      rets)
    (merge event {:onyx.core/results []})))

(defn compress-batch [event]
  (merge event (p-ext/compress-batch event)))

(defn write-batch [event]
  (merge event (p-ext/write-batch event)))

(defn close-batch-resources [event]
  (merge event (l-ext/close-batch-resources* event)))

(defn release-messages! [messenger event]
  (go
   (loop []
     (when-let [id (<! (:release-ch messenger))]
       (p-ext/ack-message event id)
       (recur)))))

(defn forward-completion-calls! [event completion-ch]
  (try
    (loop []
      (when-let [{:keys [id peer-id]} (<!! completion-ch)]
        (let [peer-link (operation/peer-link event peer-id :completion-peer-site)]
          (extensions/internal-complete-message (:onyx.core/messenger event) id peer-link)
          (recur))))
    (catch Exception e
      (timbre/fatal e))))

(defn handle-exception [e restart-ch outbox-ch job-id]
  (warn e)
  (if (some #{(type e)} restartable-exceptions)
    (>!! restart-ch true)
    (let [entry (entry/create-log-entry :kill-job {:job job-id})]
      (>!! outbox-ch entry))))

(defn run-task-lifecycle [init-event kill-ch]
  (loop [event init-event]
    (when (first (alts!! [kill-ch] :default true))
      (-> event
          (inject-batch-resources)
          (read-batch)
          (decompress-batch)
          (apply-fn)
          (compress-batch)
          (write-batch)
          (close-batch-resources))
      (recur init-event))))

(defn listen-for-sealer [job task init-event seal-ch outbox-ch]
  ;; TODO: only launch for output tasks
  (go
   (try
     (when (<! seal-ch)
       (p-ext/seal-resource init-event)
       (let [entry (entry/create-log-entry :seal-output {:job job :task task})]
         (>!! outbox-ch entry)))
     (catch Exception e
       (warn e)))))

(defrecord TaskLifeCycle [id log messenger-buffer messenger job-id task-id replica restart-ch outbox-ch seal-resp-ch completion-ch opts]
  component/Lifecycle

  (start [component]
    (try
      (let [catalog (extensions/read-chunk log :catalog job-id)
            task (extensions/read-chunk log :task task-id)
            catalog-entry (find-task catalog (:name task))

            kill-ch (chan (dropping-buffer 1))

            _ (taoensso.timbre/info (format "[%s] Starting Task LifeCycle for %s" id (:name task)))

            pipeline-data {:onyx.core/id id
                           :onyx.core/job-id job-id
                           :onyx.core/task-id task-id
                           :onyx.core/task (:name task)
                           :onyx.core/catalog catalog
                           :onyx.core/workflow (extensions/read-chunk log :workflow job-id)
                           :onyx.core/task-map catalog-entry
                           :onyx.core/serialized-task task
                           :onyx.core/params (resolve-calling-params catalog-entry  opts)
                           :onyx.core/drained-back-off (or (:onyx.peer/drained-back-off opts) 400)
                           :onyx.core/log log
                           :onyx.core/messenger-buffer messenger-buffer
                           :onyx.core/messenger messenger
                           :onyx.core/outbox-ch outbox-ch
                           :onyx.core/seal-response-ch seal-resp-ch
                           :onyx.core/peer-opts opts
                           :onyx.core/replica replica
                           :onyx.core/state (atom {})}

            ex-f (fn [e] (handle-exception e restart-ch outbox-ch job-id))
            pipeline-data (merge pipeline-data (l-ext/inject-lifecycle-resources* pipeline-data))]

        (while (not (:onyx.core/start-lifecycle? (munge-start-lifecycle pipeline-data)))
          (Thread/sleep (or (:onyx.peer/sequential-back-off opts) 2000)))

        (>!! outbox-ch (entry/create-log-entry :signal-ready {:id id}))

        (loop [replica-state @replica]
          (when-not (and (common/job-covered? replica-state job-id)
                         (common/any-ackers? replica-state job-id))
            (taoensso.timbre/info (format "[%s] Not enough virtual peers have warmed up to start the job yet, backing off and trying again..." id))
            (Thread/sleep 500)
            (recur @replica)))

        (release-messages! messenger pipeline-data)
        (thread (forward-completion-calls! pipeline-data completion-ch))
        (listen-for-sealer job-id task-id pipeline-data seal-resp-ch outbox-ch)
        (thread (run-task-lifecycle pipeline-data kill-ch))

        (assoc component :pipeline-data pipeline-data :kill-ch kill-ch :seal-ch seal-resp-ch))
      (catch Exception e
        (handle-exception e restart-ch outbox-ch job-id)
        component)))

  (stop [component]
    (taoensso.timbre/info (format "[%s] Stopping Task LifeCycle for %s" id (:onyx.core/task (:pipeline-data component))))
    (l-ext/close-lifecycle-resources* (:pipeline-data component))

    (close! (:kill-ch component))
    (close! (:seal-ch component))

    component))

(defn task-lifecycle [args {:keys [id log messenger-buffer messenger job task replica
                                   restart-ch outbox-ch seal-ch completion-ch opts]}]
  (map->TaskLifeCycle {:id id :log log :messenger-buffer messenger-buffer
                       :messenger messenger :job-id job
                       :task-id task :restart-ch restart-ch :outbox-ch outbox-ch
                       :replica replica :seal-resp-ch seal-ch :completion-ch completion-ch
                       :opts opts}))

(dire/with-post-hook! #'munge-start-lifecycle
  (fn [{:keys [onyx.core/id onyx.core/lifecycle-id onyx.core/start-lifecycle?] :as event}]
    (when-not start-lifecycle?
      (timbre/info (format "[%s / %s] Sequential task currently has queue consumers. Backing off and retrying..." id lifecycle-id)))))

(dire/with-post-hook! #'inject-batch-resources
  (fn [{:keys [onyx.core/id onyx.core/lifecycle-id]}]
    (taoensso.timbre/trace (format "[%s / %s] Created new tx session" id lifecycle-id))))

(dire/with-post-hook! #'read-batch
  (fn [{:keys [onyx.core/id onyx.core/batch onyx.core/lifecycle-id]}]
    (taoensso.timbre/info (format "[%s / %s] Read %s segments" id lifecycle-id (count batch)))))

(dire/with-post-hook! #'decompress-batch
  (fn [{:keys [onyx.core/id onyx.core/decompressed onyx.core/batch onyx.core/lifecycle-id]}]
    (taoensso.timbre/trace (format "[%s / %s] Decompressed %s segments" id lifecycle-id (count decompressed)))))

(dire/with-post-hook! #'apply-fn
  (fn [{:keys [onyx.core/id onyx.core/results onyx.core/lifecycle-id]}]
    (taoensso.timbre/trace (format "[%s / %s] Applied fn to %s segments" id lifecycle-id (count results)))))

(dire/with-post-hook! #'compress-batch
  (fn [{:keys [onyx.core/id onyx.core/compressed onyx.core/lifecycle-id]}]
    (taoensso.timbre/trace (format "[%s / %s] Compressed %s segments" id lifecycle-id (count compressed)))))

(dire/with-post-hook! #'write-batch
  (fn [{:keys [onyx.core/id onyx.core/lifecycle-id onyx.core/compressed]}]
    (taoensso.timbre/info (format "[%s / %s] Wrote %s segments" id lifecycle-id (count compressed)))))

(dire/with-post-hook! #'close-batch-resources
  (fn [{:keys [onyx.core/id onyx.core/lifecycle-id]}]
    (taoensso.timbre/trace (format "[%s / %s] Closed batch plugin resources" id lifecycle-id))))

Fix forward complete.

Fix forward complete.


(ns posthere.capture-request
  "
  Capture the request to a particular URL in the storage so they can be retrieved later.
  Respond to the request.
  "
  (:require [clojure.string :as s]
            [clojure.core.incubator :refer (dissoc-in)]
            [clojure.core.match :refer (match)]
            [defun :refer (defun-)]
            [ring.util.codec :refer (form-decode)]
            [ring.util.response :refer (header response status)]
            [posthere.storage :refer (save-request)]
            [clj-time.core :as t]
            [cheshire.core :refer (parse-string generate-string)]
            [clojure.data.xml :refer (parse-str indent-str)]))

(def max-body-size (* 1024 1024)) ; 1 megabyte

(def form-urlencoded "application/x-www-form-urlencoded")

(def default-http-status-code 200)

;; http://en.wikipedia.org/wiki/List_of_HTTP_status_codes
(def http-status-codes #{
  100 101 102
  200 201 202 203 204 205 206 207 208 226
  300 301 302 303 304 305 306 307 308
  400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420
  422 423 424 426 428 429 431 440 449 450 451 494 495 496 497 498 499
  500 501 502 503 504 505 506 507 508 509 510 511 520 521 522 523 524 598 599
})

(def json-mime-types #{
  "application/json"
  "application/x-json"
  "application/javascript"
  "application/x-javascript"
  "text/json"
  "text/x-json"
  "text/javascript"
  "text/x-javascript"
  })

(def xml-mime-types #{
  "application/xml"
  "application/xhtml+xml"
  "application/rdf+xml"
  "application/atom+xml"
  "text/xml"
  })

(defn- add-time-stamp [request]
  (assoc request :timestamp (str (t/now))))

(defn- content-type-for [request]
  (get-in request [:headers "content-type"]))

;; ----- HTTP Response -----

(defn post-response-body [url-uuid]
  (str "We got your POST request! View your results at: http://posthere.io/" url-uuid "\n"))

(defn- post-response
  ""
  [url-uuid request]
  (-> (post-response-body url-uuid) ; string with directions
    (response) ; make the string the body of our response
    (header "Content-Type" "text/plain") ; add a content type header
    (status (:status request)))) ; add the HTTP status of the response

;; ----- HTTP Status -----

(defn- valid-status
  "Esure the requested status is an integer in our set of valid HTTP statuses,
   default the status if it's not or none was requested."
  [requested-status]
  (let [status (read-string (or requested-status "-1"))] ; turn status string into an integer
    (if (contains? http-status-codes status) ; make sure it's in our valid set
      status ; use the valid status they provided
      default-http-status-code))) ; they provided an invalid status (or none at all), so use the default status

(defn- handle-response-status
  "Move the requested status from the query string params to the root of the request map."
  [request]
  (let [requested-status-path [:parsed-query-string "status"]
        requested-status (get-in request requested-status-path)
        status (valid-status requested-status)] ; ensure the requested status is valid
    (-> request
      (assoc :status status)
      (dissoc-in requested-status-path))))

;; ----- Limit Body Size -----

(defn- update-request-body-too-big [uuid request-hash]
  (save-request
    uuid
    (assoc (dissoc request-hash :body) :body-overflow true)))

(defn- content-length-OK?
  "Check if the content length header is < max-body-size"
  [request]
  (let [content-length-header (read-string (get-in request [:headers "content-length"])) ; content-length header as int
        content-length (or content-length-header 0)] ; 0 if we have no content-length header
    (< content-length max-body-size)))

;; TODO check body length after slurp
;; TODO set overflow flags
(defn- limit-body-request-size
  ""
  [request]
  (if (and (:body request) (content-length-OK? request))
    (assoc request :body (slurp (:body request)))
    (dissoc request :body)))

;; ----- Pretty Print Body -----

(defun- json?
  "Generously determine if this mime-type is possibly JSON."
  ([nil] false)
  ([content-type]
    (let [base (first (s/split content-type #";"))]
      (or
        (contains? json-mime-types base) ; is a JSON mime-type seen out in the wild
        (re-find #"\+json" base))))) ; is some custom mime-type that uses JSON

(defun- xml?
  "Generously determine if this mime-type is possibly XML."
  ([nil] false)
  ([content-type]
    (let [base (first (s/split content-type #";"))]
      (or
        (contains? xml-mime-types base) ; is an XML mime-type seen out in the wild
        (re-find #"\+xml" base))))) ; is some custom mime-type that uses XML

(defn- url-encoded? [content-type]
  (= content-type form-urlencoded))

(defn- pretty-print
  "Try to parse the request body as XML if content-type is XML or not provided and it's not JSON"
  [request content-type? pretty-print derived-content-type]
  (let [content-type (content-type-for request)]
    (if (or (content-type? content-type)
            (and (s/blank? content-type) (s/blank? (:derived-content-type request))))
      (try
        ; pretty-print the body
        (-> request
          (assoc :body (pretty-print request))
          (assoc :derived-content-type derived-content-type))
        (catch Exception e ; XML parsing failed
          (if (s/blank? content-type) ; did they tell us it was XML?
            request ; we were only guessing it might be XML, so leave it as is
            (assoc request :invalid-body true)))) ; they told us it was XML, but it didn't parse
      request))) ; content-type is not XML

(defn- pretty-print-json
  [request]
  (pretty-print
    request
    json?
    (fn [request] (generate-string (parse-string (:body request)) {:pretty true}))
    "JSON"))

(defn- pretty-print-xml
  [request]
  (pretty-print
    request
    xml?
    (fn [request] (indent-str (parse-str (:body request))))
    "XML"))

 (defn- pretty-print-urlencoded
  [request]
  (pretty-print
    request
    url-encoded?
    (fn [request] (form-decode (:body request)))
    "URL ENCODED"))

;; ----- Parse URL Encoding -----

(defn- parse-query-string
  "Parse the query string into a map if there is one."
  [request]
  (if-let [query-string (:query-string request)]
    (assoc request :parsed-query-string (form-decode query-string))
    request)) ; no query-string to parse

;; ----- Data flow: Incoming Request -> Processed Request -> Storage -> HTTP Response -----

(defn capture-request
  "Save the processed request, respond to the POST."
  [url-uuid request]
  ;; Process the request
  (let [processed-request
    (-> request
      (add-time-stamp)
      (limit-body-request-size)
      (parse-query-string)
      (pretty-print-json) ; handle the body data if it's JSON
      (pretty-print-xml) ; handle the body data if it's XML
      (pretty-print-urlencoded) ; handle the body data if it's URL encoded field data
      (handle-response-status))]
    ;; Save the request
    (save-request url-uuid processed-request)
    ;; Respond to the HTTP client
    (post-response url-uuid processed-request)))

(ns posthere.capture-request
  "
  Capture the request to a particular URL in the storage so they can be retrieved later.
  Respond to the request.
  "
  (:require [clojure.string :as s]
            [clojure.core.incubator :refer (dissoc-in)]
            [clojure.core.match :refer (match)]
            [defun :refer (defun-)]
            [ring.util.codec :refer (form-decode)]
            [ring.util.response :refer (header response status)]
            [posthere.storage :refer (save-request)]
            [clj-time.core :as t]
            [cheshire.core :refer (parse-string generate-string)]
            [clojure.data.xml :refer (parse-str indent-str)]))

(def max-body-size (* 1024 1024)) ; 1 megabyte

(def form-urlencoded "application/x-www-form-urlencoded")

(def default-http-status-code 200)

;; http://en.wikipedia.org/wiki/List_of_HTTP_status_codes
(def http-status-codes #{
  100 101 102
  200 201 202 203 204 205 206 207 208 226
  300 301 302 303 304 305 306 307 308
  400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420
  422 423 424 426 428 429 431 440 449 450 451 494 495 496 497 498 499
  500 501 502 503 504 505 506 507 508 509 510 511 520 521 522 523 524 598 599
})

(def json-mime-types #{
  "application/json"
  "application/x-json"
  "application/javascript"
  "application/x-javascript"
  "text/json"
  "text/x-json"
  "text/javascript"
  "text/x-javascript"
  })

(def xml-mime-types #{
  "application/xml"
  "application/xhtml+xml"
  "application/rdf+xml"
  "application/atom+xml"
  "text/xml"
  })

(defn- add-time-stamp [request]
  (assoc request :timestamp (str (t/now))))

(defn- content-type-for [request]
  (get-in request [:headers "content-type"]))

;; ----- HTTP Response -----

(defn post-response-body [url-uuid]
  (str "We got your POST request! View your results at: http://posthere.io/" url-uuid "\n"))

(defn- post-response
  ""
  [url-uuid request]
  (-> (post-response-body url-uuid) ; string with directions
    (response) ; make the string the body of our response
    (header "Content-Type" "text/plain") ; add a content type header
    (status (:status request)))) ; add the HTTP status of the response

;; ----- HTTP Status -----

(defn- valid-status
  "Esure the requested status is an integer in our set of valid HTTP statuses,
   default the status if it's not or none was requested."
  [requested-status]
  (let [status (read-string (or requested-status "-1"))] ; turn status string into an integer
    (if (contains? http-status-codes status) ; make sure it's in our valid set
      status ; use the valid status they provided
      default-http-status-code))) ; they provided an invalid status (or none at all), so use the default status

(defn- handle-response-status
  "Move the requested status from the query string params to the root of the request map."
  [request]
  (let [requested-status-path [:parsed-query-string "status"]
        requested-status (get-in request requested-status-path)
        status (valid-status requested-status)] ; ensure the requested status is valid
    (-> request
      (assoc :status status)
      (dissoc-in requested-status-path))))

;; ----- Limit Body Size -----

(defn- update-request-body-too-big [uuid request-hash]
  (save-request
    uuid
    (assoc (dissoc request-hash :body) :body-overflow true)))

(defn- content-length-OK?
  "Check if the content length header is < max-body-size"
  [request]
  (let [content-length-header (read-string (get-in request [:headers "content-length"])) ; content-length header as int
        content-length (or content-length-header 0)] ; 0 if we have no content-length header
    (< content-length max-body-size)))

;; TODO check body length after slurp
;; TODO set overflow flags
(defn- limit-body-request-size
  ""
  [request]
  (if (and (:body request) (content-length-OK? request))
    (assoc request :body (slurp (:body request)))
    (dissoc request :body)))

;; ----- Pretty Print Body -----

(defun- json?
  "Generously determine if this mime-type is possibly JSON."
  ([nil] false)
  ([content-type]
    (let [base (first (s/split content-type #";"))]
      (or
        (contains? json-mime-types base) ; is a JSON mime-type seen out in the wild
        (re-find #"\+json" base))))) ; is some custom mime-type that uses JSON

(defun- xml?
  "Generously determine if this mime-type is possibly XML."
  ([nil] false)
  ([content-type]
    (let [base (first (s/split content-type #";"))]
      (or
        (contains? xml-mime-types base) ; is an XML mime-type seen out in the wild
        (re-find #"\+xml" base))))) ; is some custom mime-type that uses XML

(defn- url-encoded? [content-type]
  (= content-type form-urlencoded))

(defn- pretty-print
  "Try to parse the request body as XML if content-type is XML or not provided and it's not JSON"
  [request content-type? pretty-printer derived-content-type]
  (let [content-type (content-type-for request)]
    (if (or (content-type? content-type)
            (and (s/blank? content-type) (s/blank? (:derived-content-type request))))
      (try
        ; pretty-print the body
        (-> request
          (assoc :body (pretty-printer request))
          (assoc :derived-content-type derived-content-type))
        (catch Exception e ; XML parsing failed
          (if (s/blank? content-type) ; did they tell us it was XML?
            request ; we were only guessing it might be XML, so leave it as is
            (assoc request :invalid-body true)))) ; they told us it was XML, but it didn't parse
      request))) ; content-type is not XML

(defn- pretty-print-json
  [request]
  (pretty-print
    request
    json?
    (fn [request] (generate-string (parse-string (:body request)) {:pretty true}))
    "JSON"))

(defn- pretty-print-xml
  [request]
  (pretty-print
    request
    xml?
    (fn [request] (indent-str (parse-str (:body request))))
    "XML"))

 (defn- pretty-print-urlencoded
  [request]
  (pretty-print
    request
    url-encoded?
    (fn [request] (form-decode (:body request)))
    "URL ENCODED"))

;; ----- Parse URL Encoding -----

(defn- parse-query-string
  "Parse the query string into a map if there is one."
  [request]
  (if-let [query-string (:query-string request)]
    (assoc request :parsed-query-string (form-decode query-string))
    request)) ; no query-string to parse

;; ----- Data flow: Incoming Request -> Processed Request -> Storage -> HTTP Response -----

(defn capture-request
  "Save the processed request, respond to the POST."
  [url-uuid request]
  ;; Process the request
  (let [processed-request
    (-> request
      (add-time-stamp)
      (limit-body-request-size)
      (parse-query-string)
      (pretty-print-json) ; handle the body data if it's JSON
      (pretty-print-xml) ; handle the body data if it's XML
      (pretty-print-urlencoded) ; handle the body data if it's URL encoded field data
      (handle-response-status))]
    ;; Save the request
    (save-request url-uuid processed-request)
    ;; Respond to the HTTP client
    (post-response url-uuid processed-request)))

Replace a shadowed var with clearer code.


(ns stuttaford.web.content
  (:require [clj-time.format :as time-format]
            [clojure.string :as str]
            [hiccup.page :as page]
            [stuttaford.db :as db]
            [stuttaford.web.posts :as posts]))

(defn client-app [name dev? app-state]
  (list
   [:div {:data-component name}
    [:script {:type "application/edn"}
     (binding [*print-length* nil]
       (pr-str app-state))]]
   (page/include-js (str "/js/stuttaford" (when-not dev? ".min") ".js"))))

(defn codex [{:keys [db dev?]}]
  {:title  "Clojure Codex"
   :layout "page"
   :content
   (list
    [:p.add-link-message
     "Have a link you'd like to add? Tweet the link to me @RobStuttaford on Twitter with "
     [:span.hashtag "#codex"] " or simply click here: " [:br]
     [:a.twitter-hashtag-button
      {:href         "https://twitter.com/intent/tweet?button_hashtag=codex&text=%40RobStuttaford%20Link%3A%20your-link-here"
       :data-related "RobStuttaford" :data-dnt "true"}]
     [:script "!function(d,s,id){var js,fjs=d.getElementsByTagName(s)[0],p=/^http:/.test(d.location)?'http':'https';if(!d.getElementById(id)){js=d.createElement(s);js.id=id;js.src=p+'://platform.twitter.com/widgets.js';fjs.parentNode.insertBefore(js,fjs);}}(document, 'script', 'twitter-wjs');"]]
    (client-app "codex" dev?
                       {:db (db/datascript-db db
                                              #{:link/tags
                                                :link/title
                                                :link/uri
                                                :tag/name})}))})

(def format-date (partial time-format/unparse (time-format/formatter "dd MMM yyyy")))

(defmulti template (comp keyword :layout :page))

(defmethod template :page [{{:keys [title content]} :page}]
  [:div.page
   [:h1.page-title title]
   content])

(defmethod template :post [{{:keys [title content date permalink]} :page
                            :keys [recent-posts]}]
  (list
   [:div.post
    [:h1.post-title
     (if permalink
       [:a {:href permalink} title]
       title)]
    [:span.post-date (format-date date)]
    content]
   (when (str/includes? content "language-mermaid")
     (list [:script {:src "https://unpkg.com/mermaid@8.0.0-rc.6/dist/mermaid.min.js"}]
           [:script "mermaid.init({startOnLoad:true}, \".language-mermaid\");"]))
   (when (str/includes? content "language-clojure")
     (list [:script {:src "https://unpkg.com/highlightjs@9.10.0/highlight.pack.js"}]
           [:script " document.querySelectorAll(\".language-clojure\").forEach(hljs.highlightBlock);"]))
   (when-let [related (seq (posts/recent recent-posts date false))]
     [:div.related
      [:h2 "Related Posts"]
      [:ul.related-posts
       (for [{:keys [permalink title date]} related]
         [:li
          [:h3
           [:a {:href permalink} title " " [:small (format-date date)]]]])]])))

(defmethod template :blog [{:keys [latest-posts] :as config}]
  [:div.posts
   (if-some [latest (seq (posts/latest latest-posts))]
     (for [post latest]
       (template (update config :page merge post)))
     (list
      [:h1.post-title "Blog"]
      [:p "A new year, a new approach - coming soon!"]))
   [:div.related
    [:a {:href "/blog/archived/"}
     "Archived posts"]]])

(defmethod template :archived-blog [_]
  [:div.posts
   [:h2 "Archived Posts"]
   [:ul.related-posts
    (for [{:keys [permalink title date]} (posts/archived)]
      [:li
       [:h3
        [:a {:href permalink} title " " [:small (format-date date)]]]])]])

(defn html-layout [{{:keys [page-name title description content]} :page
                    {:keys [site-title site-description]} :meta
                    {:keys [name]} :author
                    :keys [base-url nav google-analytics-id domain year]
                    :as config}]
  (page/html5
   [:head
    [:link {:rel "profile" :href "http://gmpg.org/xfn/11"}]
    [:meta {:content "IE=edge" :http-equiv "X-UA-Compatible"}]
    [:meta {:content "text/html; charset=utf-8" :http-equiv "content-type"}]
    [:meta {:content "width=device-width initial-scale=1.0 maximum-scale=1"
            :name    "viewport"}]
    [:title
     (when-let [page-title title]
       (str page-title " · "))
     site-title ", " site-description]
    (when-let [description description]
      [:meta {:name "description" :content description}])
    (page/include-css "https://fonts.googleapis.com/css?family=Volkhov"
                      (str base-url "css/poole.css")
                      (str base-url "css/stuttaford.css")
                      "//cdn-images.mailchimp.com/embedcode/horizontal-slim-10_7.css")
    [:link {:href (str base-url "apple-touch-icon-precomposed.png") :sizes "152x152"
            :rel  "apple-touch-icon-precomposed"}]
    [:link {:href (str base-url "favicon.ico") :rel "shortcut icon"}]
    [:link {:href (str base-url "atom.xml") :rel   "alternate"
            :type "application/rss+xml"     :title "RSS"}]
    (when (str/includes? content "language-clojure")
      (page/include-css "https://unpkg.com/highlightjs@9.10.0/styles/tomorrow.css"))]
   [:body (when (some? page-name) {:class page-name})
    [:a {:name "top"}]
    [:div.container.content
     [:div.masthead
      [:h3.masthead-title
       [:a {:title "Home" :href base-url} site-title] " "
       [:small site-description]]
      (->> (for [{:keys [title path]} nav]
             [:small [:a {:href path} title]])
           (interpose " · "))]
     (template config)
     [:div.back-to-top [:a {:href "#top"} "Back to top"]]
     [:div#mc_embed_signup
      [:form#mc-embedded-subscribe-form.validate
       {:action "https://stuttaford.us17.list-manage.com/subscribe/post?u=fb5cca3ecb94dac76560e8fd8&id=4aa6be7af7"
        :method "post"
        :name   "mc-embedded-subscribe-form"
        :target "_blank"}
       [:div#mc_embed_signup_scroll
        [:input#mce-EMAIL.email
         {:type        "email"
          :value       ""
          :name        "EMAIL"
          :placeholder "Subscribe for updates"}]
        [:div {:style "position: absolute; left: -5000px;"
               :aria-hidden "true"}
         [:input {:type "text"
                  :name "b_fb5cca3ecb94dac76560e8fd8_4aa6be7af7"
                  :tabindex "-1"
                  :value ""}]]
        [:div.clear
         [:input#mc-embedded-subscribe.button
          {:type  "submit"
           :value "Subscribe"
           :name  "subscribe"
           :style "margin-left: 0.5rem"}]]]]]
     [:div.footer
      [:p "© " name " " year ". All rights reserved. Some lefts, too."]]
     [:script {:src         "https://code.jquery.com/jquery-3.3.0.slim.min.js"
               :integrity   "sha256-AMg3I7ya76OLPD9M+Mk7kqrA29HUn/FuGBfT/9Uf9ls="
               :crossorigin "anonymous"}]
     [:script "function backToTop() {
  if ($(window).scrollTop() <= 500 ) {
    $('.back-to-top').css('visibility','hidden');
  } else {
    $('.back-to-top').css('visibility','visible');
  }
}
scrollIntervalID = setInterval(backToTop, 10);"]
     [:script {:type "text/javascript"}
      "(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
    (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
    m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
    })(window,document,'script','//www.google-analytics.com/analytics.js','google_analytics');
    google_analytics('create', '" google-analytics-id "', '" domain "');
    google_analytics('send', 'pageview');"]]]))

(ns stuttaford.web.content
  (:require [clj-time.format :as time-format]
            [clojure.string :as str]
            [hiccup.page :as page]
            [stuttaford.db :as db]
            [stuttaford.web.posts :as posts]))

(defn client-app [name dev? app-state]
  (list
   [:div {:data-component name}
    [:script {:type "application/edn"}
     (binding [*print-length* nil]
       (pr-str app-state))]]
   (page/include-js (str "/js/stuttaford" (when-not dev? ".min") ".js"))))

(defn codex [{:keys [db dev?]}]
  {:title  "Clojure Codex"
   :layout "page"
   :content
   (list
    [:p.add-link-message
     "Have a link you'd like to add? Tweet the link to me @RobStuttaford on Twitter with "
     [:span.hashtag "#codex"] " or simply click here: " [:br]
     [:a.twitter-hashtag-button
      {:href         "https://twitter.com/intent/tweet?button_hashtag=codex&text=%40RobStuttaford%20Link%3A%20your-link-here"
       :data-related "RobStuttaford" :data-dnt "true"}]
     [:script "!function(d,s,id){var js,fjs=d.getElementsByTagName(s)[0],p=/^http:/.test(d.location)?'http':'https';if(!d.getElementById(id)){js=d.createElement(s);js.id=id;js.src=p+'://platform.twitter.com/widgets.js';fjs.parentNode.insertBefore(js,fjs);}}(document, 'script', 'twitter-wjs');"]]
    (client-app "codex" dev?
                       {:db (db/datascript-db db
                                              #{:link/tags
                                                :link/title
                                                :link/uri
                                                :tag/name})}))})

(def format-date (partial time-format/unparse (time-format/formatter "dd MMM yyyy")))

(defmulti template (comp keyword :layout :page))

(defmethod template :page [{{:keys [title content]} :page}]
  [:div.page
   [:h1.page-title title]
   content])

(defmethod template :post [{{:keys [title content date permalink]} :page
                            :keys [recent-posts]}]
  (list
   [:div.post
    [:h1.post-title
     (if permalink
       [:a {:href permalink} title]
       title)]
    [:span.post-date (format-date date)]
    content]
   (when (str/includes? content "language-mermaid")
     (list [:script {:src "https://unpkg.com/mermaid@8.0.0-rc.6/dist/mermaid.min.js"}]
           [:script "mermaid.init({startOnLoad:true}, \".language-mermaid\");"]))
   (when (str/includes? content "language-clojure")
     (list [:script {:src "https://unpkg.com/highlightjs@9.10.0/highlight.pack.js"}]
           [:script " document.querySelectorAll(\".language-clojure\").forEach(hljs.highlightBlock);"]))
   (when-let [related (seq (posts/recent recent-posts date false))]
     [:div.related
      [:h2 "Related Posts"]
      [:ul.related-posts
       (for [{:keys [permalink title date]} related]
         [:li
          [:h3
           [:a {:href permalink} title " " [:small (format-date date)]]]])]])))

(defmethod template :blog [{:keys [latest-posts] :as config}]
  [:div.posts
   (if-some [latest (seq (posts/latest latest-posts))]
     (for [post latest]
       (template (update config :page merge post)))
     (list
      [:h1.post-title "Blog"]
      [:p "A new year, a new approach - coming soon!"]))
   [:div.related
    [:a {:href "/blog/archived/"}
     "Archived posts"]]])

(defmethod template :archived-blog [_]
  [:div.posts
   [:h2 "Archived Posts"]
   [:ul.related-posts
    (for [{:keys [permalink title date]} (posts/archived)]
      [:li
       [:h3
        [:a {:href permalink} title " " [:small (format-date date)]]]])]])

(defn html-layout [{{:keys [page-name title description content]} :page
                    {:keys [site-title site-description]} :meta
                    {:keys [name]} :author
                    :keys [base-url nav google-analytics-id domain year]
                    :as config}]
  (page/html5
   [:head
    [:link {:rel "profile" :href "http://gmpg.org/xfn/11"}]
    [:meta {:content "IE=edge" :http-equiv "X-UA-Compatible"}]
    [:meta {:content "text/html; charset=utf-8" :http-equiv "content-type"}]
    [:meta {:content "width=device-width initial-scale=1.0 maximum-scale=1"
            :name    "viewport"}]
    [:title
     (when-let [page-title title]
       (str page-title " · "))
     site-title ", " site-description]
    (when-let [description description]
      [:meta {:name "description" :content description}])
    (page/include-css "https://fonts.googleapis.com/css?family=Volkhov"
                      (str base-url "css/poole.css")
                      (str base-url "css/stuttaford.css")
                      "//cdn-images.mailchimp.com/embedcode/horizontal-slim-10_7.css")
    [:link {:href (str base-url "apple-touch-icon-precomposed.png") :sizes "152x152"
            :rel  "apple-touch-icon-precomposed"}]
    [:link {:href (str base-url "favicon.ico") :rel "shortcut icon"}]
    [:link {:href (str base-url "atom.xml") :rel   "alternate"
            :type "application/rss+xml"     :title "RSS"}]
    (when (str/includes? content "language-clojure")
      (page/include-css "https://unpkg.com/highlightjs@9.10.0/styles/solarized-light.css"))]
   [:body (when (some? page-name) {:class page-name})
    [:a {:name "top"}]
    [:div.container.content
     [:div.masthead
      [:h3.masthead-title
       [:a {:title "Home" :href base-url} site-title] " "
       [:small site-description]]
      (->> (for [{:keys [title path]} nav]
             [:small [:a {:href path} title]])
           (interpose " · "))]
     (template config)
     [:div.back-to-top [:a {:href "#top"} "Back to top"]]
     [:div#mc_embed_signup
      [:form#mc-embedded-subscribe-form.validate
       {:action "https://stuttaford.us17.list-manage.com/subscribe/post?u=fb5cca3ecb94dac76560e8fd8&id=4aa6be7af7"
        :method "post"
        :name   "mc-embedded-subscribe-form"
        :target "_blank"}
       [:div#mc_embed_signup_scroll
        [:input#mce-EMAIL.email
         {:type        "email"
          :value       ""
          :name        "EMAIL"
          :placeholder "Subscribe for updates"}]
        [:div {:style "position: absolute; left: -5000px;"
               :aria-hidden "true"}
         [:input {:type "text"
                  :name "b_fb5cca3ecb94dac76560e8fd8_4aa6be7af7"
                  :tabindex "-1"
                  :value ""}]]
        [:div.clear
         [:input#mc-embedded-subscribe.button
          {:type  "submit"
           :value "Subscribe"
           :name  "subscribe"
           :style "margin-left: 0.5rem"}]]]]]
     [:div.footer
      [:p "© " name " " year ". All rights reserved. Some lefts, too."]]
     [:script {:src         "https://code.jquery.com/jquery-3.3.0.slim.min.js"
               :integrity   "sha256-AMg3I7ya76OLPD9M+Mk7kqrA29HUn/FuGBfT/9Uf9ls="
               :crossorigin "anonymous"}]
     [:script "function backToTop() {
  if ($(window).scrollTop() <= 500 ) {
    $('.back-to-top').css('visibility','hidden');
  } else {
    $('.back-to-top').css('visibility','visible');
  }
}
scrollIntervalID = setInterval(backToTop, 10);"]
     [:script {:type "text/javascript"}
      "(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
    (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
    m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
    })(window,document,'script','//www.google-analytics.com/analytics.js','google_analytics');
    google_analytics('create', '" google-analytics-id "', '" domain "');
    google_analytics('send', 'pageview');"]]]))

Switch to solarized-light

Switch to solarized-light


(ns radicalzephyr.boot-junit
  {:boot/export-tasks true}
  (:require [boot.core :as core]
            [clojure.string :as str])
  (:import org.junit.runner.JUnitCore
           org.junit.runner.notification.RunListener
           (org.reflections Reflections
                            Configuration)
           (org.reflections.scanners Scanner
                                     TypeAnnotationsScanner
                                     MethodAnnotationsScanner)
           (org.reflections.util ClasspathHelper
                                 ConfigurationBuilder
                                 FilterBuilder)))

(defn- failure->map [failure]
  {:description (.. failure (getDescription) (toString))
   ;;:exception (.getException failure)
   :message (.getMessage failure)})

(defn- result->map [result]
  {:successful? (.wasSuccessful result)
   :run-time (.getRunTime result)
   :run     (.getRunCount result)
   :ignored (.getIgnoreCount result)
   :failed  (.getFailureCount result)
   :failures (map failure->map (.getFailures result))})

(defn- build-package-config [^String package]
  (.. (ConfigurationBuilder.)
      (setUrls (ClasspathHelper/forPackage package (into-array ClassLoader [])))
      (setScanners (into-array Scanner [(TypeAnnotationsScanner.)
                                        (MethodAnnotationsScanner.)]))
      (filterInputsBy (.. (FilterBuilder.)
                          (includePackage (into-array String [package]))))))

(defn- find-tests-in-package [package]
  (let [^Configuration config (build-package-config package)
        reflections (Reflections. config)
        test-methods (.getMethodsAnnotatedWith reflections
                                               org.junit.Test)]
    (map (memfn getDeclaringClass) test-methods)))

(defn- find-all-tests [packages]
  (->> packages
       (map str)
       (mapcat find-tests-in-package)
       set))

(defn- run-listener [packages]
  (proxy [RunListener]
      []
    (testRunStarted [description]
      (println "Running jUnit tests for " (str/join ", " packages)))

    (testRunFinished [result]
      (println "\nTest run finished!")
      (when (> (.getFailureCount result) 0)
        (println (result->map result))))

    (testStarted [description]
      (print "."))

    (testFailure [failure]
      (print "E"))))

(core/deftask junit
  "Run the jUnit test runner."
  [p packages PACKAGE #{sym} "The set of Java packages to run tests in."]
  (core/with-pre-wrap fileset
    (if (seq packages)
      (let [^JUnitCore core (doto (JUnitCore.)
                              (.addListener (run-listener packages)))]
        (.run core
              (into-array Class
                          (find-all-tests packages))))
      (println "No packages were tested."))
    fileset))

(ns radicalzephyr.boot-junit
  {:boot/export-tasks true}
  (:require [boot.core :as core]
            [clojure.string :as str])
  (:import org.junit.runner.JUnitCore
           org.junit.runner.notification.RunListener
           (org.reflections Reflections
                            Configuration)
           (org.reflections.scanners Scanner
                                     TypeAnnotationsScanner
                                     MethodAnnotationsScanner)
           (org.reflections.util ClasspathHelper
                                 ConfigurationBuilder
                                 FilterBuilder)))

(defn- failure->map [failure]
  {:description (.. failure (getDescription) (toString))
   ;;:exception (.getException failure)
   :message (.getMessage failure)})

(defn- result->map [result]
  {:successful? (.wasSuccessful result)
   :run-time (.getRunTime result)
   :run     (.getRunCount result)
   :ignored (.getIgnoreCount result)
   :failed  (.getFailureCount result)
   :failures (map failure->map (.getFailures result))})

(defn- build-package-config [^String package]
  (.. (ConfigurationBuilder.)
      (setUrls (ClasspathHelper/forPackage package (into-array ClassLoader [])))
      (setScanners (into-array Scanner [(TypeAnnotationsScanner.)
                                        (MethodAnnotationsScanner.)]))
      (filterInputsBy (.. (FilterBuilder.)
                          (includePackage (into-array String [package]))))))

(defn- find-tests-in-package [package]
  (let [^Configuration config (build-package-config package)
        reflections (Reflections. config)
        test-methods (.getMethodsAnnotatedWith reflections
                                               org.junit.Test)]
    (map (memfn getDeclaringClass) test-methods)))

(defn- find-all-tests [packages]
  (->> packages
       (map str)
       (mapcat find-tests-in-package)
       set))

(defn- run-listener [packages]
  (proxy [RunListener]
      []
    (testRunStarted [description]
      (println "Running jUnit tests for " (str/join ", " packages)))

    (testRunFinished [result]
      (println "\nTest run finished!")
      (when (> (.getFailureCount result) 0)
        (println (result->map result))))

    (testIgnored [description]
      (print "I"))

    (testFailure [failure]
      (print "F"))))

(core/deftask junit
  "Run the jUnit test runner."
  [p packages PACKAGE #{sym} "The set of Java packages to run tests in."]
  (core/with-pre-wrap fileset
    (if (seq packages)
      (let [^JUnitCore core (doto (JUnitCore.)
                              (.addListener (run-listener packages)))]
        (.run core
              (into-array Class
                          (find-all-tests packages))))
      (println "No packages were tested."))
    fileset))

Improve test listener output

Improve test listener output


(ns frontend.analytics.facebook
  (:require [frontend.utils :as utils :include-macros true]
            [goog.net.jsloader]))

(defn track-conversion []
  (.push js/window._fbq #js ["track" "6017231164176" {:value "0.01" :currency "USD"}]))

(defn track-signup []
  (if (aget js/window "_fbq")
    (track-conversion)
    (-> (goog.net.jsloader.load "//connect.facebook.net/en_US/fbds.js")
        (.addCallback track-conversion)))

remove unnecessary whitespace

remove unnecessary whitespace