Fix exception

Fix exception

--- src/clojure/clojurewerkz/cassaforte/client.clj
+++ src/clojure/clojurewerkz/cassaforte/client.clj
@@ -72,7 +72,7 @@

   Object
   (build-statement [s]
-    (throw (RuntimeException. "Can't build the statement out of the" (type s)))))
+    (throw (RuntimeException. (str "Can't build the statement out of the" (type s))))))

 (defprotocol Listenable
   (add-listener [_ runnable executor]))


Filter

Filter

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -597,6 +597,29 @@
 (defn function [f var vars]
   (Function. f var vars (make-array (alength vars))))

+(deftype Filter [f vars scratch]
+  Object
+  (reset [this solver constraint]
+         (dotimes [i (alength vars)]
+           (.set-watch solver (aget vars i) constraint true)))
+  (split-left [this solver constraint]
+              false)
+  (split-right [this solver constraint])
+  (propagate [this solver constraint]
+             (let [los (.-los solver)
+                   his (.-his solver)]
+               (loop [i 0]
+                 (if (< i (alength vars))
+                   (let [var (aget vars i)]
+                     (when (identical? (aget los var) (aget his var))
+                       (aset scratch i (aget los var))
+                       (recur (+ i 1))))
+                   (when (false? (.apply f nil scratch))
+                     (set! (.-failed? solver) true)))))))
+
+(defn filter [f vars]
+  (Filter. f vars (make-array (alength vars))))
+
 ;; SOLVER

 ;; los and his are inclusive
@@ -1148,4 +1171,23 @@
   (take 100 (take-while identity (repeatedly #(.next s))))
   )

+  (let [tree1 (tree 10)
+      _ (.assoc! tree1 #js ["a" "b"] 0)
+      _ (.assoc! tree1 #js ["b" "c"] 0)
+      _ (.assoc! tree1 #js ["c" "d"] 0)
+      _ (.assoc! tree1 #js ["d" "b"] 0)
+      tree2 (tree 10)
+      _ (.assoc! tree2 #js ["b" "a"] 0)
+      _ (.assoc! tree2 #js ["c" "b"] 0)
+      _ (.assoc! tree2 #js ["d" "c"] 0)
+      _ (.assoc! tree2 #js ["b" "d"] 0)
+      s (solver 4
+                #js [(contains (iterator tree1) #js [0 1])
+                     (contains (iterator tree2) #js [2 3])
+                     (filter = #js [1 3])])
+      ]
+    (.reset s)
+  (take 100 (take-while identity (repeatedly #(.next s))))
+  )
+
  )


core: comparator

core: comparator

--- data/core.clj
+++ data/core.clj
@@ -1543,3 +1543,10 @@
   "defs the supplied var names with no bindings, useful for making forward declarations."
   {:added "1.0"}
   [& names] `(do ~@(map #(list 'def (vary-meta % assoc :declared true)) names)))
+
+(defn comparator
+  "Returns a comparator based upon pred."
+  {:added "1.0"}
+  [pred]
+  (fn [x y]
+    (cond (pred x y) -1 (pred y x) 1 :else 0)))


core: iterate

core: iterate

--- data/core.clj
+++ data/core.clj
@@ -1475,3 +1475,8 @@
   {:added "1.0"}
   ([x] (lazy-seq (cons x (repeat x))))
   ([n x] (take n (repeat x))))
+
+(defn iterate
+  "Returns a lazy sequence of x, (f x), (f (f x)) etc. f must be free of side-effects"
+  {:added "1.0"}
+  [f x] (cons x (lazy-seq (iterate f (f x)))))


Add support for project dependencies when compiling

--- src/leiningen/droid/compile.clj
+++ src/leiningen/droid/compile.clj
@@ -23,18 +23,21 @@
   This task is necessary if you define the UI in XML and also to gain
   access to your strings and images by their ID."
   [{{:keys [sdk-path target-version manifest-path res-path gen-path
-            out-res-path]} :android}]
+            out-res-path external-res-paths library]} :android}]
   (info "Generating R.java...")
   (let [aapt-bin (str sdk-path "/platform-tools/aapt")
         android-jar (get-sdk-android-jar sdk-path target-version)
-        manifest-file (io/file manifest-path)]
+        manifest-file (io/file manifest-path)
+        library-specific (if library "--non-constant-id" "--auto-add-overlay")
+        external-resources (for [res external-res-paths] ["-S" res])]
     (ensure-paths sdk-path manifest-path res-path aapt-bin android-jar)
     (.mkdirs (io/file gen-path))
     (.mkdirs (io/file out-res-path))
-    (sh aapt-bin "package" "-f" "-m" "--auto-add-overlay"
+    (sh aapt-bin "package" library-specific "-f" "-m"
         "-M" manifest-path
+        "-S" out-res-path
         "-S" res-path
-        "-S" out-res-path
+        external-resources
         "-I" android-jar
         "-J" gen-path
         "--generate-dependencies")))
@@ -50,15 +53,15 @@
   Then the path to the actual `android.jar` file is constructed and
   appended to the rest of the classpath list. Also removes all duplicate
   jars from the classpath."
-  [f {{:keys [sdk-path target-version use-google-api]} :android :as project}]
+  [f {{:keys [sdk-path target-version external-classes-paths use-google-api]}
+      :android :as project}]
   (let [classpath (f project)
         [jars paths] ((juxt filter remove) #(re-matches #".+\.jar" %) classpath)
-        result (conj (concat (unique-jars jars) paths
+        result (conj (concat (unique-jars jars) paths external-classes-paths
                              (when use-google-api
                                (get-sdk-google-api-jars sdk-path
                                                         target-version)))
                      (get-sdk-android-jar sdk-path target-version)
-
                      (str sdk-path "/tools/support/annotations.jar"))]
     result))


Revert "-"

Revert "-"

This reverts commit 6b458b84542500902cc2e81f93cd8f00f5bb547e.

--- src/c4_arena/core.clj
+++ src/c4_arena/core.clj
@@ -142,18 +142,14 @@
   (let [ch-in (chan)
         ch-out (chan)]
     ;; Incoming messages
-    (st/consume (fn [msg] (put! ch-in (parse-string msg))) s)
+    (st/connect (st/map #(parse-string % true) s) ch-in)
     ;; Outgoing messages
-    (go-loop []
-      (when-let [msg (<! ch-out)]
-        (st/put! s (generate-string msg))))
+    (st/connect (st/map generate-string ch-out) s)
     ;; Event loop for the connection
     (go
       ;; Keep waiting to start new games if channels are still alive
       (<! (game-handler [ch-in ch-out]))
-      (st/close! s))
-    ;; Cleanup
-    (st/on-drained s (fn [] (async/close! ch-in) (async/close! ch-out)))))
+      (st/close! s))))

 ;;; Websocket connection for the game protocol
 (defn game-handler [req]
@@ -173,4 +169,4 @@

 (defn -main [& args]
   (matcher-init)
-  (http/start-server #'app {:port 8001}))
+  (http/start-server #'game-handler {:port 8001}))


access :move closer to use

access :move closer to use

--- src/c4_arena/core.clj
+++ src/c4_arena/core.clj
@@ -106,7 +106,7 @@
         (notify ch-out))
       ;; During the game
       (loop []
-        (when-let [[{:keys [type move] :as msg} ch-in] (alts! ch-ins)]
+        (when-let [[{:keys [type] :as msg} ch-in] (alts! ch-ins)]
           (let [actor (.indexOf ch-ins ch-in)
                 ch-out (ch-outs actor)]
             (if-not msg
@@ -124,7 +124,7 @@
                              "Not your turn"
                              ;; Move gets processed here via
                              ;; side-effect (boo!)
-                             (not (process-move move))
+                             (not (process-move (:move msg)))
                              "Invalid move")]
                 (cond
                   reason


Convert params of normal fn.

Convert params of normal fn.

--- src/cbfg/zgo/core.clj
+++ src/cbfg/zgo/core.clj
@@ -139,7 +139,9 @@
    "="     (make-cvt-infix "==")})

 (defn cvt-normal-fn [lvl scope name args]
-  [(cvt-sym name) "(" args ")"])
+  [(cvt-sym name) "(" (interpose ","
+                                 (map (fn [arg] (cvt-expr (inc lvl) scope arg))
+                                      args)) ")"])

 (defn cvt-expr [lvl scope expr]
   (cond


formatting, fix `cljs.repl/source` docstring

support `(cljs.repl/pst)` as pointed out by Mike Fikes

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -329,7 +329,7 @@
      ((:print opts) value))
    (when-let [st (:stacktrace ret)]
      (if (and (true? (:source-map opts))
-           (satisfies? IParseStacktrace repl-env))
+              (satisfies? IParseStacktrace repl-env))
        (let [cst (-parse-stacktrace repl-env st ret opts)]
          (if (vector? cst)
            (if (satisfies? IPrintStacktrace repl-env)
@@ -923,7 +923,7 @@
 (defmacro source
   "Prints the source code for the given symbol, if it can find it.
   This requires that the symbol resolve to a Var defined in a
-  namespace for which the .clj is in the classpath.
+  namespace for which the .cljs is in the classpath.

   Example: (source filter)"
   [n]
@@ -952,19 +952,21 @@
   `(doseq [sym# (quote ~(sort (keys (ana-api/ns-publics ns))))]
      (println sym#)))

-(defmacro pst [e]
-  (let [{:keys [repl-env] :as env} &env]
-    (when repl-env
-      (let [ret (edn/read-string
-                  (evaluate-form repl-env env "<cljs repl>"
-                   `(when ~e
-                      (pr-str
-                        {:value (.-message ~e)
-                         :stacktrace (.-stack ~e)}))))]
-        (when ret
-          (let [ret (update-in ret [:value]
-                      (fn [msg]
-                        (if (satisfies? IParseErrorMessage repl-env)
-                          (-parse-error-message repl-env msg ret *repl-opts*)
-                          msg)))]
-            (display-error repl-env ret nil *repl-opts*)))))))
+(defmacro pst
+  ([] `(pst *e))
+  ([e]
+   (let [{:keys [repl-env] :as env} &env]
+     (when (and e repl-env)
+       (let [ret (edn/read-string
+                   (evaluate-form repl-env env "<cljs repl>"
+                     `(when ~e
+                        (pr-str
+                          {:value (.-message ~e)
+                           :stacktrace (.-stack ~e)}))))]
+         (when ret
+           (let [ret (update-in ret [:value]
+                       (fn [msg]
+                         (if (satisfies? IParseErrorMessage repl-env)
+                           (-parse-error-message repl-env msg ret *repl-opts*)
+                           msg)))]
+             (display-error repl-env ret nil *repl-opts*))))))))


first cut of `cljs.test/run-tests`

first cut of `cljs.test/run-tests`

--- src/clj/cljs/test.clj
+++ src/clj/cljs/test.clj
@@ -211,6 +211,29 @@
             (cljs.test/test-var env# (.-cljs$lang$var ~name)))))
        (set! (.-cljs$lang$var ~name) (var ~name)))))

+;; =============================================================================
+;; Running Tests
+
+(defmacro run-tests
+  "Runs all tests in the given namespaces; prints results.
+  Defaults to current namespace if none given.  Returns a map
+  summarizing test results."
+  ([] `(run-tests (cljs.test/empty-env) '~ana/*cljs-ns*))
+  ([env & namespaces]
+   (assert (every?
+             (fn [[quote ns]] (and (= quote 'quote) (symbol? ns)))
+             namespaces)
+     "All arguments to run-tests must be quoted symbols")
+   `(let [summary# (apply merge-with +
+                     [~@(map
+                          (fn [ns]
+                            `(cljs.test/test-ns
+                               (assoc ~env :return true) ~ns))
+                          namespaces)])]
+      (do-report summary#
+        (assoc (:report-counters summary#) :type :summary))
+      summary#)))
+
 (defmacro test-all-vars
   "Calls test-vars on every var interned in the namespace, with fixtures."
   ([ns]


Add file, filename, url, path and extension helpers to cljs.util

--- src/clj/cljs/util.clj
+++ src/clj/cljs/util.clj
@@ -9,7 +9,8 @@
 (ns cljs.util
   (:require [clojure.java.io :as io]
             [clojure.string :as string])
-  (:import [java.io File]))
+  (:import [java.io File]
+           [java.net URL]))

 ;; next line is auto-generated by the build-script - Do not edit!
 (def ^:dynamic *clojurescript-version*)
@@ -73,3 +74,23 @@
   ([opts] (output-directory opts "out"))
   ([opts default]
     (or (:output-dir opts) default)))
+
+(defn file? [f]
+  (instance? File f))
+
+(defn url? [f]
+  (instance? URL f))
+
+(defn ^String filename [^File f]
+  (.getName f))
+
+(defn ^String path [^URL url]
+  (.getPath url))
+
+(defn ^String ext
+  "Given a file or url return the file extension."
+  [f]
+  (let [s (cond
+            (file? f) (filename f)
+            (url? f) (path f))]
+    (last (string/split s #"\."))))


call gain-agenda-point when forfeiting

call gain-agenda-point when forfeiting

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -1612,7 +1612,7 @@
 (defn forfeit [state side card]
   (let [c (desactivate state side card)]
     (system-msg state side (str "forfeits " (:title c)))
-    (gain state side :agenda-point (- (get-agenda-points state side c)))
+    (gain-agenda-point state side (- (get-agenda-points state side c)))
     (move state :corp c :rfg)))

 (defn expose [state side target]


refactor subdb code

refactor subdb code

--- src/cljs/sm/core.cljs
+++ src/cljs/sm/core.cljs
@@ -3,6 +3,9 @@
   (:require [wilkerdev.util.nodejs :refer [lstat fopen fread http] :as node]))

 (def ^:dynamic *subdb-endpoint* "http://api.thesubdb.com/")
+
+(defn map->query [m]
+  (.toString (.createFromMap goog.Uri.QueryData (clj->js m))))

 (def subdb-ua "SubDB/1.0 (Subtitle Master/2.0.1; http://subtitlemaster.com)")

@@ -20,11 +23,17 @@

       (node/md5-hex buffer))))

+(defn subdb-query
+  ([action] (subdb-query action {}))
+  ([action options]
+   (let [query (map->query (merge {:action action} options))
+         uri (str *subdb-endpoint* "?" query)]
+     {:uri     uri
+      :headers {"User-Agent" subdb-ua}})))
+
 (defn subdb-search-languages [hash]
   (go-catch
-    (let [uri (str *subdb-endpoint* "?action=search&hash=" hash "&versions")
-          params {:uri     uri
-                  :headers {"User-Agent" subdb-ua}}
+    (let [params (subdb-query "search" {:hash hash :versions ""})
           response (<? (http params))
           status (.-statusCode response)
           parse-language (fn [l] (let [[lang count] (.split l ":")]
@@ -39,9 +48,7 @@
   ([hash language] (subdb-download hash language 0))
   ([hash language version]
    (go-catch
-     (let [uri (str *subdb-endpoint* "?action=download&hash=" hash "&version=" version "&language=" language)
-           params {:uri     uri
-                   :headers {"User-Agent" subdb-ua}}
+     (let [params (subdb-query "download" {:hash hash :version version :language language})
            response (<? (http params))
            status (.-statusCode response)]
        (if (= 200 status)
@@ -49,9 +56,7 @@

 (defn subdb-upload [hash stream]
   (go-catch
-    (let [uri (str *subdb-endpoint* "?action=upload")
-          params {:uri     uri
-                  :headers {"User-Agent" subdb-ua}}
+    (let [params (subdb-query "upload")
           build-form (fn [f]
                        (.append f "hash" hash)
                        (.append f "file" stream #js {:contentType "application/octet-stream"}))


fixed typo in Content-Type header

fixed typo in Content-Type header


leaf decision added to corpus

leaf decision added to corpus

--- src/crawler/crawl.clj
+++ src/crawler/crawl.clj
@@ -491,7 +491,17 @@
                                 sampled-corpus))]
           (merge-with concat acc {:leaf-paths leaf-paths
                                   :examples examples
-                                  :corpus   sampled-corpus
+                                  :corpus   (map
+                                             (fn [x]
+                                               (merge x {:leaf (try
+                                                                 (and
+                                                                  (:src-text x)
+                                                                  (:body x)
+                                                                  (leaf? {:anchor-text (:src-text x)
+                                                                          :src-url     (:url x)
+                                                                          :body        (:body x)}))
+                                                                 (catch Exception e nil))}))
+                                             sampled-corpus)
                                   :new-visited links-list})))
       {}
       xpaths-and-urls)))


increase exploration

increase exploration

--- src/crawler/crawl.clj
+++ src/crawler/crawl.clj
@@ -493,9 +493,8 @@

               ;; sample 10 or 25% of the links (whichever is bigger)
               links-and-texts (utils/random-take
-                               ;; (max 10 (int (/ (count stuff)
-                               ;;                 4)))
-                               10
+                               (max 10 (int (/ (count stuff)
+                                               4)))
                                stuff)

               sampled-corpus  (filter


Update nml-map to handle r* value

Update nml-map to handle r* value

--- src/nml/core.clj
+++ src/nml/core.clj
@@ -192,14 +192,16 @@
                 :nv_subsequence (fn [name values] {name values})
                 :nv_subsequence_begin identity
                 :partref identity
+                :r identity
                 :real string_id
                 :s (fn [& nv_sequences] (into {} nv_sequences))
                 :sign identity
                 :stmt (fn [name nv_sequence _] (into {} {name nv_sequence}))
                 :true string_lc
                 :uint identity
+                :star identity
                 :string string_id
-                :value identity
+                :value string_id
                 :values (fn [& values] (into [] values))
                 } tree)]
       (println (str "### after " new))


Whoops. I'd lost query-string param handling

--- src/onix/web.clj
+++ src/onix/web.clj
@@ -19,7 +19,8 @@
              [pokemon :as pokemon]]
             [ring.middleware
              [format-params :refer [wrap-json-kw-params]]
-             [format-response :refer [wrap-json-response]]]))
+             [format-response :refer [wrap-json-response]]
+             [params :refer [wrap-params]]]))

 (def json-content-type "application/json;charset=UTF-8")
 (def text-plain-type "text/plain;charset=UTF-8")
@@ -156,6 +157,7 @@
       (instrument)
       (wrap-error-handling)
       (wrap-ignore-trailing-slash)
+      (wrap-json-response)
       (wrap-json-kw-params)
-      (wrap-json-response)
+      (wrap-params)
       (expose-metrics-as-json)))


Restart the entire peer when there's a midway failure.

--- src/onyx/api.clj
+++ src/onyx/api.clj
@@ -110,12 +110,13 @@

                              (let [restart-ch (:dead-restart-tail-ch (:peer live))
                                    [v ch] (alts!! [stop-ch restart-ch] :priority true)]
-                               (when (= ch stop-ch)
+                               (if (= ch stop-ch)
                                  (try
                                    (component/stop live)
                                    (catch Exception e
                                      (warn e)
-                                     :stopped)))))
+                                     :stopped))
+                                 (throw (ex-info "Peer failed" {})))))
                            (catch Exception e
                              (warn e)
                              (warn "Virtual peer failed, backing off and rebooting...")


Fix API error.

Fix API error.

--- src/onyx/api.clj
+++ src/onyx/api.clj
@@ -226,7 +226,7 @@
   "Blocks until job-id has had all of its tasks completed or the job is killed.
    Returns true if the job completed successfully, false if the job was killed."
   ([peer-config job-id]
-     (await-job-completion peer-config job-id {:monitoring :no-op}))
+     (await-job-completion peer-config job-id {:monitoring-config {:monitoring :no-op}}))
   ([peer-config job-id {:keys [monitoring-config timeout-ms]}]
    (let [job-id (validator/coerce-uuid job-id)
          client (component/start (system/onyx-client peer-config monitoring-config))


Cleanup messenger replica

Cleanup messenger replica

--- src/onyx/messaging/messenger_replica.clj
+++ src/onyx/messaging/messenger_replica.clj
@@ -105,26 +105,10 @@
         remove-subs (difference (:subs old-pub-subs) (:subs new-pub-subs))
         add-subs (difference (:subs new-pub-subs) (:subs old-pub-subs))]
     (as-> messenger m
-      (reduce (fn [m pub]
-                ;(println "Should be removing pub" pub)
-                (m/remove-publication m pub))
-              m
-              remove-pubs)
-      (reduce (fn [m pub]
-                ;(println "Should be adding pub " pub)
-                (m/add-publication m pub))
-              m
-              add-pubs)
-      (reduce (fn [m sub]
-                ;(println "should be removing sub" sub)
-                (m/remove-subscription m sub))
-              m
-              remove-subs)
-      (reduce (fn [m sub]
-                ;(println "should be adding sub" sub)
-                (m/add-subscription m sub))
-              m
-              add-subs))))
+      (reduce m/remove-publication m remove-pubs)
+      (reduce m/add-publication m add-pubs)
+      (reduce m/remove-subscription m remove-subs)
+      (reduce m/add-subscription m add-subs))))

 (defn assert-consistent-messenger-state [messenger pub-subs pre-post]
   (assert (= (count (:pubs pub-subs))


Cleanup

Cleanup

--- src/fugue/space.cljs
+++ src/fugue/space.cljs
@@ -7,7 +7,7 @@

 (def init-state-m
   {:boxes '(1 (2 3))
-   :active-box 1
+   :active 1
    :next-id 4
    :result nil
    :files {1 "(+ 82 34)" 2 "bar" 3 "biz"}})
@@ -43,26 +43,27 @@
         (recur (zip/next loc))))))

-(defn init-state [state]
-  (assoc-in state [:cljs.analyzer/namespaces 'cljs.user]
-            (analyzer-state 'fugue.api)))
+(defn load-namespace [eval-state]
+  (assoc-in eval-state [:cljs.analyzer/namespaces 'cljs.user] (analyzer-state 'fugue.api)))

-(def state (cljs.js/empty-state init-state))
+(defn current-buffer-text [state]
+  (get-in state [:files (:active state)]))

-(def eval-settings
+(defn eval-settings [state]
   {:eval cljs.js/js-eval
-   :context :statement})
+   :context :statement
+   :load (fn [m cb]
+           (if-let [source (get-in state [:files (str :name m)])]
+             (cb {:lang :clj :source source})
+             (cb nil)))})

-(defn eval-str [source load-fn cb]
-  (cljs.js/eval-str state source nil (assoc eval-settings :load load-fn) cb))
+(defn eval-active [eval-state app-state cb]
+  (cljs.js/eval-str eval-state (current-buffer-text app-state) nil (eval-settings app-state) cb))

-(defn do-eval [state cb]
-  (let [text (get-in state [:files (:active-box state)])
-        load-fn (fn [m cb]
-                  (if-let [source (get-in state [:files (str (:name m))])]
-                    (cb {:lang :clj :source source})
-                    (cb nil)))]
-    (eval-str text load-fn cb)))
+(defn on-eval [state result]
+  (-> state
+      (assoc-in [:files (:next-id state)] (str result))
+      (update :boxes insert :below (:active state) (:next-id state))))

 (defn boxes [files box is-row]
   [:div {:style {:display "flex"
@@ -73,13 +74,16 @@
      [:p (str (get files box))])])

 (defn app []
-  (let [state (r/atom init-state-m)]
+  (let [eval-state (cljs.js/empty-state load-namespace)
+        app-state (r/atom init-state-m)]
+    (defn eval! []
+      (eval-active eval-state @app-state (partial swap! app-state on-eval)))
     (fn []
       [:div
-       [:button {:on-click #(do-eval @state (partial swap! state update :boxes insert :below (:active-box @state)))}
+       [:button {:on-click eval!}
         "Click me"]
-       [:p (str @state)]
-       (boxes (:files @state) (:boxes @state) true)])))
+       [:p (str @app-state)]
+       (boxes (:files @app-state) (:boxes @app-state) true)])))


arglist

arglist

--- src/govalert/api.clj
+++ src/govalert/api.clj
@@ -10,7 +10,7 @@
             [net.cgrand.enlive-html :as html]))

 (html/deftemplate subscribe-html "../resources/public/index.html"
-  [{govbodies :govbodies}]
+  [& {govbodies :govbodies}]
   [:select]
   (html/clone-for [body govbodies]
     (html/content


extract startup function

extract startup function

--- src/holston/core.clj
+++ src/holston/core.clj
@@ -41,8 +41,11 @@
     ring-app
     auth/auth-params)))

+(defn start-server [port]
+  (println (str "Starting Holston on port " port))
+  (run-server (site #'app) {:port port}))
+
 (defn -main
   "Starts the server"
   [port]
-  (println "Starting Holston")
-  (run-server (site #'app) {:port (Integer. port)}))
+  (start-server (Integer. port)))


Add ->Triple constructors but make them construct Quad types

--- src/rdf-common/grafter/rdf/protocols.clj
+++ src/rdf-common/grafter/rdf/protocols.clj
@@ -94,10 +94,19 @@
   (nth [this ^int i default]
     (destructure-quad this i default)))

-(defn ->Triple [s p o]
+(defn ->Triple
+  "Constructs a Quad with a nil graph (context)."
+  [s p o]
   (->Quad s p o nil))

-(defn map->Triple [m]
+(defn triple? [t]
+  (if (context t)
+    true
+    false))
+
+(defn map->Triple
+  "Constructs a Quad from an {:s :p :o } mapwith a nil graph (context)."
+  [m]
   (->Triple (:s m) (:p m) (:o m)))

 (extend-type clojure.lang.IPersistentVector


refactoring ring response generation

refactoring ring response generation

--- src/statuspage_crawler/server/routes.clj
+++ src/statuspage_crawler/server/routes.clj
@@ -4,12 +4,17 @@
             [compojure.core :refer [defroutes context routes GET POST PUT]]
             [compojure.route :as route]
             [statuspage-crawler.domain.crawler :as crawler]
-            [statuspage-crawler.server.db :as db]))
+            [statuspage-crawler.server.db :as db]
+            [statuspage-crawler.util :refer :all]))

 (defn not-found-response [job-id]
   {:status 404
    :body (str "Could not find job with id : " job-id)})

+(defn ->ring-response [status body]
+  {:status status
+   :body body
+   :content-type "application/json"})

 (defn create-new-job [{:keys [params]}]
   (let [urls (get params "urls")
@@ -17,22 +22,18 @@
         job-id (:id job-row)]
     (future
       (crawler/images-in-urls job-id urls))
-    {:status 202
-     :body (json/encode {:job-id job-id})}))
+    (->ring-response 202 (json/encode {:job-id job-id}))))

 (defn status [{:keys [params]} job-id]
   (if-let [job (db/find-job job-id)]
-    {:status 200
-     :body (json/encode {:status (:status job)})}
+    (->ring-response 200 (json/encode {:status (:status job)}))
     (not-found-response job-id)))

 (defn result [{:keys [params]} job-id]
   (if-let [job (db/find-job job-id)]
     (if (= "completed" (:status job))
-      {:status 200
-       :body (:body job)}
-      {:status 200
-       :body "Job is still running. Check back later."})
+      (->ring-response 200 (json/encode (:body job)))
+      (->ring-response 200 "Job is still running. Check back later."))
     (not-found-response job-id)))

 (def all-routes


Skip loading some namespaces

Skip loading some namespaces

Some namespaces will cause an issue if actually
loaded, so skip them.

Also refactor a bit with some helper fns.

Former-commit-id: a2bf649ca2e29d84dc5329b7ab48b64bb26980ef

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -508,27 +508,43 @@

 (def closure-index-mem (memoize closure-index))

+(defn- skip-load? [{:keys [name macros]}]
+  (cond
+    (= name 'cljs.core) true
+    (and (= name 'cljs.pprint) macros) true
+    :else false))
+
+(defn- load-file [file cb]
+  (when-not (load-and-callback! file :clj :calculate-cache-prefix cb)
+    (cb nil)))
+
+(defn- load-goog [name cb]
+  (if-let [goog-path (get (closure-index-mem) name)]
+    (when-not (load-and-callback! (str goog-path ".js") :js nil cb)
+      (cb nil))
+    (cb nil)))
+
+(defn- load-other [path macros cb]
+  (loop [extensions (if macros
+                      [".clj" ".cljc"]
+                      [".cljs" ".cljc" ".js"])]
+    (if extensions
+      (when-not (load-and-callback!
+                  (str path (first extensions))
+                  (extension->lang (first extensions))
+                  (cache-prefix-for-path path)
+                  cb)
+        (recur (next extensions)))
+      (cb nil))))
+
 ; file here is an alternate parameter denoting a filesystem path
 (defn load [{:keys [name macros path file] :as full} cb]
-  (if file
-    (when-not (load-and-callback! file :clj :calculate-cache-prefix cb)
-      (cb nil))
-    (if (re-matches #"^goog/.*" path)
-      (if-let [goog-path (get (closure-index-mem) name)]
-        (when-not (load-and-callback! (str goog-path ".js") :js nil cb)
-          (cb nil))
-        (cb nil))
-      (loop [extensions (if macros
-                          [".clj" ".cljc"]
-                          [".cljs" ".cljc" ".js"])]
-        (if extensions
-          (when-not (load-and-callback!
-                      (str path (first extensions))
-                      (extension->lang (first extensions))
-                      (cache-prefix-for-path path)
-                      cb)
-            (recur (next extensions)))
-          (cb nil))))))
+  (cond
+    (skip-load? full) (cb {:lang   :js
+                           :source ""})
+    file (load-file file cb)
+    (re-matches #"^goog/.*" path) (load-goog name cb)
+    :else (load-other path macros cb)))

 (defn- handle-error [e include-stacktrace? in-exit-context?]
   (let [cause (or (.-cause e) e)


More progress on creating a new team

More progress on creating a new team

--- webapp/src/org/teamweek/webapp/endpoint/team.clj
+++ webapp/src/org/teamweek/webapp/endpoint/team.clj
@@ -1,6 +1,7 @@
 (ns org.teamweek.webapp.endpoint.team
   (:require [compojure.core :refer :all]
             [ring.util.response :refer :all]
+            [ring.middleware.flash :refer [flash-response]]
             [clj-http.client :as http]
             [cheshire.core :refer [parse-string]]
             [datomic.api :as d]))
@@ -28,10 +29,8 @@

 (defn create-team
   "Creates a team based on a token"
-  [conn token]
-  (let [team-data (get-team-data token)
-        team-id (d/tempid :db.part/user)
-        team-tx {:db/id team-id
+  [conn token team-data]
+  (let [team-tx {:db/id (d/tempid :db.part/user)
                  :team/domain (:domain team-data)
                  :team/token token
                  :team/name (:name team-data)
@@ -42,20 +41,33 @@
                  :team/questions [{:question/text "What have you accomplished this week?"
                                    :question/order 1}
                                   {:question/text "What you commit to do next week?"
-                                   :question/order 2}]}
-        ]
+                                   :question/order 2}]}]
     @(d/transact conn [team-tx])))

 (defn team-endpoint [config]
   (context "/team" []
    (GET "/" req
-     (str ring.middleware.anti-forgery/*anti-forgery-token*))
+     (prn ring.middleware.anti-forgery/*anti-forgery-token*)
+     (if-let [token (get (:session req) "teamweek-token")]
+       "OK"
+       (redirect "/")))
    (POST "/" req
      (if-let [token (get (:form-params req) "token")]
        (let [db (:db req)
              conn (:conn req)
              team (ffirst (d/q '[:find ?e :in $ ?t :where [?e :team/token ?t]] db token))]
          (if team
-           (pr-str (d/touch (d/entity db team)))
-           (create-team conn token)))
-       {:status 400}))))
+           (-> (redirect "/team")
+               (assoc-in [:session "teamweek-token"] token))
+           (let [team-data (get-team-data token)]
+             (if (:domain team-data)
+               (do
+                 (create-team conn token team-data)
+                 (->
+                   (redirect "/team")
+                   (assoc-in [:session "teamweek-token"] token)))
+               (do
+                 ;; How does this work?
+                 ;; (flash-response {:flash "Invalid token"} req)
+                 (redirect "/"))))))
+       (redirect "/")))))


fix typo

fix typo

--- src/main/clojure/clojure/tools/analyzer/js.clj
+++ src/main/clojure/clojure/tools/analyzer/js.clj
@@ -11,9 +11,9 @@
   (:refer-clojure :exclude [macroexpand-1 var?])
   (:require [clojure.tools.analyzer
              :as ana
-             :refer [analyze analyze-in-env ctx]
+             :refer [analyze analyze-in-env]
              :rename {analyze -analyze}]
-            [clojure.tools.analyzer.utils :refer [resolve-var]]
+            [clojure.tools.analyzer.utils :refer [resolve-var ctx]]
             cljs.tagged-literals)
   (:import cljs.tagged_literals.JSValue))


friend-list: added comment to tests regarding ordering of mock calls

--- examples/friend-list/test/unit/controller.cljs
+++ examples/friend-list/test/unit/controller.cljs
@@ -18,6 +18,7 @@
       (control :_model [:middleware.history/on-enter :_new-token] dispatch-signal dispatch-action)

       ; assert
+      ; order of calls doesn't matter because we know that searching is async, thus :on-search-success will be called on next tick
       (is (f/was-called-once dispatch-action [[:set-query :_new-token]]))
       (is (f/was-called-once dispatch-signal [[:on-search-success :_new-token :_found-friends]])))))


When archiving a repaired production update the container table

instead of inserting a new row

--- src/mdr2/archive.clj
+++ src/mdr2/archive.clj
@@ -40,6 +40,7 @@
             [me.raynes.fs :as fs]
             [mdr2.production :as prod]
             [mdr2.production.path :as path]
+            [mdr2.repair :as repair]
             [mdr2.rdf :as rdf]))

 (def ^:private db (env :archive-database-url))
@@ -56,14 +57,6 @@
 (def other-spool-dir
   "Path to the archive spool directory for other productions"
   (env :archive-other-spool-dir))
-
-(def ^:private default-job
-  {:archivar "Madras2"
-   :abholer ""
-   :aktion "save"
-   :transaktions_status "pending"
-   :container_status "ok"
-   :bemerkung ""})

 (defn- container-id
   "Return the name of a archive spool directory for a given
@@ -99,18 +92,34 @@
         rdf-name (str (container-id production sektion) ".rdf")]
     (.getPath (file root-path rdf-name))))

+(defn- db-job
+  "Return a map that can be used to insert a job in the archive db"
+  [verzeichnis sektion datum aktion]
+  {:archivar "Madras2"
+   :abholer ""
+   :aktion aktion
+   :transaktions_status "pending"
+   :container_status "ok"
+   :bemerkung ""
+   :verzeichnis verzeichnis
+   :sektion sektion
+   :datum datum})
+
 (defn- add-to-db
   "Insert a `production` into the archive db for the given `sektion`.
   This marks the files in the spool directory as ready for archiving
   and concludes the archiving process from the point of view of the
   production system."
   [production sektion]
-  (let [new-job
-        {:verzeichnis (container-id production sektion)
-         :sektion (case sektion :master "master" :dist-master "cdimage")
-         :datum (to-date (t/now))}
-        job (merge default-job new-job)]
-    (jdbc/insert! db :container job)))
+  (let [update (> (:revision production) 1)
+        job (db-job (container-id production sektion)
+                    (case sektion :master "master" :dist-master "cdimage")
+                    (to-date (t/now))
+                    (if update "update" "save"))]
+    (if update
+      (let [container-id (repair/container-id production)]
+        (jdbc/update! db :container job ["id = ?" container-id]))
+      (jdbc/insert! db :container job))))

 (defn set-file-permissions
   "Set file permissions on `root` to g+w recursively"


Fix Alexey's GH login

Fix Alexey's GH login

--- src-cljs/frontend/components/about.cljs
+++ src-cljs/frontend/components/about.cljs
@@ -160,7 +160,7 @@
     :img-path (scaled-image-path "alexey")
     :email "alexey@circleci.com"
     :role "Support Engineer"
-    :github "applemac"
+    :github "appplemac"
     :bio "Alexey joins Circle from the sunny coasts of Spain. In between mountain biking, partying at art galleries and doing martial arts, he helps to ensure that Circle’s customers get the smoothest experience possible."}])


slightly faster pan and select cursors

slightly faster pan and select cursors


Default heartbeat-ms to 500ms

Default heartbeat-ms to 500ms

--- src/onyx/information_model.cljc
+++ src/onyx/information_model.cljc
@@ -721,7 +721,7 @@
             {:doc "Number of ms an idle peer should wait before sending a heartbeat message."
              :type :integer
              :unit :millisecond
-             :default 50
+             :default 500
              :optional? true
              :added "0.10.0"}


keen io timeout

keen io timeout

--- src/ontrail/keen.clj
+++ src/ontrail/keen.clj
@@ -21,7 +21,7 @@
   (merge {:accept :json
           :throw-exceptions false
           :socket-timeout 20000  ;; in milliseconds
-          :conn-timeout 120000}
+          :conn-timeout 240000}
          {:connection-manager conman}))

 (def read-key (-> properties :keen :read-key))


Offset of :modif was off by one

Offset of :modif was off by one

- was using inner start offset instead of upper start offset

--- src/paredit/core.clj
+++ src/paredit/core.clj
@@ -706,9 +706,10 @@
                                   [sel-so sel-eo])

             new-offset (- offset (- inner-so un-so))
-            replace-text (.substring text inner-so inner-eo)]
-        (-> t
-            (assoc-in [:text] (t/str-replace text replace-offset replace-length replace-text))
-            (assoc-in [:offset] new-offset)
-            (update-in [:modifs] conj {:offset inner-so :length replace-length :text replace-text})))
+            replace-text (.substring text inner-so inner-eo)
+            ret (-> t
+                    (assoc-in [:text] (t/str-replace text replace-offset replace-length replace-text))
+                    (assoc-in [:offset] new-offset)
+                    (update-in [:modifs] conj {:offset un-so :length replace-length :text replace-text}))]
+        ret)
       t)))


Fixed a bug with transitions that hold from -Infinity to Infinity.

--- src/player/core.cljs
+++ src/player/core.cljs
@@ -98,8 +98,8 @@
         [v10 v1f] (get-var-and-flow has ha v1k)
         [v20 v2f] (get-var-and-flow has ha v2k)
         sat (guard-satisfied? rel v10 v20 c)
-        #_ _ #_(println (str "(" v10 " + " v1f "t) - (" v20 " + " v2f "t) "
-             (case rel :gt ">" :geq ">=" :leq "<=" :lt "<") " " c))
+        #_(println (str "(" v10 " + " v1f "t) - (" v20 " + " v2f "t) "
+                        (case rel :gt ">" :geq ">=" :leq "<=" :lt "<") " " c))
         ; by algebra: A0+fA*dt-B0-fB*dt-C~0 --> (fA-fB)*dt ~ (-A0 + B0 + C) --> dt ~ (-A0 + B0 + C)/(fA-fB)
         denom (- v1f v2f)
         rhs (if (= denom 0)
@@ -116,7 +116,7 @@
                 :lt :gt))
         ; t REL rhs
         entry-time (:entry-time ha)
-        ;_ (println (:id ha) simple-guard "et" entry-time "push up" time-unit rhs "to" (+ entry-time time-unit) (+ entry-time rhs) "sat?" sat)
+        #_(println (:id ha) simple-guard "et" entry-time "push up" time-unit rhs "to" (+ entry-time time-unit) (+ entry-time rhs) "sat?" sat)
         min-t (+ entry-time time-unit)
         rhs (+ entry-time rhs)]
     (assert (not (nil? v10))
@@ -124,12 +124,15 @@
     (assert (not (nil? v20))
             "V2 must be a valid variable reference")
     (cond
-      ;if RHS is +-infinity, then the guard will never flip truth value
-      (or (= rhs Infinity) (= rhs -Infinity)) (if sat
-                                                [-Infinity Infinity]
-                                                [Infinity Infinity])
+      ;if RHS is +-infinity, then the guard will never flip truth value.
+      ;that said, we need to set the minimum actuation time to be min-t.
+      (or (= rhs Infinity)
+          (= rhs -Infinity)) (if sat
+                               [min-t Infinity]
+                               [Infinity Infinity])
       ; if t is bounded from above by a number less than time-unit, return an interval which will become empty during intersection
-      (and (< rhs min-t) (#{:lt :leq} rel)) [-Infinity rhs]
+      (and (< rhs min-t)
+           (#{:lt :leq} rel)) [-Infinity rhs]
       ; being bounded from below by a number less than time-unit is no problem. all intervals are open.
       :else (case rel
               ;  < : t  < rhs --> guard is true until t exceeds rhs
@@ -142,10 +145,10 @@
               :gt [(.max js/Math (+ rhs (/ time-unit 16)) min-t) Infinity]))))

 (defn transition-interval [has ha transition]
-  ;(println "Transition" (:id ha) (:x ha) (:target transition) (:guard transition))
+  #_(println "Transition" (:id ha) (:x ha) (:target transition) (:guard transition))
   (let [intervals (map #(simple-interval has ha %) (:guard transition))
         interval (intersect-all intervals)]
-    ;(println "interval:" intervals "->" interval)
+    #_(println "interval:" intervals "->" interval)
     ; TODO: handle cases where transition is also guarded on states
     {:interval   interval
      :id         (:id ha)
@@ -183,6 +186,8 @@
                                                                     ha
                                                                     Infinity
                                                                     (required-transitions ha)))
+        _ (assert (>= (first (:interval req)) now) "Can't transition until later than entry time")
+
         ; calculate intervals when optional guards will be satisfied up to and including the upcoming required guard, if any
         opts (transition-intervals has
                                    ha
@@ -235,16 +240,17 @@
                                          ; already-past...
                                          (<= end then)
                                          ; and too-far-in-the-future transitions
-                                         (> start min-t)) trs
-                                                          ; use max(then, start) as transition time
-                                                          (let [clipped-start (.max js/Math then start)
-                                                                ; clip the interval in the transition as appropriate
-                                                                trans (assoc trans :interval [clipped-start end])]
-                                                            (if (< clipped-start min-t)
-                                                              ; this is a new minimum time
-                                                              [clipped-start [trans]]
-                                                              ; otherwise must be equal to min-t
-                                                              [min-t (conj trs trans)]))))
+                                         (> start min-t))
+                                     trs
+                                     ; use max(then, start) as transition time
+                                     (let [clipped-start (.max js/Math then start)
+                                           ; clip the interval in the transition as appropriate
+                                           trans (assoc trans :interval [clipped-start end])]
+                                       (if (< clipped-start min-t)
+                                         ; this is a new minimum time
+                                         [clipped-start [trans]]
+                                         ; otherwise must be equal to min-t
+                                         [min-t (conj trs trans)]))))
                                  [Infinity []]
                                  (:optional-transitions ha))]
     (assert (not= req-t min-opt-t) "Ambiguous required vs optional transition")
@@ -298,9 +304,9 @@
                            (enter-state has ha (:state ha) t))
                          deps)]
     #_(println "next transitions" #_reenter-has (transition-intervals has
-                                                                    (second reenter-has)
-                                                                    Infinity
-                                                                    (required-transitions (second reenter-has))))
+                                                                      (second reenter-has)
+                                                                      Infinity
+                                                                      (required-transitions (second reenter-has))))
     (merge has (zipmap (map :id reenter-has) reenter-has))))

 (defn update-scene [scene now inputs bailout]
@@ -422,18 +428,21 @@

 (defn tick-frame [t]
   (when-not last-time (set! last-time t))
-  (when (:playing @scene-a)
-    (swap! scene-a
-           (fn [s] (let [new-s (update-scene s
-                                             (+ (:now s) (/ (- t last-time) 1000))
-                                             #{[(floor-time (:now s) time-unit) #{}]}
-                                             0)]
-                     (if (and (:pause-on-play new-s)
-                              (not= (ha-states s) (ha-states new-s)))
-                       (assoc new-s :playing false)
-                       new-s)))))
-  (set! last-time t)
-  (.requestAnimationFrame js/window tick-frame))
+  (assert (>= t last-time) "Non-monotonic time?")
+  (let [old-last-time last-time]
+    (set! last-time t)
+    (.requestAnimationFrame js/window tick-frame)
+    (when (:playing @scene-a)
+      (swap! scene-a
+             (fn [s] (let [new-s (update-scene s
+                                               (+ (:now s) (/ (- t old-last-time) 1000))
+                                               #{[(floor-time (:now s) time-unit) #{}]}
+                                               0)]
+                       (if (and (:pause-on-play new-s)
+                                (not= (ha-states s) (ha-states new-s)))
+                         (assoc new-s :playing false)
+                         new-s)))))))
+
 (when (= @scene-a {})
   (.requestAnimationFrame js/window tick-frame)
   (reset-scene-a!))
@@ -470,6 +479,8 @@
            (ha-states @scene))
          scene-a)

+(def show-transition-thresholds true)
+
 (defn scene-widget [scene _owner]
   (let [scale 2
         view-h (str (* scale 240) "px")
@@ -479,39 +490,40 @@
                              :width           (str (* scale 320) "px")
                              :height          view-h
                              :position        "relative"}}
-               (map (fn [ha i]
-                      (let [trans-count (count (required-transitions ha))
-                            trans-h (/ line-h trans-count)]
-                        [:div
-                         (map (fn [trans j]
-                                (let [[s e] (:interval trans)
-                                      sx (* scale (:x (extrapolate ha s)))
-                                      ex (* scale (:x (extrapolate ha e)))
-                                      line-top (+ (* i line-h) (* j trans-h))]
-                                  [:div {:style {:height        trans-h :width (.abs js/Math (- sx ex))
-                                                 :top           line-top :left (.min js/Math sx ex)
-                                                 :position      "absolute" :backgroundColor "grey"
-                                                 :pointerEvents "none"}}
-                                   [:div {:style {:position        "absolute"
-                                                  :width           "100px"
-                                                  :backgroundColor "rgba(255,255,255,0.5)"
-                                                  :pointerEvents   "none"}}
-                                    (str (:id ha) "-" (:target (:transition trans)))]
-                                   [:div {:style {:height          "100%" :width "2px"
-                                                  :position        "absolute" :left (if (< sx ex) "0%" "100%")
-                                                  :backgroundColor "green"
-                                                  :pointerEvents   "none"}}]
-                                   [:div {:style {:height          "100%" :width "2px"
-                                                  :position        "absolute" :left (if (< sx ex) "100%" "0%")
-                                                  :backgroundColor "red"
-                                                  :pointerEvents   "none"}}]]))
-                              (transition-intervals (:objects @scene)
-                                                    ha
-                                                    Infinity
-                                                    (required-transitions ha))
-                              (range 0 trans-count))]))
-                    (map #(extrapolate % (:now @scene)) (vals (:objects @scene)))
-                    (range 0 ct))
+               (when show-transition-thresholds
+                 (map (fn [ha i]
+                       (let [trans-count (count (required-transitions ha))
+                             trans-h (/ line-h trans-count)]
+                         [:div
+                          (map (fn [trans j]
+                                 (let [[s e] (:interval trans)
+                                       sx (* scale (:x (extrapolate ha s)))
+                                       ex (* scale (:x (extrapolate ha e)))
+                                       line-top (+ (* i line-h) (* j trans-h))]
+                                   [:div {:style {:height        trans-h :width (.abs js/Math (- sx ex))
+                                                  :top           line-top :left (.min js/Math sx ex)
+                                                  :position      "absolute" :backgroundColor "grey"
+                                                  :pointerEvents "none"}}
+                                    [:div {:style {:position        "absolute"
+                                                   :width           "100px"
+                                                   :backgroundColor "rgba(255,255,255,0.5)"
+                                                   :pointerEvents   "none"}}
+                                     (str (:id ha) "-" (:target (:transition trans)))]
+                                    [:div {:style {:height          "100%" :width "2px"
+                                                   :position        "absolute" :left (if (< sx ex) "0%" "100%")
+                                                   :backgroundColor "green"
+                                                   :pointerEvents   "none"}}]
+                                    [:div {:style {:height          "100%" :width "2px"
+                                                   :position        "absolute" :left (if (< sx ex) "100%" "0%")
+                                                   :backgroundColor "red"
+                                                   :pointerEvents   "none"}}]]))
+                               (transition-intervals (:objects @scene)
+                                                     ha
+                                                     Infinity
+                                                     (required-transitions ha))
+                               (range 0 trans-count))]))
+                     (map #(extrapolate % (:now @scene)) (vals (:objects @scene)))
+                     (range 0 ct)))
                (map (fn [[x y w h]]
                       [:div {:style {:width           (str (* scale w) "px") :height (str (* scale h) "px")
                                      :backgroundColor "white"
@@ -525,9 +537,10 @@
                                       :borderRadius    (str (* scale w) "px")
                                       :backgroundColor "brown"
                                       :position        "absolute"
+                                      :color           "white"
                                       :left            (str (* scale x) "px")
                                       :bottom          (str (* scale y) "px")}}
-                        (str (:id ha))]])
+                        (str (:id ha) " " (:state ha))]])
                     (map #(extrapolate % (:now @scene)) (vals (:objects @scene))))
                [:button {:onClick #(swap! scene (fn [s] (assoc s :playing (not (:playing s)))))}
                 (if (:playing @scene) "PAUSE" "PLAY")]


(maint) make handlers a property of a client

In order to make dispatch-message's calling convention more obvious we move the
handlers down into the client object, and then use it in dispatch-message.

--- src/puppetlabs/cthun/client.clj
+++ src/puppetlabs/cthun/client.clj
@@ -28,7 +28,8 @@
   "schema for a client"
   (merge ConnectParams
          {:conn Object
-          :websocket Object}))
+          :websocket Object
+          :handlers Handlers}))

 ;; private helpers for the ssl/websockets setup

@@ -64,10 +65,10 @@
   [client message]
   (log/debug "no handler for " message))

-(defn- dispatch-message
-  [handlers client message]
+(defn dispatch-message
+  [client message]
   (let [message-type (:message_type message)
-        handers (:handlers client)
+        handlers (:handlers client)
         handler (or (get handlers message-type)
                     (get handlers :default)
                     fallback-handler)]
@@ -98,12 +99,12 @@
                                      (log/debug "websocket closed" code message))
                          :on-receive (fn [text]
                                        (log/debug "text message")
-                                       (dispatch-message handlers @client (message/decode (message/string->bytes text))))
+                                       (dispatch-message @client (message/decode (message/string->bytes text))))
                          :on-binary (fn [buffer offset count]
                                       (log/debug "bytes message" offset count)
                                       (log/debug "got " (message/decode buffer))
-                                      (dispatch-message handlers @client (message/decode buffer))))]
-    (deliver client (assoc params :conn conn :websocket websocket))
+                                      (dispatch-message @client (message/decode buffer))))]
+    (deliver client (assoc params :conn conn :websocket websocket :handlers handlers))
     @client))

 (s/defn ^:always-validate close :- s/Bool


(PE-3516) Add functions to rename debian service files

For debhelper to correctly generate pre and post scripts for service
management, as is generally desireable, it has to also be installing the init
script. This was previously happening via the Makefile. Debian will do this
automatically if the files are placed in the debian directory with the expected
names. This commit adds functions to help accomplish this.

--- src/puppetlabs/ezbake/stage.clj
+++ src/puppetlabs/ezbake/stage.clj
@@ -129,6 +129,19 @@
   [lein-project]
   (fs/rename (fs/file staging-dir "ext" "redhat" "ezbake.spec.erb")
              (fs/file staging-dir "ext" "redhat" (format "%s.spec.erb"
+                                                         (:name lein-project)))))
+(defn rename-debian-init-file
+  "things."
+  [lein-project]
+  (fs/rename (fs/file staging-dir "ext" "debian" "ezbake.init.erb")
+             (fs/file staging-dir "ext" "debian" (format "%s.init.erb"
+                                                         (:name lein-project)))))
+
+(defn rename-debian-default-file
+  "things."
+  [lein-project]
+  (fs/rename (fs/file staging-dir "ext" "debian" "ezbake.default.erb")
+             (fs/file staging-dir "ext" "debian" (format "%s.default.erb"
                                                          (:name lein-project)))))

 (defn get-out-dir-for-shared-config-file
@@ -348,6 +361,8 @@
         (cp-doc-files lein-project)
         (cp-project-file project-file)
         (rename-redhat-spec-file lein-project)
+        (rename-debian-init-file lein-project)
+        (rename-debian-default-file lein-project)
         (generate-ezbake-config-file lein-project build-target config-files)
         (generate-project-data-yaml lein-project)
         (generate-manifest-file lein-project)


change external svn diff command

change external svn diff command

--- src/revdiff/core.clj
+++ src/revdiff/core.clj
@@ -39,7 +39,7 @@
         v (vpaths r1 r2 object object)
         o1 (first v)
         o2 (second v)
-        cmd-components ["svn" "diff" "--diff-cmd" "diff" "-x" "-U 0" shhh o1 o2]]
+        cmd-components ["svn" "diff" "--diff-cmd=diff" shhh o1 o2]]
     (if show (show-cmd cmd-components))
     (apply sh cmd-components)))

@@ -96,13 +96,15 @@
 ;; If no filter term is given, a changed file automatically matches.

 (defn matching-files [r1 r2 object filt show insens]
-  (let [raw (:out (diff r1 r2 object show))
-        blocks (rest (split raw #"^Index: |\nIndex: "))
-        filt (if insens (str "(?i)" filt) filt)]
+  (let [raw (diff r1 r2 object show)
+        out (:out raw)
+        blocks (rest (split out #"^Index: |\nIndex: "))
+        filt (if insens (str "(?i)" filt) filt)
+        re (re-pattern filt)]
     (remove nil?
             (into []
                   (for [block blocks]
-                    (let [matching-line-in? #(re-matches (re-pattern filt) %)
+                    (let [matching-line-in? #(re-matches re %)
                           diff-line? #(re-matches #"^[+-][^+-].*" %)
                           strip+- #(clojure.string/replace % #"^[+-]" "")
                           all-lines (split-lines block)


Minor update in docstring

Minor update in docstring

--- backend/src/akvo/lumen/import/common.clj
+++ backend/src/akvo/lumen/import/common.clj
@@ -3,8 +3,8 @@
 (defprotocol DatasetImporter
   "
   A protocol for importing datasets into Lumen. A typical implementation
-  should also implement java.io.CLoseable because some data sources are
-  backed by resources that needs to be released.
+  should also implement `java.io.Closeable` since some data sources are
+  backed by resources that need to be released.

   Example:
   (reify


Tests for projections

Tests for projections

--- test/photon/current/integration_test.clj
+++ test/photon/current/integration_test.clj
@@ -5,7 +5,8 @@
             [photon.config :as conf]
             [photon.filedb :as filedb]
             [photon.db :as db]
-            [photon.muon :as muon])
+            [photon.muon :as muon]
+            [photon.current.common :refer :all])
   (:use midje.sweet))

 (defn elem-count [ch]
@@ -14,37 +15,11 @@
       n
       (recur (<!! ch) (inc n)))))

-(defn post-one-event
-  ([m url]
-   (cl/with-muon m
-     (cl/post-event (str "muon://" url "/events")
-                    {"service-id","muon://chatter",
-                     "local-id","5198cea7-b260-4bb7-963d-f102132032fe",
-                     "payload",{"id","dbd6eecf-8f5c-42aa-8aa8-1b2172d53c71",
-                                "text","substitutable",
-                                "textanalysis",
-                                {"aggregateSentiment",40,
-                                 "keyphrases",[{"phrase",
-                                                "substitutable",
-                                                "count",1}]}},
-                     "stream-name","chatter",
-                     "server-timestamp",1420660080000})
-     #_(cl/query-event "muon://photon/projection"
-                       {:projection-name "count"})))
-  ([m]
-   (post-one-event m "photon-integration-test")))
-
-(let [temp-file (.getAbsolutePath
-                 (java.io.File/createTempFile "muon" ".json"))
-      d (filedb/->DBFile temp-file)
-      _ (println temp-file)
-      _ (db/delete-all! d)
-      uuid (java.util.UUID/randomUUID)
-      ms (muon/start-server! (str "photon-integration-test-" uuid) d)
+(let [uuid (java.util.UUID/randomUUID)
+      ms (new-server uuid)
       m (cl/muon-client (:amqp.url conf/config) "client-test"
                         "client" "test")
       res (post-one-event m (str "photon-integration-test-" uuid))
-      _ (Thread/sleep 2000)
       ch (cl/with-muon m
            (cl/stream-subscription (str "muon://photon-integration-test-"
                                         uuid "/stream")
@@ -55,7 +30,7 @@
   (fact "One event on stream" (elem-count ch) => 1)
   (dorun (take 10 (repeatedly
                    (fn []
-                     (post-one-event
+                      (post-one-event
                       m (str "photon-integration-test-" uuid))))))
   (let [ch (cl/with-muon m
              (cl/stream-subscription (str "muon://photon-integration-test-"
@@ -88,14 +63,3 @@
     (Thread/sleep 20000)
     (fact "11011 events on stream" (elem-count ch) => 11011)))

-
-
-#_(let [m (cl/muon-client amazon-url "client-test" "client" "test")]
-  (Thread/sleep 5000)
-  (let [res (cl/with-muon m
-              #_(cl/query-event "muon://photon/projection" {:projection-name "test"})
-              (dorun (take 10 (repeatedly (fn [] (cl/post-event "muon://photon/events" "chatter"
-                                                        {"service-id","muon://chatter","local-id","6198cea7-b260-4bb7-963d-f102132032fe","payload",{"id","dbd6eecf-8f5c-42aa-8aa8-1b2172d53c71","text","substitutable","textanalysis",{"aggregateSentiment",40,"keyphrases",[{"phrase","substitutable","count",1}]}},"stream-name","dummy","server-timestamp",1420660080000}))))))]
-    (log/info res)
-    res))
-


redis env variable not picked up on heroku

--- src/setlista/search_history.clj
+++ src/setlista/search_history.clj
@@ -3,7 +3,7 @@
             [clojure.data.json :as json]))

 (defn server-conn []
-  (when-let [redis-cloud (System/getProperty "REDISCLOUD_URL")]
+  (when-let [redis-cloud (get (System/getenv) "REDISCLOUD_URL")]
     {:pool {} :spec {:host redis-cloud :port 6379}}))

 (def last-searches "last-searches")


Update delete image event acording to new image storage layout.

--- src/uxbox/main/data/images.cljs
+++ src/uxbox/main/data/images.cljs
@@ -239,19 +239,21 @@

 ;; --- Delete Images

-(defrecord DeleteImage [coll-id image]
-  rs/UpdateEvent
-  (-apply-update [_ state]
-    (update-in state [:image-colls-by-id coll-id :images] disj image))
-
-  rs/WatchEvent
-  (-apply-watch [_ state s]
-    (->> (rp/req :delete/image (:id image))
+(defrecord DeleteImage [coll-id image-id]
+  rs/UpdateEvent
+  (-apply-update [_ state]
+    (update state [:images-by-id] dissoc image-id))
+
+  rs/WatchEvent
+  (-apply-watch [_ state s]
+    (->> (rp/req :delete/image image-id)
          (rx/ignore))))

 (defn delete-image
-  [coll-id image]
-  (DeleteImage. coll-id image))
+  [coll-id image-id]
+  {:pre [(uuid? coll-id)
+         (uuid? image-id)]}
+  (DeleteImage. coll-id image-id))

 ;; --- Remove Image


Apply new layout only if changed

Apply new layout only if changed

--- frontend/src/faceboard/views/boards/people.cljs
+++ frontend/src/faceboard/views/boards/people.cljs
@@ -349,17 +349,19 @@
 (defn retrieve-cards-layout [cards]
   (apply hash-map (mapcat #(retrieve-card-layout %) cards)))

-(defn recompute-layout [owner]
+(defn recompute-layout [data owner]
   (let [node (om/get-node owner "desk")
         cards (.-childNodes node)
+        old-layout (get-in data [:ui :people :layout])
         layout (retrieve-cards-layout cards)]
-    (perform! :people-layout layout)))
+    (when-not (= (pr-str old-layout) (pr-str layout))
+      (perform! :people-layout layout))))

 (defcomponent people-scaffold-component [data owner _]
   (did-mount [_]
-    (recompute-layout owner))
+    (recompute-layout data owner))
   (did-update [_ _ _]
-    (recompute-layout owner))
+    (recompute-layout data owner))
   (render [_]
     (let [{:keys [ui anims]} data
           people (get-in data [:content :people])


Add back in the missing validation for collection 3 to bulk_index_test

--- system-int-test/test/cmr/system_int_test/bootstrap/bulk_index_test.clj
+++ system-int-test/test/cmr/system_int_test/bootstrap/bulk_index_test.clj
@@ -75,6 +75,7 @@
                     (d/refs-match? expected (search/find-refs concept-type search))
                     {:concept-id (:concept-id coll1)} :collection [umm1]
                     {:concept-id (:concept-id coll2)} :collection []
+                    {:concept-id (:concept-id coll3)} :collection []
                     {:concept-id (:concept-id ummg1)} :granule [])))))

 ;; This test verifies that the bulk indexer can run concurrently with ingest and indexing of items.


Generate `:short-preview` when msg received

--- src/status_im/chat/events/receive_message.cljs
+++ src/status_im/chat/events/receive_message.cljs
@@ -22,10 +22,9 @@
     (assoc cofx :message-exists? messages-store/exists?)))

 (re-frame/reg-cofx
- :get-last-clock-value
- (fn [cofx]
-   (assoc cofx :get-last-clock-value messages-store/get-last-clock-value)))
-
+  :get-last-clock-value
+  (fn [cofx]
+    (assoc cofx :get-last-clock-value messages-store/get-last-clock-value)))

 ;;;; FX

@@ -41,15 +40,21 @@
   (fn [{:keys [db] :as cofx} [{:keys [content] :as message}]]
     (if (:command content)
       ;; we are dealing with received command message, we can't add it right away,
-      ;; we first need to fetch preview and add it only after we already have the preview.
+      ;; we first need to fetch short-preview + preview and add it only after we already have those.
       ;; note that `request-command-message-data` implicitly wait till jail is ready and
-      ;; call is made only after that
+      ;; calls are made only after that
       (commands-events/request-command-message-data
-        db message
-        {:data-type             :preview
-         :proceed-event-creator (fn [preview]
-                                  [::received-message
-                                   (assoc-in message [:content :preview] preview)])})
+       db message
+       {:data-type             :short-preview
+        :proceed-event-creator (fn [short-preview]
+                                 [:request-command-message-data
+                                  message
+                                  {:data-type             :preview
+                                   :proceed-event-creator (fn [preview]
+                                                            [::received-message
+                                                             (update message :content merge
+                                                                     {:short-preview short-preview
+                                                                      :preview       preview})])}])})
       ;; regular non command message, we can add it right away
       (message-model/receive cofx message))))


added arriver

added arriver

--- src/babel/francais/lexicon.cljc
+++ src/babel/francais/lexicon.cljc
@@ -62,6 +62,10 @@
    "apprendre" {:synsem {:cat :verb
                          :past-participle "appris"
                          :sem {:pred :learn}}}
+
+   "arriver" {:synsem {:cat :verb
+                       :essere true
+                       :sem {:pred :arrive}}}

    "assurer" [{:synsem {:cat :verb
                         :sem {:pred :assure}}}


handle case where there are no exceptions generated

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -78,10 +78,14 @@
           [k (eval v)])))

 (defn exception-generator2 [lexicon]
-  (let [exceptions
-        (reduce #(merge-with concat %1 %2)
-                (exception-generator lexicon))]
-    (merge-with concat lexicon exceptions)))
+  (let [exception-maps (exception-generator lexicon)]
+    (if (not (empty? exception-maps))
+      (merge-with concat
+                  lexicon
+                  (reduce (fn [m1 m2]
+                            (merge-with concat m1 m2))
+                          (exception-generator lexicon)))
+      lexicon)))

 ;; TODO: factor out Italian-specific parts and promote to babel.lexiconfn.
 ;; TODO: see if we can use Clojure transducers here. (http://clojure.org/reference/transducers)


use direct access to defrecord fields in real-fs

--- src/brainbot/nozzle/real_fs.clj
+++ src/brainbot/nozzle/real_fs.clj
@@ -103,20 +103,20 @@
 (defrecord RealFilesystem [root]
   vfs/Filesystem
   (extract-content [fs entry]
-    (let [fp (string/join "/" [(:root fs) entry])]
+    (let [fp (string/join "/" [root entry])]
       {:tika-content (convert fp)}))

   (access-denied-exception? [fs err]
     (instance? AccessDeniedException err))

   (get-permissions [fs entry]
-    (let [fp (string/join "/" [(:root fs) entry])]
+    (let [fp (string/join "/" [root entry])]
       (if is-windows
         (windows-acl-from-path fp)
         (posix-acl-from-path fp))))

   (stat [fs entry]
-    (let [fp (string/join "/" [(:root fs) entry])
+    (let [fp (string/join "/" [root entry])
           attr (read-attributes fp)
           ct (fn [t] (/ (.toMillis t) 1000))]
       {:type (type-from-attribute attr)
@@ -127,7 +127,7 @@
     (normalize-path (string/join "/" parts)))

   (listdir [fs dir]
-    (let [fp (string/join "/" [(:root fs) dir])
+    (let [fp (string/join "/" [root dir])
           up (get-path fp)]
       (map #(-> % .getFileName str)
            (nio2.dir-seq/dir-seq up)))))


[#244] Extract code to function

[#244] Extract code to function

* This fixes some `eastwood` warnings in previous builds

--- api/test/clojure/org/akvo/flow_api/end_to_end.clj
+++ api/test/clojure/org/akvo/flow_api/end_to_end.clj
@@ -1,6 +1,7 @@
 (ns org.akvo.flow-api.end-to-end
-  (:require [clojure.test :refer [use-fixtures deftest testing is]]
+  (:require [cheshire.core :as json]
             [clj-http.client]
+            [clojure.test :refer [use-fixtures deftest testing is]]
             [org.akvo.flow-api.fixtures :as fixtures])
   (:import clojure.lang.ExceptionInfo))

@@ -16,64 +17,60 @@
                       :headers {"huge" (apply str (repeat 30000 "x"))}
                       :content-type :json}))))))

+(defn http-result [^ExceptionInfo e]
+  (-> e
+      ex-data
+      (select-keys [:status :body])
+      (update :body #(json/parse-string % true))))
+
+(defn test-error [expected-status expected-message http-url http-opts]
+  (is (thrown-with-msg?
+       ExceptionInfo (re-pattern (str "status " expected-status))
+       (try
+         (clj-http.client/get http-url
+                              (merge {:as :json
+                                      :content-type :json}
+                                     http-opts))
+         (catch ExceptionInfo e
+           (let [{{message :message} :body
+                  :keys [status]} (http-result e)]
+             (is (= expected-status status))
+             (is (= expected-message message)))
+           (throw e))))))
+
 (deftest answer-stats
   (testing "Random email trying to get a statistic"
-    (is (thrown-with-msg? ExceptionInfo #"status 403"
-        (try
-          (clj-http.client/get "http://localhost:3000/orgs/akvoflowsandbox/stats"
-                               {:as :json
-                                :headers {"x-akvo-email" "random.email@gmail.com"}
-                                :query-params {:survey_id "148412306"
-                                               :form_id "145492013"
-                                               :question_id "147432013"}
-                                :content-type :json})
-          (catch ExceptionInfo e
-            (is (= (-> e ex-data :status) 403))
-            (is (.contains ^String (-> e ex-data :body) "User does not exist"))
-            (throw e))))))
+    (test-error 403
+                "User does not exist"
+                "http://localhost:3000/orgs/akvoflowsandbox/stats"
+                {:headers {"x-akvo-email" "random.email@gmail.com"}
+                 :query-params {:survey_id "148412306"
+                                :form_id "145492013"
+                                :question_id "147432013"}}))
   (testing "Survey Not Found"
-    (is (thrown-with-msg? ExceptionInfo #"status 404"
-                          (try
-                            (clj-http.client/get "http://localhost:3000/orgs/akvoflowsandbox/stats"
-                                                 {:as :json
-                                                  :headers {"x-akvo-email" "akvo.flow.user.test@gmail.com"}
-                                                  :query-params {:survey_id "999"
-                                                                 :form_id "145492013"
-                                                                 :question_id "147432013"}
-                                                  :content-type :json})
-                            (catch ExceptionInfo e
-                              (is (= (-> e ex-data :status) 404))
-                              (is (.contains ^String (-> e ex-data :body) "Survey not found"))
-                              (throw e))))))
+    (test-error 404
+                "Survey not found"
+                "http://localhost:3000/orgs/akvoflowsandbox/stats"
+                {:headers {"x-akvo-email" "akvo.flow.user.test@gmail.com"}
+                 :query-params {:survey_id "999"
+                                :form_id "145492013"
+                                :question_id "147432013"}}))
   (testing "Question Not Found"
-    (is (thrown-with-msg? ExceptionInfo #"status 404"
-                          (try
-                            (clj-http.client/get "http://localhost:3000/orgs/akvoflowsandbox/stats"
-                                                 {:as :json
-                                                  :headers {"x-akvo-email" "akvo.flow.user.test@gmail.com"}
-                                                  :query-params {:survey_id "148412306"
-                                                                 :form_id "145492013"
-                                                                 :question_id "999"}
-                                                  :content-type :json})
-                            (catch ExceptionInfo e
-                              (is (= (-> e ex-data :status) 404))
-                              (is (.contains ^String (-> e ex-data :body) "Question not found"))
-                              (throw e))))))
+    (test-error 404
+                "Question not found"
+                "http://localhost:3000/orgs/akvoflowsandbox/stats"
+                {:headers {"x-akvo-email" "akvo.flow.user.test@gmail.com"}
+                 :query-params {:survey_id "148412306"
+                                :form_id "145492013"
+                                :question_id "999"}}))
   (testing "Question is not an Option Question"
-    (is (thrown-with-msg? ExceptionInfo #"status 400"
-                          (try
-                            (clj-http.client/get "http://localhost:3000/orgs/akvoflowsandbox/stats"
-                                                 {:as :json
-                                                  :headers {"x-akvo-email" "akvo.flow.user.test@gmail.com"}
-                                                  :query-params {:survey_id "148412306"
-                                                                 :form_id "145492013"
-                                                                 :question_id "148442013"}
-                                                  :content-type :json})
-                            (catch ExceptionInfo e
-                              (is (= (-> e ex-data :status) 400))
-                              (prn (-> e ex-data :body))
-                              (is (.contains ^String (-> e ex-data :body) "Not an OPTION question"))
-                              (throw e))))))
+    (test-error 400
+                "Not an OPTION question"
+                "http://localhost:3000/orgs/akvoflowsandbox/stats"
+                {:headers {"x-akvo-email" "akvo.flow.user.test@gmail.com"}
+                 :query-params {:survey_id "148412306"
+                                :form_id "145492013"
+                                :question_id "148442013"}}))
   (testing "Answer summary of an option type of question"
     (let [response (clj-http.client/get "http://mainnetwork:3000/orgs/akvoflowsandbox/stats"
                      {:as :json


:bug: Fix uuid of builtin icons

:bug: Fix uuid of builtin icons

--- frontend/src/uxbox/builtins/library/icons.cljs
+++ frontend/src/uxbox/builtins/library/icons.cljs
@@ -7,7 +7,7 @@

 (ns uxbox.builtins.library.icons
   (:require [uxbox.builtins.library.icons.material.actions :as md-actions]
-            [uxbox.builtins.library.icons.material.alerts :as md-alerts]:id #uuid (uuid/random)
+            [uxbox.builtins.library.icons.material.alerts :as md-alerts]
             [uxbox.builtins.library.icons.material.av :as md-av]
             [uxbox.builtins.library.icons.material.communication :as md-comm]
             [uxbox.builtins.library.icons.material.content :as md-content]
@@ -26,77 +26,77 @@

 (def collections-list
   [{:name "Material design (actions)"
-    :id #uuid (uuid/random)
+    :id (uuid/random)
     :type :builtin
     :created-at 1
     :icons md-actions/+icons+}
    {:name "Material design (alerts)"
-    :id #uuid (uuid/random)
+    :id (uuid/random)
     :type :builtin
     :created-at 2
     :icons md-alerts/+icons+}
    {:name "Material design (Av)"
-    :id #uuid (uuid/random)
+    :id (uuid/random)
     :type :builtin
     :created-at 3
     :icons md-av/+icons+}
    {:name "Material design (Communication)"
-    :id #uuid (uuid/random)
+    :id (uuid/random)
     :type :builtin
     :created-at 4
     :icons md-comm/+icons+}
    {:name "Material design (Content)"
-    :id #uuid (uuid/random)
+    :id (uuid/random)
     :type :builtin
     :created-at 5
     :icons md-content/+icons+}
    {:name "Material design (Device)"
-    :id #uuid (uuid/random)
+    :id (uuid/random)
     :type :builtin
     :created-at 6
     :icons md-device/+icons+}
    {:name "Material design (Editor)"
-    :id #uuid (uuid/random)
+    :id (uuid/random)
     :type :builtin
     :created-at 7
     :icons md-editor/+icons+}
    {:name "Material design (File)"
-    :id #uuid (uuid/random)
+    :id (uuid/random)
     :type :builtin
     :created-at 8
     :icons md-file/+icons+}
    {:name "Material design (Hardware)"
-    :id #uuid (uuid/random)
+    :id (uuid/random)
     :type :builtin
     :created-at 9
     :icons md-hardware/+icons+}
    {:name "Material design (Image)"
-    :id #uuid (uuid/random)
+    :id (uuid/random)
     :type :builtin
     :created-at 10
     :icons md-image/+icons+}
    {:name "Material design (Maps)"
-    :id #uuid (uuid/random)
+    :id (uuid/random)
     :type :builtin
     :created-at 11
     :icons md-maps/+icons+}
    {:name "Material design (Navigation)"
-    :id #uuid (uuid/random)
+    :id (uuid/random)
     :type :builtin
     :created-at 12
     :icons md-nav/+icons+}
    {:name "Material design (Notifications)"
-    :id #uuid (uuid/random)
+    :id (uuid/random)
     :type :builtin
     :created-at 13
     :icons md-not/+icons+}
    {:name "Material design (Social)"
-    :id #uuid (uuid/random)
+    :id (uuid/random)
     :type :builtin
     :created-at 14
     :icons md-social/+icons+}
    {:name "Material design (Toggle)"
-    :id #uuid (uuid/random)
+    :id (uuid/random)
     :type :builtin
     :created-at 15
     :icons md-toggle/+icons+}])


Always sort the chapter list by urls

Always sort the chapter list by urls

--- src/clj/comic_reader/server.clj
+++ src/clj/comic_reader/server.clj
@@ -32,8 +32,9 @@
 (defn get-comic-imgs [{{:keys [site comic chapter page]} :params
                        :as request}]
   (println (:uri request))
-  (let [chapter-list (scrape/fetch-list
-                      (sites/chapter-list-data site comic))]
+  (let [chapter-list (sort-by :url
+                      (scrape/fetch-list
+                       (sites/chapter-list-data site comic)))]
    (if-let [comic-urls nil]
      (edn-response)
      (edn-response (gen-error-data request) 404))))


Refactoring source.

Refactoring source.

--- src/clj/freefrog/governance.clj
+++ src/clj/freefrog/governance.clj
@@ -82,74 +82,70 @@
   [circle role-name new-purpose]
   (validate-role-updates circle role-name)
   (if (empty? new-purpose)
-    (update-in circle [:roles role-name]
-               dissoc :purpose)
-    (update-in circle [:roles role-name]
-               assoc :purpose new-purpose)))
+    (update-in circle [:roles role-name] dissoc :purpose)
+    (update-in circle [:roles role-name] assoc :purpose new-purpose)))

-(defn- get-domains [circle role-name]
-  (get-in circle [:roles role-name :domains]))
+(defn- get-things [circle role-name type]
+  (get-in circle [:roles role-name type]))

-(defn- validate-domain [circle role-name domain check-fn err-msg-fmt]
-  "Validate everything about domain manipulation. Checks that the role name
-   is non-empty and present. Also calls the custom validation function.
+(def ^:private err-types {:domains "Domain"
+                          :accountabilities "Accountability"})
+
+(defn- validate-things
+  "Abstract function to validate collections of things in a circle. Checks that
+   the role name is non-empty and present. Also calls the custom validation
+   function.

    If the check-fn returns true, throws an error with the given
-   err-msg-fmt. err-msg-fmt be in the form of ^.*?%s.*?%s.*$ where the
-   first %s is to be replaced with the domain and the second with the
-   role-name."
+   err-msg-fmt. err-msg-fmt be in the form of ^.*%s.*%s.*%s.*$ where the
+   first %s is to be replaced with a singular English representation of
+   the given type (see err-types), the second %s is to be replaced with the
+   thing itself and the third with the role-name.
+
+   For example: %s '%s' already exists on role '%s'"
+  [circle role-name type thing check-fn err-msg-fmt]
   (validate-role-updates circle role-name)
-  (validate-not (check-fn (get-domains circle role-name) domain)
-                 (format err-msg-fmt domain role-name)))
+  (validate-not (check-fn (get-things circle role-name type) thing)
+                (format err-msg-fmt (err-types type) thing role-name)))
+
+(defn- add-to
+  "Abstract function that adds anything to a set of things in a role in a
+   circle. Performs all validation and so forth. Creates the set if it doesn't
+   exist."
+  [circle role-name type thing]
+  (validate-things circle role-name type thing contains?
+                   "%s '%s' already exists on role '%s'")
+  (let [things (get-things circle role-name type)
+        circle (if things circle
+                 (update-in circle [:roles role-name] assoc type #{}))]
+    (update-in circle [:roles role-name type] conj thing)))
+
+(defn- remove-from
+  "Abstract function that removes a thing from a set of things in a role in a
+   circle. Performs all validation and so forth. Removes the set if it's empty."
+  [circle role-name type thing]
+  (validate-things circle role-name type thing (comp not contains?)
+                   "%s '%s' doesn't exist on role '%s'")
+  (let [result (update-in circle [:roles role-name type] disj thing)]
+    (if (empty? (get-things result role-name type))
+      (update-in result [:roles role-name] dissoc type) result)))

 (defn add-domain
   "Add a domain to a role in the given circle."
   [circle role-name domain]
-  (validate-domain circle role-name domain contains?
-                   "Domain '%s' already exists on role '%s'")
-  (let [domains (get-domains circle role-name)
-        circle (if domains
-                 circle
-                 (update-in circle [:roles role-name] assoc :domains #{}))]
-    (update-in circle [:roles role-name :domains] conj domain)))
+  (add-to circle role-name :domains domain))

 (defn remove-domain
   "Remove a domain from a role in the given circle."
   [circle role-name domain]
-  (validate-domain circle role-name domain (comp not contains?)
-                   "Domain '%s' doesn't exist on role '%s'")
-  (let [result (update-in circle [:roles role-name :domains] disj domain)]
-    (if (empty? (get-domains result role-name))
-      (update-in result [:roles role-name] dissoc :domains) result)))
-
-(defn- get-accountabilities [circle role-name]
-  (get-in circle [:roles role-name :accountabilities]))
+  (remove-from circle role-name :domains domain))

 (defn add-accountability
   "Add an accountability to a role in the given circle."
   [circle role-name accountability]
-  (validate-role-updates circle role-name)
-  (validate-not (contains? (get-accountabilities circle role-name)
-                           accountability)
-                (format "Accountability '%s' already exists on role '%s'"
-                        accountability role-name))
-  (let [accountabilities (get-accountabilities circle role-name)
-        circle (if accountabilities
-                 circle
-                 (update-in circle [:roles role-name] assoc
-                            :accountabilities #{}))]
-    (update-in circle [:roles role-name :accountabilities]
-               conj accountability)))
+  (add-to circle role-name :accountabilities accountability))

 (defn remove-accountability
   "Remove an accountability from a role in the given circle."
   [circle role-name accountability]
-  (validate-role-updates circle role-name)
-  (validate-not ((comp not contains?) (get-accountabilities circle role-name)
-                           accountability)
-                (format "Accountability '%s' doesn't exist on role '%s'"
-                        accountability role-name))
-  (let [result (update-in circle [:roles role-name :accountabilities]
-                          disj accountability)]
-    (if (empty? (get-accountabilities result role-name))
-      (update-in result [:roles role-name] dissoc :accountabilities) result)))+  (remove-from circle role-name :accountabilities accountability))


allow Parasite to keep gaining counters and make Architect strength negative

--- src/clj/game/cards-programs.clj
+++ src/clj/game/cards-programs.clj
@@ -433,7 +433,9 @@
              {:req (req (= (:cid target) (:cid (:host card))))
               :effect (effect (ice-strength-bonus (- (get-virus-counters state side card)) target))}
              :ice-strength-changed
-             {:req (req (and (= (:cid target) (:cid (:host card))) (<= (:current-strength target) 0)))
+             {:req (req (and (= (:cid target) (:cid (:host card)))
+                             (not (card-flag? (:host card) :untrashable-while-rezzed true))
+                             (<= (:current-strength target) 0)))
               :effect (req (unregister-events state side card)
                            (when (get-in card [:special :installing])
                              (update! state side (update-in card [:special] dissoc :installing))


New function file-list

New function file-list

--- src/clj_fileutils/fileutils.clj
+++ src/clj_fileutils/fileutils.clj
@@ -96,3 +96,13 @@
              (map #(.getName %))
              (filter #(.endsWith % extension)))))

+(defn file-list
+    "Return list of files that resides in specified directory."
+    (   [directory]
+        (->> (.listFiles (new java.io.File directory))
+             (filter #(.isFile %))))
+    (   [directory extension]
+        (->> (.listFiles (new java.io.File directory))
+             (filter #(.isFile %))
+             (filter #(.endsWith (.getName %) extension)))))
+


Fix description mode

Fix description mode

--- src/cljc/robinson/describe.cljc
+++ src/cljc/robinson/describe.cljc
@@ -90,7 +90,7 @@
         npc  (npc-at-xy state x y)
         items (get cell :items)]
     (cond
-      (not= (get cell :discovered) (dec (rw/get-time state)))
+      (not= (get cell :discovered) (rw/get-time state))
         (format "You can't see that.")
       (and npc (seq items))
         (format "There is %s, and %s." (describe-npc npc) (describe-items items))


Ideas

Ideas

--- src/cljs/clojure_rest/core.cljs
+++ src/cljs/clojure_rest/core.cljs
@@ -9,6 +9,7 @@
   ))

 ; https://github.com/reagent-project/reagent/blob/master/src/reagent/core.cljs
+; https://github.com/reagent-project/reagent-cookbook/blob/master/old-recipes/nvd3/README.md
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn status->str
@@ -107,6 +108,10 @@
    }])

 (defn render-card
+  ; TODO - Try to avoid the update-card! use and use messages / cursors
+  ; * Add an inner ratom? Then use a watch on it to update?
+  ; * Provide a callback to provide message below?
+  ; * Or fix the filter on top of the board to provide cursors down?
   [card]
   (let [show-details (::show-details card)
         toggle-details #(update-card! (update-in card [::show-details] not))
@@ -147,6 +152,8 @@

 (defn render-app
   []
+  ; TODO - Try to go deeper with a cursor
+  ; Try to filter, providing a list of cursors instead
   (let [filter (r/cursor app-state [:filter])
         cards (reaction (filter-by-title @filter (:cards @app-state)))]
     [:div


Remove punctuation normalization function


Indentation fix on either ns.

Indentation fix on either ns.

--- src/cljx/cats/monad/either.cljx
+++ src/cljx/cats/monad/either.cljx
@@ -168,31 +168,32 @@
 ;; Monad definition
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(def either-monad
- (reify
-   proto/Functor
-   (fmap [_ f s]
-     (if (right? s)
-       (right (f (.-v s)))
-       s))
-
-   proto/Applicative
-   (pure [_ v]
-     (right v))
-
-   (fapply [m af av]
-     (if (right? af)
-       (proto/fmap m (.-v af) av)
-       af))
-
-   proto/Monad
-   (mreturn [_ v]
-     (right v))
-
-   (mbind [_ s f]
-     (if (right? s)
-       (f (.-v s))
-       s))))
+(def ^{:no-doc true}
+  either-monad
+  (reify
+    proto/Functor
+    (fmap [_ f s]
+      (if (right? s)
+        (right (f (.-v s)))
+        s))
+
+    proto/Applicative
+    (pure [_ v]
+      (right v))
+
+    (fapply [m af av]
+      (if (right? af)
+        (proto/fmap m (.-v af) av)
+        af))
+
+    proto/Monad
+    (mreturn [_ v]
+      (right v))
+
+    (mbind [_ s f]
+      (if (right? s)
+        (f (.-v s))
+        s))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Monad transformer definition


Improved docstring of either transformer.

--- src/cljx/cats/monad/either.cljx
+++ src/cljx/cats/monad/either.cljx
@@ -199,7 +199,9 @@
 ;; Monad transformer definition
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defn either-transformer [inner-monad]
+(defn either-transformer
+  "The Either transformer constructor."
+  [inner-monad]
   (reify
     proto/Monad
     (mreturn [_ v]


At least category charts weren't that painful

--- src/com/hypirion/clj_xchart.clj
+++ src/com/hypirion/clj_xchart.clj
@@ -1,6 +1,8 @@
 (ns com.hypirion.clj-xchart
   (:import (org.knowm.xchart XYChart
                              PieChart
+                             CategoryChart
+                             CategorySeries$CategorySeriesRenderStyle
                              PieSeries$PieSeriesRenderStyle
                              XYSeries$XYSeriesRenderStyle
                              XChartPanel)
@@ -24,12 +26,6 @@
            (java.awt Color
                      GridLayout)))

-(defn add-series
-  ([^XYChart chart s-name x-data y-data]
-   (.addSeries chart s-name x-data y-data))
-  ([^XYChart chart s-name x-data y-data error-bars]
-   (.addSeries chart s-name x-data y-data error-bars)))
-
 (def colors
   {:blue Color/BLUE
    :black Color/BLACK
@@ -66,6 +62,14 @@
   {:label PieStyler$AnnotationType/Label
    :label-and-percentage PieStyler$AnnotationType/LabelAndPercentage
    :percentage PieStyler$AnnotationType/Percentage})
+
+(def category-render-styles
+  {:area CategorySeries$CategorySeriesRenderStyle/Area
+   :bar CategorySeries$CategorySeriesRenderStyle/Bar
+   :line CategorySeries$CategorySeriesRenderStyle/Line
+   :scatter CategorySeries$CategorySeriesRenderStyle/Scatter
+   :stick CategorySeries$CategorySeriesRenderStyle/Stick})
+

 (def text-alignments
   {:centre Styler$TextAlignment/Centre
@@ -293,6 +297,32 @@
      x-axis (set-x-axis-style! x-axis)
      y-axis (set-y-axis-style! y-axis))))

+(defn- add-raw-series
+  ([chart s-name x-data y-data]
+   (.addSeries chart s-name x-data y-data))
+  ([chart s-name x-data y-data error-bars]
+   (.addSeries chart s-name x-data y-data error-bars)))
+
+(defn add-series
+  [chart s-name data]
+  (if (sequential? data)
+    (apply add-raw-series chart s-name data)
+    (let [{:keys [x y error-bars style]} data
+          {:keys [marker-color marker-type
+                  line-color line-style line-width
+                  fill-color show-in-legend]} style]
+      (doto-cond
+       (if error-bars
+         (add-raw-series chart s-name x y error-bars)
+         (add-raw-series chart s-name x y))
+       marker-color (.setMarkerColor (colors marker-color marker-color))
+       marker-type (.setMarker (markers marker-type marker-type))
+       line-color (.setLineColor (colors line-color line-color))
+       line-style (.setLineStyle line-style)
+       line-width (.setLineWidth (float line-width))
+       fill-color (.setFillColor (colors fill-color fill-color))
+       (not (nil? show-in-legend)) (.setShowInLegend (boolean show-in-legend))))))
+
 ;; TODO: Add in font as a shortcut to set all fonts not yet set.

 (defn xy-chart
@@ -306,28 +336,41 @@
    {:pre [series]}
    (let [chart (XYChart. width height)]
      (doseq [[s-name data] series]
-       (if (sequential? data)
-         (apply add-series chart s-name data)
-         (let [{:keys [x y error-bars style]} data
-               {:keys [marker-color marker-type
-                       line-color line-style line-width
-                       fill-color show-in-legend render-style]} style]
-           (doto-cond
-            (if error-bars
-              (add-series chart s-name x y error-bars)
-              (add-series chart s-name x y))
-            marker-color (.setMarkerColor (colors marker-color marker-color))
-            marker-type (.setMarker (markers marker-type marker-type))
-            line-color (.setLineColor (colors line-color line-color))
-            line-style (.setLineStyle line-style)
-            line-width (.setLineWidth (float line-width))
-            fill-color (.setFillColor (colors fill-color fill-color))
-            (not (nil? show-in-legend)) (.setShowInLegend (boolean show-in-legend))
-            render-style (.setXYSeriesRenderStyle (xy-render-styles render-style))))))
+       (let [render-style (-> data :style :render-style)]
+         (doto-cond (add-series chart s-name data)
+          render-style (.setXYSeriesRenderStyle (xy-render-styles render-style)))))
      (doto-cond
       (.getStyler chart)
       theme (.setTheme (themes theme theme))
       render-style (.setDefaultSeriesRenderStyle (xy-render-styles render-style)))
+     (doto (.getStyler chart)
+       (set-default-style! styling)
+       (set-axes-style! styling))
+     (doto-cond
+      chart
+      title (.setTitle title)))))
+
+(defn category-chart
+  "Returns a category chart"
+  ([series]
+   (category-chart series {}))
+  ([series
+    {:keys [width height title theme render-style available-space-fill overlap?]
+     :or {width 640 height 500}
+     :as styling}]
+   {:pre [series]}
+   (let [chart (CategoryChart. width height)]
+     (doseq [[s-name data] series]
+       (let [render-style (-> data :style :render-style)]
+         (doto-cond (add-series chart s-name data)
+          render-style (.setChartCategorySeriesRenderStyle
+                        (category-render-styles render-style)))))
+     (doto-cond
+      (.getStyler chart)
+      theme (.setTheme (themes theme theme))
+      render-style (.setDefaultSeriesRenderStyle (category-render-styles render-style))
+      available-space-fill (.setAvailableSpaceFill (double available-space-fill))
+      (not (nil? overlap?))  (.setOverlapped (boolean overlap?)))
      (doto (.getStyler chart)
        (set-default-style! styling)
        (set-axes-style! styling))


Adding experimental code for computing the DGL base

which is the combined Duquenne-Guiges base for given minimal support and
the Luxenburger base for given minimal support and minimal confidence.

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

--- src/conexp/fca/implications.clj
+++ src/conexp/fca/implications.clj
@@ -358,4 +358,35 @@

 ;;;

+(defn- extended-iceberg-intent-seq
+  "Computes for the given closure operator for given minimal support minsupp the corresponding
+  extended iceberg intent seq, which is the iceberg lattice of all intents and pseudo-intents."
+  ;; UNTESTED!
+  [context minsupp]
+  (let [mincount (ceil (* minsupp (count (objects context))))]
+    (all-closed-sets-in-family (fn [intent]
+                                 (>= (count (attribute-derivation context intent))
+                                     mincount))
+                               (attributes context)
+                               (pseudo-clop-by-implications (stem-base context)))))
+
+(defn- dgl-basis
+  "Computes the combined Duquenne-Guiges basis for minimal support minsupp and the Luxenburger basis
+  for minimal support minsupp and minimal confidence minconf."
+  ;; UNTESTED!
+  [context minsupp minconf]
+  (let [closures (set (extended-iceberg-intent-seq context minsupp))]
+    (set-of impl
+            [B_1 closures,
+             B_2 closures,
+             :when (and (proper-subset? B_1 B_2)
+                        (not (exists [C closures]
+                               (and (proper-subset? B_1 C)
+                                    (proper-subset? C B_2)))))
+             :let [impl (make-implication B_1
+                                          (context-attribute-closure context B_2))]
+             :when (>= (confidence impl) minconf)])))
+
+;;;
+
 nil