Removes FIXME.

Removes FIXME.

--- src/active/clojure/match.clj
+++ src/active/clojure/match.clj
@@ -335,7 +335,6 @@
 (s/def ::binding-key #{:as})
 (s/def ::binding symbol?)

-;; FIXME: represent optionals as full-fledged terminal symbols in this grammar
 (s/def ::key-exists-without-binding
   (s/or :required (s/or :flat ::key
                         :list (s/coll-of ::key :count 1 :kind list?))))


More fixes and idiomatic clojure

More fixes and idiomatic clojure

--- src/dakait/downloader.clj
+++ src/dakait/downloader.clj
@@ -93,12 +93,8 @@
                  (let [p (apply sh/proc (map str args))]
                    (with-open [rdr (io/reader (:out p))]
                      (doseq [line (line-seq rdr)]
-                       (info "stdout: " line)
                        (let [state-map (update-to-map line)]
-                         (info "source key: " src)
-                         (info "download state map: " state-map)
                          (swap! download-states assoc src state-map))))
-                   (info "Process ended")
                    (sh/exit-code p))
                  (catch Exception e
                    (info "Download process failed: " (.getMessage e))
@@ -115,16 +111,20 @@
             ;; check if we have room for another download, if we do check if we have a task waiting
             ;; if so, start it up
             (try
+              ; start any new tasks that need to be started if we have room
+              ;
               (when (< (count @active-downloads) concurrency)
-                (let [next-task (peek @download-queue)]
-                  (when next-task
-                    (reset! download-queue (pop @download-queue))
-                    (let [[src dest f] next-task
-                          p (download src dest)]
-                      (info "Process is: " (apply str p))
-                      (let [new-dl-state (conj (vec p) f false)] ; false indicates that the user has not been notified about this completion yet
-                        (reset! active-downloads (conj @active-downloads new-dl-state)))))))
+                (when-let [next-task (peek @download-queue)]
+                  (swap! download-queue pop)
+                  (let [[src dest f] next-task
+                        p (download src dest)]
+                    (info "Process is: " (apply str p))
+                    ; false indicates that the user has not been notified about this completion yet
+                    (let [new-dl-state (conj (vec p) f false)]
+                      (swap! active-downloads conj new-dl-state)))))

+              ; call callbacks on any completed but not triggered tasks
+              ;
               (swap! active-downloads
                      (fn [dls]
                        (map #(match [%]
@@ -133,10 +133,9 @@
                                                                             [t s d cb true])
                                     :else %) dls)))

-              ;; Remove any completed futures from our active downloads list
-              (swap! active-downloads
-                     (fn [dls]
-                       (remove #(last %) dls)))
+              ; Remove any completed futures from our active downloads list
+              ;
+              (swap! active-downloads #(remove last %))

               (catch Exception e
                 (warn "Exception in downloader thread: " (.getMessage e))


use pmap for (babel.english.writer/translate)

--- src/babel/english/writer.clj
+++ src/babel/english/writer.clj
@@ -37,8 +37,7 @@
         debug (log/debug (str "using root:" root))
         debug (log/debug (str "using spec:" (strip-refs spec)))

-        ;;        use-map-fn pmap
-        use-map-fn map
+        use-map-fn pmap
         source-expressions (read-all spec
                                      source-language-short-name)]
     (count


Use `if-not` for error handling in ethereum core functions.

That fixes the exception if we have an error that isn't a string and does not conform to `ISeqable`.

Signed-off-by: Igor Mandrigin <042dc4512fa3d391c5170cf3aa61e6a638f84342@mandrigin.ru>

--- src/status_im/utils/ethereum/core.cljs
+++ src/status_im/utils/ethereum/core.cljs
@@ -109,24 +109,24 @@
 (defn get-block-number [web3 cb]
   (.getBlockNumber (.-eth web3)
                    (fn [error result]
-                     (if (seq error)
-                       (handle-error error)
-                       (cb result)))))
+                     (if-not error
+                       (cb result)
+                       (handle-error error)))))

 (defn get-block-info [web3 number cb]
   (.getBlock (.-eth web3) number (fn [error result]
-                                   (if (seq error)
-                                     (handle-error error)
-                                     (cb (js->clj result :keywordize-keys true))))))
+                                   (if-not error
+                                     (cb (js->clj result :keywordize-keys true))
+                                     (handle-error error)))))

 (defn get-transaction [web3 number cb]
   (.getTransaction (.-eth web3) number (fn [error result]
-                                         (if (seq error)
-                                           (handle-error error)
-                                           (cb (js->clj result :keywordize-keys true))))))
+                                         (if-not error
+                                           (cb (js->clj result :keywordize-keys true))
+                                           (handle-error error)))))

 (defn get-transaction-receipt [web3 number cb]
   (.getTransactionReceipt (.-eth web3) number (fn [error result]
-                                                (if (seq error)
-                                                  (handle-error error)
-                                                  (cb (js->clj result :keywordize-keys true))))))
+                                                (if-not error
+                                                  (cb (js->clj result :keywordize-keys true))
+                                                  (handle-error error)))))


[#87] Message queue: catch unexpected `dequeue` errors (@gsnewmark)

--- src/taoensso/carmine/message_queue.clj
+++ src/taoensso/carmine/message_queue.clj
@@ -241,11 +241,14 @@
                 (when @running?_
                   (let [?error
                         (try
-                          (let [[poll-reply ndruns mid-circle-size]
+                          (let [[poll-reply ndruns mid-circle-size :as -resp]
                                 (wcar conn-opts
                                   (dequeue qname opts)
                                   (car/get  (qk :ndry-runs))
                                   (car/llen (qk :mid-circle)))]
+
+                            (when-let [t (some #(instance? Throwable %) -resp)]
+                              (throw t))

                             (when monitor
                               (monitor {:mid-circle-size mid-circle-size


Revert "Fix #87: don't pass mq connection errors to handler"

This reverts commit b69204bca7fce761d61577da7520051a034d49f3.

--- src/taoensso/carmine/message_queue.clj
+++ src/taoensso/carmine/message_queue.clj
@@ -351,16 +351,11 @@
                                         :ndry-runs       (or ndruns 0)
                                         :poll-reply      poll-reply}))

-                            (cond
-                              (instance? Exception poll-reply)
-                              (throw poll-reply) ; Don't pass conn errs to `handle1`
-
-                              (= poll-reply "eoq-backoff")
+                            (if (= poll-reply "eoq-backoff")
                               (Thread/sleep
-                                (max (wcar conn-opts (car/pttl (qk :eoq-backoff?)))
-                                  10))
-
-                              :else (handle1 conn-opts qname handler poll-reply))
+                               (max (wcar conn-opts (car/pttl (qk :eoq-backoff?)))
+                                    10))
+                              (handle1 conn-opts qname handler poll-reply))

                             (when throttle-ms (Thread/sleep throttle-ms)))
                           nil ; Successful worker loop


remove unneeded cdn helper functions

remove unneeded cdn helper functions

--- frontend/components/language_landing.cljs
+++ frontend/components/language_landing.cljs
@@ -17,21 +17,20 @@
     0 "arrowLeft"
     1 "arrowCenter"
     2 "arrowRight"
-    "arrowLeft"
-    ))
+    "arrowLeft"))

 (def templates {"ruby" {:language "Ruby"
                         :headline "CircleCI makes Continous Integration and Deployment for Ruby projects a breeze."
-                        :logo-path (utils/cdn-path "/img/outer/languages/ruby-logo.svg")
+                        :logo-path "/img/outer/languages/ruby-logo.svg"
                         :features [{:feature "CircleCI uses RVM to provide support for a wide variety of Ruby versions and gems. It is also trivial to add any packages or frameworks that are not installed on our machines by default, allowing you to effortlessly customize your test enviroment.  CircleCI also supports Test::Unit, RSpec, Cucumber, Spinach, Jasmine, Konacha, and just about any other testing framework you use for your Ruby project."
                                     :title "Built For Ruby"
-                                    :icon (utils/cdn-path "/img/outer/languages/gear-icon.svg")}
+                                    :icon "/img/outer/languages/gear-icon.svg"}
                                    {:feature "Circle manages all your database requirements for your, such as running your rake commands for creating, loading, and migrating your database. We have pre-installed more than a dozen databases and queues, including PostgreSQL, MySQL, and MongoDB. You can also add custom database commands via your circle.yml."
                                     :title "Database Management"
-                                    :icon (utils/cdn-path "/img/outer/languages/file-icon.svg")}
+                                    :icon "/img/outer/languages/file-icon.svg"}
                                    {:feature "For the majority of Ruby projects no configuration is required; you just run your builds on CircleCI and it works! CircleCI will automatically infer your test commands if you're using Test::Unit, RSpec, Cucumber, Spinach, Jasmine, or Konacha."
                                     :title "Inference That Just Works"
-                                    :icon (utils/cdn-path "/img/outer/languages/book-icon.svg")}]
+                                    :icon "/img/outer/languages/book-icon.svg"}]
                         :docs-link "/docs/language-ruby-on-rails"
                         :testimonials [{:text "The speed is really impressive, the rspec suite alone takes 6 minutes to run on my Macbook Air, but only 2 minutes on Circle."
                                         :img "/img/outer/languages/olivier.jpg"
@@ -47,16 +46,16 @@
                                         :title "Operations Engineer @Kickstarter"}]}
                 "python" {:language "Python"
                         :headline "CircleCI makes Continous Integration and Deployment for Python projects a breeze."
-                        :logo-path (utils/cdn-path "/img/outer/languages/ruby-logo.svg")
+                        :logo-path "/img/outer/languages/ruby-logo.svg"
                         :features [{:feature "CircleCI uses RVM to provide support for a wide variety of Ruby versions and gems. It is also trivial to add any packages or frameworks that are not installed on our machines by default, allowing you to effortlessly customize your test enviroment.  CircleCI also supports Test::Unit, RSpec, Cucumber, Spinach, Jasmine, Konacha, and just about any other testing framework you use for your Ruby project."
                                     :title "Built For Ruby"
-                                    :icon (utils/cdn-path "/img/outer/languages/gear-icon.svg")}
+                                    :icon "/img/outer/languages/gear-icon.svg"}
                                    {:feature "Circle manages all your database requirements for your, such as running your rake commands for creating, loading, and migrating your database. We have pre-installed more than a dozen databases and queues, including PostgreSQL, MySQL, and MongoDB. You can also add custom database commands via your circle.yml."
                                     :title "Database Management"
-                                    :icon (utils/cdn-path "/img/outer/languages/file-icon.svg")}
+                                    :icon "/img/outer/languages/file-icon.svg"}
                                    {:feature "For the majority of Ruby projects no configuration is required; you just run your builds on CircleCI and it works! CircleCI will automatically infer your test commands if you're using Test::Unit, RSpec, Cucumber, Spinach, Jasmine, or Konacha."
                                     :title "Inference That Just Works"
-                                    :icon (utils/cdn-path "/img/outer/languages/book-icon.svg")}]
+                                    :icon "/img/outer/languages/book-icon.svg"}]
                         :docs-link "/docs/language-ruby-on-rails"
                         :testimonials [{:text "The speed is really impressive, the rspec suite alone takes 6 minutes to run on my Macbook Air, but only 2 minutes on Circle."
                                         :img "/img/outer/languages/olivier.jpg"


Improve tenancy compatibility check

Improve tenancy compatibility check

--- src/onyx/peer/communicator.clj
+++ src/onyx/peer/communicator.clj
@@ -27,13 +27,17 @@
     ;; Race to write the job scheduler and messaging to durable storage so that
     ;; non-peers subscribers can discover which properties to use.
     ;; Only one writer will succeed, and only one needs to.
-
-    (extensions/write-chunk log
-                            :log-parameters
-                            {:job-scheduler (:onyx.peer/job-scheduler peer-config)
-                             :messaging (select-keys peer-config [:onyx.messaging/impl])
-                             :log-version onyx.peer.log-version/version}
-                            nil)
+    (let [log-parameters {:job-scheduler (:onyx.peer/job-scheduler peer-config)
+                          :messaging (select-keys peer-config [:onyx.messaging/impl])
+                          :log-version onyx.peer.log-version/version}]
+      (extensions/write-chunk log :log-parameters log-parameters nil)
+      (let [read-log-parameters (extensions/read-chunk log :log-parameters nil)]
+        (onyx.peer.log-version/check-compatible-log-versions! (:log-version read-log-parameters))
+        (when-not (= (dissoc log-parameters :log-version)
+                     (dissoc read-log-parameters :log-version))
+          (throw (ex-info "Log parameters read from cluster differ from the local parameters."
+                          {:log-parameters log-parameters
+                           :read-log-parameters read-log-parameters})))))
     (let [outbox-ch (chan (arg-or-default :onyx.peer/outbox-capacity peer-config))
           outbox-loop-thread (thread (outbox-loop log outbox-ch group-ch))]
       (assoc component


Check for duplicate entries in catalog

Check for duplicate entries in catalog

--- src/onyx/static/validation.clj
+++ src/onyx/static/validation.clj
@@ -60,8 +60,14 @@
   (when (= (:onyx/name entry) (:onyx/type entry))
     (throw (ex-info "Task's :onyx/name and :onyx/type cannot be equal" {:task entry}))))

+(defn no-duplicate-entries [catalog]
+  (let [tasks (map :onyx/name catalog)]
+    (when-not (= (distinct tasks) tasks)
+      (throw (ex-info "Multiple catalog entries found with the same :onyx/name." {:catalog catalog})))))
+
 (defn validate-catalog
   [catalog]
+  (no-duplicate-entries catalog)
   (doseq [entry catalog]
     (schema/validate catalog-entry-validator entry)
     (when (and (= (:onyx/type entry) :function)


Rename cookie to "braid"

Rename cookie to "braid"

--- src/braid/server/handler.clj
+++ src/braid/server/handler.clj
@@ -43,6 +43,7 @@

 (defn assoc-cookie-conf [defaults]
   (-> defaults
+      (assoc-in [:session :cookie-name] "braid")
       (assoc-in [:session :cookie-attrs :secure] false #_(= (env :environment) "prod"))
       (assoc-in [:session :cookie-attrs :max-age] (* 60 60 24 7))
       (assoc-in [:session :store] session-store)))


asddssddf

asddssddf

--- src/epicea/typed/core.clj
+++ src/epicea/typed/core.clj
@@ -1,2 +1,56 @@
 (ns epicea.typed.core
-  (:require [clojure.spec :as spec]))
+  (:require [clojure.spec :as spec] :reload-all))
+
+(spec/def ::double (partial = :double))
+(spec/def ::unspecified nil?)
+(spec/def ::count number?)
+(spec/def ::primitive (spec/or :double ::double))
+
+(spec/def ::key keyword?)
+
+(spec/def ::record-field (spec/cat
+                          :key ::key
+                          :value ::sized-type))
+
+(spec/def ::record (spec/cat
+                    :type (partial = :record)
+                    :fields (spec/* ::record-field)))
+
+(spec/def ::union (spec/cat
+                   :type (partial = :union)
+                   :alts (spec/* ::sized-type)))
+
+(spec/def ::vec (spec/cat
+                 :type (partial = :vec)
+                 :type ::sized-type
+                 :count ::count))
+
+(spec/def ::tagged (spec/cat
+                    :type (partial = :tag)
+                    :tag (constantly true)
+                    :data ::sized-type))
+
+(spec/def ::sized-type (spec/or :primitive ::primitive
+                                :record ::record
+                                :union ::union
+                                :unspecified ::unspecified
+                                :tagged ::tagged
+                                :vec ::vec))
+
+(spec/def ::array (spec/cat
+                   :type (partial = :array)
+                   :element-type ::sized-type))
+
+(spec/def ::harray (spec/cat
+                    :type (partial = :harray)
+                    :header ::sized-type
+                    :data ::sized-type))
+
+(assert (spec/valid? ::double :double))
+(assert (spec/valid? ::union [:union :double :double]))
+(assert (spec/valid? ::record [:record
+                               :a :double
+                               :b [:vec nil 3]]))
+(assert (spec/valid? ::tagged [:tag 119 [:vec :double 3]]))
+(assert (spec/valid? ::array [:array [:record :a nil :b nil]]))
+(assert (spec/valid? ::harray [:harray [:record :a nil :b nil] nil]))


fix sort by on users

fix sort by on users

--- src/foreclojure/users.clj
+++ src/foreclojure/users.clj
@@ -4,10 +4,11 @@
         compojure.core))

 (defn get-users []
-  (from-mongo
-   (fetch :users
-          :only [:user :solved]
-	  :sort {:solved -1})))
+  (let [users (from-mongo
+               (fetch :users
+                      :only [:user :solved]))
+        sortfn  #(compare (count (:solved %1)) (count (:solved %2)))]
+    (reverse (sort sortfn users))))

 (def-page users-page []
   [:table {:class "my-table" :width "50%"}


cleaned up uploads

cleaned up uploads

--- src/frontend/uploads.cljs
+++ src/frontend/uploads.cljs
@@ -117,6 +117,32 @@
                  :started
                  :stopped)))))))

+(defn handle-pause! [uploads uploads-order upload-slots]
+  (let [first-inactive-upload-id (first (filter #(unpaused-and-not-started? (uploads %)) uploads-order))
+        first-inactive-upload    (uploads first-inactive-upload-id)]
+    (if (and (not (nil? first-inactive-upload))
+             (> (count (active-uploads uploads-order uploads))
+                upload-slots))
+      (swap! app-state/app-state
+             assoc
+             :uploads
+             (assoc (:uploads @app-state/app-state)
+             first-inactive-upload-id
+             (start-upload first-inactive-upload))))))
+
+(defn handle-unpause-while-started! [uploads uploads-order upload-slots active-uploads upload-id]
+  (if (> (count (active-uploads uploads-order uploads))
+          upload-slots)
+    (let [uploads-order-after-id (uploads-after-id uploads-order upload-id)
+          upload-to-stop-id (last (active-uploads uploads-order uploads))]
+      (if-let [upload-to-stop (uploads upload-to-stop-id)]
+        (swap! app-state/app-state
+               assoc
+               :uploads
+               (assoc (:uploads @app-state/app-state)
+                      upload-to-stop-id
+                      (stop-upload upload-to-stop)))))))
+
 (defn upload-file! [file]
   (let [upload-id (.v4 js/uuid)
         new-upload (merge blank-upload {:filename (.-name file)
@@ -137,32 +163,16 @@
                                    (= action :paused)
                                      (do
                                        (.unpipe blob-stream)
-                                       (let [first-inactive-upload-id (first (filter #(unpaused-and-not-started? (uploads %)) uploads-order))
-                                             first-inactive-upload    (uploads first-inactive-upload-id)]
-                                         (if (and (not (nil? first-inactive-upload))
-                                                  (> (count (active-uploads uploads-order uploads))
-                                                     upload-slots))
-                                           (swap! app-state/app-state
-                                                  assoc
-                                                  :uploads
-                                                  (assoc (:uploads @app-state/app-state)
-                                                         first-inactive-upload-id
-                                                         (start-upload first-inactive-upload))))))
+                                       (handle-pause! uploads uploads-order upload-slots))
                                    (and (= action :unpaused)
                                         (:started? upload))
                                      (do
                                        (.pipe blob-stream stream)
-                                       (if (> (count (active-uploads uploads-order uploads))
-                                              upload-slots)
-                                         (let [uploads-order-after-id (uploads-after-id uploads-order upload-id)
-                                               upload-to-stop-id (last (active-uploads uploads-order uploads))]
-                                           (if-let [upload-to-stop (uploads upload-to-stop-id)]
-                                             (swap! app-state/app-state
-                                                    assoc
-                                                    :uploads
-                                                    (assoc (:uploads @app-state/app-state)
-                                                           upload-to-stop-id
-                                                           (stop-upload upload-to-stop)))))))
+                                       (handle-unpause-while-started! uploads
+                                                                      uploads-order
+                                                                      upload-slots
+                                                                      active-uploads
+                                                                      upload-id))
                                    (= action :stopped)
                                      (.unpipe blob-stream)
                                    (and (= action :started)


(maint) Fix some errors being obscured (#281)

(maint) Fix some errors being obscured

--- src/puppetlabs/trapperkeeper/core.clj
+++ src/puppetlabs/trapperkeeper/core.clj
@@ -177,7 +177,9 @@
           (if (keyword? type)
             (case (without-ns (:type m))
               :cli-error (quit 1 (:message m) *err*)
-              :cli-help (quit 0 (:message m) *out*))))
+              :cli-help (quit 0 (:message m) *out*)
+              ;; By default let the throw below reraise the error
+              nil)))
         (throw+))
       (finally
         (log/debug (i18n/trs "Finished TK main lifecycle, shutting down Clojure agent threads."))


system.async function have been integrated with execution mode

--- core/src/cljc/hellhound/system/async.cljc
+++ core/src/cljc/hellhound/system/async.cljc
@@ -7,9 +7,15 @@
 (defn execute-io!
   [f]
   ;;   (exec/execute-io-with-system  f)
-  (async/future-with (exec/wait-pool (store/get-system)) (f)))
+  (let [system (store/get-system)]
+    (if (exec/single-threaded? system)
+      (f)
+      (async/future-with (exec/wait-pool (store/get-system)) (f)))))

 (defn execute
   [f]
   ;;(exec/execute-with-system (hellhound/system) f)
-  (async/future-with (exec/execution-pool (store/get-system)) (f)))
+  (let [system (store/get-system)]
+    (if (exec/single-threaded? system)
+      (f)
+      (async/future-with (exec/execution-pool (store/get-system)) (f)))))


basic tree analytics

basic tree analytics

--- src/ceres_analytics/core.clj
+++ src/ceres_analytics/core.clj
@@ -4,6 +4,9 @@
             [clj-time.core :as t]
             [clj-time.periodic :as p]
             [clj-time.format :as f]
+            [incanter.stats :refer [mean sd quantile]]
+            [ceres-analytics.tree :refer [full-reaction-tree reaction-tree tree-summary]]
+            [aprint.core :refer [aprint]]
             [monger.core :as mg]
             [monger.joda-time]
             [monger.operators :refer :all]
@@ -42,5 +45,51 @@
   (->> (mc/find-maps @db "publications" {:ts {$gt (t/date-time 2015 2 15)} :type :share})
        (map #(mc/find-one-as-map @db "reactions" {:publication (:_id %)})))

+  (def suids (->> (mc/find-maps @db "users" {:screen_name {$in news-accounts}})
+                  (map (fn [{:keys [_id screen_name]}] [_id screen_name ]) )
+                  (into {})))
+
+  (keys suids)
+
+  (->> (mc/find-maps @db "publications" {:user {$in (keys suids)}})
+       (pmap :user)
+       frequencies
+       (map (fn [[k v]] [(suids k) v]))
+       )
+
+  (mc/count @db "publications" {:user {$in (keys suids)}})
+  (mc/count @db "publications" {:user {$nin (keys suids)}})
+
+  (def tree-summaries
+    (future
+      (time
+       (->> (mc/find-maps @db "publications" {:user {$in (keys suids)}})
+            (pmap (comp tree-summary reaction-tree :_id))))))
+
+
+  (->>  (sort-by :size > tree-summaries)
+        (take 50)
+        (pmap (fn [{:keys [source height size]}]
+                [height size
+                 (->> source
+                      (mc/find-map-by-id @db "publications")
+                      :tweet
+                      (mc/find-map-by-id @db "tweets"))]))
+        (pmap (fn [[height size {:keys [text user]}]]
+                [(:screen_name user) text size height ((comp float /) height size)]))
+        aprint)
+
+  (->>  (sort-by :height > tree-summaries)
+        (take 50)
+        (pmap (fn [{:keys [source height size]}]
+                [height size
+                 (->> source
+                      (mc/find-map-by-id @db "publications")
+                      :tweet
+                      (mc/find-map-by-id @db "tweets"))]))
+        (pmap (fn [[height size {:keys [text user]}]]
+                [(:screen_name user) text size height ((comp float /) height size)]))
+        aprint)
+

   )


Fix config.

Fix config.

--- src/oc/storage/config.clj
+++ src/oc/storage/config.clj
@@ -114,6 +114,6 @@

 (defonce seen-replies-container-id (env :seen-replies-container-id))

-(defonce unread-days-limit (or (read-string (env :unread-days-limit)) 30))
+(defonce unread-days-limit (or (env :unread-days-limit) 30))

-(defonce unseen-cap-days (or (read-string (env :unseen-cap-days)) 0))+(defonce unseen-cap-days (or (env :unseen-cap-days) 0))


bugfix `describe-*` entity query spec

bugfix `describe-*` entity query spec

--- src/imago/graph/model.clj
+++ src/imago/graph/model.clj
@@ -94,7 +94,7 @@
           {:describe '~'?id
            :from g#
            :query [{:where [['~'?id "rdf:type" ~type]]}]
-           :values {'~'?id #{(:id id#)}}})))))
+           :values {'~'?id #{id#}}})))))

 (defentity User (:User imago)
   {:user-name {:prop (:nick foaf)


Global stream client.

Global stream client.

--- src/orbitingnews/core.clj
+++ src/orbitingnews/core.clj
@@ -13,19 +13,24 @@
             [cognitect.transit :as transit])
   (:gen-class))

+(defonce listeners
+  (atom #{}))
+
+(go (let [c (twitter/do-filter-stream)]
+      (while true
+        (let [status (<! c)
+              out (ByteArrayOutputStream. 4096)
+              writer (transit/writer out :json)]
+          (transit/write writer {:msg (.getText status)})
+          (dorun (pmap #(send! % (.toString out) false)) @listeners))))) ; false => don't close after send
+
 (defn handler [req]
   (with-channel req channel              ; get the channel
     ;; communicate with client using method defined above
     (on-close channel (fn [status]
-                        (println "channel closed, " status)))
+                        (swap! listeners disj channel)))

-    (go (let [c (twitter/do-filter-stream)]
-          (while true
-            (let [status (<! c)
-                  out (ByteArrayOutputStream. 4096)
-                  writer (transit/writer out :json)]
-              (transit/write writer {:msg (.getText status)})
-              (send! channel (.toString out) false))))) ; false => don't close after send
+    (swap! listeners conj channel)

 ;       (loop [id 0]
 ;         (when (< id 10)


Revert "Allow entities to be stored in maps"

This reverts commit fbb4e9f2b51a7b8f84935a9d44a643e6865a1e37.

--- src/play_clj/entities.clj
+++ src/play_clj/entities.clj
@@ -11,20 +11,11 @@
 (defprotocol Entity
   (draw-entity! [this screen batch] "Draws the entity"))

-(defn draw-map!
-  [m screen batch]
-  (doseq [[k v] m]
-    (try
-      (draw-entity! v screen batch)
-      (catch Exception _))))
-
 (extend-protocol Entity
   clojure.lang.PersistentArrayMap
-  (draw-entity! [this screen batch]
-    (draw-map! this screen batch))
+  (draw-entity! [this screen batch])
   clojure.lang.PersistentHashMap
-  (draw-entity! [this screen batch]
-    (draw-map! this screen batch))
+  (draw-entity! [this screen batch])
   nil
   (draw-entity! [this screen batch]))


Update syntax on require :refer.

Update syntax on require :refer.

--- src/posthere/app.clj
+++ src/posthere/app.clj
@@ -7,7 +7,7 @@
               [compojure.core :refer (GET POST PUT PATCH DELETE defroutes)]
               [compojure.route :as route]
               [org.httpkit.server :refer (run-server)]
-              [ring.middleware.cors :refer [wrap-cors]]
+              [ring.middleware.cors :refer (wrap-cors)]
               [environ.core :refer (env)]
               [posthere.capture-request :refer (capture-request)]
               [posthere.storage :refer (requests-for delete-requests)]


tentative sort column added to table

tentative sort column added to table

--- src/prais2/data.cljs
+++ src/prais2/data.cljs
@@ -79,7 +79,7 @@

 (def sort-columns (atom [[5 true] [1 false]]))

-(r/defc table1 < r/reactive #_(data-table-on :#table1) [data]
+(r/defc table1 < r/reactive (data-table-on :#table1) [data]
   (let [sdata (sort-column data @sort-columns)
         headers (:headers sdata)
         visible-headers (- (count headers) 1)]


fixed ents

fixed ents

--- server/src/gratefulplace/db/query.clj
+++ server/src/gratefulplace/db/query.clj
@@ -47,8 +47,7 @@
   (let [common (flatten ['?c common-attribute])
         conditions (concat [common]
                            (map #(concat ['?c] %) conditions))]
-    (map ents (q {:find ['?c]
-                  :where conditions}))))
+    (ents (q {:find ['?c] :where conditions}))))

 (defn ent-count
   [attr]


[#1877] Add logs

[#1877] Add logs

--- backend/src/akvo/lumen/lib/public.clj
+++ backend/src/akvo/lumen/lib/public.clj
@@ -6,6 +6,7 @@
             [akvo.lumen.lib.visualisation :as visualisation]
             [akvo.lumen.lib.visualisation.maps :as maps]
             [cheshire.core :as json]
+            [clojure.tools.logging :as log]
             [clojurewerkz.scrypt.core :as scrypt]
             [clojure.set :as set]
             [hugsql.core :as hugsql]))
@@ -165,7 +166,9 @@
     (let [[tag vis] (visualisation/fetch tenant-conn id)]
      (when (= tag ::lib/ok)
        (visualisation tenant-conn vis config)))
-    (catch Exception e nil)))
+    (catch Exception e (do
+                         (log/warn e ::visualisation-response-data (str "problems fetching this vis-id: " id))
+                         nil))))

 (defn dashboard-response-data [tenant-conn id config]
   (let [[tag dashboard] (dashboard/fetch tenant-conn id)]


Return the correct thing from malformed?.

--- src/kixi/eventlog/api.clj
+++ src/kixi/eventlog/api.clj
@@ -3,8 +3,9 @@
             [clojure.tools.logging :as log]))

 (defn malformed? [ctx]
+  (println (get-in ctx [:request :body]))
   (if-let [body (get-in ctx [:request :body])]
-    (assoc ctx ::body body)
+    [false (assoc ctx ::body body)]
     true))

 (defn handle-created [publish-fn ctx]


Taking out the clojure data structure conversion for real...

--- src/clinvar_submitter/ld.clj
+++ src/clinvar_submitter/ld.clj
@@ -1,7 +1,6 @@
 (ns clinvar-submitter.ld
   (:require [cheshire.core :as json]
-            [clojure.java.io :as io]
-            [clojure.walk :as walk])
+            [clojure.java.io :as io])
   (:import [com.github.jsonldjava.core JsonLdProcessor JsonLdOptions]
            [com.github.jsonldjava.utils JsonUtils]
            [java.util Map List]))
@@ -52,18 +51,10 @@
                                (if (instance? List r) (some #(= % v) r) (= r v))))  m)
             (when (= v (ld-> t m ks)) m))))

-(defn convert-jsonld
-  "Convert java structures from jsonld library into clojure structures"
-  [m]
-  (walk/postwalk (fn [n] (cond
-                           (instance? Map n) (into {} n)
-                           (instance? List n) (into [] n)
-                           :else n)) m))
-
 (defn construct-symbol-table
   [coll]
   (let [graph (into [] (get coll "@graph"))]
-    (reduce (fn [acc v] (assoc acc (.get v "id") (convert-jsonld v))) {} graph)))
+    (reduce (fn [acc v] (assoc acc (.get v "id") v)) {} graph)))

 (defn flatten-interpretation
   [interp-path context-path]
@@ -72,7 +63,7 @@
     (let [i (json/parse-stream ir)
           cx (json/parse-stream cxr)
           opts (JsonLdOptions.)]
-      (-> (JsonLdProcessor/flatten i cx opts) convert-jsonld))))
+      (JsonLdProcessor/flatten i cx opts))))

 (defn read-ld
   [interp-path context-path]


fix doc on comp-paths

fix doc on comp-paths

--- src/clj/com/rpl/specter.cljc
+++ src/clj/com/rpl/specter.cljc
@@ -423,10 +423,7 @@

 (defn comp-paths
   "Returns a compiled version of the given path for use with
-   compiled-{select/transform/setval/etc.} functions. This can compile navigators
-   (defined with `defnav`) without their parameters, and the resulting compiled
-   path will require parameters for all such navigators in the order in which
-   they were declared."
+   compiled-{select/transform/setval/etc.} functions."
   [& apath]
   (i/comp-paths* (vec apath)))


FPS calculations

FPS calculations

--- src/cljs/kindness/utils.cljs
+++ src/cljs/kindness/utils.cljs
@@ -7,6 +7,8 @@
             [goog.events :as events])
   (:import [goog.async AnimationDelay]
            [goog.events EventType]))
+
+(defonce render-times (atom '()))

 (defn guid []
   (let [s4 (fn [] (-> (Math/floor (* (inc (Math/random)) 0x10000))
@@ -114,3 +116,28 @@
     (if (.-paused audio)
       (.play audio)
       (.pause audio))))
+
+(defn max-conj
+  [num]
+  (fn [col item]
+    (take num (conj col item))))
+
+(defn record-render-time
+  [delta]
+  (swap! render-times (max-conj 10) delta))
+
+(defn get-render-times
+  []
+  @render-times)
+
+(defn average-render-time
+  []
+  (let [times @render-times]
+    (/ (reduce + times)
+       (count times))))
+
+(defn frame-rate
+  []
+  (/ 1
+     (/ (average-render-time)
+      1000)))


Call update-instruction-map-uuids in perform-genetic-operators

--- src/clojush/pushgp/breed.clj
+++ src/clojush/pushgp/breed.clj
@@ -101,7 +101,8 @@
    and performs them to create a new individual. Uses recursive helper function
    even with a single operator by putting that operator in a vector."
   [operator population location rand-gen
-   {:keys [max-points] :as argmap}]
+   {:keys [max-points
+           track-instruction-maps] :as argmap}]
   (let [first-parent (select population location argmap)
         operator-vector (if (sequential? operator) operator (vector operator))
         child (perform-genetic-operator-list operator-vector
@@ -111,7 +112,9 @@
      (assoc child :genetic-operators operator)
      #(when (> (count (:genome %))
                 (/ max-points 4))
-      (revert-too-big-child first-parent % argmap)))
+      (revert-too-big-child first-parent % argmap))
+     #(when track-instruction-maps
+        (update-instruction-map-uuids %)))))

 (defn breed
   "Returns an individual bred from the given population using the given parameters."


Fixed bug reported by Tom Hickey in file-utils/resource

--- src/compojure/file_utils.clj
+++ src/compojure/file_utils.clj
@@ -18,7 +18,7 @@
 (defn resource
   "Returns a URL to a file in a resource."
   [name]
-  (.getResource (.baseLoader RT) name))
+  (.getResource (RT/baseLoader) name))

 (defn list-dir
   "List all the files in a directory."


Type hints for conexp.math.optimize

Type hints for conexp.math.optimize

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/math/optimize.clj
+++ src/conexp/math/optimize.clj
@@ -2,18 +2,20 @@
   (:use conexp.math.util
 	conexp.base)
   (:import [org.apache.commons.math.optimization RealPointValuePair GoalType]
-	   [org.apache.commons.math.optimization.direct NelderMead]
-	   [org.apache.commons.math.optimization.general NonLinearConjugateGradientOptimizer
+	   [org.apache.commons.math.optimization.direct DirectSearchOptimizer NelderMead]
+	   [org.apache.commons.math.optimization.general AbstractScalarDifferentiableOptimizer
+	                                                 NonLinearConjugateGradientOptimizer
 	                                                 ConjugateGradientFormula]))

-(defvar *direct-optimizer* (NelderMead.)
+(defvar #^DirectSearchOptimizer *direct-optimizer* (NelderMead.)
   "Direct optimizer used by directly-optimize")
-(defvar *differential-optimizer* (NonLinearConjugateGradientOptimizer. ConjugateGradientFormula/FLETCHER_REEVES)
+(defvar #^AbstractScalarDifferentiableOptimizer *differential-optimizer*
+  (NonLinearConjugateGradientOptimizer. ConjugateGradientFormula/FLETCHER_REEVES)
   "Optimizer for differentiable functions used by differentially-optimize.")

 (defn point-value-pair-to-vector
   "Converts RealPointValuePair to a point-value-vector."
-  [pvp]
+  [#^RealPointValuePair pvp]
   [(vec (.getPoint pvp)) (.getValue pvp)])

 (defn directly-optimize


Get rid of old wrapping code

Get rid of old wrapping code

Inputs are now backed by a proper Reagent component. The same class
is now shared by every input instance.

--- src/reagent/impl/template.cljs
+++ src/reagent/impl/template.cljs
@@ -124,50 +124,28 @@
     (.! this :cljsInputValue nil)))

 (defn input-component? [x]
-  (let [DOM (.' js/React :DOM)]
-    (or (= x "input")
-        (= x "textarea")
-        (identical? x (.' DOM :input))
-        (identical? x (.' DOM :textarea)))))
-
-
-;;; Wrapping of native components
+  (or (= x "input")
+      (= x "textarea")))
+
+(def reagent-input-class nil)

 (declare make-element)

-(defn wrapped-render [this comp id-class input-setup]
-  (let [inprops (.' this :props)
-        argv (.' inprops :argv)
-        props (nth argv 1 nil)
-        hasprops (or (nil? props) (map? props))
-        jsprops (convert-props (if hasprops props) id-class false)]
-    (when-not (nil? input-setup)
-      (input-setup this jsprops))
-    (make-element argv comp jsprops
-                  (if hasprops 2 1))))
-
-(defn wrapped-should-update [c nextprops nextstate]
-  (or util/*always-update*
-      (let [a1 (.' c :props.argv)
-            a2 (.' nextprops :argv)]
-        (not (util/equal-args a1 a2)))))
-
-(defn add-input-methods [spec]
-  (doto spec
-    (.! :componentDidUpdate #(this-as c (input-set-value c)))
-    (.! :componentWillUnmount #(this-as c (input-unmount c)))))
-
-(defn wrap-component [comp extras name]
-  (let [input? (input-component? comp)
-        input-setup (if input? input-render-setup)
-        spec #js{:render
-                 #(this-as C (wrapped-render C comp extras input-setup))
-                 :shouldComponentUpdate
-                 #(this-as C (wrapped-should-update C %1 %2))
-                 :displayName (or name "ComponentWrapper")}]
-    (when input?
-      (add-input-methods spec))
-    (.' js/React createClass spec)))
+(def input-spec
+  {:display-name "ReagentInput"
+   :component-did-update input-set-value
+   :component-will-unmount input-unmount
+   :component-function
+   (fn [argv comp jsprops first-child]
+     (let [this comp/*current-component*]
+       (input-render-setup this jsprops)
+       (make-element argv comp jsprops first-child)))})
+
+(defn reagent-input [argv comp jsprops first-child]
+  (when (nil? reagent-input-class)
+    (set! reagent-input-class
+          (comp/create-class input-spec)))
+  (reagent-input-class argv comp jsprops first-child))

 ;;; Conversion from Hiccup forms
@@ -179,12 +157,6 @@
     (assert tag (str "Unknown tag: '" hiccup-tag "'"))
     [tag (when (or id class')
            [id class'])]))
-
-(defn get-wrapper [tag]
-  (let [[comp id-class] (parse-tag tag)]
-    (wrap-component comp id-class (str tag))))
-
-(def cached-wrapper (util/memoize-1 get-wrapper))

 (defn fn-to-class [f]
   (assert (ifn? f) (str "Expected a function, not " (pr-str f)))
@@ -196,25 +168,24 @@
     wrapf))

 (defn as-class [tag]
-  (if (hiccup-tag? tag)
-    (cached-wrapper tag)
-    (let [cached-class (util/cached-react-class tag)]
-      (if-not (nil? cached-class)
-        cached-class
-        (fn-to-class tag)))))
+  (let [cached-class (util/cached-react-class tag)]
+    (if-not (nil? cached-class)
+      cached-class
+      (fn-to-class tag))))

 (def cached-parse (util/memoize-1 parse-tag))

 (defn native-element [tag argv]
   (when (hiccup-tag? tag)
     (let [[comp id-class] (cached-parse tag)]
-      (when-not (input-component? comp)
-        (let [props (nth argv 1 nil)
-              hasprops (or (nil? props) (map? props))
-              jsprops (convert-props (if hasprops props) id-class true)]
-          ;; TODO: Meta key
-          (make-element argv comp jsprops
-                        (if hasprops 2 1)))))))
+      (let [props (nth argv 1 nil)
+            hasprops (or (nil? props) (map? props))
+            jsprops (convert-props (if hasprops props) id-class true)
+            first-child (if hasprops 2 1)]
+        ;; TODO: Meta key
+        (if (input-component? comp)
+          (reagent-input argv comp jsprops first-child)
+          (make-element argv comp jsprops first-child))))))

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


New problem added

New problem added


Changed local binding questions from "easy" to "elementary"

--- src/foreclojure/data_set.clj
+++ src/foreclojure/data_set.clj
@@ -348,7 +348,7 @@
             :title "Local bindings"
             :times-solved 0
             :description "Clojure lets you give local names to values using the special let-form."
-            :tags ["easy" "syntax"]
+            :tags ["elementary" "syntax"]
             :tests ["(= __ (let [x 5] (+ 2 x)))"
 		    "(= __ (let [x 3, y 10] (- y x)))"
                     "(= __ (let [x 21] (let [y 3] (/ x y))))"]})
@@ -358,7 +358,7 @@
             :title "Let it Be"
             :times-solved 0
             :description "Can you bind x, y, and z so that these are all true?"
-            :tags ["easy" "math" "syntax"]
+            :tags ["elementary" "math" "syntax"]
             :tests ["(= 10 (let __ (+ x y)))"
 		    "(= 4 (let __ (+ y z)))"
                     "(= 1 (let __ z))"]})))


A crazy idea for a problem

A crazy idea for a problem

--- src/foreclojure/data_set.clj
+++ src/foreclojure/data_set.clj
@@ -869,7 +869,25 @@
            :tests ["(= __\n   (letfn\n     [(foo [x y] #(bar (conj x y) y))\n      (bar [x y] (if (> (last x) 10)\n                   x\n                   #(foo x (+ 2 y))))]\n     (trampoline foo [] 1)))"]})

       (insert! :problems
-           {:_id 77
+          {:_id 77
+           :title "Create an Equation"
+           :times-solved 0
+           :description "Write a function which takes three or more integers.  Using these integers, your function should generate clojure code representing an equation.  The following rules for the equation must be satisfied:\n\n    1. All integers must be used once and only once.\n    2. The order of the integers must be maintained when reading the equation left-to-right.\n    3. The only functions you may use are +, *, or =.\n    4. The equation must use the minimum number of parentheses.\n    5. If no satisfying equation exists, return nil."
+           :tags ["hard", "code-generation"]
+           :tests ["(= (__ 3 4 7) '(= (+ 3 4) 7))"
+		   "(= (__ 3 4 12) '(= (* 3 4) 12))"
+		   "(= (__ 3 4 14) nil)"
+		   "(= (__ 3 4 5 35) '(= (* (+ 3 4) 5) 35))"
+		   "(= (__ 3 4 5 60) '(= (+ (* 3 4) 5) 60))"
+		   "(= (__ 3 4 5 23) '(= (+ 3 (* 4 5)) 23))"
+		   "(= (__ 3 4 5 27) '(= (* 3 (+ 4 5)) 27))"
+		   "(= (__ 3 4 5 6) nil)"
+		   "(= (__ 1 2 10 100 2001) '(= (+ 1 (* 2 10 100)) 2001)"
+		   "(= (__ 1 2 10 100 1300) '(= (* (+ 1 2 10) 100) 1300)"]})
+
+
+      (insert! :problems
+           {:_id 78
             :title "Power Set"
             :times-solved 0
             :description "A power set is the set of all subsets of a given set. Given a list, produce a set of sublists while preserving the order of elements."


Blacklist use, require, and import

Blacklist use, require, and import

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -54,7 +54,7 @@
     (flash-msg (str message " " gist-link) "/problems")))

 (defn get-tester [restricted]
-  (into secure-tester (map symbol restricted)))
+  (into secure-tester (concat [:use :require :import] (map symbol restricted))))

 (def sb (sandbox*))


Use clojure.string, not c.c.string. Also, convert supplied code into a string explicitly, in case it got coerced to something else somehow. If nothing else, makes experimenting at the repl easier.

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -2,9 +2,9 @@
   (:use [foreclojure.utils]
         [clojail core testers]
 	[somnium.congomongo]
-        [clojure.contrib.string :only [replace-str]]
         [hiccup form-helpers])
-  (:require [sandbar.stateful-session :as session]))
+  (:require [sandbar.stateful-session :as session]
+            [clojure.string :as s]))

 (defn get-solved [user]
   (set
@@ -43,7 +43,7 @@
       (loop [[test & more] tests]
         (if-not test
           (mark-completed id)
-          (let [testcase (replace-str "__" code test)]
+          (let [testcase (s/replace test "__" (str code))]
             (if (sb sb-tester (read-string testcase))
               (recur more)
               (do


update example type introspection

update example type introspection

--- src/graphql_clj/executor.clj
+++ src/graphql_clj/executor.clj
@@ -268,5 +268,5 @@
 }"))
            (graphql-clj.type/create-type-meta-fn graphql-clj.type/demo-schema))
   (let [type-schema (type/create-schema (parser/parse graphql-clj.introspection/introspection-schema))]
-    (execute nil type-schema nil "query{__schema{types}}"))
+    (execute nil type-schema nil "query{__schema{types {name kind}}}"))
   )


Add period to end of rude? doc string.

Add period to end of rude? doc string.

--- src/manners/victorian.clj
+++ src/manners/victorian.clj
@@ -39,7 +39,7 @@
   (empty? (bad-manners etiquette value)))

 (def rude?
-  "The complement of manners.victorian/proper?"
+  "The complement of manners.victorian/proper?."
   (complement proper?))

 (defn falter


Other minor version updates

Other minor version updates

--- link/.lein/profiles.clj
+++ link/.lein/profiles.clj
@@ -9,17 +9,16 @@
                      (pjstadig.humane-test-output/activate!)

                      ;; Spyscope is for tracing.
-                     (require 'spyscope.core)
-                     ]
+                     (require 'spyscope.core)]
         :dependencies [[org.clojure/java.classpath "0.2.2"]
                        [org.clojure/tools.namespace "0.2.4"]
                        [org.clojure/tools.trace "0.7.6"]
                        [evalive "1.1.0"]
-                       [pjstadig/humane-test-output "0.6.0"]
+                       [pjstadig/humane-test-output "0.7.0"]
                        [slamhound "1.5.5"]
                        ;; [leiningen #= (leiningen.core.main/leiningen-version)]
                        ;; [im.chit/vinyasa "0.2.0"]
-                       [spyscope "0.1.4"]]}}
+                       [spyscope "0.1.5"]]}}

 ;;;; WIP: more emacs-like Gorilla keybindings.
 ;; :gorilla-options {:keymap { ;; "command:app:commands" ""


updating env variable names

updating env variable names

--- src/lcmap/clownfish/core.clj
+++ src/lcmap/clownfish/core.clj
@@ -16,16 +16,16 @@

 (def environment
  "Creates environment map from the system environment"
- {:http-port      (System/getenv "CLOWNFISH_HTTP_PORT")
-  :event-host     (System/getenv "CLOWNFISH_RABBIT_HOST")
-  :event-port     (System/getenv "CLOWNFISH_RABBIT_PORT")
-  :db-keyspace    (System/getenv "CLOWNFISH_DB_KEYSPACE")
-  :db-url         (System/getenv "CLOWNFISH_DB_CONTACT_POINTS")
-  :db-user        (System/getenv "CLOWNFISH_DB_USERNAME")
-  :db-pass        (System/getenv "CLOWNFISH_DB_PASSWORD")
-  :exchange       (System/getenv "CLOWNFISH_EXCHANGE")
-  :queue          (System/getenv "CLOWNFISH_QUEUE")
-  :tile-specs-url (System/getenv "CLOWNFISH_TILE_SPECS_URL")})
+ {:http-port      (System/getenv "LC_HTTP_PORT")
+  :event-host     (System/getenv "LC_RABBIT_HOST")
+  :event-port     (System/getenv "LC_RABBIT_PORT")
+  :db-keyspace    (System/getenv "LC_DB_KEYSPACE")
+  :db-url         (System/getenv "LC_DB_CONTACT_POINTS")
+  :db-user        (System/getenv "LC_DB_USERNAME")
+  :db-pass        (System/getenv "LC_DB_PASSWORD")
+  :exchange       (System/getenv "LC_EXCHANGE")
+  :queue          (System/getenv "LC_QUEUE")
+  :tile-specs-url (System/getenv "LC_TILE_SPECS_URL")})

 (defn -main


update

update

--- src/service/core.clj
+++ src/service/core.clj
@@ -17,6 +17,13 @@
               (log/warn "no PORT environment variable set, using default")
               default-port)))

+(defonce server (atom nil))
+
+(defn stop-server []
+  (when-not (nil? @server)
+    (@server :timeout 100)
+    (reset! server nil)))
+
 (defn home []
   {:status 200
    :headers {"Content-Type" "application/json"}
@@ -28,13 +35,6 @@
    :headers {"Content-Type" "text/html"}
    :body    "resource not found"}))

-(defonce server (atom nil))
-
-(defn stop-server []
-  (when-not (nil? @server)
-    (@server :timeout 100)
-    (reset! server nil)))
-
 (defn -main []
   (log/info "server listening on port " port)
   (reset! server (srv/run-server #'all-routes {:port port})))


cleanup

cleanup

--- ccw.core/src/ccw/debug/serverrepl.clj
+++ ccw.core/src/ccw/debug/serverrepl.clj
@@ -108,13 +108,9 @@
         [:children
          (apply vector (sort-by :name (map #(var-info (second %)) (ns-interns n))))]))))

-(def ns-info-cache (atom nil))
-
 (defn namespaces-info []
-  (let [info
-        {:name "namespaces" :type "namespaces"
-         :children (apply vector (sort-by :name (map ns-info (all-ns))))}]
-    (reset! ns-info-cache info) info))
+  {:name "namespaces" :type "namespaces"
+   :children (apply vector (sort-by :name (map ns-info (all-ns))))})

 ; The following function (splitted-match) taken from vimClojure with the permission of the author.
 ; Please look for vimClojure license for more detail


added save- and load-pattern

added save- and load-pattern

--- src/temperaments/core.clj
+++ src/temperaments/core.clj
@@ -3,7 +3,7 @@
         seesaw.graphics
         ;seesaw.color
         ;seesaw.keystroke
-        ;seesaw.chooser
+        seesaw.chooser
         clojure.math.numeric-tower)
   (:require [overtone.core :as o]
             [clojure.string :as s])
@@ -207,8 +207,6 @@
         oct2 (map #(s/join [% "4"]) c-scale)]
     (concat oct1 oct2)))

-(def test-model '("A" "B" "C" "D\u266D"))
-
 (defn make-note-box [id]
   (let [cb (combobox :id (keyword (s/join ["kb-" id]))
                      :model keyboard)]
@@ -260,11 +258,10 @@
          (range rhy-hours))))

   ;; adds keyboards to xyz-panel
-(defn add-note-circles [id]
-  (let [root (get-in @melody-map [id :root])
-        mel-keys (make-note-circle-mel id)
+(defn add-note-circles [id panel]
+  (let [mel-keys (make-note-circle-mel id)
         rhy-keys (make-note-circle-rhy id)]
-    (config! root :items (concat mel-keys rhy-keys))))
+    (config! panel :items (concat mel-keys rhy-keys))))

 (defn make-style [c]
   (style :foreground c :background c))
@@ -303,9 +300,10 @@
         mel-prefix (s/join ["#kb-" id "-mel-"])
         mel-len (get-in @melody-map [id :pitches])
         root (get-in @melody-map [id :root])
-        mel-pattern (map #(value (select root [(keyword (s/join [mel-prefix %]))]))
+        panel (select root [:#kb])
+        mel-pattern (map #(value (select panel [(keyword (s/join [mel-prefix %]))]))
                          (range mel-len))
-        rhy-seq (map #(value (select root [(keyword (s/join [rhy-prefix %]))]))
+        rhy-seq (map #(value (select panel [(keyword (s/join [rhy-prefix %]))]))
                      (range (get-in @melody-map [id :beats])))
         rhy-pattern (str-pattern->rhythm rhy-seq)
         rhy-len (count (filter #(> % 0) rhy-pattern))
@@ -349,8 +347,8 @@
   (let [[mel rhy] (make-part id)
         notes (map str->midi mel)
         part (map vector notes rhy)]
-    (play one-twenty-bpm inst-cur part)))
-
+    (play one-twenty-bpm inst-cur part)))
+
 (defn remove-circle [id kw]
   (let [len (get-in @melody-map [id kw])
         kwstring (case kw
@@ -359,46 +357,51 @@
         idprefix (s/join ["#kb-" id kwstring])
         idlist (vec (map #(keyword (s/join [idprefix (str %)])) (range len)))
         root (get-in @melody-map [id :root])
+        panel (select root [:#kb])
         circhash (atom {})]
+    ;(println idlist)
     (doseq [k idlist]
-      (let [w (select root [k])]
-        ;(println w)
+      (let [w (select panel [k])]
         (swap! circhash assoc k (value w))
-        (remove! root w)))
+        (remove! panel w)))
     @circhash))

 (defn change-circle-mel [id newnum]
   (let [root (get-in @melody-map [id :root])
+        panel (select root [:#kb])
         rhyvals (remove-circle id :beats)
         len (get-in @melody-map [id :beats])
         idprefix (s/join ["#kb-" id "-rhy-"])
         kwlist (vec (map #(keyword (s/join [idprefix (str %)])) (range len)))]
     (remove-circle id :pitches)
     (swap! melody-map assoc-in [id :pitches] newnum)
-    (config! root :items (concat (make-note-circle-mel id) (make-note-circle-rhy id)))
+    (config! panel :items (concat (make-note-circle-mel id) (make-note-circle-rhy id)))
     (doseq [kw kwlist]
-      (value! (select root [kw]) (get rhyvals kw)))
+      (value! (select panel [kw]) (get rhyvals kw)))
     ))

 (defn change-circle-rhy [id newnum]
   (let [root (get-in @melody-map [id :root])
+        panel (select root [:#kb])
         melvals (remove-circle id :pitches)
         len (get-in @melody-map [id :pitches])
         idprefix (s/join ["#kb-" id "-mel-"])
         kwlist (vec (map #(keyword (s/join [idprefix (str %)])) (range len)))]
     (remove-circle id :beats)
     (swap! melody-map assoc-in [id :beats] newnum)
-    (config! root :items (concat (make-note-circle-mel id) (make-note-circle-rhy id)))
+    (config! panel :items (concat (make-note-circle-mel id) (make-note-circle-rhy id)))
     (doseq [kw kwlist]
-      (value! (select root [kw]) (get melvals kw)))
+      (value! (select panel [kw]) (get melvals kw)))
     ))

 (defn make-panel-controls [id]
   (let [cbp (combobox :model (range 1 10)
+                      :id (keyword (s/join ["kb-" (str id) "-numpitch"]))
                       :listen [:action
                                (fn [e]
                                  (change-circle-mel id (value (.getSource e))))])
         cbb (combobox :model (range 1 10)
+                      :id (keyword (s/join ["kb-" (str id) "-numbeats"]))
                       :listen [:action
                                (fn [e]
                                  (change-circle-rhy id (value (.getSource e))))])]
@@ -407,25 +410,91 @@
                               (label "# beats:") cbb])))

 (defn make-melody-panel [id]
-  (let [pan (xyz-panel :id id
+  (let [pan (xyz-panel :id :kb
                        :size panel-size
                        :items []
                        )
         controls (make-panel-controls id)
         playsolo (button :text "Play Solo"
                          :listen [:action #(play-solo id %)])
-        verticalpanel (vertical-panel :items [pan playsolo controls])
         f (frame :title (s/join ["Tune " (str id)])
                  :id (s/join ["frame-" (str id)])
                  :listen [:window-closing
                           (fn [e]
                             (swap! melody-map dissoc id))])
+        verticalpanel (vertical-panel :items [pan playsolo controls])
         numcbs 1]
-    (swap! melody-map assoc id {:pitches numcbs, :beats numcbs, :root pan})
-    (add-note-circles id)
+    (swap! melody-map assoc id {:pitches numcbs, :beats numcbs, :root f})
+    (add-note-circles id pan)
     (config! f :content verticalpanel)
     (-> f pack! show!)
-    pan))
+    f))
+
+(defn make-circles-hash [id]
+  (let [root (get-in @melody-map [id :root])
+        panel (select root [:#kb])
+        melprefix (s/join ["#kb-" id "-mel-"])
+        rhyprefix (s/join ["#kb-" id "-rhy-"])
+        mellen (get-in @melody-map [id :pitches])
+        rhylen (get-in @melody-map [id :beats])
+        mellist (map #(keyword (s/join [melprefix (str %)])) (range mellen))
+        rhylist (map #(keyword (s/join [rhyprefix (str %)])) (range rhylen))
+        idlist (vec (concat mellist rhylist))
+        circhash (atom {})]
+    (doseq [k idlist]
+      (let [w (select panel [k])]
+        (swap! circhash assoc k (value w))))
+    @circhash))
+
+(defn replace-in-key [key old new]
+  (let [oldkeystr (str key)
+        newkeystr (s/replace oldkeystr old new)]
+    (keyword (subs newkeystr 1))))
+
+(defn restore-circles [id oldid panel circhash]
+  (let [oldstr (s/join ["-" (str oldid) "-"])
+        newstr (s/join ["-" (str id) "-"])]
+    (doseq [[k v] circhash]
+      (let [newk (replace-in-key k oldstr newstr)]
+        (value! (select panel [newk]) v)))))
+
+(defn restore-panel [oldid panhash circhash]
+  (let [newroot (new-panel nil)
+        id @counter
+        panel (select newroot [:#kb])
+        newpanhash (assoc panhash :root newroot)
+        numpitbut (select newroot [(keyword (s/join ["#kb-" (str id) "-numpitch"]))])
+        numbeabut (select newroot [(keyword (s/join ["#kb-" (str id) "-numbeats"]))])
+        ]
+    (value! numpitbut (get panhash :pitches))
+    (value! numbeabut (get panhash :beats))
+    (restore-circles id oldid panel circhash)
+    (swap! melody-map assoc id newpanhash)))
+
+(defn make-dump []
+  (let [dump (atom {})]
+    (doseq [[k v] @melody-map]
+      (let [val {:panhash (dissoc v :root),
+                 :circhash (make-circles-hash k)}]
+        (swap! dump assoc k val)))
+    @dump))
+
+(defn restore-dump [dump]
+  (doseq [[oldid {:keys [panhash circhash]}] dump]
+    (restore-panel oldid panhash circhash)))
+
+(defn save-pattern [e]
+  (let [dump (make-dump)
+        savefile (choose-file :type :save)]
+    (if savefile
+      (spit savefile dump))))
+
+(defn load-pattern [e]
+  (let [loadfile (choose-file :type :open)]
+    (if loadfile
+      (let [dumpstr (slurp loadfile)
+            dump (clojure.edn/read-string dumpstr)]
+        (restore-dump dump)))))

 (def control-frame
   (frame :title "Tuning Demo"
@@ -442,6 +511,12 @@
                            (button :id :newPanel
                                    :text "New Panel"
                                    :listen [:action new-panel])
+                           (button :id :saveButt
+                                   :text "Save"
+                                   :listen [:action save-pattern])
+                           (button :id :loadButt
+                                   :text "Load"
+                                   :listen [:action load-pattern])
                            ;; spacer
                            (label :text ""
                                   :size [100 :by 30])


fixing bad cursor-left

fixing bad cursor-left

--- src/text_stream/edits.clj
+++ src/text_stream/edits.clj
@@ -24,7 +24,7 @@
   "Produces an edit function which decrements cursor index by `n`."
   [n]
   (fn [source-map]
-    (update-in source-map [:pos] (partial - n))))
+    (update-in source-map [:pos] #(- % n))))

 (defn cursor-right
   "Produces an edit function which increments cursor index by `n`."
@@ -63,12 +63,6 @@
              {:pos new-position
               :text new-text}))))

-(defn titled
-  "Produces a titling function which sets the title to `title`."
-  [title]
-  (fn [source-map]
-    (assoc source-map :title title)))
-
 (defn forward-delete
   "Produces an edit function which deletes `deletion-count` characters from
   the text forwards from the current cursor position."
@@ -76,6 +70,12 @@
   #((delete deletion-count)
     ((cursor (+ deletion-count (:pos %)))
      %)))
+
+(defn titled
+  "Produces a titling function which sets the title to `title`."
+  [title]
+  (fn [source-map]
+    (assoc source-map :title title)))

 (defn initial-text
   "Produces a source-map which has the initial text `text`."


first work on handling division - move-division-outward

--- src/thesis/polynomial.clj
+++ src/thesis/polynomial.clj
@@ -16,6 +16,22 @@
     (if (not= expression transformed)
       (recur transformed)
       transformed)))
+
+; TODO maybe (/ a const) = (* a 1/const)
+(defn move-division-outward
+  [predicate]
+  (let [transformed (->> predicate
+                         (expr-transform [:+ [:/ "a" "b"] [:/ "c" "d"]]
+                                         [:/ [:+ [:* "a" "d"] [:* "c" "b"]] [:* "b" "d"]])
+                         (expr-transform [:* "a" [:/ "b" "c"]] [:/ [:* "a" "b"] "c"])
+                         (expr-transform [:+ "a" [:/ "b" "c"]] [:/ [:+ [:* "a" "c"] "b"] "c"])
+                         (expr-transform [:/ "a" [:/ "b" "c"]] [:/ "a" [:* "b" "c"]])
+                         (expr-transform [:/ [:/ "a" "b"] "c"] [:/ "a" [:* "b" "c"]])
+                         )]
+    (if (not= predicate transformed)
+      (recur transformed)
+      transformed)))
+

 (defn polynomial-clauses [normalized-polynomial]
   (map (partial expr-clauses :*) (expr-clauses :+ normalized-polynomial)))
@@ -42,8 +58,6 @@

 (defn multiply-cpf [factor terms]
   (into {} (map (fn [[t-vars t-factor]] [t-vars (/ t-factor factor)]) terms)))
-
-

 (defn normalize-cpf
   "Given CPF, return [factor-for-highest-power-clause clauses-with-highest-power-clause-equal-to-1]"


Use snappy framed format for streamed compression.

--- src/uxbox/util/snappy.clj
+++ src/uxbox/util/snappy.clj
@@ -8,8 +8,9 @@
   "A lightweight abstraction layer for snappy compression library."
   (:require [buddy.core.codecs :as codecs])
   (:import org.xerial.snappy.Snappy
-           org.xerial.snappy.SnappyOutputStream
-           org.xerial.snappy.SnappyInputStream
+           org.xerial.snappy.SnappyFramedInputStream
+           org.xerial.snappy.SnappyFramedOutputStream
+
            java.io.OutputStream
            java.io.InputStream))

@@ -29,11 +30,11 @@
 (defn input-stream
   "Create a Snappy framed input stream."
   [^InputStream istream]
-  (SnappyInputStream. istream))
+  (SnappyFramedInputStream. istream))

 (defn output-stream
   "Create a Snappy framed output stream."
   ([ostream]
    (output-stream ostream nil))
   ([^OutputStream ostream {:keys [block-size] :or {block-size 65536}}]
-   (SnappyOutputStream. ostream (int block-size))))
+   (SnappyFramedOutputStream. ostream (int block-size) 1.0)))


Started work on register report.

Started work on register report.

--- src/wealthpulse/query.clj
+++ src/wealthpulse/query.clj
@@ -95,7 +95,7 @@

 (defn balance
   "Returns a tuple of [account-balances, total-balance] that match the filters, where
-  account-balances is a vector of [account, amount] tuples.
+  account-balances is a vector of [account, amount] tuples, and total-balance is an amount.
   Valid filters are:
     :accounts-with :: select entries containing any of these strings.
     :exclude-accounts-with :: filter out entries containing any of these strings.
@@ -109,3 +109,15 @@
                              exclude-parent-accounts-where-child-has-same-balance)
         total-balance (calc-total-balance filtered-entries)]
     [account-balances, total-balance]))
+
+
+(defn register
+  "Returns a tuple of [] that match the filters, where ... .
+  Valid filters are:
+    :accounts-with :: select entries containing any of these strings.
+    :exclude-accounts-with :: filter out entries containing any of these strings.
+    :period-start :: select entries on or after this date.
+    :period-end :: select entries up to and including this date."
+  [journal {:keys [accounts-with exclude-accounts-with period-start period-end] :as filters}]
+  (let [filtered-entries (filter-entries journal filters)]
+    filtered-entries))


playground: adapt callbacks

playground: adapt callbacks

--- src/cljs/cljs_morphic/playground.cljs
+++ src/cljs/cljs_morphic/playground.cljs
@@ -6,9 +6,9 @@
                                         without $morph it submorphs ast-type
                                         world-state set-prop add-morphs-to
                                         evolve redefinitions default-meta
-                                        description properties observe add-morph]]
+                                        description properties observe add-morph =>]]
             [fresnel.lenses :refer [fetch putback]]
-            [cljs-morphic.morph.editor :refer [ace-editor set-editor-value]]
+            [cljs-morphic.morph.editor :refer [ace-editor set-editor-value loop-mapping-button]]
             [cljs-morphic.morph.window :refer [window]]
             [cljs-morphic.morph.halo :refer [halo]]
             [cljs-morphic.event :refer [signals]]
@@ -40,9 +40,17 @@

 (defn hand [world-state signal-value]
   (match [signal-value]
-         [{:type :mouse-move
-           :args {:pos pos}}] [(-> world-state
-                                 (set-prop "handMorph" :position pos))
+         [{:type :mouse-move
+           :target-props props
+           :args {:pos pos
+                  :client-pos client-pos}}] [(let [world-state (-> world-state
+                                                   (set-prop "handMorph" :position
+                                                             (add-points pos {:x 8 :y 8})))
+                                     mouse-move-cb (:mouse-move props)]
+                                 (if mouse-move-cb
+                                   (mouse-move-cb world-state ($morph (:id props))
+                                                  pos client-pos)
+                                   world-state))
                                hand]
          [{:type :mouse-enter
            :target-props props
@@ -55,6 +63,17 @@
            :args {}}] [(if-let [mouse-leave-cb (:mouse-leave props)]
                          (mouse-leave-cb world-state ($morph (:id props)))
                          world-state) hand]
+         [{:type :mouse-down-left
+           :target-props props
+           :args {:pos pos
+                  :client-pos client-pos}}] [(if-let [mouse-down-left-cb (:mouse-down-left props)]
+                         (mouse-down-left-cb world-state ($morph (:id props)) pos client-pos)
+                         world-state) hand]
+         [{:type :mouse-up-left
+           :target-props props
+           :args {}}] [(if-let [mouse-up-left-cb (:mouse-up-left props)]
+                         (mouse-up-left-cb world-state ($morph (:id props)))
+                         world-state) hand]
          [{:type :click-right
            :target-props props
            :args {}}] [(if-let [mouse-click-right-cb (or (:click-right props) (:mouse-click props))]
@@ -62,8 +81,8 @@
                          world-state) hand]
          [{:type :click-left
            :target-props props
-           :args {}}] [(if-let [mouse-click-right-cb (or (:click-left props) (:mouse-click props))]
-                         (mouse-click-right-cb world-state ($morph (:id props)))
+           :args {}}] [(if-let [mouse-click-left-cb (or (:click-left props) (:mouse-click props))]
+                         (mouse-click-left-cb world-state ($morph (:id props)))
                          world-state) hand]
          :else :zero))

@@ -180,10 +199,12 @@
                       (observe editor-id
                                target-morph
                                (fn [world editor inspected-morph _]
-                                 (-> world
-                                   (redefine ($morph editor) (fn [e p s]
-                                                               (set-editor-value
-                                                                (e p s) (fetch world [($morph inspected-morph) description]))))))
+                                 (let [expr (fetch world [($morph inspected-morph) description])]
+                                   (cond-> world
+                                     true (redefine ($morph editor) (fn [e p s]
+                                                                      (set-editor-value (e p s) expr)))
+                                     ;(=> world editor :mapping-active) (putback [($morph inspected-morph) description] expr)
+                                     )))
                                (fn [world editor inspected-morph]
                                  (-> world
                                    (redefine ($morph editor) (fn [e p s]
@@ -483,6 +504,4 @@
 (go
  (<! (init-compiler macro-info (fn [c] (prn "INIT RES" c))))
  (go-loop [] (rerender (<! view)) (recur))
- (pprint (meta (fetch (morph-eval '(ellipse {:id 42} (map (fn [x] (rectangle {:id x :fn (fn [x] 42)})) (range 3)))) [submorphs 0 submorphs 0])))
- (pprint (meta (fetch (ellipse {:id 42} (map (fn [x] (rectangle {:id x :fn (fn [x] 42)})) (range 3))) [submorphs 0 submorphs 0])))
  (run-tests 'cljs-morphic.test))


refactor pending badges

refactor pending badges

--- src/cljs/salava/social/ui/stream.cljs
+++ src/cljs/salava/social/ui/stream.cljs
@@ -10,12 +10,11 @@
             [salava.core.helper :refer [dump]]
             [salava.core.time :refer [date-from-unix-time]]
             [salava.user.ui.helper :refer [profile-picture]]
-            [salava.gallery.ui.badges :as b]
-            [salava.badge.ui.helper :as bh]
             ;[salava.extra.application.ui.helper :refer [application-plugin?]]
             [salava.social.ui.helper :refer [system-image]]
             [salava.core.ui.notactivated :refer [not-activated-banner]]
-            [salava.core.ui.helper :as h :refer [unique-values navigate-to path-for plugin-fun not-activated?]]))
+            [salava.badge.ui.pending :refer [pending-badge-content]]
+            [salava.core.ui.helper :refer [path-for plugin-fun not-activated?]]))

 (defn init-data [state]
@@ -57,7 +56,7 @@
                  (init-data state) )
       :error-handler (fn [{:keys [status status-text]}])}))

-(defn badge-pending [{:keys [id image_file name description meta_badge meta_badge_req issuer_content_name issuer_content_url issued_on issued_by_obf verified_by_obf obf_url]} state]
+#_(defn badge-pending [{:keys [id image_file name description meta_badge meta_badge_req issuer_content_name issuer_content_url issued_on issued_by_obf verified_by_obf obf_url]} state]
   [:div.row {:key id}
    [:div.col-md-12
     [:div.badge-container-pending
@@ -91,6 +90,26 @@
                  :on-click #(do
                               (update-status id "declined" state)
                               (.preventDefault %))}
+        (t :badge/Declinebadge)]]]]]])
+
+(defn badge-pending [badge state]
+  [:div.row {:key (:id badge)}
+   [:div.col-md-12
+    [:div.badge-container-pending
+     [pending-badge-content badge]
+     [:div {:class "row button-row"}
+      [:div.col-md-12
+       [:button {:class "btn btn-primary"
+                 :on-click #(do
+                              (update-status (:id badge) "accepted" state)
+                              (.preventDefault %)
+                              (swap! state assoc :badge-alert "accepted" :badge-name (:name badge)))}
+        (t :badge/Acceptbadge)]
+       [:button {:class "btn btn-warning"
+                 :on-click #(do
+                              (update-status (:id badge) "declined" state)
+                              (.preventDefault %)
+                              (swap! state assoc :badge-alert "declined" :badge-name (:name badge)))}
         (t :badge/Declinebadge)]]]]]])

 (defn badges-pending [state]


Fixing capture reveal problem.

Fixing capture reveal problem.

--- src/cmr/common/dev/capture_reveal.clj
+++ src/cmr/common/dev/capture_reveal.clj
@@ -47,7 +47,7 @@
   to captured values"
   (atom {}))

-(defn- capture-values
+(defn capture-values
   "Stores the captured var-sym-values in the capture-values by namespace. var-sym-values should be
   an alternating list of symbols and their values. the-ns should be the namesspace string name."
   [the-ns & var-sym-values]
@@ -69,12 +69,12 @@
                    ;; Create a sequence of var symbols to the var values.
                    ~@(mapcat (fn [v] [`'~v v]) vars)))

-(defn- reveal-value
+(defn reveal-value
   "Gets the captured value of the given symbol in the namespace."
   [the-ns var-sym]
   (get-in @captured-values [the-ns var-sym]))

-(defn- reveal-all-values
+(defn reveal-all-values
   "Returns all the captured values for a namespace."
   [the-ns]
   (get @captured-values the-ns))


Code formatting.

Code formatting.

--- src/tryclojure/models/eval.clj
+++ src/tryclojure/models/eval.clj
@@ -36,9 +36,8 @@
 (def isla-env (ref (library/get-initial-env)))

 (defn run-isla-code [code]
-  (let [return
-        (interpret (first (:c (first (:c (isla.parser/parse code)))))
-                   (deref isla-env))]
+  (let [return (interpret (first (:c (first (:c (isla.parser/parse code)))))
+                          (deref isla-env))]
     (dosync (ref-set isla-env return))
     (:ret return)))


Fixed game board

Fixed game board

--- src/twentyfortyeight/view.cljs
+++ src/twentyfortyeight/view.cljs
@@ -3,11 +3,9 @@
             [twentyfortyeight.logic :as l]
             [twentyfortyeight.db :as db]))

-;; (def screen-width (.-innerWidth js/window))
-;; (def screen-height (.-innerHeight js/window))
+(def screen-width (.-innerWidth js/window))
+(def screen-height (.-innerHeight js/window))

-(def screen-width 500)
-(def screen-height 500)
 (def board-size 5)

 (def tile-width (/ (min screen-height screen-width) board-size))
@@ -39,6 +37,9 @@
      {:style {:display "flex"
               :width screen-width
               :height screen-height
+              :position "fixed"
+              :x 0
+              :y 0
               :justify-content "center"
               :align-items "center"}}
      [:div


(TK-31) Add proxy explosion test

(TK-31) Add proxy explosion test

Add test that ensures that a proxy request explodes when given
an extremely large cookie and the request buffer size is not
configured.

--- test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_service_proxy_test.clj
+++ test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_service_proxy_test.clj
@@ -1,4 +1,5 @@
 (ns puppetlabs.trapperkeeper.services.webserver.jetty9-service-proxy-test
+  (:import (org.httpkit.client TimeoutException))
   (:require [clojure.test :refer :all]
             [puppetlabs.trapperkeeper.services.webserver.jetty9-service :refer :all]
             [puppetlabs.trapperkeeper.testutils.webserver.common :refer :all]
@@ -92,6 +93,24 @@
           (is (= (:status response) 200))
           (is (= (:body response) "Hello, World!")))))

+    (testing (str "proxy explodes on a large cookie if larger request-buffer-size"
+                  "is not specified")
+      (with-target-and-proxy-servers
+        {:target       {:host "0.0.0.0"
+                        :port 9000}
+         :proxy        {:host "0.0.0.0"
+                        :port 10000}
+         :proxy-config {:host "localhost"
+                        :port 9000
+                        :path "/hello"}}
+        (let [response (http-get "http://localhost:9000/hello/world")]
+          (is (= (:status response) 200))
+          (is (= (:body response) "Hello, World!")))
+        (is (thrown? TimeoutException (http-get "http://localhost:10000/hello-proxy/world"
+                                                {:headers {"Cookie" absurdly-large-cookie}
+                                                 :as      :text
+                                                 :timeout 3000})))))
+
     (testing "proxy does not explode on a large cookie when properly configured"
       (with-target-and-proxy-servers
         {:target       {:host "0.0.0.0"


Added some more code to the move method.

--- src/startrek/nav.clj
+++ src/startrek/nav.clj
@@ -1,8 +1,22 @@
 (ns startrek.nav
+   (:require [startrek.utils :as u])
    (:require [startrek.enterprise :as e])
-   (:require [startrek.klingon :as k]))
+   (:require [startrek.klingon :as k])
+   (:require [clojure.math.numeric-tower :as math]))

 (declare get-course get-warp-factor pick-course pick-warp-factor)
+
+(def course-vector
+  [[]
+   [1 0]   ; dir 1: right
+   [1 -1]  ; dir 2: right and up
+   [0 -1]  ; dir 3: up
+   [-1 -1] ; dir 4: left and up
+   [-1 0]  ; dir 5: left
+   [-1 1]  ; dir 6: left and down
+   [0 -1]  ; dir 7: down
+   [1 1]   ; dir 8: right and down
+   [1 0]]) ; dir 9: same as dir 1

 (defn get-course [] 5)
 (defn get-warp-factor [] 5)
@@ -36,13 +50,64 @@
         (do (println "WARP ENGINES ARE DAMAGED, MAXIMUM SPEED = WARP .2") (recur))
         :else factor))))

-(defn- move [game-state factor course]
-  (let [n (int (* factor 8))]))
+(defn- leave-sector? [coord]
+  (some true? (concat (map #(< % 0.5) coord)
+                      (map #(>= % 8.5) coord))))
+
+(defn- hit-item? [sector coord]
+  (let [p (map #(math/round %) coord)]
+    (pos? (get sector (u/coord-to-index p)))))
+
+(defn- set-sector-position [game-state factor coord]
+  (println (get-in @game-state [:enterprise]))
+  (let [e {:sector coord
+           :energy (- (get-in @game-state [:enterprise :energy])
+                      (+ -5 (* 8 (int factor))))}]
+  (swap! game-state update-in [:enterprise] merge e))
+  (when (> factor 1)
+    (swap! game-state update-in [:stardate :start] + 1)))
+
+(defn- bad-nav [game-state factor coord inc-coord]
+  (let [p (map math/round (map - coord inc-coord))]
+    (println "WARP ENGINES SHUTDOWN AT SECTOR " (seq coord) " DUE TO BAD NAVIGATION")
+    (set-sector-position game-state factor coord)))
+
+(defn warp-travel-distance [enterprise factor inc-coord]
+  (map + (map #(* 8 %) (get-in enterprise [:quadrant]))
+         (get-in enterprise [:sector])
+         (map #(* (* 8 (int factor)) %) inc-coord)))
+
+(defn- leave-sector [game-state factor coord inc-coord]
+  (let [place (warp-travel-distance (get-in @game-state [:enterprise])
+                                    factor
+                                    inc-coord)]
+    (def new-quad (map #(int (/ 8 %)) place))
+    (def new-sector (map #(math/round %) (- place
+                                            (map #(* 8 %) new-quad))))
+    ))
+
+(defn move [game-state course factor]
+  (let [n (int (* factor 8))
+        coord (get-in @game-state [:enterprise :coord])
+        sector (get-in @game-state [:current-sector])
+        course' (int course)]
+    ; clear current enterprise coord
+    (aset sector (u/coord-to-index coord))
+    (let [inc-cord (map + (course-vector course')
+                        (map (partial * (- course course'))
+                             (map - (course-vector (+ course' 1)) (course-vector course'))))]
+      (loop [p (+ coord inc-cord) i n]
+        (cond
+          (leave-sector? p) (leave-sector )
+          (hit-item? p) (bad-nav game-state factor p inc-cord)
+          (zero? i) (set-sector-position game-state factor p)
+          :else (recur p (dec i))))
+      )))

 (defn set-course [game-state]
   (let [course (pick-course) factor (pick-warp-factor (:enterprise @game-state))]
     (assoc-in @game-state [:enterprise] (k/klingon-turn (:enterprise @game-state) (:current-klingons @game-state)))
     (when-not (neg? (get-in @game-state [:enterprise :shields]))
       (e/enterprise-update game-state)
-      (move game-state))))
+      (move game-state course factor))))


[Issue #82] dynamic binding of *num-generations-per-formula* works again

--- src/midje/ideas/formulas.clj
+++ src/midje/ideas/formulas.clj
@@ -27,15 +27,6 @@
                  ~@body :formula :formula-in-progress))
          (recur rest#)))))

-(defmacro the-loop [cnt-down fact docstring? bindings body]
-  (if (pos? cnt-down)
-    `(let [value# ~(second bindings)]
-      (let [~(first bindings) value#]
-        (if ~fact
-          (the-loop ~(dec cnt-down) ~fact ~docstring? ~bindings ~body)
-          (shrink-failure-case ~docstring? ~(first bindings) value# ~body))))
-    `(do nil)))
-
 (defmacro formula
   "ALPHA/EXPERIMENTAL - Generative-style fact macro.

@@ -57,7 +48,12 @@
                                :always-pass midje.sweet/=> :always-pass :formula :formula-conclude )]

       `(try
-         (the-loop ~*num-generations-per-formula* ~fact ~docstring? ~bindings ~body)
+         (loop [cnt-down# midje.ideas.formulas/*num-generations-per-formula*]
+           (when (pos? cnt-down#)
+             (let [~(first bindings) ~(second bindings)]
+               (if ~fact
+                 (recur (dec cnt-down#))
+                 (shrink-failure-case ~docstring? ~(first bindings) ~(second bindings) ~body)))))
          (finally
            ~conclusion-signal)))))


Don't break *print-fn*

Don't break *print-fn*


Added volume control

Added volume control

--- src/moodseer_clj/process.clj
+++ src/moodseer_clj/process.clj
@@ -16,11 +16,6 @@
 ;; ORBIT_SOCKETDIR=/tmp/orbit-gregj

-(def fifo-path "/tmp/MYCMD")
-
-(def player-cmd (str "/usr/bin/mplayer -quiet -slave -input file=" fifo-path " -idle -nocache -nortc"))
-
-
 (defn mplayer-key->keyword [s]
   (->>
    (str/replace s #"(ANS_META_|ANS_)" "")
@@ -37,43 +32,41 @@
    (apply hash-map)
    )))

-(defn mkfifo []
-  (let [fifo-path "/tmp/MYCMD"]
-    (do
-      (sh "rm" "-f" fifo-path)
-      (sh "mkfifo" fifo-path))))
-
-
-;; (defn start-player [& playlist]
-;;   (do
-;;     (mkfifo)
-;;     (Thread/sleep 200)
-;;     (println (str player-cmd " " (clojure.string/join " " playlist) " 1>/tmp/mplayer-out.log 2>&1 & \n echo $!"))
-;;     (sh "bash" "-c" (str player-cmd " " (first playlist) " 1>/tmp/mplayer-out.log 2>&1 & \n echo $!"))))
-
-;; (defn pause-player []
-;;   (sh "bash" "-c" (str "echo 'pause' > " fifo-path) ))
-(defn play-player []
+(defn player-play []
   (sh "mpc" "play"))

-(defn pause-player []
+(defn player-pause []
   (sh "mpc" "toggle"))

-;; (defn step-player
-;;   ([] (step-player 1))
+;; (defn player-step
+;;   ([] (player-step 1))
 ;;   ([step]
 ;;      (sh "bash" "-c" (str "echo 'pt_step " step "' > " fifo-path))))

-(defn next-player []
+(defn player-next []
   (sh "mpc" "next"))

-(defn prev-player []
+(defn player-prev []
   (sh "mpc" "prev"))

-(defn quit-player []
+(defn player-quit []
   (sh "bash" "-c" (str "echo 'quit' > " fifo-path) ))
+
+(defn player-volume-up
+  ([] (player-volume-up 5))
+  ([n]
+     (player-set-volume (str "+" n))))
+
+(defn player-volume-down
+  ([] (player-volume-down 5))
+  ([n]
+     (player-set-volume (str "-" n))))
+
+(defn player-set-volume [n]
+  "Set volume by integer 0-100, or increment (with + or - prefix)"
+  (sh "mpc" "volume" (str n)))

 (defn get-player-track-info []
   (let [x (sh "bash" "-c" "echo 'get_meta_artist\nget_meta_title\nget_meta_album\nget_meta_genre\nget_meta_year\nget_meta_track\nget_meta_comment' > /tmp/MYCMD")
@@ -111,6 +104,11 @@
         ]
     zz))

+(defn get-player-volume []
+  (first
+   (map #(hash-map (keyword (nth % 1)) (nth % 2))
+        (re-seq #"(volume):\s*([0-9]+)" (:out (sh "mpc" "volume"))))))
+
 (defn get-player-upcoming
   "Get pre-formatted upcoming songs"
   ([]


adding common cycle fn

adding common cycle fn

--- test/celestial/integration/puppet.clj
+++ test/celestial/integration/puppet.clj
@@ -4,28 +4,30 @@
     [celestial.persistency :as p])
   (:use
     clojure.test
+    [taoensso.timbre :only (debug info error warn)]
     [celestial.api :only (app)]
     [ring.adapter.jetty :only (run-jetty)]
     [celestial.tasks :only (reload puppetize)]
     [celestial.common :only (config)]
     [celestial.redis :only (clear-all)]
     [celestial.persistency :only (host register-host new-type)]
-    [celestial.fixtures :only (redis-prox-spec redis-ec2-spec local-prox redis-type)]
-    [celestial.puppet-standalone :only (copy-module)]))
+    [celestial.fixtures :only (redis-prox-spec redis-ec2-spec local-prox redis-type)]))
+
+(defn run-cycle [spec type]
+  (let [hostname (get-in redis-ec2-spec [:machine :hostname])]
+    (clear-all)
+    (new-type "redis" type)
+    (register-host spec)
+    (let [vm (reload spec)]
+      (puppetize type (host hostname))
+      (.delete vm))))

 (deftest ^:puppet redis-ec2-provision
   "assumes a working ec2 defs in ~/.celestial.edn"
-  (let [puppet-ami (assoc-in redis-ec2-spec [:aws :image-id] "ami-4eb1ba3a")
-        hostname (get-in redis-ec2-spec [:machine :hostname])]
-    (clear-all)
-    (new-type "redis" redis-type)
-    (register-host redis-ec2-spec)
-    (reload puppet-ami)
-    (puppetize redis-type (host hostname))))
+  (let [puppet-ami (assoc-in redis-ec2-spec [:aws :image-id] "ami-4eb1ba3a")]
+    (run-cycle puppet-ami redis-type)))

-#_(deftest ^:puppet redis-prox-provision
-  (with-redefs [config local-prox]
-    (reload redis-prox-spec)
-    (puppetize redis-type redis-prox-spec)))
+(deftest ^:puppet redis-prox-provision
+    (run-cycle redis-prox-spec redis-type))


(PE-5211) Reorder dependencies for pe-console-services

because apparently order matters when resolving dependencies? So, for
consistency with other projects in this package, order is: 1) clojure libs, 2)
third party libs, 3) puppet labs libs, and alphabetical within each section.

--- configs/pe-console-services/pe-console-services.clj
+++ configs/pe-console-services/pe-console-services.clj
@@ -1,10 +1,10 @@
 (defproject puppetlabs.packages/pe-console-services "{{{pe-console-services-version}}}"
   :description "Release artifacts for console services"
   :pedantic? :abort
-  :dependencies [[puppetlabs/rbac-ui "{{{pe-rbac-ui-version}}}"]
+  :dependencies [[puppetlabs/classifier "{{{pe-classifier-version}}}"]
+                 [puppetlabs/classifier-ui "{{{pe-classifier-ui-version}}}"]
                  [puppetlabs/pe-rbac-service "{{{pe-rbac-version}}}"]
-                 [puppetlabs/classifier-ui "{{{pe-classifier-ui-version}}}"]
-                 [puppetlabs/classifier "{{{pe-classifier-version}}}"]
+                 [puppetlabs/rbac-ui "{{{pe-rbac-ui-version}}}"]
                  ;[puppetlabs/pe-activity-service "{{{pe-classifier-version}}}"]
                  ;[puppetlabs/pe-trapperkeeper-proxy "{{{pe-trapperkeeper-proxy}}}"]
                  [puppetlabs/trapperkeeper-webserver-jetty9 "0.5.2"]]


docs-href conditionally creates link based on cljs namespace or not

--- cljs-shared/cljs_cheatsheet/util.cljs
+++ cljs-shared/cljs_cheatsheet/util.cljs
@@ -22,15 +22,33 @@

 (def uri-encode js/encodeURIComponent)

-(defn- encode-symbol-url
+(defn- encode-symbol-url-clojuredocs
   "Encode URL for clojuredocs.org"
   [s]
   (-> s
       (replace "/" "_fs") ;; divide symbol - "/"
       (replace "?" "_q")))

+(defn- encode-symbol-url-cljs
+  "Encode URL for cljs.github.io"
+  [s]
+  (-> s
+      (replace "/" "SLASH")
+      (replace "?" "QMARK")
+      (replace "!" "BANG")
+      (replace ">" "GT")
+      (replace "<" "LT")
+      (replace "=" "EQ")))
+
 (defn docs-href [name name-space]
-  (str "http://clojuredocs.org/"
-       (uri-encode name-space)
-       "/"
-       (uri-encode (encode-symbol-url name))))
+  (let [cljsns? (= name-space "cljs.core")
+        domain (if cljsns?
+                 "http://cljs.github.io/api/"
+                 "http://clojuredocs.org/")
+        encode-fn (if cljsns?
+                    encode-symbol-url-cljs
+                    encode-symbol-url-clojuredocs)]
+    (str domain
+         (uri-encode name-space)
+         "/"
+         (uri-encode (encode-fn name)))))


Add missing namespace.

Add missing namespace.

--- src/oc/storage/db/common.clj
+++ src/oc/storage/db/common.clj
@@ -2,6 +2,7 @@
   "CRUD function to retrieve entries from RethinkDB with pagination."
   (:require [clj-time.core :as t]
             [clj-time.format :as f]
+            [clj-time.coerce :as c]
             [rethinkdb.query :as r]
             [oc.lib.schema :as lib-schema]
             [oc.lib.time :as lib-time]


Sort Clojure user plugins

Sort Clojure user plugins

--- clojure/lein.symlink/profiles.clj
+++ clojure/lein.symlink/profiles.clj
@@ -2,13 +2,13 @@
                        [org.clojure/tools.namespace "0.2.4"]
                        [clj-stacktrace "0.2.7"]]

-        :plugins [[lein-pprint "1.1.1"]
+        :plugins [[jonase/eastwood "0.0.2"]
+                  [lein-cloverage "1.0.2"]
                   [lein-difftest "2.0.0"]
-                  [lein-cloverage "1.0.2"]
+                  [lein-kibit "0.0.8"]
                   [lein-marginalia "0.7.1"]
-                  [lein-swank "1.4.4"]
-                  [lein-kibit "0.0.8"]
-                  [jonase/eastwood "0.0.2"]]
+                  [lein-pprint "1.1.1"]
+                  [lein-swank "1.4.4"]]

         :injections [(let [orig (ns-resolve (doto 'clojure.stacktrace require)
                                             'print-cause-trace)


Fix tests

Fix tests

--- test/integration/mongo_query_test.clj
+++ test/integration/mongo_query_test.clj
@@ -34,8 +34,10 @@

     (fact "get-metadata returns metadata for a dataset"
         (:name metadata) => "integration_test"
-        (keys metadata) => (contains [:_id :last-modified :name :database :dir :info :concepts :slices :tables])
-        (get-in metadata [:tables :incomes]) =not=> nil
+        (keys metadata) => (contains [:_id :last-modified :name :database :dir
+                                      :info :concepts :slices :compression-map]
+                                     :in-any-order)
+        (get-in metadata [:compression-map :incomes]) =not=> nil
         (get-in metadata [:info :copyright]) => #"public domain"
         (get-in metadata [:slices :incomes :metrics])
         => ["tax_returns" "adjusted_gross_income" "date_observed"]))


AB & JK | 130 | Fixed test definition for question creation

--- test/objective8/unit/actions_test.clj
+++ test/objective8/unit/actions_test.clj
@@ -170,7 +170,7 @@

 (facts "about creating questions"
        (fact "A question can be created"
-             (actions/create-question! question) => {:status ::actions/success :result :stored-question}
+             (actions/create-question! question) => {:status ::actions/success :result stored-question}
              (provided
                (objectives/get-objective OBJECTIVE_ID) => :an-objective
                (writers/retrieve-writer-for-objective USER_ID OBJECTIVE_ID) => nil


Add docstrings to the rest of core-global

--- src/play_clj/core_global.clj
+++ src/play_clj/core_global.clj
@@ -84,6 +84,11 @@
 ; input/output

 (defn game
+  "Calls the global method cooresponding to `k` in a more Clojuresque way
+
+    (game :width)
+    (game :is-touched?)
+"
   [k]
   (case k
     :width (graphics! :get-width)
@@ -96,19 +101,31 @@
     (u/throw-key-not-found k)))

 (defmacro key-code
+  "Returns the static field cooresponding to `k` from [Input.Keys](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/Input.Keys.html)
+
+    (key-code :a)
+    (key-code :page-down)
+"
   [k]
   `~(symbol (str u/main-package ".Input$Keys/" (u/key->upper k))))

 (defmacro is-pressed?
+  "Returns a boolean indicating if the key cooresponding to `k` is being pressed
+
+    (is-pressed? :a)
+    (is-pressed? :page-down)
+"
   [k]
   `(input! :is-key-pressed (key-code ~k)))

 (defn ^:private add-input!
+  "Internal use only"
   [^InputProcessor p]
   (let [^InputMultiplexer multi (input! :get-input-processor)]
     (.addProcessor multi p)))

 (defn ^:private remove-input!
+  "Internal use only"
   [^InputProcessor p]
   (let [^InputMultiplexer multi (input! :get-input-processor)]
     (.removeProcessor multi p)))