lein-release plugin: preparing 0.41 release

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject shuppet "0.41-SNAPSHOT"
+(defproject shuppet "0.41"
   :description "Shuppet service"
   :url "http://wikis.in.nokia.com/NokiaMusicArchitecture/Shuppet"


Set version to 0.11.0.

Set version to 0.11.0.

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject buddy/buddy-sign "0.10.0"
+(defproject buddy/buddy-sign "0.11.0"
   :description "High level message signing for Clojure"
   :url "https://github.com/funcool/buddy-sign"
   :license {:name "Apache 2.0"


Release 0.3.2

Release 0.3.2

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject data-frisk-reagent "0.3.1"
+(defproject data-frisk-reagent "0.3.2"
   :description "Frisking EDN since 2016!"
   :url "http://github.com/odinodin/data-frisk-reagent"
   :license {:name "MIT"


Add environ library for handling env variables

--- project.clj
+++ project.clj
@@ -7,11 +7,13 @@
   :dependencies [[org.clojure/clojure "1.7.0"]
                  [org.clojure/clojurescript "1.7.122"]
                  [org.clojure/core.async "0.1.346.0-17112a-alpha"]
+                 [environ "1.0.1"]
                  [sablono "0.3.6"]
                  [org.omcljs/om "0.9.0"]]

   :plugins [[lein-cljsbuild "1.1.0"]
-            [lein-figwheel "0.4.1"]]
+            [lein-figwheel "0.4.1"]
+            [lein-environ "1.0.1"]]

   :source-paths ["src"]


up version

up version

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject pjson "0.3.8"
+(defproject pjson "0.4.0"
             :description "Fast clojure json library"
             :url "https://github.com/gerritjvv/pjson"
             :license {:name "Eclipse Public License"


Update project file for 0.1.0 release

Update project file for 0.1.0 release

--- project.clj
+++ project.clj
@@ -1,8 +1,8 @@
-(defproject howl "0.1.0-SNAPSHOT"
-  :description "FIXME: write description"
-  :url "http://example.com/FIXME"
-  :license {:name "Eclipse Public License"
-            :url "http://www.eclipse.org/legal/epl-v10.html"}
+(defproject howl "0.1.0"
+  :description "Tools for processing HOWL format"
+  :url "https://github.com/ontodev/howl"
+  :license {:name "Simplified BSD License"
+            :url "http://opensource.org/licenses/BSD-2-Clause"}
   :dependencies [[org.clojure/clojure "1.7.0"]
                  [instaparse "1.4.1"]
                  [org.clojure/tools.cli "0.3.3"]


upgrade logging deps

upgrade logging deps

--- project.clj
+++ project.clj
@@ -12,8 +12,8 @@
                  [io.dropwizard.metrics/metrics-core "3.1.0"]
                  [io.dropwizard.metrics/metrics-jvm "3.1.0"]
                  [measure "0.1.7"]
-                 [org.clojure/tools.logging "0.2.6"]
-                 [ch.qos.logback/logback-classic "1.1.1"]]
+                 [org.clojure/tools.logging "0.3.1"]
+                 [ch.qos.logback/logback-classic "1.1.2"]]
   :plugins [[lein-ring "0.8.10"]
             [lein-elastic-beanstalk "0.2.8-SNAPSHOT"]
             ;[lein-beanstalk "0.2.7"]


Run nashorn tests with cljs profile.

Run nashorn tests with cljs profile.

--- project.clj
+++ project.clj
@@ -29,7 +29,7 @@
   :profiles {:dev {:dependencies [[lein-doo "0.1.6"]]}
              :cljs {:dependencies [[org.clojure/clojurescript "1.9.293"]]}}

-  :aliases {"test-nashorn" ["doo" "nashorn" "test"]}
+  :aliases {"test-nashorn" ["with-profile" "cljs" "doo" "nashorn" "test"]}

   :plugins [[lein-cljsbuild "1.1.3"]
             [lein-doo "0.1.6"]]


0.9.0-wip11

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject storm/storm "0.9.0-wip10"
+(defproject storm/storm "0.9.0-wip11"
   :url "http://storm-project.clj"
   :description "Distributed and fault-tolerant realtime computation"
   :license {:name "Eclipse Public License - Version 1.0" :url "https://github.com/nathanmarz/storm/blob/master/LICENSE.html"}


Bump to new snapshot.

Bump to new snapshot.

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject backtype/cascading-thrift "0.2.2"
+(defproject backtype/cascading-thrift "0.2.3-SNAPSHOT"
   :source-path "src/clj"
   :java-source-path "src/jvm"
   :javac-options {:debug "true" :fork "true"}


Now working on 0.3.0-SNAPSHOT

Now working on 0.3.0-SNAPSHOT

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject io.tilde.momentum/momentum "0.2.0"
+(defproject io.tilde.momentum/momentum "0.3.0-SNAPSHOT"
   :description "Async HTTP framework built on top of Netty"

   :dependencies [[org.clojure/clojure   "1.3.0"]


Updating to 1.0.0

Updating to 1.0.0

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject com.okl.tokenmgr "1.0.0-SNAPSHOT"
+(defproject com.okl.tokenmgr "1.0.0"
   :description "Store tokens in zookeeper and filter them"
   :url "https://github.com/okl/danger-tokenmgr"
   :dependencies [[org.clojure/clojure "1.5.1"]


obb-rules v1.3.6

obb-rules v1.3.6


0.3.0

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject org.commos/delta "0.3.0-SNAPSHOT"
+(defproject org.commos/delta "0.3.0"
   :description "Communicate changes of compound values"
   :url "http://github.com/commos/delta"
   :license {:name "Eclipse Public License"


Release 5.1.1

Release 5.1.1

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject cheshire "5.1.1-SNAPSHOT"
+(defproject cheshire "5.1.1"
   :description "JSON and JSON SMILE encoding, fast."
   :url "https://github.com/dakrone/cheshire"
   :license {:name "The MIT License"


Fix race condition, cleanup in background thread to not delay exit (fixes #156)

--- boot/pod/src/boot/pod.clj
+++ boot/pod/src/boot/pod.clj
@@ -347,21 +347,25 @@
   (let [run? (atom true)
         pri  (or priority Thread/NORM_PRIORITY)
         q    (LinkedBlockingQueue. (int size))
+        q*   (promise)
         poll #(.poll % 1 TimeUnit/SECONDS)
-        putp #(util/with-let [p (promise)] (.put % p))
+        putp #(util/with-let [p (promise)]
+                (.put % p)
+                (when-not (realized? q*)
+                  (deliver q* q)))
         fill #(util/while-let [p (and @run? (putp q))]
                 (deliver p (when @run? (create))))
-        take #(deref (.peek q))
-        swap #(destroy @(.take q))
-        stop #(do (reset! run? false)
-                  (util/while-let [p (poll q)]
-                    (destroy @p)))]
+        take #(deref (.peek @q*))
+        swap #(destroy @(.take @q*))
+        stop #(future (reset! run? false)
+                      (util/while-let [p (poll @q*)]
+                         (destroy @p)))]
     (doto (Thread. fill) (.setDaemon true) (.setPriority pri) .start)
     (fn
       ([] (take))
       ([op] (case op
               :shutdown (stop)
-              :take     @(.take q)
+              :take     @(.take @q*)
               :refresh  (do (swap) (take)))))))

 (defn- init-pod!


Add random beat number dynamic parameter.

--- src/afterglow/effects/fun.clj
+++ src/afterglow/effects/fun.clj
@@ -9,7 +9,7 @@
             [afterglow.effects.params :as params]
             [afterglow.rhythm :as rhythm]
             [afterglow.show :as show]
-            [afterglow.show-context :refer [*show*]]
+            [afterglow.show-context :refer [*show* with-show]]
             [afterglow.transform :as transform]
             [clojure.math.numeric-tower :as math]
             [com.evocomputing.colors :as colors]
@@ -426,3 +426,72 @@
                                                   :ignore-y true :ignore-z true)]
     (color-cycle-chase fixtures measure :color-cycle color-cycle :color-index-function color-index-function
                        :transition-phase-function transition-phase-function :effect-name effect-name)))
+
+(defn- pick-new-value
+  "Helper function for random-beat-number-param to pick a new random
+  value with a minimum difference from the former value."
+  [old-value min range min-change]
+  (loop [new-value (+ min (rand range))]
+    (if (or (nil? old-value)
+            (>= (math/abs (- new-value old-value)) min-change))
+      new-value
+      (recur (+ min (rand range))))))
+
+(defn random-beat-number-param
+  "Returns a dynamic number parameter which gets a new random value on each beat."
+  {:doc/format :markdown}
+  [& {:keys [min max min-change] :or {min 0 max 255 min-change 0}}]
+  {:pre [(some? *show*)]}
+  (let [min (params/bind-keyword-param min Number 0)
+        max (params/bind-keyword-param max Number 255)
+        min-change (params/bind-keyword-param min-change Number 0)
+        last-beat (ref nil)
+        last-value (ref nil)]
+    (if-not (some (partial satisfies? params/IParam) [min max min-change])
+      ;; Optimize the simple case of all constant parameters
+      (let [range (- max min)
+            eval-fn (fn [_ snapshot]
+                      ;; TODO support min-change
+                      (dosync (when (not= @last-beat (:beat snapshot))
+                                (ref-set last-beat (:beat snapshot))
+                                (alter last-value pick-new-value min range min-change))
+                              @last-value))]
+        (when-not (pos? range)
+          (throw (IllegalArgumentException. "min must be less than max")))
+        (when-not (< min-change (/ range 3))
+          (throw (IllegalArgumentException. "min-change must be less 1/3 the range")))
+        (reify params/IParam
+          (evaluate [this show snapshot] (eval-fn show snapshot))
+          (frame-dynamic? [this] true)
+          (result-type [this] Number)
+          (resolve-non-frame-dynamic-elements [this show snapshot]  ; Nothing to resolve, return self
+            this)))
+      ;; Support the general case where we have an incoming variable parameter
+      (let [eval-fn (fn [show snapshot]
+                      (let [min (params/resolve-param min show snapshot)
+                            max (params/resolve-param max show snapshot)
+                            min-change (params/resolve-param min-change show snapshot)
+                            range (- max min)]
+                        ;; TODO support min-change
+                        (if (neg? range)
+                          (do
+                            (timbre/error "Random beat number parameters min > max, returning max.")
+                            max)
+                          (if (< min-change (/ range 3))
+                              (dosync (when (not= @last-beat (:beat snapshot))
+                                        (ref-set last-beat (:beat snapshot))
+                                        (alter last-value pick-new-value min range min-change))
+                                      @last-value)
+                              (do
+                                (timbre/error "Random beat number min-change > 1/3 range, returning max.")
+                                max)))))]
+        (reify params/IParam
+          (evaluate [this show snapshot] (eval-fn show snapshot))
+          (frame-dynamic? [this] true)
+          (result-type [this] Number)
+          (resolve-non-frame-dynamic-elements [this show snapshot]
+            (with-show show
+              (random-beat-number-param :min (params/resolve-unless-frame-dynamic min show snapshot)
+                                        :max (params/resolve-unless-frame-dynamic max show snapshot)
+                                        :min-change (params/resolve-unless-frame-dynamic
+                                                     min-change show snapshot)))))))))


Fix get-all-problem

Fix get-all-problem

--- src/antlion_clojure/redis.clj
+++ src/antlion_clojure/redis.clj
@@ -50,7 +50,7 @@
           read-string))

 (defn get-all-problem []
-  (wcar* (car/hgetall key-problem)))
+  (wcar* (car/hgetall* key-problem)))

 (defn del-problem
   [problem]


Made the record factory more idiomatic.

Made the record factory more idiomatic.

--- src/appengine_magic/utils.clj
+++ src/appengine_magic/utils.clj
@@ -8,14 +8,13 @@
            javax.xml.transform.stream.StreamResult))

-;;; From: http://groups.google.com/group/clojure/msg/5206fac13144ea99
+;;; Adapted from: http://groups.google.com/group/clojure/msg/5206fac13144ea99
 (defmacro record
   "Dynamic factory for Clojure record objects."
-  ([name] `(record ~name {}))
-  ([name vals-map]
-     `(let [con# (first (.getDeclaredConstructors ~name))
-            num# (alength (.getParameterTypes con#))]
-        (merge (.newInstance con# (make-array Object num#)) ~vals-map))))
+  [name & {:as vals-map}]
+  `(let [con# (first (.getDeclaredConstructors ~name))
+         num# (alength (.getParameterTypes con#))]
+     (merge (.newInstance con# (make-array Object num#)) ~vals-map)))

 (defn dash_ [s]


~(defn get-lexemes): fix typo that was preventing matching from working

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -168,21 +168,17 @@
    is a function that we call with _spec_ to get a set of lexemes
    that matches the given _spec_."
   [spec]
-  (let [result
-         (->> (index-fn spec)
-              (filter #(and
-                         (or (nil? lexical-filter) (lexical-filter %))
-                         ;; TODO: probably remove this in favor of per-language filtering as we
-                         ;; do in italiano.lab/lexical-filter, where we (binding [babel.generate/lexical-filter-fn]).
-                         (= false (u/get-in % [:exception] false))
-                         (not (= :verb (u/get-in % [:synsem :cat])))))
-              (map #(unify % spec))
-              (filter #(not (= :fail %)))
-              (map #(u/assoc-in! % [::done?] true)))]
-    (println (str "found this many lexemes: " (count result)))
-    (if (= 0 (count result))
-      (println (str "WARN: no lexemes found for spec: " (u/strip-refs spec))))
-    result))
+  (if (= true (u/get-in spec [:phrasal]))
+    []
+    (->> (index-fn spec)
+         (filter #(and (or (nil? lexical-filter) (lexical-filter %))
+                       ;; TODO: probably remove this in favor of per-language filtering as we
+                       ;; do in italiano.lab/lexical-filter, where we (binding [babel.generate/lexical-filter-fn]).
+                       (or (= false (u/get-in % [:exception] false))
+                           (not (= :verb (u/get-in % [:synsem :cat]))))))
+         (map #(unify % spec))
+         (filter #(not (= :fail %)))
+         (map #(u/assoc-in! % [::done?] true)))))

 (defn- assoc-each-default [tree children path]
   (if (not (empty? children))


improve logging

improve logging

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -185,8 +185,17 @@

                           (and (empty? filtered-lexical-complements)
                                (empty? phrasal-complements))
-                          (log/warn (str "failed to generate both phrasal or lexical complements with spec: "
-                                         (strip-refs spec)))
+                          (let [cat (get-in spec [:synsem :cat] :top)
+                                pred (get-in spec [:synsem :sem :pred] :top)
+                                subcat1-cat (get-in spec [:synsem :subcat :1 :cat] :none)
+                                subcat1-pred (get-in spec [:synsem :subcat :1 :sem :pred] :none)]
+                            (log/warn (str "failed to generate both phrasal or lexical complements for rule: "
+                                           (get-in bolt (concat (butlast path) [:rule]) :norule-wtf) " "
+                                           "with "
+                                           "cat: " cat "; "
+                                           "pred: " pred "; "
+                                           "subcat1 cat: " subcat1-cat "; "
+                                           "subcat1 pred: " subcat1-pred)))

                           lexemes-before-phrases
                           (lazy-cat (lazy-shuffle filtered-lexical-complements) phrasal-complements)


+(defn test-cm)

+(defn test-cm)

--- src/babel/italiano.cljc
+++ src/babel/italiano.cljc
@@ -140,10 +140,6 @@
            true
            (str "don't know how to parse input: " (type input))))))

-;;(let [m (create-model "cane" "nero")]
-;;                 (repeatedly #(println (morph (generate {:synsem {:subcat []}
-;;                                                         :head {:phrasal true}} m)))))
-
 (defn create-model [ & words]
   (let [base-model (babel.italiano.grammar/model)
         base-lexicon
@@ -166,7 +162,9 @@
                (get (:lexicon base-model) word))
              (sort words))))))))

+(defn test-cm []
+  (let [m (create-model "io" "ti" "mi" "vedere")]
+    (repeatedly #(println (morph (generate {:synsem {:subcat []}
+                                            :head {:phrasal true}} m))))))

-
-


change echo message token for inducers

change echo message token for inducers

--- src/bract/core/echo.clj
+++ src/bract/core/echo.clj
@@ -90,7 +90,7 @@
   [message & body]
   `(let [start# (System/currentTimeMillis)
          messg# ~message]
-     (echof "Starting '%s'" messg#)
+     (echof "Invoking '%s'" messg#)
      (try
        ~@body
        (finally


Close intermediate result-ch's.

Close intermediate result-ch's.

--- src/cbfg/world-net.cljs
+++ src/cbfg/world-net.cljs
@@ -64,12 +64,14 @@
                   (ago init-world world
                        (aput init-world listen-ch [:server 8000 listen-result-ch])
                        (when-let [[accept-ch close-accept-ch] (atake init-world listen-result-ch)]
+                         (atake init-world listen-result-ch)
                          (server-accept-loop world accept-ch close-accept-ch)
                          (ago client-init world
                               (let [connect-result-ch (achan client-init)]
                                 (aput client-init connect-ch [:server 8000 :client connect-result-ch])
                                 (when-let [[client-send-ch client-recv-ch close-client-recv-ch]
                                            (atake client-init connect-result-ch)]
+                                  (atake client-init connect-result-ch)
                                   (client-loop world cmd-ch
                                                client-hist
                                                client-send-ch client-recv-ch


Added optional force-coords param to render-net.

--- src/cbfg/world/net.cljs
+++ src/cbfg/world/net.cljs
@@ -92,7 +92,9 @@
               true
               (conj out (render-msg curr-msg "msg-enter" "")))))))

-(defn render-net-html [net-state prev-addrs & {:keys [addr-attrs-fn]}]
+(defn render-net-html [net-state prev-addrs &
+                       {:keys [addr-attrs-fn force-coords]
+                        :or {addr-attrs-fn nil force-coords {}}}]
   (let [addrs (atom {})
         coords (atom {})] ; Index positions.
     (doseq [[[addr port] accept-chs] (:listens net-state)]
@@ -136,7 +138,7 @@
           line-height 20
           addr-width 50
           addr-gap 80
-          calc-xy (fn [addr] (let [[c0 c1] (get coords addr)]
+          calc-xy (fn [addr] (let [[c0 c1] (get force-coords addr (get coords addr))]
                                [(* addr-width c0 (/ (+ addr-width addr-gap) addr-width))
                                 (* top-height c1)]))
           h ["<div style='height:" (apply max (map #(count (:outs %))


adding su user

adding su user

--- src/celestial/roles.clj
+++ src/celestial/roles.clj
@@ -1,16 +1,41 @@
+(comment
+  Celestial, Copyright 2012 Ronen Narkis, narkisr.com
+  Licensed under the Apache License,
+  Version 2.0  (the "License") you may not use this file except in compliance with the License.
+  You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+  Unless required by applicable law or agreed to in writing, software
+  distributed under the License is distributed on an "AS IS" BASIS,
+  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+  See the License for the specific language governing permissions and
+  limitations under the License.)
+
 (ns celestial.roles
-  "celetial roles")
+  "Celetial roles
+  * Admin can access any machine and change any user
+  * Super user can access any machine but cant change users
+  * User can access only his machines (no user manipulation at all)
+  * Anonymous can't access any machine nor any other service
+  Note that by 'any machine' we mean any machine in the environments he is allowed
+  to access.
+  ")

 (def ^{:doc "roles string to keyword map"}
-  roles-m {"admin" ::admin "user" ::user "anonymous" ::anonymous})
+  roles-m {"admin" ::admin "user" ::user "super-user" ::super-user "anonymous" ::anonymous})

 (def roles (into #{} (vals roles-m)))

 (derive ::admin ::user)

+(derive ::super-user ::user)
+
 (def user #{::user})

 (def admin #{::admin})

+(def su #{::super-user})
+
 (defn admin? [{:keys [roles] :as user}]
   (clojure.set/subset? admin roles))
+
+(defn su? [{:keys [roles] :as user}]
+  (clojure.set/subset? su roles))


added hurt oneself hurt

added hurt oneself hurt

--- src/babel/english/lexicon.clj
+++ src/babel/english/lexicon.clj
@@ -678,6 +678,25 @@
     :english {:past "hugged"
               :participle "hugging"}}

+    "hurt" (let [subject-semantics (ref {:human true})]
+               :english {:past "hurt"}
+               {:synsem {:cat :verb
+                         :sem {:pred :hurt-oneself
+                               :subj subject-semantics
+                               :obj subject-semantics}
+                         :subcat {:1 {:sem subject-semantics}
+                                  :2 {:pronoun true
+                                      :reflexive true
+                                      :sem subject-semantics}}}})
+
+
+    "hurt"
+   {:synsem {:cat :verb
+             :sem {:pred :hurt
+                   :subj {:human true}
+                   :obj {:animate true}}}
+    :english {:past "hurt"}}
+
     "Juan and I"
       [{:synsem {:cat :noun
                  :pronoun true


added comenzar hervir

added comenzar hervir

--- src/babel/espanol/lexicon.clj
+++ src/babel/espanol/lexicon.clj
@@ -320,6 +320,11 @@
                        :sem {:pred :talk
                              :subj {:human true}}}}]

+   "hervir" {:espanol {:boot-stem1 "hierv"
+                        :boot-stem2 "herv"}
+             :synsem {:cat :verb
+                      :sem {:pred :boil}}}
+
    "ir" {:espanol {:future-stem "ir"
                    :present {:1sing "voy"
                              :2sing "vas"


fix typo

fix typo

--- src/babel/espanol/lexicon.clj
+++ src/babel/espanol/lexicon.clj
@@ -244,10 +244,11 @@
                  {:unify [common]
                   :synsem {:cat :verb
                          :sem {:pred :drive-c}}}])
-   "conocer" {synsem {espanol {present {:1sing "conozco"}}}}
-                {:synsem {:cat :verb
-                          :sem {:pred :know}}}
-
+
+   "conocer" {:espanol {:present {:1sing "conozco"}}
+              :synsem {:cat :verb
+                       :sem {:pred :know}}}
+
    "consentir" {:espanol {:boot-stem "consient"}
                 :synsem {:cat :verb
                          :sem {:pred :consent}}}


cleanup

cleanup

--- src/babel/italiano/writer.clj
+++ src/babel/italiano/writer.clj
@@ -23,7 +23,7 @@
                            (not (= :top (get-in lexeme [:synsem :sem :pred] :top)))))
                         lexeme-set))
               (vals @lexicon)))]
-    (if true
+    (if false
       (delete-from-expressions "it" {:synsem {:sem {:subj {:pred :io}}}}))

     (write-lexicon "it" @lexicon)


improve duration string

improve duration string

--- iwaswhere-web/src/cljc/iwaswhere_web/utils/misc.cljc
+++ iwaswhere-web/src/cljc/iwaswhere_web/utils/misc.cljc
@@ -20,13 +20,11 @@
   [entry]
   (let [arrival-ts (:arrival-timestamp entry)
         depart-ts (:departure-timestamp entry)
-        dur (when (and arrival-ts depart-ts)
+        secs (when (and arrival-ts depart-ts)
               (let [dur (- depart-ts arrival-ts)]
-                (if (int? dur)
-                  (/ dur 1000)
-                  (Math/floor dur))))]
-    (when (and dur (< dur 99999999))
-      (str ", " (duration-string dur)))))
+                (Math/floor (if (int? dur) (/ dur 1000) dur))))]
+    (when (and secs (< secs 99999999))
+      (str ", " (duration-string secs)))))

 (defn pvt-filter
   "Filter for entries considered private."


run eastwood on core

run eastwood on core

--- src/civs/model/core.clj
+++ src/civs/model/core.clj
@@ -85,10 +85,6 @@
     (required-by-id game (:political-entity-id group))
     (catch IllegalArgumentException e
       (throw (IllegalStateException. (str "Political entity for group " group " not found") e)))))
-
-; Return the Culture of the entity
-(defn culture [game el]
-  (.culture (to-political-entity game el)))

 (defn society [game el]
   (.society (to-political-entity game el)))
@@ -238,8 +234,9 @@
             gs (conj gs group-id)]
         (assoc pe :groups gs)))))

-(defn- by-id-with-collection [game id]
+(defn- by-id-with-collection
   "Return the element associated to the id"
+  [game id]
   (reduce
     #(let
        [res (get-in game [%2 id])]
@@ -248,8 +245,9 @@
          {:element res :collection %2}))
     nil [:groups :settlements :political-entities]))

-(defn by-id [game id]
+(defn by-id
   "Return the element associated to the id"
+  [game id]
   (:element (by-id-with-collection game id)))

 (defn required-by-id [game id]
@@ -266,6 +264,7 @@
   (let [{element :element, collection :collection} (by-id-with-collection game id)]
     (update-in game [collection id] f)))

+; Return the Culture of the entity
 (defn culture [game x]
   {:pre [(not (nil? x))]}
   (.culture (to-political-entity game x)))


Removed more dumb capitalization issues.

--- src/cljfastdtw/core.clj
+++ src/cljfastdtw/core.clj
@@ -1,4 +1,4 @@
-(ns cljfastDTW.core
+(ns cljfastdtw.core
   (:import [com.timeseries TimeSeries TimeSeriesPoint]
            [com.dtw FastDTW DTW]
            [java.util ArrayList]))


first, rest rewritten in RT.java style as per David Nolen's idea

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -500,14 +500,23 @@
   "Returns the first item in the collection. Calls seq on its
   argument. If coll is nil, returns nil."
   [coll]
-  (when-let [s (seq coll)]
-    (-first s)))
+  (when (coercive-not= coll nil)
+    (if (satisfies? ISeq coll)
+      (-first coll)
+      (let [s (seq coll)]
+        (when (coercive-not= s nil)
+          (-first s))))))

 (defn rest
   "Returns a possibly empty seq of the items after the first. Calls seq on its
   argument."
   [coll]
-  (-rest (seq coll)))
+  (when (coercive-not= coll nil)
+    (if (satisfies? ISeq coll)
+      (-rest coll)
+      (let [s (seq coll)]
+        (when (coercive-not= s nil)
+          (-rest s))))))

 (defn next
   "Returns a seq of the items after the first. Calls seq on its


Improved authorization backend.

Improved authorization backend.

--- src/buddy/auth/middleware.clj
+++ src/buddy/auth/middleware.clj
@@ -79,16 +79,11 @@
                   backend)]
     (fn [request]
       (try+
-       (handler request)
-       (catch [:type :buddy.auth/unauthorized] {:keys [payload]}
-         (proto/handle-unauthorized backend request errordata))
-       (catch Object e
-         (if (satisfies? proto/IAuthorizationdError e)
-           (->> (proto/get-error-data e)
-                (proto/handle-unauthorized backend request))
-           (throw+)))))))
-
-(extend-protocol proto/IAuthorizationdError
-  buddy.exceptions.UnauthorizedAccessException
-  (get-error-data [this]
-    (.-metadata this)))
+        (handler request)
+        (catch [:type :buddy.auth/unauthorized] {:keys [payload]}
+          (proto/handle-unauthorized backend request errordata))
+        (catch Object e
+          (if (satisfies? proto/IAuthorizationdError e)
+            (->> (proto/get-error-data e)
+                 (proto/handle-unauthorized backend request))
+            (throw+)))))))


support *print-length*

support *print-length*

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -34,12 +34,14 @@
 (def ^:dynamic *print-readably* true)
 (def ^:dynamic *print-meta* false)
 (def ^:dynamic *print-dup* false)
+(def ^:dynamic *print-length* nil)

 (defn- pr-opts []
   {:flush-on-newline *flush-on-newline*
    :readably *print-readably*
    :meta *print-meta*
-   :dup *print-dup*})
+   :dup *print-dup*
+   :print-length *print-length*})

 (declare into-array)

@@ -6600,9 +6602,14 @@
   (-write writer begin)
   (when (seq coll)
     (print-one (first coll) writer opts))
-  (doseq [o (next coll)]
+  (loop [coll (next coll) n (:print-length opts)]
+    (when (and coll (or (nil? n) (not (zero? n))))
+      (-write writer sep)
+      (print-one (first coll) writer opts)
+      (recur (next coll) (dec n))))
+  (when (:print-length opts)
     (-write writer sep)
-    (print-one o writer opts))
+    (print-one "..." writer opts))
   (-write writer end))

 (defn write-all [writer & ss]


Fixes for the previous commit

Fixes for the previous commit

--- src/cljs/zest/core.cljs
+++ src/cljs/zest/core.cljs
@@ -222,7 +222,7 @@
                (do
                  (reset! hash new-hash)
                  (aset (.getElementById js/document "right") "className"
-                       (str "_" (nth (.split docset "~") 1)))
+                       (str "_" (nth (.split docset "~") 0)))
                  (async-set-html response #(set-hash new-hash))
                  (set-600ms-focus)))))))

@@ -245,7 +245,8 @@
         {:class    (str (if (= @index i) "collection-item active"
                                          "collection-item")
                         (if (not (= (.-path (.-contents item)) "__FTS__"))
-                          (str " _list-item " "_icon-" (.-docset item))
+                          (str " _list-item " "_icon-"
+                               (nth (.split (.-docset item) "~") 0))
                           ""))
          :href     "#"
          :on-click (fn []


Added a @work command

Added a @work command

--- src/clojurebot/core.clj
+++ src/clojurebot/core.clj
@@ -64,6 +64,12 @@
   "Yep, you're the most correct of them all."))

 (reg-command
+  "work"
+  #(cond cmd
+      "init" "Bleep bloop, initializing work..."
+      "end"  "Bleep bloop, work terminated"))
+
+(reg-command
  "coin"
  (fn [_]
    (if (zero? (rand-int 2))


single action added

single action added

--- src/celestial/api/actions.clj
+++ src/celestial/api/actions.clj
@@ -32,7 +32,7 @@
 (defroutes- actions {:path "/actions" :description "Adhoc actions managment"}

   (POST- "/actions" [& ^:action action] {:nickname "addActions" :summary "Adds an actions set"}
-    (wrap-errors (success {:msg "added actions" :id (a/add-action action)})))
+    (wrap-errors (success {:msg "added action" :id (a/add-action action)})))

   (PUT- "/actions/:id" [^:int id & ^:action action] {:nickname "updateActions" :summary "Update an actions set"}
         (wrap-errors


Log when aborting a build

Log when aborting a build

--- src/circle/backend/action.clj
+++ src/circle/backend/action.clj
@@ -3,7 +3,8 @@
   (:use [arohner.validation :only (validate!)]
         [circle.utils.predicates :only (bool? ref?)]
         [circle.utils.args :only (require-args)]
-        [circle.utils.except :only (throw-if throw-if-not)]))
+        [circle.utils.except :only (throw-if throw-if-not)]
+        [clojure.tools.logging :only (errorf)]))

 (defrecord Action [name
                    act-fn ;; an fn of one argument, the session. If returns falsy, the action has "failed" and the on-fail code is run
@@ -46,6 +47,7 @@
 (defn abort!
   "Stop the build."
   [build message]
+  (errorf "Aborting build: %s" message)
   (dosync
    (alter build assoc :continue? false)
    (alter build assoc :failed? true)))


Implement Independent Thinking

Implement Independent Thinking

--- src/clj/game/cards-events.clj
+++ src/clj/game/cards-events.clj
@@ -241,6 +241,12 @@
                                :effect (req (doseq [c (take 5 (:deck corp))]
                                               (move state side c :play-area)))}} card))}

+   "Independent Thinking"
+   (let [cards-to-draw (fn [ts] (* (count ts) (if (not-any? #(has? % :subtype "Directive") ts) 1 2)))]
+     {:choices {:max 5 :req #(and (:installed %) (= (:side %) "Runner"))}
+      :effect (effect (trash-cards targets) (draw :runner (cards-to-draw targets)))
+      :msg (msg "trash " (count targets) " card" (when (not= 1(count targets)) "s") " and draw " (cards-to-draw targets) " cards")})
+
    "Infiltration"
    {:prompt "Gain 2 [Credits] or expose a card?" :choices ["Gain 2 [Credits]" "Expose a card"]
     :effect (effect (resolve-ability (if (= target "Expose a card")


add test for Test Run returning hosted programs to Stack

--- src/clj/test/cards-events.clj
+++ src/clj/test/cards-events.clj
@@ -468,6 +468,43 @@
       (prompt-select :runner gd)
       (is (= 3 (get-in (refresh gd) [:counter])) "Surge does not trigger on Gorman Drip"))))

+(deftest test-run
+  "Test Run - Programs hosted after install get returned to Stack. Issue #1081"
+  (do-game
+    (new-game (default-corp [(qty "Wraparound" 1)])
+              (default-runner [(qty "Test Run" 2) (qty "Morning Star" 1)
+                               (qty "Knight" 1) (qty "Leprechaun" 1)]))
+    (play-from-hand state :corp "Wraparound" "HQ")
+    (let [wrap (get-ice state :hq 0)]
+      (core/rez state :corp wrap)
+      (take-credits state :corp)
+      (core/gain state :runner :credit 5)
+      (core/move state :runner (find-card "Morning Star" (:hand (get-runner))) :discard)
+      (core/move state :runner (find-card "Knight" (:hand (get-runner))) :discard)
+      (let [ms (find-card "Morning Star" (:discard (get-runner)))]
+        (play-from-hand state :runner "Leprechaun")
+        (play-from-hand state :runner "Test Run")
+        (prompt-choice :runner "Heap")
+        (prompt-choice :runner ms)
+        (let [lep (get-in @state [:runner :rig :program 0])
+              ms (get-in @state [:runner :rig :program 1])]
+          (card-ability state :runner lep 1)
+          (prompt-select :runner ms)
+          (is (= "Morning Star" (:title (first (:hosted (refresh lep))))) "Morning Star hosted on Lep")
+          (take-credits state :runner)
+          (is (= "Morning Star" (:title (first (:deck (get-runner))))) "Morning Star returned to Stack from host")
+          (take-credits state :corp)
+          (let [kn (find-card "Knight" (:discard (get-runner)))]
+            (play-from-hand state :runner "Test Run")
+            (prompt-choice :runner "Heap")
+            (prompt-choice :runner kn)
+            (let [kn (get-in @state [:runner :rig :program 1])]
+              (card-ability state :runner kn 0)
+              (prompt-select :runner wrap)
+              (is (= "Knight" (:title (first (:hosted (refresh wrap))))) "Knight hosted on Wraparound")
+              (take-credits state :runner)
+              (is (= "Knight" (:title (first (:deck (get-runner))))) "Knight returned to Stack from host ICE"))))))))
+
 (deftest vamp
   "Vamp - Run HQ and use replace access to pay credits to drain equal amount from Corp"
   (do-game


pong pong

pong pong

--- src/clj/whodowha/services.clj
+++ src/clj/whodowha/services.clj
@@ -14,7 +14,7 @@

 (defroutes handler
            (GET ["/ping"] []
-                (str "pong")))
+                (str "pong pong")))

 (def app
  (->


Fix #16

Fix #16

--- src/clj_simple_chart/core.clj
+++ src/clj_simple_chart/core.clj
@@ -75,27 +75,31 @@
 (defn translate [x y]
   (str "translate(" x "," y ")"))

-(defn render [t]
-  (let [body [:body (style
-                      :margin "0 !important"
-                      :padding "0 !important"
-                      :overflow-x "hidden"
-                      :overflow-y "hidden")]
-        attrs (second t)
-        width (:width attrs)
-        height (:height attrs)
-        s (hiccup.core/html (conj body t))]
-    (Platform/runLater (fn [] (.setPrefHeight @webview height)))
-    (Platform/runLater (fn [] (.setPrefWidth @webview width)))
-    (render-string s)
-    (wait-for-worker)
-    (Platform/runLater (fn [] (.sizeToScene @stage)))
-    (Platform/runLater (fn [] (.show @stage)))
-    s))
-
 (defn export-to-file [filename t]
   (let [s (hiccup.core/html t)]
     (spit filename s)))
+
+(defn render
+  ([filename t]
+   (export-to-file filename t)
+   (render t))
+  ([t]
+   (let [body [:body (style
+                       :margin "0 !important"
+                       :padding "0 !important"
+                       :overflow-x "hidden"
+                       :overflow-y "hidden")]
+         attrs (second t)
+         width (:width attrs)
+         height (:height attrs)
+         s (hiccup.core/html (conj body t))]
+     (Platform/runLater (fn [] (.setPrefHeight @webview height)))
+     (Platform/runLater (fn [] (.setPrefWidth @webview width)))
+     (render-string s)
+     (wait-for-worker)
+     (Platform/runLater (fn [] (.sizeToScene @stage)))
+     (Platform/runLater (fn [] (.show @stage)))
+     s)))

 (defn render-to-file [filename t]
   (let [ll (CountDownLatch. 1)
@@ -137,11 +141,10 @@
         range (:range (meta scale))
         tiks (apply ticks/ticks domain)]
     [:g
-     [:line {:x1    0 :x2 0 :y1 (scale (first domain)) :y2 (scale (second domain))
-             :style (str "stroke:" color "; stroke-width:1;")}]
-     [:line {:stroke color :x2 -6 :y1 0.5 :y2 0.5}]
-     [:g {:transform (translate 0 (scale (second domain)))}
-      [:line {:stroke color :x2 -6 :y1 0.5 :y2 0.5}]]
+     [:path {:stroke color
+             :stroke-width "1"
+             :fill "none"
+             :d (str "M-6," (apply max range) ".5 H0.5 V0.5 H-6")}]
      (map (fn [d] [:g {:transform (translate 0 (scale d))}
                    [:line {:stroke color :x2 -6 :y1 0.5 :y2 0.5}]
                    [:text {:x           -9
@@ -151,11 +154,31 @@
                            :y           0.5}
                     d]]) tiks)]))

+(defn right-y-axis [scale]
+  (let [domain (:domain (meta scale))
+        color (get (meta scale) :color "#000")
+        range (:range (meta scale))
+        tiks (apply ticks/ticks domain)]
+    [:g
+     [:path {:stroke color
+             :stroke-width "1"
+             :fill "none"
+             :d (str "M6," (apply max range) ".5 H0.5 V0.5 H6")}]
+     (map (fn [d] [:g {:transform (translate 0 (scale d))}
+                   [:line {:stroke color :x2 6 :y1 0.5 :y2 0.5}]
+                   [:text {:x           9
+                           :text-anchor "start"
+                           :fill        color
+                           :dy          ".32em"
+                           :y           0.5}
+                    d]]) tiks)]))
+
 (def width 500)
 (def height 500)
 (def margin {:top 50 :bottom 50 :left 60 :right 60})

-(def y (scale-linear {:color "black" :domain [0 1.69] :range [height 0]}))
+(def y (scale-linear {:color "red" :domain [0 100] :range [height 0]}))
+(def y2 (scale-linear {:color "blue" :domain [0 1.69] :range [height 0]}))
 (def x (scale-linear {:domain [0 100] :range [0 width]}))

 (defn diagram
@@ -169,7 +192,7 @@
    ;[:circle {:cx 0 :cy (+ (:top margin) (:bottom margin) height) :r 50 :fill "yellow" :stroke "black"}]
    [:g {:transform (translate (:left margin) (:top margin))}
     (left-y-axis y)
-    #_[:g {:transform (translate width 0)} (right-y-axis y)]
+    [:g {:transform (translate width 0)} (right-y-axis y2)]
     ;[:rect {:x 0 :y 0 :width width :height height :fill "none" :stroke "black"}]
     ;[:circle {:cx 50 :cy 100 :r 10 :fill "yellow" :stroke "black"}]
     ;[:circle {:cx (x 25) :cy (y 25) :r 25 :fill "yellow" :stroke-width 5 :stroke "black"}]
@@ -180,5 +203,4 @@
     ;[:text {:x 50 :y 100 :dy ".32em" :font-size "200px"} "1,234"]
     ;[:line {:x1 0 :y1 0 :x2 width :y2 height :stroke "blue"}]
     ;[:line {:x1 width :y1 0 :x2 0 :y2 height :stroke "blue"}]
-    ]]
-  )
+    ]])


add service mapping

add service mapping

--- src/cljc/swarmpit/domain.cljc
+++ src/cljc/swarmpit/domain.cljc
@@ -1,9 +1,10 @@
-(ns swarmpit.domain)
+(ns swarmpit.domain
+  (:require [clojure.string :as str]))

 (defn ->service-mode
   [service]
   (if (= (:mode service) "global")
-    "Global"
+    {:Global {}}
     {:Replicated
      {:Replicas (:replicas service)}}))

@@ -33,6 +34,44 @@
    :EndpointSpec
          {:Ports (->service-ports service)}})

+(defn <-service-ports
+  [service]
+  (->> (get-in service [:Spec :EndpointSpec :Ports])
+       (map (fn [p] {:containerPort (:TargetPort p)
+                     :protocol      (:Protocol p)
+                     :hostPort      (:PublishedPort p)}))
+       (into [])))
+
+(defn <-service-variables
+  [service]
+  (->> (get-in service [:Spec :TaskTemplate :ContainerSpec :Env])
+       (map (fn [p]
+              (let [variable (str/split p #"=")]
+                {:name  (first variable)
+                 :value (second variable)})))
+       (into [])))
+
 (defn <-service
   "Map docker service domain to swarmpit service domain"
-  [service])
+  [service]
+  (let [image (get-in service [:Spec :TaskTemplate :ContainerSpec :Image])
+        image-info (str/split image #"@")
+        image-name (first image-info)
+        image-digest (second image-info)]
+    {:id           (get service :ID)
+     :createdAt    (get service :CreatedAt)
+     :updatedAt    (get service :UpdatedAt)
+     :image        image-name
+     :imageDigest  image-digest
+     :serviceName  (get-in service [:Spec :Name])
+     :mode         (str/lower-case (name (first (keys (get-in service [:Spec :Mode])))))
+     :replicas     (get-in service [:Spec :Mode :Replicated :Replicas])
+     :autoredeploy false
+     :ports        (<-service-ports service)
+     :variables    (<-service-variables service)}))
+
+(defn <-services
+  [services]
+  (->> services
+       (map <-service)
+       (into [])))


correctly handle undo/redo edge cases

correctly handle undo/redo edge cases

--- src/cljs/palimpsest/core.cljs
+++ src/cljs/palimpsest/core.cljs
@@ -45,7 +45,9 @@
       (swap! dragging #(-> true)))))

 (defn mouseup-handler [event]
-  (swap! dragging #(-> false)))
+  (when (= 0 (.-button event))
+    (swap! undone-strokes #())
+    (swap! dragging #(-> false))))

 (defn keyevent->char [event]
   (let [kc (.-keyCode event)]
@@ -55,18 +57,20 @@
         (+ kc 32) kc))))

 (defn undo-stroke []
-  (let [last-stroke (last @drawn-strokes)]
-    (swap! drawn-strokes (comp vec drop-last))
-    (swap! undone-strokes conj last-stroke))
-  (drawing/clear-screen canvas-context)
-  (doseq [stroke @drawn-strokes]
-    (drawing/draw-stroke canvas-context stroke)))
+  (when-not (empty? @drawn-strokes)
+    (let [last-stroke (last @drawn-strokes)]
+      (swap! drawn-strokes (comp vec drop-last))
+      (swap! undone-strokes conj last-stroke))
+    (drawing/clear-screen canvas-context)
+    (doseq [stroke @drawn-strokes]
+      (drawing/draw-stroke canvas-context stroke))))

 (defn redo-stroke []
-  (let [last-undone (first @undone-strokes)]
-    (swap! drawn-strokes conj last-undone)
-    (swap! undone-strokes rest)
-    (drawing/draw-stroke canvas-context last-undone)))
+  (when-not (empty? @undone-strokes)
+    (let [last-undone (first @undone-strokes)]
+      (swap! drawn-strokes conj last-undone)
+      (swap! undone-strokes rest)
+      (drawing/draw-stroke canvas-context last-undone))))

 (defn keydown-handler [event]
   (case (keyevent->char event)


Show commit messages in sidebar

Show commit messages in sidebar

--- src/clojure/nightcode/git.clj
+++ src/clojure/nightcode/git.clj
@@ -8,44 +8,40 @@
   (:import [javax.swing.event HyperlinkEvent$EventType TreeSelectionListener]
            [javax.swing.text.html HTMLEditorKit StyleSheet]
            [javax.swing.tree DefaultMutableTreeNode DefaultTreeModel
-            TreeSelectionModel]))
+            TreeSelectionModel]
+           [org.eclipse.jgit.api Git]
+           [org.eclipse.jgit.internal.storage.file FileRepository]))

-(def commit-list [[{:name "Commit 1"}
-                   [{:name "file1"}
-                    {:name "file2"}
-                    {:name "file3"}]]])
+(def ^:const git-name "*Git*")
+(def ^:const max-commits 50)

 (defn update-content!
-  [content node]
+  [content commit]
   (doto content
     (.setText "")
     (.setCaretPosition 0)))

-(defn file-node
-  [{:keys [name] :as file}]
-  (proxy [DefaultMutableTreeNode] [file]
-    (isLeaf [] true)
-    (toString [] name)))
-
 (defn commit-node
-  [[{:keys [name] :as commit} files]]
-  (proxy [DefaultMutableTreeNode] []
-    (getChildAt [i] (file-node (nth files i)))
-    (getChildCount [] (count files))
-    (toString [] name)))
+  [commit]
+  (proxy [DefaultMutableTreeNode] [commit]
+    (toString [] (.getShortMessage commit))))

 (defn root-node
-  []
-  (proxy [DefaultMutableTreeNode] []
-    (getChildAt [i] (commit-node (nth commit-list i)))
-    (getChildCount [] (count commit-list))))
+  [f]
+  (let [repo (FileRepository. f)
+        git (Git. repo)
+        commit-objects (-> git .log (.setMaxCount max-commits) .call .iterator)
+        commits (iterator-seq commit-objects)]
+    (proxy [DefaultMutableTreeNode] []
+      (getChildAt [i] (commit-node (nth commits i)))
+      (getChildCount [] (count commits)))))

 (defn create-sidebar
-  [content]
+  [content f]
   (doto (s/tree :id :git-sidebar)
     (.setRootVisible false)
-    (.setShowsRootHandles true)
-    (.setModel (DefaultTreeModel. (root-node)))
+    (.setShowsRootHandles false)
+    (.setModel (DefaultTreeModel. (root-node f)))
     (.addTreeSelectionListener
       (reify TreeSelectionListener
         (valueChanged [this e]
@@ -64,11 +60,13 @@
                          :content-type "text/html")
       (.setEditorKit kit))))

-(def ^:const git-name "*Git*")
+(defn git-file
+  [path]
+  (io/file path ".git"))

 (defn git-project?
   [path]
-  (.exists (io/file path ".git")))
+  (.exists (git-file path)))

 (def ^:dynamic *widgets* [:pull :push :configure])

@@ -92,14 +90,16 @@

 (defmethod editors/create-editor :git [_ path]
   (when (= (.getName (io/file path)) git-name)
-    (let [; create the pane
+    (let [; get the path of the parent directory
+          path (-> path io/file .getParentFile .getCanonicalPath)
+          ; create the pane
           content (create-content)
-          sidebar (create-sidebar content)
+          sidebar (create-sidebar content (git-file path))
           git-pane (s/border-panel
-                     :west (s/scrollable sidebar :size [200 :by 0])
+                     :west (s/scrollable sidebar
+                                         :size [200 :by 0]
+                                         :hscroll :never)
                      :center (s/scrollable content))
-          ; get the path of the parent directory
-          path (-> path io/file .getParentFile .getCanonicalPath)
           ; create the actions and widgets
           actions (create-actions)
           widgets (create-widgets actions)


Remove 'Finished' from REPL

Remove 'Finished' from REPL

--- src/clojure/nightmod/repl.clj
+++ src/clojure/nightmod/repl.clj
@@ -16,8 +16,7 @@
   [in-out func]
   (->> (fn []
          (try (func)
-           (catch Exception e (some-> (.getMessage e) println))
-           (finally (println "\n===" (nc-utils/get-string :finished) "==="))))
+           (catch Exception e (some-> (.getMessage e) println))))
        (redirect-io in-out)
        (fn [])
        Thread.


CMR-615: Removed json body wrapper.

CMR-615: Removed json body wrapper.

--- src/cmr/search/api/routes.clj
+++ src/cmr/search/api/routes.clj
@@ -30,10 +30,6 @@
 (def CURL_CLIENT_ID "curl")
 (def UNKNOWN_CLIENT_ID "unknown")

-(def supported-content-types
-  "The content types supported by search"
-  #{"application/x-www-form-urlencoded"})
-
 (def extension->mime-type
   "A map of URL file extensions to the mime type they represent."
   {"json" "application/json"
@@ -259,23 +255,10 @@
                 :body-copy body
                 :body (java.io.ByteArrayInputStream. (.getBytes body)))))))

-;; Validates the content type of the request.
-(defn content-type-handler
-  [f]
-  (fn [request]
-    (println request)
-    (let [content-type (get-in request [:headers "content-type"])]
-      (if (get supported-content-types content-type)
-        (f request)
-        (svc-errors/throw-service-error :bad-request
-                                        (str "Unsupported content type [" content-type "]"))))))
-
 (defn make-api [system]
   (-> (build-routes system)
       (http-trace/build-request-context-handler system)
       handler/site
       copy-of-body-handler
-      content-type-handler
       errors/exception-handler
-      ring-json/wrap-json-body
       ring-json/wrap-json-response))


[impl/default] This fixes a compile warning I was getting about resolving `.getName`

--- src/cortex/impl/default_.cljc
+++ src/cortex/impl/default_.cljc
@@ -75,7 +75,8 @@
 ;;default serialization implementation for generic modules
 (defn record->map
   [rec]
-  (assoc (into {} rec) :record-type (.getName (class rec))))
+  (let [^Class klass (class rec)]
+    (assoc (into {} rec) :record-type (.getName klass))))

 (extend-protocol cp/PSerialize
   #?(:clj Object :cljs object)


Fixing bug on rules monoid

Fixing bug on rules monoid

--- src/dalap/leiningen/rules.clj
+++ src/dalap/leiningen/rules.clj
@@ -95,7 +95,7 @@
        (and (fn? tr1) (sequential? tr2))  (tr1 tr2)
        :else
        (throw (Exception.
-               (str "-mappend-rules invalid argument types"
+               (str "-mappend invalid argument types"
                     (type tr1) " => " (str tr1) "\n"
                     (type tr2) " => " (str tr2))))))
   ([tr1 tr2 & rest]


fixed processing/grouped-words according to documented recognized word data structure

--- src/distillery/processing.clj
+++ src/distillery/processing.clj
@@ -108,8 +108,8 @@
   [results word-filters group-filters]
   (let [word-filter (partial multi-filter (vec word-filters))
         group-filter (partial multi-filter (vec group-filters))]
-    (->> (words results :best-phrases cfg/best-phrases-only :predicate word-filter)
-         (group-by #(dissoc % :confidence))
+    (->> (words results :predicate word-filter)
+         (group-by #(dissoc % :no :result-no :alt-no :confidence))
          (map process-word-group)
          (filter group-filter))))


improved match matrix

improved match matrix

--- src/distillery/view/match.clj
+++ src/distillery/view/match.clj
@@ -48,19 +48,23 @@
    :content
    (vec (cons {:tag :th
                :attrs {:class ""}
-               :content [(link (str "videos/" id "/index.html")
-                               name)]}
+               :content [{:tag :a
+                          :attrs {:href (str "videos/" id "/index.html")
+                                  :title name}
+                          :content name}]}
               (map
                (fn [category-id]
-                 (let [match (get-in matrix [category-id id])]
+                 (let [match (get-in matrix [category-id id])
+                       score (:score match)
+                       normalized-score (/ score (:max-score video))]
                    (if match
                      {:tag :td
                       :attrs {:class "match"
                               :data-video-id id
                               :data-category-id category-id
-                              :style (str "background-color: rgba(0,76,204," (:score-normalized match) ")")}
+                              :style (str "background-color: rgba(234,30,106," normalized-score ")")}
                       :content [(link (str "categories/" category-id "/index.html?match=" id)
-                                 (format "%.4f" (:score-normalized match)))]}
+                                 (format "%.1f%%" (* 100 score)))]}
                      {:tag :td :content []})))
                category-ids)))})

@@ -77,7 +81,7 @@
                                  (get (:matches video) (:id category))]))
                              (map
                               (fn [[video-id match]]
-                                [video-id (assoc match :score-normalized (/ (:score match) max-score))]))
+                                [video-id match]))
                              (apply concat)
                              (apply hash-map))]))
                     (apply concat)


OO: Clean up no-geodata? logic

OO: Clean up no-geodata? logic

--- src/hatti/views/dataview.cljs
+++ src/hatti/views/dataview.cljs
@@ -90,9 +90,9 @@
     (init-state [_]
       (let [form (om/get-shared owner :flat-form)
             geopoints? (-> app-state :dataset-info :instances_with_geopoints)
-            no-geodata? (not (if (or geopoints? (some f/geopoint? form))
-                               geopoints?
-                               (some f/geofield? form)))]
+            no-geodata? (not (or geopoints?
+                                 (some f/geopoint? form)
+                                 (some f/geofield? form)))]
         (when (and no-geodata? (= :map (-> app-state :views :selected)))
           (om/update! app-state [:views :selected] :table))
         {:no-geodata? no-geodata?}))


mapdb is opened readonly when initialized

--- src/help_me_im_dumb/index.clj
+++ src/help_me_im_dumb/index.clj
@@ -16,7 +16,7 @@
 (defn initialize-index
   []
   (def DICTIONARY (read-in-dictionary))
-  (def MAPDB (spicerack/open-database MAPDB-FILENAME)))
+  (def MAPDB (spicerack/open-database MAPDB-FILENAME :read-only? true)))

 (defn docid->doc
   [docid]


Refactoring: read-chapter-name, read-group-name, read-component-name

--- src/hurvinek/db_interface.clj
+++ src/hurvinek/db_interface.clj
@@ -50,44 +50,32 @@
     [product-id]
     (read-from-product-table product-id :description))

+(defn read-name-for-id
+    [table-name id]
+    (try
+        (->
+            (jdbc/query db-spec/hurvinek-db
+                            [(str "select name from " table-name " where id=?") id])
+            first
+            (get :name))
+        (catch Exception e
+            (println e)
+            nil)))
+
 (defn read-chapter-name
     "Read name of chapter for the given chapter id."
     [chapter-id]
-    (try
-        (->
-            (jdbc/query db-spec/hurvinek-db
-                            ["select name from chapters where id=?" chapter-id])
-            first
-            (get :name))
-        (catch Exception e
-            (println e)
-            nil)))
+    (read-name-for-id "chapters" chapter-id))

 (defn read-group-name
     "Read name of group for the given group id."
     [group-id]
-    (try
-        (->
-            (jdbc/query db-spec/hurvinek-db
-                            ["select name from groups where id=?" group-id])
-            first
-            (get :name))
-        (catch Exception e
-            (println e)
-            nil)))
+    (read-name-for-id "groups" group-id))

 (defn read-component-name
     "Read name of component for the given component id."
     [component-id]
-    (try
-        (->
-            (jdbc/query db-spec/hurvinek-db
-                            ["select name from components where id=?" component-id])
-            first
-            (get :name))
-        (catch Exception e
-            (println e)
-            nil)))
+    (read-name-for-id "components" component-id))

 (defn read-chapters
     "Read list of all chapters for selected product."


Proper logging when the target WAR file cannot be found

--- src/leiningen/amp/install.clj
+++ src/leiningen/amp/install.clj
@@ -82,34 +82,53 @@
 (defn- find-dependency
   "Finds the WAR from the project then returns its file"
   [{:keys [repositories amp-target-war]}]
-  (let [files (aether/dependency-files
-                   (aether/resolve-dependencies :repositories (repo-map repositories)
-                                                :coordinates  [amp-target-war]))]
-    (if (empty? files)
-      (main/abort "No target WAR was found. Did you set :amp-target-war in your project.clj?")
-      (find-one amp-target-war files))))
+  (try
+    (let [files (aether/dependency-files
+                 (aether/resolve-dependencies :repositories (repo-map repositories)
+                                              :coordinates  [amp-target-war]))]
+      (if (empty? files)
+        (main/abort "No target WAR was found. Did you set :amp-target-war in your project.clj?")
+        (find-one amp-target-war files)))
+    (catch org.sonatype.aether.transfer.ArtifactNotFoundException e
+      (when main/*debug* (.printStackTrace e))
+      (main/abort "The target WAR specified in your project could not be found in the configured repositories"))
+    (catch Exception e
+      (when main/*debug* (.printStackTrace e))
+      (main/abort "Invalid target WAR found in project:" amp-target-war))))

 (defn- reference-war
   "Creates and validates a path to a target WAR file"
   [loc]
   (let [file (io/file loc)]
     (if (not (.exists ^java.io.File file))
-      (main/abort "The specified WAR file does not exist")
+      (main/abort "The specified WAR file does not exist:" loc)
       file)))

 (defn- dependency-war
   "Creates and validates a target WAR file specified as a project dependency"
   [{:keys [amp-target-war] :as project}]
+  (if (not amp-target-war)
+    (main/abort "You need to specify a target WAR location"))
   (let [dependency (find-dependency project)
         temp-war (io/file (:target-path project) (dep-to-filename amp-target-war))]
     (io/copy dependency temp-war)
     temp-war))

+(defn- get-war-str
+  "Finds the string representation of the target WAR location, if one is given. If
+   the location is specified at the command line it takes precedence over the project
+   configuration."
+  [target-war args]
+  (or (first args)
+      (if (string?  target-war)
+        target-war
+        false)))
+
 (defn- locate-war
   "Locates the WAR file to deploy to. The WAR can be specified as the argument,
    or as a dependency in the project at the entry :amp-target-war"
   [{:keys [amp-target-war] :as project} args]
-  (if-let [target-war (first args)]
+  (if-let [target-war (get-war-str amp-target-war args)]
     (reference-war target-war)
     (dependency-war project)))


Refactored common parts in 'get' and 'latest' tasks.

--- src/leiningen/ancient/get.clj
+++ src/leiningen/ancient/get.clj
@@ -38,40 +38,45 @@
           (doseq [v vp] (print (pr-str v) ""))))
       (println "]"))))

-(defn run-get-task!
-  [project [package & args]]
-  (if-not package
-    (println "':get' expects an artifact to retrieve version information for.")
-    (let [settings (-> (parse-cli args) (assoc :aggressive? true))
-          {:keys [artifact-id group-id] :as artifact} (anc/artifact-map [package "RELEASE"])
-          artifact-str (str group-id "/" artifact-id)]
-      (with-output-settings settings
-        (let [repos (collect-repositories project)]
-          (println "Getting Version Information for" (yellow artifact-str)
-                   "from" (count repos) "Repositories ...")
-          (let [vs (->> (anc/versions! settings repos artifact)
-                     (sort #(v/version-seq-compare (second %1) (second %2)))
-                     (reverse))]
-            (if-not (seq vs)
-              (println "No versions found.")
-              (let [releases (filter (complement (comp v/qualified? second)) vs)
-                    snapshots (filter (comp v/snapshot? second) vs)
-                    qualified (filter (comp  #(and (not (v/snapshot? %)) (v/qualified? %)) second) vs)]
-                (println (str "  * " (count vs) " version(s) found."))
-                (print-version "latest release" (first releases))
-                (print-version "latest SNAPSHOT" (first snapshots))
-                (print-version "latest qualified" (first qualified))
-                (print-version-seq "all releases" releases)
-                (print-version-seq "all SNAPSHOTs" snapshots)
-                (print-version-seq "all qualified versions" qualified)))))))))
+(defn- wrap-version-retrieval-task
+  [f task-name]
+  (let [error-msg (format "'%s' expects an artifact to retrieve version information for." task-name)]
+    (fn [project [package & args]]
+      (if-not package
+        (println error-msg)
+        (let [settings (assoc (parse-cli args) :aggressive? true)
+              artifact (anc/artifact-map [package "RELEASE"])]
+          (with-output-settings settings
+            (let [repos (collect-repositories project)]
+              (f settings repos package artifact))))))))

-(defn run-latest-vector-task!
-  [project [package & args]]
-  (if-not package
-    (println "Expected an artifact to retrieve version information for")
-    (let [settings (assoc (parse-cli args) :aggressive? true)
-          artifact (anc/artifact-map [package "RELEASE"])]
-      (with-output-settings settings
-        (if-let [latest (retrieve-latest-version-string! settings (collect-repositories project) (:group-id artifact) (:artifact-id artifact))]
-          (println (str  "[" package " \"" latest "\"]") )
-          (println "No versions found"))))))
+(def run-get-task!
+  (->
+    (fn [settings repos package {:keys [group-id artifact-id] :as artifact}]
+      (let [artifact-str (str group-id "/" artifact-id)]
+        (println "Getting Version Information for" (yellow artifact-str)
+                 "from" (count repos) "Repositories ...")
+        (let [vs (->> (anc/versions! settings repos artifact)
+                      (sort #(v/version-seq-compare (second %1) (second %2)))
+                      (reverse))]
+          (if-not (seq vs)
+            (println "No versions found.")
+            (let [releases (filter (complement (comp v/qualified? second)) vs)
+                  snapshots (filter (comp v/snapshot? second) vs)
+                  qualified (filter (comp  #(and (not (v/snapshot? %)) (v/qualified? %)) second) vs)]
+              (println (str "  * " (count vs) " version(s) found."))
+              (print-version "latest release" (first releases))
+              (print-version "latest SNAPSHOT" (first snapshots))
+              (print-version "latest qualified" (first qualified))
+              (print-version-seq "all releases" releases)
+              (print-version-seq "all SNAPSHOTs" snapshots)
+              (print-version-seq "all qualified versions" qualified))))))
+    (wrap-version-retrieval-task "get")))
+
+(def run-latest-vector-task!
+  (->
+    (fn [settings repos package {:keys [group-id artifact-id]}]
+      (if-let [latest (retrieve-latest-version-string! settings repos group-id artifact-id)]
+        (println (format "[%s \"%s\"]" package latest))
+        (println "No versions found.")))
+    (wrap-version-retrieval-task "latest")))


Delete quadratic loss function (duplicative with MSE loss)

--- src/cortex/optimise.clj
+++ src/cortex/optimise.clj
@@ -127,26 +127,6 @@
   ([]
     (MSELoss.)))

-; NOTE: not really sure how this is supposed to differ and why from a simple MSE
-; loss.  Must investigate.
-(deftype QuadraticLoss []
-  cp/PLossFunction
-    (loss [this v target]
-      ; NOTE: linear/norm is different for matrices and vectors so this row-matrix
-      ; conversion is important for correctness.
-      ;(println "loss: " v "-" target)
-      (let [diff (m/sub v target)
-            diff (if (m/vec? diff) (m/row-matrix diff) diff)]
-        (m/mul 0.5 (m/pow (linear/norm diff) 2))))
-
-    (loss-gradient [this v target]
-      (m/sub v target)))
-
-(defn quadratic-loss
-  "Returns a qaudratic loss function"
-  ([]
-    (QuadraticLoss.)))
-
 (def SMALL-NUM 1e-30)

 (deftype CrossEntropyLoss []


Remove call to `persistent!` in cljs lru print function

no longer pased on transients. And even if it were calling persistent
on a transient in a side-effecting operation that changes the
transient.

This error would manifest itself just by calling the lru function:

```cljs
(require '[datascript.lru :as lru])
(lru/lru 3)

```

--- src/datascript/lru.cljc
+++ src/datascript/lru.cljc
@@ -12,7 +12,7 @@
       (-lookup [_ k nf] (-lookup key-value k nf))
       IPrintWithWriter
       (-pr-writer [_ writer opts]
-                  (-pr-writer (persistent! key-value) writer opts)))
+                  (-pr-writer key-value writer opts)))
    :clj
     (deftype LRU [^clojure.lang.Associative key-value gen-key key-gen gen limit]
       clojure.lang.ILookup


hide implementation details

hide implementation details

--- src/deferst/system.cljc
+++ src/deferst/system.cljc
@@ -116,7 +116,7 @@
   [obj]
   (d/deferred? obj))

-(defn construct-maybe-lift
+(defn- construct-maybe-lift
   "construct an object given a factory-fn and args. if the
    object is already Deferred lift it into the config-ctx,
    otherwise wrap it"
@@ -132,7 +132,7 @@
                         {:state st
                          :error e}))))))

-(defn construct-obj
+(defn- construct-obj
   [factory-fn arg-specs]
   (with-context config-ctx
     (mlet
@@ -144,7 +144,7 @@
                                    [obj-and-maybe-destructor-fn])]]
       (return [obj destructor-fn deps]))))

-(defn destroy-maybe-lift
+(defn- destroy-maybe-lift
   [st destructor-fn]
   (with-context config-ctx
     (try
@@ -158,7 +158,7 @@
                         {:state st
                          :error e}))))))

-(defn m-destructor
+(defn- m-destructor
   "returns a monadic value which destroys key
    k and removes it from the system state"
   [k destructor-fn]
@@ -186,7 +186,7 @@
       (return
        (filter-system-map new-st)))))

-(defn m-constructor
+(defn- m-constructor
   "returns a monadic value which creates key k,
    and adds it to the system state"
   [k factory-fn arg-specs]
@@ -233,7 +233,7 @@
            (or base-system-builder (new-system))
            key-factoryfn-argspecs-list)))

-(defn system-destructor
+(defn- system-destructor
   "given a system (including the ::system key) create a
    system-destructor which will apply the individual object
    destructors for all the objects in the system in


Get rid of debugging helper

Get rid of debugging helper

--- src/desdemona/query.clj
+++ src/desdemona/query.clj
@@ -4,8 +4,7 @@
    [clojure.core.match :as m]
    [clojure.string :as s]
    [instaparse.core :as insta]
-   [clojure.java.io :refer [resource]]
-   [taoensso.timbre :refer [spy]]))
+   [clojure.java.io :refer [resource]]))

 (defn ^:private generate-logic-query
   "Expands a query and events to a core.logic program that executes


Write unused code to the bottom

Write unused code to the bottom

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -77,10 +77,19 @@
         [this-line-tokens ts-rest _] (reduce fill-group [[] ts 0] groups)]
     [(string/join this-line-tokens) ts-rest]))

+;; arrange tokens to form ascii-art
+;; return [result remained-tokens] tuple
 (defn arrange-tokens [ts img result]
-  (if (or (empty? ts) (empty? img)) result
+  (if (or (empty? ts) (empty? img)) [(identity result) ts]
     (let [[line ts-rest] (arrange-tokens-line ts (first img))]
       (recur ts-rest (rest img) (conj result line)))))
+
+(defn arrange-unused [ts width]
+  (let [a    (/ width 7)
+        line (concat (repeat a 0) (repeat (* 3 a) 1) (repeat a 0) (repeat (* 3 a) 1))
+        fake-img (take (/ (count ts) 5) (cycle [line]))       ; crap, re-do!!
+        [result _] (arrange-tokens ts fake-img [])]
+    (concat (repeat 20 "\n") result)))

 (defn analyze-code [code]
@@ -128,8 +137,13 @@
 ;; w    -- int, width of output, in chars
 (defn harnify [code img w]
   (let [tokens (js->clj (js/esprima.tokenize code) :keywordize-keys true)
-        ts (tokens-to-text (split-string-literals tokens 5) [])]
-    (string/join "\n" (reverse (arrange-tokens ts img)))              ; img must be resized by now, no need in w
+        ts (tokens-to-text (split-string-literals tokens 5) [])
+        [arranged ts-unused] (arrange-tokens ts img [])
+        unused               (arrange-unused ts-unused 160)
+        result (concat arranged unused)
+        ]
+    (println unused)
+    (string/join "\n" result)              ; img must be resized by now, no need in w
     ))

 ;; TODO: add unused tokens


comment

comment

--- sidecar/src/figwheel_sidecar/repl.clj
+++ sidecar/src/figwheel_sidecar/repl.clj
@@ -387,6 +387,7 @@
          repl-build   (first (config/narrow-builds* all-builds' build-ids))
          build-ids    (or (not-empty build-ids) [(:id repl-build)]) ;; give a default build-id
          ]
+     ;; this is what currently starts the autobuild
      ((get repl-control-fns 'start-autobuild) build-ids)
      (loop [build repl-build]
        (newline)


Работа над резкой изображения, выбран формат PNG.

Также добавлен функционал для переработки всех файлов

--- src/ixinfestor/core.clj
+++ src/ixinfestor/core.clj
@@ -4,6 +4,8 @@
   (:use korma.core)

   (:use clojure.pprint)
+
+  (:import [org.imgscalr Scalr])

   (:require [clj-time.core :as tco]
             [clj-time.format :as tf]
@@ -11,6 +13,8 @@
             [clj-time.local :as tl]

             [image-resizer.core :refer :all]
+            [image-resizer.format :as format]
+            [image-resizer.pad :as pad]
             )
   )

@@ -677,6 +681,11 @@
 (def files-root-directory (promise))

+(defn image-file_as_w_png [buffered-file file-src w]
+  (let [resized-file (new java.io.File (str (.getPath file-src) "_as_" w ".png"))]
+    (javax.imageio.ImageIO/write buffered-file "png" resized-file)
+    (.getAbsolutePath resized-file)))
+
 (defn save-file-o [tempfile dir filename {:keys [ws] :or {ws []}}]
   (let [dir-filename (str dir "/" filename)
         full-path (str (if (realized? files-root-directory) @files-root-directory
@@ -702,17 +711,48 @@
             ext (image-resizer.fs/extension full-path)]
         ;;(println "EXT:" (clojure.string/lower-case ext))
         (when (#{"png" "jpg" "jpeg" "gif"} (clojure.string/lower-case ext))
-          (doseq [w ws
-                  :let [full-path-spec (str full-path w)]]
+          (doseq [w ws]
             (-> file-src
                 ;;(image-resizer.core/resize-to-width w)
-
-                ;;((image-resizer.resize/resize-width-fn w image-resizer.scale-methods/ultra-quality))
-                ((image-resizer.resize/force-resize-fn w w image-resizer.scale-methods/ultra-quality))
-
-                (javax.imageio.ImageIO/write ext (new java.io.File full-path-spec))))))
+
+                ((image-resizer.resize/resize-fn w w image-resizer.scale-methods/ultra-quality))
+
+                ;;(javax.imageio.ImageIO/write ext (new java.io.File full-path-spec))
+                ;;(format/as-file full-path-spec)
+                (image-file_as_w_png file-src w)
+                ))))

       dir-filename)))
+
+
+(declare files)
+
+(defn files-resize-all-images [{:keys [ws] :or {ws []}}]
+  (doseq [{path :path} (select files
+                               (fields :path)
+                               (where {:content_type [in ["image/gif"
+                                                          "image/jpeg"
+                                                          "image/pjpeg"
+                                                          "image/png"
+                                                          ;;"image/svg+xml"
+                                                          ;;"image/tiff"
+                                                          ]]}))
+          :let [path (clojure.string/replace-first path #"/image/" "/")
+                file-src (new java.io.File (str @files-root-directory "/" path))]]
+    (do
+      (println "Do file: " (.getPath file-src))
+      (doseq [w ws]
+        (-> file-src
+            ;;(image-resizer.core/resize-to-width w)
+
+            ((image-resizer.resize/resize-fn w w image-resizer.scale-methods/ultra-quality))
+
+            ;;(format/as-file full-path-spec)
+            (image-file_as_w_png file-src w)
+
+            println))
+      (println "OK")
+      )))

 (defn save-file [tempfile dir filename]
   (save-file-o tempfile dir filename {}))
@@ -935,8 +975,8 @@
                  (as-> row
                      (if keyname
                        (assoc row :ttitle (make-translit-ru-en (str keyname)))
-                       row))
-
+                       row))
+
                  (assoc :plan_text (html-clean-tags web_description))
                  )))


require common resources

require common resources

--- src/kvm/validations.clj
+++ src/kvm/validations.clj
@@ -18,7 +18,7 @@
  )

 (def common-resources
-   {:cpus #{:required :number} :memory #{:required :number} :hostname #{:required :String}})
+   {:cpu #{:required :number} :ram #{:required :number} :hostname #{:required :String}})

 (def machine-entity
   {:machine {
@@ -38,7 +38,7 @@
   })

 (defmethod check-validity [:kvm :entity] [domain]
-  (validate! domain (combine machine-entity kvm-entity) :error ::invalid-system))
+  (validate! domain (combine common-resources machine-entity kvm-entity) :error ::invalid-system))

 (defn provider-validation [domain]
-  (validate! domain domain-provider :error ::invalid-domain))
+  (validate! domain (combine common-resources domain-provider) :error ::invalid-domain))


Implement ngram backoff classification

Implement ngram backoff classification

--- src/langolier/train.clj
+++ src/langolier/train.clj
@@ -31,18 +31,16 @@

 ;; TODO READABLE CODE WTF!
 (defn- fill-ngrams [n-type lang tokens]
-  (let [cnt (count tokens) freq (frequencies tokens)]
+  (let [rm (-> tokens
+               (frequencies)
+               (assoc :size (count tokens)))]
     (do (swap! model ;; fill global model
                #(assoc % n-type
-                       (merge-with +
-                                   (assoc freq :size cnt)
-                                   (get-in @model [n-type] {})
+                       (merge-with + rm (get-in @model [n-type] {})
                                    )))
-        (swap! model
+        (swap! model ;; fill lang specific model
                #(assoc-in % [:lang lang n-type]
-                          (merge-with +
-                                      (assoc freq :size cnt)
-                                      (get-in @model [:lang lang n-type] {})))))))
+                          (merge-with + rm (get-in @model [:lang lang n-type] {})))))))

 ;; TODO avoid repetition
@@ -50,7 +48,8 @@
   (let [tokens (t/tokenize source)]
     (do (fill-ngrams :n3 language (trigrams (wrap tokens)))
         (fill-ngrams :n2 language (bigrams (wrap tokens)))
-        (fill-ngrams :n1 language tokens))))
+        (fill-ngrams :n1 language tokens)
+        :ok)))

 (defn train-dir [dir]
   (let [langs (->> dir
@@ -63,15 +62,38 @@
         (doseq [f (remove #(.isDirectory %)
                           (file-seq (io/file lang-dir)))]
           (train (slurp f) lang-key))))))
-
-(defn- log-prob [token language]
-  (Math/log
-   (/ (double (inc (get (get @cat-map language {}) token 0)))
-      (+ (get @global-map token 0) (reduce + (vals @global-map))))))

-;; TODO probability of category
+;; TODO make abstractions like dictsize, tokencat instead of get-in..
+(defn unigram-probability [token language]
+  (let [a (get-in @model [:lang language :n1 token] 0)
+        b (get-in @model [:n1 token] 0)] ;; to aviod div/0
+    (/ (double (inc a))
+       (+ b (get-in @model [:n1 :size]))))) ;; dict size
+
+
+(defn- probability [token language]
+  (let [trigram (get-in @model [:lang language :n3 token] 0)]
+    (cond (> trigram 0)
+          (/ (double trigram) (get-in @model [:n3 token]))
+          :else ;; backoff strategy
+          (let [bigram (get-in @model [:lang language :n2 (butlast token)] 0)]
+            (cond (> bigram 0)
+                  (* (/ (double bigram) (get-in @model [:n2 (butlast token)]))
+                     (unigram-probability (last token) language))
+                  :else
+                  (reduce *' (map #(unigram-probability % language) token)))))))
+
+(defn- lang-probability [lang]
+  (let [total (get-in @model [:n1 :size])]
+    (if (zero? total)
+      (throw (IllegalArgumentException. "Model is empty"))
+      (/ (double (get-in @model [:lang lang :n1 :size] 0))
+         total))))
+
 (defn- score [tokens language]
-  (reduce +' (map #(log-prob % language) tokens)))
+  (reduce +'
+          ;;(Math/log (lang-probability language))
+          (map #(Math/log (probability % language)) tokens)))

 (defn- scores [tokens languages]
   (map #(vec [% (score tokens %)]) languages))
@@ -81,10 +103,11 @@

 (defn classify [source]
   (-> source
-      (t/tokenize)
+      (t/tokenize) ;; at least 1
+      (wrap)
       (trigrams)
-      (scores (keys @cat-map))
+      (scores (languages))
       (best)))

 (defn languages []
-  (keys @cat-map))
+  (keys (get @model :lang)))


Disable auto-recovery for now

Disable auto-recovery for now

--- src/onyx/state/bookkeeper.clj
+++ src/onyx/state/bookkeeper.clj
@@ -43,6 +43,7 @@
                                                 (.setZkServers (:zookeeper/address env-config))
                                                 (.setZkLedgersRootPath ledgers-root-path)
                                                 (.setBookiePort port)
+                                                ;(.setAutoRecoveryDaemonEnabled true)
                                                 (.setJournalDirName journal-dir)
                                                 (.setLedgerDirNames (into-array String [ledger-dir]))
                                                 (.setAllowLoopback true))


Working base bot. Stays connected, nicks up, can send messages.

--- src/org/timmc/heim_logger.clj
+++ src/org/timmc/heim_logger.clj
@@ -13,50 +13,100 @@
   [server room]
   (format "wss://%s/room/%s/ws" server (pencode room)))

-(defn respond
-  [state msg]
-  (case (:type msg)
-    "hello-event"
-    [(assoc state :whoami (-> msg :data :id))]
+(def nick "hillbot")

-    "ping-event"
-    [state {:type "ping-reply"
-            :data {:time (-> msg :data :time)}}]
+(defn send-message
+  [{:as session :keys [sender wc]} msg]
+  (send sender (fn serial-send [_]
+                 (doto wc (s/put! (json/generate-string msg)))))
+  nil)

-    "snapshot-event"
-    [(assoc state :lifecycle :joined)]
+(defn auto-respond
+  [{:as session :keys [state sender]} msg]
+  (dosync
+   (case (:type msg)
+     "hello-event"
+     (do (alter state assoc :whoami (-> msg :data :id))
+         (send-message session {:type "nick" :data {:name nick}}))

-    "bounce-event"
-    [(assoc state :lifecycle :authing)]
+     "ping-event"
+     (send-message session
+                   {:type "ping-reply"
+                    :data {:time (-> msg :data :time)}})

-    [state]))
+     "snapshot-event"
+     (alter state assoc :lifecycle :joined)

-(defonce client
-  (atom nil))
+     "bounce-event"
+     (alter state assoc :lifecycle :authing)

-(defn spin
-  [wc]
-  (loop [state {:lifecycle :handshake}]
+     "send-event"
+     (println (format "%s \"%s\" said:\n%s"
+                      (-> msg :data :sender :id)
+                      (-> msg :data :sender :name)
+                      (-> msg :data :content)))
+
+     "join-event"
+     (println (format "%s \"%s\" joined"
+                      (-> msg :data :id)
+                      (-> msg :data :name)))
+
+     "part-event"
+     (println (format "%s \"%s\" left"
+                      (-> msg :data :id)
+                      (-> msg :data :name)))
+
+     "nick-event"
+     (println (format "%s changed nick from \"%s\" to \"%s\""
+                      (-> msg :data :id)
+                      (-> msg :data :from)
+                      (-> msg :data :to)))
+
+     ("nick-reply")
+     nil
+
+     (prn msg))))
+
+(defn react-to
+  [{:as session :keys [wc state sender]}]
+  (while true ;; (not= (:lifecycle @state) :end)
     (let [msg (json/parse-string @(s/take! wc) true)]
-      (println "RECV" (:type msg))
-      (when (:throttled msg)
+      (auto-respond session msg))))
+
+(def initial-state
+  {:lifecycle :handshake})
+
+(defn run
+  "Start a session and yield it as a map of:
+
+- :state A ref of session state
+- :wc Websocket client
+- :sender An agent used to send messages in coordination with state changes"
+  [server room]
+  (let [url (address server room)
+        wc @(ah/websocket-client url)
+        state (ref initial-state)
+        sender (agent nil
+                      :error-handler (fn sender-error [a e]
+                                       (println "Error in sender agent.")
+                                       (.printStackTrace e))
+                      :error-mode :fail)
+        session {:state state
+                 :wc wc
+                 :sender sender}
+        reactor (future (try (react-to session)
+                             (catch Throwable t
+                               (.printStackTrace t)
+                               (throw t))))]
+    session))
+
+;; TODO
+#_      (when (:throttled msg)
         (println "Throttled, sleeping.")
         (Thread/sleep 300))
-      (let [[state reply] (respond state msg)
-            state (assoc state :last-msg msg)]
-        (when reply
-          (s/put! wc (json/generate-string reply)))
-        (if (= (:lifecycle state) :joined)
-          state
-          (recur state))))))

 (defn -main
   "Demo connection to heim"
   [server room]
-  (let [url (address server room)
-        wc (reset! client @(ah/websocket-client url))
-        spinner (future (try (spin wc)
-                             (catch Throwable t
-                               (.printStackTrace t)
-                               (throw t))))]
-    spinner))
+  (let [session (run server room)]
+    ))


More conservative catchup -- only catchup until last marker.

This introduces markers into the log; markers are not written until the
log (or snapshot) responses reach the previous marker. A marker is also
written on halt, if possible. If we cannot write a marker, the next run
will re-download the same stretch of backlog.

Unifies snapshot-event and log-reply handling.

--- src/org/timmc/heim_logger.clj
+++ src/org/timmc/heim_logger.clj
@@ -145,56 +145,100 @@
       (do ;; something's wrong
         (println msg)))))

+(defn oldest-msg
+  "Find the oldest message-data in a coll of them."
+  [msg-datas]
+  (max-1 (fn compare-times [x y]
+           ;; Reverse sort, get msg with min time
+           (- (:time y) (:time x)))
+         msg-datas))
+
+(defn newest-msg
+  "Find the newest message-data in a coll of them."
+  [msg-datas]
+  (max-1 (fn compare-times [x y]
+           (- (:time x) (:time y)))
+         msg-datas))
+
 (defn log-messages
-  "Log message datas to file."
-  [session event-datas]
-  (let [w (-> session :state deref :logger :writer)]
+  "Log message datas to file and note the newest."
+  [{:as session :keys [state]} msg-datas]
+  (let [w (-> @state :logger :writer)]
     (binding [*out* w]
-      (doseq [m event-datas]
+      (doseq [m msg-datas]
         (println (json/generate-string {:hl-type "message"
                                         :data m}))))
     (.flush w)))

+(defn mark-latest-message
+  "Given some new message-datas, potentially note one of them as the
+newest message we've seen. Return the newest message value."
+  [{:as session :keys [state]} msg-datas]
+  (get-in
+   (alter state
+          (fn [oldstate]
+            (let [prev-last-seen (-> oldstate :logger :last-seen-msg)
+                  newest (newest-msg (concat msg-datas
+                                             (when prev-last-seen
+                                               [prev-last-seen])))]
+              (assoc-in oldstate [:logger :last-seen-msg] newest))))
+   [:logger :last-seen-msg]))
+
+(defn mark-catchup-complete
+  "Make a mark in the log indicating where we'll need to catch up to
+next time."
+  [{:as session :keys [state]} msg]
+  (println "Marking catchup complete to" (:id msg))
+  (let [w (-> @state :logger :writer)]
+    (binding [*out* w]
+      (println (json/generate-string {:hl-type "caughtup"
+                                      :data msg})))
+    (.flush w)))
+
+(defn done-catching-up?
+  "Have we encountered overlap with the previous catchup marker?"
+  [{:as session :keys [state]} msg-datas]
+  (let [catchup-to-id (-> @state :logger :catchup-to-id)]
+    (contains? (set (map :id msg-datas))
+               catchup-to-id)))
+
 (defn do-send-event
   "Log a single new message to file."
   [session msg]
-  (log-messages session [(get-in msg [:data])]))
-
-(defn oldest-msg-id
-  [msgs]
-  (:id (max-1 (fn compare-times [x y]
-                ;; Reverse sort, get msg with min time
-                (- (:time y) (:time x)))
-              msgs)))
+  (let [msg-datas [(get-in msg [:data])]]
+    (log-messages session msg-datas)
+    (mark-latest-message session msg-datas)))

 (defn ask-for-backlog
-  [session before-id]
+  [{:as session :keys [state]} before-id]
   (println "Asking for backlog before" before-id)
   (send-message session
                 {:type "log"
                  :data {:n 1000
                         :before before-id}}))

-(defn do-snapshot-event
-  "Log an entire snapshot to file."
+(defn do-backlog-events
+  "Log an entire snapshot or log reply to file."
   [session msg]
+  ;; TODO: Check if lifecycle is actually :catchup before proceeding?
   (let [recent-log (get-in msg [:data :log])]
     (log-messages session recent-log)
-    ;; Start downloading entire room history
-    (println "Switching to full catchup mode!")
-    ;; Should maybe check if lifecycle is :waiting-for-snapshot ?
-    (alter (:state session) assoc-in [:logger :lifecycle] :full-catchup)
-    (ask-for-backlog session (oldest-msg-id recent-log))))
-
-(defn do-log-reply
-  "Write backlog to file, ask for more if possible."
-  [session msg]
-  (let [recent-log (get-in msg [:data :log])]
-    (if (empty? recent-log)
-      (do (println "All caught up, no more backlog. Now just tailing.")
-          (alter (:state session) assoc-in [:logger :lifecycle] :tailing))
-      (do (log-messages session recent-log)
-          (ask-for-backlog session (oldest-msg-id recent-log))))))
+    (let [newest (mark-latest-message session recent-log)]
+      (if (or (empty? recent-log)
+              (done-catching-up? session recent-log))
+        (do (println "All caught up, no more backlog. Now just tailing.")
+            (alter (:state session)
+                   assoc-in [:logger :lifecycle] :tailing)
+            (mark-catchup-complete session newest))
+        (ask-for-backlog session (:id (oldest-msg recent-log)))))))
+
+(defn do-before-halt
+  "Actions to take on halt."
+  [{:as session :keys [state]} _msg]
+  ;; Only mark newer messages as caughtup if log catchup finished
+  (when (= (-> @state :logger :lifecycle) :tailing)
+    (mark-catchup-complete session (-> @state :logger :last-seen-msg)))
+  (some-> @state :logger :writer .close))

 (def logger-dispatch
   "Reactive dispatch overlay for logger."
@@ -204,10 +248,10 @@
     #'do-send-event

     "snapshot-event"
-    #'do-snapshot-event
+    #'do-backlog-events

     "log-reply"
-    #'do-log-reply
+    #'do-backlog-events

     :unknown-type
     ;; (fn [session msg]
@@ -218,28 +262,33 @@
     #'debug-print-message

     :halt
-    (fn [session _msg]
-      (some-> session :state deref :logger :writer .close))}))
-
-(defn find-last-logged
-  "Find the most recently logged message."
+    #'do-before-halt}))
+
+(defn find-last-catchup-id
+  "Find the ID of the last message we'd caught up to, or nil."
   [logfile]
   (with-open [rdr (io/reader logfile :encoding "UTF-8")]
-    (max-1 (fn compare-times [x y]
-             (- (get-in x [:data :time])
-                (get-in y [:data :time])))
-           (json/parsed-seq rdr true))))
+    (->> (json/parsed-seq rdr true)
+         (filter #(= (:hl-type %) "caughtup"))
+         (last)
+         (:data)
+         (:id))))

 (defn -main
   "Demo connection to heim"
   [server room logfile]
   (let [w (io/writer logfile :encoding "UTF-8" :append true)
-        ;; FIXME unused
-        last-logged-id (:id (:data (find-last-logged logfile)))
-        _ (println "Last logged message ID:" last-logged-id)
         session (run server room
-                     {:logger {:lifecycle :waiting-for-snapshot
-                               :path logfile
-                               :writer w}}
+                     {:logger
+                      {:lifecycle :catchup
+                       ;; Last message ID from last session,
+                       ;; used for backlog catchup
+                       :catchup-to-id (find-last-catchup-id logfile)
+                       ;; Last message from this session, used
+                       ;; to mark place for next session's
+                       ;; catchup.
+                       :last-seen-msg nil
+                       :path logfile
+                       :writer w}}
                      logger-dispatch)]
     session))


Allow size! to work with any camera

Allow size! to work with any camera

--- src/play_clj/core_cameras.clj
+++ src/play_clj/core_cameras.clj
@@ -45,8 +45,10 @@

     (size! screen 480 360)"
   [screen width height]
-  (let [^OrthographicCamera camera (u/get-obj screen :camera)]
-    (.setToOrtho camera false width height)))
+  (let [^Camera camera (u/get-obj screen :camera)]
+    (set! (. camera viewportWidth) width)
+    (set! (. camera viewportHeight) height)
+    (.update camera)))

 (defn width!
   "Sets the width of the camera in `screen`, adjusting the height so the ratio


show visual cue for beat as well

show visual cue for beat as well

--- src/metronome/core.cljs
+++ src/metronome/core.cljs
@@ -93,6 +93,21 @@
                                                   (put! click-channel (- m previous-click)))))}
                               "tap tempo"))))

+(defn dots [meter owner]
+  (reify
+    om/IRender
+    (render [_]
+      (let [dot (fn [pos]
+                  (dom/div #js {:className "col-xs-3"}
+                           (dom/span #js {:className (str "glyphicon glyphicon-record " pos (if (= (:count meter) pos)
+                                                                                ""
+                                                                                " hidden"))})))]
+        (dom/div #js {:className "row"}
+                 (dot 1) ; sound is not done on render loop, thus the strange order here
+                 (dot 2)
+                 (dot 3)
+                 (dot 0))))))
+
 (om/root
  (fn [app owner]
    (reify
@@ -106,7 +121,8 @@
                (dom/h1 nil "metronome")
                (om/build clock (:bpm app) {:init-state {:sound-channel sound-channel :click-channel click-channel}})
                (om/build sound (:meter app) {:init-state {:sound-channel sound-channel}})
-               (om/build click nil {:init-state {:click-channel click-channel}}))
+               (om/build click nil {:init-state {:click-channel click-channel}})
+               (om/build dots (:meter app)))
       )))
  app-state
  {:target (. js/document (getElementById "app"))})


also add some debounce to edit-input

also add some debounce to edit-input

--- frontend/utils.cljs
+++ frontend/utils.cljs
@@ -106,6 +106,19 @@
 (defn encode-branch [branch]
   (-> branch name js/encodeURIComponent))

+;; Stores unique keys to uuids for the functions
+(def debounce-state (atom {}))
+
+(defn debounce
+  "Takes a unique key and a function, will only execute the last function
+   in a sliding 20ms interval (slightly longer than 16ms, time for rAF, seems to work best)"
+  [unique-key f]
+  (let [f-uuid (uuid)]
+    (swap! debounce-state assoc unique-key f-uuid)
+    (js/setTimeout #(when (= f-uuid (get @debounce-state unique-key))
+                      (f))
+                   20)))
+
 (defn edit-input
   "Meant to be used in a react event handler, usually for the :on-change event on input.
   Path is the vector of keys you would pass to assoc-in to change the value in state,
@@ -113,7 +126,7 @@
   Optionally takes :value as a keyword arg to override the event's value"
   [controls-ch path event & {:keys [value]
                              :or {value (.. event -target -value)}}]
-  (put! controls-ch [:edited-input {:path path :value value}]))
+  (debounce path #(put! controls-ch [:edited-input {:path path :value value}])))

 (defn toggle-input
   "Meant to be used in a react event handler, usually for the :on-change event on input.


Update generator.clj

Update generator.clj

--- src/swagger_gen/generator.clj
+++ src/swagger_gen/generator.clj
@@ -36,11 +36,11 @@

 (defn -main [& args]
   (let [args (parse-opts args cli-options)]
-    (let [template (get-in args [:options :template])
-          spec (get-in args [:options :spec])
+    (let [template    (get-in args [:options :template])
+          spec        (get-in args [:options :spec])
           destination (get-in args [:options :destination])]
       ;; TODO error handling on missing args
       (do
         (println "Generating swagger output from spec")
         (spit destination (render-swagger spec template))))))
-
+