fixed comments

fixed comments

--- src/cljs/simlab/alfa.cljs
+++ src/cljs/simlab/alfa.cljs
@@ -4,33 +4,32 @@
    [quil.middleware :as m]))

 (defn setup []
-  ; Set frame rate to 30 frames per second.
+  ;; Set frame rate to 30 frames per second.
   (q/frame-rate 30)
-  ; Set color mode to HSB (HSV) instead of default RGB.
+  ;; Set color mode to HSB (HSV) instead of default RGB.
   (q/color-mode :hsb)
-  ; setup function returns initial state. It contains
-  ; circle color and position.
-  {:color 0
-   :angle 0})
+  ;; setup function returns initial state. It contains
+  ;; circle color and position.
+  {:x 100})

 (defn update-state [state]
-  ; Update sketch state by changing circle color and position.
+  ;; Update sketch state by changing circle color and position.
   {:color (mod (+ (:color state) 0.7) 255)
    :angle (+ (:angle state) 0.1)})

 (defn draw-state [state]
-  ; Clear the sketch by filling it with light-grey color.
+  ;; Clear the sketch by filling it with light-grey color.
   (q/background 240)
   ; Set circle color.
   (q/fill (:color state) 255 255)
-  ; Calculate x and y coordinates of the circle.
+  ;; Calculate x and y coordinates of the circle.
   (let [angle (:angle state)
         x (* 150 (q/cos angle))
         y (* 150 (q/sin angle))]
-    ; Move origin point to the center of the sketch.
+    ;; Move origin point to the center of the sketch.
     (q/with-translation [(/ (q/width) 2)
                          (/ (q/height) 2)]
-      ; Draw the circle.
+      ;; Draw the circle.
       (q/ellipse x y 100 100))))

 (q/defsketch simlab


implement search

implement search

--- src/cljs/traffic/app.cljs
+++ src/cljs/traffic/app.cljs
@@ -1,15 +1,25 @@
 (ns traffic.app
   (:require [traffic.storage :refer [fill-store empty-store get-stored]]
+            [clojure.string :refer [split]]
             [kioo.om :refer [content set-attr do-> substitute listen wrap]]
             [kioo.core :refer [handle-wrapper]]
             [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]
-            [cljs.reader :refer [read-string]])
+            [cljs.reader :refer [read-string]]
+            [clojure.set :refer [intersection]])
   (:require-macros [kioo.om :refer [defsnippet deftemplate]]))

 (declare main-page main-state detail-page)

 (def signmapname "traffic-signs")
+
+;;
+;; helper functions
+;;
+
+(defn get-tags [str]
+  (set (split (.toLowerCase str) #"\W+")))
+

 ;;
 ;; Exported functions
@@ -23,13 +33,21 @@

 (defn ^:export onDeviceReady []
-  (prompt "PhoneGap is working"
-          ))
+  (prompt "PhoneGap is working"))

 (defn  ^:export initialize []
   (fill-store signmapname)
   (.addEventListener js/document "deviceready" onDeviceReady true))
+
+(defn search [search-str]
+  (let [words (get-tags search-str)
+        signmap (read-string (get-stored signmapname))
+        results1 (filter #(not-empty (intersection words (get-tags (:kategorie %))))
+                         signmap)
+        results2 (filter #(not-empty (intersection words (get-tags (:bedeutung %))))
+                         signmap)]
+    (set (concat results1 results2))) )

 ;;
 ;; shortcuts for kioo templating
@@ -53,9 +71,8 @@

 (defn text-search-result-state [search-str] ;; dummy state
   (atom {:heading "Suche"
-         :topic (str "Ergebnisse für \"" search-str "\":")
-         :list (filter #(= "-" (:kategorie %))
-                       (read-string (get-stored signmapname)))}))
+         :topic (str "Ergebnisse für \"" search-str "\"")
+         :list (search search-str)}))

 (def photo-search-result-state ;; [photo];; dummy state
   (atom {:heading "Suche"


Moar.

Moar.

--- src/clojurecraft/core.clj
+++ src/clojurecraft/core.clj
@@ -24,6 +24,8 @@
   0x0F :playerblockplacement
   0x10 :holdingchange
   0x11 :usebed
+  0x12 :animation
+  0x13 :entityaction
 })
 (def packet-ids (apply assoc {} (mapcat reverse packet-types)))

@@ -177,6 +179,18 @@
   (-write-int conn x)
   (-write-byte conn y)
   (-write-int conn z))
+
+(defn write-packet-animation [conn {eid :eid animate :animate}]
+  (-write-byte conn (:animation packet-ids))
+
+  (-write-int conn eid)
+  (-write-byte conn animate))
+
+(defn write-packet-entityaction [conn {eid :eid action :action}]
+  (-write-byte conn (:entityaction packet-ids))
+
+  (-write-int conn eid)
+  (-write-byte conn action))

 ; Writing Wrappers -----------------------------------------------------------------
@@ -198,6 +212,8 @@
     (= packet-type :playerblockplacement) (write-packet-playerblockplacement conn payload)
     (= packet-type :holdingchange)        (write-packet-holdingchange conn payload)
     (= packet-type :usebed)               (write-packet-usebed conn payload)
+    (= packet-type :animation)            (write-packet-animation conn payload)
+    (= packet-type :entityaction)         (write-packet-entityaction conn payload)
     )
   (flushc conn))

@@ -326,6 +342,16 @@
     (assoc :x (-read-int conn))
     (assoc :y (-read-byte conn))
     (assoc :z (-read-int conn))))
+
+(defn read-packet-animate [conn]
+  (-> {}
+    (assoc :eid (-read-int conn))
+    (assoc :animate (-read-byte conn))))
+
+(defn read-packet-entityaction [conn]
+  (-> {}
+    (assoc :eid (-read-int conn))
+    (assoc :action (-read-byte conn))))

 ; Reading Wrappers -----------------------------------------------------------------
@@ -350,6 +376,8 @@
         (= packet-type :playerblockplacement) (read-packet-playerblockplacement conn)
         (= packet-type :holdingchange)        (read-packet-holdingchange conn)
         (= packet-type :usebed)               (read-packet-usebed conn)
+        (= packet-type :animate)              (read-packet-animate conn)
+        (= packet-type :entityaction)         (read-packet-entityaction conn)
         :else (str "UNKNOWN PACKET TYPE: " packet-id)
         ))
     (println "\n\n\n")))


Five tests: read-all-words, read-words-for-pattern, read-words-with-status, read-deleted-words, and read-active-words

--- test/zg/db_interface_test.clj
+++ test/zg/db_interface_test.clj
@@ -68,3 +68,33 @@
     (testing "if the zg.db-interface/undelete-word definition exists."
         (is (callable? 'zg.db-interface/undelete-word))))

+
+(deftest test-read-all-words-existence
+    "Check that the zg.db-interface/read-all-words definition exists."
+    (testing "if the zg.db-interface/read-all-words definition exists."
+        (is (callable? 'zg.db-interface/read-all-words))))
+
+
+(deftest test-read-words-for-pattern-existence
+    "Check that the zg.db-interface/read-words-for-pattern definition exists."
+    (testing "if the zg.db-interface/read-words-for-pattern definition exists."
+        (is (callable? 'zg.db-interface/read-words-for-pattern))))
+
+
+(deftest test-read-words-with-status-existence
+    "Check that the zg.db-interface/read-words-with-status definition exists."
+    (testing "if the zg.db-interface/read-words-with-status definition exists."
+        (is (callable? 'zg.db-interface/read-words-with-status))))
+
+
+(deftest test-read-deleted-words-existence
+    "Check that the zg.db-interface/read-deleted-words definition exists."
+    (testing "if the zg.db-interface/read-deleted-words definition exists."
+        (is (callable? 'zg.db-interface/read-deleted-words))))
+
+
+(deftest test-read-active-words-existence
+    "Check that the zg.db-interface/read-active-words definition exists."
+    (testing "if the zg.db-interface/read-active-words definition exists."
+        (is (callable? 'zg.db-interface/read-active-words))))
+


Update friends tests

Update friends tests

--- test/myshelf/test/db.clj
+++ test/myshelf/test/db.clj
@@ -14,20 +14,20 @@
                       :oauth_token_secret "gollyfluff"}]
     (insert-user user-id user-handle access-token)
     ;; insert a new friends list
-    (let [friends ["1337" "255"]]
+    (let [friends ["1337" "255"]
+          updated (update-friends user-id friends)]
       ;; should have returned the inserted data
-      (is (= {:user-id user-id
-              :friends friends}
-             (update-friends user-id friends)))
+      (is (= user-id (:user-id updated)))
+      (is (= friends (:friends updated)))
       ;; should be able to pull the friends back out
       (is (= friends
              (pull-friends user-id)))
       ;; update our friends list
-      (let [new-friends ["1337" "255" "13"]]
+      (let [new-friends ["1337" "255" "13"]
+            updated (update-friends user-id new-friends)]
         ;; should have gotten back the updated list
-        (is (= {:user-id user-id
-                :friends new-friends}
-               (update-friends user-id new-friends)))
+        (is (= user-id (:user-id updated)))
+        (is (= new-friends (:friends updated)))
         ;; should be able to fetch the updated list back out
         (is (= new-friends
                (pull-friends user-id)))))))


insights: refactor SVG history handling

insights: refactor SVG history handling

- Now all SVG related logic is in on place and easier to understand.

--- src-cljs/frontend/history.cljs
+++ src-cljs/frontend/history.cljs
@@ -82,57 +82,64 @@
       (and (.-platformModifierKey event)
            (.isButton event goog.events.BrowserEvent.MouseButton.LEFT))))

-(defn closest-tag [element tag]
+(defn closest-tag [element query-tag]
   "Handle SVG element properly."
   (let [dom-helper (goog.dom.DomHelper.)
-        tag (string/upper-case tag)
-        lower-tag (string/lower-case tag) ; SVG is case-sensitive
+        upper-query (string/upper-case query-tag)
+        lower-query (string/lower-case query-tag)
         ]
-    (or (when (= (.-tagName element) tag) element)
-        (.getAncestorByTagNameAndClass dom-helper element tag)
-        (when (= (instance? js/SVGElement element))
+    (or (when (= (.-tagName element) upper-query) element)
+        (.getAncestorByTagNameAndClass dom-helper element upper-query)
+        (when (instance? js/SVGElement element)
           (loop [e element]
-            (let [e-tag (.-tagName e)]
+            (let [e-tag (.-tagName e)]  ; SVG tags are case sensitive
               (condp = e-tag
-                lower-tag e
+                lower-query e
                 "svg" nil
                 (recur (.-parentElement e)))))))))

+(defn closest-a-tag-and-populate-properties [target]
+  "Find closest <a> ancestor of target and add some properties to it."
+  (let [a (closest-tag target "A")]
+    (cond (instance? js/SVGElement a)   ; SVG
+          (let [href (-> a (.-href) (.-baseVal))]
+            (hash-map :attr-href href
+                      :attr-target (-> a
+                                       (.-target)
+                                       (.-baseVal))
+                      :host-name (let [uri-info (goog.Uri.parse href)
+                                       domain (.getDomain uri-info)]
+                                   (if (empty? domain)
+                                     (.. js/window -location -hostname)
+                                     domain))))
+          (instance? js/HTMLElement a)                         ; HTML
+          (let [href (let [path (str (.-pathname a) (.-search a) (.-hash a))]
+                       (when-not (empty? path)
+                         path))]
+            (hash-map :attr-href href
+                      :attr-target (-> a .-target)
+                      :host-name (-> a .-hostname))))))
+
 (defn setup-link-dispatcher! [history-imp top-level-node]
-  (events/listen top-level-node "click"
-                 #(let [-target (.. % -target)
-                        target (closest-tag -target "A")
-                        location (when target
-                                   (or (let [path (str (.-pathname target) (.-search target) (.-hash target))]
-                                         (if-not (empty? path)
-                                           path))
-                                       ;; SVG
-                                       (-> target (.-href) (.-baseVal))))
-                        new-token (when (seq location) (subs location 1))
-                        attr-target (or (.-target target)
-                                        (-> target ; SVG
-                                            (.-target)
-                                            (.-baseVal)))
-                        host-name (or (.-hostname target)
-                                      (let [uri-info (goog.Uri.parse location) ; SVG
-                                            domain (.getDomain uri-info)]
-                                        (if (empty? domain)
-                                          (.. js/window -location -hostname)
-                                          domain)))]
-                    (when (and (seq location)
-                               (= (.. js/window -location -hostname)
-                                  host-name)
-                               (not (or (new-window-click? %) (= attr-target "_blank"))))
-                      (.preventDefault %)
-                      (if (and (route-fragment location)
-                               (path-matches? (.getToken history-imp) new-token))
+  (events/listen
+   top-level-node "click"
+     #(let [-target (.. % -target)
+            {:keys [attr-href attr-target host-name]} (closest-a-tag-and-populate-properties -target)
+            new-token (when (seq attr-href) (subs attr-href 1))]
+      (when (and (= (-> js/window .-location .-hostname)
+                    host-name)
+                 (not (or (new-window-click? %)
+                          (= attr-target "_blank"))))
+        (.preventDefault %)
+        (if (and (route-fragment attr-href)
+                 (path-matches? (.getToken history-imp) new-token))

-                        (do (utils/mlog "scrolling to hash for" location)
-                            ;; don't break the back button
-                            (.replaceToken history-imp new-token))
+          (do (utils/mlog "scrolling to hash for" attr-href)
+              ;; don't break the back button
+              (.replaceToken history-imp new-token))

-                        (do (utils/mlog "navigating to" location)
-                            (.setToken history-imp new-token)))))))
+          (do (utils/mlog "navigating to" attr-href)
+              (.setToken history-imp new-token)))))))

 (defn new-history-imp [top-level-node]
   ;; need a history element, or goog will overwrite the entire dom


Complete cards tests

Complete cards tests

--- test/skat/cards_test.clj
+++ test/skat/cards_test.clj
@@ -6,6 +6,9 @@
 (def c2 (skat.cards.Card. :kreuz :K))
 (def c3 (skat.cards.Card. :schell :W))
 (def c4 (skat.cards.Card. :schell :K))
+(def cards (list c1 c2 c3 c4))
+
+(defn same-elements? [coll1 coll2] (= (set coll1) (set coll2)))

 (deftest property-matches?-test
   (testing "checks Cards's property"
@@ -49,3 +52,48 @@
       (is (neg? (compare-for-sort-null c3 c2)))
       (is (pos? (compare-for-sort-null c2 c3))))))

+(deftest filter-cards-test
+  (testing "filters by property"
+    (is (same-elements?
+          (filter-cards :color :kreuz cards)
+          (list c1 c2)))
+    (is (same-elements?
+          (filter-cards :figure :W cards)
+          (list c1 c3)))))
+
+(deftest filter-color-test
+  (testing "filters by color"
+    (is (same-elements?
+          (filter-color :kreuz cards)
+          (list c1 c2)))))
+
+(deftest filter-figure-test
+  (testing "filters by figure"
+    (is (same-elements?
+          (filter-figure :W cards)
+          (list c1 c3)))))
+
+(deftest deck-test
+  (testing "deck contains one piece of each card"
+    (let [deck-set (set deck)]
+      (is (== 32 (count deck-set)))
+      (is (== 8 (count (filter #(= (:color %) :kreuz) deck-set))))
+      (is (== 8 (count (filter #(= (:color %) :grun) deck-set))))
+      (is (== 8 (count (filter #(= (:color %) :herz) deck-set))))
+      (is (== 8 (count (filter #(= (:color %) :schell) deck-set))))
+      (is (== 4 (count (filter #(= (:figure %) :7) deck-set))))
+      (is (== 4 (count (filter #(= (:figure %) :8) deck-set))))
+      (is (== 4 (count (filter #(= (:figure %) :9) deck-set))))
+      (is (== 4 (count (filter #(= (:figure %) :10) deck-set))))
+      (is (== 4 (count (filter #(= (:figure %) :W) deck-set))))
+      (is (== 4 (count (filter #(= (:figure %) :Q) deck-set))))
+      (is (== 4 (count (filter #(= (:figure %) :K) deck-set))))
+      (is (== 4 (count (filter #(= (:figure %) :A) deck-set)))))))
+
+(deftest deal-cards-test
+  (testing "deal cards correctly"
+    (let [deal (deal-cards)]
+      (is (== 10 (count (:front deal))))
+      (is (== 10 (count (:middle deal))))
+      (is (== 10 (count (:rear deal))))
+      (is (== 2 (count (:skat deal)))))))


CMR-1297 Add basic support for Atom collections on concept routes

--- search-app/src/cmr/search/api/routes.clj
+++ search-app/src/cmr/search/api/routes.clj
@@ -87,6 +87,8 @@
   #{"*/*"
     "application/xml" ; allows retrieving native format
     "application/metadata+xml" ; retrieve in native format
+    "application/atom+xml"
+    "application/json"
     "application/echo10+xml"
     "application/iso19115+xml"
     "application/iso:smap+xml"
@@ -203,15 +205,15 @@
         results (query-svc/find-concepts-by-aql context params aql)]
     (search-response params results)))

-(defn- find-concept-by-cmr-concept-id
-  "Invokes query service to find concept metadata by cmr concept id and returns the response"
-  [context path-w-extension params headers]
-  (let [result-format (get-search-results-format path-w-extension headers
-                                                 supported-concept-id-retrieval-mime-types
-                                                 "application/xml")
-        concept-id (path-w-extension->concept-id path-w-extension)
-        _ (info (format "Search for concept with cmr-concept-id [%s]" concept-id))
-        concept (query-svc/find-concept-by-id context result-format concept-id)
+(defn- get-feed-concept-by-id
+  "Returns search results for a concept id"
+  [context params result-format concept-id]
+  (search-response params (query-svc/find-concepts-by-parameters context :collection {:result-format result-format
+                                                                                :concept-id concept-id})))
+
+(defn- get-transformed-concept-by-id
+  [context params headers result-format concept-id]
+  (let [concept (query-svc/find-concept-by-id context result-format concept-id)
         {:keys [metadata]} concept
         body (if (api/pretty-request? params headers)
                (cx/pretty-print-xml metadata)
@@ -220,6 +222,18 @@
      :headers {CONTENT_TYPE_HEADER (str (:format concept) "; charset=utf-8")
                CORS_ORIGIN_HEADER "*"}
      :body body}))
+
+(defn- find-concept-by-cmr-concept-id
+  "Invokes query service to find concept metadata by cmr concept id and returns the response"
+  [context path-w-extension params headers]
+  (let [result-format (get-search-results-format path-w-extension headers
+                                                 supported-concept-id-retrieval-mime-types
+                                                 "application/xml")
+        concept-id (path-w-extension->concept-id path-w-extension)
+        _ (info (format "Search for concept with cmr-concept-id [%s]" concept-id))]
+    (if (contains? #{:atom :json} result-format)
+      (get-feed-concept-by-id context params result-format concept-id)
+      (get-transformed-concept-by-id context params headers result-format concept-id))))

 (defn- get-provider-holdings
   "Invokes query service to retrieve provider holdings and returns the response"


Fix a wee little bug; format some.

Fix a wee little bug; format some.

--- src/doctopus/doctopus.clj
+++ src/doctopus/doctopus.clj
@@ -40,6 +40,10 @@
     ;; great question! The answer is: we need to make sure that what's returned
     ;; is a map from the key "/" to a map of the form {tentacle-name
     ;; tentacle-routes}. This is not the prettiest, but it does just that.
-    {"/" (apply merge (flatten (into [] (for [head (:heads this)
-                                              :let [route-map (h/load-tentacle-routes head (:substitutions this))]]
-                                          [route-map]))))}))
+    {"/" (apply merge
+                (flatten
+                 (into []
+                       (for [head (list-heads this)
+                             :let [route-map (h/load-tentacle-routes head
+                                                                     (:substitutions this))]]
+                         [route-map]))))}))


Unshadow clojure.core/name to get tests passing again.

--- src/leiningen/compile.clj
+++ src/leiningen/compile.clj
@@ -151,9 +151,9 @@
       (pr-str (pr-str form))
       (prn-str form))))

-(defn- add-system-property [java name value]
+(defn- add-system-property [java key value]
   (.addSysproperty java (doto (Environment$Variable.)
-                          (.setKey (name name))
+                          (.setKey (name key))
                           (.setValue (name value)))))

 ;; TODO: split this function up


Revert scroll change in demo

Revert scroll change in demo

--- demo/reagentdemo/page.cljs
+++ demo/reagentdemo/page.cljs
@@ -77,7 +77,7 @@
                         (.preventDefault e)
                         (reset! page href)
                         (reagent/next-tick
-                         #(set! (.-scrollTop (.-documentElement js/document))
+                         #(set! (.-scrollTop (.-body js/document))
                                 0)))
                       identity))
      child]))


Fix missing default argument

Fix missing default argument

--- ring-core/src/ring/middleware/session.clj
+++ ring-core/src/ring/middleware/session.clj
@@ -34,7 +34,7 @@
   See: wrap-session."
   {:added "1.2"}
   ([request]
-   (session-request request))
+   (session-request request {}))
   ([request options]
    (-> request
        cookies/cookies-request


Minor change to mention Dana

Minor change to mention Dana

--- scrape-n-mail/src/scrape_n_mail/core.cljs
+++ scrape-n-mail/src/scrape_n_mail/core.cljs
@@ -187,10 +187,10 @@
                   ; We currently assume all visible data is "current"
                   ; (filter #(s/includes? (aget % 0) "2017"))
                   ; Each line is a list, this joins them in to one string
-                  ; (map #(vector :li (::held-name-altar %)) name-records))
                   (map #(vector :li (prefilled-link %)) name-records))

                 "New names may be submitted at "
+
                 [:a {:href "https://docs.google.com/forms/d/e/1FAIpQLSc_FFrH7a_ClDmpAq36vA7gdUd1njmoEK0wfhRNaYcjfLox0w/viewform"}
                 "this link"] ". If the above links don't work, you can copy-paste the form link into your browser:"]

@@ -199,6 +199,8 @@
                [:p "Please recall that it is traditional to offer Dana along with the submission of names."]

                [:p "If we do not hear from you, we will remove these names from the altar. Jai mitra!"]
+
+               [:p "As a reminder, it is customary to contribute Dana along with the submission of names." ]

                ; Note that the \ is an escape character!
                [:p "/|\\"]


Detect natural-scrolling on osx

Detect natural-scrolling on osx

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -56,7 +56,10 @@
                                                 (.preventDefault event)
                                                 (.stopPropagation event)
                                                 (let [dx     (- (aget event "deltaX"))
-                                                      dy     (- (aget event "deltaY"))]
+                                                      dy     (if (aget event "nativeEvent" "webkitDirectionInvertedFromDevice")
+                                                               ;; Detect inverted scroll (natural scroll)
+                                                               (aget event "deltaY")
+                                                               (- (aget event "deltaY")))]
                                                   (om/transact! payload (fn [state]
                                                                           (let [camera (cameras/camera state)
                                                                                mode   (cameras/camera-mouse-mode state)]


give in-progress text higher opacity

give in-progress text higher opacity

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -212,7 +212,7 @@
         (apply dom/g nil (mapv (fn [l] (svg-element #{} (merge l {:strokeDasharray "5,5"
                                                                   :layer/fill "none"
                                                                   :style {:stroke (:subscriber-color l)}
-                                                                  :fillOpacity "0.25"}
+                                                                  :fillOpacity "0.5"}
                                                                (when (= :layer.type/text (:layer/type l))
                                                                  {:layer/stroke "none"
                                                                   :style {:fill (:subscriber-color l)}}))))


Added stuartsierra/component dependency to the project.

--- app/project.clj
+++ app/project.clj
@@ -3,7 +3,8 @@
   :url "http://example.com/FIXME"
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
-  :dependencies [[org.clojure/clojure "1.6.0"]]
+  :dependencies [[org.clojure/clojure "1.6.0"]
+                 [com.stuartsierra/component "0.2.3"]]
   :main ^:skip-aot clj-web-example.main
   :target-path "target/%s"
   :profiles {:uberjar {:aot :all}})


Throw conditions instead of Java exceptions.

--- src/active/clojure/record.cljc
+++ src/active/clojure/record.cljc
@@ -3,11 +3,17 @@
   (:clj
    [(:require
      [active.clojure.lens :as lens]
+     [active.clojure.condition :as c]
      [active.clojure.macro :refer [if-cljs]])]
    :cljs
    [(:require
      [active.clojure.lens :as lens]
+     [active.clojure.condition :as c])
     (:require-macros [active.clojure.macro :refer [if-cljs]])]))
+
+(defn throw-illegal-argument-exception
+  [msg]
+  (c/assertion-violation `throw-illegal-argument-exception "Illegal argument" msg))

 ;; Only needed in ClojureScript, does nothing in Clojure
 (defn check-type
@@ -53,13 +59,13 @@
   [?type ?constructor-call ?predicate ?field-specs & ?opt+specs]
   (when-not (and (list? ?constructor-call)
                  (not (empty? ?constructor-call)))
-    (throw (IllegalArgumentException. (str "constructor call must be a list in " *ns* " " (meta &form)))))
+    (throw (throw-illegal-argument-exception (str "constructor call must be a list in " *ns* " " (meta &form)))))
   (when-not (vector? ?field-specs)
-    (throw (IllegalArgumentException. (str "field specs must be a vector in " *ns* " " (meta &form)))))
+    (throw (throw-illegal-argument-exception (str "field specs must be a vector in " *ns* " " (meta &form)))))
   (when-not (even? (count (remove seq? ?field-specs)))
-    (throw (IllegalArgumentException. (str "odd number of elements in field specs in " *ns* " " (meta &form)))))
+    (throw (throw-illegal-argument-exception (str "odd number of elements in field specs in " *ns* " " (meta &form)))))
   (when-not (every? true? (map #(= 3 (count %1)) (filter seq? ?field-specs)))
-    (throw (IllegalArgumentException. (str "wrong number of elements in field specs with lens in " *ns* " " (meta &form)))))
+    (throw (throw-illegal-argument-exception (str "wrong number of elements in field specs with lens in " *ns* " " (meta &form)))))

   (let [?field-triples (loop [specs (seq ?field-specs)
                               triples '()]
@@ -72,20 +78,20 @@
                               (do
                                 (when-not (and (= 3 (count spec))
                                                (every? symbol spec))
-                                  (IllegalArgumentException. (str "invalid field spec " spec " in " *ns* " " (meta &form))))
+                                  (throw-illegal-argument-exception (str "invalid field spec " spec " in " *ns* " " (meta &form))))
                                 (recur (rest specs) (list* spec triples)))

                               (symbol? spec)
                               (do
                                 (when (empty? (rest specs))
-                                  (throw (IllegalArgumentException. (str "incomplete field spec for " spec " in " *ns* " " (meta &form)))))
+                                  (throw (throw-illegal-argument-exception (str "incomplete field spec for " spec " in " *ns* " " (meta &form)))))
                                 (when-not (symbol? (fnext specs))
-                                  (throw (IllegalArgumentException. (str "invalid accessor " (fnext specs) " for " spec " in " *ns* " " (meta &form)))))
+                                  (throw (throw-illegal-argument-exception (str "invalid accessor " (fnext specs) " for " spec " in " *ns* " " (meta &form)))))
                                 (recur (nnext specs)
                                        (list* [spec (fnext specs) nil] triples)))

                               :else
-                              (throw (IllegalArgumentException. (str "invalid field spec " spec " in " *ns* " " (meta &form))))))))
+                              (throw (throw-illegal-argument-exception (str "invalid field spec " spec " in " *ns* " " (meta &form))))))))

         ?constructor (first ?constructor-call)
         ?constructor-args (rest ?constructor-call)
@@ -120,7 +126,7 @@
     (let [?field-names-set (set ?field-names)]
       (doseq [?constructor-arg ?constructor-args]
         (when-not (contains? ?field-names-set ?constructor-arg)
-          (throw (IllegalArgumentException. (str "constructor argument " ?constructor-arg " is not a field in " *ns* " " (meta &form)))))))
+          (throw (throw-illegal-argument-exception (str "constructor argument " ?constructor-arg " is not a field in " *ns* " " (meta &form)))))))

     `(do
        (defrecord ~?type


(MAINT) Get rid of explicit compojure references

Now that comidi has a `wrap-routes` fn, we no longer need to
mix in explicit calls to compojure.

--- src/puppetlabs/trapperkeeper/services/status/status_core.clj
+++ src/puppetlabs/trapperkeeper/services/status/status_core.clj
@@ -4,7 +4,6 @@
             [schema.utils :refer [validation-error-explain]]
             [ring.middleware.defaults :as ring-defaults]
             [slingshot.slingshot :refer [throw+]]
-            [compojure.core :as compojure]
             [puppetlabs.comidi :as comidi]
             [puppetlabs.kitchensink.core :as ks]
             [puppetlabs.trapperkeeper.services.status.ringutils :as ringutils]
@@ -396,24 +395,24 @@
               :message (str "No status information found for service "
                             service-name)})))))

-(schema/defn ^:always-validate wrap-errors-by-type
-  [handler t :- ringutils/ResponseType]
-  (-> handler
-      (ringutils/wrap-request-data-errors t)
-      (ringutils/wrap-schema-errors t)
-      (ringutils/wrap-errors t)))
+(schema/defn ^:always-validate errors-by-type-middleware
+  [t :- ringutils/ResponseType]
+  (fn [handler]
+    (-> handler
+        (ringutils/wrap-request-data-errors t)
+        (ringutils/wrap-schema-errors t)
+        (ringutils/wrap-errors t))))

 (defn build-handler [path status-fns]
-  (-> (compojure/context path []
-        (compojure/context "/v1" []
-          (compojure/routes
-            (-> (build-json-routes "/services" status-fns)
-                comidi/routes->handler
-                (wrap-errors-by-type :json))
-            (-> (build-plaintext-routes "/simple" status-fns)
-                comidi/routes->handler
-                (wrap-errors-by-type :plain)))))
-      (ring-defaults/wrap-defaults ring-defaults/api-defaults)))
+  (comidi/routes->handler
+   (comidi/wrap-routes
+    (comidi/context path
+      (comidi/context "/v1"
+        (-> (build-json-routes "/services" status-fns)
+            (comidi/wrap-routes (errors-by-type-middleware :json)))
+        (-> (build-plaintext-routes "/simple" status-fns)
+            (comidi/wrap-routes (errors-by-type-middleware :plain)))))
+    #(ring-defaults/wrap-defaults % ring-defaults/api-defaults))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Status Service Status


[#28] Trim after slurping a secrets file

--- api/src/clojure/org/akvo/flow_api/main.clj
+++ api/src/clojure/org/akvo/flow_api/main.clj
@@ -18,7 +18,9 @@
   containing secret files"
   [secret-key]
   (let [mount-path (ensure-trailing-slash (:secrets-mount-path env))]
-    (slurp (format "%s%s" secret-key))))
+    (-> (format "%s%s" secret-key)
+        slurp
+        str/trim)))

 (defn -main [& args]
   (let [bindings {'http-port (Integer/parseInt (:port env "3000"))


Add test for calculating savings and expenses with savings

--- test/cljs/my_money/calculations_test.cljs
+++ test/cljs/my_money/calculations_test.cljs
@@ -13,12 +13,24 @@
   (is (= -1 (calc/expenses [{:amount 300}
                             {:amount -100}
                             {:amount 150}
-                            {:amount 150}]))))
+                            {:amount 150}] #{}))))
 (deftest test-income
   (is (= 6 (calc/income [{:amount 300}
                          {:amount -100}
                          {:amount 150}
                          {:amount 150}]))))
+
+(deftest test-savings
+  (is (= 1 (calc/savings [{:amount 300}
+                          {:amount -100 :recipient "Savings account"}
+                          {:amount 150}
+                          {:amount 150}] #{"Savings account"}))))
+
+(deftest test-expenses-with-savings
+  (is (= -3 (calc/expenses [{:amount -300}
+                            {:amount -100 :recipient "Savings account"}
+                            {:amount 150}
+                            {:amount 150}] #{"Savings account"}))))

 (deftest test-sum-til-date
   (let [events [{:amount 300 :transaction_date (js/Date. 2016 8 1)}


There was already a way to connect nodes.

--- src/asid/wallet/repository.clj
+++ src/asid/wallet/repository.clj
@@ -1,8 +1,7 @@
 (ns asid.wallet.repository
   (:use [asid.error.thread :only [fail->]])

-  (:require [clojurewerkz.neocons.rest.relationships :as nrl]
-            [asid.nodes :as an]
+  (:require [asid.nodes :as an]
             [asid.error.definition :as ed])

   (:import [asid.wallet Wallet]))
@@ -33,7 +32,7 @@
                                     (an/create-node {:identity (:identity wallet)}))]
       (doseq [data [:bag :signatures :key]]
         (an/attach-to-node wallet data (get wallet data)))
-      (nrl/create (:root ctxt) (:node-id wallet) :wallet)
+      (an/connect-nodes ctxt wallet :wallet)
       wallet)))

 (defn get-wallet [id ctxt]


Add constructors to match

Add constructors to match

--- src/aurora/compiler/match.cljs
+++ src/aurora/compiler/match.cljs
@@ -25,6 +25,7 @@
 (deftraced data->jsth [pattern] [pattern]
   (cond
    (or (number? pattern) (string? pattern)) pattern
+   (symbol? pattern) pattern ;; passed from inputs
    (keyword? pattern) `(new (cljs.core.Keyword ~(namespace pattern) ~(name pattern) ~(str (namespace pattern) (if (namespace pattern) "/" "") (name pattern)) ~(hash pattern)))
    (vector? pattern) `(cljs.core.PersistentVector.fromArray
                        ~(vec (map data->jsth pattern))
@@ -68,6 +69,10 @@
         failure `(return nil)]
     (js/Function (jsth/munge input-sym) (jsth/statement->string `(do ~success ~failure)))))

+(defn constructor [constructor inputs]
+  (let [body (data->jsth constructor)]
+    (apply js/Function (conj (vec (map jsth/munge inputs)) (jsth/statement->string `(return ~body))))))
+
 (comment
   (match :a :a :ok)

@@ -90,4 +95,14 @@
   (match {:a 0 :b [1 2]}
          {:c _} :bad
          ^z {:b [x y]} [x y z])
+
+  ((constructor 1 []))
+
+  ((constructor "foo" []))
+
+  ((constructor 'a '[a]) :ok)
+
+  ((constructor '[a a] '[a]) :ok)
+
+  ((constructor '{:a a :b b} '[a b]) :A :B)
   )


whitespace

whitespace

--- src/babel/english/grammar.cljc
+++ src/babel/english/grammar.cljc
@@ -36,9 +36,7 @@
    [:synsem :sem :pred]
    [:synsem :sem :human]])

-(defn apply-default-if [tree
-                        test
-                        to-apply]
+(defn apply-default-if [tree test to-apply]
   (if (test tree)
     (apply-default tree to-apply)
     tree))


simplify and normalize "tall"

simplify and normalize "tall"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1697,19 +1697,13 @@
                    :subj {:human true}}}}

    "tall"
-   [;; non-comparative:
-    (let [subject-sem (atom {:human true}) ;; only humans can be tall.
-          subject-agr (atom :top)]
-      (unify adjective
-             {:synsem {:cat :adjective
-                       :sem {:mod {:pred :alto}
-                             :comparative false
-                             :arg1 subject-sem
-                             :human true}
-                       :subcat {:1 {:cat :det
-                                    :agr subject-agr
-                                    :sem subject-sem}
-                                :2 '()}}}))]
+   (unify adjective
+          {:synsem {:cat :adjective
+                    :sem {:mod {:pred :tall}
+                          :human true
+                          :comparative false}
+                    :subcat {:1 {:cat :det}
+                             :2 '()}}})
    "short"
    [;; non-comparative:
     (unify adjective


make "complain" semantically reflexive

make "complain" semantically reflexive

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -511,7 +511,8 @@
                                     :sem {:pred :to}}}}}

    "complain" {:synsem {:cat :verb
-                        :sem {:pred :complain}}}
+                        :sem {:reflexive true
+                              :pred :complain}}}

    "consent" {:synsem {:cat :verb
                        :sem {:pred :consent}


use lexiconfn/unify rather than dag-unify.core/unifyc so we can fail fast

--- src/babel/italiano/lexicon.clj
+++ src/babel/italiano/lexicon.clj
@@ -4,7 +4,7 @@
    [babel.lexiconfn :refer [compile-lex map-function-on-map-vals unify]]
    [babel.italiano.morphology :as morph]
    [babel.italiano.pos :refer :all]
-   [dag-unify.core :refer [get-in merge unifyc]]))
+   [dag-unify.core :refer [fail? get-in merge]]))

 (def lexicon-source
   {"Antonia"
@@ -1997,7 +1997,7 @@
                                               (= (get-in val [:synsem :aux] false)
                                                  false)
                                               (= :none (get-in val [:synsem :sem :reflexive] :none)))
-                                         (unifyc val {:synsem {:sem {:reflexive false}}})
+                                         (unify val {:synsem {:sem {:reflexive false}}})
                                          true
                                          val))
                                  vals)))


Fix wrong tag in wpml/graphic

Fix wrong tag in wpml/graphic

--- src/bakyeono/litedocx/wpml.clj
+++ src/bakyeono/litedocx/wpml.clj
@@ -691,7 +691,7 @@
                                 ;; Offset
                                 (node :a:off {:x 0 :y 0})
                                 ;; Extents
-                                (node :ext {:cx width :cy height}))
+                                (node :a:ext {:cx width :cy height}))
                           ;; Preset Geometry
                           (node :a:prstGeom {:prst "rect"} ; Preset Shape
                                 ;; List of Shape Adjust Values


Add w:wordWrap attribute support in paragraph style

--- src/bakyeono/litedocx/wpml.clj
+++ src/bakyeono/litedocx/wpml.clj
@@ -296,12 +296,16 @@
 (defn- ppr
   "Creates w:pPr tag node. Called by paragaph-style."
   [{:as options
-    :keys [align
+    :keys [word-wrap?
+           align
            space-before space-after space-line
            indent-left indent-right indent-first-line
            mirror-indents?]}]
   ;; Paragraph Properties
   (node :w:pPr {}
+        (when (word-wrap?)
+          ;; Allow Line Breaking at Character Level
+          (node :w:wordWrap {:w:val true}))
         (when (or space-before space-after space-line)
           ;; Spacing Between Lines and Above/Below Paragraph
           (node :w:spacing (make-attrs :w:before space-before ; Spacing Above Paragraph
@@ -370,6 +374,7 @@
    & {:as options
       :keys [font font-size font-color
              bold? italics? underline? strike?
+             word-wrap?
              align
              space-before space-after space-line
              indent-left indent-right indent-first-line mirror-indents?]}]
@@ -383,7 +388,7 @@
            (when font
              (node :w:link {:w:val font-style-name})) ; Linked Style Reference
            (node :w:qFormat) ; Primary Style
-           (when (or align
+           (when (or word-wrap? align
                      space-before space-after space-line
                      indent-left indent-right indent-first-line mirror-indents?)
              (ppr options))


Fixed wrong working directory arg.

Fixed wrong working directory arg.

--- src/fm/simrunner/main.clj
+++ src/fm/simrunner/main.clj
@@ -11,7 +11,8 @@
     (java.io File)))

 (defn run [& {:keys [stand-alone? working-directory] :or {stand-alone? false}}]
-  (let [working-directory (-> (or ".")
+  (let [working-directory (-> working-directory
+                              (or ".")
                               File.
                               .getAbsolutePath)]
     (app/start {:working-directory working-directory


Add options to asplan

Add options to asplan

--- src/angelic/search/action_set/asplan.clj
+++ src/angelic/search/action_set/asplan.clj
@@ -14,6 +14,8 @@
 ;; Fixed version.

 ; For now, pretend analysis is free, just brute-force it.
+
+; Modes:

 ; Put stuff previous in HLAs into state, so we can keep track of, e.g.,
 ; actions added while accomplishing some other action.
@@ -120,6 +122,7 @@
                    (for [v precond-vars] [(action-var v) nil])))
      0)))

+;; TODO: should fail if I own parent, it has right value, but an action. (right now, we assert)...

 ;; Try to make an action that greedily fires the action scheduled on effect-var,
 ;; effectively representing a composition of set-parent and fire-action actions.
@@ -127,54 +130,53 @@
 ;; Assumes this will always be called on a "source", and asserts correspondingly.
 (defn make-greedy-fire-action [s effect-var]
   (let [{:keys [name precond-map effect-map reward] :as factored-primitive}
-          (->> effect-var action-var (state/get-var s))
+        (->> effect-var action-var (state/get-var s))
         precond-vars (keys (dissoc precond-map effect-var))
         [free-pv unfree-pv] (util/separate #(state/get-var s (free-var %)) precond-vars)]
     (assert (every? #(contains? #{nil :frozen} (state/get-var s (action-var %))) precond-vars))
-    (assert (every? #(contains? #{nil :frozen} (state/get-var s (action-var %))) unfree-pv))
-    (doto (env-util/make-factored-primitive
-           [::GreedyFire name]
-           (into precond-map
-                 (concat [[(action-var effect-var) factored-primitive]]
-                         (for [v free-pv]   [(free-var v)              true])
-                         (for [v unfree-pv] [(parent-var v effect-var) true])
-                         (for [v precond-vars] [(action-var v) (state/get-var s (action-var v))])))
-           (into effect-map
-                 (concat [[(action-var effect-var) nil]]
-                         (for [v unfree-pv] [(free-var v)              true])
-                         (for [v unfree-pv] [(parent-var v effect-var) false])
-                         (for [v precond-vars] [(action-var v) nil])))
-           0)
-      (-> (env/applicable? s) assert))))
-
-
-;; TODO: sloppy (var can be reserved for someone else, no action),
-;;       extra-sloppy (if it has the right value now, who cares about anything else?)
-
-;; TODO: should fail if I own parent, it has right value, but an action. (right now, we assert)...
-
-(comment ;; Version of above that allows "stealing"
- (defn make-greedy-fire-action [s effect-var]
-   (let [{:keys [name precond-map effect-map reward] :as factored-primitive}
-         (->> effect-var action-var (state/get-var s))
-         precond-vars (keys (dissoc precond-map effect-var))
-         [free-pv unfree-pv] (util/separate #(state/get-var s (free-var %)) precond-vars)
-         [reserved-pv external-pv] (util/separate #(state/get-var s (parent-var % effect-var))
-                                                  unfree-pv)]
-     (when (state/state-matches-map? s precond-map)
-       (env-util/make-factored-primitive
-        [::GreedyFire name]
-        (into precond-map
-              (concat [[(action-var effect-var) factored-primitive]]
-                      (for [v free-pv]   [(free-var v)              true])
-                      (for [v reserved-pv] [(parent-var v effect-var) true])
-                      (for [v external-pv] [(free-var v) false])
-                      (for [v external-pv] [(parent-var v effect-var) false])))
-        (into effect-map
-              (concat [[(action-var effect-var) nil]]
-                      (for [v reserved-pv] [(free-var v)              true])
-                      (for [v reserved-pv] [(parent-var v effect-var) false])))
-        0)))))
+    (env-util/make-factored-primitive
+     [::Fire name]
+     (into precond-map
+           (concat [[(action-var effect-var) factored-primitive]]
+                   (for [v free-pv]   [(free-var v)              true])
+                   (for [v unfree-pv] [(parent-var v effect-var) true])
+                   (for [v precond-vars] [(action-var v) (state/get-var s (action-var v))])))
+     (into effect-map
+           (concat [[(action-var effect-var) nil]]
+                   (for [v unfree-pv] [(free-var v)              true])
+                   (for [v unfree-pv] [(parent-var v effect-var) false])
+                   (for [v precond-vars] [(action-var v) nil])))
+     0)))
+
+(defn make-sloppy-fire-action [s effect-var]
+  (let [{:keys [name precond-map effect-map reward] :as factored-primitive}
+        (->> effect-var action-var (state/get-var s))
+        precond-vars (keys (dissoc precond-map effect-var))
+        [free-pv unfree-pv] (util/separate #(state/get-var s (free-var %)) precond-vars)
+        [reserved-pv external-pv] (util/separate #(state/get-var s (parent-var % effect-var))
+                                                 unfree-pv)]
+    (assert (every? #(contains? #{nil :frozen} (state/get-var s (action-var %))) reserved-pv))
+    (env-util/make-factored-primitive
+     [::Fire name]
+     (into precond-map
+           (concat [[(action-var effect-var) factored-primitive]]
+                   (for [v free-pv]   [(free-var v)              true])
+                   (for [v reserved-pv] [(parent-var v effect-var) true])
+                   (for [v external-pv] [(free-var v) false])
+                   (for [v external-pv] [(parent-var v effect-var) false])))
+     (into effect-map
+           (concat [[(action-var effect-var) nil]]
+                   (for [v reserved-pv] [(free-var v)              true])
+                   (for [v reserved-pv] [(parent-var v effect-var) false])
+                   (for [v reserved-pv] [(action-var v) nil])))
+     0)))
+
+(defn make-fire-action-type [s edge-rule effect-var]
+  (doto (case edge-rule
+          :naive (make-fire-action (->> effect-var action-var (state/get-var s)))
+          :greedy (make-greedy-fire-action s effect-var)
+          (:sloppy :extra-sloppy) (make-sloppy-fire-action s effect-var))
+    (-> (env/applicable? s) assert)))

@@ -218,8 +220,6 @@
     (3)(b) sloppy:       If (action-var c) has precondition on p, value mismatch or action on p and reserved by o!=c, o --> c
     (3)(c) extra-sloppy: If (action-var c) has precondition on p, value mismatch and reserved by o!=c, o --> c"
   [s child-map rule]
-  (assert (contains? #{:naive :greedy :sloppy :extra-sloppy} rule))
-  (assert (contains? #{:greedy} rule))
   (apply concat
          (for [v (cons sas/goal-var-name (keys child-map))]
            (let [a (state/get-var s (action-var v))]
@@ -231,44 +231,50 @@
                                 (let [right-val? (= (state/get-var s p) pval)
                                       p-child    (current-child s child-map p)
                                       unavail?   (not (or (= p-child nil) (= p-child v)))]
-                                  (cond unavail?         [p-child v]
-                                        (not right-val?) [p v])))))))))
-
-;; TO remove deadlock, simply avoid dag check and remove assert.
+                                  (case rule
+                                    :naive  (cond unavail?         [p-child v]
+                                                  (or (not (= p-child v)) (not (= (state/get-var s (action-var p)) :frozen))) [p v])                                            :greedy (cond unavail?         [p-child v]
+                                                  (not right-val?) [p v])
+                                    :sloppy (cond (and unavail? (or (not right-val?) (when-let [a (state/get-var s (action-var p))] (not (= a :frozen)))))         [p-child v]
+                                                  (and (not unavail?) (not right-val?)) [p v])
+                                    :extra-sloppy
+                                            (cond (and unavail? (not right-val?)) [p-child v]
+                                                  (and (not unavail?) (not right-val?)) [p v]))))))))))
+
+
+
+
 (defn source-vars
   "Take the graph from var-ordering-edges, and return the sources in the same component
    as the goal variable, which are ripe for action.  Returns nil if there are any cycles
    in the graph, since this indicates a deadlock (at least some actions cannot fire)."
-  [s child-map rule]
+  [s child-map check-deadlock? check-components? edge-rule]
 ;  (println (var-ordering-edges s child-map rule))
-  (let [edges (var-ordering-edges s child-map rule)]
-    (when (graphs/dag? edges)
+  (let [edges (var-ordering-edges s child-map edge-rule)]
+    (when (or (not check-deadlock?) (graphs/dag? edges))
       (let [sources (clojure.set/difference (set (cons sas/goal-var-name (map first edges))) (set (map second edges)))
-            goal-component (graphs/ancestor-set (cons [sas/goal-var-name sas/goal-var-name] edges) [sas/goal-var-name])
-            goal-component-sources (clojure.set/intersection sources goal-component)]
+            goal-component-sources
+            (if check-components?
+              (clojure.set/intersection
+               sources
+               (graphs/ancestor-set (cons [sas/goal-var-name sas/goal-var-name] edges) [sas/goal-var-name]))
+              sources)]
         (when-not (= (count sources) (count goal-component-sources)) (println "Warning: multiple components..."))
-        (assert (seq goal-component-sources))
+        (when check-deadlock? (assert (seq goal-component-sources)))
         goal-component-sources))))

 (defn source-var-type [s child-map v]
   (let [a (state/get-var s (action-var v))]
-    (cond (= a :frozen)
-          :top-down-activate
-
-          a
-          :fire
+    (cond (= a :frozen)  :top-down-activate
+          a              :fire

           ;; no action
-          (not (state/get-var s (free-var v)))
-          :bottom-up-action ;; Can assert on action below...
-
+          (not (state/get-var s (free-var v))) :bottom-up-action
           (some (fn [c] (when-let [ca (state/get-var s (action-var c))]
                           (contains? (:precond-map ca) v)))
                 (child-map v))
-          :bottom-up-activate
-
-          :else
-          :top-down-action)))
+                         :bottom-up-activate
+          :els           :top-down-action)))

 ;; TODO: dynamic bottom-up pruning.
  ; i.e., exists precondition of some current action, NOT currently achieved,
@@ -284,41 +290,22 @@
                           (ancestor-map pv)))]
     (not-every? live-set
                 (concat (map second extra-edges)
+                        (for [p (keys child-map)
+                              :let [a (state/get-var s (action-var p))]
+                              :when (and a (not (= a :frozen)))]
+                          p)
                         (for [[p cs] child-map, c cs
-                              :when (or (state/get-var s (parent-var p c))
-                                        (state/get-var s (action-var c)))]
+                              :when (state/get-var s (parent-var p c))]
                           c)))))

-;; Why can we use parent-edges and not filtered res-edges???
-(defn b-deadlocked? [s child-map extra-edges]
-;  false #_
-  (let [parent-edges (concat extra-edges
-                       (for [[p cs] child-map, c cs :when (state/get-var s (parent-var p c))] [p c]))
-        ;; Parent->child actions for active PC, where action on child actually wants parent
-        ; ? =*=> A
-        res-map      (into {} (filter (fn [[p c]]
-                                        (when-let [a (state/get-var s (action-var c))]
-                                          (contains? (:precond-map a) p)))
-                                      parent-edges))
-
-        ; Cross-edge -- from var reserving precondition to other var needing it.
-        extra-edges  (for [[p c] parent-edges
-                           :let [a (state/get-var s (action-var p))]
-                           :when a
-                           precond (remove #{p} (keys (:precond-map a)))
-                           :let [res (res-map precond)]
-                           :when res]
-                       [res p])]
-    (not (graphs/dag? (concat parent-edges extra-edges)))))
-
+;; TODO: remove redundant dead-end check ?
 (defn possible-activation-actions
    "Return a list of possible activation actions for var v possible in state s.
    To be possible parent, must be supported from below. "
    [s ancestor-map child-map v]
 ;   (activation-actions child-map v) #_
-   (for [c (child-map v) :when (not (or #_ (b-deadlocked? s child-map [[v c]])
-                                        (dead-end? s ancestor-map child-map [[ v c]])))]
+   (for [c (child-map v) :when (not (or (dead-end? s ancestor-map child-map [[ v c]])))]
      (make-set-parent-var-action v c)))
 ;   (or (deadlocked? s child-map [[v c]]))

@@ -326,17 +313,6 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Actions fn, actual env ;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-; Simplest way to express mechanics (in order of preference):
-
-;  Schematics:
-;  a* => A   goes to a* -> a   (greedy fire)
-;  a => A    goes to  A => A   (bottom-up action)
-;  a -> A    goes to  a => A   (bottom-up activate)
-;  a => a => goes to => A =>   (top-down action)
-;  a => a -> goes to a => a => (top-down activate)
-
-; Ideally, should prefer top-most top-down, bottom-most bottom-up, or something...

 (defrecord ASPlanEnv [base-sas-env init actions actions-fn g-map
                     ; Following stuff is used by hierarchy.
@@ -348,67 +324,87 @@
   env/FactoredEnv
     (goal-map      [e] g-map))

-(defn make-asplan-env [sas-problem]
-  (def *add-count* (util/sref 0))
-  (let [causal-graph  (remove #(apply = %) (sas-analysis/standard-causal-graph sas-problem))
-        vars          (graphs/ancestor-set causal-graph [sas/goal-var-name])
-        causal-graph  (filter (fn [[v1 v2]] (and (vars v1) (vars v2))) causal-graph)
-        tsi           (graphs/topological-sort-indices causal-graph)
-        av-map        (into {} (for [v vars] [v (graphs/ancestor-set causal-graph [v])]))
-        child-var-map (util/map-vals #(map second %) (group-by first causal-graph))
-;        vars          (keys (:vars sas-problem))
-        dtgs          (sas-analysis/domain-transition-graphs sas-problem)
-        simple-dtgs   (util/map-vals (fn [dtg] (for [[pval emap] dtg, [eval _] emap] [pval eval])) dtgs)
-        acyclic-succ-fn (partial possibly-acyclic-successors (HashMap.) simple-dtgs)]
-    (assert (graphs/dag? causal-graph))
-;    (clojure.inspector/inspect-tree child-var-map)
-    (ASPlanEnv.
-     sas-problem
-     (expand-initial-state (env/initial-state sas-problem) child-var-map (goal-action dtgs))
-     (concat
-      (for [v vars] (make-freeze-var-action v))
-      (for [a (:actions sas-problem)] (make-add-action-action a))
-      (for [[p cs] child-var-map, c cs] (make-set-parent-var-action p c))
-      (for [a (:actions sas-problem)] (make-fire-action a)))
-
-     (fn asplan-actions [s]
-;;       (println "\n" s)
-       (when-let [sources (and (not (dead-end? s av-map child-var-map [])) ;; This is necessary to catch hanging edges, or need other checks.  i.e., look at top-down env.
-                               (seq (source-vars s child-var-map :greedy)))]
-         (let [sources-by-type (group-by #(source-var-type s child-var-map %) sources)]
-;           (println sources-by-type)
-           (util/cond-let [sources]
-             (seq (sources-by-type :fire))
-             [(make-greedy-fire-action s (first sources))]
-
-             (seq (sources-by-type :bottom-up-action))
-             (let [v     (apply min-key tsi sources)
-                   c-val (state/get-var s v)
-                   dtg   (get-in dtgs [v c-val])
-                   child (current-child s child-var-map v)
-                   d-val (-> (state/get-var s (action-var child)) :precond-map (util/safe-get v))]
-               (util/assert-is (not (= c-val d-val)) "%s" (def *s* s)) ;; TODO: this only correct for greedy...
-               (for [n-val (acyclic-succ-fn v c-val d-val), a (dtg n-val)]
-                (make-add-action-action a)))
-
-             (seq (sources-by-type :bottom-up-activate))
-             (possible-activation-actions s av-map child-var-map (apply max-key tsi sources)) ;; TODO: sort!
-
-             (seq (sources-by-type :top-down-activate))
-             (let [v (first sources)]
-               (println "I!" v)
-               (possible-activation-actions s av-map child-var-map (first sources))) ;; TODO: sort?
-
-             (seq (sources-by-type :top-down-action))
-             (let [v (first sources)]
-               (println "A!" v) ;                         (state/get-var s x) (state/get-var s (parent-var x sas/goal-var-name))
-               (cons (make-freeze-var-action v)
-                     (for [as (vals (get-in dtgs [v (state/get-var s v)])), a as]
-                       (make-add-action-action a))))
-
-             :else (assert "Unknown source type!")))))
-     (env/goal-map sas-problem)
-     causal-graph dtgs av-map child-var-map acyclic-succ-fn)))
+;(def *dead-count* (atom 0))
+
+;; Recall: greedy helps the most when, e.g., lots of passengers and not much room.
+(defn make-asplan-env
+  "Make an actino-set planning environment.  Switches are:
+    check-deadlock?: check for cycles in precedence graph above and beyond lack of sources
+    check-components?: check for disconnected components, rule out sources outside of goal comp
+    edge-rule: :naive, :greedy, :sloppy, or :extra-sloppy.
+       Naive means we stick exactly to the simple semantics of the vanilla actions.
+       Greedy means we forget about reserving preconditions when free and we can fire right now (less branching).
+       Sloppy means we ignore if preconditions are free, but require no action on them.
+       Extra-sloppy means anything goes -- if you can execute ignoring commitments, go for it."
+  ([sas-problem] (make-asplan-env sas-problem true true :greedy))
+  ([sas-problem check-deadlock? check-components? edge-rule]
+  (assert (contains? #{:naive :greedy :sloppy :extra-sloppy} edge-rule))
+     (def *add-count* (util/sref 0))
+;  (def *dead-count* (util/sref 0))
+     (let [causal-graph  (remove #(apply = %) (sas-analysis/standard-causal-graph sas-problem))
+           vars          (graphs/ancestor-set causal-graph [sas/goal-var-name])
+           causal-graph  (filter (fn [[v1 v2]] (and (vars v1) (vars v2))) causal-graph)
+           tsi           (graphs/topological-sort-indices causal-graph)
+           av-map        (into {} (for [v vars] [v (graphs/ancestor-set causal-graph [v])]))
+           child-var-map (util/map-vals #(map second %) (group-by first causal-graph))
+                                        ;        vars          (keys (:vars sas-problem))
+           dtgs          (sas-analysis/domain-transition-graphs sas-problem)
+           simple-dtgs   (util/map-vals (fn [dtg] (for [[pval emap] dtg, [eval _] emap] [pval eval])) dtgs)
+           acyclic-succ-fn (partial possibly-acyclic-successors (HashMap.) simple-dtgs)]
+       (assert (graphs/dag? causal-graph))
+                                        ;    (clojure.inspector/inspect-tree child-var-map)
+       (ASPlanEnv.
+        sas-problem
+        (expand-initial-state (env/initial-state sas-problem) child-var-map (goal-action dtgs))
+        (concat
+         (for [v vars] (make-freeze-var-action v))
+         (for [a (:actions sas-problem)] (make-add-action-action a))
+         (for [[p cs] child-var-map, c cs] (make-set-parent-var-action p c))
+         (for [a (:actions sas-problem)] (make-fire-action a)))
+
+        (fn asplan-actions [s]
+          ;;       (println "\n" s)
+;          (println "\n" s #_(dead-end? s av-map child-var-map []))
+          (when-let [sources (and (not (dead-end? s av-map child-var-map [])) ;; This is necessary to catch hanging edges, or need other checks.  i.e., look at top-down env.
+                                  (seq (source-vars s child-var-map check-deadlock? check-components? edge-rule)))]
+            (let [sources-by-type (group-by #(source-var-type s child-var-map %) sources)]
+;              (println sources-by-type)
+              (util/cond-let [sources]
+                (seq (sources-by-type :fire))
+                [(make-fire-action-type s edge-rule (first sources))]
+
+                (seq (sources-by-type :bottom-up-action))
+                (let [v     (apply min-key tsi sources)
+                      c-val (state/get-var s v)
+                      dtg   (get-in dtgs [v c-val])
+                      child (current-child s child-var-map v)
+                      d-val (-> (state/get-var s (action-var child)) :precond-map (util/safe-get v))]
+                  (when (= edge-rule :greedy)
+                    #_ (util/assert-is (not (= c-val d-val)) "%s" (def *s* s)))
+                  (if (= c-val d-val)
+                    [(make-freeze-var-action v)]
+                    (for [n-val (acyclic-succ-fn v c-val d-val), a (dtg n-val)]
+                      (make-add-action-action a))))
+
+                (seq (sources-by-type :bottom-up-activate))
+                (possible-activation-actions s av-map child-var-map (apply max-key tsi sources)) ;; TODO: smarter sort!
+
+                (seq (sources-by-type :top-down-activate))
+                (let [v (first sources)]
+                  (println "I!" v)
+                  (possible-activation-actions s av-map child-var-map (first sources))) ;; TODO: sort?
+
+                (seq (sources-by-type :top-down-action))
+                (let [v (first sources)]
+                  (println "A!" v) ;                         (state/get-var s x) (state/get-var s (parent-var x sas/goal-var-name))
+                  (cons (make-freeze-var-action v)
+                        (for [as (vals (get-in dtgs [v (state/get-var s v)])), a as]
+                          (make-add-action-action a))))
+
+                :else (assert "Unknown source type!")))
+            #_ (do (util/sref-set! *dead-count* (inc (util/sref-get *dead-count*))) nil)))
+        (env/goal-map sas-problem)
+        causal-graph dtgs av-map child-var-map acyclic-succ-fn))))

 (defn make-naive-asplan-env
   "Replace the actions-fn in asplan-env with one that generates all legal actions,
@@ -419,7 +415,7 @@

 (defn asplan-solution-name [sol]
-  (map second (filter #(= (first %) ::GreedyFire) sol)))
+  (map second (filter #(= (first %) ::Fire) sol)))

 (defn asplan-solution-pair-name [[sol rew]]
   [(asplan-solution-name sol) rew])


improved excerpt algo

improved excerpt algo

--- src/app/cljs/one/sample/view/editor.cljs
+++ src/app/cljs/one/sample/view/editor.cljs
@@ -36,6 +36,7 @@
                   CHANGE
                   (fn [e] (let [content (. field (getCleanContents))
                                 previous (first (doc-session :get-history))]
+                            (.log js/console content)
                             (doc-session :set! :content content)
                             (if (not= content previous)
                               (do
@@ -65,25 +66,40 @@

 (defn strip-html [s]
   (-> s
-      (.replace "
" " ")
+      (.replace "
" "\n")
       (.replace " " " ")
       (.replace (js/RegExp. "(<([^>]+)>)" "ig") "")))

 (defn excerpt [s chars]
-  (.substring (strip-html s) 0 chars))
+  (let [stripped (strip-html s)
+        trimmed  (.trim stripped)
+        length   (.-length trimmed)
+        first-br (.indexOf trimmed "\n")
+        substr   (.substring trimmed 0 chars)
+        last-sp  (.lastIndexOf substr " ")]
+    (if (empty? trimmed)
+      "<Untitled>"
+      (if (and (not= -1 first-br) (< first-br chars))
+        (.substring trimmed 0 first-br)
+        (if (> length chars)
+          (if (not= -1 last-sp)
+            (str (.substring substr 0 last-sp) "...")
+            (str substr "..."))
+          trimmed)))))

 (defn list-documents [documents]
   (let [element ($ "#sidebar-documents > ol")
         sorted  (reverse (sort-by :ts (vals documents)))]
     (destroy-children! element)
     (doseq [{id :id :as doc} sorted]
-      (append! element (crate/html
-                        [:li {:id (name id)}
-                         [:div.excerpt
-                          [:span (excerpt (:content doc) 20)]]
-                         [:div.document-id
-                          [:span
-                           [:a.bookmark {:href (str \# (name id))} (name id)]]]])))
+      (append! element
+               (crate/html [:li {:id (name id)}
+                            [:div.excerpt
+                             [:span (excerpt (:content doc) 20)]]
+                            [:div.document-id
+                             [:span
+                              [:a.bookmark {:href (str \# (name id))}
+                               (name id)]]]])))
     (add-documents-list-listeners)))

 (dispatch/react-to #{:documents-changed}


remove testing code

remove testing code

--- src/atom_finder/util/classifier_util.clj
+++ src/atom_finder/util/classifier_util.clj
@@ -130,8 +130,6 @@
           #{:oct :dec :hex} (if (integral? s) (Long/decode s) (Double/parseDouble s))
           #{:bin} (parse-binary-literal s)
           nil)))
-
-(Double/parseDouble "0x756e6547")

 (defn log2 [n] (/ (Math/log n) (Math/log 2)))
 (def number-bits "How many bits are requited to store an integer value" log2)


s/(throw (Exception./(exception /

s/(throw (Exception./(exception /

--- src/babel/francais/morphology/verbs.cljc
+++ src/babel/francais/morphology/verbs.cljc
@@ -8,6 +8,12 @@
    #?(:cljs [babel.logjs :as log])
    [dag_unify.core :refer (copy dissoc-paths fail? get-in merge ref? strip-refs unifyc)]))

+(defn exception [error-string]
+  #?(:clj
+     (throw (Exception. error-string)))
+  #?(:cljs
+     (throw (js/Error. error-string))))
+
 (declare number-and-person)

 (def suppress-incomplete-morphology-errors true)
@@ -20,7 +26,7 @@
   (let [infinitive (reflexive-to-infinitive (get-in word [:français]))
         ar-type (try (re-find #"ar$" infinitive)
                      (catch Exception e
-                       (throw (Exception. (str "Can't regex-find on non-string: " infinitive " from word: " word)))))
+                       (exception (str "Can't regex-find on non-string: " infinitive " from word: " word))))
         er-type (re-find #"[eé]r$" infinitive)
         ir-type (re-find #"ir$" infinitive)
         re-type (re-find #"re$" infinitive)
@@ -94,13 +100,13 @@
        (if (= true suppress-incomplete-morphology-errors)
          (do (log/warn message)
              "(" (get-in word [:francais]) ")")
-         (throw (Exception. message)))))))
+         (exception message))))))

 (defn future [word]
   (let [infinitive (reflexive-to-infinitive (get-in word '(:français)))
         ar-type (try (re-find #"ar$" infinitive)
                      (catch Exception e
-                       (throw (Exception. (str "Can't regex-find on non-string: " infinitive " from word: " word)))))
+                       (exception (str "Can't regex-find on non-string: " infinitive " from word: " word))))
         er-type (re-find #"[eé]r$" infinitive)
         ir-type (re-find #"ir$" infinitive)
         re-type (re-find #"re$" infinitive)
@@ -181,13 +187,13 @@
      (let [message (str "get-string: future regular inflection: don't know what to do with input argument: " (strip-refs word))]
        (if (= true suppress-incomplete-morphology-errors)
          (do (log/warn message)
-             (throw (Exception. message))))))))
+             (exception message)))))))

 (defn imperfect [word]
   (let [infinitive (reflexive-to-infinitive (get-in word [:français]))
         ar-type (try (re-find #"ar$" infinitive)
                      (catch Exception e
-                       (throw (Exception. (str "Can't regex-find on non-string: " infinitive " from word: " word)))))
+                       (exception (str "Can't regex-find on non-string: " infinitive " from word: " word))))
         er-type (re-find #"er$" infinitive)
         ir-type (re-find #"ir$" infinitive)
         stem (if (get-in word [:imperfect-stem])
@@ -262,13 +268,13 @@
        (if (= true suppress-incomplete-morphology-errors)
          (do (log/warn message)
              "(" (get-in word [:francais]) ")")
-         (throw (Exception. message)))))))
+         (exception message))))))

 (defn present [word]
   (let [infinitive (reflexive-to-infinitive (get-in word [:français]))
         ar-type (try (re-find #"ar$" infinitive)
                      (catch Exception e
-                       (throw (Exception. (str "Can't regex-find on non-string: " infinitive " from word: " word)))))
+                       (exception (str "Can't regex-find on non-string: " infinitive " from word: " word))))
         er-type (re-find #"[eé]r$" infinitive)
         ir-type (re-find #"ir$" infinitive)
         re-type (re-find #"re$" infinitive)
@@ -368,9 +374,9 @@
      (get-in word [:français])

      :else
-     (throw (Exception. (str "get-string: present regular inflection: don't know what to do with input argument: "
-                             (strip-refs word)
-                             " (er-type: " er-type "; ir-type: " ir-type "; re-type: " re-type))))))
+     (exception (str "get-string: present regular inflection: don't know what to do with input argument: "
+                     (strip-refs word)
+                     " (er-type: " er-type "; ir-type: " ir-type "; re-type: " re-type)))))

 (defn passe-compose [word]
   (let [infinitive (reflexive-to-infinitive (get-in word '(:français)))]


Add support for reader literal anonymous functions

--- src/icfp2014/compiler.clj
+++ src/icfp2014/compiler.clj
@@ -238,7 +238,7 @@
          (compile-form fns val)
          [[:st (count *scope*) (str "^" var-name) (format "; store %s" var-name)]]))

-      (= (first form) 'lambda)
+      (or (= (first form) 'lambda) (= (first form) 'fn*))
       (let [[_ args & forms] form
             fn-name (gensym (str (*cur-fun* "-lambda")))
             fn-end (str fn-name "-end")


fix quoting bug in with-fs-tmp macro

fix quoting bug in with-fs-tmp macro

--- src/clj/elephantdb/testing.clj
+++ src/clj/elephantdb/testing.clj
@@ -18,7 +18,7 @@
       (.delete fs (path t) true))))

 (defmacro with-fs-tmp [[fs-sym & tmp-syms] & body]
-  (let [tmp-paths (mapcat (fn [t] [t '(str "/tmp/unittests/" (uuid))]) tmp-syms)]
+  (let [tmp-paths (mapcat (fn [t] [t `(str "/tmp/unittests/" (uuid))]) tmp-syms)]
     `(let [~fs-sym (filesystem)
            ~@tmp-paths]
        (.mkdirs ~fs-sym (path "/tmp/unittests"))


undo effects of Mandatory Upgrades and Self-Destruct Chips if forfeited or Turntabled by Runner

--- src/clj/game/cards-agendas.clj
+++ src/clj/game/cards-agendas.clj
@@ -254,7 +254,8 @@
                        :effect (effect (corp-install target nil {:install-state :rezzed}))} card targets))}

    "Mandatory Upgrades"
-   {:effect (effect (gain :click 1 :click-per-turn 1))}
+   {:effect (effect (gain :click 1 :click-per-turn 1))
+    :leave-play (effect (lose :click-per-turn 1))}

    "Market Research"
    {:req (req tagged) :effect (effect (set-prop card :counter 1 :agendapoints 3))}
@@ -366,7 +367,8 @@
                  :trace {:base 2 :msg "give the Runner 1 tag" :effect (effect (tag-runner :runner 1))}}]}

    "Self-Destruct Chips"
-   {:effect (effect (lose :runner :max-hand-size 1))}
+   {:effect (effect (lose :runner :max-hand-size 1))
+    :leave-play (effect (gain :runner :max-hand-size 1))}

    "Sentinel Defense Program"
    {:events {:damage {:req (req (= target :brain)) :msg "to do 1 net damage"


fix docstring removal from name meta

fix docstring removal from name meta

--- src/cljs_api_gen/docstring.clj
+++ src/cljs_api_gen/docstring.clj
@@ -49,8 +49,10 @@
         ;; rewrite utils
         z-sexpr #(when (z/sexpr-able? %) (z/sexpr %))
         z-dissoc (fn [zm k] ;; zloc of map
-                   (let [zk (-> zm z/down (z/find #(= k (z-sexpr %))))];; get key
-                     (-> zk z/right z/remove z/remove))) ;; remove key and following value
+                   (let [zk (-> zm z/down (z/find #(= k (z-sexpr %))));; get key
+                         result (-> zk z/right z/remove z/remove)] ;; remove key and following value
+                     (cond-> result
+                       (not (z/leftmost? zk)) z/up))) ;; return map zloc

         ;; in name meta?
         zloc (z/right zloc) ;; skip def, defn, or defmacro
@@ -74,10 +76,14 @@

     (or (z/root-string
           (cond
-            a-name (let [zm (-> zloc z/down)]
-                     (if (z/map? zm)
-                       (z-dissoc zm :doc)
-                       (z/replace za a-name))) ;; just replace
+            a-name (or
+                     (let [zm (-> za z/down)]
+                       (when (z/map? zm)
+                         (let [zm (z-dissoc zm :doc)]
+                           (when (seq (z-sexpr zm))
+                             zm))))
+                     ;; fallback to plain-printed meta
+                     (z/replace za a-name))
             b-str (z/remove zb)
             c-map (if (seq c-map)
                     (z-dissoc zc :doc)


Fix wait-for (not sure why we get RT exceptions) and make processor more robust

--- modules/messaging/src/main/clojure/immutant/messaging.clj
+++ modules/messaging/src/main/clojure/immutant/messaging.clj
@@ -41,22 +41,30 @@
                     (codecs/decode encoded)))))

 (defn processor [dest-name f]
-  (let [connection (.createConnection connection-factory)
-        session (.createSession connection false Session/AUTO_ACKNOWLEDGE)
-        destination (destination session dest-name)
-        consumer (.createConsumer session destination)]
-    (.setMessageListener consumer (proxy [javax.jms.MessageListener] []
-                                    (onMessage [message]
-                                      (f (codecs/decode message)))))
-    (at-exit #(do (.close connection) (println "JC: closed" connection)))
-    (.start connection)))
+  (let [connection (.createConnection connection-factory)]
+    (try
+      (let [session (.createSession connection false Session/AUTO_ACKNOWLEDGE)
+            destination (destination session dest-name)
+            consumer (.createConsumer session destination)]
+        (.setMessageListener consumer (proxy [javax.jms.MessageListener] []
+                                        (onMessage [message]
+                                          (f (codecs/decode message)))))
+        (at-exit #(do (.close connection) (println "JC: closed" connection)))
+        (.start connection))
+      (catch Throwable e
+        (.close connection)
+        (throw e)))))

-(defn wait-for-destination [f & count]
+(defn wait-for-destination [f & [count]]
   "Ignore exceptions, retrying until destination starts up"
   (let [attempts (or count 30)
         retry #(do (Thread/sleep 1000) (wait-for-destination f (dec attempts)))]
     (try
       (f)
+      (catch RuntimeException e
+        (if (and (instance? javax.jms.JMSException (.getCause e)) (> attempts 0))
+          (retry)
+          (throw e)))
       (catch javax.naming.NameNotFoundException e
         (if (> attempts 0) (retry) (throw e)))
       (catch javax.jms.JMSException e


cleanup

cleanup

--- src/babel/over.cljc
+++ src/babel/over.cljc
@@ -48,7 +48,6 @@
   [parent head]
   ;; TODO: get rid of all this type-checking and use
   ;; whatever people use for Clojure argument type-checking.
-  (println (str "wtf: type of head: " (type head)))
   (cond
     (or (seq? head)
         (vector? head))


Bump minor version

Bump minor version

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject dot-utility "0.0.1"
+(defproject dot-utility "0.0.2"
   :description "Create a utility tree from simple text format"
   :dependencies [[clojure "1.2.1"]
                  [clojure-contrib "1.2.0"]]


CMR-5275: Bumped micro-version for new feature.

--- project.clj
+++ project.clj
@@ -14,7 +14,7 @@
        ns
        "\u001B[35m]\u001B[33m λ\u001B[m=> "))

-(defproject gov.nasa.earthdata/cmr-http-kit "0.1.4-SNAPSHOT"
+(defproject gov.nasa.earthdata/cmr-http-kit "0.1.5-SNAPSHOT"
   :description "Utilities, wrappers, middleware, and components for http-kit interop"
   :url "https://github.com/cmr-exchange/cmr-http-kit"
   :license {


Version 2.2.2

Version 2.2.2

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject puppetlabs/lein-ezbake "2.2.2-SNAPSHOT"
+(defproject puppetlabs/lein-ezbake "2.2.2"
   :description "A system for building packages for trapperkeeper-based applications"
   :url "https://github.com/puppetlabs/ezbake"
   :license {:name "Apache License 2.0"


Start 0.1.1-SNAPSHOT

Start 0.1.1-SNAPSHOT

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject nightmod "0.1.0"
+(defproject nightmod "0.1.1-SNAPSHOT"
   :description "A tool for making live-moddable games in Clojure"
   :url "https://github.com/oakes/Nightmod"
   :license {:name "Public Domain"


Update reagent to 0.6.0-alpha

Update reagent to 0.6.0-alpha

--- project.clj
+++ project.clj
@@ -54,12 +54,11 @@
   :profiles {:dev {:dependencies [[cljsjs/jquery "2.1.4-0"]
                                   [crate "0.2.5"]
                                   [criterium "0.4.3"]
-                                  [devcards "0.2.1"]
                                   [devcards "0.2.1" :exclusions [sablono]]
                                   [doo "0.1.6"]
                                   [figwheel-sidecar "0.5.0-2"]
                                   [hickory "0.5.4"]
-                                  [reagent "0.5.1"]]
+                                  [reagent "0.6.0-alpha"]]
                    :plugins [[lein-cljsbuild "1.1.1"]
                              [lein-doo "0.1.6"]
                              [lein-figwheel "0.5.0-2"]]


Update dependencies.

Update dependencies.

--- project.clj
+++ project.clj
@@ -14,31 +14,31 @@

   :dependencies [
     ;; Server-side
-    [org.clojure/clojure "1.9.0-alpha14"] ; Lisp on the JVM http://clojure.org/documentation
+    [org.clojure/clojure "1.9.0-alpha15"] ; Lisp on the JVM http://clojure.org/documentation
     [org.clojure/core.match "0.3.0-alpha4"] ; Erlang-esque pattern matching https://github.com/clojure/core.match
     [defun "0.3.0-RC1"] ; Erlang-esque pattern matching for Clojure functions https://github.com/killme2008/defun
-    [ring/ring-devel "1.6.0-beta6"] ; Web application library https://github.com/ring-clojure/ring
-    [ring/ring-core "1.6.0-beta6"] ; Web application library https://github.com/ring-clojure/ring
+    [ring/ring-devel "1.6.0-RC1"] ; Web application library https://github.com/ring-clojure/ring
+    [ring/ring-core "1.6.0-RC1"] ; Web application library https://github.com/ring-clojure/ring
     [http-kit "2.3.0-alpha1"] ; Development Web server http://http-kit.org/
-    [compojure "1.6.0-beta2"] ; Web routing https://github.com/weavejester/compojure
+    [compojure "1.6.0-beta3"] ; Web routing https://github.com/weavejester/compojure
     [jumblerg/ring.middleware.cors "1.0.1"] ; CORS library https://github.com/jumblerg/ring.middleware.cors
     [raven-clj "1.5.0"] ; Clojure interface to Sentry error reporting https://github.com/sethtrain/raven-clj
     [enlive "1.1.6"] ; HTML Templating system for Clojure https://github.com/cgrand/enlive
-    [com.taoensso/carmine "2.15.0"] ; Redis client for Clojure https://github.com/ptaoussanis/carmine
+    [com.taoensso/carmine "2.16.0"] ; Redis client for Clojure https://github.com/ptaoussanis/carmine
     [clj-time "0.13.0"] ; Clojure date/time library https://github.com/clj-time/clj-time
     [environ "1.1.0"] ; Get environment settings from different sources https://github.com/weavejester/environ
-    [cheshire "5.6.3"] ; JSON de/encoding https://github.com/dakrone/cheshire
+    [cheshire "5.7.0"] ; JSON de/encoding https://github.com/dakrone/cheshire
     [org.clojure/data.xml "0.2.0-alpha2"] ; XML parser/encoder https://github.com/clojure/data.xml
     [clj-http "3.4.1"] ; HTTP client https://github.com/dakrone/clj-http
     ;; Client-side
-    [org.clojure/clojurescript "1.9.293"] ; ClojureScript compiler https://github.com/clojure/clojurescript
+    [org.clojure/clojurescript "1.9.495"] ; ClojureScript compiler https://github.com/clojure/clojurescript
     [jayq "2.5.4"] ; ClojureScript wrapper for jQuery https://github.com/ibdknox/jayq
     [hiccups "0.3.0"] ; ClojureScript implementation of Hiccup https://github.com/teropa/hiccups
     [cljs-uuid "0.0.4"] ; ClojureScript UUID https://github.com/davesann/cljs-uuid
   ]

   :plugins [
-    [lein-ring "0.10.0"] ; common ring tasks https://github.com/weavejester/lein-ring
+    [lein-ring "0.11.0"] ; common ring tasks https://github.com/weavejester/lein-ring
     [lein-environ "1.1.0"] ; Get environment settings from lein project https://github.com/weavejester/environ
   ]


update lein-protobuf

update lein-protobuf

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject org.flatland/protobuf "0.8.2-SNAPSHOT"
+(defproject org.flatland/protobuf "0.8.2"
   :description "Clojure-protobuf provides a clojure interface to Google's protocol buffers."
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
@@ -8,7 +8,7 @@
                  [org.flatland/schematic "0.1.0"]
                  [org.flatland/io "0.3.0"]
                  [ordered-collections "0.4.0"]]
-  :plugins [[lein-protobuf "0.4.1"]]
+  :plugins [[lein-protobuf "0.4.2"]]
   :aliases {"testall" ["with-profile" "dev,default:dev,1.3,default:dev,1.5,default" "test"]}
   :profiles {:1.3 {:dependencies [[org.clojure/clojure "1.3.0"]]}
              :1.5 {:dependencies [[org.clojure/clojure "1.5.0-master-SNAPSHOT"]]}


Location plugin, explore marker fixes

Location plugin, explore marker fixes

--- src/cljs/salava/location/ui/explore.cljs
+++ src/cljs/salava/location/ui/explore.cljs
@@ -26,13 +26,13 @@
                    (update coll [(-> v :lat rounded) (-> v :lng rounded)] conj v)) ; Put items at same lat/lng into a list
         click-cb (case kind
                    "users"
-                   (fn [u]
-                     (if (= 1 (count u))
+                   (fn [u u-count]
+                     (if (= 1 u-count)
                        #(mo/open-modal [:user :profile] {:user-id (-> u first :id)})
                        #(mo/open-modal [:location :userlist] {:users u})))
                    "badges"
-                   (fn [b]
-                     (if (= 1 (count b))
+                   (fn [b b-count]
+                     (if (= 1 b-count)
                        #(mo/open-modal [:gallery :badges] {:badge-id (-> b first :badge_id)})
                        #(mo/open-modal [:location :badgelist] {:badges b}))))
         item-name (case kind
@@ -47,12 +47,18 @@
        (fn [data]
          (.clearLayers layer-group)
          (doseq [item (->> kind keyword (get data) (reduce group-fn {}) vals)]
-           (let [item-1 (first item)]
+           (let [item-1 (first item)
+                 unique-key (case kind
+                              "users"  :id
+                              "badges" :badge_id)
+                 unique-count (->> item (map unique-key) set count)
+                 icon  (icon kind unique-count)
+                 title (if (= unique-count 1) (item-name item-1) "")]
              (.addLayer
                layer-group
                (-> (js/L.latLng. (:lat item-1) (:lng item-1))
-                   (js/L.marker. (clj->js {:icon (icon kind (count item)) :title (item-name item-1)}))
-                   (.on "click" (click-cb item)))))))
+                   (js/L.marker. (clj->js {:icon icon :title title}))
+                   (.on "click" (click-cb item unique-count)))))))
        })))

 (defn filter-autocomplete [kind state]


Prepare for next snapshot

Prepare for next snapshot

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject binaryage/devtools "0.3.0"
+(defproject binaryage/devtools "0.3.1-SNAPSHOT"
   :description "Experimental Chrome devtools support for ClojureScript"
   :url "https://github.com/binaryage/cljs-devtools"
   :license {:name         "MIT License"


Version 0.7.2

Version 0.7.2

--- project.clj
+++ project.clj
@@ -2,7 +2,7 @@
 (def ks-version "1.3.0")
 (def i18n-version "0.4.1")

-(defproject puppetlabs/pcp-broker "0.7.2-SNAPSHOT"
+(defproject puppetlabs/pcp-broker "0.7.2"
   :description "PCP fabric messaging broker"
   :url "https://github.com/puppetlabs/pcp-broker"
   :license {:name "Apache License, Version 2.0"


Update dependencies.

Update dependencies.

--- project.clj
+++ project.clj
@@ -3,11 +3,12 @@
   :url         "https://github.com/funcool/cats"
   :license {:name "BSD (2 Clause)"
             :url  "http://opensource.org/licenses/BSD-2-Clause"}
-  :dependencies [[org.clojure/clojure "1.7.0" :scope "provided"]
-                 [org.clojure/clojurescript "1.7.189" :scope "provided"]
+  :dependencies [[org.clojure/clojure "1.8.0" :scope "provided"]
+                 [org.clojure/clojurescript "1.9.36" :scope "provided"]
                  [org.clojure/core.async "0.2.374" :scope "provided"]
                  [org.clojure/test.check "0.9.0" :scope "provided"]
-                 [manifold "0.1.1" :scope "provided"]]
+                 [manifold "0.1.4" :scope "provided"]
+                 [funcool/promesa "1.3.1" :scope "provided"]]
   :deploy-repositories {"releases"  :clojars
                         "snapshots" :clojars}
   :source-paths   ["src"]


cider middleware

cider middleware

--- project.clj
+++ project.clj
@@ -49,12 +49,25 @@
   :source-paths ["src"]
   :test-paths ["test"]
   :repositories {"sonatype-oss-public" "https://oss.sonatype.org/content/groups/public/"}
-  :profiles { :dev {:source-paths ["dev" "src"]
-                    :plugins [[lein-midje "3.1.3"]]
-                    :repl-options {:init-ns user}
-                    :dependencies [[org.clojure/tools.namespace "0.2.8"]
-                                   [org.clojure/java.classpath "0.2.2"]
-                                   [midje "1.7.0-SNAPSHOT"] ]}
+  :profiles {:dev {:source-paths ["dev" "src"]
+                   :dependencies [[cider/cider-nrepl "0.9.0-SNAPSHOT"]
+                                  [org.clojure/tools.nrepl "0.2.7"]]
+                   :repl-options {:init-ns user
+                                  :nrepl-middleware
+                                  [cider.nrepl.middleware.apropos/wrap-apropos
+                                   cider.nrepl.middleware.classpath/wrap-classpath
+                                   cider.nrepl.middleware.complete/wrap-complete
+                                   cider.nrepl.middleware.format/wrap-format
+                                   cider.nrepl.middleware.info/wrap-info
+                                   cider.nrepl.middleware.inspect/wrap-inspect
+                                   cider.nrepl.middleware.macroexpand/wrap-macroexpand
+                                   cider.nrepl.middleware.ns/wrap-ns
+                                   cider.nrepl.middleware.pprint/wrap-pprint
+                                   cider.nrepl.middleware.resource/wrap-resource
+                                   cider.nrepl.middleware.stacktrace/wrap-stacktrace
+                                   cider.nrepl.middleware.test/wrap-test
+                                   cider.nrepl.middleware.trace/wrap-trace
+                                   cider.nrepl.middleware.undef/wrap-undef]}}
              :prod {:aot :all
                     :hooks [leiningen.cljsbuild]
                     :main server.system}}


lein-release plugin: preparing 0.41 release

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


Update deploy-repositories with correct clojars syntax.

--- project.clj
+++ project.clj
@@ -48,8 +48,8 @@
                  [hikari-cp "2.13.0"]]

-  :deploy-repositories [["releases" {:url "https://clojars.org/repo"
-                                     :sign-releases false}]]
+  :deploy-repositories [["clojars" {:url "https://repo.clojars.org"
+                                    :sign-releases false}]]

   :release-tasks [["vcs" "assert-committed"]
                   ["change" "version" "leiningen.release/bump-version" "release"]


bump version to stable to update clojars search index

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject crucible "0.2.0-SNAPSHOT"
+(defproject crucible "0.2.0"
   :description "AWS Cloudformation templates in Clojure"
   :url "http://github.com/brabster/crucible"
   :license {:name "Eclipse Public License"


Changes:  - Bumped to ClojureScript 0.0-3169  - Bumped to Secretary 1.2.3

--- project.clj
+++ project.clj
@@ -37,12 +37,12 @@
   :url              "https://github.com/Day8/re-com.git"

   :dependencies     [[org.clojure/clojure         "1.6.0"]
-                     [org.clojure/clojurescript   "0.0-2843" scope="provided"]
+                     [org.clojure/clojurescript   "0.0-3169" scope="provided"]
                      ;[stabilized/clojurescript    "1.0.0" scope="provided"]       ;; TODO: Eventually switch to this one (when it works)
                      [org.clojure/core.async      "0.1.346.0-17112a-alpha" scope="provided"]
                      [reagent                     "0.5.0" scope="provided"]
                      [com.andrewmcveigh/cljs-time "0.3.2" scope="provided"]
-                     [secretary                   "1.2.1" scope="provided"]]
+                     [secretary                   "1.2.3" scope="provided"]]

   ;:plugins          [[lein-unpack-resources "0.1.1"]]
   ;


upgrade to latest dag_unify release

upgrade to latest dag_unify release


lein-release plugin: bumped version from 0.1.1 to 0.1.2-SNAPSHOT for next development cycle

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject lein-jslint "0.1.1"
+(defproject lein-jslint "0.1.2-SNAPSHOT"
   :description "A Leiningen plugin for running JS code through JSLint."
   :url "https://github.com/vbauer/lein-jslint"
   :license {:name "Eclipse Public License"


0.8.1-wip4

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject storm "0.8.1-wip4-SNAPSHOT"
+(defproject storm "0.8.1-wip4"
   :source-path "src/clj"
   :test-path "test/clj"
   :java-source-path "src/jvm"


Cyanite 0.2.13.

Cyanite 0.2.13.

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject org.spootnik/cyanite "0.2.12"
+(defproject org.spootnik/cyanite "0.2.13"
   :description "Alternative storage backend for graphite, backed by cassandra"
   :url "https://github.com/pyr/cyanite"
   :license {:name "MIT License"


fix url

fix url

--- project.clj
+++ project.clj
@@ -1,6 +1,6 @@
 (defproject migae/lein-template "0.1.0"
   :description "migae project template"
-  :url "http://github.com/greynolds/migae"
+  :url "http://github.com/greynolds/migae-template"
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :eval-in-leiningen true)


exclude hatch from everything and dep directly

--- project.clj
+++ project.clj
@@ -14,16 +14,18 @@
                  ^{:voom {:repo "https://github.com/vlacs/helmsman"}}
                  [org.vlacs/helmsman "0.2.6-20140619_005947-gb4bb7d4" :exclusions [org.eclipse.jetty.orbit/javax.servlet com.taoensso/timbre]]
                  ^{:voom {:repo "https://github.com/vlacs/navigator" :branch "dev"}}
-                 [org.vlacs/navigator "0.1.3-20140630_172219-g25afde4" :exclusions [com.datomic/datomic-free]]
+                 [org.vlacs/navigator "0.1.3-20140630_172219-g25afde4" :exclusions [com.datomic/datomic-free org.vlacs/hatch]]
                  ^{:voom {:repo "https://github.com/vlacs/oarlock" :branch "dev"}}
-                 [org.vlacs/oarlock "0.1.0-20140717_190327-g1cc7312" :exclusions [com.datomic/datomic-free]]
+                 [org.vlacs/oarlock "0.1.0-20140721_170833-g437eae1" :exclusions [com.datomic/datomic-free org.vlacs/hatch]]
                  ^{:voom {:repo "https://github.com/vlacs/timber"}}
                  [org.vlacs/timber "0.1.7-20140625_192643-gf77b7f9"]
                  ^{:voom {:repo "https://github.com/vlacs/traveler" :branch "dev"}}
                  [org.vlacs/traveler "0.3.0-20140721_134856-g001f72c"
-                  :exclusions [org.vlacs/helmsman org.vlacs/hatch com.datomic/datomic-free]]
+                  :exclusions [org.vlacs/helmsman com.datomic/datomic-free org.vlacs/hatch]]
                  ^{:voom {:repo "https://github.com/vlacs/flare" :branch "dev"}}
-                 [org.vlacs/flare "0.1.0-20140718_201951-g1750394" :exclusions [com.datomic/datomic-free]]
+                 [org.vlacs/flare "0.1.0-20140718_201951-g1750394" :exclusions [com.datomic/datomic-free org.vlacs/hatch]]
+                 ^{:voom {:repo "https://github.com/vlacs/hatch" :branch "dev"}}
+                 [org.vlacs/hatch "0.2.3-20140721_152704-g587007c"]

                  [clj-http "0.9.1"]
                  [clj-time "0.7.0"]


Version 0.0.15-SNAPSHOT

Version 0.0.15-SNAPSHOT

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject pe-jdbc-utils "0.0.14"
+(defproject pe-jdbc-utils "0.0.15-SNAPSHOT"
   :description "A Clojure library of helper functions when working with JDBC."
   :url "https://github.com/evanspa/pe-jdbc-utils"
   :license {:name "MIT"


Add re-frame to the project

Add re-frame to the project


Upgrade more tools

Upgrade more tools

--- project.clj
+++ project.clj
@@ -8,10 +8,10 @@
                  [org.clojure/spec.alpha "0.1.143" :scope "provided"]]
   :deploy-repositories [["releases" :clojars]]
   :jar-exclusions [#"^public/.*"]
-  :plugins [[com.jakemccrary/lein-test-refresh "0.22.0"]
+  :plugins [[com.jakemccrary/lein-test-refresh "0.23.0"]
             [lein-cljfmt "0.5.7"]
             [lein-cljsbuild "1.1.7" :exclusions [[org.clojure/clojure]]]
-            [lein-figwheel "0.5.15"]
+            [lein-figwheel "0.5.16"]
             [lein-codox "0.10.3"]
             [lein-hiera "1.0.0"]]
   :codox {:output-path "docs"
@@ -80,7 +80,7 @@
              ;; :server-logfile false
 }
   :profiles {:dev {:dependencies [[binaryage/devtools "0.9.10"]
-                                  [figwheel-sidecar "0.5.15"]
+                                  [figwheel-sidecar "0.5.16"]
                                   [com.cemerick/piggieback "0.2.2"]
                                   [orchestra "2017.11.12-1"]
                                   [org.clojure/core.specs.alpha "0.1.24"]
@@ -91,7 +91,7 @@
                                   [ring/ring-core "1.6.3"] ; required to make ring-spec work, may cause issues with figwheel?
                                   [ring/ring-spec "0.0.4"] ; to test specs
                                   [org.onyxplatform/onyx-spec "0.12.7.0"] ; to test specs
-                                  [com.gfredericks/test.chuck "0.2.8"]]
+                                  [com.gfredericks/test.chuck "0.2.9"]]
                    :plugins [[io.aviso/pretty "0.1.34"]
                              [lein-eftest "0.5.2"]]
                    ;; need to add dev source path here to get user.clj loaded
@@ -115,7 +115,7 @@
                                           [metosin/spec-tools "0.6.1"]]}
              :test-web [:test-common
                         {:source-paths ["test"]
-                         :dependencies [[figwheel-sidecar "0.5.15"]
+                         :dependencies [[figwheel-sidecar "0.5.16"]
                                         [karma-reporter "2.1.2"]]}]
              :cljs-repl {:dependencies [[com.cemerick/piggieback "0.2.2"]]}
              :clj-1.9.0-alpha19 {:dependencies [[org.clojure/clojure "1.9.0-alpha19"]]}


Prepare for next release cycle.

Prepare for next release cycle.

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject onyx-app/lein-template "0.9.7.0-alpha4"
+(defproject onyx-app/lein-template "0.9.7.0-SNAPSHOT"
   :description "Onyx Leiningen application template"
   :url "https://github.com/onyx-platform/onyx-template"
   :license {:name "MIT License"


next iteration

next iteration

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
- (defproject com.ladderlife/om-css "0.5.0"
+ (defproject com.ladderlife/om-css "0.5.1-SNAPSHOT"
   :description "Om Next + CSS"
   :url "http://github.com/ladderlife/om-css"
   :license {:name "Eclipse Public License"


Remove slf4j conflict warning

Remove slf4j conflict warning

--- project.clj
+++ project.clj
@@ -91,7 +91,7 @@
                         clj-http                   "1.0.1"

                         ;; org.projectodd.wunderboss  "0.8.1"
-                        org.projectodd.wunderboss  "1.x.incremental.263"
+                        org.projectodd.wunderboss  "1.x.incremental.264"
                         ;; org.projectodd.wunderboss  "0.8.2-SNAPSHOT"

                         org.immutant               :version