(ns metabase.models.hydrate
  "Functions for deserializing and hydrating fields in objects fetched from the DB."
  (:require [clojure.data.json :as json]
            [clojure.walk :as walk]
            [metabase.db :refer [sel]]
            [metabase.util :as u]))

(declare batched-hydrate
         can-batched-hydrate?
         counts-apply
         hydrate
         hydrate-1
         hydrate-kw
         hydrate-many
         hydrate-vector
         hydration-key->entity
         k->k_id
         simple-hydrate
         valid-hydration-form?)

;; ## REALIZE-JSON

(defn- read-json-str-or-clob
  "If STR is a JDBC Clob, convert to a String. Then call `json/read-str`."
  [str]
  (when-let [str (if-not (= (type str) org.h2.jdbc.JdbcClob) str
                         (u/jdbc-clob->str str))]
    (json/read-str str)))

(defn realize-json
  "Deserialize JSON strings keyed by JSON-KEYS.
   RESULT may either be a single result or a sequence of results. "
  [result & [first-key & rest-keys]]
  (if (sequential? result) (map #(apply realize-json % first-key rest-keys) result) ;  map ourself recursively if RESULT is a sequence
      (let [result (cond-> result
                     (first-key result) (->> first-key
                                             read-json-str-or-clob
                                             walk/keywordize-keys
                                             (assoc result first-key)))]
        (if (empty? rest-keys) result                                               ; if there are remaining keys recurse to realize those
            (recur result rest-keys)))))

;; ## HYDRATE 2.0

(defn hydrate
  "Hydrate a single object or sequence of objects.

  **Batched Hydration**

  Hydration attempts to do a *batched hydration* where possible.
  If the key being hydrated is defined as one of some entity's `:hydration-keys`,
  `hydrate` will do a batched `sel` if a corresponding key ending with `_id`
  is found in the objects being hydrated.

  `defentity` threads resulting map through its forms using `->`, so define
  `:hydration-keys` with `assoc`:

    (defentity User
      (assoc :hydration-keys #{:user}))

    (hydrate [{:user_id 100}, {:user_id 101}] :user)

  Since `:user` is a hydration key for `User`, a single `sel` will used to
  fetch `Users`:

    (sel :many User :id [in #{100 101}])

  The corresponding `Users` are then added under the key `:user`.

  **Simple Hydration**

  If the key is *not* eligible for batched hydration, `hydrate` will look for delays
  in objects being hydrated whose keys match the hydration key. These will be
  evaluated and their values will replace the delays.

    (hydrate [{:fish (delay 1)} {:fish (delay 2)}] :fish)
      -> [{:fish 1} {:fish 2}]

  **Hydrating Multiple Keys**

  You can hydrate several keys at one time:

    (hydrate {:a (delay 1) :b (delay 2)} :a :b)
      -> {:a 1 :b 2}

  **Nested Hydration**

  You can do recursive hydration by listing keys inside a vector:

    (hydrate {:a (delay {:b (delay 1)})} [:a :b])
      -> {:a {:b 1}}

  The first key in a vector will be hydrated normally, and any subsequent keys
  will be hydrated *inside* the corresponding values for that key.

    (hydrate {:a (delay {:b (delay {:c (delay 1)})
                         :e (delay 2)})}
             [:a [:b :c] :e])
      -> {:a {:b {:c 1} :e 2}}"
  [results k & ks]
  {:pre [(valid-hydration-form? k)
         (every? valid-hydration-form? ks)]}
  (when results
    (if (sequential? results) (if (empty? results) results
                                  (apply hydrate-many results k ks))
        (first (apply hydrate-many [results] k ks)))))

;; ## HYDRATE IMPLEMENTATION

;;                          hydrate <-------------+
;;                            |                   |
;;                        hydrate-many            |
;;                            | (for each form)   |
;;                        hydrate-1               | (recursively)
;;                            |                   |
;;                 keyword? --+-- vector?         |
;;                    |             |             |
;;               hydrate-kw    hydrate-vector ----+
;;                    |
;;           can-batched-hydrate?
;;                    |
;;         false -----+----- true
;;          |                 |
;;     simple-hydrate    batched-hydrate

;; ### Primary Hydration Fns

(defn- hydrate-many
  "Hydrate many hydration forms across a *sequence* of RESULTS by recursively calling `hydrate-1`."
  [results k & more]
  (let [results (hydrate-1 results k)]
    (if-not (seq more) results
            (recur results (first more) (rest more)))))

(defn- hydrate-1
  "Hydrate a single hydration form."
  [results k]
  (if (keyword? k) (hydrate-kw results k)
      (hydrate-vector results k)))

(defn- hydrate-vector
  "Hydrate a nested hydration form (vector) by recursively calling `hydrate`."
  [results [k & more]]
  (let [results (hydrate results k)]
    (if-not (seq more) results
            (counts-apply results k #(apply hydrate % more)))))

(defn- hydrate-kw
  "Hydrate a single keyword."
  [results k]
  (if (can-batched-hydrate? results k) (batched-hydrate results k)
      (simple-hydrate results k)))

(defn- simple-hydrate
  "Hydrate keyword K in results by dereferencing corresponding delays when applicable."
  [results k]
  {:pre [(keyword? k)]}
  (map (fn [result]
         (let [v (k result)]
           (if-not (delay? v) result      ; if v isn't a delay it's either already hydrated or nil.
                   (assoc result k @v)))) ; don't barf on nil; just no-op
       results))

(defn- batched-hydrate
  "Hydrate keyword DEST-KEY across all RESULTS by aggregating corresponding source keys (`DEST-KEY_id`),
   doing a single `sel`, and mapping corresponding objects to DEST-KEY."
  ([results dest-key]
   {:pre [(keyword? dest-key)]}
   (let [entity     (@hydration-key->entity dest-key)
         source-key (k->k_id dest-key)
         ids        (set (map source-key results))
         objs       (->> (sel :many entity :id [in ids])
                         (map (fn [obj]
                                {(:id obj) obj}))
                         (into {}))]
     (map (fn [result]
            (let [source-id (result source-key)
                  obj       (objs source-id)]
              (assoc result dest-key obj)))
          results))))

;; #### Possible Improvements
;; TODO - It would be *nice* to extend this to work with one-to-many relationships. e.g. `Dashboard -> Cards`
;;
;; It could work like this:
;;
;;     (defentity Card
;;       (assoc :hydration-keys {:1t1 {:keys #{:card}}        ; (hydrate obj :card)    -> obj.card_id <-> Card.id
;;                               :1tM {:keys #{:cards}
;;                                     :fks #{:table_id}}}))  ; (hydrate table :cards) -> obj.id <-> Card.table_id
;;
;;     (-> (sel :many Table ...)
;;         (hydrate :cards))
;;
;; 1.  `:hydration-keys` can be reworked to differentiate between one-to-one hydrations and one-to-many hydrations
;;     (not sure on the exact format yet)
;;
;; 2.  one-to-many hydrations will additionally need to know what fields it has that can be used as Foreign Keys
;;     -  Could we reflect on the DB and add this info at runtime?
;;     -  Could we just use `belongs-to` / `has-one` / etc? (or an augmented version thereof) to specify foreign keys?
;;
;; 3.  We can infer that `:table_id` is an FK to `Table` because `Table` has `:table` defined as a hydration key.
;;     `:table <-> :table_id`
;;
;; 4.  (This is the tricky part)
;;     If we could somehow know that we are trying to hydrate `Tables`, we would know we could use `:id -> :table_id`
;;     and could do a `(sel Card :table_id [in ids])`
;;     -  We could add a key like `:_type :Table` (?) to results so we know the type

;; ### Helper Fns

(def ^:private hydration-key->entity
  "Delay that returns map of `hydration-key` -> korma entity.
   e.g. `:user -> User`.

   This is built pulling the `:hydration-keys` set from all korma entities."
  (delay (->> (all-ns)
              (mapcat ns-publics)
              vals
              (map var-get)
              (filter (u/fn-> type (= :korma.core/Entity)))
              (filter :hydration-keys)
              (mapcat (fn [{:keys [hydration-keys] :as entity}]
                        (assert (and (set? hydration-keys) (every? keyword? hydration-keys))
                                (str ":hydration-keys should be a set of keywords. In: " entity))
                        (map (u/rpartial vector entity)
                             hydration-keys)))
              (into {}))))

(def ^:private batched-hydration-keys
  "Delay that returns set of keys that are elligible for batched hydration."
  (delay (set (keys @hydration-key->entity))))

(defn- k->k_id
  "Append `_id` to a keyword. `(k->k_id :user) -> :user_id`"
  [k]
  (keyword (str (name k) "_id")))

(defn- can-batched-hydrate?
  "Can we do a batched hydration of RESULTS with key K?"
  [results k]
  (and (contains? @batched-hydration-keys k)
       (every? (u/rpartial contains? (k->k_id k)) results)))

(and (contains? @batched-hydration-keys k)
     (every? (u/rpartial contains? (k->k_id k)) results))

(and (contains? @batched-hydration-keys k)
     (every? (util/rpartial contains? (k->k_id k)) results))

(defn- valid-hydration-form?
  "Is this a valid argument to `hydrate`?"
  [k]
  (or (keyword? k)
      (and (sequential? k)
           (keyword? (first k))
           (every? valid-hydration-form? (rest k)))))

;; ### Counts Destructuring

;; This was written at 4 AM. It works (somehow) and is well-tested.
;; But I feel like it's a bit overengineered and there's probably a clearer way of doing this.
;;
;; At a high level, these functions let you aggressively flatten a sequence of maps by a key
;; so you can apply some function across it, and then unflatten that sequence.
;;
;;          +-------------------------------------------------------------------------+
;;          |                                                                         +--> (map merge) --> new seq
;;     seq -+--> counts-of ------------------------------------+                      |
;;          |                                                  +--> counts-unflatten -+
;;          +--> counts-flatten -> (modify the flattened seq) -+
;;
;; 1.  Get a value that can be used to unflatten a sequence later with `counts-of`.
;; 2.  Flatten the sequence with `counts-flatten`
;; 3.  Modify the flattened sequence as needed
;; 4.  Unflatten the sequence by calling `counts-unflatten` with the modified sequence and value from step 1
;; 5.  `map merge` the original sequence and the unflattened sequence.
;;
;; For your convenience `counts-apply` combines these steps for you.

(defn- counts-of
  "Return a sequence of counts / keywords that can be used to unflatten
   COLL later.

    (counts-of [{:a [{:b 1} {:b 2}], :c 2}
                {:a {:b 3}, :c 4}] :a)
      -> [2 :atom]

   For each `x` in COLL, return:

   *  `(count (k x))` if `(k x)` is sequential
   *  `:atom`         if `(k x)` is otherwise non-nil
   *  `:nil`          if `x` has key `k` but the value is nil
   *  `nil`           if `x` is nil."
  [coll k]
  (map (fn [x]
         (cond
           (sequential? (k x)) (count (k x))
           (k x)               :atom
           (contains? x k)     :nil
           :else               nil))
       coll))

(defn- counts-flatten
  "Flatten COLL by K.

    (counts-flatten [{:a [{:b 1} {:b 2}], :c 2}
                     {:a {:b 3}, :c 4}] :a)
      -> [{:b 1} {:b 2} {:b 3}]"
  [coll k]
  {:pre [(sequential? coll)
         (keyword? k)]}
  (->> coll
       (map k)
       (mapcat (fn [x]
                 (if (sequential? x)  x
                     [x])))))

(defn- counts-unflatten
  "Unflatten COLL by K using COUNTS from `counts-of`.

    (counts-unflatten [{:b 2} {:b 4} {:b 6}] :a [2 :atom])
      -> [{:a [{:b 2} {:b 4}]}
          {:a {:b 6}}]"
  ([coll k counts]
   (counts-unflatten [] coll k counts))
  ([acc coll k [count & more]]
   (let [[unflattend coll] (condp = count
                             nil   [nil (rest coll)]
                             :atom [(first coll) (rest coll)]
                             :nil  [:nil (rest coll)]
                             (split-at count coll))
         acc (conj acc unflattend)]
     (if-not (seq more) (map (fn [x]
                               (when x
                                 {k (when-not (= x :nil) x)}))
                             acc)
             (recur acc coll k more)))))

(defn- counts-apply
  "Apply F to values of COLL flattened by K, then return unflattened/updated results.

    (counts-apply [{:a [{:b 1} {:b 2}], :c 2}
                   {:a {:b 3}, :c 4}]
      :a #(update-in % [:b] (partial * 2)))

      -> [{:a [{:b 2} {:b 4}], :c 2}
          {:a {:b 3}, :c 4}]"
  [coll k f]
  (let [counts (counts-of coll k)
        new-vals (-> coll
                     (counts-flatten k)
                     f
                     (counts-unflatten k counts))]
    (map merge coll new-vals)))

(ns metabase.models.hydrate
  "Functions for deserializing and hydrating fields in objects fetched from the DB."
  (:require [clojure.data.json :as json]
            [clojure.walk :as walk]
            [metabase.db :refer [sel]]
            [metabase.util :as u]))

(declare batched-hydrate
         can-batched-hydrate?
         counts-apply
         hydrate
         hydrate-1
         hydrate-kw
         hydrate-many
         hydrate-vector
         hydration-key->entity
         k->k_id
         simple-hydrate
         valid-hydration-form?)

;; ## REALIZE-JSON

(defn- read-json-str-or-clob
  "If STR is a JDBC Clob, convert to a String. Then call `json/read-str`."
  [str]
  (when-let [str (if-not (= (type str) org.h2.jdbc.JdbcClob) str
                         (u/jdbc-clob->str str))]
    (json/read-str str)))

(defn realize-json
  "Deserialize JSON strings keyed by JSON-KEYS.
   RESULT may either be a single result or a sequence of results. "
  [result & [first-key & rest-keys]]
  (if (sequential? result) (map #(apply realize-json % first-key rest-keys) result) ;  map ourself recursively if RESULT is a sequence
      (let [result (cond-> result
                     (first-key result) (->> first-key
                                             read-json-str-or-clob
                                             walk/keywordize-keys
                                             (assoc result first-key)))]
        (if (empty? rest-keys) result                                               ; if there are remaining keys recurse to realize those
            (recur result rest-keys)))))

;; ## HYDRATE 2.0

(defn hydrate
  "Hydrate a single object or sequence of objects.

  **Batched Hydration**

  Hydration attempts to do a *batched hydration* where possible.
  If the key being hydrated is defined as one of some entity's `:hydration-keys`,
  `hydrate` will do a batched `sel` if a corresponding key ending with `_id`
  is found in the objects being hydrated.

  `defentity` threads the resulting map through its forms using `->`, so define
  `:hydration-keys` with `assoc`:

    (defentity User
      (assoc :hydration-keys #{:user}))

    (hydrate [{:user_id 100}, {:user_id 101}] :user)

  Since `:user` is a hydration key for `User`, a single `sel` will used to
  fetch `Users`:

    (sel :many User :id [in #{100 101}])

  The corresponding `Users` are then added under the key `:user`.

  **Simple Hydration**

  If the key is *not* eligible for batched hydration, `hydrate` will look for delays
  in objects being hydrated whose keys match the hydration key. These will be
  evaluated and their values will replace the delays.

    (hydrate [{:fish (delay 1)} {:fish (delay 2)}] :fish)
      -> [{:fish 1} {:fish 2}]

  **Hydrating Multiple Keys**

  You can hydrate several keys at one time:

    (hydrate {:a (delay 1) :b (delay 2)} :a :b)
      -> {:a 1 :b 2}

  **Nested Hydration**

  You can do recursive hydration by listing keys inside a vector:

    (hydrate {:a (delay {:b (delay 1)})} [:a :b])
      -> {:a {:b 1}}

  The first key in a vector will be hydrated normally, and any subsequent keys
  will be hydrated *inside* the corresponding values for that key.

    (hydrate {:a (delay {:b (delay {:c (delay 1)})
                         :e (delay 2)})}
             [:a [:b :c] :e])
      -> {:a {:b {:c 1} :e 2}}"
  [results k & ks]
  {:pre [(valid-hydration-form? k)
         (every? valid-hydration-form? ks)]}
  (when results
    (if (sequential? results) (if (empty? results) results
                                  (apply hydrate-many results k ks))
        (first (apply hydrate-many [results] k ks)))))

;; ## HYDRATE IMPLEMENTATION

;;                          hydrate <-------------+
;;                            |                   |
;;                        hydrate-many            |
;;                            | (for each form)   |
;;                        hydrate-1               | (recursively)
;;                            |                   |
;;                 keyword? --+-- vector?         |
;;                    |             |             |
;;               hydrate-kw    hydrate-vector ----+
;;                    |
;;           can-batched-hydrate?
;;                    |
;;         false -----+----- true
;;          |                 |
;;     simple-hydrate    batched-hydrate

;; ### Primary Hydration Fns

(defn- hydrate-many
  "Hydrate many hydration forms across a *sequence* of RESULTS by recursively calling `hydrate-1`."
  [results k & more]
  (let [results (hydrate-1 results k)]
    (if-not (seq more) results
            (recur results (first more) (rest more)))))

(defn- hydrate-1
  "Hydrate a single hydration form."
  [results k]
  (if (keyword? k) (hydrate-kw results k)
      (hydrate-vector results k)))

(defn- hydrate-vector
  "Hydrate a nested hydration form (vector) by recursively calling `hydrate`."
  [results [k & more]]
  (let [results (hydrate results k)]
    (if-not (seq more) results
            (counts-apply results k #(apply hydrate % more)))))

(defn- hydrate-kw
  "Hydrate a single keyword."
  [results k]
  (if (can-batched-hydrate? results k) (batched-hydrate results k)
      (simple-hydrate results k)))

(defn- simple-hydrate
  "Hydrate keyword K in results by dereferencing corresponding delays when applicable."
  [results k]
  {:pre [(keyword? k)]}
  (map (fn [result]
         (let [v (k result)]
           (if-not (delay? v) result      ; if v isn't a delay it's either already hydrated or nil.
                   (assoc result k @v)))) ; don't barf on nil; just no-op
       results))

(defn- batched-hydrate
  "Hydrate keyword DEST-KEY across all RESULTS by aggregating corresponding source keys (`DEST-KEY_id`),
   doing a single `sel`, and mapping corresponding objects to DEST-KEY."
  ([results dest-key]
   {:pre [(keyword? dest-key)]}
   (let [entity     (@hydration-key->entity dest-key)
         source-key (k->k_id dest-key)
         ids        (set (map source-key results))
         objs       (->> (sel :many entity :id [in ids])
                         (map (fn [obj]
                                {(:id obj) obj}))
                         (into {}))]
     (map (fn [result]
            (let [source-id (result source-key)
                  obj       (objs source-id)]
              (assoc result dest-key obj)))
          results))))

;; #### Possible Improvements
;; TODO - It would be *nice* to extend this to work with one-to-many relationships. e.g. `Dashboard -> Cards`
;;
;; It could work like this:
;;
;;     (defentity Card
;;       (assoc :hydration-keys {:1t1 {:keys #{:card}}        ; (hydrate obj :card)    -> obj.card_id <-> Card.id
;;                               :1tM {:keys #{:cards}
;;                                     :fks #{:table_id}}}))  ; (hydrate table :cards) -> obj.id <-> Card.table_id
;;
;;     (-> (sel :many Table ...)
;;         (hydrate :cards))
;;
;; 1.  `:hydration-keys` can be reworked to differentiate between one-to-one hydrations and one-to-many hydrations
;;     (not sure on the exact format yet)
;;
;; 2.  one-to-many hydrations will additionally need to know what fields it has that can be used as Foreign Keys
;;     -  Could we reflect on the DB and add this info at runtime?
;;     -  Could we just use `belongs-to` / `has-one` / etc? (or an augmented version thereof) to specify foreign keys?
;;
;; 3.  We can infer that `:table_id` is an FK to `Table` because `Table` has `:table` defined as a hydration key.
;;     `:table <-> :table_id`
;;
;; 4.  (This is the tricky part)
;;     If we could somehow know that we are trying to hydrate `Tables`, we would know we could use `:id -> :table_id`
;;     and could do a `(sel Card :table_id [in ids])`
;;     -  We could add a key like `:_type :Table` (?) to results so we know the type

;; ### Helper Fns

(def ^:private hydration-key->entity
  "Delay that returns map of `hydration-key` -> korma entity.
   e.g. `:user -> User`.

   This is built pulling the `:hydration-keys` set from all korma entities."
  (delay (->> (all-ns)
              (mapcat ns-publics)
              vals
              (map var-get)
              (filter (u/fn-> type (= :korma.core/Entity)))
              (filter :hydration-keys)
              (mapcat (fn [{:keys [hydration-keys] :as entity}]
                        (assert (and (set? hydration-keys) (every? keyword? hydration-keys))
                                (str ":hydration-keys should be a set of keywords. In: " entity))
                        (map (u/rpartial vector entity)
                             hydration-keys)))
              (into {}))))

(def ^:private batched-hydration-keys
  "Delay that returns set of keys that are elligible for batched hydration."
  (delay (set (keys @hydration-key->entity))))

(defn- k->k_id
  "Append `_id` to a keyword. `(k->k_id :user) -> :user_id`"
  [k]
  (keyword (str (name k) "_id")))

(defn- can-batched-hydrate?
  "Can we do a batched hydration of RESULTS with key K?"
  [results k]
  (and (contains? @batched-hydration-keys k)
       (every? (u/rpartial contains? (k->k_id k)) results)))

(and (contains? @batched-hydration-keys k)
     (every? (u/rpartial contains? (k->k_id k)) results))

(and (contains? @batched-hydration-keys k)
     (every? (util/rpartial contains? (k->k_id k)) results))

(defn- valid-hydration-form?
  "Is this a valid argument to `hydrate`?"
  [k]
  (or (keyword? k)
      (and (sequential? k)
           (keyword? (first k))
           (every? valid-hydration-form? (rest k)))))

;; ### Counts Destructuring

;; This was written at 4 AM. It works (somehow) and is well-tested.
;; But I feel like it's a bit overengineered and there's probably a clearer way of doing this.
;;
;; At a high level, these functions let you aggressively flatten a sequence of maps by a key
;; so you can apply some function across it, and then unflatten that sequence.
;;
;;          +-------------------------------------------------------------------------+
;;          |                                                                         +--> (map merge) --> new seq
;;     seq -+--> counts-of ------------------------------------+                      |
;;          |                                                  +--> counts-unflatten -+
;;          +--> counts-flatten -> (modify the flattened seq) -+
;;
;; 1.  Get a value that can be used to unflatten a sequence later with `counts-of`.
;; 2.  Flatten the sequence with `counts-flatten`
;; 3.  Modify the flattened sequence as needed
;; 4.  Unflatten the sequence by calling `counts-unflatten` with the modified sequence and value from step 1
;; 5.  `map merge` the original sequence and the unflattened sequence.
;;
;; For your convenience `counts-apply` combines these steps for you.

(defn- counts-of
  "Return a sequence of counts / keywords that can be used to unflatten
   COLL later.

    (counts-of [{:a [{:b 1} {:b 2}], :c 2}
                {:a {:b 3}, :c 4}] :a)
      -> [2 :atom]

   For each `x` in COLL, return:

   *  `(count (k x))` if `(k x)` is sequential
   *  `:atom`         if `(k x)` is otherwise non-nil
   *  `:nil`          if `x` has key `k` but the value is nil
   *  `nil`           if `x` is nil."
  [coll k]
  (map (fn [x]
         (cond
           (sequential? (k x)) (count (k x))
           (k x)               :atom
           (contains? x k)     :nil
           :else               nil))
       coll))

(defn- counts-flatten
  "Flatten COLL by K.

    (counts-flatten [{:a [{:b 1} {:b 2}], :c 2}
                     {:a {:b 3}, :c 4}] :a)
      -> [{:b 1} {:b 2} {:b 3}]"
  [coll k]
  {:pre [(sequential? coll)
         (keyword? k)]}
  (->> coll
       (map k)
       (mapcat (fn [x]
                 (if (sequential? x)  x
                     [x])))))

(defn- counts-unflatten
  "Unflatten COLL by K using COUNTS from `counts-of`.

    (counts-unflatten [{:b 2} {:b 4} {:b 6}] :a [2 :atom])
      -> [{:a [{:b 2} {:b 4}]}
          {:a {:b 6}}]"
  ([coll k counts]
   (counts-unflatten [] coll k counts))
  ([acc coll k [count & more]]
   (let [[unflattend coll] (condp = count
                             nil   [nil (rest coll)]
                             :atom [(first coll) (rest coll)]
                             :nil  [:nil (rest coll)]
                             (split-at count coll))
         acc (conj acc unflattend)]
     (if-not (seq more) (map (fn [x]
                               (when x
                                 {k (when-not (= x :nil) x)}))
                             acc)
             (recur acc coll k more)))))

(defn- counts-apply
  "Apply F to values of COLL flattened by K, then return unflattened/updated results.

    (counts-apply [{:a [{:b 1} {:b 2}], :c 2}
                   {:a {:b 3}, :c 4}]
      :a #(update-in % [:b] (partial * 2)))

      -> [{:a [{:b 2} {:b 4}], :c 2}
          {:a {:b 3}, :c 4}]"
  [coll k f]
  (let [counts (counts-of coll k)
        new-vals (-> coll
                     (counts-flatten k)
                     f
                     (counts-unflatten k counts))]
    (map merge coll new-vals)))

fix typo

fix typo


(ns brainbot.nozzle.main
  (:require [clojure.tools.logging :as logging])
  (:require [brainbot.nozzle
             [fsworker :as fsworker]
             [manage :as manage]
             [extract2 :as extract]
             [esconnect :as esconnect]
             [version :as version]
             [misc :as misc]]
            [brainbot.nozzle.misc :refer [die]])
  (:require [clojure.tools.nrepl.server :as nrepl-server])
  (:require [clojure.tools.cli :as cli])
  (:require [com.brainbot.iniconfig :as ini])
  (:gen-class))

(defn ensure-java-version
  []
  (let [java-version (System/getProperty "java.version")
        [major minor] (map #(Integer. %)
                           (rest (re-find #"^(\d+)\.(\d+)" java-version)))]

    (when (> 0 (compare [major minor] [1 7]))
      (binding [*out* *err*]
        (println
         (format "Fatal error: You need at least java version 7. The java installation in %s has version %s."
                 (System/getProperty "java.home") java-version))
        (System/exit 1)))))

(defn parse-command-line-options
  "parse command line options with clojure.tools.cli
   returns a map of options"

  [args]
  (let [[options args banner]
        (cli/cli args
                 ["-h" "--help" "Show help" :flag true :default false]
                 ["--version" "show version" :flag true :default false]
                 ;; ["--ampqp-url" "amqp url to connect to"]
                 ;; ["--port" "Port to listen on" :default 5000]
                 ;; ["--root" "Root directory of web server" :default "public"])
                 ["--iniconfig" "(required) ini configuration filename"])]
    (when (:help options)
      (do (println banner)
          (System/exit 0)))
    (when (:version options)
      (do (println "nozzle" (version/nozzle-version)
                   "on Java" (System/getProperty "java.version")
                   (System/getProperty "java.vm.name"))
          (System/exit 0)))
    (when-not (:iniconfig options)
      (die "--iniconfig option missing"))
    (assoc (dissoc options :help) :sections args)))

(declare run-all-sections)

(defn meta-run-section
  [iniconfig section]
  (let [subsections (misc/trimmed-lines-from-string
                     (get-in iniconfig [section "sections"]))]
    (run-all-sections iniconfig subsections)))

(def type->run-section
  {"fsworker" fsworker/worker-run-section
   "meta"   meta-run-section
   "extract"  extract/extract-run-section
   "esconnect" esconnect/esconnect-run-section
   "manage" manage/manage-run-section})

(defn run-all-sections
  [iniconfig sections]
  (doseq [section sections]
    (let [type (get-in iniconfig [section "type"])
          run-section (type->run-section type)]
      (if (nil? run-section)
        nil
        (do
          (logging/info "starting runner for section" section)
          (run-section iniconfig section))))))

(defn maybe-start-repl-server
  []
  (if-let [port (System/getProperty "nozzle.repl")]
    (do
      (println "starting repl on port" port)
      (nrepl-server/start-server :port (Integer. port)))))

(defn sanity-check-tika-resources
  "this function checks that the right tika resources are being used.

tika reads the 'META-INF/services/org.apache.tika.parser.Parser' resource
and uses that to initialize the available parsers.

org.gagravarr/vorbis-java-tika is a dependency of tika and ships with
it's own version of the above file, but it does only list 3
vorbis-java-tika parsers.

lein uberjar chooses to use the resource file from vorbis-java-tika

we must make sure that we do not use the file shipped by
vorbis-java-tika, since then parsing only works for ogg files
"
  []
  (let [path "META-INF/services/org.apache.tika.parser.Parser"
        content (slurp (clojure.java.io/resource path))
        line-count (count (clojure.string/split content #"\n"))]
    (when (> 20 line-count)
      (throw (ex-info "internal error: broken tika resources"
                      {:line-count line-count
                       :content content
                       :path path})))))

(defn -main [& args]
  (ensure-java-version)
  (sanity-check-tika-resources)
  (maybe-start-repl-server)
  (let [{:keys [iniconfig sections]} (parse-command-line-options args)]
    (misc/setup-logging!)
    (let [cfg (ini/read-ini iniconfig)]
      (logging/debug "using config" cfg)
      (run-all-sections
       cfg
       sections))))

(ns brainbot.nozzle.main
  (:require [clojure.tools.logging :as logging])
  (:require [brainbot.nozzle
             [fsworker :as fsworker]
             [manage :as manage]
             [extract2 :as extract]
             [esconnect :as esconnect]
             [version :as version]
             [misc :as misc]]
            [brainbot.nozzle.misc :refer [die]])
  (:require [clojure.tools.nrepl.server :as nrepl-server])
  (:require [clojure.tools.cli :as cli])
  (:require [com.brainbot.iniconfig :as ini])
  (:gen-class))

(defn ensure-java-version
  []
  (let [java-version (System/getProperty "java.version")
        [major minor] (map #(Integer. %)
                           (rest (re-find #"^(\d+)\.(\d+)" java-version)))]

    (when (> 0 (compare [major minor] [1 7]))
      (binding [*out* *err*]
        (println
         (format "Fatal error: You need at least java version 7. The java installation in %s has version %s."
                 (System/getProperty "java.home") java-version))
        (System/exit 1)))))

(defn parse-command-line-options
  "parse command line options with clojure.tools.cli
   returns a map of options"

  [args]
  (let [[options args banner]
        (cli/cli args
                 ["-h" "--help" "Show help" :flag true :default false]
                 ["--version" "show version" :flag true :default false]
                 ;; ["--ampqp-url" "amqp url to connect to"]
                 ;; ["--port" "Port to listen on" :default 5000]
                 ;; ["--root" "Root directory of web server" :default "public"])
                 ["--iniconfig" "(required) ini configuration filename"])]
    (when (:help options)
      (do (println banner)
          (System/exit 0)))
    (when (:version options)
      (do (println "nozzle" (version/nozzle-version)
                   "on Java" (System/getProperty "java.version")
                   (System/getProperty "java.vm.name"))
          (System/exit 0)))
    (when-not (:iniconfig options)
      (die "--iniconfig option missing"))
    (assoc (dissoc options :help) :sections args)))

(declare run-all-sections)

(defn meta-run-section
  [iniconfig section]
  (let [subsections (misc/trimmed-lines-from-string
                     (get-in iniconfig [section "sections"]))]
    (run-all-sections iniconfig subsections)))

(def type->run-section
  {"fsworker" fsworker/worker-run-section
   "meta"   meta-run-section
   "extract"  extract/extract-run-section
   "esconnect" esconnect/esconnect-run-section
   "manage" manage/manage-run-section})

(defn ensure-sections-exist
  [iniconfig sections]
  (let [cfg-sections (set (keys iniconfig))
        sections-set (set sections)
        missing (clojure.set/difference sections-set cfg-sections)]
    (when (seq missing)
      (die (str "the following sections are missing in " (:source (meta iniconfig)) ": "
                (clojure.string/join ", " missing))))))

(defn run-all-sections
  [iniconfig sections]
  (ensure-sections-exist iniconfig sections)
  (doseq [section sections]
    (let [type (get-in iniconfig [section "type"])
          run-section (type->run-section type)]
      (if (nil? run-section)
        nil
        (do
          (logging/info "starting runner for section" section)
          (run-section iniconfig section))))))

(defn maybe-start-repl-server
  []
  (if-let [port (System/getProperty "nozzle.repl")]
    (do
      (println "starting repl on port" port)
      (nrepl-server/start-server :port (Integer. port)))))

(defn sanity-check-tika-resources
  "this function checks that the right tika resources are being used.

tika reads the 'META-INF/services/org.apache.tika.parser.Parser' resource
and uses that to initialize the available parsers.

org.gagravarr/vorbis-java-tika is a dependency of tika and ships with
it's own version of the above file, but it does only list 3
vorbis-java-tika parsers.

lein uberjar chooses to use the resource file from vorbis-java-tika

we must make sure that we do not use the file shipped by
vorbis-java-tika, since then parsing only works for ogg files
"
  []
  (let [path "META-INF/services/org.apache.tika.parser.Parser"
        content (slurp (clojure.java.io/resource path))
        line-count (count (clojure.string/split content #"\n"))]
    (when (> 20 line-count)
      (throw (ex-info "internal error: broken tika resources"
                      {:line-count line-count
                       :content content
                       :path path})))))

(defn -main [& args]
  (ensure-java-version)
  (sanity-check-tika-resources)
  (maybe-start-repl-server)
  (let [{:keys [iniconfig sections]} (parse-command-line-options args)]
    (misc/setup-logging!)
    (let [cfg (ini/read-ini iniconfig)]
      (logging/debug "using config" cfg)
      (run-all-sections
       cfg
       sections))))

check that ini-section arguments exist

check that ini-section arguments exist


(ns circle.backend.build
  "Main definition of the Build object. "
  (:require [clojure.string :as str])
  (:require fs)
  (:use [arohner.utils :only (inspect)])
  (:use [circle.util.except :only (throw-if-not)]
        [circle.util.args :only (require-args)])
  (:require [clj-time.core :as time])
  (:require [circle.util.model-validation :as v])
  (:require [circle.backend.ssh :as ssh])
  (:require [circle.model.project :as project])
  (:use [circle.util.model-validation-helpers :only (is-ref? require-keys)])
  (:use [circle.util.predicates :only (ref?)])
  (:require [somnium.congomongo :as mongo])
  (:require [circle.util.mongo :as c-mongo])
  (:require [circle.sh :as sh])
  (:use [clojure.tools.logging :only (log)]))

(def build-coll :builds) ;; mongo collection for builds

(def build-defaults {:continue? true
                     :action-results []})

(def node-validation
  [(require-keys [:username])])

(def build-validations
  [(require-keys [:_project_id
                  :build_num
                  :vcs_url
                  :vcs_revision
                  :node])
   (fn [build]
     (v/validate node-validation (-> build :node)))
   (fn [b]
     (when (and (= :deploy (:type b)) (not (-> b :vcs_revision)))
       "version-control revision is required for deploys"))
   (fn [b]
     (when-not (and (-> b :build_num (integer?))
                    (-> b :build_num (pos?)))
       "build_num must be a positive integer"))])

(defn validate [b]
  (v/validate build-validations b))

(defn valid? [b]
  (v/valid? build-validations b))

(defn validate!
  "Validates the contents of a build. i.e. pass the map, not the ref"
  [b]
  {:pre [(not (ref? b))]}
  (v/validate! build-validations b))

(def build-dissoc-keys
  ;; Keys on build that shouldn't go into mongo, for whatever reason
  [:actions :action-results])

(defn insert! [b]
  (let [return (mongo/insert! build-coll (apply dissoc @b build-dissoc-keys))]
    (alter b assoc :_id (-> return :_id)
                   :start_time (-> (time/now) .toDate))
    b))

(defn update-mongo
  "Given a build ref, update the mongo row with the current values of b."
  [b]
  (assert (-> @b :_id))
  (c-mongo/ensure-object-id-ref build-coll b)
  (mongo/update! build-coll
                 {:_id (-> @b :_id)}
                 (apply dissoc @b build-dissoc-keys)))

(defn sync-with-db [b id]
  "Fetch the build from the db using id and merge it with b"
  (dosync
   (let [old (mongo/fetch-by-id build-coll (mongo/object-id id))]
     (alter b merge old)
     (update-mongo b))))

(defn add-to-db [b id]
  "If id is null, add build to database, else sync contents with existing db object"
  (if id
    (sync-with-db b id)
    (insert! b)))

(defn project-name [b]
  {:pre [(-> @b :_project_id)]}
  (-> @b :_project_id (project/get-by-id) :name))

(defn build [{:keys [build_num    ;; int
                     vcs_url
                     vcs_revision ;; if present, the commit that caused the build to be run, or nil
                     notify_emails ;; a seq of email addresses to notify when build is done
                     actions      ;; a seq of actions
                     action-results
                     node         ;; Map containing keys required by ec2/start-instance
                     lb-name      ;; name of the load-balancer to use
                     continue?    ;; if true, continue running the build. Failed actions will set this to false
                     ]
              :as args}]
  (let [project (project/get-by-url! vcs_url)
        build_num (or build_num (project/next-build-num project))]
    (ref (merge build-defaults
                args
                {:build_num build_num
                 :_project_id (-> project :_id)})
         :validator validate!)))

(defn extend-group-with-revision
  "update the build, setting the pallet group-name to extends the
  existing group with the VCS revision."
  [build]
  (dosync
   (alter build
          assoc-in [:group :group-name] (keyword (.toLowerCase (format "%s-%s" (project-name build) (-> @build :vcs_revision))))))
  build)

(defn build-name
  ([build]
     (build-name (project-name build) (-> @build :build_num)))
  ([project-name build-num]
     (str project-name "-" build-num)))

(defn checkout-dir
  "Directory where the build will be checked out, on the build box."
  ([build]
     (checkout-dir (project-name build) (-> @build :build_num)))
  ([project-name build-num]
     (str/replace (build-name project-name build-num) #" " "-")))

(defn successful? [build]
  (and (-> @build :stop_time)
       (-> @build :continue?)))

(defn log-ns
  "returns the name of the logger to use for this build "
  [build]
  (symbol (str "circle.build." (project-name build) "-" (-> @build :build_num))))

(def ^:dynamic *log-ns* nil) ;; contains the name of the logger for the current build

(defn ssh-build-log
  "This is a different function from the normal build log because 1)
  ssh/handle-out won't pass format arguments. 2) if the string does happen to
  contain a %s, we don't want format throwing because we have a %s and
  no extra args"
  [s]
  (when *log-ns*
    (log *log-ns* :info nil s)))

(defn ssh-build-log-error [s]
  (when *log-ns*
    (log *log-ns* :error nil s)))

(defmacro with-build-log [build & body]
  `(binding [*log-ns* (log-ns ~build)
             ssh/handle-out ssh-build-log
             ssh/handle-err ssh-build-log-error]
     ~@body))

(defn build-log [message & args]
  (when *log-ns*
    (log *log-ns* :info nil (apply format message args))))

(defn build-log-error [message & args]
  (when *log-ns*
    (log *log-ns* :error nil (apply format message args))))

(defn build-with-instance-id
  "Returns the build from the DB with the given instance-id"
  [id]
  (mongo/fetch-one build-coll :where {:instance-ids id}))

(defn ssh
  "Opens a terminal window that SSHs into instance with the provided id.

Assumes:
  1) the instance was started by a build
  2) the build is in the DB
  3) the instance is still running
  4) this clojure process is on OSX"

  [instance-id]
  (let [build (build-with-instance-id instance-id)
        ssh-private-key (-> build :node :private-key)
        username (-> build :node :username)
        ip-addr (-> build :node :ip-addr)
        key-temp-file (fs/tempfile "ssh")
        _ (spit key-temp-file ssh-private-key)
        _ (fs/chmod "-r" key-temp-file)
        _ (fs/chmod "u+r" key-temp-file)
        ssh-cmd (format "ssh -i %s %s@%s" key-temp-file username ip-addr)
        tell-cmd (format "'tell app \"Terminal\" \ndo script \"%s\"\n end tell'" ssh-cmd)]
    (sh/shq (osascript -e ~tell-cmd))))

(ns circle.backend.build
  "Main definition of the Build object. "
  (:require [clojure.string :as str])
  (:require fs)
  (:use [arohner.utils :only (inspect)])
  (:use [circle.util.except :only (throw-if-not)]
        [circle.util.args :only (require-args)])
  (:require [clj-time.core :as time])
  (:require [circle.util.model-validation :as v])
  (:require [circle.backend.ssh :as ssh])
  (:require [circle.model.project :as project])
  (:use [circle.util.model-validation-helpers :only (is-ref? require-keys)])
  (:use [circle.util.predicates :only (ref?)])
  (:require [somnium.congomongo :as mongo])
  (:require [circle.util.mongo :as c-mongo])
  (:require [circle.sh :as sh])
  (:use [clojure.tools.logging :only (log)])
  (:use [circle.util.string :only (non-empty?)])
  (:require [circle.backend.github-url :as github-url]))

(def build-coll :builds) ;; mongo collection for builds

(def build-defaults {:continue? true
                     :action-results []})

(def node-validation
  [(require-keys [:username])])

(def build-validations
  [(require-keys [:_project_id
                  :build_num
                  :vcs_url
                  :vcs_revision
                  :node])
   (fn [build]
     (v/validate node-validation (-> build :node)))
   (fn [b]
     (when (and (= :deploy (:type b)) (not (-> b :vcs_revision)))
       "version-control revision is required for deploys"))
   (fn [b]
     (when-not (and (-> b :build_num (integer?))
                    (-> b :build_num (pos?)))
       "build_num must be a positive integer"))])

(defn validate [b]
  (v/validate build-validations b))

(defn valid? [b]
  (v/valid? build-validations b))

(defn validate!
  "Validates the contents of a build. i.e. pass the map, not the ref"
  [b]
  {:pre [(not (ref? b))]}
  (v/validate! build-validations b))

(def build-dissoc-keys
  ;; Keys on build that shouldn't go into mongo, for whatever reason
  [:actions :action-results])

(defn insert! [b]
  (let [return (mongo/insert! build-coll (apply dissoc @b build-dissoc-keys))]
    (alter b assoc :_id (-> return :_id)
                   :start_time (-> (time/now) .toDate))
    b))

(defn update-mongo
  "Given a build ref, update the mongo row with the current values of b."
  [b]
  (assert (-> @b :_id))
  (c-mongo/ensure-object-id-ref build-coll b)
  (mongo/update! build-coll
                 {:_id (-> @b :_id)}
                 (apply dissoc @b build-dissoc-keys)))

(defn sync-with-db [b id]
  "Fetch the build from the db using id and merge it with b"
  (dosync
   (let [old (mongo/fetch-by-id build-coll (mongo/object-id id))]
     (alter b merge old)
     (update-mongo b))))

(defn add-to-db [b id]
  "If id is null, add build to database, else sync contents with existing db object"
  (if id
    (sync-with-db b id)
    (insert! b)))

(defn project-name [b]
  {:pre [(-> @b :_project_id)]
   :post [(non-empty? %)]}
  (or (-> @b :_project_id (project/get-by-id) :name)
      (-> @b :vcs_url (github-url/parse) :project)))

(defn build [{:keys [build_num    ;; int
                     vcs_url
                     vcs_revision ;; if present, the commit that caused the build to be run, or nil
                     notify_emails ;; a seq of email addresses to notify when build is done
                     actions      ;; a seq of actions
                     action-results
                     node         ;; Map containing keys required by ec2/start-instance
                     lb-name      ;; name of the load-balancer to use
                     continue?    ;; if true, continue running the build. Failed actions will set this to false
                     ]
              :as args}]
  (let [project (project/get-by-url! vcs_url)
        build_num (or build_num (project/next-build-num project))]
    (ref (merge build-defaults
                args
                {:build_num build_num
                 :_project_id (-> project :_id)})
         :validator validate!)))

(defn extend-group-with-revision
  "update the build, setting the pallet group-name to extends the
  existing group with the VCS revision."
  [build]
  (dosync
   (alter build
          assoc-in [:group :group-name] (keyword (.toLowerCase (format "%s-%s" (project-name build) (-> @build :vcs_revision))))))
  build)

(defn build-name
  ([build]
     (build-name (project-name build) (-> @build :build_num)))
  ([project-name build-num]
     (str project-name "-" build-num)))

(defn checkout-dir
  "Directory where the build will be checked out, on the build box."
  ([build]
     (checkout-dir (project-name build) (-> @build :build_num)))
  ([project-name build-num]
     (str/replace (build-name project-name build-num) #" " "-")))

(defn successful? [build]
  (and (-> @build :stop_time)
       (-> @build :continue?)))

(defn log-ns
  "returns the name of the logger to use for this build "
  [build]
  (symbol (str "circle.build." (project-name build) "-" (-> @build :build_num))))

(def ^:dynamic *log-ns* nil) ;; contains the name of the logger for the current build

(defn ssh-build-log
  "This is a different function from the normal build log because 1)
  ssh/handle-out won't pass format arguments. 2) if the string does happen to
  contain a %s, we don't want format throwing because we have a %s and
  no extra args"
  [s]
  (when *log-ns*
    (log *log-ns* :info nil s)))

(defn ssh-build-log-error [s]
  (when *log-ns*
    (log *log-ns* :error nil s)))

(defmacro with-build-log [build & body]
  `(binding [*log-ns* (log-ns ~build)
             ssh/handle-out ssh-build-log
             ssh/handle-err ssh-build-log-error]
     ~@body))

(defn build-log [message & args]
  (when *log-ns*
    (log *log-ns* :info nil (apply format message args))))

(defn build-log-error [message & args]
  (when *log-ns*
    (log *log-ns* :error nil (apply format message args))))

(defn build-with-instance-id
  "Returns the build from the DB with the given instance-id"
  [id]
  (mongo/fetch-one build-coll :where {:instance-ids id}))

(defn ssh
  "Opens a terminal window that SSHs into instance with the provided id.

Assumes:
  1) the instance was started by a build
  2) the build is in the DB
  3) the instance is still running
  4) this clojure process is on OSX"

  [instance-id]
  (let [build (build-with-instance-id instance-id)
        ssh-private-key (-> build :node :private-key)
        username (-> build :node :username)
        ip-addr (-> build :node :ip-addr)
        key-temp-file (fs/tempfile "ssh")
        _ (spit key-temp-file ssh-private-key)
        _ (fs/chmod "-r" key-temp-file)
        _ (fs/chmod "u+r" key-temp-file)
        ssh-cmd (format "ssh -i %s %s@%s" key-temp-file username ip-addr)
        tell-cmd (format "'tell app \"Terminal\" \ndo script \"%s\"\n end tell'" ssh-cmd)]
    (sh/shq (osascript -e ~tell-cmd))))

Fix build/project-name, for projects that don't have a project name in the DB


(ns clj-money.core
  (:require [clojure.string :as string]
            [reagent.core :as r]
            [reagent.cookies :as cookies]
            [secretary.core :as secretary :include-macros true]
            [accountant.core :as accountant]
            [clj-money.inflection :refer [humanize]]
            [clj-money.state :refer [app-state
                                     current-user
                                     current-entity
                                     logout]]
            [clj-money.notifications :as notify]
            [clj-money.html :as html]
            [clj-money.views.entities]
            [clj-money.views.imports]
            [clj-money.views.commodities]
            [clj-money.views.accounts]
            [clj-money.views.transactions]
            [clj-money.views.users]
            [clj-money.views.budgets]
            [clj-money.views.reports]
            [clj-money.views.dashboard :refer [dashboard]]
            [clj-money.api.entities :as entities]
            [clj-money.dom :refer [app-element]]
            [clj-money.bootstrap :as bootstrap]
            [clj-money.api.users :as users]))

(defn home-page []
  [:div.jumbotron.mt-3
   [:h1.display-5 "clj-money"]
   [:p "This is a double-entry accounting application that aims to be available anywhere."]])

(secretary/defroute "/" []
    (swap! app-state assoc :page (if @current-user
                                   #'dashboard
                                   #'home-page)))

(defn- nil-page []
  (html/space))

(defn- entity->nav-item
  [{:keys [id name] :as entity}]
  {:id id
   :caption name
   :on-click (fn []
               (let [page (get-in @app-state [:page])]
                 (swap! app-state assoc :page #'nil-page)
                 (js/setTimeout
                     #(swap! app-state assoc
                             :current-entity entity
                             :page page)
                     5)))})

(def authenticated-nav-items
  [{:id :commodities}
   {:id :accounts}
   {:id :budgets}
   {:id :reports
    :tool-tip "Click here to view reports"}])

(defn- assoc-if-nil
  [m k v]
  (if (get-in m [k])
    m
    (assoc m k v)))

(defn- nav-items
  [current-user current-entity active-nav]
  (if current-user
    (if current-entity
      (map (fn [{:keys [id] :as item}]
             (-> item
                 (assoc-if-nil :caption (humanize id))
                 (assoc-if-nil :url (str "/" (name id)))
                 (assoc-if-nil :active? (= id active-nav))
                 (assoc-if-nil :tool-tip (str "Click here to manage "
                                              (humanize id)
                                              "."))))
           authenticated-nav-items)
      [])
    [{:id :login
      :url "/login"
      :caption "Login"
      :tool-top "Click here to sign into the system"}]))

(defn- secondary-nav-items
  [current-user entities current-entity]
  (when current-user
    (let [items (if (seq entities)
                  [{:id :entities
                    :role :dropdown
                    :caption (:name current-entity)
                    :children (concat (map entity->nav-item
                                           entities)
                                      [{:role :separator
                                        :id "entity-separator"}
                                       {:id "manage-entities"
                                        :url "/entities"
                                        :caption "Manage Entities"
                                        :tool-tip "Click here to manage your entities."}
                                       {:id "manage-imports"
                                        :url "/imports"
                                        :caption "Manage Imports"
                                        :tool-tip "Click here to manage your imports."}])}]
                  [])]
      (concat items
              [{:id :current-user
                :caption (->> ((juxt :first-name :last-name) current-user)
                              (string/join " "))}
               {:id :logout
                :caption "Logout"
                :on-click (fn []
                            (logout)
                            (cookies/remove! :auth-token)
                            (secretary/dispatch! "/"))}]))))

(defn- nav []
  (let [active-nav (r/cursor app-state [:active-nav])
        entities (r/cursor app-state [:entities])]
    (fn []
      (let [items (nav-items @current-user @current-entity @active-nav)
            secondary-items (secondary-nav-items @current-user @entities @current-entity)]
        (bootstrap/navbar
          {:title "clj-money"
           :title-url "/"
           :items items
           :secondary-items secondary-items})))))

(defn- alerts []
  (fn []
    (when (seq @notify/notifications)
      [:div#alerts
       (doall (for [n @notify/notifications]
                (bootstrap/alert n #(notify/unnotify n))))])))

(defn- current-page []
  (let [page (r/cursor app-state [:page])]
    (fn []
      [:div
       [nav]
       [:div.container
        [alerts]
        [@page]]])))

(defn mount-root []
  (let [mounted? (r/cursor app-state [:mounted?])]
    (when-not @mounted?
      (swap! app-state assoc :mounted? true :page #'home-page)
      (r/render [current-page] (app-element)))))

(defn- set-default-entity
  [state entity]
  (if entity
    (assoc state :current-entity entity)
    (dissoc state :current-entity)))

(defn- sign-in-from-cookie []
  (when-not @current-user
    (when-let [auth-token (cookies/get :auth-token)]
      (swap! app-state assoc :auth-token auth-token)
      (users/me
        #(swap! app-state assoc :current-user %)
        (notify/danger-fn "Unable to get information for the user: %s"))
      (entities/select
        (fn [[entity :as result]]
          (swap! app-state (fn [s]
                             (-> s
                                 (assoc :entities result)
                                 (set-default-entity entity))))
          (if entity
            (secretary/dispatch! "/")
            (secretary/dispatch! "/entities")))
        (notify/danger-fn "Unable to get the entities: %s")))))

(defn init! []
  (accountant/configure-navigation!
    {:nav-handler #(secretary/dispatch! %)
     :path-exists? #(secretary/locate-route %)})
  (accountant/dispatch-current!)
  (sign-in-from-cookie)
  (mount-root))

(init!)

(ns clj-money.core
  (:require [clojure.string :as string]
            [reagent.core :as r]
            [reagent.cookies :as cookies]
            [secretary.core :as secretary :include-macros true]
            [accountant.core :as accountant]
            [clj-money.inflection :refer [humanize]]
            [clj-money.state :refer [app-state
                                     current-user
                                     current-entity
                                     logout]]
            [clj-money.notifications :as notify]
            [clj-money.html :as html]
            [clj-money.views.entities]
            [clj-money.views.imports]
            [clj-money.views.commodities]
            [clj-money.views.accounts]
            [clj-money.views.transactions]
            [clj-money.views.users]
            [clj-money.views.budgets]
            [clj-money.views.reports]
            [clj-money.views.dashboard :refer [dashboard]]
            [clj-money.api.entities :as entities]
            [clj-money.dom :refer [app-element]]
            [clj-money.bootstrap :as bootstrap]
            [clj-money.api.users :as users]))

(defn home-page []
  [:div.jumbotron.mt-3
   [:h1.display-5 "clj-money"]
   [:p "This is a double-entry accounting application that aims to be available anywhere."]
   [:a#login.btn.btn-light {:href "/auth/google/start"
                              :title "Click here to sign in with a Google account"}
    (html/google-g)
    [:span "Sign in with Google"]]])

(secretary/defroute "/" []
    (swap! app-state assoc :page (if @current-user
                                   #'dashboard
                                   #'home-page)))

(defn- nil-page []
  (html/space))

(defn- entity->nav-item
  [{:keys [id name] :as entity}]
  {:id id
   :caption name
   :on-click (fn []
               (let [page (get-in @app-state [:page])]
                 (swap! app-state assoc :page #'nil-page)
                 (js/setTimeout
                     #(swap! app-state assoc
                             :current-entity entity
                             :page page)
                     5)))})

(def authenticated-nav-items
  [{:id :commodities}
   {:id :accounts}
   {:id :budgets}
   {:id :reports
    :tool-tip "Click here to view reports"}])

(defn- assoc-if-nil
  [m k v]
  (if (get-in m [k])
    m
    (assoc m k v)))

(defn- nav-items
  [current-user current-entity active-nav]
  (if current-user
    (if current-entity
      (map (fn [{:keys [id] :as item}]
             (-> item
                 (assoc-if-nil :caption (humanize id))
                 (assoc-if-nil :url (str "/" (name id)))
                 (assoc-if-nil :active? (= id active-nav))
                 (assoc-if-nil :tool-tip (str "Click here to manage "
                                              (humanize id)
                                              "."))))
           authenticated-nav-items)
      [])
    [{:id :login
      :url "/login"
      :caption "Login"
      :tool-top "Click here to sign into the system"}]))

(defn- secondary-nav-items
  [current-user entities current-entity]
  (when current-user
    (let [items (if (seq entities)
                  [{:id :entities
                    :role :dropdown
                    :caption (:name current-entity)
                    :children (concat (map entity->nav-item
                                           entities)
                                      [{:role :separator
                                        :id "entity-separator"}
                                       {:id "manage-entities"
                                        :url "/entities"
                                        :caption "Manage Entities"
                                        :tool-tip "Click here to manage your entities."}
                                       {:id "manage-imports"
                                        :url "/imports"
                                        :caption "Manage Imports"
                                        :tool-tip "Click here to manage your imports."}])}]
                  [])]
      (concat items
              [{:id :current-user
                :caption (->> ((juxt :first-name :last-name) current-user)
                              (string/join " "))}
               {:id :logout
                :caption "Logout"
                :on-click (fn []
                            (logout)
                            (cookies/remove! :auth-token)
                            (secretary/dispatch! "/"))}]))))

(defn- nav []
  (let [active-nav (r/cursor app-state [:active-nav])
        entities (r/cursor app-state [:entities])]
    (fn []
      (let [items (nav-items @current-user @current-entity @active-nav)
            secondary-items (secondary-nav-items @current-user @entities @current-entity)]
        (bootstrap/navbar
          {:title "clj-money"
           :title-url "/"
           :items items
           :secondary-items secondary-items})))))

(defn- alerts []
  (fn []
    (when (seq @notify/notifications)
      [:div#alerts
       (doall (for [n @notify/notifications]
                (bootstrap/alert n #(notify/unnotify n))))])))

(defn- current-page []
  (let [page (r/cursor app-state [:page])]
    (fn []
      [:div
       [nav]
       [:div.container
        [alerts]
        [@page]]])))

(defn mount-root []
  (let [mounted? (r/cursor app-state [:mounted?])]
    (when-not @mounted?
      (swap! app-state assoc :mounted? true :page #'home-page)
      (r/render [current-page] (app-element)))))

(defn- set-default-entity
  [state entity]
  (if entity
    (assoc state :current-entity entity)
    (dissoc state :current-entity)))

(defn- sign-in-from-cookie []
  (when-not @current-user
    (when-let [auth-token (cookies/get :auth-token)]
      (swap! app-state assoc :auth-token auth-token)
      (users/me
        #(swap! app-state assoc :current-user %)
        (notify/danger-fn "Unable to get information for the user: %s"))
      (entities/select
        (fn [[entity :as result]]
          (swap! app-state (fn [s]
                             (-> s
                                 (assoc :entities result)
                                 (set-default-entity entity))))
          (if entity
            (secretary/dispatch! "/")
            (secretary/dispatch! "/entities")))
        (notify/danger-fn "Unable to get the entities: %s")))))

(defn init! []
  (accountant/configure-navigation!
    {:nav-handler #(secretary/dispatch! %)
     :path-exists? #(secretary/locate-route %)})
  (accountant/dispatch-current!)
  (sign-in-from-cookie)
  (mount-root))

(init!)

add google signin button to home page

add google signin button to home page


(ns ohack.core
  (:use [overtone.live]
        [overtone.inst.piano]
        [overtone.inst.sampled-piano]
        [overtone.synth.stringed])
  (:require [overtone.inst.synth :as synth]
            [clojure.string :as s]))

;; run M-x cider-jack-in to get started
;;
;; once started, move your cursor to the (ns ...) block above and hit
;; C-M-x to evaluate it and boot the supercollider server.  if your
;; sampled-piano samples are not cached, overtime will attempt to
;; download them and cache them now. once you see the prompt update with
;; the Overtone logo, you are good to go.

;; use odoc() to lookup function documentation in overtone outside of
;; this you should probably use doc() for the same purpose

;; get documentation for prn
(odoc prn)

;; get documentation for synth/ping
(odoc synth/ping)

;; get documentation for odoc
(odoc odoc)

;; so `synth` contains a bunch of instrument definitions that you can
;; use already. you can try them by calling e.g.
(synth/ping)

;; some of them will fade away after a while.
(synth/rise-fall-pad)

;; some of them don't
(synth/vintage-bass)

;; in which case, stop(), i.e. overtone.live/stop(), switches off all sounds
(stop)

;; tip: C-M-x evals the expression (to the outermost surrounding
;; expression!) that your cursor is /inside/, or /before/. To evaluate
;; the expression that your cursor is /immdiately after/, use C-x-e

;; other synths to try
(comment
  (synth/daf-bass)
  (synth/buzz)
  (synth/cs80lead)
  (synth/ticker)
  (synth/pad)
  (synth/bass)
  (synth/daf-bass)
  (synth/grunge-bass)
  (synth/ks1)

  (stop)
  )

;; now let's play a little melody
(let [beat-ms 250
      base-line [:D3 :A2 :A#2 :C3
                 :D3 :F3 :G3 :C4
                 :D4 :A3 :F3 :C3
                 :D3 :F2 :G2 :A#2]
      num-measures (* 1 (count base-line))
      ]
  (stop)
  (letfn [(play-it
            ;; first, define a recursive note player
            ([interval instrument values]
             (play-it (now) interval instrument values 0))
            ([time interval instrument values counter]
             ;; the counter is only used for this hack:
             ;; because vintage bass "plays" forever...
             ;; close the instrument's play envelope.
             ;; you can try commenting this out and hear
             ;; what happens.
             (when (= (mod counter 4) 0)
               (ctl instrument :gate 0))
             (if-not (empty? values)
               (let [value (first values)
                     next-time (+ time interval)]
                 (when value
                   ;; at() is basically overtone's scheduler
                   (at time (instrument value)))
                 ;; after the note plays, schedule another call at the
                 ;; later time
                 (apply-at next-time
                           play-it [next-time interval instrument (rest values) (inc counter)])))))]

    ;; baseline plays once per 4 notes
    (play-it (* 4 beat-ms)
             synth/vintage-bass
             ;; cycle the base line forever (but in reality, just for
             ;; `num-measures` times)
             (take num-measures (cycle (map note base-line))))

    (play-it beat-ms
             piano
             ;; concat the sets-of-4-note-chords into a single
             ;; seq of notes to send to play-it
             (apply concat
                    (take num-measures
                          ;; for each root note, use overtone's rand-chord
                          ;; to construct a 4-note chord that spans up to
                          ;; 24 degrees
                          (map (fn [root-note] (rand-chord root-note :major 4 24))
                               (cycle base-line)))))))

;; ok, let's get back to more basics and build up to other exciting things.
;; first, let's add a few imports.

;; playing with the guitar synth

;; Mark found this guitar-pick function
(guitar-pick (guitar) 0 0) ;; String 0 (Low E) Fret 0 (open)

;; we need a function that will play a sequence of notes; notes will
;; contain an arbitrarily long sequence of pairs of numbers denoting
;; `string-index` `fret-value`
(defn guitar-pick-note-sequence
  "play a sequence of notes [string fret] on instrument instrument
  spaced by interval milliseconds

  interval = milliseconds between each play
  noteseq = [[string-index-1 fret-index-1
              string-index-2 fret-index-2 ... ]]
  "
  [interval noteseq]
  (let [playguitar (partial guitar-pick (guitar))
        timeseq (range (now) (+ (now) (* interval (count noteseq))) interval)]
    (doseq [[string-fret-seq timeval] (map vector noteseq timeseq)]
      (doseq [[string fret] (partition 2 string-fret-seq)]
        (playguitar string fret timeval)))))

(def playguitar320
  (partial guitar-pick-note-sequence 320))  ;; 320ms delay between picked strings

(def everybody-hurts
 "
  ;; Guitar Tab for Everybody Hurts by REM
  ;;
  ;;       D                        G
  ;; E:5]--------2-----------2------------3-----------3-----[
  ;; B:4]------3---2-------3---3--------0---0-------0---0---[
  ;; G:3]----2-------2---2-------2----0-------0---0-------0-[
  ;; D:2]--0-----------0------------------------------------[
  ;; A:1]---------------------------------------------------[
  ;; E:0]---------------------------3-----------3-----------[
")

;; now we can play multiple notes at the same time
(playguitar320 [[0 3, 3 0, 4 0, 5 3]])

;; we're going to fetch the tab from
;; http://tabs.ultimate-guitar.com/t/tracy_chapman/fast_car_ver8_tab.htm
(def fast-car-html (slurp "http://tabs.ultimate-guitar.com/t/tracy_chapman/fast_car_ver8_tab.htm"))
;; verify we grabbed some html?
(print (.substring fast-car-html 2000 3000))
;; we're just going to extract the tab section by visual inspection...
(print
 (-> fast-car-html
     (.split "Tabbed by")
     second
     (.split "hammer-on")
     first))

add tab section extraction code print

add tab section extraction code print


(ns io.aviso.twixt.utils
  "Some re-usable utilities. This namespace should be considered unsupported.")

(defn transform-values
  "Transforms a map by passing each value through a provided function."
  [m f]
  (into {} (map (fn [[k v]] [k (f v)]) m)))

(declare merge-maps-recursively)

(defn- merge-values [l r]
  (cond
    ;; We know how to merge two maps together:
    (and (map? l) (map? r)) (merge-maps-recursively l r)
    ;; But we can't merge a map with a non-map
    (and (seq? l) (seq? r)) (concat l r)
    ;; In any other case the right (later) value replaces the left (earlier) value
    :else r))

(defn merge-maps-recursively
  "Merges any number of maps together, recursively. When merging values:
  - two maps are merged, recursively
  - two seqs are concatinated
  - one map and one non-map is an error
  - one seq and one non-seq is an error
  - otherwise, the 'right' value overwrites the 'left' value"
  [& maps]
  (apply merge-with merge-values maps))

(ns io.aviso.twixt.utils
  "Some re-usable utilities. This namespace should be considered unsupported.")

(defn transform-values
  "Transforms a map by passing each value through a provided function."
  [m f]
  (into {} (map (fn [[k v]] [k (f v)]) m)))

(declare merge-maps-recursively)

(defn- merge-values [l r]
  (cond
    ;; We know how to merge two maps together:
    (and (map? l) (map? r)) (merge-maps-recursively l r)
    ;; But we can't merge a map with a non-map
    (and (seq? l) (seq? r)) (concat l r)
    ;; In any other case the right (later) value replaces the left (earlier) value
    :else r))

(defn merge-maps-recursively
  "Merges any number of maps together, recursively. When merging values:
  - two maps are merged, recursively
  - two seqs are concatinated
  - otherwise, the 'right' value overwrites the 'left' value"
  [& maps]
  (apply merge-with merge-values maps))

Remove misleading comment

Remove misleading comment