;; Copyright (c) 2014-2016 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2014-2016 Alejandro Gómez <alejandro@dialelo.com>
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(ns cats.monad.exception
  "The Exception monad.

  Also known as Try monad, popularized by Scala.

  It represents a computation that may either result
  in an exception or return a successfully computed
  value. Is very similar to Either monad, but is
  semantically different.

  It consists in two types: Success and Failure. The
  Success type is a simple wrapper like Right of Either
  monad. But the Failure type is slightly different
  from Left, because it is forced to wrap an instance
  of Throwable (or Error in cljs).

  The most common use case of this monad is for wrap
  third party libraries that uses standard Exception
  based error handling. In normal circumstances you
  should use Either instead.

  The types defined for Exception monad (Success and
  Failure) also implementes the clojure IDeref interface
  which facilitates libraries developing using monadic
  composition without forcing a user of that library
  to use or understand monads.

  That is because when you will dereference the
  failure instance, it will reraise the containing
  exception."

  (:require [cats.protocols :as p]
            [cats.util :as util]
            #?(:clj [cats.context :as ctx]
               :cljs [cats.context :as ctx :include-macros true]))
  #?(:cljs
     (:require-macros [cats.monad.exception :refer (try-on)])))

;; --- Helpers

(defn throw-exception
  [^String message]
  (throw (#?(:clj IllegalArgumentException.
             :cljs js/Error.)
            message)))

(defn throwable?
  "Return true if `v` is an instance of
  the Throwable or js/Error type."
  [e]
  (instance? #?(:clj Throwable :cljs js/Error) e))

;; --- Types and implementations.

(declare context)

(defrecord Success [success]
  p/Contextual
  (-get-context [_] context)

  p/Extract
  (-extract [_] success)

  p/Printable
  (-repr [_]
    (str "#<Success " (pr-str success) ">"))

  #?@(:cljs [cljs.core/IDeref
             (-deref [_] success)]
      :clj  [clojure.lang.IDeref
             (deref [_] success)]))

(defrecord Failure [failure]
  p/Contextual
  (-get-context [_] context)

  p/Extract
  (-extract [_] failure)

  p/Printable
  (-repr [_]
    (str "#<Failure " (pr-str failure) ">"))

  #?@(:cljs [cljs.core/IDeref
             (-deref [_] (throw failure))]
      :clj  [clojure.lang.IDeref
             (deref [_] (throw failure))]))

(alter-meta! #'->Success assoc :private true)
(alter-meta! #'->Failure assoc :private true)

(util/make-printable Success)
(util/make-printable Failure)

(defn success
  "A Success type constructor.

  It wraps any arbitrary value into
  success type."
  [v]
  (Success. v))

(defn failure
  "A failure type constructor.

  If a provided parameter is an exception, it wraps
  it in a `Failure` instance and return it. But if
  a provided parameter is arbitrary data, it tries
  create an exception from it using clojure `ex-info`
  function.

  Take care that `ex-info` function in clojurescript
  differs a little bit from clojure."
  ([e] (failure e ""))
  ([e message]
   (if (throwable? e)
     (Failure. e)
     (Failure. (ex-info message e)))))

(defn success?
  "Return true if `v` is an instance of
  the Success type."
  [v]
  (instance? Success v))

(defn failure?
  "Return true if `v` is an instance of
  the Failure type."
  [v]
  (instance? Failure v))

(defn exception?
  "Return true in case of `v` is instance
  of Exception monad."
  [v]
  (cond
    (or (instance? Failure v)
        (instance? Success v))
    true

    (satisfies? p/Contextual v)
    (identical? (p/-get-context v) context)

    :else false))

(defn extract
  "Return inner value from exception monad.

  This is a specialized version of `cats.core/extract`
  for Exception monad types that allows set up
  the default value.

  If a provided `mv` is an instance of Failure type
  it will re raise the inner exception. If you need
  extract value without raising it, use `cats.core/extract`
  function for it."
  ([mv]
   {:pre [(exception? mv)]}
   (if (success? mv)
     (p/-extract mv)
     (throw (p/-extract mv))))
  ([mv default]
   {:pre [(exception? mv)]}
   (if (success? mv)
     (p/-extract mv)
     default)))

(defn ^{:no-doc true}
  exec-try-on
  [func]
  (try
    (let [result (func)]
      (cond
        (throwable? result) (failure result)
        (exception? result) result
        :else (success result)))
    (catch #?(:clj Exception
              :cljs js/Error) e (failure e))))

(defn ^{:no-doc true}
  exec-try-or-else
  [func defaultvalue]
  (let [result (exec-try-on func)]
    (if (failure? result)
      (success defaultvalue)
      result)))

(defn ^{:no-doc true}
  exec-try-or-recover
  [func recoverfn]
  (let [result (exec-try-on func)]
    (ctx/with-context context
      (if (failure? result)
        (recoverfn (.-failure ^Failure result))
        result))))

#?(:clj
   (defmacro try-on
    "Wraps a computation and return success of failure."
    [expr]
    `(let [func# (fn [] ~expr)]
       (exec-try-on func#))))

#?(:clj
   (defmacro try-or-else
     [expr defaultvalue]
     `(let [func# (fn [] ~expr)]
        (exec-try-or-else func# ~defaultvalue))))

#?(:clj
   (defmacro try-or-recover
     [expr func]
     `(let [func# (fn [] ~expr)]
        (exec-try-or-recover func# ~func))))

(defn wrap
  "Wrap a function in a try monad.

  Is a high order function that accept a function
  as parameter and returns an other that returns
  success or failure depending of result of the
  first function."
  [func]
  (let [metadata (meta func)]
    (-> (fn [& args] (try-on (apply func args)))
        (with-meta metadata))))

;; --- Monad definition

(def ^{:no-doc true}
  context
  (reify
    p/Context
    p/Functor
    (-fmap [_ f s]
      (if (success? s)
        (try-on (f (p/-extract s)))
        s))

    p/Applicative
    (-pure [_ v]
      (success v))

    (-fapply [m af av]
      (if (success? af)
        (p/-fmap m (p/-extract af) av)
        af))

    p/Monad
    (-mreturn [_ v]
      (success v))

    (-mbind [_ s f]
      (assert (exception? s) (str "Context mismatch: " (p/-repr s)
                                  " is not allowed to use with exception context."))

      (if (success? s)
        (f (p/-extract s))
        s))

    p/Printable
    (-repr [_]
      "#<Exception>")))

(util/make-printable (type context))

;; Copyright (c) 2014-2016 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2014-2016 Alejandro Gómez <alejandro@dialelo.com>
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(ns cats.monad.exception
  "The Exception monad.

  Also known as Try monad, popularized by Scala.

  It represents a computation that may either result
  in an exception or return a successfully computed
  value. Is very similar to Either monad, but is
  semantically different.

  It consists in two types: Success and Failure. The
  Success type is a simple wrapper like Right of Either
  monad. But the Failure type is slightly different
  from Left, because it is forced to wrap an instance
  of Throwable (or Error in cljs).

  The most common use case of this monad is for wrap
  third party libraries that uses standard Exception
  based error handling. In normal circumstances you
  should use Either instead.

  The types defined for Exception monad (Success and
  Failure) also implementes the clojure IDeref interface
  which facilitates libraries developing using monadic
  composition without forcing a user of that library
  to use or understand monads.

  That is because when you will dereference the
  failure instance, it will reraise the containing
  exception."

  (:require [cats.protocols :as p]
            [cats.util :as util]
            #?(:clj [cats.context :as ctx]
               :cljs [cats.context :as ctx :include-macros true]))
  #?(:cljs
     (:require-macros [cats.monad.exception :refer (try-on)])))

;; --- Helpers

(defn throw-exception
  [^String message]
  (throw (#?(:clj IllegalArgumentException.
             :cljs js/Error.)
            message)))

(defn throwable?
  "Return true if `v` is an instance of
  the Throwable or js/Error type."
  [e]
  (instance? #?(:clj Throwable :cljs js/Error) e))

;; --- Types and implementations.

(declare context)

(defrecord Success [success]
  p/Contextual
  (-get-context [_] context)

  p/Extract
  (-extract [_] success)

  p/Printable
  (-repr [_]
    (str "#<Success " (pr-str success) ">"))

  #?@(:cljs [cljs.core/IDeref
             (-deref [_] success)]
      :clj  [clojure.lang.IDeref
             (deref [_] success)]))

(defrecord Failure [failure]
  p/Contextual
  (-get-context [_] context)

  p/Extract
  (-extract [_] failure)

  p/Printable
  (-repr [_]
    (str "#<Failure " (pr-str failure) ">"))

  #?@(:cljs [cljs.core/IDeref
             (-deref [_] (throw failure))]
      :clj  [clojure.lang.IDeref
             (deref [_] (throw failure))]))

(alter-meta! #'->Success assoc :private true)
(alter-meta! #'->Failure assoc :private true)

(util/make-printable Success)
(util/make-printable Failure)

(defn success
  "A Success type constructor.

  It wraps any arbitrary value into
  success type."
  [v]
  (Success. v))

(defn failure
  "A failure type constructor.

  If a provided parameter is an exception, it wraps
  it in a `Failure` instance and return it. But if
  a provided parameter is arbitrary data, it tries
  create an exception from it using clojure `ex-info`
  function.

  Take care that `ex-info` function in clojurescript
  differs a little bit from clojure."
  ([e] (failure e ""))
  ([e message]
   (if (throwable? e)
     (Failure. e)
     (Failure. (ex-info message e)))))

(defn success?
  "Return true if `v` is an instance of
  the Success type."
  [v]
  (instance? Success v))

(defn failure?
  "Return true if `v` is an instance of
  the Failure type."
  [v]
  (instance? Failure v))

(defn exception?
  "Return true in case of `v` is instance
  of Exception monad."
  [v]
  (cond
    (or (instance? Failure v)
        (instance? Success v))
    true

    (satisfies? p/Contextual v)
    (identical? (p/-get-context v) context)

    :else false))

(defn extract
  "Return inner value from exception monad.

  This is a specialized version of `cats.core/extract`
  for Exception monad types that allows set up
  the default value.

  If a provided `mv` is an instance of Failure type
  it will re raise the inner exception. If you need
  extract value without raising it, use `cats.core/extract`
  function for it."
  ([mv]
   {:pre [(exception? mv)]}
   (if (success? mv)
     (p/-extract mv)
     (throw (p/-extract mv))))
  ([mv default]
   {:pre [(exception? mv)]}
   (if (success? mv)
     (p/-extract mv)
     default)))

(defn ^{:no-doc true}
  exec-try-on
  [func]
  (try
    (let [result (func)]
      (cond
        (throwable? result) (failure result)
        (exception? result) result
        :else (success result)))
    (catch #?(:clj Throwable
              :cljs js/Error) e (failure e))))

(defn ^{:no-doc true}
  exec-try-or-else
  [func defaultvalue]
  (let [result (exec-try-on func)]
    (if (failure? result)
      (success defaultvalue)
      result)))

(defn ^{:no-doc true}
  exec-try-or-recover
  [func recoverfn]
  (let [result (exec-try-on func)]
    (ctx/with-context context
      (if (failure? result)
        (recoverfn (.-failure ^Failure result))
        result))))

#?(:clj
   (defmacro try-on
    "Wraps a computation and return success of failure."
    [expr]
    `(let [func# (fn [] ~expr)]
       (exec-try-on func#))))

#?(:clj
   (defmacro try-or-else
     [expr defaultvalue]
     `(let [func# (fn [] ~expr)]
        (exec-try-or-else func# ~defaultvalue))))

#?(:clj
   (defmacro try-or-recover
     [expr func]
     `(let [func# (fn [] ~expr)]
        (exec-try-or-recover func# ~func))))

(defn wrap
  "Wrap a function in a try monad.

  Is a high order function that accept a function
  as parameter and returns an other that returns
  success or failure depending of result of the
  first function."
  [func]
  (let [metadata (meta func)]
    (-> (fn [& args] (try-on (apply func args)))
        (with-meta metadata))))

;; --- Monad definition

(def ^{:no-doc true}
  context
  (reify
    p/Context
    p/Functor
    (-fmap [_ f s]
      (if (success? s)
        (try-on (f (p/-extract s)))
        s))

    p/Applicative
    (-pure [_ v]
      (success v))

    (-fapply [m af av]
      (if (success? af)
        (p/-fmap m (p/-extract af) av)
        af))

    p/Monad
    (-mreturn [_ v]
      (success v))

    (-mbind [_ s f]
      (assert (exception? s) (str "Context mismatch: " (p/-repr s)
                                  " is not allowed to use with exception context."))

      (if (success? s)
        (f (p/-extract s))
        s))

    p/Printable
    (-repr [_]
      "#<Exception>")))

(util/make-printable (type context))

add missing change on catch

add missing change on catch


(ns clojurewerkz.statistiker.scaling-test
  (:require [clojurewerkz.statistiker.scaling :refer :all]
            [clojure.test :refer :all]))

(deftest rescale-test
  (is (= [0.0 0.25 0.5 0.75 1.0] (rescale [2 4 6 8 10])))
  (is (= [0.0 0.25 0.5 0.75 1.0] (rescale [-4 -2 0 2 4]))))

(deftest rescale-range-test
  (is (= [-0.5 -0.25 0.0 0.25 0.5] (rescale-range [-4 -2 0 2 4] -0.5 0.5)))
  (is (= [-4.0 -2.0 0.0 2.0 4.0] (rescale-range [-4 -2 0 2 4] -4 4))))

(deftest standartise-test
  (is (= [(/ -25 (Math/sqrt 1250))
          (/ 25  (Math/sqrt 1250))]
         (standartise [50 100]))))

(deftest l1-normalize-test
  (is (= (map double [(/ 2 10)
                     (/ 2 10)
                     (/ 6 10)])
         (l1-normalize [2 2 6]))))

(deftest l2-normalize-test
  (is (= [(double (/ 10 (Math/sqrt 125)))
          (double (/ 5 (Math/sqrt 125)))]
         (l2-normalize [10 5]))))

(deftest scale-feature-test
  (is (= [{:a 0.0 :b 1}
          {:a 0.25 :b 2}
          {:a 0.5 :b 4}
          {:a 0.75 :b 4}
          {:a 1.0  :b 5}]
         (scale-feature [{:a 2 :b 1}
                         {:a 4 :b 2}
                         {:a 6 :b 4}
                         {:a 8 :b 4}
                         {:a 10  :b 5}]
                        :a
                        make-rescale-fn
                        ))))

(ns clojurewerkz.statistiker.scaling-test
  (:require [clojurewerkz.statistiker.scaling :refer :all]
            [clojure.test :refer :all]))

(deftest rescale-test
  (is (= [0.0 0.25 0.5 0.75 1.0] (rescale [2 4 6 8 10])))
  (is (= [0.0 0.25 0.5 0.75 1.0] (rescale [-4 -2 0 2 4]))))

(deftest rescale-range-test
  (is (= [-0.5 -0.25 0.0 0.25 0.5] (rescale-range [-4 -2 0 2 4] -0.5 0.5)))
  (is (= [-4.0 -2.0 0.0 2.0 4.0] (rescale-range [-4 -2 0 2 4] -4 4))))

(deftest standartise-test
  (is (= [(/ -25 (Math/sqrt 1250))
          (/ 25  (Math/sqrt 1250))]
         (standartise [50 100]))))

(deftest l1-normalize-test
  (is (= (map double [(/ 2 10)
                      (/ 2 10)
                      (/ 6 10)])
         (l1-normalize [2 2 6]))))

(deftest l2-normalize-test
  (is (= (map double [(/ 10 (Math/sqrt 125))
                      (/ 5 (Math/sqrt 125))])
         (l2-normalize [10 5]))))

(deftest scale-feature-test
  (is (= [{:a 0.0 :b 1}
          {:a 0.25 :b 2}
          {:a 0.5 :b 4}
          {:a 0.75 :b 4}
          {:a 1.0  :b 5}]
         (scale-feature [{:a 2 :b 1}
                         {:a 4 :b 2}
                         {:a 6 :b 4}
                         {:a 8 :b 4}
                         {:a 10  :b 5}]
                        :a
                        make-rescale-fn
                        ))))

Use of map instead of parsing to double feature by feature


(ns onyx.windowing.basic-windowing-crash-test
  (:require [clojure.core.async :refer [chan >!! <!! close! sliding-buffer]]
            [clojure.test :refer [deftest is]]
            [taoensso.timbre :refer [info error warn trace fatal] :as timbre]
            [onyx.plugin.core-async :refer [take-segments!]]
            [onyx.state.state-extensions :as state-extensions]
            [onyx.test-helper :refer [load-config with-test-env add-test-env-peers!]]
            [onyx.api]))

;;; IMPORTANT - since this crashed before task, it'll never play a message twice
;;; Therefore this is not a good test of message deduping
;;; It also only tests crashes at certain points of the process.
;;; For example, in this test, messages are likely already acked since the crash
;;; delay is rather long

(def input
  ;; ensure some duplicates are around and interdispersed
  [{:id 1  :age 21 :event-time #inst "2015-09-13T03:00:00.829-00:00"}
   {:id 2  :age 12 :event-time #inst "2015-09-13T03:04:00.829-00:00"}
   ; Exact dupe
   {:id 2  :age 12 :event-time #inst "2015-09-13T03:04:00.829-00:00"}
   ; Exact dupe
   {:id 2  :age 12 :event-time #inst "2015-09-13T03:04:00.829-00:00"}
   ; Exact dupe
   {:id 2  :age 12 :event-time #inst "2015-09-13T03:04:00.829-00:00"}
   {:id 3  :age 3  :event-time #inst "2015-09-13T03:05:00.829-00:00"}
   {:id 4  :age 64 :event-time #inst "2015-09-13T03:06:00.829-00:00"}
   {:id 5  :age 53 :event-time #inst "2015-09-13T03:07:00.829-00:00"}
   {:id 4  :age 64 :event-time #inst "2015-09-13T03:06:00.829-00:00"}
   {:id 6  :age 52 :event-time #inst "2015-09-13T03:08:00.829-00:00"}
   {:id 7  :age 24 :event-time #inst "2015-09-13T03:09:00.829-00:00"}
   {:id 8  :age 35 :event-time #inst "2015-09-13T03:15:00.829-00:00"}
   {:id 9  :age 49 :event-time #inst "2015-09-13T03:25:00.829-00:00"}
   {:id 10 :age 37 :event-time #inst "2015-09-13T03:45:00.829-00:00"}
   {:id 11 :age 15 :event-time #inst "2015-09-13T03:03:00.829-00:00"}
   ; Exact dupe
   {:id 10 :age 37 :event-time #inst "2015-09-13T03:45:00.829-00:00"}
   {:id 12 :age 22 :event-time #inst "2015-09-13T03:56:00.829-00:00"}
   ; Exact dupe
   {:id 12 :age 22 :event-time #inst "2015-09-13T03:56:00.829-00:00"}
   {:id 13 :age 83 :event-time #inst "2015-09-13T03:59:00.829-00:00"}
   {:id 14 :age 60 :event-time #inst "2015-09-13T03:32:00.829-00:00"}
   {:id 15 :age 35 :event-time #inst "2015-09-13T03:16:00.829-00:00"}
   ;; Ensure some duplicate ages are counted, with different ids
   {:id 16  :age 12 :event-time #inst "2015-09-13T03:04:00.829-00:00"}
   {:id 17  :age 52 :event-time #inst "2015-09-13T03:08:00.829-00:00"}
   {:id 18  :age 53 :event-time #inst "2015-09-13T03:07:00.829-00:00"}
   {:id 19  :age 3 :event-time #inst "2015-09-13T03:05:00.829-00:00"}])

(defn output->final-counts [window-counts]
  (let [grouped (group-by (juxt first second) window-counts)]
    (set (map (fn get-latest [[k v]]
                (last (sort-by #(apply + (vals (nth % 2))) v)))
              grouped))))

(def expected-windows
  #{[1442114700000 1442114999999 {49 1}]
    [1442113500000 1442113799999 {3 2, 64 1, 53 2, 52 2, 24 1}]
    [1442114100000 1442114399999 {35 2}]
    [1442116500000 1442116799999 {22 1, 83 1}]
    [1442113200000 1442113499999 {21 1, 12 2, 15 1}]
    [1442115900000 1442116199999 {37 1}]
    [1442115000000 1442115299999 {60 1}]})

(defn restartable? [e]
  true)

(defrecord MonitoringStats
  [zookeeper-write-log-entry
   zookeeper-read-log-entry
   zookeeper-write-catalog
   zookeeper-write-workflow
   zookeeper-write-flow-conditions
   zookeeper-write-lifecycles
   zookeeper-write-task
   zookeeper-write-chunk
   zookeeper-write-job-scheduler
   zookeeper-write-messaging
   zookeeper-force-write-chunk
   zookeeper-write-origin
   zookeeper-read-catalog
   zookeeper-read-workflow
   zookeeper-read-flow-conditions
   zookeeper-read-lifecycles
   zookeeper-read-task
   zookeeper-read-chunk
   zookeeper-read-origin
   zookeeper-read-job-scheduler
   zookeeper-read-messaging
   zookeeper-gc-log-entry
   window-log-write-entry
   window-log-playback
   window-log-compaction
   peer-ack-segments
   peer-retry-segment
   peer-try-complete-job
   peer-strip-sentinel
   peer-complete-message
   peer-gc-peer-link
   peer-backpressure-on
   peer-backpressure-off
   peer-prepare-join
   peer-notify-join
   peer-accept-join])

(deftest fault-tolerance-fixed-windows-segment-trigger

  (def test-state (atom []))

  (defn update-atom! [event window trigger {:keys [window-id upper-bound lower-bound]} state]
    (swap! test-state conj [lower-bound upper-bound state]))

  (def batch-num (atom 0))

  (def identity-crash
    {:lifecycle/before-batch
     (fn [event lifecycle]
       (case (swap! batch-num inc)
         2
         (do (state-extensions/compact-log (:onyx.core/state-log event) event @(:onyx.core/window-state event))
             (Thread/sleep 7000))
         ;; compactions happen at a check in between log entries writing, so we need to wait for two cycles
         ;; before crashing
         4
         (do
           ; give the peer a bit of time to write the chunks out and ack the batches,
           ; since we want to ensure that the batches aren't re-read on restart
           (Thread/sleep 7000)
           (throw (ex-info "Restartable" {:restartable? true})))
         {}))})

  (def compaction-finished? (atom false))
  (def playback-occurred? (atom false))

  (def in-chan (chan (inc (count input))))

  (def out-chan (chan (sliding-buffer (inc (count input)))))

  (defn inject-in-ch [event lifecycle]
    {:core.async/chan in-chan})

  (defn inject-out-ch [event lifecycle]
    {:core.async/chan out-chan})

  (def in-calls
    {:lifecycle/before-task-start inject-in-ch})

  (def out-calls
    {:lifecycle/before-task-start inject-out-ch})

  (let [id (java.util.UUID/randomUUID)
        config (load-config)
        env-config (assoc (:env-config config) :onyx/id id)
        peer-config (assoc (:peer-config config)
                           :onyx/id id
                           ;; Write for every batch to ensure compaction occurs
                           :onyx.bookkeeper/write-batch-size 1)
        batch-size 5
        workflow
        [[:in :identity] [:identity :out]]

        catalog
        [{:onyx/name :in
          :onyx/plugin :onyx.plugin.core-async/input
          :onyx/type :input
          :onyx/medium :core.async
          :onyx/pending-timeout 30000
          ;; make the time between batches very long
          ;; because we don't want too many empty batches
          ;; between which we'll get crashes
          :onyx/batch-timeout 20000
          :onyx/batch-size batch-size
          :onyx/max-peers 1
          :onyx/doc "Reads segments from a core.async channel"}

         {:onyx/name :identity
          :onyx/fn :clojure.core/identity
          :onyx/group-by-key :age ;; irrelevant because only one peer
          :onyx/restart-pred-fn ::restartable?
          :onyx/uniqueness-key :id
          :onyx/min-peers 1
          :onyx/max-peers 1
          :onyx/flux-policy :recover ;; should only recover if possible?
          :onyx/type :function
          :onyx/batch-size batch-size}

         {:onyx/name :out
          :onyx/plugin :onyx.plugin.core-async/output
          :onyx/type :output
          :onyx/medium :core.async
          :onyx/max-peers 1
          :onyx/batch-size batch-size
          :onyx/doc "Writes segments to a core.async channel"}]

        windows
        [{:window/id :collect-segments
          :window/task :identity
          :window/type :fixed
          :window/aggregation :onyx.windowing.aggregation/count
          :window/window-key :event-time
          :window/range [5 :minutes]}]

        triggers
        [{:trigger/window-id :collect-segments
          :trigger/refinement :accumulating
          :trigger/on :segment
          :trigger/fire-all-extents? true
          ;; Align threshhold with batch-size since we'll be restarting
          :trigger/threshold [1 :elements]
          :trigger/sync ::update-atom!}]

        lifecycles
        [{:lifecycle/task :in
          :lifecycle/calls ::in-calls}
         {:lifecycle/task :in
          :lifecycle/calls :onyx.plugin.core-async/reader-calls}
         {:lifecycle/task :out
          :lifecycle/calls ::out-calls}
         {:lifecycle/task :identity
          :lifecycle/calls ::identity-crash}
         {:lifecycle/task :out
          :lifecycle/calls :onyx.plugin.core-async/writer-calls}]

        stats-holder (let [stats (map->MonitoringStats {})]
                       (reduce (fn [st k] (assoc st k (atom [])))
                               stats
                               (keys stats)))

        event-fn (fn print-monitoring-event [_ event]
                   (let [stats-value (swap! (get stats-holder (:event event)) conj event)]
                     (case (:event event)
                       :window-log-compaction (reset! compaction-finished? true)
                       :window-log-playback (reset! playback-occurred? true)
                       nil)))

        monitoring-config {:monitoring :custom
                           :zookeeper-read-catalog event-fn
                           :window-log-compaction event-fn
                           :window-log-playback event-fn
                           :window-log-write-entry event-fn}]
    (with-test-env [test-env [6 env-config peer-config monitoring-config]]
      (onyx.api/submit-job peer-config
                           {:catalog catalog
                            :workflow workflow
                            :lifecycles lifecycles
                            :windows windows
                            :triggers triggers
                            :task-scheduler :onyx.task-scheduler/balanced})
      (doseq [i input]
        (>!! in-chan i))
      (>!! in-chan :done)

      (close! in-chan)

      (let [results (take-segments! out-chan)]
        (is (= :done (last results)))
        ;; FIXME: Re-enable this test.
        #_(is (true? @compaction-finished?))
        (is (true? @playback-occurred?))
        (is (= expected-windows (output->final-counts @test-state)))))))

(ns onyx.windowing.basic-windowing-crash-test
  (:require [clojure.core.async :refer [chan >!! <!! close! sliding-buffer]]
            [clojure.test :refer [deftest is]]
            [taoensso.timbre :refer [info error warn trace fatal] :as timbre]
            [onyx.plugin.core-async :refer [take-segments!]]
            [onyx.state.state-extensions :as state-extensions]
            [onyx.test-helper :refer [load-config with-test-env add-test-env-peers!]]
            [onyx.api]))

;;; IMPORTANT - since this crashed before task, it'll never play a message twice
;;; Therefore this is not a good test of message deduping
;;; It also only tests crashes at certain points of the process.
;;; For example, in this test, messages are likely already acked since the crash
;;; delay is rather long

(def input
  ;; ensure some duplicates are around and interdispersed
  [{:id 1  :age 21 :event-time #inst "2015-09-13T03:00:00.829-00:00"}
   {:id 2  :age 12 :event-time #inst "2015-09-13T03:04:00.829-00:00"}
   ; Exact dupe
   {:id 2  :age 12 :event-time #inst "2015-09-13T03:04:00.829-00:00"}
   ; Exact dupe
   {:id 2  :age 12 :event-time #inst "2015-09-13T03:04:00.829-00:00"}
   ; Exact dupe
   {:id 2  :age 12 :event-time #inst "2015-09-13T03:04:00.829-00:00"}
   {:id 3  :age 3  :event-time #inst "2015-09-13T03:05:00.829-00:00"}
   {:id 4  :age 64 :event-time #inst "2015-09-13T03:06:00.829-00:00"}
   {:id 5  :age 53 :event-time #inst "2015-09-13T03:07:00.829-00:00"}
   {:id 4  :age 64 :event-time #inst "2015-09-13T03:06:00.829-00:00"}
   {:id 6  :age 52 :event-time #inst "2015-09-13T03:08:00.829-00:00"}
   {:id 7  :age 24 :event-time #inst "2015-09-13T03:09:00.829-00:00"}
   {:id 8  :age 35 :event-time #inst "2015-09-13T03:15:00.829-00:00"}
   {:id 9  :age 49 :event-time #inst "2015-09-13T03:25:00.829-00:00"}
   {:id 10 :age 37 :event-time #inst "2015-09-13T03:45:00.829-00:00"}
   {:id 11 :age 15 :event-time #inst "2015-09-13T03:03:00.829-00:00"}
   ; Exact dupe
   {:id 10 :age 37 :event-time #inst "2015-09-13T03:45:00.829-00:00"}
   {:id 12 :age 22 :event-time #inst "2015-09-13T03:56:00.829-00:00"}
   ; Exact dupe
   {:id 12 :age 22 :event-time #inst "2015-09-13T03:56:00.829-00:00"}
   {:id 13 :age 83 :event-time #inst "2015-09-13T03:59:00.829-00:00"}
   {:id 14 :age 60 :event-time #inst "2015-09-13T03:32:00.829-00:00"}
   {:id 15 :age 35 :event-time #inst "2015-09-13T03:16:00.829-00:00"}
   ;; Ensure some duplicate ages are counted, with different ids
   {:id 16  :age 12 :event-time #inst "2015-09-13T03:04:00.829-00:00"}
   {:id 17  :age 52 :event-time #inst "2015-09-13T03:08:00.829-00:00"}
   {:id 18  :age 53 :event-time #inst "2015-09-13T03:07:00.829-00:00"}
   {:id 19  :age 3 :event-time #inst "2015-09-13T03:05:00.829-00:00"}])

(defn output->final-counts [window-counts]
  (let [grouped (group-by (juxt first second) window-counts)]
    (set (map (fn get-latest [[k v]]
                (last (sort-by #(apply + (vals (nth % 2))) v)))
              grouped))))

(def expected-windows
  #{[1442114700000 1442114999999 {49 1}]
    [1442113500000 1442113799999 {3 2, 64 1, 53 2, 52 2, 24 1}]
    [1442114100000 1442114399999 {35 2}]
    [1442116500000 1442116799999 {22 1, 83 1}]
    [1442113200000 1442113499999 {21 1, 12 2, 15 1}]
    [1442115900000 1442116199999 {37 1}]
    [1442115000000 1442115299999 {60 1}]})

(defn restartable? [event lifecycle lifecycle-name e]
  :restart)

(defrecord MonitoringStats
  [zookeeper-write-log-entry
   zookeeper-read-log-entry
   zookeeper-write-catalog
   zookeeper-write-workflow
   zookeeper-write-flow-conditions
   zookeeper-write-lifecycles
   zookeeper-write-task
   zookeeper-write-chunk
   zookeeper-write-job-scheduler
   zookeeper-write-messaging
   zookeeper-force-write-chunk
   zookeeper-write-origin
   zookeeper-read-catalog
   zookeeper-read-workflow
   zookeeper-read-flow-conditions
   zookeeper-read-lifecycles
   zookeeper-read-task
   zookeeper-read-chunk
   zookeeper-read-origin
   zookeeper-read-job-scheduler
   zookeeper-read-messaging
   zookeeper-gc-log-entry
   window-log-write-entry
   window-log-playback
   window-log-compaction
   peer-ack-segments
   peer-retry-segment
   peer-try-complete-job
   peer-strip-sentinel
   peer-complete-message
   peer-gc-peer-link
   peer-backpressure-on
   peer-backpressure-off
   peer-prepare-join
   peer-notify-join
   peer-accept-join])

(deftest fault-tolerance-fixed-windows-segment-trigger

  (def test-state (atom []))

  (defn update-atom! [event window trigger {:keys [window-id upper-bound lower-bound]} state]
    (swap! test-state conj [lower-bound upper-bound state]))

  (def batch-num (atom 0))

  (def identity-crash
    {:lifecycle/before-batch
     (fn [event lifecycle]
       (case (swap! batch-num inc)
         2
         (do (state-extensions/compact-log (:onyx.core/state-log event) event @(:onyx.core/window-state event))
             (Thread/sleep 7000))
         ;; compactions happen at a check in between log entries writing, so we need to wait for two cycles
         ;; before crashing
         4
         (do
           ; give the peer a bit of time to write the chunks out and ack the batches,
           ; since we want to ensure that the batches aren't re-read on restart
           (Thread/sleep 7000)
           (throw (ex-info "Restart me!" {})))
         {}))})

  (def compaction-finished? (atom false))
  (def playback-occurred? (atom false))

  (def in-chan (chan (inc (count input))))

  (def out-chan (chan (sliding-buffer (inc (count input)))))

  (defn inject-in-ch [event lifecycle]
    {:core.async/chan in-chan})

  (defn inject-out-ch [event lifecycle]
    {:core.async/chan out-chan})

  (def in-calls
    {:lifecycle/before-task-start inject-in-ch})

  (def identity-calls
    {:lifecycle/handle-exception restartable?})

  (def out-calls
    {:lifecycle/before-task-start inject-out-ch})

  (let [id (java.util.UUID/randomUUID)
        config (load-config)
        env-config (assoc (:env-config config) :onyx/id id)
        peer-config (assoc (:peer-config config)
                           :onyx/id id
                           ;; Write for every batch to ensure compaction occurs
                           :onyx.bookkeeper/write-batch-size 1)
        batch-size 5
        workflow
        [[:in :identity] [:identity :out]]

        catalog
        [{:onyx/name :in
          :onyx/plugin :onyx.plugin.core-async/input
          :onyx/type :input
          :onyx/medium :core.async
          :onyx/pending-timeout 30000
          ;; make the time between batches very long
          ;; because we don't want too many empty batches
          ;; between which we'll get crashes
          :onyx/batch-timeout 20000
          :onyx/batch-size batch-size
          :onyx/max-peers 1
          :onyx/doc "Reads segments from a core.async channel"}

         {:onyx/name :identity
          :onyx/fn :clojure.core/identity
          :onyx/group-by-key :age ;; irrelevant because only one peer
          :onyx/uniqueness-key :id
          :onyx/min-peers 1
          :onyx/max-peers 1
          :onyx/flux-policy :recover ;; should only recover if possible?
          :onyx/type :function
          :onyx/batch-size batch-size}

         {:onyx/name :out
          :onyx/plugin :onyx.plugin.core-async/output
          :onyx/type :output
          :onyx/medium :core.async
          :onyx/max-peers 1
          :onyx/batch-size batch-size
          :onyx/doc "Writes segments to a core.async channel"}]

        windows
        [{:window/id :collect-segments
          :window/task :identity
          :window/type :fixed
          :window/aggregation :onyx.windowing.aggregation/count
          :window/window-key :event-time
          :window/range [5 :minutes]}]

        triggers
        [{:trigger/window-id :collect-segments
          :trigger/refinement :accumulating
          :trigger/on :segment
          :trigger/fire-all-extents? true
          ;; Align threshhold with batch-size since we'll be restarting
          :trigger/threshold [1 :elements]
          :trigger/sync ::update-atom!}]

        lifecycles
        [{:lifecycle/task :in
          :lifecycle/calls ::in-calls}
         {:lifecycle/task :in
          :lifecycle/calls :onyx.plugin.core-async/reader-calls}
         {:lifecycle/task :identity
          :lifecycle/calls ::identity-calls}
         {:lifecycle/task :out
          :lifecycle/calls ::out-calls}
         {:lifecycle/task :identity
          :lifecycle/calls ::identity-crash}
         {:lifecycle/task :out
          :lifecycle/calls :onyx.plugin.core-async/writer-calls}]

        stats-holder (let [stats (map->MonitoringStats {})]
                       (reduce (fn [st k] (assoc st k (atom [])))
                               stats
                               (keys stats)))

        event-fn (fn print-monitoring-event [_ event]
                   (let [stats-value (swap! (get stats-holder (:event event)) conj event)]
                     (case (:event event)
                       :window-log-compaction (reset! compaction-finished? true)
                       :window-log-playback (reset! playback-occurred? true)
                       nil)))

        monitoring-config {:monitoring :custom
                           :zookeeper-read-catalog event-fn
                           :window-log-compaction event-fn
                           :window-log-playback event-fn
                           :window-log-write-entry event-fn}]
    (with-test-env [test-env [6 env-config peer-config monitoring-config]]
      (onyx.api/submit-job peer-config
                           {:catalog catalog
                            :workflow workflow
                            :lifecycles lifecycles
                            :windows windows
                            :triggers triggers
                            :task-scheduler :onyx.task-scheduler/balanced})
      (doseq [i input]
        (>!! in-chan i))
      (>!! in-chan :done)

      (close! in-chan)

      (let [results (take-segments! out-chan)]
        (is (= :done (last results)))
        ;; FIXME: Re-enable this test.
        #_(is (true? @compaction-finished?))
        (is (true? @playback-occurred?))
        (is (= expected-windows (output->final-counts @test-state)))))))

Fix test that still used restart pred fn to use new lifecycles.


(ns deepfns.core)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; fmap

(declare deepfmap)

(defn- fseq [f m]
  (map (partial deepfmap f) m))

(defn- fvec [f m]
  (mapv (partial deepfmap f) m))

(defn- flst [f m]
  (into '() (map (partial deepfmap f) m)))

(defn- fset [f m]
  (into #{} (map (partial deepfmap f) m)))

(defn- group-vals [ms k]
  (let [matches (map #(find % k) ms)]
    (when-not (every? nil? matches)
      (vals (remove nil? matches)))))

(defn apply-key [f ms k]
  [k (apply (partial deepfmap f)
       (group-vals ms k))])

(defn- fassc
  ([f m]
   (reduce (fn [acc [k v]]
             (assoc acc k (deepfmap f v)))
     {} m))
  ([f m ms]
   (let [mcoll (cons m ms)]
     (reduce-kv (fn [acc mk mv]
                  ;; find all the matching keys in mcoll
                  (when-let [keys (into #{} (flatten (map keys mcoll)))]
                    (into {}
                      ;; eval the nested maps and bind them to the output
                      (map (partial apply-key f mcoll) keys))))
       m m))))

(defn deepfmap
  "Like fmap but it will recursively evalute all nested collections"
  ([f]
   (fn [m & ms]
     (if ms
       (deepfmap f m ms)
       (deepfmap f m))))
  ([f m]
   (cond
     ;; map deepfmap over all the entries until it thunks out
     (list? m) (flst f m)
     (vector? m) (fvec f m)
     (seq? m) (fseq f m)
     (set? m) (fset f m)
     ;; map deepfmap over all the vals (nested too)
     (associative? m) (fassc f m)
     ;; two base cases here:
     ;; compose fns
     (fn? m) (comp f m)
     :else
     ;; thunk on list atoms like string/keyword/number/etc.
     (f m)))
  ([f m & ms]
   ;; same thing here but we'll mutually walk ms
   (let [mcoll (cons m ms)]
     (cond
       (list? m) (map (partial flst f) mcoll)
       (vector? m) (map (partial fvec f) mcoll)
       (seq? m) (map (partial fseq f) mcoll)
       (set? m) (map (partial fset f) mcoll)
       (associative? m) (fassc f m ms)
       (fn? m) (map #(comp f %) mcoll)
       :else
       (apply f mcoll)))))

(def <-$>
  "An alias for deepfmap"
  deepfmap)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; fapply + pure + filterapply

(declare deepfapply)

(defn- lst-fapply
  ([fs m]
   (apply list
     ;; converts to fs to symbols
     (mapcat #(map (partial deepfapply (eval %)) m) fs)))
  ([fs m ms]
    (apply list
      (mapcat #(apply map (partial deepfapply (eval %)) m ms) fs))))

(defn- seq-fapply
  ([fs m]
   (mapcat #(map (partial deepfapply %) m) fs))
  ([fs m ms]
   (mapcat #(apply map (partial deepfapply %) m ms) fs)))

(defn- set-fapply
  ([fs m]
   (set
     (mapcat #(map (partial deepfapply %) m) fs)))
  ([fs m ms]
   (set
     (mapcat #(apply map (partial deepfapply %) m ms) fs))))

(defn- vec-fapply
  ([fs m]
   (apply vector
     (mapcat #(map (partial deepfapply %) m) fs)))
  ([fs m ms]
   (apply vector
     (mapcat #(apply map (partial deepfapply %) m ms) fs))))

(defn- assc-fapply
  ([fs m]
   (reduce-kv (fn [acc fk f]
                (if-let [[_ mv] (find m fk)]
                  (assoc acc fk (deepfapply f mv))
                  acc))
     m fs))
  ([fs m ms]
   (let [mcoll (cons m ms)]
     (reduce-kv (fn [acc fk f]
                  ;; find all the matching keys in mcoll
                  (when-let [vals (group-vals mcoll fk)]
                    (assoc acc fk
                      ;; eval the nested maps and bind them to the output
                      (apply (partial deepfapply f) vals))))
       m fs))))

(defn deepfapply
  "Similar to fapply but recursively evaluates all the arguments"
  ([f]
   (fn [m & ms]
     (if ms
       (deepfapply f m ms)
       (deepfapply f m))))
  ([fs m]
   (cond
     ;; map the fn for sequential/set types
     (list? fs) (lst-fapply fs m)
     (seq? fs) (seq-fapply fs m)
     (vector? fs) (vec-fapply fs m)
     (set? fs) (set-fapply fs m)
     ;; match keys for maps and if found apply the fn (otherwise
     ;;  just leave it)
     (map? fs) (assc-fapply fs m)
     ;; base cases:
     ;; either use the fn
     (fn? fs) (fs m)
     :else
     ;; or wrap list atoms in a constantly
     ((constantly fs) m)))
  ([fs m & ms]
   (let [mcoll (cons m ms)]
     (cond
       ;; mapcat all the results for sequential/set types
       (list? fs) (lst-fapply fs m ms)
       (seq? fs) (seq-fapply fs m ms)
       (vector? fs) (vec-fapply fs m ms)
       (set? fs) (set-fapply fs m ms)
       ;; match all keys for maps and apply the fn if ther was a match
       (map? fs) (assc-fapply fs m ms)
       ;; apply the fn to the args
       (fn? fs) (apply fs mcoll)
       :else
       ;; list atoms should be constants
       (map (constantly fs) mcoll)))))

(def <-*>
  "An alias for deepfapply"
  deepfapply)

(declare pure)

(defn- coll-pure [t v]
  (into (empty t)
    (if (empty? t)
      (conj t v)
      (for [branch (map identity t)]
        (if  (not (coll? branch))
          v
          (pure branch v))))))

(defn- map-pure [t v]
  (into (empty t)
    (if (empty? t)
      (assoc t nil v)
      (map (fn [[k val :as branch]]
             (if-not (coll? branch)
               (into (empty t) [[k v]])
               (into (empty t) [[k (pure val v)]])))
        t))))

(defn deeppure
  "This is a recursive version of pure. It will replace all values in
   the given type with value. All keys on maps will also be preserved."
  ([m]
   (fn [value]
     (pure m value)))
  ([m value]
   (cond
     (map? m) (map-pure m value)
     (coll? m) (coll-pure m value)
     :else
     value)))

(declare filterapply)

(defn- assc-filterapply
  ([fs m]
   (reduce-kv (fn [acc fk f]
                (if-let [[_ mv] (find m fk)]
                  (assoc acc fk (filterapply f mv))
                  acc))
     ;; start with an empty map to filter vals not in applicative
     {} fs))
  ([fs m ms]
   (let [mcoll (cons m ms)]
     (reduce-kv (fn [acc fk f]
                  ;; find all the matching keys in mcoll
                  (if-let [vals (group-vals mcoll fk)]
                    (assoc acc fk
                      ;; eval the nested maps and bind them to the output
                      (apply (partial filterapply f) vals))
                    acc))
       ;; use the empty map here too
       {} fs))))

(defn filterapply
  "The same as deepfapply but keys not in the applicative will not be
  propagated."
  ([f]
   (fn [m & ms]
     (if ms
       (filterapply f m ms)
       (filterapply f m))))
  ([fs m]
   (cond
     (list? fs) (lst-fapply fs m)
     (seq? fs) (seq-fapply fs m)
     (vector? fs) (vec-fapply fs m)
     (set? fs) (set-fapply fs m)
     (map? fs) (assc-filterapply fs m)
     (fn? fs) (fs m)
     :else
     ((constantly fs) m)))
  ([fs m & ms]
   (let [mcoll (cons m ms)]
     (cond
       (list? fs) (lst-fapply fs m ms)
       (seq? fs) (seq-fapply fs m ms)
       (vector? fs) (vec-fapply fs m ms)
       (set? fs) (set-fapply fs m ms)
       (map? fs) (assc-filterapply fs m ms)
       (fn? fs) (apply fs mcoll)
       :else
       (map (constantly fs) mcoll)))))

(ns deepfns.core)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; fmap

(declare deepfmap)

(defn- fseq [f m]
  (map (partial deepfmap f) m))

(defn- fvec [f m]
  (mapv (partial deepfmap f) m))

(defn- flst [f m]
  (into '() (map (partial deepfmap f) m)))

(defn- fset [f m]
  (into #{} (map (partial deepfmap f) m)))

(defn- group-vals [ms k]
  (let [matches (map #(find % k) ms)]
    (when-not (every? nil? matches)
      (vals (remove nil? matches)))))

(defn apply-key [handler]
  (fn [f ms k]
    [k (apply (partial handler f)
         (group-vals ms k))]))

(defn- fassc
  ([f m]
   (reduce (fn [acc [k v]]
             (assoc acc k (deepfmap f v)))
     {} m))
  ([f m ms]
   (let [mcoll (cons m ms)]
     (reduce-kv (fn [acc mk mv]
                  ;; find all the matching keys in mcoll
                  (when-let [keys (into #{} (flatten (map keys mcoll)))]
                    (let [apply-key (apply-key deepfmap)]
                      (into {}
                        ;; eval the nested maps and bind them to the output
                        (map (partial apply-key f mcoll) keys)))))
       m m))))

(defn deepfmap
  "Like fmap but it will recursively evalute all nested collections"
  ([f]
   (fn [m & ms]
     (if ms
       (deepfmap f m ms)
       (deepfmap f m))))
  ([f m]
   (cond
     ;; map deepfmap over all the entries until it thunks out
     (list? m) (flst f m)
     (vector? m) (fvec f m)
     (seq? m) (fseq f m)
     (set? m) (fset f m)
     ;; map deepfmap over all the vals (nested too)
     (associative? m) (fassc f m)
     ;; two base cases here:
     ;; compose fns
     (fn? m) (comp f m)
     :else
     ;; thunk on list atoms like string/keyword/number/etc.
     (f m)))
  ([f m & ms]
   ;; same thing here but we'll mutually walk ms
   (let [mcoll (cons m ms)]
     (cond
       (list? m) (map (partial flst f) mcoll)
       (vector? m) (map (partial fvec f) mcoll)
       (seq? m) (map (partial fseq f) mcoll)
       (set? m) (map (partial fset f) mcoll)
       (associative? m) (fassc f m ms)
       (fn? m) (map #(comp f %) mcoll)
       :else
       (apply f mcoll)))))

(def <-$>
  "An alias for deepfmap"
  deepfmap)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; fapply + pure + filterapply

(declare deepfapply)

(defn- lst-fapply
  ([fs m]
   (apply list
     ;; converts to fs to symbols
     (mapcat #(map (partial deepfapply (eval %)) m) fs)))
  ([fs m ms]
    (apply list
      (mapcat #(apply map (partial deepfapply (eval %)) m ms) fs))))

(defn- seq-fapply
  ([fs m]
   (mapcat #(map (partial deepfapply %) m) fs))
  ([fs m ms]
   (mapcat #(apply map (partial deepfapply %) m ms) fs)))

(defn- set-fapply
  ([fs m]
   (set
     (mapcat #(map (partial deepfapply %) m) fs)))
  ([fs m ms]
   (set
     (mapcat #(apply map (partial deepfapply %) m ms) fs))))

(defn- vec-fapply
  ([fs m]
   (apply vector
     (mapcat #(map (partial deepfapply %) m) fs)))
  ([fs m ms]
   (apply vector
     (mapcat #(apply map (partial deepfapply %) m ms) fs))))

(defn- assc-fapply
  ([fs m]
   (reduce-kv (fn [acc fk f]
                (if-let [[_ mv] (find m fk)]
                  (assoc acc fk (deepfapply f mv))
                  acc))
     m fs))
  ([fs m ms]
   (let [mcoll (cons m ms)
         seed (apply merge (reverse mcoll))]
     (reduce-kv (fn [acc fk f]
                  ;; find all the matching keys in mcoll
                  (if-let [vals (group-vals mcoll fk)]
                    (assoc acc fk
                      ;; eval the nested maps and bind them to the output
                      (apply (partial deepfapply f) vals))
                    acc))
       seed fs))))

(defn deepfapply
  "Similar to fapply but recursively evaluates all the arguments"
  ([f]
   (fn [m & ms]
     (if ms
       (deepfapply f m ms)
       (deepfapply f m))))
  ([fs m]
   (cond
     ;; map the fn for sequential/set types
     (list? fs) (lst-fapply fs m)
     (seq? fs) (seq-fapply fs m)
     (vector? fs) (vec-fapply fs m)
     (set? fs) (set-fapply fs m)
     ;; match keys for maps and if found apply the fn (otherwise
     ;;  just leave it)
     (map? fs) (assc-fapply fs m)
     ;; base cases:
     ;; either use the fn
     (fn? fs) (fs m)
     :else
     ;; or wrap list atoms in a constantly
     ((constantly fs) m)))
  ([fs m & ms]
   (let [mcoll (cons m ms)]
     (cond
       ;; mapcat all the results for sequential/set types
       (list? fs) (lst-fapply fs m ms)
       (seq? fs) (seq-fapply fs m ms)
       (vector? fs) (vec-fapply fs m ms)
       (set? fs) (set-fapply fs m ms)
       ;; match all keys for maps and apply the fn if ther was a match
       (map? fs) (assc-fapply fs m ms)
       ;; apply the fn to the args
       (fn? fs) (apply fs mcoll)
       :else
       ;; list atoms should be constants
       (map (constantly fs) mcoll)))))

(def <-*>
  "An alias for deepfapply"
  deepfapply)

(declare pure)

(defn- coll-pure [t v]
  (into (empty t)
    (if (empty? t)
      (conj t v)
      (for [branch (map identity t)]
        (if  (not (coll? branch))
          v
          (pure branch v))))))

(defn- map-pure [t v]
  (into (empty t)
    (if (empty? t)
      (assoc t nil v)
      (map (fn [[k val :as branch]]
             (if-not (coll? branch)
               (into (empty t) [[k v]])
               (into (empty t) [[k (pure val v)]])))
        t))))

(defn deeppure
  "This is a recursive version of pure. It will replace all values in
   the given type with value. All keys on maps will also be preserved."
  ([m]
   (fn [value]
     (pure m value)))
  ([m value]
   (cond
     (map? m) (map-pure m value)
     (coll? m) (coll-pure m value)
     :else
     value)))

(declare filterapply)

(defn- assc-filterapply
  ([fs m]
   (reduce-kv (fn [acc fk f]
                (if-let [[_ mv] (find m fk)]
                  (assoc acc fk (filterapply f mv))
                  acc))
     ;; start with an empty map to filter vals not in applicative
     {} fs))
  ([fs m ms]
   (let [mcoll (cons m ms)]
     (reduce-kv (fn [acc fk f]
                  ;; find all the matching keys in mcoll
                  (if-let [vals (group-vals mcoll fk)]
                    (assoc acc fk
                      ;; eval the nested maps and bind them to the output
                      (apply (partial filterapply f) vals))
                    acc))
       ;; use the empty map here too
       {} fs))))

(defn filterapply
  "The same as deepfapply but keys not in the applicative will not be
  propagated."
  ([f]
   (fn [m & ms]
     (if ms
       (filterapply f m ms)
       (filterapply f m))))
  ([fs m]
   (cond
     (list? fs) (lst-fapply fs m)
     (seq? fs) (seq-fapply fs m)
     (vector? fs) (vec-fapply fs m)
     (set? fs) (set-fapply fs m)
     (map? fs) (assc-filterapply fs m)
     (fn? fs) (fs m)
     :else
     ((constantly fs) m)))
  ([fs m & ms]
   (let [mcoll (cons m ms)]
     (cond
       (list? fs) (lst-fapply fs m ms)
       (seq? fs) (seq-fapply fs m ms)
       (vector? fs) (vec-fapply fs m ms)
       (set? fs) (set-fapply fs m ms)
       (map? fs) (assc-filterapply fs m ms)
       (fn? fs) (apply fs mcoll)
       :else
       (map (constantly fs) mcoll)))))

Fix map application for fapply

Fix map application for fapply


(ns ankha.core
  (:refer-clojure :exclude [empty? inspect])
  (:require
   [om.core :as om :include-macros true]
   [om.dom :as dom :include-macros true]
   [clojure.string :as string]
   [cljs.reader :as reader]
   [goog.object :as object]
   [goog.crypt :as crypt]
   goog.crypt.Md5))

(enable-console-print!)

;; ---------------------------------------------------------------------
;; Protocols

(defprotocol IInspect
  (-inspect [this]
    "Return a React or Om compatible representation of this."))

;; ---------------------------------------------------------------------
;; Utilities

(defn- empty?
  "Return true if x is an empty js/Object or empty Clojure collection."
  [x]
  (if (object? x)
    (object/isEmpty x)
    (clojure.core/empty? x)))

(defn- record?
  "Return true if x satisfies IRecord, false otherwise."
  [x]
  (satisfies? IRecord x))

(defn record-name
  "Return the name of a Record type."
  [r]
  (let [s (pr-str r)]
    (subs s 0 (.indexOf s "{"))))

(defn record-opener
  "Return an opener for a Record type."
  [r]
  (str (record-name r) "{"))

(defn hash-key [data]
  (let [d (goog.crypt.Md5.)]
    (.update d (crypt/stringToByteArray (str data)))
    (crypt/byteArrayToHex (.digest d))))

;; ---------------------------------------------------------------------
;; View helpers

(declare collection-view)

(defn literal [class x]
  (dom/span #js {:className class :key x}
    (pr-str x)))

(defn coll-view [data opener closer class]
  (om/build collection-view data
    {:opts {:opener opener :closer closer :class class}}))

(defn inspect [x]
  (cond
    (satisfies? IInspect x)
    (-inspect x)
    (fn? x)
    (literal "function" x)
    :else
    (literal "literal" x)))

(defn associative->dom
  [data {:keys [entry-class key-class val-class]}]
  (into-array
    (for [[k v] data]
      (dom/li #js {:key (hash-key [k v])}
        (dom/div #js {:className (str "entry " entry-class)
                      :style #js {:position "relative"}}
          (dom/span #js {:className (str "key " key-class)
                         :style #js {:display "inline-block"
                                     :verticalAlign "top"}}
            (inspect k))
          (dom/span #js {:style #js {:display "inline-block"
                                     :width "1em"}})
          (dom/span #js {:className (str "val " val-class)
                         :style #js {:display "inline-block"
                                     :verticalAlign "top"}}
            (inspect v)))))))

(defn sequential->dom
  [data owner {:keys [page-item-count] :or {page-item-count 10}}]
  (reify
    om/IInitState
    (init-state [_]
      {:page 1})

    om/IRenderState
    (render-state [_ {:keys [page]}]
      (let [button-style {:display "inline-block"
                          :verticalAlign "top"
                          :border "none"
                          :background "none"
                          :cursor "pointer"
                          :outline "none"
                          :fontWeight "bold"
                          :padding "0 1em"}
            total (count data)
            total-pages (js/Math.ceil (/ total page-item-count))
            first-page? (= page 1)
            last-page? (= page total-pages)]

        (dom/div nil
         (dom/button
          #js {:onClick
               (fn [_]
                 (when-not first-page?
                   (om/update-state! owner :page dec)))
               :style (clj->js
                       (assoc button-style :opacity (if first-page? "0.3" "1.0")))}
          "Prev")

         (dom/span nil (str "Page " page " of " total-pages " (" total " items)"))

         (dom/button
           #js {:onClick
                (fn [_]
                  (when-not last-page?
                    (om/update-state! owner :page inc)))
                :style (clj->js
                        (assoc button-style :opacity (if last-page? "0.3" "1.0")))}
           "Next")

         (let [page-data (->> data
                              (drop (* (dec page) page-item-count))
                              (take page-item-count))]
           (into-array
            (for [[i x :as pair] (map-indexed vector page-data)]
              (dom/li #js {:className "entry"
                           :key (hash-key pair)}
                      (inspect x))))))))))

(defn coll->dom [data]
  (cond
   (map? data)
   (associative->dom data {:entry-class "map-entry"
                           :key-class "map-key"
                           :val-class "map-val"})
   (object? data)
   (let [;; Avoid zipmap to preserve key order.
         ks (object/getKeys data)
         vs (object/getValues data)
         m (map vector ks vs)]
     (associative->dom m {:entry-class "object-entry"
                          :key-class "object-key"
                          :val-class "object-val"}))
   :else
   (om/build sequential->dom data)))

(defn- toggle-button [owner {:keys [disable?]}]
  (dom/button #js {:className "toggle-button"
                   :disabled disable?
                   :onClick
                   (fn [_]
                     (om/update-state! owner :open? not))
                   :style #js {:display "inline-block"
                               :verticalAlign "top"
                               :border "none"
                               :background "none"
                               :cursor "pointer"
                               :outline "none"
                               :fontWeight "bold"
                               :padding "0"
                               :opacity (if disable? "0.5" "1.0")}}
    (if (om/get-state owner :open?) "-" "+")))

(defn- edit-button [owner {:keys [disable? save-editor open-editor]}]
  (dom/button #js {:className "edit-button"
                   :disabled disable?
                   :onClick
                   (fn [_]
                     (if (om/get-state owner :editing?)
                       (save-editor)
                       (open-editor)))
                   :style #js {:display "inline-block"
                               :verticalAlign "top"
                               :border "none"
                               :background "none"
                               :cursor "pointer"
                               :outline "none"
                               :fontWeight "bold"
                               :padding "0"
                               :opacity (if disable? "0.5" "1.0")}}
              (if (om/get-state owner :editing?) "Save" "Edit")))

(defn enter-key? [e]
  (= 13 (.-keyCode e)))

(defn escape-key? [e]
  (= 27 (.-keyCode e)))

(defn- editor [owner {:keys [value save-editor cancel-editor error-message]}]
  (dom/div #js {:style #js {:display "inline"}}
           (dom/textarea #js {:className "editor"
                              :ref "editor"
                              :style #js {:display "inline-block"}
                              :value value
                              :onKeyPress (fn [e]
                                            (when (enter-key? e)
                                              (.preventDefault e)))
                              :onKeyUp (fn [e]
                                         (cond
                                           (enter-key? e) (save-editor)
                                           (escape-key? e) (cancel-editor)))
                              :onChange (fn [e] (om/set-state! owner :edited-data (.. e -target -value)))
                              :onBlur save-editor})
           (when error-message
             (dom/span #js {:className "error" :style #js {:vertical-align "top"}}
                       error-message))))

;; ---------------------------------------------------------------------
;; Main component

(defn collection-view
  [data owner {:keys [class opener closer] :as opts}]
  (reify
    om/IInitState
    (init-state [_]
      {:edited-data (pr-str data)
       :editing? (boolean (:editing? opts))
       :open-editor (fn [] (om/update-state! owner (fn [s] (merge s {:editing-error-message nil :editing? true :edited-data (pr-str @data)}))))
       :save-editor (fn []
                      (try
                        (let [new-data (reader/read-string (om/get-state owner :edited-data))]
                          ;; if the new data is the same as the old just stop editing
                          ;; if not, set data to new data, which will cause this component to re-mount
                          ;; this is a little funky but seems necessary to avoid trying to update an unmounted component
                          (if (= new-data @data)
                            (om/set-state! owner :editing? false)
                            (om/update! data new-data)))
                        (catch js/Error e
                          (om/set-state! owner :editing-error-message (.-message e)))))
       :cancel-editor (fn [] (om/set-state! owner :editing? false))
       :vacant? (empty? data)
       :open? (and (not (false? (:open? opts)))
                   (not (empty? data)))})

    om/IRenderState
    (render-state [_ {:keys [open? vacant? editing? edited-data editing-error-message open-editor save-editor cancel-editor]}]
      (dom/div #js {:className class}
        (toggle-button owner {:disable? vacant?})

        (when open?
         (edit-button owner {:open-editor open-editor :save-editor save-editor}))

        (when (and open? editing?)
          (editor owner {:value edited-data :error-message editing-error-message
                         :save-editor save-editor :cancel-editor cancel-editor}))

        (dom/span #js {:className "opener"
                       :style #js {:display (if (and open? editing?) "none" "inline-block")}}
          opener)

        (dom/ul #js {:className "values"
                     :style #js {:display (if (and open? (not editing?)) "block" "none")
                                 :listStyleType "none"
                                 :margin "0"}}
          (coll->dom data))

        (dom/span #js {:className "ellipsis"
                       :style #js {:display (if (or open? vacant?)
                                              "none"
                                              "inline")}}
          "…")

        (dom/span #js {:className "closer"
                       :style #js {:display (if open?
                                              (if editing?
                                                "none"
                                                "block")
                                              "inline-block")}}
          closer)))

    om/IDidUpdate
    (did-update [this prev-props prev-state]
      (when (om/get-state owner :editing?)
        (.focus (om/get-node owner "editor"))))))

(defn inspector
  ([data owner]
     (inspector data owner {:opts {:class "inspector"}}))
  ([data owner {:keys [class] :or {class "inspector"} :as opts}]
     (reify
       om/IRender
       (render [_]
         (dom/div #js {:className class
                       :style #js {:fontFamily "monospace"
                                   :whiteSpace "pre-wrap"
                                   :width "100%"
                                   :overflowX "scroll"}}
           (inspect data))))))

;; ---------------------------------------------------------------------
;; IInspect Implementation

(extend-protocol IInspect
  Keyword
  (-inspect [this] (literal "keyword" this))

  Symbol
  (-inspect [this] (literal "symbol" this))

  PersistentArrayMap
  (-inspect [this]
    (coll-view this "{" "}" "map persistent-array-map"))

  PersistentHashMap
  (-inspect [this]
    (coll-view this "{" "}" "map persistent-hash-map"))

  PersistentVector
  (-inspect [this] (coll-view this "[" "]" "vector"))

  PersistentHashSet
  (-inspect [this] (coll-view this "#{" "}" "set persistent-hash-set"))

  PersistentTreeSet
  (-inspect [this] (coll-view this "#{" "}" "set persistent-tree-set"))

  List
  (-inspect [this] (coll-view this "(" ")" "list"))

  LazySeq
  (-inspect [this] (coll-view this "(" ")" "seq lazy-seq"))

  KeySeq
  (-inspect [this] (coll-view this "(" ")" "seq key-seq"))

  ValSeq
  (-inspect [this] (coll-view this "(" ")" "seq val-seq"))

  PersistentArrayMapSeq
  (-inspect [this] (coll-view this "(" ")" "seq persistent-array-map-seq"))

  Range
  (-inspect [this] (coll-view this "(" ")" "seq range"))

  UUID
  (-inspect [this] (literal "uuid" this))

  om/IndexedCursor
  (-inspect [this]
    (coll-view this "[" "]" "vector indexed-cursor"))

  om/MapCursor
  (-inspect [this]
    (if (record? (om/value this))
      (coll-view this (record-opener this) "}" "record map-cursor")
      (coll-view this "{" "}" "map map-cursor")))

  js/RegExp
  (-inspect [this] (literal "regexp" this))

  js/Date
  (-inspect [this] (literal "date" this))

  function
  (-inspect [this] (literal "function" this))

  number
  (-inspect [this] (literal "number" this))

  string
  (-inspect [this] (literal "string" this))

  boolean
  (-inspect [this] (literal "boolean" this))

  array
  (-inspect [this] (coll-view this "#js [" "]" "array"))

  object
  (-inspect [this] (coll-view this "#js {" "}" "object"))

  nil
  (-inspect [this] (literal "nil" this)))

(ns ankha.core
  (:refer-clojure :exclude [empty? inspect])
  (:require
   [om.core :as om :include-macros true]
   [om.dom :as dom :include-macros true]
   [clojure.string :as string]
   [cljs.reader :as reader]
   [goog.object :as object]
   [goog.crypt :as crypt]
   goog.crypt.Md5))

(enable-console-print!)

;; ---------------------------------------------------------------------
;; Protocols

(defprotocol IInspect
  (-inspect [this]
    "Return a React or Om compatible representation of this."))

;; ---------------------------------------------------------------------
;; Utilities

(defn- empty?
  "Return true if x is an empty js/Object or empty Clojure collection."
  [x]
  (if (object? x)
    (object/isEmpty x)
    (clojure.core/empty? x)))

(defn- record?
  "Return true if x satisfies IRecord, false otherwise."
  [x]
  (satisfies? IRecord x))

(defn record-name
  "Return the name of a Record type."
  [r]
  (let [s (pr-str r)]
    (subs s 0 (.indexOf s "{"))))

(defn record-opener
  "Return an opener for a Record type."
  [r]
  (str (record-name r) "{"))

(defn hash-key [data]
  (let [d (goog.crypt.Md5.)]
    (.update d (crypt/stringToByteArray (str data)))
    (crypt/byteArrayToHex (.digest d))))

;; ---------------------------------------------------------------------
;; View helpers

(declare collection-view)

(defn literal [class x]
  (dom/span #js {:className class :key x}
    (pr-str x)))

(defn coll-view [data opener closer class]
  (om/build collection-view data
    {:opts {:opener opener :closer closer :class class :open? false}}))

(defn inspect [x]
  (cond
    (satisfies? IInspect x)
    (-inspect x)
    (fn? x)
    (literal "function" x)
    :else
    (literal "literal" x)))

(defn associative->dom
  [data {:keys [entry-class key-class val-class]}]
  (into-array
    (for [[k v] data]
      (dom/li #js {:key (hash-key [k v])}
        (dom/div #js {:className (str "entry " entry-class)
                      :style #js {:position "relative"}}
          (dom/span #js {:className (str "key " key-class)
                         :style #js {:display "inline-block"
                                     :verticalAlign "top"}}
            (inspect k))
          (dom/span #js {:style #js {:display "inline-block"
                                     :width "1em"}})
          (dom/span #js {:className (str "val " val-class)
                         :style #js {:display "inline-block"
                                     :verticalAlign "top"}}
            (inspect v)))))))

(defn sequential->dom
  [data owner {:keys [page-item-count] :or {page-item-count 10}}]
  (reify
    om/IInitState
    (init-state [_]
      {:page 1})

    om/IRenderState
    (render-state [_ {:keys [page]}]
      (let [button-style {:display "inline-block"
                          :verticalAlign "top"
                          :border "none"
                          :background "none"
                          :cursor "pointer"
                          :outline "none"
                          :fontWeight "bold"
                          :padding "0 1em"}
            total (count data)
            total-pages (js/Math.ceil (/ total page-item-count))
            first-page? (= page 1)
            last-page? (= page total-pages)]

        (dom/div nil
         (dom/button
          #js {:onClick
               (fn [_]
                 (when-not first-page?
                   (om/update-state! owner :page dec)))
               :style (clj->js
                       (assoc button-style :opacity (if first-page? "0.3" "1.0")))}
          "Prev")

         (dom/span nil (str "Page " page " of " total-pages " (" total " items)"))

         (dom/button
           #js {:onClick
                (fn [_]
                  (when-not last-page?
                    (om/update-state! owner :page inc)))
                :style (clj->js
                        (assoc button-style :opacity (if last-page? "0.3" "1.0")))}
           "Next")

         (let [page-data (->> data
                              (drop (* (dec page) page-item-count))
                              (take page-item-count))]
           (into-array
            (for [[i x :as pair] (map-indexed vector page-data)]
              (dom/li #js {:className "entry"
                           :key (hash-key pair)}
                      (inspect x))))))))))

(defn coll->dom [data]
  (cond
   (map? data)
   (associative->dom data {:entry-class "map-entry"
                           :key-class "map-key"
                           :val-class "map-val"})
   (object? data)
   (let [;; Avoid zipmap to preserve key order.
         ks (object/getKeys data)
         vs (object/getValues data)
         m (map vector ks vs)]
     (associative->dom m {:entry-class "object-entry"
                          :key-class "object-key"
                          :val-class "object-val"}))
   :else
   (om/build sequential->dom data)))

(defn- toggle-button [owner {:keys [disable?]}]
  (dom/button #js {:className "toggle-button"
                   :disabled disable?
                   :onClick
                   (fn [_]
                     (om/update-state! owner :open? not))
                   :style #js {:display "inline-block"
                               :verticalAlign "top"
                               :border "none"
                               :background "none"
                               :cursor "pointer"
                               :outline "none"
                               :fontWeight "bold"
                               :padding "0"
                               :opacity (if disable? "0.5" "1.0")}}
    (if (om/get-state owner :open?) "-" "+")))

(defn- edit-button [owner {:keys [disable? save-editor open-editor]}]
  (dom/button #js {:className "edit-button"
                   :disabled disable?
                   :onClick
                   (fn [_]
                     (if (om/get-state owner :editing?)
                       (save-editor)
                       (open-editor)))
                   :style #js {:display "inline-block"
                               :verticalAlign "top"
                               :border "none"
                               :background "none"
                               :cursor "pointer"
                               :outline "none"
                               :fontWeight "bold"
                               :padding "0"
                               :opacity (if disable? "0.5" "1.0")}}
              (if (om/get-state owner :editing?) "Save" "Edit")))

(defn enter-key? [e]
  (= 13 (.-keyCode e)))

(defn escape-key? [e]
  (= 27 (.-keyCode e)))

(defn- editor [owner {:keys [value save-editor cancel-editor error-message]}]
  (dom/div #js {:style #js {:display "inline"}}
           (dom/textarea #js {:className "editor"
                              :ref "editor"
                              :style #js {:display "inline-block"}
                              :value value
                              :onKeyPress (fn [e]
                                            (when (enter-key? e)
                                              (.preventDefault e)))
                              :onKeyUp (fn [e]
                                         (cond
                                           (enter-key? e) (save-editor)
                                           (escape-key? e) (cancel-editor)))
                              :onChange (fn [e] (om/set-state! owner :edited-data (.. e -target -value)))
                              :onBlur save-editor})
           (when error-message
             (dom/span #js {:className "error" :style #js {:vertical-align "top"}}
                       error-message))))

;; ---------------------------------------------------------------------
;; Main component

(defn collection-view
  [data owner {:keys [class opener closer] :as opts}]
  (reify
    om/IInitState
    (init-state [_]
      {:edited-data (pr-str data)
       :editing? (boolean (:editing? opts))
       :open-editor (fn [] (om/update-state! owner (fn [s] (merge s {:editing-error-message nil :editing? true :edited-data (pr-str @data)}))))
       :save-editor (fn []
                      (try
                        (let [new-data (reader/read-string (om/get-state owner :edited-data))]
                          ;; if the new data is the same as the old just stop editing
                          ;; if not, set data to new data, which will cause this component to re-mount
                          ;; this is a little funky but seems necessary to avoid trying to update an unmounted component
                          (if (= new-data @data)
                            (om/set-state! owner :editing? false)
                            (om/update! data new-data)))
                        (catch js/Error e
                          (om/set-state! owner :editing-error-message (.-message e)))))
       :cancel-editor (fn [] (om/set-state! owner :editing? false))
       :vacant? (empty? data)
       :open? (and (not (false? (:open? opts)))
                   (not (empty? data)))})

    om/IRenderState
    (render-state [_ {:keys [open? vacant? editing? edited-data editing-error-message open-editor save-editor cancel-editor]}]
      (dom/div #js {:className class}
        (toggle-button owner {:disable? vacant?})

        (when open?
         (edit-button owner {:open-editor open-editor :save-editor save-editor}))

        (when (and open? editing?)
          (editor owner {:value edited-data :error-message editing-error-message
                         :save-editor save-editor :cancel-editor cancel-editor}))

        (dom/span #js {:className "opener"
                       :style #js {:display (if (and open? editing?) "none" "inline-block")}}
          opener)

        (dom/ul #js {:className "values"
                     :style #js {:display (if (and open? (not editing?)) "block" "none")
                                 :listStyleType "none"
                                 :margin "0"}}
          (coll->dom data))

        (dom/span #js {:className "ellipsis"
                       :style #js {:display (if (or open? vacant?)
                                              "none"
                                              "inline")}}
          "…")

        (dom/span #js {:className "closer"
                       :style #js {:display (if open?
                                              (if editing?
                                                "none"
                                                "block")
                                              "inline-block")}}
          closer)))

    om/IDidUpdate
    (did-update [this prev-props prev-state]
      (when (om/get-state owner :editing?)
        (.focus (om/get-node owner "editor"))))))

(defn inspector
  ([data owner]
     (inspector data owner {:opts {:class "inspector"}}))
  ([data owner {:keys [class] :or {class "inspector"} :as opts}]
     (reify
       om/IRender
       (render [_]
         (dom/div #js {:className class
                       :style #js {:fontFamily "monospace"
                                   :whiteSpace "pre-wrap"
                                   :width "100%"
                                   :overflowX "scroll"}}
           (inspect data))))))

;; ---------------------------------------------------------------------
;; IInspect Implementation

(extend-protocol IInspect
  Keyword
  (-inspect [this] (literal "keyword" this))

  Symbol
  (-inspect [this] (literal "symbol" this))

  PersistentArrayMap
  (-inspect [this]
    (coll-view this "{" "}" "map persistent-array-map"))

  PersistentHashMap
  (-inspect [this]
    (coll-view this "{" "}" "map persistent-hash-map"))

  PersistentVector
  (-inspect [this] (coll-view this "[" "]" "vector"))

  PersistentHashSet
  (-inspect [this] (coll-view this "#{" "}" "set persistent-hash-set"))

  PersistentTreeSet
  (-inspect [this] (coll-view this "#{" "}" "set persistent-tree-set"))

  List
  (-inspect [this] (coll-view this "(" ")" "list"))

  LazySeq
  (-inspect [this] (coll-view this "(" ")" "seq lazy-seq"))

  KeySeq
  (-inspect [this] (coll-view this "(" ")" "seq key-seq"))

  ValSeq
  (-inspect [this] (coll-view this "(" ")" "seq val-seq"))

  PersistentArrayMapSeq
  (-inspect [this] (coll-view this "(" ")" "seq persistent-array-map-seq"))

  Range
  (-inspect [this] (coll-view this "(" ")" "seq range"))

  UUID
  (-inspect [this] (literal "uuid" this))

  om/IndexedCursor
  (-inspect [this]
    (coll-view this "[" "]" "vector indexed-cursor"))

  om/MapCursor
  (-inspect [this]
    (if (record? (om/value this))
      (coll-view this (record-opener this) "}" "record map-cursor")
      (coll-view this "{" "}" "map map-cursor")))

  js/RegExp
  (-inspect [this] (literal "regexp" this))

  js/Date
  (-inspect [this] (literal "date" this))

  function
  (-inspect [this] (literal "function" this))

  number
  (-inspect [this] (literal "number" this))

  string
  (-inspect [this] (literal "string" this))

  boolean
  (-inspect [this] (literal "boolean" this))

  array
  (-inspect [this] (coll-view this "#js [" "]" "array"))

  object
  (-inspect [this] (coll-view this "#js {" "}" "object"))

  nil
  (-inspect [this] (literal "nil" this)))

Make the inspector's tree folded by default


(ns incise.config
  (:require [clojure.java.io :refer [reader file resource]]
            [clojure.edn :as edn]
            [manners.victorian :refer [defmannerisms]])
  (:import [java.io PushbackReader])
  (:refer-clojure :exclude [merge load assoc get]))

(defonce config (atom {:in-dir "content"
                       :out-dir "public"}))

(defn get [& more]
  (if (empty? more)
    @config
    (apply @config more)))

(defn merge [& more]
  (apply swap! config
         clojure.core/merge more))

(defn assoc [& more]
  (apply swap! config clojure.core/assoc more))

(defonce config-path (atom nil))

(defn serving? [] (= (get :method) :serve))

(defn load
  "Load the config from "
  [& [path-to-config]]
  (when path-to-config (reset! config-path path-to-config))
  (when-let [config-file (file (or @config-path (resource "incise.edn")))]
    (reset! config (edn/read (PushbackReader. (reader config-file))))))

(defn- str-starts-or-ends-with-slash?
  [a-str]
  {:pre [(string? a-str)]}
  (some #(= \/ %) [(last a-str) (first a-str)]))

(defmannerisms config
  [(comp (some-fn nil? string?) :uri-root) "uri-root must be a string"]
  [(comp (complement (every-pred string? str-starts-or-ends-with-slash?))
         :uri-root)
   "uri-root must not start or end with a \"/\""]
  [:in-dir "must have an input directory (in-dir)"]
  [(comp string? :in-dir) "in-dir must be a string (like a path)"]
  [:out-dir "must have an output directory (out-dir)"]
  [(comp string? :out-dir) "out-dir must be a string (like a path)"])

(defn avow! [] (avow-config! @config))

(ns incise.config
  (:require [clojure.java.io :refer [reader file resource]]
            [clojure.edn :as edn]
            [manners.victorian :refer [defmannerisms]])
  (:import [java.io PushbackReader])
  (:refer-clojure :exclude [merge load assoc get]))

(defonce config (atom {:in-dir "content"
                       :out-dir "public"}))

(defn get [& more]
  (if (empty? more)
    @config
    (apply @config more)))

(defn merge [& more]
  (apply swap! config
         clojure.core/merge more))

(defn assoc [& more]
  (apply swap! config clojure.core/assoc more))

(defonce config-path (atom nil))

(defn serving? [] (= (get :method) :serve))

(defn load
  "Load the config from "
  [& [path-to-config]]
  (when path-to-config (reset! config-path path-to-config))
  (when-let [config-file (file (or @config-path (resource "incise.edn")))]
    (merge (edn/read (PushbackReader. (reader config-file))))))

(defn- str-starts-or-ends-with-slash?
  [a-str]
  {:pre [(string? a-str)]}
  (some #(= \/ %) [(last a-str) (first a-str)]))

(defmannerisms config
  [(comp (some-fn nil? string?) :uri-root) "uri-root must be a string"]
  [(comp (complement (every-pred string? str-starts-or-ends-with-slash?))
         :uri-root)
   "uri-root must not start or end with a \"/\""]
  [:in-dir "must have an input directory (in-dir)"]
  [(comp string? :in-dir) "in-dir must be a string (like a path)"]
  [:out-dir "must have an output directory (out-dir)"]
  [(comp string? :out-dir) "out-dir must be a string (like a path)"])

(defn avow! [] (avow-config! @config))

Use merge instead of reset when loading config.


(ns incise.server
  (:require (compojure [route :refer [files not-found]]
                       [core :refer [defroutes]])
            (hiccup [page :refer [html5]])
            (incise [config :as conf]
                    [load :refer [load-parsers-and-layouts]])
            (ring.middleware [reload :refer [wrap-reload]]
                             [incise :refer [wrap-incise]]
                             [stacktrace :refer [wrap-stacktrace-web]])
            [stefon.core :refer [asset-pipeline]]
            [taoensso.timbre :refer [info error]]
            [clojure.stacktrace :refer [print-cause-trace]]
            [org.httpkit.server :refer [run-server]]))

(conf/load)
(defroutes routes
  (files "/" {:root (conf/get :out-dir)})
  (not-found (html5 [:h1 "404"])))

(defn wrap-static-index [handler]
  (fn [{:keys [uri] :as request}]
    (handler (if (= (last uri) \/)
               (assoc request :uri (str uri "index.html"))
               request))))

(defn wrap-log-exceptions [func & {:keys [bubble] :or {bubble true}}]
  "Log (i.e. print) exceptions received from the given function."
  (fn [& args]
    (try
      (apply func args)
      (catch Exception e
        (error (with-out-str (print-cause-trace e)))
        (when bubble (throw e))))))

(def app (-> routes
             (wrap-static-index)
             (wrap-reload :dirs ["src" "spec"])
             (wrap-incise)
             (wrap-log-exceptions)
             (wrap-stacktrace-web)
             (asset-pipeline)))

(defn getenv
  "A nice wrapper around System/getenv that allows a second argument to be
  passed in as the default."
  [variable & [default]]
  (or (System/getenv variable) default))

(defn serve
  "Start the development server"
  []
  (let [port (Integer. (conf/get :port (getenv "PORT" 5000)))]
    (info "Serving at"
          (str "http://" (.getCanonicalHostName
                           (java.net.InetAddress/getLocalHost)) \: port \/))
    (run-server app {:port port
                     :thread (Integer.
                               (conf/get :thread-count
                                         (getenv "THREAD_COUNT" 4)))})))

(defonce server (atom nil))

(defn defserver
  "Start a server and bind the result to a var, 'server'."
  [& args]
  (reset! server (apply serve args)))

(defn stop-server []
  (when @server
    (@server)
    (reset! server nil)))

(ns incise.server
  (:require (compojure [route :refer [files not-found]]
                       [core :refer [defroutes]])
            (hiccup [page :refer [html5]])
            (incise [config :as conf]
                    [load :refer [load-parsers-and-layouts]])
            (ring.middleware [reload :refer [wrap-reload]]
                             [incise :refer [wrap-incise]]
                             [stacktrace :refer [wrap-stacktrace-web]])
            [stefon.core :refer [asset-pipeline]]
            [taoensso.timbre :refer [info error fatal]]
            [clojure.stacktrace :refer [print-cause-trace]]
            [org.httpkit.server :refer [run-server]]))

(conf/load)
(defroutes routes
  (files "/" {:root (conf/get :out-dir)})
  (not-found (html5 [:h1 "404"])))

(defn wrap-static-index [handler]
  (fn [{:keys [uri] :as request}]
    (handler (if (= (last uri) \/)
               (assoc request :uri (str uri "index.html"))
               request))))

(defn wrap-log-exceptions [func & {:keys [bubble] :or {bubble true}}]
  "Log (i.e. print) exceptions received from the given function."
  (fn [& args]
    (try
      (apply func args)
      (catch Exception e
        ((if bubble error fatal) (with-out-str (print-cause-trace e)))
        (when bubble (throw e))))))

(def app (-> routes
             (wrap-static-index)
             (wrap-reload :dirs ["src" "spec"])
             (wrap-incise)
             (wrap-log-exceptions)
             (wrap-stacktrace-web)
             (asset-pipeline)))

(defn getenv
  "A nice wrapper around System/getenv that allows a second argument to be
  passed in as the default."
  [variable & [default]]
  (or (System/getenv variable) default))

(defn serve
  "Start the development server"
  []
  (let [port (Integer. (conf/get :port (getenv "PORT" 5000)))]
    (info "Serving at"
          (str "http://" (.getCanonicalHostName
                           (java.net.InetAddress/getLocalHost)) \: port \/))
    (run-server app {:port port
                     :thread (Integer.
                               (conf/get :thread-count
                                         (getenv "THREAD_COUNT" 4)))})))

(defonce server (atom nil))

(defn defserver
  "Start a server and bind the result to a var, 'server'."
  [& args]
  (reset! server (apply serve args)))

(defn stop-server []
  (when @server
    (@server)
    (reset! server nil)))

Use fatal instead of error when bubble is false.