--- frontend/src/cruncher/utils/lib.cljs
+++ frontend/src/cruncher/utils/lib.cljs
@@ -25,6 +25,9 @@
             :info    {:message nil}
             :app     {:loading? false
                       :progress {}}}))
+<<<<<<< 2eacc09b925a97a5b015af1af1c5c0f3934e5388
+>>>>>>> Add reconciler function to store progress status
+=======
 >>>>>>> Add reconciler function to store progress status

 (declare get-pokemon-by-id)
@@ -87,6 +90,7 @@

 (defmethod mutate 'status/progress
   [{:keys [state]} _ {:keys [status]}]
+<<<<<<< 2eacc09b925a97a5b015af1af1c5c0f3934e5388
 <<<<<<< 010157a5406735dcd98fd6520b39944f79e7b6c1
   {:action (fn [] (swap! state update-in [:progress]
                          (fn [] {:status    (:status status)
@@ -98,10 +102,15 @@
   {:action (fn [] (swap! state update-in [:progress-running?] (fn [] status)))})

 =======
+=======
+>>>>>>> Add reconciler function to store progress status
   {:action (fn [] (swap! state update-in [:app :progress]
                          (fn [] {:to-delete (:to_delete status)
                                  :deleted   (:deleted status)})))})

+<<<<<<< 2eacc09b925a97a5b015af1af1c5c0f3934e5388
+>>>>>>> Add reconciler function to store progress status
+=======
 >>>>>>> Add reconciler function to store progress status
 (defonce reconciler
          (om/reconciler
@@ -220,6 +229,7 @@
   []
   (get-in @app-state [:progress-running?]))

+
 ;;;; State transitions
 (defn update-pokemon!
   "Update pokemon based on API response."


Improve documentation for `degrees` and `radians`.

Fixes https://github.com/quil/quil-site/issues/32


uuid->member-id

uuid->member-id


Fix error replies activity center while not implemented

Signed-off-by: Shivek Khurana <ae036b02ef2f3d9f073f7930137ecb248a31c067@status.im>


Docs for `sequential?`, `cond->`, and `cond->>`


(maint) Remove leftover lein dependency

(maint) Remove leftover lein dependency

As part of removing the developer dashboard, we removed the need to
depend on lein as a dev dependency. It was removed from project.clj at
that time, but not from dev_tools.clj, meaning that the repl can no
longer be started on the 5.3.x series. In the 6.x series, this dep was
removed as part of the move to figwheel-sidecar. This commit removes it
from dev_tools.clj in the older branch.

--- dev/dev_tools.clj
+++ dev/dev_tools.clj
@@ -28,8 +28,7 @@
             [puppetlabs.metrics :as metrics]
             [puppetlabs.metrics.http :as http-metrics]
             [puppetlabs.trapperkeeper.services :as tk-services]
-            [puppetlabs.services.puppet-profiler.puppet-profiler-core :as puppet-profiler-core]
-            [leiningen.core.main :as lein])
+            [puppetlabs.services.puppet-profiler.puppet-profiler-core :as puppet-profiler-core])
   (:import (java.io File)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


:bug: Fix icons collection init

:bug: Fix icons collection init

--- frontend/src/uxbox/library/icons.cljs
+++ frontend/src/uxbox/library/icons.cljs
@@ -23,79 +23,82 @@
             [uxbox.library.icons.material.toggle :as md-toggle]
             ))

-(def +collections+
+(def collections-list
   [{:name "Material design (actions)"
     :id #uuid "00000000-0000-0000-0000-100000000001"
     :created-at 1
-    :type :builtin
+    :builtin true
     :icons md-actions/+icons+}
    {:name "Material design (alerts)"
     :id #uuid "00000000-0000-0000-0000-100000000002"
     :created-at 2
-    :type :builtin
+    :builtin true
     :icons md-alerts/+icons+}
    {:name "Material design (Av)"
     :id #uuid "00000000-0000-0000-0000-100000000003"
     :created-at 3
-    :type :builtin
+    :builtin true
     :icons md-av/+icons+}
    {:name "Material design (Communication)"
     :id #uuid "00000000-0000-0000-0000-100000000004"
     :created-at 4
-    :type :builtin
+    :builtin true
     :icons md-comm/+icons+}
    {:name "Material design (Content)"
     :id #uuid "00000000-0000-0000-0000-100000000005"
     :created-at 5
-    :type :builtin
+    :builtin true
     :icons md-content/+icons+}
    {:name "Material design (Device)"
     :id #uuid "00000000-0000-0000-0000-100000000006"
     :created-at 6
-    :type :builtin
+    :builtin true
     :icons md-device/+icons+}
    {:name "Material design (Editor)"
     :id #uuid "00000000-0000-0000-0000-100000000007"
     :created-at 7
-    :type :builtin
+    :builtin true
     :icons md-editor/+icons+}
    {:name "Material design (File)"
     :id #uuid "00000000-0000-0000-0000-100000000008"
     :created-at 8
-    :type :builtin
+    :builtin true
     :icons md-file/+icons+}
    {:name "Material design (Hardware)"
     :id #uuid "00000000-0000-0000-0000-100000000009"
     :created-at 9
-    :type :builtin
+    :builtin true
     :icons md-hardware/+icons+}
    {:name "Material design (Image)"
     :id #uuid "00000000-0000-0000-0000-1000000000010"
     :created-at 10
-    :type :builtin
+    :builtin true
     :icons md-image/+icons+}
    {:name "Material design (Maps)"
     :id #uuid "00000000-0000-0000-0000-100000000011"
     :created-at 11
-    :type :builtin
+    :builtin true
     :icons md-maps/+icons+}
    {:name "Material design (Navigation)"
     :id #uuid "00000000-0000-0000-0000-100000000012"
     :created-at 12
-    :type :builtin
+    :builtin true
     :icons md-nav/+icons+}
    {:name "Material design (Notifications)"
     :id #uuid "00000000-0000-0000-0000-100000000013"
     :created-at 13
-    :type :builtin
+    :builtin true
     :icons md-not/+icons+}
    {:name "Material design (Social)"
     :id #uuid "00000000-0000-0000-0000-100000000014"
     :created-at 14
-    :type :builtin
+    :builtin true
     :icons md-social/+icons+}
    {:name "Material design (Toggle)"
     :id #uuid "00000000-0000-0000-0000-100000000015"
     :created-at 15
-    :type :builtin
+    :builtin true
     :icons md-toggle/+icons+}])
+
+(def collections
+  (index-by collections-list :id))


javaparser: replace .toString with str

javaparser: replace .toString with str

--- src/app/javaparser.clj
+++ src/app/javaparser.clj
@@ -131,7 +131,7 @@
       [p (.getPackage this)]
       (if (nil? p)
         ""
-        (.toString (.getName p))))))
+        (str (.getName p))))))

 (extend-protocol withPackageName
   Node
@@ -177,7 +177,7 @@
       (str (getQName pn) "." (getName this)))))

 (defn toStringWithoutComments [node]
-  (.toString node))
+  (str node))

 (defn constructorDeclarationAsString [constructor]
   (let [sb (StringBuffer. )]
@@ -191,7 +191,7 @@
         (.append sb ", ")
         (.append sb (toStringWithoutComments (.getType param)))))
     (.append sb ")")
-    (.toString sb)))
+    (str sb)))

 (extend-protocol Named
   ConstructorDeclaration


Update jws.clj

Update jws.clj

--- src/buddy/sign/jws.clj
+++ src/buddy/sign/jws.clj
@@ -99,7 +99,7 @@
   (let [header (-> (codecs/safebase64->str headerdata)
                    (json/parse-string true))]
     (when (not= alg (keyword (str/lower-case (:alg header))))
-      (throw (ex-info "The `alg` param mismatch with header value."
+      (throw (ex-info "The `alg` param is mismatched with the header value."
                       {:type :validation :cause :header})))
     (merge {:alg alg} (dissoc header :alg))))


Caissa hosting

Caissa hosting

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -207,6 +207,16 @@
     :prompt "Choose an agenda to trigger"
     :choices (req (filter #(not= (:title %) "Bifrost Array") (:scored corp)))
     :effect (effect (card-init target))}
+
+   "Bishop"
+   {:abilities [{:label "Host Bishop on a piece ICE" :cost [:click 1]
+                 :choices {:req #(and (= (:type %) "ICE")
+                                      (= (last (:zone %)) :ices)
+                                      (not (some (fn [c] (has? c :subtype "Caïssa")) (:hosted %))))}
+                 :msg (msg "host it on " (:title target)) :effect (effect (host target card))}]
+    :events {:pre-ice-strength
+             {:req (req (and (= (:cid target) (:cid (:host card))) (:rezzed target)))
+              :effect (effect (ice-strength-bonus -2))}}}

    "Brain Cage"
    {:effect (effect (damage :brain 1 {:card card}) (gain :max-hand-size 3))
@@ -1558,6 +1568,13 @@
    "Paricia"
    {:recurring 2}

+   "Pawn"
+   {:abilities [{:label "Host Pawn on a piece ICE" :cost [:click 1]
+                 :choices {:req #(and (= (:type %) "ICE")
+                                      (= (last (:zone %)) :ices)
+                                      (not (some (fn [c] (has? c :subtype "Caïssa")) (:hosted %))))}
+                 :msg (msg "host it on " (:title target)) :effect (effect (host target card))}]}
+
    "Paywall Implementation"
    {:events {:successful-run {:msg "gain 1 [Credits]" :effect (effect (gain :corp :credit 1))}}}

@@ -1859,6 +1876,15 @@
    {:advanceable :always
     :abilities [{:cost [:click 1] :req (req (>= (:advance-counter card) 4))
                  :msg "do 3 net damage" :effect (effect (damage :net 3 {:card card}) (trash card))}]}
+
+   "Rook"
+   {:abilities [{:label "Host Rook on a piece ICE" :cost [:click 1]
+                 :choices {:req #(and (= (:type %) "ICE")
+                                      (= (last (:zone %)) :ices)
+                                      (not (some (fn [c] (has? c :subtype "Caïssa")) (:hosted %))))}
+                 :msg (msg "host it on " (:title target)) :effect (effect (host target card))}]
+    :events {:pre-rez {:req (req (= (:zone (:host card)) (:zone target)))
+                       :effect (effect (rez-cost-bonus 2))}}}

    "Running Interference"
    {:prompt "Choose a server" :choices (req servers)
@@ -2637,7 +2663,11 @@
                  :effect (effect (pump card 1 true))}]}

    "Knight"
-   {:abilities [{:cost [:click 1] :msg "host it on an ICE"}
+   {:abilities [{:label "Host Knight on a piece ICE" :cost [:click 1]
+                 :choices {:req #(and (= (:type %) "ICE")
+                                      (= (last (:zone %)) :ices)
+                                      (not (some (fn [c] (has? c :subtype "Caïssa")) (:hosted %))))}
+                 :msg (msg "host it on " (:title target)) :effect (effect (host target card))}
                 {:cost [:credit 2] :msg "break 1 subroutine on the hosted ICE"}]}

    "Leviathan"


Revert change to Blue Sun ability; issue was fixed in core.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -156,7 +156,7 @@
    "Blue Sun: Powering the Future"
    {:abilities [{:msg (msg "add " (:title target) " to HQ and gain " (:cost target) " [Credits]")
                  :choices {:req #(:rezzed %)}
-                 :effect (effect (gain :credit (:cost target)) (move (assoc target :rezzed false) :hand))}]}
+                 :effect (effect (gain :credit (:cost target)) (move target :hand))}]}

    "Big Brother"
    {:req (req tagged) :effect (effect (gain :runner :tag 2))}


add pprint-and-return-l for left-threading

--- src/clj_money/util.clj
+++ src/clj_money/util.clj
@@ -51,3 +51,7 @@
   (println message)
   (pprint value)
   value)
+
+(defn pprint-and-return-l
+  [value message]
+  (pprint-and-return message value))


Fix statements order

Fix statements order

--- src/cljakstab/core.clj
+++ src/cljakstab/core.clj
@@ -97,9 +97,10 @@
   (if
    (empty? prevs)
    (conj prevs cur)
-   (let [[head & tail] prevs
+   (let [head (first prevs)
+         tail (rest prevs)
          [prev-lbl prev-succ] head]
-     (into [cur [prev-lbl (remove #(= (cur 0) %1) prev-succ)]] tail))))
+     (into tail [[prev-lbl (remove #(= (cur 0) %1) prev-succ)] cur]))))

 (defn show-jumps
   [jumps]
@@ -119,7 +120,7 @@
   (->>
    stmt-map
    (into (sorted-map))
-   (reduce remove-right-after [])
+   (reduce remove-right-after (list))
    reverse
    (transduce
     (map
@@ -135,13 +136,14 @@
     (completing
      (fn
        [stmts {lbl :label :as obj}]
-       (if (zero? (.getIndex lbl))
+       (if (or (zero? (.getIndex lbl)) (empty? stmts))
          (let [address (.getAddress lbl)
                instruction (.getInstruction program address)
                instruction-str (.getInstructionString program address instruction)]
            (conj stmts [instruction-str [obj]]))
-         (conj (rest stmts) (conj (first stmts) obj)))))
-    [])))
+         (conj (rest stmts) (update (first stmts) 1 #(conj %1 obj))))))
+    (list))
+    reverse))

 (defn export-abstract-state
   [state]


Refactor conditional-thread

Refactor conditional-thread

Using the or macro is so much cleaner than the anonymous function that I
wrote.

--- src/clojush/random.clj
+++ src/clojush/random.clj
@@ -43,11 +43,8 @@
    returns nil, the old value will be the value passed to the next
    function."
   [val & fs]
-  (reduce (fn [value f]
-              (if-let [new-value (f value)]
-                new-value
-                value))
-          val fs))
+  (reduce #(or (%2 %1) %1) val fs))
+
 ;; Example usage of conditional-thread (the function)
 ;; (conditional-thread 0 inc inc inc)
 ;; => 3


Replaced apply-doc with c.c.def/name-with-attributes

--- src/compojure/core.clj
+++ src/compojure/core.clj
@@ -1,6 +1,7 @@
 (ns compojure.core
   "A concise syntax for generating Ring handlers."
-  (:use [ring.middleware params cookies]
+  (:use clojure.contrib.def
+        [ring.middleware params cookies]
         clout.core
         compojure.response))

@@ -70,20 +71,12 @@
       (fn [request]
         (some #(% request) handlers)))))

-(defn- apply-doc
-  "Return a symbol and body with an optional docstring applied."
-  [name doc? body]
-  (if (string? doc?)
-    (list* (vary-meta name assoc :doc doc?) body)
-    (list* name doc? body)))
-
 (defmacro defroutes
-  "Define a Ring handler function from a sequence of routes. Takes an optional
-  doc-string."
-  [name doc? & routes]
-  (let [[name & routes] (apply-doc name doc? routes)]
-   `(def ~name
-      (routes ~@routes))))
+  "Define a Ring handler function from a sequence of routes. The name may be
+  optionally be followed by a doc-string and metadata map."
+  [name & routes]
+  (let [[name routes] (name-with-attributes name routes)]
+   `(def ~name (routes ~@routes))))

 (defmacro GET "Generate a GET route."
   [path args & body]


Added explicit format descriptor for read-«thing»

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

--- src/conexp/io/util.clj
+++ src/conexp/io/util.clj
@@ -73,12 +73,14 @@
 	 (keys @known-context-input-formats#))

        (defn- ~find
-         [file#]
-         (first
-          (for [[name# predicate#] @known-context-input-formats#
-                :when (with-open [in-rdr# (reader file#)]
-                        (predicate# in-rdr#))]
-            name#)))
+         ([file#]
+            (first
+             (for [[name# predicate#] @known-context-input-formats#
+                   :when (with-open [in-rdr# (reader file#)]
+                           (predicate# in-rdr#))]
+               name#)))
+         ([file# format#]
+            format#))

        nil)

@@ -113,7 +115,7 @@

      (defmulti ~read
        ~(str "Reads " name " from file, automatically determining the format used.")
-       {:arglists (list [(symbol "file")])}
+       {:arglists (list [(symbol "file")] [(symbol "file") (symbol "explicit-format")])}
        (fn [& args#] (apply ~find args#)))
      (defmethod ~read :default
        [file#]
@@ -131,8 +133,10 @@
        ~(str "Defines input format for " name "s.")
        [~'input-format [~'file] & ~'body]
        `(defmethod ~'~read ~~'input-format
-          [~~'file]
-          ~@~'body))
+          ([~~'file]
+             ~@~'body)
+          ([~~'file ~'~'_]
+             ~@~'body)))

      (defmacro ~(symbol (str "define-" name "-output-format"))
        ~(str "Defines output format for " name "s.")


Fix filter with null value

Fix filter with null value

--- backend/src/akvo/lumen/postgres/filter.clj
+++ backend/src/akvo/lumen/postgres/filter.clj
@@ -99,7 +99,6 @@
   (if (empty? filters)
     "TRUE"
     (let [filters (->> filters
-                       (filter :value)
                        (map #(assoc % :column (find-column columns (:column %)))))]
       (str/join " AND " (map #(format "(%s)" (filter-sql %))
                              filters)))))


JSON cannot eat future reps...

JSON cannot eat future reps...

--- src/aerobio/server.clj
+++ src/aerobio/server.clj
@@ -132,7 +132,6 @@
             :params params
             :template tempnm
             :recipient user
-            :flowres flowfut
             :user-agent user-agent
             :reqtype reqtype})))
       (hiccup/html


cleanup: remove (foo)

cleanup: remove (foo)

--- src/babel/workbook.clj
+++ src/babel/workbook.clj
@@ -5,6 +5,7 @@
    [babel.enrich :refer [against-pred]]
    [babel.english.grammar :as eng]
    [babel.english.writer :as en]
+   [babel.english.lexicon :as enl]
    [babel.english.morphology :as enm]
    [babel.espanol.grammar :as esg]
    [babel.espanol.writer :as es]
@@ -16,6 +17,7 @@
    [babel.parse :as parse]
    [babel.pos :as pos]
    [babel.reader :as reader]
+   [babel.writer :as writer]
 ;   [babel.test.fr :as frtest]
    [clojail.core :refer [sandbox]]
    [clojail.testers :refer :all]
@@ -204,38 +206,3 @@
 ;;                                          :infl :imperfect
 ;;                                          :sem {:subj {:pred :I} :pred :be}}}
 ;;                                @fr/small)
-(def foo
-  (do
-
-    (try
-      (generate {:synsem {:subcat {:1 :top
-                                   :2 '()}
-                          :sem {:pred :be-called}}} @esg/small)
-      (catch Exception e
-        (log/warn (str "ignoring exception while trying to generate: e=" e))))
-
-                                        ;
-    (try
-      (generate {:synsem {:subcat {:1 :top
-                                   :2 '()}
-                          :sem {:pred :be-called}}} @eng/small-plus-plus-np)
-      (catch Exception e
-        (log/warn (str "ignoring exception while trying to generate: e=" e))))
-
-
-;    (generate {:synsem {:subcat '()
-;                      :infl :imperfect
-;                        :sem {:pred :be
-;                              :subj {:pred :I}}}}
-;              @fr/small)
-
-    ;; the below is needed to avoid:
-    ;;INFO  56:12,470 com.mchange.v2.c3p0.C3P0Registry:
-    ;; jdk1.5 management interfaces unavailable... JMX support disabled.
-    ;; java.security.AccessControlException: access denied
-    ;; ("javax.management.MBeanServerPermission" "createMBeanServer")
-    (try (expr 0)
-         (catch Exception e
-           (log/error (str "ignoring exception while trying to do (expr 0): "
-                           e))))))
-


use updated inducer API

use updated inducer API

--- src/bract/core/dev.clj
+++ src/bract/core/dev.clj
@@ -24,7 +24,7 @@

 (def default-root-inducers [inducer/set-verbosity
                             inducer/read-config
-                            inducer/run-inducers])
+                            inducer/run-config-inducers])

 (defn init
@@ -33,7 +33,7 @@
   (try
     (inducer/set-verbosity default-root-context)
     (echo/with-latency-capture "Initializing app in DEV mode"
-      (util/induce config/apply-inducer default-root-context default-root-inducers))
+      (inducer/induce config/apply-inducer default-root-context default-root-inducers))
     (catch Throwable e
       (.printStackTrace e)
       (echo/abort (.getMessage e)))))


Slightly less wide lines.

Slightly less wide lines.

--- src/cbfg/net-test.cljs
+++ src/cbfg/net-test.cljs
@@ -104,25 +104,29 @@
                                 (e n (atake tn connect-result-ch) nil nil)
                                 (let [[server-send-ch server-recv-ch close-server-recv-ch]
                                       (atake tn accept-ch)]
-                                  (and (e n (not (nil? server-send-ch)) true nil)
-                                       (e n (not (nil? server-recv-ch)) true nil)
-                                       (e n (not (nil? close-server-recv-ch)) true nil)
-                                       (do (aput tn client-send-ch [:hi-from-client])
-                                           (and (e n (atake tn server-recv-ch) :hi-from-client nil)
-                                                (do (aput tn server-send-ch [:hi-from-server])
-                                                    (and (e n (atake tn client-recv-ch)
-                                                            :hi-from-server nil)
-                                                         (do (aclose tn close-server-recv-ch)
-                                                             (aclose tn close-client-recv-ch)
-                                                             (aclose tn server-send-ch)
-                                                             (aclose tn client-send-ch)
-                                                             (e n (atake tn server-recv-ch) nil nil)
-                                                             (e n (atake tn client-recv-ch) nil nil)
-                                                             (aclose tn listen-ch)
-                                                             (aclose tn connect-ch)
-                                                             (e n (atake tn net)
-                                                                :done
-                                                                (atake tn net)))))))))))))))
+                                  (and
+                                   (e n (not (nil? server-send-ch)) true nil)
+                                   (e n (not (nil? server-recv-ch)) true nil)
+                                   (e n (not (nil? close-server-recv-ch)) true nil)
+                                   (do (aput tn client-send-ch [:hi-from-client])
+                                       (and
+                                        (e n (atake tn server-recv-ch) :hi-from-client nil)
+                                        (do (aput tn server-send-ch [:hi-from-server])
+                                            (and (e n (atake tn client-recv-ch)
+                                                    :hi-from-server nil)
+                                                 (do (aclose tn close-server-recv-ch)
+                                                     (aclose tn close-client-recv-ch)
+                                                     (aclose tn server-send-ch)
+                                                     (aclose tn client-send-ch)
+                                                     (and
+                                                      (e n (atake tn server-recv-ch) nil nil)
+                                                      (e n (atake tn client-recv-ch) nil nil)
+                                                      (do
+                                                        (aclose tn listen-ch)
+                                                        (aclose tn connect-ch)
+                                                        (e n (atake tn net)
+                                                           :done
+                                                           (atake tn net)))))))))))))))))
               ; Try sending multiple msgs between client to server.
               (let [listen-ch (achan tn)
                     connect-ch (achan tn)
@@ -143,29 +147,33 @@
                                 (e n (atake tn connect-result-ch) nil nil)
                                 (let [[server-send-ch server-recv-ch close-server-recv-ch]
                                       (atake tn accept-ch)]
-                                  (and (e n (not (nil? server-send-ch)) true nil)
-                                       (e n (not (nil? server-recv-ch)) true nil)
-                                       (e n (not (nil? close-server-recv-ch)) true nil)
-                                       (do (aput tn client-send-ch [:hi-from-client0])
-                                           (aput tn client-send-ch [:hi-from-client1])
-                                           (aput tn client-send-ch [:hi-from-client2])
-                                           (aput tn client-send-ch [:hi-from-client3])
-                                           (aclose tn client-send-ch)
-                                           (and (e n (atake tn server-recv-ch) :hi-from-client0 nil)
-                                                (e n (atake tn server-recv-ch) :hi-from-client1 nil)
-                                                (e n (atake tn server-recv-ch) :hi-from-client2 nil)
-                                                (e n (atake tn server-recv-ch) :hi-from-client3 nil)
-                                                (e n (atake tn server-recv-ch) nil nil)
-                                                (do (aclose tn close-server-recv-ch)
-                                                    (aclose tn close-client-recv-ch)
-                                                    (aclose tn server-send-ch)
-                                                    (e n (atake tn server-recv-ch) nil nil)
-                                                    (e n (atake tn client-recv-ch) nil nil)
-                                                    (aclose tn listen-ch)
-                                                    (aclose tn connect-ch)
-                                                    (e n (atake tn net)
-                                                       :done
-                                                       (atake tn net))))))))))))))
+                                  (and
+                                   (e n (not (nil? server-send-ch)) true nil)
+                                   (e n (not (nil? server-recv-ch)) true nil)
+                                   (e n (not (nil? close-server-recv-ch)) true nil)
+                                   (do (aput tn client-send-ch [:hi-from-client0])
+                                       (aput tn client-send-ch [:hi-from-client1])
+                                       (aput tn client-send-ch [:hi-from-client2])
+                                       (aput tn client-send-ch [:hi-from-client3])
+                                       (aclose tn client-send-ch)
+                                       (and
+                                        (e n (atake tn server-recv-ch) :hi-from-client0 nil)
+                                        (e n (atake tn server-recv-ch) :hi-from-client1 nil)
+                                        (e n (atake tn server-recv-ch) :hi-from-client2 nil)
+                                        (e n (atake tn server-recv-ch) :hi-from-client3 nil)
+                                        (e n (atake tn server-recv-ch) nil nil)
+                                        (do (aclose tn close-server-recv-ch)
+                                            (aclose tn close-client-recv-ch)
+                                            (aclose tn server-send-ch)
+                                            (and
+                                             (e n (atake tn server-recv-ch) nil nil)
+                                             (e n (atake tn client-recv-ch) nil nil)
+                                             (do
+                                               (aclose tn listen-ch)
+                                               (aclose tn connect-ch)
+                                               (e n (atake tn net)
+                                                  :done
+                                                  (atake tn net))))))))))))))))
            "pass"
            (str "FAIL: on test-net #" @n)))))


Implement t2 item-scan-keys/changes.

Implement t2 item-scan-keys/changes.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -11,6 +11,8 @@
             [cbfg.world.base]
             [cbfg.world.net]))

+(def max-int (.-MAX_SAFE_INTEGER js/Number))
+
 (defn parse-sq [s] ; TODO: Unify req or sq concepts.
   (if (= s "")
     nil
@@ -62,10 +64,20 @@
                                             :sq (parse-sq (:sq m))})}]))

     "item-scan-keys"
-    [coll-state (assoc m :status :not-implemented)]
+    (do (act item-scan-keys actx
+             (aput item-scan-keys (:kvs-mgr-ch coll-state)
+                   (assoc m :op :scan-keys
+                          :kvs-ident (:kvs-ident coll-state))))
+        [coll-state nil])

     "item-scan-changes"
-    [coll-state (assoc m :status :not-implemented)]
+    (do (act item-scan-changes actx
+             (aput item-scan-changes (:kvs-mgr-ch coll-state)
+                   (assoc m :op :scan-changes
+                          :kvs-ident (:kvs-ident coll-state)
+                          :from [(js/parseInt (or (parse-sq (:from m)) 0)) nil]
+                          :to [(js/parseInt (or (parse-sq (:to m)) max-int)) nil])))
+        [coll-state nil])

     [coll-state (assoc m :status :invalid :status-info :invalid-op)]))


parse top-level arrays as lazy chunked-seqs

--- src/cheshire/parse.clj
+++ src/cheshire/parse.clj
@@ -28,6 +28,7 @@
              (recur mmap#))
            (persistent! mmap#))))))

+
 (definline parse-array [^JsonParser jp key-fn bd? array-coerce-fn]
   (let [jp (tag jp)]
     `(let [array-field-name# (.getCurrentName ~jp)]
@@ -36,12 +37,28 @@
                                  (~array-coerce-fn array-field-name#)
                                  []))]
          (if-not (= (.getCurrentToken ~jp)
-                    JsonToken/END_ARRAY)
+                   JsonToken/END_ARRAY)
            (let [coll# (conj! coll#
-                              (parse* ~jp ~key-fn ~bd? ~array-coerce-fn))]
+                         (parse* ~jp ~key-fn ~bd? ~array-coerce-fn))]
              (.nextToken ~jp)
              (recur coll#))
            (persistent! coll#))))))
+
+(defn lazily-parse-array [^JsonParser jp key-fn bd? array-coerce-fn]
+  (lazy-seq
+    (loop [chunk-idx 0, buf (chunk-buffer 32)]
+      (if (identical? (.getCurrentToken jp) JsonToken/END_ARRAY)
+
+        (chunk-cons (chunk buf) nil)
+
+        (let [coll# (chunk-append buf (parse* jp key-fn bd? array-coerce-fn))]
+          (.nextToken jp)
+          (let [chunk-idx* (unchecked-inc chunk-idx)]
+            (if (< chunk-idx* 32)
+              (recur chunk-idx* buf)
+              (chunk-cons
+                (chunk buf)
+                (lazily-parse-array jp key-fn bd? array-coerce-fn)))))))))

 (defn parse* [^JsonParser jp key-fn bd? array-coerce-fn]
   (condp identical? (.getCurrentToken jp)
@@ -62,6 +79,13 @@
 (defn parse [^JsonParser jp key-fn eof array-coerce-fn]
   (let [key-fn (or (if (= key-fn true) keyword key-fn) identity)]
     (.nextToken jp)
-    (if (nil? (.getCurrentToken jp))
+    (condp identical? (.getCurrentToken jp)
+      nil
       eof
+
+      JsonToken/START_ARRAY
+      (do
+        (.nextToken jp)
+        (lazily-parse-array jp key-fn *use-bigdecimals?* array-coerce-fn))
+
       (parse* jp key-fn *use-bigdecimals?* array-coerce-fn))))


count done

count done

--- src/codestat/mysql.clj
+++ src/codestat/mysql.clj
@@ -70,7 +70,7 @@
   [rec vcs_url branch]
   ;(println "insert commit: " rec)
   (insert commit
-          (values {:author_name (:author rec)
+          (values {:author_name (:author_name rec)
                    :commit_date (java.sql.Timestamp. (* 1000 (Integer/parseInt (:commit_date rec))))
                    :revision (:revision rec)
                    :message (:message rec)


Fix pricing slider bug.

Fix pricing slider bug.

1. Start dragging the slider.
2. Move the mouse off the page entirely.
3. Mouse up while off-page.
4. Move the mouse back onto the page.

You're still "dragging" the slider. With this change, we notice the lack
of button-holding on reentry.

--- src-cljs/frontend/components/pricing.cljs
+++ src-cljs/frontend/components/pricing.cljs
@@ -48,10 +48,10 @@
             total-cost (max (* (dec container-count) 50) 0)]
         (html
           [:div#pricing.page {:on-mouse-up #(om/set-state! owner :dragging? false)
-                              :on-mouse-down #(when dragging?
-                                                (om/set-state! owner :drag-percent (calculate-drag-percent owner %)))
-                              :on-mouse-move #(when dragging?
-                                                (om/set-state! owner :drag-percent (calculate-drag-percent owner %)))}
+                              :on-mouse-move #(if (zero? (.-buttons %))
+                                                (om/set-state! owner :dragging? false)
+                                                (when dragging?
+                                                  (om/set-state! owner :drag-percent (calculate-drag-percent owner %))))}
            [:div.jumbotron
             common/language-background-jumbotron
             [:section.container


Inline clj call to hash and fix comparison

Proper comparison on JVM should return 1, 0, -1.
A comparator expects to return int, this could cause an exception if the
resulting long doesn't fit in an int

--- src/datascript/db.cljc
+++ src/datascript/db.cljc
@@ -368,9 +368,15 @@
   #?(:clj  (long (compare (class-name x) (class-name y)))
      :cljs (garray/defaultCompare (type->str (type x)) (type->str (type y)))))

+#?(:clj
+   (defn ihash
+     {:inline (fn [x] `(. clojure.lang.Util (hasheq ~x)))}
+     ^long [x]
+     (. clojure.lang.Util (hasheq x))))
+
 (defn value-compare
   ^long [x y]
-  (try
+  (try
     (cond
       (= x y) 0
       #?@(:clj  [(instance? Number x)       (clojure.lang.Numbers/compare x y)])
@@ -378,7 +384,7 @@
           :cljs [(satisfies? IComparable x) (-compare x y)])
       (not (class-identical? x y)) (class-compare x y)
       #?@(:cljs [(or (number? x) (string? x) (array? x) (true? x) (false? x)) (garray/defaultCompare x y)])
-      :else (- (hash x) (hash y)))
+      :else #?(:clj (Integer/compare (ihash x) (ihash y)) :cljs (- (hash x) (hash y))))
     (catch #?(:clj ClassCastException :cljs js/Error) e
       (if (not (class-identical? x y))
         (class-compare x y)


Allow js api to create conn from db

Allow js api to create conn from db

Maybe I am going about this the wrong way,
but I am trying to deserialize a datascript database
from localstorage (a la your example here: https://github.com/tonsky/datascript-todo/blob/gh-pages/src/datascript_todo.cljs)
but via the vanilla js api.

There seems to be an asymmetry in the js api,
in that you can dereference a database from a conn,
but you cannot create a conn from a database.

My pull request is kind of a dumb hack.
Maybe it would be better for the original create-conn
function to be a multimethod or something.

--- src/datascript/js.cljs
+++ src/datascript/js.cljs
@@ -94,6 +94,10 @@
 (defn ^:export create_conn [& [schema]]
   (d/create-conn (schema->clj schema)))

+(defn ^:export conn_from [db]
+  (atom db
+        :meta { :listeners  (atom {}) }))
+
 (defn ^:export db [conn]
   @conn)


fix update record check

fix update record check

--- server/src/gratefulplace/controllers/shared.clj
+++ server/src/gratefulplace/controllers/shared.clj
@@ -54,15 +54,18 @@
 (defmacro can-delete-record?
   [record auth]
   `(fn [_#]
-     (let [record# ~record]
-       (if (or (author? record# ~auth) (moderator? ~auth))
+     (let [record# ~record
+           auth# ~auth]
+       (if (or (author? record# auth#) (moderator? auth#))
          {:record record#}))))

 (defmacro can-update-record?
   [record auth]
   `(fn [_#]
-     (let [record# ~record]
-       (if (and (author? record# ~auth) (not (:deleted ~record)))
+     (let [auth# ~auth
+           record# ~record]
+       (if (or (moderator? auth#)
+               (and (author? record# auth#) (not (:deleted record#))))
          {:record record#}))))

 (defn create-record


fixed upload pausing

fixed upload pausing

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -67,6 +67,9 @@
                                         client-id)
     (.pipe blob-stream stream)

+    ; HACK!!!!
+    (.on blob-stream "data" #(.resume blob-stream))
+
     (.on blob-stream "end"
       (fn []
         (println "Upload complete: " (.-name file))


fixing login on 401 and 404 page

fixing login on 401 and 404 page

--- src-cljs/frontend/components/errors.cljs
+++ src-cljs/frontend/components/errors.cljs
@@ -22,7 +22,7 @@
            [:div.container
             [:h1 status]
             [:h3 (str (condp = status
-                        401 "Login required"
+                        401 "Log in required"
                         404 "Page not found"
                         500 "Internal server error"
                         "Something unexpected happened"))]]]
@@ -35,8 +35,8 @@
                                                       :properties {:source "401"
                                                                    :url js/window.location.pathname}
                                                       :path (gh-utils/auth-url)}])}
-                       "Login here"]]
-                  " to view this page"]
+                       "Log in"]]
+                  " here to view this page"]
              404 (if (and (not logged-in?) maybe-login-page?)
                    [:div
                     [:p "We're sorry; either that page doesn't exist or you need to be logged in to view it."]
@@ -45,7 +45,7 @@
                                                            {:event "login_click"
                                                             :properties {:source "404"
                                                                          :url js/window.location.pathname}
-                                                            :path (gh-utils/auth-url)}])} "Login here"] " to view this page with your GitHub permissions."]]]
+                                                            :path (gh-utils/auth-url)}])} "Log in"] " here to view this page with your GitHub permissions."]]]
                    [:p "We're sorry, but that page doesn't exist."])
              500 [:p "We're sorry, but something broke"]
              "Something completely unexpected happened")]])))))


display new alias attribute

display new alias attribute

--- app/src/semtag_web/rendering/partials.cljs
+++ app/src/semtag_web/rendering/partials.cljs
@@ -44,6 +44,10 @@
     [:td.editable {:data-field "name" :title s}
      (if (seq s) (link-thing s)
        (if id (link-thing id "nil" {:class "noname" :title "This thing has no name. Feel free to give it one."}) s))]))
+
+(defn- td-alias
+  [s]
+  [:td.editable {:data-field "alias" :title s} s])

 (defn- td-desc
   ([desc] (td-desc desc 70))
@@ -135,6 +139,7 @@
        :type (td-type (:value row))
        :url (td-url (:value row))
        :name (td-name (:value row))
+       :alias (td-alias (:value row))
        :tags (td-tags (:value row))
        :tagged [:td (link-tagged (:value row))]
        :desc (td-desc (:value row) 1000)


Add date string to make Torque vis easy

Add date string to make Torque vis easy

--- src/clj/forma/hadoop/jobs/postprocess.clj
+++ src/clj/forma/hadoop/jobs/postprocess.clj
@@ -94,7 +94,7 @@
                 50)"
   [src nodata zoom tres tres-out start thresh]
   (let [epoch (date/datetime->period tres-out "2000-01-01")]
-    (<- [?x ?y ?z ?p ?iso ?gadm2 ?ecoregion ?lat ?lon]
+    (<- [?x ?y ?z ?p ?date-str ?iso ?gadm2 ?ecoregion ?lat ?lon]
         (src ?sres ?modh ?modv ?s ?l ?start-period ?prob-series ?gadm2 ?ecoregion)
         (gadm2->iso ?gadm2 :> ?iso)
         (o/clean-probs ?prob-series nodata :> ?clean-series)
@@ -103,6 +103,7 @@
         (date/shift-resolution tres tres-out ?period :> ?period-new-res)
         (- ?period-new-res epoch :> ?rp)
         (min-period ?rp :> ?p)
+        (date/period->datetime tres-out ?period-new-res :> ?date-str)
         (r/modis->latlon ?sres ?modh ?modv ?s ?l :> ?lat ?lon)
         (latlon-valid? ?lat ?lon)
         (latlon->tile ?lat ?lon zoom :> ?x ?y ?z))))


be lenient to unknown columns in workspace-column-defaults [risk: low] (#1434)

be lenient to unknown columns in workspace-column-defaults

--- src/cljs/main/broadfcui/common/table.cljs
+++ src/cljs/main/broadfcui/common/table.cljs
@@ -216,10 +216,16 @@
      (let [columns (-> props :body :columns)
            processed-columns (if-let [defaults (-> props :body :column-defaults)]
                                (let [by-header (utils/index-by (some-fn :id :header) columns)
-                                     default-showing (->> (defaults "shown")
+                                     ;; columns actually in the data model
+                                     known-columns (set (keys by-header))
+                                     ;; strip out any workspace-column-defaults that aren't in the data model
+                                     known-shown (set/intersection (set (defaults "shown")) known-columns)
+                                     known-hiding (set/intersection (set (defaults "hidden")) known-columns)
+                                     ;; flesh out the workspace-column-defaults
+                                     default-showing (->> known-shown
                                                           (replace by-header)
                                                           (map #(assoc % :show-initial? true)))
-                                     default-hiding (->> (defaults "hidden")
+                                     default-hiding (->> known-hiding
                                                          (replace by-header)
                                                          (map #(assoc % :show-initial? false)))
                                      mentioned (set/union (set (defaults "shown"))


New function in the utils module: get-exception-message

--- src/hurvinek/utils.clj
+++ src/hurvinek/utils.clj
@@ -44,3 +44,8 @@
     [^String s pattern replacement]
     (.replaceAll s pattern replacement))

+(defn get-exception-message
+    "Retrieve a message from given exception."
+    [^java.lang.Exception exception]
+    (.getMessage exception))
+


Reverted b1d9656 which caused (not fixed) v-scroll regression

--- src/day8/re_frame_10x/view/container.cljs
+++ src/day8/re_frame_10x/view/container.cljs
@@ -240,19 +240,22 @@
                    [rc/hyperlink
                     :label "Dismiss"
                     :on-click #(rf/dispatch [:errors/dismiss-popup-failed])]])
-                [rc/box
-                 :v-scroll :on
-                 :height "100%"
-                 :style {:margin-left common/gs-19s}
-                 :child (case @selected-tab
-                          :event [event/render]
-                          :fx [fx/render]
-                          :app-db [app-db/render db/app-db]
-                          :subs [subs/render]
-                          :views [views/render]
-                          :parts [parts/render]
-                          :timing [timing/render]
-                          :traces [traces/render]
-                          :debug [debug/render]
-                          :settings [settings/render]
-                          [app-db/render db/app-db])]]]))
+                [rc/v-box
+                 :class "tab-wrapper"
+                 :size "1"
+                 :style {:margin-left common/gs-19s
+                         :overflow-y  (if (contains? #{:event :fx :parts :timing :debug :settings} @selected-tab)
+                                        "auto"
+                                        "initial")}
+                 :children [(case @selected-tab
+                              :event [event/render]
+                              :fx [fx/render]
+                              :app-db [app-db/render db/app-db]
+                              :subs [subs/render]
+                              :views [views/render]
+                              :parts [parts/render]
+                              :timing [timing/render]
+                              :traces [traces/render]
+                              :debug [debug/render]
+                              :settings [settings/render]
+                              [app-db/render db/app-db])]]]]))


remove '/' route

remove '/' route

--- src/clj/dokkaa_builder/route.clj
+++ src/clj/dokkaa_builder/route.clj
@@ -89,7 +89,6 @@
   (friend/logout (ANY "/logout" request (ring.util.response/redirect "/"))))

 (defroutes routes
-  (GET "/" req (friend/authorize #{:user} (fn [req] "index")))
   (GET "/_ping"  [] ping)
   (context "/users" req users-routes)
   (context "/apps/:app" req apps-routes)


fixup

fixup

--- src/clj/freestuffly/notifier.clj
+++ src/clj/freestuffly/notifier.clj
@@ -22,4 +22,4 @@

 (defn listen
   []
-  (send-email scraper/scraped-content))
+  (send-email (scraper/scraped-content)))


make Order of Sol fire if Runner is at 0 credits after installing it

--- src/clj/game/cards-resources.clj
+++ src/clj/game/cards-resources.clj
@@ -365,7 +365,10 @@
                                                (swap! state assoc-in [:per-turn (:cid card)] true))}
              :corp-turn-begins {:req (req (= (:credit runner) 0)) :msg "gain 1 [Credits]"
                                 :effect (req (gain state :runner :credit 1)
-                                             (swap! state assoc-in [:per-turn (:cid card)] true))}}
+                                             (swap! state assoc-in [:per-turn (:cid card)] true))}
+             :runner-install {:req (req (and (= target card) (= (:credit runner) 0))) :msg "gain 1 [Credits]"
+                              :effect (req (gain state :runner :credit 1)
+                                           (swap! state assoc-in [:per-turn (:cid card)] true))}}
     :leave-play (req (remove-watch state :order-of-sol))}

    "Paige Piper"


Update worker.clj

Update worker.clj

--- src/clj/hatnik/worker/worker.clj
+++ src/clj/hatnik/worker/worker.clj
@@ -35,7 +35,7 @@
   (timbre/debug "Performing action for user" user
                 " Variables: " variables)
   (case (:type action)
-    "email" (email/perform action user variables)))
+    "email" (email/perform action user variables utils)))

 (defn check-library-and-perform-actions
   "Retrieves latest version for given library and updates actions if they


make chunk feedback asynchronous

make chunk feedback asynchronous

--- src/clj_money/import/gnucash.clj
+++ src/clj_money/import/gnucash.clj
@@ -6,6 +6,7 @@
             [clojure.string :as s]
             [clojure.tools.logging :as log]
             [clojure.tools.cli :refer [parse-opts]]
+            [clojure.core.async :refer [chan go go-loop <! <!! >!]]
             [clj-time.core :as t]
             [clj-xpath.core :refer :all]
             [clj-money.core]
@@ -317,17 +318,25 @@
         output-folder (.getParent input-file)
         file-name (.getName input-file)
         context (atom {:output-paths []
-                       :verbose (:vervose opts)
+                       :verbose (:verbose opts)
                        :records []
                        :max-record-count (-> opts :options :maximum)
                        :file-name (second (re-matches #"^(.+)(\..+)$" file-name))
-                       :output-folder output-folder})]
-    (with-open [input-stream (FileInputStream. input-file)]
-      (doseq [record (read-source :gnucash input-stream)]
-        (when (not (:verbose opts))
-          (print "."))
-        (swap! context #(-> %
-                            (update-in [:records] (fn [records] (conj records record)))
-                            advance-context)))
-      (process-output @context)))
-  (println ""))
+                       :output-folder output-folder})
+        record-chan (chan)
+        result (go
+                 (with-open [input-stream (FileInputStream. input-file)]
+                   (doseq [record (read-source :gnucash input-stream)]
+                     (swap! context #(-> %
+                                         (update-in [:records] (fn [records] (conj records record)))
+                                         advance-context))
+                     (>! record-chan record))
+                   (process-output @context)))]
+    (go-loop [record (<! record-chan)]
+             (when (not (:verbose opts))
+               (print (-> record meta :record-type name first))
+               (flush))
+             (recur (<! record-chan)))
+    (println "reading the source file...")
+    (<!! result)
+    (println "\nDone")))


Now checking on left and right sides, not if hitting paddle.

--- src/cljs/clj_mini_apps/pong.cljs
+++ src/cljs/clj_mini_apps/pong.cljs
@@ -17,8 +17,6 @@
 (def ball-speed 2)

 (defn init-game []
-  (log "init-game")
-
   (do
     (q/rect-mode :corner)
     ;Create background and outline
@@ -42,14 +40,12 @@

 (defn move-player-paddle
   [state direction]
-  ;(log "move-player-paddle")
   (if (= direction :down)
     (update-in state [:player :y] + speed)
     (update-in state [:player :y] - speed)))

 (defn start-game
   [state]
-  ;(log "start-game")
   (if (= 2 (count (:ball state)))
     (as-> state state
       (assoc-in state [:ball :x-dir] (rand-nth [+ -]))
@@ -59,7 +55,6 @@

 (defn update-ball
   [state]
-  ;(log "update-ball")
   (if (:is-running? state)
     (as-> state state
       (update-in state [:ball :y] (:y-dir (:ball state)) ball-speed)
@@ -67,7 +62,6 @@
     state))

 (defn handle-input [state]
-  ;(log "handle-input")
   (condp = (q/key-as-keyword)
     :w (move-player-paddle state :up)
     :s (move-player-paddle state :down)
@@ -80,23 +74,29 @@
 (defn on-collision [state]
   (let [ball-x (:x (:ball state))
         ball-y (:y (:ball state))
-        top-wall (+ 9 7.5)
-        btm-wall (- 490 7.5)
-        new-y-dir (if (= + (:y-dir (:ball state))) - +)]
-    ;Check wall collision
-    (if (not (and (> ball-y top-wall)
-                  (< ball-y btm-wall)))
-      (as-> state state
-        (assoc-in state [:ball :y-dir] new-y-dir)
-        (if (= (:y-dir (:ball state)) +)
-          (assoc-in state [:ball :y] top-wall)
-          (assoc-in state [:ball :y] btm-wall)))
-      state)))
+        top-wall (+ 2 (+ 9 7.5))
+        btm-wall (- (- 490 7.5) 2)
+        not-dir #({+ -, - +} %)]
+    (cond
+      ;;check w/ top/btm walls
+      (not (and (> ball-y top-wall)
+                (< ball-y btm-wall)))
+      (update-in state [:ball :y-dir] not-dir)
+
+      ;;check w/ player paddle
+      (< ball-x (+ (:x (:player state))
+                   paddle-width))
+      (update-in state [:ball :x-dir] not-dir)
+
+      ;;check w/ cpu paddle
+      (> ball-x (- (:x (:computer state))
+                   paddle-width))
+      (update-in state [:ball :x-dir] not-dir)
+
+      :else state)))

 (defn draw-game
   [state]
-  ;(log "draw-game")
-
   (do
     (q/rect-mode :corner)
     (q/fill 255)


an onclick event worked

an onclick event worked

--- src/cljs/om_lette/templater.cljs
+++ src/cljs/om_lette/templater.cljs
@@ -54,7 +54,7 @@
 (defn has-listeners? [h] (when-let [ons (->> h like-html-vec? second keys
                                              (filterv #(->> % str (take 3) (clojure.string/join "") (= ":on")))
                                              seq)]
-                           (dbg2 "has-listeners?" [h (vec ons)])))
+                            [h (vec ons)]))

 (#(str (subs % 0 2) "-" (subs % 2)) "onclick")

@@ -135,7 +135,7 @@
             (if (not-empty sel-ks)
               (-> a
                   (#(apply dissoc % ks))
-                  (assoc :om-lette (select-keys a ks)))
+                  (assoc :om-lette sel-ks))
               a))]
     r))

@@ -189,22 +189,24 @@
                                (eval-parsed-code state))))]
    [has-listeners? (fn [[h onkeys]]
                      (update-in h [1]
-                                #(reduce (fn [agg k]
-                                           (let [strk (str k)
-                                                 on-k (keyword (str (subs strk 1 2)
-                                                                    "-"
-                                                                    (subs strk 3)))]
-
-                                             (-> agg
-                                                 (assoc on-k
-                                                   (eval-parsed-code (-> agg
-                                                                         k
-                                                                         parse-code
-                                                                         last)
-                                                                     state))
-                                                 (dissoc k))))
-                                         %
-                                         onkeys)))]])
+                                (fn [attrs] (reduce (fn [agg k]
+                                                      (let [strk (str k)
+                                                            on-k (keyword (str (subs strk 1 3)
+                                                                               "-"
+                                                                               (subs strk 3)))]
+
+                                                        (-> agg
+                                                            (assoc on-k
+                                                              (eval-parsed-code (->> agg
+                                                                                k
+                                                                                (mapcat second)
+                                                                                (apply str)
+                                                                                parse-code
+                                                                                last)
+                                                                                state))
+                                                            (dissoc k))))
+                                                    attrs
+                                                    onkeys))))]])

 ; #(str (subs % 0 2) "-" (subs % 2))


Use 180 day window (instead of 1810

Use 180 day window (instead of 1810

--- src/cljs/schengencalc/dates.cljs
+++ src/cljs/schengencalc/dates.cljs
@@ -18,8 +18,8 @@
 (defn- relevant-periods [travel-dates]
   (mapcat
     (fn [{entry :entry exit :exit}]
-      [{:start entry :end (add-days entry 180)}
-       {:start exit :end (add-days exit 180)}])
+      [{:start entry :end (add-days entry 179)}
+       {:start exit :end (add-days exit 179)}])
     travel-dates))

 (defn- clean-travel-dates [travel-dates]


Fixed errors in report_tag-ing and implementation.

--- src/clojush/instructions/tag.clj
+++ src/clojush/instructions/tag.clj
@@ -13,7 +13,7 @@
        (or
          (.startsWith (name i) "tag")
          (.startsWith (name i) "untag")
-         (.startsWith (name i) "return-tag"))))
+         (.startsWith (name i) "return_tag"))))

 (defn closest-association
   "Returns the key-val pair for the closest match to the given tag
@@ -73,10 +73,10 @@
            (= (second iparts) "tag"))
       (let [source-type (read-string (str ":" (nth iparts 2)))
             the-tag (read-string (nth iparts 3))
-            new-tag-instr (subs i (count "return_"))]
+            new-tag-instr (symbol (subs (name i) (count "return_")))]
         (if (empty? (source-type state))
           state
-          (let [item (list new-tag-instr (top-item source-type state))]
+          (let [item (list (top-item source-type state) new-tag-instr)]
             ((if @global-pop-when-tagging pop-item (fn [type state] state))
                  source-type
                  (push-item item :return state)))))


For some reason and I can't remember what happened (it was very late (or very early if you like) but modify-state didn't work, now it is fixed to work...

--- src/fpinscala/purely_functional_state.clj
+++ src/fpinscala/purely_functional_state.clj
@@ -375,7 +375,8 @@
 (defn get-state [s] (make-state (:val s) (:val s)))
 (defn set-state [v] (make-state nil v))
 (defn modify-state [f]
-  (flat-map-s get-state (fn [s] (set-state (f s)))))
+  (flat-map-s get-state (fn [v] (fn [_] (let [fs (f v)]
+                                          (set-state fs))))))

 ;now when step-machine is in place - to re-think get, set and modify...

@@ -394,6 +395,7 @@
   "inputs is sequence of either coins or turns, s is 'machine' in focus"
   [i]
   (fn [s]
+    (println s)
     (match [i s]
          [_ {:locked _ :candies 0 :coins _}] s
          [:coin {:locked false :candies _ :coins _}] s
@@ -402,6 +404,3 @@
          (machine false candies (inc coins))
          [:turn {:locked false :candies candies :coins coins}]
          (machine true (dec candies) coins))))
-
-
-


Changed require statement to remove circular dependencies

--- src/hydrofoil/core.clj
+++ src/hydrofoil/core.clj
@@ -1,6 +1,7 @@
 (ns hydrofoil.core
   (:require [hydrofoil.evolution :refer :all]
-            [hydrofoil.model :refer :all]))
+            [hydrofoil.model :refer :all]
+            [hydrofoil.utils :refer :all]))

 ;;[hydrofoil.evolution :as evo]

@@ -17,7 +18,6 @@
 (defn -main [& args]
   (new-indv(NACA-design 50 50 50)))

-(new-indv(NACA-design 50 50 50))

 ;;(defn generate-random-design
 ;;  [individual]


test path should be pointed by :test-path key

--- src/leiningen/test.clj
+++ src/leiningen/test.clj
@@ -14,7 +14,7 @@
 tests for. If none are given, runs them all."
   [project & namespaces]
   (let [namespaces (if (empty? namespaces)
-                     (find-namespaces-in-dir (file (:root project) "test"))
+                     (find-namespaces-in-dir (file (:test-path project)))
                      (map symbol namespaces))]
     ;; It's long and a bit hairy because it has to be self-contained.
     (eval-in-project


Also have 'parse-tag normalize the :proj name.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -400,7 +400,8 @@
   [tag]
   (->
    (zipmap [:prefix :proj :ver :path :sha] (s/split tag #"--"))
-   (update-in [:path] (fnil s/replace "") #"%" "/")))
+   (update-in [:path] (fnil s/replace "") #"%" "/")
+   (update-in [:proj] (fnil s/replace "") #"%" "/")))

 (defn newest-voom-ver-by-spec
   [proj-name ver-spec {:keys [repo ref path]}]


Factor out read-args function in test task.

--- src/leiningen/test.clj
+++ src/leiningen/test.clj
@@ -34,20 +34,26 @@
             (.write w# (pr-str summary#))))
         (System/exit 0))))

+(defn- read-args [args project]
+  (let [args (map read-string args)
+        nses (if (or (empty? args) (every? keyword? args))
+               (sort (namespaces-in-dir (:test-path project)))
+               args)
+        selectors (map (:test-selectors project) (filter keyword? args))
+        selectors (if (and (empty? selectors)
+                           (:default (:test-selectors project)))
+                    [(:default (:test-selectors project))]
+                    selectors)]
+    (when (and (not (:test-selectors project)) (some keyword? args))
+      (throw (Exception. "Must specify :test-selectors in project.clj")))
+    [nses selectors]))
+
 (defn test
   "Run the project's tests. Accepts a list of namespaces for which to run all
 tests. If none are given, runs them all." ; TODO: update
   [project & tests]
-  (let [tests (map read-string tests)
-        nses (if (or (empty? tests) (every? keyword? tests))
-               (sort (namespaces-in-dir (:test-path project)))
-               tests)
-        result (doto (File/createTempFile "lein" "result") .deleteOnExit)
-        selectors (map (:test-selectors project) (filter keyword? tests))
-        selectors (if (and (empty? selectors)
-                           (:default (:test-selectors project)))
-                    [(:default (:test-selectors project))]
-                    selectors)]
+  (let [[nses selectors] (read-args tests project)
+        result (doto (File/createTempFile "lein" "result") .deleteOnExit)]
     (when-not (or (every? symbol? nses) (every? keyword? nses))
       (throw (Exception. "Args must be either all namespaces or keywords.")))
     (eval-in-project project (form-for-testing-namespaces


[voom] clone repos for :managed-dependencies, in addition to :dependencies

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -440,7 +440,7 @@
   "Like 'lein deps', but also builds voom-versioned things as needed."
   [project & args]
   (println "-- build-deps for" (:name project))
-  (ensure-deps-repos (:dependencies project))
+  (ensure-deps-repos (concat (:dependencies project) (:managed-dependencies project)))
   (try
     (loop []
       (when-not (= :ok (try-once-resolve-voom-version project))


Bump voomdb version to fix dbs with nil project names

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1165,7 +1165,7 @@
           (vary-meta assoc ::dirty true)))
       (build-shabam (vals new-branches)))))

-(def voomdb-header "voom-db-9")
+(def voomdb-header "voom-db-10")

 (defn ^File git-db-file
   [gitdir]


Filter out branches that do not contain any matching project tags

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -497,8 +497,12 @@
                                                      "--simplify-by-decoration" "-m" (str "^origin/" found-branch)))))
               ;; yes-yes-tags are the matching tags reachable via this branch:
               yes-yes-tags (set/difference tags not-not-tags)
-              tags-with-parents (remove #(.endsWith ^String % "--no-parent") yes-yes-tags)
-              tags-here-with-parents (filter #(= found-path (:path (parse-tag %))) tags-with-parents)
+              tags-here (filter #(= found-path (:path (parse-tag %))) yes-yes-tags)]
+        ;; If this branch contains no matching tags, the
+        ;; project+version we're looking for must not be on this
+        ;; branch. Skip it.
+        :when (seq tags-here)
+        :let [tags-here-with-parents (remove #(.endsWith ^String % "--no-parent") tags-here)
               neg-tags (map #(str "^" % "^") tags-here-with-parents)
               ;; All commits on the current branch more recent than
               ;; (and including) the most recent tag matching our


rename of fixtures

rename of fixtures

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -31,9 +31,8 @@
   var-binder
   (atom nil))

-; 2DO: understand how to pack dimmer and strobe into 1 function definition
-(defn simple-rgbd
-  "A simple RGB with dimmer"
+(defn rgbd-cheap
+  "A simple RGB with dimmer and strobe on 1 channel"
   []
   {:channels [(chan/color 1 :red)
               (chan/color 2 :green)
@@ -94,9 +93,9 @@
         (with-show s (show/stop!)))
       (show/show :universes [1] :description "Accuraten"))))

-  (show/patch-fixture! :back-odd-1 (simple-rgbd) 1 1 :x 1)
-  (show/patch-fixture! :back-even-2 (simple-rgbd) 1 5 :x 2)
-  (show/patch-fixture! :back-odd-3 (simple-rgbd) 1 9 :x 3)
+  (show/patch-fixture! :back-odd-1 (rgbd-cheap) 1 1 :x 1)
+  (show/patch-fixture! :back-even-2 (rgbd-cheap) 1 5 :x 2)
+  (show/patch-fixture! :back-odd-3 (rgbd-cheap) 1 9 :x 3)
   (show/patch-fixture! :front-1 (rgb-arch) 1 13  :x 3.5)

   ;; Return the show's symbol, rather than the actual map, which gets huge with
@@ -124,12 +123,12 @@
   (show/patch-fixture! :head-3 (jb-systems-sirius-8ch) 1 81 :x 3.5  :y 7  :z 2.8)
   (show/patch-fixture! :head-4 (jb-systems-sirius-8ch) 1 97 :x 3.5  :y 7  :z 2.8)

-  (show/patch-fixture! :back-1 (simple-rgbd) 1 113 :x -1.757 :y 0.325 :z 0.3)
-  (show/patch-fixture! :back-2 (simple-rgbd) 1 117 :x -1.057 :y 0.325 :z 0.3)
-  (show/patch-fixture! :back-3 (simple-rgbd) 1 121 :x -0.39  :y 0.325 :z 0.3)
-  (show/patch-fixture! :back-4 (simple-rgbd) 1 125 :x 0.39   :y 0.325 :z 0.3)
-  (show/patch-fixture! :back-5 (simple-rgbd) 1 129 :x 1.057  :y 0.325 :z 0.3)
-  (show/patch-fixture! :back-6 (simple-rgbd) 1 133 :x 1.757  :y 0.325 :z 0.3)
+  (show/patch-fixture! :back-1 (rgbd-cheap) 1 113 :x -1.757 :y 0.325 :z 0.3)
+  (show/patch-fixture! :back-2 (rgbd-cheap) 1 117 :x -1.057 :y 0.325 :z 0.3)
+  (show/patch-fixture! :back-3 (rgbd-cheap) 1 121 :x -0.39  :y 0.325 :z 0.3)
+  (show/patch-fixture! :back-4 (rgbd-cheap) 1 125 :x 0.39   :y 0.325 :z 0.3)
+  (show/patch-fixture! :back-5 (rgbd-cheap) 1 129 :x 1.057  :y 0.325 :z 0.3)
+  (show/patch-fixture! :back-6 (rgbd-cheap) 1 133 :x 1.757  :y 0.325 :z 0.3)

   ;; Return the show's symbol, rather than the actual map, which gets huge with
   ;; all the expanded, patched fixtures in it.


WIP control chance with Quneo button

WIP control chance with Quneo button

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -262,6 +262,13 @@
     )
   )

+  (if (= interface "quneo")
+    (do
+      (cues/add-midi-control-to-cue-mapping "Bus 1" 0
+        :note 36 0 7 :use-velocity? true)
+      )
+    )
+
   (if (= interface "uno-clock")
     (show/sync-to-external-clock
       (afterglow.midi/sync-to-midi-clock "USB Uno MIDI Interface"))


fix typo

fix typo

--- src/babel/francais/morphology/verbs.cljc
+++ src/babel/francais/morphology/verbs.cljc
@@ -220,7 +220,7 @@
                                     :person :3rd}}}
                  :infl :present}}}])

-(def past-reflexive
+(def past
   [
    ;; <reflexive past>: e.g. "amusé" => "s'amuser"
    {:comment "past participle reflexive singular masculine -er where stem begins with a vowel"
@@ -293,8 +293,8 @@
     :g [#"^(\S+)re$"           "$1u"]
     :u {:synsem {:infl :past-p}}}

-   {:comment "past participle non-reflexive singular -ir"
-    :p [#"^(\S+)i$"            "$1re"]
+   {:comment "past participle non-reflexive -ir"
+    :p [#"^(\S+)i$"            "$1ir"]
     :g [#"^(\S+)ir$"           "$1i"]
     :u {:synsem {:infl :past-p}}}


Fixed bug in computing gc2-diff in august2016-diversifying?

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -369,7 +369,7 @@
         c1-diff (diff g c1)
         c2-diff (diff g c2)
         gc1-diff (diff c1 gc1)
-        gc2-diff (diff c2 gc1)
+        gc2-diff (diff c2 gc2)
         diffs [c1-diff c2-diff gc1-diff gc2-diff]]
     (and (> (reduce min diffs) 0)
          (apply distinct? diffs))))


First gen tracing and improvements

First gen tracing and improvements

--- src/com/wsscode/pathom/connect/test.cljc
+++ src/com/wsscode/pathom/connect/test.cljc
@@ -7,14 +7,22 @@
      (:import (java.util Date))))

 (s/def ::values set?)
-(s/def ::data-bank (s/map-of keyword? ::values))
-(s/def ::call-history (s/map-of symbol? ::data-bank))
+(s/def ::error any?)
+(s/def ::depth nat-int?)
+(s/def ::error-box (s/keys :req [::error]))
+(s/def ::data-bank (s/map-of ::p.connect/attribute ::values))
+(s/def ::input-arguments (s/map-of ::p.connect/attribute any?))
+(s/def ::call-result (s/or :error (s/keys :req [::error]) :value any?))
+(s/def ::call-event (s/map-of ::input-arguments ::call-result))
+(s/def ::call-history (s/map-of symbol? ::call-event))
 (s/def ::calls (s/coll-of map? :kind set?))
 (s/def ::log (s/tuple inst? symbol? map? map?))
 (s/def ::call-log (s/coll-of ::log :kind vector?))
 (s/def ::multi-args (s/coll-of ::p.connect/attributes-set :kind set?))

 (declare test-resolver discover-data)
+
+(defn reduce-first [col] (reduce #(reduced %2) nil col))

 (defn add-subsets [{::keys [multi-args] :as a} b]
   (let [b-keys (set (keys b))]
@@ -47,37 +55,56 @@
   "Mark attribute k as unreachable on db. Returns ::unreachable."
   [{::keys [data-bank]} k]
   (swap! data-bank update ::unreachable (fnil conj #{}) k)
-  ::unreachable)
+  {::error ::unreachable})
+
+(s/fdef unreachable
+  :args (s/cat :env (s/keys :req [::data-bank]) :k ::p.connect/attribute)
+  :ret ::error-box)
+
+(defn print-trace [{::keys [depth]
+                    :or    {depth 0}} & messages]
+  (apply println (apply str (repeat depth "  "))
+    "- " messages))

 (defn seek-attr
   "Try to run more resolvers to get more attributes of type `attr`."
-  [{::keys           [data-bank resolver-trace]
+  [{::keys           [data-bank resolver-trace depth]
     ::p.connect/keys [indexes]
+    :or              {depth 0}
     :as              env}
    attr]
   (let [db      @data-bank
         db-keys (set (keys db))
         {::p.connect/keys [index-oir index-resolvers]} indexes]
+    (print-trace env "seeking" attr)
     (if-let [attr-resolvers (get index-oir attr)]
-      (if-let [attr-set (->> attr-resolvers
-                             (mapcat (fn [[attrs syms]]
-                                       (let [missing (set/difference attrs db-keys)]
-                                         (for [s syms]
-                                           {:sym     s
-                                            :data    (get index-resolvers s)
-                                            :attrs   attrs
-                                            :missing missing}))))
-                             (sort-by (comp count :missing))
-                             (eduction
-                               (remove (comp (or resolver-trace #{}) :sym))
-                               (keep (fn [{:keys [sym data]}]
-                                       (if (and (test-resolver (update env ::resolver-trace (fnil conj #{}) sym) data)
-                                                (not= (get db attr) (get @data-bank attr)))
-                                         (get @data-bank attr)))))
-                             (first))]
-        attr-set
-        (unreachable env attr))
+      (or (->> attr-resolvers
+               (mapcat (fn [[attrs syms]]
+                         (let [missing (set/difference attrs db-keys)]
+                           (for [s syms]
+                             {:sym     s
+                              :data    (get index-resolvers s)
+                              :attrs   attrs
+                              :missing missing}))))
+               (sort-by (comp count :missing))
+               (eduction
+                 (remove (comp (or resolver-trace #{}) :sym))
+                 (keep (fn [{:keys [sym data]}]
+                         (print-trace env "trying to read from" sym)
+                         (test-resolver (-> env
+                                            (assoc ::depth (inc depth))
+                                            (update ::resolver-trace (fnil conj #{}) sym)) data)
+                         (when (not= (get db attr) (get @data-bank attr))
+                           (get @data-bank attr)))))
+               (reduce-first))
+          (unreachable env attr))
       (unreachable env attr))))
+
+(s/fdef seek-attr
+  :args (s/cat :env (s/keys :req [::data-bank ::p.connect/indexes]
+                            :opt [::resolver-trace])
+               :attr ::p.connect/attribute)
+  :ret (s/or :err ::error-box :inputs ::values))

 (defn resolve-attr
   "Find a value for an attribute."
@@ -85,7 +112,7 @@
   (let [db @data-bank]
     (or (get db attr)
         (if (contains? (::unreachable db) attr)
-          ::unreachable
+          {::error ::unreachable}
           (seek-attr env attr)))))

 (defn discover-data
@@ -158,14 +185,15 @@
   :args (s/cat :env (s/keys :req [::data-bank])
                :resolver (s/keys :req [::p.connect/input])
                :in-data (s/map-of keyword? set?))
-  :ret (s/coll-of (s/map-of keyword? any?)))
+  :ret (s/coll-of (s/map-of ::p.connect/attribute any?)))

 (defn test-resolver
   "Test a resolver."
   ([{::keys [data-bank] :as env} {::p.connect/keys [sym] :as resolver}]
    (let [db      @data-bank
          in-data (discover-data env resolver)]
-     (if (some (fn [[_ v]] (= v ::unreachable)) in-data)
+     (print-trace env "discovered input" sym (pr-str in-data))
+     (if (some ::error (vals in-data))
        (log! env resolver {:in in-data :out ::unreachable})
        (if-let [input' (->> (input-list env resolver in-data)
                             (remove (get-in db [::call-history sym] {}))
@@ -176,15 +204,16 @@
   ([{::keys [data-bank] :as env}
     {::p.connect/keys [sym] :as resolver}
     input]
+   (print-trace env "call resolver" (pr-str sym) (pr-str input))
    (let [f (resolve sym)]
      (let [out (try
                  (some-> (f env input)
                          (dissoc ::p.connect/env))
                  (catch Throwable e
-                   e))]
+                   {::error e}))]
        (swap! data-bank update-in [::call-history sym] assoc input out)
        (log! env resolver {:in input :out out})
-       (if (map? out)
+       (if-not (::error out)
          (swap! data-bank bank-add out)))
      env)))


(maint) update catalog timestamp in untimed benchmark run

Without this change, resubmission of a catalog using the benchmark tool will
not reactivate a deactivated node.

--- src/puppetlabs/puppetdb/cli/benchmark.clj
+++ src/puppetlabs/puppetdb/cli/benchmark.clj
@@ -230,7 +230,7 @@
    similar to timed-update-host, but always sends the update (doesn't run/skip
    based on the clock)"
   [{:keys [host lastrun catalog report factset base-url run-interval rand-percentage] :as state}]
-  (let [catalog (some-> catalog (maybe-tweak-catalog rand-percentage))
+  (let [catalog (some-> catalog update-catalog (maybe-tweak-catalog rand-percentage))
         report (some-> report update-report-run-fields)
         factset (some-> factset (update-factset rand-percentage))]
     (when catalog (client/submit-catalog base-url 6 (json/generate-string catalog)))


Add password store

Add password store

--- modules/entrance/src/modular/entrance.clj
+++ modules/entrance/src/modular/entrance.clj
@@ -14,6 +14,8 @@

 (ns modular.entrance
   (:require
+   [clojure.java.io :as io]
+   [clojure.pprint :refer (pprint)]
    [bidi.bidi :as bidi :refer (path-for resolve-handler unresolve-handler ->WrapMiddleware)]
    [modular.bidi :as modbidi :refer (BidiRoutesContributor routes context)]
    [schema.core :as s]
@@ -22,6 +24,9 @@
    [hiccup.core :refer (html)]
    [com.stuartsierra.component :as component])
   (:import
+   java.security.SecureRandom
+   javax.crypto.SecretKeyFactory
+   javax.crypto.spec.PBEKeySpec
    (javax.xml.bind DatatypeConverter)))

 (defprotocol HttpRequestAuthorizer
@@ -39,6 +44,98 @@
 (extend-protocol UserPasswordAuthorizer
   Boolean
   (authorized-user? [this user password] this))
+
+(def PASSWORD_HASH_ALGO "PBKDF2WithHmacSHA1")
+
+(defn pbkdf2
+  "Get a hash for the given string and optional salt. From
+http://adambard.com/blog/3-wrong-ways-to-store-a-password/"
+  ([password salt]
+     (assert password "No password!")
+     (assert salt "No salt!")
+     (let [k (PBEKeySpec. (.toCharArray password) (.getBytes salt) 1000 192)
+           f (SecretKeyFactory/getInstance PASSWORD_HASH_ALGO)]
+       (format "%x"
+               (java.math.BigInteger. (.getEncoded (.generateSecret f k)))))))
+
+(defn make-salt
+  "Make a base64 string representing a salt. Pass in a SecureRandom."
+  [rng]
+  (let [ba (byte-array 32)]
+    (.nextBytes rng ba)
+    (javax.xml.bind.DatatypeConverter/printBase64Binary ba)))
+
+(defn create-hash [rng password]
+  (let [salt (make-salt rng)
+        hash (pbkdf2 password salt)]
+    {:salt salt
+     :hash hash}))
+
+(defn verify-password [password {:keys [hash salt]}]
+  (= (pbkdf2 password salt) hash))
+
+;; ----------------
+
+(defprotocol PasswordStore
+  ;; Returns a map of :hash and :salt
+  (get-hash-for-uid [_ uid])
+  (store-user-hash! [_ uid hash]))
+
+(defrecord PasswordFile [f]
+  component/Lifecycle
+  (start [this]
+    (assoc this
+      :ref (ref (if (.exists f) (read-string (slurp f)) {}))
+      :agent (agent f)))
+  (stop [this] this)
+  PasswordStore
+  (get-hash-for-uid [this uid] (get @(:ref this) uid))
+  (store-user-hash! [this uid hash]
+    (dosync
+     (alter (:ref this) assoc uid hash)
+     (send-off (:agent this) (fn [f]
+                               ;;(println "Writing passwords:" @(:ref this) "to" f)
+                               (spit f (with-out-str (pprint @(:ref this))))
+                               f))
+     (get @(:ref this) uid))))
+
+(defn new-password-file [f]
+  (assert (.exists (.getParentFile f))
+          (format "Please create the directory structure which should contain the password file: %s" f))
+  (->PasswordFile f))
+
+(defprotocol NewUserCreator
+  (add-user! [_ uid pw]))
+
+;; This implementation of a user domain provides a password storage
+;; facility based on PASSWORD_HASH_ALGO and a pluggable store for
+;; persistence
+
+(defrecord UserDomain []
+  component/Lifecycle
+  (start [this] (assoc this :rng (SecureRandom.)))
+  (stop [this] this)
+
+  UserPasswordAuthorizer
+  (authorized-user? [this uid pw]
+    (when-let [hash (get-hash-for-uid (:password-store this) uid)]
+      (verify-password pw hash)
+      ;; TODO There is a slight security concern here. If no uid is
+      ;; found, then the system will return slightly faster and this can
+      ;; be measured by an attacker to discover usernames. I don't know
+      ;; what the current advice is regarding this problem. I have
+      ;; consdiered priming the user store with a 'nobody' password to
+      ;; use.
+      ))
+
+  NewUserCreator
+  (add-user! [this uid pw]
+    (store-user-hash! (:password-store this) uid (create-hash (:rng this) pw))))
+
+(defn new-user-domain []
+  (component/using (->UserDomain) [:password-store]))
+
+;; -------

 (defprotocol FailedAuthorizationHandler
   (failed-authorization [_ request]))
@@ -285,11 +382,18 @@
   (context [this] (or
                    (first (keep #(when (satisfies? BidiRoutesContributor %) (context %))
                                 ((juxt :protector :user-password-authorizer :http-session-store) this)))
-                   "")))
+                   ""))
+  NewUserCreator
+  (add-user! [_ uid pw]
+    (if (satisfies? NewUserCreator user-password-authorizer)
+      (add-user! user-password-authorizer uid pw)
+      (throw (ex-info "This protection domain implementation does not support the creation of new users" {})))))

 (def new-default-protection-domain-schema
-  {(s/optional-key :session-timeout-in-seconds) s/Int
-   (s/optional-key :boilerplate) (s/=> 1)})
+  {:password-file s/Any
+   (s/optional-key :session-timeout-in-seconds) s/Int
+   (s/optional-key :boilerplate) (s/=> 1)
+   })

 (defn new-default-protection-domain [& {:as opts}]
   (s/validate new-default-protection-domain-schema opts)
@@ -297,7 +401,8 @@
    {:protector (if-let [boilerplate (:boilerplate opts)]
                  (new-login-form :boilerplate boilerplate)
                  (new-login-form))
-    :user-password-authorizer (new-map-backed-user-registry {"malcolm" "password"})
+    :user-password-authorizer (component/using (new-user-domain) [:password-store])
+    :password-store (new-password-file (:password-file opts))
     :http-session-store (new-atom-backed-session-store
                          (or (:session-timeout-in-seconds opts)
                              10))}))


Add IDs to all systems

Add IDs to all systems

--- src/glory_of_empires/systems.clj
+++ src/glory_of_empires/systems.clj
@@ -1,181 +1,172 @@
 (ns glory-of-empires.systems)

 (def all-systems
-  [ { :id :acheron :image "1planet/Tile-Acheron.gif" }
-    { :id :aeon :image "1planet/Tile-Aeon.gif" }
-    { :id :aker :image "1planet/Tile-Aker.gif" }
-    { :id :ammit :image "1planet/Tile-Ammit.gif" }
-    { :id :amun :image "1planet/Tile-Amun.gif" }
-    { :image "1planet/Tile-Andjety.gif" }
-    { :image "1planet/Tile-Anhur.gif" }
-    { :image "1planet/Tile-Ankh.gif" }
-    { :image "1planet/Tile-Anuket.gif" }
-    { :image "1planet/Tile-Apis.gif" }
-    { :image "1planet/Tile-Asgard.gif" }
-    { :image "1planet/Tile-Asgard_III.gif" }
-    { :image "1planet/Tile-Astennu.gif" }
-    { :image "1planet/Tile-Aten.gif" }
-    { :image "1planet/Tile-Babi.gif" }
-    { :image "1planet/Tile-Bakha.gif" }
-    { :image "1planet/Tile-Bast.gif" }
-    { :image "1planet/Tile-Beriyil.gif" }
-    { :image "1planet/Tile-Bes.gif" }
-    { :image "1planet/Tile-Capha.gif" }
-    { :image "1planet/Tile-Chensit.gif" }
-    { :image "1planet/Tile-Chnum.gif" }
-    { :image "1planet/Tile-Chuuka.gif" }
-    { :image "1planet/Tile-Cicerus.gif" }
-    { :image "1planet/Tile-Coruscant.gif" }
-    { :image "1planet/Tile-Dedun.gif" }
-    { :image "1planet/Tile-Deimo.gif" }
-    { :image "1planet/Tile-Discworld.gif" }
-    { :image "1planet/Tile-Dune.gif" }
-    { :image "1planet/Tile-Elnath.gif" }
-    { :image "1planet/Tile-Everra.gif" }
-    { :image "1planet/Tile-Faunus.gif" }
-    { :image "1planet/Tile-Fiorina.gif" }
-    { :image "1planet/Tile-FloydIV.gif" }
-    { :image "1planet/Tile-Garbozia.gif" }
-    { :image "1planet/Tile-Heimat.gif" }
-    { :image "1planet/Tile-Hopes_End.gif" }
-    { :image "1planet/Tile-Inaak.gif" }
-    { :image "1planet/Tile-Industrex.gif" }
-    { :image "1planet/Tile-Iskra.gif" }
-    { :image "1planet/Tile-Ithaki.gif" }
-    { :image "1planet/Tile-Kanite.gif" }
-    { :image "1planet/Tile-Kauket.gif" }
-    { :image "1planet/Tile-Kazenoeki.gif" }
-    { :image "1planet/Tile-Khepri.gif" }
-    { :image "1planet/Tile-Khnum.gif" }
-    { :image "1planet/Tile-Klendathu.gif" }
-    { :image "1planet/Tile-Kobol.gif" }
-    { :image "1planet/Tile-Laurin.gif" }
-    { :image "1planet/Tile-Lesab.gif" }
-    { :image "1planet/Tile-Lodor.gif" }
-    { :image "1planet/Tile-Lv426.gif" }
-    { :image "1planet/Tile-Medusa_V.gif" }
-    { :image "1planet/Tile-Mehar_Xull.gif" }
-    { :image "1planet/Tile-Mirage.gif" }
-    { :image "1planet/Tile-Myrkr.gif" }
-    { :image "1planet/Tile-Nanan.gif" }
-    { :image "1planet/Tile-Natthar.gif" }
-    { :image "1planet/Tile-Nef.gif" }
-    { :image "1planet/Tile-Nexus.gif" }
-    { :image "1planet/Tile-Niiwa-Sei.gif" }
-    { :image "1planet/Tile-Pakhet.gif" }
-    { :image "1planet/Tile-Parzifal.gif" }
-    { :image "1planet/Tile-Perimeter.gif" }
-    { :image "1planet/Tile-Petbe.gif" }
-    { :image "1planet/Tile-Primor.gif" }
-    { :image "1planet/Tile-Ptah.gif" }
-    { :image "1planet/Tile-Qetesh.gif" }
-    { :image "1planet/Tile-Quann.gif" }
-    { :image "1planet/Tile-Radon.gif" }
-    { :image "1planet/Tile-Saudor.gif" }
-    { :image "1planet/Tile-Sem-Lore.gif" }
-    { :image "1planet/Tile-Shai.gif" }
-    { :image "1planet/Tile-Shool.gif" }
-    { :image "1planet/Tile-Solitude.gif" }
-    { :image "1planet/Tile-Sulako.gif" }
-    { :image "1planet/Tile-Suuth.gif" }
-    { :image "1planet/Tile-Tarmann.gif" }
-    { :image "1planet/Tile-Tefnut.gif" }
-    { :image "1planet/Tile-Tempesta.gif" }
-    { :image "1planet/Tile-Tenenit.gif" }
-    { :image "1planet/Tile-Theom.gif" }
-    { :image "1planet/Tile-Thibah.gif" }
-    { :image "1planet/Tile-Ubuntu.gif" }
-    { :image "1planet/Tile-Vefut_II.gif" }
-    { :image "1planet/Tile-Wadjet.gif" }
-    { :image "1planet/Tile-Wellon.gif" }
-    { :image "1planet/Tile-Wepwawet.gif" }
-    { :image "2planet/Tile-Abyz-Fria.gif" }
-    { :image "2planet/Tile-Achill.gif" }
-    { :image "2planet/Tile-AeternaTammuz.gif" }
-    { :image "2planet/Tile-Arinam-Meer.gif" }
-    { :image "2planet/Tile-Arnor-Lor.gif" }
-    { :image "2planet/Tile-Aztlan-Senhora.gif" }
-    { :image "2planet/Tile-Bereg-Lirta_IV.gif" }
-    { :image "2planet/Tile-Bondar-MacLean.gif" }
-    { :image "2planet/Tile-Cato.gif" }
-    { :image "2planet/Tile-Centauri-Gral.gif" }
-    { :image "2planet/Tile-Coorneeq-Resculon.gif" }
-    { :image "2planet/Tile-Custos-Xhal.gif" }
-    { :image "2planet/Tile-Dal_Bootha-Xxehan.gif" }
-    { :image "2planet/Tile-Garneau-Hadfield.gif" }
-    { :image "2planet/Tile-Gilea-Xerel_Wu.gif" }
-    { :image "2planet/Tile-Gurmee-Uguza.gif" }
-    { :image "2planet/Tile-Hana.gif" }
-    { :image "2planet/Tile-Hercalor-Tiamat.gif" }
-    { :image "2planet/Tile-Kazaros-Mirabar.gif" }
-    { :image "2planet/Tile-Lazar-Sakulag.gif" }
-    { :image "2planet/Tile-Lisis-Velnor.gif" }
-    { :image "2planet/Tile-MachallSorkragh.gif" }
-    { :image "2planet/Tile-Masada-Jamiah.gif" }
-    { :image "2planet/Tile-Massada-Iuddaea.gif" }
-    { :image "2planet/Tile-Mellon-Zohbat.gif" }
-    { :image "2planet/Tile-Nadir-Lucus.gif" }
-    { :image "2planet/Tile-New_Albion-Starpoint.gif" }
-    { :image "2planet/Tile-Nummantia-Hisspania.gif" }
-    { :image "2planet/Tile-OthorAiel.gif" }
-    { :image "2planet/Tile-Pankow-Prenzlberg.gif" }
-    { :image "2planet/Tile-Perro-Senno.gif" }
-    { :image "2planet/Tile-Qucenn-Rarron.gif" }
-    { :image "2planet/Tile-Renenutet-Osiris.gif" }
-    { :image "2planet/Tile-Renpet-Tawaret.gif" }
-    { :image "2planet/Tile-Resheph-Ogdoad.gif" }
-    { :image "2planet/Tile-SalemIogu.gif" }
-    { :image "2planet/Tile-Shiva-Wishnu.gif" }
-    { :image "2planet/Tile-SullaMartinez.gif" }
-    { :image "2planet/Tile-Sumerian-Arcturus.gif" }
-    { :image "2planet/Tile-Temujin-Avanti.gif" }
-    { :image "2planet/Tile-Tequran-Torkan.gif" }
-    { :image "2planet/Tile-Thoth-Mafdet.gif" }
-    { :image "2planet/Tile-Tsion-Bellatrix.gif" }
-    { :image "2planet/Tile-Vega.gif" }
-    { :image "2planet/Tile-Verne-Quebec.gif" }
-    { :image "2planet/Tile-Vortekai-Deguzz.gif" }
-    { :image "Special/Tile-3-Ashtroth-Loki-Abaddon.gif" }
-    { :image "Special/Tile-3-Rigel.gif" }
-    { :image "Special/Tile-Ancient_Minefield.gif" }
-    { :image "Special/Tile-Ashtroth-Loki-Abaddon.gif" }
-    { :image "Special/Tile-Asteroid_Field.gif" }
-    { :image "Special/Tile-Asteroid_Field2.gif" }
-    { :image "Special/Tile-Asteroid_Nexus.gif" }
-    { :image "Special/Tile-Babylon_5.gif" }
-    { :image "Special/Tile-BlackHole.gif" }
-    { :image "Special/Tile-China.gif" }
-    { :image "Special/Tile-Citadel.gif" }
-    { :image "Special/Tile-Cormund.gif" }
-    { :image "Special/Tile-Elder-Card.gif" }
-    { :image "Special/Tile-Elder-Uhuru-Amani.gif" }
-    { :image "Special/Tile-Empty.gif" }
-    { :image "Special/Tile-Galactic_Storm.gif" }
-    { :image "Special/Tile-Gravity Rift.gif" }
-    { :image "Special/Tile-Gravity_Well.gif" }
-    { :image "Special/Tile-Gravity_rift.gif" }
-    { :image "Special/Tile-Ion_Storm.gif" }
-    { :image "Special/Tile-Ion_Storm2.gif" }
-    { :image "Special/Tile-Mecatol_Rex.gif" }
-    { :image "Special/Tile-Mecatol_Rex09.gif" }
-    { :image "Special/Tile-Muaat-Supernova.gif" }
-    { :image "Special/Tile-Nebula.gif" }
-    { :image "Special/Tile-Nebula_Nexus.gif" }
-    { :image "Special/Tile-OldMecatolRex.gif" }
-    { :image "Special/Tile-Orion2.gif" }
-    { :image "Special/Tile-Pulsar.gif" }
-    { :image "Special/Tile-Quantum_Singularity.gif" }
-    { :image "Special/Tile-Rigel.gif" }
-    { :image "Special/Tile-Summer_Palace.gif" }
-    { :image "Special/Tile-Supernova.gif" }
-    { :image "Special/Tile-Tianshang-Tiangu-Changtian.gif" }
-    { :image "Special/Tile-Wormhole_A.gif" }
-    { :image "Special/Tile-Wormhole_B.gif" }
+  [ { :id :acheron  :image "1planet/Tile-Acheron.gif" }
+    { :id :aeon     :image "1planet/Tile-Aeon.gif" }
+    { :id :aker     :image "1planet/Tile-Aker.gif" }
+    { :id :ammit    :image "1planet/Tile-Ammit.gif" }
+    { :id :amun     :image "1planet/Tile-Amun.gif" }
+    { :id :andjety  :image "1planet/Tile-Andjety.gif" }
+    { :id :anhur    :image "1planet/Tile-Anhur.gif" }
+    { :id :ankh     :image "1planet/Tile-Ankh.gif" }
+    { :id :anuket   :image "1planet/Tile-Anuket.gif" }
+    { :id :apis     :image "1planet/Tile-Apis.gif" }
+    { :id :asgard   :image "1planet/Tile-Asgard.gif" }
+    { :id :asgard3  :image "1planet/Tile-Asgard_III.gif" }
+    { :id :astennu  :image "1planet/Tile-Astennu.gif" }
+    { :id :aten :image "1planet/Tile-Aten.gif" }
+    { :id :babi :image "1planet/Tile-Babi.gif" }
+    { :id :bakha :image "1planet/Tile-Bakha.gif" }
+    { :id :bast :image "1planet/Tile-Bast.gif" }
+    { :id :beriyil :image "1planet/Tile-Beriyil.gif" }
+    { :id :bes :image "1planet/Tile-Bes.gif" }
+    { :id :capha :image "1planet/Tile-Capha.gif" }
+    { :id :chensit :image "1planet/Tile-Chensit.gif" }
+    { :id :chnum :image "1planet/Tile-Chnum.gif" }
+    { :id :chuuka :image "1planet/Tile-Chuuka.gif" }
+    { :id :cicerus :image "1planet/Tile-Cicerus.gif" }
+    { :id :coruscant :image "1planet/Tile-Coruscant.gif" }
+    { :id :dedun :image "1planet/Tile-Dedun.gif" }
+    { :id :deimo :image "1planet/Tile-Deimo.gif" }
+    { :id :discworld :image "1planet/Tile-Discworld.gif" }
+    { :id :dune :image "1planet/Tile-Dune.gif" }
+    { :id :elnath :image "1planet/Tile-Elnath.gif" }
+    { :id :everra :image "1planet/Tile-Everra.gif" }
+    { :id :faunus :image "1planet/Tile-Faunus.gif" }
+    { :id :fiorina :image "1planet/Tile-Fiorina.gif" }
+    { :id :floyd4 :image "1planet/Tile-FloydIV.gif" }
+    { :id :garbozia :image "1planet/Tile-Garbozia.gif" }
+    { :id :heimat :image "1planet/Tile-Heimat.gif" }
+    { :id :hopes-end :image "1planet/Tile-Hopes_End.gif" }
+    { :id :inaak :image "1planet/Tile-Inaak.gif" }
+    { :id :industrex :image "1planet/Tile-Industrex.gif" }
+    { :id :iskra :image "1planet/Tile-Iskra.gif" }
+    { :id :ithaki :image "1planet/Tile-Ithaki.gif" }
+    { :id :kanite :image "1planet/Tile-Kanite.gif" }
+    { :id :kauket :image "1planet/Tile-Kauket.gif" }
+    { :id :kazenoeki :image "1planet/Tile-Kazenoeki.gif" }
+    { :id :khepri :image "1planet/Tile-Khepri.gif" }
+    { :id :khnum :image "1planet/Tile-Khnum.gif" }
+    { :id :klendathu :image "1planet/Tile-Klendathu.gif" }
+    { :id :kobol :image "1planet/Tile-Kobol.gif" }
+    { :id :laurin :image "1planet/Tile-Laurin.gif" }
+    { :id :lesab :image "1planet/Tile-Lesab.gif" }
+    { :id :lodor :image "1planet/Tile-Lodor.gif" }
+    { :id :lv426 :image "1planet/Tile-Lv426.gif" }
+    { :id :medusa-v :image "1planet/Tile-Medusa_V.gif" }
+    { :id :mehar-xull :image "1planet/Tile-Mehar_Xull.gif" }
+    { :id :mirage :image "1planet/Tile-Mirage.gif" }
+    { :id :myrkr :image "1planet/Tile-Myrkr.gif" }
+    { :id :nanan :image "1planet/Tile-Nanan.gif" }
+    { :id :natthar :image "1planet/Tile-Natthar.gif" }
+    { :id :nef :image "1planet/Tile-Nef.gif" }
+    { :id :nexus :image "1planet/Tile-Nexus.gif" }
+    { :id :niiwa-sei :image "1planet/Tile-Niiwa-Sei.gif" }
+    { :id :pakhet :image "1planet/Tile-Pakhet.gif" }
+    { :id :parzifal :image "1planet/Tile-Parzifal.gif" }
+    { :id :perimeter :image "1planet/Tile-Perimeter.gif" }
+    { :id :petbe :image "1planet/Tile-Petbe.gif" }
+    { :id :primor :image "1planet/Tile-Primor.gif" }
+    { :id :ptah :image "1planet/Tile-Ptah.gif" }
+    { :id :qetesh :image "1planet/Tile-Qetesh.gif" }
+    { :id :quann :image "1planet/Tile-Quann.gif" }
+    { :id :radon :image "1planet/Tile-Radon.gif" }
+    { :id :saudor :image "1planet/Tile-Saudor.gif" }
+    { :id :sem-lore :image "1planet/Tile-Sem-Lore.gif" }
+    { :id :shai :image "1planet/Tile-Shai.gif" }
+    { :id :shool :image "1planet/Tile-Shool.gif" }
+    { :id :solitude :image "1planet/Tile-Solitude.gif" }
+    { :id :sulako :image "1planet/Tile-Sulako.gif" }
+    { :id :suuth :image "1planet/Tile-Suuth.gif" }
+    { :id :tarmann :image "1planet/Tile-Tarmann.gif" }
+    { :id :tefnut :image "1planet/Tile-Tefnut.gif" }
+    { :id :tempesta :image "1planet/Tile-Tempesta.gif" }
+    { :id :tenenit :image "1planet/Tile-Tenenit.gif" }
+    { :id :theom :image "1planet/Tile-Theom.gif" }
+    { :id :thibah :image "1planet/Tile-Thibah.gif" }
+    { :id :ubuntu :image "1planet/Tile-Ubuntu.gif" }
+    { :id :vefut2 :image "1planet/Tile-Vefut_II.gif" }
+    { :id :wadjet :image "1planet/Tile-Wadjet.gif" }
+    { :id :wellon :image "1planet/Tile-Wellon.gif" }
+    { :id :wepwawet :image "1planet/Tile-Wepwawet.gif" }
+    { :id :abyz-fria :image "2planet/Tile-Abyz-Fria.gif" }
+    { :id :achill :image "2planet/Tile-Achill.gif" }
+    { :id :aeterna-tammuz :image "2planet/Tile-AeternaTammuz.gif" }
+    { :id :arinam-meer :image "2planet/Tile-Arinam-Meer.gif" }
+    { :id :arnor-lor :image "2planet/Tile-Arnor-Lor.gif" }
+    { :id :aztlan-senhora :image "2planet/Tile-Aztlan-Senhora.gif" }
+    { :id :bereg-lirta4 :image "2planet/Tile-Bereg-Lirta_IV.gif" }
+    { :id :bondar-maclean :image "2planet/Tile-Bondar-MacLean.gif" }
+    { :id :cato :image "2planet/Tile-Cato.gif" }
+    { :id :centauri-gral :image "2planet/Tile-Centauri-Gral.gif" }
+    { :id :coorneeq-resculon :image "2planet/Tile-Coorneeq-Resculon.gif" }
+    { :id :custos-xhal :image "2planet/Tile-Custos-Xhal.gif" }
+    { :id :dal-bootha-xxehan :image "2planet/Tile-Dal_Bootha-Xxehan.gif" }
+    { :id :garneau-hadfield :image "2planet/Tile-Garneau-Hadfield.gif" }
+    { :id :gilea-xerel-wu :image "2planet/Tile-Gilea-Xerel_Wu.gif" }
+    { :id :gurmee-uguza :image "2planet/Tile-Gurmee-Uguza.gif" }
+    { :id :hana :image "2planet/Tile-Hana.gif" }
+    { :id :hercalor-tiamat :image "2planet/Tile-Hercalor-Tiamat.gif" }
+    { :id :kazaros-mirabar :image "2planet/Tile-Kazaros-Mirabar.gif" }
+    { :id :lazar-sakulag :image "2planet/Tile-Lazar-Sakulag.gif" }
+    { :id :lisis-velnor :image "2planet/Tile-Lisis-Velnor.gif" }
+    { :id :machall-sorkragh :image "2planet/Tile-MachallSorkragh.gif" }
+    { :id :masada-jamiah :image "2planet/Tile-Masada-Jamiah.gif" }
+    { :id :massada-iuddaea :image "2planet/Tile-Massada-Iuddaea.gif" }
+    { :id :mellon-zohbat :image "2planet/Tile-Mellon-Zohbat.gif" }
+    { :id :nadir-lucus :image "2planet/Tile-Nadir-Lucus.gif" }
+    { :id :new-albion-starpoint :image "2planet/Tile-New_Albion-Starpoint.gif" }
+    { :id :nummantia-hisspania :image "2planet/Tile-Nummantia-Hisspania.gif" }
+    { :id :othorAiel :image "2planet/Tile-OthorAiel.gif" }
+    { :id :pankow-prenzlberg :image "2planet/Tile-Pankow-Prenzlberg.gif" }
+    { :id :perro-senno :image "2planet/Tile-Perro-Senno.gif" }
+    { :id :qucenn-rarron :image "2planet/Tile-Qucenn-Rarron.gif" }
+    { :id :renenutet-osiris :image "2planet/Tile-Renenutet-Osiris.gif" }
+    { :id :renpet-tawaret :image "2planet/Tile-Renpet-Tawaret.gif" }
+    { :id :resheph-ogdoad :image "2planet/Tile-Resheph-Ogdoad.gif" }
+    { :id :salem-iogu :image "2planet/Tile-SalemIogu.gif" }
+    { :id :shiva-wishnu :image "2planet/Tile-Shiva-Wishnu.gif" }
+    { :id :sulla-martinez :image "2planet/Tile-SullaMartinez.gif" }
+    { :id :sumerian-arcturus :image "2planet/Tile-Sumerian-Arcturus.gif" }
+    { :id :temujin-avanti :image "2planet/Tile-Temujin-Avanti.gif" }
+    { :id :tequran-torkan :image "2planet/Tile-Tequran-Torkan.gif" }
+    { :id :thoth-mafdet :image "2planet/Tile-Thoth-Mafdet.gif" }
+    { :id :tsion-bellatrix :image "2planet/Tile-Tsion-Bellatrix.gif" }
+    { :id :vega :image "2planet/Tile-Vega.gif" }
+    { :id :verne-quebec :image "2planet/Tile-Verne-Quebec.gif" }
+    { :id :vortekai-deguzz :image "2planet/Tile-Vortekai-Deguzz.gif" }
+    { :id :ashtroth-loki-abaddon :image "3planet/Tile-Ashtroth-Loki-Abaddon.gif" }
+    { :id :rigel :image "3planet/Tile-Rigel.gif" }
+    { :id :elder-uhuru-amani :image "3planet/Tile-Elder-Uhuru-Amani.gif" }
+    { :id :tianshang-tiangu-changtian :image "3planet/Tile-Tianshang-Tiangu-Changtian.gif" }
+    { :id :ancient-minefield :image "Special/Tile-Ancient_Minefield.gif" }
+    { :id :asteroid-field :image "Special/Tile-Asteroid_Field.gif" }
+    { :id :babylon5 :image "Special/Tile-Babylon_5.gif" }
+    { :id :blackHole :image "Special/Tile-BlackHole.gif" }
+    { :id :citadel :image "Special/Tile-Citadel.gif" }
+    { :id :cormund :image "Special/Tile-Cormund.gif" }
+    { :id :empty :image "Special/Tile-Empty.gif" }
+    { :id :galactic-storm :image "Special/Tile-Galactic_Storm.gif" }
+    { :id :gravity-well :image "Special/Tile-Gravity_Well.gif" }
+    { :id :gravity-rift :image "Special/Tile-Gravity_rift.gif" }
+    { :id :ion-storm :image "Special/Tile-Ion_Storm.gif" }
+    { :id :mecatol-rex :image "Special/Tile-Mecatol_Rex.gif" }
+    { :id :mecatol-rex09 :image "Special/Tile-Mecatol_Rex09.gif" }
+    { :id :muaat-supernova :image "Special/Tile-Muaat-Supernova.gif" }
+    { :id :nebula :image "Special/Tile-Nebula.gif" }
+    { :id :old-mecatol-rex :image "Special/Tile-OldMecatolRex.gif" }
+    { :id :orion2 :image "Special/Tile-Orion2.gif" }
+    { :id :pulsar :image "Special/Tile-Pulsar.gif" }
+    { :id :quantum-singularity :image "Special/Tile-Quantum_Singularity.gif" }
+    { :id :summer-palace :image "Special/Tile-Summer_Palace.gif" }
+    { :id :Supernova :image "Special/Tile-Supernova.gif" }
+    { :id :wormhole-a :image "Special/Tile-Wormhole_A.gif" }
+    { :id :wormhole-b :image "Special/Tile-Wormhole_B.gif" }
     { :id :setup-dark-blue :image "Setup/Tile-Setup-DarkBlue.gif" }
-    { :image "Setup/Tile-Setup-LightBlue.gif" }
-    { :image "Setup/Tile-Setup-MediumBlue.gif" }
-    { :image "Setup/Tile-Setup-Red.gif" }
-    { :image "Setup/Tile-Setup-Yellow.gif" } ] )
+    { :id :setup-light-blue :image "Setup/Tile-Setup-LightBlue.gif" }
+    { :id :setup-medium-blue :image "Setup/Tile-Setup-MediumBlue.gif" }
+    { :id :setup-red :image "Setup/Tile-Setup-Red.gif" }
+    { :id :setup-yellow :image "Setup/Tile-Setup-Yellow.gif" } ] )

 ; TODO: make this hash-map instead (use index)
 (defn get-system [ id ]


Allow passing of infer option to statements on rdf4j repositories.

--- src/grafter/rdf4j/repository.clj
+++ src/grafter/rdf4j/repository.clj
@@ -649,12 +649,12 @@
 (extend-type RepositoryConnection

   pr/ITripleReadable
-  (pr/to-statements [this _]
+  (pr/to-statements [this {:keys [:grafter.repository/infer] :or {infer true}}]
     (let [f (fn next-item [i]
               (when (.hasNext i)
                 (let [v (.next i)]
                   (lazy-seq (cons (rio/backend-quad->grafter-quad v) (next-item i))))))]
-      (let [iter (.getStatements this nil nil nil true (into-array Resource []))]
+      (let [iter (.getStatements this nil nil nil infer (into-array Resource []))]
         (f iter)))))

 (defn shutdown


give a nicer URL if we are setting the S3 endpoint manually

--- src/hivewing_core/hive_image.clj
+++ src/hivewing_core/hive_image.clj
@@ -35,6 +35,7 @@
   (hive-image-package-image hive-uuid reference)
   (hive-image-package-url hive-uuid reference)
   (s3/get-resource-url hive-image-data-bucket "123.zip")
+  (s3/get-url hive-image-data-bucket "123.zip")
   (hive-images-sqs-queue)
   (hive-images-send-images-update-message hive-uuid)

@@ -196,7 +197,11 @@
 (defn hive-image-package-url
   [hive-uuid reference]
   (let [object-key (hive-image-package-key hive-uuid reference)]
-    (s3/get-resource-url hive-image-data-bucket object-key)))
+    (if (re-find #"^http" (:endpoint config/s3-aws-credentials))
+      ; We do this via some string munging b/c it's all confusing to the system
+      (str (:endpoint config/s3-aws-credentials) "/" hive-image-data-bucket "/" object-key)
+      ; We are in normal-land, so we do it via the s3 aws lib
+      (s3/get-resource-url hive-image-data-bucket object-key))))

 (defn hive-image-package-image