(ns audio-utils.worker)

;;;; General interface for audio processing nodes in web workers

(defprotocol IWorkerAudioNode
  (connect [this destination])
  (disconnect [this])
  (process-audio [this data]))

(defn main-entry-node
  "Creates a ScriptProcessorNode in the main UI thread that
   forwards audio to a worker by posting a :worker-process-audio
   message to it whenever there is new audio to be processed."
  [worker ctx {:keys [buffer-size input-channels output-channels]
               :or   {buffer-size     4096
                      input-channels  1
                      output-channels 1}}]
  (doto (.createScriptProcessor ctx buffer-size
                                input-channels
                                output-channels)
    (aset "onaudioprocess"
          (fn [event]
            (let [input-buffer  (.-inputBuffer event)
                  output-buffer (.-outputBuffer event)
                  n-channels    (.-numberOfChannels input-buffer)
                  worker-data   (into-array (repeat n-channels #js []))]
              (dotimes [channel n-channels]
                (let [input-data  (.getChannelData input-buffer channel)
                      output-data (.getChannelData output-buffer channel)]
                  (dotimes [n (.-length input-data)]
                    (let [sample (aget input-data n)]
                      (aset output-data n sample)
                      (.push (aget worker-data channel) sample)))))
              (.postMessage worker (clj->js {:name :worker-process-audio
                                             :data worker-data})))))))

(defn worker-entry-node
  "Creates an IWorkerAudioNode in a worker that receives its audio
   data from the main UI thread via a :worker-process-audio message.
   It then forwards the audio to the next IWorkerAudioNode if
   there is one."
  []
  (let [next (atom nil)
        node (reify IWorkerAudioNode
               (connect [this destination]
                 (reset! next destination))
               (disconnect [this]
                 (reset! next nil))
               (process-audio [this data]
                 (when @next
                   (process-audio @next data))))]
    (set! (.-onmessage js/self)
          (fn [msg]
            (let [clj-msg (js->clj (.-data msg))
                  name    (keyword (clj-msg "name"))
                  data    (clj-msg "data")]
              (when (= name :worker-process-audio)
                (process-audio node data)))))
    node))

(defn worker-exit-node
  "Creates an IWorkerAudioNode that takes audio data from a previous
   IWorkerAudioNode and forwards it to the main UI thread via a
   :main-process-audio message."
  []
  (reify IWorkerAudioNode
    (connect [this destination])
    (disconnect [this])
    (process-audio [this data]
      (.postMessage js/self (clj->js {:name :main-process-audio
                                      :data data})))))

(defn main-exit-node
  [worker data-fn]
  (set! (.-onmessage worker)
        (fn [msg]
          (let [clj-msg (js->clj (.-data msg))
                name    (keyword (clj-msg "name"))
                data    (clj-msg "data")]
            (when (= name :main-process-audio)
              (when data-fn
                (data-fn data)))))))

(ns audio-utils.worker)

;;;; General interface for audio processing nodes in web workers

(defprotocol IWorkerAudioNode
  (connect [this destination])
  (disconnect [this])
  (process-audio [this data]))

(defn main-entry-node
  "Creates a ScriptProcessorNode in the main UI thread that
   forwards audio to a worker by posting a :worker-process-audio
   message to it whenever there is new audio to be processed."
  [worker ctx {:keys [buffer-size input-channels output-channels]
               :or   {buffer-size     4096
                      input-channels  1
                      output-channels 1}}]
  (doto (.createScriptProcessor ctx buffer-size
                                input-channels
                                output-channels)
    (aset "onaudioprocess"
          (fn [event]
            (let [input-buffer  (.-inputBuffer event)
                  output-buffer (.-outputBuffer event)
                  n-channels    (.-numberOfChannels input-buffer)
                  worker-data   (into-array (repeat n-channels #js []))]
              (dotimes [channel n-channels]
                (let [input-data  (.getChannelData input-buffer channel)
                      output-data (.getChannelData output-buffer channel)]
                  (dotimes [n (.-length input-data)]
                    (let [sample (aget input-data n)]
                      (aset output-data n sample)
                      (.push (aget worker-data channel) sample)))))
              (.postMessage worker (doto #js []
                                     (aset "name" "worker-process-audio")
                                     (aset "data" worker-data))))))))

(defn worker-entry-node
  "Creates an IWorkerAudioNode in a worker that receives its audio
   data from the main UI thread via a :worker-process-audio message.
   It then forwards the audio to the next IWorkerAudioNode if
   there is one."
  []
  (let [next (atom nil)
        node (reify IWorkerAudioNode
               (connect [this destination]
                 (reset! next destination))
               (disconnect [this]
                 (reset! next nil))
               (process-audio [this data]
                 (when @next
                   (process-audio @next data))))]
    (set! (.-onmessage js/self)
          (fn [msg]
            (let [name     (aget (.-data msg) "name")
                  data     (aget (.-data msg) "data")
                  clj-data (js->clj data)]
              (when (= name "worker-process-audio")
                (process-audio node clj-data)))))
    node))

(defn worker-exit-node
  "Creates an IWorkerAudioNode that takes audio data from a previous
   IWorkerAudioNode and forwards it to the main UI thread via a
   :main-process-audio message."
  []
  (reify IWorkerAudioNode
    (connect [this destination])
    (disconnect [this])
    (process-audio [this data]
      (.postMessage js/self (doto #js {}
                              (aset "name" "main-process-audio")
                              (aset "data" data))))))

(defn main-exit-node
  [worker data-fn]
  (set! (.-onmessage worker)
        (fn [msg]
          (let [name    (aget (.-data msg) "name")
                data    (aget (.-data msg) "data")]
            (when (= name "main-process-audio")
              (when data-fn
                (data-fn data)))))))

Use JavaScript data structures for communication with audio workers


(ns expound.problems-test
  (:require [clojure.test :as ct :refer [is testing deftest use-fixtures]]
            [clojure.spec.alpha :as s]
            [expound.problems :as problems]
            [expound.test-utils :as test-utils]
            [clojure.string :as string]
            [com.gfredericks.test.chuck.clojure-test :refer [checking]]
            [clojure.test.check.generators :as gen]
            [com.gfredericks.test.chuck :as chuck]
            [expound.paths :as paths] ;; TODO - remove
))

(def num-tests 100)

(use-fixtures :once
  test-utils/check-spec-assertions
  test-utils/instrument-all)

(defn get-args [& args] args)

(s/def :highlighted-value/nested-map-of (s/map-of keyword? (s/map-of keyword? keyword?)))

(s/def :highlighted-value/city string?)
(s/def :highlighted-value/address (s/keys :req-un [:highlighted-value/city]))
(s/def :highlighted-value/house (s/keys :req-un [:highlighted-value/address]))

(deftest highlighted-value
  (testing "atomic value"
    (is (= "\"Fred\"\n^^^^^^"
           (problems/highlighted-value
            {}
            {:expound/form "Fred"
             :expound/in []}))))
  (testing "value in vector"
    (is (= "[... :b ...]\n     ^^"
           (problems/highlighted-value
            {}
            {:expound/form [:a :b :c]
             :expound/in [1]}))))
  (testing "long, composite values are pretty-printed"
    (is (= (str "{:letters {:a \"aaaaaaaa\",
           :b \"bbbbbbbb\",
           :c \"cccccccd\",
           :d \"dddddddd\",
           :e \"eeeeeeee\"}}"
                #?(:clj  "\n          ^^^^^^^^^^^^^^^"
                   :cljs "\n          ^^^^^^^^^^^^^^^^"))
           ;; ^- the above works in clojure - maybe not CLJS?
           (problems/highlighted-value
            {}
            {:expound/form
             {:letters
              {:a "aaaaaaaa"
               :b "bbbbbbbb"
               :c "cccccccd"
               :d "dddddddd"
               :e "eeeeeeee"}}
             :expound/in [:letters]}))))
  (testing "args to function"
    (is (= "(1 ... ...)\n ^"
           (problems/highlighted-value
            {}
            {:expound/form (get-args 1 2 3)
             :expound/in [0]}))))
  (testing "show all values"
    (is (= "(1 2 3)\n ^"
           (problems/highlighted-value
            {:show-valid-values? true}
            {:expound/form (get-args 1 2 3)
             :expound/in [0]}))))

  (testing "special replacement chars are not used"
    (is (= "\"$ $$ $1 $& $` $'\"\n^^^^^^^^^^^^^^^^^^"
           (problems/highlighted-value
            {}
            (first
             (:expound/problems
              (problems/annotate
               (s/explain-data keyword? "$ $$ $1 $& $` $'"))))))))

  (testing "nested map-of specs"
    (is (= "{:a {:b 1}}\n        ^"
           (problems/highlighted-value
            {}
            (first
             (:expound/problems
              (problems/annotate
               (s/explain-data :highlighted-value/nested-map-of {:a {:b 1}})))))))
    (is (= "{:a {\"a\" ...}}\n     ^^^"
           (problems/highlighted-value
            {}
            (first
             (:expound/problems
              (problems/annotate
               (s/explain-data :highlighted-value/nested-map-of {:a {"a" :b}})))))))
    (is (= "{1 ...}\n ^"
           (problems/highlighted-value
            {}
            (first
             (:expound/problems
              (problems/annotate
               (s/explain-data :highlighted-value/nested-map-of {1 {:a :b}}))))))))

  (testing "nested keys specs"
    (is (= "{:address {:city 1}}\n                 ^"
           (problems/highlighted-value
            {}
            (first
             (:expound/problems
              (problems/annotate
               (s/explain-data :highlighted-value/house {:address {:city 1}})))))))
    (is (= "{:address {\"city\" \"Denver\"}}\n          ^^^^^^^^^^^^^^^^^"
           (problems/highlighted-value
            {}
            (first
             (:expound/problems
              (problems/annotate
               (s/explain-data :highlighted-value/house {:address {"city" "Denver"}})))))))
    (is (= "{\"address\" {:city \"Denver\"}}\n^^^^^^^^^^^^^^^^^^^^^^^^^^^^"
           (problems/highlighted-value
            {}
            (first
             (:expound/problems
              (problems/annotate
               (s/explain-data :highlighted-value/house {"address" {:city "Denver"}})))))))))

(deftest highlighted-value-on-alt
  (is (= "[... 0]\n     ^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (clojure.spec.alpha/alt :a int?
                                      :b (clojure.spec.alpha/spec (clojure.spec.alpha/cat :c int?)))
              [1 0]))))))))

(deftest highlighted-value-on-coll-of
  ;; sets
  (is (= "#{1 3 2 :a}\n        ^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              #{1 :a 2 3})))))))
  (is (= "#{:a}\n  ^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              #{:a})))))))

  ;; lists
  (is (= "(... :a ... ...)\n     ^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              '(1 :a 2 3))))))))
  (is (= "(:a)\n ^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              '(:a))))))))

  ;; vectors
  (is (= "[... :a ... ...]\n     ^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              [1 :a 2 3])))))))

  (is (= "[:a]\n ^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              [:a])))))))

    ;; maps
  (is (= "[1 :a]\n^^^^^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              {1 :a 2 3})))))))

  (is (= "[:a 1]\n^^^^^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              {:a 1}))))))))

(s/def :annotate-test/div-fn (s/fspec
                              :args (s/cat :x int? :y pos-int?)))
(defn my-div [x y]
  (assert (pos? (/ x y))))

(deftest annotate-test
  (is (= {:expound/in [0]
          :val '(0 1)
          :reason "Assert failed: (pos? (/ x y))"}
         (-> (s/explain-data (s/coll-of :annotate-test/div-fn) [my-div])
             problems/annotate
             :expound/problems
             first
             (select-keys [:expound/in :val :reason])))))

;; 1.9.562 doesn't implement map-entry?
(when-not #?(:clj false :cljs (= *clojurescript-version* "1.9.562"))
  (defn nth-value [form i]
    (let [seq (remove map-entry? (tree-seq coll? seq form))]
      (nth seq (mod i (count seq))))))

(when-not #?(:clj false :cljs (= *clojurescript-version* "1.9.562"))
  ;; TODO - move to paths
  (deftest paths-to-value-test
    (checking
     "value-in is inverse of paths-to-value"
     (chuck/times num-tests)
     [form test-utils/any-printable-wo-nan
      i gen/pos-int
      :let [x (nth-value form i)
            paths (paths/paths-to-value form x [] [])]]
     (is (not (empty? paths)))
     (doseq [path paths]
       (is (= x
              (problems/value-in form
                                 path)))))))

(ns expound.problems-test
  (:require [clojure.test :as ct :refer [is testing deftest use-fixtures]]
            [clojure.spec.alpha :as s]
            [expound.problems :as problems]
            [expound.test-utils :as test-utils]
            [clojure.string :as string]
            [com.gfredericks.test.chuck.clojure-test :refer [checking]]
            [clojure.test.check.generators :as gen]
            [com.gfredericks.test.chuck :as chuck]
            [expound.paths :as paths] ;; TODO - remove
))

(def num-tests 100)

(use-fixtures :once
  test-utils/check-spec-assertions
  test-utils/instrument-all)

(defn get-args [& args] args)

(s/def :highlighted-value/nested-map-of (s/map-of keyword? (s/map-of keyword? keyword?)))

(s/def :highlighted-value/city string?)
(s/def :highlighted-value/address (s/keys :req-un [:highlighted-value/city]))
(s/def :highlighted-value/house (s/keys :req-un [:highlighted-value/address]))

(deftest highlighted-value
  (testing "atomic value"
    (is (= "\"Fred\"\n^^^^^^"
           (problems/highlighted-value
            {}
            {:expound/form "Fred"
             :expound/in []}))))
  (testing "value in vector"
    (is (= "[... :b ...]\n     ^^"
           (problems/highlighted-value
            {}
            {:expound/form [:a :b :c]
             :expound/in [1]}))))
  (testing "long, composite values are pretty-printed"
    (is (= (str "{:letters {:a \"aaaaaaaa\",
           :b \"bbbbbbbb\",
           :c \"cccccccd\",
           :d \"dddddddd\",
           :e \"eeeeeeee\"}}"
                #?(:clj  "\n          ^^^^^^^^^^^^^^^"
                   :cljs "\n          ^^^^^^^^^^^^^^^^"))
           ;; ^- the above works in clojure - maybe not CLJS?
           (problems/highlighted-value
            {}
            {:expound/form
             {:letters
              {:a "aaaaaaaa"
               :b "bbbbbbbb"
               :c "cccccccd"
               :d "dddddddd"
               :e "eeeeeeee"}}
             :expound/in [:letters]}))))
  (testing "args to function"
    (is (= "(1 ... ...)\n ^"
           (problems/highlighted-value
            {}
            {:expound/form (get-args 1 2 3)
             :expound/in [0]}))))
  (testing "show all values"
    (is (= "(1 2 3)\n ^"
           (problems/highlighted-value
            {:show-valid-values? true}
            {:expound/form (get-args 1 2 3)
             :expound/in [0]}))))

  (testing "special replacement chars are not used"
    (is (= "\"$ $$ $1 $& $` $'\"\n^^^^^^^^^^^^^^^^^^"
           (problems/highlighted-value
            {}
            (first
             (:expound/problems
              (problems/annotate
               (s/explain-data keyword? "$ $$ $1 $& $` $'"))))))))

  (testing "nested map-of specs"
    (is (= "{:a {:b 1}}\n        ^"
           (problems/highlighted-value
            {}
            (first
             (:expound/problems
              (problems/annotate
               (s/explain-data :highlighted-value/nested-map-of {:a {:b 1}})))))))
    (is (= "{:a {\"a\" ...}}\n     ^^^"
           (problems/highlighted-value
            {}
            (first
             (:expound/problems
              (problems/annotate
               (s/explain-data :highlighted-value/nested-map-of {:a {"a" :b}})))))))
    (is (= "{1 ...}\n ^"
           (problems/highlighted-value
            {}
            (first
             (:expound/problems
              (problems/annotate
               (s/explain-data :highlighted-value/nested-map-of {1 {:a :b}}))))))))

  (testing "nested keys specs"
    (is (= "{:address {:city 1}}\n                 ^"
           (problems/highlighted-value
            {}
            (first
             (:expound/problems
              (problems/annotate
               (s/explain-data :highlighted-value/house {:address {:city 1}})))))))
    (is (= "{:address {\"city\" \"Denver\"}}\n          ^^^^^^^^^^^^^^^^^"
           (problems/highlighted-value
            {}
            (first
             (:expound/problems
              (problems/annotate
               (s/explain-data :highlighted-value/house {:address {"city" "Denver"}})))))))
    (is (= "{\"address\" {:city \"Denver\"}}\n^^^^^^^^^^^^^^^^^^^^^^^^^^^^"
           (problems/highlighted-value
            {}
            (first
             (:expound/problems
              (problems/annotate
               (s/explain-data :highlighted-value/house {"address" {:city "Denver"}})))))))))

(deftest highlighted-value-on-alt
  (is (= "[... 0]\n     ^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (clojure.spec.alpha/alt :a int?
                                      :b (clojure.spec.alpha/spec (clojure.spec.alpha/cat :c int?)))
              [1 0]))))))))

(deftest highlighted-value-on-coll-of
  ;; sets
  (is (= "#{1 3 2 :a}\n        ^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              #{1 :a 2 3})))))))
  (is (= "#{:a}\n  ^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              #{:a})))))))

  ;; lists
  (is (= "(... :a ... ...)\n     ^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              '(1 :a 2 3))))))))
  (is (= "(:a)\n ^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              '(:a))))))))

  ;; vectors
  (is (= "[... :a ... ...]\n     ^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              [1 :a 2 3])))))))

  (is (= "[:a]\n ^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              [:a])))))))

    ;; maps
  (is (= "[1 :a]\n^^^^^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              {1 :a 2 3})))))))

  (is (= "[:a 1]\n^^^^^^"
         (problems/highlighted-value
          {}
          (first
           (:expound/problems
            (problems/annotate
             (s/explain-data
              (s/coll-of integer?)
              {:a 1}))))))))

(s/def :annotate-test/div-fn (s/fspec
                              :args (s/cat :x int? :y pos-int?)))
(defn my-div [x y]
  (assert (pos? (/ x y))))

(deftest annotate-test
  (is (= {:expound/in [0]
          :val '(0 1)
          :reason "Assert failed: (pos? (/ x y))"}
         (-> (s/explain-data (s/coll-of :annotate-test/div-fn) [my-div])
             problems/annotate
             :expound/problems
             first
             (select-keys [:expound/in :val :reason])))))

;; map-entry? introduced in CLJS 1.10.238
(when-not #?(:clj false :cljs (contains? #{"1.9.562" "1.9.946"} *clojurescript-version* ))
  (defn nth-value [form i]
    (let [seq (remove map-entry? (tree-seq coll? seq form))]
      (nth seq (mod i (count seq))))))

(when-not #?(:clj false :cljs (contains? #{"1.9.562" "1.9.946"} *clojurescript-version* ))
  ;; TODO - move to paths
  (deftest paths-to-value-test
    (checking
     "value-in is inverse of paths-to-value"
     (chuck/times num-tests)
     [form test-utils/any-printable-wo-nan
      i gen/pos-int
      :let [x (nth-value form i)
            paths (paths/paths-to-value form x [] [])]]
     (is (not (empty? paths)))
     (doseq [path paths]
       (is (= x
              (problems/value-in form
                                 path)))))))

Exclude older CLJS versions from test

Exclude older CLJS versions from test


(ns github-changelog.core
  (:require [clojure.spec.alpha :as s]
            [github-changelog.config :as config]
            [github-changelog.conventional :as conventional]
            [github-changelog.core-spec :as core-spec]
            [github-changelog.git :as git]
            [github-changelog.github :as github]
            [github-changelog.semver :as semver]))

(defn assoc-semver [prefix {:keys [name] :as tag}]
  (assoc tag :version (semver/extract name prefix)))

(defn assoc-ranges [tags]
  (let [previous-shas (concat (map :sha (rest tags)) [nil])]
    (map #(assoc %1 :from %2) tags previous-shas)))

(defn parse-tags [tags prefix]
  (->> (map (partial assoc-semver prefix) tags)
       (filter :version)
       (sort-by :version semver/newer?)
       (assoc-ranges)))

(defn assoc-commits [git-repo {:keys [from sha] :as tag}]
  (assoc tag :commits (git/commits git-repo from sha)))

(defn map-commits [tags git-repo]
  (map (partial assoc-commits git-repo) tags))

(defn ^:no-gen load-tags [config]
  (let [git-repo (git/init config)
        prefix   (get config :tag-prefix "v")]
    (-> (git/tags git-repo)
        (parse-tags prefix)
        (map-commits git-repo))))

(s/fdef load-tags
  :args (s/cat :config ::config/config-map)
  :ret (s/* ::core-spec/tag))

(defn find-pull [pulls sha]
  (first (filter #(= (github/get-sha %) sha) pulls)))

(defn ^:no-gen assoc-pulls [pulls {:keys [commits] :as tag}]
  (->> commits
       (map (partial find-pull pulls))
       (remove nil?)
       (assoc tag :pulls)))

(s/fdef assoc-pulls
  :args (s/cat :pulls (s/* ::github/pull) :tag ::core-spec/tag)
  :ret ::core-spec/tag-with-pulls)

(defn ^:no-gen collect-tags [config]
  (let [pulls (github/fetch-pulls config)]
    (->> (load-tags config)
         (map (partial assoc-pulls pulls)))))

(s/fdef collect-tags
  :args (s/cat :config ::config/config-map)
  :ret (s/* ::core-spec/tag-with-pulls))

(defn ^:no-gen changelog
  "Fetches the changelog"
  [config]
  (->> (collect-tags config)
       (map (partial conventional/parse-changes config))))

(s/fdef changelog
  :args (s/cat :config ::config/config-map)
  :ret (s/* ::conventional/tag-with-changes))

(defn filter-tags [tags {:keys [last since until]}]
  (cond->> tags
    since (filter #(semver/newer? (:version %) since))
    until (filter #(not (semver/newer? (:version %) until)))
    last  (take last)))

(ns github-changelog.core
  (:require [clojure.spec.alpha :as s]
            [github-changelog.config :as config]
            [github-changelog.conventional :as conventional]
            [github-changelog.core-spec :as core-spec]
            [github-changelog.git :as git]
            [github-changelog.github :as github]
            [github-changelog.semver :as semver]))

(defn assoc-semver [prefix {:keys [name] :as tag}]
  (assoc tag :version (semver/extract name prefix)))

(defn assoc-ranges [tags]
  (let [previous-shas (concat (map :sha (rest tags)) [nil])]
    (map #(assoc %1 :from %2) tags previous-shas)))

(defn parse-tags [tags prefix]
  (->> (map (partial assoc-semver prefix) tags)
       (filter :version)
       (sort-by :version semver/newer?)
       (assoc-ranges)))

(defn assoc-commits [git-repo {:keys [from sha] :as tag}]
  (assoc tag :commits (git/commits git-repo from sha)))

(defn map-commits [tags git-repo]
  (map (partial assoc-commits git-repo) tags))

(defn ^:no-gen load-tags [config]
  (let [git-repo (git/init config)
        prefix   (get config :tag-prefix "v")]
    (-> (git/tags git-repo)
        (parse-tags prefix)
        (map-commits git-repo))))

(s/fdef load-tags
  :args (s/cat :config ::config/config-map)
  :ret (s/* ::core-spec/tag))

(defn find-pull [pulls sha]
  (first (filter #(= (github/get-sha %) sha) pulls)))

(defn ^:no-gen assoc-pulls [pulls {:keys [commits] :as tag}]
  (->> commits
       (keep (partial find-pull pulls))
       (assoc tag :pulls)))

(s/fdef assoc-pulls
  :args (s/cat :pulls (s/* ::github/pull) :tag ::core-spec/tag)
  :ret ::core-spec/tag-with-pulls)

(defn ^:no-gen collect-tags [config]
  (let [pulls (github/fetch-pulls config)]
    (->> (load-tags config)
         (map (partial assoc-pulls pulls)))))

(s/fdef collect-tags
  :args (s/cat :config ::config/config-map)
  :ret (s/* ::core-spec/tag-with-pulls))

(defn ^:no-gen changelog
  "Fetches the changelog"
  [config]
  (->> (collect-tags config)
       (map (partial conventional/parse-changes config))))

(s/fdef changelog
  :args (s/cat :config ::config/config-map)
  :ret (s/* ::conventional/tag-with-changes))

(defn filter-tags [tags {:keys [last since until]}]
  (cond->> tags
    since (filter #(semver/newer? (:version %) since))
    until (filter #(not (semver/newer? (:version %) until)))
    last  (take last)))

Use keep instead of map + remove

Use keep instead of map + remove

Co-Authored-By: Szabó Krisztián <509c28f63eb4b0a9fa210ded0c2640ef2f75a9c4@gmail.com>


(ns onyx.peer.log-version)

(def version "0.10.0-SNAPSHOT")

(defn check-compatible-log-versions! [cluster-version]
  (when-not (or (re-find #"-SNAPSHOT" version)
                 (= version cluster-version))
    (throw (ex-info "Incompatible versions of the Onyx cluster coordination log.
                     A new, distinct, :onyx/tenancy-id should be supplied when upgrading or downgrading Onyx."
                    {:cluster-version cluster-version
                     :peer-version version}))))

(ns onyx.peer.log-version)

(def version "0.10.0-SNAPSHOT")

(defn check-compatible-log-versions! [cluster-version]
  (when-not (or (re-find #"-" version)
                 (= version cluster-version))
    (throw (ex-info "Incompatible versions of the Onyx cluster coordination log.
                     A new, distinct, :onyx/tenancy-id should be supplied when upgrading or downgrading Onyx."
                    {:cluster-version cluster-version
                     :peer-version version}))))

Revert "Make alpha/beta/etc versions incompatible with each other."

This reverts commit ae9cd69e738069965b2a97784bb7b7fd833be8b6.


(defproject nomnomnom "0.5.0-SNAPSHOT"
  :dependencies [[org.clojure/clojure "1.1.0-master-SNAPSHOT"]
                 [rome/rome "0.9"]
                 [org.ccil.cowan.tagsoup/tagsoup "1.2"]]
  :namespaces [nom.nom.nom])

(defproject nomnomnom "0.5.0-SNAPSHOT"
  :dependencies [[org.clojure/clojure "1.1.0-master-SNAPSHOT"]
                 [rome/rome "0.9"]
                 [org.ccil.cowan.tagsoup/tagsoup "1.2"]]
  :main nom.nom.nom)

Add a :main clause to the sample's project.clj file.


;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2016-2019 Andrey Antukh <niwi@niwi.nz>

(ns uxbox.common.data
  "Data manipulation and query helper functions."
  (:refer-clojure :exclude [concat read-string])
  (:require [clojure.set :as set]
            #?(:cljs [cljs.reader :as r]
               :clj [clojure.edn :as r])))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Structures Manipulation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn dissoc-in
  [m [k & ks :as keys]]
  (if ks
    (if-let [nextmap (get m k)]
      (let [newmap (dissoc-in nextmap ks)]
        (if (seq newmap)
          (assoc m k newmap)
          (dissoc m k)))
      m)
    (dissoc m k)))

(defn concat
  [& colls]
  (loop [result (first colls)
         colls (rest colls)]
    (if (seq colls)
      (recur (reduce conj result (first colls))
             (rest colls))
      result)))

(defn enumerate
  ([items] (enumerate items 0))
  ([items start]
   (loop [idx start
          items items
          res []]
     (if (empty? items)
       res
       (recur (inc idx)
              (rest items)
              (conj res [idx (first items)]))))))

(defn seek
  ([pred coll]
   (seek pred coll nil))
  ([pred coll not-found]
   (reduce (fn [_ x]
             (if (pred x)
               (reduced x)
               not-found))
           not-found coll)))

(defn diff-maps
  [ma mb]
  (let [ma-keys (set (keys ma))
        mb-keys (set (keys mb))
        added (set/difference mb-keys ma-keys)
        removed (set/difference ma-keys mb-keys)
        both (set/intersection ma-keys mb-keys)]
    (concat
     (mapv #(vector :set % (get mb %)) added)
     (mapv #(vector :set % nil) removed)
     (loop [k (first both)
            r (rest both)
            rs []]
       (if k
         (let [vma (get ma k)
               vmb (get mb k)]
           (if (= vma vmb)
             (recur (first r) (rest r) rs)
             (recur (first r) (rest r) (conj rs [:set k vmb]))))
         rs)))))

(defn index-by
  "Return a indexed map of the collection keyed by the result of
  executing the getter over each element of the collection."
  [getter coll]
  (persistent!
   (reduce #(assoc! %1 (getter %2) %2) (transient {}) coll)))

(defn index-of
  [coll v]
  (loop [c (first coll)
         coll (rest coll)
         index 0]
    (if (nil? c)
      nil
      (if (= c v)
        index
        (recur (first coll)
               (rest coll)
               (inc index))))))

(defn remove-nil-vals
  "Given a map, return a map removing key-value
  pairs when value is `nil`."
  [data]
  (into {} (remove (comp nil? second) data)))

(defn without-keys
  "Return a map without the keys provided
  in the `keys` parameter."
  [data keys]
  (persistent!
   (reduce #(dissoc! %1 %2) (transient data) keys)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Parsing / Conversion
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- nan?
  [v]
  (not= v v))

(defn- impl-parse-integer
  [v]
  #?(:cljs (js/parseInt v 10)
     :clj (try
            (Integer/parseInt v)
            (catch Throwable e
              nil))))

(defn- impl-parse-double
  [v]
  #?(:cljs (js/parseFloat v)
     :clj (try
            (Double/parseDouble v)
            (catch Throwable e
              nil))))

(defn parse-integer
  ([v]
   (parse-integer v nil))
  ([v default]
   (let [v (impl-parse-integer v)]
     (if (or (nil? v) (nan? v))
       default
       v))))

(defn parse-double
  ([v]
   (parse-double v nil))
  ([v default]
   (let [v (impl-parse-double v)]
     (if (or (nil? v) (nan? v))
       default
       v))))

(defn read-string
  [v]
  (r/read-string v))

(defn coalesce-str
  [val default]
  (if (or (nil? val) (nan? val))
    default
    (str val)))

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2016-2019 Andrey Antukh <niwi@niwi.nz>

(ns uxbox.common.data
  "Data manipulation and query helper functions."
  (:refer-clojure :exclude [concat read-string])
  (:require [clojure.set :as set]
            #?(:cljs [cljs.reader :as r]
               :clj [clojure.edn :as r])))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Structures Manipulation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn dissoc-in
  [m [k & ks :as keys]]
  (if ks
    (if-let [nextmap (get m k)]
      (let [newmap (dissoc-in nextmap ks)]
        (if (seq newmap)
          (assoc m k newmap)
          (dissoc m k)))
      m)
    (dissoc m k)))

(defn concat
  [& colls]
  (loop [result (transient (first colls))
         colls (rest colls)]
    (if (seq colls)
      (recur (reduce conj! result (first colls))
             (rest colls))
      (persistent! result))))

(defn enumerate
  ([items] (enumerate items 0))
  ([items start]
   (loop [idx start
          items items
          res []]
     (if (empty? items)
       res
       (recur (inc idx)
              (rest items)
              (conj res [idx (first items)]))))))

(defn seek
  ([pred coll]
   (seek pred coll nil))
  ([pred coll not-found]
   (reduce (fn [_ x]
             (if (pred x)
               (reduced x)
               not-found))
           not-found coll)))

(defn diff-maps
  [ma mb]
  (let [ma-keys (set (keys ma))
        mb-keys (set (keys mb))
        added (set/difference mb-keys ma-keys)
        removed (set/difference ma-keys mb-keys)
        both (set/intersection ma-keys mb-keys)]
    (concat
     (mapv #(vector :set % (get mb %)) added)
     (mapv #(vector :set % nil) removed)
     (loop [k (first both)
            r (rest both)
            rs []]
       (if k
         (let [vma (get ma k)
               vmb (get mb k)]
           (if (= vma vmb)
             (recur (first r) (rest r) rs)
             (recur (first r) (rest r) (conj rs [:set k vmb]))))
         rs)))))

(defn index-by
  "Return a indexed map of the collection keyed by the result of
  executing the getter over each element of the collection."
  [getter coll]
  (persistent!
   (reduce #(assoc! %1 (getter %2) %2) (transient {}) coll)))

(defn index-of
  [coll v]
  (loop [c (first coll)
         coll (rest coll)
         index 0]
    (if (nil? c)
      nil
      (if (= c v)
        index
        (recur (first coll)
               (rest coll)
               (inc index))))))

(defn remove-nil-vals
  "Given a map, return a map removing key-value
  pairs when value is `nil`."
  [data]
  (into {} (remove (comp nil? second) data)))

(defn without-keys
  "Return a map without the keys provided
  in the `keys` parameter."
  [data keys]
  (persistent!
   (reduce #(dissoc! %1 %2) (transient data) keys)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Parsing / Conversion
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- nan?
  [v]
  (not= v v))

(defn- impl-parse-integer
  [v]
  #?(:cljs (js/parseInt v 10)
     :clj (try
            (Integer/parseInt v)
            (catch Throwable e
              nil))))

(defn- impl-parse-double
  [v]
  #?(:cljs (js/parseFloat v)
     :clj (try
            (Double/parseDouble v)
            (catch Throwable e
              nil))))

(defn parse-integer
  ([v]
   (parse-integer v nil))
  ([v default]
   (let [v (impl-parse-integer v)]
     (if (or (nil? v) (nan? v))
       default
       v))))

(defn parse-double
  ([v]
   (parse-double v nil))
  ([v default]
   (let [v (impl-parse-double v)]
     (if (or (nil? v) (nan? v))
       default
       v))))

(defn read-string
  [v]
  (r/read-string v))

(defn coalesce-str
  [val default]
  (if (or (nil? val) (nan? val))
    default
    (str val)))

:zap: Improve performance of `concat` operation.


(ns discuss.utils.common
  (:require [om.next :as om :refer-macros [defui]]
            [clojure.walk :refer [keywordize-keys]]
            [clojure.string :refer [trim trim-newline]]
            [cljs.spec.alpha :as s]
            [goog.string :as gstring]
            [cognitect.transit :as transit]
            [inflections.core :refer [plural]]
            [discuss.config :as config]
            [discuss.parser :as parser]))

(defn prefix-name
  "Create unique id for DOM elements."
  [name]
  (str config/project "-" name))

(s/def ::fn-and-val (s/tuple symbol? any?))
(s/def ::col-of-fn-and-vals (s/coll-of ::fn-and-val))

(defn build-transactions
  "Takes a list of vectors containing fns and values, which should be transacted with the reconciler.

  Example: (build-transactions [['discussion/items items] ['discussion/bubbles bubbles]])
  => ((discussion/items {:value [...]})
      (discussion/bubbles {:value [...]}))"
  [col-of-fn-and-vals]
  (vec (for [[f value] col-of-fn-and-vals]
         `(~f {:value ~value}))))
(s/fdef build-transactions
  :args (s/cat :col-of-vectors ::col-of-fn-and-vals)
  :ret (s/coll-of list?))

(defn store-multiple-values-to-app-state!
  "Creates one big transaction of multiple mutation functions and the new values,
  which should be assigned to them.

  Example: (store-multiple-values-to-app-state! [['discussion/items items] ['discussion/bubbles bubbles]])"
  [col-of-fn-and-vals]
  (om/transact! parser/reconciler (build-transactions col-of-fn-and-vals)))
(s/fdef store-multiple-values-to-app-state!
  :args (s/cat :col-of-vectors ::col-of-fn-and-vals))

(defn store-to-app-state!
  "Use reconciler to do a transaction on the app-state.

  Example: (store-to-app-state! 'foo \"bar\")"
  [field value]
  (store-multiple-values-to-app-state! [[field value]]))
(s/fdef store-to-app-state!
  :args (s/cat :field symbol? :value any?))

(defn load-from-app-state
  "Load data from application state."
  [field]
  (field @(om/app-state parser/reconciler)))
(s/fdef load-from-app-state
  :args (s/cat :field keyword?))

;; -----------------------------------------------------------------------------
;; CLJS <--> JS
(defn clj->json
  "Convert CLJS to valid JSON."
  [col]
  (.stringify js/JSON (clj->js col)))

(defn json->clj
  "Use cognitect's transit reader for json to convert it to proper Clojure data
  structures."
  [response]
  (cond
    (string? response) (let [r (transit/reader :json)]
                         (keywordize-keys (transit/read r response)))
    :default (keywordize-keys response)))

(defn str->int
  "Convert String to Integer."
  [s]
  (let [converted (js/parseInt s)]
    (when-not (js/isNaN converted)
      converted)))

;;;; React Key Generation
(defn get-unique-key
  "Return unique react-key."
  []
  (str (prefix-name "unique-react-key-") (random-uuid)))

(defn unique-key-dict
  "Generate a dictionary with unique key."
  []
  {:key (get-unique-key)})

(defn unique-react-key-dict
  "Generate a dictionary with unique react-key."
  []
  {:react-key (get-unique-key)})

(defn merge-react-key
  "Get a unique key, create a small map with :react-key property and merge it
  with the given collection."
  [col]
  (merge (unique-key-dict) col))

;;;;

(defn get-items
  "Returns list of items from the discussion."
  []
  (load-from-app-state :discussion/items))

(defn get-bubbles
  "Return message bubbles from DBAS."
  []
  (load-from-app-state :discussion/bubbles))

;;;; Getter
(defn get-nickname
  "Return the user's nickname, with whom she logged in."
  []
  (load-from-app-state :user/nickname))

(defn get-avatar
  "Return the URL of the user's avatar."
  []
  (load-from-app-state :user/avatar))

(defn get-token
  "Return the user's token for discussion system."
  []
  (load-from-app-state :user/token))

(defn get-issues
  "Returns list of dictionaries with all available issues."
  []
  (load-from-app-state :issue/list))

(defn get-issue
  "Return specific issue, matching by id or title."
  [issue]
  (cond
    (number? issue) (first (filter #(= (str->int (:uid %)) issue) (get-issues)))
    (string? issue) (first (filter #(= (:title %) issue) (get-issues)))))

;;;; Booleans
(defn logged-in?
  "Return true if user is logged in."
  []
  (load-from-app-state :user/logged-in?))

;;;; References
;; TODO Move to references/lib
(defn get-references
  "Returns a list of references which were received from the discussion system."
  []
  (load-from-app-state :references/all))

(defn get-reference
  "Returns a map matching a specific id. This id must be a number."
  ([id col] (first (filter #(= (str->int id) (:uid %)) col)))
  ([id] (get-reference id (get-references))))

;; Show error messages
(defn error?
  "Return boolean indicating if there are errors or not."
  []
  (not (empty? (load-from-app-state :layout/error))))

(defn error!
  "Set error message."
  ([msg]
   (store-to-app-state! 'layout/error msg))
  ([]
   (error! nil)))

(defn get-error
  "Return error message."
  []
  (load-from-app-state :layout/error))

;; Change views
(defn hide-add-form!
  "Hide the form which allows to add new content."
  []
  (store-to-app-state! 'layout/add? false))

(defn show-add-form!
  "Shows a form to enable user-added content."
  []
  (when (logged-in?)
    (store-to-app-state! 'layout/add? true)))

(defn current-view
  "Returns the current selected template, which should be visible in the
  main-content-view."
  []
  (load-from-app-state :layout/view))

(defn change-view-next!
  [view]
  (om/transact! parser/reconciler `[(layout/view {:value ~view})
                                     (layout/add? {:value false})]))

(defn next-view!
  "Set the next view, which should be loaded after the ajax call has finished."
  [view]
  (hide-add-form!)
  (store-to-app-state! 'layout/view-next view))

(defn change-to-next-view!
  "Set next view to current view. Falls back to default if there is no different
  next view."
  []
  (let [current-view (current-view)
        next-view (load-from-app-state :layout/next-template)]
    (if (= current-view next-view)
      (change-view-next! :default)
      (change-view-next! next-view))))

(defn save-current-and-change-view!
  "Saves the current view and changes to the next specified view. Used for the
  'close' button in some views."
  [view]
  (next-view! (current-view))
  (change-view-next! view))

;;;; Last-api
(defn last-api!
  "Keep last-api call. Useful to login and then re-request the url to jump to the
  same position in the discussion, but this time as a logged in user."
  [url]
  (when-not (empty? url)
    (store-to-app-state! 'api/last-call url)))

(defn get-last-api
  "Return url of last API call."
  []
  (load-from-app-state :api/last-call))

;;;; Generic Handlers
(defn loading?
  "Return boolean if app is currently loading content. Provide a boolean to
  change the app-state."
  ([] (load-from-app-state :layout/loading?))
  ([bool] (store-to-app-state! 'layout/loading? bool)))

(defn process-response
  "Generic success handler, which sets error handling and returns a cljs-compatible response."
  [response]
  (let [res (json->clj response)
        error (:error res)]
    (loading? false)
    (if (pos? (count error))
      (error! error)
      (do (error! nil)
          res))))

;;;; Selections
(defn get-selection
  "Return the stored selection of the user."
  []
  (load-from-app-state :selection/current))

(defn remove-selection!
  "Remove current selection for a 'clean' statement."
  []
  (store-to-app-state! 'selection/current nil))

;;;; String Stuff
(defn substring?
  "Evaluates if a substring is contained in the given string."
  [sub st]
  (not= (.indexOf st sub) -1))

(defn singular->plural
  "Return pluralized string of word if number is greater than one."
  [number word]
  (when (and (string? word)
             (or (pos? number)
                 (zero? number)))
    (if (not= 1 number)
      (plural word)
      word)))

(defn trim-and-normalize
  "Remove all surrounding whitespaces and reduce all 'inner' whitespaces to a
  single space."
  [str]
  (gstring/unescapeEntities
   (clojure.string/replace (trim-newline (trim str)) #"\s+" " ")))

;;;; CSS modifications
(defn toggle-class
  "Toggle CSS class of provided DOM element. A third paramenter as boolean can
  be provided to force removing or adding the class."
  ([dom-element class] (.classList/toggle dom-element class))
  ([dom-element class bool] (.classList/toggle dom-element class bool)))

(defn remove-class
  "Remove a specific class of a DOM element."
  [dom-element class]
  (toggle-class dom-element class false))

(defn add-class
  "Add a specific class to a DOM element."
  [dom-element class]
  (toggle-class dom-element class true))

;;;; Language
(defn language
  "Returns currently selected language."
  []
  (load-from-app-state :layout/lang))

(defn language-next!
  "Set new language. Should be a keyword."
  [lang]
  (store-to-app-state! 'layout/lang lang))

;;;; Other
(defn get-value-by-id
  "Return value of element matching the id."
  [id]
  (let [element (.getElementById js/document (prefix-name id))]
    (when element (.-value element))))

(defn log
  "Print argument as JS object to be accessible from the console."
  [arg]
  (.log js/console arg))

(defn filter-keys-by-namespace
  "Filter a collection of vectors by their namespaces.

  Example: (filter-keys-by-namespace [:foo/bar :bar/foo] \"foo\")
  => (:foo/bar)"
  [col keyword-namespace]
  (filter #(= keyword-namespace (namespace %)) col))

(s/fdef filter-keys-by-namespace
  :args (s/cat :col coll? :namespace any?)
  :ret coll?)

;; -----------------------------------------------------------------------------
;; Specs

(s/fdef change-view-next!
        :args (s/cat :view keyword?))

(s/fdef trim-and-normalize
        :args (s/cat :str string?)
        :ret string?
        :fn #(<= (-> % :ret count) (-> % :args :str count)))

(s/fdef language-next!
        :args (s/cat :lang keyword?))

(ns discuss.utils.common
  (:require [om.next :as om :refer-macros [defui]]
            [clojure.walk :refer [keywordize-keys]]
            [clojure.string :refer [trim trim-newline]]
            [cljs.spec.alpha :as s]
            [goog.string :as gstring]
            [cognitect.transit :as transit]
            [inflections.core :refer [plural]]
            [discuss.config :as config]
            [discuss.parser :as parser]))

(defn prefix-name
  "Create unique id for DOM elements."
  [name]
  (str config/project "-" name))

(s/def ::fn-and-val (s/tuple symbol? any?))
(s/def ::col-of-fn-and-vals (s/coll-of ::fn-and-val))

(defn build-transactions
  "Takes a list of vectors containing fns and values, which should be transacted with the reconciler.

  Example: (build-transactions [['discussion/items items] ['discussion/bubbles bubbles]])
  => ((discussion/items {:value [...]})
      (discussion/bubbles {:value [...]}))"
  [col-of-fn-and-vals]
  (vec (for [[f value] col-of-fn-and-vals]
         `(~f {:value ~value}))))
(s/fdef build-transactions
  :args (s/cat :col-of-vectors ::col-of-fn-and-vals)
  :ret (s/coll-of list?))

(defn store-multiple-values-to-app-state!
  "Creates one big transaction of multiple mutation functions and the new values,
  which should be assigned to them.

  Example: (store-multiple-values-to-app-state! [['discussion/items items] ['discussion/bubbles bubbles]])"
  [col-of-fn-and-vals]
  (om/transact! parser/reconciler (build-transactions col-of-fn-and-vals)))
(s/fdef store-multiple-values-to-app-state!
  :args (s/cat :col-of-vectors ::col-of-fn-and-vals))

(defn store-to-app-state!
  "Use reconciler to do a transaction on the app-state.

  Example: (store-to-app-state! 'foo \"bar\")"
  [field value]
  (store-multiple-values-to-app-state! [[field value]]))
(s/fdef store-to-app-state!
  :args (s/cat :field symbol? :value any?))

(defn load-from-app-state
  "Load data from application state."
  [field]
  (field @(om/app-state parser/reconciler)))
(s/fdef load-from-app-state
  :args (s/cat :field keyword?))

;; -----------------------------------------------------------------------------
;; CLJS <--> JS
(defn clj->json
  "Convert CLJS to valid JSON."
  [col]
  (.stringify js/JSON (clj->js col)))

(defn json->clj
  "Use cognitect's transit reader for json to convert it to proper Clojure data
  structures."
  [response]
  (cond
    (string? response) (let [r (transit/reader :json)]
                         (keywordize-keys (transit/read r response)))
    :default (keywordize-keys response)))

(defn str->int
  "Convert String to Integer."
  [s]
  (let [converted (js/parseInt s)]
    (when-not (js/isNaN converted)
      converted)))

;;;; React Key Generation
(defn get-unique-key
  "Return unique react-key."
  []
  (str (prefix-name "unique-react-key-") (random-uuid)))

(defn unique-key-dict
  "Generate a dictionary with unique key."
  []
  {:key (get-unique-key)})

(defn unique-react-key-dict
  "Generate a dictionary with unique react-key."
  []
  {:react-key (get-unique-key)})

(defn merge-react-key
  "Get a unique key, create a small map with :react-key property and merge it
  with the given collection."
  [col]
  (merge (unique-key-dict) col))

;;;;

(defn get-items
  "Returns list of items from the discussion."
  []
  (load-from-app-state :discussion/items))

(defn get-bubbles
  "Return message bubbles from DBAS."
  []
  (load-from-app-state :discussion/bubbles))

;;;; Getter
(defn get-nickname
  "Return the user's nickname, with whom she logged in."
  []
  (load-from-app-state :user/nickname))

(defn get-avatar
  "Return the URL of the user's avatar."
  []
  (load-from-app-state :user/avatar))

(defn get-token
  "Return the user's token for discussion system."
  []
  (load-from-app-state :user/token))

(defn get-issues
  "Returns list of dictionaries with all available issues."
  []
  (load-from-app-state :issue/list))

(defn get-issue
  "Return specific issue, matching by id or title."
  [issue]
  (cond
    (number? issue) (first (filter #(= (str->int (:uid %)) issue) (get-issues)))
    (string? issue) (first (filter #(= (:title %) issue) (get-issues)))))

;;;; Booleans
(defn logged-in?
  "Return true if user is logged in."
  []
  (load-from-app-state :user/logged-in?))

;;;; References
;; TODO Move to references/lib
(defn get-references
  "Returns a list of references which were received from the discussion system."
  []
  (load-from-app-state :references/all))

(defn get-reference
  "Returns a map matching a specific id. This id must be a number."
  ([id col] (first (filter #(= (str->int id) (:uid %)) col)))
  ([id] (get-reference id (get-references))))

;; Show error messages
(defn error?
  "Return boolean indicating if there are errors or not."
  []
  (seq (load-from-app-state :layout/error)))

(defn error!
  "Set error message."
  ([msg]
   (store-to-app-state! 'layout/error msg))
  ([]
   (error! nil)))

(defn get-error
  "Return error message."
  []
  (load-from-app-state :layout/error))

;; Change views
(defn hide-add-form!
  "Hide the form which allows to add new content."
  []
  (store-to-app-state! 'layout/add? false))

(defn show-add-form!
  "Shows a form to enable user-added content."
  []
  (when (logged-in?)
    (store-to-app-state! 'layout/add? true)))

(defn current-view
  "Returns the current selected template, which should be visible in the
  main-content-view."
  []
  (load-from-app-state :layout/view))

(defn change-view-next!
  [view]
  (om/transact! parser/reconciler `[(layout/view {:value ~view})
                                     (layout/add? {:value false})]))

(defn next-view!
  "Set the next view, which should be loaded after the ajax call has finished."
  [view]
  (hide-add-form!)
  (store-to-app-state! 'layout/view-next view))

(defn change-to-next-view!
  "Set next view to current view. Falls back to default if there is no different
  next view."
  []
  (let [current-view (current-view)
        next-view (load-from-app-state :layout/next-template)]
    (if (= current-view next-view)
      (change-view-next! :default)
      (change-view-next! next-view))))

(defn save-current-and-change-view!
  "Saves the current view and changes to the next specified view. Used for the
  'close' button in some views."
  [view]
  (next-view! (current-view))
  (change-view-next! view))

;;;; Last-api
(defn last-api!
  "Keep last-api call. Useful to login and then re-request the url to jump to the
  same position in the discussion, but this time as a logged in user."
  [url]
  (when (seq url)
    (store-to-app-state! 'api/last-call url)))

(defn get-last-api
  "Return url of last API call."
  []
  (load-from-app-state :api/last-call))

;;;; Generic Handlers
(defn loading?
  "Return boolean if app is currently loading content. Provide a boolean to
  change the app-state."
  ([] (load-from-app-state :layout/loading?))
  ([bool] (store-to-app-state! 'layout/loading? bool)))

(defn process-response
  "Generic success handler, which sets error handling and returns a cljs-compatible response."
  [response]
  (let [res (json->clj response)
        error (:error res)]
    (loading? false)
    (if (pos? (count error))
      (error! error)
      (do (error! nil)
          res))))

;;;; Selections
(defn get-selection
  "Return the stored selection of the user."
  []
  (load-from-app-state :selection/current))

(defn remove-selection!
  "Remove current selection for a 'clean' statement."
  []
  (store-to-app-state! 'selection/current nil))

;;;; String Stuff
(defn substring?
  "Evaluates if a substring is contained in the given string."
  [sub st]
  (not= (.indexOf st sub) -1))

(defn singular->plural
  "Return pluralized string of word if number is greater than one."
  [number word]
  (when (and (string? word)
             (or (pos? number)
                 (zero? number)))
    (if (not= 1 number)
      (plural word)
      word)))

(defn trim-and-normalize
  "Remove all surrounding whitespaces and reduce all 'inner' whitespaces to a
  single space."
  [str]
  (gstring/unescapeEntities
   (clojure.string/replace (trim-newline (trim str)) #"\s+" " ")))

;;;; CSS modifications
(defn toggle-class
  "Toggle CSS class of provided DOM element. A third paramenter as boolean can
  be provided to force removing or adding the class."
  ([dom-element class] (.classList/toggle dom-element class))
  ([dom-element class bool] (.classList/toggle dom-element class bool)))

(defn remove-class
  "Remove a specific class of a DOM element."
  [dom-element class]
  (toggle-class dom-element class false))

(defn add-class
  "Add a specific class to a DOM element."
  [dom-element class]
  (toggle-class dom-element class true))

;;;; Language
(defn language
  "Returns currently selected language."
  []
  (load-from-app-state :layout/lang))

(defn language-next!
  "Set new language. Should be a keyword."
  [lang]
  (store-to-app-state! 'layout/lang lang))

;;;; Other
(defn get-value-by-id
  "Return value of element matching the id."
  [id]
  (let [element (.getElementById js/document (prefix-name id))]
    (when element (.-value element))))

(defn log
  "Print argument as JS object to be accessible from the console."
  [arg]
  (.log js/console arg))

(defn filter-keys-by-namespace
  "Filter a collection of vectors by their namespaces.

  Example: (filter-keys-by-namespace [:foo/bar :bar/foo] \"foo\")
  => (:foo/bar)"
  [col keyword-namespace]
  (filter #(= keyword-namespace (namespace %)) col))

(s/fdef filter-keys-by-namespace
  :args (s/cat :col coll? :namespace any?)
  :ret coll?)

;; -----------------------------------------------------------------------------
;; Specs

(s/fdef change-view-next!
        :args (s/cat :view keyword?))

(s/fdef trim-and-normalize
        :args (s/cat :str string?)
        :ret string?
        :fn #(<= (-> % :ret count) (-> % :args :str count)))

(s/fdef language-next!
        :args (s/cat :lang keyword?))

Use idiomatic functions in lib

Use idiomatic functions in lib


(ns twitter-hashtags-visualizer.handler
  (:require [compojure.core :refer :all]
            [compojure.handler :as handler]
            [compojure.route :as route]
            [cheshire.core :as json]
            [amazonica.aws.dynamodbv2 :as dynamo]
            [hiccup.page :refer [html5 include-css include-js]]
            [environ.core :refer [env]]
            [clojure.java.jdbc :as jdbc])
  (:import com.mchange.v2.c3p0.ComboPooledDataSource))

(defn pool [spec]
  (let [cpds (doto (ComboPooledDataSource.)
               (.setDriverClass (:classname spec))
               (.setJdbcUrl (str "jdbc:" (:subprotocol spec) ":" (:subname spec)))
               (.setUser (:user spec))
               (.setPassword (:password spec))
               ;; expire excess connections after 30 minutes of inactivity:
               (.setMaxIdleTimeExcessConnections (* 30 60))
               ;; expire connections after 3 hours of inactivity:
               (.setMaxIdleTime (* 3 60 60)))]
    {:datasource cpds}))

(def db-spec {:classname (env :db-classname)
              :subprotocol (env :db-subprotocol)
              :subname (env :db-subname)
              :user (env :db-user)
              :password (env :db-password)})

(def pooled-db-spec (pool db-spec))

(def tags (atom {}))

(defn query-top-tags []
  (let [tags ["monkey" "cat" "horse" "pig" "football" "hockey" "skating" "golf"]]
    (map #(hash-map :tag % :count (rand-int 10)) tags)))

(defn update-tags []
  (swap! tags (fn [_] (query-top-tags))))

(defn poll-db []
  (update-tags)
  (Thread/sleep 5000)
  (poll-db))

(defn start-polling []
  (println "Polling each 5 seconds")
  (.start (Thread. poll-db)))

(defn json-response [data & [status]]
  {:status (or status 200)
   :headers {"Content-Type" "application/json"
             "Cache-Control" "public, max-age=0, nocache"}
   :body (json/generate-string data)})

(defn page []
  (let [title "Popular Twitter Tags"]
    (html5
      [:head
        [:title title]
        (include-css "main.css")
        (include-js "http://code.jquery.com/jquery-2.0.3.min.js"
                    "http://underscorejs.org/underscore.js"
                    "tags.js")]
      [:body
        [:h1 title]
        [:div {:class "tags-container"}]])))

(defroutes app-routes
  (GET "/" [] (page))
  (GET "/tags" [] (json-response @tags))
  (route/resources "/")
  (route/not-found "Not Found"))

(def app
  (handler/site app-routes))

(defn -main [& args]
  (try
    (println)
    (println "creating table")
    (jdbc/db-do-commands
     pooled-db-spec
     (jdbc/create-table-ddl :fruit
                            [:name "varchar(32)" "PRIMARY KEY"]
                            [:price :int]))
    (println "inserting fruit"
             (jdbc/insert! pooled-db-spec :fruit {:name "apple" :price 120}))
    (println (jdbc/query pooled-db-spec ["SELECT * FROM fruit WHERE price > ? ORDER BY price" 100]))
    (println "updating price"
             (jdbc/update! pooled-db-spec :fruit {:name "apple" :price 122} ["name = ?" "apple"]))
    (println (jdbc/query pooled-db-spec ["SELECT * FROM fruit WHERE price > ? ORDER BY price" 100]))
    (println "deleting fruit"
             (jdbc/delete! pooled-db-spec :fruit ["name = ?" "apple"]))
    (println (jdbc/query pooled-db-spec ["SELECT * FROM fruit WHERE price > ? ORDER BY price" 100]))
    (finally
      (println "dropping table")
      (jdbc/db-do-commands
       pooled-db-spec
       (jdbc/drop-table-ddl :fruit)))))

(comment
  ;; for testing
  (-main)
  )

(ns twitter-hashtags-visualizer.handler
  (:require [compojure.core :refer :all]
            [compojure.handler :as handler]
            [compojure.route :as route]
            [cheshire.core :as json]
            [amazonica.aws.dynamodbv2 :as dynamo]
            [hiccup.page :refer [html5 include-css include-js]]
            [environ.core :refer [env]]
            [clojure.java.jdbc :as jdbc])
  (:import com.mchange.v2.c3p0.ComboPooledDataSource))

(defn pool [spec]
  (let [cpds (doto (ComboPooledDataSource.)
               (.setDriverClass (:classname spec))
               (.setJdbcUrl (str "jdbc:" (:subprotocol spec) ":" (:subname spec)))
               (.setUser (:user spec))
               (.setPassword (:password spec))
               ;; expire excess connections after 30 minutes of inactivity:
               (.setMaxIdleTimeExcessConnections (* 30 60))
               ;; expire connections after 3 hours of inactivity:
               (.setMaxIdleTime (* 3 60 60)))]
    {:datasource cpds}))

(def db-spec {:classname (env :db-classname)
              :subprotocol (env :db-subprotocol)
              :subname (env :db-subname)
              :user (env :db-user)
              :password (env :db-password)})

(def pooled-db-spec (pool db-spec))

(def tags (atom {}))

(defn query-top-tags []
  (take 10 (jdbc/query pooled-db-spec
                       ["select * from tag_count where valid_to > current_timestamp"]
                       :row-fn #(select-keys % [:tag :count]))))

(defn update-tags []
  (swap! tags (fn [_] (query-top-tags))))

(defn poll-db []
  (update-tags)
  (Thread/sleep 5000)
  (poll-db))

(defn start-polling []
  (println "Polling each 5 seconds")
  (.start (Thread. poll-db)))

(defn json-response [data & [status]]
  {:status (or status 200)
   :headers {"Content-Type" "application/json"
             "Cache-Control" "public, max-age=0, nocache"}
   :body (json/generate-string data)})

(defn page []
  (let [title "Popular Twitter Tags"]
    (html5
      [:head
        [:title title]
        (include-css "main.css")
        (include-js "http://code.jquery.com/jquery-2.0.3.min.js"
                    "http://underscorejs.org/underscore.js"
                    "tags.js")]
      [:body
        [:h1 title]
        [:div {:class "tags-container"}]])))

(defroutes app-routes
  (GET "/" [] (page))
  (GET "/tags" [] (json-response @tags))
  (route/resources "/")
  (route/not-found "Not Found"))

(def app
  (handler/site app-routes))

(defn -main [& args]
  (try
    (println)
    (println "creating table")
    (jdbc/db-do-commands
     pooled-db-spec
     (jdbc/create-table-ddl :fruit
                            [:name "varchar(32)" "PRIMARY KEY"]
                            [:price :int]))
    (println "inserting fruit"
             (jdbc/insert! pooled-db-spec :fruit {:name "apple" :price 120}))
    (println (jdbc/query pooled-db-spec ["SELECT * FROM fruit WHERE price > ? ORDER BY price" 100]))
    (println "updating price"
             (jdbc/update! pooled-db-spec :fruit {:name "apple" :price 122} ["name = ?" "apple"]))
    (println (jdbc/query pooled-db-spec ["SELECT * FROM fruit WHERE price > ? ORDER BY price" 100]))
    (println "deleting fruit"
             (jdbc/delete! pooled-db-spec :fruit ["name = ?" "apple"]))
    (println (jdbc/query pooled-db-spec ["SELECT * FROM fruit WHERE price > ? ORDER BY price" 100]))
    (finally
      (println "dropping table")
      (jdbc/db-do-commands
       pooled-db-spec
       (jdbc/drop-table-ddl :fruit)))))

(comment
  ;; for testing
  (-main)
  )

Load tags from db.

Load tags from db.


(ns leiningen.git-version
  (:require [clojure.java.shell :refer [sh]]
            [clojure.string :as s]
            [leiningen.core.main :as lmain])
  (:import [java.util Date]))

(def timestamp-fmt "yyyyMMddhhmmss")

(defn formatted-timestamp
  [fmt t]
  (.format (doto (java.text.SimpleDateFormat. fmt java.util.Locale/US)
             (.setTimeZone (java.util.SimpleTimeZone. 0 "GMT")))
           t))

(defn get-git-version
  [path & [long-sha]]
  (let [shafmt (if long-sha "%H" "%h")
        fmt (str "--pretty=" shafmt ",%cd")
        {:keys [out exit err]} (sh "git" "log" "-1" fmt path)
        ;; Throw exception if error?
        [sha, datestr] (-> out s/trim (s/split #"," 2))
        ctime (Date. datestr)]
    {:ctime ctime :sha sha}))

(defn format-git-ver
  [gver fmt]
  (let [{:keys [ctime sha]} gver]
    (str "-" (formatted-timestamp fmt ctime) "-" sha)))

(defn ver-parse
  "Parses jar-path-like-string or artifact-version-string to find ctime and sha.
   Can handle cases in the range of:
     1.2.3-20120219223112-abc123f
     foo-1.2.3-20120219223112-abc123f
     /path/to/foo-1.2.3-20120219223112-abc123f19ea8d29b13.jar"
  [ver-str]
  (let [[_ ctime sha] (re-matches #".*-?([0-9]{14})-([a-f0-9]{5,40})(?:\.jar)?$" ver-str)]
    (when (and ctime sha)
      {:ctime ctime :sha sha})))

(defn dirty-wc?
  [path]
  (let [{:keys [out err exit]} (sh "git" "status" "--short" path)]
    (not (empty? out))))

(defn git-version
  "Usage:
    lein git-version [flags] [lein command ...]
      Runs lein command with a project version augmented with git
      version of the most recent change of this project directory.
      Flags include:
        :insanely-allow-dirty-working-copy - by default git-version
          refuses to handle a dirty working copy
        :no-upstream - by default git-version wants to see the current
          version reachable via an upstream repo
        :long-sha - uses a full length sha instead of the default
          short form
    lein git-version [:long-sha] :print
    lein git-version :parse <version-str>"
  [project & args]
  (let [[kstrs sargs] (split-with #(.startsWith % ":") args)
        kargset (set (map #(keyword (.substring % 1)) kstrs))
        long-sha (kargset :long-sha)
        gver (-> project :root (get-git-version long-sha))
        qual (format-git-ver gver timestamp-fmt)
        upfn #(str (s/replace % #"-SNAPSHOT" "") qual)
        nproj (update-in project [:version] upfn)
        nmeta (update-in (meta project) [:without-profiles :version] upfn)
        nnproj (with-meta nproj nmeta)]
    ;; TODO throw exception if upstream doesn't contain this commit :no-upstream
    (cond
     (:print kargset) (println (upfn (:version project)))
     (:parse kargset) (prn (ver-parse (first sargs)))
     :else (if (and (dirty-wc? (:root project))
                    (not (:insanely-allow-dirty-working-copy kargset)))
             (lmain/abort "Refusing to continue with dirty working copy. (Hint: Run 'git status')")
             (lmain/resolve-and-apply nnproj sargs)))))

(ns leiningen.git-version
  (:require [clojure.java.shell :refer [sh]]
            [clojure.string :as s]
            [leiningen.core.main :as lmain])
  (:import [java.util Date]))

(def timestamp-fmt "yyyyMMdd_hhmmss")

(defn formatted-timestamp
  [fmt t]
  (.format (doto (java.text.SimpleDateFormat. fmt java.util.Locale/US)
             (.setTimeZone (java.util.SimpleTimeZone. 0 "GMT")))
           t))

(defn get-git-version
  [path & [long-sha]]
  (let [shafmt (if long-sha "%H" "%h")
        fmt (str "--pretty=" shafmt ",%cd")
        {:keys [out exit err]} (sh "git" "log" "-1" fmt path)
        ;; Throw exception if error?
        [sha, datestr] (-> out s/trim (s/split #"," 2))
        ctime (Date. datestr)]
    {:ctime ctime :sha sha}))

(defn format-git-ver
  [gver fmt]
  (let [{:keys [ctime sha]} gver]
    (str "-" (formatted-timestamp fmt ctime) "-g" sha)))

(defn ver-parse
  "Parses jar-path-like-string or artifact-version-string to find ctime and sha.
   Can handle cases in the range of:
     1.2.3-20120219223112-abc123f
     1.2.3-20120219_223112-gabc123f
     foo-1.2.3-20120219223112-gabc123f
     foo-1.2.3-20120219_223112-abc123f
     /path/to/foo-1.2.3-20120219_223112-gabc123f19ea8d29b13.jar"
  [ver-str]
  (let [[_ ctime sha] (re-matches #".*-?([0-9]{8}_?[0-9]{6})-g?([a-f0-9]{4,40})(?:\.jar)?$" ver-str)
        ctime (s/replace ctime #"_" "")]
    (when (and ctime sha)
      {:ctime ctime :sha sha})))

(defn dirty-wc?
  [path]
  (let [{:keys [out err exit]} (sh "git" "status" "--short" path)]
    (not (empty? out))))

(defn git-version
  "Usage:
    lein git-version [flags] [lein command ...]
      Runs lein command with a project version augmented with git
      version of the most recent change of this project directory.
      Flags include:
        :insanely-allow-dirty-working-copy - by default git-version
          refuses to handle a dirty working copy
        :no-upstream - by default git-version wants to see the current
          version reachable via an upstream repo
        :long-sha - uses a full length sha instead of the default
          short form
    lein git-version [:long-sha] :print
    lein git-version :parse <version-str>"
  [project & args]
  (let [[kstrs sargs] (split-with #(.startsWith % ":") args)
        kargset (set (map #(keyword (.substring % 1)) kstrs))
        long-sha (kargset :long-sha)
        gver (-> project :root (get-git-version long-sha))
        qual (format-git-ver gver timestamp-fmt)
        upfn #(str (s/replace % #"-SNAPSHOT" "") qual)
        nproj (update-in project [:version] upfn)
        nmeta (update-in (meta project) [:without-profiles :version] upfn)
        nnproj (with-meta nproj nmeta)]
    ;; TODO throw exception if upstream doesn't contain this commit :no-upstream
    (cond
     (:print kargset) (println (upfn (:version project)))
     (:parse kargset) (prn (ver-parse (first sargs)))
     :else (if (and (dirty-wc? (:root project))
                    (not (:insanely-allow-dirty-working-copy kargset)))
             (lmain/abort "Refusing to continue with dirty working copy. (Hint: Run 'git status')")
             (lmain/resolve-and-apply nnproj sargs)))))

Include separator between date and time, pefix sha with "g" (following git-describe).


(ns loggerbotter.database
  (:require [clj-time.core :as time]))

(defprotocol Database
  (save-raw-data [db data] "Save unprocessed data to database")
  (save-meter-data [db data] "Save meter data to database")
  (get-meter-data [db after-date] "Fetch all meter data after given date"))

(defn- conj-to-key [d ks v]
  (update-in d ks
             (fnil #(conj % v) [])))

(defrecord InMemoryDatabase [db-atom]
  Database
  (save-raw-data [db data]
    (swap! (:db-atom db)
           #(conj-to-key % [:raw-log] data)))
  (save-meter-data [db data]
    (swap! (:db-atom db)
           #(conj-to-key % [:meters] data)))
  (get-meter-data [db after-date]
    (->> (deref (:db-atom db))
         :meters
         (filter #(time/before? after-date (:time %)))
         (sort-by :time))))

(defn new-memory-db []
  (->InMemoryDatabase (atom {})))

(ns loggerbotter.database
  (:require [clj-time [core :as time] [coerce :as time-coerce]]
            [cheshire [generate :refer [add-encoder]]]
            [com.ashafa.clutch :as clutch]))

(defprotocol Database
  (save-raw-data! [db data] "Save unprocessed data to database")
  (save-meter-data! [db data] "Save meter data to database")
  (get-meter-data [db after-date] "Fetch all meter data after given date"))

(defn- conj-to-key [d ks v]
  (update-in d ks
             (fnil #(conj % v) [])))

(defrecord InMemoryDatabase [db-atom]
  Database
  (save-raw-data! [db data]
    (swap! (:db-atom db)
           #(conj-to-key % [:raw-log] data)))
  (save-meter-data! [db data]
    (swap! (:db-atom db)
           #(conj-to-key % [:meters] data)))
  (get-meter-data [db after-date]
    (->> (deref (:db-atom db))
         :meters
         (filter #(time/before? after-date (:time %)))
         (sort-by :time))))

(defn create-memory-db []
  (->InMemoryDatabase (atom {})))

(defn- remove-data-older-than [coll date]
  (remove #(time/after? date (:time %)) coll))

(defn- remove-old-data-for-field [db field before-date]
  (update-in db [field]
             #(remove-data-older-than % before-date)))

(defn drop-old-data [memory-db before-date]
  (swap! (:db-atom memory-db)
         (fn [db]
           (reduce
             #(remove-old-data-for-field %1 %2 before-date)
             db [:meters :raw-log]))))

(add-encoder org.joda.time.DateTime
             (fn [dt json-generator]
               (.writeString json-generator
                             (str (time-coerce/to-string dt)))))

(defrecord CouchDatabase [db-url]
  Database
  (save-raw-data! [db data]
    (if (map? data)
      (clutch/put-document (:db-url db)
                           (into {:datatype "raw-log"} data))))
  (save-meter-data! [db data]
    (if (map? data)
      (clutch/put-document (:db-url db)
                           (into {:datatype "meter"} data))))
  (get-meter-data [db after-date]
    (->> (clutch/get-view (:db-url db) "meterdata" "by-time"
                          {:startkey (time-coerce/to-string after-date)})
         (map :value))))

(def meterdata-by-time-javascript
  "function(doc, req) {
    if (doc.time && doc.datatype === \"meter\") {
      emit(doc.time, doc);
    }
  }")

(def meterdata-javascript-views
  {:by-time {:map meterdata-by-time-javascript}})

(defn initialize-couchdb-db [db-url]
  (clutch/get-database db-url)
  (clutch/save-view db-url "meterdata"
                    [:javascript meterdata-javascript-views])
  (->CouchDatabase db-url))

(defrecord CachedDatabase [master cache]
  Database
  (save-raw-data! [db data]
    (do (save-raw-data! (:master db) data)
        (save-raw-data! (:cache db) data)))
  (save-meter-data! [db data]
    (do (save-meter-data! (:master db) data)
        (save-meter-data! (:cache db) data)))
  (get-meter-data [db after-date]
    (let [data (get-meter-data (:cache db) after-date)]
      (if (empty? data)
        (get-meter-data (:master db) after-date)
        data))))

Add API for storing data to CouchDB

Add API for storing data to CouchDB


(ns monkey-music.wrapper
  (:require [monkey-music.core :as c]
            [clojure.string :as string]))

(defn str* [s]
  (cond
    (nil? s) "<nil>"
    (= "" s) "<empty string>"
    :else s))

(defn throw-error [& msgs]
  (throw (js/Error. (apply str (map str* msgs)))))

(defn leaf-descendants [entity]
  (filter (comp nil? descendants) (descendants entity)))

(defn str->entity [entity s]
  (let [parsed-entity (keyword "monkey-music.core" s)]
    (if (isa? parsed-entity entity)
      parsed-entity
      (throw-error "Unknown " (name entity) ": " s ". Known " (name entity) "s: "
                   (string/join ", " (map name (leaf-descendants entity))) "."))))

(defn json->layout [layout legend]
  (->> layout
       (mapv vec)
       (mapv (partial mapv #(->> % (legend)
                                   (str->entity ::c/layoutable))))))

(defn json->level [{:strs [legend turns layout inventorySize]}]
  {:layout (json->layout layout legend)
   :inventory-size inventorySize
   :turns turns})

(defmulti json->command #(str->entity ::c/command (get % "command")))

(defmethod json->command ::c/move [{:strs [command team direction directions]}]
  (merge {:command ::c/move :team-name team}
         (if directions
           {:directions (map (partial str->entity ::c/direction) directions)}
           {:direction (str->entity ::c/direction direction)})))

(defmethod json->command ::c/use [{:strs [command team item]}]
  {:command ::c/use :team-name team :item (str->entity ::c/usable item)})

(defmethod json->command ::c/idle [{:strs [command team]}]
  {:command ::c/idle :team-name team})

(defmulti hint->json :hint)

(defmethod hint->json ::c/steal
  [{:keys [item from-team-name to-team-name]}]
  {"hint" "steal"
   "item" (name item)
   "fromTeam" from-team-name
   "toTeam" to-team-name})

(defmethod hint->json ::c/trigger-trap
  [{:keys [team-name]}]
  {"hint" "trigger-trap"
   "team" team-name})

(defmethod hint->json ::c/enter-tunnel
  [{:keys [item team-name from-position enter-position exit-position]}]
  {"hint" "enter-tunnel"
   "team" team-name
   "from" from-position
   "enter" enter-position
   "exit" exit-position})

(defmethod hint->json ::c/move-team
  [{:keys [team-name from-position to-position]}]
  {"hint" "move-team"
   "team" team-name
   "from" from-position
   "to" to-position})

(defn team->json [{:keys [position buffs inventory score]}]
  {"buffs" (into {} (for [[buff remaining-turns] buffs] [(name buff) remaining-turns]))
   "position" position
   "inventory" (map name inventory)
   "score" score})

(defn layoutable->str [layoutable]
  (if (isa? layoutable ::trap) "trap" (name layoutable)))

(defn layout->json [layout]
  (map (partial map layoutable->str) layout))

;;; Exports

(defn create-game-state [team-names json-level]
  (c/create-game-state team-names (json->level json-level)))

(defn validate-command
  [{:keys [teams]}
   {:keys [team-name] :as command}]
  (when-not (some (partial = team-name) (keys teams))
    (throw-error "team not part of game: " team-name))
  (when (isa? (:command command) ::c/move)
    (when (and (:directions command) (not (get-in (teams team-name) [:buffs ::c/speedy])))
      (throw-error "can only make multiple moves with speedy buff")))
  command)

(defn parse-command [state command]
  (validate-command state (json->command command)))

(defn teams->json [teams]
  (into {} (for [[team-name team] teams] [team-name (team->json team)])))

(defn trap->json [{:keys [team-name position]}]
  {"team" team-name "position" position})

(defn game-state->json-for-renderer
  [{:keys [layout base-layout inventory-size remaining-turns
           teams rendering-hints traps armed-traps] :as state}]
  {"layout" (layout->json layout)
   "baseLayout" (layout->json base-layout)
   "teams" (teams->json teams)
   "inventorySize" inventory-size
   "traps" (map trap->json traps)
   "armedTraps" (map trap->json armed-traps)
   "remainingTurns" remaining-turns
   "isGameOver" (c/game-over? state)
   "renderingHints" (map hint->json rendering-hints)})

(defn game-state->json-for-team
  [{:keys [layout inventory-size remaining-turns teams] :as state}
   team-name]
  (merge
    {"layout" (layout->json layout)
     "inventorySize" inventory-size
     "remainingTurns" remaining-turns
     "isGameOver" (c/game-over? state)}
    (team->json (teams team-name))))

(ns monkey-music.wrapper
  (:require [monkey-music.core :as c]
            [clojure.string :as string]))

(defn str* [s]
  (cond
    (nil? s) "<nil>"
    (= "" s) "<empty string>"
    :else s))

(defn throw-error [& msgs]
  (throw (js/Error. (apply str (map str* msgs)))))

(defn leaf-descendants [entity]
  (filter (comp nil? descendants) (descendants entity)))

(defn str->entity [entity s]
  (let [parsed-entity (keyword "monkey-music.core" s)]
    (if (isa? parsed-entity entity)
      parsed-entity
      (throw-error "Unknown " (name entity) ": " s ". Known " (name entity) "s: "
                   (string/join ", " (map name (leaf-descendants entity))) "."))))

(defn json->layout [layout legend]
  (->> layout
       (mapv vec)
       (mapv (partial mapv #(->> % (legend)
                                   (str->entity ::c/layoutable))))))

(defn json->level [{:strs [legend turns layout inventorySize]}]
  {:layout (json->layout layout legend)
   :inventory-size inventorySize
   :turns turns})

(defmulti json->command #(str->entity ::c/command (get % "command")))

(defmethod json->command ::c/move [{:strs [command team direction directions]}]
  (merge {:command ::c/move :team-name team}
         (if directions
           {:directions (map (partial str->entity ::c/direction) directions)}
           {:direction (str->entity ::c/direction direction)})))

(defmethod json->command ::c/use [{:strs [command team item]}]
  {:command ::c/use :team-name team :item (str->entity ::c/usable item)})

(defmethod json->command ::c/idle [{:strs [command team]}]
  {:command ::c/idle :team-name team})

(defmulti hint->json :hint)

(defmethod hint->json ::c/steal
  [{:keys [item from-team-name to-team-name]}]
  {"hint" "steal"
   "item" (name item)
   "fromTeam" from-team-name
   "toTeam" to-team-name})

(defmethod hint->json ::c/trigger-trap
  [{:keys [team-name]}]
  {"hint" "trigger-trap"
   "team" team-name})

(defmethod hint->json ::c/enter-tunnel
  [{:keys [item team-name from-position enter-position exit-position]}]
  {"hint" "enter-tunnel"
   "team" team-name
   "from" from-position
   "enter" enter-position
   "exit" exit-position})

(defmethod hint->json ::c/move-team
  [{:keys [team-name from-position to-position]}]
  {"hint" "move-team"
   "team" team-name
   "from" from-position
   "to" to-position})

(defn team->json [{:keys [position buffs inventory score]}]
  {"buffs" (into {} (for [[buff remaining-turns] buffs] [(name buff) remaining-turns]))
   "position" position
   "inventory" (map name inventory)
   "score" score})

(defn layout->json [layout]
  (map (partial map name) layout))

;;; Exports

(defn create-game-state [team-names json-level]
  (c/create-game-state team-names (json->level json-level)))

(defn validate-command
  [{:keys [teams]}
   {:keys [team-name] :as command}]
  (when-not (some (partial = team-name) (keys teams))
    (throw-error "team not part of game: " team-name))
  (when (isa? (:command command) ::c/move)
    (when (and (:directions command) (not (get-in (teams team-name) [:buffs ::c/speedy])))
      (throw-error "can only make multiple moves with speedy buff")))
  command)

(defn parse-command [state command]
  (validate-command state (json->command command)))

(defn teams->json [teams]
  (into {} (for [[team-name team] teams] [team-name (team->json team)])))

(defn trap->json [{:keys [team-name position]}]
  {"team" team-name "position" position})

(defn game-state->json-for-renderer
  [{:keys [layout base-layout inventory-size remaining-turns
           teams rendering-hints traps armed-traps] :as state}]
  {"layout" (layout->json layout)
   "baseLayout" (layout->json base-layout)
   "teams" (teams->json teams)
   "inventorySize" inventory-size
   "traps" (map trap->json traps)
   "armedTraps" (map trap->json armed-traps)
   "remainingTurns" remaining-turns
   "isGameOver" (c/game-over? state)
   "renderingHints" (map hint->json rendering-hints)})

(defn game-state->json-for-team
  [{:keys [layout inventory-size remaining-turns teams] :as state}
   team-name]
  (merge
    {"layout" (layout->json layout)
     "inventorySize" inventory-size
     "remainingTurns" remaining-turns
     "isGameOver" (c/game-over? state)}
    (team->json (teams team-name))))

Stop censoring our tunnels!

Stop censoring our tunnels!


(ns metabase.models.activity
  (:require [korma.core :refer :all, :exclude [defentity update]]
            [metabase.api.common :refer [*current-user-id*]]
            [metabase.db :refer :all]
            [metabase.events :as events]
            (metabase.models [dashboard :refer [Dashboard]]
                             [database :refer [Database]]
                             [interface :refer :all]
                             [table :refer [Table]]
                             [user :refer [User]])
            [metabase.util :as u]))

(defrecord ActivityFeedItemInstance []
  clojure.lang.IFn
  (invoke [this k]
    (get this k)))

(extend-ICanReadWrite ActivityFeedItemInstance :read :public-perms, :write :public-perms)

(defentity Activity
           [(table :activity)
            (types :details :json, :topic :keyword)]

           (pre-insert [_ {:keys [details] :as activity}]
                       (let [defaults {:timestamp (u/new-sql-timestamp)
                                       :details {}}]
                         (merge defaults activity)))

           (post-select [_ {:keys [user_id database_id table_id] :as activity}]
                        (-> (map->ActivityFeedItemInstance activity)
                            (assoc :user (delay (User user_id)))
                            (assoc :database (delay (-> (Database database_id)
                                                        (select-keys [:id :name :description]))))
                            (assoc :table (delay (-> (Table table_id)
                                                     (select-keys [:id :name :description])))))))

(extend-ICanReadWrite ActivityEntity :read :public-perms, :write :public-perms)

(ns metabase.models.activity
  (:require [korma.core :refer :all, :exclude [defentity update]]
            [metabase.api.common :refer [*current-user-id*]]
            [metabase.db :refer :all]
            [metabase.events :as events]
            (metabase.models [dashboard :refer [Dashboard]]
                             [database :refer [Database]]
                             [interface :refer :all]
                             [table :refer [Table]]
                             [user :refer [User]])
            [metabase.util :as u]))

(defrecord ActivityFeedItemInstance []
  clojure.lang.IFn
  (invoke [this k]
    (get this k)))

(extend-ICanReadWrite ActivityFeedItemInstance :read :public-perms, :write :public-perms)

(defentity Activity
           [(table :activity)
            (types :details :json, :topic :keyword)]

           (pre-insert [_ {:keys [details] :as activity}]
                       (let [defaults {:timestamp (u/new-sql-timestamp)
                                       :details {}}]
                         (merge defaults activity)))

           (post-select [_ {:keys [user_id database_id table_id] :as activity}]
                        (-> (map->ActivityFeedItemInstance activity)
                            (assoc :user (delay (User user_id)))
                            (assoc :database (delay (-> (Database database_id)
                                                        (select-keys [:id :name :description]))))
                            (assoc :table (delay (-> (Table table_id)
                                                     (select-keys [:id :name :display_name :description])))))))

(extend-ICanReadWrite ActivityEntity :read :public-perms, :write :public-perms)

include :display_name in the set of hydrated fields on a table for Activity


(ns {{project-ns}}.server
  (:require [clojure.java.io :as io]
            [{{project-ns}}.dev :refer [is-dev? inject-devmode-html browser-repl start-figwheel{{less-refer}}{{sass-refer}}]]
            [compojure.core :refer [GET defroutes]]
            [compojure.route :refer [resources]]
            [net.cgrand.enlive-html :refer [deftemplate]]
            [net.cgrand.reload :refer [auto-reload]]
            [ring.middleware.reload :as reload]
            [ring.middleware.defaults :refer [wrap-defaults {{ring-defaults}}]]
            [environ.core :refer [env]]{{{server-clj-requires}}}))

(deftemplate page
  (io/resource "index.html") [] [:body] (if is-dev? inject-devmode-html identity))

(defroutes routes
  (resources "/")
  (resources "/react" {:root "react"})
  (GET "/*" req (page)))

(def http-handler
  (if is-dev?
    (reload/wrap-reload (wrap-defaults #'routes {{ring-defaults}}))
    (wrap-defaults routes {{ring-defaults}})))

(defn run [& [port]]
  (defonce ^:private server
    (do
      (when is-dev?
        (auto-reload *ns*)
        (start-figwheel){{less-start}}{{sass-start}})
      (let [port (Integer. (or port (env :port) 10555))]
        (print "Starting web server on port" port ".\n")
        ({{server-command}} http-handler {:port port
                          :join? false}))))
  server)

(defn -main [& [port]]
  (run port))

(ns {{project-ns}}.server
  (:require [clojure.java.io :as io]
            [{{project-ns}}.dev :refer [is-dev? inject-devmode-html browser-repl start-figwheel{{less-sass-refer}}]]
            [compojure.core :refer [GET defroutes]]
            [compojure.route :refer [resources]]
            [net.cgrand.enlive-html :refer [deftemplate]]
            [net.cgrand.reload :refer [auto-reload]]
            [ring.middleware.reload :as reload]
            [ring.middleware.defaults :refer [wrap-defaults {{ring-defaults}}]]
            [environ.core :refer [env]]{{{server-clj-requires}}}))

(deftemplate page
  (io/resource "index.html") [] [:body] (if is-dev? inject-devmode-html identity))

(defroutes routes
  (resources "/")
  (resources "/react" {:root "react"})
  (GET "/*" req (page)))

(def http-handler
  (if is-dev?
    (reload/wrap-reload (wrap-defaults #'routes {{ring-defaults}}))
    (wrap-defaults routes {{ring-defaults}})))

(defn run [& [port]]
  (defonce ^:private server
    (do
      (when is-dev?
        (auto-reload *ns*)
        (start-figwheel){{less-start}}{{sass-start}})
      (let [port (Integer. (or port (env :port) 10555))]
        (print "Starting web server on port" port ".\n")
        ({{server-command}} http-handler {:port port
                          :join? false}))))
  server)

(defn -main [& [port]]
  (run port))

Simplify less/sass stuff

Simplify less/sass stuff